( uxncli drifblim.rom source.tal application.rom )

|10 @Console &vector $2 &read $1 &pad $5 &write $1 &err $1
|a0 @File1 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @File2 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|0000

	@src $30
	@dst $30

|0100 ( -> )

	;&await .Console/vector DEO2 ;dict/input pstr BRK
	&await ( -> ) .Console/read DEI .src skey ?ready-dst BRK
	@ready-dst ( -> ) ;&await .Console/vector DEO2 ;dict/output pstr BRK
	&await ( -> ) .Console/read DEI .dst skey ?on-ready

BRK

@on-ready ( -> )

	#0a18 DEO
	;src ;dst assemble
	save-symbols
	print-summary
	( debug ) #010e DEO
	( halt ) #800f DEO

BRK

@on-error ( id* name* -> )

	#01 .File2/delete DEO
	#0a18 DEO
	( print ) ;err pstr pstr #2018 DEO pstr ;dict/in pstr ;scope pstr ;dict/dot pstr
	( halt ) #010f DEO

BRK

(
@|generics )

@assemble ( src* dst* -- )

	( prepare output )
	.File2/name DEO2
	#01 .File2/delete DEO
	#0001 .File2/length DEO2
	( pass1 ) DUP2 handle-top
	( pass2 ) #00 ;write/skip STA

@handle-top ( f* -- )

	#0100 set-head
	;dict/reset ;scope scpy

@handle-file ( f* -- )

	.File1/name DEO2
	#0001 .File1/length DEO2
	&s
		;&c .File1/read DEO2
		.File1/success DEI2 ORA ?&continue
			,&c LDR #00 EQU ?&err JMP2r
		&continue [ LIT &c $1 ] handle-char
!&s
	&err .File1/name DEI2 ;err/source !on-error

@handle-char ( c -- )

	#20 GTHk NIP ?&append POP
	;token LDAk ?&run POP2

JMP2r
	&append ( c -- ) ;token DUP2 slen #001f LTH2 ?sput POP JMP2r
	&run ( t* -- ) DUP2 handle-token !sclr

@handle-token ( t* -- )

	LDAk LIT "( EQU ?&on-parens
	LDAk LIT ") EQU ?&on-parens
	[ LIT &sleep $1 ] ?&on-sleep

!parse
	&on-parens ( t* -- ) LDA LIT "( EQU ,&sleep STR JMP2r
	&on-sleep ( t* -- ) POP2 JMP2r

(
@|core )

@parse ( t* -- )

	LDAk ,&rune STR
	( runes )
	;runes/err ;runes
	&l
		LDAk [ LIT &rune $1 ] NEQ ?&no-runic
			NIP2 INC2 LDA2 JMP2
			&no-runic
		#0003 ADD2 GTH2k ?&l
	POP2 POP2
	( non-runic )
	DUP2 is-hex ?lib/rawhex
	DUP2 is-opcode ?lib/opcode

!lib/litjsi

@lib
	&padabs INC2 get-hex write-pad !set-head
	&padrel INC2 get-hex !write-fill
	&toplab INC2 ;scope OVR2 SWP2 scpy !create-label
	&sublab INC2 make-sublabel !create-label
	&litrel #80 write
	&rawrel INC2 get-ref get-rel INC !write
	&litzep #80 write
	&rawzep INC2 get-ref LDA2 NIP !write
	&litabs #a0 write
	&rawabs INC2 get-ref LDA2 !write-short
	&litjci #20 write INC2 !write-call
	&litjmi #40 write INC2 !write-call
	&litjsi #60 write !write-call
	&lithex INC2 DUP2 slen NIP #02 SFT #a080 ROT [ JMP SWP POP ] write
	&rawhex !write-hex
	&rawstr INC2 !write-str
	&opcode find-opcode !write
	&inc INC2k ;include STH2k scpy sclr STH2r !handle-file
	&ignore POP2 JMP2r

(
@|primitives )

@write-pad ( addr* -- dest* )

	;write/head LDA2
	LTH2k ?&no-pad
		SUB2k write-fill POP2 JMP2r
		&no-pad
	OVR2 #0100 LTH2 ?&no-err
		;token ;err/rewind !on-error
		&no-err
	POP2

JMP2r

@write-fill ( len* -- )

	#0000 EQU2k ?&skip
	&l
		#00 write
		INC2 GTH2k ?&l
	&skip
	POP2 POP2

JMP2r

@write-str ( str* -- )

	&w
		LDAk write
		INC2 LDAk ?&w
	POP2

JMP2r

@write-call ( str* -- )

	get-ref LDA2 ;write/head LDA2 INC2 INC2 SUB2

!write-short

