( cat input.tal | uxncli drifloon.rom > output.rom )

|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1

|000

	@token/buf $2f &cap $1
	@scope/buf $2f &cap $1

|100

@on-reset ( -> )
	;meta #06 DEO2
	;dict/reset scope/<set>
	;on-console .Console/vector DEO2
	BRK

@on-console ( -> )
	[ LIT2 04 -Console/type ] DEI EQU ?{ .Console/read DEI token/<push-byte>
		BRK }
	assembly/<resolve>
	BRK

@rom/<emit> ( -- )
	;dict/assembled err/<pstr>
	;dict/in err/<pstr>
	[ LIT2 &length 0100 ] DUP2 #0100 SUB2 err/<pdec>
	;dict/bytes err/<pstr>
	( | write )
	;rom/mem ADD2 ;rom/output
	&>l
		LDAk #18 DEO
		INC2 GTH2k ?&>l
	POP2 POP2 JMP2r

@runes/concat ( t* -- )
	POP2 JMP2r

@err/<pchr> ( c -- )
	#19 DEO
	JMP2r

@meta $1
	( name ) "Drifloon 0a
	( desc ) "Uxntal 20 "Assembler 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "24 20 "Jun 20 "2025 $2



( Core )

@assembly/<resolve> ( -- )
	,&mode LDR2 ;asm-comment NEQ2 ?{
		( ! ) ;dict/open ;dict/trail ;dict/Comment err/<generic> }
	,&mode LDR2 ;asm-macro NEQ2 ?{
		( ! ) ;dict/open ;dict/trail ;dict/Macro err/<generic> }
	.System/state DEI ?{
		refs/<resolve-all>
		.System/state DEI ?{
			[ LIT2 80 -System/state ] DEO !syms/<emit> } }
	JMP2r

@assembly/apply ( t* -- )
	LDZk ?{ POP2 JMP2r }
	[ LIT2 &mode =asm-default ] JMP2

@assembly/<set-default> ( -- )
	;asm-default ,&mode STR2
	JMP2r

@assembly/<set-comment> ( -- )
	;asm-comment ,&mode STR2
	[ LIT2 01 _asm-comment/depth ] STR
	JMP2r

@assembly/<set-macro> ( -- )
	;asm-macro ,&mode STR2
	[ LIT2 00 _asm-macro/depth ] STR
	JMP2r

@asm-default ( t* -- )
	( hex ) str/not-hex ?{ !rom/<write-rawhex> }
	( opc ) opcodes/is-opcode ?rom/<write-opcode>
	LDZk runes/find INC2k ORA ?{
		POP2
		( mac ) DUP2 macros/find-name [ INC2k ORA ?macros/<write> POP2 ]
		( imm ) !runes/litjsi }
	INC2 LDA2 JMP2

