duskos

kernel.fs (31266B) - raw

---

 ?f<< /asm/arm.fs
 ?f<< /xcomp/tools.fs
 
 \ HAL opcode structure (close to ARM structure)
 \ b3:0   Number bank index
 \ b4     Has an nonzero offset
 \ b5     Rn is an absolute memory addr in bank if set
 \ b11:6  Zeroes
 \ b15:12 Rd
 \ b19:16 Rn
 \ b21:20 Zeroes
 \ b22    8-bit if set
 \ b23    Inverted destination <>)
 \ b24    Dereferenced source &)
 \ b25    Immediate if set
 \ b26    32-bit if set, 16-bit if unset
 \ b27    Zero
 \ b31:28 Cond
 
 \ Macros
 : xnip, add) rPSP rdn) CELLSZ imm) ,) ;
 : xdrop, rTOP ppop, ;
 : xgrow, sub) rPSP rdn) CELLSZ imm) ,) ;
 : xdup, rTOP ppush, ;
 : pushret, rLR push, ;
 : popret, rLR pop, ;
 : ret, rLR bx) ,) ;
 : absb, abs>rel b) ,) ;
 : absbl, abs>rel bl) ,) ;
 : abscall, pushret, absbl, popret, ;
 : wcall, xwordlbl abscall, ;
 : wjmp, xwordlbl abs>rel b) ,) ; \ only for leaf words!
 
 : pc>reg, ( pc r -- )
   dip pc -^ 8 + | ( off r )
   mov) over rd) rPC rm) ,)
   sub) swap rdn) swap imm) ,) ;
 
 : pc@>reg, ( pc r -- )
   dip pc -^ 8 + | ( off r )
   ldr) swap rd) rPC rn) swap -i) ,) ;
 
 : movi2, ( r n1 n2 -- )
   rot mov) over rd) rot imm) ,) ( n1 r )
   add) swap rdn) swap imm) ,) ;
 
 : xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, ret, ;
 
 : return) ( -- operand ) mov) rPC rd) rLR rm) ;
 : setrd0) ( -- operand ) bic) $f000 imm) ;
 : setrn0) ( -- operand ) bic) $f0000 imm) ;
 : setimm0) ( -- operand ) bic) $3f imm) ;
 
 : values ( n -- ) for 0 value next ;
 16 values lblimmsplit lbladdnwr lbllitwr lblimmwr
           lblrn>rm lblrdn lblrd<>rn lblmov lblswp
           lblcwrite lbldwrite lblmoverange lblwriterange lblopwr
           lblerrmsg lblmain
 $8000 to binstart
 binstart const RSTOP
 RSTOP $1000 - const PSTOP
 $04 const COMPILING
 $08 const HERE
 $0c const SYSDICT \ our length field lands at COMPILING MSB, which is always 0
 $10 const HBANKIDX
 $14 const RCNT
 $18 const NEXTMETA
 $1c const MOD
 $20 const NEXTWORD
 $24 const BOOTPTR
 $28 const HEREMAX
 \ 24b unused
 $40 const CURWORD
 $60 const HBANK
 $10000 const HERESTART
 \ Basis for all operands. Always cond, 32-bit, Rd=rTOP
 $e4009000 const HALBASE
 \ Mask for HAL-related flags with no meaning in ARM instructions
 $07800000 const HALMASK
 $0000003f const HALBMASK
 $01000000 const HALDEREF
 $02000000 const HALIMM
 $00800000 const HALINV
 $00000010 const HALOFF
 $00000020 const HALMEM
 $04000000 const HAL16B
 $00400000 const HAL8B
 
 \ 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, \ HBANKIDX
 0 le, \ RCNT
 0 le, \ NEXTMETA
 0 le, \ MOD
 0 le, \ NEXTWORD
 0 le, \ BOOTPTR
 $10000000 le, \ HEREMAX
 $18 allot0 \ unused
 $20 allot0 \ CURWORD
 $40 allot0 \ HBANK
 binstart HERE + xconst HERE
 binstart SYSDICT + xconst sysdict
 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
 PSTOP xconst PSTOP
 RSTOP xconst RSTOP
 12 xconst DOESSZ
 4 xconst BRSZ
 
 xcode bye 0 b) ,)
 xcode dbg 0 b) ,)
 
 pc to L1 \ fail
   mov) rTOP rd) 0 imm) ,)
   ret,
 
 \ parse char
 pc to L2 \ rTOP=a-with-'-skipped r0=u
   cmp) r0 rn) 3 imm) ,)
   L1 abs>rel b) ne) ,)
   ldr) r0 rd) rTOP rn) ,)
   and) r1 rd) r0 rn) $ff00 imm) ,)
   cmp) r1 rn) $2700 imm) ,) \ ' char
   L1 abs>rel b) ne) ,)
   and) r0 rdn) $ff imm) ,)
   r0 ppush,
   mov) rTOP rd) 1 imm) ,)
   ret,
 
 \ parse hexadecimal
 pc to L3 \ rTOP=a-with-$-skipped r0=u
   cmp) r0 rn) 2 imm) ,)
   L1 abs>rel b) lo) ,)
   sub) r0 rdn) 1 imm) ,) \ skip $
   mov) r2 rd) 0 imm) ,) \ accumulated result
 pc \ loop
   ldr) r1 rd) rTOP rn) 8b) 1 +i) post) ,)
   orr) r1 rdn) $20 imm) ,)
   sub) r1 rdn) '0' imm) f) ,)
   L1 abs>rel b) lo) ,)
   cmp) r1 rn) 10 imm) ,)
   forward b) lo) ,) to L4 \ parse ok, under 10
   sub) r1 rdn) 'a' '0' - imm) f) ,)
   L1 abs>rel b) lo) ,)
   add) r1 rdn) 10 imm) ,)
   cmp) r1 rn) 16 imm) ,)
   L1 abs>rel b) hs) ,)
 L4 forward! \ parse ok
   add) r2 rd) r1 rn) r2 rm) 4 lsl) ,) \ r2 = r2*16 + r1
   sub) r0 rdn) 1 imm) f) ,)
   ( loop ) abs>rel b) nz) ,)
   r2 ppush,
   mov) rTOP rd) 1 imm) ,)
   ret,
 
 \ parse unsigned decimal
 pc to L4 \ rTOP=a+1 r1=first-char r0=u
   mov) r4 rd) r1 rm) ,) \ for '-' check
   cmp) r1 rn) '-' imm) ,)
   ldr) z) r1 rd) rTOP rn) 8b) 1 +i) post) ,)
   sub) z) r0 rdn) 1 imm) f) ,)
   L1 abs>rel b) z) ,) \ '-' only? can't parse
   mov) r2 rd) 0 imm) ,) \ accumulated result
   mov) r3 rd) 10 imm) ,) \ const for mul)
 pc \ loop
   sub) r1 rdn) '0' imm) f) ,)
   L1 abs>rel b) lo) ,)
   cmp) r1 rn) 10 imm) ,)
   L1 abs>rel b) hs) ,)
   mul) r2 rd) r3 rm) r2 rs) r1 acc) ,)
   ldr) r1 rd) rTOP rn) 8b) 1 +i) post) ,)
   sub) r0 rdn) 1 imm) f) ,)
   ( loop ) abs>rel b) nz) ,)
   cmp) r4 rn) '-' imm) ,)
   rsb) z) r2 rdn) 0 imm) ,) \ negate
   r2 ppush,
   mov) rTOP rd) 1 imm) ,)
   ret,
 
 xcode parse ( str -- n? f )
   ldr) r0 rd) rTOP rn) 8b) 1 +i) post) ,) \ rTOP=a r0=u
   ldr) r1 rd) rTOP rn) 8b) 1 +i) post) ,)
   cmp) r1 rn) ''' imm) ,)
   L2 abs>rel b) eq) ,)
   cmp) r1 rn) '$' imm) ,)
   L3 abs>rel b) eq) ,)
   mov) r2 rd) r1 rm) ,)
   L4 abs>rel b) ,)
 
 xcode rtype ret, \ placeholder
 
 xcode compiling
   xdup, rTOP binstart COMPILING movi2,
   ldr) rTOP rdn) ,)
   ret,
 
 xcode [ ximm
   mov) r0 rd) 0 imm) ,)
   r1 binstart COMPILING movi2,
   str) r0 rd) r1 rn) ,)
   ret,
 
 pc to L1 \ set MOD to 0
   mov) r0 rd) 0 imm) ,)
   r1 binstart MOD movi2,
   str) r0 rd) r1 rn) ,)
   ret,
 xcode quit
   mov) rSP rd) RSTOP imm) ,)
   L1 abs>rel bl) ,)
   wcall, [
   forward b) ,) to lblmain \ never returns
 
 xcode (abort)
   ( coldboot ) forward!
   mov) rPSP rd) PSTOP imm) ,)
   wjmp, quit
 
 \ During early boot, it's better to halt the machine than to go back to the
 \ mainloop because the mainloop likely sends us to an infinite error loop
 \ through boot<.
 pc ," boot failure"
 xcode abort
   ( pc ) r0 pc>reg,
   r0 ppush,
   mov) rTOP rd) 12 imm) ,)
   wcall, rtype
   0 b) ,)
 
 xcode findmeta ( id ll -- ll-or-0 ) \ preserves r6
   r0 ppop,
 pc to L2 \ r0=id rTOP=ll
   cmp) rTOP rn) 0 imm) ,)
   return) z) ,) \ not found
   ldr) r1 rd) rTOP rn) 4 +i) ,)
   cmp) r0 rn) r1 rm) ,)
   return) z) ,) \ found
   ldr) rTOP rdn) ,)
   L2 abs>rel b) ,)
 
 xcode findmod ( w -- w )
   r0 binstart MOD movi2, ldr) r0 rdn) ,)
   cmp) r0 rn) 0 imm) ,)
   return) z) ,) \ no mod
   mov) r6 rd) rTOP rm) ,) \ save w
   sub) rTOP rdn) 8 imm) ,) \ rTOP=ll
   pushret, L2 abs>rel bl) ,) popret,
   cmp) rTOP rn) 0 imm) ,)
   mov) z) rTOP rd) r6 rm) ,) \ restore w if meta not found
   return) z) ,) \ no mod
   pushret, L1 abs>rel bl) ,) popret,
   add) rTOP rdn) 8 imm) ,)
   ret,
 
 pc to lblerrmsg \ r0=sa r1=sl
   r0 ppush,
   mov) rTOP rd) r1 rm) ,)
   wcall, rtype
   wjmp, (abort)
 
 xcode boot<
   r0 binstart BOOTPTR movi2,
   ldr) r1 rd) r0 rn) ,)
   xdup, ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
   str) r1 rd) r0 rn) ,)
   ret,
 
 xcode in< wjmp, boot<
 
 pc to lblmoverange \ r0=src r1=len r2=dst. out: r0=src+len r2=dst+len Saves r3
   cmp) r1 rn) 0 imm) ,) \ guard against zero
   return) z) ,)
   pc
     ldr) r4 rd) r0 rn) 8b) 1 +i) post) ,)
     str) r4 rd) r2 rn) 8b) 1 +i) post) ,)
     sub) r1 rdn) 1 imm) f) ,)
     ( pc ) abs>rel b) ne) ,)
   ret,
 
 pc \ we have a nonzero lblnextword. r0=src
   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) ,)
   r2 binstart CURWORD movi2, \ dst
   mov) rTOP rd) r2 rm) ,)
   lblmoverange abs>rel b) ,)
 
 xcode maybeword ( -- str-or-0 )
   xdup,
   r0 binstart NEXTWORD movi2, ldr) r0 rdn) ,)
   cmp) r0 rn) 0 imm) ,)
   ( pc ) abs>rel b) ne) ,)
   pc
     wcall, in<
     xnip,
     cmp) rTOP rn) 0 imm) ,)
     mov) le) rTOP rd) 0 imm) ,)
     return) le) ,) \ EOF
     cmp) rTOP rn) SPC imm) ,)
     ( pc ) abs>rel b) le) ,) \ rTOP=first non-ws
   mov) r6 rd) 0 imm) ,)
   r5 binstart CURWORD movi2,
   pc
     add) r6 rdn) 1 imm) ,)
     str) rTOP rd) r5 rn) 8b) 1 +i) pre) !) ,)
     wcall, in<
     xnip,
     cmp) rTOP rn) SPC imm) ,)
     ( pc ) abs>rel b) gt) ,)
   rTOP binstart CURWORD movi2,
   str) r6 rd) rTOP rn) 8b) ,)
   ret,
 
 pc ," word expected" alignhere
 xcode word
   wcall, maybeword
   ( pc ) r0 pc>reg,
   mov) r1 rd) 13 imm) ,)
   cmp) rTOP rn) 0 imm) ,)
   lblerrmsg abs>rel b) z) ,)
   ret,
 
 pc ,"  word not found" alignhere
 xcode (wnf)
   r0 binstart CURWORD movi2,
   ldr) rTOP rd) r0 rn) 8b) 1 +i) post) ,)
   r0 ppush,
   wcall, rtype
   ( pc ) r0 pc>reg,
   mov) r1 rd) 15 imm) ,)
   lblerrmsg abs>rel b) ,)
 
 xcode execute ( a -- )
   mov) r0 rd) rTOP rm) ,)
   xdrop,
   r0 bx) ,)
 
 xcode find ( name 'dict -- w-or-0 )
   r2 ppop,
   ldr) r1 rd) r2 rn) 8b) 1 +i) post) ,) \ r2=a r1=len
 pc \ loop1
   ldr) r3 rd) rTOP rn) 8b) 5 -i) ,) \ entry len
   and) r3 rdn) $3f imm) ,) \ remove flags
   cmp) r1 rn) r3 rm) ,)
   forward b) ne) ,) to L1
   \ same length
   sub) r4 rd) rTOP rn) 5 imm) ,)
   sub) r4 rdn) r1 rm) ,) \ beginning of name range
   mov) r3 rd) 0 imm) ,)
 pc \ loop2
   ldr) r5 rd) r4 rn) 8b) r3 +r) ,)
   ldr) r0 rd) r2 rn) 8b) r3 +r) ,)
   cmp) r5 rn) r0 rm) ,)
   forward b) ne) ,) to L2
   add) r3 rdn) 1 imm) ,)
   cmp) r3 rn) r1 rm) ,)
   ( loop2 ) abs>rel b) ne) ,)
   \ same contents
   add) rTOP rdn) 4 imm) ,) \ e>w
   ret,
 L2 forward! L1 forward! \ not matching, try next
   ldr) rTOP rdn) 0 +i) ,)
   cmp) rTOP rn) 0 imm) ,)
   ( loop1 ) abs>rel b) ne) ,)
   \ not found
   ret,
 
 pc to lblcwrite \ r0=char
   r2 binstart HERE movi2,
   ldr) r1 rd) r2 rn) ,)
   str) r0 rd) r1 rn) 8b) 1 +i) post) ,)
   str) r1 rd) r2 rn) ,)
   ret,
 
 pc to lbldwrite \ r0=n. Destroys r1 and r2, preserves rest and flags
   r2 binstart HERE movi2,
   ldr) r1 rd) r2 rn) ,)
   str) r0 rd) r1 rn) 4 +i) post) ,)
   str) r1 rd) r2 rn) ,)
   ret,
 
 pc to lblwriterange \ r0=addr r1=len
   r3 binstart HERE movi2,
   ldr) r2 rd) r3 rn) ,)
   pushret, lblmoverange abs>rel bl) ,) popret,
   str) r2 rd) r3 rn) ,)
   ret,
 
 xcode entry pushret, ( 'dict s -- )
   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
   r0 binstart HERE movi2,
   ldr) r1 rd) r0 rn) ,)
   add) r2 rd) r1 rn) rTOP rm) ,)
   and) r2 rdn) 3 imm) f) ,)
   sub) ne) r1 rdn) r2 rm) ,)
   add) ne) r1 rdn) 4 imm) ,)
   str) ne) r1 rd) r0 rn) ,)
   xdrop, \ rTOP='dict
   mov) r0 rd) r6 rm) ,)
   mov) r1 rd) r5 rm) ,)
   lblwriterange absbl,
   mov) r0 rd) r5 rm) ,)
   lblcwrite absbl,
   r0 binstart NEXTMETA movi2,
   ldr) r0 rdn) ,)
   lbldwrite absbl,
   ldr) r0 rd) rTOP rn) ,) \ r0=dict
   r1 binstart HERE movi2, ldr) r1 rdn) ,)
   str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
   xdrop,
   popret,
   lbldwrite abs>rel b) ,)
 
 xcode code
   wcall, sysdict
   wcall, word
   wjmp, entry
 
 pc to L1 \ r3=meta-id
   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,
   mov) r0 rd) r3 rm) ,)
   lbldwrite abs>rel b) ,)
 
 xcode code16b mov) r3 rd) EMETA_16B imm) ,) L1 abs>rel b) ,)
 xcode code8b mov) r3 rd) EMETA_8B imm) ,) L1 abs>rel b) ,)
 
 \ HAL operands
 HALBASE rTOP rn) xconst W)
 HALBASE rA rn) xconst A)
 HALBASE rPSP rn) xconst PSP)
 HALBASE rSP rn) xconst RSP)
 0 eq) xconst Z)
 0 ne) xconst NZ)
 0 hs) xconst >=)
 0 lo) xconst <)
 0 hi) xconst >)
 0 ls) xconst <=)
 0 ge) xconst s>=)
 0 lt) xconst s<)
 0 gt) xconst s>)
 0 le) xconst s<=)
 
 xcode _hbank' ( slot -- a ) \ Preserves r0 r1 r2
   and) r3 rd) rTOP rn) $f imm) ,)
   rTOP binstart HBANK movi2,
   add) rTOP rdn) r3 rm) 2 lsl) ,)
   ret,
 
 xcode hbank' ( slot -- a ) \ Preserves r0 r1 r2
   and) r3 rd) rTOP rn) $f imm) ,)
   rTOP binstart HBANK movi2,
   add) rTOP rdn) r3 rm) 2 lsl) ,)
   ret,
 
 xcode hbank@ ( slot -- n )
   wcall, _hbank'
   ldr) rTOP rdn) ,)
   ret,
 
 xcode hbank! ( n -- slot )
   r0 binstart HBANKIDX movi2,
   mov) r1 rd) rTOP rm) ,)
   ldr) rTOP rd) r0 rn) ,)
   and) r2 rd) rTOP rn) $f imm) ,)
   wcall, _hbank'
   str) r1 rd) rTOP rn) ,)
   mov) rTOP rd) r2 rm) ,)
   add) r2 rdn) 1 imm) ,)
   str) r2 rd) r0 rn) ,)
   ret,
 
 pc HALBASE HALMEM or le,
 xcode m) ( a -- operand )
   wcall, hbank!
   ( pc ) r0 pc@>reg,
   orr) rTOP rdn) r0 rm) ,)
   ret,
 
 pc HALBASE HALIMM or le,
 xcode i) ( n -- operand )
   wcall, hbank!
   ( pc ) r0 pc@>reg,
   orr) rTOP rdn) r0 rm) ,)
   ret,
 
 \ Instead of using a new number bank, add n to operand's current bank
 pc to L1 ( operand n -- operand )
   rTOP push,
   ldr) rTOP rd) rPSP rn) ,) \ rTOP=operand
   wcall, hbank'
   ldr) r0 rd) rTOP rn) ,)
   r1 pop,
   add) r0 rdn) r1 rm) ,)
   str) r0 rd) rTOP rn) ,)
   xdrop, ret,
 
 xcode +) ( operand n -- operand )
   ldr) r0 rd) rPSP rn) ,)
   tst) r0 rn) HALIMM imm) ,)
   L1 abs>rel b) nz) ,)
   tst) r0 rn) HALMEM HALOFF or imm) ,)
   L1 abs>rel b) nz) ,)
   wcall, hbank!
   ldr) r0 rd) rPSP rn) ,)
   xnip,
   orr) rTOP rdn) r0 rm) ,)
   orr) rTOP rdn) HALOFF imm) ,)
   ret,
 
 xcode 8b) ( operand -- operand )
   orr) rTOP rdn) HAL8B imm) ,)
   ret,
 
 xcode 16b) ( operand -- operand )
   bic) rTOP rdn) HAL16B imm) ,)
   ret,
 
 xcode 32b) ( operand -- operand )
   bic) rTOP rdn) HAL8B imm) ,)
   orr) rTOP rdn) HAL16B imm) ,)
   ret,
 
 xcode A>) ( operand -- operand )
   setrd0) rTOP rdn) ,)
   orr) rTOP rdn) rA 12 lshift imm) ,)
   ret,
 
 xcode <>) ( operand -- operand )
   orr) rTOP rdn) HALINV imm) ,)
   ret,
 
 xcode &) ( operand -- operand )
   tst) rTOP rn) HALMEM imm) ,)
   bic) nz) rTOP rdn) HALMEM imm) ,)
   orr) nz) rTOP rdn) HALIMM imm) ,)
   orr) z) rTOP rdn) HALDEREF imm) ,)
   ret,
 
 \ HAL operations
 \ r0 is used as the immediate accumulator
 \ TODO: add out-of-range error for offsets not fitting 12 bits
 
 \ merge operand with instr and write
 pc to lblopwr ( operand -- ) \ r0=base instr. Preserves r3
   bic) rTOP rdn) HALMASK imm) ,)
   orr) r0 rdn) rTOP rm) ,)
   xdrop,
   lbldwrite abs>rel b) ,)
 
 \ Extract 12b rotate+imm from n. Preserves r0
 pc to lblimmsplit \ In: rTOP=n Out: rTOP=rotate+imm r1=rest of n.
   mov) r2 rd) 0 imm) ,) \ r2=rotate
   mov) r1 rd) 0 imm) ,)
   cmp) rTOP rn) $100 imm) ,)
   return) lo) ,)
 pc
   mov) r3 rd) rTOP rm) r2 rlsr) f) ,)
   return) z) ,) \ rTOP is zero, nothing to do
   tst) r3 rn) 3 imm) ,)
   add) z) r2 rdn) 2 imm) ,)
   ( pc ) abs>rel b) z) ,)
   and) r3 rdn) $ff imm) ,) \ r3=8b imm
   sub) r1 rd) rTOP rn) r3 rm) r2 rlsl) f) ,) \ r1=rest of n
   rsb) r2 rdn) 0 imm) ,) \ rotate is to the *right*
   and) r2 rdn) $1e imm) ,) \ 0-32, even numbers
   orr) rTOP rd) r3 rn) r2 rm) 7 lsl) ,) \ rTOP=rotate+imm
   ret,
 
 \ Compile a add) of immediate "n" with target register selected in r1
 pc add) 0 imm) f) ,)
 pc to lbladdnwr ( n -- ) \ r1=Rd/Rn
   cmp) rTOP rn) 0 imm) ,) \ if n=0, don't write anything
   ldr) z) rTOP rd) rPSP rn) CELLSZ +i) post) ,)
   return) z) ,)
   ( pc ) r0 pc@>reg,
   orr) r0 rdn) r1 rm) 12 lsl) ,)
   orr) r0 rdn) r1 rm) 16 lsl) ,)
   tst) rTOP rn) $80000000 imm) ,)
   eor) ne) r0 rdn) $00c00000 imm) ,) \ add) to sub)
   rsb) ne) rTOP rdn) 0 imm) ,) \ negate rTOP
   pushret,
 pc
   lblimmsplit abs>rel bl) ,)
   r0 push,
   orr) r0 rdn) rTOP rm) ,)
   mov) rTOP rd) r1 rm) ,)
   lbldwrite abs>rel bl) ,)
   r0 pop,
   cmp) rTOP rn) 0 imm) ,)
   ( pc ) abs>rel b) nz) ,)
   xdrop, popret, ret,
 
 xcode rs+, ( n -- )
   r0 binstart RCNT movi2,
   ldr) r1 rd) r0 rn) ,)
   add) r1 rdn) rTOP rm) ,)
   str) r1 rd) r0 rn) ,)
   mov) r1 rd) rSP imm) ,) lbladdnwr abs>rel b) ,)
 
 xcode ps+, ( n -- )
   mov) r1 rd) rPSP imm) ,) lbladdnwr abs>rel b) ,)
 
 \ Compile code resulting in register Rd to contain "n"
 pc mov) 0 imm) ,)
 pc to lbllitwr ( n -- ) \ r0=Rd
   pushret, r0 push,
   lblimmsplit abs>rel bl) ,)
   r1 ppush, ( rest imm+rotate )
   ( pc ) r3 pc@>reg,
   orr) r0 rd) r3 rn) r0 rm) 12 lsl) ,) \ merge Rd in instr
   lblopwr abs>rel bl) ,)
   r1 pop, popret, \ r1=Rd
   lbladdnwr abs>rel b) ,)
 
 \ Checks if operand is i) or m). If it is, compile a write of this value to r0
 \ and modify operand in consequence
 pc to lblimmwr ( operand -- operand ) \ preserves r0
   tst) rTOP rn) HALMEM imm) ,)
   return) z) ,) \ not a m) operand
   r0 push,
   xdup, wcall, hbank@
   mov) r0 rd) r1 imm) ,)
   pushret, lbllitwr abs>rel bl) ,) popret, ( operand )
   setrn0) rTOP rdn) ,)
   orr) rTOP rdn) $10000 imm) ,) \ Rn=r1
   bic) rTOP rdn) HALBMASK imm) ,)
   r0 pop,
   ret,
 
 \ Move Rn to Rm in operand
 pc to lblrn>rm \ rTOP=operand
   \ move Rn to Rm
   bic) rTOP rdn) HALBMASK imm) ,)
   mov) r0 rd) rTOP rm) 16 lsr) ,)
   and) r0 rdn) $f imm) ,)
   orr) rTOP rdn) r0 rm) ,)
   bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
   ret,
 
 \ Copy Rd to Rn in operand.
 pc to lblrdn \ rTOP=operand. preserves r0
   bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
   and) r1 rd) rTOP rn) $f000 imm) ,)
   orr) rTOP rdn) r1 rm) 4 lsl) ,)
   ret,
 
 \ Swap Rd and Rn in operand
 pc to lblrd<>rn \ rTOP=operand
   and) r0 rd) rTOP rn) $f000 imm) ,)
   and) r1 rd) rTOP rn) $f0000 imm) ,)
   bic) rTOP rdn) $ff000 imm) ,)
   orr) rTOP rdn) r0 rm) 4 lsl) ,)
   orr) rTOP rdn) r1 rm) 4 lsr) ,)
   ret,
 
 \ Write a mov) from operand's src to operand *dereferenced* dst. If operand has
 \ an offset, a add) is written after the mov).
 pc mov) ,)
 pc to lblmov ( operand -- )
   tst) rTOP rn) HALINV imm) ,)
   pushret, lblrd<>rn abs>rel bl) nz) ,) popret,
   xdup, ( op op )
   lblrn>rm abscall,
   ( pc ) r0 pc@>reg,
   lblopwr abscall, ( op )
   tst) rTOP rn) HALOFF imm) ,)
   and) r1 rd) rTOP rn) $f000 imm) ,) \ Rd
   mov) r1 rd) r1 rm) 12 lsr) ,)
   wcall, hbank@
   lbladdnwr abs>rel b) nz) ,)
   xdrop, ret,
 
 \ Write an eor between operand's src and dereferenced dst.
 pc eor) ,)
 pc to L2 ( operand -- )
   lblrn>rm abscall,
   lblrdn abscall,
   ( pc ) r0 pc@>reg,
   lblopwr abs>rel b) ,)
 
 \ Write a swap between operand's src to operand *dereferenced* dst. Offsets are
 \ ignored. Registers only
 pc to lblswp ( operand -- )
   pushret,
   xdup, xdup,
   L2 abs>rel bl) ,)
   lblrd<>rn abs>rel bl) ,)
   L2 abs>rel bl) ,)
   popret,
   L2 abs>rel b) ,)
 
 pc rsb) rTOP rdn) 0 imm) ,)
 xcode -W, ( -- )
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 \ if HALOFF is set in operand, fetch number associated with hbank in r1, and
 \ if that number is negative, unset the U (up/down) bit of the instruction in
 \ r0. Also set HALMASK to 0 in operand.
 \ Z is set according to whether HALOFF was there: Z=no HALOFF NZ=HALOFF
 \ TODO: support numbers over 12b
 pc to L1 ( operand -- ) \ r0=instr r1=bank number
   tst) rTOP rn) HALOFF imm) ,) \ has offset?
   return) z) ,)
   rTOP push, wcall, hbank@ mov) r1 rd) rTOP rm) f) ,) rTOP pop,
   bic) mi) r0 rdn) $00800000 imm) ,) \ negative, unset U bit
   rsb) mi) r1 rdn) 0 imm) ,)
   bic) rTOP rdn) HALBMASK imm) f) ,) \ unset Z
   ret,
 
 \ conditionally merge hbank with operand, then with instr then write
 pc to L2 ( operand -- ) \ r0=instr
   L1 abscall,
   orr) nz) rTOP rdn) r1 rm) ,)
   lblopwr abs>rel b) ,)
 
 \ operand is 16b
 pc to L3 ( operand -- ) \ r0=base instr
   orr) r0 rdn) $b0 imm) ,) \ make into a ldrh/strh op
   bic) r0 rdn) $04000000 imm) ,)
   orr) r0 rdn) $00400000 imm) ,) \ immediate
   L1 abscall,
   mov) nz) r2 rd) r1 rm) 4 lsl) ,) \ imm high nibble
   and) nz) r1 rdn) $f imm) ,)
   and) nz) r2 rdn) $f00 imm) ,)
   orr) nz) r0 rdn) r1 rm) ,) \ apply low nibble
   orr) nz) r0 rdn) r2 rm) ,) \ apply high nibble
   lblopwr abs>rel b) ,)
 
 \ Write a ldr) or str), depending on instr
 pc to L4 ( operand -- ) \ r0=instr
   lblimmwr abscall,
   tst) rTOP rn) HALINV imm) ,)
   eor) nz) r0 rdn) $100000 imm) ,) \ toggle LDR/STR
   tst) rTOP rn) HAL16B imm) ,)
   L3 abs>rel b) z) ,)
   L2 abs>rel b) ,)
 \ Write number specified in bank as an immediate to operand's target
 pc to L3 ( operand -- )
   mov) r0 rd) rTOP rm) 12 lsr) ,)
   and) r0 rdn) $f imm) ,)
   wcall, hbank@
   lbllitwr abs>rel b) ,)
 pc ldr) 0 +i) ,)
 xcode @, ( operand -- ) \ Compiled code preserves r0
   tst) rTOP rn) HALIMM imm) ,)
   L3 abs>rel b) nz) ,)
   tst) rTOP rn) HALDEREF imm) ,)
   lblmov abs>rel b) nz) ,)
   ( pc ) r0 pc@>reg, L4 abs>rel b) ,)
 
 xcode !, ( operand -- )
   eor) rTOP rdn) HALINV imm) ,)
   wjmp, @,
 
 pc to L1 ( operand -- ) \ r0=base instr
   \ set offset to 4, 2, or 1
   mov) r1 rd) 4 imm) ,)
   tst) rTOP rn) HAL16B imm) ,)
   mov) z) r1 rd) 2 imm) ,)
   tst) rTOP rn) HAL8B imm) ,)
   mov) nz) r1 rd) 1 imm) ,)
   orr) r0 rdn) r1 rm) ,)
   L4 absb,
 
 pc ldr) 0 +i) post) ,)
 xcode @+, ( operand -- )
   ( pc ) r0 pc@>reg, L1 abs>rel b) ,)
 
 xcode !+, ( operand -- )
   eor) rTOP rdn) HALINV imm) ,)
   wjmp, @+,
 
 pc ldr) 0 -i) pre) !) ,)
 xcode -@, ( operand -- )
   ( pc ) r0 pc@>reg, L1 abs>rel b) ,)
 
 xcode -!, ( operand -- )
   eor) rTOP rdn) HALINV imm) ,)
   wjmp, -@,
 
 pc add) 0 imm) ,)
 pc to L1 ( operand -- )
   rTOP push, wcall, hbank@ mov) r0 rd) rTOP rm) ,) rTOP pop,
   tst) rTOP rn) HALMEM imm) ,)
   mov) nz) rTOP rd) r0 rm) ,)
   mov) nz) r0 rd) rTOP imm) ,)
   lbllitwr abs>rel b) nz) ,) \ m) operand
   ( pc ) r0 pc@>reg, L2 abs>rel b) ,)
 
 \ operand is 16b and ARM doesn't have a 16b SWP! LDR+STR+MOV...
 pc mov) rTOP rd) r0 rm) ,)
 pc to L3 ( operand -- )
   xdup,
   setrd0) rTOP rdn) ,)
   wcall, @, wcall, !,
   ( pc ) r0 pc@>reg,
   lbldwrite abs>rel b) ,)
 
 pc swp) rTOP rd) rTOP rm) ,)
 xcode @!, ( operand -- )
   lblimmwr abscall,
   tst) rTOP rn) HALDEREF imm) ,)
   lblswp abs>rel b) nz) ,)
   tst) rTOP rn) HAL16B imm) ,)
   L3 abs>rel b) z) ,)
   tst) rTOP rn) HALOFF imm) ,) \ has offset?
   forward b) z) ,)
     xdup, setrd0) rTOP rdn) ,)
     L1 abscall,
     setrn0) rTOP rdn) ,)
   forward!
   \ TODO: figure out how HALBMASK can be nonzero at this point. Theoretically,
   \ it's always zero, but without this line, we fail.
   setimm0) rTOP rdn) ,)
   ( pc ) r0 pc@>reg,
   lblopwr abs>rel b) ,)
 
 \ Handle "mul" by moving Rn to Rm, setting Rn to zero.
 pc to L1 ( operand -- ) \ r0=instr
   and) r1 rd) rTOP rn) $f000 imm) ,) \ Rn
   bic) rTOP rdn) $f000 imm) ,)
   orr) rTOP rdn) r1 rm) 4 lsr) ,)
   lblopwr abs>rel b) ,)
 
 \ Proxy lblopwr with this processing:
 \ 1. Remove OP8B which messes with arithmetic opcodes
 \ 2. If opcode is one of the "comparison" opcodes, forcefully set Rd to 0 before
 \    writing it off.
 \ 3. Also check for "mul".
 pc to L4 ( operand -- ) \ r0=instr
   bic) rTOP rdn) HAL8B imm) ,)
   and) r1 rd) r0 rn) $01900000 imm) ,)
   cmp) r1 rn) $01100000 imm) ,)
   setrd0) z) rTOP rdn) ,)
   and) z) r1 rd) r0 rn) $01900000 imm) ,)
   and) r1 rd) r0 rn) $0ff00000 imm) ,)
   and) r2 rd) r0 rn) $000000f0 imm) ,)
   orr) r1 rdn) r2 rm) ,)
   cmp) r1 rn) $00000090 imm) ,)
   L1 abs>rel b) z) ,)
   lblopwr abs>rel b) ,)
 
 \ Write arithmetic operation with an immediate src
 pc to L3 ( operand -- ) \ r0=instr
   \ TODO: avoid step by encoding imm) directly when possible
   r0 push,
   xdup, ( op op )
   setrd0) rTOP rdn) ,)
   wcall, @, ( op ) \ imm in r0
   r0 pop, \ r0=instr
   setimm0) rTOP rdn) ,)
   lblrdn abscall,
   L4 abs>rel b) ,) ( )
 
 \ Write inverted arithmetic operation, that is:
 \ 1. Load operand's src in r0
 \ 2. Apply instr with r0 as Rd and Rn and operand's dst as Rm.
 \ 3. Store r0 in operand's src
 pc to L2 ( operand -- ) \ r0=instr
   bic) rTOP rdn) HALINV imm) ,)
   r0 push,
   lblimmwr abscall,
   xdup, ( op op )
   setrd0) rTOP rdn) ,)
   wcall, @, ( op )
   xdup, ( op op )
   setimm0) rTOP rdn) ,)
   lblrd<>rn abscall,
   setrd0) rTOP rdn) ,)
   lblrn>rm abscall,
   r0 pop, \ r0=instr
   L4 abscall, ( op )
   setrd0) rTOP rdn) ,)
   wjmp, !, ( )
 
 \ Write arithmetic operation, that is:
 \ 1. Load operand's src in r0
 \ 2. Apply instr with operand's dst as Rd and Rn and r0 as Rm.
 pc to L1 ( operand -- ) \ r0=instr
   tst) rTOP rn) HALINV imm) ,)
   L2 abs>rel b) nz) ,)
   tst) rTOP rn) HALIMM imm) ,)
   L3 abs>rel b) nz) ,)
   r0 push,
   lblimmwr abscall,
   xdup, ( op op )
   setrd0) rTOP rdn) ,)
   wcall, @, ( op )
   r0 pop, \ r0=instr
   setimm0) rTOP rdn) ,)
   lblrdn abscall,
   L4 abs>rel b) ,) ( )
 
 xcode +, ( operand -- )
   mov) r0 rd) $00900000 imm) ,) ( add+s ) L1 abs>rel b) ,)
 
 xcode -, ( operand -- )
   mov) r0 rd) $00500000 imm) ,) ( sub+s ) L1 abs>rel b) ,)
 
 xcode &, ( operand -- )
   mov) r0 rd) $00100000 imm) ,) ( and+s ) L1 abs>rel b) ,)
 
 xcode |, ( operand -- )
   mov) r0 rd) $01900000 imm) ,) ( and+s ) L1 abs>rel b) ,)
 
 xcode ^, ( operand -- )
   mov) r0 rd) $00300000 imm) ,) ( and+s ) L1 abs>rel b) ,)
 
 xcode compare, ( operand -- )
   mov) r0 rd) $01500000 imm) ,) ( cmp ) L1 abs>rel b) ,)
 
 xcode *, ( operand -- )
   mov) r0 rd) $00000090 imm) ,) ( mul ) L1 abs>rel b) ,)
 
 \ Write << or >> in its immediate form
 pc to L1 ( operand -- ) \ r0=instr
   wcall, hbank@
   and) rTOP rdn) $1f imm) ,) \ 5-bit
   orr) r0 rdn) rTOP rm) 7 lsl) ,) \ or in b11:7
   xdrop,
   lbldwrite abs>rel b) ,)
 
 \ Write << or >> in its register form
 pc to L2 ( operand -- ) \ r0=instr
   r0 push,
   setrd0) rTOP rdn) ,)
   wcall, @,
   r0 pop,
   orr) r0 rdn) $10 imm) ,) \ register shift
   lbldwrite abs>rel b) ,)
 
 \ Write << or >> in either its register form or immediate form
 pc to L3 ( operand -- ) \ r0=instr mask
   orr) r0 rdn) $e0000000 imm) ,) \ always
   orr) r0 rdn) $01a00000 imm) ,) \ MOV
   and) r1 rd) rTOP rn) $f000 imm) ,) \ Rd
   orr) r0 rdn) r1 rm) ,)
   orr) r0 rdn) r1 rm) 12 lsr) ,) \ Rm
   \ We're set for everything except b11:6 and b4
   tst) rTOP rn) HALIMM imm) ,)
   L1 abs>rel b) nz) ,)
   L2 abs>rel b) ,)
 
 \ Write << or >> while handling the <>) case
 pc to L4 ( operand -- ) \ r0=instr mask
   tst) rTOP rn) HALINV imm) ,)
   L3 abs>rel b) z) ,) \ not <>)
   bic) rTOP rdn) HALINV imm) ,)
   r0 push, xdup, xdup, wcall, @!, r0 pop,
   L3 abscall,
   wjmp, @!,
 
 xcode <<, ( operand -- )
   mov) r0 rd) 0 imm) ,) L4 absb,
 
 xcode >>, ( operand -- )
   mov) r0 rd) $20 imm) ,) L4 absb,
 
 xcode +n, ( n operand -- )
   lblimmwr abscall,
   setrd0) rTOP rdn) ,)
   xdup, wcall, @,
   swp) rTOP rd) rPSP rn) rTOP rm) ,) ( operand n )
   mov) r1 rd) r0 imm) ,) lbladdnwr abscall,
   wjmp, !,
 
 pc pushret,
 xcode pushret,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 pc popret,
 xcode popret,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 pc ret,
 xcode exit,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 pc to L1 ( w -- ) \ r2=base instr
   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) ,)
   bic) r0 rn) $ff000000 imm) ,)
   orr) r0 rdn) r2 rm) ,)
   xdrop,
   lbldwrite abs>rel b) ,)
 
 xcode branchR, ( w -- )
   mov) r2 rd) $eb000000 imm) ,)
   L1 abs>rel b) ,)
 
 xcode branch, ( a -- a )
   mov) r2 rd) $ea000000 imm) ,)
 pc to L2 ( a -- a ) \ r2=base instr
   pushret, L1 abs>rel bl) ,) popret,
   xdup, rTOP binstart HERE movi2, ldr) rTOP rdn) ,)
   sub) rTOP rdn) 4 imm) ,)
   ret,
 
 xcode branchC, ( a cond -- a )
   mov) r2 rd) $0a000000 imm) ,)
   orr) r2 rdn) rTOP rm) ,)
   xdrop,
   L2 abs>rel b) ,)
 
 pc mov) rPC rd) rA rm) ,)
 xcode branchA,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 xcode branch! ( tgt a -- )
   r1 ppop, \ r1=tgt
   sub) r0 rd) r1 rn) rTOP rm) ,) \ r0=displacement
   mov) r0 rd) r0 rm) 2 lsr) ,)
   sub) r0 rdn) 2 imm) ,)
   bic) r0 rn) $ff000000 imm) ,) \ r0=24-bit offset
   ldr) r1 rd) rTOP rn) ,)
   and) r1 rdn) $ff000000 imm) ,)
   orr) r0 rdn) r1 rm) ,)
   str) r0 rd) rTOP rn) ,)
   xdrop, ret,
 
 \ a simple SWP pc, [sp] would be nice, right? but we can't...
 \ In this sequence below, remember that PC is 8 bytes ahead.
 pc mov) rLR rd) rPC rm) ,) add) rLR rdn) 8 imm) ,)
    swp) rLR rd) rSP rn) rLR rm) ,) return) ,)
 xcode yield ximm
   ( pc ) r0 pc>reg,
   mov) r1 rd) 16 imm) ,)
   lblwriterange abs>rel b) ,)
 
 pc mov) rTOP rd) 0 imm) ,) add) z) ( 0 cond ) rTOP rdn) 1 imm) ,)
 xcode C>W, ( cond -- )
   dup ( pc ) r0 pc@>reg,
   pushret, lbldwrite abs>rel bl) ,) popret,
   ( pc ) 4 + r0 pc@>reg,
   orr) r0 rdn) rTOP rm) ,)
   xdrop,
   lbldwrite abs>rel b) ,)
 
 pc xdup,
 xcode dup,
   ( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
 
 xcode litn
   wcall, dup,
   mov) r0 rd) rTOP imm) ,) lbllitwr abs>rel b) ,)
 
 pc ," divide by zero" alignhere
 pc to L1 \ rTOP=dividend rA=divisor
   ( pc ) r0 pc>reg,
   mov) r1 rd) 14 imm) ,)
   cmp) rA rn) 0 imm) ,)
   lblerrmsg abs>rel b) z) ,)
   \ rTOP is active remainder
   mov) r1 rd) 0 imm) ,) \ r1=quotient
   mov) r2 rd) rA rm) ,) \ r2=tmp
   \ double tmp until 2 * tmp > dividend
   cmp) r2 rn) rTOP rm) 1 lsr) ,)
 pc
   mov) ls) r2 rd) r2 rm) 1 lsl) ,)
   cmp) r2 rn) rTOP rm) 1 lsr) ,)
   ( pc ) abs>rel b) ls) ,)
 pc
   cmp) rTOP rn) r2 rm) ,) \ can we subtract temp from dividend?
   sub) cs) rTOP rdn) r2 rm) ,) \ if yes, do it
   adc) r1 rdn) r1 rm) ,) \ double and add carry
   mov) r2 rd) r2 rm) 1 lsr) ,)
   cmp) r2 rn) rA rm) ,)
   ( pc ) abs>rel b) hs) ,)
   mov) rA rd) rTOP rm) ,) \ set remainder
   mov) rTOP rd) r1 rm) ,) \ set quotient
   ret,
 
 \ Write /mod with HALINV already processed
 pc L1 le,
 pc to L2 ( operand -- )
   wcall, A>)
   wcall, @,
   wcall, pushret,
   xdup,
   ( pc ) rTOP pc@>reg,
   wcall, branchR,
   wjmp, popret,
 
 \ Write /mod with <>)
 pc to L3 ( operand -- )
   bic) rTOP rdn) HALINV imm) ,)
   xdup, xdup, wcall, @!,
   L2 abscall,
   wjmp, @!,
 
 xcode /mod, ( operand -- )
   tst) rTOP rn) HALINV imm) ,)
   L3 abs>rel b) nz) ,)
   L2 absb,
 
 \ Speed-critical words
 xcode move ( src dst u -- )
   r2 ppop, r0 ppop, \ r0=src r2=dst
   mov) r1 rd) rTOP rm) ,) xdrop, \ r1=u
   cmp) r2 rn) 0 imm) ,)
   lblmoverange abs>rel b) nz) ,)
   ret,
 
 xcode []= ( src dst u -- f )
   r2 ppop, r0 ppop, \ r0=src r2=dst
   cmp) rTOP rn) 0 imm) ,)
   mov) z) rTOP rd) 1 imm) ,)
   return) z) ,)
   mov) r1 rd) rTOP rm) ,) \ r1=u
   mov) rTOP rd) 0 imm) ,)
 pc
   ldr) r3 rd) r0 rn) 8b) 1 +i) post) ,)
   ldr) r4 rd) r2 rn) 8b) 1 +i) post) ,)
   cmp) r3 rn) r4 rm) ,)
   return) nz) ,)
   sub) r1 rdn) 1 imm) f) ,)
   ( pc ) abs>rel b) ne) ,)
   mov) rTOP rd) 1 imm) ,)
   ret,
 
 xcode cidx ( c a u -- ?idx f )
   r0 ppop, \ r0=a rTOP=u
   ldr) r1 rd) rPSP rn) ,) \ r1=c
   mov) r2 rd) 0 imm) ,) \ r2=i
 pc
   ldr) r3 rd) r0 rn) 8b) 1 +i) post) ,)
   cmp) r3 rn) r1 rm) ,)
   str) z) r2 rd) rPSP rn) ,)
   mov) z) rTOP rd) 1 imm) ,)
   return) z) ,)
   add) r2 rdn) 1 imm) ,)
   sub) rTOP rdn) 1 imm) f) ,)
   ( pc ) abs>rel b) nz) ,)
   xnip,
   mov) rTOP rd) 0 imm) ,)
   ret,
 
 \ Interpret loop
 xcode ; ximm
   wcall, popret,
   wcall, exit,
   wjmp, [
 
 pc ," stack underflow" alignhere
 xcode stack?
   cmp) rPSP rn) PSTOP imm) ,)
   return) ls) ,)
   ( pc ) r0 pc>reg,
   mov) r1 rd) 15 imm) ,)
   lblerrmsg abs>rel b) ,)
 
 pc to L1 ( str -- w ) \ find in sys dict
   wcall, curword
   wcall, sysdict
   wcall, find
   teq) rTOP rn) 0 imm) ,)
   xwordlbl (wnf) abs>rel b) eq) ,)
   ret,
 
 pc to L2 ( w -- ) \ findmod+execute
   wcall, findmod
   wcall, execute
   wjmp, stack?
 
 xcode compword ( str -- )
   wcall, parse
   cmp) rTOP rn) 0 imm) ,)
   xdrop,
   xwordlbl litn abs>rel b) ne) ,) \ literal: jump to litn
   L1 abscall,
   ldr) r0 rd) rTOP rn) 8b) 9 -i) ,)
   tst) r0 rn) $80 imm) ,)
   L2 abs>rel b) ne) ,) \ immediate? execute
   \ compile word
   wcall, findmod
   wjmp, branchR,
 
 xcode ]
   r1 binstart COMPILING movi2,
   mov) r0 rd) 1 imm) ,)
   str) r0 rd) r1 rn) ,)
 pc
   wcall, word
   wcall, compword
   wcall, compiling
   cmp) rTOP rn) 0 imm) ,)
   xdrop,
   ( pc ) abs>rel b) nz) ,)
   ret,
 
 xcode runword ( str -- )
   r0 binstart COMPILING movi2,
   ldr) r0 rdn) ,)
   cmp) r0 rn) 0 imm) ,)
   xwordlbl compword abs>rel b) ne) ,)
   wcall, parse
   cmp) rTOP rn) 0 imm) ,)
   xdrop,
   return) ne) ,) \ literal: nothing to do
   L1 abscall,
   L2 abs>rel b) ,)
 
 xcode main pc w>e org SYSDICT + le!
 lblmain forward!
 pc
   wcall, word
   wcall, runword
   abs>rel b) ,)
 
 pc org BOOTPTR + le!