~rabbits/drifblim

c66c1a9f68e91165a4f1c70339c36858c155e45b — Devine Lu Linvega 2 months ago edbfcbb 
Revamped assembler
patch browse .tar.gz 
4 files changed, 622 insertions(+), 750 deletions(-)

A examples/catclock.tal
M examples/hello.tal
M src/drifblim.tal
D src/symbols.tal

A examples/catclock.tal => examples/catclock.tal +418 -0
@@ 0,0 1,418 @@
( catclock )

|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1

|0000

@timer
	&frame $1 &anim $1 &last $1
@center
	&x $2 &y $2
@line
	&x $2 &y $2 &dx $2 &dy $2 &e1 $2
@needles
	&hx $2 &hy $2
	&mx $2 &my $2
	&sx $2 &sy $2

(
@|vectors )

|0100 ( -> )

	( meta )
	;meta #06 DEO2

	( theme )
	#0ff0 .System/r DEO2
	#0f00 .System/g DEO2
	#0f00 .System/b DEO2

	( vectors )
	;on-frame .Screen/vector DEO2

	( resize )
	#0060 .Screen/width DEO2
	#00c0 .Screen/height DEO2

	( center )
	.Screen/width DEI2 #01 SFT2 .center/x STZ2
	.Screen/height DEI2 #01 SFT2 #0018 ADD2 .center/y STZ2

	( init )
	#05 .timer/frame STZ
	;clear-screen JSR2
	.center/y LDZ2 #0050 SUB2 .Screen/y DEO2
	#08 ;spritesheet/head ;draw-body JSR2

@on-frame ( -> )

	( once per second )
	.DateTime/second DEI
	DUP .timer/last LDZ EQU ,&same-sec JCN
		;make-needles JSR2
		;draw-needles JSR2
		DUP .timer/last STZ
		&same-sec
	POP
	( every 5th frame )
	.timer/frame LDZ #05 NEQ ,&no-anim JCN
		.timer/anim LDZ ;draw-animation JSR2
		.timer/anim LDZk INC #0f AND SWP STZ
		#00 .timer/frame STZ
		&no-anim
	( incr timer )
	.timer/frame LDZk INC SWP STZ

BRK

@meta 00
	( name ) "Catclock 0a
	( details ) "Tic 20 "Tac 20 "Cat 20 "Clock 0a
	( author ) "By 20 "Hundred 20 "Rabbits 0a
	( date ) "Jan 20 "8, 20 "2023 00
	02
		( icon ) 83 =appicon
		( mask ) 41 1705

(
@|helpers )

