~rabbits/drifblim

2aa909a26982a0310293076c26fad2be0b251db7 — neauoire 4 months ago d1cd740 
Removed old versions
patch browse .tar.gz 
2 files changed, 0 insertions(+), 542 deletions(-)

D src/drifloon.tal
D src/procblim.tal

D src/drifloon.tal => src/drifloon.tal +0 -369
@@ 1,369 0,0 @@
( Usage: uxncli drifloon.rom src/source.tal )

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

|0000

	@src $40
	@token $30
	@scope $30
	@buf $30
	@sym &ptr $2
	@ref &ptr $2
	@p &ptr $2 &len $2

|0100

	;on-console .Console/vector DEO2

BRK

@on-console ( -> )

	;src STH2
	( filepath )
	.Console/read DEI
	DUP #20 LTH OVR #7f GTH ORA ,&end JCN
	STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
		STH2r ;sput JSR2 BRK
		&end
	POP
	( assemble )
	STH2kr .File/name DEO2
	#0001 .File/length DEO2
	&stream
		;&c .File/read DEO2 [ LIT &c $1 ] ,walk JSR
		.File/success DEI2 ORA ,&stream JCN
	;resolve JSR2
	STH2r ;build JSR2
	( halt )
	#010f DEO

BRK

@walk ( char -- )

	#20 GTHk NIP ,&append JCN
	;token
		DUP2 ,walk-token JSR
		#0030 ;mclr JSR2
	POP

JMP2r
	&append ;token ;sput JMP2

@walk-token ( token* -- )

	LDAk LIT '( EQU ,&on-parens JCN
	LDAk LIT ') EQU ,&on-parens JCN
	[ LIT &sleep $1 ] ,&on-sleep JCN
	;slen JSR2 ORA #01 JCN JMP2r

	;runes/end ;runes
	&loop
		LDAk ;token LDA EQU ,&on-runic JCN
		INC2 INC2 INC2 GTH2k ,&loop JCN
	POP2 POP2
	;token
		DUP2 ;is-opcode JSR2 ,&on-opcode JCN
		DUP2 ;slen JSR2 #0004 EQU2 ,&on-short JCN
		DUP2 ;slen JSR2 #0002 EQU2 ,&on-byte JCN

;str/key ;print-err JMP2

	&on-runic NIP2 ;token INC2 SWP2 [ INC2 LDA2 JMP2 ]
	&on-opcode ;find-opcode JSR2 ;write-byte JMP2
	&on-short ;shex JSR2 ;write-short JMP2
	&on-byte ;shex JSR2 NIP ;write-byte JMP2
	&on-parens LDA #29 SUB ,&sleep STR JMP2r
	&on-sleep POP2 JMP2r

@resolve ( -- )

	( skip empty ) .ref/ptr LDZ2 ORA #01 JCN JMP2r
	;refs
	&while
		DUP2 ,resolve-ref JSR
		( eol ) INC2 INC2 ;scap JSR2 INC2 INC2k INC2 LDA ,&while JCN
	POP2

JMP2r

@resolve-ref ( ref* -- )

	STH2k
	INC2 INC2 INC2k ,find-label JSR DUP2 #ffff EQU2 ,&no-found JCN
	LDA2 STH2
	( rune )
	LDAk LIT '. EQU ,&on-litzer JCN
	LDAk LIT ', EQU ,&on-litrel JCN
	LDAk LIT '; EQU ,&on-litabs JCN
	LDAk LIT ': EQU ,&on-rawabs JCN
	&no-found
	POP2 STH2r INC2 INC2 POP2r

;str/ref ;print-err JMP2

	&on-litzer STH2r NIP STH2r ,&set-byte JMP
	&on-litrel STH2r STH2kr LDA2 SUB2 #0002 SUB2
		DUP2 #0080 ADD2 POP #00 EQU ,&in-range JCN
			OVR2 INC2 ;str/far ;print-err JSR2
			&in-range
			NIP STH2r
		&set-byte LDA2 ;dst ADD2 STA POP2 JMP2r
	&on-litabs STH2r STH2r ,&set-short JMP
	&on-rawabs STH2r STH2r
		&set-short LDA2 ;dst ADD2 STA2 POP2 JMP2r

