commit 01a72f2

(repl.tal) First draft

  1@@ -1,4 +1,4 @@
  2-( Test )
  3+( REPL )
  4 
  5 |00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2
  6 |10 @Console &vector $2 &read $1 &pad $5 &write $1
  7@@ -10,20 +10,17 @@
  8 |0000
  9 
 10 	@input $80
 11+	@token $40
 12+	@p &ptr $2 &len $2
 13 
 14 |0100 ( -> )
 15 
 16 	( theme )
 17-	#07a6 .System/r DEO2
 18-	#075c .System/g DEO2
 19-	#07ca .System/b DEO2
 20+	#f0f7 .System/r DEO2
 21+	#50f7 .System/g DEO2
 22+	#60f7 .System/b DEO2
 23 	( vectors )
 24 	;on-button .Controller/vector DEO2
 25-	( move stacks into ram )
 26-	#fe .System/wst DEO
 27-	#ff .System/rst DEO
 28-	( put something in the stack )
 29-	#1234 #abcd
 30 	( draw )
 31 	#fe00 ;draw-stack JSR2
 32 
 33@@ -31,43 +28,137 @@ BRK
 34 
 35 @on-button ( -> )
 36 
 37-	#00 ;draw-input JSR2
 38 	.Controller/key DEI
 39-	[ #08 ] NEQk NIP ,&no-pop JCN ;input ;spop JSR2 &no-pop
 40-	[ #0d ] NEQk NIP ,&no-load JCN ;send JSR2 &no-load
 41-	DUP #20 LTH ,&end JCN
 42-	DUP #7e GTH ,&end JCN
 43-	;input ;slen JSR2 NIP #7f EQU ,&no-push JCN
 44-		DUP ;input ROT ;sput JSR2
 45-		&no-push
 46+	[ #0d ] EQUk NIP ,&validate JCN
 47+	[ #08 ] EQUk NIP ,&erase JCN
 48+	[ #20 ] LTHk NIP ,&end JCN
 49+	[ #7e ] GTHk NIP ,&end JCN
 50+	;input ;slen JSR2 NIP #80 LTH ,&append JCN
 51 	&end
 52 	POP
 53-	#01 ;draw-input JSR2
 54 
 55 BRK
 56+	&append ( char -> ) #00 ;draw-input JSR2 ;input ;sput JSR2 #01 ;draw-input JSR2 BRK
 57+	&erase ( char -> ) #00 ;draw-input JSR2 ;input ;spop JSR2 #01 ;draw-input JSR2 BRK
 58+	&validate ( char -> ) #00 ;draw-input JSR2 ;input ;sput JSR2 ;input ;parse JSR2 ;input #0080 ;mclr JSR2 BRK
 59 
 60-@send ( -- )
 61+@parse ( addr* -- )
 62+
 63+	&while
 64+		LDAk #20 GTH ,&no-space JCN 
 65+			;do-token JSR2
 66+			,&continue JMP
 67+			&no-space
 68+		LDAk ;token ;sput JSR2
 69+		&continue
 70+		INC2 LDAk ,&while JCN
 71+	POP2
 72 
 73-	;input ;print-str JSR2 #0a18 DEO
 74-	;input ;parse JSR2
 75-	;input #0080 ;mclr JSR2
 76-	#01 ;draw-input JSR2
 77+	( set return )
 78+	;&end ;write-litshort JSR2 #2c ;write-byte JSR2
 79+	( time to evaluate program )
 80+	( borrow wst ) #fe .System/wst DEO
 81+	;dst JMP2
 82+	&end
 83+	( released wst ) #00 .System/wst DEO
 84+	#fe00 ;draw-stack JSR2
 85+	
 86+	;dst .p/len LDZ2 #0004 ADD2 ;mclr JSR2
 87+	#0000 .p/len STZ2
 88+	#0000 .p/ptr STZ2
 89 
 90 JMP2r
 91 
 92-@parse ( addr* -- )
 93+@do-token ( -- )
 94 
 95-	LDAk LIT '# NEQ ,&no-lit JCN 
 96-		
 97+	;token LDAk LIT '# NEQ ,&no-lithex JCN
 98+		DUP2 INC2 ;do-lithex JSR2 ,&end JMP
 99+		&no-lithex
100+	DUP2 ;is-opcode JSR2 #00 EQU ,&no-opcode JCN
101+		DUP2 ;find-opcode JSR2 ;write-byte JSR2
102+		&no-opcode
103+	&end
104+	POP2
105 
106-	&no-lit
107+	;token #0040 ;mclr JSR2
108 
109-	POP2
110+	;draw-program JSR2
111 
112-	#2222
113-	#fe00 ;draw-stack JSR2
114+JMP2r
115+
116+@is-opcode ( string* -- flag )
117+
118+	DUP2 ;opcodes/brk ,scmp3 JSR ,find-opcode/on-brk JCN
119+
120+@find-opcode ( name* -- byte )
121+
122+	STH2
123+	#2000
124+	&loop
125+		#00 OVR #03 MUL ;opcodes ADD2 STH2kr ,scmp3 JSR ,&on-found JCN
126+		INC GTHk ,&loop JCN
127+	POP2 POP2r #00
128 
129 JMP2r
130+	&on-found NIP STH2r ,find-mode JSR ADD JMP2r
131+	&on-brk POP2 #01 JMP2r
132+
133+@find-mode ( mode* -- byte )
134+
135+	LITr 00
136+	;opcodes OVR2 ,scmp3 JSR #70 SFT STH ADDr
137+	INC2 INC2 INC2
138+	LDAk #00 EQU ,&end JCN
139+	&while
140+		LDAk LIT '2 EQU #50 SFT STH ADDr
141+		LDAk LIT 'r EQU #60 SFT STH ADDr
142+		LDAk LIT 'k EQU #70 SFT STH ADDr
143+		INC2 LDAk ,&while JCN
144+	&end
145+	POP2 STHr
146+
147+JMP2r
148+
149+@scmp3 ( a[3]* b[3]* -- flag )
150+
151+	LDA2k STH2 INC2 INC2 SWP2
152+	LDA2k STH2 INC2 INC2 EQU2r
153+	LDA STH LDA STH EQUr
154+	ANDr STHr
155+
156+JMP2r
157+
158+@do-lithex ( t* -- )
159+
160+	DUP2 ;slen JSR2 #0004 EQU2 ,&on-short JCN
161+	DUP2 ;slen JSR2 #0002 EQU2 ,&on-byte JCN
162+
163+;err/lithx ;print-err JMP2
164+
165+	&on-short ;sshort JSR2 ;write-litshort JMP2
166+	&on-byte ;sbyte JSR2 ;write-litbyte JMP2
167+
168+@write-litbyte ( byte -- )
169+
170+	( LITk ) #80 SWP ,write-short JMP
171+
172+@write-litshort ( short* -- )
173+
174+	( LIT2k ) #a0 ,write-byte JSR
175+
176+@write-short ( short -- )
177+
178+	SWP ,write-byte JSR
179+
180+@write-byte ( byte -- )
181+
182+	;dst .p/ptr LDZ2 STH2k ADD2 STA
183+	INC2r STH2kr .p/ptr STZ2
184+	STH2r .p/len STZ2
185+
186+JMP2r
187+
188+( drawing )
189 
190 @draw-input ( color -- )
191 
192@@ -84,7 +175,6 @@ JMP2r
193 	( position )
194 	#0020 .Screen/x DEO2
195 	#0020 .Screen/y DEO2
196-
197 	STH2k
198 	#00ff ADD2 LDA ,&length STR
199 	#01 .Screen/auto DEO
200@@ -106,6 +196,34 @@ JMP2r
201 
202 JMP2r
203 
204+@draw-program ( -- )
205+
206+	#0020 .Screen/x DEO2
207+	.Screen/height DEI2 #0020 SUB2 .Screen/y DEO2
208+	#10 ;dst ;draw-memory JSR2
209+
210+JMP2r
211+
212+@draw-memory ( length addr* -- )
213+
214+	STH2
215+	#01 .Screen/auto DEO
216+	.Screen/x DEI2 ,&anchor STR2
217+	#00
218+	&loop
219+		( linebreak )
220+		DUP #0f AND ,&skip JCN
221+			[ LIT2 &anchor $2 ] .Screen/x DEO2
222+			.Screen/y DEI2k #000a ADD2 ROT DEO2
223+			&skip
224+		( byte ) #00 OVR STH2kr ADD2 LDA #01 ;draw-byte JSR2
225+		.Screen/x DEI2k #0002 ADD2 ROT DEO2
226+		INC GTHk ,&loop JCN
227+	POP2
228+	POP2r
229+
230+JMP2r
231+
232 @draw-short ( short* color -- )
233 
234 	STH SWP STHkr ,draw-byte JSR STHr
235@@ -136,6 +254,8 @@ JMP2r
236 
237 JMP2r
238 
239+( utils )
240+
241 @scat ( src* dst* -- )
242 
243 	DUP2 ,slen JSR ADD2
244@@ -164,9 +284,9 @@ JMP2r
245 
246 JMP2r
247 
248-@sput ( str* char -- )
249+@sput ( char str* -- )
250 
251-	ROT ROT ,scap JSR STA
252+	,scap JSR STA
253 
254 JMP2r
255 
256@@ -178,6 +298,28 @@ JMP2r
257 
258 JMP2r
259 
260+@shex ( str* -- short* )
261+
262+	LIT2r 0000
263+	&while
264+		LITr 40 SFT2r
265+		LITr 00
266+		LDAk ,chex JSR STH ADD2r
267+		INC2 LDAk ,&while JCN
268+	POP2 STH2r
269+
270+JMP2r
271+
272+@chex ( char -- value )
273+
274+	DUP #2f GTH OVR #3a LTH AND ,&number JCN
275+	DUP #60 GTH OVR #67 LTH AND ,&lc JCN
276+		POP #00
277+
278+JMP2r
279+	&number #30 SUB JMP2r
280+	&lc #57 SUB JMP2r
281+
282 @mclr ( addr* len* -- )
283 
284 	OVR2 ADD2 SWP2
285@@ -208,6 +350,26 @@ JMP2r
286 
287 JMP2r
288 
289+@sshort ( str* -- short* )
290+
291+	INC2k INC2 ,sbyte JSR STH
292+	,sbyte JSR STHr
293+
294+JMP2r
295+
296+@sbyte ( str* -- byte )
297+
298+	LDAk ,chex JSR STH
299+	INC2 LDA ,chex JSR
300+	STHr #40 SFT ADD
301+
302+JMP2r
303+
304+@print-err ( token* err* -- )
305+
306+	LIT '! .Console/write DEO
307+	SWP2 ,print-str JSR #2018 DEO
308+
309 @print-str ( str* -- )
310 
311 	&while
312@@ -217,6 +379,18 @@ JMP2r
313 
314 JMP2r
315 
316+( assets )
317+
318+@opcodes
319+	"LIT "INC "POP "DUP "NIP "SWP "OVR "ROT
320+	"EQU "NEQ "GTH "LTH "JMP "JCN "JSR "STH
321+	"LDZ "STZ "LDR "STR "LDA "STA "DEI "DEO
322+	"ADD "SUB "MUL "DIV "AND "ORA "EOR "SFT
323+	&brk "BRK
324+
325+@err
326+	&lithx "LITHX $1 &label "LABEL $1 &token "TOKEN $1 &reslv "RESLV $1
327+
328 @font ( acorn8 )
329 	0000 0000 0000 0000 1818 1818 1800 1800
330 	3636 3600 0000 0000 3636 7f36 7f36 3600
331@@ -282,3 +456,5 @@ JMP2r
332 	1c30 307c 3030 30ff 1800 3818 1818 3cff
333 	0000 7c66 6666 66ff 0000 3c66 7e60 3cff
334 	0606 3e66 6666 3eff 0000 0000 0000 0000
335+
336+@dst