duskos

commit d21b8837fae60ef631dc24c0c0856f6d5af1bbf6
parent 1172c52f4b40a606ce582601008d156a56e5f5d8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sat,  3 Jun 2023 12:10:58 -0400

rpi: add findmeta findmod

This brings us to , in bootlo, enabling all 8b and 16b mods.

Diffstat:
M
fs/xcomp/arm/rpi/kernel.fs
 | 
106
++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------
M
fs/xcomp/rpiboot.fs
 | 
2
++

2 files changed, 75 insertions(+), 33 deletions(-)
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -49,8 +49,9 @@ $44 const UART0_ICR
 : xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, exit, ;
 
 : values ( n -- ) for 0 value next ;
-13 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
-          lblhbank lblcwrite lbldwrite lblwriterange lblimmwr
+14 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling lblbootptr
+          lblhbank lblmod
+          lblcwrite lbldwrite lblwriterange lblimmwr
           lblerrmsg lblmain
 $8000 to binstart
 binstart const RSTOP
@@ -62,32 +63,6 @@ $e4009000 const HALBASE \ Always, 32-bit, Rd=rTOP
 forward b) ,) \ coldboot
 HERESTART xconst herestart
 
-pc to lblcompiling 0 le,
-xcode compiling
-  xdup, lblcompiling rTOP pc@>reg,
-  exit,
-
-xcode [ ximm
-  mov) r0 rd) 0 i) ,)
-pc
-  lblcompiling rTOP pc>reg,
-  str) r0 rd) rTOP rn) ,)
-  exit,
-
-xcode ]
-  mov) r0 rd) 1 i) ,)
-  ( pc ) abs>rel b) ,)
-
-xcode quit
-  mov) rSP rd) RSTOP i) ,)
-  wcall, [
-  forward b) ,) to lblmain
-
-xcode abort
-  ( coldboot ) forward!
-  mov) rPSP rd) PSTOP i) ,)
-  wjmp, quit
-
 xcode bye 0 b) ,)
 
 pc to L1 \ fail
@@ -201,6 +176,66 @@ xcode stype ( str -- )
   xdup, mov) rTOP rd) r0 rm) ,)
   wjmp, rtype
 
+pc to lblcompiling 0 le,
+xcode compiling
+  xdup, lblcompiling rTOP pc@>reg,
+  exit,
+
+pc to lblmod 0 le,
+lblmod xaddr MOD
+
+xcode [ ximm
+  mov) r0 rd) 0 i) ,)
+pc
+  lblcompiling r1 pc>reg,
+  str) r0 rd) r1 rn) ,)
+  exit,
+
+xcode ]
+  mov) r0 rd) 1 i) ,)
+  ( pc ) abs>rel b) ,)
+
+pc to L1 \ set lblmod to 0
+  mov) r0 rd) 0 i) ,)
+  lblmod r1 pc>reg,
+  str) r0 rd) r1 rn) ,)
+  exit,
+xcode quit
+  mov) rSP rd) RSTOP i) ,)
+  L1 abs>rel bl) ,)
+  wcall, [
+  forward b) ,) to lblmain \ never returns
+
+xcode abort
+  ( coldboot ) forward!
+  mov) rPSP rd) PSTOP i) ,)
+  wjmp, quit
+
+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
+  ldr) r1 rd) rTOP rn) 4 +i) ,)
+  cmp) r0 rn) r1 rm) ,)
+  mov) z) rPC rd) rLR rm) ,) \ 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
+  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
+  pushret, L1 abs>rel bl) ,) popret,
+  add) rTOP rdn) 8 i) ,)
+  exit,
+
 pc to lblerrmsg \ r0=sa r1=sl
   r0 ppush,
   mov) rTOP rd) r1 rm) ,)
@@ -619,7 +654,7 @@ xcode ; ximm pushret,
   wcall, exit,
   popret, wjmp, [
 
-pc to L2 pushret, ( str -- w ) \ find in sys dict
+pc to L1 pushret, ( str -- w ) \ find in sys dict
   wcall, curword
   wcall, sysdict
   wcall, find
@@ -627,16 +662,21 @@ pc to L2 pushret, ( str -- w ) \ find in sys dict
   xwordlbl (wnf) abs>rel b) eq) ,)
   popret, exit,
 
+pc to L2 ( w -- ) \ findmod+execute
+  pushret, wcall, findmod popret,
+  wjmp, execute
+
 xcode compword ( str -- )
   pushret, wcall, parse popret,
   cmp) rTOP rn) 0 i) ,)
   xdrop,
   xwordlbl litn abs>rel b) ne) ,) \ literal: jump to litn
-  pushret, L2 execute, popret,
+  pushret, L1 execute, popret,
   ldr) r0 rd) rTOP rn) 8b) 9 -i) ,)
   tst) r0 rn) $80 i) ,)
-  xwordlbl execute abs>rel b) ne) ,) \ immediate? execute
+  L2 abs>rel b) ne) ,) \ immediate? execute
   \ compile word
+  pushret, wcall, findmod popret,
   wjmp, execute,
 
 pc lblcompiling le,
@@ -648,8 +688,8 @@ xcode runword ( str -- )
   cmp) rTOP rn) 0 i) ,)
   xdrop,
   mov) ne) rPC rd) rLR rm) ,) \ literal: nothing to do
-  pushret, L2 execute, popret,
-  wjmp, execute
+  pushret, L1 execute, popret,
+  L2 abs>rel b) ,)
 
 xcode uartinit
   r6 MMIO_BASE GPIO_BASE movi2, \ r6 = GPIO_BASE
diff --git a/fs/xcomp/rpiboot.fs b/fs/xcomp/rpiboot.fs
@@ -68,5 +68,7 @@ code 1- -1 W+n, exit,
 : :8b code8b ] ;
 : :16b code16b ] ;
 
+: , HERE @!+ ; :16b HERE 16b @!+ ; :8b HERE 8b @!+ ; : c, 8b , ;
+
 uartinit prompt interactive!