@find-label ( name* -- addr/ffff* )

	STH2
	;syms
	&while
		INC2k INC2 STH2kr ;scmp JSR2 ,&on-found JCN
		( go eol ) INC2 INC2 ;scap JSR2 INC2 INC2k INC2 LDA ,&while JCN
	POP2
	POP2r
	#ffff

JMP2r
	&on-found POP2r JMP2r

@build ( name* -- )

	( write file  )
	;str/rom OVR2 ;scap JSR2 #0003 SUB2 ;scpy JSR2
	DUP2 .File/name DEO2
	.p/len LDZ2 #0100 SUB2 .File/length DEO2
	;dst/clip .File/write DEO2
	( write stats )
	;str/assembled ;print-str JSR2
	;print-str JSR2
	#2818 DEO
	.p/len LDZ2 ;print JSR2
	LIT '/ #18 DEO
	#0000 ;dst SUB2 ;print JSR2
	#2918 DEO #0a18 DEO

JMP2r

( runic )

@do-lithex ( t* -- )

	DUP2 ;slen JSR2 #0004 EQU2 ,&on-short JCN
	DUP2 ;slen JSR2 #0002 EQU2 ,&on-byte JCN

;str/lit ;print-err JMP2

	&on-short ;shex JSR2 ;write-litshort JMP2
	&on-byte ;shex JSR2 NIP ;write-litbyte JMP2

@create-label ( name* -- )

	( check duplicate )
	DUP2 ;find-label JSR2 #ffff EQU2 ,&unique JCN
		DUP2 ;str/dup ;print-err JSR2
		&unique
	( write ref )
	.p/ptr LDZ2 ;syms .sym/ptr LDZ2 STH2k ADD2 STA2
	INC2r INC2r
	( write string )
	DUP2 ;syms STH2kr ADD2 ;scpy JSR2
	;slen JSR2 STH2 ADD2r INC2r STH2r .sym/ptr STZ2

JMP2r

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

	;scope STH2k #0030 ;mclr JSR2 DUP2 STH2r

;scpy JMP2

@do-padabs ( t* -- ) ;shex JSR2 .p/ptr STZ2 JMP2r
@do-padrel ( t* -- ) ;shex JSR2 .p/ptr LDZ2 ADD2 .p/ptr STZ2 JMP2r
@do-plabel ( t* -- ) ,set-scope JSR ,create-label JMP
@do-slabel ( t* -- ) ,make-sublabel JSR ,create-label JMP
@do-litbyt ( t* -- ) .p/ptr LDZ2 INC2 ,create-ref JSR #ff ;write-litbyte JMP2
@do-litabs ( t* -- ) .p/ptr LDZ2 INC2 ,create-ref JSR #ffff ;write-litshort JMP2
@do-rawabs ( t* -- ) .p/ptr LDZ2 ,create-ref JSR #ffff ;write-short JMP2
@do-rawchr ( t* -- ) LDA ;write-byte JMP2
@do-rawstr ( t* -- ) &w LDAk ;write-byte JSR2 INC2 LDAk ,&w JCN POP2 JMP2r
@do-ignore ( t* -- ) POP2 JMP2r

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

	;buf STH2k #0030 ;mclr JSR2
	;scope STH2kr ;scpy JSR2
	LIT '/ STH2kr ;sput JSR2
	STH2kr ;scat JSR2 STH2r

JMP2r

