2 files changed, 53 insertions(+), 7 deletions(-)

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

@@ 313,7 313,7 @@ L2 forward! L1 forward! \ not matching, try next
   exit,
 
 pc to lblhere HERESTART le,
-lblhere xaddr here
+lblhere xaddr HERE
 
 pc to lblcwrite \ r0=char
   lblhere r2 pc>reg,


@@ 370,6 370,7 @@ xcode entry pushret, ( 'dict s -- )
   lblhere r1 pc>reg,
   ldr) r1 rdn) ,)
   str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
+  xdrop,
   popret,
   lbldwrite abs>rel b) ,)
 


@@ 378,6 379,18 @@ xcode code pushret,
   wcall, word
   popret, wjmp, entry
 
+pc to L1 \ r3=meta-id
+  lblsysdict r2 pc@>reg,
+  lblhere r0 pc@>reg,
+  sub) r2 rdn) 4 i) ,)
+  swp) r0 rd) r2 rn) r0 rm) ,)
+  pushret, lbldwrite abs>rel bl) ,) popret,
+  mov) r0 rd) r3 rm) ,)
+  lbldwrite abs>rel b) ,)
+
+xcode code16b mov) r3 rd) EMETA_16B i) ,) L1 abs>rel b) ,)
+xcode code8b mov) r3 rd) EMETA_8B i) ,) L1 abs>rel b) ,)
+
 \ HAL operands
 HALBASE rTOP rn) xconst W)
 HALBASE rA rn) xconst A)


@@ 443,20 456,35 @@ pc mov) rTOP rd) 0 i) ,)
 xcode LIT>W, ( n -- )
   ( pc ) r0 pc@>reg, L1 abs>rel b) ,)
 
-pc to L2 ( operand -- ) \ r0=base instr
+\ operand is 16b
+pc mov) r0 rd) 0 i) ,)
+pc to L2 ( operand -- ) \ r0=base instr r1=off
+  orr) r3 rd) r0 rn) $b0 i) ,) \ make into a ldrh/strh op
+  bic) r3 rdn) $04000000 i) ,)
+  ( pc ) r0 pc@>reg,
+  tst) rTOP rn) $8 i) ,) \ has offset?
+  mov) z) r1 rd) 0 i) ,) \ if not, force a 0
+  orr) r0 rdn) r1 rm) ,)
+  pushret, lbldwrite abs>rel bl) ,) popret, \ copy offset in r0
+  mov) r0 rd) r3 rm) ,)
+  L1 abs>rel b) ,)
+
+pc to L3 ( operand -- ) \ r0=base instr
   lblhbank r1 pc@>reg,
-  tst) rTOP rn) $8 i) ,)
+  tst) rTOP rn) $04000000 i) ,)
+  L2 abs>rel b) z) ,)
+  tst) rTOP rn) $8 i) ,) \ has offset?
   bic) rTOP rdn) $3f i) ,)
   orr) nz) rTOP rdn) r1 rm) ,)
   L1 abs>rel b) ,)
 
 pc ldr) rTOP rd) 0 +i) ,)
 xcode @, ( operand -- )
-  ( pc ) r0 pc@>reg, L2 abs>rel b) ,)
+  ( pc ) r0 pc@>reg, L3 abs>rel b) ,)
 
 pc str) rTOP rd) 0 +i) ,)
 xcode !, ( operand -- )
-  ( pc ) r0 pc@>reg, L2 abs>rel b) ,)
+  ( pc ) r0 pc@>reg, L3 abs>rel b) ,)
 
 pc swp) rTOP rd) rTOP rm) ,) add) r0 rd) rPSP rn) 0 i) ,)
 xcode @!, pushret, ( operand -- )


@@ 482,16 510,28 @@ pc exit,
 xcode exit,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
-xcode execute, ( w -- )
+pc to L1 ( w -- ) \ r2=base instr
   lblhere r1 pc@>reg,
   sub) r0 rd) rTOP rn) r1 rm) ,)
   mov) r0 rd) r0 rm) 2 lsr) ,)
   sub) r0 rdn) 2 i) ,)
   bic) r0 rn) $ff000000 i) ,)
-  orr) r0 rdn) $eb000000 i) ,)
+  orr) r0 rdn) r2 rm) ,)
   xdrop,
   lbldwrite abs>rel b) ,)
 
+xcode execute, ( w -- )
+  mov) r2 rd) $eb000000 i) ,)
+  L1 abs>rel b) ,)
+
+xcode branch, ( a -- a )
+  mov) r2 rd) $ea000000 i) ,)
+pc to L2 ( a -- a ) \ r2=base instr
+  pushret, L1 abs>rel bl) ,) popret,
+  xdup, lblhere rTOP pc@>reg,
+  sub) rTOP rdn) 4 i) ,)
+  exit,
+
 pc xdup,
 xcode dup,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)

@@ 10,5 10,11 @@ code rot> PSP) 4 +) @!, PSP) @!, exit,
 : over, dup, PSP) 4 +) @, ; code over over, exit,
 code tuck swap, over, exit,
 code 2dup -8 ps+, PSP) 4 +) !, PSP) 8 +) @, PSP) !, PSP) 4 +) @, exit,
+
+code @ W) @, exit,
+code16b HERE @ W) 16b) @, exit,
+code8b HERE @ W) 8b) @, exit,
+code c@ branch, drop
+code w@ branch, drop
 uartinit prompt interactive!