@asm-comment ( t* -- )
	[ LITr &depth $1 ] LDA2 DUP2
	( | nested comments )
	[ LIT2 ") 00 ] NEQ2 ?{ LITr 01 SUBr }
	[ LIT2 "( 00 ] NEQ2 ?{ INCr }
	STHkr [ LITr _&depth ] STRr
	?{ !assembly/<set-default> }
	JMP2r

@asm-macro ( t* -- )
	[ LITr &depth $1 ] LDA2k
	( | nested lambdas )
	[ LIT2 "} 00 ] NEQ2 ?{
		[ LITr 01 ] SUBr STHkr ?{
			#00 macros/<push-byte>
			POP2 POPr !assembly/<set-default> } }
	STHkr #00 EQU ?{ ;token/buf macros/<push-word>
		#20 macros/<push-byte> }
	LDA2 [ LIT2 "{ 00 ] NEQ2 ?{ INCr }
	[ LITr _&depth ] STRr
	JMP2r

(
@|Token )

@token/<new> ( -- )
	[ LIT2 -&buf _&ptr ] STR
	[ LIT2 00 -&buf ] STZ
	JMP2r

@token/<push-byte> ( c -- )
	DUP #20 GTH ?{ POP ;&buf assembly/apply !/<new> }
	[ LIT2 00 &ptr -&buf ] INCk
	( | check overflow )
	DUP .&cap LTH ?{
		( ! ) ;dict/exceeded ;dict/Name err/<token> }
	,&ptr STR
	STZ2
	JMP2r

(
@|Scope )

@scope/<push-byte> ( c -- )
	[ LIT2 00 &ptr -&buf ] INCk
	( | check overflow )
	DUP .&cap LTH ?{
		( ! ) ;dict/exceeded ;dict/Symbol err/<token> }
	,&ptr STR
	STZ2
	JMP2r

@scope/<set> ( name* -- )
	[ LIT2 -&buf _&ptr ] STR
	&>w
		LDAk [ LIT "/ ] EQU ?{
			LDAk /<push-byte>
			INC2 LDAk ?&>w }
	POP2 ,&ptr LDR ,&anchor STR
	JMP2r

@scope/make-name ( name* -- scope/label* )
	INC2 [ LIT2 &anchor $1 _&ptr ] STR
	[ LIT "/ ] /<push-byte>
	&>wl
		LDAk DUP ?{ POP POP2 ;&buf JMP2r }
		/<push-byte>
		INC2 !&>wl

(
@|Runes )

@runes/find ( char -- <addr>* )
	STH
	;&lut
	&>w
		LDAk STHkr EQU ?{
			#0003 ADD2 LDAk ?&>w
		POP2 #ffff }
	POPr JMP2r

@runes/ignore ( t* -- )
	POP2 JMP2r

	&lambda ( t* -- )
	POP2 !lambda/pop

	&coment ( t* -- )
	POP2 !assembly/<set-comment>

	&padabs ( t* -- )
	/req-name refs/get-any !head/<set>

	&padrel ( t* -- )
	/req-name refs/get-any !head/<set-rel>

	&toplab ( t* -- )
	/req-name DUP2 scope/<set> !syms/<new>

	&sublab ( t* -- )
	scope/make-name !syms/<new>

	&litrel ( t* -- )
	#80 rom/<write-byte> &rawrel /req-name refs/get-rel !rom/<write-byte>

	&litzep ( t* -- )
	#80 rom/<write-byte> &rawzep /req-name refs/get-abs !rom/<write-byte>

	&litabs ( t* -- )
	#a0 rom/<write-byte> &rawabs /req-name refs/get-abs2 !rom/<write-short>

	&litjci ( t* -- )
	/req-name #20 !rom/<write-call>

	&litjmi ( t* -- )
	/req-name #40 !rom/<write-call>

	&litjsi ( t* -- )
	#60 !rom/<write-call>

	&lithex ( t* -- )
	/req-name !rom/<write-lithex>

	&rawstr ( t* -- )
	/req-name !rom/<write-str>

	&macros ( t* -- )
	/req-name !macros/<new>

@runes/req-name ( str* -- str1* )
	INC2 LDAk #20 GTH ?{ ;dict/invalid ;dict/Name !err/<token> }
	JMP2r

@runes/lut [
	"| =&padabs "$ =&padrel
	"@ =&toplab "& =&sublab
	"% =&macros "( =&coment
	", =&litrel "_ =&rawrel
	". =&litzep "- =&rawzep
	"; =&litabs "= =&rawabs
	"? =&litjci "! =&litjmi
	"# =&lithex "" =&rawstr
	"} =&lambda "~ =&concat
	"[ =&ignore "] =&ignore ] $1

(
@|Opcodes )

@opcodes/is-opcode ( str* -- str* bool )
	DUP2 /parse #00 NEQ STH
	DUP2 ;&brk str/cmp STHr ORA JMP2r

@opcodes/parse ( str* -- byte )
	[ LIT2r 1f00 ] ;&lut
	&>w1
		SWP2k #0003 SWP2 mem/cmp ?{
			INCr #0003 ADD2 LDAk ?&>w1
		POP2 POP2 POP2r #00 JMP2r }
	POP2
	( mask ) ANDr
	( litk ) LDA2k [ LIT2 "LI ] EQU2 #70 SFT [ STH ORAr ]
	( move ) #0003 ADD2
	&>w2
		LDAk #21 LTH ?{
			( | parse modes )
			LDAk [ LIT "2 ] NEQ ?{ LITr 20 !&r }
			LDAk [ LIT "r ] NEQ ?{ LITr 40 !&r }
			LDAk [ LIT "k ] NEQ ?{ LITr 80 !&r }
			POP2 POPr #00 JMP2r
			&r ORAr INC2 !&>w2 }
	POP2 STHr JMP2r

@opcodes/lut [
	"LIT "INC "POP "NIP "SWP "ROT "DUP "OVR
	"EQU "NEQ "GTH "LTH "JMP "JCN "JSR "STH
	"LDZ "STZ "LDR "STR "LDA "STA "DEI "DEO
	"ADD "SUB "MUL "DIV "AND "ORA "EOR "SFT ]
	&brk "BRK $1

(
@|Lambda )

@lambda/make-name ( -- name* )
	[ LIT &count $1 ] INCk ,&count STR
	DUP [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2
	STA
	( >> )

@lambda/name ( id -- str* )
	DUP #04 SFT hexc SWP ,&id STR2
	;&sym JMP2r

@lambda/pop ( -- )
	,&ptr LDR2 #0001 SUB2 LDAk /name syms/<new>
	,&ptr STR2
	JMP2r
	&sym cebb
	&id ".. $1

(
@|Name )

%else-return ( bool -- ) {
	[ JMP JMP2r ] }

@name/<validate> ( name* -- name* )
	( not hex ) str/not-hex ?{ JMP2r }
	( not runic ) LDAk runes/find INC2 ORA ?{
		( not opcode ) opcodes/is-opcode else-return }
	;dict/invalid ;dict/Name !err/<token>

(
@|Macros )

@macros/<new> ( name* -- )
	name/<validate>
	DUP2 /find-name INC2 ORA ?&err-duplicate
	DUP2 syms/find-name INC2 ORA ?&err-duplicate
	/<push-word>
	#00 /<push-byte> !assembly/<set-macro>

@macros/find-name ( name* -- <addr>* )
	STH2
	,&ptr LDR2 ;&mem
	&>lf
		EQU2k ?&fail
		DUP2 STH2kr str/cmp ?{
			str/cap str/cap !&>lf
		&fail POP2 #ffff }
	NIP2 POP2r JMP2r

@macros/<push-word> ( t* -- )
	&>wp
		LDAk DUP ?{ POP POP2 JMP2r }
		/<push-byte>
		INC2 !&>wp

@macros/<push-byte> ( byte -- )
	[ LIT2 &ptr =&mem ] INC2k
	( | check overflow )
	DUP2 ;&memend LTH2 ?{
		( ! ) ;dict/exceeded ;dict/Macros err/<token> }
	,&ptr STR2
	STA
	JMP2r

@macros/<write> ( t* macro* -- )
	token/<new>
	str/cap
	&>wm
		LDAk DUP ?{ POP POP2 POP2 JMP2r }
		token/<push-byte>
		INC2 !&>wm

@macros/err-duplicate ( name* -- )
	POP2
	( ! ) ;dict/duplicate ;dict/Macro !err/<token>

(
@|Syms )

@syms/<new> ( name* -- )
	DUP2 /find-name INC2k ORA ?{
		( alloc ) POP2 .SymType/declared head/get !/<push-sym> }
	( | name* sym* -- )
	INC2k INC2 LDA .SymType/declared AND ?{
		( addr* ) head/get OVR2 STA2
		( type ) INC2 INC2 LDAk .SymType/declared ORA ROT ROT STA
		( name* ) POP2 JMP2r }
	POP2
	( >> )

@syms/err-duplicate ( name* -- )
	POP2
	( ! ) ;dict/duplicate ;dict/Symbol !err/<token>

@syms/find-name ( name* -- <sym>* )
	STH2
	;&ptr LDA2 ;&mem
	&>lfn
		EQU2k ?&fail
		DUP2 #0003 ADD2 STH2kr str/cmp ?{
			/next !&>lfn
		&fail POP2 #ffff }
	NIP2 POP2r JMP2r

@syms/find-addr ( addr* -- sym* )
	LDA2 STH2
	;&ptr LDA2 ;&mem
	&>lfa
		DUP2 /next LDA2 STH2kr SWP2 LTH2 ?{ /next GTH2k ?&>lfa }
	NIP2 POP2r JMP2r

@syms/find-alloc ( name* -- <addr>* )
	DUP2 /find-name INC2k ORA ?{
		( null* -> ptr* ) POP2 ,&ptr LDR2
		( alloc ) OVR2 .SymType/used #ffff /<push-sym> }
	NIP2 JMP2r

@syms/<push-sym> ( name* type addr* -- )
	( hb ) SWP /<push-byte>
	( lb ) /<push-byte>
	( type ) /<push-byte>
	name/<validate>
	DUP2 macros/find-name INC2 ORA ?&err-duplicate
	( >> )

@syms/<push-string> ( word* -- )
	LDAk /<push-byte>
	INC2 LDAk ?&<push-string>
	LDA
	( >> )

@syms/<push-byte> ( byte -- )
	[ LIT2 &ptr =&mem ] INC2k
	( | check overflow )
	DUP2 ;&memend LTH2 ?{
		( ! ) ;dict/exceeded ;dict/Symbols err/<token> }
	,&ptr STR2
	STA
	JMP2r

@syms/<emit> ( -- )
	;&ptr LDA2 ;&mem
	&>ls
		EQU2k ?{
			INC2k INC2 LDA .SymType/used AND ?{
				LDA2k #0100 EQU2 ?{
					DUP2 #0003 ADD2 LDAk [ LIT "A ] SUB #1a LTH ?{
						;dict/unused err/<pstr>
						DUP2 err/<pstr>
						#0a err/<pchr> }
					POP2 } }
			/next !&>ls }
	POP2 POP2 !rom/<emit>

@syms/next ( sym* -- next* )
	#0003 ADD2 !str/cap

@syms/byte-distance ( addr* -- addr* )
	DUP2 #0080 ADD2 POP ?{ JMP2r }
	( ! ) ;dict/too-far ;dict/Symbol !err/<token>

(
@|References )

@refs/get-any ( str* -- value* )
	str/not-hex ?/get-ref
	!str/hex

@refs/get-type ( token* type* -- addr* )
	,&type STR2
	( >> )

@refs/get-ref ( token* -- addr* )
	LDAk [ LIT "{ ] NEQ ?{ POP2 lambda/make-name }
	LDAk [ LIT "/ ] NEQ ?{ scope/make-name }
	LDAk [ LIT "& ] NEQ ?{ scope/make-name }
	( | find symbol or create it )
	syms/find-alloc
	( | check if declared )
	INC2k INC2 STH2k LDA .SymType/declared AND ?{
		DUP2 head/get
		( addr* ) /<push-short>
		( value* ) /<push-short>
		( type ) [ LIT2 &type $2 ] /<push-short> }
	( | mark as used )
	LDAkr STHr .SymType/used ORA STH2r STA
	LDA2 JMP2r

@refs/<push-short> ( value* -- )
	SWP /<push-byte>
	( >> )

@refs/<push-byte> ( byte -- )
	[ LIT2 &ptr =&mem ] INC2k
	( | check overflow )
	DUP2 ;&memend LTH2 ?{
		( ! ) ;dict/exceeded ;dict/References err/<token> }
	,&ptr STR2
	STA
	JMP2r

@refs/get-abs ( label* -- addr )
	;&handle-abs /get-type NIP JMP2r

@refs/get-abs2 ( label* -- addr* )
	;&handle-abs2 !/get-type

@refs/get-rel ( label* -- distance )
	;&handle-rel /get-type INC2k ORA ?{
		( undefined ) POP2 #00 JMP2r }
	head/get /get-distance syms/byte-distance NIP JMP2r

@refs/get-rel2 ( label* -- distance* )
	;&handle-rel2 /get-type head/get
	( >> )

@refs/get-distance ( a* b* -- distance* )
	INC2 INC2 SUB2 JMP2r

@refs/<resolve-all> ( -- )
	,&ptr LDR2 ;&mem
	&>l
		EQU2k ?{
			DUP2 ;&err STA2
			DUP2k #0004 ADD2 LDA2 JSR2
			( ) #0006 ADD2 !&>l }
	POP2 POP2 JMP2r

@refs/resolve-sym ( ref* -- ref* sym/addr* )
	LDA2k head/<set>
	( ref* sym* ) INC2k INC2 LDA2
	( ref* sym/addr* ) LDA2
	( ref* sym/addr* ) INC2k ORA ?{
		( ! ) ;dict/invalid /<error> }
	( ref* sym/addr* ) JMP2r

@refs/handle-abs ( ref* -- )
	/resolve-sym NIP2 NIP !rom/<write-byte>

@refs/handle-abs2 ( ref* -- )
	/resolve-sym NIP2 !rom/<write-short>

@refs/handle-rel ( ref* -- )
	/resolve-sym SWP2 LDA2 /get-distance /byte-distance NIP !rom/<write-byte>

@refs/handle-rel2 ( ref* -- )
	/resolve-sym SWP2 LDA2 /get-distance !rom/<write-short>

@refs/byte-distance ( addr* -- addr* )
	DUP2 #0080 ADD2 POP ?{ JMP2r }
	( ! ) ;dict/too-far
	( >> )

@refs/<error> ( adj* -- )
	[ LIT2 &err $2 ] DUP2 syms/find-addr #0003 ADD2 scope/<set>
	INC2 INC2 LDA2 #0003 ADD2 ;dict/Reference !err/<generic>

(
@|Rom )

@rom/<write-str> ( str* -- )
	LDAk /<write-byte>
	INC2 LDAk ?&<write-str>
	POP2 JMP2r

@rom/<write-opcode> ( str* -- )
	opcodes/parse !/<write-byte>

@rom/<write-lithex> ( str* -- )
	str/len #02 NEQ #50 SFT #80 ORA /<write-byte>
	( >> )

@rom/<write-rawhex> ( str* -- )
	str/not-hex ?{
		str/len DUP #02 NEQ ?{ POP str/hex NIP !/<write-byte> }
		#04 NEQ ?{ str/hex !/<write-short> } }
	POP2 ;dict/invalid ;dict/Number !err/<token>

@rom/<write-call> ( str* opc -- )
	/<write-byte>
	refs/get-rel2
	( >> )

@rom/<write-short> ( short* -- )
	SWP /<write-byte>
	( >> )

@rom/<write-byte> ( byte -- )
	DUP head/get-inc ;&mem ADD2 STA
	( not zero ) ?{ JMP2r }
	( test zep ) head/get OVR ?{
		( ! ) ;dict/zero-page ;dict/Writing err/<token> }
	DUP2 ;&length LDA2 GTH2 ?{ POP2 JMP2r }
	;&length STA2
	JMP2r

@head/get-inc ( -- addr* )
	[ LIT2 &addr 0100 ] INC2k ,&addr STR2
	JMP2r

@head/get ( -- addr* )
	,&addr LDR2 JMP2r

@head/<set-rel> ( addr* -- )
	/get ADD2
	( >> )

@head/<set> ( addr* -- )
	,&addr STR2
	JMP2r

(
@|Stdlib )

@hexc ( hex -- char )
	#0f AND #0a LTHk ?{
		SUB [ LIT "a ] ADD JMP2r }
	POP [ LIT "0 ] ADD JMP2r

@chex ( addr* -- addr* <val> )
	LDAk
	( dec ) [ LIT "0 ] SUB DUP #09 GTH else-return
	( hex ) #27 SUB DUP #0a SUB #05 GTH else-return
	( nil ) POP #ff JMP2r

@str/hex ( str* -- value* )
	[ LIT2r 0000 ]
	&>wh
		[ LITr 40 ] SFT2r chex [ LITr 00 ] STH
		ADD2r INC2 LDAk ?&>wh
	POP2 STH2r JMP2r

@str/len ( str* -- str* length )
	DUP2k /cap SWP2 INC2 SUB2 NIP JMP2r

@str/not-hex ( str* -- str* f )
	DUP2
	&>wih
		chex INC ?{ LDA JMP2r }
		INC2 !&>wih

@str/cap ( str* -- end* )
	LDAk ?{ INC2 JMP2r }
	INC2 !/cap

@str/cmp ( a* b* -- bool )
	DUP2k /cap SWP2 SUB2 SWP2
	( >> )

@mem/cmp ( a* length* b* -- t )
	STH2
	OVR2 ADD2 SWP2
	&>l
		EQU2k ?{
			LDAk LDAkr STHr NEQ ?{ INC2 INC2r !&>l } }
	POP2r EQU2 JMP2r

(
@|Error )

@err/<token> ( adj* topic* -- )
	;token/buf SWP2
	( >> )

@err/<generic> ( adj* keyword* topic* -- )
	.System/state DEI ?{
		/<pstr>
		#20 /<pchr>
		SWP2 /<pstr>
		;dict/spacer /<pstr>
		/<pstr>
		;dict/in /<pstr>
		;scope/buf /<pstr>
		#0a /<pchr>
		[ LIT2 01 -System/state ] DEO
		JMP2r }
	POP2 POP2 POP2 JMP2r

@err/<pstr> ( str* -- )
	&>w
		LDAk DUP ?{ POP POP2 JMP2r }
		/<pchr>
		INC2 !&>w

@err/<pdec> ( short* -- )
	[ LIT2r ff00 ]
	&>read
		#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read
	POP2
	&>write
		NIP #30 ADD /<pchr>
		OVRr ADDr STHkr ?&>write
	POP2r JMP2r

@dict/assembled "Assembled $1 &in 20 "in 20 $1 &bytes 20 "bytes. 0a $1
	&unused "-- 20 "Unused
	&spacer ": 20 $1
	&References "References $1
	&Reference "Reference $1
	&Symbols "Symbols $1
	&Symbol "Symbol $1
	&Macros "Macros $1
	&Macro "Macro $1
	&Name "Name $1
	&Number "Number $1
	&Comment "Comment $1
	&Writing "Writing $1
	&exceeded "exceeded $1
	&invalid "invalid $1
	&zero-page "in 20 "zero-page $1
	&duplicate "duplicate $1
	&too-far "too 20 "far $1
	&open "open $1
	&trail ".. $1
	&reset "RESET $1

(
@|Buffers )

@macros/mem ( name..00, value..00 )
	$1000 &memend

@lambda/mem $100

@refs/mem ( addr*, symbol*, type-fn* )
	$1800 &memend

@syms/mem ( addr*, SymType, body..00 )
	$4800 &memend

@rom/mem ( zeropage )
	$100
	&output
(
@|Enums )


|00 @SymType/empty $1 &used $1 &declared