duskos

commit ca7490b5087a738534ba6a5b46721b2900d0cc0a
parent 5c2dba4d74464eac9d7584352e0a167e076829d7
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu, 25 May 2023 19:37:34 -0400

rpi: add abort mechanism

Diffstat:
M
fs/xcomp/arm/rpi/kernel.fs
 | 
87
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------

1 file changed, 70 insertions(+), 17 deletions(-)
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/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