commit 0718c73159dd8ed2ec316879887c2d604a973f69
parent da567fcb454321d01e0283b1868c251aace175ca
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 4 Sep 2022 09:50:34 -0400
Extract "compword" from "runword" behavior
See doc/dict. This specific behavior is useful in places like "of" of the
"case..of" pattern. The previous "' execute," pattern prevented immediate words
from being executed, and thus prevented the use of struct methods in those
patterns. Not anymore.
Diffstat:
4 files changed, 59 insertions(+), 39 deletions(-)
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -324,10 +324,15 @@ word -- s Try to read a word and error out if EOF is reached.
parse s -- n? f Try to parse string s as a number. f=1 and n exists if
parsing was successful.
-runword s -- Execute string s according to our general logic: compile it
- if in compiling mode, execute it otherwise or if it's an
- immediate. If it's a number, either compile its literal or
- push it to PS.
+compword s -- Compile s regardless of "compiling" flag. That is: try to
+ parse as a number. Write a literal if it's a number. Other-
+ wise, find word in system dict and check if it's an
+ immediate. If yes, execute, otherwise, write a call to its
+ address.
+runword s -- Execute string s according to our general logic: if
+ "compiling" flag is set, run "compword". Otherwise, try to
+ parse s as a number. If it is one, push in to PS. Otherwise
+ find in system dict and then execute.
## Compiling
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -145,7 +145,7 @@ alias abort key
\ NOTE: if you want to access your reference value in the final "else", you
\ need to use "r@".
: case ( -- then-stopgap ) 0 [compile] >r ; immediate
-: of ( -- jump-addr ) [compile] r@ ' execute, [compile] if ; immediate
+: of ( -- jump-addr ) [compile] r@ word compword [compile] if ; immediate
: endof [compile] else ; immediate
: endcase ( then-stopgap jump1? jump2? ... jumpn? -- )
?dup if begin [compile] then ?dup not until then [compile] rdrop ; immediate
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -898,35 +898,25 @@ xcode stack?
si ( pc ) i) mov,
lblerrmsg abs>rel jmp,
-pc to L1 ( execute imm word )
- wcall, execute
- xwordlbl stack? abs>rel jmp,
+pc to L2 \ find in sys dict
+ lblcurword pspushN,
+ dx lblsysdict m) mov,
+ lblfind abs>rel call,
+ [ebp]z?
+ xwordlbl (wnf) abs>rel jz,
+ ret,
-pc to L2 ( execute word when not compiling )
- AX pspop,
- ax lblwoff m) add,
- lblwoff m) 0 i) mov,
- ax call,
+pc to L1 \ execute imm word
+ wcall, execute
xwordlbl stack? abs>rel jmp,
-pc ( literal handling )
- lblcompiling m) -1 i) test,
- xwordlbl litn abs>rel jnz, \ compiling
- ret, \ not compiling, nothing to do
-
-xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
+xcode compword ( str -- )
wcall, parse
AX pspop,
ax ax test,
- ( pc ) abs>rel jnz, \ is a literal
- \ not a literal
- lblcurword pspushN,
- dx lblsysdict m) mov,
- lblfind abs>rel call,
- [ebp]z?
- xwordlbl (wnf) abs>rel jz,
- lblcompiling m) -1 i) test,
- L2 abs>rel jz, \ not compiling? execute
+ xwordlbl litn abs>rel jnz, \ literal: jump to litn
+ \ not a literal, find and compile
+ L2 abs>rel call,
ax [ebp] mov, \ w
ax dec,
8b! ax 0 d) $80 i) test,
@@ -934,6 +924,21 @@ xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
\ compile word
xwordlbl execute, abs>rel jmp,
+xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
+ lblcompiling m) -1 i) test,
+ xwordlbl compword abs>rel jnz,
+ wcall, parse
+ AX pspop,
+ ax ax test,
+ xwordlbl noop abs>rel jnz, \ literal: nothing to do
+ \ not a literal, find and execute
+ L2 abs>rel call,
+ AX pspop,
+ ax lblwoff m) add,
+ lblwoff m) 0 i) mov,
+ ax call,
+ xwordlbl stack? abs>rel jmp,
+
pc lblmainalias pc>addr !
pc ( loop )
wcall, word
diff --git a/posix/vm.c b/posix/vm.c
@@ -666,23 +666,33 @@ static void STOPCOMP() { // op: 5a
vm.compiling = 0;
}
-static void RUNWORD() { // op: 5b
+static void COMPWORD() { // op: 5b
PARSE();
if (ppop()) {
- if (vm.compiling) LITN();
+ LITN();
} else {
ppush(CURWORD);
ppush(sysdict());
FIND();
if (!ppeek()) { WNF(); return; }
- if (vm.compiling) {
- if ((gb(ppeek()-1) & 0x80) /* immediate */) {
- callword(ppop());
- STACKCHK();
- } else {
- EXECUTEWR();
- }
+ if ((gb(ppeek()-1) & 0x80) /* immediate */) {
+ callword(ppop());
+ STACKCHK();
} else {
+ EXECUTEWR();
+ }
+ }
+}
+static void RUNWORD() { // op: 5c
+ if (vm.compiling) {
+ COMPWORD();
+ } else {
+ PARSE();
+ if (!ppop()) {
+ ppush(CURWORD);
+ ppush(sysdict());
+ FIND();
+ if (!ppeek()) { WNF(); return; }
callword(ppop()+woff());
STACKCHK();
}
@@ -921,7 +931,7 @@ static void (*ops[OPCNT])() = {
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
RSHIFT, LITN, EXECUTEWR, EXITWR, MOVE, MOVEWR, RTYPE, WNF,
STACKCHK, MAYBEWORD, WORD, PARSE, REQ, FIND, APOS, COMPILING,
- SWR, STARTCOMP, STOPCOMP, RUNWORD, NULL, NULL, NULL, NULL,
+ SWR, STARTCOMP, STOPCOMP, COMPWORD, RUNWORD, NULL, NULL, NULL,
FCHILD, FOPEN, FREADBUF, FCLOSE, FINFO, FITER, NULL, NULL,
MOUNTDRV, DRVRD, DRVWR};
@@ -937,7 +947,7 @@ static char *opnames[OPCNT] = {
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "rtype", "(wnf)",
"stack?", "maybeword", "word", "parse", "[]=", "find", "'", "compiling",
- ",\"", "]", "[", "runword", NULL, NULL, NULL, NULL,
+ ",\"", "]", "[", "compword", "runword", NULL, NULL, NULL,
"_fchild", "_fopen", "_freadbuf", "_fclose", "_finfo", "_fiter", NULL, NULL,
"_mountdrv", "_drv@", "_drv!"};