@create-ref ( name* addr* -- )

	( addr ) ;refs .ref/ptr LDZ2 ADD2 STH2k STA2 INC2r INC2r
	( rune ) DUP2 #0001 SUB2 LDA STH2kr STA INC2r
	( child ) LDAk LIT '& NEQ ,&parent JCN INC2 ,make-sublabel JSR &parent
	( name ) DUP2 STH2kr ;scpy JSR2
	( move ) ;slen JSR2 STH2r ADD2 ;refs SUB2 INC2 .ref/ptr STZ2

JMP2r

@write-litbyte ( byte -- )

	( LITk ) #80 SWP ,write-short JMP

@write-litshort ( short* -- )

	( LIT2k ) #a0 ,write-byte JSR

@write-short ( short -- )

	SWP ,write-byte JSR

@write-byte ( byte -- )

	;dst .p/ptr LDZ2 STH2k ADD2 STA
	INC2r STH2kr .p/ptr STZ2
	STH2r .p/len STZ2

JMP2r

@is-opcode ( string* -- flag )

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

@find-opcode ( name* -- byte )

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

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

@find-mode ( mode* -- byte )

	LITr 00
	&while
		LDAk LIT '2 EQU #50 SFT STH ADDr
		LDAk LIT 'r EQU #60 SFT STH ADDr
		LDAk LIT 'k EQU #70 SFT STH ADDr
		INC2 LDAk ,&while JCN
	POP2 STHr

JMP2r

@scmp3 ( a[3]* b[3]* -- flag )

	LDA2k STH2 INC2 INC2 SWP2
	LDA2k STH2 INC2 INC2 EQU2r
	LDA STH LDA STH EQUr
	ANDr STHr

JMP2r

@shex ( str* -- short* )

	DUP2 ,sihx JSR ,&valid JCN
		;str/hex ;print-err JSR2 #0000 JMP2r
		&valid
	LIT2r 0000
	&while
		LITr 40 SFT2r
		LITr 00
		LDAk ,chex JSR STH ADD2r
		INC2 LDAk ,&while JCN
	POP2 STH2r

JMP2r

@sihx ( str* -- flag )

	&while
		LDAk ,chex JSR #ff NEQ ,&valid JCN
			POP2 #00 JMP2r &valid
		INC2 LDAk ,&while JCN
	POP2
	#01

JMP2r

@chex ( char -- value/ff )

	DUP #2f GTH OVR #3a LTH AND ,&number JCN
	DUP #60 GTH OVR #67 LTH AND ,&lc JCN
		POP #ff

JMP2r
	&number #30 SUB JMP2r
	&lc #57 SUB JMP2r

@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
@sput ( chr str* -- ) ,scap JSR STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scat ( src* dst* -- ) DUP2 ,slen JSR ADD2
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA 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
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r

@print ( short* -- )

	SWP ,&byte JSR
	&byte ( byte -- ) DUP #04 SFT ,&char JSR
	&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO

JMP2r

@print-err ( token* err* -- )

	;&error-txt ,print-str JSR
	,print-str JSR #2018 DEO
	,print-str JSR #0a18 DEO

JMP2r
	&error-txt "-- 20 $1

@print-str ( str* -- )

	&while
		LDAk .Console/write DEO
		INC2 LDAk ,&while JCN
	POP2

JMP2r

@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

@str
	&hex "hex $1 &lit "lit $1 &dup "dup $1
	&far "far $1 &ref "ref $1 &key "key $1
	&rom "rom $1
	&assembled "Assembled 20 $1

