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