commit f3f139a7e21d3659afae9765aacb56fbb10bcadd
parent bfeb3b8b15e87ab02198d1cb464a4469c8e3257c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 25 May 2023 07:00:58 -0400
Decouple find and findmod
Don't automatically call findmod in find and instead move that usage up to
compword and runword.
The previous approach saved a few lines of code, but had an important bug which
was uncovered during the work of the commit that will follow: immediate
detection was completely broken in compword. When a MOD was involved, it would
check the immediate flag on a memory area that wasn't a lengh+immediate field.
It worked only by chance, because the field happened to be "word-1" and that on
a mod, this metadata ID would have bit 31 unset.
Now, immediate detection happens before we select a word modifier.
Diffstat:
2 files changed, 41 insertions(+), 40 deletions(-)
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -485,31 +485,6 @@ pc to lblerrmsg \ ecx=sl ebx=sa
wcall, rtype
wjmp, abort
-xcode findmeta ( id ll -- ll-or-0 ) \ Preserves dx
- bx si 0 d) mov, xnip,
-pc to L1 \ bx=id
- ax ax test,
- lblret abs>rel jz,
- bx ax 4 d) cmp,
- lblret abs>rel jz,
- ax ax 0 d) mov,
- L1 absjmp,
-
-pc to L2 \ mod not found, restore dx
- ax dx mov, ret,
-xcode findmod ( w -- w )
- lblmod m) -1 i) test,
- lblret abs>rel jz,
- dx ax mov,
- ax ax -9 d) mov,
- bx lblmod m) mov,
- L1 abscall,
- ax ax test,
- L2 abs>rel jz,
- lblmod m) 0 i) mov,
- ax 8 i) add,
- ret,
-
xcode find ( str 'dict -- word-or-0 )
dx ax mov, xdrop,
pc to lblfind \ ax=str dx='dict
@@ -532,7 +507,7 @@ pc ( loop )
si pop, di pop,
dx 5 i) add, \ word
ax dx mov,
- wjmp, findmod
+ ret,
L2 forward! ( skip2 )
cl bl mov,
L1 forward! ( skip1 )
@@ -652,6 +627,31 @@ xcode stack?
bx swap ( pc ) i) mov,
lblerrmsg absjmp,
+xcode findmeta ( id ll -- ll-or-0 ) \ Preserves dx
+ bx si 0 d) mov, xnip,
+pc to L1 \ bx=id
+ ax ax test,
+ lblret abs>rel jz,
+ bx ax 4 d) cmp,
+ lblret abs>rel jz,
+ ax ax 0 d) mov,
+ L1 absjmp,
+
+pc to L2 \ mod not found, restore dx
+ ax dx mov, ret,
+xcode findmod ( w -- w )
+ lblmod m) -1 i) test,
+ lblret abs>rel jz,
+ dx ax mov,
+ ax ax -9 d) mov,
+ bx lblmod m) mov,
+ L1 abscall, \ findmeta
+ ax ax test,
+ L2 abs>rel jz,
+ lblmod m) 0 i) mov,
+ ax 8 i) add,
+ ret,
+
pc to L2 ( -- w ) \ find in sys dict
xdup,
ax lblcurword i) mov,
@@ -662,6 +662,7 @@ pc to L2 ( -- w ) \ find in sys dict
ret,
pc to L1 \ execute imm word
+ wcall, findmod
bx ax mov,
xdrop,
bx call,
@@ -677,6 +678,7 @@ xcode compword ( str -- )
ax -1 d) 8b) $80 i) test,
L1 abs>rel jnz, \ immediate? execute
\ compile word
+ wcall, findmod
wjmp, execute,
xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
diff --git a/posix/vm.c b/posix/vm.c
@@ -164,25 +164,13 @@ static dword findmeta(dword id, dword ll) {
while (ll && gd(ll+4) != id) ll = gd(ll);
return ll;
}
-static dword findmod(dword word) {
- dword a = word;
- if (gd(MOD)) {
- if ((a = findmeta(gd(MOD), gd(word-9)))) {
- a += 8;
- sd(MOD, 0);
- } else {
- a = word;
- }
- }
- return a;
-}
static dword _find(dword dict, byte *name, byte slen) {
dword a = dict;
byte len;
while (memchk(a)) {
len = gb(a+4) & 0x3f;
if ((len == slen) && (memcmp(name, &vm.mem[a-4-len], len)==0)) {
- return findmod(a+5);
+ return a+5;
}
a = gd(a);
}
@@ -479,7 +467,15 @@ static void WNF() {
write(STDOUT_FILENO, " word not found", 15);
vm.PC = abortaddr;
}
-static void FINDMOD() { vm.W = findmod(vm.W); }
+static void FINDMOD() {
+ dword a;
+ if (gd(MOD)) {
+ if ((a = findmeta(gd(MOD), gd(vm.W-9)))) {
+ vm.W = a + 8;
+ sd(MOD, 0);
+ }
+ }
+}
static void STACKCHK() { // 0x38
if (vm.PSP > PSTOP) {
@@ -498,9 +494,11 @@ static void COMPWORD() {
FIND();
if (!vm.W) { WNF(); return; }
if ((gb(vm.W-1) & 0x80) /* immediate */) {
+ FINDMOD();
callword(ppop());
STACKCHK();
} else {
+ FINDMOD();
callwr(ppop());
}
}
@@ -515,6 +513,7 @@ static void RUNWORD() {
ppush(sysdict());
FIND();
if (!vm.W) { WNF(); return; }
+ FINDMOD();
callword(ppop());
STACKCHK();
}