cleaning up more

This commit is contained in:
~d6 2022-01-29 23:56:57 -05:00
parent e0898742f0
commit 971148f379
1 changed files with 12 additions and 30 deletions

View File

@ -277,29 +277,23 @@
( this unrolls until it hits #ffff #ffff, which it ) ( this unrolls until it hits #ffff #ffff, which it )
( also removes from the stack. ) ( also removes from the stack. )
@unroll-stack ( -> start* end* ) @unroll-stack ( -> start* end* )
( LIT 'p emit newline ) ;pop4 JSR2 STH2 ( r )
( #fedc #9876 ;emit-short JSR2 ;emit-short JSR2 space print ) #00 STH ( count items in stack frame )
;pop4 JSR2 STH2 ( r ) ( print ) DUP2 #0000 NEQ2 ,&loop JCN ;alloc-empty JSR2
#00 STH &loop ( r* )
DUP2 #0000 NEQ2 ,&loop JCN ;alloc-empty JSR2 ( print ) ;pop4 JSR2 POP2 ( r x )
&loop ( r* ) ( LIT 'L emit print ) DUP2 #ffff EQU2 ( r x x-is-end? ) ,&done JCN
;pop4 JSR2 POP2 ( r x ) ( print ) INCr ( items++ )
DUP2 #ffff EQU2 ( print ) ( r x x-is-end? ) ,&done JCN ;alloc-or JSR2 ( r|x ) ,&loop JMP
INCr
( print ) ;alloc-or JSR2 ( r|x ) ( print ) ,&loop JMP
&done &done
( LIT 'q emit newline ) ( r ffff )
( r ffff ) ( print )
POP2 POP2
STHr ,&is-or JCN STHr ,&is-or JCN
STH2r JMP2r STH2r JMP2r
&is-or &is-or
POP2r POP2r
( LIT 'b emit print )
;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r ) ;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r )
( LIT 'c emit print ) ;set-next JSR2
;set-next JSR2 ( LIT 'd emit print )
( STH2 ;pop4 JSR2 POP2 STH2r ;push4 JSR2 )
JMP2r JMP2r
( add r to the top of the stock. ) ( add r to the top of the stock. )
@ -310,27 +304,15 @@
;pop4 JSR2 ( r0 r1 x0 x1 ) ;pop4 JSR2 ( r0 r1 x0 x1 )
DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN
STH2 ROT2 STH2r ( r1 x0 r0 x1 ) STH2 ROT2 STH2r ( r1 x0 r0 x1 )
( LIT 'p emit print )
;set-next JSR2 SWP2 ( x0 r1 ) ;set-next JSR2 SWP2 ( x0 r1 )
( LIT 'q emit print )
;push4 JSR2 ;push4 JSR2
JMP2r JMP2r
&is-zero POP2 POP2 ;push4 JSR2 JMP2r &is-zero POP2 POP2 ;push4 JSR2 JMP2r
( ( for nodes (other than 'or') read their 'next' pointer )
@get-next ( r* -> r.next* )
LDAk #01 NEQ ,&!1 JCN INC2 LDA2 JMP2r
&!1 LDAk #02 NEQ ,&!2 JCN INC2 LDA2 JMP2r
&!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 ) error! )
@set-next-addr ( target* addr* -> ) @set-next-addr ( target* addr* -> )
( LIT 'Z emit print )
LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
( LIT 'N emit print ) LDA2 ;set-next JSR2 JMP2r LDA2 ;set-next JSR2 JMP2r
&is-zero ( print ) ( LIT 'z emit print ) STA2 JMP2r &is-zero STA2 JMP2r
( set regex.next to target ) ( set regex.next to target )
@set-next ( target* regex* -> ) @set-next ( target* regex* -> )