commit 98347638ca28601f9f27cd378dcde700a247f88f
parent 138472d8e9315f1ed16b1ac316c2599c2f29d578
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 28 Jun 2023 16:32:10 -0400
hal: towards a unified HAL
Low HAL and High HAL is messy. Sure, it allows us to make the kernel slimmer
and leverage assembler mechanisms, but it also has a cost in terms of code
architecture.
Screw that, the whole HAL will be implemented in kernels. It makes kernels
harder to write, but not by *that* much. Writing the Low HAL is already pretty
hard, you might as well go the whole way.
This commit begins the process by moving &) to kernel, but not the whole
shebang, only enough to have bootlo working.
Diffstat:
9 files changed, 179 insertions(+), 109 deletions(-)
diff --git a/fs/asm/arm.fs b/fs/asm/arm.fs
@@ -88,20 +88,3 @@ $90 al) const mul)
: ppush, ( r -- ) str) swap rd) rPSP rn) CELLSZ -i) pre) !) ,) ;
: ppop, ( r -- ) ldr) swap rd) rPSP rn) CELLSZ +i) post) ,) ;
-\ HAL
-
-\ "opcode+mod" structure (close to ARM structure)
-\ b3:0 Number bank index
-\ b4 Has an nonzero offset
-\ b5 Rn is an absolute memory addr in bank if set
-\ b11:6 Zeroes
-\ b15:12 Rd
-\ b19:16 Rn
-\ b21:20 Zeroes
-\ b22 8-bit if set
-\ b23 Inverted destination <>)
-\ b24 Dereferenced source &)
-\ b25 Immediate if set
-\ b26 32-bit if set, 16-bit if unset
-\ b27 Zero
-\ b31:28 Cond
diff --git a/fs/comp/c/fgen.fs b/fs/comp/c/fgen.fs
@@ -77,15 +77,15 @@ alias noop parseStatement ( tok -- ) \ forward declaration
read; r> resolvebreaks ;
code _lookup ( nref lookup -- )
- W>A, A) @,
+ A) &) !, A) @,
-8 rs+, RSP) 4 +) !, 0 LIT>W, 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) @,
PSP) compare, NZ) branchC, drop \ Z=match
\ we have a match, add totcnt*CELLSZ to A, dereference. that's our target.
- RSP) 4 +) @, 2 i) <<, RSP) !, W<>A, RSP) +, W) @, \ W=target
- 12 rs+, W>A, nip, branchA,
+ RSP) 4 +) @, 2 i) <<, RSP) !, A) &) @!, RSP) +, W) @, \ W=target
+ 12 rs+, A) &) !, nip, branchA,
\ Switch works by constructing a lookup table of all the cases and generating
\ all statements one after the other. Whenever there's a "case", we associate it
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -103,7 +103,7 @@ operand (see below) can we refer directly to a value in a register.
### &) operand modifier
-The &) word takes an input operand and returns its reference counterpart. For
+The &) word takes an input operand and returns its dereferenced counterpart. For
example, m) becomes i), W) becomes a direct reference to W, etc. This also works
with displacements. For example, "RSP) 4 +) &)" yields an operand that points
to RSP+4.
@@ -115,8 +115,7 @@ i386 would yield "bx sp 4 +) lea, ax bx add,".
The "&)" word never writes instructions directly, only operator words. The
"lea," above wouldn't be written when "&)" is called, but when "+," is.
-If the &) word is called with an operand that can't be referenced, this word has
-no effect. For example "i) &)" is the same as "i)".
+The &) operand can't be used with: 8b) 16b) i)
### <>) operand modifiers
@@ -223,6 +222,7 @@ PSP) -- op Indirect PSP register
RSP) -- op Indirect RSP register
m) addr -- op Absolute address
+) op disp -- op Apply displacement to op. Can be applied multiple times.
+&) op -- op Dereference operand (see above)
8b) op -- op Make op 8-bit
16b) op -- op Make op 16-bit
32b) op -- op Make op 32-bit (default)
@@ -280,8 +280,6 @@ 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>A, -- Copy W to A
-W<>A, -- Swap W and A
-W, -- W = -W
## High HAL
@@ -291,7 +289,6 @@ Operand words:
i) Immediate operand
A>) A register is the destination instead of W
<>) Direction of the operation is inverted (see above)
-&) Reference to operand (see above)
Instructions:
diff --git a/fs/lib/crc.fs b/fs/lib/crc.fs
@@ -4,7 +4,7 @@
code crc32 ( crc c -- crc )
PSP) ^,
8 i) A>) @, PSP) A>) !, begin \ counter in PSP+0
- W>A, 1 i) >>,
+ A) &) !, 1 i) >>,
1 i) A>) &, 0 Z) branchC, $edb88320 i) ^, then
-1 PSP) +n, NZ) branchC, drop
nip, exit,
diff --git a/fs/tests/asm/hal.fs b/fs/tests/asm/hal.fs
@@ -112,7 +112,7 @@ here 42 , here swap , ( pc of *int )
code test12 ( -- n )
dup,
( pc ) LIT>W,
- W) @, W>A,
+ W) A>) @,
A) @,
1 W+n, \ result in W, not in memory location
A) +, \ 42+43, not 43+43
@@ -136,7 +136,7 @@ create myarray 1 , 2 , 3 , 0 ,
code test14 ( -- n )
dup, -4 rs+,
0 LIT>W, RSP) !, \ i=0
- myarray i) A>) &) @,
+ myarray i) A>) @,
begin
1 RSP) +n,
A) @,
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -1,6 +1,22 @@
?f<< /asm/arm.fs
?f<< /xcomp/tools.fs
+\ HAL opcode structure (close to ARM structure)
+\ b3:0 Number bank index
+\ b4 Has an nonzero offset
+\ b5 Rn is an absolute memory addr in bank if set
+\ b11:6 Zeroes
+\ b15:12 Rd
+\ b19:16 Rn
+\ b21:20 Zeroes
+\ b22 8-bit if set
+\ b23 Inverted destination <>)
+\ b24 Dereferenced source &)
+\ b25 Immediate if set
+\ b26 32-bit if set, 16-bit if unset
+\ b27 Zero
+\ b31:28 Cond
+
\ Macros
: xnip, add) rPSP rdn) CELLSZ imm) ,) ;
: xdrop, rTOP ppop, ;
@@ -33,7 +49,8 @@
: setrn0) ( -- operand ) bic) $f0000 imm) ;
: values ( n -- ) for 0 value next ;
-10 values lblimmsplit lbladdnwr lbllitwr lblmemwr
+15 values lblimmsplit lbladdnwr lbllitwr lblimmwr
+ lblrn>rm lblrdn lblrd<>rn lblmov lblswp
lblcwrite lbldwrite lblmoverange lblwriterange
lblerrmsg lblmain
$8000 to binstart
@@ -52,7 +69,11 @@ $28 const HEREMAX
\ 24b unused
$40 const CURWORD
$10000 const HERESTART
-$e4009000 const HALBASE \ Always, 32-bit, Rd=rTOP
+\ Basis for all operands. Always cond, 32-bit, Rd=rTOP
+$e4009000 const HALBASE
+\ Mask for HAL-related flags with no meaning in ARM instructions
+$07800000 const HALMASK
+$01000000 const HALDEREF
\ 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
@@ -433,6 +454,13 @@ HALBASE rSP rn) xconst RSP)
0 gt) xconst s>)
0 le) xconst s<=)
+pc HALBASE $10 or le, \ b4 is set
+xcode i) ( a -- operand )
+ r0 binstart HBANK movi2,
+ str) rTOP rd) r0 rn) ,)
+ ( pc ) rTOP pc@>reg,
+ exit,
+
pc HALBASE $20 or le, \ b5 is set
xcode m) ( a -- operand )
r0 binstart HBANK movi2,
@@ -461,12 +489,17 @@ xcode 32b) ( operand -- operand )
orr) rTOP rdn) $04000000 imm) ,)
exit,
+xcode &) ( operand -- operand )
+ orr) rTOP rdn) HALDEREF imm) ,)
+ exit,
+
\ HAL operations
\ r0 is used as the immediate accumulator
\ TODO: add out-of-range error for offsets not fitting 12 bits
\ merge operand with instr and write
pc to L1 ( operand -- ) \ r0=base instr. Preserves r3
+ bic) rTOP rdn) HALMASK imm) ,)
orr) r0 rdn) rTOP rm) ,)
xdrop,
lbldwrite abs>rel b) ,)
@@ -490,6 +523,7 @@ pc
orr) rTOP rd) r3 rn) r2 rm) 7 lsl) ,) \ rTOP=rotate+imm
exit,
+\ Compile a add) of immediate "n" with target register selected in r1
pc add) 0 imm) f) ,)
pc to lbladdnwr ( n -- ) \ r1=Rd/Rn
cmp) rTOP rn) 0 imm) ,) \ if n=0, don't write anything
@@ -526,6 +560,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"
pc mov) 0 imm) ,)
pc to lbllitwr ( n -- ) \ r0=Rd
pushret, r0 push,
@@ -537,7 +572,9 @@ pc to lbllitwr ( n -- ) \ r0=Rd
r1 pop, popret, \ r1=Rd
lbladdnwr abs>rel b) ,)
-pc to lblmemwr ( operand -- operand ) \ preserves r0
+\ Checks if operand is i) or m). If it is, compile a write of this value to r0
+\ and modify operand in consequence
+pc to lblimmwr ( operand -- operand ) \ preserves r0
tst) rTOP rn) $20 imm) ,)
return) z) ,) \ not a m) operand
r0 push,
@@ -550,28 +587,70 @@ pc to lblmemwr ( operand -- operand ) \ preserves r0
r0 pop,
exit,
+\ Move Rn to Rm in operand
+pc to lblrn>rm \ rTOP=operand
+ \ move Rn to Rm
+ bic) rTOP rdn) $3f imm) ,) \ clear offset+imm flags
+ mov) r0 rd) rTOP rm) 16 lsr) ,)
+ and) r0 rdn) $f imm) ,)
+ orr) rTOP rdn) r0 rm) ,)
+ bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
+ exit,
+
+\ Copy Rd to Rn in operand.
+pc to lblrdn \ rTOP=operand
+ bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
+ and) r0 rd) rTOP rn) $f000 imm) ,)
+ orr) rTOP rdn) r0 rm) 4 lsl) ,)
+ exit,
+
+\ Swap Rd and Rn in operand
+pc to lblrd<>rn \ rTOP=operand
+ and) r0 rd) rTOP rn) $f000 imm) ,)
+ and) r1 rd) rTOP rn) $f0000 imm) ,)
+ bic) rTOP rdn) $ff000 imm) ,)
+ orr) rTOP rdn) r0 rm) 4 lsl) ,)
+ orr) rTOP rdn) r1 rm) 4 lsr) ,)
+ exit,
+
+\ Write a mov) from operand's src to operand *dereferenced* dst. Offsets are
+\ ignored.
+pc mov) ,)
+pc to lblmov ( operand -- )
+ pushret, lblrn>rm abs>rel bl) ,) popret,
+ ( pc ) r0 pc@>reg,
+ L1 abs>rel b) ,)
+
+\ Write an eor between operand's src and dereferenced dst.
+pc eor) ,)
+pc to L2
+ pushret,
+ lblrn>rm abs>rel bl) ,)
+ lblrdn abs>rel bl) ,)
+ ( pc ) r0 pc@>reg,
+ popret,
+ L1 abs>rel b) ,)
+
+\ Write a swap between operand's src to operand *dereferenced* dst. Offsets are
+\ ignored. Registers only
+pc to lblswp ( operand -- )
+ pushret,
+ xdup, xdup,
+ L2 abs>rel bl) ,)
+ lblrd<>rn abs>rel bl) ,)
+ L2 abs>rel bl) ,)
+ popret,
+ L2 abs>rel b) ,)
+
xcode LIT>W, ( n -- )
mov) r0 rd) rTOP imm) ,) lbllitwr abs>rel b) ,)
-pc mov) rA rd) rTOP rm) ,)
-xcode W>A, ( -- )
- ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
-
pc rsb) rTOP rdn) 0 imm) ,)
xcode -W, ( -- )
( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
-pc eor) rTOP rdn) rA rm) ,)
- eor) rA rdn) rTOP rm) ,)
- eor) rTOP rdn) rA rm) ,)
-xcode W<>A, ( -- )
- ( pc ) r0 pc>reg,
- mov) r1 rd) 12 imm) ,)
- lblwriterange abs>rel b) ,)
-
\ conditionally merge hbank with operand, then with instr then write
-pc to L2 \ rTOP=operand
- bic) rTOP rdn) $04000000 imm) ,) \ remove 32b flag
+pc to L2 ( operand -- ) \ r0=instr
tst) rTOP rn) $10 imm) ,) \ has offset?
bic) rTOP rdn) $3f imm) ,)
r1 binstart HBANK movi2, ldr) r1 rdn) ,)
@@ -594,17 +673,22 @@ pc to L3 ( operand -- ) \ r0=base instr
L1 abs>rel b) ,)
pc to L4 ( operand -- ) \ r0=base instr
- pushret, lblmemwr abs>rel bl) ,) popret,
+ pushret, lblimmwr abs>rel bl) ,) popret,
tst) rTOP rn) $04000000 imm) ,)
L3 abs>rel b) z) ,)
L2 abs>rel b) ,)
pc ldr) 0 +i) ,)
xcode @, ( operand -- ) \ Compiled code preserves r0
+ tst) rTOP rn) HALDEREF imm) ,)
+ lblmov abs>rel b) nz) ,)
( pc ) r0 pc@>reg, L4 abs>rel b) ,)
pc str) 0 +i) ,)
xcode !, ( operand -- )
+ tst) rTOP rn) HALDEREF imm) ,)
+ pushret, lblrd<>rn abs>rel bl) nz) ,) popret,
+ lblmov abs>rel b) nz) ,)
( pc ) r0 pc@>reg, L4 abs>rel b) ,)
pc add) 0 imm) ,)
@@ -617,7 +701,7 @@ xcode addr, ( operand -- )
\ operand is 16b and ARM doesn't have a 16b SWP! LDR+STR+MOV...
pc mov) rTOP rd) r0 rm) ,)
-pc to L2 ( operand -- )
+pc to L3 ( operand -- )
pushret, xdup,
setrd0) rTOP rdn) ,)
wcall, @, wcall, !,
@@ -627,10 +711,11 @@ pc to L2 ( operand -- )
pc swp) rTOP rd) rTOP rm) ,)
xcode @!, ( operand -- )
- pushret, lblmemwr abs>rel bl) ,) popret,
+ pushret, lblimmwr abs>rel bl) ,) popret,
+ tst) rTOP rn) HALDEREF imm) ,)
+ lblswp abs>rel b) nz) ,)
tst) rTOP rn) $04000000 imm) ,)
- L2 abs>rel b) z) ,)
- bic) rTOP rdn) $04000000 imm) ,) \ remove 32b flag
+ L3 abs>rel b) z) ,)
tst) rTOP rn) $10 imm) ,) \ has offset?
forward b) z) ,)
xdup, setrd0) rTOP rdn) ,)
@@ -641,7 +726,7 @@ xcode @!, ( operand -- )
L1 abs>rel b) ,)
pc to L1 ( operand -- )
- pushret, lblmemwr abs>rel bl) ,) popret,
+ pushret, lblimmwr abs>rel bl) ,) popret,
setrd0) rTOP rdn) ,)
wjmp, @,
@@ -659,7 +744,7 @@ xcode compare, ( operand -- )
xcode +n, ( n operand -- )
pushret,
- lblmemwr abs>rel bl) ,)
+ lblimmwr abs>rel bl) ,)
setrd0) rTOP rdn) ,)
xdup, wcall, @,
swp) rTOP rd) rPSP rn) rTOP rm) ,) ( operand n )
@@ -668,7 +753,7 @@ xcode +n, ( n operand -- )
pc to L1 ( operand -- ) \ r0=base instr
pushret,
- lblmemwr abs>rel bl) ,)
+ lblimmwr abs>rel bl) ,)
xdup, setrd0) rTOP rdn) ,)
wcall, 32b) rTOP push, r0 push, wcall, @,
setrn0) rTOP rdn) ,)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -17,24 +17,24 @@ code8b HERE @ W) 8b) @, exit,
code c@ branch, drop
code w@ branch, drop
-code ! W>A, PSP) @, A) !, 2drop, exit,
-code16b HERE @ W>A, PSP) @, A) 16b) !, 2drop, exit,
-code8b HERE @ W>A, PSP) @, A) 8b) !, 2drop, exit,
+code ! A) &) !, PSP) @, A) !, 2drop, exit,
+code16b HERE @ A) &) !, PSP) @, A) 16b) !, 2drop, exit,
+code8b HERE @ A) &) !, PSP) @, A) 8b) !, 2drop, exit,
code c! branch, drop
code w! branch, drop
-code +! W>A, drop, A) +, A) !, drop, exit,
-code16b W>A, drop, A) 16b) +, A) 16b) !, drop, exit,
-code8b W>A, drop, A) 8b) +, A) 8b) !, drop, exit,
+code +! A) &) !, drop, A) +, A) !, drop, exit,
+code16b A) &) !, drop, A) 16b) +, A) 16b) !, drop, exit,
+code8b A) &) !, drop, A) 8b) +, A) 8b) !, drop, exit,
code 1+! 1 W) +n, drop, exit,
code16b 1 W) 16b) +n, drop, exit,
code8b 1 W) 8b) +n, drop, exit,
code 1-! -1 W) +n, drop, exit,
code16b -1 W) 16b) +n, drop, exit,
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 @! A) &) !, drop, A) @!, exit,
+code16b A) &) !, drop, A) 16b) @!, exit,
+code8b A) &) !, drop, A) 8b) @!, exit,
code @+ dup, PSP) [@+], exit,
code16b dup, PSP) 16b) [@+], exit,
code8b HERE @ dup, PSP) 8b) [@+], exit,
@@ -48,9 +48,9 @@ code c!+ branch, drop
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 @!+ A) &) !, drop, A) [!+], drop, exit,
+code16b A) &) !, drop, A) 16b) [!+], drop, exit,
+code8b A) &) !, drop, A) 8b) [!+], drop, exit,
code + PSP) +, nip, exit,
code - -W, PSP) +, nip, exit,
@@ -70,10 +70,10 @@ code 1- -1 W+n, exit,
: , HERE @!+ ; :16b HERE 16b @!+ ; :8b HERE 8b @!+ ; : c, 8b , ;
-code execute W>A, drop, branchA,
+code execute A) &) !, drop, branchA,
code not W=0>Z, Z) C>W, exit,
code bool W=0>Z, NZ) C>W, exit,
-: if W>A, drop, A=0>Z, 0 Z) branchC, ; immediate
+: if A) &) !, drop, A=0>Z, 0 Z) branchC, ; immediate
: ahead 0 branch, ; immediate
: then HERE @ swap branch! ; immediate
code ?dup W=0>Z, 0 Z) branchC, dup, then exit,
@@ -85,7 +85,7 @@ code ?dup W=0>Z, 0 Z) branchC, dup, then exit,
: else [compile] ahead HERE @ rot branch! ; immediate
: begin HERE @ ; immediate
: again branch, drop ; immediate
-: until W>A, drop, A=0>Z, Z) branchC, drop ; immediate
+: until A) &) !, drop, A=0>Z, Z) branchC, drop ; immediate
: _ code PSP) compare, C>W, nip, exit, ;
Z) _ = NZ) _ <> >) _ < <) _ > >=) _ <= <=) _ >=
@@ -152,7 +152,7 @@ create toptrdef ' @ , ' _@, ,
\ Compiling words
create _ 0 ,
-code (does) pushret, r> W>A, W) @, W<>A, CELLSZ W+n, branchA,
+code (does) pushret, r> A) &) !, W) @, A) &) @!, CELLSZ W+n, branchA,
: doer code pushret, compile (does) HERE @ _ ! CELLSZ allot ;
: does> r> ( exit current definition ) _ @ ! ;
: does' ( w -- 'data ) DOESSZ + ;
@@ -322,7 +322,7 @@ create _ 0 , EMETA_8B , EMETA_16B ,
: _svalue ( sz -- ) doer immediate _sfield
does> CELLSZ + @+ dip @ | ( a? sz off )
compiling if ( sz off )
- W>A, drop, A) swap +) swap
+ A) &) !, drop, A) swap +) swap
else ( a sz off ) rot + swap then ( a-or-operand sz )
_szmeta MOD ! toptr@ execute ;
: sfield CELLSZ _svalue ;
@@ -333,9 +333,9 @@ create _ 0 , EMETA_8B , EMETA_16B ,
: sconst doer CELLSZ _sfield
does> [ W) CELLSZ +) @, ] + @ ;
: smethod doer CELLSZ _sfield
- does> [ popret, W) CELLSZ +) @, PSP) +, W) @, W>A, drop, branchA,
+ does> [ popret, W) CELLSZ +) @, PSP) +, W) @, A) &) !, drop, branchA,
: ssmethod doer CELLSZ _sfield
- does> [ popret, W) CELLSZ +) @, PSP) +, W) @, W>A, 2drop, branchA,
+ does> [ popret, W) CELLSZ +) @, PSP) +, W) @, A) &) !, 2drop, branchA,
: nabort, ( n -- ) ['] abort swap for dup , next drop ;
\ 4b link to struct
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -1,7 +1,7 @@
\ This is the i386 Dusk kernel. It is called when the bootloader has finished
\ loading this binary as well as the Forth boot code following it in memory.
\ We're in protected mode and all segments have been initialized.
-\ ESP=RSP SI=PSP EBX=A EAX=W. They begin uninitialized.
+\ ESP=RSP ESI=PSP EBX=A EAX=W. They begin uninitialized.
\ HAL operand structure is the same as asm/i386 opmod structure.
\ Registers preserved/destroyed by words usually don't matter much: as an API,
\ we must assume that all registers are destroyed. However, some words within
@@ -29,16 +29,21 @@
\ Constants and labels
0 to realmode
: values ( n -- ) for 0 value next ;
-21 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
- lblsysdict lblparsec lblparseh lblparseud lblerrmsg lblhere lbl[rcnt]
- lblwriterange lblfind lblcompiling lblidt lblmod lblrelwr lblcallwr
- lblhbank
+22 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
+ lblsysdict lblhere lbl[rcnt] lblhbank lblmod
+ lblparsec lblparseh lblparseud lblerrmsg
+ lblfind lblcompiling lblidt
+ lblwriterange lblrelwr lblcallwr lblderef
+
$8000 const HERESTART
$500 to binstart
$2000 const STACKSZ
$7c00 const RSTOP
$80000 const PSTOP
PSTOP STACKSZ - const HEREMAX
+$100 const HAL8B
+$20000 const HAL16B
+$10000 const HALDEREF
: _ dx lblhere m) mov, dx 0 d) swap mov, ;
: cwrite, ( opmod -- ) _ lblhere m) inc, ; \ Destroys dx
@@ -132,13 +137,16 @@ xcode +) ( operand n -- operand )
ret,
xcode 8b) ( operand -- operand )
- ax $fffffeff i) and, ret,
+ ax HAL8B ^ i) and, ret,
xcode 16b) ( operand -- operand )
- ax $20000 i) or, ret,
+ ax HAL16B i) or, ret,
xcode 32b) ( operand -- operand )
- ax $100 i) or, ax $fffdffff i) and, ret,
+ ax HAL8B i) or, ax HAL16B ^ i) and, ret,
+
+xcode &) ( operand -- operand )
+ ax HALDEREF i) or, ret,
\ Write routines
xcode pushret, ret,
@@ -178,23 +186,22 @@ xcode ps+, ( n -- ) \ si XX i) add,
cx $1c6 ( si ) i) mov, L1 abscall,
xdrop, ret,
-pc to L1
- ax dwrite, xdrop,
- ret,
-
xcode LIT>W, ( n -- ) \ ax XX i) mov,
- $b8 i) cwrite, L1 absjmp,
+ $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!
- $05 i) cwrite, L1 absjmp,
-
-xcode W>A, ( n -- ) \ bx ax mov,
- $c389 i) wwrite, ret,
+ $05 i) cwrite, ax dwrite, xdrop, ret,
-xcode W<>A, ( n -- ) \ bx ax xchg,
- $93 i) cwrite, 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 )
+ ax HALDEREF i) test, forward8 jnz, ret, forward!
+ ax $c0 i) test, \ mod
+ forward8 jnz, \ mod=0, set to mod=3
+ ax $c0 i) or, forward!
+ ret,
pc to L3 \ ax=opmod disp32
ax lblhbank m) mov,
@@ -205,13 +212,15 @@ pc to L2 \ ax=opmod disp8
al cwrite,
xdrop, ret,
pc to L1 \ ax=opmod
- ax $20000 i) test, forward8 jz, $66 i) cwrite, forward! \ 16b?
+ lblderef abscall,
+ ax HAL16B i) test, forward8 jz, $66 i) cwrite, forward! \ 16b?
al ah xchg,
ax wwrite,
al ah xchg,
dx ax mov, dl $7 i) and, dl $4 i) cmp,
forward8 jnz, $24 i) cwrite, forward! \ sp? write SIB
- al $40 i) test, L2 abs>rel jnz, \ disp8
+ dl al mov, dl $c0 i) and, \ dl=mod
+ dl $40 i) cmp, L2 abs>rel jz, \ disp8
al $05 i) cmp, L3 abs>rel jz, \ m) means disp32
xdrop, ret,
@@ -219,12 +228,12 @@ xcode !, ( operand -- ) \ operand ax mov,
ax $8800 i) or, L1 absjmp,
pc to L2 \ 16b or 8b
- ax $fffdffff i) and,
+ ax HAL16B ^ i) and,
$0f i) cwrite,
ax $b600 i) or, L1 absjmp,
xcode @, ( operand -- ) \ ax operand mov,
- ax $20000 i) test, L2 abs>rel jnz,
- ax $100 i) test, L2 abs>rel jz,
+ ax HAL16B i) test, L2 abs>rel jnz,
+ ax HAL8B i) test, L2 abs>rel jz,
ax $8a00 i) or, L1 absjmp,
xcode @!, ( operand -- ) \ operand ax xchg,
@@ -249,8 +258,8 @@ xcode +n, ( n operand -- ) \ operand n i) add,
pc to L2 ( operand -- operand-with-di-src )
xdup,
di 4 i) mov,
- ax $20000 i) test, forward8 jz, di 2 i) mov, forward!
- ax $100 i) test, forward8 jnz, di 1 i) mov, forward!
+ ax HAL16B i) test, forward8 jz, di 2 i) mov, forward!
+ ax HAL8B i) test, forward8 jnz, di 1 i) mov, forward!
xgrow, si 0 d) di mov,
xdup, ( op n op )
al $38 i) or, \ target=di
diff --git a/posix/vm.c b/posix/vm.c
@@ -58,7 +58,7 @@ no assembler to complete the HAL to "full" level later. It's all in there.
#define OPRSP 3
#define OPMEM 4
#define OPHASDISP 0x08
-#define OPDIRECT 0x10
+#define OPDEREF 0x10
#define OPADEST 0x20
#define OPINVERT 0x40
#define OP16B 0x100
@@ -199,7 +199,7 @@ 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(); }
+static void storewr() { wstorewr(OPA|OPDEREF); dropwr(); wstorewr(OPA); dropwr(); }
static void callword(dword addr); // forward declaration
static void _entry(dword dict, byte *name, byte slen) {
@@ -266,8 +266,6 @@ 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 W2A() { vm.A = vm.W; }
-static void WSWAPA() { dword n = vm.A; vm.A = vm.W; vm.W = n; }
static void readop() {
byte op = gpcb();
@@ -289,11 +287,11 @@ static void readop() {
printf("Invalid HAL operand %x\n", op);
vmabort();
}
- if (!(op & OPDIRECT)) {
+ if (!(op & OPDEREF)) {
opsrc = (dword*)&vm.mem[*opsrc];
}
if ((op & OPHASDISP) && ((op & 0x7) != OPMEM)) {
- if (op & OPDIRECT) {
+ if (op & OPDEREF) {
vm.T = *opsrc + gpc(); opsrc = &vm.T;
} else { opsrc = (dword*)((byte*)opsrc + gpc()); }
}
@@ -903,7 +901,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, W2A, WSWAPA,
+ PSADD, RSADD, WLIT, 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,
@@ -996,8 +994,6 @@ static void buildsysdict() {
entry("ps+,"); compileop(0x08); writewr(); retwr();
entry("LIT>W,"); compileop(0x0a); writewr(); retwr();
entry("W+n,"); compileop(0x0c); writewr(); retwr();
- entry("W>A,"); compileop(0x0e); retwr();
- entry("W<>A,"); compileop(0x0f); retwr();
entry("@,"); compopwr(0x10); retwr();
entry("@!,"); compopwr(0x12); retwr();
// ( n ?disp operand -- )
@@ -1041,7 +1037,7 @@ static void buildsysdict() {
entry("32b)"); litwr((OP8B|OP16B)^0xffffffff); callwr(find("and")); retwr();
entry("A>)"); litwr(OPADEST); callwr(find("or")); retwr();
entry("<>)"); litwr(OPINVERT); callwr(find("xor")); retwr();
- entry("&)"); litwr(OPDIRECT); callwr(find("or")); retwr();
+ entry("&)"); litwr(OPDEREF); callwr(find("or")); retwr();
entry("i)"); callwr(find("m)")); callwr(find("&)")); retwr();
entry("!,"); callwr(find("<>)")); callwr(find("@,")); retwr();
entry("dup,");
