1 files changed, 70 insertions(+), 17 deletions(-)

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

@@ 41,8 41,8 @@ $44 const UART0_ICR
 : xaddr ( lbl -- ) xcode xdup, rTOP pc>reg, lret, ;
 
 : values ( n -- ) for 0 value next ;
-7 values lblcurword lblsysdict lblhere lblnextmeta
-         lblcwrite lbldwrite lblwriterange
+10 values lblcurword lblsysdict lblhere lblnextmeta lblcompiling
+          lblcwrite lbldwrite lblwriterange lblerrmsg lblmain
 $8000 to binstart
 binstart const RSTOP
 RSTOP $1000 - const PSTOP


@@ 51,6 51,33 @@ $10000 const HERESTART
 0 align4 here to org
 forward b) ,)
 HERESTART xconst herestart
+
+pc to lblcompiling 0 le,
+xcode compiling
+  xdup, lblcompiling rTOP pc>reg,
+  ldr) rTOP rdn) ,)
+  lret,
+
+xcode [ ximm
+  mov) r0 rd) 0 i) ,)
+pc
+  lblcompiling rTOP pc>reg,
+  str) r0 rd) rTOP rn) ,)
+  lret,
+
+xcode ]
+  mov) r0 rd) 1 i) ,)
+  ( pc ) b) ,)
+
+xcode quit
+  mov) rSP rd) RSTOP i) ,)
+  wcall, [
+  forward b) ,) to lblmain
+
+xcode abort
+  mov) rPSP rd) PSTOP i) ,)
+  wjmp, quit
+
 xcode emit ( c -- )
   pc
     ldr) r3 rd) r8 rn) UART0_FR +i) ,)


@@ 85,6 112,12 @@ xcode stype ( str -- )
   xdup, mov) rTOP rd) r0 rm) ,)
   wjmp, rtype
 
+pc to lblerrmsg \ r0=sa r1=sl
+  r0 ppush,
+  mov) rTOP rd) r1 rm) ,)
+  wcall, rtype
+  wjmp, abort
+
 pc to lblcurword $20 allot0
 lblcurword xaddr curword
 


@@ 108,13 141,13 @@ xcode word ( -- str )
   str) r2 rd) rTOP rn) 8b) ,)
   lret,
 
-pc 15 c, ,"  word not found" 0 align4
+pc ,"  word not found" 0 align4
 xcode (wnf)
   wcall, curword
   wcall, stype
-  xdup,
-  ( pc ) rTOP pc>reg,
-  wjmp, stype
+  ( pc ) r0 pc>reg,
+  mov) r1 rd) 15 i) ,)
+  lblerrmsg abs>rel b) ,)
 
 pc 12 c, ," Hello World!" 0 align4
 xcode prompt


@@ 232,11 265,40 @@ xcode entry ( 'dict s -- )
   str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
   lbldwrite abs>rel b) ,)
 
-xcode code pc w>e lblsysdict pc>addr le!
+xcode code
   wcall, sysdict
   wcall, word
   wjmp, entry
 
+pc lret,
+xcode exit,
+  ( pc ) r0 pc>reg,
+  ldr) r0 rdn) ,)
+  lbldwrite abs>rel b) ,)
+
+xcode ; ximm
+  \ wcall, exit,
+  wjmp, [
+
+xcode compword ( str -- )
+xcode runword ( str -- ) pc w>e lblsysdict pc>addr le!
+  wcall, compiling
+  cmp) rTOP rn) 0 i) ,)
+  xdrop,
+  xwordlbl compword b) ne) ,)
+  wcall, sysdict
+  wcall, find
+  teq) rTOP rn) 0 i) ,)
+  xwordlbl (wnf) abs>rel b) eq) ,)
+  wjmp, execute
+
+xcode main
+lblmain forward!
+pc
+  wcall, word
+  wcall, runword
+  abs>rel b) ,)
+
 forward!
 mov) rSP rd) RSTOP i) ,)
 mov) rPSP rd) PSTOP i) ,)


@@ 273,14 335,5 @@ str) r1 rd) r8 rn) UART0_IMSC +i) ,)
 \ Enable UART0, receive & transfer part of UART.
 mov) r1 rd) $300 i) ,) add) r1 rd) r1 rn) $01 i) ,)
 str) r1 rd) r8 rn) UART0_CR +i) ,)
-
 wcall, prompt
-pc
-  wcall, word
-  wcall, sysdict
-  wcall, find
-  teq) rTOP rn) 0 i) ,)
-  mov) eq) rTOP rd) binstart i) ,)
-  add) eq) rTOP rd) rTOP rn) xwordlbl (wnf) binstart - i) ,)
-  wcall, execute
-  abs>rel b) ,)
+wjmp, abort