commit 8fac74429fc8fe6a1f102f36faa901e720a247f8
parent 0db6bee65b0d9253f79a9b656dfbd6163f5afa22
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 10 Aug 2022 06:51:15 -0400
Change find semantic
Going from ( str -- w-or-0 ) to ( str 'dict -- w-or-0 ). It makes it easier to
have adhoc dicts.
Diffstat:
5 files changed, 21 insertions(+), 15 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -206,7 +206,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
parentnode dup ast.func.locsize swap to ast.func.cursf ;
:w ( Ident ) dup identfind ?dup if ( inode dnode )
nip decl>op else ( inode )
- ast.ident.name find ?dup _assert mem>op then ;
+ ast.ident.name current find ?dup _assert mem>op then ;
:w ( UnaryOp )
_debug if ." unaryop: " dup printast nl> .ops then
dup genchildren
diff --git a/fs/lib/xdict.fs b/fs/lib/xdict.fs
@@ -4,8 +4,8 @@
\ "current".
\ Usage: You begin by allocating a new dict structure with "newxdict <name>".
-\ Then, you just need to use "x" words like "xentry", "x'" and "xfind". If you
-\ need dict-related words that aren't proxied by "x" words, you can use xdict[
+\ 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:
@@ -23,7 +23,6 @@
: xdictproxy ( w -- ) doer , does> ( 'dict 'w -- )
over xdict[ swap >r @ execute r> ]xdict ;
' ' xdictproxy x'
-' find xdictproxy xfind
' entry xdictproxy xentry
' create xdictproxy xcreate
' value xdictproxy xvalue
diff --git a/fs/tests/lib/xdict.fs b/fs/tests/lib/xdict.fs
@@ -8,5 +8,5 @@ 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
-word noop mydict xfind not #
+S" noop" mydict find not #
testend
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -24,9 +24,9 @@
\ Constants and labels
0 to realmode
: values ( n -- ) >r begin 0 value next ;
-24 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
+25 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
lblnextmeta lblret lblcurrent lblemit lblparsec lblparseh lblparseud
- lblerrmsg lblrtype lblhere lblmovewrite lblwrite lblcwrite
+ lblerrmsg lblrtype lblhere lblmovewrite lblwrite lblcwrite lblfind
lblcompiling lblareg lblidt
$8000 const HERESTART \ TODO: find a better place
$500 to binstart
@@ -616,12 +616,13 @@ pc to lblerrmsg \ exc=sl esi=sa
lblrtype abs>rel call,
xwordlbl abort abs>rel jmp,
-xcode find ( str -- word-or-0 )
+xcode find ( str 'dict -- word-or-0 )
+ DX pspop,
+pc to lblfind
si [ebp] mov,
cx cx xor,
cl [esi] mov,
[ebp] inc,
- dx lblcurrent m) mov,
pc ( loop )
di dx mov,
di dec,
@@ -661,7 +662,8 @@ xcode (wnf)
xcode ' ( "name" -- w )
wcall, word
- wcall, find
+ dx lblcurrent m) mov,
+ lblfind abs>rel call,
[ebp]z?
xwordlbl (wnf) abs>rel jz,
ret,
@@ -818,7 +820,8 @@ xcode runword ( str -- ) pc lblcurrent pc>addr !
( pc ) abs>rel jnz, \ is a literal
\ not a literal
lblcurword pspushN,
- wcall, find
+ dx lblcurrent m) mov,
+ lblfind abs>rel call,
[ebp]z?
xwordlbl (wnf) abs>rel jz,
lblcompiling m) -1 i) test,
diff --git a/posix/vm.c b/posix/vm.c
@@ -69,8 +69,8 @@ static void rpush(dword d) { vm.RSP -= 4; sd(vm.RSP, d); }
static dword here() { return gd(HERE); }
static void allot(dword n) { sd(HERE, here()+n); }
static dword current() { return gd(CURRENT); }
-static dword _find(byte *name, byte slen) {
- dword a = current();
+static dword _find(dword dict, byte *name, byte slen) {
+ dword a = dict;
byte len;
while (a) {
len = gb(a-1) & 0x3f;
@@ -82,7 +82,7 @@ static dword _find(byte *name, byte slen) {
return 0;
}
static dword find(char *name) {
- return _find((byte*)name, strlen(name));
+ return _find(current(), (byte*)name, strlen(name));
}
static void cwrite(byte b) {
sb(here(), b);
@@ -647,14 +647,17 @@ static void REQ() { // op: 54
ppush(memcmp(&vm.mem[a1], &vm.mem[a2], u) == 0);
}
+// ( name 'dict -- entry-or-0 )
static void FIND() { // op: 55
+ dword dict = ppop();
dword s = ppop();
byte len = gb(s++);
- ppush(_find(&vm.mem[s], len));
+ ppush(_find(dict, &vm.mem[s], len));
}
static void APOS() { // op: 56
WORD();
+ ppush(current());
FIND();
if (!ppeek()) WNF();
}
@@ -690,6 +693,7 @@ static void RUNWORD() { // op: 5b
if (vm.compiling) LITN();
} else {
ppush(CURWORD);
+ ppush(current());
FIND();
if (!ppeek()) { WNF(); return; }
if (vm.compiling && !((gb(ppeek()-1) & 0x80) /* immediate */)) {