User user@ for user-value

parent 4888ef6e
......@@ -193,7 +193,7 @@ KERN_SRC = \
kernel/recognizer.fs \
kernel/io.fs \
kernel/input.fs \
kernel/input-struct.fs \
kernel/input-class.fs \
kernel/license.fs \
kernel/nio.fs \
kernel/saccept.fs \
......
......@@ -1113,6 +1113,7 @@ Ghost 2dup drop
Ghost call drop
Ghost @ drop
Ghost useraddr drop
Ghost user@ drop
Ghost execute drop
Ghost + drop
Ghost decimal drop
......@@ -1749,8 +1750,9 @@ T has? relocate H
: cfalign ( -- ) 0 T cfalign# H ;
: >address dup 0>= IF tbyte / THEN ; \ ?? jaw
\ : A! swap >address swap dup relon T ! H ;
: A! swap >address swap dup relon T ! H ;
: A, ( w -- ) >address T here H relon T , H ;
: V, ( w -- ) >address T here H reloff T , H ;
\ high-level ghosts
......@@ -3449,16 +3451,16 @@ Builder Create
compile: g>body alit, ;compile
Builder User
compile: g>body compile useraddr T here H reloff T @ , H ;compile
compile: g>body compile useraddr T @ V, H ;compile
Builder Defer
compile: g>body compile lit-perform T A, H ;compile
Builder (Field)
compile: g>body T @ H compile lit+ T here H reloff T , H ;compile
compile: g>body T @ H compile lit+ T V, H ;compile
Builder UValue
compile: g>body compile useraddr T here H reloff T @ , H compile @ ;compile
compile: g>body compile user@ T @ V, H ;compile
[THEN]
\ structural conditionals 17dec92py
......
......@@ -464,7 +464,7 @@ opt: ( uvalue-xt to-xt -- )
!!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
\g u-to is the to-method for user values; it's xt is only
\g there to be consumed by @code{set-to}.
: u-compile, ( xt -- ) >body @ postpone useraddr , postpone @ ;
: u-compile, ( xt -- ) >body @ postpone user@ , ;
: UValue ( "name" -- )
\G Define a per-thread value
......
......@@ -18,7 +18,7 @@
\ along with this program. If not, see http://www.gnu.org/licenses/.
require ./vars.fs
include ./input-struct.fs
include ./input-class.fs
include ./int.fs
has? compiler [IF]
include ./comp.fs
......
......@@ -1467,7 +1467,7 @@ f = FLAG(u1-u2 < u3-u2);
\g stack
useraddr ( #u -- a_addr ) new
useraddr ( #u -- a_addr ) gforth
a_addr = (Cell *)(((Address)up)+u);
up! ( a_addr -- ) gforth up_store
......@@ -1609,6 +1609,9 @@ w = sp[u];
:
2swap 2over ;
user@ ( #u -- w ) gforth user_fetch
w = *(Cell *)(((Address)up)+u);
\ toggle is high-level: 0.11/0.42%
\g memory
......
......@@ -692,6 +692,23 @@ VARIABLE C-Pass
THEN
THEN cell+ ;
[THEN]
[IFDEF] user@
: search-userval ( offset nt -- offset flag )
name>int dup >does-code ['] infile-id >does-code = IF
2dup >body @ = IF -rot nip false EXIT
THEN THEN drop true ;
: c-user@ ( addr -- addr' )
display? IF
0 over @
[: ['] search-userval swap traverse-wordlist ;] map-vocs drop
display? IF
?dup-IF name>string com# .string bl cemit
ELSE s" user@ " com# .string
dup @ c-. bl cemit
THEN
THEN
THEN cell+ ;
[THEN]
CREATE C-Table
' lit A, ' c-lit A,
......@@ -730,6 +747,7 @@ CREATE C-Table
[IFDEF] u#+ ' u#+ A, ' c-u#+ A, [THEN]
[IFDEF] call-c# ' call-c# A, ' c-call-c# A, [THEN]
[IFDEF] useraddr ' useraddr A, ' c-useraddr A, [THEN]
[IFDEF] user@ ' user@ A, ' c-user@ A, [THEN]
0 , here 0 ,
avariable c-extender
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment