commit e77d30d2316a2318de8f83de20e5946f84d8eb49
parent 1e80fd3d0b21f4ba76b2d09ac466c9a7ae07db5d
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 22 Jun 2023 20:03:51 -0400
hal: Change [@], and [!], to [@+], and [!+],
This opens the door to astounding simplifications in bootlo and results in much
faster code under ARM.
For some reason, HAL tests weren't picked up in the whole test suite. Now they
are.
The new CC tok tests are a leftover of a bug hunting session I had under i386.
Diffstat:
11 files changed, 117 insertions(+), 86 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -57,7 +57,8 @@ create _bank $10 CELLSZ * allot
: newbankid to1+ _bankidx _bankidx $f and ;
: bank' ( id -- a ) CELLSZ * _bank + ;
: bank@ ( opmod -- n ) bankid@ bank' @ ;
-: newbankedop ( n -- opmod ) newbankid tuck bank' ! 20 lshift ;
+: oldbank! ( n -- ) drop ; \ realiased in i386h
+: newbankedop ( n -- opmod ) dup oldbank! newbankid tuck bank' ! 20 lshift ;
: r) $1c0 or to1+ _argcnt ;
diff --git a/fs/asm/i386h.fs b/fs/asm/i386h.fs
@@ -2,6 +2,7 @@
\ W=ax A=di PSP=si RSP=sp
?f<< /asm/i386.fs
+:realias oldbank! HBANK ! ;
: A>) ( halop -- halop ) $40000 or ;
: A>? $40000 and bool ;
: <>) ( halop -- halop ) $80000 xor ;
@@ -49,10 +50,10 @@ op <<, shl, op >>, shr,
-1 = of dec, endof
i) add, endcase ;
: _ ( halop -- dst src )
- dup 16b? >r dup 8b? >r 32b)
- halop>dstsrc bx swap mov, ( dst )
- bx 0 d) r> if 8b) then r> if 16b) then ;
-: [@], _ mov, ; : [!], _ swap mov, ;
+ r! 32b) halop>dstsrc bx swap mov, ( dst ) \ V1=halop
+ r@ case 8b? of 1 endof 16b? of 2 endof drop 4 endcase r@ [+n], ( dst )
+ bx 0 d) r@ 8b? if 8b) then r> 16b? if 16b) then ;
+: [@+], _ mov, ; : [!+], _ swap mov, ;
\ These are used so often that it's worth redefining them in their more
\ efficient version.
@@ -61,4 +62,3 @@ op <<, shl, op >>, shr,
: dup, -4 ps+, PSP) !, ;
: nip, 4 ps+, ;
: drop, PSP) @, nip, ;
-
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -137,8 +137,9 @@ is $42, comparison is done one the whole W register.
### Operation width and indirect operators
-The HAL has indirect fetch/store operators under the name of "[@]," and "[!],".
-This means that we fetch and store at the address where the operand points to.
+The HAL has indirect fetch/store operators under the name of "[@+]," and
+"[!+],". This means that we fetch and store at the address where the operand
+points to.
What happens when we use this with 8b) and 16b) operand modifiers? These
modifiers will only apply to the last part of the fetch/store operation. Because
@@ -269,8 +270,8 @@ Instructions:
!, op -- Write dest to source
@!, op -- Swap dest and source
+, op -- Z Add source to dest
-[@], op -- Read indirect source into dest
-[!], op -- Write indirect source into dest
+[@+], op -- Read indirect source into dest and add 4 to source.
+[!+], op -- Write dest into indirect source and add 4 to source.
compare, op -- A Compare source to dest (all flags set)
[+n], n op -- Z Add n to source without affecting dest
addr, op -- Store the effective address of the operand in dest
@@ -281,7 +282,6 @@ LIT>W, n -- Set W to n
W+n, n -- Z Add n to W
A+n, n -- Z Add n to A
W>A, -- Copy W to A
-A>W, -- Copy A to W
W<>A, -- Swap W and A
-W, -- W = -W
diff --git a/fs/tests/asm/all.fs b/fs/tests/asm/all.fs
@@ -1,5 +1,6 @@
\ Run all asm test suites
?f<< /lib/context.fs
+f<< /tests/asm/hal.fs
context asm
f<< /tests/asm/arm.fs
f<< /tests/asm/i386.fs
diff --git a/fs/tests/asm/hal.fs b/fs/tests/asm/hal.fs
@@ -47,7 +47,7 @@ code test5 ( -- n )
RSP) addr,
RSP) 4 +) !, \ reference to RS+0 in RS+4
\ Now, let's dereference
- RSP) 4 +) [@],
+ RSP) 4 +) [@+],
8 rs+, exit,
test5 42 #eq
@@ -58,7 +58,7 @@ code test6
RSP) 4 +) !, \ reference to RS+0 in RS+4
\ Now, let's assign-dereference
54 LIT>W,
- RSP) 4 +) [!],
+ RSP) 4 +) [!+],
RSP) @,
8 rs+, exit,
test6 54 #eq
@@ -125,7 +125,7 @@ code test13 ( -- n )
42 LIT>W, RSP) !,
RSP) addr, RSP) 4 +) !,
54 LIT>W,
- RSP) 4 +) [!],
+ RSP) 4 +) [!+],
RSP) @,
8 rs+, exit,
test13 54 #eq
@@ -136,7 +136,7 @@ create myarray 1 , 2 , 3 , 0 ,
code test14 ( -- n )
dup, -4 rs+,
0 LIT>W, RSP) !, \ i=0
- myarray LIT>A,
+ myarray i) A>) &) @,
begin
1 RSP) [+n],
A) @,
diff --git a/fs/tests/comp/c/all.fs b/fs/tests/comp/c/all.fs
@@ -1,4 +1,5 @@
\ Run all CC test suites
f<< tests/comp/c/type.fs
+f<< tests/comp/c/tok.fs
f<< tests/comp/c/cc.fs
f<< tests/comp/c/lib.fs
diff --git a/fs/tests/comp/c/tok.fs b/fs/tests/comp/c/tok.fs
@@ -0,0 +1,11 @@
+?f<< /tests/harness.fs
+?f<< /comp/c/cc.fs
+testbegin
+\ Tests for CC tokenizer
+: checktok ( expected n -- ) for nextt dup #s= s) next drop ;
+9 stringlist expected "short" "retconst" "(" ")" "{" "return" "42" ";" "}"
+expected 9 checktok
+short retconst() {
+ return 42;
+}
+testend
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -664,21 +664,32 @@ xcode [+n], ( n operand -- )
mov) r1 rd) r0 i) ,) lbladdnwr abs>rel bl) ,)
popret, wjmp, !,
-pc to L1 ( operand -- operand-rn=r0 )
- pushret, lblmemwr abs>rel bl) ,) popret,
+pc to L1 ( operand -- ) \ r0=base instr
+ pushret,
+ lblmemwr abs>rel bl) ,)
xdup, setrd0) rTOP rdn) ,)
- pushret, wcall, 32b) wcall, @, popret,
+ wcall, 32b) rTOP push, r0 push, wcall, @,
setrn0) rTOP rdn) ,)
bic) rTOP rdn) $3f i) ,) \ clear offset+imm flags
- exit,
+ \ set offset to 4, 2, or 1
+ mov) r1 rd) 4 i) ,)
+ tst) rTOP rn) $04000000 i) ,)
+ mov) z) r1 rd) 2 i) ,)
+ tst) rTOP rn) $00400000 i) ,)
+ mov) nz) r1 rd) 1 i) ,)
+ r0 pop,
+ orr) r0 rdn) r1 rm) ,)
+ L4 abs>rel bl) ,)
+ xdup, rTOP pop,
+ popret, wjmp, !,
-xcode [@], ( operand -- )
- pushret, L1 abs>rel bl) ,) popret,
- wjmp, @,
+pc ldr) 0 +i) post) ,)
+xcode [@+], ( operand -- )
+ ( pc ) r0 pc@>reg, L1 abs>rel b) ,)
-xcode [!], ( operand -- )
- pushret, L1 abs>rel bl) ,) popret,
- wjmp, !,
+pc str) 0 +i) post) ,)
+xcode [!+], ( operand -- )
+ ( pc ) r0 pc@>reg, L1 abs>rel b) ,)
pc pushret,
xcode pushret,
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -35,22 +35,22 @@ code8b -1 W) 8b) [+n], drop, exit,
code @! W>A, drop, A) @!, exit,
code16b W>A, drop, A) 16b) @!, exit,
code8b W>A, drop, A) 8b) @!, exit,
-code @+ W>A, A) @, W<>A, 4 W+n, dup, W<>A, exit,
-code16b W>A, A) 16b) @, W<>A, 2 W+n, dup, W<>A, exit,
-code8b HERE @ W>A, A) 8b) @, W<>A, 1 W+n, dup, W<>A, exit,
+code @+ dup, PSP) [@+], exit,
+code16b dup, PSP) 16b) [@+], exit,
+code8b HERE @ dup, PSP) 8b) [@+], exit,
code c@+ branch, drop
-code !+ W>A, drop, A) !, W<>A, 4 W+n, exit,
-code16b W>A, drop, A) 16b) !, W<>A, 2 W+n, exit,
-code8b HERE @ W>A, drop, A) 8b) !, W<>A, 1 W+n, exit,
+code !+ PSP) @!, PSP) [!+], drop, exit,
+code16b PSP) @!, PSP) 16b) [!+], drop, exit,
+code8b HERE @ PSP) @!, PSP) 8b) [!+], drop, exit,
code c!+ branch, drop
-code @@+ W>A, A) [@], 4 A) [+n], exit,
-code16b W>A, A) 16b) [@], 2 A) [+n], exit,
-code8b W>A, A) 8b) [@], 1 A) [+n], exit,
-code @!+ W>A, drop, A) [!], 4 A) [+n], drop, exit,
-code16b W>A, drop, A) 16b) [!], 2 A) [+n], drop, exit,
-code8b W>A, drop, A) 8b) [!], 1 A) [+n], drop, exit,
+code @@+ W) [@+], exit,
+code16b W) 16b) [@+], exit,
+code8b W) 8b) [@+], exit,
+code @!+ W>A, drop, A) [!+], drop, exit,
+code16b W>A, drop, A) 16b) [!+], drop, exit,
+code8b W>A, drop, A) 8b) [!+], drop, exit,
code + PSP) +, nip, exit,
code - -W, PSP) +, nip, exit,
@@ -167,13 +167,13 @@ _to to1+ 1+! _1+!,
: _1-!, -1 swap [+n], ; :16b -1 swap 16b) [+n], ; :8b -1 swap 8b) [+n], ;
_to to1- 1-! _1-!,
_to to@! @! @!,
-: _@@+, dup, dup [@], 4 swap [+n], ;
-:16b dup, dup 16b) [@], 2 swap [+n], ;
-:8b dup, dup 8b) [@], 1 swap [+n], ;
+: _@@+, dup, [@+], ;
+:16b dup, 16b) [@+], ;
+:8b dup, 8b) [@+], ;
_to to@+ @@+ _@@+,
-: _@!+, dup [!], 4 swap [+n], drop, ;
-:16b dup 16b) [!], 2 swap [+n], drop, ;
-:8b dup 8b) [!], 1 swap [+n], drop, ;
+: _@!+, [!+], drop, ;
+:16b 16b) [!+], drop, ;
+:8b 8b) [!+], drop, ;
_to to!+ @!+ _@!+,
: _addr, dup, addr, ; :16b dup, addr, ; :8b dup, addr, ;
_to to' noop _addr,
@@ -276,9 +276,9 @@ create _repl 3 nc, LF CR 0
code []= ( a1 a2 u -- f )
W=0>Z, 0 Z) branchC, PSP) @!, W>A, begin \ P+4=a1 P+0=u A=a2
- PSP) 4 +) 8b) [@], A) 8b) compare, 0 Z) branchC,
+ PSP) 4 +) 8b) [@+], A) 8b) compare, 0 Z) branchC,
8 ps+, 0 LIT>W, exit, then
- 1 A+n, 1 PSP) 4 +) [+n], -1 PSP) [+n], NZ) branchC, drop then
+ 1 A+n, -1 PSP) [+n], NZ) branchC, drop then
8 ps+, 1 LIT>W, exit,
: s= ( s1 s2 -- f ) over c@ 1+ []= ;
: [if] not if S" [then]" begin word over s= until drop then ;
@@ -286,8 +286,7 @@ alias noop [then]
code move ( src dst u -- )
W=0>Z, 0 Z) branchC, W>A, begin \ A=u
- PSP) 4 +) 8b) [@], PSP) 8b) [!],
- 1 PSP) 4 +) [+n], 1 PSP) [+n],
+ PSP) 4 +) 8b) [@+], PSP) 8b) [!+],
-1 A+n, NZ) branchC, drop then
8 ps+, drop, exit,
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -37,7 +37,6 @@ $500 to binstart
$2000 const STACKSZ
$7c00 const RSTOP
$80000 const PSTOP
-$10 const HBANKCNT
PSTOP STACKSZ - const HEREMAX
: _ dx lblhere m) mov, dx 0 d) swap mov, ;
@@ -118,6 +117,7 @@ $2 xconst <) $3 xconst >=) $6 xconst <=) $7 xconst >)
$c xconst s<) $d xconst s>=) $e xconst s<=) $f xconst s>)
pc to lblhbank 0 ,
+lblhbank xconst HBANK
xcode m) ( a -- operand )
lblhbank m) ax mov,
ax $105 i) mov,
@@ -246,25 +246,33 @@ xcode compare, ( operand -- ) \ ax operand cmp,
xcode addr, ( operand -- ) \ ax operand lea,
ax $8d00 i) or, L1 absjmp,
-xcode [@], ( operand -- ) \ ax 32b) operand mov, ax Xb) ax 0 d) mov,
- xdup, wcall, 32b) wcall, @, ( operand -- )
- ax $ffffff00 i) and, \ set operand to [eax] but keep size
- wjmp, @,
-
-\ bx 32b) operand mov, Xb) bx 0 d) ax mov,
-xcode [!], ( operand -- )
- xdup, al $18 i) or, \ change target from ax to bx
- wcall, 32b) wcall, @, ( operand -- )
- ah $88 i) or,
- al $03 i) mov, \ keep size, but modrm is for bx 0 d) ax mov,
- L1 absjmp,
-
-xcode [+n], ( n operand -- ) \ operand n i) add, OR operand inc,/dec,
+xcode [+n], ( n operand -- ) \ operand n i) add,
si 0 d) 1 i) cmp, forward8 jnz, xnip, ax $fe00 i) or, L1 absjmp, forward!
si 0 d) -1 i) cmp, forward8 jnz, xnip, ax $fe08 i) or, L1 absjmp, forward!
ax $8000 i) or, L1 abscall, ( n -- )
ax dwrite, xdrop, ret,
+\ Write: bx 32b) operand mov, operand 32b) 1/2/4 i) add,
+pc to L2 ( operand -- operand-with-bx-src )
+ xdup,
+ bx 4 i) mov,
+ ax $20000 i) test, forward8 jz, bx 2 i) mov, forward!
+ ax $100 i) test, forward8 jnz, bx 1 i) mov, forward!
+ xgrow, si 0 d) bx mov,
+ xdup, ( op n op )
+ al $18 i) or, \ target=bx
+ wcall, 32b) wcall, @,
+ wcall, 32b) wcall, [+n],
+ ax $20100 i) and, \ Set operand to W) but preserve size flags
+ al $03 i) mov, \ keep size, but modrm is for bx 0 d) ax mov,
+ ret,
+
+xcode [@+], ( operand -- )
+ L2 abscall, wjmp, @,
+
+xcode [!+], ( operand -- )
+ L2 abscall, wjmp, !,
+
xcode dup,
-4 xlit, wcall, ps+,
wcall, PSP)
diff --git a/posix/vm.c b/posix/vm.c
@@ -184,18 +184,16 @@ static void binopwr(byte binopidx, dword operand) {
}
static void wfetchwr(dword op) { wopwr(0x10, op); }
static void wstorewr(dword op) { wopwr(0x10, op^OPINVERT); }
-static void maddnwr(dword op, dword n) { wopwr(0x13, op); dwrite(n); }
-static void wistorewr(dword op) { wopwr(0x16, op); }
+static void wistoreincwr(dword op) { wopwr(0x16, op); }
static void dupwr() { psaddwr(0xfffffffc); wstorewr(OPPSP); }
static void nipwr() { psaddwr(4); }
static void dropwr() { wfetchwr(OPPSP); nipwr(); }
static void wlitwr(dword n) { cwrite(0x0a); dwrite(n); }
-static void alitwr(dword n) { cwrite(0x0b); dwrite(n); }
static void litwr(dword n) { dupwr(); wlitwr(n); }
static void callwr(dword a) { cwrite(0x01); dwrite(a); }
static void brwr(dword a) { cwrite(0x00); dwrite(a); }
-static void writewr() { alitwr(HERE); wistorewr(OPA); maddnwr(OPA, 4); dropwr(); }
-static void cwritewr() { alitwr(HERE); wistorewr(OPA|OP8B); maddnwr(OPA, 1); dropwr(); }
+static void writewr() { wistoreincwr(hbankset(OPHASDISP|OPMEM, HERE)); dropwr(); }
+static void cwritewr() { wistoreincwr(hbankset(OPHASDISP|OPMEM|OP8B, HERE)); dropwr(); }
static void compopwr(byte opcode) { litwr(opcode); cwrite(0x3f); }
static void compbinopwr(byte binopidx) { litwr(binopidx); cwrite(0x45); }
static void storewr() { cwrite(0x0e); dropwr(); wstorewr(OPA); dropwr(); }
@@ -222,6 +220,7 @@ static void entry(char *name) {
/* Operations */
static dword *opsrc;
static dword *opdst;
+static dword opsz;
static dword (*mget)(dword *a);
static void (*mset)(dword *a, dword val);
static dword mget32(dword *a) { return *a; }
@@ -230,9 +229,9 @@ static dword mget8(dword *a) { return (dword)*(byte *)a; }
static void mset32(dword *a, dword val) { *a = val; }
static void mset16(dword *a, dword val) { *(word *)a = (word)val; }
static void mset8(dword *a, dword val) { *(byte *)a = (byte)val; }
-#define M32B mget = mget32; mset = mset32
-#define M16B mget = mget16; mset = mset16
-#define M8B mget = mget8; mset = mset8
+#define M32B opsz = 4; mget = mget32; mset = mset32
+#define M16B opsz = 2; mget = mget16; mset = mset16
+#define M8B opsz = 1; mget = mget8; mset = mset8
static dword def_opdget() { return *opdst; }
static void def_opdset(dword val) { *opdst = val; }
static dword def_opsget() { return mget(opsrc); }
@@ -266,7 +265,6 @@ static void YIELD() { dword pc = vm.PC; vm.PC = rpop(); rpush(pc); }
static void PSADD() { vm.PSP += gpc(); } // 0x08
static void RSADD() { vm.RSP += gpc(); }
static void WLIT() { vm.W = gpc(); }
-static void ALIT() { vm.A = gpc(); }
static void WADDN() { vm.W += gpc(); vm.Z = vm.W == 0;}
static void AADDN() { vm.A += gpc(); vm.Z = vm.A == 0;}
static void W2A() { vm.A = vm.W; }
@@ -308,30 +306,32 @@ static void _wcmp() {
readop(); dword n = opsget(); dword ref = opdget();
vm.Z = n == ref; vm.C = ref < n;
vm.SC = (ref+0x80000000) < (n+0x80000000); }
-static void _wifetch() { readop(); opdset(mget((dword*)&vm.mem[*opsrc])); }
-static void _wistore() { readop(); mset((dword*)&vm.mem[*opsrc], opdget()); }
+static void _wifetchinc() {
+ readop(); opdset(mget((dword*)&vm.mem[*opsrc])); *opsrc += opsz; }
+static void _wistoreinc() {
+ readop(); mset((dword*)&vm.mem[*opsrc], opdget()); *opsrc += opsz; }
static void WFETCH() { M32B; _wfetch(); } // 0x10
static void WSWAP() { M32B; _wswap(); }
static void MADDN() { M32B; _maddn(); }
static void WCMP() { M32B; _wcmp(); }
-static void WIFETCH() { M32B; _wifetch(); }
-static void WISTORE() { M32B; _wistore(); }
+static void WIFETCHINC() { M32B; _wifetchinc(); }
+static void WISTOREINC() { M32B; _wistoreinc(); }
static void WLEA() { readop(); opdset((dword)((byte*)opsrc-vm.mem)); }
static void WFETCH16() { M16B; _wfetch(); } // 0x18
static void WSWAP16() { M16B; _wswap(); }
static void MADDN16() { M16B; _maddn(); }
static void WCMP16() { M16B; _wcmp(); }
-static void WIFETCH16() { M16B; _wifetch(); }
-static void WISTORE16() { M16B; _wistore(); }
+static void WIFETCHINC16() { M16B; _wifetchinc(); }
+static void WISTOREINC16() { M16B; _wistoreinc(); }
static void WFETCH8() { M8B; _wfetch(); } // 0x20
static void WSWAP8() { M8B; _wswap(); }
static void MADDN8() { M8B; _maddn(); }
static void WCMP8() { M8B; _wcmp(); }
-static void WIFETCH8() { M8B; _wifetch(); }
-static void WISTORE8() { M8B; _wistore(); }
+static void WIFETCHINC8() { M8B; _wifetchinc(); }
+static void WISTOREINC8() { M8B; _wistoreinc(); }
// 0x28
static void BOOTRD() { ppush(fgetc(fp)); }
@@ -867,10 +867,10 @@ static void DRVWR() {
#define OPCNT 0x70
static void (*ops[OPCNT])() = {
BR, CALL, RET, BRWR, BRA, BRC, NULL, YIELD,
- PSADD, RSADD, WLIT, ALIT, WADDN, AADDN, W2A, WSWAPA,
- WFETCH, NULL, WSWAP, MADDN, WCMP, WIFETCH, WISTORE, WLEA,
- WFETCH16, NULL, WSWAP16, MADDN16, WCMP16, WIFETCH16, WISTORE16, WLEA,
- WFETCH8, NULL, WSWAP8, MADDN8, WCMP8, WIFETCH8, WISTORE8, WLEA,
+ PSADD, RSADD, WLIT, NULL, WADDN, AADDN, W2A, WSWAPA,
+ WFETCH, NULL, WSWAP, MADDN, WCMP, WIFETCHINC, WISTOREINC, WLEA,
+ WFETCH16, NULL, WSWAP16, MADDN16, WCMP16, WIFETCHINC16, WISTOREINC16, WLEA,
+ WFETCH8, NULL, WSWAP8, MADDN8, WCMP8, WIFETCHINC8, WISTOREINC8, WLEA,
NULL, BOOTRD, STDOUT, MAYBEKEY, NULL, MAKEMEM, ADDDISP, NULL,
MAYBEWORD, WORD, PARSE, FIND, WNF, FINDMOD, NULL, NULL,
STACKCHK, COMPWORD, RUNWORD, COMPILING, STARTCOMP, STOPCOMP, RSADDWR, COMPOP,
@@ -959,7 +959,6 @@ static void buildsysdict() {
entry("popret,"); retwr();
entry("ps+,"); compileop(0x08); writewr(); retwr();
entry("LIT>W,"); compileop(0x0a); writewr(); retwr();
- entry("LIT>A,"); compileop(0x0b); writewr(); retwr();
entry("W+n,"); compileop(0x0c); writewr(); retwr();
entry("A+n,"); compileop(0x0d); writewr(); retwr();
entry("W>A,"); compileop(0x0e); retwr();
@@ -969,8 +968,8 @@ static void buildsysdict() {
// ( n ?disp operand -- )
entry("[+n],"); compopwr(0x13); writewr(); retwr();
entry("compare,"); compopwr(0x14); retwr();
- entry("[@],"); compopwr(0x15); retwr();
- entry("[!],"); compopwr(0x16); retwr();
+ entry("[@+],"); compopwr(0x15); retwr();
+ entry("[!+],"); compopwr(0x16); retwr();
entry("+,"); compbinopwr(0x00); retwr();
entry("-,"); compbinopwr(0x01); retwr();
entry("*,"); compbinopwr(0x02); retwr();