@make-needles ( -- )

	[ #00 .DateTime/second DEI ] DUP2 ADD2 ;sin60 ADD2 LDA2
		#0090 ,circle JSR .needles/sx STZ2 .needles/sy STZ2
	[ #00 .DateTime/minute DEI ] DUP2 ADD2 ;sin60 ADD2 LDA2
		#0090 ,circle JSR .needles/mx STZ2 .needles/my STZ2
	[ #00 .DateTime/hour DEI #0c ( mod ) DIVk MUL SUB #20 SFTk NIP ADD ]
	[ #00 .DateTime/minute DEI #0f DIV ADD2 ] DUP2 ADD2 ;sin60 ADD2 LDA2
		#00b0 ,circle JSR .needles/hx STZ2 .needles/hy STZ2

JMP2r

@circle ( cx cy radius* -- y* x* )

	STH2 SWP
	#00 SWP #40 SFT2 STH2kr DIV2 .center/x LDZ2 ADD2 #0800 STH2kr DIV2 SUB2
	STH2 SWP2r
	#00 SWP #40 SFT2 STH2kr DIV2 .center/y LDZ2 ADD2 #0800 STH2kr DIV2 SUB2
	POP2r STH2r

JMP2r

@draw-animation ( state -- )

	DUP STHk
	#04 .Screen/auto DEO
	( eyes )
	( reverse ) DUP #08 LTH ,&no-rev JCN #0f SWP SUB &no-rev
	#0c MUL #00 SWP #30 SFT2 ;spritesheet/eyes ADD2 .Screen/addr DEO2
	#0c00
	&loop-eyes
		DUP #06 ( mod ) DIVk MUL SUB #00 SWP #30 SFT2 .center/x LDZ2 #0018 SUB2 ADD2 .Screen/x DEO2
		DUP #06 DIV #00 SWP #30 SFT2 .center/y LDZ2 #0030 SUB2 ADD2 .Screen/y DEO2
		#01 .Screen/sprite DEO
		INC GTHk ,&loop-eyes JCN
	POP2

	STHr #07 GTH ,&tail-reverse JCN

	( tail )

	#0c MUL #00 SWP #30 SFT2 ;spritesheet/tail ADD2 .Screen/addr DEO2
	#0c00
	&loop-tail
		#00 OVRk
			( x ) #03 AND #30 SFT2 .center/x LDZ2 ADD2 #0010 SUB2 .Screen/x DEO2
			( y ) #32 SFT2 .center/y LDZ2 ADD2 #0015 ADD2 .Screen/y DEO2
		#04 .Screen/sprite DEO
		INC GTHk ,&loop-tail JCN
	POP2

JMP2r

&tail-reverse ( state -- )

	#07 AND #0c MUL #00 SWP #30 SFT2 ;spritesheet/tail ADD2 .Screen/addr DEO2
	#0c00
	&loop-tail-reverse
		#00 OVRk
			( x ) #03 AND [ #04 SWP SUB ] #30 SFT2 .center/x LDZ2 ADD2 #0018 SUB2 .Screen/x DEO2
			( y ) #32 SFT2 .center/y LDZ2 ADD2 #0015 ADD2 .Screen/y DEO2
		#14 .Screen/sprite DEO
		INC GTHk ,&loop-tail-reverse JCN
	POP2

JMP2r

@draw-needles ( mask -- )

	.center/y LDZ2 #0010 SUB2 .Screen/y DEO2
	#05 ;spritesheet/body ;draw-body JSR2
	( draw )
	#00 .Screen/auto DEO
	.center/x LDZ2 .center/y LDZ2
		OVR2 OVR2 .needles/sx LDZ2 .needles/sy LDZ2 #02 ,draw-line JSR
		OVR2 OVR2 .needles/mx LDZ2 .needles/my LDZ2 #00 ,draw-line JSR
		OVR2 OVR2 .needles/hx LDZ2 .needles/hy LDZ2 #00 ,draw-line JSR
	( middle )
	#0001 SUB2 .Screen/y DEO2
	#0001 SUB2 .Screen/x DEO2
	;middle-icn .Screen/addr DEO2
	#0a .Screen/sprite DEO

JMP2r

@draw-body ( height addr* -- )

	#76 .Screen/auto DEO
	.center/x LDZ2 #0020 SUB2 .Screen/x DEO2
	.Screen/addr DEO2
	#00
	&ver
		#04 .Screen/sprite DEO
		INC GTHk ,&ver JCN
	POP2

JMP2r

@draw-line ( x1* y1* x2* y2* color -- )

	( load ) STH ,&y STR2 ,&x STR2 .line/y STZ2 .line/x STZ2
	,&x LDR2 .line/x LDZ2 SUB2 ;abs2 JSR2 .line/dx STZ2
	#0000 ,&y LDR2 .line/y LDZ2 SUB2 ;abs2 JSR2 SUB2 .line/dy STZ2
	#ffff #00 .line/x LDZ2 ,&x LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sx STR2
	#ffff #00 .line/y LDZ2 ,&y LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sy STR2
	.line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
	&loop
		.line/x LDZ2 DUP2 .Screen/x DEO2 [ LIT2 &x $2 ] EQU2
		.line/y LDZ2 DUP2 .Screen/y DEO2 [ LIT2 &y $2 ] EQU2
			STHkr .Screen/pixel DEO
			AND ,&end JCN
		.line/e1 LDZ2 DUP2 ADD2 DUP2
		.line/dy LDZ2 ;lts2 JSR2 ,&skipy JCN
			.line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
			.line/x LDZ2 [ LIT2 &sx $2 ] ADD2 .line/x STZ2
		&skipy
		.line/dx LDZ2 ;gts2 JSR2 ,&skipx JCN
			.line/e1 LDZ2 .line/dx LDZ2 ADD2 .line/e1 STZ2
			.line/y LDZ2 [ LIT2 &sy $2 ] ADD2 .line/y STZ2
		&skipx
		,&loop JMP
	&end
	POPr

JMP2r

@clear-screen ( -- )

	.Screen/width DEI2 #03 SFT2 NIP ,&x STR
	.Screen/height DEI2 #02 SFT2 NIP ,&y STR
	;fill-icn .Screen/addr DEO2
	#0000 DUP2 .Screen/x DEO2 .Screen/y DEO2
	#11 .Screen/auto DEO
	[ LIT &y $1 ] #00
	&v
		[ LIT &x $1 ] #00
		&h
			#01 .Screen/sprite DEO
			INC GTHk ,&h JCN
		POP2
		#0000 .Screen/x DEO2
		.Screen/y DEI2k #0010 ADD2 ROT DEO2
		INC GTHk ,&v JCN
	POP2

JMP2r

(
@|stdlib )

@abs2 DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 JMP2r
@lts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
@gts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r

(
@|tables )

@sin60 ( 60 positions on a circle )
	8000 8d00 9a02 a706 b40b c011 cb18 d520
	df2a e734 ee40 f44b f958 fd65 ff72 ff80
	ff8d fd9a f9a7 f4b4 eec0 e7cb dfd5 d5df
	cbe7 c0ee b4f4 a7f9 9afd 8dff 80ff 72ff
	65fd 58f9 4bf4 40ee 34e7 2adf 20d5 18cb
	11c0 0bb4 06a7 029a 008d 0080 0072 0265
	0658 0b4b 113f 1834 202a 2a20 3418 3f11
	4b0b 5806 6502 7200

(
@|assets )

@middle-icn
	40e0 4000 0000 0000
@fill-icn
	ffff ffff ffff ffff

@spritesheet
	&head ( 08 x 0d )
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0103 070f 0f1f 0000 80c0 c0e0 e0f0
	0000 0103 0307 070f 0000 80c0 e0f0 f0f8
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0001
	3f3f 7f7f 7fff fffd f0f0 f8f8 fcfc fefe
	0f0f 1f1f 3f3f 7f7f fcfc fefe feff ffbf
	0000 0000 0000 0080 0000 0000 0000 0000
	0000 0001 0101 0000 0101 01c1 e1f3 f77f
	fcfc f8f8 ffff ffff ffff 7f7f ffff ffff
	ffff fefe ffff ffff 3f3f 1f1f ffff ffff
	8080 8083 87cf effe 0000 0080 8080 0000
	0707 0703 0001 0307 3fbf ffff ffff ffff
	ffff ffff ffff ff0f ffff ffff efc7 efff
	ffff ffff f7e3 f7ff ffff ffff ffff fff0
	fcfd ffff ffff ffff e0e0 e0c0 0080 c0e0
	070f 1f1f 3f3f 3f3f f800 0000 0000 0000
	0000 0000 0000 0000 ff00 0000 0000 0000
	ff00 0000 0000 0000 0000 0000 0000 0000
	1f00 0000 0000 0000 e0f0 f8f8 fcfc fcfc
	3f3f 3f3f 3f3f 3f20 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 fcfc fcfc fcfc fc04
	1010 0908 0402 0100 0010 8c03 4090 10c0
	0000 01fe 0000 0102 0049 8600 0000 e017
	0092 6100 0000 07e8 0000 807f 0000 8040
	0008 31c0 0209 0803 0808 9010 2040 8000
	0000 0000 0000 0000 3807 0001 0608 1020
	02fe 9e26 0f07 0f7f 0808 3808 088f f000
	1010 1c10 10f1 0f00 407f 7964 f0e0 f0fe
	1ce0 0080 6010 0804 0000 0000 0000 0000
	&body
	0000 0000 0000 0000 4041 8387 4f3f 1f3f
	fcf8 f1e1 c181 0100 0202 4242 4240 4000
	c020 6181 e101 0100 3f1f 0f07 0301 0000
	0282 c1e1 f2fc f8fc 0000 0000 0000 0000
	0000 0000 0000 0000 3e7e 7c7c fcf8 f8f9
	4854 5454 4800 8040 0000 0000 0000 0000
	0000 0000 0000 0000 1804 0c10 1c00 0300
	7c7e 3e3e 3f1f 1f9f 0000 0000 0000 0000
	0000 0000 1f28 2430 f8f8 f8f8 7cfc 7c3e
	c040 8000 0010 2810 0000 0000 0000 0000
	0000 0000 0000 0000 0300 0300 0004 0c14
	1f9f 1f1f 3e3f 3e7c 0000 0000 f814 240c
	2810 1008 0402 0100 1e0f 0733 3919 8163
	2810 80c0 e0f0 f8fe 0000 7010 2141 4100
	0000 03c2 0380 4380 1e04 8103 078f 1f7f
	78f0 e0cc 9c98 81c6 1408 0810 2040 8000
	0000 0000 0000 0000 1c00 0000 0000 0000
	ff7f 1f07 0000 0000 e0ff ffff ff00 0000
	07ff ffff ff00 0000 fffe f8e0 0000 0000
	3800 0000 0000 0000 0000 0000 0000 0000
	&eyes
	0f3f 7361 c1c3 c3c3 ffff ffff ffff ffff
	80c0 e0f0 f0f0 f8fb 0103 070e 0c1c 1cdc
	ffff 3f1f 1f3f 3f3f f0fc fefe ffff ffff
	c3c3 c3c3 c161 73bf ffff ffff ffff ffff
	fbfb fbfb f7f6 efde dcdc dcdc ec6e f77b
	3f3f 3f3f 1f1f 3fff ffff ffff fefe fdff
	0f3f 7970 e0e1 e1e1 ffff ffff ffff ffff
	80c0 e0f0 f0f0 f8fb 0103 070f 0e1e 1ede
	ffff 9f0f 0f1f 1f1f f0fc fefe ffff ffff
	e1e1 e1e1 e070 79bf ffff ffff ffff ffff
	fbfb fbfb f7f6 efde dede dede ee6f f77b
	1f1f 1f1f 0f0f 9fff ffff ffff fefe fdff
	0f3f 7e7c f8f8 f8f8 ffff 7f3f 3f3f 3f3f
	80c0 e0f0 f0f0 f8fb 0103 070f 0f1f 1fdf
	ffff e7c3 8383 8383 f0fc fefe ffff ffff
	f8f8 f8f8 f87c 7ebf 3f3f 3f3f 3f3f 7fff
	fbfb fbfb f7f6 efde dfdf dfdf ef6f f77b
	8383 8383 83c3 e7ff ffff ffff fefe fdff
	0f3f 7f7f fefe fefe ffff 9f0f 0707 0707
	80c0 e0f0 f0f0 f8fb 0103 070f 0f1f 1fdf
	ffff f9f0 e0e0 e0e0 f0fc fefe 7f7f 7f7f
	fefe fefe fe7f 7fbf 0707 0707 070f 9fff
	fbfb fbfb f7f6 efde dfdf dfdf ef6f f77b
	e0e0 e0e0 e0f0 f9ff 7f7f 7f7f 7efe fdff
	0f3f 7f7f ffff ffff ffff e7c3 c1c1 c1c1
	80c0 e0f0 f0f0 f8fb 0103 070f 0f1f 1fdf
	ffff fefc fcfc fcfc f0fc 7e3e 1f1f 1f1f
	ffff ffff ff7f 7fbf c1c1 c1c1 c1c3 e7ff
	fbfb fbfb f7f6 efde dfdf dfdf ef6f f77b
	fcfc fcfc fcfc feff 1f1f 1f1f 1e3e 7dff
	0f3f 7f7f ffff ffff ffff f9f0 f0f0 f8f8
	80c0 e0f0 7070 787b 0103 070f 0f1f 1fdf
	ffff ffff ffff ffff f0fc 9e0e 0787 8787
	ffff ffff ff7f 7fbf f8f8 f8f0 f0f0 f9ff
	7b7b 7b7b 77f6 efde dfdf dfdf ef6f f77b
	ffff ffff ffff ffff 8787 8707 060e 9dff
	0f3f 7f7f ffff ffff ffff fcf8 f8fc fcfc
	80c0 e070 3030 383b 0103 070f 0f1f 1fdf
	ffff ffff ffff ffff f0fc ce86 83c3 c3c3
	ffff ffff ff7f 7fbf fcfc fcfc f8f8 fcff
	3b3b 3b3b 3776 efde dfdf dfdf ef6f f77b
	ffff ffff ffff ffff c3c3 c3c3 8286 cdff
	0f3f 7f7f ffff ffff ffff fefc fcfe fefe
	80c0 6030 1010 181b 0103 070f 0f1f 1fdf
	ffff ffff ffff ffff f0fc e6c2 c1e1 e1e1
	ffff ffff ff7f 7fbf fefe fefe fcfc feff
	1b1b 1b1b 1736 6fde dfdf dfdf ef6f f77b
	ffff ffff ffff ffff e1e1 e1e1 c0c2 e5ff
	&tail
	0000 0000 0000 0000 0101 0303 0303 0303
	0080 80c0 c0c0 c0c0 0000 0000 0000 0000
	0000 0000 0000 0000 0303 0303 0707 0707
	c0c0 c0c0 e0e0 e0e0 0000 0000 0000 0000
	0000 0000 0000 0000 0707 0707 0301 0000
	e0e0 e0e0 c080 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0103 070f 1f1e 3e3c
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 7c7c 7cfc fcfc fefe
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 7f7f 3f1f 0e00 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0001 0303 0107 1f7f fefc f8f0
	0080 8000 0000 0000 0000 0000 0000 0000
	0707 0707 0707 0707 f0e0 e0e0 e0f0 f0f0
	0000 0000 0000 0000 0000 0000 0000 0000
	0303 0100 0000 0000 f0f0 e000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0007 1f3f 7f7f 0107 ffff fef8 e000
	0080 8000 0000 0000 0000 0000 0000 0000
	fefc fcfe fefe 7e3c 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 071f 3f7f fffe 01ff ffff fec0 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	fcfc fefe fe7c 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0103 0707 0f1f 3efe
	0080 8000 0000 0000 0000 0000 0000 0000
	033f 7fff ffff 7e00 fcfc f8f0 e080 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0103 0303 0707 0f0f
	0080 8080 8000 0000 0000 0000 0000 0000
	0000 0000 0107 0f1f 1f3f 7efe fcfc f8f8
	0000 0000 0000 0000 0000 0000 0000 0000
	1f1f 0f00 0000 0000 f0c0 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0101 0103 0303 0707
	0080 8080 8080 8080 0000 0000 0000 0000
	0000 0000 0000 0103 0f1f 1f3f 7fff fefc
	8080 8000 0000 0000 0000 0000 0000 0000
	0707 0707 0300 0000 fcf8 f0e0 8000 0000
	0000 0000 0000 0000 0000 0000 0000 0000

@appicon ( 3x3 )
0000 0000 0000 0000 1f7f 7fff ffff ffff 0000 0000 0000 0000 ffff ffff ffff ffff 
0000 0000 0000 0000 f8fe feff ffff ffff 0000 0000 0000 0000 ffff ffff ffff ffff 
0018 0018 0099 6600 ffff ffff ffff ffff 0000 0000 0000 0000 ffff ffff ffff ffff 
0000 0000 0000 0000 ffff ffff ff7f 7f1f 0000 0000 0000 0000 ffff ffff ffff ffff 
0000 0000 0000 0000 ffff ffff fffe fef8



M examples/hello.tal => examples/hello.tal +1 -1
@@ 6,7 6,7 @@

	&while
		( send ) LDAk #18 DEO
		( loop ) INC2 LDAk ?&while
		( loop ) INC2 LDAk ,&while JCN
	POP2

	#010f DEO


M src/drifblim.tal => src/drifblim.tal +203 -282
@@ 1,4 1,4 @@
( Usage: uxncli driflim.rom src.tal dst.rom )
( uxnasm src/symbols.tal bin/sym.rom && uxncli bin/sym.rom examples/hello.tal bin/test.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


@@ 8,19 8,14 @@

	@src $30
	@dst $30
	@run $1
	@size $2
	@inc $30
	@program &head $2 &write $1

|0100 ( -> )

	( project )
	;dict/drifblim .File1/name DEO2
	#0061 .File1/length DEO2
	#0000 .File1/read DEO2
	.File1/success DEI2 ORA ,on-ready JCN

	( interactive )
	;await-src .Console/vector DEO2 ;dict/input ;pstr JSR2
	;await-src .Console/vector DEO2
	;dict/input ;pstr JSR2

BRK



@@ 33,146 28,165 @@ BRK
	#0a18 DEO

	( pass1 )
	,assemble-top JSR
	;src ;handle-file JSR2

	( setup )
	;pass2/err ;tokenize/to STA2
	;pass2 ;tokenize/from STA2
	#00 ;write-byte/mock STA
	.size LDZ2 ;write-byte/bound STA2
	( pass2 )
	#01 .program/write STZ
	;src ;handle-file JSR2

	( prepare output )
	;dst .File2/name DEO2
	#01 .File2/delete DEO
	#0001 .File2/length DEO2
	( export )
	;dst .File1/name DEO2
	.program/head LDZ2 .File1/length DEO2
	;rom/start .File1/write DEO2

	( pass2 )
	,assemble-top JSR
	;save-symbols JSR2
	;print-summary JSR2
	;summary JSR2

	( auto ) .run LDZ ,&run JCN
	( debug ) #010e DEO
	( halt ) #010f DEO

BRK

&run ( -> )

	;dst .File1/name DEO2
	#fe00 .File1/length DEO2
	;loader-rom #ffd5 #002a ;mcpy JSR2
	#ffd5 ( .. )

JMP2

(
@|stream )
@|generics )

@assemble-top ( file* -- )
@handle-file ( f* -- )

	#0000
		DUP2 .size STZ2
		;write-byte/ptr STA2
	;src

@assemble ( file* -- )

	( stream )
	DUP2 .File1/name DEO2
	.File1/name DEO2
	#0001 .File1/length DEO2
	&s
		;&c .File1/read DEO2
		.File1/success DEI2 #0000 EQU2 ,&eof JCN
		[ LIT &c $1 ] ,stream JSR
		,&s JMP &eof
	( check if file exists )
	,&c LDR #00 EQU ,&empty JCN
	POP2
		.File1/success DEI2 #0000 NEQ2 ,&continue JCN JMP2r
		&continue [ LIT &c $1 ] ,handle-char JSR
		,&s JMP

JMP2r
	&empty ;err/source ;crash JMP2

@stream ( char -- )
@handle-char ( c -- )

	#20 GTHk NIP ,&append JCN POP
	;token LDAk ,&run JCN
	( skip empty ) POP2
	;token LDAk ,&run JCN POP2

JMP2r
	&run ( token* -- )
		DUP2 ,read-token JSR
		;sclr JMP2
	&append ( char -- )
		;token
			DUP2 ;slen JSR2 #0018 EQU2 ,&overflow JCN
			;sput JMP2
	&overflow ( char token* -- )
		ROT POP ;err/token ;crash JMP2
	&append ( c -- ) ;token DUP2 ;slen JSR2 #001f LTH2 ;sput JCN2 POP JMP2r
	&run ( t* -- ) DUP2 ,handle-token JSR ;sclr JMP2

(
@|token )

@read-token ( token* -- )
@handle-token ( t* -- )

	LDAk LIT "( EQU ,&on-parens JCN
	LDAk LIT ") EQU ,&on-parens JCN
	[ LIT &sleep $1 ] ,&on-sleep JCN
	DUP2 ,tokenize JSR
		INC2 LDA2 ( .. )
	;parse JSR2

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

@tokenize ( token* -- type* )
(
@|library )

	STH2
@parse ( t* -- )

	LDAk ,&rune STR
	( runes )
	[ LIT2 &to =pass1/err ] [ LIT2 &from =pass1 ]
	;runes/err ;runes
	&l
		LDAk LDAkr STHr EQU ,&on-runic JCN
		INC2 INC2 INC2 GTH2k ,&l JCN
		LDAk [ LIT &rune $1 ] NEQ ,&no-runic JCN
			NIP2 INC2 LDA2 JMP2
			&no-runic
		#0003 ADD2 GTH2k ,&l JCN
	POP2 POP2
	( variable )
	STH2r
		DUP2 ;is-opcode JSR2 ,&on-opcode JCN
		DUP2 ;is-hex JSR2 ,&on-rawhex JCN
	( error )
	POP2 ;pass1/err
	( non-runic )
	DUP2 ;is-hex JSR2 ;library/do-rawhex JCN2
	DUP2 ;is-opcode JSR2 ;library/do-opcode JCN2
	( jsi )
	;library/do-litjsi JSR2

JMP2r
	&on-runic NIP2 POP2r JMP2r
	&on-opcode POP2 ;pass1/opcode JMP2r
	&on-rawhex POP2 ;pass1/rawhex JMP2r

(
@|operations )

@do-inc ( t* -- ) INC2k ;incsrc STH2k ;scpy JSR2 ;sclr JSR2 STH2r ;assemble JMP2
@do-ignore ( t* -- ) POP2 JMP2r
@do-padabs ( t* -- ) INC2 ;shex JSR2 ;write-byte/ptr LDA2 LTH2k ,&rev JCN SUB2 ;fill JMP2 &rev POP2 ;write-byte/ptr STA2 JMP2r
@do-padrel ( t* -- ) INC2 ;shex JSR2 ;fill JMP2
@do-labtop ( t* -- ) INC2 ;set-scope JSR2 ;create-label JMP2
@do-labsub ( t* -- ) INC2 ;make-sublabel JSR2 ;create-label JMP2
@do-rawtxt ( t* -- ) INC2 &w LDAk ;write-byte JSR2 INC2 LDAk ,&w JCN POP2 JMP2r
@do-lithex ( t* -- ) INC2 ;write-lithex JMP2
@do-opcode ( t* -- ) ;find-opcode JSR2 ;write-byte JMP2
@do-rawhex ( t* -- ) ;write-rawhex JMP2
@do-errors ( t* -- ) ;err/token ;crash JMP2
@do-neulzep ( t* -- ) POP2 #ff ;write-litbyte JMP2
@do-neurzep ( t* -- ) POP2 #ff ;write-byte JMP2
@do-neulabs ( t* -- ) POP2 #ffff ;write-litshort JMP2
@do-neurabs ( t* -- ) POP2 #ffff ;write-short JMP2
@do-neutop ( t* -- ) INC2 ,set-scope JSR POP2 JMP2r
@do-reflrel ( t* -- ) INC2 ,get-ref JSR ,get-rel JSR ;write-litbyte JMP2
@do-refrrel ( t* -- ) INC2 ,get-ref JSR ,get-rel JSR INC ;write-byte JMP2
@do-reflzep ( t* -- ) INC2 ,get-ref JSR LDA2 NIP ;write-litbyte JMP2
@do-refrzep ( t* -- ) INC2 ,get-ref JSR LDA2 NIP ;write-byte JMP2
@do-reflabs ( t* -- ) INC2 ,get-ref JSR LDA2 ;write-litshort JMP2
@do-refrabs ( t* -- ) INC2 ,get-ref JSR LDA2 ;write-short JMP2
@library
( head )
&do-padabs INC2 ;shex JSR2 ;set-head JMP2
&do-padrel INC2 ;shex JSR2 ;move-head JMP2
( labels )
&do-toplab INC2 ;set-scope JSR2 ;create-label JMP2
&do-sublab INC2 ;make-sublabel JSR2 ;create-label JMP2
( addressing )
&do-litrel #80 ;write JSR2 
&do-rawrel INC2 ;get-ref JSR2 ;get-rel JSR2 INC ;write JMP2
&do-litzep #80 ;write JSR2
&do-rawzep INC2 ;get-ref JSR2 LDA2 NIP ;write JMP2
&do-litabs #a0 ;write JSR2 
&do-rawabs INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
( calls )
&do-litjmi #20 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
&do-litjci #40 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
&do-litjsi #60 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
( hexadecimals )
&do-rawhex ;write-rawhex JMP2
&do-lithex INC2 ;write-lithex JMP2
( etc )
&do-rawstr INC2 ;write-rawstr JMP2
&do-opcode ;find-opcode JSR2 ;write JMP2
&do-inc INC2k ;inc STH2k ;scpy JSR2 ;sclr JSR2 STH2r ;handle-file JMP2
&do-ignore POP2 JMP2r

(
@|helpers )
@|primitives )

@write-short ( short* -- )

	SWP ,write JSR

@write ( byte -- )

	.program/write LDZ #00 EQU ,&no-write JCN
		DUP ;rom .program/head LDZ2 ADD2 STA
		&no-write
	POP

	( move )
	.program/head LDZ2k INC2 ROT STZ2

JMP2r

@write-rawstr ( str* -- )

	&w
		LDAk ;write JSR2
		INC2 LDAk ,&w JCN
	POP2

JMP2r

@write-rawhex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		;shex JSR2 ,write-short JMP
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		;shex JSR2 NIP ,write JMP
		&no-byte
	&invalid
	;err/number ;crash ( .. )

JMP2

@write-lithex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		#a0 ;write JSR2
		;shex JSR2 ;write-short JMP2
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		#80 ;write JSR2
		;shex JSR2 NIP ;write JMP2
		&no-byte
	&invalid
	;err/number ;crash ( .. )

JMP2

@set-scope ( t* -- name* )



@@ 182,15 196,20 @@ JMP2

@get-rel ( label* -- distance )

	LDA2k ;write-byte/ptr LDA2 SUB2 #0003 SUB2
	.program/write LDZ #00 EQU ,&fill JCN
	LDA2k .program/head LDZ2 SUB2 #0003 SUB2
	DUP2 #0080 ADD2 POP ,&fail JCN
	NIP2 NIP

JMP2r
	&fail POP2 INC2 INC2 INC2 ;err/distance ;crash JMP2
	&fill POP2 #00 JMP2r

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

	.program/write LDZ ,&no-write JCN
		POP2 ;&fill JMP2r
		&no-write
	LDAk LIT "& NEQ ,&no-sub JCN
		INC2 ;make-sublabel JSR2
		&no-sub


@@ 202,11 221,13 @@ JMP2r
	( count ) INC2k INC2 LDAk INC ROT ROT STA

JMP2r
	&fill 0000 "[empty] $1

@create-label ( name* -- )

	.program/write LDZ ,&skip JCN
	( check duplicate ) DUP2 ;find-label JSR2 INC2 ORA ,&not-unique JCN
	( save addr ) ;write-byte/ptr LDA2 [ LIT2 &ptr =symbols ] STH2k STA2
	( save addr ) .program/head LDZ2 [ LIT2 &ptr =symbols ] STH2k STA2
	( move ) INC2r INC2r INC2r
	( save name ) DUP2 STH2kr ;scpy JSR2
	( move ) ;slen JSR2 STH2r ADD2 INC2 ,&ptr STR2


@@ 214,10 235,11 @@ JMP2r

JMP2r
	&not-unique ;err/duplicate ;crash JMP2
	&skip POP2 JMP2r

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

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


@@ 238,71 260,20 @@ JMP2r
JMP2r
	&found #0003 SUB2 POP2r JMP2r

@write-lithex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		;shex JSR2 ,write-litshort JMP
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		;shex JSR2 NIP ,write-litbyte JMP
		&no-byte
	&invalid
	;err/number ;crash ( .. )
@move-head ( v* -- ) .program/head LDZ2 ADD2
@set-head ( v* -- ) .program/head STZ2 JMP2r

JMP2

@write-rawhex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		;shex JSR2 ,write-short JMP
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		;shex JSR2 NIP ,write-byte JMP
		&no-byte
	&invalid
	;err/number ;crash ( .. )

JMP2

@write-litbyte ( byte -- )

	( LITk ) #80 SWP ,write-short JMP

@write-litshort ( short* -- )

	( LIT2k ) #a0 ,write-byte JSR

@write-short ( short -- )

	SWP ,write-byte JSR
(
@helpers )

@write-byte ( byte -- )
@is-hex ( str* -- flag )

	,&byte STR
	[ LIT2 &ptr $2 ]
	[ LIT &mock 01 ] ,&no-w JCN
	DUP2 #0100 LTH2 ,&no-w JCN
	DUP2 [ LIT2 &bound $2 ] GTH2 ,&no-w JCN
		;&byte .File2/write DEO2
		&no-w
	INC2 
		DUP2 ,&ptr STR2
		[ LIT &byte $1 ] ,&no-null JCN
	&w
		LDAk ;chex JSR2 INC ,&valid JCN
			POP2 #00 JMP2r &valid
		INC2 LDAk ,&w JCN
	POP2

JMP2r
	&no-null .size STZ2 JMP2r

@fill ( length* -- )

	#0000 EQU2k ,&skip JCN
	&l
		#00 ,write-byte JSR
		INC2 GTH2k ,&l JCN
		&skip
	POP2 POP2
	#01

JMP2r



@@ 341,6 312,18 @@ JMP2r

JMP2r

@crash ( id* name* -- )

	;err ;perr JSR2
	;perr JSR2
	LIT ": #19 DEO
	#2019 DEO
	;perr JSR2
	#0a19 DEO
	#010f DEO

BRK

@scmp3 ( a* b* -- flag )

	LDA2k ROT2 LDA2k ROT2 EQU2 STH


@@ 349,28 332,7 @@ JMP2r

JMP2r

(
@|extras )

@save-symbols ( -- )

	;dst ;scap JSR2 ;&ext OVR2 ;scpy JSR2
	;dst .File2/name DEO2
	;symbols
	&l
		#0002 .File2/length DEO2
		DUP2 .File2/write DEO2
		#0003 ADD2
			DUP2 ;slen JSR2 INC2 .File2/length DEO2
			DUP2 .File2/write DEO2
		;scap JSR2 INC2 DUP2 #0003 ADD2 LDA ,&l JCN
	POP2
	#00 ROT ROT STA

JMP2r
	&ext ".sym $1

@print-summary ( -- )
@summary ( -- )

	;symbols
	&w


@@ 391,7 353,7 @@ JMP2r
	;dst ;pstr JSR2

	;dict/in ;pstr JSR2
	.size LDZ2 #0100 SUB2 ;pdec JSR2
	.program/head LDZ2 #0100 SUB2 ;pdec JSR2
	;dict/bytes ;pstr JSR2
	LIT "( #18 DEO
	;create-label/count LDA2 ;pdec JSR2


@@ 401,23 363,29 @@ JMP2r

JMP2r

@crash ( id* name* -- )
@save-symbols ( -- )

	;err ;perr JSR2
	;perr JSR2
	LIT ": #19 DEO
	#2019 DEO
	;perr JSR2
	#0a19 DEO
	#010f DEO
	;dst ;scap JSR2 ;&ext OVR2 ;scpy JSR2
	;dst .File1/name DEO2
	;symbols
	&l
		#0002 .File1/length DEO2
		DUP2 .File1/write DEO2
		#0003 ADD2
			DUP2 ;slen JSR2 INC2 .File1/length DEO2
			DUP2 .File1/write DEO2
		;scap JSR2 INC2 DUP2 #0003 ADD2 LDA ,&l JCN
	POP2
	#00 ROT ROT STA

BRK
JMP2r
	&ext ".sym $1

(
@|stdlib )

@pstr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@perr ( src* str* -- ) &w LDAk #19 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@pstr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@scap ( str* -- end* ) LDAk ,&w JCN JMP2r &w INC2 LDAk ,&w JCN JMP2r
@sput ( chr str* -- ) ,scap JSR INC2k #00 ROT ROT STA STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r


@@ 426,30 394,8 @@ BRK
@sclr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w STH2k #00 STH2r STA INC2 LDAk ,&w JCN POP2 JMP2r
@skey ( key buf -- proc ) OVR #21 LTH ,&eval JCN #00 SWP ;sput JSR2 #00 JMP2r &eval POP2 #01 JMP2r
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r 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 JSR STH ADD2r
		INC2 LDAk ,&w JCN
	POP2 STH2r

JMP2r

@is-hex ( str* -- flag )

	&w
		LDAk ,chex JSR INC ,&valid JCN
			POP2 #00 JMP2r &valid
		INC2 LDAk ,&w JCN
	POP2
	#01

JMP2r
@shex ( str* -- val* ) LIT2r 0000 &w LITr 40 SFT2r LITr 00 LDAk ,chex JSR STH ADD2r INC2 LDAk ,&w JCN POP2 STH2r JMP2r

@pdec ( short* -- )



@@ 467,48 413,9 @@ JMP2r
		&skip POP MUL2 SUB2
	JMP2r

(
@|tables )

@pass1
	"| =do-padabs "$ =do-padrel
	"@ =do-labtop "& =do-labsub
	", =do-neulzep "_ =do-neulzep
	". =do-neulzep "- =do-neurzep
	"; =do-neulabs "= =do-neurabs
	"[ =do-ignore "] =do-ignore
	"# =do-lithex "" =do-rawtxt
	"~ =do-inc
	&err
	00 =do-errors
	&opcode
	00 =do-opcode
	&rawhex
	00 =do-rawhex

@pass2
	"| =do-padabs "$ =do-padrel
	"@ =do-neutop "& =do-ignore
	", =do-reflrel "_ =do-refrrel
	". =do-reflzep "- =do-refrzep
	"; =do-reflabs "= =do-refrabs
	"[ =do-ignore "] =do-ignore
	"# =do-lithex "" =do-rawtxt
	"~ =do-inc
	&err

@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

@dict
	( io )
	&input "Input(.tal): 20 $1
	&output "Output(.rom): 20 $1
	&drifblim ".drifblim $1
	( debug )
	&assembled "Assembled 20 $1
	&spacer 20 "-> 20 $1


@@ 520,27 427,41 @@ JMP2r
@err
	"!! 20 "Error 20 $1
	&duplicate "Duplicate  $1
	&token "Token $1
	&number "Number $1
	&reference "Reference $1
	&source "Source $1
	&mode "Mode $1
	&distance "Distance $1

@loader-rom
	8000 8000 0711 0106 80f7 0d02 a001 00af
	80ac 37a0 ffd5 80a2 36ef 3826 8000 0505
	1521 aa80 f50d 2222 6f2c
@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
	"| =library/do-padabs "$ =library/do-padrel
	"@ =library/do-toplab "& =library/do-sublab
	", =library/do-litrel "_ =library/do-rawrel
	". =library/do-litzep "- =library/do-rawzep
	"; =library/do-litabs "= =library/do-rawabs
	"! =library/do-litjmi "? =library/do-litjci
	"[ =library/do-ignore "] =library/do-ignore
	"# =library/do-lithex "" =library/do-rawstr
	"~ =library/do-inc
	&err

