commit 138472d8e9315f1ed16b1ac316c2599c2f29d578
parent b413f3bdce0f4c2cf1db9ac5ea7ff1400b544ebe
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 28 Jun 2023 09:44:03 -0400
arm: straigten out sysvars
Things were messed up with sysvars in the ARM kernel. My first "PC-relative
address compilation" approach was flaky because code written this way had to be
close to the address itself. As the code grew and strained that limit, it broke
in random ways (if the address happens to be well-aligned, the refering code
can be further, but it breaks randomly as code changes afterwards).
Flakiness limits was reached, I had to straigten this out. See comment added
in kernel code.
Diffstat:
1 file changed, 78 insertions(+), 69 deletions(-)
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -26,7 +26,6 @@
rot mov) over rd) rot imm) ,) ( n1 r )
add) swap rdn) swap imm) ,) ;
-: 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) ;
@@ -34,21 +33,57 @@
: setrn0) ( -- operand ) bic) $f0000 imm) ;
: values ( n -- ) for 0 value next ;
-21 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblcompiling!
- lblbootptr lblhbank lblmod lbl[rcnt] lblnextword
- lblimmsplit lbladdnwr lbllitwr lblmemwr
+10 values lblimmsplit lbladdnwr lbllitwr lblmemwr
lblcwrite lbldwrite lblmoverange lblwriterange
lblerrmsg lblmain
$8000 to binstart
binstart const RSTOP
RSTOP $1000 - const PSTOP
-$20000 const HERESTART
+$04 const COMPILING
+$08 const HERE
+$0c const SYSDICT \ our length field lands at COMPILING MSB, which is always 0
+$10 const HBANK
+$14 const RCNT
+$18 const NEXTMETA
+$1c const MOD
+$20 const NEXTWORD
+$24 const BOOTPTR
+$28 const HEREMAX
+\ 24b unused
+$40 const CURWORD
+$10000 const HERESTART
$e4009000 const HALBASE \ Always, 32-bit, Rd=rTOP
+\ 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
+\ base+offset place. However, to facilitate initialization, we also want them to
+\ be pre-initialized in the binary, at compile time. For this reason, we place
+\ sysvars directly at the beginning of the binary, right after the initial
+\ forward jump.
here# to org
forward b) ,) \ coldboot
+0 le, \ COMPILING
+HERESTART le, \ HERE
+0 le, \ SYSDICT
+0 le, \ HBANK
+0 le, \ RCNT
+0 le, \ NEXTMETA
+0 le, \ MOD
+0 le, \ NEXTWORD
+0 le, \ BOOTPTR
+$10000000 le, \ HEREMAX
+$18 allot0 \ unused
+$20 allot0 \ CURWORD
+binstart HERE + xconst HERE
+binstart SYSDICT + xconst sysdict
+binstart HBANK + xconst HBANK
+binstart RCNT + xconst [rcnt]
+binstart NEXTMETA + xconst nextmeta
+binstart MOD + xconst MOD
+binstart NEXTWORD + xconst NEXTWORD
+binstart HEREMAX + xconst HEREMAX
+binstart CURWORD + xconst curword
HERESTART xconst herestart
-pc $10000000 le, xaddr HEREMAX
PSTOP xconst PSTOP
RSTOP xconst RSTOP
12 xconst DOESSZ
@@ -135,24 +170,20 @@ xcode parse ( str -- n? f )
xcode rtype exit, \ placeholder
-pc to lblcompiling 0 le,
xcode compiling
- xdup, lblcompiling rTOP pc@>reg,
+ xdup, rTOP binstart COMPILING movi2,
+ ldr) rTOP rdn) ,)
exit,
-pc to lblmod 0 le,
-lblmod xaddr MOD
-
xcode [ ximm
mov) r0 rd) 0 imm) ,)
-pc to lblcompiling!
- lblcompiling r1 pc>reg,
+ r1 binstart COMPILING movi2,
str) r0 rd) r1 rn) ,)
exit,
-pc to L1 \ set lblmod to 0
+pc to L1 \ set MOD to 0
mov) r0 rd) 0 imm) ,)
- lblmod r1 pc>reg,
+ r1 binstart MOD movi2,
str) r0 rd) r1 rn) ,)
exit,
xcode quit
@@ -189,7 +220,7 @@ pc to L2 \ r0=id rTOP=ll
L2 abs>rel b) ,)
xcode findmod ( w -- w )
- lblmod r0 pc@>reg,
+ r0 binstart MOD movi2, ldr) r0 rdn) ,)
cmp) r0 rn) 0 imm) ,)
return) z) ,) \ no mod
mov) r6 rd) rTOP rm) ,) \ save w
@@ -208,9 +239,8 @@ pc to lblerrmsg \ r0=sa r1=sl
wcall, rtype
wjmp, (abort)
-pc to lblbootptr 0 le,
xcode boot<
- lblbootptr r0 pc>reg,
+ r0 binstart BOOTPTR movi2,
ldr) r1 rd) r0 rn) ,)
xdup, ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
str) r1 rd) r0 rn) ,)
@@ -218,12 +248,6 @@ xcode boot<
xcode in< wjmp, boot<
-pc to lblcurword $20 allot0
-lblcurword xaddr curword
-
-pc to lblnextword 0 le,
-lblnextword xaddr NEXTWORD
-
pc to lblmoverange \ r0=src r1=len r2=dst. out: r0=src+len r2=dst+len Saves r3
ldr) r4 rd) r0 rn) 8b) 1 +i) post) ,)
str) r4 rd) r2 rn) 8b) 1 +i) post) ,)
@@ -232,12 +256,12 @@ pc to lblmoverange \ r0=src r1=len r2=dst. out: r0=src+len r2=dst+len Saves r3
exit,
pc \ we have a nonzero lblnextword. r0=src
- lblnextword r1 pc>reg,
+ r1 binstart NEXTWORD movi2,
mov) r2 rd) 0 imm) ,)
str) r2 rd) r1 rn) ,)
ldr) r1 rd) r0 rn) 8b) ,) \ len
add) r1 rdn) 1 imm) ,)
- lblcurword r2 pc>reg, \ dst
+ r2 binstart CURWORD movi2, \ dst
mov) rTOP rd) r2 rm) ,)
lblmoverange abs>rel b) ,)
@@ -247,7 +271,7 @@ pc to L1 \ EOF
xcode maybeword ( -- str-or-0 )
xdup,
- lblnextword r0 pc@>reg,
+ r0 binstart NEXTWORD movi2, ldr) r0 rdn) ,)
cmp) r0 rn) 0 imm) ,)
( pc ) abs>rel b) ne) ,)
pushret,
@@ -259,7 +283,7 @@ xcode maybeword ( -- str-or-0 )
cmp) rTOP rn) SPC imm) ,)
( pc ) abs>rel b) le) ,) \ rTOP=first non-ws
mov) r6 rd) 0 imm) ,)
- lblcurword r5 pc>reg,
+ r5 binstart CURWORD movi2,
pc
add) r6 rdn) 1 imm) ,)
str) rTOP rd) r5 rn) 8b) 1 +i) pre) !) ,)
@@ -267,7 +291,7 @@ xcode maybeword ( -- str-or-0 )
xnip,
cmp) rTOP rn) SPC imm) ,)
( pc ) abs>rel b) gt) ,)
- lblcurword rTOP pc>reg,
+ rTOP binstart CURWORD movi2,
str) r6 rd) rTOP rn) 8b) ,)
popret, exit,
@@ -282,7 +306,7 @@ xcode word
pc ," word not found" alignhere
xcode (wnf)
- lblcurword r0 pc>reg,
+ r0 binstart CURWORD movi2,
ldr) rTOP rd) r0 rn) 8b) 1 +i) post) ,)
r0 ppush,
wcall, rtype
@@ -295,9 +319,6 @@ xcode execute ( a -- )
xdrop,
r0 bx) ,)
-8 allot0 pc to lblsysdict 0 le,
-lblsysdict xaddr sysdict
-
xcode find ( name 'dict -- w-or-0 )
r2 ppop,
ldr) r1 rd) r2 rn) 8b) 1 +i) post) ,) \ r2=a r1=len
@@ -328,45 +349,35 @@ L2 forward! L1 forward! \ not matching, try next
\ not found
exit,
-pc to lblhere HERESTART le,
-lblhere xaddr HERE
-
pc to lblcwrite \ r0=char
- lblhere r2 pc>reg,
+ r2 binstart HERE movi2,
ldr) r1 rd) r2 rn) ,)
str) r0 rd) r1 rn) 8b) 1 +i) post) ,)
str) r1 rd) r2 rn) ,)
exit,
pc to lbldwrite \ r0=n. Destroys r1 and r2, preserves rest and flags
- lblhere r2 pc>reg,
+ r2 binstart HERE movi2,
ldr) r1 rd) r2 rn) ,)
str) r0 rd) r1 rn) 4 +i) post) ,)
str) r1 rd) r2 rn) ,)
exit,
pc to lblwriterange \ r0=addr r1=len
- lblhere r3 pc>reg,
+ r3 binstart HERE movi2,
ldr) r2 rd) r3 rn) ,)
pushret, lblmoverange abs>rel bl) ,) popret,
str) r2 rd) r3 rn) ,)
exit,
-
-pc to lblnextmeta 0 le,
-lblnextmeta xaddr nextmeta
-
-pc to lbl[rcnt] 0 le,
-lbl[rcnt] xaddr [rcnt]
-
xcode entry pushret, ( 'dict s -- )
- lbl[rcnt] r0 pc>reg,
+ r0 binstart RCNT movi2,
mov) r1 rd) 0 imm) ,)
str) r1 rd) r0 rn) ,)
mov) r6 rd) rTOP rm) ,)
ldr) r5 rd) r6 rn) 8b) 1 +i) post) ,) \ r5=a r6=len
add) rTOP rd) r5 rn) 1 imm) ,) \ rTOP=len+1
- lblhere r0 pc>reg,
+ r0 binstart HERE movi2,
ldr) r1 rd) r0 rn) ,)
add) r2 rd) r1 rn) rTOP rm) ,)
and) r2 rdn) 3 imm) f) ,)
@@ -379,11 +390,11 @@ xcode entry pushret, ( 'dict s -- )
lblwriterange execute,
mov) r0 rd) r5 rm) ,)
lblcwrite execute,
- lblnextmeta r0 pc>reg,
+ r0 binstart NEXTMETA movi2,
ldr) r0 rdn) ,)
lbldwrite execute,
ldr) r0 rd) rTOP rn) ,) \ r0=dict
- lblhere r1 pc@>reg,
+ r1 binstart HERE movi2, ldr) r1 rdn) ,)
str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
xdrop,
popret,
@@ -395,8 +406,8 @@ xcode code pushret,
popret, wjmp, entry
pc to L1 \ r3=meta-id
- lblsysdict r2 pc@>reg,
- lblhere r0 pc@>reg,
+ r2 binstart SYSDICT movi2, ldr) r2 rdn) ,)
+ r0 binstart HERE movi2, ldr) r0 rdn) ,)
sub) r2 rdn) 4 imm) ,)
swp) r0 rd) r2 rn) r0 rm) ,)
pushret, lbldwrite abs>rel bl) ,) popret,
@@ -422,19 +433,16 @@ HALBASE rSP rn) xconst RSP)
0 gt) xconst s>)
0 le) xconst s<=)
-pc to lblhbank 0 le,
-lblhbank xaddr HBANK
-
pc HALBASE $20 or le, \ b5 is set
xcode m) ( a -- operand )
- lblhbank r0 pc>reg,
+ r0 binstart HBANK movi2,
str) rTOP rd) r0 rn) ,)
( pc ) rTOP pc@>reg,
exit,
\ TODO: support negative offsets
xcode +) ( operand n -- operand )
- lblhbank r0 pc>reg,
+ r0 binstart HBANK movi2,
str) rTOP rd) r0 rn) ,)
xdrop,
orr) rTOP rdn) $10 imm) ,)
@@ -506,7 +514,7 @@ pc
xdrop, popret, exit,
xcode rs+, ( n -- )
- lbl[rcnt] r0 pc>reg,
+ r0 binstart RCNT movi2,
ldr) r1 rd) r0 rn) ,)
add) r1 rdn) rTOP rm) ,)
str) r1 rd) r0 rn) ,)
@@ -533,7 +541,7 @@ pc to lblmemwr ( operand -- operand ) \ preserves r0
tst) rTOP rn) $20 imm) ,)
return) z) ,) \ not a m) operand
r0 push,
- xdup, lblhbank rTOP pc@>reg,
+ xdup, rTOP binstart HBANK movi2, ldr) rTOP rdn) ,)
mov) r0 rd) r1 imm) ,)
pushret, lbllitwr abs>rel bl) ,) popret, ( operand )
setrn0) rTOP rdn) ,)
@@ -566,7 +574,7 @@ pc to L2 \ rTOP=operand
bic) rTOP rdn) $04000000 imm) ,) \ remove 32b flag
tst) rTOP rn) $10 imm) ,) \ has offset?
bic) rTOP rdn) $3f imm) ,)
- lblhbank r1 pc@>reg,
+ r1 binstart HBANK movi2, ldr) r1 rdn) ,)
orr) nz) rTOP rdn) r1 rm) ,)
L1 abs>rel b) ,)
@@ -576,7 +584,7 @@ pc to L3 ( operand -- ) \ r0=base instr
bic) r0 rdn) $04000000 imm) ,)
orr) r0 rdn) $00400000 imm) ,) \ immediate
tst) rTOP rn) $10 imm) ,) \ has offset?
- lblhbank r1 pc@>reg,
+ r1 binstart HBANK movi2, ldr) r1 rdn) ,)
bic) nz) rTOP rdn) $3f imm) ,) \ clear offset+imm flags
mov) nz) r2 rd) r1 rm) 4 lsl) ,) \ imm high nibble
and) nz) r1 rdn) $f imm) ,)
@@ -601,7 +609,7 @@ xcode !, ( operand -- )
pc add) 0 imm) ,)
xcode addr, ( operand -- )
- lblhbank r0 pc@>reg,
+ 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,
@@ -698,7 +706,7 @@ xcode exit,
( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
pc to L1 ( w -- ) \ r2=base instr
- lblhere r1 pc@>reg,
+ r1 binstart HERE movi2, ldr) r1 rdn) ,)
sub) r0 rd) rTOP rn) r1 rm) ,)
mov) r0 rd) r0 rm) 2 lsr) ,)
sub) r0 rdn) 2 imm) ,)
@@ -715,7 +723,7 @@ xcode branch, ( a -- a )
mov) r2 rd) $ea000000 imm) ,)
pc to L2 ( a -- a ) \ r2=base instr
pushret, L1 abs>rel bl) ,) popret,
- xdup, lblhere rTOP pc@>reg,
+ xdup, rTOP binstart HERE movi2, ldr) rTOP rdn) ,)
sub) rTOP rdn) 4 imm) ,)
exit,
@@ -923,8 +931,9 @@ xcode compword ( str -- )
xcode ]
pushret,
+ r1 binstart COMPILING movi2,
mov) r0 rd) 1 imm) ,)
- lblcompiling! abs>rel bl) ,)
+ str) r0 rd) r1 rn) ,)
pc
wcall, word
wcall, compword
@@ -934,9 +943,9 @@ pc
( pc ) abs>rel b) nz) ,)
popret, exit,
-pc lblcompiling le,
xcode runword ( str -- )
- ( pc ) r0 pc@>reg, ldr) r0 rdn) ,)
+ r0 binstart COMPILING movi2,
+ ldr) r0 rdn) ,)
cmp) r0 rn) 0 imm) ,)
xwordlbl compword abs>rel b) ne) ,)
pushret, wcall, parse popret,
@@ -946,11 +955,11 @@ xcode runword ( str -- )
pushret, L1 execute, popret,
L2 abs>rel b) ,)
-xcode main pc w>e lblsysdict pc>addr le!
+xcode main pc w>e org SYSDICT + le!
lblmain forward!
pc
wcall, word
wcall, runword
abs>rel b) ,)
-pc lblbootptr pc>addr le!
+pc org BOOTPTR + le!