commit a6638b867a5c796dc1487e4bf9fcedbf2a5646fe
parent dba76c5072a8724efce26b7b6cd68209ddc502c1
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 8 Jun 2023 08:51:12 -0400
rpi: add support for the m) operand to all instructions
Diffstat:
3 files changed, 80 insertions(+), 35 deletions(-)
diff --git a/fs/doc/hw/arm/arch.txt b/fs/doc/hw/arm/arch.txt
@@ -1,3 +1,17 @@
# ARM architecture
TODO
+
+## Register usage
+
+rSP = RSP
+r10 = PSP
+r9 = PS Top of Stack
+r8 = A register
+
+r0-r7 are generally free and used liberally across Dusk's ARM code. However, HAL
+generates code that uses r0 and r1 as temporary values. Those values are never
+used beyond the scope of a single HAL operation. Therefore, if you mix and match
+HAL and assembler, you don't have to preserve r0 and r1 in between HAL
+operations. However, you can consider that all HAL operations destroy these
+registers.
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -36,13 +36,14 @@ $18 const UART0_FR
: xaddr ( lbl -- ) xcode xdup, rTOP pc>reg, exit, ;
: xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, exit, ;
+: return) ( -- operand ) mov) rPC rd) rLR rm) ;
: setrd0) ( -- operand ) bic) $f000 i) ;
: setrn0) ( -- operand ) bic) $f0000 i) ;
: values ( n -- ) for 0 value next ;
-16 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
+18 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
lblhbank lblmod lbl[rcnt]
- lblimmsplit lblimmwr
+ lblimmsplit lbladdnwr lbllitwr lblmemwr
lblcwrite lbldwrite lblwriterange
lblerrmsg lblmain
$8000 to binstart
@@ -215,23 +216,23 @@ xcode findmeta ( id ll -- ll-or-0 ) \ preserves r6
r0 ppop,
pc to L2 \ r0=id rTOP=ll
cmp) rTOP rn) 0 i) ,)
- mov) z) rPC rd) rLR rm) ,) \ not found
+ return) z) ,) \ not found
ldr) r1 rd) rTOP rn) 4 +i) ,)
cmp) r0 rn) r1 rm) ,)
- mov) z) rPC rd) rLR rm) ,) \ found
+ return) z) ,) \ found
ldr) rTOP rdn) ,)
L2 abs>rel b) ,)
xcode findmod ( w -- w )
lblmod r0 pc@>reg,
cmp) r0 rn) 0 i) ,)
- mov) z) rPC rd) rLR rm) ,) \ no mod
+ return) z) ,) \ no mod
mov) r6 rd) rTOP rm) ,) \ save w
sub) rTOP rdn) 8 i) ,) \ rTOP=ll
pushret, L2 abs>rel bl) ,) popret,
cmp) rTOP rn) 0 i) ,)
mov) z) rTOP rd) r6 rm) ,) \ restore w if meta not found
- mov) z) rPC rd) rLR rm) ,) \ no mod
+ return) z) ,) \ no mod
pushret, L1 abs>rel bl) ,) popret,
add) rTOP rdn) 8 i) ,)
exit,
@@ -357,7 +358,7 @@ pc to lblcwrite \ r0=char
str) r1 rd) r2 rn) ,)
exit,
-pc to lbldwrite \ r0=n. Destroys r1 and r2, preserves rest
+pc to lbldwrite \ r0=n. Destroys r1 and r2, preserves rest and flags
lblhere r2 pc>reg,
ldr) r1 rd) r2 rn) ,)
str) r0 rd) r1 rn) 4 +i) post) ,)
@@ -481,7 +482,7 @@ xcode 32b) ( operand -- operand )
\ 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
+pc to L1 ( operand -- ) \ r0=base instr. Preserves r3
orr) r0 rdn) rTOP rm) ,)
xdrop,
lbldwrite abs>rel b) ,)
@@ -492,7 +493,7 @@ pc to lblimmsplit \ In: rTOP=n Out: rTOP=rotate+imm r1=rest of n. Z set if 0
mov) r1 rd) 0 i) ,)
pc
mov) r3 rd) rTOP rm) r2 rlsr) f) ,)
- mov) z) rPC rd) rLR rm) ,) \ rTOP is zero, nothing to do
+ return) z) ,) \ rTOP is zero, nothing to do
tst) r3 rn) 3 i) ,)
add) z) r2 rdn) 2 i) ,)
( pc ) abs>rel b) z) ,)
@@ -503,49 +504,68 @@ pc
orr) rTOP rd) r3 rn) r2 rm) 7 lsl) ,) \ rTOP=rotate+imm
exit,
-pc to lblimmwr ( n -- ) \ r0=base instr
+pc add) 0 i) ,)
+pc to lbladdnwr ( n -- ) \ r1=Rd/Rn
cmp) rTOP rn) 0 i) ,) \ if n=0, don't write anything
ldr) z) rTOP rd) rPSP rn) CELLSZ +i) post) ,)
- mov) z) rPC rd) rLR rm) ,)
+ return) z) ,)
+ ( pc ) r0 pc@>reg,
+ orr) r0 rdn) r1 rm) 12 lsl) ,)
+ orr) r0 rdn) r1 rm) 16 lsl) ,)
tst) rTOP rn) $80000000 i) ,)
eor) ne) r0 rdn) $00c00000 i) ,) \ add) to sub)
rsb) ne) rTOP rdn) 0 i) ,) \ negate rTOP
+ pushret,
pc
- r0 push, pushret, lblimmsplit abs>rel bl) ,)
- cmp) r1 rn) 0 i) ,)
- str) nz) rTOP rd) rPSP rn) CELLSZ -i) pre) !) ,)
- mov) nz) rTOP rd) r1 rm) ,)
- ( pc ) abs>rel bl) nz) ,) popret, r0 pop,
- L1 abs>rel b) ,)
+ lblimmsplit abs>rel bl) ,)
+ orr) r0 rdn) rTOP rm) ,)
+ lbldwrite abs>rel bl) ,) \ still have flags from immsplit
+ mov) rTOP rd) r1 rm) ,)
+ ( pc ) b) nz) ,)
+ xdrop, popret, exit,
-pc add) rSP rdn) 0 i) ,)
xcode rs+, ( n -- )
lbl[rcnt] r0 pc>reg,
ldr) r1 rd) r0 rn) ,)
add) r1 rdn) rTOP rm) ,)
str) r1 rd) r0 rn) ,)
- ( pc ) r0 pc@>reg, lblimmwr abs>rel b) ,)
+ mov) r1 rd) rSP i) ,) lbladdnwr abs>rel b) ,)
-pc add) rPSP rdn) 0 i) ,)
xcode ps+, ( n -- )
- ( pc ) r0 pc@>reg, lblimmwr abs>rel b) ,)
+ mov) r1 rd) rPSP i) ,) lbladdnwr abs>rel b) ,)
-pc add) rTOP rdn) 0 i) ,)
xcode W+n, ( n -- )
- ( pc ) r0 pc@>reg, lblimmwr abs>rel b) ,)
+ mov) r1 rd) rTOP i) ,) lbladdnwr abs>rel b) ,)
-pc add) rA rdn) 0 i) ,)
xcode A+n, ( n -- )
- ( pc ) r0 pc@>reg, lblimmwr abs>rel b) ,)
+ mov) r1 rd) rA i) ,) lbladdnwr abs>rel b) ,)
-pc mov) rTOP rd) 0 i) ,)
-xcode LIT>W, ( n -- )
- pushret,
+pc mov) 0 i) ,)
+pc to lbllitwr ( n -- ) \ r0=Rd
+ pushret, r0 push,
lblimmsplit abs>rel bl) ,)
r1 ppush, ( rest imm+rotate )
- ( pc ) r0 pc@>reg, L1 abs>rel bl) ,)
- popret,
- wjmp, W+n,
+ ( pc ) r3 pc@>reg,
+ orr) r0 rd) r3 rn) r0 rm) 12 lsl) ,) \ merge Rd in instr
+ L1 abs>rel bl) ,)
+ r1 pop, popret, \ r1=Rd
+ lbladdnwr abs>rel b) ,)
+
+pc to lblmemwr ( operand -- operand ) \ preserves r0
+ tst) rTOP rn) $10 i) ,)
+ return) z) ,) \ not a m) operand
+ r0 push,
+ xdup, lblhbank rTOP pc@>reg,
+ mov) r0 rd) r1 i) ,)
+ pushret, lbllitwr abs>rel bl) ,) popret, ( operand )
+ setrn0) rTOP rdn) ,)
+ orr) rTOP rdn) $10000 i) ,) \ Rn=r1
+ bic) rTOP rdn) $3f i) ,) \ clear offset+imm flags
+ r0 pop,
+ exit,
+
+xcode LIT>W, ( n -- )
+ mov) r0 rd) rTOP i) ,) lbllitwr abs>rel b) ,)
pc mov) rA rd) rTOP rm) ,)
xcode W>A, ( -- )
@@ -583,6 +603,7 @@ pc to L3 ( operand -- ) \ r0=base instr r1=off
L1 abs>rel b) ,)
pc to L4 ( operand -- ) \ r0=base instr
+ pushret, lblmemwr abs>rel bl) ,) popret,
tst) rTOP rn) $04000000 i) ,)
L3 abs>rel b) z) ,)
L2 abs>rel b) ,)
@@ -597,6 +618,10 @@ xcode !, ( operand -- )
pc add) 0 i) ,)
xcode addr, ( operand -- )
+ lblhbank r0 pc@>reg,
+ tst) rTOP rn) $10 i) ,)
+ mov) nz) rTOP rd) r0 rm) ,)
+ xwordlbl LIT>W, abs>rel b) nz) ,) \ m) operand? same as LIT>W,
( pc ) r0 pc@>reg, L2 abs>rel b) ,)
\ operand is 16b and ARM doesn't have a 16b SWP! LDR+STR+MOV...
@@ -611,6 +636,7 @@ pc to L2 ( operand -- )
pc swp) rTOP rd) rTOP rm) ,)
xcode @!, ( operand -- )
+ pushret, lblmemwr abs>rel bl) ,) popret,
tst) rTOP rn) $04000000 i) ,)
L2 abs>rel b) z) ,)
bic) rTOP rdn) $04000000 i) ,) \ remove 32b flag
@@ -624,6 +650,7 @@ xcode @!, ( operand -- )
L1 abs>rel b) ,)
pc to L1 ( operand -- )
+ pushret, lblmemwr abs>rel bl) ,) popret,
setrd0) rTOP rdn) ,)
wjmp, @,
@@ -639,17 +666,17 @@ xcode compare, ( operand -- )
( pc ) r0 pc@>reg,
lbldwrite abs>rel b) ,)
-pc add) r0 rdn) 0 i) ,)
xcode [+n], ( n operand -- )
pushret,
+ lblmemwr abs>rel bl) ,)
setrd0) rTOP rdn) ,)
xdup, wcall, @,
- ( pc ) r0 pc@>reg,
swp) rTOP rd) rPSP rn) rTOP rm) ,) ( operand n )
- lblimmwr abs>rel bl) ,)
+ mov) r1 rd) r0 i) ,) lbladdnwr abs>rel bl) ,)
popret, wjmp, !,
pc to L1 ( operand -- operand-rn=r0 )
+ pushret, lblmemwr abs>rel bl) ,) popret,
xdup, setrd0) rTOP rdn) ,)
pushret, wcall, 32b) wcall, @, popret,
setrn0) rTOP rdn) ,)
@@ -840,7 +867,7 @@ xcode runword ( str -- )
pushret, wcall, parse popret,
cmp) rTOP rn) 0 i) ,)
xdrop,
- mov) ne) rPC rd) rLR rm) ,) \ literal: nothing to do
+ return) ne) ,) \ literal: nothing to do
pushret, L1 execute, popret,
L2 abs>rel b) ,)
diff --git a/fs/xcomp/rpiboot.fs b/fs/xcomp/rpiboot.fs
@@ -177,6 +177,10 @@ _to to@+ @@+ _@@+,
_to to!+ @!+ _@!+,
: _addr, dup, addr, ; :16b dup, addr, ; :8b dup, addr, ;
_to to' noop _addr,
+: _toexec ( a -- ) compiling if m) then toptr@ execute ;
+: value doer , immediate does> _toexec ;
+: here HERE _toexec ; immediate
+: alias ' code branch, drop ;
: test ( n ) dup 1+ >r >r V1 emit V2 emit to1+ V2 V2 emit 2rdrop ;
: test2 doer , does> @ emit ;