@runes
	'| :do-padabs	'$ :do-padrel	'@ :do-plabel	'& :do-slabel
	'. :do-litbyt	', :do-litbyt	'; :do-litabs	': :do-rawabs
	'' :do-rawchr	'" :do-rawstr	'[ :do-ignore	'] :do-ignore
	'# :do-lithex 	&end

( buffers )

@syms $3000 ( addr* name* )
@refs $3000 ( addr* name* )

@dst $0100 ( zero-page ) 
	&clip ( program )


D src/procblim.tal => src/procblim.tal +0 -173
@@ 1,173 0,0 @@
( Usage: uxncli procblim.rom src/source.tal )

|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 $40 @dst $40 @token $30 @subtoken $30 @next $2

|0100

	;on-console .Console/vector DEO2
	;macros .next STZ2

BRK

@on-console ( -> )

	;src STH2
	( filepath )
	.Console/read DEI
	DUP #20 LTH OVR #7f GTH ORA ,&end JCN
	STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
		STH2r ;sput JSR2 BRK
		&end
	POP

	( output )
	STH2kr
	;dst ;scpy JSR2
	;&ext-txt ;dst ;scap JSR2 #0004 SUB2 ;scpy JSR2
	;dst .File2/name DEO2

	STH2r ,parse JSR

	( halt )
	#010e DEO
	#010f DEO

BRK
	&ext-txt ".pro.tal $1

@parse ( name* -- )

	.File1/name DEO2
	#0001 .File1/length DEO2

	&stream
		;&c .File1/read DEO2
		.File1/success DEI2 ORA #01 JCN JMP2r
		[ LIT &c $1 ] ,walk JSR
		,&stream JMP

JMP2r

@walk ( char -- )

	LIT '( EQUk NIP ,&toggle JCN
	LIT ') EQUk NIP ,&toggle JCN
	[ LIT &sleep $1 ] ,&skip JCN
	#20 GTHk NIP ,&append JCN
	;token
		DUP2 ,walk-token JSR
		#0030 ;mclr JSR2
	&skip
	POP

JMP2r
	&toggle #29 SUB ,&sleep STR JMP2r
	&append ;token ;sput JMP2

@walk-token ( token* -- )

	( skip empty ) ;slen JSR2 ORA #01 JCN JMP2r

	( macro )
	;token
		LDAk LIT '% EQU ;create-macro JCN2

	( replace )
	DUP2 ;find-macro JSR2
		ORAk ,replace-token JCN
	POP2

	,write-word JSR

JMP2r

@replace-token ( macro* -- )

	NIP2
	;scap JSR2 INC2 INC2

	&w
		;subtoken #0030 ;mclr JSR2
		DUP2 ;subtoken OVR2 ;word-length JSR2 ;mcpy JSR2
		;subtoken ;write-word JSR2
		,word-skip JSR
		INC2 LDAk ,&w JCN
	POP2

JMP2r

@write-word ( str* -- )

	DUP2 ;slen JSR2 .File2/length DEO2
		.File2/write DEO2
	#0001 .File2/length DEO2
	;&ws .File2/write DEO2

JMP2r
	&ws 20

@word-length ( str* -- length* )

	DUP2 ,word-skip JSR SWP2 SUB2

JMP2r

@word-skip ( str* -- word* )

	&eow INC2 LDAk #20 GTH ,&eow JCN

JMP2r

( macro )

@create-macro ( token* -- )

	INC2
	( push name )
	DUP2 .next LDZ2 ;scpy JSR2
	;slen JSR2 .next LDZ2 ADD2 INC2 .next STZ2
	&stream
		;&c .File1/read DEO2
		,&c LDR LIT '{ EQU ,&stream JCN
		,&c LDR LIT '} EQU ,&end JCN
		.File1/success DEI2 #0000 EQU2 ,&end JCN
		[ LIT &c $1 ] .next LDZ2 ;sput JSR2
		,&stream JMP
	&end
	.next LDZ2
		DUP2 ;slen JSR2 ADD2 INC2 .next STZ2

JMP2r

@find-macro ( token* -- macro* )

	STH2
	;macros
	&while
		DUP2 STH2kr ;scmp JSR2 ,&found JCN
		,scap JSR INC2 ,scap JSR INC2
		LDAk ,&while JCN
	POP2
	POP2r
	#0000

JMP2r
	&found POP2r JMP2r

( stdlib )

@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
@sput ( char str* -- ) ,scap JSR STA JMP2r
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA 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
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r JMP2r

@macros ( name | body | name | body .. )