[OpenBIOS] r616 - trunk/openbios-devel/forth/lib
svn at openbios.org
svn at openbios.org
Fri Nov 20 16:38:30 CET 2009
Author: stepan
Date: 2009-11-20 16:38:29 +0100 (Fri, 20 Nov 2009)
New Revision: 616
Added:
trunk/openbios-devel/forth/lib/64bit.fs
Modified:
trunk/openbios-devel/forth/lib/build.xml
Log:
Add 64bit extensions from 12756d5
Signed-off-by: Stefan Reinauer <stepan at coresystems.de>
Added: trunk/openbios-devel/forth/lib/64bit.fs
===================================================================
--- trunk/openbios-devel/forth/lib/64bit.fs (rev 0)
+++ trunk/openbios-devel/forth/lib/64bit.fs 2009-11-20 15:38:29 UTC (rev 616)
@@ -0,0 +1,140 @@
+\
+\ Copyright (C) 2009 Stefan Reinauer
+\
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\
+
+\ Implementation of IEEE Draft Std P1275.6/D5
+\ Standard for Boot (Initialization Configuration) Firmware
+\ 64 Bit Extensions
+
+
+cell /x = constant 64bit?
+
+64bit? [IF]
+
+: 32>64 ( 32bitsigned -- 64bitsigned )
+ dup 80000000 and if \ is it negative?
+ ffffffff00000000 or \ then set all high bits
+ then
+;
+
+: lxjoin ( quad.lo quad.hi -- o )
+ d# 32 lshift or
+;
+
+: wxjoin ( w.lo w.2 w.3 w.hi -- o )
+ wljoin >r wljoin r> lxjoin
+;
+
+: bxjoin ( b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi -- o )
+ bljoin >r bljoin r> lxjoin
+;
+
+: <l@ ( qaddr -- n )
+ l@ 32>64
+;
+
+: unaligned-x@ ( addr - o )
+ dup la+ unaligned-l@ swap unaligned-l@ lxjoin
+;
+
+: unaligned-x! ( oaddr o -- )
+ 2dup d# 32 rshift unaligned-l!
+ swap la+ swap h# ffffffff and unaligned-l!
+;
+
+: x@ ( oaddr -- o )
+ unaligned-x@ \ for now
+;
+
+: x! ( oaddr o -- )
+ unaligned-x! \ for now
+;
+
+: (rx@) ( oaddr - o )
+ x@
+;
+
+: (rx!) ( o oaddr -- )
+ x!
+;
+
+\ : rx@ ( oaddr - o )
+\ compile? if
+\ h# 22e get-token if compile, else execute then
+\ else
+\ h# 22e get-token drop execute
+\ then
+\ ; immediate
+
+\ : rx! ( o oaddr -- )
+\ compile? if
+\ h# 22f get-token if compile, else execute then
+\ else
+\ h# 22f get-token drop execute
+\ then
+\ ; immediate
+
+: x, ( o -- )
+ here /x allot x!
+;
+
+: /x* ( nu1 -- nu2 )
+ /x *
+;
+
+: xa+ ( addr1 index -- addr2 )
+ /x* +
+;
+
+: xa1+ ( addr1 -- addr2 )
+ /x +
+;
+
+: xlsplit ( o -- quad.lo quad.hi )
+ dup h# ffffffff and swap d# 32 rshift
+;
+
+: xwsplit ( o -- w.lo w.2 w.3 w.hi )
+ xlsplit >r lwsplit r> lwsplit
+;
+
+: xbsplit ( o -- b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi )
+ xlsplit >r lbsplit r> lbsplit
+;
+
+: xlflip ( oct1 -- oct2 )
+ xlsplit swap lxjoin
+;
+
+: xlflips ( oaddr len -- )
+ bounds ?do
+ i unaligned-x@ xlflip i unaligned-x!
+ /x +loop
+;
+
+: xwflip ( oct1 -- oct2 )
+ xlsplit lwflip swap lwflip lxjoin
+;
+
+: xwflips ( oaddr len -- )
+ bounds ?do
+ i unaligned-x@ xwflip i unaligned-x! /x
+ +loop
+;
+
+: xbflip ( oct1 -- oct2 )
+ xlsplit lbflip swap lbflip lxjoin
+;
+
+: xbflips ( oaddr len -- )
+ bounds ?do
+ i unaligned-x@ xbflip i unaligned-x!
+ /x +loop
+;
+
+\ : b(lit) b(lit) 32>64 ;
+
+[THEN]
Modified: trunk/openbios-devel/forth/lib/build.xml
===================================================================
--- trunk/openbios-devel/forth/lib/build.xml 2009-11-20 15:30:52 UTC (rev 615)
+++ trunk/openbios-devel/forth/lib/build.xml 2009-11-20 15:38:29 UTC (rev 616)
@@ -15,6 +15,7 @@
<object source="creation.fs"/>
<object source="split.fs"/>
<object source="lists.fs"/>
+ <object source="64bit.fs"/>
</dictionary>
</build>
More information about the OpenBIOS
mailing list