~rabbits/uxnfor

826a38d859bacb6d581d95d3f46778fe9ed28664 — Devine Lu Linvega 3 months ago 0ca3d26
Formatted source
1 files changed, 113 insertions(+), 113 deletions(-)

M src/uxnfor.tal
M src/uxnfor.tal => src/uxnfor.tal +113 -113
@@ 52,17 52,17 @@
	#0001 .File/length DEO2
	[ LIT2 00 -err ] STZ
	result/new
	&s ( -- )
	&>s ( -- )
		;&c feof ?&eof
		.err LDZ ?&fail
		[ LIT &c $1 ] walk-char !&s
		[ LIT &c $1 ] walk-char !&>s
	&eof ( -- )
		eval-scope !save-file
	eval-scope !save-file
	&fail ( -- )
		;dict/err <sprint>
		;mem/scope <wprint>/
		#0a19 DEO
		JMP2r
	;dict/err <sprint>
	;mem/scope <wprint>/
	#0a19 DEO
	JMP2r

@walk-char ( c -- c )
	( norm ws ) #20 GTHk [ JMP SWP POP ]


@@ 96,45 96,44 @@
	LDAk [ LIT "$ ] NEQ ?{ <emit-space>
		!&w }
	&w ( -- )
		DUP2 #0001 SUB2 LDA #20 NEQ ?{
			LDAk #28 EQU ?handle-comment
			LDAk #5b EQU ?handle-block
			LDAk [ LIT "| ] EQU ?handle-padabs
			LDAk [ LIT "$ ] EQU ?handle-padrel
			LDAk [ LIT "& ] EQU ?handle-sublab
			LDAk [ LIT "{ ] EQU ?handle-lambda
			LDAk [ LIT "} ] EQU ?handle-lambda-end
			LDAk [ LIT "? ] EQU ?handle-jxi
			LDAk [ LIT "! ] EQU ?handle-jxi
			LDAk [ LIT "~ ] EQU ?handle-include }
		LDAk #20 NEQ ?&collapse
		DUP2 wrew INC2 is-breaking #00 EQU ?&collapse
		<emit-break-tab>
		!&continue
		&collapse LDAk <emit>
		&continue INC2 LDAk ?&w
	DUP2 #0001 SUB2 LDA #20 NEQ ?{
		LDAk #28 EQU ?handle-comment
		LDAk #5b EQU ?handle-block
		LDAk [ LIT "| ] EQU ?handle-padabs
		LDAk [ LIT "$ ] EQU ?handle-padrel
		LDAk [ LIT "& ] EQU ?handle-sublab
		LDAk [ LIT "{ ] EQU ?handle-lambda
		LDAk [ LIT "} ] EQU ?handle-lambda-end
		LDAk [ LIT "? ] EQU ?handle-jxi
		LDAk [ LIT "! ] EQU ?handle-jxi
		LDAk [ LIT "~ ] EQU ?handle-include }
	LDAk #20 NEQ ?&collapse
	DUP2 wrew INC2 is-breaking #00 EQU ?&collapse
	<emit-break-tab>
	!&continue
	&collapse LDAk <emit>
	&continue INC2 LDAk ?&w
	.nobrk LDZ ?&join
	.inzp LDZ ?{ #0a <emit> }
	#0a <emit>
	POP2 !scope/new
	&join ( -- )
		[ LIT2 00 -nobrk ] STZ
		#20 <emit>
		POP2 !scope/new
	[ LIT2 00 -nobrk ] STZ
	#20 <emit>
	POP2 !scope/new

@handle-padabs ( addr* -- addr* )
	#0a <emit>
	DUP2 wrew wrew INC2 LDA [ LIT ") ] NEQ ?{ #0a <emit> }
	INC2k slen #0004 EQU2 ?&page
	[ LIT2 01 -nobrk ] STZ
	INC2k slen #0004 EQU2 ?{
		[ LIT2 01 -nobrk ] STZ
		<emit-word>/
		<emit-space>
		!eval-scope/continue }
	INC2k LDA2 [ LIT2 "00 ] EQU2 .inzp STZ
	<emit-word>/
	<emit-space>
	#0a <emit>
	!eval-scope/continue
	&page ( addr* -- addr* )
		INC2k LDA2 [ LIT2 "00 ] EQU2 .inzp STZ
		<emit-word>/
		#0a <emit>
		!eval-scope/continue

@handle-padrel ( addr* -- addr* )
	<emit-word>/


@@ 144,11 143,11 @@
	DUP2 wrew wrew INC2 LDA [ LIT "& ] EQU ?&space-after
	DUP2 wrew wrew LDA [ LIT "@ ] EQU ?&space-after
	&break-after ( addr* -- addr* )
		<emit-break-tab>
		!eval-scope/continue
	<emit-break-tab>
	!eval-scope/continue
	&space-after ( addr* -- addr* )
		<emit-space>
		!eval-scope/continue
	<emit-space>
	!eval-scope/continue

@handle-sublab ( addr* -- addr* )
	DUP2 #0002 SUB2 LDA LIT "] NEQ ?{ <emit-break-tab> }


@@ 158,18 157,18 @@
	<emit-space>
	!eval-scope/continue
	&anon ( -- )
		<emit-word>/
		<emit-space>
		INC2 LDAk #28 NEQ ?{ <emit-comment> }
		!eval-scope/w
	<emit-word>/
	<emit-space>
	INC2 LDAk #28 NEQ ?{ <emit-comment> }
	!eval-scope/w
	&defined ( -- )
		<emit-break-once>
		( pad content ) LDA2k [ LIT2 "&> ] NEQ2 ?{ <inc-depth> }
		<emit-word>/
		INC2 <emit-space>
		<emit-comment>
		<emit-break-tab>
		INC2 !eval-scope/w
	<emit-break-once>
	LDA2k [ LIT2 "&> ] NEQ2 ?{ <inc-depth> }
	<emit-word>/
	INC2 <emit-space>
	<emit-comment>
	<emit-break-tab>
	INC2 !eval-scope/w

@handle-block ( addr* -- addr* )
	<emit-block>


@@ 213,19 212,20 @@
	!eval-scope/continue

@save-file ( -- )
	( overwrite file ) .err LDZ ?&cancel
	;src .File/name DEO2
	#0001 .File/length DEO2
	;mem/result
	&w ( -- )
		LDAk ,&b STR
		LDA2k #200a EQU2 ?&>skip
		LDA2k #2020 EQU2 ?&>skip
		LDA2k #090a EQU2 ?&>skip
		DUP2 #0001 SUB2 LDA2 #0920 EQU2 ?&>skip
			;&b .File/write DEO2 &>skip
		INC2 LDAk ?&w
	POP2 &cancel JMP2r
	.err LDZ ?{
		;src .File/name DEO2
		#0001 .File/length DEO2
		;mem/result
		&>w ( -- )
			LDAk ,&b STR
			LDA2k #200a EQU2 ?&skip
			LDA2k #2020 EQU2 ?&skip
			LDA2k #090a EQU2 ?&skip
			DUP2 #0001 SUB2 LDA2 #0920 EQU2 ?&skip
			;&b .File/write DEO2
			&skip INC2 LDAk ?&>w
		POP2 }
	JMP2r
	&b $1

(


@@ 247,25 247,25 @@
	DUP2 ;dict/jmp scmp3 ?&special-opcode
	DUP2 ;dict/jcn scmp3 ?&special-opcode
	&ignore ( -- )
		POP2 #00 JMP2r
	POP2 #00 JMP2r
	&special-opcode ( -- )
		DUP2 wcap/ #0001 SUB2 LDA [ LIT "k ] EQU ?&ignore
	DUP2 wcap/ #0001 SUB2 LDA [ LIT "k ] EQU ?&ignore
	&pass ( -- )
		POP2 #01 JMP2r
	POP2 #01 JMP2r

@count-block ( str* -- length* )
	[ LIT2r 0000 ]
	&w ( -- )
	&>w ( -- )
		LDAk #5d EQU ?&end
		INC2r INC2 LDAk ?&w
		INC2r INC2 LDAk ?&>w
	&end POP2 STH2r JMP2r

@count-lambda ( str* -- length* )
	LIT2r 0000
	&w ( -- )
	&>w ( -- )
		LDAk [ LIT "} ] EQU ?&end
		LDAk #20 NEQ ?{ INC2r }
		INC2 LDAk ?&w
		INC2 LDAk ?&>w
	&end POP2 STH2r JMP2r

@get-block-width ( len* -- and )


@@ 282,10 282,10 @@

@<emit-block> ( str* -- str* )
	DUP2 count-block #0027 GTH2 ?<emit-long-block>
	&w ( -- )
	&>w ( -- )
		LDAk <emit>
		LDAk #5d EQU ?&end
		INC2 LDAk ?&w
		INC2 LDAk ?&>w
	LDAk <emit>
	&end INC2 JMP2r



@@ 295,31 295,31 @@
	( b ) wcap/ INC2 wlen STH2r GTH2k [ JMP SWP2 POP2 ]
	( res ) get-block-width ,&lb STR
	LIT2r 0000
	&w ( -- )
	&>w ( -- )
		LDAk <emit>
		LDAk #20 NEQ ?&>no-ws
		STHkr [ LIT &lb $1 ] AND ?&>no-spacer
		INC2k LDA #5d EQU ?&>no-spacer
			<emit-break-tab> &>no-spacer
			INC2r &>no-ws
		LDAk #20 NEQ ?{
			STHkr [ LIT &lb $1 ] AND ?&no-spacer
			INC2k LDA #5d EQU ?&no-spacer
			<emit-break-tab>
			&no-spacer INC2r }
		LDAk #00 EQU ?&end
		INC2 LDAk #5d NEQ ?&w
		INC2 LDAk #5d NEQ ?&>w
	LDAk <emit>
	&end INC2 POP2r JMP2r

@<emit-comment> ( str* -- str* )
	INC2k INC2 LDA2 LIT2 "@| EQU2 ?<emit-mark>
	INC2k LDA2 LIT2 20 "| EQU2 ?<emit-line-comment>
	&w ( -- )
	&>w ( -- )
		LDAk <emit>
		LDAk #00 EQU ?&end
		INC2 LDAk #29 NEQ ?&w
		INC2 LDAk #29 NEQ ?&>w
	LDAk <emit>
	&end ( str* -- str* )
		INC2 JMP2r
	INC2 JMP2r

@<emit-line-comment> ( str* -- str* )
	<emit-comment>/w
	<emit-comment>/>w
	DUP2 wcap/ INC2 LDA #28 EQU ?{ <emit-break-tab> }
	JMP2r



@@ 327,7 327,7 @@
	#0a <emit>
	LDAk <emit>
	#0a <emit>
	INC2 INC2 !<emit-comment>/w
	INC2 INC2 !<emit-comment>/>w

@<emit-break-once> ( -: )
	;result/ptr LDA2 #0001 SUB2 LDA #1f GTH ?<emit-break-tab>


@@ 342,7 342,8 @@
	JMP2r

@<dec-depth> ( -- )
	;<emit-break-tab>/depth LDA DUP ?{ POP JMP2r } #01 SUB ;<emit-break-tab>/depth STA
	;<emit-break-tab>/depth LDA DUP ?{ POP JMP2r }
	#01 SUB ;<emit-break-tab>/depth STA
	JMP2r

@<emit-break-tab> ( -- )


@@ 351,9 352,9 @@
	( | depth )
	[ LIT2 &depth $1 00 ] EQUk ?{
		OVR #10 GTH ?{
			&l ( -- )
			&>l ( -- )
				#09 <emit>
				INC GTHk ?&l }
				INC GTHk ?&>l }
		}
	POP2 JMP2r



@@ 369,10 370,10 @@

@<emit> ( c -- )
	DUP ?{ POP JMP2r }
	DUP #0a NEQ ?&>no-lb
	DUP #0a NEQ ?{
		[ LIT &lb $1 ] INCk ,&lb STR
		#02 LTH ?result/put
		POP JMP2r &>no-lb
		POP JMP2r }
	result/put [ LIT2 00 _&lb ] STR
	JMP2r



@@ 391,17 392,16 @@

@<sclr> ( str* -: )
	#00 ROT ROT
	&w ( cap str* -- )
		STAk INC2 LDAk ?&w
	&>w ( cap str* -- )
		STAk INC2 LDAk ?&>w
	STA
	JMP2r

@skey ( key buf -: proc )
	OVR #21 LTH ?&eval
	#00 SWP scap/ STA
	#00 JMP2r
	&eval ( key buf -: proc )
		POP2 #01 JMP2r
	OVR #21 LTH ?{
		#00 SWP scap/ STA
		#00 JMP2r }
	POP2 #01 JMP2r

@scmp3 ( a* b* -- f )
	STH2


@@ 410,12 410,12 @@

@wcmp ( a* b* -- f )
	STH2
	&w ( -- )
	&>w ( -- )
		LDAk LDAkr STHr DUP2 #2020 EQU2 ?&end
		NEQk ?&end
		POP2 INC2 INC2r !&w
		POP2 INC2 INC2r !&>w
	&end ( a b cc -- f )
		NIP2 POP2r EQU JMP2r
	NIP2 POP2r EQU JMP2r

@wrew ( w* -- rew* )
	DUP2 ;mem/scope EQU2 ?{


@@ 448,26 448,26 @@

@scope
	&new ( -- )
		;mem/scope DUP2 ,&ptr STR2
		!<sclr>
	;mem/scope DUP2 ,&ptr STR2
	!<sclr>
	&put ( c -- )
		#00 [ LIT2 &ptr =mem/scope ]
		( ) DUP2 ;mem/scope-cap EQU2 ?&overflow
		( ) INC2k ,&ptr STR2
		STA2
		JMP2r
	#00 [ LIT2 &ptr =mem/scope ]
	( ) DUP2 ;mem/scope-cap EQU2 ?&overflow
	( ) INC2k ,&ptr STR2
	STA2
	JMP2r
	&overflow ( c* ptr* -- )
		POP2 POP2 [ LIT2 01 -err ] STZ
		JMP2r
	POP2 POP2 [ LIT2 01 -err ] STZ
	JMP2r

@result
	&new ( -- )
		;mem/result ,&ptr STR2
		JMP2r
	;mem/result ,&ptr STR2
	JMP2r
	&put ( c -- )
		#00 [ LIT2 &ptr =mem/result ] INC2k ,&ptr STR2
		STA2
		JMP2r
	#00 [ LIT2 &ptr =mem/result ] INC2k ,&ptr STR2
	STA2
	JMP2r

@dict ( localization )
	&usage "usage: 20 "uxnfor.rom 20 "source.tal 0a $1