commit 1c74a87a6e79e5c76906608e0dacd3554781176a
parent 98347638ca28601f9f27cd378dcde700a247f88f
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 28 Jun 2023 19:52:19 -0400
hal: move i) to kernel and remove LIT>W,
Diffstat:
9 files changed, 85 insertions(+), 50 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -9,12 +9,9 @@
\ b8 0=8b 1=32/16b
\ b14:9 zeroes
\ b15 immediate? ( value in bank )
-\ b16 dual meaning:
-\ asm: opcode is 2 bytes (has $0f extension byte)
-\ hal: "&)" flag
+\ b16 opcode is 2 bytes (has $0f extension byte)
\ b17 16b?
-\ b18 HAL "A>)" flag
-\ b19 HAL "<>)" flag
+\ b19:18 zeroes
\ b23:20 Number bank index
\ b31:24 SIB
\ When we refer to "opmod" below, it's this structure
diff --git a/fs/comp/c/fgen.fs b/fs/comp/c/fgen.fs
@@ -78,7 +78,7 @@ alias noop parseStatement ( tok -- ) \ forward declaration
code _lookup ( nref lookup -- )
A) &) !, A) @,
- -8 rs+, RSP) 4 +) !, 0 LIT>W, RSP) !, begin \ RS+0=i RS+4=totcnt
+ -8 rs+, RSP) 4 +) !, 0 i) @, RSP) !, begin \ RS+0=i RS+4=totcnt
RSP) @, RSP) 4 +) compare, 0 NZ) branchC, \ not found
8 rs+, nip, exit, then
1 RSP) +n, CELLSZ A) &) +n, A) @,
diff --git a/fs/doc/cc/impl.txt b/fs/doc/cc/impl.txt
@@ -276,7 +276,7 @@ The HAL equivalent for this is:
code foobar ( a b -- n )
dup, -4 rs+,
- 42 LIT>W, RSP) !,
+ 42 i) @, RSP) !,
PSP 4 +) @,
PSP) +,
RSP) +,
@@ -310,7 +310,7 @@ code foobar ( a b -- n )
dup, -12 rs+,
PSP) @, RSP) !,
PSP) 4+) @, RSP) 4 +) !,
- 42 LIT>W, RSP) 8 +) !,
+ 42 i) @, RSP) 8 +) !,
RSP 4 +) @,
RSP) +,
RSP) 8 +) +,
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -131,7 +131,7 @@ result directly in address $1234 without affecting W.
(the C flag is never set in 16b) or 8b) mode).
This also applies to compare, which means that, for example,
-"$4242 LIT>W, RSP) 8b) compare," will never set the Z flag because even if RSP)
+"$4242 i) @, RSP) 8b) compare," will never set the Z flag because even if RSP)
is $42, comparison is done one the whole W register.
### Operation width and indirect operators
@@ -278,7 +278,6 @@ addr, op -- Store the effective address of the operand in dest
ps+, n -- Add n to PSP
rs+, n -- Add n to RSP
-LIT>W, n -- Set W to n
W+n, n -- Z Add n to W
-W, -- W = -W
diff --git a/fs/tests/asm/hal.fs b/fs/tests/asm/hal.fs
@@ -10,8 +10,8 @@ code test1 ( a b -- a-b )
\ use RSP as local variables
code test2 ( -- n )
dup, -8 rs+,
- 42 LIT>W, RSP) !,
- 5 LIT>W, RSP) 4 +) !,
+ 42 i) @, RSP) !,
+ 5 i) @, RSP) 4 +) !,
RSP) @,
RSP) 4 +) +,
8 rs+, exit,
@@ -20,8 +20,8 @@ test2 47 #eq
\ simple expression
code test3 ( -- n )
dup, -4 rs+,
- 2 LIT>W, RSP) !,
- 3 LIT>W, RSP) *,
+ 2 i) @, RSP) !,
+ 3 i) @, RSP) *,
1 W+n,
4 rs+, exit,
test3 7 #eq
@@ -29,12 +29,12 @@ test3 7 #eq
\ expression involving push/popping intermediate results
code test4 ( -- n ) \ 2 * 3 + 2
dup,
- 3 LIT>W,
+ 3 i) @,
-1 W+n,
dup,
- 2 LIT>W,
+ 2 i) @,
dup,
- 3 LIT>W,
+ 3 i) @,
PSP) *, nip,
PSP) +, nip,
exit,
@@ -43,7 +43,7 @@ test4 8 #eq
\ variable reference and dereference
code test5 ( -- n )
dup, -8 rs+,
- 42 LIT>W, RSP) !,
+ 42 i) @, RSP) !,
RSP) addr,
RSP) 4 +) !, \ reference to RS+0 in RS+4
\ Now, let's dereference
@@ -57,7 +57,7 @@ code test6
RSP) addr,
RSP) 4 +) !, \ reference to RS+0 in RS+4
\ Now, let's assign-dereference
- 54 LIT>W,
+ 54 i) @,
RSP) 4 +) [!+],
RSP) @,
8 rs+, exit,
@@ -72,7 +72,7 @@ test7 1234 #eq
\ Increase/decrease directly in memory
code test8 ( -- n )
dup, -4 rs+,
- 42 LIT>W, RSP) !,
+ 42 i) @, RSP) !,
1 RSP) +n,
RSP) @,
4 rs+, exit,
@@ -82,16 +82,16 @@ test8 43 #eq
code test9 ( n -- n ) \ returns 42 if arg >= 10, 54 otherwise
10 i) compare,
0 <) branchC,
- 42 LIT>W, exit,
+ 42 i) @, exit,
then
- 54 LIT>W, exit,
+ 54 i) @, exit,
5 test9 54 #eq
15 test9 42 #eq
\ function calls
code test10 ( n -- n-42 )
dup,
- 42 LIT>W,
+ 42 i) @,
pushret, ' test1 execute, popret,
exit,
54 test10 12 #eq
@@ -100,7 +100,7 @@ code test10 ( n -- n-42 )
here ," hello" ( a )
code test11 ( n -- c )
dup,
- ( a ) LIT>W,
+ ( a ) i) @,
PSP) +, nip,
W) 8b) @,
exit,
@@ -111,7 +111,7 @@ code test11 ( n -- c )
here 42 , here swap , ( pc of *int )
code test12 ( -- n )
dup,
- ( pc ) LIT>W,
+ ( pc ) i) @,
W) A>) @,
A) @,
1 W+n, \ result in W, not in memory location
@@ -122,9 +122,9 @@ test12 85 #eq
\ a rewrite of ptrset() from test.c for more precise testing
code test13 ( -- n )
dup, -8 rs+,
- 42 LIT>W, RSP) !,
+ 42 i) @, RSP) !,
RSP) addr, RSP) 4 +) !,
- 54 LIT>W,
+ 54 i) @,
RSP) 4 +) [!+],
RSP) @,
8 rs+, exit,
@@ -135,7 +135,7 @@ create myarray 1 , 2 , 3 , 0 ,
\ Equivalent: int i = 0; int *b = myarray; do ++i; while (*(b++)); return i;
code test14 ( -- n )
dup, -4 rs+,
- 0 LIT>W, RSP) !, \ i=0
+ 0 i) @, RSP) !, \ i=0
myarray i) A>) @,
begin
1 RSP) +n,
@@ -195,7 +195,7 @@ code test20 ( a b -- n )
\ *, with A>)
code test21 ( a b -- n )
W) &) A>) @,
- 0 LIT>W,
+ 0 i) @,
PSP) A>) *,
A) &) @,
nip, exit,
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -74,6 +74,7 @@ $e4009000 const HALBASE
\ Mask for HAL-related flags with no meaning in ARM instructions
$07800000 const HALMASK
$01000000 const HALDEREF
+$02000000 const HALIMM
\ ARM immediate system makes it difficult to place sysvars at arbitrary places
\ in the code and they need to be neatly arranged in an easy to refer
@@ -468,6 +469,13 @@ xcode m) ( a -- operand )
( pc ) rTOP pc@>reg,
exit,
+pc HALBASE HALIMM or le,
+xcode i) ( n -- operand )
+ r0 binstart HBANK movi2,
+ str) rTOP rd) r0 rn) ,)
+ ( pc ) rTOP pc@>reg,
+ exit,
+
\ TODO: support negative offsets
xcode +) ( operand n -- operand )
r0 binstart HBANK movi2,
@@ -560,7 +568,7 @@ xcode ps+, ( n -- )
xcode W+n, ( n -- )
mov) r1 rd) rTOP imm) ,) lbladdnwr abs>rel b) ,)
-\ Compile code resulting in target register in r0 to contain "n"
+\ Compile code resulting in register Rd to contain "n"
pc mov) 0 imm) ,)
pc to lbllitwr ( n -- ) \ r0=Rd
pushret, r0 push,
@@ -642,8 +650,6 @@ pc to lblswp ( operand -- )
popret,
L2 abs>rel b) ,)
-xcode LIT>W, ( n -- )
- mov) r0 rd) rTOP imm) ,) lbllitwr abs>rel b) ,)
pc rsb) rTOP rdn) 0 imm) ,)
xcode -W, ( -- )
@@ -672,14 +678,22 @@ pc to L3 ( operand -- ) \ r0=base instr
orr) nz) r0 rdn) r2 rm) ,) \ apply high nibble
L1 abs>rel b) ,)
-pc to L4 ( operand -- ) \ r0=base instr
+\ Write a ldr) or str), depending on instr
+pc to L4 ( operand -- ) \ r0=instr
pushret, lblimmwr abs>rel bl) ,) popret,
tst) rTOP rn) $04000000 imm) ,)
L3 abs>rel b) z) ,)
L2 abs>rel b) ,)
-
+\ Write number specified in bank as an immediate to operand's target
+pc to L3 ( operand -- )
+ mov) r0 rd) rTOP rm) 12 lsr) ,)
+ and) r0 rdn) $f imm) ,)
+ rTOP binstart HBANK movi2, ldr) rTOP rdn) ,)
+ lbllitwr abs>rel b) ,)
pc ldr) 0 +i) ,)
xcode @, ( operand -- ) \ Compiled code preserves r0
+ tst) rTOP rn) HALIMM imm) ,)
+ L3 abs>rel b) nz) ,)
tst) rTOP rn) HALDEREF imm) ,)
lblmov abs>rel b) nz) ,)
( pc ) r0 pc@>reg, L4 abs>rel b) ,)
@@ -696,7 +710,8 @@ xcode addr, ( operand -- )
r0 binstart HBANK movi2, ldr) r0 rdn) ,)
tst) rTOP rn) $20 imm) ,)
mov) nz) rTOP rd) r0 rm) ,)
- xwordlbl LIT>W, abs>rel b) nz) ,) \ m) operand? same as LIT>W,
+ mov) nz) r0 rd) rTOP imm) ,)
+ lbllitwr abs>rel b) nz) ,) \ m) operand
( pc ) r0 pc@>reg, L2 abs>rel b) ,)
\ operand is 16b and ARM doesn't have a 16b SWP! LDR+STR+MOV...
@@ -866,7 +881,7 @@ xcode dup,
xcode litn
pushret, wcall, dup, popret,
- wjmp, LIT>W,
+ mov) r0 rd) rTOP imm) ,) lbllitwr abs>rel b) ,)
\ Arithmetics
xcode and ( n n -- n )
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -212,7 +212,7 @@ alias execute | immediate
: ivar, ( off -- ) RSP) swap +) toptr@ execute ;
: i 4 ivar, ; immediate : j 8 ivar, ; immediate : k 12 ivar, ; immediate
: :iterator doer immediate [compile] ] does> ( w -- yieldjmp loopaddr )
- -16 rs+, RSP) !, LIT>W, RSP) @!,
+ -16 rs+, RSP) !, i) @, RSP) @!,
[compile] ahead \ jump to yield
[compile] begin ( loop ) ;
0 value _breaklbl
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -7,6 +7,20 @@
\ we must assume that all registers are destroyed. However, some words within
\ the kernel refer to other words with register preservation assumptions. In
\ these cases, the word itself mentions which registers are preserved.
+
+\ HAL operand structure (very close to i386 structure)
+\ b2:0 regid
+\ b5:3 zeroes
+\ b7:6 mod ( displacement in bank if present )
+\ b8 0=8b 1=32/16b
+\ b14:9 zeroes
+\ b15 immediate? ( value in bank )
+\ b16 "&)" flag
+\ b17 16b?
+\ b18 "A>)" flag
+\ b19 "<>)" flag
+\ b23:20 Number bank index
+\ b31:24 zeroes
?f<< /asm/i386.fs
?f<< /xcomp/tools.fs
@@ -43,6 +57,7 @@ $80000 const PSTOP
PSTOP STACKSZ - const HEREMAX
$100 const HAL8B
$20000 const HAL16B
+$8000 const HALIMM
$10000 const HALDEREF
: _ dx lblhere m) mov, dx 0 d) swap mov, ;
@@ -129,6 +144,11 @@ xcode m) ( a -- operand )
ax $105 i) mov,
ret,
+xcode i) ( n -- operand )
+ lblhbank m) ax mov,
+ ax HALIMM i) mov,
+ ret,
+
pc to L1 xdrop, ret,
xcode +) ( operand n -- operand )
ax ax test, L1 abs>rel jz,
@@ -186,9 +206,6 @@ xcode ps+, ( n -- ) \ si XX i) add,
cx $1c6 ( si ) i) mov, L1 abscall,
xdrop, ret,
-xcode LIT>W, ( n -- ) \ ax XX i) mov,
- $b8 i) cwrite, ax dwrite, xdrop, ret,
-
xcode W+n, ( n -- ) \ ax XX i) add, OR ax inc,/dec,
ax 1 i) cmp, forward8 jnz, $40 i) cwrite, xdrop, ret, forward!
ax -1 i) cmp, forward8 jnz, $48 i) cwrite, xdrop, ret, forward!
@@ -203,15 +220,15 @@ pc to lblderef ( opmod -- opmod )
ax $c0 i) or, forward!
ret,
-pc to L3 \ ax=opmod disp32
+pc to L3 ( operand -- ) \ disp32
ax lblhbank m) mov,
ax dwrite,
xdrop, ret,
-pc to L2 \ ax=opmod disp8
+pc to L2 ( operand -- ) \ disp8
ax lblhbank m) mov,
al cwrite,
xdrop, ret,
-pc to L1 \ ax=opmod
+pc to L1 ( operand -- )
lblderef abscall,
ax HAL16B i) test, forward8 jz, $66 i) cwrite, forward! \ 16b?
al ah xchg,
@@ -227,11 +244,18 @@ pc to L1 \ ax=opmod
xcode !, ( operand -- ) \ operand ax mov,
ax $8800 i) or, L1 absjmp,
-pc to L2 \ 16b or 8b
+pc to L3 ( operand -- ) \ immediate
+ al $b8 i) or,
+ al cwrite,
+ ax lblhbank m) mov,
+ ax dwrite,
+ xdrop, ret,
+pc to L2 ( operand -- ) \ 16b or 8b
ax HAL16B ^ i) and,
$0f i) cwrite,
ax $b600 i) or, L1 absjmp,
xcode @, ( operand -- ) \ ax operand mov,
+ ax HALIMM i) test, L3 abs>rel jnz,
ax HAL16B i) test, L2 abs>rel jnz,
ax HAL8B i) test, L2 abs>rel jz,
ax $8a00 i) or, L1 absjmp,
@@ -282,7 +306,8 @@ xcode dup,
xcode litn
wcall, dup,
- wjmp, LIT>W,
+ $b8 i) cwrite, ax dwrite, \ ax XX i) mov,
+ xdrop, ret,
pc 3 nc, $5f $ff $d7 \ di pop, di call,
xcode yield ximm
diff --git a/posix/vm.c b/posix/vm.c
@@ -191,7 +191,7 @@ 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 wlitwr(dword n) { wfetchwr(hbankset(OPHASDISP|OPMEM|OPDEREF, 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); }
@@ -264,7 +264,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 WADDN() { vm.W += gpc(); vm.Z = vm.W == 0;}
static void readop() {
@@ -901,7 +900,7 @@ static void DRVWR() {
#define OPCNT 0x70
static void (*ops[OPCNT])() = {
BR, CALL, RET, BRWR, BRA, BRC, NULL, YIELD,
- PSADD, RSADD, WLIT, NULL, WADDN, NULL, NULL, NULL,
+ PSADD, RSADD, NULL, NULL, WADDN, NULL, NULL, NULL,
WFETCH, NULL, WSWAP, ADDN, WCMP, WIFETCHINC, WISTOREINC, WLEA,
WFETCH16, NULL, WSWAP16, ADDN16, WCMP16, WIFETCHINC16, WISTOREINC16, WLEA,
WFETCH8, NULL, WSWAP8, ADDN8, WCMP8, WIFETCHINC8, WISTOREINC8, WLEA,
@@ -992,7 +991,6 @@ static void buildsysdict() {
entry("pushret,"); retwr();
entry("popret,"); retwr();
entry("ps+,"); compileop(0x08); writewr(); retwr();
- entry("LIT>W,"); compileop(0x0a); writewr(); retwr();
entry("W+n,"); compileop(0x0c); writewr(); retwr();
entry("@,"); compopwr(0x10); retwr();
entry("@!,"); compopwr(0x12); retwr();
@@ -1043,7 +1041,8 @@ static void buildsysdict() {
entry("dup,");
litwr(0xfffffffc); callwr(find("ps+,"));
callwr(find("PSP)")); callwr(find("!,")); retwr();
- entry("litn"); callwr(find("dup,")); callwr(find("LIT>W,")); retwr();
+ entry("litn");
+ callwr(find("dup,")); callwr(find("i)")); callwr(find("@,")); retwr();
sysalias("in<", "boot<");
sysalias("rtype", "byefail");
sysalias("abort", "byefail");