@write-hex ( str* -- )

	DUP2 slen OVR2 get-hex SWP2 NIP
	DUP #02 EQU ?&byte
	DUP #04 EQU ?&short
	POP POP2
	;err/number !on-error
	&byte POP NIP2 NIP !write
	&short POP NIP2 ( fall through )

@write-short ( short* -- )

	SWP write

@write ( byte -- )

	,&b STR
	[ LIT2 &head 0100 ] #0100 LTH2 ?&ignore
	[ LIT &skip 01 ] ?&pass1
	[ LIT2 &length $2 ] ,&head LDR2 LTH2 ?&ignore
	( pass2 ) ;&b .File2/write DEO2
	&ignore

!move-head

&pass1 ( -- )

	[ LIT &b $1 ] #00 EQU ?&no-record
		,&head LDR2 ;write/length STA2
		&no-record

( >> )

@move-head ( -- )

	;write/head LDA2 INC2

@set-head ( v* -- )

	;write/head STA2

JMP2r

(
@|labels )

@get-ref ( token* -- <label*> )

	;write/skip LDA #00 EQU ?&no-write
		POP2 ;&fill JMP2r
		&no-write
	LDAk LIT "& NEQ ?&no-sub
		INC2 make-sublabel
		&no-sub
	find-label
		INC2k ORA ?&found
			POP2 ;err/reference !on-error
			&found
	( count )
	INC2k INC2 LDAk INC ROT ROT STA

JMP2r
	&fill ffff "[empty] $1

@create-label ( name* -- )

	;write/skip LDA #00 EQU ?&skip
	( not hex ) DUP2 is-hex ?&invalid
	( not opc ) DUP2 is-opcode ?&invalid
	( not dup ) DUP2 find-label INC2 ORA ?&not-unique
	( save addr ) ;write/head LDA2 [ LIT2 &ptr =symbols ] STH2k STA2
	( move ) INC2r INC2r INC2r
	( save name ) DUP2 STH2kr scpy
	( move ) slen STH2r ADD2 INC2 ,&ptr STR2
	( stats ) [ LIT2 &count $2 ] INC2 ,&count STR2

JMP2r
	&invalid ;err/invalid !on-error
	&not-unique ;err/duplicate !on-error
	&skip POP2 JMP2r

@make-sublabel ( name* -- sublabel* )

	;scope ;sublabel STH2k scpy
	LIT "/ STH2kr sput
	STH2kr scat
	STH2r

JMP2r

@find-label ( name* -- <addr*> )

	STH2
	;symbols
	&w
		#0003 ADD2 DUP2 STH2kr scmp ?&found
		scap INC2 INC2k INC2 INC2 LDA ?&w
	POP2
	POP2r
	#ffff

JMP2r
	&found #0003 SUB2 POP2r JMP2r

(
@|helpers )

@get-hex ( str* -- value* )

	DUP2 is-hex ?&valid
		;err/number !on-error
		&valid

!shex

@get-rel ( label* -- distance )

	;write/skip LDA ?&fill
	LDA2k ;write/head LDA2 SUB2 #0003 SUB2
	DUP2 #0080 ADD2 POP ?&fail
	NIP2 NIP

JMP2r
	&fail POP2 #0003 ADD2 ;err/distance !on-error
	&fill POP2 #ff JMP2r

@is-hex ( str* -- f )

	&w
		LDAk chex INC ?&valid
			POP2 #00 JMP2r &valid
		INC2 LDAk ?&w
	POP2
	#01

JMP2r

@is-opcode ( string* -- f )

	DUP2 ;opcodes/brk scmp3 ?find-opcode/on-brk

@find-opcode ( name* -- byte )

	STH2
	#2000
	&l
		#00 OVR #03 MUL ;opcodes ADD2 STH2kr scmp3 ?&on-found
		INC GTHk ?&l
	POP2 POP2r #00

JMP2r
	&on-found
		NIP ( LITk ) DUP #00 EQU #70 SFT ADD
		STH2r #0003 ADD2 find-modes ADD JMP2r
	&on-brk POP2 #01 JMP2r

@find-modes ( mode* -- byte )

	LITr 00
	&w
		LDAk #20
		OVR LIT "2 EQU ?&end DUP ADD
		OVR LIT "r EQU ?&end DUP ADD
		OVR LIT "k EQU ?&end DUP ADD
		OVR #21 LTH ?&end
			;token ;err/mode !on-error
		&end NIP STH ORAr
		INC2 LDAk ?&w
	POP2 STHr

JMP2r

