134 lines
3.5 KiB
Tal
134 lines
3.5 KiB
Tal
( repl-regex.tal )
|
|
|
|
%dbg { #ff #0e DEO }
|
|
%sp { #20 #18 DEO }
|
|
%nl { #0a #18 DEO }
|
|
%exit { #01 #0f DEO BRK }
|
|
|
|
( read in regular expressions )
|
|
( and emit internal structures parsed )
|
|
|0100
|
|
;r-prompt ;println JSR2
|
|
;r-read-stdin #10 DEO2 BRK
|
|
|
|
( we use two different prompts depending on what mode we're in )
|
|
@r-prompt "enter 20 "regex: 20 00
|
|
@s-prompt "string 20 "to 20 "match: 20 00
|
|
|
|
|
|
@regex $2 ( compiled regex address (if any) )
|
|
@buffer $1000 ( buffer to read user input )
|
|
@ptr :buffer ( next byte to write in buffer )
|
|
|
|
@println ( s* -> )
|
|
&loop LDAk #00 EQU ,&eof JCN
|
|
LDAk #18 DEO INC2 ,&loop JMP
|
|
&eof POP2 JMP2r
|
|
|
|
@r-read-stdin ( -> )
|
|
#12 DEI #0a EQU ,&execute JCN
|
|
#12 DEI ;ptr LDA2 STA
|
|
;ptr LDA2k INC2 SWP2 STA2
|
|
BRK
|
|
&execute
|
|
#00 ;ptr LDA2 STA
|
|
;buffer ;ptr STA2
|
|
;buffer ;compile JSR2 dbg nl
|
|
DUP2 ;regex STA2
|
|
;emit-stack JSR2 nl
|
|
;emit-arena JSR2 nl
|
|
;reset-arena JSR2
|
|
POP2
|
|
;s-prompt ;println JSR2
|
|
;s-read-stdin #10 DEO2 BRK
|
|
BRK
|
|
|
|
@s-read-stdin ( -> )
|
|
#12 DEI #0a EQU ,&execute JCN
|
|
#12 DEI ;ptr LDA2 STA
|
|
;ptr LDA2k INC2 SWP2 STA2
|
|
BRK
|
|
&execute
|
|
#00 ;ptr LDA2 STA ( null terminate string )
|
|
;ptr LDA2 ;buffer EQU2 STH ( stash is-empty? )
|
|
;buffer ;ptr STA2 ( reset ptr )
|
|
;buffer ;regex LDA2 ;rx-match JSR2 ( match regex )
|
|
;emit-byte JSR2 nl ( print result )
|
|
STHr ,&was-empty JCN
|
|
;s-prompt ;println JSR2
|
|
BRK
|
|
&was-empty
|
|
;r-prompt ;println JSR2
|
|
;r-read-stdin #10 DEO2 BRK
|
|
BRK
|
|
|
|
~regex.tal
|
|
|
|
@emit-short ( short* -- )
|
|
SWP ;emit-byte JSR2 ;emit-byte JSR2 JMP2r
|
|
|
|
@emit-byte ( byte^ -- )
|
|
DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP
|
|
&hex #30 ADD DUP #39 GTH #27 MUL ADD emit!
|
|
JMP2r
|
|
|
|
( print stack size, followed by contents )
|
|
@emit-stack ( -> )
|
|
space LIT 'n emit! LIT '= emit! ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit!
|
|
;stack-bot
|
|
&loop
|
|
DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN
|
|
POP2 newline JMP2r
|
|
&ok
|
|
space LDA2k ;emit-short JSR2
|
|
#0002 ADD2 ,&loop JMP
|
|
|
|
( emit n bytes from the given address )
|
|
@emit-n ( addr* count^ -> addr2* )
|
|
DUP #00 GTH ( addr count count>0? ) ,&ok JCN ( addr count ) POP newline JMP2r
|
|
&ok
|
|
STH ( addr [count] ) space LDAk ;emit-byte JSR2 INC2 ( addr+1 [count] )
|
|
STHr #01 SUB ( addr+1 count-1 )
|
|
;emit-n JMP2
|
|
|
|
( emit the arena, with one line per node )
|
|
( parses node type, since node size is dynamic (3-5). )
|
|
@emit-arena ( -> )
|
|
;arena-bot
|
|
&loop
|
|
DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r
|
|
&ok
|
|
DUP2 ;emit-short JSR2
|
|
LIT ': emit! space
|
|
LDAk #01 LTH ,&uu JCN
|
|
LDAk #0b GTH ,&uu JCN
|
|
LDAk #09 GTH ,&cc JCN
|
|
LDAk #00 SWP ;rx-node-sizes ADD2
|
|
LDA ;emit-n JSR2 ,&loop JMP
|
|
&cc
|
|
DUP2 #0003 ADD2 LDA #02 MUL #04 ADD
|
|
;emit-n JSR2 ,&loop JMP
|
|
&uu
|
|
LDAk #cc ;unknown-node-type ;error!! JSR2
|
|
|
|
@emit-subgroups ( -> )
|
|
;groups-top ;groups-bot
|
|
&init ( top* i* )
|
|
GTH2k #00 EQU ,&start JCN ( top* i* )
|
|
#0000 OVR2 STA2 INC2 INC2 ,&init JMP ( top* i+2* )
|
|
&start
|
|
POP2 POP2 ( )
|
|
;subgroup-pos LDA2 ;subgroup-bot ( limit* pos* )
|
|
&loop
|
|
GTH2k ,&ok JCN JMP2r ( limit* pos* )
|
|
&ok
|
|
LDAk #13 GTH ,&next JCN ( limit* pos* )
|
|
LDAk #00 SWP ;groups-bot ADD2 STH2 ( limit* pos* [dest*] )
|
|
INC2k LDA2k STH2kr STA2 ( limit* pos* pos+1* [dest*] )
|
|
INC2 INC2 INC2r INC2r ( limit* pos* pos+3* [dest+2*] )
|
|
LDA2 STH2r STA2 ( limit* pos* )
|
|
&next
|
|
#0005 ADD2 ,&loop JMP ( limit* pos+5* )
|
|
|
|
@groups-bot $50 @groups-top
|