diff --git a/regex.tal b/regex.tal index 759273e..e37b145 100644 --- a/regex.tal +++ b/regex.tal @@ -35,10 +35,13 @@ %newline { #0a emit } %print { debug newline } +( test -> ) + |0100 - ;expr1 ;compile JSR2 print newline - ;emit-stack JSR2 newline - ;emit-arena JSR2 newline + ;expr1 ;compile JSR2 + print + ;emit-stack JSR2 + ;emit-arena JSR2 newline ;test1 OVR2k ;match JSR2 ;emit-byte JSR2 newline @@ -220,8 +223,8 @@ ( LIT '@ emit DUP ;emit-byte JSR2 newline ) ;alloc-lit JSR2 ( LIT '# emit print ) - ;emit-stack JSR2 - ;emit-arena JSR2 +( ;emit-stack JSR2 + ;emit-arena JSR2 ) DUP2 ;push-next JSR2 ( print ) ( LIT '& emit print ) ;compile-region-loop JMP2 @@ -234,22 +237,22 @@ @c-star ( c^ -> regex* ) ( LIT '* emit print ) - POP print + POP ( print ) ;pop4 JSR2 SWP2 STH2 STH2k ( x1 [x0 x1] ) ( LIT '! emit space print ) ;alloc-star JSR2 ( r ) STH2r STH2kr ( r x1 x0 [x0] ) ( LIT '0 emit newline ) - ;emit-arena JSR2 +( ;emit-arena JSR2 ) ;remove-from JSR2 ( r [x0] ) - LIT '1 emit newline - ;emit-arena JSR2 +( LIT '1 emit newline + ;emit-arena JSR2 ) STH2r OVR2 OVR2 ( r x0 r x0 ) ;set-next JSR2 OVR2 #0003 ADD2 #0000 SWP2 STA2 ( fixme ) - LIT '2 emit print - ;emit-arena JSR2 +( LIT '2 emit print + ;emit-arena JSR2 ) ( r x0 ) SWP2 ;push4 JSR2 - LIT '* emit print +( LIT '* emit print ) ;compile-region-loop JMP2 @@ -289,15 +292,15 @@ @alloc-star ( expr* -> r* ) ( LIT '& emit space print ) - LIT 'a emit print - #05 ;alloc JSR2 STH2 print ( expr [r] ) - #05 STH2kr STA print ( expr [r] ) - DUP2 STH2kr INC2 STA2 print ( expr [r] ) - #0000 STH2kr #0003 ADD2 STA2 print ( expr [r] ) - LIT 'a emit ;emit-arena JSR2 ;emit-stack JSR2 +( LIT 'a emit print ) + #05 ;alloc JSR2 STH2 ( print ) ( expr [r] ) + #05 STH2kr STA ( print ) ( expr [r] ) + DUP2 STH2kr INC2 STA2 ( print ) ( expr [r] ) + #0000 STH2kr #0003 ADD2 STA2 ( print ) ( expr [r] ) +( LIT 'a emit ;emit-arena JSR2 ;emit-stack JSR2 ) - STH2kr SWP2 print ( r expr [r] ) - LIT 'x emit print + STH2kr SWP2 ( print ) ( r expr [r] ) +( LIT 'x emit print ) ;set-next JSR2 ( [r] ) STH2r JMP2r @@ -313,7 +316,7 @@ ;pop4 JSR2 STH2 ( r ) ( print ) #00 STH DUP2 #0000 NEQ2 ,&loop JCN ;alloc-empty JSR2 ( print ) - &loop ( r* ) LIT 'L emit print + &loop ( r* ) ( LIT 'L emit print ) ;pop4 JSR2 POP2 ( r x ) ( print ) DUP2 #ffff EQU2 ( print ) ( r x x-is-end? ) ,&done JCN INCr @@ -326,10 +329,10 @@ STH2r JMP2r &is-or POP2r - LIT 'b emit print +( LIT 'b emit print ) ;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r ) - LIT 'c emit print - ;set-next JSR2 LIT 'd emit print +( LIT 'c emit print ) + ;set-next JSR2 ( LIT 'd emit print ) ( STH2 ;pop4 JSR2 POP2 STH2r ;push4 JSR2 ) JMP2r @@ -341,22 +344,12 @@ ;pop4 JSR2 ( r0 r1 x0 x1 ) DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN STH2 ROT2 STH2r ( r1 x0 r0 x1 ) - LIT 'p emit print +( LIT 'p emit print ) ;set-next JSR2 SWP2 ( x0 r1 ) - LIT 'q emit print +( LIT 'q emit print ) ;push4 JSR2 JMP2r &is-zero POP2 POP2 ;push4 JSR2 JMP2r -( ( r -> ) -( LIT 'N emit space print 0 ) - STH2k ( r [r] ) ( print ) - ;pop4 JSR2 ( r x0 x1 [r] ) ( print ) - DUP2 #0000 EQU2 ( r x0 x1 x1=0? [r] ) ( print ) ,&is-zero JCN - ROT2 SWP2 ( x0 r x1 [r] ) ( print ) - ;set-next JSR2 ( x0 [r] ) STH2r ( x0 r ) ( print ) - ;push4 JSR2 ( ) - JMP2r - &is-zero POP2 POP2 STH2r ;push4 JSR2 ( print LIT '* emit newline ) JMP2r ) ( for nodes (other than 'or') read their 'next' pointer ) @get-next ( r* -> r.next* ) @@ -365,36 +358,36 @@ &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 LDA2 JMP2r &!3 LDAk #04 NEQ ,&!4 JCN INC2 LDA2 JMP2r &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 LDA2 JMP2r - &!5 ( either #04 (or) or ??? ) LIT 'q emit #00 #00 DIV + &!5 ( either #04 (or) or ??? ) ( LIT 'q emit ) #00 #00 DIV @set-next-addr ( target* addr* -> ) - LIT 'Z emit print +( LIT 'Z emit print ) LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN - LIT 'N emit print LDA2 ;set-next JSR2 JMP2r - &is-zero ( print ) LIT 'z emit print STA2 JMP2r +( LIT 'N emit print ) LDA2 ;set-next JSR2 JMP2r + &is-zero ( print ) ( LIT 'z emit print ) STA2 JMP2r ( set regex.next to target ) @set-next ( target* regex* -> ) - LIT 'n emit space LDAk ;emit-byte JSR2 print - LDAk #01 NEQ ,&!1 JCN INC2 ( STA2 ) LIT 't emit print ;set-next-addr JSR2 JMP2r +( LIT 'n emit space LDAk ;emit-byte JSR2 print ) + LDAk #01 NEQ ,&!1 JCN INC2 ( STA2 ) ( LIT 't emit print ) ;set-next-addr JSR2 JMP2r &!1 LDAk #02 NEQ ,&!2 JCN INC2 ( STA2 ) ;set-next-addr JSR2 JMP2r - &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ( STA2 ) LIT 'y emit print ;set-next-addr JSR2 JMP2r + &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ( STA2 ) ( LIT 'y emit print ) ;set-next-addr JSR2 JMP2r &!3 LDAk #04 NEQ ,&!4 JCN - LIT 'w emit print +( LIT 'w emit print ) ( INC2k LDA2 space LIT '{ emit DUP2 ;emit-short JSR2 ;set-next JSR2 #0003 ADD2 LDA2 space LIT '} emit DUP2 ;emit-short JSR2 ;set-next JSR2 JMP2r ) OVR2 OVR2 INC2 ( LIT '{ emit space ) ;set-next-addr JSR2 #0003 ADD2 ( LIT '} emit space ) ;set-next-addr JSR2 JMP2r &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ( STA2 ) ;set-next-addr JSR2 JMP2r - &!5 LIT '? emit LDAk ;emit-byte JSR2 #00 #00 DIV + &!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) #00 #00 DIV @remove-addr ( target* addr* -> ) - LIT 'A emit print +( LIT 'A emit print ) LDA2k #0000 EQU2 ( t a v=0? ) ,&is-zero JCN OVR2 OVR2 LDA2 EQU2 ( t a t=v? ) ,&is-equal JCN LDA2 ( t v ) ;remove-from JSR2 JMP2r - &is-zero LIT 'r emit print POP2 POP2 JMP2r - &is-equal LIT 's emit print NIP2 #0000 SWP2 STA2 JMP2r + &is-zero ( LIT 'r emit print ) POP2 POP2 JMP2r + &is-equal ( LIT 's emit print ) NIP2 #0000 SWP2 STA2 JMP2r ( remove target from regex ) @remove-from ( target* regex* -> ) @@ -408,7 +401,7 @@ ( LIT 'q emit print ) #0003 ADD2 ;remove-addr JSR2 JMP2r &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ;remove-addr JSR2 JMP2r - &!5 LIT '? emit LDAk ;emit-byte JSR2 #00 #00 DIV + &!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) #00 #00 DIV ( test cases -------- )