commit a69056e53690671991c4774bd06cef6e6222a99f
parent 6ef30f6a6bc5fbf6fa17b5501f7b5e79a2038214
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 8 Aug 2022 10:51:08 -0400
Some more bootlo jujitsu
Diffstat:
3 files changed, 43 insertions(+), 43 deletions(-)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -1,17 +1,22 @@
-here $20 + 1 over c! dup 1+ ':' swap c!
-entry ] word entry ] [ exit,
-: immediate current 1- dup c@ $80 or swap c! [ exit,
-: [compile] ' execute, [ exit, immediate
-: ; exit, [compile] [ [ exit, immediate
+," ]" 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,
+," entry" 0 , current , 5 c, here to current ]
+ dup 1+ swap c@ tuck move, nextmeta , current , c,
+ here to current 0 to nextmeta ;
+," :" 0 , current , 1 c, here to current ]
+ word entry ] ;
+: immediate current 1- dup c@ $80 or swap c! ;
: ['] ' litn ; immediate
-: to ['] ! [to] ;
: to+ ['] +! [to] ;
: to' ['] noop [to] ;
: to@ ['] @ [to] ;
: @! dup @ rot> ! ;
: to@! ['] @! [to] ;
: allot to+ here ;
-: compile ' litn ['] execute, execute, [ exit, immediate
+: compile ' litn ['] execute, execute, ; immediate
+: [compile] ' execute, ; immediate
: if compile (?br) here 4 allot ; immediate
: then here swap ! ; immediate
: else compile (br) here 4 allot here rot ! ; immediate
@@ -107,7 +112,6 @@ $20 const SPC $0d const CR $0a const LF $08 const BS
: nl> CR emit LF emit ; : spc> SPC emit ;
\ emit all chars of "str"
: stype ( str -- ) c@+ rtype ;
-: ," begin in< dup '"' = not while c, repeat drop ;
: S" ( comp: -- ) ( not-comp: -- str )
compiling if compile (s) else here then
here 1 allot here ," here -^ ( 'len len ) swap c! ; immediate
@@ -141,7 +145,7 @@ alias noop [then]
\ Docstrings
1 const EMETA_DOCLINE \ a doc strings that ends with LF
\ a \\ comment goes before the creation of the word it comments
-: \\ nextmeta lladd drop EMETA_DOCLINE , begin in< dup c, LF = until ;
+: \\ to' nextmeta lladd drop EMETA_DOCLINE , begin in< dup c, LF = until ;
: .doc ( w -- ) emeta begin ( ll )
EMETA_DOCLINE swap findemeta ?dup while ( ll )
dup 'emetadata begin c@+ dup emit LF = until drop llnext repeat ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -745,27 +745,19 @@ xcode parse ( str -- n? f )
bp CELLSZ d) neg,
ret,
-pc to lblnextmeta 4 allot0
+xcode ,"
+ wcall, in<
+ AX pspop,
+ al '"' i) cmp,
+ lblret abs>rel jz,
+ xwordlbl ," i) push,
+ lblcwrite abs>rel jmp,
+
xcode nextmeta
- lblnextmeta pspushN,
- ret,
+ wcall, (val) pc to lblnextmeta 0 ,
-xcode entry ( str -- )
- SI pspop,
- cx cx xor,
- cl [esi] mov,
- si inc,
- dx cx mov, \ save len
- lblmovewrite abs>rel call, \ name
- ax lblnextmeta m) mov,
- lblwrite abs>rel call, \ meta
- lblnextmeta m) 0 i) mov,
- ax lblcurrent m) mov,
- lblwrite abs>rel call, \ prev
- ax dx mov,
- lblcwrite abs>rel call, \ len
- ax lblhere m) mov,
- lblcurrent m) ax mov,
+xcode to
+ lbltoptr m) xwordlbl ! i) mov,
ret,
\ binary for "bp 4 i) sub, [ebp] XXXX i) mov," is 83 ed 04 c7 45 00 XX XX XX XX
@@ -790,10 +782,6 @@ xcode exit,
al $c3 ( ret ) i) mov,
lblcwrite abs>rel jmp,
-xcode ]
- lblcompiling m) 1 i) mov,
- ret,
-
xcode [ $81 here 1- c! \ make immediate
lblcompiling m) 0 i) mov,
ret,
diff --git a/posix/vm.c b/posix/vm.c
@@ -50,6 +50,7 @@ struct VM {
static struct VM vm = {0};
static FILE *bootfp;
+static dword lblfind = 0;
// Utilities
static byte gb(dword addr) { return vm.mem[addr]; }
@@ -659,14 +660,21 @@ static void APOS() { // op: 56
if (!ppeek()) WNF();
}
-static void ENTRY() { // op: 57
- dword s = ppop();
- byte len = gb(s++);
- _entry(&vm.mem[s], len);
+static void TO() { // op: 57
+ if (lblfind == 0) {
+ lblfind = find("!");
+ }
+ vm.toptr = lblfind;
}
-static void STARTCOMP() { // op: 59
- sd(COMPILING, 1);
+static void SWR() { // op: 58
+ dword c;
+ while (1) {
+ callword(gd(INRD));
+ c = ppop();
+ if (c == '"') return;
+ cwrite(c);
+ }
}
static void STOPCOMP() { // op: 5a
@@ -823,8 +831,8 @@ static void (*ops[OPCNT])() = {
STORE, ADDSTORE, WRITE, ADD, SUB, MUL, DIVMOD, AND,
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
RSHIFT, LITN, EXECUTEWR, EXITWR, MOVE, MOVEWR, RTYPE, WNF,
- STACKCHK, MAYBEWORD, WORD, PARSE, REQ, FIND, APOS, ENTRY,
- NULL, STARTCOMP, STOPCOMP, RUNWORD, EXIT, FCHILD, FOPEN, FREADBUF,
+ STACKCHK, MAYBEWORD, WORD, PARSE, REQ, FIND, APOS, TO,
+ SWR, NULL, STOPCOMP, RUNWORD, EXIT, FCHILD, FOPEN, FREADBUF,
FCLOSE};
static char *opnames[OPCNT] = {
@@ -838,8 +846,8 @@ static char *opnames[OPCNT] = {
"!", "+!", ",", "+", "-", "*", "/mod", "and",
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "rtype", "(wnf)",
- "stack?", "maybeword", "word", "parse", "[]=", "find", "'", "entry",
- NULL, "]", "[", "runword", "exit", "fchild", "fopen", "_freadbuf",
+ "stack?", "maybeword", "word", "parse", "[]=", "find", "'", "to",
+ ",\"", NULL, "[", "runword", "exit", "fchild", "fopen", "_freadbuf",
"_fclose"};
static void oprun1() { // run next op
@@ -914,9 +922,9 @@ static void buildsysdict() {
sysval("here", HERE);
sysval("current", CURRENT);
sysval("compiling", COMPILING);
+ sysval("nextmeta", NEXTMETA);
sysconst("heremax", HEREMAX);
sysconst("curword", CURWORD);
- sysconst("nextmeta", NEXTMETA);
entry("mainloop");
sd(MAINLOOP, here());
callwr(find("word"));
