update test-regex.tal to work with modern uxnasm

This commit is contained in:
~d6 2025-02-02 17:58:16 -05:00
parent 9ef4beaac2
commit 4c213b2a25
1 changed files with 56 additions and 58 deletions

View File

@ -1,45 +1,43 @@
%dbg { #ff #0e DEO } %sp { #2018 DEO }
%sp { #20 #18 DEO } %nl { #0a18 DEO }
%nl { #0a #18 DEO }
%exit { #01 #0f DEO BRK }
|0100 |0100
;expr1 ;compile JSR2 dbg nl ;expr1 compile #010e DEO nl
;emit-stack JSR2 nl emit-stack nl
;emit-arena JSR2 nl emit-arena nl
LIT '= ;emit JSR2 sp LIT "= emit sp
#01 ;emit-bool JSR2 sp #01 emit-bool sp
#01 ;emit-bool JSR2 sp #01 emit-bool sp
#00 ;emit-bool JSR2 sp #00 emit-bool sp
#01 ;emit-bool JSR2 sp #01 emit-bool sp
#01 ;emit-bool JSR2 sp #01 emit-bool sp
#00 ;emit-bool JSR2 sp #00 emit-bool sp
#00 ;emit-bool JSR2 sp #00 emit-bool sp
#00 ;emit-bool JSR2 nl #00 emit-bool nl
LIT 'A ;emit JSR2 sp LIT "A emit sp
;test1 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test1 OVR2k rx-match emit-bool sp
;test2 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test2 OVR2k rx-match emit-bool sp
;test3 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test3 OVR2k rx-match emit-bool sp
;test4 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test4 OVR2k rx-match emit-bool sp
;test5 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test5 OVR2k rx-match emit-bool sp
;test6 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test6 OVR2k rx-match emit-bool sp
;test7 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test7 OVR2k rx-match emit-bool sp
;test8 OVR2k ;match JSR2 ;emit-bool JSR2 nl ;test8 OVR2k rx-match emit-bool nl
LIT 'B ;emit JSR2 sp LIT "B emit sp
;test1 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test1 ;graph1 rx-match emit-bool sp
;test2 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test2 ;graph1 rx-match emit-bool sp
;test3 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test3 ;graph1 rx-match emit-bool sp
;test4 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test4 ;graph1 rx-match emit-bool sp
;test5 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test5 ;graph1 rx-match emit-bool sp
;test6 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test6 ;graph1 rx-match emit-bool sp
;test7 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test7 ;graph1 rx-match emit-bool sp
;test8 ;graph1 ;match JSR2 ;emit-bool JSR2 nl ;test8 ;graph1 rx-match emit-bool nl
;reset-arena JSR2 reset-arena
exit #010f DEO BRK
( corresponds to regex: a(b|c)d* ) ( corresponds to regex: a(b|c)d* )
@expr1 "a(b|c)d* 00 @expr1 "a(b|c)d* 00
@ -47,12 +45,12 @@
( corresponds to regex: a(b|c)d* ) ( corresponds to regex: a(b|c)d* )
( accepts "ab" or "ac" followd by any number of d's ) ( accepts "ab" or "ac" followd by any number of d's )
@graph1 @graph1
03 'a :x1 03 "a =x1
@x1 04 :x2 :x3 @x1 04 =x2 =x3
@x2 03 'b :x4 @x2 03 "b =x4
@x3 03 'c :x4 @x3 03 "c =x4
@x4 05 :x5 0000 @x4 05 =x5 0000
@x5 03 'd :x4 @x5 03 "d =x4
( test case strings to try matching ) ( test case strings to try matching )
@test1 "ab 00 ( yes ) @test1 "ab 00 ( yes )
@ -67,10 +65,10 @@
~regex.tal ~regex.tal
@emit ( c^ -- ) @emit ( c^ -- )
emit JMP2r #18 DEO JMP2r
@emit-short ( short* -- ) @emit-short ( short* -- )
SWP ;emit-byte JSR2 ;emit-byte JSR2 JMP2r SWP emit-byte emit-byte JMP2r
@emit-byte ( byte^ -- ) @emit-byte ( byte^ -- )
DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP
@ -78,24 +76,24 @@
JMP2r JMP2r
@emit-bool ( byte^ -- ) @emit-bool ( byte^ -- )
LIT '0 ADD emit JMP2r LIT "0 ADD emit JMP2r
( print stack size, followed by contents ) ( print stack size, followed by contents )
@emit-stack ( -> ) @emit-stack ( -> )
space LIT 'n emit LIT '= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit sp LIT "n emit LIT "= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 emit-short LIT ": emit
;stack-bot ;stack-bot
&loop &loop
DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN
POP2 newline JMP2r POP2 nl JMP2r
&ok &ok
space LDA2k ;emit-short JSR2 sp LDA2k emit-short
#0002 ADD2 ,&loop JMP #0002 ADD2 ,&loop JMP
( emit n bytes from the given address ) ( emit n bytes from the given address )
@emit-n ( addr* count^ -> addr2* ) @emit-n ( addr* count^ -> addr2* )
DUP #00 GTH ( addr count count>0? ) ,&ok JCN ( addr count ) POP newline JMP2r DUP #00 GTH ( addr count count>0? ) ,&ok JCN ( addr count ) POP nl JMP2r
&ok &ok
STH ( addr [count] ) space LDAk ;emit-byte JSR2 INC2 ( addr+1 [count] ) STH ( addr [count] ) sp LDAk emit-byte INC2 ( addr+1 [count] )
STHr #01 SUB ( addr+1 count-1 ) STHr #01 SUB ( addr+1 count-1 )
;emit-n JMP2 ;emit-n JMP2
@ -106,11 +104,11 @@
&loop &loop
DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r
&ok &ok
DUP2 ;emit-short JSR2 DUP2 emit-short
LIT ': emit space LIT ": emit sp
LDAk #01 NEQ ,&!1 JCN #03 ;emit-n JSR2 ,&loop JMP LDAk #01 NEQ ,&!1 JCN #03 emit-n ,&loop JMP
&!1 LDAk #02 NEQ ,&!2 JCN #03 ;emit-n JSR2 ,&loop JMP &!1 LDAk #02 NEQ ,&!2 JCN #03 emit-n ,&loop JMP
&!2 LDAk #03 NEQ ,&!3 JCN #04 ;emit-n JSR2 ,&loop JMP &!2 LDAk #03 NEQ ,&!3 JCN #04 emit-n ,&loop JMP
&!3 LDAk #04 NEQ ,&!4 JCN #05 ;emit-n JSR2 ,&loop JMP &!3 LDAk #04 NEQ ,&!4 JCN #05 emit-n ,&loop JMP
&!4 LDAk #05 NEQ ,&!5 JCN #05 ;emit-n JSR2 ,&loop JMP &!4 LDAk #05 NEQ ,&!5 JCN #05 emit-n ,&loop JMP
&!5 ;unknown-node-type ;error! JSR2 &!5 ;unknown-node-type errorm