[OpenBIOS] r617 - trunk/openbios-devel/forth/device

[svn at openbios.org]

Author: stepan
Date: 2009-11-20 16:40:53 +0100 (Fri, 20 Nov 2009)
New Revision: 617

Modified:
   trunk/openbios-devel/forth/device/fcode.fs
   trunk/openbios-devel/forth/device/other.fs
   trunk/openbios-devel/forth/device/table.fs
Log:
- hook up new 64bit words into fcode table.
- dummy implementations for peek, poke, ms and get-msecs


Modified: trunk/openbios-devel/forth/device/fcode.fs
===================================================================
--- trunk/openbios-devel/forth/device/fcode.fs	2009-11-20 15:38:29 UTC (rev 616)
+++ trunk/openbios-devel/forth/device/fcode.fs	2009-11-20 15:40:53 UTC (rev 617)
@@ -368,12 +368,21 @@
 \ b(lit) ( -- n1 ) 
 \   Numeric literal FCode. Followed by FCode-num32.
 
+64bit? [IF]
 : b(lit)
+  fcode-num32 32>64
+  state @ if
+    ['] (lit) , ,
+  then
+  ; immediate
+[ELSE]
+: b(lit)
   fcode-num32 
   state @ if
     ['] (lit) , ,
   then
   ; immediate
+[THEN]
 
 
 \ b(') ( -- xt )  

Modified: trunk/openbios-devel/forth/device/other.fs
===================================================================
--- trunk/openbios-devel/forth/device/other.fs	2009-11-20 15:38:29 UTC (rev 616)
+++ trunk/openbios-devel/forth/device/other.fs	2009-11-20 15:40:53 UTC (rev 617)
@@ -21,21 +21,27 @@
 \ 5.3.7.1 Peek/poke 
 
 : cpeek    ( addr -- false | byte true )
+  c@ true
   ;
 
 : wpeek    ( waddr -- false | w true )
+  w@ true
   ;
 
 : lpeek    ( qaddr -- false | quad true )
+  l@ true
   ;
   
 : cpoke    ( byte addr -- okay? )
+  c! true
   ;
   
 : wpoke    ( w waddr -- okay? )
+  w! true
   ;
   
 : lpoke    ( quad qaddr -- okay? )
+  l! true
   ;
 
 
@@ -59,13 +65,33 @@
 : rl!    ( quad qaddr -- )
   ;
 
-  
+: rx@ ( oaddr - o )
+  state @ if
+    h# 22e get-token if , else execute then
+  else
+    h# 22e get-token drop execute
+  then
+  ; immediate
+
+: rx! ( o oaddr -- )
+  state @ if
+    h# 22f get-token if , else execute then
+  else
+    h# 22f get-token drop execute
+  then
+  ; immediate
+ 
 \ 5.3.7.3 Time
 
+0 value dummy-msecs
+
 : get-msecs    ( -- n )
+  dummy-msecs dup 1+ to dummy-msecs
   ;
   
 : ms    ( n -- )
+  get-msecs +
+  begin dup get-msecs < until
   ;
   
 : alarm    ( xt n -- )

Modified: trunk/openbios-devel/forth/device/table.fs
===================================================================
--- trunk/openbios-devel/forth/device/table.fs	2009-11-20 15:38:29 UTC (rev 616)
+++ trunk/openbios-devel/forth/device/table.fs	2009-11-20 15:40:53 UTC (rev 617)
@@ -380,7 +380,13 @@
   ['], lbflip
   ['], lbflips
   ['], adr-mask
-  6 n['], reserved-fcode       \ 22a-22f 
+  4 n['], reserved-fcode       \ 22a-22d
+64bit? [IF]
+  ['], (rx@)
+  ['], (rx!)
+[ELSE]
+   2 n['], reserved-fcode       \ 22e-22f 
+[THEN]
   ['], rb@
   ['], rb!
   ['], rw@
@@ -398,9 +404,34 @@
   ['], byte-load
   ['], set-args
   ['], left-parse-string        \ 240
+64bit? [IF]
+  ['], bxjoin
+  ['], <l@
+  ['], lxjoin
+  ['], wxjoin
+  ['], x,
+  ['], x@
+  ['], x!
+  ['], /x
+  ['], /x*
+\   ['], /xa+
+\   ['], /xa1+
+  ['], xbflip
+  ['], xbflips
+  ['], xbsplit
+  ['], xlflip
+  ['], xlflips
+  ['], xlsplit
+  ['], xwflip
+  ['], xwflips
+  ['], xwsplit
+[ELSE]
   7 n['], reserved-fcode	\ 241-247 (Part of IEEE1275 64-bit draft standard)
   ['], /x
+  c n['], reserved-fcode	\ 249-254 (Part of IEEE1275 64-bit draft standard)
+[THEN]
 
+
 here fcode-master-table - constant fcode-master-table-size