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