@print-summary ( -- )

	;create-label/ptr LDA2 ;symbols
	&l
		INC2k INC2 LDA ?&skip
		#0003 ADD2 LDAk LIT "A SUB #1a LTH ?&skip
			;dict/unused pstr DUP2 pstr #0a18 DEO
		&skip scap INC2 GTH2k ?&l
	POP2 POP2
	( result )
	;dict/assembled pstr ;src pstr
	;dict/spacer pstr ;dst pstr
	( length )
	;dict/in pstr ;write/length LDA2 #00ff SUB2 pdec ;dict/bytes pstr
	;create-label/count LDA2 pdec ;dict/labels pstr
	;dict/end

!pstr

@save-symbols ( -- )

	;dst
		DUP2 scap ;dict/sym-ext OVR2 scpy
		SWP2 .File1/name DEO2
	;symbols
	&l
		( addr )
		#0002 .File1/length DEO2
		DUP2 .File1/write DEO2
		( name )
		#0003 ADD2
			DUP2 slen INC2 STH2k .File1/length DEO2
			DUP2 .File1/write DEO2
		STH2r ADD2 DUP2 #0003 ADD2 LDA ?&l
	POP2
	#00 ROT ROT STA

JMP2r

(
@|stdlib )

@pstr ( str* -- ) LDAk ?&w POP2 JMP2r &w LDAk #18 DEO INC2 LDAk ?&w POP2 JMP2r
@scap ( str* -- end* ) LDAk ?&w JMP2r &w INC2 LDAk ?&w JMP2r
@sput ( chr str* -- ) scap INC2k #00 ROT ROT STA STA JMP2r
@slen ( str* -- len* ) DUP2 scap SWP2 SUB2 JMP2r
@scat ( src* dst* -- ) scap
@scpy ( src* dst* -- ) OVR2 LDA ?&e POP2 POP2 JMP2r &e STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ?&w POP2 #00 STH2r STA JMP2r
@sclr ( str* -- ) LDAk ?&w POP2 JMP2r &w STH2k #00 STH2r STA INC2 LDAk ?&w POP2 JMP2r
@skey ( key buf -- proc ) OVR #21 LTH ?&eval #00 SWP sput #00 JMP2r &eval POP2 #01 JMP2r
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ?&e NEQk ?&e POP2 INC2 INC2r !&l &e NIP2 POP2r EQU JMP2r
@scmp3 ( a* b* -- f ) LDA2k ROT2 LDA2k ROT2 EQU2 STH INC2 LDA2 SWP2 INC2 LDA2 EQU2 STHr AND JMP2r
@chex ( c -- val|ff ) LIT "0 SUB DUP #09 GTH [ JMP JMP2r ] #27 SUB DUP #0f GTH [ JMP JMP2r ] POP #ff JMP2r
@shex ( str* -- val* ) LIT2r 0000 &w LITr 40 SFT2r LITr 00 LDAk chex STH ADD2r INC2 LDAk ?&w POP2 STH2r JMP2r

@pdec ( short* -- )

	#00 ,&z STR
	#2710 pdec/parse
	#03e8 pdec/parse
	#0064 pdec/parse
	#000a pdec/parse
	NIP #30 ADD #18 DEO

JMP2r

&parse ( short* den* -- short* )

	DIV2k DUPk [ LIT &z $1 ] EQU ?&skip
	DUP #30 ADD #18 DEO #ff ,&z STR
	&skip POP MUL2 SUB2

JMP2r

(
@|assets )

@dict
	&input "Input(.tal): 20 $1
	&output "Output(.rom): 20 $1
	&assembled "Assembled 20 $1
	&reset "INIT $1
	&spacer 20 "-> 20 $1
	&in ", 20 "in 20 $1
	&bytes 20 "bytes( $1
	&end ") &dot ". 0a $1
	&labels 20 "labels $1
	&unused "-- 20 "Unused 20 "label: 20 $1
	&sym-ext ".sym $1

@err "!! 20 "Error: 20 $1
	&source "Source $1
	&duplicate "Duplicate $1
	&number "Number $1
	&reference "Reference $1
	&distance "Distance $1
	&invalid "Invalid $1
	&mode "Mode $1
	&rewind "Rewind $1

@opcodes
	"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

@runes
	"| =lib/padabs "$ =lib/padrel
	"@ =lib/toplab "& =lib/sublab
	", =lib/litrel "_ =lib/rawrel
	". =lib/litzep "- =lib/rawzep
	"; =lib/litabs "= =lib/rawabs
	"? =lib/litjci "! =lib/litjmi
	"[ =lib/ignore "] =lib/ignore
	"# =lib/lithex "" =lib/rawstr
	"~ =lib/inc
	&err

(
@|memory )

@token $20
@scope $20
@sublabel $20
@include $30
@symbols ( addr*, refs, name[], 00 )