commit 5158f54c2c29e4a95d0b3f0ec438494dcd098d84
parent 3ec9e14a32294b17a620d2ce62d227da65cba55a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 9 Mar 2023 20:58:00 -0500
hal: introduce a wider branching system
Diffstat:
3 files changed, 64 insertions(+), 30 deletions(-)
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -37,3 +37,21 @@ Width-aware compiler words:
[!], op --
[+n], n op --
lea, op -- (width aware, but has the same behavior in all widths)
+
+Conditions
+
+=)
+<>)
+<)
+>)
+<=)
+>=)
+Z)
+NZ)
+C)
+NC)
+
+branchC, ( a cond -- a )
+>branchC, ( a cond -- a ) drop and branch
+=0>Z,
+Z>W,
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -3,6 +3,7 @@ code : ] code ] ;
: :16b code16b ] ;
: noop ;
: W) 0 ; : A) 1 ; : PSP) 2 ; : RSP) 3 ;
+: Z) $11 ; : NZ) $01 ; : C) $22 ; : NC) $02 ;
: dup, -4 ps+, PSP) !, ;
code dup dup, exit,
code swap PSP) @!, exit,
@@ -61,12 +62,13 @@ code8b W>A, drop, A) 8b [!], 1 A) [+n], drop, exit,
code execute W>A, drop, branchA,
code 1+ 1 W+n, exit,
code 1- -1 W+n, exit,
+code not =0>Z, Z>W, exit,
+code bool =0>Z, Z>W, 1 xorn, exit,
: litn -4 ps+, PSP) !, LIT>W, ;
-: if 0 ?branch, ; immediate
-: ifz 0 branchz, ; immediate
+: if 0 =0>Z, Z) >branchC, ; immediate
: ahead 0 branch, ; immediate
: then HERE @ swap branch! ; immediate
-: ?dup ifz [ dup, ] then ;
+code ?dup =0>Z, 0 Z) branchC, dup, then exit,
: ' word sysdict @ find dup not if (wnf) then ;
: ['] ' litn ; immediate
: compile ' litn ['] execute, execute, ; immediate
@@ -75,7 +77,7 @@ code 1- -1 W+n, exit,
: else [compile] ahead HERE @ rot branch! ; immediate
: begin HERE @ ; immediate
: again branch, drop ; immediate
-: until ?branch, drop ; immediate
+: until =0>Z, Z) >branchC, drop ; immediate
: = - not ;
: \ begin in< $0a = until ; immediate
\ hello, this is a comment!
@@ -108,7 +110,7 @@ code + PSP) +, nip, exit,
: max0 ( n -- n ) dup 0< if drop 0 then ;
: =><= ( n l h -- f ) over - rot> ( h n l ) - >= ;
: neg 0 -^ ;
-: ^ -1 xor ;
+code ^ -1 xorn, exit,
: and? bool swap bool and ;
: or? or bool ;
: upcase ( c -- c ) dup 'a' - 26 < if $df and then ;
@@ -256,10 +258,13 @@ code (s) r@ W>A, W) 8b @, 1 W+n, RSP) +, rdrop W<>A, branchA,
: ."
compiling if [compile] S" compile stype else
begin "< dup 0>= while emit repeat drop then ; immediate
-: prompt ." hello HAL!\n" ; prompt bye
: abort" [compile] ." compile abort ; immediate
: word" [compile] S" NEXTWORD litn compile ! ; immediate
+: prompt ." hello HAL!\n" ; prompt bye
+code []= ( a1 a2 u -- f )
+ PSP) @!, W>A, begin \ P+4=a1 P+0=u A=a2
+ PSP
: s= ( s1 s2 -- f ) over c@ 1+ []= ;
: [if] not if S" [then]" begin word over s= until drop then ;
alias noop [then]
diff --git a/posix/vm.c b/posix/vm.c
@@ -30,6 +30,8 @@
#define OPPSP 2
#define OPRSP 3
#define OPIMM 0x80000000
+#define CONDZ 0x01
+#define CONDNZ 0x11
#define EMETA_8B 0x10
#define EMETA_16B 0x11
@@ -43,6 +45,8 @@ struct VM {
dword PC; // when PC >= MEMSZ, machine is halted
dword W; // W is PS top
dword A;
+ byte Z;
+ byte C;
byte compiling;
byte mem[MEMSZ];
};
@@ -159,11 +163,17 @@ 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(); }
+// ( a -- a )
+static void BRWR() { dwrite(vm.W); vm.W = here()-4; }
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; }
-static void BRZ() { dword a = gpc(); if (!vm.W) vm.PC = a; }
+static int checkcond(byte cond) {
+ switch (cond&0xf) {
+ case CONDZ: return vm.Z == ((cond >> 4) & 1);
+ default: return 0;
+ }
+}
+static void BRC() { byte cond = gpcb(); dword a = gpc(); if (checkcond(cond)) vm.PC = a; }
+static void BRCDROP() { BRC(); ppop(); }
static void YIELD() { dword pc = vm.PC; vm.PC = rpop(); rpush(pc); }
static void PSADD() { vm.PSP += gpc(); } // 0x08
@@ -193,7 +203,6 @@ static void WFETCH() { vm.W = gd(readop()); } // 0x10
static void WSTORE() { sd(readop(), vm.W); }
static void WSWAP() { dword a, n; a = readop(); n = gd(a); sd(a, vm.W); vm.W = n; }
static void MADDN() { dword a = readop(); dword n=gpc(); sd(a, gd(a)+n); }
-static void WLEA() { vm.W = readop(); }
static void WIFETCH() { vm.W = gd(gd(readop())); }
static void WISTORE() { sd(gd(readop()), vm.W); }
static void WADD() { vm.W += gd(readop()); }
@@ -214,7 +223,8 @@ static void WIFETCH8() { vm.W = gb(gd(readop())); }
static void WISTORE8() { sb(gd(readop()), vm.W); }
static void WADD8() { vm.W += gb(readop()); }
-static void BOOTRD() { ppush(fgetc(fp)); } // 0x28
+static void WLEA() { vm.W = readop(); } // 0x28
+static void BOOTRD() { ppush(fgetc(fp)); }
static void STDOUT() { dword c = ppop(); write(STDOUT_FILENO, &c, 1); }
// ( -- c? f )
static void MAYBEKEY() {
@@ -402,8 +412,6 @@ static void LT() { vm.W = pnip() < vm.W; }
static void AND() { vm.W &= pnip(); } // 0x50
static void OR() { vm.W |= pnip(); }
static void XOR() { vm.W ^= pnip(); }
-static void BOOL() { if (vm.W) vm.W = 1; }
-static void NOT() { vm.W = !vm.W; }
static void BYE() { vm.PC = MEMSZ; } // 0x58
static void BYEFAIL() { vmabort(); }
@@ -427,22 +435,24 @@ static void SHRN() { vm.W >>= gpcb(); }
static void ANDN() { vm.W &= gpc(); }
static void ORN() { vm.W |= gpc(); }
static void XORN() { vm.W ^= gpc(); }
+static void CHECKZ() { vm.Z = !vm.W; }
+static void STOREZ() { vm.W = vm.Z; }
#define OPCNT 0x68
static void (*ops[OPCNT])() = {
- BR, CALL, RET, BRA, CBR, BRWR, BRZ, YIELD,
+ BR, CALL, RET, BRWR, BRA, BRC, BRCDROP, YIELD,
PSADD, RSADD, WLIT, ALIT, WADDN, AADDN, W2A, WSWAPA,
- WFETCH, WSTORE, WSWAP, MADDN, WLEA, WIFETCH, WISTORE, WADD,
- WFETCH16, WSTORE16, WSWAP16, MADDN16, WLEA, WIFETCH16, WISTORE16, WADD16,
- WFETCH8, WSTORE8, WSWAP8, MADDN8, WLEA, WIFETCH8, WISTORE8, WADD8,
- BOOTRD, STDOUT, MAYBEKEY, NULL, NULL, NULL, NULL, NULL,
+ WFETCH, WSTORE, WSWAP, MADDN, NULL, WIFETCH, WISTORE, WADD,
+ WFETCH16, WSTORE16, WSWAP16, MADDN16, NULL, WIFETCH16, WISTORE16, WADD16,
+ WFETCH8, WSTORE8, WSWAP8, MADDN8, NULL, WIFETCH8, WISTORE8, WADD8,
+ WLEA, BOOTRD, STDOUT, MAYBEKEY, NULL, NULL, NULL, NULL,
MAYBEWORD, WORD, PARSE, FIND, WNF, FINDMOD, NULL, NULL,
STACKCHK, COMPWORD, RUNWORD, COMPILING, STARTCOMP, STOPCOMP, RSADDWR, NULL,
ALIGN4, ENTRY, CODE, CODE16, CODE8, NULL, NULL, NULL,
SUB, MUL, DIVMOD, LT, NULL, NULL, NULL, NULL,
- AND, OR, XOR, BOOL, NOT, NULL, NULL, NULL,
+ AND, OR, XOR, NULL, NULL, NULL, NULL, NULL,
BYE, BYEFAIL, QUIT, ABORT_, DBG, NULL, NULL, NULL,
- SHLN, SHRN, ANDN, ORN, XORN, NULL, NULL, NULL,
+ SHLN, SHRN, ANDN, ORN, XORN, CHECKZ, STOREZ, NULL,
};
static void oprun1() { // run next op
@@ -493,7 +503,7 @@ static void buildsysdict() {
sysconst("sysdict", SYSDICT);
sysconst("nextmeta", NEXTMETA);
sysconst("[rcnt]", _RCNT_);
- wentry("boot<", 0x28); wentry("(emit)", 0x29);
+ wentry("boot<", 0x29); wentry("(emit)", 0x2a);
wentry("word", 0x31); wentry("find", 0x33);
wentry("(wnf)", 0x34); wentry("findmod", 0x35);
wentry("compword", 0x39); wentry("runword", 0x3a); wentry("compiling", 0x3b);
@@ -503,7 +513,6 @@ static void buildsysdict() {
wentry("-", 0x48); wentry("*", 0x49); wentry("/mod", 0x4a);
wentry("<", 0x4b);
wentry("and", 0x50); wentry("or", 0x51); wentry("xor", 0x52);
- wentry("bool", 0x53); wentry("not", 0x54);
wentry("bye", 0x58); wentry("byefail", 0x59);
wentry("quit", 0x5a); wentry("(abort)", 0x5b); wentry("dbg", 0x5c);
entry("ps+,"); compileop(0x08); writewr(); retwr();
@@ -527,9 +536,6 @@ static void buildsysdict() {
entry("[+n],"); compopwr(0x13); writewr(); retwr();
CODE16(); compopwr(0x1b); writewr(); retwr();
CODE8(); compopwr(0x23); writewr(); retwr();
- entry("lea,"); compopwr(0x14); retwr();
- CODE16(); compopwr(0x1c); retwr();
- CODE8(); compopwr(0x24); retwr();
entry("[@],"); compopwr(0x15); retwr();
CODE16(); compopwr(0x1d); retwr();
CODE8(); compopwr(0x25); retwr();
@@ -539,17 +545,22 @@ static void buildsysdict() {
entry("+,"); compopwr(0x17); retwr();
CODE16(); compopwr(0x1f); retwr();
CODE8(); compopwr(0x27); retwr();
+ entry("lea,"); compopwr(0x28); retwr();
+ CODE16(); compopwr(0x28); retwr();
+ CODE8(); compopwr(0x28); retwr();
entry("<<n,"); compileop(0x60); cwritewr(); retwr();
entry(">>n,"); compileop(0x61); cwritewr(); retwr();
entry("andn,"); compileop(0x62); writewr(); retwr();
entry("orn,"); compileop(0x63); writewr(); retwr();
entry("xorn,"); compileop(0x64); writewr(); retwr();
+ entry("=0>Z,"); compileop(0x65); retwr();
+ entry("Z>W,"); compileop(0x66); retwr();
entry("exit,"); compileop(0x02); retwr();
entry("execute,"); compileop(0x01); writewr(); 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();
+ entry("branchA,"); compileop(0x04); retwr();
+ entry("branch,"); litwr(0x00); cwritewr(); cwrite(0x03); retwr();
+ entry("branchC,"); litwr(0x05); cwritewr(); cwritewr(); cwrite(0x03); retwr();
+ entry(">branchC,"); litwr(0x06); cwritewr(); cwritewr(); cwrite(0x03); retwr();
entry("branch!"); storewr(); retwr();
entry("yield"); compileop(0x07); retwr(); makeimm();
entry(";"); compileop(0x02); cwrite(0x3d); retwr(); makeimm();
