From 656acfaa0d6d6a15d1044c1fd2fdffaeff9bdec9 Mon Sep 17 00:00:00 2001
From: d6 <d_m@plastic-idolatry.com>
Date: Sun, 30 Jan 2022 14:34:50 -0500
Subject: [PATCH] add error message, quit cmd

---
 regex.tal | 52 +++++++++++++++++++++++++++++++++-------------------
 1 file changed, 33 insertions(+), 19 deletions(-)

diff --git a/regex.tal b/regex.tal
index de32f2f..e2002ad 100644
--- a/regex.tal
+++ b/regex.tal
@@ -34,7 +34,7 @@
 %space { #20 emit }
 %newline { #0a emit }
 %print { debug newline }
-%error! { #00 #00 DIV }
+%quit! { #01 #0f DEO BRK }
 
 ( test -> )
 
@@ -63,7 +63,19 @@
     ;test6 ;graph1 ;match JSR2 ;emit-byte JSR2 newline
     ;test7 ;graph1 ;match JSR2 ;emit-byte JSR2 newline
     ;test8 ;graph1 ;match JSR2 ;emit-byte JSR2 newline
-    BRK
+    quit!
+
+@error! ( msg* -> )
+    LIT '! emit space
+    &loop LDAk ,&continue JCN ,&done JMP
+    &continue LDAk emit INC2 ,&loop JMP
+    &done POP2 newline quit!
+
+@unknown-node-type "unknown 20 "node 20 "type 00
+@mismatched-parens "mismatched 20 "parenthesis 00
+@stack-is-full "stack 20 "is 20 "full 00
+@stack-is-empty "stack 20 "is 20 "empty 00
+@arena-is-full "arena 20 "is 20 "full 00
 
 @match ( str* regex* -> bool^ )
     ;reset-stack JSR2
@@ -81,7 +93,7 @@
     LDAk #03 EQU ;do-literal JCN2
     LDAk #04 EQU ;do-or JCN2
     LDAk #05 EQU ;do-or JCN2 ( same code as the or case )
-    error!
+    ;unknown-node-type ;error! JSR2
 
 @goto-backtrack ( -> bool^ )
     ;stack-exist JSR2 ,&has-stack JCN ( do we have stack? )
@@ -180,7 +192,7 @@
     POP
     ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN
     ;unroll-stack JSR2 POP2 JMP2r
-    &mismatched-parens error!
+    &mismatched-parens ;mismatched-parens ;error! JSR2
 
 @c-or ( c^ -> r2* )
     POP
@@ -199,7 +211,7 @@
     ;unroll-stack JSR2
     ;push-next JSR2
     ;compile-region-loop JMP2
-    &mismatched-parens error!
+    &mismatched-parens ;mismatched-parens ;error! JSR2
 
 @c-dot ( c^ -> r2* )
     POP
@@ -233,7 +245,7 @@
 
 @alloc3 ( mode^ -> r* )
     #0000 ROT ( 00 00 mode^ )
-    #03 ;alloc JSR2 ( 00 00 mode^ addr* ) ( LIT 'a emit print )
+    #03 ;alloc JSR2 ( 00 00 mode^ addr* )
     STH2k STA
     STH2kr INC2 STA2
     STH2r
@@ -324,7 +336,7 @@
             OVR2 OVR2 INC2 ;set-next-addr JSR2
                 #0003 ADD2 ;set-next-addr JSR2 JMP2r
     &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ;set-next-addr JSR2 JMP2r
-    &!5 error!
+    &!5 ;unknown-node-type ;error! JSR2
 
 @remove-addr ( target* addr* -> )
     LDA2k #0000 EQU2 ( t a v=0? ) ,&is-zero JCN
@@ -342,7 +354,7 @@
             OVR2 OVR2 INC2 ;remove-addr JSR2
                 #0003 ADD2 ;remove-addr JSR2 JMP2r
     &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ;remove-addr JSR2 JMP2r
-    &!5 error!
+    &!5 ;unknown-node-type ;error! JSR2
 
 ( test cases -------- )
 
@@ -381,14 +393,14 @@
 ( stack operations ---- )
 
 @push4 ( str* regex* -> )
-    ;assert-avail JSR2 ( check for space )
+    ;assert-stack-avail JSR2 ( check for space )
     ;stack-pos LDA2 #0002 ADD2 STA2 ( cell[2:3] <- regex )
     ;stack-pos LDA2 STA2 ( cell[0:1] <- str )
     ;stack-pos LDA2 #0004 ADD2 ;stack-pos STA2 ( pos += 4 )
     JMP2r
 
 @pop4 ( -> str* regex* )
-    ;assert-exist JSR2 ( check for space )
+    ;assert-stack-exist JSR2 ( check for space )
     ;stack-pos LDA2 ( load stack-pos )
     #0002 SUB2 LDA2k STH2 ( pop and stash regex )
     #0002 SUB2 LDA2k STH2 ( pop and stash str )
@@ -403,10 +415,10 @@
     ;stack-pos LDA2 ;stack-top LTH2 JMP2r
 @stack-exist ( -> bool^ )
     ;stack-pos LDA2 ;stack-bot GTH2 JMP2r
-@assert-avail ( -> )
-    ;stack-avail JSR2 ,&ok JCN error! &ok JMP2r
-@assert-exist ( -> )
-    ;stack-exist JSR2 ,&ok JCN error! &ok JMP2r
+@assert-stack-avail ( -> )
+    ;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error! JSR2 &ok JMP2r
+@assert-stack-exist ( -> )
+    ;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error! JSR2 &ok JMP2r
 
 @emit-stack ( -> )
     space LIT 'n emit LIT '= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit
@@ -428,10 +440,12 @@
 
 @alloc ( size^ -> addr* )
     #00 SWP ( size* )
-    ;arena-pos LDA2 STH2k ADD2 ( pos+size* {pos} )
-    ( TODO: ensure we don't exceed our space )
-    ;arena-pos STA2 ( pos <- pos+size )
-    STH2r JMP2r ( return old pos )
+    ;arena-pos LDA2 STH2k ADD2 ( pos+size* [pos] )
+    DUP2 ;arena-top GTH2 ( pos+size pos+size>top? [pos] )
+    ,&error JCN ( pos+size [pos] )
+    ;arena-pos STA2 ( pos += size [pos] )
+    STH2r JMP2r ( pos )
+    &error POP2 POP2r ;arena-is-full ;error! JSR2
 
 |1ffe
 @arena-pos :arena-bot ( the next position to allocate )
@@ -456,4 +470,4 @@
     &!2 LDAk #03 NEQ ,&!3 JCN #04 ;emit-n JSR2 ,&loop JMP
     &!3 LDAk #04 NEQ ,&!4 JCN #05 ;emit-n JSR2 ,&loop JMP
     &!4 LDAk #05 NEQ ,&!5 JCN #05 ;emit-n JSR2 ,&loop JMP
-    &!5 error!
+    &!5 ;unknown-node-type ;error! JSR2