2 files changed, 38 insertions(+), 3 deletions(-)

M fs/xcomp/arm/rpi/kernel.fs
M fs/xcomp/rpiboot.fs

@@ 37,9 37,9 @@ $18 const UART0_FR
 : xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, exit, ;
 
 : values ( n -- ) for 0 value next ;
-15 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
-          lblhbank lblmod lblimmsplit
-          lblcwrite lbldwrite lblwriterange lblimmwr
+16 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
+          lblhbank lblmod lbl[rcnt]
+          lblimmsplit lblcwrite lbldwrite lblwriterange lblimmwr
           lblerrmsg lblmain
 $8000 to binstart
 binstart const RSTOP


@@ 52,6 52,8 @@ forward b) ,) \ coldboot
 HERESTART xconst herestart
 PSTOP xconst PSTOP
 RSTOP xconst RSTOP
+4 xconst CALLSZ
+4 xconst BRSZ
 
 xcode bye 0 b) ,)
 


@@ 382,7 384,13 @@ xcode align4 ( n -- )
 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,
+  mov) r1 rd) 0 i) ,)
+  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 i) ,) \ rTOP=len+1


@@ 506,6 514,10 @@ pc
 
 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) ,)
 
 pc add) rPSP rdn) 0 i) ,)

@@ 138,6 138,29 @@ code (cell) pushret, r> popret, exit,
 : const code litn exit, ;
 4 const CELLSZ
 
+\ execword param: addr
+\ compileword param: HAL operand
+create toptr 0 , \ pointer to 8b struct [execword, compileword]
+: _@, ( operand -- ) dup, @, ; :16b dup, 16b) @, ; :8b dup, 8b) @, ;
+create toptrdef ' @ , ' _@, ,
+: toptr@ ( -- w )
+  0 toptr @! ?dup not if toptrdef then
+  compiling if CELLSZ + then @ findmod ;
+: var, ( off -- ) RSP) swap [rcnt] @ neg CELLSZ - -^ +) toptr@ execute ;
+: V1 0 var, ; immediate : V2 4 var, ; immediate
+: V3 8 var, ; immediate : V4 12 var, ; immediate
+
+\ Compiling words
+create _ 0 ,
+code (does) pushret, r> W>A, W) @, W<>A, CELLSZ W+n, branchA,
+: doer code pushret, compile (does) HERE @ _ ! CELLSZ allot ;
+: does> r> ( exit current definition ) _ @ ! ;
+: does' ( w -- 'data ) CALLSZ + CELLSZ + ;
+
+: test ( n ) dup 1+ >r >r V1 emit V2 emit 2rdrop ;
+: test2 doer , does> @ emit ;
+
+
 \ For RPI model 1
 $20000000 const MMIO_BASE
 MMIO_BASE $200000 + const GPIO_BASE