~aleteoryx/uxn

ref: ad6afdf57e4e3b79e4f582bc70a2b241badbe43b uxn/bfc.tal -rw-r--r-- 2.6 KiB
ad6afdf5 — Aleteoryx replace lambdas with labels 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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

|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 }
	DUP [ LIT ", ] NEQ ?{ Labels/get Labels/print-label }

	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
@puts ( addr* -- )
	LDAk DUP ?{ POP2 POP JMP2r }
	.Console/write DEO
	INC2 !puts

@Code/tab
	"+ =/add
	"- =/sub
	"> =/next
	"< =/prev
	". =/out
	", =/in
	"[ =/close
	"] =/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	20 "POP 20 ";{ 20 "#10 20 "DEO2 20 "BRK 20 "} 20 "#12 20 "DEI 0a

&open	20 "DUP 20 "#00 20 "EQU 20 $1
&close	"r 0a $1

&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


@Labels/get ( -- label* )
	[ LIT2 &ctr $2 ] INC2k ,/ctr STR2 ( get next loop idx )
	JMP2r

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

@Loops/open ( -- )
	Labels/get DUP2 Labels/print-label
	;Code/open puts
	DUP2 Labels/print-jci
	[ 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 }
	DUP2 Labels/print-jmi
	[ LIT2 20 -Console/write ] DEO
	Labels/print-label
	,/ptr STR2
	JMP2r

&not-empty? ( -- empty )
	,/ptr LDR2 ;/stack EQU2
	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 )