commit 5ef6c1fb84ed08b38cf007b6490853b1d72d26f5
parent 7b7c4df614d3d82514e728cd110e58936d088307
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 9 Aug 2022 07:57:46 -0400
De-value-ize "compiling"
As we'll see in my upcoming commits, the fact that "compiling" obeys to "to"
semantics restricts the kind of things that can be done with "to": Compiling
something that obeys "to" semantics doesn't work.
"[" and "]" words are all we'll ever need.
Diffstat:
4 files changed, 31 insertions(+), 19 deletions(-)
diff --git a/fs/lib/wordtbl.fs b/fs/lib/wordtbl.fs
@@ -1,5 +1,5 @@
\ Word tables
-: xtcomp 1 to compiling begin word runword compiling not until ;
+: xtcomp [compile] ] begin word runword compiling not until ;
: wordtbl ( n -- a ) create here swap 4 * allot0 1 here c! ;
: w+ ( a -- a+4? ) 4 + dup @ if drop then ;
: :w ( a -- a+4? ) here xtcomp over ! w+ ;
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -1,7 +1,5 @@
-," ]" 0 , current , 1 c, here to current 1 to compiling
- 1 to compiling [ exit,
-," ;" 0 , current , $81 c, here to current ]
- 0 to compiling exit, [ exit,
+," ;" 0 , current , $81 c, here to current
+ ' [ execute, ' exit, execute, exit,
," entry" 0 , current , 5 c, here to current ]
dup 1+ swap c@ tuck move, nextmeta , current , c,
here to current 0 to nextmeta ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -139,8 +139,11 @@ xcode here
xcode current
wcall, (val) pc to lblcurrent 0 ,
+pc to lblcompiling 0 ,
xcode compiling
- wcall, (val) pc to lblcompiling 0 ,
+ ax lblcompiling m) mov,
+ AX pspush,
+ ret,
xcode quit
cld,
@@ -787,6 +790,10 @@ xcode [ $81 here 1- c! \ make immediate
lblcompiling m) 0 i) mov,
ret,
+xcode ]
+ lblcompiling m) 1 i) mov,
+ ret,
+
pc ," stack underflow"
xcode stack?
bp PSTOP i) cmp,
diff --git a/posix/vm.c b/posix/vm.c
@@ -23,8 +23,7 @@ The VM is little endian.
#define SYSVARS ((PSTOP-STACKSZ)-SYSVARSSZ)
#define HERE SYSVARS
#define CURRENT (HERE+4)
-#define COMPILING (CURRENT+4)
-#define NEXTMETA (COMPILING+4)
+#define NEXTMETA (CURRENT+4)
#define INRD (NEXTMETA+4)
#define EMIT (INRD+4)
#define ABORT (EMIT+4)
@@ -45,6 +44,7 @@ struct VM {
dword PC; // when PC >= MEMSZ, machine is halted
dword toptr;
dword areg;
+ dword compiling;
byte mem[MEMSZ];
};
@@ -69,7 +69,6 @@ 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 compiling() { return gd(COMPILING); }
static dword _find(byte *name, byte slen) {
dword a = current();
byte len;
@@ -162,7 +161,7 @@ static void QUIT() { // op: 06
static void ABORT_() { // op: 07
vm.PSP = PSTOP;
- sd(COMPILING, 0);
+ vm.compiling = 0;
sd(NEXTMETA, 0);
QUIT();
}
@@ -677,19 +676,23 @@ static void SWR() { // op: 58
}
}
+static void STARTCOMP() { // op: 59
+ vm.compiling = 1;
+}
+
static void STOPCOMP() { // op: 5a
- sd(COMPILING, 0);
+ vm.compiling = 0;
}
static void RUNWORD() { // op: 5b
PARSE();
if (ppop()) {
- if (compiling()) LITN();
+ if (vm.compiling) LITN();
} else {
ppush(CURWORD);
FIND();
if (!ppeek()) { WNF(); return; }
- if (compiling() && !((gb(ppeek()-1) & 0x80) /* immediate */)) {
+ if (vm.compiling && !((gb(ppeek()-1) & 0x80) /* immediate */)) {
EXECUTEWR();
} else {
callword(ppop());
@@ -819,7 +822,12 @@ static void FCLOSE () { // op: 60
}
}
-#define OPCNT 0x61
+// Words that should go before the FS section, but were added later.
+static void COMPILING() { // op: 61
+ ppush(vm.compiling);
+}
+
+#define OPCNT 0x62
static void (*ops[OPCNT])() = {
JUMP, CALL, RET, LIT, BYE, BYEFAIL, QUIT, ABORT_,
EXECUTE, CELL, VAL, ALIAS, DOES, SLIT, BR, CBR,
@@ -832,8 +840,8 @@ 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, TO,
- SWR, NULL, STOPCOMP, RUNWORD, EXIT, FCHILD, FOPEN, FREADBUF,
- FCLOSE};
+ SWR, STARTCOMP, STOPCOMP, RUNWORD, EXIT, FCHILD, FOPEN, FREADBUF,
+ FCLOSE, COMPILING};
static char *opnames[OPCNT] = {
NULL, NULL, NULL, NULL, "bye", "byefail", "quit", "(abort)",
@@ -847,8 +855,8 @@ static char *opnames[OPCNT] = {
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "rtype", "(wnf)",
"stack?", "maybeword", "word", "parse", "[]=", "find", "'", "to",
- ",\"", NULL, "[", "runword", "exit", "_fchild", "_fopen", "_freadbuf",
- "_fclose"};
+ ",\"", "]", "[", "runword", "exit", "_fchild", "_fopen", "_freadbuf",
+ "_fclose", "compiling"};
static void oprun1() { // run next op
byte opcode = vm.mem[vm.PC++];
@@ -921,7 +929,6 @@ static void buildsysdict() {
sysalias("main", MAINLOOP);
sysval("here", HERE);
sysval("current", CURRENT);
- sysval("compiling", COMPILING);
sysval("nextmeta", NEXTMETA);
sysconst("heremax", HEREMAX);
sysconst("curword", CURWORD);
