commit 362ef3986cce1109bb8f4a81cbdc8f2973d72085
parent 10bc993f0109fe515f7b7727b9daea33834275fd
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 10 Aug 2022 11:38:03 -0400
Allow "entry" to create entries in any dictionary
This facilitates the creation of ad-hoc dictionaries. It also removes the use
for the "xdict" library.
Diffstat:
6 files changed, 12 insertions(+), 55 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -185,7 +185,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
_debug if ." debugging: " dup ast.func.name stype nl> then
ops$
dup ast.func.flags 1 and ( extern? ) if
- dup ast.func.name entry then ( fnode )
+ sysdict over ast.func.name entry then ( fnode )
here over to ast.func.address
dup ast.func.args ast.args.totsize over ast.func.locsize ( argsz locsz )
vmprelude, dup genchildren
diff --git a/fs/lib/xdict.fs b/fs/lib/xdict.fs
@@ -1,28 +0,0 @@
-\ Extra dictionaries
-\ Create and use dictionaries besides the system one. Such dictionaries use the
-\ same words as words for the system dictionary. It does so by fiddling with
-\ "sysdict".
-
-\ Usage: You begin by allocating a new dict structure with "newxdict <name>".
-\ Then, you just need to use "x" words like "xentry" and "x'". If you need
-\ dict-related words that aren't proxied by "x" words, you can use xdict[
-\ and ]xdict directly, but be careful not to use this in interpret mode because
-\ you'll lock you out of your system dict. Also, you can't nest xdict[ calls.
-\ Example:
-
-\ newxdict mydict
-\ mydict xcreate foo 1 c, 2 c, 3 c,
-\ 42 mydict xvalue bar
-\ mydict x' foo execute 1+ c@ .x1 -> 02
-\ mydict x' bar execute .x1 -> 2a
-
-0 value dictbkp
-: newxdict create 4 allot0 ;
-: xdict[ ( 'dict -- ) sysdict @ to dictbkp @ sysdict ! ;
-: ]xdict ( 'dict -- ) sysdict @ swap ! dictbkp sysdict ! ;
-: xdictproxy ( w -- ) doer , does> ( 'dict 'w -- )
- over xdict[ swap >r @ execute r> ]xdict ;
-' ' xdictproxy x'
-' entry xdictproxy xentry
-' create xdictproxy xcreate
-' value xdictproxy xvalue
diff --git a/fs/tests/lib/all.fs b/fs/tests/lib/all.fs
@@ -2,6 +2,5 @@
f<< /tests/lib/core.fs
f<< /tests/lib/bit.fs
f<< /tests/lib/str.fs
-f<< /tests/lib/xdict.fs
f<< /tests/lib/crc.fs
f<< /tests/lib/io.fs
diff --git a/fs/tests/lib/xdict.fs b/fs/tests/lib/xdict.fs
@@ -1,12 +0,0 @@
-?f<< tests/harness.fs
-?f<< lib/xdict.fs
-testbegin
-\ Test xdict
-
-newxdict mydict
-mydict xcreate foo 1 c, 2 c, 3 c,
-42 mydict xvalue bar
-mydict x' foo execute 1+ c@ 2 #eq
-mydict x' bar execute 42 #eq
-S" noop" mydict find not #
-testend
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -2,12 +2,11 @@
5 - [ exit,
," ;" 0 , sysdict @ , $81 c, here w>e sysdict !
' [ execute, ' exit, execute, exit,
-," dict," 0 , sysdict @ , 5 c, here w>e sysdict ! ]
- dup 1+ swap c@ tuck move, rot> , , c, ;
," entry" 0 , sysdict @ , 5 c, here w>e sysdict ! ]
- sysdict @ nextmeta @ rot dict, here w>e sysdict ! 0 nextmeta ! ;
+ dup 1+ swap c@ tuck move, nextmeta @ , over @ , c,
+ here w>e swap ! 0 nextmeta ! ;
," :" 0 , sysdict @ , 1 c, here w>e sysdict ! ]
- word entry ] ;
+ sysdict word entry ] ;
: e>w 5 + ;
: current sysdict @ e>w ;
: immediate current 1- dup c@ $80 or swap c! ;
@@ -70,7 +69,7 @@
: nc, ( n -- ) >r begin word runword c, next ;
\ Compiling words
-: code word entry ;
+: code sysdict word entry ;
: create code compile (cell) ;
: value code compile (val) , ;
: const code litn exit, ;
@@ -189,10 +188,9 @@ alias noop [then]
: 'structsz ( 'struct -- sz ) @ llcnt CELLSZ * ;
: structsz ( w -- sz ) does' 'structsz ;
: struct ( cnt -- )
- doer >r here 0 , 0 , 0 0 begin ( 'dict off current )
- 0 ( meta ) word dict, here w>e ( 'dict off current )
- swap dup , CELLSZ + swap next ( 'dict off current )
- nip swap ! immediate
+ doer >r here 0 , 0 , 0 begin ( 'dict off )
+ over word entry ( 'dict off ) dup , CELLSZ + next ( 'dict off )
+ 2drop immediate
does> ( ??? 'struct -- ??? *to* )
word case ( 'struct R:str )
S" '(" of s= 0 _parens endof
diff --git a/fs/xcomp/tools.fs b/fs/xcomp/tools.fs
@@ -4,16 +4,16 @@
\ dict in it.
?f<< /lib/str.fs
-?f<< /lib/xdict.fs
?f<< /asm/label.fs \ org and binstart are there
-newxdict xbindict
+create xbindict 0 ,
: xoffset binstart org - ;
-: xcode word xbindict xentry ;
+: xcode xbindict word entry ;
\ Usage: xwordlbl foo call, "foo" being a word name in xbindict
-: xwordlbl ( "name" -- pc ) xbindict x' xoffset + ;
+: xwordlbl ( "name" -- pc )
+ word xbindict find ?dup not if (wnf) then xoffset + ;
\ Traverse xdict and change all its prev field values so that they are related
\ to current org+binstart. Once this is done, the xdict can't be traversed
