duskos

commit f6bd9d0c88ee1b8983d076f2613d5a2b07219034
parent adf4d049fd0dd475605209af1c2ea7d029311146
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu,  9 Mar 2023 12:05:45 -0500

HAL: make does> words work

Diffstat:
M
fs/xcomp/bootlo.fs
 | 
15
+++++++++------
M
posix/vm.c
 | 
7
+++----

2 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -24,14 +24,15 @@ code ! W>A, PSP) @, A) !, 2drop, exit,
 code16b W>A, PSP) @, A) 16b !, 2drop, exit,
 code8b W>A, PSP) @, A) 8b !, 2drop, exit,
 : c! 8b ! ; : w! 16b ! ;
-code +! W>A, A) @, ] + [ A) !, exit,
-code16b W>A, A) 16b @, ] + [ A) 16b !, exit,
-code8b W>A, A) 8b @, ] + [ A) 8b !, exit,
+code +! W>A, A) @, ] + [ A) !, drop, exit,
+code16b W>A, A) 16b @, ] + [ A) 16b !, drop, exit,
+code8b W>A, A) 8b @, ] + [ A) 8b !, drop, exit,
 code , HERE i) [!], 4 HERE i) [+n], drop, exit,
 code16b HERE i) 16b [!], 2 HERE i) [+n], drop, exit,
 code8b HERE i) 8b [!], 1 HERE i) [+n], drop, exit,
 : c, 8b , ;
 
+code execute W>A, drop, branchA,
 code 1+ 1 W+, exit,
 code 1- -1 W+, exit,
 : litn -4 ps+, PSP) !, LIT>W, ;
@@ -115,14 +116,16 @@ create toptrdef ' @ , ' _@, ,
 : var, ( off -- ) RSP) swap [rcnt] @ neg -^ +) toptr@ execute ;
 : V1 0 var, ; immediate : V2 4 var, ; immediate
 : V3 8 var, ; immediate : V4 12 var, ; immediate
-dbg
-: foo 42 >r dbg V1 dbg drop r> dbg drop ;
-'X' (emit) foo dbg bye
 \ Compiling words
 create _ 0 ,
+code (does) r> W>A, W) @, W<>A, CELLSZ W+, branchA,
 : doer code compile (does) HERE @ _ ! CELLSZ allot ;
 : does> r> ( exit current definition ) _ @ ! ;
 : does' ( w -- 'data ) CALLSZ + CELLSZ + ;
+: foo doer , does> @ dbg drop ;
+42 foo bar
+bar : hello bar ; hello dbg bye
+
 : _to doer ' , ' , immediate does> toptr ! ;
 _to to ! A!,       _to to+ +! A+!,     _to to' noop A>,
 : _toexec ( a -- ) compiling if LIT>A, then toptr@ execute ;
diff --git a/posix/vm.c b/posix/vm.c
@@ -165,7 +165,7 @@ static void entry(char *name) {
 static void BR() { vm.PC = gpc(); } // 0x00
 static void CALL() { dword n = gpc(); rpush(vm.PC); vm.PC = n; }
 static void RET() { vm.PC = rpop(); }
-static void EXECUTE() { rpush(vm.PC); vm.PC = ppop(); }
+static void BRA() { vm.PC = vm.A; }
 static void CBR() { dword a = gpc(); if (!ppop()) vm.PC = a; }
 // ( a opcode -- a )
 static void BRWR() { cwrite(ppop()); dwrite(vm.W); vm.W = here()-4; }
@@ -431,7 +431,7 @@ static void DBG() {
 
 #define OPCNT 0x60
 static void (*ops[OPCNT])() = {
-	BR, CALL, RET, EXECUTE, CBR, BRWR, BRZ, NULL,
+	BR, CALL, RET, BRA, CBR, BRWR, BRZ, NULL,
 	PSADD, RSADD, WLIT, ALIT, WADD, AADD, W2A, WSWAPA,
 	WFETCH, WSTORE, WSWAP, MADDN, WLEA, WIFETCH, WISTORE, NULL,
 	WFETCH16, WSTORE16, WSWAP16, MADDN16, WLEA, WIFETCH16, WISTORE16, NULL,
@@ -448,7 +448,6 @@ static void (*ops[OPCNT])() = {
 static void oprun1() { // run next op
 	if (!memchk(vm.PC)) return;
 	byte opcode = vm.mem[vm.PC++];
-	//printf("op %02x PC %08x PSP %08x RSP %08x\n", opcode, vm.PC-1, vm.PSP, vm.RSP);
 	if ((opcode >= OPCNT) || (!ops[opcode])) {
 		printf("Illegal opcode %02x at PC %08x\n", opcode, vm.PC-1);
 		BYEFAIL();
@@ -539,7 +538,7 @@ static void buildsysdict() {
 		CODE8(); compopwr(0x26); retwr();
 	entry("exit,"); compileop(0x02); retwr();
 	entry("execute,"); compileop(0x01); writewr(); retwr();
-	entry("execute"); cwrite(0x03); retwr();
+	entry("branchA,"); compileop(0x03); retwr();
 	entry("branch,"); litwr(0x00); cwrite(0x05); retwr();
 	entry("?branch,"); litwr(0x04); cwrite(0x05); retwr();
 	entry("branchz,"); litwr(0x06); cwrite(0x05); retwr();