~aleteoryx/uxn

ref: 4a19b81bacf40581b5b06f88859cc5b1cfaf06d2 uxn/bfc.tal -rw-r--r-- 2.3 KiB
4a19b81b — Aleteoryx bfc cleanup 8 months ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

|0 @System &pad $e &debug $1 &state $1
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1

%dbg { LIT2 01 -System/debug DEO }

|100
@on-reset ( -> )
	;on-console .Console/vector DEO2
	;Code/intro Code/emit-line
	;Code/intro2 Code/emit-line
	BRK

@on-console ( -> )
	.Console/type DEI #04 NEQ ?{ ( EOF handling )
		Loops/not-empty? ?{ ;errs/mismatch errs/die }
	}
	.Console/read DEI

	DUP [ LIT "[ ] NEQ ?{ Loops/open }
	DUP [ LIT "] ] NEQ ?{ Loops/close }

	Code/emit
	BRK


@putn2 ( n* -- )
	SWP putn
	( >> )
@putn ( n -- )
	#10 DIVk DUP putbcd
	MUL SUB putbcd
	JMP2r
@putbcd ( n -- )
	DUP #0a LTH ?{ #27 ADD }
	#30 ADD .Console/write DEO
	JMP2r


@Code/tab
	"+ =/add
	"- =/sub
	"> =/next
	"< =/prev
	". =/out
	", =/in
	"[ =/open
	"] =/close
	$1

&add	"INC 0a
&sub	"STHrk 20 "SUB 0a
&next	"OVR 20 "STZ 20 "INC 20 "LDZk 0a
&prev	"OVR 20 "STZ 20 "STHrk 20 "SUB 20 "LDZk 0a
&out	"DUP 20 "#18 20 "DEO 0a
&in	"POP 20 ";{ 20 "#10 20 "DEO2 20 "BRK 20 "} 20 "#12 20 "DEI 0a
&open	20 "DUP 20 "#00 20 "EQU 20 "?{ 0a
&close	20 "} 0a

&intro "|100 20 "( 20 "generated 20 "by 20 "bfc.rom 20 ") 0a
&intro2 "LITr 20 "01 0a

&trailer "#800f 20 "DEO 20 "BRK 0a

&emit ( c -- )
	LIT2r =/tab
	( >> )

&search ( c `addr* -- )
	DUP LDArk STHr DUP
	#00 NEQ ?{ POP2r POP2 POP JMP2r }
	EQU ?{ INC2r INC2r INC2r !/search }
	POP STH2r INC2 LDA2
	( >> )

&emit-line ( addr* -- )
	LDAk .Console/write DEO
	LDAk #0a EQU ?{ INC2 !/emit-line }
	POP2 JMP2r


@Loops/open ( -- )
	[ LIT2 &ctr $2 ] INC2k ,/ctr STR2 ( get next loop idx )
	DUP2 /print-label
	[ LIT2 &ptr =/stack ] INC2k INC2 ,/ptr STR2 ( increment stack pointer )
	STA2 ( store idx )
	JMP2r

&close ( -- )
	,/ptr LDR2 #0002 SUB2 ( decrement stack pointer )
	LDA2k INC2k ORA ?{ ;errs/underflow errs/die }
	/print-jmi
	,/ptr STR2
	JMP2r

&not-empty? ( -- empty )
	,/ptr LDR2 ;/stack EQU2
	JMP2r

&print-label ( n* -- )
	[ LIT2 "@ -Console/write ] DEO
	!/print-name
&print-jmi ( n* -- )
	[ LIT2 "! -Console/write ] DEO
	( >> )
&print-name ( n* -- )
	[ LIT2 "l -Console/write ] DEO
	putn2
	JMP2r


@errs/die ( addr* -- )
	LDAk DUP ?{ #ff .System/state DEO BRK }
	.Console/error DEO
	INC2 !/die

&underflow	"fatal: 20 "too 20 "many 20 "closing 20 "braces. 0a $1
&mismatch	"fatal: 20 "not 20 "enough 20 "closing 20 "braces. 0a $1


@Loops/guard [ ffff ]
&stack ( goes to end of ram )