(
@|buffers )

@incsrc $30
@buf $30
@scope $20
@token $20
@scope $20
@sublabel $20

(
@|memory )

@symbols ( addr*, refs, text, 00 )
@symbols ( addr*, refs, text, 00 ) $2000

@rom $100 &start



D src/symbols.tal => src/symbols.tal +0 -467
@@ 1,467 0,0 @@
( uxnasm src/symbols.tal bin/sym.rom && uxncli bin/sym.rom examples/hello.tal bin/test.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
	@inc $30
	@program &head $2 &write $1

|0100 ( -> )

	( interactive )
	;await-src .Console/vector DEO2
	;dict/input ;pstr JSR2

BRK

@await-src ( -> ) .Console/read DEI .src ;skey JSR2 ,ready-dst JCN BRK
@ready-dst ( -> ) ;await-dst .Console/vector DEO2 ;dict/output ;pstr JSR2 BRK
@await-dst ( -> ) .Console/read DEI .dst ;skey JSR2 ,on-ready JCN BRK

@on-ready ( -> )

	#0a18 DEO

	( pass1 )
	;src ;handle-file JSR2

	( pass2 )
	#01 .program/write STZ
	;src ;handle-file JSR2

	( export )
	;dst .File1/name DEO2
	.program/head LDZ2 .File1/length DEO2
	;rom/start .File1/write DEO2

	;summary JSR2

	( debug ) #010e DEO
	( halt ) #010f DEO

BRK

(
@|generics )

@handle-file ( f* -- )

	.File1/name DEO2
	#0001 .File1/length DEO2
	&s
		;&c .File1/read DEO2
		.File1/success DEI2 #0000 NEQ2 ,&continue JCN JMP2r
		&continue [ LIT &c $1 ] ,handle-char JSR
		,&s JMP

JMP2r

@handle-char ( c -- )

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

JMP2r
	&append ( c -- ) ;token DUP2 ;slen JSR2 #001f LTH2 ;sput JCN2 POP JMP2r
	&run ( t* -- ) DUP2 ,handle-token JSR ;sclr JMP2

@handle-token ( t* -- )

	LDAk LIT "( EQU ,&on-parens JCN
	LDAk LIT ") EQU ,&on-parens JCN
	[ LIT &sleep $1 ] ,&on-sleep JCN
	;parse JSR2

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

(
@|library )

@parse ( t* -- )

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

JMP2r

@library
( head )
&do-padabs INC2 ;shex JSR2 ;set-head JMP2
&do-padrel INC2 ;shex JSR2 ;move-head JMP2
( labels )
&do-toplab INC2 ;set-scope JSR2 ;create-label JMP2
&do-sublab INC2 ;make-sublabel JSR2 ;create-label JMP2
( addressing )
&do-litrel #80 ;write JSR2 
&do-rawrel INC2 ;get-ref JSR2 ;get-rel JSR2 ;write JMP2
&do-litzep #80 ;write JSR2
&do-rawzep INC2 ;get-ref JSR2 LDA2 NIP ;write JMP2
&do-litabs #a0 ;write JSR2 
&do-rawabs INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
( calls )
&do-litjmi #20 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
&do-litjci #40 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
&do-litjsi #60 ;write JSR2 INC2 ;get-ref JSR2 LDA2 ;write-short JMP2
( hexadecimals )
&do-rawhex ;write-rawhex JMP2
&do-lithex INC2 ;write-lithex JMP2
( etc )
&do-rawstr INC2 ;write-rawstr JMP2
&do-opcode ;find-opcode JSR2 ;write JMP2
&do-inc INC2k ;inc STH2k ;scpy JSR2 ;sclr JSR2 STH2r ;handle-file JMP2
&do-ignore POP2 JMP2r

(
@|primitives )

@write-short ( short* -- )

	SWP ,write JSR

@write ( byte -- )

	.program/write LDZ #00 EQU ,&no-write JCN
		DUP ;rom .program/head LDZ2 ADD2 STA
		&no-write
	POP

	( move )
	.program/head LDZ2k INC2 ROT STZ2

JMP2r

@write-rawstr ( str* -- )

	&w
		LDAk ;write JSR2
		INC2 LDAk ,&w JCN
	POP2

JMP2r

@write-rawhex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		;shex JSR2 ,write-short JMP
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		;shex JSR2 NIP ,write JMP
		&no-byte
	&invalid
	;err/number ;crash ( .. )

JMP2

@write-lithex ( str* -- )

	DUP2 ;is-hex JSR2 #00 EQU ,&invalid JCN
	DUP2 ;slen JSR2 #0004 NEQ2 ,&no-short JCN
		#a0 ;write JSR2
		;shex JSR2 ;write-short JMP2
		&no-short
	DUP2 ;slen JSR2 #0002 NEQ2 ,&no-byte JCN
		#80 ;write JSR2
		;shex JSR2 NIP ;write JMP2
		&no-byte
	&invalid
	;err/number ;crash ( .. )

JMP2

@set-scope ( t* -- name* )

	;scope OVR2 SWP2 ;scpy ( .. )

JMP2

@get-rel ( label* -- distance )

	LDA2k .program/head LDZ2 SUB2 #0003 SUB2
	DUP2 #0080 ADD2 POP ,&fail JCN
	NIP2 NIP

JMP2r
	&fail POP2 INC2 INC2 INC2 ;err/distance ;crash JMP2

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

	.program/write LDZ ,&no-write JCN
		POP2 ;&fill JMP2r
		&no-write
	LDAk LIT "& NEQ ,&no-sub JCN
		INC2 ;make-sublabel JSR2
		&no-sub
	;find-label JSR2
		INC2k ORA ,&found JCN
			POP2 ;err/reference ;crash JMP2
			&found

	( count ) INC2k INC2 LDAk INC ROT ROT STA

JMP2r
	&fill ffff

@create-label ( name* -- )

	.program/write LDZ ,&skip JCN
	DUP2 ;pstr JSR2 #0a18 DEO

	( check duplicate ) DUP2 ;find-label JSR2 INC2 ORA ,&not-unique JCN
	( save addr ) .program/head LDZ2 [ LIT2 &ptr =symbols ] STH2k STA2
	( move ) INC2r INC2r INC2r
	( save name ) DUP2 STH2kr ;scpy JSR2
	( move ) ;slen JSR2 STH2r ADD2 INC2 ,&ptr STR2
	( stats ) [ LIT2 &count $2 ] INC2 ,&count STR2

JMP2r
	&not-unique ;err/duplicate ;crash JMP2
	&skip POP2 JMP2r

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

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

JMP2r

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

	STH2
	;symbols
	&w
		INC2 INC2 INC2 DUP2 STH2kr ;scmp JSR2 ,&found JCN
		;scap JSR2 INC2 INC2k INC2 INC2 LDA ,&w JCN
	POP2
	POP2r
	#ffff

JMP2r
	&found #0003 SUB2 POP2r JMP2r

@move-head ( v* -- ) .program/head LDZ2 ADD2
@set-head ( v* -- ) .program/head STZ2 JMP2r

(
@helpers )

@is-hex ( str* -- flag )

	&w
		LDAk ;chex JSR2 INC ,&valid JCN
			POP2 #00 JMP2r &valid
		INC2 LDAk ,&w JCN
	POP2
	#01

JMP2r

@is-opcode ( string* -- flag )

	DUP2 ;opcodes/brk ;scmp3 JSR2 ,find-opcode/on-brk JCN

@find-opcode ( name* -- byte )

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

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

@find-modes ( mode* -- byte )

	LITr 00
	&w
		LDAk #20
		OVR LIT "2 EQU ,&end JCN DUP ADD
		OVR LIT "r EQU ,&end JCN DUP ADD
		OVR LIT "k EQU ,&end JCN DUP ADD
		OVR #21 LTH ,&end JCN
			;token ;err/mode ;crash JMP2
		&end NIP STH ORAr
		INC2 LDAk ,&w JCN
	POP2 STHr

JMP2r

@crash ( id* name* -- )

	;err ;perr JSR2
	;perr JSR2
	LIT ": #19 DEO
	#2019 DEO
	;perr JSR2
	#0a19 DEO
	#010f DEO

BRK

@scmp3 ( a* b* -- flag )

	LDA2k ROT2 LDA2k ROT2 EQU2 STH
	INC2 LDA2 SWP2 INC2 LDA2 EQU2 STHr
	AND

JMP2r

@summary ( -- )

	;symbols
	&w
		( ignore uppercased device labels )
		INC2k INC2 INC2 LDA DUP #40 GTH SWP #5b LTH AND ,&used JCN
		INC2k INC2 LDA ,&used JCN
			;dict/unused ;pstr JSR2
			INC2 INC2 INC2 DUP2 ;pstr JSR2 #0a18 DEO
			&used
		;scap JSR2 INC2 INC2k INC2 INC2 LDA ,&w JCN
	POP2

	( result )
	;dict/assembled ;pstr JSR2

	;src ;pstr JSR2
	;dict/spacer ;pstr JSR2
	;dst ;pstr JSR2

	;dict/in ;pstr JSR2
	.program/head LDZ2 #0100 SUB2 ;pdec JSR2
	;dict/bytes ;pstr JSR2
	LIT "( #18 DEO
	;create-label/count LDA2 ;pdec JSR2
	;dict/labels ;pstr JSR2
	LIT ") #18 DEO
	#0a18 DEO

JMP2r

@save-symbols ( -- )

	;dst ;scap JSR2 ;&ext OVR2 ;scpy JSR2
	;dst .File1/name DEO2
	;symbols
	&l
		#0002 .File1/length DEO2
		DUP2 .File1/write DEO2
		#0003 ADD2
			DUP2 ;slen JSR2 INC2 .File1/length DEO2
			DUP2 .File1/write DEO2
		;scap JSR2 INC2 DUP2 #0003 ADD2 LDA ,&l JCN
	POP2
	#00 ROT ROT STA

JMP2r
	&ext ".sym $1

(
@|stdlib )

@perr ( src* str* -- ) &w LDAk #19 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@pstr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@scap ( str* -- end* ) LDAk ,&w JCN JMP2r &w INC2 LDAk ,&w JCN JMP2r
@sput ( chr str* -- ) ,scap JSR INC2k #00 ROT ROT STA STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scat ( src* dst* -- ) ,scap JSR
@scpy ( src* dst* -- ) OVR2 LDA ,&e JCN POP2 POP2 JMP2r &e STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
@sclr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w STH2k #00 STH2r STA INC2 LDAk ,&w JCN POP2 JMP2r
@skey ( key buf -- proc ) OVR #21 LTH ,&eval JCN #00 SWP ;sput JSR2 #00 JMP2r &eval POP2 #01 JMP2r
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU 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 JSR STH ADD2r INC2 LDAk ,&w JCN POP2 STH2r JMP2r

@pdec ( short* -- )

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

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

@dict
	&input "Input(.tal): 20 $1
	&output "Output(.rom): 20 $1
	( debug )
	&assembled "Assembled 20 $1
	&spacer 20 "-> 20 $1
	&in 20 "in 20 $1
	&bytes 20 "bytes $1
	&labels 20 "labels $1
	&unused "-- 20 "Unused 20 "label: 20 $1

@err
	"!! 20 "Error 20 $1
	&duplicate "Duplicate  $1
	&number "Number $1
	&reference "Reference $1
	&mode "Mode $1
	&distance "Distance $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
	"| =library/do-padabs "$ =library/do-padrel
	"@ =library/do-toplab "& =library/do-sublab
	", =library/do-litrel "_ =library/do-rawrel
	". =library/do-litzep "- =library/do-rawzep
	"; =library/do-litabs "= =library/do-rawabs
	"! =library/do-litjmi "? =library/do-litjci
	"[ =library/do-ignore "] =library/do-ignore
	"# =library/do-lithex "" =library/do-rawstr
	"~ =library/do-inc
	&err

(
@|buffers )

@token $20
@scope $20
@sublabel $20

(
@|memory )

@symbols ( addr*, refs, text, 00 ) $2000

@rom $100 &start