commit 68795838fccb3891f5d4f34aa9480aa1adf22f59
parent da0bcf59c9e610e904d456c3269e8411ce0fd734
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 29 Jun 2023 14:58:02 -0400
hal: re-add i) support to arithmetic ops
This lets us to remove W+n,
Diffstat:
6 files changed, 46 insertions(+), 30 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -40,7 +40,7 @@ unaryop _!, _ not
: _ ( eop incsz -- eop )
over ExprOp :*arisz *
- over ExprOp :isW? if W+n, else over ExprOp :hal# +n, then ;
+ over ExprOp :isW? if i) +, else over ExprOp :hal# +n, then ;
: _++, 1 _ ; : _--, -1 _ ;
UOPSCNT wordtbl uoptbl ( eop -- eop )
diff --git a/fs/tests/hal.fs b/fs/tests/hal.fs
@@ -21,7 +21,7 @@ code test3 ( -- n )
dup, -4 rs+,
2 i) @, RSP) !,
3 i) @, RSP) *,
- 1 W+n,
+ 1 i) +,
4 rs+, exit,
test3 7 #eq
@@ -29,7 +29,7 @@ test3 7 #eq
code test4 ( -- n ) \ 2 * 3 + 2
dup,
3 i) @,
- -1 W+n,
+ -1 i) +,
dup,
2 i) @,
dup,
@@ -113,7 +113,7 @@ code test12 ( -- n )
( pc ) i) @,
W) A>) @,
A) @,
- 1 W+n, \ result in W, not in memory location
+ 1 i) +, \ result in W, not in memory location
A) +, \ 42+43, not 43+43
exit,
test12 85 #eq
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -574,9 +574,6 @@ xcode rs+, ( n -- )
xcode ps+, ( n -- )
mov) r1 rd) rPSP imm) ,) lbladdnwr abs>rel b) ,)
-xcode W+n, ( n -- )
- mov) r1 rd) rTOP imm) ,) lbladdnwr abs>rel b) ,)
-
\ Compile code resulting in register Rd to contain "n"
pc mov) 0 imm) ,)
pc to lbllitwr ( n -- ) \ r0=Rd
@@ -748,6 +745,17 @@ xcode @!, ( operand -- )
( pc ) r0 pc@>reg,
lblopwr abs>rel b) ,)
+\ Write arithmetic operation with an immediate src
+pc to L3 ( operand -- ) \ r0=instr
+ r0 push,
+ xdup, ( op op )
+ setrd0) rTOP rdn) ,)
+ wcall, @, ( op ) \ imm in r0
+ r0 pop, \ r0=instr
+ setimm0) rTOP rdn) ,)
+ lblrdn abscall,
+ lblopwr abs>rel b) ,) ( )
+
\ Write inverted arithmetic operation, that is:
\ 1. Load operand's src in r0
\ 2. Apply instr with r0 as Rd and Rn and operand's dst as Rm.
@@ -775,6 +783,9 @@ pc to L2 ( operand -- ) \ r0=instr
pc to L1 ( operand -- ) \ r0=instr
tst) rTOP rn) HALINV imm) ,)
L2 abs>rel b) nz) ,)
+ \ TODO: avoid step by encoding imm) directly when possible
+ tst) rTOP rn) HALIMM imm) ,)
+ L3 abs>rel b) nz) ,)
r0 push,
lblimmwr abscall,
xdup, ( op op )
@@ -789,7 +800,7 @@ xcode +, ( operand -- )
mov) r0 rd) $00900000 imm) ,) ( add+s ) L1 abs>rel b) ,)
\ This can't join the arithmetic instr party because Rn has to stay zero.
-pc cmp) rTOP rn) ,) \ TODO: support A>)
+pc cmp) rTOP rn) ,) \ TODO: support A>) and <>)
xcode compare, ( operand -- )
lblimmwr abscall,
setrd0) rTOP rdn) ,)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -59,8 +59,8 @@ code - -W, PSP) +, nip, exit,
: e>wlen 5 - ;
: w>e 4 - ;
: current sysdict @ e>w ;
-code 1+ 1 W+n, exit,
-code 1- -1 W+n, exit,
+code 1+ 1 i) +, exit,
+code 1- -1 i) +, exit,
: immediate sysdict @ e>wlen dup c@ $80 or swap c! ;
: EMETA_16B $11 ; : EMETA_8B $10 ;
: 16b EMETA_16B MOD ! ; immediate
@@ -152,7 +152,7 @@ create toptrdef ' @ , ' _@, ,
\ Compiling words
create _ 0 ,
-code (does) pushret, r> W) A>) @, CELLSZ W+n, branchA,
+code (does) pushret, r> W) A>) @, CELLSZ i) +, branchA,
: doer code pushret, compile (does) HERE @ _ ! CELLSZ allot ;
: does> r> ( exit current definition ) _ @ ! ;
: does' ( w -- 'data ) DOESSZ + ;
@@ -191,8 +191,8 @@ alias @ llnext
: lladd ( ll -- newll ) here# swap llappend here 0 , ;
\ Entry metadata
-: &+ ( n -- ) code W+n, exit, ;
-: &+@ ( n -- ) code W+n, W) @, exit, ;
+: &+ ( n -- ) code i) +, exit, ;
+: &+@ ( n -- ) code i) +, W) @, exit, ;
-4 &+@ emeta
-4 &+ 'emeta
: metaadd ( id entry -- ) 'emeta lladd drop , ;
@@ -223,7 +223,7 @@ alias execute | immediate
: break 16 rs+, [compile] ahead to _breaklbl ; immediate
:iterator for ( n -- ) [
- 1 W+n, RSP) 4 +) !, drop, ahead
+ 1 i) +, RSP) 4 +) !, drop, ahead
begin yield swap then -1 RSP) 4 +) +n, NZ) branchC, drop
unyield popret, exit,
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -43,11 +43,11 @@
\ Constants and labels
0 to realmode
: values ( n -- ) for 0 value next ;
-22 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
+23 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
lblsysdict lblhere lbl[rcnt] lblhbank lblmod
lblparsec lblparseh lblparseud lblerrmsg
lblfind lblcompiling lblidt
- lblwriterange lblrelwr lblcallwr lblderef
+ lblwriterange lblrelwr lblcallwr lblderef lblariwr
$8000 const HERESTART
$500 to binstart
@@ -213,11 +213,6 @@ xcode ps+, ( n -- ) \ si XX i) add,
cx $1c6 ( si ) i) mov, L1 abscall,
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!
- $05 i) cwrite, ax dwrite, xdrop, ret,
-
\ If HALDEREF flag is set operate the necessary changes in opmod to dereference
\ it. If a lea, is necessary, write it.
pc to lblderef ( opmod -- opmod )
@@ -280,12 +275,6 @@ xcode @, ( operand -- ) \ ax operand mov,
xcode @!, ( operand -- ) \ operand ax xchg,
ax $8600 i) or, L1 absjmp,
-xcode +, ( operand -- ) \ ax operand add,
- ax $0200 i) or, L1 absjmp,
-
-xcode compare, ( operand -- ) \ ax operand cmp,
- ax $3a00 i) or, L1 absjmp,
-
xcode addr, ( operand -- ) \ ax operand lea,
ax $8d00 i) or, L1 absjmp,
@@ -316,6 +305,24 @@ xcode [@+], ( operand -- )
xcode [!+], ( operand -- )
L2 abscall, wjmp, !,
+\ Write arithmetic operand with specified opcodes, handling the imm/register
+\ complexity. opcodes are supplied as 2 bytes: b15:8 is the "not imm" opcode
+\ and b5:3 is the "/reg" argument to supply to the $81 immediate operation.
+pc to lblariwr ( operand -- ) \ dx=opcodes
+ ax HALIMM i) test, forward8 jnz, \ not an imm
+ dx $ff00 i) and, ax dx or, L1 absjmp, forward!
+ \ mod becomes 3, reg moves to rm and dx is orred into modrm
+ al 3 i) shr, al 7 i) and, al $c0 i) or, al dl or,
+ $81 i) cwrite, al cwrite,
+ ax lblhbank m) mov, ax dwrite,
+ xdrop, ret,
+
+xcode +, ( operand -- ) \ ax operand add,
+ dx $0200 i) mov, lblariwr absjmp,
+
+xcode compare, ( operand -- ) \ ax operand cmp,
+ dx $3a38 i) mov, lblariwr absjmp,
+
xcode dup,
-4 xlit, wcall, ps+,
wcall, PSP)
diff --git a/posix/vm.c b/posix/vm.c
@@ -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 WADDN() { vm.W += gpc(); vm.Z = vm.W == 0;}
static void readop() {
byte op = gpcb();
@@ -900,7 +899,7 @@ static void DRVWR() {
#define OPCNT 0x70
static void (*ops[OPCNT])() = {
BR, CALL, RET, BRWR, BRA, BRC, NULL, YIELD,
- PSADD, RSADD, NULL, NULL, WADDN, NULL, NULL, NULL,
+ PSADD, RSADD, NULL, NULL, NULL, 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,
@@ -991,7 +990,6 @@ static void buildsysdict() {
entry("pushret,"); retwr();
entry("popret,"); retwr();
entry("ps+,"); compileop(0x08); writewr(); retwr();
- entry("W+n,"); compileop(0x0c); writewr(); retwr();
entry("@,"); compopwr(0x10); retwr();
entry("@!,"); compopwr(0x12); retwr();
// ( n ?disp operand -- )
