commit a1f9afe5eaf7a4a31a2f01bf00d0e4b3b580e24f
parent 33fa1be1e8cb51e3935483746427b30f1dfa39f8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 29 Aug 2022 14:25:23 -0400
Move to? and [to] to bootlo
It's the slowest Dusk has ever been, and maybe ever will be! The next commit is
the big one.
Diffstat:
3 files changed, 27 insertions(+), 47 deletions(-)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -11,21 +11,10 @@ code : ] code ] ;
: e>w 5 + ;
: current sysdict @ e>w ;
: immediate current 1- dup c@ $80 or swap c! ;
-: exit exit, ; immediate
: ['] ' litn ; immediate
-: to ['] ! [to] ;
-: to+ ['] +! [to] ;
-: to' ['] noop [to] ;
-: to@ ['] @ [to] ;
-: @! dup @ rot> ! ;
-: to@! ['] @! [to] ;
-: allot HERE +! ;
: compile ' litn ['] execute, execute, ; immediate
: [compile] ' execute, ; immediate
-: rdrop 4 r+, ; immediate
-: r@ 0 r', compile @ ; immediate
-: r> [compile] r@ [compile] rdrop ; immediate
-: >r -4 r+, 0 r', compile ! ; immediate
+: allot HERE +! ;
: if compile (?br) HERE @ 4 allot ; immediate
: then HERE @ swap ! ; immediate
: else compile (br) HERE @ 4 allot HERE @ rot ! ; immediate
@@ -37,12 +26,17 @@ code : ] code ] ;
: = - not ;
: \ begin IN< @ execute $0a = until ; immediate
\ hello, this is a comment!
+: exit exit, ; immediate
: ( begin
word dup c@ 1 = if
1+ c@ ')' = if exit then else drop then
again ; immediate
( hello, another comment! )
\ Stack
+: rdrop 4 r+, ; immediate
+: r@ 0 r', compile @ ; immediate
+: r> [compile] r@ [compile] rdrop ; immediate
+: >r -4 r+, 0 r', compile ! ; immediate
: 2drop drop drop ;
: 2dup over over ;
@@ -69,6 +63,7 @@ code : ] code ] ;
: c@+ ( a -- a+1 c ) dup 1+ swap c@ ;
: @+ ( a -- a+4 n ) dup 4 + swap @ ;
: c!+ ( c a -- a+1 ) tuck c! 1+ ;
+: @! dup @ rot> ! ;
: Ac@+ Ac@ A+ ;
: Ac!+ Ac! A+ ;
: fill ( a u b -- ) A>r rot> >r >A begin dup Ac!+ next drop r>A ;
@@ -92,6 +87,12 @@ create _ 0 ,
: doer code compile (does) HERE @ _ ! CELLSZ allot ;
: does> r> ( exit current definition ) _ @ ! ;
: does' ( w -- 'data ) CALLSZ + CELLSZ + ;
+: to ['] ! TOPTR ! ;
+: to+ ['] +! TOPTR ! ;
+: to' ['] noop TOPTR ! ;
+: to@ ['] @ TOPTR ! ;
+: to@! ['] @! TOPTR ! ;
+: to? 0 TOPTR @! ;
: value doer , does> to? ?dup if execute else @ then ;
: ivalue doer , does> @ to? ?dup if execute else @ then ;
HERE ivalue here
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -24,7 +24,7 @@
\ Constants and labels
0 to realmode
: values ( n -- ) >r begin 0 value next ;
-27 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblabort
+26 values L1 L2 lblmainalias lbltoptr lblbootptr lblin< lblabort
lblcurword lblnextmeta lblret lblsysdict lblemit lblparsec lblparseh
lblparseud lblerrmsg lblrtype lblhere lbl[rcnt] lblmovewrite lblwrite
lblcwrite lblfind lblcompiling lblareg lblidt
@@ -50,11 +50,9 @@ forward16 jmp, to L1
xcode noop pc to lblret ret,
align4 pc to lbltoptr 0 ,
-pc to lbltoexec \ AX=cell addr
- AX pspush,
- bx lbltoptr m) mov,
- lbltoptr m) 0 i) mov,
- bx jmp,
+xcode TOPTR
+ lbltoptr pspushN,
+ ret,
xcode (cell)
ax pop,
@@ -96,17 +94,6 @@ xcode (next)
ax CELLSZ i) add,
ax jmp,
-xcode [to]
- AX pspop,
- lbltoptr m) ax mov,
- ret,
-
-xcode to?
- ax lbltoptr m) mov,
- AX pspush,
- lbltoptr m) 0 i) mov,
- ret,
-
pc to lblmainalias 0 ,
xcode MAIN
lblmainalias pspushN,
diff --git a/posix/vm.c b/posix/vm.c
@@ -32,7 +32,8 @@ The VM is little endian.
#define EMIT (INRD+4)
#define ABORT (EMIT+4)
#define MAINLOOP (ABORT+4)
-#define CURWORD (MAINLOOP+4)
+#define TOPTR (MAINLOOP+4)
+#define CURWORD (TOPTR+4)
#define IOBUFSZ 0x200
#define IOBUF (SYSVARS-IOBUFSZ)
#define HEREMAX IOBUF
@@ -46,7 +47,6 @@ struct VM {
dword PSP;
dword RSP;
dword PC; // when PC >= MEMSZ, machine is halted
- dword toptr;
dword areg;
dword compiling;
byte mem[MEMSZ];
@@ -160,7 +160,7 @@ static void BYEFAIL() { // op: 05
}
static void QUIT() { // op: 06
- vm.toptr = 0;
+ sd(TOPTR, 0);
vm.RSP = RSTOP;
vm.PC = gd(MAINLOOP);
}
@@ -347,15 +347,6 @@ static void RS2A() { // op: 2d
rpush(a);
}
-static void TOSET() { // op: 2e
- vm.toptr = ppop();
-}
-
-static void TOGET() { // op: 2f
- ppush(vm.toptr);
- vm.toptr = 0;
-}
-
static void INC() { // op: 30
ppush(ppop()+1);
}
@@ -534,13 +525,13 @@ static void MAYBEWORD() { // op: 51
dword c, a;
// save toptr so that it doesn't mess in<, which could be calling a word
// with to semantics
- dword toptr = vm.toptr;
- vm.toptr = 0;
+ dword toptr = gd(TOPTR);
+ sd(TOPTR, 0);
do {
callword(gd(INRD));
c = ppop();
if (c >> 31) { // EOF
- vm.toptr = toptr;
+ sd(TOPTR, toptr);
ppush(0);
return;
}
@@ -551,7 +542,7 @@ static void MAYBEWORD() { // op: 51
callword(gd(INRD));
c = ppop();
} while (!(c >> 31) && (c > ' '));
- vm.toptr = toptr;
+ sd(TOPTR, toptr);
sb(CURWORD, a-CURWORD-1); // len
ppush(CURWORD);
}
@@ -900,7 +891,7 @@ static void (*ops[OPCNT])() = {
NEXT, NULL, NULL, BOOTRD, STDOUT, STDERR, KEY, DROP,
DUP, CDUP, SWAP, OVER, ROT, ROTR, NIP, TUCK,
RSADD, RSADDWR, RSADDR, RSADDRWR, SCNT, RCNT, ASET, AGET,
- ACFETCH, ACSTORE, AINC, ADEC, A2RS, RS2A, TOSET, TOGET,
+ ACFETCH, ACSTORE, AINC, ADEC, A2RS, RS2A, NULL, NULL,
INC, DEC, CFETCH, CSTORE, CWRITE, WFETCH, WSTORE, FETCH,
STORE, ADDSTORE, WRITE, ADD, SUB, MUL, DIVMOD, AND,
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
@@ -916,7 +907,7 @@ static char *opnames[OPCNT] = {
"(next)", NULL, NULL, "boot<", "(emit)", "stderr", "(key)", "drop",
"dup", "?dup", "swap", "over", "rot", "rot>", "nip", "tuck",
NULL, "r+,", NULL, "r',", "scnt", "rcnt", ">A", "A>",
- "Ac@", "Ac!", "A+", "A-", "A>r", "r>A", "[to]", "to?",
+ "Ac@", "Ac!", "A+", "A-", "A>r", "r>A", NULL, NULL,
"1+", "1-", "c@", "c!", "c,", "w@", "w!", "@",
"!", "+!", ",", "+", "-", "*", "/mod", "and",
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
@@ -983,6 +974,7 @@ static void buildsysdict() {
sysconst("ABORT", ABORT);
sysconst("MAIN", MAINLOOP);
sysconst("HERE", HERE);
+ sysconst("TOPTR", TOPTR);
sysconst("heremax", HEREMAX);
sysconst("curword", CURWORD);
sysconst("sysdict", SYSDICT);
