eNuTDMMk

1
2; Enhanced BASIC to assemble under 6502 simulator, $ver 2.10
3
4; $E7E1 $E7CF $E7C6 $E7D3 $E7D1 $E7D5 $E7CF
5
6; 2.00	new revision numbers start here
7; 2.01	fixed LCASE$() and UCASE$()
8; 2.02	new get value routine done
9; 2.03	changed RND() to galoise method
10; 2.04	fixed SPC()
11; 2.05	new get value routine fixed
12; 2.06	changed USR() code
13; 2.07	fixed STR$()
14; 2.08	changed INPUT and READ to remove need for $00 start to input buffer
15; 2.09	fixed RND()
16; 2.10	integrated missed changes from an earlier version
17
18; zero page use ..
19
20LAB_WARM 		= $00		; BASIC warm start entry point
21Wrmjpl 		= LAB_WARM+1; BASIC warm start vector jump low byte
22Wrmjph 		= LAB_WARM+2; BASIC warm start vector jump high byte
23
24Usrjmp		= $0A		; USR function JMP address
25Usrjpl		= Usrjmp+1	; USR function JMP vector low byte
26Usrjph		= Usrjmp+2	; USR function JMP vector high byte
27Nullct		= $0D		; nulls output after each line
28TPos			= $0E		; BASIC terminal position byte
29TWidth		= $0F		; BASIC terminal width byte
30Iclim			= $10		; input column limit
31Itempl		= $11		; temporary integer low byte
32Itemph		= Itempl+1	; temporary integer high byte
33
34nums_1		= Itempl	; number to bin/hex string convert MSB
35nums_2		= nums_1+1	; number to bin/hex string convert
36nums_3		= nums_1+2	; number to bin/hex string convert LSB
37
38Srchc			= $5B		; search character
39Temp3			= Srchc	; temp byte used in number routines
40Scnquo		= $5C		; scan-between-quotes flag
41Asrch			= Scnquo	; alt search character
42
43XOAw_l		= Srchc	; eXclusive OR, OR and AND word low byte
44XOAw_h		= Scnquo	; eXclusive OR, OR and AND word high byte
45
46Ibptr			= $5D		; input buffer pointer
47Dimcnt		= Ibptr	; # of dimensions
48Tindx			= Ibptr	; token index
49
50Defdim		= $5E		; default DIM flag
51Dtypef		= $5F		; data type flag, $FF=string, $00=numeric
52Oquote		= $60		; open quote flag (b7) (Flag: DATA scan; LIST quote; memory)
53Gclctd		= $60		; garbage collected flag
54Sufnxf		= $61		; subscript/FNX flag, 1xxx xxx = FN(0xxx xxx)
55Imode			= $62		; input mode flag, $00=INPUT, $80=READ
56
57Cflag			= $63		; comparison evaluation flag
58
59TabSiz		= $64		; TAB step size (was input flag)
60
61next_s		= $65		; next descriptor stack address
62
63					; these two bytes form a word pointer to the item
64					; currently on top of the descriptor stack
65last_sl		= $66		; last descriptor stack address low byte
66last_sh		= $67		; last descriptor stack address high byte (always $00)
67
68des_sk		= $68		; descriptor stack start address (temp strings)
69
70;			= $70		; End of descriptor stack
71
72ut1_pl		= $71		; utility pointer 1 low byte
73ut1_ph		= ut1_pl+1	; utility pointer 1 high byte
74ut2_pl		= $73		; utility pointer 2 low byte
75ut2_ph		= ut2_pl+1	; utility pointer 2 high byte
76
77Temp_2		= ut1_pl	; temp byte for block move	
78
79FACt_1		= $75		; FAC temp mantissa1
80FACt_2		= FACt_1+1	; FAC temp mantissa2
81FACt_3		= FACt_2+1	; FAC temp mantissa3
82
83dims_l		= FACt_2	; array dimension size low byte
84dims_h		= FACt_3	; array dimension size high byte
85
86TempB			= $78		; temp page 0 byte
87
88Smeml			= $79		; start of mem low byte		(Start-of-Basic)
89Smemh			= Smeml+1	; start of mem high byte	(Start-of-Basic)
90Svarl			= $7B		; start of vars low byte	(Start-of-Variables)
91Svarh			= Svarl+1	; start of vars high byte	(Start-of-Variables)
92Sarryl		= $7D		; var mem end low byte		(Start-of-Arrays)
93Sarryh		= Sarryl+1	; var mem end high byte		(Start-of-Arrays)
94Earryl		= $7F		; array mem end low byte	(End-of-Arrays)
95Earryh		= Earryl+1	; array mem end high byte	(End-of-Arrays)
96Sstorl		= $81		; string storage low byte	(String storage (moving down))
97Sstorh		= Sstorl+1	; string storage high byte	(String storage (moving down))
98Sutill		= $83		; string utility ptr low byte
99Sutilh		= Sutill+1	; string utility ptr high byte
100Ememl			= $85		; end of mem low byte		(Limit-of-memory)
101Ememh			= Ememl+1	; end of mem high byte		(Limit-of-memory)
102Clinel		= $87		; current line low byte		(Basic line number)
103Clineh		= Clinel+1	; current line high byte	(Basic line number)
104Blinel		= $89		; break line low byte		(Previous Basic line number)
105Blineh		= Blinel+1	; break line high byte		(Previous Basic line number)
106
107Cpntrl		= $8B		; continue pointer low byte
108Cpntrh		= Cpntrl+1	; continue pointer high byte
109
110Dlinel		= $8D		; current DATA line low byte
111Dlineh		= Dlinel+1	; current DATA line high byte
112
113Dptrl			= $8F		; DATA pointer low byte
114Dptrh			= Dptrl+1	; DATA pointer high byte
115
116Rdptrl		= $91		; read pointer low byte
117Rdptrh		= Rdptrl+1	; read pointer high byte
118
119Varnm1		= $93		; current var name 1st byte
120Varnm2		= Varnm1+1	; current var name 2nd byte
121
122Cvaral		= $95		; current var address low byte
123Cvarah		= Cvaral+1	; current var address high byte
124
125Frnxtl		= $97		; var pointer for FOR/NEXT low byte
126Frnxth		= Frnxtl+1	; var pointer for FOR/NEXT high byte
127
128Tidx1			= Frnxtl	; temp line index
129
130Lvarpl		= Frnxtl	; let var pointer low byte
131Lvarph		= Frnxth	; let var pointer high byte
132
133prstk			= $99		; precedence stacked flag
134
135comp_f		= $9B		; compare function flag, bits 0,1 and 2 used
136					; bit 2 set if >
137					; bit 1 set if =
138					; bit 0 set if <
139
140func_l		= $9C		; function pointer low byte
141func_h		= func_l+1	; function pointer high byte
142
143garb_l		= func_l	; garbage collection working pointer low byte
144garb_h		= func_h	; garbage collection working pointer high byte
145
146des_2l		= $9E		; string descriptor_2 pointer low byte
147des_2h		= des_2l+1	; string descriptor_2 pointer high byte
148
149g_step		= $A0		; garbage collect step size
150
151Fnxjmp		= $A1		; jump vector for functions
152Fnxjpl		= Fnxjmp+1	; functions jump vector low byte
153Fnxjph		= Fnxjmp+2	; functions jump vector high byte
154
155g_indx		= Fnxjpl	; garbage collect temp index
156
157FAC2_r		= $A3		; FAC2 rounding byte
158
159Adatal		= $A4		; array data pointer low byte
160Adatah		= Adatal+1	; array data pointer high  byte
161
162Nbendl		= Adatal	; new block end pointer low byte
163Nbendh		= Adatah	; new block end pointer high  byte
164
165Obendl		= $A6		; old block end pointer low byte
166Obendh		= Obendl+1	; old block end pointer high  byte
167
168numexp		= $A8		; string to float number exponent count
169expcnt		= $A9		; string to float exponent count
170
171numbit		= numexp	; bit count for array element calculations
172
173numdpf		= $AA		; string to float decimal point flag
174expneg		= $AB		; string to float eval exponent -ve flag
175
176Astrtl		= numdpf	; array start pointer low byte
177Astrth		= expneg	; array start pointer high  byte
178
179Histrl		= numdpf	; highest string low byte
180Histrh		= expneg	; highest string high  byte
181
182Baslnl		= numdpf	; BASIC search line pointer low byte
183Baslnh		= expneg	; BASIC search line pointer high  byte
184
185Fvar_l		= numdpf	; find/found variable pointer low byte
186Fvar_h		= expneg	; find/found variable pointer high  byte
187
188Ostrtl		= numdpf	; old block start pointer low byte
189Ostrth		= expneg	; old block start pointer high  byte
190
191Vrschl		= numdpf	; variable search pointer low byte
192Vrschh		= expneg	; variable search pointer high  byte
193
194FAC1_e		= $AC		; FAC1 exponent
195FAC1_1		= FAC1_e+1	; FAC1 mantissa1
196FAC1_2		= FAC1_e+2	; FAC1 mantissa2
197FAC1_3		= FAC1_e+3	; FAC1 mantissa3
198FAC1_s		= FAC1_e+4	; FAC1 sign (b7)
199
200str_ln		= FAC1_e	; string length
201str_pl		= FAC1_1	; string pointer low byte
202str_ph		= FAC1_2	; string pointer high byte
203
204des_pl		= FAC1_2	; string descriptor pointer low byte
205des_ph		= FAC1_3	; string descriptor pointer high byte
206
207mids_l		= FAC1_3	; MID$ string temp length byte
208
209negnum		= $B1		; string to float eval -ve flag
210numcon		= $B1		; series evaluation constant count
211
212FAC1_o		= $B2		; FAC1 overflow byte
213
214FAC2_e		= $B3		; FAC2 exponent
215FAC2_1		= FAC2_e+1	; FAC2 mantissa1
216FAC2_2		= FAC2_e+2	; FAC2 mantissa2
217FAC2_3		= FAC2_e+3	; FAC2 mantissa3
218FAC2_s		= FAC2_e+4	; FAC2 sign (b7)
219
220FAC_sc		= $B8		; FAC sign comparison, Acc#1 vs #2
221FAC1_r		= $B9		; FAC1 rounding byte
222
223ssptr_l		= FAC_sc	; string start pointer low byte
224ssptr_h		= FAC1_r	; string start pointer high byte
225
226sdescr		= FAC_sc	; string descriptor pointer
227
228csidx			= $BA		; line crunch save index
229Asptl			= csidx	; array size/pointer low byte
230Aspth			= $BB		; array size/pointer high byte
231
232Btmpl			= Asptl	; BASIC pointer temp low byte
233Btmph			= Aspth	; BASIC pointer temp low byte
234
235Cptrl			= Asptl	; BASIC pointer temp low byte
236Cptrh			= Aspth	; BASIC pointer temp low byte
237
238Sendl			= Asptl	; BASIC pointer temp low byte
239Sendh			= Aspth	; BASIC pointer temp low byte
240
241LAB_IGBY		= $BC		; get next BASIC byte subroutine
242
243LAB_GBYT		= $C2		; get current BASIC byte subroutine
244Bpntrl		= $C3		; BASIC execute (get byte) pointer low byte
245Bpntrh		= Bpntrl+1	; BASIC execute (get byte) pointer high byte
246
247;			= $D3		; end of get BASIC char subroutine
248
249Rbyte4		= $D4		; extra PRNG byte
250Rbyte1		= Rbyte4+1	; most significant PRNG byte
251Rbyte2		= Rbyte4+2	; middle PRNG byte
252Rbyte3		= Rbyte4+3	; least significant PRNG byte
253
254NmiBase		= $D8		; NMI handler enabled/setup/triggered flags
255					; bit	function
256					; ===	========
257					; 7	interrupt enabled
258					; 6	interrupt setup
259					; 5	interrupt happened
260;			= $D9		; NMI handler addr low byte
261;			= $DA		; NMI handler addr high byte
262IrqBase		= $DB		; IRQ handler enabled/setup/triggered flags
263;			= $DC		; IRQ handler addr low byte
264;			= $DD		; IRQ handler addr high byte
265
266;			= $DE		; unused
267;			= $DF		; unused
268;			= $E0		; unused
269;			= $E1		; unused
270;			= $E2		; unused
271;			= $E3		; unused
272;			= $E4		; unused
273;			= $E5		; unused
274;			= $E6		; unused
275;			= $E7		; unused
276;			= $E8		; unused
277;			= $E9		; unused
278;			= $EA		; unused
279;			= $EB		; unused
280;			= $EC		; unused
281;			= $ED		; unused
282;			= $EE		; unused
283
284Decss			= $EF		; number to decimal string start
285Decssp1		= Decss+1	; number to decimal string start
286
287;			= $FF		; decimal string end
288
289; token values needed for BASIC
290
291; primary command tokens (can start a statement)
292
293TK_END		= $80			; END token
294TK_FOR		= TK_END+1		; FOR token
295TK_NEXT		= TK_FOR+1		; NEXT token
296TK_DATA		= TK_NEXT+1		; DATA token
297TK_INPUT	= TK_DATA+1		; INPUT token
298TK_DIM		= TK_INPUT+1	; DIM token
299TK_READ		= TK_DIM+1		; READ token
300TK_LET		= TK_READ+1		; LET token
301TK_DEC		= TK_LET+1		; DEC token
302TK_GOTO		= TK_DEC+1		; GOTO token
303TK_RUN		= TK_GOTO+1		; RUN token
304TK_IF		= TK_RUN+1		; IF token
305TK_RESTORE	= TK_IF+1		; RESTORE token
306TK_GOSUB	= TK_RESTORE+1	; GOSUB token
307TK_RETIRQ	= TK_GOSUB+1	; RETIRQ token
308TK_RETNMI	= TK_RETIRQ+1	; RETNMI token
309TK_RETURN	= TK_RETNMI+1	; RETURN token
310TK_REM		= TK_RETURN+1	; REM token
311TK_STOP		= TK_REM+1		; STOP token
312TK_ON		= TK_STOP+1		; ON token
313TK_NULL		= TK_ON+1		; NULL token
314TK_INC		= TK_NULL+1		; INC token
315TK_WAIT		= TK_INC+1		; WAIT token
316TK_LOAD		= TK_WAIT+1		; LOAD token
317TK_SAVE		= TK_LOAD+1		; SAVE token
318TK_DEF		= TK_SAVE+1		; DEF token
319TK_POKE		= TK_DEF+1		; POKE token
320TK_DOKE		= TK_POKE+1		; DOKE token
321TK_CALL		= TK_DOKE+1		; CALL token
322TK_DO		= TK_CALL+1		; DO token
323TK_LOOP		= TK_DO+1		; LOOP token
324TK_PRINT	= TK_LOOP+1		; PRINT token
325TK_CONT		= TK_PRINT+1	; CONT token
326TK_LIST		= TK_CONT+1		; LIST token
327TK_CLEAR	= TK_LIST+1		; CLEAR token
328TK_NEW		= TK_CLEAR+1	; NEW token
329TK_WIDTH	= TK_NEW+1		; WIDTH token
330TK_GET		= TK_WIDTH+1	; GET token
331TK_SWAP		= TK_GET+1		; SWAP token
332TK_BITSET	= TK_SWAP+1		; BITSET token
333TK_BITCLR	= TK_BITSET+1	; BITCLR token
334TK_IRQ		= TK_BITCLR+1	; IRQ token
335TK_NMI		= TK_IRQ+1		; NMI token
336
337; secondary command tokens, can't start a statement
338
339TK_TAB		= TK_NMI+1		; TAB token
340TK_TO			= TK_TAB+1		; TO token
341TK_FN			= TK_TO+1		; FN token
342TK_SPC		= TK_FN+1		; SPC token
343TK_THEN		= TK_SPC+1		; THEN token
344TK_NOT		= TK_THEN+1		; NOT token
345TK_STEP		= TK_NOT+1		; STEP token
346TK_UNTIL		= TK_STEP+1		; UNTIL token
347TK_WHILE		= TK_UNTIL+1	; WHILE token
348TK_OFF		= TK_WHILE+1	; OFF token
349
350; opperator tokens
351
352TK_PLUS		= TK_OFF+1		; + token
353TK_MINUS		= TK_PLUS+1		; - token
354TK_MUL		= TK_MINUS+1	; * token
355TK_DIV		= TK_MUL+1		; / token
356TK_POWER		= TK_DIV+1		; ^ token
357TK_AND		= TK_POWER+1	; AND token
358TK_EOR		= TK_AND+1		; EOR token
359TK_OR			= TK_EOR+1		; OR token
360TK_RSHIFT		= TK_OR+1		; RSHIFT token
361TK_LSHIFT		= TK_RSHIFT+1	; LSHIFT token
362TK_GT			= TK_LSHIFT+1	; > token
363TK_EQUAL		= TK_GT+1		; = token
364TK_LT			= TK_EQUAL+1	; < token
365
366; functions tokens
367
368TK_SGN		= TK_LT+1		; SGN token
369TK_INT		= TK_SGN+1		; INT token
370TK_ABS		= TK_INT+1		; ABS token
371TK_USR		= TK_ABS+1		; USR token
372TK_FRE		= TK_USR+1		; FRE token
373TK_POS		= TK_FRE+1		; POS token
374TK_SQR		= TK_POS+1		; SQR token
375TK_RND		= TK_SQR+1		; RND token
376TK_LOG		= TK_RND+1		; LOG token
377TK_EXP		= TK_LOG+1		; EXP token
378TK_COS		= TK_EXP+1		; COS token
379TK_SIN		= TK_COS+1		; SIN token
380TK_TAN		= TK_SIN+1		; TAN token
381TK_ATN		= TK_TAN+1		; ATN token
382TK_PEEK		= TK_ATN+1		; PEEK token
383TK_DEEK		= TK_PEEK+1		; DEEK token
384TK_SADD		= TK_DEEK+1		; SADD token
385TK_LEN		= TK_SADD+1		; LEN token
386TK_STRS		= TK_LEN+1		; STR$ token
387TK_VAL		= TK_STRS+1		; VAL token
388TK_ASC		= TK_VAL+1		; ASC token
389TK_UCASES		= TK_ASC+1		; UCASE$ token
390TK_LCASES		= TK_UCASES+1	; LCASE$ token
391TK_CHRS		= TK_LCASES+1	; CHR$ token
392TK_HEXS		= TK_CHRS+1		; HEX$ token
393TK_BINS		= TK_HEXS+1		; BIN$ token
394TK_BITTST		= TK_BINS+1		; BITTST token
395TK_MAX		= TK_BITTST+1	; MAX token
396TK_MIN		= TK_MAX+1		; MIN token
397TK_PI			= TK_MIN+1		; PI token
398TK_TWOPI		= TK_PI+1		; TWOPI token
399TK_VPTR		= TK_TWOPI+1	; VARPTR token
400TK_LEFTS		= TK_VPTR+1		; LEFT$ token
401TK_RIGHTS		= TK_LEFTS+1	; RIGHT$ token
402TK_MIDS		= TK_RIGHTS+1	; MID$ token
403
404; offsets from a base of X or Y
405
406PLUS_0		= $00		; X or Y plus 0
407PLUS_1		= $01		; X or Y plus 1
408PLUS_2		= $02		; X or Y plus 2
409PLUS_3		= $03		; X or Y plus 3
410
411LAB_STAK		= $0100	; stack bottom, no offset
412
413LAB_SKFE		= LAB_STAK+$FE
414					; flushed stack address
415LAB_SKFF		= LAB_STAK+$FF
416					; flushed stack address
417
418ccflag		= $0200	; BASIC CTRL-C flag, 00 = enabled, 01 = dis
419ccbyte		= ccflag+1	; BASIC CTRL-C byte
420ccnull		= ccbyte+1	; BASIC CTRL-C byte timeout
421
422VEC_CC		= ccnull+1	; ctrl c check vector
423
424VEC_IN		= VEC_CC+2	; input vector
425VEC_OUT		= VEC_IN+2	; output vector
426VEC_LD		= VEC_OUT+2	; load vector
427VEC_SV		= VEC_LD+2	; save vector
428
429; Ibuffs can now be anywhere in RAM, ensure that the max length is < $80
430
431Ibuffs		= IRQ_vec+$14
432					; start of input buffer after IRQ/NMI code
433Ibuffe		= Ibuffs+$47; end of input buffer
434
435Ram_base		= $0300	; start of user RAM (set as needed, should be page aligned)
436Ram_top		= $C000	; end of user RAM+1 (set as needed, should be page aligned)
437
438; This start can be changed to suit your system
439
440	*=	$C000
441
442; BASIC cold start entry point
443
444; new page 2 initialisation, copy block to ccflag on
445
446LAB_COLD
447	LDY	#PG2_TABE-PG2_TABS-1
448					; byte count-1
449LAB_2D13
450	LDA	PG2_TABS,Y		; get byte
451	STA	ccflag,Y		; store in page 2
452	DEY				; decrement count
453	BPL	LAB_2D13		; loop if not done
454
455	LDX	#$FF			; set byte
456	STX	Clineh		; set current line high byte (set immediate mode)
457	TXS				; reset stack pointer
458
459	LDA	#$4C			; code for JMP
460	STA	Fnxjmp		; save for jump vector for functions
461
462; copy block from LAB_2CEE to $00BC - $00D3
463
464	LDX	#StrTab-LAB_2CEE	; set byte count
465LAB_2D4E
466	LDA	LAB_2CEE-1,X	; get byte from table
467	STA	LAB_IGBY-1,X	; save byte in page zero
468	DEX				; decrement count
469	BNE	LAB_2D4E		; loop if not all done
470
471; copy block from StrTab to $0000 - $0012
472
473LAB_GMEM
474	LDX	#EndTab-StrTab-1	; set byte count-1
475TabLoop
476	LDA	StrTab,X		; get byte from table
477	STA	PLUS_0,X		; save byte in page zero
478	DEX				; decrement count
479	BPL	TabLoop		; loop if not all done
480
481; set-up start values
482
483	LDA	#$00			; clear A
484	STA	NmiBase		; clear NMI handler enabled flag
485	STA	IrqBase		; clear IRQ handler enabled flag
486	STA	FAC1_o		; clear FAC1 overflow byte
487	STA	last_sh		; clear descriptor stack top item pointer high byte
488
489	LDA	#$0E			; set default tab size
490	STA	TabSiz		; save it
491	LDA	#$03			; set garbage collect step size for descriptor stack
492	STA	g_step		; save it
493	LDX	#des_sk		; descriptor stack start
494	STX	next_s		; set descriptor stack pointer
495	JSR	LAB_CRLF		; print CR/LF
496	LDA	#<LAB_MSZM		; point to memory size message (low addr)
497	LDY	#>LAB_MSZM		; point to memory size message (high addr)
498	JSR	LAB_18C3		; print null terminated string from memory
499	JSR	LAB_INLN		; print "? " and get BASIC input
500	STX	Bpntrl		; set BASIC execute pointer low byte
501	STY	Bpntrh		; set BASIC execute pointer high byte
502	JSR	LAB_GBYT		; get last byte back
503
504	BNE	LAB_2DAA		; branch if not null (user typed something)
505
506	LDY	#$00			; else clear Y
507					; character was null so get memory size the hard way
508					; we get here with Y=0 and Itempl/h = Ram_base
509LAB_2D93
510	INC	Itempl		; increment temporary integer low byte
511	BNE	LAB_2D99		; branch if no overflow
512
513	INC	Itemph		; increment temporary integer high byte
514	LDA	Itemph		; get high byte
515	CMP	#>Ram_top		; compare with top of RAM+1
516	BEQ	LAB_2DB6		; branch if match (end of user RAM)
517
518LAB_2D99
519	LDA	#$55			; set test byte
520	STA	(Itempl),Y		; save via temporary integer
521	CMP	(Itempl),Y		; compare via temporary integer
522	BNE	LAB_2DB6		; branch if fail
523
524	ASL				; shift test byte left (now $AA)
525	STA	(Itempl),Y		; save via temporary integer
526	CMP	(Itempl),Y		; compare via temporary integer
527	BEQ	LAB_2D93		; if ok go do next byte
528
529	BNE	LAB_2DB6		; branch if fail
530
531LAB_2DAA
532	JSR	LAB_2887		; get FAC1 from string
533	LDA	FAC1_e		; get FAC1 exponent
534	CMP	#$98			; compare with exponent = 2^24
535	BCS	LAB_GMEM		; if too large go try again
536
537	JSR	LAB_F2FU		; save integer part of FAC1 in temporary integer
538					; (no range check)
539
540LAB_2DB6
541	LDA	Itempl		; get temporary integer low byte
542	LDY	Itemph		; get temporary integer high byte
543	CPY	#<Ram_base+1	; compare with start of RAM+$100 high byte
544	BCC	LAB_GMEM		; if too small go try again
545
546
547; uncomment these lines if you want to check on the high limit of memory. Note if
548; Ram_top is set too low then this will fail. default is ignore it and assume the
549; users know what they're doing!
550
551;	CPY	#>Ram_top		; compare with top of RAM high byte
552;	BCC	MEM_OK		; branch if < RAM top
553
554;	BNE	LAB_GMEM		; if too large go try again
555					; else was = so compare low bytes
556;	CMP	#<Ram_top		; compare with top of RAM low byte
557;	BEQ	MEM_OK		; branch if = RAM top
558
559;	BCS	LAB_GMEM		; if too large go try again
560
561;MEM_OK
562	STA	Ememl			; set end of mem low byte
563	STY	Ememh			; set end of mem high byte
564	STA	Sstorl		; set bottom of string space low byte
565	STY	Sstorh		; set bottom of string space high byte
566
567	LDY	#<Ram_base		; set start addr low byte
568	LDX	#>Ram_base		; set start addr high byte
569	STY	Smeml			; save start of mem low byte
570	STX	Smemh			; save start of mem high byte
571
572; this line is only needed if Ram_base is not $xx00
573
574;	LDY	#$00			; clear Y
575	TYA				; clear A
576	STA	(Smeml),Y		; clear first byte
577	INC	Smeml			; increment start of mem low byte
578
579; these two lines are only needed if Ram_base is $xxFF
580
581;	BNE	LAB_2E05		; branch if no rollover
582
583;	INC	Smemh			; increment start of mem high byte
584LAB_2E05
585	JSR	LAB_CRLF		; print CR/LF
586	JSR	LAB_1463		; do "NEW" and "CLEAR"
587	LDA	Ememl			; get end of mem low byte
588	SEC				; set carry for subtract
589	SBC	Smeml			; subtract start of mem low byte
590	TAX				; copy to X
591	LDA	Ememh			; get end of mem high byte
592	SBC	Smemh			; subtract start of mem high byte
593	JSR	LAB_295E		; print XA as unsigned integer (bytes free)
594	LDA	#<LAB_SMSG		; point to sign-on message (low addr)
595	LDY	#>LAB_SMSG		; point to sign-on message (high addr)
596	JSR	LAB_18C3		; print null terminated string from memory
597	LDA	#<LAB_1274		; warm start vector low byte
598	LDY	#>LAB_1274		; warm start vector high byte
599	STA	Wrmjpl		; save warm start vector low byte
600	STY	Wrmjph		; save warm start vector high byte
601	JMP	(Wrmjpl)		; go do warm start
602
603; open up space in memory
604; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)
605
606; Nbendl,Nbendh - new block end address (A/Y)
607; Obendl,Obendh - old block end address
608; Ostrtl,Ostrth - old block start address
609
610; returns with ..
611
612; Nbendl,Nbendh - new block start address (high byte - $100)
613; Obendl,Obendh - old block start address (high byte - $100)
614; Ostrtl,Ostrth - old block start address (unchanged)
615
616LAB_11CF
617	JSR	LAB_121F		; check available memory, "Out of memory" error if no room
618					; addr to check is in AY (low/high)
619	STA	Earryl		; save new array mem end low byte
620	STY	Earryh		; save new array mem end high byte
621
622; open up space in memory
623; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)
624; don't set array end
625
626LAB_11D6
627	SEC				; set carry for subtract
628	LDA	Obendl		; get block end low byte
629	SBC	Ostrtl		; subtract block start low byte
630	TAY				; copy MOD(block length/$100) byte to Y
631	LDA	Obendh		; get block end high byte
632	SBC	Ostrth		; subtract block start high byte
633	TAX				; copy block length high byte to X
634	INX				; +1 to allow for count=0 exit
635	TYA				; copy block length low byte to A
636	BEQ	LAB_120A		; branch if length low byte=0
637
638					; block is (X-1)*256+Y bytes, do the Y bytes first
639
640	SEC				; set carry for add + 1, two's complement
641	EOR	#$FF			; invert low byte for subtract
642	ADC	Obendl		; add block end low byte
643
644	STA	Obendl		; save corrected old block end low byte
645	BCS	LAB_11F3		; branch if no underflow
646
647	DEC	Obendh		; else decrement block end high byte
648	SEC				; set carry for add + 1, two's complement
649LAB_11F3
650	TYA				; get MOD(block length/$100) byte
651	EOR	#$FF			; invert low byte for subtract
652	ADC	Nbendl		; add destination end low byte
653	STA	Nbendl		; save modified new block end low byte
654	BCS	LAB_1203		; branch if no underflow
655
656	DEC	Nbendh		; else decrement block end high byte
657	BCC	LAB_1203		; branch always
658
659LAB_11FF
660	LDA	(Obendl),Y		; get byte from source
661	STA	(Nbendl),Y		; copy byte to destination
662LAB_1203
663	DEY				; decrement index
664	BNE	LAB_11FF		; loop until Y=0
665
666					; now do Y=0 indexed byte
667	LDA	(Obendl),Y		; get byte from source
668	STA	(Nbendl),Y		; save byte to destination
669LAB_120A
670	DEC	Obendh		; decrement source pointer high byte
671	DEC	Nbendh		; decrement destination pointer high byte
672	DEX				; decrement block count
673	BNE	LAB_1203		; loop until count = $0
674
675	RTS
676
677; check room on stack for A bytes
678; stack too deep? do OM error
679
680LAB_1212
681	STA	TempB			; save result in temp byte
682	TSX				; copy stack
683	CPX	TempB			; compare new "limit" with stack
684	BCC	LAB_OMER		; if stack < limit do "Out of memory" error then warm start
685
686	RTS
687
688; check available memory, "Out of memory" error if no room
689; addr to check is in AY (low/high)
690
691LAB_121F
692	CPY	Sstorh		; compare bottom of string mem high byte
693	BCC	LAB_124B		; if less then exit (is ok)
694
695	BNE	LAB_1229		; skip next test if greater (tested <)
696
697					; high byte was =, now do low byte
698	CMP	Sstorl		; compare with bottom of string mem low byte
699	BCC	LAB_124B		; if less then exit (is ok)
700
701					; addr is > string storage ptr (oops!)
702LAB_1229
703	PHA				; push addr low byte
704	LDX	#$08			; set index to save Adatal to expneg inclusive
705	TYA				; copy addr high byte (to push on stack)
706
707					; save misc numeric work area
708LAB_122D
709	PHA				; push byte
710	LDA	Adatal-1,X		; get byte from Adatal to expneg ( ,$00 not pushed)
711	DEX				; decrement index
712	BPL	LAB_122D		; loop until all done
713
714	JSR	LAB_GARB		; garbage collection routine
715
716					; restore misc numeric work area
717	LDX	#$00			; clear the index to restore bytes
718LAB_1238
719	PLA				; pop byte
720	STA	Adatal,X		; save byte to Adatal to expneg
721	INX				; increment index
722	CPX	#$08			; compare with end + 1
723	BMI	LAB_1238		; loop if more to do
724
725	PLA				; pop addr high byte
726	TAY				; copy back to Y
727	PLA				; pop addr low byte
728	CPY	Sstorh		; compare bottom of string mem high byte
729	BCC	LAB_124B		; if less then exit (is ok)
730
731	BNE	LAB_OMER		; if greater do "Out of memory" error then warm start
732
733					; high byte was =, now do low byte
734	CMP	Sstorl		; compare with bottom of string mem low byte
735	BCS	LAB_OMER		; if >= do "Out of memory" error then warm start
736
737					; ok exit, carry clear
738LAB_124B
739	RTS
740
741; do "Out of memory" error then warm start
742
743LAB_OMER
744	LDX	#$0C			; error code $0C ("Out of memory" error)
745
746; do error #X, then warm start
747
748LAB_XERR
749	JSR	LAB_CRLF		; print CR/LF
750
751	LDA	LAB_BAER,X		; get error message pointer low byte
752	LDY	LAB_BAER+1,X	; get error message pointer high byte
753	JSR	LAB_18C3		; print null terminated string from memory
754
755	JSR	LAB_1491		; flush stack and clear continue flag
756	LDA	#<LAB_EMSG		; point to " Error" low addr
757	LDY	#>LAB_EMSG		; point to " Error" high addr
758LAB_1269
759	JSR	LAB_18C3		; print null terminated string from memory
760	LDY	Clineh		; get current line high byte
761	INY				; increment it
762	BEQ	LAB_1274		; go do warm start (was immediate mode)
763
764					; else print line number
765	JSR	LAB_2953		; print " in line [LINE #]"
766
767; BASIC warm start entry point
768; wait for Basic command
769
770LAB_1274
771					; clear ON IRQ/NMI bytes
772	LDA	#$00			; clear A
773	STA	IrqBase		; clear enabled byte
774	STA	NmiBase		; clear enabled byte
775	LDA	#<LAB_RMSG		; point to "Ready" message low byte
776	LDY	#>LAB_RMSG		; point to "Ready" message high byte
777
778	JSR	LAB_18C3		; go do print string
779
780; wait for Basic command (no "Ready")
781
782LAB_127D
783	JSR	LAB_1357		; call for BASIC input
784LAB_1280
785	STX	Bpntrl		; set BASIC execute pointer low byte
786	STY	Bpntrh		; set BASIC execute pointer high byte
787	JSR	LAB_GBYT		; scan memory
788	BEQ	LAB_127D		; loop while null
789
790; got to interpret input line now ..
791
792	LDX	#$FF			; current line to null value
793	STX	Clineh		; set current line high byte
794	BCC	LAB_1295		; branch if numeric character (handle new BASIC line)
795
796					; no line number .. immediate mode
797	JSR	LAB_13A6		; crunch keywords into Basic tokens
798	JMP	LAB_15F6		; go scan and interpret code
799
800; handle new BASIC line
801
802LAB_1295
803	JSR	LAB_GFPN		; get fixed-point number into temp integer
804	JSR	LAB_13A6		; crunch keywords into Basic tokens
805	STY	Ibptr			; save index pointer to end of crunched line
806	JSR	LAB_SSLN		; search BASIC for temp integer line number
807	BCC	LAB_12E6		; branch if not found
808
809					; aroooogah! line # already exists! delete it
810	LDY	#$01			; set index to next line pointer high byte
811	LDA	(Baslnl),Y		; get next line pointer high byte
812	STA	ut1_ph		; save it
813	LDA	Svarl			; get start of vars low byte
814	STA	ut1_pl		; save it
815	LDA	Baslnh		; get found line pointer high byte
816	STA	ut2_ph		; save it
817	LDA	Baslnl		; get found line pointer low byte
818	DEY				; decrement index
819	SBC	(Baslnl),Y		; subtract next line pointer low byte
820	CLC				; clear carry for add
821	ADC	Svarl			; add start of vars low byte
822	STA	Svarl			; save new start of vars low byte
823	STA	ut2_pl		; save destination pointer low byte
824	LDA	Svarh			; get start of vars high byte
825	ADC	#$FF			; -1 + carry
826	STA	Svarh			; save start of vars high byte
827	SBC	Baslnh		; subtract found line pointer high byte
828	TAX				; copy to block count
829	SEC				; set carry for subtract
830	LDA	Baslnl		; get found line pointer low byte
831	SBC	Svarl			; subtract start of vars low byte
832	TAY				; copy to bytes in first block count
833	BCS	LAB_12D0		; branch if overflow
834
835	INX				; increment block count (correct for =0 loop exit)
836	DEC	ut2_ph		; decrement destination high byte
837LAB_12D0
838	CLC				; clear carry for add
839	ADC	ut1_pl		; add source pointer low byte
840	BCC	LAB_12D8		; branch if no overflow
841
842	DEC	ut1_ph		; else decrement source pointer high byte
843	CLC				; clear carry
844
845					; close up memory to delete old line
846LAB_12D8
847	LDA	(ut1_pl),Y		; get byte from source
848	STA	(ut2_pl),Y		; copy to destination
849	INY				; increment index
850	BNE	LAB_12D8		; while <> 0 do this block
851
852	INC	ut1_ph		; increment source pointer high byte
853	INC	ut2_ph		; increment destination pointer high byte
854	DEX				; decrement block count
855	BNE	LAB_12D8		; loop until all done
856
857					; got new line in buffer and no existing same #
858LAB_12E6
859	LDA	Ibuffs		; get byte from start if input buffer
860	BEQ	LAB_1319		; if null line just go flush stack/vars and exit
861
862					; got new line and it isn't empty line
863	LDA	Ememl			; get end of mem low byte
864	LDY	Ememh			; get end of mem high byte
865	STA	Sstorl		; set bottom of string space low byte
866	STY	Sstorh		; set bottom of string space high byte
867	LDA	Svarl			; get start of vars low byte	(end of BASIC)
868	STA	Obendl		; save old block end low byte
869	LDY	Svarh			; get start of vars high byte	(end of BASIC)
870	STY	Obendh		; save old block end high byte
871	ADC	Ibptr			; add input buffer pointer	(also buffer length)
872	BCC	LAB_1301		; branch if no overflow from add
873
874	INY				; else increment high byte
875LAB_1301
876	STA	Nbendl		; save new block end low byte	(move to, low byte)
877	STY	Nbendh		; save new block end high byte
878	JSR	LAB_11CF		; open up space in memory
879					; old start pointer Ostrtl,Ostrth set by the find line call
880	LDA	Earryl		; get array mem end low byte
881	LDY	Earryh		; get array mem end high byte
882	STA	Svarl			; save start of vars low byte
883	STY	Svarh			; save start of vars high byte
884	LDY	Ibptr			; get input buffer pointer	(also buffer length)
885	DEY				; adjust for loop type
886LAB_1311
887	LDA	Ibuffs-4,Y		; get byte from crunched line
888	STA	(Baslnl),Y		; save it to program memory
889	DEY				; decrement count
890	CPY	#$03			; compare with first byte-1
891	BNE	LAB_1311		; continue while count <> 3
892
893	LDA	Itemph		; get line # high byte
894	STA	(Baslnl),Y		; save it to program memory
895	DEY				; decrement count
896	LDA	Itempl		; get line # low byte
897	STA	(Baslnl),Y		; save it to program memory
898	DEY				; decrement count
899	LDA	#$FF			; set byte to allow chain rebuild. if you didn't set this
900					; byte then a zero already here would stop the chain rebuild
901					; as it would think it was the [EOT] marker.
902	STA	(Baslnl),Y		; save it to program memory
903
904LAB_1319
905	JSR	LAB_1477		; reset execution to start, clear vars and flush stack
906	LDX	Smeml			; get start of mem low byte
907	LDA	Smemh			; get start of mem high byte
908	LDY	#$01			; index to high byte of next line pointer
909LAB_1325
910	STX	ut1_pl		; set line start pointer low byte
911	STA	ut1_ph		; set line start pointer high byte
912	LDA	(ut1_pl),Y		; get it
913	BEQ	LAB_133E		; exit if end of program
914
915; rebuild chaining of Basic lines
916
917	LDY	#$04			; point to first code byte of line
918					; there is always 1 byte + [EOL] as null entries are deleted
919LAB_1330
920	INY				; next code byte
921	LDA	(ut1_pl),Y		; get byte
922	BNE	LAB_1330		; loop if not [EOL]
923
924	SEC				; set carry for add + 1
925	TYA				; copy end index
926	ADC	ut1_pl		; add to line start pointer low byte
927	TAX				; copy to X
928	LDY	#$00			; clear index, point to this line's next line pointer
929	STA	(ut1_pl),Y		; set next line pointer low byte
930	TYA				; clear A
931	ADC	ut1_ph		; add line start pointer high byte + carry
932	INY				; increment index to high byte
933	STA	(ut1_pl),Y		; save next line pointer low byte
934	BCC	LAB_1325		; go do next line, branch always, carry clear
935
936
937LAB_133E
938	JMP	LAB_127D		; else we just wait for Basic command, no "Ready"
939
940; print "? " and get BASIC input
941
942LAB_INLN
943	JSR	LAB_18E3		; print "?" character
944	JSR	LAB_18E0		; print " "
945	BNE	LAB_1357		; call for BASIC input and return
946
947; receive line from keyboard
948
949					; $08 as delete key (BACKSPACE on standard keyboard)
950LAB_134B
951	JSR	LAB_PRNA		; go print the character
952	DEX				; decrement the buffer counter (delete)
953	.byte	$2C			; make LDX into BIT abs
954
955; call for BASIC input (main entry point)
956
957LAB_1357
958	LDX	#$00			; clear BASIC line buffer pointer
959LAB_1359
960	JSR	V_INPT		; call scan input device
961	BCC	LAB_1359		; loop if no byte
962
963	BEQ	LAB_1359		; loop until valid input (ignore NULLs)
964
965	CMP	#$07			; compare with [BELL]
966	BEQ	LAB_1378		; branch if [BELL]
967
968	CMP	#$0D			; compare with [CR]
969	BEQ	LAB_1384		; do CR/LF exit if [CR]
970
971	CPX	#$00			; compare pointer with $00
972	BNE	LAB_1374		; branch if not empty
973
974; next two lines ignore any non print character and [SPACE] if input buffer empty
975
976	CMP	#$21			; compare with [SP]+1
977	BCC	LAB_1359		; if < ignore character
978
979LAB_1374
980	CMP	#$08			; compare with [BACKSPACE] (delete last character)
981	BEQ	LAB_134B		; go delete last character
982
983LAB_1378
984	CPX	#Ibuffe-Ibuffs	; compare character count with max
985	BCS	LAB_138E		; skip store and do [BELL] if buffer full
986
987	STA	Ibuffs,X		; else store in buffer
988	INX				; increment pointer
989LAB_137F
990	JSR	LAB_PRNA		; go print the character
991	BNE	LAB_1359		; always loop for next character
992
993LAB_1384
994	JMP	LAB_1866		; do CR/LF exit to BASIC
995
996; announce buffer full
997
998LAB_138E
999	LDA	#$07			; [BELL] character into A
1000	BNE	LAB_137F		; go print the [BELL] but ignore input character
1001					; branch always
1002
1003; crunch keywords into Basic tokens
1004; position independent buffer version ..
1005; faster, dictionary search version ....
1006
1007LAB_13A6
1008	LDY	#$FF			; set save index (makes for easy math later)
1009
1010	SEC				; set carry for subtract
1011	LDA	Bpntrl		; get basic execute pointer low byte
1012	SBC	#<Ibuffs		; subtract input buffer start pointer
1013	TAX				; copy result to X (index past line # if any)
1014
1015	STX	Oquote		; clear open quote/DATA flag
1016LAB_13AC
1017	LDA	Ibuffs,X		; get byte from input buffer
1018	BEQ	LAB_13EC		; if null save byte then exit
1019
1020	CMP	#'_'			; compare with "_"
1021	BCS	LAB_13EC		; if >= go save byte then continue crunching
1022
1023	CMP	#'<'			; compare with "<"
1024	BCS	LAB_13CC		; if >= go crunch now
1025
1026	CMP	#'0'			; compare with "0"
1027	BCS	LAB_13EC		; if >= go save byte then continue crunching
1028
1029	STA	Scnquo		; save buffer byte as search character
1030	CMP	#$22			; is it quote character?
1031	BEQ	LAB_1410		; branch if so (copy quoted string)
1032
1033	CMP	#'*'			; compare with "*"
1034	BCC	LAB_13EC		; if < go save byte then continue crunching
1035
1036					; else crunch now
1037LAB_13CC
1038	BIT	Oquote		; get open quote/DATA token flag
1039	BVS	LAB_13EC		; branch if b6 of Oquote set (was DATA)
1040					; go save byte then continue crunching
1041
1042	STX	TempB			; save buffer read index
1043	STY	csidx			; copy buffer save index
1044	LDY	#<TAB_1STC		; get keyword first character table low address
1045	STY	ut2_pl		; save pointer low byte
1046	LDY	#>TAB_1STC		; get keyword first character table high address
1047	STY	ut2_ph		; save pointer high byte
1048	LDY	#$00			; clear table pointer
1049
1050LAB_13D0
1051	CMP	(ut2_pl),Y		; compare with keyword first character table byte
1052	BEQ	LAB_13D1		; go do word_table_chr if match
1053
1054	BCC	LAB_13EA		; if < keyword first character table byte go restore
1055					; Y and save to crunched
1056
1057	INY				; else increment pointer
1058	BNE	LAB_13D0		; and loop (branch always)
1059
1060; have matched first character of some keyword
1061
1062LAB_13D1
1063	TYA				; copy matching index
1064	ASL				; *2 (bytes per pointer)
1065	TAX				; copy to new index
1066	LDA	TAB_CHRT,X		; get keyword table pointer low byte
1067	STA	ut2_pl		; save pointer low byte
1068	LDA	TAB_CHRT+1,X	; get keyword table pointer high byte
1069	STA	ut2_ph		; save pointer high byte
1070
1071	LDY	#$FF			; clear table pointer (make -1 for start)
1072
1073	LDX	TempB			; restore buffer read index
1074
1075LAB_13D6
1076	INY				; next table byte
1077	LDA	(ut2_pl),Y		; get byte from table
1078LAB_13D8
1079	BMI	LAB_13EA		; all bytes matched so go save token
1080
1081	INX				; next buffer byte
1082	CMP	Ibuffs,X		; compare with byte from input buffer
1083	BEQ	LAB_13D6		; go compare next if match
1084
1085	BNE	LAB_1417		; branch if >< (not found keyword)
1086
1087LAB_13EA
1088	LDY	csidx			; restore save index
1089
1090					; save crunched to output
1091LAB_13EC
1092	INX				; increment buffer index (to next input byte)
1093	INY				; increment save index (to next output byte)
1094	STA	Ibuffs,Y		; save byte to output
1095	CMP	#$00			; set the flags, set carry
1096	BEQ	LAB_142A		; do exit if was null [EOL]
1097
1098					; A holds token or byte here
1099	SBC	#':'			; subtract ":" (carry set by CMP #00)
1100	BEQ	LAB_13FF		; branch if it was ":" (is now $00)
1101
1102					; A now holds token-$3A
1103	CMP	#TK_DATA-$3A	; compare with DATA token - $3A
1104	BNE	LAB_1401		; branch if not DATA
1105
1106					; token was : or DATA
1107LAB_13FF
1108	STA	Oquote		; save token-$3A (clear for ":", TK_DATA-$3A for DATA)
1109LAB_1401
1110	EOR	#TK_REM-$3A		; effectively subtract REM token offset
1111	BNE	LAB_13AC		; If wasn't REM then go crunch rest of line
1112
1113	STA	Asrch			; else was REM so set search for [EOL]
1114
1115					; loop for REM, "..." etc.
1116LAB_1408
1117	LDA	Ibuffs,X		; get byte from input buffer
1118	BEQ	LAB_13EC		; branch if null [EOL]
1119
1120	CMP	Asrch			; compare with stored character
1121	BEQ	LAB_13EC		; branch if match (end quote)
1122
1123					; entry for copy string in quotes, don't crunch
1124LAB_1410
1125	INY				; increment buffer save index
1126	STA	Ibuffs,Y		; save byte to output
1127	INX				; increment buffer read index
1128	BNE	LAB_1408		; loop while <> 0 (should never be 0!)
1129
1130					; not found keyword this go
1131LAB_1417
1132	LDX	TempB			; compare has failed, restore buffer index (start byte!)
1133
1134					; now find the end of this word in the table
1135LAB_141B
1136	LDA	(ut2_pl),Y		; get table byte
1137	PHP				; save status
1138	INY				; increment table index
1139	PLP				; restore byte status
1140	BPL	LAB_141B		; if not end of keyword go do next
1141
1142	LDA	(ut2_pl),Y		; get byte from keyword table
1143	BNE	LAB_13D8		; go test next word if not zero byte (end of table)
1144
1145					; reached end of table with no match
1146	LDA	Ibuffs,X		; restore byte from input buffer
1147	BPL	LAB_13EA		; branch always (all bytes in buffer are $00-$7F)
1148					; go save byte in output and continue crunching
1149
1150					; reached [EOL]
1151LAB_142A
1152	INY				; increment pointer
1153	INY				; increment pointer (makes it next line pointer high byte)
1154	STA	Ibuffs,Y		; save [EOL] (marks [EOT] in immediate mode)
1155	INY				; adjust for line copy
1156	INY				; adjust for line copy
1157	INY				; adjust for line copy
1158	DEC	Bpntrl		; allow for increment (change if buffer starts at $xxFF)
1159	RTS
1160
1161; search Basic for temp integer line number from start of mem
1162
1163LAB_SSLN
1164	LDA	Smeml			; get start of mem low byte
1165	LDX	Smemh			; get start of mem high byte
1166
1167; search Basic for temp integer line number from AX
1168; returns carry set if found
1169; returns Baslnl/Baslnh pointer to found or next higher (not found) line
1170
1171; old 541 new 507
1172
1173LAB_SHLN
1174	LDY	#$01			; set index
1175	STA	Baslnl		; save low byte as current
1176	STX	Baslnh		; save high byte as current
1177	LDA	(Baslnl),Y		; get pointer high byte from addr
1178	BEQ	LAB_145F		; pointer was zero so we're done, do 'not found' exit
1179
1180	LDY	#$03			; set index to line # high byte
1181	LDA	(Baslnl),Y		; get line # high byte
1182	DEY				; decrement index (point to low byte)
1183	CMP	Itemph		; compare with temporary integer high byte
1184	BNE	LAB_1455		; if <> skip low byte check
1185
1186	LDA	(Baslnl),Y		; get line # low byte
1187	CMP	Itempl		; compare with temporary integer low byte
1188LAB_1455
1189	BCS	LAB_145E		; else if temp < this line, exit (passed line#)
1190
1191LAB_1456
1192	DEY				; decrement index to next line ptr high byte
1193	LDA	(Baslnl),Y		; get next line pointer high byte
1194	TAX				; copy to X
1195	DEY				; decrement index to next line ptr low byte
1196	LDA	(Baslnl),Y		; get next line pointer low byte
1197	BCC	LAB_SHLN		; go search for line # in temp (Itempl/Itemph) from AX
1198					; (carry always clear)
1199
1200LAB_145E
1201	BEQ	LAB_1460		; exit if temp = found line #, carry is set
1202
1203LAB_145F
1204	CLC				; clear found flag
1205LAB_1460
1206	RTS
1207
1208; perform NEW
1209
1210LAB_NEW
1211	BNE	LAB_1460		; exit if not end of statement (to do syntax error)
1212
1213LAB_1463
1214	LDA	#$00			; clear A
1215	TAY				; clear Y
1216	STA	(Smeml),Y		; clear first line, next line pointer, low byte
1217	INY				; increment index
1218	STA	(Smeml),Y		; clear first line, next line pointer, high byte
1219	CLC				; clear carry
1220	LDA	Smeml			; get start of mem low byte
1221	ADC	#$02			; calculate end of BASIC low byte
1222	STA	Svarl			; save start of vars low byte
1223	LDA	Smemh			; get start of mem high byte
1224	ADC	#$00			; add any carry
1225	STA	Svarh			; save start of vars high byte
1226
1227; reset execution to start, clear vars and flush stack
1228
1229LAB_1477
1230	CLC				; clear carry
1231	LDA	Smeml			; get start of mem low byte
1232	ADC	#$FF			; -1
1233	STA	Bpntrl		; save BASIC execute pointer low byte
1234	LDA	Smemh			; get start of mem high byte
1235	ADC	#$FF			; -1+carry
1236	STA	Bpntrh		; save BASIC execute pointer high byte
1237
1238; "CLEAR" command gets here
1239
1240LAB_147A
1241	LDA	Ememl			; get end of mem low byte
1242	LDY	Ememh			; get end of mem high byte
1243	STA	Sstorl		; set bottom of string space low byte
1244	STY	Sstorh		; set bottom of string space high byte
1245	LDA	Svarl			; get start of vars low byte
1246	LDY	Svarh			; get start of vars high byte
1247	STA	Sarryl		; save var mem end low byte
1248	STY	Sarryh		; save var mem end high byte
1249	STA	Earryl		; save array mem end low byte
1250	STY	Earryh		; save array mem end high byte
1251	JSR	LAB_161A		; perform RESTORE command
1252
1253; flush stack and clear continue flag
1254
1255LAB_1491
1256	LDX	#des_sk		; set descriptor stack pointer
1257	STX	next_s		; save descriptor stack pointer
1258	PLA				; pull return address low byte
1259	TAX				; copy return address low byte
1260	PLA				; pull return address high byte
1261	STX	LAB_SKFE		; save to cleared stack
1262	STA	LAB_SKFF		; save to cleared stack
1263	LDX	#$FD			; new stack pointer
1264	TXS				; reset stack
1265	LDA	#$00			; clear byte
1266	STA	Cpntrh		; clear continue pointer high byte
1267	STA	Sufnxf		; clear subscript/FNX flag
1268LAB_14A6
1269	RTS
1270
1271; perform CLEAR
1272
1273LAB_CLEAR
1274	BEQ	LAB_147A		; if no following token go do "CLEAR"
1275
1276					; else there was a following token (go do syntax error)
1277	RTS
1278
1279; perform LIST [n][-m]
1280; bigger, faster version (a _lot_ faster)
1281
1282LAB_LIST
1283	BCC	LAB_14BD		; branch if next character numeric (LIST n..)
1284
1285	BEQ	LAB_14BD		; branch if next character [NULL] (LIST)
1286
1287	CMP	#TK_MINUS		; compare with token for -
1288	BNE	LAB_14A6		; exit if not - (LIST -m)
1289
1290					; LIST [[n][-m]]
1291					; this bit sets the n , if present, as the start and end
1292LAB_14BD
1293	JSR	LAB_GFPN		; get fixed-point number into temp integer
1294	JSR	LAB_SSLN		; search BASIC for temp integer line number
1295					; (pointer in Baslnl/Baslnh)
1296	JSR	LAB_GBYT		; scan memory
1297	BEQ	LAB_14D4		; branch if no more characters
1298
1299					; this bit checks the - is present
1300	CMP	#TK_MINUS		; compare with token for -
1301	BNE	LAB_1460		; return if not "-" (will be Syntax error)
1302
1303					; LIST [n]-m
1304					; the - was there so set m as the end value
1305	JSR	LAB_IGBY		; increment and scan memory
1306	JSR	LAB_GFPN		; get fixed-point number into temp integer
1307	BNE	LAB_1460		; exit if not ok
1308
1309LAB_14D4
1310	LDA	Itempl		; get temporary integer low byte
1311	ORA	Itemph		; OR temporary integer high byte
1312	BNE	LAB_14E2		; branch if start set
1313
1314	LDA	#$FF			; set for -1
1315	STA	Itempl		; set temporary integer low byte
1316	STA	Itemph		; set temporary integer high byte
1317LAB_14E2
1318	LDY	#$01			; set index for line
1319	STY	Oquote		; clear open quote flag
1320	JSR	LAB_CRLF		; print CR/LF
1321	LDA	(Baslnl),Y		; get next line pointer high byte
1322					; pointer initially set by search at LAB_14BD
1323	BEQ	LAB_152B		; if null all done so exit
1324	JSR	LAB_1629		; do CRTL-C check vector
1325
1326	INY				; increment index for line
1327	LDA	(Baslnl),Y		; get line # low byte
1328	TAX				; copy to X
1329	INY				; increment index
1330	LDA	(Baslnl),Y		; get line # high byte
1331	CMP	Itemph		; compare with temporary integer high byte
1332	BNE	LAB_14FF		; branch if no high byte match
1333
1334	CPX	Itempl		; compare with temporary integer low byte
1335	BEQ	LAB_1501		; branch if = last line to do (< will pass next branch)
1336
1337LAB_14FF				; else ..
1338	BCS	LAB_152B		; if greater all done so exit
1339
1340LAB_1501
1341	STY	Tidx1			; save index for line
1342	JSR	LAB_295E		; print XA as unsigned integer
1343	LDA	#$20			; space is the next character
1344LAB_1508
1345	LDY	Tidx1			; get index for line
1346	AND	#$7F			; mask top out bit of character
1347LAB_150C
1348	JSR	LAB_PRNA		; go print the character
1349	CMP	#$22			; was it " character
1350	BNE	LAB_1519		; branch if not
1351
1352					; we are either entering or leaving a pair of quotes
1353	LDA	Oquote		; get open quote flag
1354	EOR	#$FF			; toggle it
1355	STA	Oquote		; save it back
1356LAB_1519
1357	INY				; increment index
1358	LDA	(Baslnl),Y		; get next byte
1359	BNE	LAB_152E		; branch if not [EOL] (go print character)
1360	TAY				; else clear index
1361	LDA	(Baslnl),Y		; get next line pointer low byte
1362	TAX				; copy to X
1363	INY				; increment index
1364	LDA	(Baslnl),Y		; get next line pointer high byte
1365	STX	Baslnl		; set pointer to line low byte
1366	STA	Baslnh		; set pointer to line high byte
1367	BNE	LAB_14E2		; go do next line if not [EOT]
1368					; else ..
1369LAB_152B
1370	RTS
1371
1372LAB_152E
1373	BPL	LAB_150C		; just go print it if not token byte
1374
1375					; else was token byte so uncrunch it (maybe)
1376	BIT	Oquote		; test the open quote flag
1377	BMI	LAB_150C		; just go print character if open quote set
1378
1379	LDX	#>LAB_KEYT		; get table address high byte
1380	ASL				; *2
1381	ASL				; *4
1382	BCC	LAB_152F		; branch if no carry
1383
1384	INX				; else increment high byte
1385	CLC				; clear carry for add
1386LAB_152F
1387	ADC	#<LAB_KEYT		; add low byte
1388	BCC	LAB_1530		; branch if no carry
1389
1390	INX				; else increment high byte
1391LAB_1530
1392	STA	ut2_pl		; save table pointer low byte
1393	STX	ut2_ph		; save table pointer high byte
1394	STY	Tidx1			; save index for line
1395	LDY	#$00			; clear index
1396	LDA	(ut2_pl),Y		; get length
1397	TAX				; copy length
1398	INY				; increment index
1399	LDA	(ut2_pl),Y		; get 1st character
1400	DEX				; decrement length
1401	BEQ	LAB_1508		; if no more characters exit and print
1402
1403	JSR	LAB_PRNA		; go print the character
1404	INY				; increment index
1405	LDA	(ut2_pl),Y		; get keyword address low byte
1406	PHA				; save it for now
1407	INY				; increment index
1408	LDA	(ut2_pl),Y		; get keyword address high byte
1409	LDY	#$00
1410	STA	ut2_ph		; save keyword pointer high byte
1411	PLA				; pull low byte
1412	STA	ut2_pl		; save keyword pointer low byte
1413LAB_1540
1414	LDA	(ut2_pl),Y		; get character
1415	DEX				; decrement character count
1416	BEQ	LAB_1508		; if last character exit and print
1417
1418	JSR	LAB_PRNA		; go print the character
1419	INY				; increment index
1420	BNE	LAB_1540		; loop for next character
1421
1422; perform FOR
1423
1424LAB_FOR
1425	LDA	#$80			; set FNX
1426	STA	Sufnxf		; set subscript/FNX flag
1427	JSR	LAB_LET		; go do LET
1428	PLA				; pull return address
1429	PLA				; pull return address
1430	LDA	#$10			; we need 16d bytes !
1431	JSR	LAB_1212		; check room on stack for A bytes
1432	JSR	LAB_SNBS		; scan for next BASIC statement ([:] or [EOL])
1433	CLC				; clear carry for add
1434	TYA				; copy index to A
1435	ADC	Bpntrl		; add BASIC execute pointer low byte
1436	PHA				; push onto stack
1437	LDA	Bpntrh		; get BASIC execute pointer high byte
1438	ADC	#$00			; add carry
1439	PHA				; push onto stack
1440	LDA	Clineh		; get current line high byte
1441	PHA				; push onto stack
1442	LDA	Clinel		; get current line low byte
1443	PHA				; push onto stack
1444	LDA	#TK_TO		; get "TO" token
1445	JSR	LAB_SCCA		; scan for CHR$(A) , else do syntax error then warm start
1446	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
1447	JSR	LAB_EVNM		; evaluate expression and check is numeric,
1448					; else do type mismatch
1449	LDA	FAC1_s		; get FAC1 sign (b7)
1450	ORA	#$7F			; set all non sign bits
1451	AND	FAC1_1		; and FAC1 mantissa1
1452	STA	FAC1_1		; save FAC1 mantissa1
1453	LDA	#<LAB_159F		; set return address low byte
1454	LDY	#>LAB_159F		; set return address high byte
1455	STA	ut1_pl		; save return address low byte
1456	STY	ut1_ph		; save return address high byte
1457	JMP	LAB_1B66		; round FAC1 and put on stack (returns to next instruction)
1458
1459LAB_159F
1460	LDA	#<LAB_259C		; set 1 pointer low addr (default step size)
1461	LDY	#>LAB_259C		; set 1 pointer high addr
1462	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
1463	JSR	LAB_GBYT		; scan memory
1464	CMP	#TK_STEP		; compare with STEP token
1465	BNE	LAB_15B3		; jump if not "STEP"
1466
1467					;.was step so ..
1468	JSR	LAB_IGBY		; increment and scan memory
1469	JSR	LAB_EVNM		; evaluate expression and check is numeric,
1470					; else do type mismatch
1471LAB_15B3
1472	JSR	LAB_27CA		; return A=FF,C=1/-ve A=01,C=0/+ve
1473	STA	FAC1_s		; set FAC1 sign (b7)
1474					; this is +1 for +ve step and -1 for -ve step, in NEXT we
1475					; compare the FOR value and the TO value and return +1 if
1476					; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value
1477					; here (+/-1) is then compared to that result and if they
1478					; are the same (+ve and FOR > TO or -ve and FOR < TO) then
1479					; the loop is done
1480	JSR	LAB_1B5B		; push sign, round FAC1 and put on stack
1481	LDA	Frnxth		; get var pointer for FOR/NEXT high byte
1482	PHA				; push on stack
1483	LDA	Frnxtl		; get var pointer for FOR/NEXT low byte
1484	PHA				; push on stack
1485	LDA	#TK_FOR		; get FOR token
1486	PHA				; push on stack
1487
1488; interpreter inner loop
1489
1490LAB_15C2
1491	JSR	LAB_1629		; do CRTL-C check vector
1492	LDA	Bpntrl		; get BASIC execute pointer low byte
1493	LDY	Bpntrh		; get BASIC execute pointer high byte
1494
1495	LDX	Clineh		; continue line is $FFxx for immediate mode
1496					; ($00xx for RUN from immediate mode)
1497	INX				; increment it (now $00 if immediate mode)
1498	BEQ	LAB_15D1		; branch if null (immediate mode)
1499
1500	STA	Cpntrl		; save continue pointer low byte
1501	STY	Cpntrh		; save continue pointer high byte
1502LAB_15D1
1503	LDY	#$00			; clear index
1504	LDA	(Bpntrl),Y		; get next byte
1505	BEQ	LAB_15DC		; branch if null [EOL]
1506
1507	CMP	#':'			; compare with ":"
1508	BEQ	LAB_15F6		; branch if = (statement separator)
1509
1510LAB_15D9
1511	JMP	LAB_SNER		; else syntax error then warm start
1512
1513					; have reached [EOL]
1514LAB_15DC
1515	LDY	#$02			; set index
1516	LDA	(Bpntrl),Y		; get next line pointer high byte
1517	CLC				; clear carry for no "BREAK" message
1518	BEQ	LAB_1651		; if null go to immediate mode (was immediate or [EOT]
1519					; marker)
1520
1521	INY				; increment index
1522	LDA	(Bpntrl),Y		; get line # low byte
1523	STA	Clinel		; save current line low byte
1524	INY				; increment index
1525	LDA	(Bpntrl),Y		; get line # high byte
1526	STA	Clineh		; save current line high byte
1527	TYA				; A now = 4
1528	ADC	Bpntrl		; add BASIC execute pointer low byte
1529	STA	Bpntrl		; save BASIC execute pointer low byte
1530	BCC	LAB_15F6		; branch if no overflow
1531
1532	INC	Bpntrh		; else increment BASIC execute pointer high byte
1533LAB_15F6
1534	JSR	LAB_IGBY		; increment and scan memory
1535
1536LAB_15F9
1537	JSR	LAB_15FF		; go interpret BASIC code from (Bpntrl)
1538
1539LAB_15FC
1540	JMP	LAB_15C2		; loop
1541
1542; interpret BASIC code from (Bpntrl)
1543
1544LAB_15FF
1545	BEQ	LAB_1628		; exit if zero [EOL]
1546
1547LAB_1602
1548	ASL				; *2 bytes per vector and normalise token
1549	BCS	LAB_1609		; branch if was token
1550
1551	JMP	LAB_LET		; else go do implied LET
1552
1553LAB_1609
1554	CMP	#[TK_TAB-$80]*2	; compare normalised token * 2 with TAB
1555	BCS	LAB_15D9		; branch if A>=TAB (do syntax error then warm start)
1556					; only tokens before TAB can start a line
1557	TAY				; copy to index
1558	LDA	LAB_CTBL+1,Y	; get vector high byte
1559	PHA				; onto stack
1560	LDA	LAB_CTBL,Y		; get vector low byte
1561	PHA				; onto stack
1562	JMP	LAB_IGBY		; jump to increment and scan memory
1563					; then "return" to vector
1564
1565; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
1566; key press is detected.
1567
1568LAB_1629
1569	JMP	(VEC_CC)		; ctrl c check vector
1570
1571; if there was a key press it gets back here ..
1572
1573LAB_1636
1574	CMP	#$03			; compare with CTRL-C
1575
1576; perform STOP
1577
1578LAB_STOP
1579	BCS	LAB_163B		; branch if token follows STOP
1580					; else just END
1581; END
1582
1583LAB_END
1584	CLC				; clear carry (indicate program end)
1585LAB_163B
1586	BNE	LAB_167A		; return if wasn't CTRL-C
1587
1588	LDA	Bpntrh		; get BASIC execute pointer high byte
1589	EOR	#>Ibuffs		; compare with buffer address high byte (Cb unchanged)
1590	BEQ	LAB_164F		; branch if BASIC pointer is in buffer
1591					; (can't continue in immediate mode)
1592
1593					; else ..
1594	EOR	#>Ibuffs		; correct the bits
1595	LDY	Bpntrl		; get BASIC execute pointer low byte
1596	STY	Cpntrl		; save continue pointer low byte
1597	STA	Cpntrh		; save continue pointer high byte
1598LAB_1647
1599	LDA	Clinel		; get current line low byte
1600	LDY	Clineh		; get current line high byte
1601	STA	Blinel		; save break line low byte
1602	STY	Blineh		; save break line high byte
1603LAB_164F
1604	PLA				; pull return address low
1605	PLA				; pull return address high
1606LAB_1651
1607	BCC	LAB_165E		; jump if was program end
1608
1609	LDA	#<LAB_BMSG		; point to "Break" (low byte)
1610	LDY	#>LAB_BMSG		; point to "Break" (high byte)
1611	JMP	LAB_1269		; print "Break" and do warm start
1612
1613LAB_165E
1614	JMP	LAB_1274		; go do warm start
1615
1616; perform RESTORE
1617
1618LAB_RESTORE
1619	BNE	LAB_RESTOREn	; branch if next character not null (RESTORE n)
1620
1621LAB_161A
1622	SEC				; set carry for subtract
1623	LDA	Smeml			; get start of mem low byte
1624	SBC	#$01			; -1
1625	LDY	Smemh			; get start of mem high byte
1626	BCS	LAB_1624		; branch if no underflow
1627
1628LAB_uflow
1629	DEY				; else decrement high byte
1630LAB_1624
1631	STA	Dptrl			; save DATA pointer low byte
1632	STY	Dptrh			; save DATA pointer high byte
1633LAB_1628
1634	RTS
1635
1636					; is RESTORE n
1637LAB_RESTOREn
1638	JSR	LAB_GFPN		; get fixed-point number into temp integer
1639	JSR	LAB_SNBL		; scan for next BASIC line
1640	LDA	Clineh		; get current line high byte
1641	CMP	Itemph		; compare with temporary integer high byte
1642	BCS	LAB_reset_search	; branch if >= (start search from beginning)
1643
1644	TYA				; else copy line index to A
1645	SEC				; set carry (+1)
1646	ADC	Bpntrl		; add BASIC execute pointer low byte
1647	LDX	Bpntrh		; get BASIC execute pointer high byte
1648	BCC	LAB_go_search	; branch if no overflow to high byte
1649
1650	INX				; increment high byte
1651	BCS	LAB_go_search	; branch always (can never be carry clear)
1652
1653; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)
1654
1655LAB_reset_search
1656	LDA	Smeml			; get start of mem low byte
1657	LDX	Smemh			; get start of mem high byte
1658
1659; search for line # in temp (Itempl/Itemph) from (AX)
1660
1661LAB_go_search
1662
1663	JSR	LAB_SHLN		; search Basic for temp integer line number from AX
1664	BCS	LAB_line_found	; if carry set go set pointer
1665
1666	JMP	LAB_16F7		; else go do "Undefined statement" error
1667
1668LAB_line_found
1669					; carry already set for subtract
1670	LDA	Baslnl		; get pointer low byte
1671	SBC	#$01			; -1
1672	LDY	Baslnh		; get pointer high byte
1673	BCS	LAB_1624		; branch if no underflow (save DATA pointer and return)
1674
1675	BCC	LAB_uflow		; else decrement high byte then save DATA pointer and
1676					; return (branch always)
1677
1678; perform NULL
1679
1680LAB_NULL
1681	JSR	LAB_GTBY		; get byte parameter
1682	STX	Nullct		; save new NULL count
1683LAB_167A
1684	RTS
1685
1686; perform CONT
1687
1688LAB_CONT
1689	BNE	LAB_167A		; if following byte exit to do syntax error
1690
1691	LDY	Cpntrh		; get continue pointer high byte
1692	BNE	LAB_166C		; go do continue if we can
1693
1694	LDX	#$1E			; error code $1E ("Can't continue" error)
1695	JMP	LAB_XERR		; do error #X, then warm start
1696
1697					; we can continue so ..
1698LAB_166C
1699	LDA	#TK_ON		; set token for ON
1700	JSR	LAB_IRQ		; set IRQ flags
1701	LDA	#TK_ON		; set token for ON
1702	JSR	LAB_NMI		; set NMI flags
1703
1704	STY	Bpntrh		; save BASIC execute pointer high byte
1705	LDA	Cpntrl		; get continue pointer low byte
1706	STA	Bpntrl		; save BASIC execute pointer low byte
1707	LDA	Blinel		; get break line low byte
1708	LDY	Blineh		; get break line high byte
1709	STA	Clinel		; set current line low byte
1710	STY	Clineh		; set current line high byte
1711	RTS
1712
1713; perform RUN
1714
1715LAB_RUN
1716	BNE	LAB_1696		; branch if RUN n
1717	JMP	LAB_1477		; reset execution to start, clear variables, flush stack and
1718					; return
1719
1720; does RUN n
1721
1722LAB_1696
1723	JSR	LAB_147A		; go do "CLEAR"
1724	BEQ	LAB_16B0		; get n and do GOTO n (branch always as CLEAR sets Z=1)
1725
1726; perform DO
1727
1728LAB_DO
1729	LDA	#$05			; need 5 bytes for DO
1730	JSR	LAB_1212		; check room on stack for A bytes
1731	LDA	Bpntrh		; get BASIC execute pointer high byte
1732	PHA				; push on stack
1733	LDA	Bpntrl		; get BASIC execute pointer low byte
1734	PHA				; push on stack
1735	LDA	Clineh		; get current line high byte
1736	PHA				; push on stack
1737	LDA	Clinel		; get current line low byte
1738	PHA				; push on stack
1739	LDA	#TK_DO		; token for DO
1740	PHA				; push on stack
1741	JSR	LAB_GBYT		; scan memory
1742	JMP	LAB_15C2		; go do interpreter inner loop
1743
1744; perform GOSUB
1745
1746LAB_GOSUB
1747	LDA	#$05			; need 5 bytes for GOSUB
1748	JSR	LAB_1212		; check room on stack for A bytes
1749	LDA	Bpntrh		; get BASIC execute pointer high byte
1750	PHA				; push on stack
1751	LDA	Bpntrl		; get BASIC execute pointer low byte
1752	PHA				; push on stack
1753	LDA	Clineh		; get current line high byte
1754	PHA				; push on stack
1755	LDA	Clinel		; get current line low byte
1756	PHA				; push on stack
1757	LDA	#TK_GOSUB		; token for GOSUB
1758	PHA				; push on stack
1759LAB_16B0
1760	JSR	LAB_GBYT		; scan memory
1761	JSR	LAB_GOTO		; perform GOTO n
1762	JMP	LAB_15C2		; go do interpreter inner loop
1763					; (can't RTS, we used the stack!)
1764
1765; perform GOTO
1766
1767LAB_GOTO
1768	JSR	LAB_GFPN		; get fixed-point number into temp integer
1769	JSR	LAB_SNBL		; scan for next BASIC line
1770	LDA	Clineh		; get current line high byte
1771	CMP	Itemph		; compare with temporary integer high byte
1772	BCS	LAB_16D0		; branch if >= (start search from beginning)
1773
1774	TYA				; else copy line index to A
1775	SEC				; set carry (+1)
1776	ADC	Bpntrl		; add BASIC execute pointer low byte
1777	LDX	Bpntrh		; get BASIC execute pointer high byte
1778	BCC	LAB_16D4		; branch if no overflow to high byte
1779
1780	INX				; increment high byte
1781	BCS	LAB_16D4		; branch always (can never be carry)
1782
1783; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)
1784
1785LAB_16D0
1786	LDA	Smeml			; get start of mem low byte
1787	LDX	Smemh			; get start of mem high byte
1788
1789; search for line # in temp (Itempl/Itemph) from (AX)
1790
1791LAB_16D4
1792	JSR	LAB_SHLN		; search Basic for temp integer line number from AX
1793	BCC	LAB_16F7		; if carry clear go do "Undefined statement" error
1794					; (unspecified statement)
1795
1796					; carry already set for subtract
1797	LDA	Baslnl		; get pointer low byte
1798	SBC	#$01			; -1
1799	STA	Bpntrl		; save BASIC execute pointer low byte
1800	LDA	Baslnh		; get pointer high byte
1801	SBC	#$00			; subtract carry
1802	STA	Bpntrh		; save BASIC execute pointer high byte
1803LAB_16E5
1804	RTS
1805
1806LAB_DONOK
1807	LDX	#$22			; error code $22 ("LOOP without DO" error)
1808	JMP	LAB_XERR		; do error #X, then warm start
1809
1810; perform LOOP
1811
1812LAB_LOOP
1813	TAY				; save following token
1814	TSX				; copy stack pointer
1815	LDA	LAB_STAK+3,X	; get token byte from stack
1816	CMP	#TK_DO		; compare with DO token
1817	BNE	LAB_DONOK		; branch if no matching DO
1818
1819	INX				; dump calling routine return address
1820	INX				; dump calling routine return address
1821	TXS				; correct stack
1822	TYA				; get saved following token back
1823	BEQ	LoopAlways		; if no following token loop forever
1824					; (stack pointer in X)
1825
1826	CMP	#':'			; could be ':'
1827	BEQ	LoopAlways		; if :... loop forever
1828
1829	SBC	#TK_UNTIL		; subtract token for UNTIL, we know carry is set here
1830	TAX				; copy to X (if it was UNTIL then Y will be correct)
1831	BEQ	DoRest		; branch if was UNTIL
1832
1833	DEX				; decrement result
1834	BNE	LAB_16FC		; if not WHILE go do syntax error and warm start
1835					; only if the token was WHILE will this fail
1836
1837	DEX				; set invert result byte
1838DoRest
1839	STX	Frnxth		; save invert result byte
1840	JSR	LAB_IGBY		; increment and scan memory
1841	JSR	LAB_EVEX		; evaluate expression
1842	LDA	FAC1_e		; get FAC1 exponent
1843	BEQ	DoCmp			; if =0 go do straight compare
1844
1845	LDA	#$FF			; else set all bits
1846DoCmp
1847	TSX				; copy stack pointer
1848	EOR	Frnxth		; EOR with invert byte
1849	BNE	LoopDone		; if <> 0 clear stack and back to interpreter loop
1850
1851					; loop condition wasn't met so do it again
1852LoopAlways
1853	LDA	LAB_STAK+2,X	; get current line low byte
1854	STA	Clinel		; save current line low byte
1855	LDA	LAB_STAK+3,X	; get current line high byte
1856	STA	Clineh		; save current line high byte
1857	LDA	LAB_STAK+4,X	; get BASIC execute pointer low byte
1858	STA	Bpntrl		; save BASIC execute pointer low byte
1859	LDA	LAB_STAK+5,X	; get BASIC execute pointer high byte
1860	STA	Bpntrh		; save BASIC execute pointer high byte
1861	JSR	LAB_GBYT		; scan memory
1862	JMP	LAB_15C2		; go do interpreter inner loop
1863
1864					; clear stack and back to interpreter loop
1865LoopDone
1866	INX				; dump DO token
1867	INX				; dump current line low byte
1868	INX				; dump current line high byte
1869	INX				; dump BASIC execute pointer low byte
1870	INX				; dump BASIC execute pointer high byte
1871	TXS				; correct stack
1872	JMP	LAB_DATA		; go perform DATA (find : or [EOL])
1873
1874; do the return without gosub error
1875
1876LAB_16F4
1877	LDX	#$04			; error code $04 ("RETURN without GOSUB" error)
1878	.byte	$2C			; makes next line BIT LAB_0EA2
1879
1880LAB_16F7				; do undefined statement error
1881	LDX	#$0E			; error code $0E ("Undefined statement" error)
1882	JMP	LAB_XERR		; do error #X, then warm start
1883
1884; perform RETURN
1885
1886LAB_RETURN
1887	BNE	LAB_16E5		; exit if following token (to allow syntax error)
1888
1889LAB_16E8
1890	PLA				; dump calling routine return address
1891	PLA				; dump calling routine return address
1892	PLA				; pull token
1893	CMP	#TK_GOSUB		; compare with GOSUB token
1894	BNE	LAB_16F4		; branch if no matching GOSUB
1895
1896LAB_16FF
1897	PLA				; pull current line low byte
1898	STA	Clinel		; save current line low byte
1899	PLA				; pull current line high byte
1900	STA	Clineh		; save current line high byte
1901	PLA				; pull BASIC execute pointer low byte
1902	STA	Bpntrl		; save BASIC execute pointer low byte
1903	PLA				; pull BASIC execute pointer high byte
1904	STA	Bpntrh		; save BASIC execute pointer high byte
1905
1906					; now do the DATA statement as we could be returning into
1907					; the middle of an ON <var> GOSUB n,m,p,q line
1908					; (the return address used by the DATA statement is the one
1909					; pushed before the GOSUB was executed!)
1910
1911; perform DATA
1912
1913LAB_DATA
1914	JSR	LAB_SNBS		; scan for next BASIC statement ([:] or [EOL])
1915
1916					; set BASIC execute pointer
1917LAB_170F
1918	TYA				; copy index to A
1919	CLC				; clear carry for add
1920	ADC	Bpntrl		; add BASIC execute pointer low byte
1921	STA	Bpntrl		; save BASIC execute pointer low byte
1922	BCC	LAB_1719		; skip next if no carry
1923
1924	INC	Bpntrh		; else increment BASIC execute pointer high byte
1925LAB_1719
1926	RTS
1927
1928LAB_16FC
1929	JMP	LAB_SNER		; do syntax error then warm start
1930
1931; scan for next BASIC statement ([:] or [EOL])
1932; returns Y as index to [:] or [EOL]
1933
1934LAB_SNBS
1935	LDX	#':'			; set look for character = ":"
1936	.byte	$2C			; makes next line BIT $00A2
1937
1938; scan for next BASIC line
1939; returns Y as index to [EOL]
1940
1941LAB_SNBL
1942	LDX	#$00			; set alt search character = [EOL]
1943	LDY	#$00			; set search character = [EOL]
1944	STY	Asrch			; store search character
1945LAB_1725
1946	TXA				; get alt search character
1947	EOR	Asrch			; toggle search character, effectively swap with $00
1948	STA	Asrch			; save swapped search character
1949LAB_172D
1950	LDA	(Bpntrl),Y		; get next byte
1951	BEQ	LAB_1719		; exit if null [EOL]
1952
1953	CMP	Asrch			; compare with search character
1954	BEQ	LAB_1719		; exit if found
1955
1956	INY				; increment index
1957	CMP	#$22			; compare current character with open quote
1958	BNE	LAB_172D		; if not open quote go get next character
1959
1960	BEQ	LAB_1725		; if found go swap search character for alt search character
1961
1962; perform IF
1963
1964LAB_IF
1965	JSR	LAB_EVEX		; evaluate expression
1966	JSR	LAB_GBYT		; scan memory
1967	CMP	#TK_GOTO		; compare with "GOTO" token
1968	BEQ	LAB_174B		; jump if was "GOTO"
1969
1970					; wasn't IF .. GOTO so must be IF .. THEN
1971	LDA	#TK_THEN		; get THEN token
1972	JSR	LAB_SCCA		; scan for CHR$(A) , else do syntax error then warm start
1973LAB_174B
1974	LDA	FAC1_e		; get FAC1 exponent
1975	BNE	LAB_1754		; branch if result was non zero
1976					; else ..
1977
1978; perform REM, skip (rest of) line
1979
1980LAB_REM
1981	JSR	LAB_SNBL		; scan for next BASIC line
1982	BEQ	LAB_170F		; go set BASIC execute pointer and return, branch always
1983
1984					; result was non zero so do rest of line
1985LAB_1754
1986	JSR	LAB_GBYT		; scan memory
1987	BCS	LAB_175C		; branch if not numeric character (is var or keyword)
1988
1989	JMP	LAB_GOTO		; else do GOTO n (was numeric)
1990
1991					; is var or keyword
1992LAB_175C
1993	JMP	LAB_15FF		; interpret BASIC code from (Bpntrl)
1994
1995; perform ON
1996
1997LAB_ON
1998	CMP	#TK_IRQ		; was it IRQ token ?
1999	BNE	LAB_NOIN		; if not go check NMI
2000
2001	JMP	LAB_SIRQ		; else go set-up IRQ
2002
2003LAB_NOIN
2004	CMP	#TK_NMI		; was it NMI token ?
2005	BNE	LAB_NONM		; if not go do normal ON command
2006
2007	JMP	LAB_SNMI		; else go set-up NMI
2008
2009LAB_NONM
2010	JSR	LAB_GTBY		; get byte parameter
2011	PHA				; push GOTO/GOSUB token
2012	CMP	#TK_GOSUB		; compare with GOSUB token
2013	BEQ	LAB_176B		; branch if GOSUB
2014
2015	CMP	#TK_GOTO		; compare with GOTO token
2016LAB_1767
2017	BNE	LAB_16FC		; if not GOTO do syntax error then warm start
2018
2019
2020; next character was GOTO or GOSUB
2021
2022LAB_176B
2023	DEC	FAC1_3		; decrement index (byte value)
2024	BNE	LAB_1773		; branch if not zero
2025
2026	PLA				; pull GOTO/GOSUB token
2027	JMP	LAB_1602		; go execute it
2028
2029LAB_1773
2030	JSR	LAB_IGBY		; increment and scan memory
2031	JSR	LAB_GFPN		; get fixed-point number into temp integer (skip this n)
2032					; (we could LDX #',' and JSR LAB_SNBL+2, then we
2033					; just BNE LAB_176B for the loop. should be quicker ..
2034					; no we can't, what if we meet a colon or [EOL]?)
2035	CMP	#$2C			; compare next character with ","
2036	BEQ	LAB_176B		; loop if ","
2037
2038LAB_177E
2039	PLA				; else pull keyword token (run out of options)
2040					; also dump +/-1 pointer low byte and exit
2041LAB_177F
2042	RTS
2043
2044; takes n * 106 + 11 cycles where n is the number of digits
2045
2046; get fixed-point number into temp integer
2047
2048LAB_GFPN
2049	LDX	#$00			; clear reg
2050	STX	Itempl		; clear temporary integer low byte
2051LAB_1785
2052	STX	Itemph		; save temporary integer high byte
2053	BCS	LAB_177F		; return if carry set, end of scan, character was
2054					; not 0-9
2055
2056	CPX	#$19			; compare high byte with $19
2057	TAY				; ensure Zb = 0 if the branch is taken
2058	BCS	LAB_1767		; branch if >=, makes max line # 63999 because next
2059					; bit does *$0A, = 64000, compare at target will fail
2060					; and do syntax error
2061
2062	SBC	#'0'-1		; subtract "0", $2F + carry, from byte
2063	TAY				; copy binary digit
2064	LDA	Itempl		; get temporary integer low byte
2065	ASL				; *2 low byte
2066	ROL	Itemph		; *2 high byte
2067	ASL				; *2 low byte
2068	ROL	Itemph		; *2 high byte, *4
2069	ADC	Itempl		; + low byte, *5
2070	STA	Itempl		; save it
2071	TXA				; get high byte copy to A
2072	ADC	Itemph		; + high byte, *5
2073	ASL	Itempl		; *2 low byte, *10d
2074	ROL				; *2 high byte, *10d
2075	TAX				; copy high byte back to X
2076	TYA				; get binary digit back
2077	ADC	Itempl		; add number low byte
2078	STA	Itempl		; save number low byte
2079	BCC	LAB_17B3		; if no overflow to high byte get next character
2080
2081	INX				; else increment high byte
2082LAB_17B3
2083	JSR	LAB_IGBY		; increment and scan memory
2084	JMP	LAB_1785		; loop for next character
2085
2086; perform DEC
2087
2088LAB_DEC
2089	LDA	#<LAB_2AFD		; set -1 pointer low byte
2090	.byte	$2C			; BIT abs to skip the LDA below
2091
2092; perform INC
2093
2094LAB_INC
2095	LDA	#<LAB_259C		; set 1 pointer low byte
2096LAB_17B5
2097	PHA				; save +/-1 pointer low byte
2098LAB_17B7
2099	JSR	LAB_GVAR		; get var address
2100	LDX	Dtypef		; get data type flag, $FF=string, $00=numeric
2101	BMI	IncrErr		; exit if string
2102
2103	STA	Lvarpl		; save var address low byte
2104	STY	Lvarph		; save var address high byte
2105	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
2106	PLA				; get +/-1 pointer low byte
2107	PHA				; save +/-1 pointer low byte
2108	LDY	#>LAB_259C		; set +/-1 pointer high byte (both the same)
2109	JSR	LAB_246C		; add (AY) to FAC1
2110	JSR	LAB_PFAC		; pack FAC1 into variable (Lvarpl)
2111
2112	JSR	LAB_GBYT		; scan memory
2113	CMP	#','			; compare with ","
2114	BNE	LAB_177E		; exit if not "," (either end or error)
2115
2116					; was "," so another INCR variable to do
2117	JSR	LAB_IGBY		; increment and scan memory
2118	JMP	LAB_17B7		; go do next var
2119
2120IncrErr
2121	JMP	LAB_1ABC		; do "Type mismatch" error then warm start
2122
2123; perform LET
2124
2125LAB_LET
2126	JSR	LAB_GVAR		; get var address
2127	STA	Lvarpl		; save var address low byte
2128	STY	Lvarph		; save var address high byte
2129	LDA	#TK_EQUAL		; get = token
2130	JSR	LAB_SCCA		; scan for CHR$(A), else do syntax error then warm start
2131	LDA	Dtypef		; get data type flag, $FF=string, $00=numeric
2132	PHA				; push data type flag
2133	JSR	LAB_EVEX		; evaluate expression
2134	PLA				; pop data type flag
2135	ROL				; set carry if type = string
2136	JSR	LAB_CKTM		; type match check, set C for string
2137	BNE	LAB_17D5		; branch if string
2138
2139	JMP	LAB_PFAC		; pack FAC1 into variable (Lvarpl) and return
2140
2141; string LET
2142
2143LAB_17D5
2144	LDY	#$02			; set index to pointer high byte
2145	LDA	(des_pl),Y		; get string pointer high byte
2146	CMP	Sstorh		; compare bottom of string space high byte
2147	BCC	LAB_17F4		; if less assign value and exit (was in program memory)
2148
2149	BNE	LAB_17E6		; branch if >
2150					; else was equal so compare low bytes
2151	DEY				; decrement index
2152	LDA	(des_pl),Y		; get pointer low byte
2153	CMP	Sstorl		; compare bottom of string space low byte
2154	BCC	LAB_17F4		; if less assign value and exit (was in program memory)
2155
2156					; pointer was >= to bottom of string space pointer
2157LAB_17E6
2158	LDY	des_ph		; get descriptor pointer high byte
2159	CPY	Svarh			; compare start of vars high byte
2160	BCC	LAB_17F4		; branch if less (descriptor is on stack)
2161
2162	BNE	LAB_17FB		; branch if greater (descriptor is not on stack)
2163
2164					; else high bytes were equal so ..
2165	LDA	des_pl		; get descriptor pointer low byte
2166	CMP	Svarl			; compare start of vars low byte
2167	BCS	LAB_17FB		; branch if >= (descriptor is not on stack)
2168
2169LAB_17F4
2170	LDA	des_pl		; get descriptor pointer low byte
2171	LDY	des_ph		; get descriptor pointer high byte
2172	JMP	LAB_1811		; clean stack, copy descriptor to variable and return
2173
2174					; make space and copy string
2175LAB_17FB
2176	LDY	#$00			; index to length
2177	LDA	(des_pl),Y		; get string length
2178	JSR	LAB_209C		; copy string
2179	LDA	des_2l		; get descriptor pointer low byte
2180	LDY	des_2h		; get descriptor pointer high byte
2181	STA	ssptr_l		; save descriptor pointer low byte
2182	STY	ssptr_h		; save descriptor pointer high byte
2183	JSR	LAB_228A		; copy string from descriptor (sdescr) to (Sutill)
2184	LDA	#<FAC1_e		; set descriptor pointer low byte
2185	LDY	#>FAC1_e		; get descriptor pointer high byte
2186
2187					; clean stack and assign value to string variable
2188LAB_1811
2189	STA	des_2l		; save descriptor_2 pointer low byte
2190	STY	des_2h		; save descriptor_2 pointer high byte
2191	JSR	LAB_22EB		; clean descriptor stack, YA = pointer
2192	LDY	#$00			; index to length
2193	LDA	(des_2l),Y		; get string length
2194	STA	(Lvarpl),Y		; copy to let string variable
2195	INY				; index to string pointer low byte
2196	LDA	(des_2l),Y		; get string pointer low byte
2197	STA	(Lvarpl),Y		; copy to let string variable
2198	INY				; index to string pointer high byte
2199	LDA	(des_2l),Y		; get string pointer high byte
2200	STA	(Lvarpl),Y		; copy to let string variable
2201	RTS
2202
2203; perform GET
2204
2205LAB_GET
2206	JSR	LAB_GVAR		; get var address
2207	STA	Lvarpl		; save var address low byte
2208	STY	Lvarph		; save var address high byte
2209	JSR	INGET			; get input byte
2210	LDX	Dtypef		; get data type flag, $FF=string, $00=numeric
2211	BMI	LAB_GETS		; go get string character
2212
2213					; was numeric get
2214	TAY				; copy character to Y
2215	JSR	LAB_1FD0		; convert Y to byte in FAC1
2216	JMP	LAB_PFAC		; pack FAC1 into variable (Lvarpl) and return
2217
2218LAB_GETS
2219	PHA				; save character
2220	LDA	#$01			; string is single byte
2221	BCS	LAB_IsByte		; branch if byte received
2222
2223	PLA				; string is null
2224LAB_IsByte
2225	JSR	LAB_MSSP		; make string space A bytes long A=$AC=length,
2226					; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
2227	BEQ	LAB_NoSt		; skip store if null string
2228
2229	PLA				; get character back
2230	LDY	#$00			; clear index
2231	STA	(str_pl),Y		; save byte in string (byte IS string!)
2232LAB_NoSt
2233	JSR	LAB_RTST		; check for space on descriptor stack then put address
2234					; and length on descriptor stack and update stack pointers
2235
2236	JMP	LAB_17D5		; do string LET and return
2237
2238; perform PRINT
2239
2240LAB_1829
2241	JSR	LAB_18C6		; print string from Sutill/Sutilh
2242LAB_182C
2243	JSR	LAB_GBYT		; scan memory
2244
2245; PRINT
2246
2247LAB_PRINT
2248	BEQ	LAB_CRLF		; if nothing following just print CR/LF
2249
2250LAB_1831
2251	CMP	#TK_TAB		; compare with TAB( token
2252	BEQ	LAB_18A2		; go do TAB/SPC
2253
2254	CMP	#TK_SPC		; compare with SPC( token
2255	BEQ	LAB_18A2		; go do TAB/SPC
2256
2257	CMP	#','			; compare with ","
2258	BEQ	LAB_188B		; go do move to next TAB mark
2259
2260	CMP	#';'			; compare with ";"
2261	BEQ	LAB_18BD		; if ";" continue with PRINT processing
2262
2263	JSR	LAB_EVEX		; evaluate expression
2264	BIT	Dtypef		; test data type flag, $FF=string, $00=numeric
2265	BMI	LAB_1829		; branch if string
2266
2267	JSR	LAB_296E		; convert FAC1 to string
2268	JSR	LAB_20AE		; print " terminated string to Sutill/Sutilh
2269	LDY	#$00			; clear index
2270
2271; don't check fit if terminal width byte is zero
2272
2273	LDA	TWidth		; get terminal width byte
2274	BEQ	LAB_185E		; skip check if zero
2275
2276	SEC				; set carry for subtract
2277	SBC	TPos			; subtract terminal position
2278	SBC	(des_pl),Y		; subtract string length
2279	BCS	LAB_185E		; branch if less than terminal width
2280
2281	JSR	LAB_CRLF		; else print CR/LF
2282LAB_185E
2283	JSR	LAB_18C6		; print string from Sutill/Sutilh
2284	BEQ	LAB_182C		; always go continue processing line
2285
2286; CR/LF return to BASIC from BASIC input handler
2287
2288LAB_1866
2289	LDA	#$00			; clear byte
2290	STA	Ibuffs,X		; null terminate input
2291	LDX	#<Ibuffs		; set X to buffer start-1 low byte
2292	LDY	#>Ibuffs		; set Y to buffer start-1 high byte
2293
2294; print CR/LF
2295
2296LAB_CRLF
2297	LDA	#$0D			; load [CR]
2298	JSR	LAB_PRNA		; go print the character
2299	LDA	#$0A			; load [LF]
2300	BNE	LAB_PRNA		; go print the character and return, branch always
2301
2302LAB_188B
2303	LDA	TPos			; get terminal position
2304	CMP	Iclim			; compare with input column limit
2305	BCC	LAB_1897		; branch if less
2306
2307	JSR	LAB_CRLF		; else print CR/LF (next line)
2308	BNE	LAB_18BD		; continue with PRINT processing (branch always)
2309
2310LAB_1897
2311	SEC				; set carry for subtract
2312LAB_1898
2313	SBC	TabSiz		; subtract TAB size
2314	BCS	LAB_1898		; loop if result was +ve
2315
2316	EOR	#$FF			; complement it
2317	ADC	#$01			; +1 (twos complement)
2318	BNE	LAB_18B6		; always print A spaces (result is never $00)
2319
2320					; do TAB/SPC
2321LAB_18A2
2322	PHA				; save token
2323	JSR	LAB_SGBY		; scan and get byte parameter
2324	CMP	#$29			; is next character )
2325	BNE	LAB_1910		; if not do syntax error then warm start
2326
2327	PLA				; get token back
2328	CMP	#TK_TAB		; was it TAB ?
2329	BNE	LAB_18B7		; if not go do SPC
2330
2331					; calculate TAB offset
2332	TXA				; copy integer value to A
2333	SBC	TPos			; subtract terminal position
2334	BCC	LAB_18BD		; branch if result was < 0 (can't TAB backwards)
2335
2336					; print A spaces
2337LAB_18B6
2338	TAX				; copy result to X
2339LAB_18B7
2340	TXA				; set flags on size for SPC
2341	BEQ	LAB_18BD		; branch if result was = $0, already here
2342
2343					; print X spaces
2344LAB_18BA
2345	JSR	LAB_18E0		; print " "
2346	DEX				; decrement count
2347	BNE	LAB_18BA		; loop if not all done
2348
2349					; continue with PRINT processing
2350LAB_18BD
2351	JSR	LAB_IGBY		; increment and scan memory
2352	BNE	LAB_1831		; if more to print go do it
2353
2354	RTS
2355
2356; print null terminated string from memory
2357
2358LAB_18C3
2359	JSR	LAB_20AE		; print " terminated string to Sutill/Sutilh
2360
2361; print string from Sutill/Sutilh
2362
2363LAB_18C6
2364	JSR	LAB_22B6		; pop string off descriptor stack, or from top of string
2365					; space returns with A = length, X=$71=pointer low byte,
2366					; Y=$72=pointer high byte
2367	LDY	#$00			; reset index
2368	TAX				; copy length to X
2369	BEQ	LAB_188C		; exit (RTS) if null string
2370
2371LAB_18CD
2372
2373	LDA	(ut1_pl),Y		; get next byte
2374	JSR	LAB_PRNA		; go print the character
2375	INY				; increment index
2376	DEX				; decrement count
2377	BNE	LAB_18CD		; loop if not done yet
2378
2379	RTS
2380
2381					; Print single format character
2382; print " "
2383
2384LAB_18E0
2385	LDA	#$20			; load " "
2386	.byte	$2C			; change next line to BIT LAB_3FA9
2387
2388; print "?" character
2389
2390LAB_18E3
2391	LDA	#$3F			; load "?" character
2392
2393; print character in A
2394; now includes the null handler
2395; also includes infinite line length code
2396; note! some routines expect this one to exit with Zb=0
2397
2398LAB_PRNA
2399	CMP	#' '			; compare with " "
2400	BCC	LAB_18F9		; branch if less (non printing)
2401
2402					; else printable character
2403	PHA				; save the character
2404
2405; don't check fit if terminal width byte is zero
2406
2407	LDA	TWidth		; get terminal width
2408	BNE	LAB_18F0		; branch if not zero (not infinite length)
2409
2410; is "infinite line" so check TAB position
2411
2412	LDA	TPos			; get position
2413	SBC	TabSiz		; subtract TAB size, carry set by CMP #$20 above
2414	BNE	LAB_18F7		; skip reset if different
2415
2416	STA	TPos			; else reset position
2417	BEQ	LAB_18F7		; go print character
2418
2419LAB_18F0
2420	CMP	TPos			; compare with terminal character position
2421	BNE	LAB_18F7		; branch if not at end of line
2422
2423	JSR	LAB_CRLF		; else print CR/LF
2424LAB_18F7
2425	INC	TPos			; increment terminal position
2426	PLA				; get character back
2427LAB_18F9
2428	JSR	V_OUTP		; output byte via output vector
2429	CMP	#$0D			; compare with [CR]
2430	BNE	LAB_188A		; branch if not [CR]
2431
2432					; else print nullct nulls after the [CR]
2433	STX	TempB			; save buffer index
2434	LDX	Nullct		; get null count
2435	BEQ	LAB_1886		; branch if no nulls
2436
2437	LDA	#$00			; load [NULL]
2438LAB_1880
2439	JSR	LAB_PRNA		; go print the character
2440	DEX				; decrement count
2441	BNE	LAB_1880		; loop if not all done
2442
2443	LDA	#$0D			; restore the character (and set the flags)
2444LAB_1886
2445	STX	TPos			; clear terminal position (X always = zero when we get here)
2446	LDX	TempB			; restore buffer index
2447LAB_188A
2448	AND	#$FF			; set the flags
2449LAB_188C
2450	RTS
2451
2452; handle bad input data
2453
2454LAB_1904
2455	LDA	Imode			; get input mode flag, $00=INPUT, $00=READ
2456	BPL	LAB_1913		; branch if INPUT (go do redo)
2457
2458	LDA	Dlinel		; get current DATA line low byte
2459	LDY	Dlineh		; get current DATA line high byte
2460	STA	Clinel		; save current line low byte
2461	STY	Clineh		; save current line high byte
2462LAB_1910
2463	JMP	LAB_SNER		; do syntax error then warm start
2464
2465					; mode was INPUT
2466LAB_1913
2467	LDA	#<LAB_REDO		; point to redo message (low addr)
2468	LDY	#>LAB_REDO		; point to redo message (high addr)
2469	JSR	LAB_18C3		; print null terminated string from memory
2470	LDA	Cpntrl		; get continue pointer low byte
2471	LDY	Cpntrh		; get continue pointer high byte
2472	STA	Bpntrl		; save BASIC execute pointer low byte
2473	STY	Bpntrh		; save BASIC execute pointer high byte
2474	RTS
2475
2476; perform INPUT
2477
2478LAB_INPUT
2479	CMP	#$22			; compare next byte with open quote
2480	BNE	LAB_1934		; branch if no prompt string
2481
2482	JSR	LAB_1BC1		; print "..." string
2483	LDA	#$3B			; load A with ";"
2484	JSR	LAB_SCCA		; scan for CHR$(A), else do syntax error then warm start
2485	JSR	LAB_18C6		; print string from Sutill/Sutilh
2486
2487					; done with prompt, now get data
2488LAB_1934
2489	JSR	LAB_CKRN		; check not Direct, back here if ok
2490	JSR	LAB_INLN		; print "? " and get BASIC input
2491	LDA	#$00			; set mode = INPUT
2492	CMP	Ibuffs		; test first byte in buffer
2493	BNE	LAB_1953		; branch if not null input
2494
2495	CLC				; was null input so clear carry to exit program
2496	JMP	LAB_1647		; go do BREAK exit
2497
2498; perform READ
2499
2500LAB_READ
2501	LDX	Dptrl			; get DATA pointer low byte
2502	LDY	Dptrh			; get DATA pointer high byte
2503	LDA	#$80			; set mode = READ
2504
2505LAB_1953
2506	STA	Imode			; set input mode flag, $00=INPUT, $80=READ
2507	STX	Rdptrl		; save READ pointer low byte
2508	STY	Rdptrh		; save READ pointer high byte
2509
2510					; READ or INPUT next variable from list
2511LAB_195B
2512	JSR	LAB_GVAR		; get (var) address
2513	STA	Lvarpl		; save address low byte
2514	STY	Lvarph		; save address high byte
2515	LDA	Bpntrl		; get BASIC execute pointer low byte
2516	LDY	Bpntrh		; get BASIC execute pointer high byte
2517	STA	Itempl		; save as temporary integer low byte
2518	STY	Itemph		; save as temporary integer high byte
2519	LDX	Rdptrl		; get READ pointer low byte
2520	LDY	Rdptrh		; get READ pointer high byte
2521	STX	Bpntrl		; set BASIC execute pointer low byte
2522	STY	Bpntrh		; set BASIC execute pointer high byte
2523	JSR	LAB_GBYT		; scan memory
2524	BNE	LAB_1988		; branch if not null
2525
2526					; pointer was to null entry
2527	BIT	Imode			; test input mode flag, $00=INPUT, $80=READ
2528	BMI	LAB_19DD		; branch if READ
2529
2530					; mode was INPUT
2531	JSR	LAB_18E3		; print "?" character (double ? for extended input)
2532	JSR	LAB_INLN		; print "? " and get BASIC input
2533	STX	Bpntrl		; set BASIC execute pointer low byte
2534	STY	Bpntrh		; set BASIC execute pointer high byte
2535LAB_1985
2536	JSR	LAB_GBYT		; scan memory
2537LAB_1988
2538	BIT	Dtypef		; test data type flag, $FF=string, $00=numeric
2539	BPL	LAB_19B0		; branch if numeric
2540
2541					; else get string
2542	STA	Srchc			; save search character
2543	CMP	#$22			; was it " ?
2544	BEQ	LAB_1999		; branch if so
2545
2546	LDA	#':'			; else search character is ":"
2547	STA	Srchc			; set new search character
2548	LDA	#','			; other search character is ","
2549	CLC				; clear carry for add
2550LAB_1999
2551	STA	Asrch			; set second search character
2552	LDA	Bpntrl		; get BASIC execute pointer low byte
2553	LDY	Bpntrh		; get BASIC execute pointer high byte
2554
2555	ADC	#$00			; c is =1 if we came via the BEQ LAB_1999, else =0
2556	BCC	LAB_19A4		; branch if no execute pointer low byte rollover
2557
2558	INY				; else increment high byte
2559LAB_19A4
2560	JSR	LAB_20B4		; print Srchc or Asrch terminated string to Sutill/Sutilh
2561	JSR	LAB_23F3		; restore BASIC execute pointer from temp (Btmpl/Btmph)
2562	JSR	LAB_17D5		; go do string LET
2563	JMP	LAB_19B6		; go check string terminator
2564
2565					; get numeric INPUT
2566LAB_19B0
2567	JSR	LAB_2887		; get FAC1 from string
2568	JSR	LAB_PFAC		; pack FAC1 into (Lvarpl)
2569LAB_19B6
2570	JSR	LAB_GBYT		; scan memory
2571	BEQ	LAB_19C5		; branch if null (last entry)
2572
2573	CMP	#','			; else compare with ","
2574	BEQ	LAB_19C2		; branch if ","
2575
2576	JMP	LAB_1904		; else go handle bad input data
2577
2578					; got good input data
2579LAB_19C2
2580	JSR	LAB_IGBY		; increment and scan memory
2581LAB_19C5
2582	LDA	Bpntrl		; get BASIC execute pointer low byte (temp READ/INPUT ptr)
2583	LDY	Bpntrh		; get BASIC execute pointer high byte (temp READ/INPUT ptr)
2584	STA	Rdptrl		; save for now
2585	STY	Rdptrh		; save for now
2586	LDA	Itempl		; get temporary integer low byte (temp BASIC execute ptr)
2587	LDY	Itemph		; get temporary integer high byte (temp BASIC execute ptr)
2588	STA	Bpntrl		; set BASIC execute pointer low byte
2589	STY	Bpntrh		; set BASIC execute pointer high byte
2590	JSR	LAB_GBYT		; scan memory
2591	BEQ	LAB_1A03		; if null go do extra ignored message
2592
2593	JSR	LAB_1C01		; else scan for "," , else do syntax error then warm start
2594	JMP	LAB_195B		; go INPUT next variable from list
2595
2596					; find next DATA statement or do "Out of DATA" error
2597LAB_19DD
2598	JSR	LAB_SNBS		; scan for next BASIC statement ([:] or [EOL])
2599	INY				; increment index
2600	TAX				; copy character ([:] or [EOL])
2601	BNE	LAB_19F6		; branch if [:]
2602
2603	LDX	#$06			; set for "Out of DATA" error
2604	INY				; increment index, now points to next line pointer high byte
2605	LDA	(Bpntrl),Y		; get next line pointer high byte
2606	BEQ	LAB_1A54		; branch if end (eventually does error X)
2607
2608	INY				; increment index
2609	LDA	(Bpntrl),Y		; get next line # low byte
2610	STA	Dlinel		; save current DATA line low byte
2611	INY				; increment index
2612	LDA	(Bpntrl),Y		; get next line # high byte
2613	INY				; increment index
2614	STA	Dlineh		; save current DATA line high byte
2615LAB_19F6
2616	LDA	(Bpntrl),Y		; get byte
2617	INY				; increment index
2618	TAX				; copy to X
2619	JSR	LAB_170F		; set BASIC execute pointer
2620	CPX	#TK_DATA		; compare with "DATA" token
2621	BEQ	LAB_1985		; was "DATA" so go do next READ
2622
2623	BNE	LAB_19DD		; go find next statement if not "DATA"
2624
2625; end of INPUT/READ routine
2626
2627LAB_1A03
2628	LDA	Rdptrl		; get temp READ pointer low byte
2629	LDY	Rdptrh		; get temp READ pointer high byte
2630	LDX	Imode			; get input mode flag, $00=INPUT, $80=READ
2631	BPL	LAB_1A0E		; branch if INPUT
2632
2633	JMP	LAB_1624		; save AY as DATA pointer and return
2634
2635					; we were getting INPUT
2636LAB_1A0E
2637	LDY	#$00			; clear index
2638	LDA	(Rdptrl),Y		; get next byte
2639	BNE	LAB_1A1B		; error if not end of INPUT
2640
2641	RTS
2642
2643					; user typed too much
2644LAB_1A1B
2645	LDA	#<LAB_IMSG		; point to extra ignored message (low addr)
2646	LDY	#>LAB_IMSG		; point to extra ignored message (high addr)
2647	JMP	LAB_18C3		; print null terminated string from memory and return
2648
2649; search the stack for FOR activity
2650; exit with z=1 if FOR else exit with z=0
2651
2652LAB_11A1
2653	TSX				; copy stack pointer
2654	INX				; +1 pass return address
2655	INX				; +2 pass return address
2656	INX				; +3 pass calling routine return address
2657	INX				; +4 pass calling routine return address
2658LAB_11A6
2659	LDA	LAB_STAK+1,X	; get token byte from stack
2660	CMP	#TK_FOR		; is it FOR token
2661	BNE	LAB_11CE		; exit if not FOR token
2662
2663					; was FOR token
2664	LDA	Frnxth		; get var pointer for FOR/NEXT high byte
2665	BNE	LAB_11BB		; branch if not null
2666
2667	LDA	LAB_STAK+2,X	; get FOR variable pointer low byte
2668	STA	Frnxtl		; save var pointer for FOR/NEXT low byte
2669	LDA	LAB_STAK+3,X	; get FOR variable pointer high byte
2670	STA	Frnxth		; save var pointer for FOR/NEXT high byte
2671LAB_11BB
2672	CMP	LAB_STAK+3,X	; compare var pointer with stacked var pointer (high byte)
2673	BNE	LAB_11C7		; branch if no match
2674
2675	LDA	Frnxtl		; get var pointer for FOR/NEXT low byte
2676	CMP	LAB_STAK+2,X	; compare var pointer with stacked var pointer (low byte)
2677	BEQ	LAB_11CE		; exit if match found
2678
2679LAB_11C7
2680	TXA				; copy index
2681	CLC				; clear carry for add
2682	ADC	#$10			; add FOR stack use size
2683	TAX				; copy back to index
2684	BNE	LAB_11A6		; loop if not at start of stack
2685
2686LAB_11CE
2687	RTS
2688
2689; perform NEXT
2690
2691LAB_NEXT
2692	BNE	LAB_1A46		; branch if NEXT var
2693
2694	LDY	#$00			; else clear Y
2695	BEQ	LAB_1A49		; branch always (no variable to search for)
2696
2697; NEXT var
2698
2699LAB_1A46
2700	JSR	LAB_GVAR		; get variable address
2701LAB_1A49
2702	STA	Frnxtl		; store variable pointer low byte
2703	STY	Frnxth		; store variable pointer high byte
2704					; (both cleared if no variable defined)
2705	JSR	LAB_11A1		; search the stack for FOR activity
2706	BEQ	LAB_1A56		; branch if found
2707
2708	LDX	#$00			; else set error $00 ("NEXT without FOR" error)
2709LAB_1A54
2710	BEQ	LAB_1ABE		; do error #X, then warm start
2711
2712LAB_1A56
2713	TXS				; set stack pointer, X set by search, dumps return addresses
2714
2715	TXA				; copy stack pointer
2716	SEC				; set carry for subtract
2717	SBC	#$F7			; point to TO var
2718	STA	ut2_pl		; save pointer to TO var for compare
2719	ADC	#$FB			; point to STEP var
2720
2721	LDY	#>LAB_STAK		; point to stack page high byte
2722	JSR	LAB_UFAC		; unpack memory (STEP value) into FAC1
2723	TSX				; get stack pointer back
2724	LDA	LAB_STAK+8,X	; get step sign
2725	STA	FAC1_s		; save FAC1 sign (b7)
2726	LDA	Frnxtl		; get FOR variable pointer low byte
2727	LDY	Frnxth		; get FOR variable pointer high byte
2728	JSR	LAB_246C		; add (FOR variable) to FAC1
2729	JSR	LAB_PFAC		; pack FAC1 into (FOR variable)
2730	LDY	#>LAB_STAK		; point to stack page high byte
2731	JSR	LAB_27FA		; compare FAC1 with (Y,ut2_pl) (TO value)
2732	TSX				; get stack pointer back
2733	CMP	LAB_STAK+8,X	; compare step sign
2734	BEQ	LAB_1A9B		; branch if = (loop complete)
2735
2736					; loop back and do it all again
2737	LDA	LAB_STAK+$0D,X	; get FOR line low byte
2738	STA	Clinel		; save current line low byte
2739	LDA	LAB_STAK+$0E,X	; get FOR line high byte
2740	STA	Clineh		; save current line high byte
2741	LDA	LAB_STAK+$10,X	; get BASIC execute pointer low byte
2742	STA	Bpntrl		; save BASIC execute pointer low byte
2743	LDA	LAB_STAK+$0F,X	; get BASIC execute pointer high byte
2744	STA	Bpntrh		; save BASIC execute pointer high byte
2745LAB_1A98
2746	JMP	LAB_15C2		; go do interpreter inner loop
2747
2748					; loop complete so carry on
2749LAB_1A9B
2750	TXA				; stack copy to A
2751	ADC	#$0F			; add $10 ($0F+carry) to dump FOR structure
2752	TAX				; copy back to index
2753	TXS				; copy to stack pointer
2754	JSR	LAB_GBYT		; scan memory
2755	CMP	#','			; compare with ","
2756	BNE	LAB_1A98		; branch if not "," (go do interpreter inner loop)
2757
2758					; was "," so another NEXT variable to do
2759	JSR	LAB_IGBY		; else increment and scan memory
2760	JSR	LAB_1A46		; do NEXT (var)
2761
2762; evaluate expression and check is numeric, else do type mismatch
2763
2764LAB_EVNM
2765	JSR	LAB_EVEX		; evaluate expression
2766
2767; check if source is numeric, else do type mismatch
2768
2769LAB_CTNM
2770	CLC				; destination is numeric
2771	.byte	$24			; makes next line BIT $38
2772
2773; check if source is string, else do type mismatch
2774
2775LAB_CTST
2776	SEC				; required type is string
2777
2778; type match check, set C for string, clear C for numeric
2779
2780LAB_CKTM
2781	BIT	Dtypef		; test data type flag, $FF=string, $00=numeric
2782	BMI	LAB_1ABA		; branch if data type is string
2783
2784					; else data type was numeric
2785	BCS	LAB_1ABC		; if required type is string do type mismatch error
2786LAB_1AB9
2787	RTS
2788
2789					; data type was string, now check required type
2790LAB_1ABA
2791	BCS	LAB_1AB9		; exit if required type is string
2792
2793					; else do type mismatch error
2794LAB_1ABC
2795	LDX	#$18			; error code $18 ("Type mismatch" error)
2796LAB_1ABE
2797	JMP	LAB_XERR		; do error #X, then warm start
2798
2799; evaluate expression
2800
2801LAB_EVEX
2802	LDX	Bpntrl		; get BASIC execute pointer low byte
2803	BNE	LAB_1AC7		; skip next if not zero
2804
2805	DEC	Bpntrh		; else decrement BASIC execute pointer high byte
2806LAB_1AC7
2807	DEC	Bpntrl		; decrement BASIC execute pointer low byte
2808
2809LAB_EVEZ
2810	LDA	#$00			; set null precedence (flag done)
2811LAB_1ACC
2812	PHA				; push precedence byte
2813	LDA	#$02			; 2 bytes
2814	JSR	LAB_1212		; check room on stack for A bytes
2815	JSR	LAB_GVAL		; get value from line
2816	LDA	#$00			; clear A
2817	STA	comp_f		; clear compare function flag
2818LAB_1ADB
2819	JSR	LAB_GBYT		; scan memory
2820LAB_1ADE
2821	SEC				; set carry for subtract
2822	SBC	#TK_GT		; subtract token for > (lowest comparison function)
2823	BCC	LAB_1AFA		; branch if < TK_GT
2824
2825	CMP	#$03			; compare with ">" to "<" tokens
2826	BCS	LAB_1AFA		; branch if >= TK_SGN (highest evaluation function +1)
2827
2828					; was token for > = or < (A = 0, 1 or 2)
2829	CMP	#$01			; compare with token for =
2830	ROL				; *2, b0 = carry (=1 if token was = or <)
2831					; (A = 0, 3 or 5)
2832	EOR	#$01			; toggle b0
2833					; (A = 1, 2 or 4. 1 if >, 2 if =, 4 if <)
2834	EOR	comp_f		; EOR with compare function flag bits
2835	CMP	comp_f		; compare with compare function flag
2836	BCC	LAB_1B53		; if <(comp_f) do syntax error then warm start
2837					; was more than one <, = or >)
2838
2839	STA	comp_f		; save new compare function flag
2840	JSR	LAB_IGBY		; increment and scan memory
2841	JMP	LAB_1ADE		; go do next character
2842
2843					; token is < ">" or > "<" tokens
2844LAB_1AFA
2845	LDX	comp_f		; get compare function flag
2846	BNE	LAB_1B2A		; branch if compare function
2847
2848	BCS	LAB_1B78		; go do functions
2849
2850					; else was <  TK_GT so is operator or lower
2851	ADC	#TK_GT-TK_PLUS	; add # of operators (+, -, *, /, ^, AND, OR or EOR)
2852	BCC	LAB_1B78		; branch if < + operator
2853
2854					; carry was set so token was +, -, *, /, ^, AND, OR or EOR
2855	BNE	LAB_1B0B		; branch if not + token
2856
2857	BIT	Dtypef		; test data type flag, $FF=string, $00=numeric
2858	BPL	LAB_1B0B		; branch if not string
2859
2860					; will only be $00 if type is string and token was +
2861	JMP	LAB_224D		; add strings, string 1 is in descriptor des_pl, string 2
2862					; is in line, and return
2863
2864LAB_1B0B
2865	STA	ut1_pl		; save it
2866	ASL				; *2
2867	ADC	ut1_pl		; *3
2868	TAY				; copy to index
2869LAB_1B13
2870	PLA				; pull previous precedence
2871	CMP	LAB_OPPT,Y		; compare with precedence byte
2872	BCS	LAB_1B7D		; branch if A >=
2873
2874	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
2875LAB_1B1C
2876	PHA				; save precedence
2877LAB_1B1D
2878	JSR	LAB_1B43		; get vector, execute function then continue evaluation
2879	PLA				; restore precedence
2880	LDY	prstk			; get precedence stacked flag
2881	BPL	LAB_1B3C		; branch if stacked values
2882
2883	TAX				; copy precedence (set flags)
2884	BEQ	LAB_1B9D		; exit if done
2885
2886	BNE	LAB_1B86		; else pop FAC2 and return, branch always
2887
2888LAB_1B2A
2889	ROL	Dtypef		; shift data type flag into Cb
2890	TXA				; copy compare function flag
2891	STA	Dtypef		; clear data type flag, X is 0xxx xxxx
2892	ROL				; shift data type into compare function byte b0
2893	LDX	Bpntrl		; get BASIC execute pointer low byte
2894	BNE	LAB_1B34		; branch if no underflow
2895
2896	DEC	Bpntrh		; else decrement BASIC execute pointer high byte
2897LAB_1B34
2898	DEC	Bpntrl		; decrement BASIC execute pointer low byte
2899TK_LT_PLUS	= TK_LT-TK_PLUS
2900	LDY	#TK_LT_PLUS*3	; set offset to last operator entry
2901	STA	comp_f		; save new compare function flag
2902	BNE	LAB_1B13		; branch always
2903
2904LAB_1B3C
2905	CMP	LAB_OPPT,Y		;.compare with stacked function precedence
2906	BCS	LAB_1B86		; branch if A >=, pop FAC2 and return
2907
2908	BCC	LAB_1B1C		; branch always
2909
2910;.get vector, execute function then continue evaluation
2911
2912LAB_1B43
2913	LDA	LAB_OPPT+2,Y	; get function vector high byte
2914	PHA				; onto stack
2915	LDA	LAB_OPPT+1,Y	; get function vector low byte
2916	PHA				; onto stack
2917					; now push sign, round FAC1 and put on stack
2918	JSR	LAB_1B5B		; function will return here, then the next RTS will call
2919					; the function
2920	LDA	comp_f		; get compare function flag
2921	PHA				; push compare evaluation byte
2922	LDA	LAB_OPPT,Y		; get precedence byte
2923	JMP	LAB_1ACC		; continue evaluating expression
2924
2925LAB_1B53
2926	JMP	LAB_SNER		; do syntax error then warm start
2927
2928; push sign, round FAC1 and put on stack
2929
2930LAB_1B5B
2931	PLA				; get return addr low byte
2932	STA	ut1_pl		; save it
2933	INC	ut1_pl		; increment it (was ret-1 pushed? yes!)
2934					; note! no check is made on the high byte! if the calling
2935					; routine assembles to a page edge then this all goes
2936					; horribly wrong !!!
2937	PLA				; get return addr high byte
2938	STA	ut1_ph		; save it
2939	LDA	FAC1_s		; get FAC1 sign (b7)
2940	PHA				; push sign
2941
2942; round FAC1 and put on stack
2943
2944LAB_1B66
2945	JSR	LAB_27BA		; round FAC1
2946	LDA	FAC1_3		; get FAC1 mantissa3
2947	PHA				; push on stack
2948	LDA	FAC1_2		; get FAC1 mantissa2
2949	PHA				; push on stack
2950	LDA	FAC1_1		; get FAC1 mantissa1
2951	PHA				; push on stack
2952	LDA	FAC1_e		; get FAC1 exponent
2953	PHA				; push on stack
2954	JMP	(ut1_pl)		; return, sort of
2955
2956; do functions
2957
2958LAB_1B78
2959	LDY	#$FF			; flag function
2960	PLA				; pull precedence byte
2961LAB_1B7B
2962	BEQ	LAB_1B9D		; exit if done
2963
2964LAB_1B7D
2965	CMP	#$64			; compare previous precedence with $64
2966	BEQ	LAB_1B84		; branch if was $64 (< function)
2967
2968	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
2969LAB_1B84
2970	STY	prstk			; save precedence stacked flag
2971
2972					; pop FAC2 and return
2973LAB_1B86
2974	PLA				; pop byte
2975	LSR				; shift out comparison evaluation lowest bit
2976	STA	Cflag			; save comparison evaluation flag
2977	PLA				; pop exponent
2978	STA	FAC2_e		; save FAC2 exponent
2979	PLA				; pop mantissa1
2980	STA	FAC2_1		; save FAC2 mantissa1
2981	PLA				; pop mantissa2
2982	STA	FAC2_2		; save FAC2 mantissa2
2983	PLA				; pop mantissa3
2984	STA	FAC2_3		; save FAC2 mantissa3
2985	PLA				; pop sign
2986	STA	FAC2_s		; save FAC2 sign (b7)
2987	EOR	FAC1_s		; EOR FAC1 sign (b7)
2988	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
2989LAB_1B9D
2990	LDA	FAC1_e		; get FAC1 exponent
2991	RTS
2992
2993; print "..." string to string util area
2994
2995LAB_1BC1
2996	LDA	Bpntrl		; get BASIC execute pointer low byte
2997	LDY	Bpntrh		; get BASIC execute pointer high byte
2998	ADC	#$00			; add carry to low byte
2999	BCC	LAB_1BCA		; branch if no overflow
3000
3001	INY				; increment high byte
3002LAB_1BCA
3003	JSR	LAB_20AE		; print " terminated string to Sutill/Sutilh
3004	JMP	LAB_23F3		; restore BASIC execute pointer from temp and return
3005
3006; get value from line
3007
3008LAB_GVAL
3009	JSR	LAB_IGBY		; increment and scan memory
3010	BCS	LAB_1BAC		; branch if not numeric character
3011
3012					; else numeric string found (e.g. 123)
3013LAB_1BA9
3014	JMP	LAB_2887		; get FAC1 from string and return
3015
3016; get value from line .. continued
3017
3018					; wasn't a number so ..
3019LAB_1BAC
3020	TAX				; set the flags
3021	BMI	LAB_1BD0		; if -ve go test token values
3022
3023					; else it is either a string, number, variable or (<expr>)
3024	CMP	#'$'			; compare with "$"
3025	BEQ	LAB_1BA9		; branch if "$", hex number
3026
3027	CMP	#'%'			; else compare with "%"
3028	BEQ	LAB_1BA9		; branch if "%", binary number
3029
3030	CMP	#'.'			; compare with "."
3031	BEQ	LAB_1BA9		; if so get FAC1 from string and return (e.g. was .123)
3032
3033					; it wasn't any sort of number so ..
3034	CMP	#$22			; compare with "
3035	BEQ	LAB_1BC1		; branch if open quote
3036
3037					; wasn't any sort of number so ..
3038
3039; evaluate expression within parentheses
3040
3041	CMP	#'('			; compare with "("
3042	BNE	LAB_1C18		; if not "(" get (var), return value in FAC1 and $ flag
3043
3044LAB_1BF7
3045	JSR	LAB_EVEZ		; evaluate expression, no decrement
3046
3047; all the 'scan for' routines return the character after the sought character
3048
3049; scan for ")" , else do syntax error then warm start
3050
3051LAB_1BFB
3052	LDA	#$29			; load A with ")"
3053
3054; scan for CHR$(A) , else do syntax error then warm start
3055
3056LAB_SCCA
3057	LDY	#$00			; clear index
3058	CMP	(Bpntrl),Y		; check next byte is = A
3059	BNE	LAB_SNER		; if not do syntax error then warm start
3060
3061	JMP	LAB_IGBY		; increment and scan memory then return
3062
3063; scan for "(" , else do syntax error then warm start
3064
3065LAB_1BFE
3066	LDA	#$28			; load A with "("
3067	BNE	LAB_SCCA		; scan for CHR$(A), else do syntax error then warm start
3068					; (branch always)
3069
3070; scan for "," , else do syntax error then warm start
3071
3072LAB_1C01
3073	LDA	#$2C			; load A with ","
3074	BNE	LAB_SCCA		; scan for CHR$(A), else do syntax error then warm start
3075					; (branch always)
3076
3077; syntax error then warm start
3078
3079LAB_SNER
3080	LDX	#$02			; error code $02 ("Syntax" error)
3081	JMP	LAB_XERR		; do error #X, then warm start
3082
3083; get value from line .. continued
3084; do tokens
3085
3086LAB_1BD0
3087	CMP	#TK_MINUS		; compare with token for -
3088	BEQ	LAB_1C11		; branch if - token (do set-up for functions)
3089
3090					; wasn't -n so ..
3091	CMP	#TK_PLUS		; compare with token for +
3092	BEQ	LAB_GVAL		; branch if + token (+n = n so ignore leading +)
3093
3094	CMP	#TK_NOT		; compare with token for NOT
3095	BNE	LAB_1BE7		; branch if not token for NOT
3096
3097					; was NOT token
3098TK_EQUAL_PLUS	= TK_EQUAL-TK_PLUS
3099	LDY	#TK_EQUAL_PLUS*3	; offset to NOT function
3100	BNE	LAB_1C13		; do set-up for function then execute (branch always)
3101
3102; do = compare
3103
3104LAB_EQUAL
3105	JSR	LAB_EVIR		; evaluate integer expression (no sign check)
3106	LDA	FAC1_3		; get FAC1 mantissa3
3107	EOR	#$FF			; invert it
3108	TAY				; copy it
3109	LDA	FAC1_2		; get FAC1 mantissa2
3110	EOR	#$FF			; invert it
3111	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3112
3113; get value from line .. continued
3114
3115					; wasn't +, -, or NOT so ..
3116LAB_1BE7
3117	CMP	#TK_FN		; compare with token for FN
3118	BNE	LAB_1BEE		; branch if not token for FN
3119
3120	JMP	LAB_201E		; go evaluate FNx
3121
3122; get value from line .. continued
3123
3124					; wasn't +, -, NOT or FN so ..
3125LAB_1BEE
3126	SBC	#TK_SGN		; subtract with token for SGN
3127	BCS	LAB_1C27		; if a function token go do it
3128
3129	JMP	LAB_SNER		; else do syntax error
3130
3131; set-up for functions
3132
3133LAB_1C11
3134TK_GT_PLUS	= TK_GT-TK_PLUS
3135	LDY	#TK_GT_PLUS*3	; set offset from base to > operator
3136LAB_1C13
3137	PLA				; dump return address low byte
3138	PLA				; dump return address high byte
3139	JMP	LAB_1B1D		; execute function then continue evaluation
3140
3141; variable name set-up
3142; get (var), return value in FAC_1 and $ flag
3143
3144LAB_1C18
3145	JSR	LAB_GVAR		; get (var) address
3146	STA	FAC1_2		; save address low byte in FAC1 mantissa2
3147	STY	FAC1_3		; save address high byte in FAC1 mantissa3
3148	LDX	Dtypef		; get data type flag, $FF=string, $00=numeric
3149	BMI	LAB_1C25		; if string then return (does RTS)
3150
3151LAB_1C24
3152	JMP	LAB_UFAC		; unpack memory (AY) into FAC1
3153
3154LAB_1C25
3155	RTS
3156
3157; get value from line .. continued
3158; only functions left so ..
3159
3160; set up function references
3161
3162; new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
3163; to process function calls. now the function vector is computed and pushed on the stack
3164; and the preprocess offset is read. if the preprocess offset is non zero then the vector
3165; is calculated and the routine called, if not this routine just does RTS. whichever
3166; happens the RTS at the end of this routine, or the end of the preprocess routine, calls
3167; the function code
3168
3169; this also removes some less than elegant code that was used to bypass type checking
3170; for functions that returned strings
3171
3172LAB_1C27
3173	ASL				; *2 (2 bytes per function address)
3174	TAY				; copy to index
3175
3176	LDA	LAB_FTBM,Y		; get function jump vector high byte
3177	PHA				; push functions jump vector high byte
3178	LDA	LAB_FTBL,Y		; get function jump vector low byte
3179	PHA				; push functions jump vector low byte
3180
3181	LDA	LAB_FTPM,Y		; get function pre process vector high byte
3182	BEQ	LAB_1C56		; skip pre process if null vector
3183
3184	PHA				; push functions pre process vector high byte
3185	LDA	LAB_FTPL,Y		; get function pre process vector low byte
3186	PHA				; push functions pre process vector low byte
3187
3188LAB_1C56
3189	RTS				; do function, or pre process, call
3190
3191; process string expression in parenthesis
3192
3193LAB_PPFS
3194	JSR	LAB_1BF7		; process expression in parenthesis
3195	JMP	LAB_CTST		; check if source is string then do function,
3196					; else do type mismatch
3197
3198; process numeric expression in parenthesis
3199
3200LAB_PPFN
3201	JSR	LAB_1BF7		; process expression in parenthesis
3202	JMP	LAB_CTNM		; check if source is numeric then do function,
3203					; else do type mismatch
3204
3205; set numeric data type and increment BASIC execute pointer
3206
3207LAB_PPBI
3208	LSR	Dtypef		; clear data type flag, $FF=string, $00=numeric
3209	JMP	LAB_IGBY		; increment and scan memory then do function
3210
3211; process string for LEFT$, RIGHT$ or MID$
3212
3213LAB_LRMS
3214	JSR	LAB_EVEZ		; evaluate (should be string) expression
3215	JSR	LAB_1C01		; scan for ",", else do syntax error then warm start
3216	JSR	LAB_CTST		; check if source is string, else do type mismatch
3217
3218	PLA				; get function jump vector low byte
3219	TAX				; save functions jump vector low byte
3220	PLA				; get function jump vector high byte
3221	TAY				; save functions jump vector high byte
3222	LDA	des_ph		; get descriptor pointer high byte
3223	PHA				; push string pointer high byte
3224	LDA	des_pl		; get descriptor pointer low byte
3225	PHA				; push string pointer low byte
3226	TYA				; get function jump vector high byte back
3227	PHA				; save functions jump vector high byte
3228	TXA				; get function jump vector low byte back
3229	PHA				; save functions jump vector low byte
3230	JSR	LAB_GTBY		; get byte parameter
3231	TXA				; copy byte parameter to A
3232	RTS				; go do function
3233
3234; process numeric expression(s) for BIN$ or HEX$
3235
3236LAB_BHSS
3237	JSR	LAB_EVEZ		; process expression
3238	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
3239	LDA	FAC1_e		; get FAC1 exponent
3240	CMP	#$98			; compare with exponent = 2^24
3241	BCS	LAB_BHER		; branch if n>=2^24 (is too big)
3242
3243	JSR	LAB_2831		; convert FAC1 floating-to-fixed
3244	LDX	#$02			; 3 bytes to do
3245LAB_CFAC
3246	LDA	FAC1_1,X		; get byte from FAC1
3247	STA	nums_1,X		; save byte to temp
3248	DEX				; decrement index
3249	BPL	LAB_CFAC		; copy FAC1 mantissa to temp
3250
3251	JSR	LAB_GBYT		; get next BASIC byte
3252	LDX	#$00			; set default to no leading "0"s
3253	CMP	#')'			; compare with close bracket
3254	BEQ	LAB_1C54		; if ")" go do rest of function
3255
3256	JSR	LAB_SCGB		; scan for "," and get byte
3257	JSR	LAB_GBYT		; get last byte back
3258	CMP	#')'			; is next character )
3259	BNE	LAB_BHER		; if not ")" go do error
3260
3261LAB_1C54
3262	RTS				; else do function
3263
3264LAB_BHER
3265	JMP	LAB_FCER		; do function call error then warm start
3266
3267; perform EOR
3268
3269; added operator format is the same as AND or OR, precedence is the same as OR
3270
3271; this bit worked first time but it took a while to sort out the operator table
3272; pointers and offsets afterwards!
3273
3274LAB_EOR
3275	JSR	GetFirst		; get first integer expression (no sign check)
3276	EOR	XOAw_l		; EOR with expression 1 low byte
3277	TAY				; save in Y
3278	LDA	FAC1_2		; get FAC1 mantissa2
3279	EOR	XOAw_h		; EOR with expression 1 high byte
3280	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3281
3282; perform OR
3283
3284LAB_OR
3285	JSR	GetFirst		; get first integer expression (no sign check)
3286	ORA	XOAw_l		; OR with expression 1 low byte
3287	TAY				; save in Y
3288	LDA	FAC1_2		; get FAC1 mantissa2
3289	ORA	XOAw_h		; OR with expression 1 high byte
3290	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3291
3292; perform AND
3293
3294LAB_AND
3295	JSR	GetFirst		; get first integer expression (no sign check)
3296	AND	XOAw_l		; AND with expression 1 low byte
3297	TAY				; save in Y
3298	LDA	FAC1_2		; get FAC1 mantissa2
3299	AND	XOAw_h		; AND with expression 1 high byte
3300	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3301
3302; get first value for OR, AND or EOR
3303
3304GetFirst
3305	JSR	LAB_EVIR		; evaluate integer expression (no sign check)
3306	LDA	FAC1_2		; get FAC1 mantissa2
3307	STA	XOAw_h		; save it
3308	LDA	FAC1_3		; get FAC1 mantissa3
3309	STA	XOAw_l		; save it
3310	JSR	LAB_279B		; copy FAC2 to FAC1 (get 2nd value in expression)
3311	JSR	LAB_EVIR		; evaluate integer expression (no sign check)
3312	LDA	FAC1_3		; get FAC1 mantissa3
3313LAB_1C95
3314	RTS
3315
3316; perform comparisons
3317
3318; do < compare
3319
3320LAB_LTHAN
3321	JSR	LAB_CKTM		; type match check, set C for string
3322	BCS	LAB_1CAE		; branch if string
3323
3324					; do numeric < compare
3325	LDA	FAC2_s		; get FAC2 sign (b7)
3326	ORA	#$7F			; set all non sign bits
3327	AND	FAC2_1		; and FAC2 mantissa1 (AND in sign bit)
3328	STA	FAC2_1		; save FAC2 mantissa1
3329	LDA	#<FAC2_e		; set pointer low byte to FAC2
3330	LDY	#>FAC2_e		; set pointer high byte to FAC2
3331	JSR	LAB_27F8		; compare FAC1 with FAC2 (AY)
3332	TAX				; copy result
3333	JMP	LAB_1CE1		; go evaluate result
3334
3335					; do string < compare
3336LAB_1CAE
3337	LSR	Dtypef		; clear data type flag, $FF=string, $00=numeric
3338	DEC	comp_f		; clear < bit in compare function flag
3339	JSR	LAB_22B6		; pop string off descriptor stack, or from top of string
3340					; space returns with A = length, X=pointer low byte,
3341					; Y=pointer high byte
3342	STA	str_ln		; save length
3343	STX	str_pl		; save string pointer low byte
3344	STY	str_ph		; save string pointer high byte
3345	LDA	FAC2_2		; get descriptor pointer low byte
3346	LDY	FAC2_3		; get descriptor pointer high byte
3347	JSR	LAB_22BA		; pop (YA) descriptor off stack or from top of string space
3348					; returns with A = length, X=pointer low byte,
3349					; Y=pointer high byte
3350	STX	FAC2_2		; save string pointer low byte
3351	STY	FAC2_3		; save string pointer high byte
3352	TAX				; copy length
3353	SEC				; set carry for subtract
3354	SBC	str_ln		; subtract string 1 length
3355	BEQ	LAB_1CD6		; branch if str 1 length = string 2 length
3356
3357	LDA	#$01			; set str 1 length > string 2 length
3358	BCC	LAB_1CD6		; branch if so
3359
3360	LDX	str_ln		; get string 1 length
3361	LDA	#$FF			; set str 1 length < string 2 length
3362LAB_1CD6
3363	STA	FAC1_s		; save length compare
3364	LDY	#$FF			; set index
3365	INX				; adjust for loop
3366LAB_1CDB
3367	INY				; increment index
3368	DEX				; decrement count
3369	BNE	LAB_1CE6		; branch if still bytes to do
3370
3371	LDX	FAC1_s		; get length compare back
3372LAB_1CE1
3373	BMI	LAB_1CF2		; branch if str 1 < str 2
3374
3375	CLC				; flag str 1 <= str 2
3376	BCC	LAB_1CF2		; go evaluate result
3377
3378LAB_1CE6
3379	LDA	(FAC2_2),Y		; get string 2 byte
3380	CMP	(FAC1_1),Y		; compare with string 1 byte
3381	BEQ	LAB_1CDB		; loop if bytes =
3382
3383	LDX	#$FF			; set str 1 < string 2
3384	BCS	LAB_1CF2		; branch if so
3385
3386	LDX	#$01			;  set str 1 > string 2
3387LAB_1CF2
3388	INX				; x = 0, 1 or 2
3389	TXA				; copy to A
3390	ROL				; *2 (1, 2 or 4)
3391	AND	Cflag			; AND with comparison evaluation flag
3392	BEQ	LAB_1CFB		; branch if 0 (compare is false)
3393
3394	LDA	#$FF			; else set result true
3395LAB_1CFB
3396	JMP	LAB_27DB		; save A as integer byte and return
3397
3398LAB_1CFE
3399	JSR	LAB_1C01		; scan for ",", else do syntax error then warm start
3400
3401; perform DIM
3402
3403LAB_DIM
3404	TAX				; copy "DIM" flag to X
3405	JSR	LAB_1D10		; search for variable
3406	JSR	LAB_GBYT		; scan memory
3407	BNE	LAB_1CFE		; scan for "," and loop if not null
3408
3409	RTS
3410
3411; perform << (left shift)
3412
3413LAB_LSHIFT
3414	JSR	GetPair		; get integer expression and byte (no sign check)
3415	LDA	FAC1_2		; get expression high byte
3416	LDX	TempB			; get shift count
3417	BEQ	NoShift		; branch if zero
3418
3419	CPX	#$10			; compare bit count with 16d
3420	BCS	TooBig		; branch if >=
3421
3422Ls_loop
3423	ASL	FAC1_3		; shift low byte
3424	ROL				; shift high byte
3425	DEX				; decrement bit count
3426	BNE	Ls_loop		; loop if shift not complete
3427
3428	LDY	FAC1_3		; get expression low byte
3429	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3430
3431; perform >> (right shift)
3432
3433LAB_RSHIFT
3434	JSR	GetPair		; get integer expression and byte (no sign check)
3435	LDA	FAC1_2		; get expression high byte
3436	LDX	TempB			; get shift count
3437	BEQ	NoShift		; branch if zero
3438
3439	CPX	#$10			; compare bit count with 16d
3440	BCS	TooBig		; branch if >=
3441
3442Rs_loop
3443	LSR				; shift high byte
3444	ROR	FAC1_3		; shift low byte
3445	DEX				; decrement bit count
3446	BNE	Rs_loop		; loop if shift not complete
3447
3448NoShift
3449	LDY	FAC1_3		; get expression low byte
3450	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3451
3452TooBig
3453	LDA	#$00			; clear high byte
3454	TAY				; copy to low byte
3455	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
3456
3457GetPair
3458	JSR	LAB_EVBY		; evaluate byte expression, result in X
3459	STX	TempB			; save it
3460	JSR	LAB_279B		; copy FAC2 to FAC1 (get 2nd value in expression)
3461	JMP	LAB_EVIR		; evaluate integer expression (no sign check)
3462
3463; search for variable
3464
3465; return pointer to variable in Cvaral/Cvarah
3466
3467LAB_GVAR
3468	LDX	#$00			; set DIM flag = $00
3469	JSR	LAB_GBYT		; scan memory (1st character)
3470LAB_1D10
3471	STX	Defdim		; save DIM flag
3472LAB_1D12
3473	STA	Varnm1		; save 1st character
3474	AND	#$7F			; clear FN flag bit
3475	JSR	LAB_CASC		; check byte, return C=0 if<"A" or >"Z"
3476	BCS	LAB_1D1F		; branch if ok
3477
3478	JMP	LAB_SNER		; else syntax error then warm start
3479
3480					; was variable name so ..
3481LAB_1D1F
3482	LDX	#$00			; clear 2nd character temp
3483	STX	Dtypef		; clear data type flag, $FF=string, $00=numeric
3484	JSR	LAB_IGBY		; increment and scan memory (2nd character)
3485	BCC	LAB_1D2D		; branch if character = "0"-"9" (ok)
3486
3487					; 2nd character wasn't "0" to "9" so ..
3488	JSR	LAB_CASC		; check byte, return C=0 if<"A" or >"Z"
3489	BCC	LAB_1D38		; branch if <"A" or >"Z" (go check if string)
3490
3491LAB_1D2D
3492	TAX				; copy 2nd character
3493
3494					; ignore further (valid) characters in the variable name
3495LAB_1D2E
3496	JSR	LAB_IGBY		; increment and scan memory (3rd character)
3497	BCC	LAB_1D2E		; loop if character = "0"-"9" (ignore)
3498
3499	JSR	LAB_CASC		; check byte, return C=0 if<"A" or >"Z"
3500	BCS	LAB_1D2E		; loop if character = "A"-"Z" (ignore)
3501
3502					; check if string variable
3503LAB_1D38
3504	CMP	#'$'			; compare with "$"
3505	BNE	LAB_1D47		; branch if not string
3506
3507; to introduce a new variable type (% suffix for integers say) then this branch
3508; will need to go to that check and then that branch, if it fails, go to LAB_1D47
3509
3510					; type is string
3511	LDA	#$FF			; set data type = string
3512	STA	Dtypef		; set data type flag, $FF=string, $00=numeric
3513	TXA				; get 2nd character back
3514	ORA	#$80			; set top bit (indicate string var)
3515	TAX				; copy back to 2nd character temp
3516	JSR	LAB_IGBY		; increment and scan memory
3517
3518; after we have determined the variable type we need to come back here to determine
3519; if it's an array of type. this would plug in a%(b[,c[,d]])) integer arrays nicely
3520
3521
3522LAB_1D47				; gets here with character after var name in A
3523	STX	Varnm2		; save 2nd character
3524	ORA	Sufnxf		; or with subscript/FNX flag (or FN name)
3525	CMP	#'('			; compare with "("
3526	BNE	LAB_1D53		; branch if not "("
3527
3528	JMP	LAB_1E17		; go find, or make, array
3529
3530; either find or create var
3531; var name (1st two characters only!) is in Varnm1,Varnm2
3532
3533					; variable name wasn't var(... so look for plain var
3534LAB_1D53
3535	LDA	#$00			; clear A
3536	STA	Sufnxf		; clear subscript/FNX flag
3537	LDA	Svarl			; get start of vars low byte
3538	LDX	Svarh			; get start of vars high byte
3539	LDY	#$00			; clear index
3540LAB_1D5D
3541	STX	Vrschh		; save search address high byte
3542LAB_1D5F
3543	STA	Vrschl		; save search address low byte
3544	CPX	Sarryh		; compare high address with var space end
3545	BNE	LAB_1D69		; skip next compare if <>
3546
3547					; high addresses were = so compare low addresses
3548	CMP	Sarryl		; compare low address with var space end
3549	BEQ	LAB_1D8B		; if not found go make new var
3550
3551LAB_1D69
3552	LDA	Varnm1		; get 1st character of var to find
3553	CMP	(Vrschl),Y		; compare with variable name 1st character
3554	BNE	LAB_1D77		; branch if no match
3555
3556					; 1st characters match so compare 2nd characters
3557	LDA	Varnm2		; get 2nd character of var to find
3558	INY				; index to point to variable name 2nd character
3559	CMP	(Vrschl),Y		; compare with variable name 2nd character
3560	BEQ	LAB_1DD7		; branch if match (found var)
3561
3562	DEY				; else decrement index (now = $00)
3563LAB_1D77
3564	CLC				; clear carry for add
3565	LDA	Vrschl		; get search address low byte
3566	ADC	#$06			; +6 (offset to next var name)
3567	BCC	LAB_1D5F		; loop if no overflow to high byte
3568
3569	INX				; else increment high byte
3570	BNE	LAB_1D5D		; loop always (RAM doesn't extend to $FFFF !)
3571
3572; check byte, return C=0 if<"A" or >"Z" or "a" to "z"
3573
3574LAB_CASC
3575	CMP	#'a'			; compare with "a"
3576	BCS	LAB_1D83		; go check <"z"+1
3577
3578; check byte, return C=0 if<"A" or >"Z"
3579
3580LAB_1D82
3581	CMP	#'A'			; compare with "A"
3582	BCC	LAB_1D8A		; exit if less
3583
3584					; carry is set
3585	SBC	#$5B			; subtract "Z"+1
3586	SEC				; set carry
3587	SBC	#$A5			; subtract $A5 (restore byte)
3588					; carry clear if byte>$5A
3589LAB_1D8A
3590	RTS
3591
3592LAB_1D83
3593	SBC	#$7B			; subtract "z"+1
3594	SEC				; set carry
3595	SBC	#$85			; subtract $85 (restore byte)
3596					; carry clear if byte>$7A
3597	RTS
3598
3599					; reached end of variable mem without match
3600					; .. so create new variable
3601LAB_1D8B
3602	PLA				; pop return address low byte
3603	PHA				; push return address low byte
3604LAB_1C18p2	= LAB_1C18+2
3605	CMP	#<LAB_1C18p2	; compare with expected calling routine return low byte
3606	BNE	LAB_1D98		; if not get (var) go create new var
3607
3608; This will only drop through if the call was from LAB_1C18 and is only called
3609; from there if it is searching for a variable from the RHS of a LET a=b statement
3610; it prevents the creation of variables not assigned a value.
3611
3612; value returned by this is either numeric zero (exponent byte is $00) or null string
3613; (descriptor length byte is $00). in fact a pointer to any $00 byte would have done.
3614
3615; doing this saves 6 bytes of variable memory and 168 machine cycles of time
3616
3617; this is where you would put the undefined variable error call e.g.
3618
3619;					; variable doesn't exist so flag error
3620;	LDX	#$24			; error code $24 ("undefined variable" error)
3621;	JMP	LAB_XERR		; do error #X then warm start
3622
3623; the above code has been tested and works a treat! (it replaces the three code lines
3624; below)
3625
3626					; else return dummy null value
3627	LDA	#<LAB_1D96		; low byte point to $00,$00
3628					; (uses part of misc constants table)
3629	LDY	#>LAB_1D96		; high byte point to $00,$00
3630	RTS
3631
3632					; create new numeric variable
3633LAB_1D98
3634	LDA	Sarryl		; get var mem end low byte
3635	LDY	Sarryh		; get var mem end high byte
3636	STA	Ostrtl		; save old block start low byte
3637	STY	Ostrth		; save old block start high byte
3638	LDA	Earryl		; get array mem end low byte
3639	LDY	Earryh		; get array mem end high byte
3640	STA	Obendl		; save old block end low byte
3641	STY	Obendh		; save old block end high byte
3642	CLC				; clear carry for add
3643	ADC	#$06			; +6 (space for one var)
3644	BCC	LAB_1DAE		; branch if no overflow to high byte
3645
3646	INY				; else increment high byte
3647LAB_1DAE
3648	STA	Nbendl		; set new block end low byte
3649	STY	Nbendh		; set new block end high byte
3650	JSR	LAB_11CF		; open up space in memory
3651	LDA	Nbendl		; get new start low byte
3652	LDY	Nbendh		; get new start high byte (-$100)
3653	INY				; correct high byte
3654	STA	Sarryl		; save new var mem end low byte
3655	STY	Sarryh		; save new var mem end high byte
3656	LDY	#$00			; clear index
3657	LDA	Varnm1		; get var name 1st character
3658	STA	(Vrschl),Y		; save var name 1st character
3659	INY				; increment index
3660	LDA	Varnm2		; get var name 2nd character
3661	STA	(Vrschl),Y		; save var name 2nd character
3662	LDA	#$00			; clear A
3663	INY				; increment index
3664	STA	(Vrschl),Y		; initialise var byte
3665	INY				; increment index
3666	STA	(Vrschl),Y		; initialise var byte
3667	INY				; increment index
3668	STA	(Vrschl),Y		; initialise var byte
3669	INY				; increment index
3670	STA	(Vrschl),Y		; initialise var byte
3671
3672					; found a match for var ((Vrschl) = ptr)
3673LAB_1DD7
3674	LDA	Vrschl		; get var address low byte
3675	CLC				; clear carry for add
3676	ADC	#$02			; +2 (offset past var name bytes)
3677	LDY	Vrschh		; get var address high byte
3678	BCC	LAB_1DE1		; branch if no overflow from add
3679
3680	INY				; else increment high byte
3681LAB_1DE1
3682	STA	Cvaral		; save current var address low byte
3683	STY	Cvarah		; save current var address high byte
3684	RTS
3685
3686; set-up array pointer (Adatal/h) to first element in array
3687; set Adatal,Adatah to Astrtl,Astrth+2*Dimcnt+#$05
3688
3689LAB_1DE6
3690	LDA	Dimcnt		; get # of dimensions (1, 2 or 3)
3691	ASL				; *2 (also clears the carry !)
3692	ADC	#$05			; +5 (result is 7, 9 or 11 here)
3693	ADC	Astrtl		; add array start pointer low byte
3694	LDY	Astrth		; get array pointer high byte
3695	BCC	LAB_1DF2		; branch if no overflow
3696
3697	INY				; else increment high byte
3698LAB_1DF2
3699	STA	Adatal		; save array data pointer low byte
3700	STY	Adatah		; save array data pointer high byte
3701	RTS
3702
3703; evaluate integer expression
3704
3705LAB_EVIN
3706	JSR	LAB_IGBY		; increment and scan memory
3707	JSR	LAB_EVNM		; evaluate expression and check is numeric,
3708					; else do type mismatch
3709
3710; evaluate integer expression (no check)
3711
3712LAB_EVPI
3713	LDA	FAC1_s		; get FAC1 sign (b7)
3714	BMI	LAB_1E12		; do function call error if -ve
3715
3716; evaluate integer expression (no sign check)
3717
3718LAB_EVIR
3719	LDA	FAC1_e		; get FAC1 exponent
3720	CMP	#$90			; compare with exponent = 2^16 (n>2^15)
3721	BCC	LAB_1E14		; branch if n<2^16 (is ok)
3722
3723	LDA	#<LAB_1DF7		; set pointer low byte to -32768
3724	LDY	#>LAB_1DF7		; set pointer high byte to -32768
3725	JSR	LAB_27F8		; compare FAC1 with (AY)
3726LAB_1E12
3727	BNE	LAB_FCER		; if <> do function call error then warm start
3728
3729LAB_1E14
3730	JMP	LAB_2831		; convert FAC1 floating-to-fixed and return
3731
3732; find or make array
3733
3734LAB_1E17
3735	LDA	Defdim		; get DIM flag
3736	PHA				; push it
3737	LDA	Dtypef		; get data type flag, $FF=string, $00=numeric
3738	PHA				; push it
3739	LDY	#$00			; clear dimensions count
3740
3741; now get the array dimension(s) and stack it (them) before the data type and DIM flag
3742
3743LAB_1E1F
3744	TYA				; copy dimensions count
3745	PHA				; save it
3746	LDA	Varnm2		; get array name 2nd byte
3747	PHA				; save it
3748	LDA	Varnm1		; get array name 1st byte
3749	PHA				; save it
3750	JSR	LAB_EVIN		; evaluate integer expression
3751	PLA				; pull array name 1st byte
3752	STA	Varnm1		; restore array name 1st byte
3753	PLA				; pull array name 2nd byte
3754	STA	Varnm2		; restore array name 2nd byte
3755	PLA				; pull dimensions count
3756	TAY				; restore it
3757	TSX				; copy stack pointer
3758	LDA	LAB_STAK+2,X	; get DIM flag
3759	PHA				; push it
3760	LDA	LAB_STAK+1,X	; get data type flag
3761	PHA				; push it
3762	LDA	FAC1_2		; get this dimension size high byte
3763	STA	LAB_STAK+2,X	; stack before flag bytes
3764	LDA	FAC1_3		; get this dimension size low byte
3765	STA	LAB_STAK+1,X	; stack before flag bytes
3766	INY				; increment dimensions count
3767	JSR	LAB_GBYT		; scan memory
3768	CMP	#','			; compare with ","
3769	BEQ	LAB_1E1F		; if found go do next dimension
3770
3771	STY	Dimcnt		; store dimensions count
3772	JSR	LAB_1BFB		; scan for ")" , else do syntax error then warm start
3773	PLA				; pull data type flag
3774	STA	Dtypef		; restore data type flag, $FF=string, $00=numeric
3775	PLA				; pull DIM flag
3776	STA	Defdim		; restore DIM flag
3777	LDX	Sarryl		; get array mem start low byte
3778	LDA	Sarryh		; get array mem start high byte
3779
3780; now check to see if we are at the end of array memory (we would be if there were
3781; no arrays).
3782
3783LAB_1E5C
3784	STX	Astrtl		; save as array start pointer low byte
3785	STA	Astrth		; save as array start pointer high byte
3786	CMP	Earryh		; compare with array mem end high byte
3787	BNE	LAB_1E68		; branch if not reached array mem end
3788
3789	CPX	Earryl		; else compare with array mem end low byte
3790	BEQ	LAB_1EA1		; go build array if not found
3791
3792					; search for array
3793LAB_1E68
3794	LDY	#$00			; clear index
3795	LDA	(Astrtl),Y		; get array name first byte
3796	INY				; increment index to second name byte
3797	CMP	Varnm1		; compare with this array name first byte
3798	BNE	LAB_1E77		; branch if no match
3799
3800	LDA	Varnm2		; else get this array name second byte
3801	CMP	(Astrtl),Y		; compare with array name second byte
3802	BEQ	LAB_1E8D		; array found so branch
3803
3804					; no match
3805LAB_1E77
3806	INY				; increment index
3807	LDA	(Astrtl),Y		; get array size low byte
3808	CLC				; clear carry for add
3809	ADC	Astrtl		; add array start pointer low byte
3810	TAX				; copy low byte to X
3811	INY				; increment index
3812	LDA	(Astrtl),Y		; get array size high byte
3813	ADC	Astrth		; add array mem pointer high byte
3814	BCC	LAB_1E5C		; if no overflow go check next array
3815
3816; do array bounds error
3817
3818LAB_1E85
3819	LDX	#$10			; error code $10 ("Array bounds" error)
3820	.byte	$2C			; makes next bit BIT LAB_08A2
3821
3822; do function call error
3823
3824LAB_FCER
3825	LDX	#$08			; error code $08 ("Function call" error)
3826LAB_1E8A
3827	JMP	LAB_XERR		; do error #X, then warm start
3828
3829					; found array, are we trying to dimension it?
3830LAB_1E8D
3831	LDX	#$12			; set error $12 ("Double dimension" error)
3832	LDA	Defdim		; get DIM flag
3833	BNE	LAB_1E8A		; if we are trying to dimension it do error #X, then warm
3834					; start
3835
3836; found the array and we're not dimensioning it so we must find an element in it
3837
3838	JSR	LAB_1DE6		; set-up array pointer (Adatal/h) to first element in array
3839					; (Astrtl,Astrth points to start of array)
3840	LDA	Dimcnt		; get dimensions count
3841	LDY	#$04			; set index to array's # of dimensions
3842	CMP	(Astrtl),Y		; compare with no of dimensions
3843	BNE	LAB_1E85		; if wrong do array bounds error, could do "Wrong
3844					; dimensions" error here .. if we want a different
3845					; error message
3846
3847	JMP	LAB_1F28		; found array so go get element
3848					; (could jump to LAB_1F28 as all LAB_1F24 does is take
3849					; Dimcnt and save it at (Astrtl),Y which is already the
3850					; same or we would have taken the BNE)
3851
3852					; array not found, so build it
3853LAB_1EA1
3854	JSR	LAB_1DE6		; set-up array pointer (Adatal/h) to first element in array
3855					; (Astrtl,Astrth points to start of array)
3856	JSR	LAB_121F		; check available memory, "Out of memory" error if no room
3857					; addr to check is in AY (low/high)
3858	LDY	#$00			; clear Y (don't need to clear A)
3859	STY	Aspth			; clear array data size high byte
3860	LDA	Varnm1		; get variable name 1st byte
3861	STA	(Astrtl),Y		; save array name 1st byte
3862	INY				; increment index
3863	LDA	Varnm2		; get variable name 2nd byte
3864	STA	(Astrtl),Y		; save array name 2nd byte
3865	LDA	Dimcnt		; get dimensions count
3866	LDY	#$04			; index to dimension count
3867	STY	Asptl			; set array data size low byte (four bytes per element)
3868	STA	(Astrtl),Y		; set array's dimensions count
3869
3870					; now calculate the size of the data space for the array
3871	CLC				; clear carry for add (clear on subsequent loops)
3872LAB_1EC0
3873	LDX	#$0B			; set default dimension value low byte
3874	LDA	#$00			; set default dimension value high byte
3875	BIT	Defdim		; test default DIM flag
3876	BVC	LAB_1ED0		; branch if b6 of Defdim is clear
3877
3878	PLA				; else pull dimension value low byte
3879	ADC	#$01			; +1 (allow for zeroeth element)
3880	TAX				; copy low byte to X
3881	PLA				; pull dimension value high byte
3882	ADC	#$00			; add carry from low byte
3883
3884LAB_1ED0
3885	INY				; index to dimension value high byte
3886	STA	(Astrtl),Y		; save dimension value high byte
3887	INY				; index to dimension value high byte
3888	TXA				; get dimension value low byte
3889	STA	(Astrtl),Y		; save dimension value low byte
3890	JSR	LAB_1F7C		; does XY = (Astrtl),Y * (Asptl)
3891	STX	Asptl			; save array data size low byte
3892	STA	Aspth			; save array data size high byte
3893	LDY	ut1_pl		; restore index (saved by subroutine)
3894	DEC	Dimcnt		; decrement dimensions count
3895	BNE	LAB_1EC0		; loop while not = 0
3896
3897	ADC	Adatah		; add size high byte to first element high byte
3898					; (carry is always clear here)
3899	BCS	LAB_1F45		; if overflow go do "Out of memory" error
3900
3901	STA	Adatah		; save end of array high byte
3902	TAY				; copy end high byte to Y
3903	TXA				; get array size low byte
3904	ADC	Adatal		; add array start low byte
3905	BCC	LAB_1EF3		; branch if no carry
3906
3907	INY				; else increment end of array high byte
3908	BEQ	LAB_1F45		; if overflow go do "Out of memory" error
3909
3910					; set-up mostly complete, now zero the array
3911LAB_1EF3
3912	JSR	LAB_121F		; check available memory, "Out of memory" error if no room
3913					; addr to check is in AY (low/high)
3914	STA	Earryl		; save array mem end low byte
3915	STY	Earryh		; save array mem end high byte
3916	LDA	#$00			; clear byte for array clear
3917	INC	Aspth			; increment array size high byte (now block count)
3918	LDY	Asptl			; get array size low byte (now index to block)
3919	BEQ	LAB_1F07		; branch if low byte = $00
3920
3921LAB_1F02
3922	DEY				; decrement index (do 0 to n-1)
3923	STA	(Adatal),Y		; zero byte
3924	BNE	LAB_1F02		; loop until this block done
3925
3926LAB_1F07
3927	DEC	Adatah		; decrement array pointer high byte
3928	DEC	Aspth			; decrement block count high byte
3929	BNE	LAB_1F02		; loop until all blocks done
3930
3931	INC	Adatah		; correct for last loop
3932	SEC				; set carry for subtract
3933	LDY	#$02			; index to array size low byte
3934	LDA	Earryl		; get array mem end low byte
3935	SBC	Astrtl		; subtract array start low byte
3936	STA	(Astrtl),Y		; save array size low byte
3937	INY				; index to array size high byte
3938	LDA	Earryh		; get array mem end high byte
3939	SBC	Astrth		; subtract array start high byte
3940	STA	(Astrtl),Y		; save array size high byte
3941	LDA	Defdim		; get default DIM flag
3942	BNE	LAB_1F7B		; exit (RET) if this was a DIM command
3943
3944					; else, find element
3945	INY				; index to # of dimensions
3946
3947LAB_1F24
3948	LDA	(Astrtl),Y		; get array's dimension count
3949	STA	Dimcnt		; save it
3950
3951; we have found, or built, the array. now we need to find the element
3952
3953LAB_1F28
3954	LDA	#$00			; clear byte
3955	STA	Asptl			; clear array data pointer low byte
3956LAB_1F2C
3957	STA	Aspth			; save array data pointer high byte
3958	INY				; increment index (point to array bound high byte)
3959	PLA				; pull array index low byte
3960	TAX				; copy to X
3961	STA	FAC1_2		; save index low byte to FAC1 mantissa2
3962	PLA				; pull array index high byte
3963	STA	FAC1_3		; save index high byte to FAC1 mantissa3
3964	CMP	(Astrtl),Y		; compare with array bound high byte
3965	BCC	LAB_1F48		; branch if within bounds
3966
3967	BNE	LAB_1F42		; if outside bounds do array bounds error
3968
3969					; else high byte was = so test low bytes
3970	INY				; index to array bound low byte
3971	TXA				; get array index low byte
3972	CMP	(Astrtl),Y		; compare with array bound low byte
3973	BCC	LAB_1F49		; branch if within bounds
3974
3975LAB_1F42
3976	JMP	LAB_1E85		; else do array bounds error
3977
3978LAB_1F45
3979	JMP	LAB_OMER		; do "Out of memory" error then warm start
3980
3981LAB_1F48
3982	INY				; index to array bound low byte
3983LAB_1F49
3984	LDA	Aspth			; get array data pointer high byte
3985	ORA	Asptl			; OR with array data pointer low byte
3986	BEQ	LAB_1F5A		; branch if array data pointer = null (skip multiply)
3987
3988	JSR	LAB_1F7C		; does XY = (Astrtl),Y * (Asptl)
3989	TXA				; get result low byte
3990	ADC	FAC1_2		; add index low byte from FAC1 mantissa2
3991	TAX				; save result low byte
3992	TYA				; get result high byte
3993	LDY	ut1_pl		; restore index
3994LAB_1F5A
3995	ADC	FAC1_3		; add index high byte from FAC1 mantissa3
3996	STX	Asptl			; save array data pointer low byte
3997	DEC	Dimcnt		; decrement dimensions count
3998	BNE	LAB_1F2C		; loop if dimensions still to do
3999
4000	ASL	Asptl			; array data pointer low byte * 2
4001	ROL				; array data pointer high byte * 2
4002	ASL	Asptl			; array data pointer low byte * 4
4003	ROL				; array data pointer high byte * 4
4004	TAY				; copy high byte
4005	LDA	Asptl			; get low byte
4006	ADC	Adatal		; add array data start pointer low byte
4007	STA	Cvaral		; save as current var address low byte
4008	TYA				; get high byte back
4009	ADC	Adatah		; add array data start pointer high byte
4010	STA	Cvarah		; save as current var address high byte
4011	TAY				; copy high byte to Y
4012	LDA	Cvaral		; get current var address low byte
4013LAB_1F7B
4014	RTS
4015
4016; does XY = (Astrtl),Y * (Asptl)
4017
4018LAB_1F7C
4019	STY	ut1_pl		; save index
4020	LDA	(Astrtl),Y		; get dimension size low byte
4021	STA	dims_l		; save dimension size low byte
4022	DEY				; decrement index
4023	LDA	(Astrtl),Y		; get dimension size high byte
4024	STA	dims_h		; save dimension size high byte
4025
4026	LDA	#$10			; count = $10 (16 bit multiply)
4027	STA	numbit		; save bit count
4028	LDX	#$00			; clear result low byte
4029	LDY	#$00			; clear result high byte
4030LAB_1F8F
4031	TXA				; get result low byte
4032	ASL				; *2
4033	TAX				; save result low byte
4034	TYA				; get result high byte
4035	ROL				; *2
4036	TAY				; save result high byte
4037	BCS	LAB_1F45		; if overflow go do "Out of memory" error
4038
4039	ASL	Asptl			; shift multiplier low byte
4040	ROL	Aspth			; shift multiplier high byte
4041	BCC	LAB_1FA8		; skip add if no carry
4042
4043	CLC				; else clear carry for add
4044	TXA				; get result low byte
4045	ADC	dims_l		; add dimension size low byte
4046	TAX				; save result low byte
4047	TYA				; get result high byte
4048	ADC	dims_h		; add dimension size high byte
4049	TAY				; save result high byte
4050	BCS	LAB_1F45		; if overflow go do "Out of memory" error
4051
4052LAB_1FA8
4053	DEC	numbit		; decrement bit count
4054	BNE	LAB_1F8F		; loop until all done
4055
4056	RTS
4057
4058; perform FRE()
4059
4060LAB_FRE
4061	LDA	Dtypef		; get data type flag, $FF=string, $00=numeric
4062	BPL	LAB_1FB4		; branch if numeric
4063
4064	JSR	LAB_22B6		; pop string off descriptor stack, or from top of string
4065					; space returns with A = length, X=$71=pointer low byte,
4066					; Y=$72=pointer high byte
4067
4068					; FRE(n) was numeric so do this
4069LAB_1FB4
4070	JSR	LAB_GARB		; go do garbage collection
4071	SEC				; set carry for subtract
4072	LDA	Sstorl		; get bottom of string space low byte
4073	SBC	Earryl		; subtract array mem end low byte
4074	TAY				; copy result to Y
4075	LDA	Sstorh		; get bottom of string space high byte
4076	SBC	Earryh		; subtract array mem end high byte
4077
4078; save and convert integer AY to FAC1
4079
4080LAB_AYFC
4081	LSR	Dtypef		; clear data type flag, $FF=string, $00=numeric
4082	STA	FAC1_1		; save FAC1 mantissa1
4083	STY	FAC1_2		; save FAC1 mantissa2
4084	LDX	#$90			; set exponent=2^16 (integer)
4085	JMP	LAB_27E3		; set exp=X, clear FAC1_3, normalise and return
4086
4087; perform POS()
4088
4089LAB_POS
4090	LDY	TPos			; get terminal position
4091
4092; convert Y to byte in FAC1
4093
4094LAB_1FD0
4095	LDA	#$00			; clear high byte
4096	BEQ	LAB_AYFC		; always save and convert integer AY to FAC1 and return
4097
4098; check not Direct (used by DEF and INPUT)
4099
4100LAB_CKRN
4101	LDX	Clineh		; get current line high byte
4102	INX				; increment it
4103	BNE	LAB_1F7B		; return if can continue not direct mode
4104
4105					; else do illegal direct error
4106LAB_1FD9
4107	LDX	#$16			; error code $16 ("Illegal direct" error)
4108LAB_1FDB
4109	JMP	LAB_XERR		; go do error #X, then warm start
4110
4111; perform DEF
4112
4113LAB_DEF
4114	JSR	LAB_200B		; check FNx syntax
4115	STA	func_l		; save function pointer low byte
4116	STY	func_h		; save function pointer high byte
4117	JSR	LAB_CKRN		; check not Direct (back here if ok)
4118	JSR	LAB_1BFE		; scan for "(" , else do syntax error then warm start
4119	LDA	#$80			; set flag for FNx
4120	STA	Sufnxf		; save subscript/FNx flag
4121	JSR	LAB_GVAR		; get (var) address
4122	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
4123	JSR	LAB_1BFB		; scan for ")" , else do syntax error then warm start
4124	LDA	#TK_EQUAL		; get = token
4125	JSR	LAB_SCCA		; scan for CHR$(A), else do syntax error then warm start
4126	LDA	Cvarah		; get current var address high byte
4127	PHA				; push it
4128	LDA	Cvaral		; get current var address low byte
4129	PHA				; push it
4130	LDA	Bpntrh		; get BASIC execute pointer high byte
4131	PHA				; push it
4132	LDA	Bpntrl		; get BASIC execute pointer low byte
4133	PHA				; push it
4134	JSR	LAB_DATA		; go perform DATA
4135	JMP	LAB_207A		; put execute pointer and variable pointer into function
4136					; and return
4137
4138; check FNx syntax
4139
4140LAB_200B
4141	LDA	#TK_FN		; get FN" token
4142	JSR	LAB_SCCA		; scan for CHR$(A) , else do syntax error then warm start
4143					; return character after A
4144	ORA	#$80			; set FN flag bit
4145	STA	Sufnxf		; save FN flag so array variable test fails
4146	JSR	LAB_1D12		; search for FN variable
4147	JMP	LAB_CTNM		; check if source is numeric and return, else do type
4148					; mismatch
4149
4150					; Evaluate FNx
4151LAB_201E
4152	JSR	LAB_200B		; check FNx syntax
4153	PHA				; push function pointer low byte
4154	TYA				; copy function pointer high byte
4155	PHA				; push function pointer high byte
4156	JSR	LAB_1BFE		; scan for "(", else do syntax error then warm start
4157	JSR	LAB_EVEX		; evaluate expression
4158	JSR	LAB_1BFB		; scan for ")", else do syntax error then warm start
4159	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
4160	PLA				; pop function pointer high byte
4161	STA	func_h		; restore it
4162	PLA				; pop function pointer low byte
4163	STA	func_l		; restore it
4164	LDX	#$20			; error code $20 ("Undefined function" error)
4165	LDY	#$03			; index to variable pointer high byte
4166	LDA	(func_l),Y		; get variable pointer high byte
4167	BEQ	LAB_1FDB		; if zero go do undefined function error
4168
4169	STA	Cvarah		; save variable address high byte
4170	DEY				; index to variable address low byte
4171	LDA	(func_l),Y		; get variable address low byte
4172	STA	Cvaral		; save variable address low byte
4173	TAX				; copy address low byte
4174
4175					; now stack the function variable value before use
4176	INY				; index to mantissa_3
4177LAB_2043
4178	LDA	(Cvaral),Y		; get byte from variable
4179	PHA				; stack it
4180	DEY				; decrement index
4181	BPL	LAB_2043		; loop until variable stacked
4182
4183	LDY	Cvarah		; get variable address high byte
4184	JSR	LAB_2778		; pack FAC1 (function expression value) into (XY)
4185					; (function variable), return Y=0, always
4186	LDA	Bpntrh		; get BASIC execute pointer high byte
4187	PHA				; push it
4188	LDA	Bpntrl		; get BASIC execute pointer low byte
4189	PHA				; push it
4190	LDA	(func_l),Y		; get function execute pointer low byte
4191	STA	Bpntrl		; save as BASIC execute pointer low byte
4192	INY				; index to high byte
4193	LDA	(func_l),Y		; get function execute pointer high byte
4194	STA	Bpntrh		; save as BASIC execute pointer high byte
4195	LDA	Cvarah		; get variable address high byte
4196	PHA				; push it
4197	LDA	Cvaral		; get variable address low byte
4198	PHA				; push it
4199	JSR	LAB_EVNM		; evaluate expression and check is numeric,
4200					; else do type mismatch
4201	PLA				; pull variable address low byte
4202	STA	func_l		; save variable address low byte
4203	PLA				; pull variable address high byte
4204	STA	func_h		; save variable address high byte
4205	JSR	LAB_GBYT		; scan memory
4206	BEQ	LAB_2074		; branch if null (should be [EOL] marker)
4207
4208	JMP	LAB_SNER		; else syntax error then warm start
4209
4210; restore Bpntrl,Bpntrh and function variable from stack
4211
4212LAB_2074
4213	PLA				; pull BASIC execute pointer low byte
4214	STA	Bpntrl		; restore BASIC execute pointer low byte
4215	PLA				; pull BASIC execute pointer high byte
4216	STA	Bpntrh		; restore BASIC execute pointer high byte
4217
4218; put execute pointer and variable pointer into function
4219
4220LAB_207A
4221	LDY	#$00			; clear index
4222	PLA				; pull BASIC execute pointer low byte
4223	STA	(func_l),Y		; save to function
4224	INY				; increment index
4225	PLA				; pull BASIC execute pointer high byte
4226	STA	(func_l),Y		; save to function
4227	INY				; increment index
4228	PLA				; pull current var address low byte
4229	STA	(func_l),Y		; save to function
4230	INY				; increment index
4231	PLA				; pull current var address high byte
4232	STA	(func_l),Y		; save to function
4233	RTS
4234
4235; perform STR$()
4236
4237LAB_STRS
4238	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
4239	JSR	LAB_296E		; convert FAC1 to string
4240	LDA	#<Decssp1		; set result string low pointer
4241	LDY	#>Decssp1		; set result string high pointer
4242	BEQ	LAB_20AE		; print null terminated string to Sutill/Sutilh
4243
4244; Do string vector
4245; copy des_pl/h to des_2l/h and make string space A bytes long
4246
4247LAB_209C
4248	LDX	des_pl		; get descriptor pointer low byte
4249	LDY	des_ph		; get descriptor pointer high byte
4250	STX	des_2l		; save descriptor pointer low byte
4251	STY	des_2h		; save descriptor pointer high byte
4252
4253; make string space A bytes long
4254; A=length, X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
4255
4256LAB_MSSP
4257	JSR	LAB_2115		; make space in string memory for string A long
4258					; return X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
4259	STX	str_pl		; save string pointer low byte
4260	STY	str_ph		; save string pointer high byte
4261	STA	str_ln		; save length
4262	RTS
4263
4264; Scan, set up string
4265; print " terminated string to Sutill/Sutilh
4266
4267LAB_20AE
4268	LDX	#$22			; set terminator to "
4269	STX	Srchc			; set search character (terminator 1)
4270	STX	Asrch			; set terminator 2
4271
4272; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh
4273; source is AY
4274
4275LAB_20B4
4276	STA	ssptr_l		; store string start low byte
4277	STY	ssptr_h		; store string start high byte
4278	STA	str_pl		; save string pointer low byte
4279	STY	str_ph		; save string pointer high byte
4280	LDY	#$FF			; set length to -1
4281LAB_20BE
4282	INY				; increment length
4283	LDA	(ssptr_l),Y		; get byte from string
4284	BEQ	LAB_20CF		; exit loop if null byte [EOS]
4285
4286	CMP	Srchc			; compare with search character (terminator 1)
4287	BEQ	LAB_20CB		; branch if terminator
4288
4289	CMP	Asrch			; compare with terminator 2
4290	BNE	LAB_20BE		; loop if not terminator 2
4291
4292LAB_20CB
4293	CMP	#$22			; compare with "
4294	BEQ	LAB_20D0		; branch if " (carry set if = !)
4295
4296LAB_20CF
4297	CLC				; clear carry for add (only if [EOL] terminated string)
4298LAB_20D0
4299	STY	str_ln		; save length in FAC1 exponent
4300	TYA				; copy length to A
4301	ADC	ssptr_l		; add string start low byte
4302	STA	Sendl			; save string end low byte
4303	LDX	ssptr_h		; get string start high byte
4304	BCC	LAB_20DC		; branch if no low byte overflow
4305
4306	INX				; else increment high byte
4307LAB_20DC
4308	STX	Sendh			; save string end high byte
4309	LDA	ssptr_h		; get string start high byte
4310	CMP	#>Ram_base		; compare with start of program memory
4311	BCS	LAB_RTST		; branch if not in utility area
4312
4313					; string in utility area, move to string memory
4314	TYA				; copy length to A
4315	JSR	LAB_209C		; copy des_pl/h to des_2l/h and make string space A bytes
4316					; long
4317	LDX	ssptr_l		; get string start low byte
4318	LDY	ssptr_h		; get string start high byte
4319	JSR	LAB_2298		; store string A bytes long from XY to (Sutill)
4320
4321; check for space on descriptor stack then ..
4322; put string address and length on descriptor stack and update stack pointers
4323
4324LAB_RTST
4325	LDX	next_s		; get string stack pointer
4326	CPX	#des_sk+$09		; compare with max+1
4327	BNE	LAB_20F8		; branch if space on string stack
4328
4329					; else do string too complex error
4330	LDX	#$1C			; error code $1C ("String too complex" error)
4331LAB_20F5
4332	JMP	LAB_XERR		; do error #X, then warm start
4333
4334; put string address and length on descriptor stack and update stack pointers
4335
4336LAB_20F8
4337	LDA	str_ln		; get string length
4338	STA	PLUS_0,X		; put on string stack
4339	LDA	str_pl		; get string pointer low byte
4340	STA	PLUS_1,X		; put on string stack
4341	LDA	str_ph		; get string pointer high byte
4342	STA	PLUS_2,X		; put on string stack
4343	LDY	#$00			; clear Y
4344	STX	des_pl		; save string descriptor pointer low byte
4345	STY	des_ph		; save string descriptor pointer high byte (always $00)
4346	DEY				; Y = $FF
4347	STY	Dtypef		; save data type flag, $FF=string
4348	STX	last_sl		; save old stack pointer (current top item)
4349	INX				; update stack pointer
4350	INX				; update stack pointer
4351	INX				; update stack pointer
4352	STX	next_s		; save new top item value
4353	RTS
4354
4355; Build descriptor
4356; make space in string memory for string A long
4357; return X=Sutill=ptr low byte, Y=Sutill=ptr high byte
4358
4359LAB_2115
4360	LSR	Gclctd		; clear garbage collected flag (b7)
4361
4362					; make space for string A long
4363LAB_2117
4364	PHA				; save string length
4365	EOR	#$FF			; complement it
4366	SEC				; set carry for subtract (twos comp add)
4367	ADC	Sstorl		; add bottom of string space low byte (subtract length)
4368	LDY	Sstorh		; get bottom of string space high byte
4369	BCS	LAB_2122		; skip decrement if no underflow
4370
4371	DEY				; decrement bottom of string space high byte
4372LAB_2122
4373	CPY	Earryh		; compare with array mem end high byte
4374	BCC	LAB_2137		; do out of memory error if less
4375
4376	BNE	LAB_212C		; if not = skip next test
4377
4378	CMP	Earryl		; compare with array mem end low byte
4379	BCC	LAB_2137		; do out of memory error if less
4380
4381LAB_212C
4382	STA	Sstorl		; save bottom of string space low byte
4383	STY	Sstorh		; save bottom of string space high byte
4384	STA	Sutill		; save string utility ptr low byte
4385	STY	Sutilh		; save string utility ptr high byte
4386	TAX				; copy low byte to X
4387	PLA				; get string length back
4388	RTS
4389
4390LAB_2137
4391	LDX	#$0C			; error code $0C ("Out of memory" error)
4392	LDA	Gclctd		; get garbage collected flag
4393	BMI	LAB_20F5		; if set then do error code X
4394
4395	JSR	LAB_GARB		; else go do garbage collection
4396	LDA	#$80			; flag for garbage collected
4397	STA	Gclctd		; set garbage collected flag
4398	PLA				; pull length
4399	BNE	LAB_2117		; go try again (loop always, length should never be = $00)
4400
4401; garbage collection routine
4402
4403LAB_GARB
4404	LDX	Ememl			; get end of mem low byte
4405	LDA	Ememh			; get end of mem high byte
4406
4407; re-run routine from last ending
4408
4409LAB_214B
4410	STX	Sstorl		; set string storage low byte
4411	STA	Sstorh		; set string storage high byte
4412	LDY	#$00			; clear index
4413	STY	garb_h		; clear working pointer high byte (flag no strings to move)
4414	LDA	Earryl		; get array mem end low byte
4415	LDX	Earryh		; get array mem end high byte
4416	STA	Histrl		; save as highest string low byte
4417	STX	Histrh		; save as highest string high byte
4418	LDA	#des_sk		; set descriptor stack pointer
4419	STA	ut1_pl		; save descriptor stack pointer low byte
4420	STY	ut1_ph		; save descriptor stack pointer high byte ($00)
4421LAB_2161
4422	CMP	next_s		; compare with descriptor stack pointer
4423	BEQ	LAB_216A		; branch if =
4424
4425	JSR	LAB_21D7		; go garbage collect descriptor stack
4426	BEQ	LAB_2161		; loop always
4427
4428					; done stacked strings, now do string vars
4429LAB_216A
4430	ASL	g_step		; set step size = $06
4431	LDA	Svarl			; get start of vars low byte
4432	LDX	Svarh			; get start of vars high byte
4433	STA	ut1_pl		; save as pointer low byte
4434	STX	ut1_ph		; save as pointer high byte
4435LAB_2176
4436	CPX	Sarryh		; compare start of arrays high byte
4437	BNE	LAB_217E		; branch if no high byte match
4438
4439	CMP	Sarryl		; else compare start of arrays low byte
4440	BEQ	LAB_2183		; branch if = var mem end
4441
4442LAB_217E
4443	JSR	LAB_21D1		; go garbage collect strings
4444	BEQ	LAB_2176		; loop always
4445
4446					; done string vars, now do string arrays
4447LAB_2183
4448	STA	Nbendl		; save start of arrays low byte as working pointer
4449	STX	Nbendh		; save start of arrays high byte as working pointer
4450	LDA	#$04			; set step size
4451	STA	g_step		; save step size
4452LAB_218B
4453	LDA	Nbendl		; get pointer low byte
4454	LDX	Nbendh		; get pointer high byte
4455LAB_218F
4456	CPX	Earryh		; compare with array mem end high byte
4457	BNE	LAB_219A		; branch if not at end
4458
4459	CMP	Earryl		; else compare with array mem end low byte
4460	BEQ	LAB_2216		; tidy up and exit if at end
4461
4462LAB_219A
4463	STA	ut1_pl		; save pointer low byte
4464	STX	ut1_ph		; save pointer high byte
4465	LDY	#$02			; set index
4466	LDA	(ut1_pl),Y		; get array size low byte
4467	ADC	Nbendl		; add start of this array low byte
4468	STA	Nbendl		; save start of next array low byte
4469	INY				; increment index
4470	LDA	(ut1_pl),Y		; get array size high byte
4471	ADC	Nbendh		; add start of this array high byte
4472	STA	Nbendh		; save start of next array high byte
4473	LDY	#$01			; set index
4474	LDA	(ut1_pl),Y		; get name second byte
4475	BPL	LAB_218B		; skip if not string array
4476
4477; was string array so ..
4478
4479	LDY	#$04			; set index
4480	LDA	(ut1_pl),Y		; get # of dimensions
4481	ASL				; *2
4482	ADC	#$05			; +5 (array header size)
4483	JSR	LAB_2208		; go set up for first element
4484LAB_21C4
4485	CPX	Nbendh		; compare with start of next array high byte
4486	BNE	LAB_21CC		; branch if <> (go do this array)
4487
4488	CMP	Nbendl		; else compare element pointer low byte with next array
4489					; low byte
4490	BEQ	LAB_218F		; if equal then go do next array
4491
4492LAB_21CC
4493	JSR	LAB_21D7		; go defrag array strings
4494	BEQ	LAB_21C4		; go do next array string (loop always)
4495
4496; defrag string variables
4497; enter with XA = variable pointer
4498; return with XA = next variable pointer
4499
4500LAB_21D1
4501	INY				; increment index (Y was $00)
4502	LDA	(ut1_pl),Y		; get var name byte 2
4503	BPL	LAB_2206		; if not string, step pointer to next var and return
4504
4505	INY				; else increment index
4506LAB_21D7
4507	LDA	(ut1_pl),Y		; get string length
4508	BEQ	LAB_2206		; if null, step pointer to next string and return
4509
4510	INY				; else increment index
4511	LDA	(ut1_pl),Y		; get string pointer low byte
4512	TAX				; copy to X
4513	INY				; increment index
4514	LDA	(ut1_pl),Y		; get string pointer high byte
4515	CMP	Sstorh		; compare bottom of string space high byte
4516	BCC	LAB_21EC		; branch if less
4517
4518	BNE	LAB_2206		; if greater, step pointer to next string and return
4519
4520					; high bytes were = so compare low bytes
4521	CPX	Sstorl		; compare bottom of string space low byte
4522	BCS	LAB_2206		; if >=, step pointer to next string and return
4523
4524					; string pointer is < string storage pointer (pos in mem)
4525LAB_21EC
4526	CMP	Histrh		; compare to highest string high byte
4527	BCC	LAB_2207		; if <, step pointer to next string and return
4528
4529	BNE	LAB_21F6		; if > update pointers, step to next and return
4530
4531					; high bytes were = so compare low bytes
4532	CPX	Histrl		; compare to highest string low byte
4533	BCC	LAB_2207		; if <, step pointer to next string and return
4534
4535					; string is in string memory space
4536LAB_21F6
4537	STX	Histrl		; save as new highest string low byte
4538	STA	Histrh		; save as new highest string high byte
4539	LDA	ut1_pl		; get start of vars(descriptors) low byte
4540	LDX	ut1_ph		; get start of vars(descriptors) high byte
4541	STA	garb_l		; save as working pointer low byte
4542	STX	garb_h		; save as working pointer high byte
4543	DEY				; decrement index DIFFERS
4544	DEY				; decrement index (should point to descriptor start)
4545	STY	g_indx		; save index pointer
4546
4547					; step pointer to next string
4548LAB_2206
4549	CLC				; clear carry for add
4550LAB_2207
4551	LDA	g_step		; get step size
4552LAB_2208
4553	ADC	ut1_pl		; add pointer low byte
4554	STA	ut1_pl		; save pointer low byte
4555	BCC	LAB_2211		; branch if no overflow
4556
4557	INC	ut1_ph		; else increment high byte
4558LAB_2211
4559	LDX	ut1_ph		; get pointer high byte
4560	LDY	#$00			; clear Y
4561	RTS
4562
4563; search complete, now either exit or set-up and move string
4564
4565LAB_2216
4566	DEC	g_step		; decrement step size (now $03 for descriptor stack)
4567	LDX	garb_h		; get string to move high byte
4568	BEQ	LAB_2211		; exit if nothing to move
4569
4570	LDY	g_indx		; get index byte back (points to descriptor)
4571	CLC				; clear carry for add
4572	LDA	(garb_l),Y		; get string length
4573	ADC	Histrl		; add highest string low byte
4574	STA	Obendl		; save old block end low pointer
4575	LDA	Histrh		; get highest string high byte
4576	ADC	#$00			; add any carry
4577	STA	Obendh		; save old block end high byte
4578	LDA	Sstorl		; get bottom of string space low byte
4579	LDX	Sstorh		; get bottom of string space high byte
4580	STA	Nbendl		; save new block end low byte
4581	STX	Nbendh		; save new block end high byte
4582	JSR	LAB_11D6		; open up space in memory, don't set array end
4583	LDY	g_indx		; get index byte
4584	INY				; point to descriptor low byte
4585	LDA	Nbendl		; get string pointer low byte
4586	STA	(garb_l),Y		; save new string pointer low byte
4587	TAX				; copy string pointer low byte
4588	INC	Nbendh		; correct high byte (move sets high byte -1)
4589	LDA	Nbendh		; get new string pointer high byte
4590	INY				; point to descriptor high byte
4591	STA	(garb_l),Y		; save new string pointer high byte
4592	JMP	LAB_214B		; re-run routine from last ending
4593					; (but don't collect this string)
4594
4595; concatenate
4596; add strings, string 1 is in descriptor des_pl, string 2 is in line
4597
4598LAB_224D
4599	LDA	des_ph		; get descriptor pointer high byte
4600	PHA				; put on stack
4601	LDA	des_pl		; get descriptor pointer low byte
4602	PHA				; put on stack
4603	JSR	LAB_GVAL		; get value from line
4604	JSR	LAB_CTST		; check if source is string, else do type mismatch
4605	PLA				; get descriptor pointer low byte back
4606	STA	ssptr_l		; set pointer low byte
4607	PLA				; get descriptor pointer high byte back
4608	STA	ssptr_h		; set pointer high byte
4609	LDY	#$00			; clear index
4610	LDA	(ssptr_l),Y		; get length_1 from descriptor
4611	CLC				; clear carry for add
4612	ADC	(des_pl),Y		; add length_2
4613	BCC	LAB_226D		; branch if no overflow
4614
4615	LDX	#$1A			; else set error code $1A ("String too long" error)
4616	JMP	LAB_XERR		; do error #X, then warm start
4617
4618LAB_226D
4619	JSR	LAB_209C		; copy des_pl/h to des_2l/h and make string space A bytes
4620					; long
4621	JSR	LAB_228A		; copy string from descriptor (sdescr) to (Sutill)
4622	LDA	des_2l		; get descriptor pointer low byte
4623	LDY	des_2h		; get descriptor pointer high byte
4624	JSR	LAB_22BA		; pop (YA) descriptor off stack or from top of string space
4625					; returns with A = length, ut1_pl = pointer low byte,
4626					; ut1_ph = pointer high byte
4627	JSR	LAB_229C		; store string A bytes long from (ut1_pl) to (Sutill)
4628	LDA	ssptr_l		;.set descriptor pointer low byte
4629	LDY	ssptr_h		;.set descriptor pointer high byte
4630	JSR	LAB_22BA		; pop (YA) descriptor off stack or from top of string space
4631					; returns with A = length, X=ut1_pl=pointer low byte,
4632					; Y=ut1_ph=pointer high byte
4633	JSR	LAB_RTST		; check for space on descriptor stack then put string
4634					; address and length on descriptor stack and update stack
4635					; pointers
4636	JMP	LAB_1ADB		;.continue evaluation
4637
4638; copy string from descriptor (sdescr) to (Sutill)
4639
4640LAB_228A
4641	LDY	#$00			; clear index
4642	LDA	(sdescr),Y		; get string length
4643	PHA				; save on stack
4644	INY				; increment index
4645	LDA	(sdescr),Y		; get source string pointer low byte
4646	TAX				; copy to X
4647	INY				; increment index
4648	LDA	(sdescr),Y		; get source string pointer high byte
4649	TAY				; copy to Y
4650	PLA				; get length back
4651
4652; store string A bytes long from YX to (Sutill)
4653
4654LAB_2298
4655	STX	ut1_pl		; save source string pointer low byte
4656	STY	ut1_ph		; save source string pointer high byte
4657
4658; store string A bytes long from (ut1_pl) to (Sutill)
4659
4660LAB_229C
4661	TAX				; copy length to index (don't count with Y)
4662	BEQ	LAB_22B2		; branch if = $0 (null string) no need to add zero length
4663
4664	LDY	#$00			; zero pointer (copy forward)
4665LAB_22A0
4666	LDA	(ut1_pl),Y		; get source byte
4667	STA	(Sutill),Y		; save destination byte
4668
4669	INY				; increment index
4670	DEX				; decrement counter
4671	BNE	LAB_22A0		; loop while <> 0
4672
4673	TYA				; restore length from Y
4674LAB_22A9
4675	CLC				; clear carry for add
4676	ADC	Sutill		; add string utility ptr low byte
4677	STA	Sutill		; save string utility ptr low byte
4678	BCC	LAB_22B2		; branch if no carry
4679
4680	INC	Sutilh		; else increment string utility ptr high byte
4681LAB_22B2
4682	RTS
4683
4684; evaluate string
4685
4686LAB_EVST
4687	JSR	LAB_CTST		; check if source is string, else do type mismatch
4688
4689; pop string off descriptor stack, or from top of string space
4690; returns with A = length, X=pointer low byte, Y=pointer high byte
4691
4692LAB_22B6
4693	LDA	des_pl		; get descriptor pointer low byte
4694	LDY	des_ph		; get descriptor pointer high byte
4695
4696; pop (YA) descriptor off stack or from top of string space
4697; returns with A = length, X=ut1_pl=pointer low byte, Y=ut1_ph=pointer high byte
4698
4699LAB_22BA
4700	STA	ut1_pl		; save descriptor pointer low byte
4701	STY	ut1_ph		; save descriptor pointer high byte
4702	JSR	LAB_22EB		; clean descriptor stack, YA = pointer
4703	PHP				; save status flags
4704	LDY	#$00			; clear index
4705	LDA	(ut1_pl),Y		; get length from string descriptor
4706	PHA				; put on stack
4707	INY				; increment index
4708	LDA	(ut1_pl),Y		; get string pointer low byte from descriptor
4709	TAX				; copy to X
4710	INY				; increment index
4711	LDA	(ut1_pl),Y		; get string pointer high byte from descriptor
4712	TAY				; copy to Y
4713	PLA				; get string length back
4714	PLP				; restore status
4715	BNE	LAB_22E6		; branch if pointer <> last_sl,last_sh
4716
4717	CPY	Sstorh		; compare bottom of string space high byte
4718	BNE	LAB_22E6		; branch if <>
4719
4720	CPX	Sstorl		; else compare bottom of string space low byte
4721	BNE	LAB_22E6		; branch if <>
4722
4723	PHA				; save string length
4724	CLC				; clear carry for add
4725	ADC	Sstorl		; add bottom of string space low byte
4726	STA	Sstorl		; save bottom of string space low byte
4727	BCC	LAB_22E5		; skip increment if no overflow
4728
4729	INC	Sstorh		; increment bottom of string space high byte
4730LAB_22E5
4731	PLA				; restore string length
4732LAB_22E6
4733	STX	ut1_pl		; save string pointer low byte
4734	STY	ut1_ph		; save string pointer high byte
4735	RTS
4736
4737; clean descriptor stack, YA = pointer
4738; checks if AY is on the descriptor stack, if so does a stack discard
4739
4740LAB_22EB
4741	CPY	last_sh		; compare pointer high byte
4742	BNE	LAB_22FB		; exit if <>
4743
4744	CMP	last_sl		; compare pointer low byte
4745	BNE	LAB_22FB		; exit if <>
4746
4747	STA	next_s		; save descriptor stack pointer
4748	SBC	#$03			; -3
4749	STA	last_sl		; save low byte -3
4750	LDY	#$00			; clear high byte
4751LAB_22FB
4752	RTS
4753
4754; perform CHR$()
4755
4756LAB_CHRS
4757	JSR	LAB_EVBY		; evaluate byte expression, result in X
4758	TXA				; copy to A
4759	PHA				; save character
4760	LDA	#$01			; string is single byte
4761	JSR	LAB_MSSP		; make string space A bytes long A=$AC=length,
4762					; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
4763	PLA				; get character back
4764	LDY	#$00			; clear index
4765	STA	(str_pl),Y		; save byte in string (byte IS string!)
4766	JMP	LAB_RTST		; check for space on descriptor stack then put string
4767					; address and length on descriptor stack and update stack
4768					; pointers
4769
4770; perform LEFT$()
4771
4772LAB_LEFT
4773	PHA				; push byte parameter
4774	JSR	LAB_236F		; pull string data and byte parameter from stack
4775					; return pointer in des_2l/h, byte in A (and X), Y=0
4776	CMP	(des_2l),Y		; compare byte parameter with string length
4777	TYA				; clear A
4778	BEQ	LAB_2316		; go do string copy (branch always)
4779
4780; perform RIGHT$()
4781
4782LAB_RIGHT
4783	PHA				; push byte parameter
4784	JSR	LAB_236F		; pull string data and byte parameter from stack
4785					; return pointer in des_2l/h, byte in A (and X), Y=0
4786	CLC				; clear carry for add-1
4787	SBC	(des_2l),Y		; subtract string length
4788	EOR	#$FF			; invert it (A=LEN(expression$)-l)
4789
4790LAB_2316
4791	BCC	LAB_231C		; branch if string length > byte parameter
4792
4793	LDA	(des_2l),Y		; else make parameter = length
4794	TAX				; copy to byte parameter copy
4795	TYA				; clear string start offset
4796LAB_231C
4797	PHA				; save string start offset
4798LAB_231D
4799	TXA				; copy byte parameter (or string length if <)
4800LAB_231E
4801	PHA				; save string length
4802	JSR	LAB_MSSP		; make string space A bytes long A=$AC=length,
4803					; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
4804	LDA	des_2l		; get descriptor pointer low byte
4805	LDY	des_2h		; get descriptor pointer high byte
4806	JSR	LAB_22BA		; pop (YA) descriptor off stack or from top of string space
4807					; returns with A = length, X=ut1_pl=pointer low byte,
4808					; Y=ut1_ph=pointer high byte
4809	PLA				; get string length back
4810	TAY				; copy length to Y
4811	PLA				; get string start offset back
4812	CLC				; clear carry for add
4813	ADC	ut1_pl		; add start offset to string start pointer low byte
4814	STA	ut1_pl		; save string start pointer low byte
4815	BCC	LAB_2335		; branch if no overflow
4816
4817	INC	ut1_ph		; else increment string start pointer high byte
4818LAB_2335
4819	TYA				; copy length to A
4820	JSR	LAB_229C		; store string A bytes long from (ut1_pl) to (Sutill)
4821	JMP	LAB_RTST		; check for space on descriptor stack then put string
4822					; address and length on descriptor stack and update stack
4823					; pointers
4824
4825; perform MID$()
4826
4827LAB_MIDS
4828	PHA				; push byte parameter
4829	LDA	#$FF			; set default length = 255
4830	STA	mids_l		; save default length
4831	JSR	LAB_GBYT		; scan memory
4832	CMP	#')'			; compare with ")"
4833	BEQ	LAB_2358		; branch if = ")" (skip second byte get)
4834
4835	JSR	LAB_1C01		; scan for "," , else do syntax error then warm start
4836	JSR	LAB_GTBY		; get byte parameter (use copy in mids_l)
4837LAB_2358
4838	JSR	LAB_236F		; pull string data and byte parameter from stack
4839					; return pointer in des_2l/h, byte in A (and X), Y=0
4840	DEX				; decrement start index
4841	TXA				; copy to A
4842	PHA				; save string start offset
4843	CLC				; clear carry for sub-1
4844	LDX	#$00			; clear output string length
4845	SBC	(des_2l),Y		; subtract string length
4846	BCS	LAB_231D		; if start>string length go do null string
4847
4848	EOR	#$FF			; complement -length
4849	CMP	mids_l		; compare byte parameter
4850	BCC	LAB_231E		; if length>remaining string go do RIGHT$
4851
4852	LDA	mids_l		; get length byte
4853	BCS	LAB_231E		; go do string copy (branch always)
4854
4855; pull string data and byte parameter from stack
4856; return pointer in des_2l/h, byte in A (and X), Y=0
4857
4858LAB_236F
4859	JSR	LAB_1BFB		; scan for ")" , else do syntax error then warm start
4860	PLA				; pull return address low byte (return address)
4861	STA	Fnxjpl		; save functions jump vector low byte
4862	PLA				; pull return address high byte (return address)
4863	STA	Fnxjph		; save functions jump vector high byte
4864	PLA				; pull byte parameter
4865	TAX				; copy byte parameter to X
4866	PLA				; pull string pointer low byte
4867	STA	des_2l		; save it
4868	PLA				; pull string pointer high byte
4869	STA	des_2h		; save it
4870	LDY	#$00			; clear index
4871	TXA				; copy byte parameter
4872	BEQ	LAB_23A8		; if null do function call error then warm start
4873
4874	INC	Fnxjpl		; increment function jump vector low byte
4875					; (JSR pushes return addr-1. this is all very nice
4876					; but will go tits up if either call is on a page
4877					; boundary!)
4878	JMP	(Fnxjpl)		; in effect, RTS
4879
4880; perform LCASE$()
4881
4882LAB_LCASE
4883	JSR	LAB_EVST		; evaluate string
4884	STA	str_ln		; set string length
4885	TAY				; copy length to Y
4886	BEQ	NoString		; branch if null string
4887
4888	JSR	LAB_MSSP		; make string space A bytes long A=length,
4889					; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
4890	STX	str_pl		; save string pointer low byte
4891	STY	str_ph		; save string pointer high byte
4892	TAY				; get string length back
4893
4894LC_loop
4895	DEY				; decrement index
4896	LDA	(ut1_pl),Y		; get byte from string
4897	JSR	LAB_1D82		; is character "A" to "Z"
4898	BCC	NoUcase		; branch if not upper case alpha
4899
4900	ORA	#$20			; convert upper to lower case
4901NoUcase
4902	STA	(Sutill),Y		; save byte back to string
4903	TYA				; test index
4904	BNE	LC_loop		; loop if not all done
4905
4906	BEQ	NoString		; tidy up and exit, branch always
4907
4908; perform UCASE$()
4909
4910LAB_UCASE
4911	JSR	LAB_EVST		; evaluate string
4912	STA	str_ln		; set string length
4913	TAY				; copy length to Y
4914	BEQ	NoString		; branch if null string
4915
4916	JSR	LAB_MSSP		; make string space A bytes long A=length,
4917					; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
4918	STX	str_pl		; save string pointer low byte
4919	STY	str_ph		; save string pointer high byte
4920	TAY				; get string length back
4921
4922UC_loop
4923	DEY				; decrement index
4924	LDA	(ut1_pl),Y		; get byte from string
4925	JSR	LAB_CASC		; is character "a" to "z" (or "A" to "Z")
4926	BCC	NoLcase		; branch if not alpha
4927
4928	AND	#$DF			; convert lower to upper case
4929NoLcase
4930	STA	(Sutill),Y		; save byte back to string
4931	TYA				; test index
4932	BNE	UC_loop		; loop if not all done
4933
4934NoString
4935	JMP	LAB_RTST		; check for space on descriptor stack then put string
4936					; address and length on descriptor stack and update stack
4937					; pointers
4938
4939; perform SADD()
4940
4941LAB_SADD
4942	JSR	LAB_IGBY		; increment and scan memory
4943	JSR	LAB_GVAR		; get var address
4944
4945	JSR	LAB_1BFB		; scan for ")", else do syntax error then warm start
4946	JSR	LAB_CTST		; check if source is string, else do type mismatch
4947
4948	LDY	#$02			; index to string pointer high byte
4949	LDA	(Cvaral),Y		; get string pointer high byte
4950	TAX				; copy string pointer high byte to X
4951	DEY				; index to string pointer low byte
4952	LDA	(Cvaral),Y		; get string pointer low byte
4953	TAY				; copy string pointer low byte to Y
4954	TXA				; copy string pointer high byte to A
4955	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
4956
4957; perform LEN()
4958
4959LAB_LENS
4960	JSR	LAB_ESGL		; evaluate string, get length in A (and Y)
4961	JMP	LAB_1FD0		; convert Y to byte in FAC1 and return
4962
4963; evaluate string, get length in Y
4964
4965LAB_ESGL
4966	JSR	LAB_EVST		; evaluate string
4967	TAY				; copy length to Y
4968	RTS
4969
4970; perform ASC()
4971
4972LAB_ASC
4973	JSR	LAB_ESGL		; evaluate string, get length in A (and Y)
4974	BEQ	LAB_23A8		; if null do function call error then warm start
4975
4976	LDY	#$00			; set index to first character
4977	LDA	(ut1_pl),Y		; get byte
4978	TAY				; copy to Y
4979	JMP	LAB_1FD0		; convert Y to byte in FAC1 and return
4980
4981; do function call error then warm start
4982
4983LAB_23A8
4984	JMP	LAB_FCER		; do function call error then warm start
4985
4986; scan and get byte parameter
4987
4988LAB_SGBY
4989	JSR	LAB_IGBY		; increment and scan memory
4990
4991; get byte parameter
4992
4993LAB_GTBY
4994	JSR	LAB_EVNM		; evaluate expression and check is numeric,
4995					; else do type mismatch
4996
4997; evaluate byte expression, result in X
4998
4999LAB_EVBY
5000	JSR	LAB_EVPI		; evaluate integer expression (no check)
5001
5002	LDY	FAC1_2		; get FAC1 mantissa2
5003	BNE	LAB_23A8		; if top byte <> 0 do function call error then warm start
5004
5005	LDX	FAC1_3		; get FAC1 mantissa3
5006	JMP	LAB_GBYT		; scan memory and return
5007
5008; perform VAL()
5009
5010LAB_VAL
5011	JSR	LAB_ESGL		; evaluate string, get length in A (and Y)
5012	BNE	LAB_23C5		; branch if not null string
5013
5014					; string was null so set result = $00
5015	JMP	LAB_24F1		; clear FAC1 exponent and sign and return
5016
5017LAB_23C5
5018	LDX	Bpntrl		; get BASIC execute pointer low byte
5019	LDY	Bpntrh		; get BASIC execute pointer high byte
5020	STX	Btmpl			; save BASIC execute pointer low byte
5021	STY	Btmph			; save BASIC execute pointer high byte
5022	LDX	ut1_pl		; get string pointer low byte
5023	STX	Bpntrl		; save as BASIC execute pointer low byte
5024	CLC				; clear carry
5025	ADC	ut1_pl		; add string length
5026	STA	ut2_pl		; save string end low byte
5027	LDA	ut1_ph		; get string pointer high byte
5028	STA	Bpntrh		; save as BASIC execute pointer high byte
5029	ADC	#$00			; add carry to high byte
5030	STA	ut2_ph		; save string end high byte
5031	LDY	#$00			; set index to $00
5032	LDA	(ut2_pl),Y		; get string end +1 byte
5033	PHA				; push it
5034	TYA				; clear A
5035	STA	(ut2_pl),Y		; terminate string with $00
5036	JSR	LAB_GBYT		; scan memory
5037	JSR	LAB_2887		; get FAC1 from string
5038	PLA				; restore string end +1 byte
5039	LDY	#$00			; set index to zero
5040	STA	(ut2_pl),Y		; put string end byte back
5041
5042; restore BASIC execute pointer from temp (Btmpl/Btmph)
5043
5044LAB_23F3
5045	LDX	Btmpl			; get BASIC execute pointer low byte back
5046	LDY	Btmph			; get BASIC execute pointer high byte back
5047	STX	Bpntrl		; save BASIC execute pointer low byte
5048	STY	Bpntrh		; save BASIC execute pointer high byte
5049	RTS
5050
5051; get two parameters for POKE or WAIT
5052
5053LAB_GADB
5054	JSR	LAB_EVNM		; evaluate expression and check is numeric,
5055					; else do type mismatch
5056	JSR	LAB_F2FX		; save integer part of FAC1 in temporary integer
5057
5058; scan for "," and get byte, else do Syntax error then warm start
5059
5060LAB_SCGB
5061	JSR	LAB_1C01		; scan for "," , else do syntax error then warm start
5062	LDA	Itemph		; save temporary integer high byte
5063	PHA				; on stack
5064	LDA	Itempl		; save temporary integer low byte
5065	PHA				; on stack
5066	JSR	LAB_GTBY		; get byte parameter
5067	PLA				; pull low byte
5068	STA	Itempl		; restore temporary integer low byte
5069	PLA				; pull high byte
5070	STA	Itemph		; restore temporary integer high byte
5071	RTS
5072
5073; convert float to fixed routine. accepts any value that fits in 24 bits, +ve or
5074; -ve and converts it into a right truncated integer in Itempl and Itemph
5075
5076; save unsigned 16 bit integer part of FAC1 in temporary integer
5077
5078LAB_F2FX
5079	LDA	FAC1_e		; get FAC1 exponent
5080	CMP	#$98			; compare with exponent = 2^24
5081	BCS	LAB_23A8		; if >= do function call error then warm start
5082
5083LAB_F2FU
5084	JSR	LAB_2831		; convert FAC1 floating-to-fixed
5085	LDA	FAC1_2		; get FAC1 mantissa2
5086	LDY	FAC1_3		; get FAC1 mantissa3
5087	STY	Itempl		; save temporary integer low byte
5088	STA	Itemph		; save temporary integer high byte
5089	RTS
5090
5091; perform PEEK()
5092
5093LAB_PEEK
5094	JSR	LAB_F2FX		; save integer part of FAC1 in temporary integer
5095	LDX	#$00			; clear index
5096	LDA	(Itempl,X)		; get byte via temporary integer (addr)
5097	TAY				; copy byte to Y
5098	JMP	LAB_1FD0		; convert Y to byte in FAC1 and return
5099
5100; perform POKE
5101
5102LAB_POKE
5103	JSR	LAB_GADB		; get two parameters for POKE or WAIT
5104	TXA				; copy byte argument to A
5105	LDX	#$00			; clear index
5106	STA	(Itempl,X)		; save byte via temporary integer (addr)
5107	RTS
5108
5109; perform DEEK()
5110
5111LAB_DEEK
5112	JSR	LAB_F2FX		; save integer part of FAC1 in temporary integer
5113	LDX	#$00			; clear index
5114	LDA	(Itempl,X)		; PEEK low byte
5115	TAY				; copy to Y
5116	INC	Itempl		; increment pointer low byte
5117	BNE	Deekh			; skip high increment if no rollover
5118
5119	INC	Itemph		; increment pointer high byte
5120Deekh
5121	LDA	(Itempl,X)		; PEEK high byte
5122	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
5123
5124; perform DOKE
5125
5126LAB_DOKE
5127	JSR	LAB_EVNM		; evaluate expression and check is numeric,
5128					; else do type mismatch
5129	JSR	LAB_F2FX		; convert floating-to-fixed
5130
5131	STY	Frnxtl		; save pointer low byte (float to fixed returns word in AY)
5132	STA	Frnxth		; save pointer high byte
5133
5134	JSR	LAB_1C01		; scan for "," , else do syntax error then warm start
5135	JSR	LAB_EVNM		; evaluate expression and check is numeric,
5136					; else do type mismatch
5137	JSR	LAB_F2FX		; convert floating-to-fixed
5138
5139	TYA				; copy value low byte (float to fixed returns word in AY)
5140	LDX	#$00			; clear index
5141	STA	(Frnxtl,X)		; POKE low byte
5142	INC	Frnxtl		; increment pointer low byte
5143	BNE	Dokeh			; skip high increment if no rollover
5144
5145	INC	Frnxth		; increment pointer high byte
5146Dokeh
5147	LDA	Itemph		; get value high byte
5148	STA	(Frnxtl,X)		; POKE high byte
5149	JMP	LAB_GBYT		; scan memory and return
5150
5151; perform SWAP
5152
5153LAB_SWAP
5154	JSR	LAB_GVAR		; get var1 address
5155	STA	Lvarpl		; save var1 address low byte
5156	STY	Lvarph		; save var1 address high byte
5157	LDA	Dtypef		; get data type flag, $FF=string, $00=numeric
5158	PHA				; save data type flag
5159
5160	JSR	LAB_1C01		; scan for "," , else do syntax error then warm start
5161	JSR	LAB_GVAR		; get var2 address (pointer in Cvaral/h)
5162	PLA				; pull var1 data type flag
5163	EOR	Dtypef		; compare with var2 data type
5164	BPL	SwapErr		; exit if not both the same type
5165
5166	LDY	#$03			; four bytes to swap (either value or descriptor+1)
5167SwapLp
5168	LDA	(Lvarpl),Y		; get byte from var1
5169	TAX				; save var1 byte
5170	LDA	(Cvaral),Y		; get byte from var2
5171	STA	(Lvarpl),Y		; save byte to var1
5172	TXA				; restore var1 byte
5173	STA	(Cvaral),Y		; save byte to var2
5174	DEY				; decrement index
5175	BPL	SwapLp		; loop until done
5176
5177	RTS
5178
5179SwapErr
5180	JMP	LAB_1ABC		; do "Type mismatch" error then warm start
5181
5182; perform CALL
5183
5184LAB_CALL
5185	JSR	LAB_EVNM		; evaluate expression and check is numeric,
5186					; else do type mismatch
5187	JSR	LAB_F2FX		; convert floating-to-fixed
5188	LDA	#>CallExit		; set return address high byte
5189	PHA				; put on stack
5190	LDA	#<CallExit-1	; set return address low byte
5191	PHA				; put on stack
5192	JMP	(Itempl)		; do indirect jump to user routine
5193
5194; if the called routine exits correctly then it will return to here. this will then get
5195; the next byte for the interpreter and return
5196
5197CallExit
5198	JMP	LAB_GBYT		; scan memory and return
5199
5200; perform WAIT
5201
5202LAB_WAIT
5203	JSR	LAB_GADB		; get two parameters for POKE or WAIT
5204	STX	Frnxtl		; save byte
5205	LDX	#$00			; clear mask
5206	JSR	LAB_GBYT		; scan memory
5207	BEQ	LAB_2441		; skip if no third argument
5208
5209	JSR	LAB_SCGB		; scan for "," and get byte, else SN error then warm start
5210LAB_2441
5211	STX	Frnxth		; save EOR argument
5212LAB_2445
5213	LDA	(Itempl),Y		; get byte via temporary integer (addr)
5214	EOR	Frnxth		; EOR with second argument (mask)
5215	AND	Frnxtl		; AND with first argument (byte)
5216	BEQ	LAB_2445		; loop if result is zero
5217
5218LAB_244D
5219	RTS
5220
5221; perform subtraction, FAC1 from (AY)
5222
5223LAB_2455
5224	JSR	LAB_264D		; unpack memory (AY) into FAC2
5225
5226; perform subtraction, FAC1 from FAC2
5227
5228LAB_SUBTRACT
5229	LDA	FAC1_s		; get FAC1 sign (b7)
5230	EOR	#$FF			; complement it
5231	STA	FAC1_s		; save FAC1 sign (b7)
5232	EOR	FAC2_s		; EOR with FAC2 sign (b7)
5233	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
5234	LDA	FAC1_e		; get FAC1 exponent
5235	JMP	LAB_ADD		; go add FAC2 to FAC1
5236
5237; perform addition
5238
5239LAB_2467
5240	JSR	LAB_257B		; shift FACX A times right (>8 shifts)
5241	BCC	LAB_24A8		;.go subtract mantissas
5242
5243; add 0.5 to FAC1
5244
5245LAB_244E
5246	LDA	#<LAB_2A96		; set 0.5 pointer low byte
5247	LDY	#>LAB_2A96		; set 0.5 pointer high byte
5248
5249; add (AY) to FAC1
5250
5251LAB_246C
5252	JSR	LAB_264D		; unpack memory (AY) into FAC2
5253
5254; add FAC2 to FAC1
5255
5256LAB_ADD
5257	BNE	LAB_2474		; branch if FAC1 was not zero
5258
5259; copy FAC2 to FAC1
5260
5261LAB_279B
5262	LDA	FAC2_s		; get FAC2 sign (b7)
5263
5264; save FAC1 sign and copy ABS(FAC2) to FAC1
5265
5266LAB_279D
5267	STA	FAC1_s		; save FAC1 sign (b7)
5268	LDX	#$04			; 4 bytes to copy
5269LAB_27A1
5270	LDA	FAC1_o,X		; get byte from FAC2,X
5271	STA	FAC1_e-1,X		; save byte at FAC1,X
5272	DEX				; decrement count
5273	BNE	LAB_27A1		; loop if not all done
5274
5275	STX	FAC1_r		; clear FAC1 rounding byte
5276	RTS
5277
5278					; FAC1 is non zero
5279LAB_2474
5280	LDX	FAC1_r		; get FAC1 rounding byte
5281	STX	FAC2_r		; save as FAC2 rounding byte
5282	LDX	#FAC2_e		; set index to FAC2 exponent addr
5283	LDA	FAC2_e		; get FAC2 exponent
5284LAB_247C
5285	TAY				; copy exponent
5286	BEQ	LAB_244D		; exit if zero
5287
5288	SEC				; set carry for subtract
5289	SBC	FAC1_e		; subtract FAC1 exponent
5290	BEQ	LAB_24A8		; branch if = (go add mantissa)
5291
5292	BCC	LAB_2498		; branch if <
5293
5294					; FAC2>FAC1
5295	STY	FAC1_e		; save FAC1 exponent
5296	LDY	FAC2_s		; get FAC2 sign (b7)
5297	STY	FAC1_s		; save FAC1 sign (b7)
5298	EOR	#$FF			; complement A
5299	ADC	#$00			; +1 (twos complement, carry is set)
5300	LDY	#$00			; clear Y
5301	STY	FAC2_r		; clear FAC2 rounding byte
5302	LDX	#FAC1_e		; set index to FAC1 exponent addr
5303	BNE	LAB_249C		; branch always
5304
5305LAB_2498
5306	LDY	#$00			; clear Y
5307	STY	FAC1_r		; clear FAC1 rounding byte
5308LAB_249C
5309	CMP	#$F9			; compare exponent diff with $F9
5310	BMI	LAB_2467		; branch if range $79-$F8
5311
5312	TAY				; copy exponent difference to Y
5313	LDA	FAC1_r		; get FAC1 rounding byte
5314	LSR	PLUS_1,X		; shift FAC? mantissa1
5315	JSR	LAB_2592		; shift FACX Y times right
5316
5317					; exponents are equal now do mantissa subtract
5318LAB_24A8
5319	BIT	FAC_sc		; test sign compare (FAC1 EOR FAC2)
5320	BPL	LAB_24F8		; if = add FAC2 mantissa to FAC1 mantissa and return
5321
5322	LDY	#FAC1_e		; set index to FAC1 exponent addr
5323	CPX	#FAC2_e		; compare X to FAC2 exponent addr
5324	BEQ	LAB_24B4		; branch if =
5325
5326	LDY	#FAC2_e		; else set index to FAC2 exponent addr
5327
5328					; subtract smaller from bigger (take sign of bigger)
5329LAB_24B4
5330	SEC				; set carry for subtract
5331	EOR	#$FF			; ones complement A
5332	ADC	FAC2_r		; add FAC2 rounding byte
5333	STA	FAC1_r		; save FAC1 rounding byte
5334	LDA	PLUS_3,Y		; get FACY mantissa3
5335	SBC	PLUS_3,X		; subtract FACX mantissa3
5336	STA	FAC1_3		; save FAC1 mantissa3
5337	LDA	PLUS_2,Y		; get FACY mantissa2
5338	SBC	PLUS_2,X		; subtract FACX mantissa2
5339	STA	FAC1_2		; save FAC1 mantissa2
5340	LDA	PLUS_1,Y		; get FACY mantissa1
5341	SBC	PLUS_1,X		; subtract FACX mantissa1
5342	STA	FAC1_1		; save FAC1 mantissa1
5343
5344; do ABS and normalise FAC1
5345
5346LAB_24D0
5347	BCS	LAB_24D5		; branch if number is +ve
5348
5349	JSR	LAB_2537		; negate FAC1
5350
5351; normalise FAC1
5352
5353LAB_24D5
5354	LDY	#$00			; clear Y
5355	TYA				; clear A
5356	CLC				; clear carry for add
5357LAB_24D9
5358	LDX	FAC1_1		; get FAC1 mantissa1
5359	BNE	LAB_251B		; if not zero normalise FAC1
5360
5361	LDX	FAC1_2		; get FAC1 mantissa2
5362	STX	FAC1_1		; save FAC1 mantissa1
5363	LDX	FAC1_3		; get FAC1 mantissa3
5364	STX	FAC1_2		; save FAC1 mantissa2
5365	LDX	FAC1_r		; get FAC1 rounding byte
5366	STX	FAC1_3		; save FAC1 mantissa3
5367	STY	FAC1_r		; clear FAC1 rounding byte
5368	ADC	#$08			; add x to exponent offset
5369	CMP	#$18			; compare with $18 (max offset, all bits would be =0)
5370	BNE	LAB_24D9		; loop if not max
5371
5372; clear FAC1 exponent and sign
5373
5374LAB_24F1
5375	LDA	#$00			; clear A
5376LAB_24F3
5377	STA	FAC1_e		; set FAC1 exponent
5378
5379; save FAC1 sign
5380
5381LAB_24F5
5382	STA	FAC1_s		; save FAC1 sign (b7)
5383	RTS
5384
5385; add FAC2 mantissa to FAC1 mantissa
5386
5387LAB_24F8
5388	ADC	FAC2_r		; add FAC2 rounding byte
5389	STA	FAC1_r		; save FAC1 rounding byte
5390	LDA	FAC1_3		; get FAC1 mantissa3
5391	ADC	FAC2_3		; add FAC2 mantissa3
5392	STA	FAC1_3		; save FAC1 mantissa3
5393	LDA	FAC1_2		; get FAC1 mantissa2
5394	ADC	FAC2_2		; add FAC2 mantissa2
5395	STA	FAC1_2		; save FAC1 mantissa2
5396	LDA	FAC1_1		; get FAC1 mantissa1
5397	ADC	FAC2_1		; add FAC2 mantissa1
5398	STA	FAC1_1		; save FAC1 mantissa1
5399	BCS	LAB_252A		; if carry then normalise FAC1 for C=1
5400
5401	RTS				; else just exit
5402
5403LAB_2511
5404	ADC	#$01			; add 1 to exponent offset
5405	ASL	FAC1_r		; shift FAC1 rounding byte
5406	ROL	FAC1_3		; shift FAC1 mantissa3
5407	ROL	FAC1_2		; shift FAC1 mantissa2
5408	ROL	FAC1_1		; shift FAC1 mantissa1
5409
5410; normalise FAC1
5411
5412LAB_251B
5413	BPL	LAB_2511		; loop if not normalised
5414
5415	SEC				; set carry for subtract
5416	SBC	FAC1_e		; subtract FAC1 exponent
5417	BCS	LAB_24F1		; branch if underflow (set result = $0)
5418
5419	EOR	#$FF			; complement exponent
5420	ADC	#$01			; +1 (twos complement)
5421	STA	FAC1_e		; save FAC1 exponent
5422
5423; test and normalise FAC1 for C=0/1
5424
5425LAB_2528
5426	BCC	LAB_2536		; exit if no overflow
5427
5428; normalise FAC1 for C=1
5429
5430LAB_252A
5431	INC	FAC1_e		; increment FAC1 exponent
5432	BEQ	LAB_2564		; if zero do overflow error and warm start
5433
5434	ROR	FAC1_1		; shift FAC1 mantissa1
5435	ROR	FAC1_2		; shift FAC1 mantissa2
5436	ROR	FAC1_3		; shift FAC1 mantissa3
5437	ROR	FAC1_r		; shift FAC1 rounding byte
5438LAB_2536
5439	RTS
5440
5441; negate FAC1
5442
5443LAB_2537
5444	LDA	FAC1_s		; get FAC1 sign (b7)
5445	EOR	#$FF			; complement it
5446	STA	FAC1_s		; save FAC1 sign (b7)
5447
5448; twos complement FAC1 mantissa
5449
5450LAB_253D
5451	LDA	FAC1_1		; get FAC1 mantissa1
5452	EOR	#$FF			; complement it
5453	STA	FAC1_1		; save FAC1 mantissa1
5454	LDA	FAC1_2		; get FAC1 mantissa2
5455	EOR	#$FF			; complement it
5456	STA	FAC1_2		; save FAC1 mantissa2
5457	LDA	FAC1_3		; get FAC1 mantissa3
5458	EOR	#$FF			; complement it
5459	STA	FAC1_3		; save FAC1 mantissa3
5460	LDA	FAC1_r		; get FAC1 rounding byte
5461	EOR	#$FF			; complement it
5462	STA	FAC1_r		; save FAC1 rounding byte
5463	INC	FAC1_r		; increment FAC1 rounding byte
5464	BNE	LAB_2563		; exit if no overflow
5465
5466; increment FAC1 mantissa
5467
5468LAB_2559
5469	INC	FAC1_3		; increment FAC1 mantissa3
5470	BNE	LAB_2563		; finished if no rollover
5471
5472	INC	FAC1_2		; increment FAC1 mantissa2
5473	BNE	LAB_2563		; finished if no rollover
5474
5475	INC	FAC1_1		; increment FAC1 mantissa1
5476LAB_2563
5477	RTS
5478
5479; do overflow error (overflow exit)
5480
5481LAB_2564
5482	LDX	#$0A			; error code $0A ("Overflow" error)
5483	JMP	LAB_XERR		; do error #X, then warm start
5484
5485; shift FCAtemp << A+8 times
5486
5487LAB_2569
5488	LDX	#FACt_1-1		; set offset to FACtemp
5489LAB_256B
5490	LDY	PLUS_3,X		; get FACX mantissa3
5491	STY	FAC1_r		; save as FAC1 rounding byte
5492	LDY	PLUS_2,X		; get FACX mantissa2
5493	STY	PLUS_3,X		; save FACX mantissa3
5494	LDY	PLUS_1,X		; get FACX mantissa1
5495	STY	PLUS_2,X		; save FACX mantissa2
5496	LDY	FAC1_o		; get FAC1 overflow byte
5497	STY	PLUS_1,X		; save FACX mantissa1
5498
5499; shift FACX -A times right (> 8 shifts)
5500
5501LAB_257B
5502	ADC	#$08			; add 8 to shift count
5503	BMI	LAB_256B		; go do 8 shift if still -ve
5504
5505	BEQ	LAB_256B		; go do 8 shift if zero
5506
5507	SBC	#$08			; else subtract 8 again
5508	TAY				; save count to Y
5509	LDA	FAC1_r		; get FAC1 rounding byte
5510	BCS	LAB_259A		;.
5511
5512LAB_2588
5513	ASL	PLUS_1,X		; shift FACX mantissa1
5514	BCC	LAB_258E		; branch if +ve
5515
5516	INC	PLUS_1,X		; this sets b7 eventually
5517LAB_258E
5518	ROR	PLUS_1,X		; shift FACX mantissa1 (correct for ASL)
5519	ROR	PLUS_1,X		; shift FACX mantissa1 (put carry in b7)
5520
5521; shift FACX Y times right
5522
5523LAB_2592
5524	ROR	PLUS_2,X		; shift FACX mantissa2
5525	ROR	PLUS_3,X		; shift FACX mantissa3
5526	ROR				; shift FACX rounding byte
5527	INY				; increment exponent diff
5528	BNE	LAB_2588		; branch if range adjust not complete
5529
5530LAB_259A
5531	CLC				; just clear it
5532	RTS
5533
5534; perform LOG()
5535
5536LAB_LOG
5537	JSR	LAB_27CA		; test sign and zero
5538	BEQ	LAB_25C4		; if zero do function call error then warm start
5539
5540	BPL	LAB_25C7		; skip error if +ve
5541
5542LAB_25C4
5543	JMP	LAB_FCER		; do function call error then warm start (-ve)
5544
5545LAB_25C7
5546	LDA	FAC1_e		; get FAC1 exponent
5547	SBC	#$7F			; normalise it
5548	PHA				; save it
5549	LDA	#$80			; set exponent to zero
5550	STA	FAC1_e		; save FAC1 exponent
5551	LDA	#<LAB_25AD		; set 1/root2 pointer low byte
5552	LDY	#>LAB_25AD		; set 1/root2 pointer high byte
5553	JSR	LAB_246C		; add (AY) to FAC1 (1/root2)
5554	LDA	#<LAB_25B1		; set root2 pointer low byte
5555	LDY	#>LAB_25B1		; set root2 pointer high byte
5556	JSR	LAB_26CA		; convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
5557	LDA	#<LAB_259C		; set 1 pointer low byte
5558	LDY	#>LAB_259C		; set 1 pointer high byte
5559	JSR	LAB_2455		; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1)
5560	LDA	#<LAB_25A0		; set pointer low byte to counter
5561	LDY	#>LAB_25A0		; set pointer high byte to counter
5562	JSR	LAB_2B6E		; ^2 then series evaluation
5563	LDA	#<LAB_25B5		; set -0.5 pointer low byte
5564	LDY	#>LAB_25B5		; set -0.5 pointer high byte
5565	JSR	LAB_246C		; add (AY) to FAC1
5566	PLA				; restore FAC1 exponent
5567	JSR	LAB_2912		; evaluate new ASCII digit
5568	LDA	#<LAB_25B9		; set LOG(2) pointer low byte
5569	LDY	#>LAB_25B9		; set LOG(2) pointer high byte
5570
5571; do convert AY, FCA1*(AY)
5572
5573LAB_25FB
5574	JSR	LAB_264D		; unpack memory (AY) into FAC2
5575LAB_MULTIPLY
5576	BEQ	LAB_264C		; exit if zero
5577
5578	JSR	LAB_2673		; test and adjust accumulators
5579	LDA	#$00			; clear A
5580	STA	FACt_1		; clear temp mantissa1
5581	STA	FACt_2		; clear temp mantissa2
5582	STA	FACt_3		; clear temp mantissa3
5583	LDA	FAC1_r		; get FAC1 rounding byte
5584	JSR	LAB_2622		; go do shift/add FAC2
5585	LDA	FAC1_3		; get FAC1 mantissa3
5586	JSR	LAB_2622		; go do shift/add FAC2
5587	LDA	FAC1_2		; get FAC1 mantissa2
5588	JSR	LAB_2622		; go do shift/add FAC2
5589	LDA	FAC1_1		; get FAC1 mantissa1
5590	JSR	LAB_2627		; go do shift/add FAC2
5591	JMP	LAB_273C		; copy temp to FAC1, normalise and return
5592
5593LAB_2622
5594	BNE	LAB_2627		; branch if byte <> zero
5595
5596	JMP	LAB_2569		; shift FCAtemp << A+8 times
5597
5598					; else do shift and add
5599LAB_2627
5600	LSR				; shift byte
5601	ORA	#$80			; set top bit (mark for 8 times)
5602LAB_262A
5603	TAY				; copy result
5604	BCC	LAB_2640		; skip next if bit was zero
5605
5606	CLC				; clear carry for add
5607	LDA	FACt_3		; get temp mantissa3
5608	ADC	FAC2_3		; add FAC2 mantissa3
5609	STA	FACt_3		; save temp mantissa3
5610	LDA	FACt_2		; get temp mantissa2
5611	ADC	FAC2_2		; add FAC2 mantissa2
5612	STA	FACt_2		; save temp mantissa2
5613	LDA	FACt_1		; get temp mantissa1
5614	ADC	FAC2_1		; add FAC2 mantissa1
5615	STA	FACt_1		; save temp mantissa1
5616LAB_2640
5617	ROR	FACt_1		; shift temp mantissa1
5618	ROR	FACt_2		; shift temp mantissa2
5619	ROR	FACt_3		; shift temp mantissa3
5620	ROR	FAC1_r		; shift temp rounding byte
5621	TYA				; get byte back
5622	LSR				; shift byte
5623	BNE	LAB_262A		; loop if all bits not done
5624
5625LAB_264C
5626	RTS
5627
5628; unpack memory (AY) into FAC2
5629
5630LAB_264D
5631	STA	ut1_pl		; save pointer low byte
5632	STY	ut1_ph		; save pointer high byte
5633	LDY	#$03			; 4 bytes to get (0-3)
5634	LDA	(ut1_pl),Y		; get mantissa3
5635	STA	FAC2_3		; save FAC2 mantissa3
5636	DEY				; decrement index
5637	LDA	(ut1_pl),Y		; get mantissa2
5638	STA	FAC2_2		; save FAC2 mantissa2
5639	DEY				; decrement index
5640	LDA	(ut1_pl),Y		; get mantissa1+sign
5641	STA	FAC2_s		; save FAC2 sign (b7)
5642	EOR	FAC1_s		; EOR with FAC1 sign (b7)
5643	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
5644	LDA	FAC2_s		; recover FAC2 sign (b7)
5645	ORA	#$80			; set 1xxx xxx (set normal bit)
5646	STA	FAC2_1		; save FAC2 mantissa1
5647	DEY				; decrement index
5648	LDA	(ut1_pl),Y		; get exponent byte
5649	STA	FAC2_e		; save FAC2 exponent
5650	LDA	FAC1_e		; get FAC1 exponent
5651	RTS
5652
5653; test and adjust accumulators
5654
5655LAB_2673
5656	LDA	FAC2_e		; get FAC2 exponent
5657LAB_2675
5658	BEQ	LAB_2696		; branch if FAC2 = $00 (handle underflow)
5659
5660	CLC				; clear carry for add
5661	ADC	FAC1_e		; add FAC1 exponent
5662	BCC	LAB_2680		; branch if sum of exponents <$0100
5663
5664	BMI	LAB_269B		; do overflow error
5665
5666	CLC				; clear carry for the add
5667	.byte	$2C			; makes next line BIT $1410
5668LAB_2680
5669	BPL	LAB_2696		; if +ve go handle underflow
5670
5671	ADC	#$80			; adjust exponent
5672	STA	FAC1_e		; save FAC1 exponent
5673	BNE	LAB_268B		; branch if not zero
5674
5675	JMP	LAB_24F5		; save FAC1 sign and return
5676
5677LAB_268B
5678	LDA	FAC_sc		; get sign compare (FAC1 EOR FAC2)
5679	STA	FAC1_s		; save FAC1 sign (b7)
5680LAB_268F
5681	RTS
5682
5683; handle overflow and underflow
5684
5685LAB_2690
5686	LDA	FAC1_s		; get FAC1 sign (b7)
5687	BPL	LAB_269B		; do overflow error
5688
5689					; handle underflow
5690LAB_2696
5691	PLA				; pop return address low byte
5692	PLA				; pop return address high byte
5693	JMP	LAB_24F1		; clear FAC1 exponent and sign and return
5694
5695; multiply by 10
5696
5697LAB_269E
5698	JSR	LAB_27AB		; round and copy FAC1 to FAC2
5699	TAX				; copy exponent (set the flags)
5700	BEQ	LAB_268F		; exit if zero
5701
5702	CLC				; clear carry for add
5703	ADC	#$02			; add two to exponent (*4)
5704	BCS	LAB_269B		; do overflow error if > $FF
5705
5706	LDX	#$00			; clear byte
5707	STX	FAC_sc		; clear sign compare (FAC1 EOR FAC2)
5708	JSR	LAB_247C		; add FAC2 to FAC1 (*5)
5709	INC	FAC1_e		; increment FAC1 exponent (*10)
5710	BNE	LAB_268F		; if non zero just do RTS
5711
5712LAB_269B
5713	JMP	LAB_2564		; do overflow error and warm start
5714
5715; divide by 10
5716
5717LAB_26B9
5718	JSR	LAB_27AB		; round and copy FAC1 to FAC2
5719	LDA	#<LAB_26B5		; set pointer to 10d low addr
5720	LDY	#>LAB_26B5		; set pointer to 10d high addr
5721	LDX	#$00			; clear sign
5722
5723; divide by (AY) (X=sign)
5724
5725LAB_26C2
5726	STX	FAC_sc		; save sign compare (FAC1 EOR FAC2)
5727	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
5728	JMP	LAB_DIVIDE		; do FAC2/FAC1
5729
5730					; Perform divide-by
5731; convert AY and do (AY)/FAC1
5732
5733LAB_26CA
5734	JSR	LAB_264D		; unpack memory (AY) into FAC2
5735
5736					; Perform divide-into
5737LAB_DIVIDE
5738	BEQ	LAB_2737		; if zero go do /0 error
5739
5740	JSR	LAB_27BA		; round FAC1
5741	LDA	#$00			; clear A
5742	SEC				; set carry for subtract
5743	SBC	FAC1_e		; subtract FAC1 exponent (2s complement)
5744	STA	FAC1_e		; save FAC1 exponent
5745	JSR	LAB_2673		; test and adjust accumulators
5746	INC	FAC1_e		; increment FAC1 exponent
5747	BEQ	LAB_269B		; if zero do overflow error
5748
5749	LDX	#$FF			; set index for pre increment
5750	LDA	#$01			; set bit to flag byte save
5751LAB_26E4
5752	LDY	FAC2_1		; get FAC2 mantissa1
5753	CPY	FAC1_1		; compare FAC1 mantissa1
5754	BNE	LAB_26F4		; branch if <>
5755
5756	LDY	FAC2_2		; get FAC2 mantissa2
5757	CPY	FAC1_2		; compare FAC1 mantissa2
5758	BNE	LAB_26F4		; branch if <>
5759
5760	LDY	FAC2_3		; get FAC2 mantissa3
5761	CPY	FAC1_3		; compare FAC1 mantissa3
5762LAB_26F4
5763	PHP				; save FAC2-FAC1 compare status
5764	ROL				; shift the result byte
5765	BCC	LAB_2702		; if no carry skip the byte save
5766
5767	LDY	#$01			; set bit to flag byte save
5768	INX				; else increment the index to FACt
5769	CPX	#$02			; compare with the index to FACt_3
5770	BMI	LAB_2701		; if not last byte just go save it
5771
5772	BNE	LAB_272B		; if all done go save FAC1 rounding byte, normalise and
5773					; return
5774
5775	LDY	#$40			; set bit to flag byte save for the rounding byte
5776LAB_2701
5777	STA	FACt_1,X		; write result byte to FACt_1 + index
5778	TYA				; copy the next save byte flag
5779LAB_2702
5780	PLP				; restore FAC2-FAC1 compare status
5781	BCC	LAB_2704		; if FAC2 < FAC1 then skip the subtract
5782
5783	TAY				; save FAC2-FAC1 compare status
5784	LDA	FAC2_3		; get FAC2 mantissa3
5785	SBC	FAC1_3		; subtract FAC1 mantissa3
5786	STA	FAC2_3		; save FAC2 mantissa3
5787	LDA	FAC2_2		; get FAC2 mantissa2
5788	SBC	FAC1_2		; subtract FAC1 mantissa2
5789	STA	FAC2_2		; save FAC2 mantissa2
5790	LDA	FAC2_1		; get FAC2 mantissa1
5791	SBC	FAC1_1		; subtract FAC1 mantissa1
5792	STA	FAC2_1		; save FAC2 mantissa1
5793	TYA				; restore FAC2-FAC1 compare status
5794
5795					; FAC2 = FAC2*2
5796LAB_2704
5797	ASL	FAC2_3		; shift FAC2 mantissa3
5798	ROL	FAC2_2		; shift FAC2 mantissa2
5799	ROL	FAC2_1		; shift FAC2 mantissa1
5800	BCS	LAB_26F4		; loop with no compare
5801
5802	BMI	LAB_26E4		; loop with compare
5803
5804	BPL	LAB_26F4		; loop always with no compare
5805
5806; do A<<6, save as FAC1 rounding byte, normalise and return
5807
5808LAB_272B
5809	LSR				; shift b1 - b0 ..
5810	ROR				; ..
5811	ROR				; .. to b7 - b6
5812	STA	FAC1_r		; save FAC1 rounding byte
5813	PLP				; dump FAC2-FAC1 compare status
5814	JMP	LAB_273C		; copy temp to FAC1, normalise and return
5815
5816; do "Divide by zero" error
5817
5818LAB_2737
5819	LDX	#$14			; error code $14 ("Divide by zero" error)
5820	JMP	LAB_XERR		; do error #X, then warm start
5821
5822; copy temp to FAC1 and normalise
5823
5824LAB_273C
5825	LDA	FACt_1		; get temp mantissa1
5826	STA	FAC1_1		; save FAC1 mantissa1
5827	LDA	FACt_2		; get temp mantissa2
5828	STA	FAC1_2		; save FAC1 mantissa2
5829	LDA	FACt_3		; get temp mantissa3
5830	STA	FAC1_3		; save FAC1 mantissa3
5831	JMP	LAB_24D5		; normalise FAC1 and return
5832
5833; unpack memory (AY) into FAC1
5834
5835LAB_UFAC
5836	STA	ut1_pl		; save pointer low byte
5837	STY	ut1_ph		; save pointer high byte
5838	LDY	#$03			; 4 bytes to do
5839	LDA	(ut1_pl),Y		; get last byte
5840	STA	FAC1_3		; save FAC1 mantissa3
5841	DEY				; decrement index
5842	LDA	(ut1_pl),Y		; get last-1 byte
5843	STA	FAC1_2		; save FAC1 mantissa2
5844	DEY				; decrement index
5845	LDA	(ut1_pl),Y		; get second byte
5846	STA	FAC1_s		; save FAC1 sign (b7)
5847	ORA	#$80			; set 1xxx xxxx (add normal bit)
5848	STA	FAC1_1		; save FAC1 mantissa1
5849	DEY				; decrement index
5850	LDA	(ut1_pl),Y		; get first byte (exponent)
5851	STA	FAC1_e		; save FAC1 exponent
5852	STY	FAC1_r		; clear FAC1 rounding byte
5853	RTS
5854
5855; pack FAC1 into Adatal
5856
5857LAB_276E
5858	LDX	#<Adatal		; set pointer low byte
5859LAB_2770
5860	LDY	#>Adatal		; set pointer high byte
5861	BEQ	LAB_2778		; pack FAC1 into (XY) and return
5862
5863; pack FAC1 into (Lvarpl)
5864
5865LAB_PFAC
5866	LDX	Lvarpl		; get destination pointer low byte
5867	LDY	Lvarph		; get destination pointer high byte
5868
5869; pack FAC1 into (XY)
5870
5871LAB_2778
5872	JSR	LAB_27BA		; round FAC1
5873	STX	ut1_pl		; save pointer low byte
5874	STY	ut1_ph		; save pointer high byte
5875	LDY	#$03			; set index
5876	LDA	FAC1_3		; get FAC1 mantissa3
5877	STA	(ut1_pl),Y		; store in destination
5878	DEY				; decrement index
5879	LDA	FAC1_2		; get FAC1 mantissa2
5880	STA	(ut1_pl),Y		; store in destination
5881	DEY				; decrement index
5882	LDA	FAC1_s		; get FAC1 sign (b7)
5883	ORA	#$7F			; set bits x111 1111
5884	AND	FAC1_1		; AND in FAC1 mantissa1
5885	STA	(ut1_pl),Y		; store in destination
5886	DEY				; decrement index
5887	LDA	FAC1_e		; get FAC1 exponent
5888	STA	(ut1_pl),Y		; store in destination
5889	STY	FAC1_r		; clear FAC1 rounding byte
5890	RTS
5891
5892; round and copy FAC1 to FAC2
5893
5894LAB_27AB
5895	JSR	LAB_27BA		; round FAC1
5896
5897; copy FAC1 to FAC2
5898
5899LAB_27AE
5900	LDX	#$05			; 5 bytes to copy
5901LAB_27B0
5902	LDA	FAC1_e-1,X		; get byte from FAC1,X
5903	STA	FAC1_o,X		; save byte at FAC2,X
5904	DEX				; decrement count
5905	BNE	LAB_27B0		; loop if not all done
5906
5907	STX	FAC1_r		; clear FAC1 rounding byte
5908LAB_27B9
5909	RTS
5910
5911; round FAC1
5912
5913LAB_27BA
5914	LDA	FAC1_e		; get FAC1 exponent
5915	BEQ	LAB_27B9		; exit if zero
5916
5917	ASL	FAC1_r		; shift FAC1 rounding byte
5918	BCC	LAB_27B9		; exit if no overflow
5919
5920; round FAC1 (no check)
5921
5922LAB_27C2
5923	JSR	LAB_2559		; increment FAC1 mantissa
5924	BNE	LAB_27B9		; branch if no overflow
5925
5926	JMP	LAB_252A		; normalise FAC1 for C=1 and return
5927
5928; get FAC1 sign
5929; return A=FF,C=1/-ve A=01,C=0/+ve
5930
5931LAB_27CA
5932	LDA	FAC1_e		; get FAC1 exponent
5933	BEQ	LAB_27D7		; exit if zero (already correct SGN(0)=0)
5934
5935; return A=FF,C=1/-ve A=01,C=0/+ve
5936; no = 0 check
5937
5938LAB_27CE
5939	LDA	FAC1_s		; else get FAC1 sign (b7)
5940
5941; return A=FF,C=1/-ve A=01,C=0/+ve
5942; no = 0 check, sign in A
5943
5944LAB_27D0
5945	ROL				; move sign bit to carry
5946	LDA	#$FF			; set byte for -ve result
5947	BCS	LAB_27D7		; return if sign was set (-ve)
5948
5949	LDA	#$01			; else set byte for +ve result
5950LAB_27D7
5951	RTS
5952
5953; perform SGN()
5954
5955LAB_SGN
5956	JSR	LAB_27CA		; get FAC1 sign
5957					; return A=$FF/-ve A=$01/+ve
5958; save A as integer byte
5959
5960LAB_27DB
5961	STA	FAC1_1		; save FAC1 mantissa1
5962	LDA	#$00			; clear A
5963	STA	FAC1_2		; clear FAC1 mantissa2
5964	LDX	#$88			; set exponent
5965
5966; set exp=X, clearFAC1 mantissa3 and normalise
5967
5968LAB_27E3
5969	LDA	FAC1_1		; get FAC1 mantissa1
5970	EOR	#$FF			; complement it
5971	ROL				; sign bit into carry
5972
5973; set exp=X, clearFAC1 mantissa3 and normalise
5974
5975LAB_STFA
5976	LDA	#$00			; clear A
5977	STA	FAC1_3		; clear FAC1 mantissa3
5978	STX	FAC1_e		; set FAC1 exponent
5979	STA	FAC1_r		; clear FAC1 rounding byte
5980	STA	FAC1_s		; clear FAC1 sign (b7)
5981	JMP	LAB_24D0		; do ABS and normalise FAC1
5982
5983; perform ABS()
5984
5985LAB_ABS
5986	LSR	FAC1_s		; clear FAC1 sign (put zero in b7)
5987	RTS
5988
5989; compare FAC1 with (AY)
5990; returns A=$00 if FAC1 = (AY)
5991; returns A=$01 if FAC1 > (AY)
5992; returns A=$FF if FAC1 < (AY)
5993
5994LAB_27F8
5995	STA	ut2_pl		; save pointer low byte
5996LAB_27FA
5997	STY	ut2_ph		; save pointer high byte
5998	LDY	#$00			; clear index
5999	LDA	(ut2_pl),Y		; get exponent
6000	INY				; increment index
6001	TAX				; copy (AY) exponent to X
6002	BEQ	LAB_27CA		; branch if (AY) exponent=0 and get FAC1 sign
6003					; A=FF,C=1/-ve A=01,C=0/+ve
6004
6005	LDA	(ut2_pl),Y		; get (AY) mantissa1 (with sign)
6006	EOR	FAC1_s		; EOR FAC1 sign (b7)
6007	BMI	LAB_27CE		; if signs <> do return A=FF,C=1/-ve
6008					; A=01,C=0/+ve and return
6009
6010	CPX	FAC1_e		; compare (AY) exponent with FAC1 exponent
6011	BNE	LAB_2828		; branch if different
6012
6013	LDA	(ut2_pl),Y		; get (AY) mantissa1 (with sign)
6014	ORA	#$80			; normalise top bit
6015	CMP	FAC1_1		; compare with FAC1 mantissa1
6016	BNE	LAB_2828		; branch if different
6017
6018	INY				; increment index
6019	LDA	(ut2_pl),Y		; get mantissa2
6020	CMP	FAC1_2		; compare with FAC1 mantissa2
6021	BNE	LAB_2828		; branch if different
6022
6023	INY				; increment index
6024	LDA	#$7F			; set for 1/2 value rounding byte
6025	CMP	FAC1_r		; compare with FAC1 rounding byte (set carry)
6026	LDA	(ut2_pl),Y		; get mantissa3
6027	SBC	FAC1_3		; subtract FAC1 mantissa3
6028	BEQ	LAB_2850		; exit if mantissa3 equal
6029
6030; gets here if number <> FAC1
6031
6032LAB_2828
6033	LDA	FAC1_s		; get FAC1 sign (b7)
6034	BCC	LAB_282E		; branch if FAC1 > (AY)
6035
6036	EOR	#$FF			; else toggle FAC1 sign
6037LAB_282E
6038	JMP	LAB_27D0		; return A=FF,C=1/-ve A=01,C=0/+ve
6039
6040; convert FAC1 floating-to-fixed
6041
6042LAB_2831
6043	LDA	FAC1_e		; get FAC1 exponent
6044	BEQ	LAB_287F		; if zero go clear FAC1 and return
6045
6046	SEC				; set carry for subtract
6047	SBC	#$98			; subtract maximum integer range exponent
6048	BIT	FAC1_s		; test FAC1 sign (b7)
6049	BPL	LAB_2845		; branch if FAC1 +ve
6050
6051					; FAC1 was -ve
6052	TAX				; copy subtracted exponent
6053	LDA	#$FF			; overflow for -ve number
6054	STA	FAC1_o		; set FAC1 overflow byte
6055	JSR	LAB_253D		; twos complement FAC1 mantissa
6056	TXA				; restore subtracted exponent
6057LAB_2845
6058	LDX	#FAC1_e		; set index to FAC1
6059	CMP	#$F9			; compare exponent result
6060	BPL	LAB_2851		; if < 8 shifts shift FAC1 A times right and return
6061
6062	JSR	LAB_257B		; shift FAC1 A times right (> 8 shifts)
6063	STY	FAC1_o		; clear FAC1 overflow byte
6064LAB_2850
6065	RTS
6066
6067; shift FAC1 A times right
6068
6069LAB_2851
6070	TAY				; copy shift count
6071	LDA	FAC1_s		; get FAC1 sign (b7)
6072	AND	#$80			; mask sign bit only (x000 0000)
6073	LSR	FAC1_1		; shift FAC1 mantissa1
6074	ORA	FAC1_1		; OR sign in b7 FAC1 mantissa1
6075	STA	FAC1_1		; save FAC1 mantissa1
6076	JSR	LAB_2592		; shift FAC1 Y times right
6077	STY	FAC1_o		; clear FAC1 overflow byte
6078	RTS
6079
6080; perform INT()
6081
6082LAB_INT
6083	LDA	FAC1_e		; get FAC1 exponent
6084	CMP	#$98			; compare with max int
6085	BCS	LAB_2886		; exit if >= (already int, too big for fractional part!)
6086
6087	JSR	LAB_2831		; convert FAC1 floating-to-fixed
6088	STY	FAC1_r		; save FAC1 rounding byte
6089	LDA	FAC1_s		; get FAC1 sign (b7)
6090	STY	FAC1_s		; save FAC1 sign (b7)
6091	EOR	#$80			; toggle FAC1 sign
6092	ROL				; shift into carry
6093	LDA	#$98			; set new exponent
6094	STA	FAC1_e		; save FAC1 exponent
6095	LDA	FAC1_3		; get FAC1 mantissa3
6096	STA	Temp3			; save for EXP() function
6097	JMP	LAB_24D0		; do ABS and normalise FAC1
6098
6099; clear FAC1 and return
6100
6101LAB_287F
6102	STA	FAC1_1		; clear FAC1 mantissa1
6103	STA	FAC1_2		; clear FAC1 mantissa2
6104	STA	FAC1_3		; clear FAC1 mantissa3
6105	TAY				; clear Y
6106LAB_2886
6107	RTS
6108
6109; get FAC1 from string
6110; this routine now handles hex and binary values from strings
6111; starting with "$" and "%" respectively
6112
6113LAB_2887
6114	LDY	#$00			; clear Y
6115	STY	Dtypef		; clear data type flag, $FF=string, $00=numeric
6116	LDX	#$09			; set index
6117LAB_288B
6118	STY	numexp,X		; clear byte
6119	DEX				; decrement index
6120	BPL	LAB_288B		; loop until numexp to negnum (and FAC1) = $00
6121
6122	BCC	LAB_28FE		; branch if 1st character numeric
6123
6124; get FAC1 from string .. first character wasn't numeric
6125
6126	CMP	#'-'			; else compare with "-"
6127	BNE	LAB_289A		; branch if not "-"
6128
6129	STX	negnum		; set flag for -ve number (X = $FF)
6130	BEQ	LAB_289C		; branch always (go scan and check for hex/bin)
6131
6132; get FAC1 from string .. first character wasn't numeric or -
6133
6134LAB_289A
6135	CMP	#'+'			; else compare with "+"
6136	BNE	LAB_289D		; branch if not "+" (go check for hex/bin)
6137
6138; was "+" or "-" to start, so get next character
6139
6140LAB_289C
6141	JSR	LAB_IGBY		; increment and scan memory
6142	BCC	LAB_28FE		; branch if numeric character
6143
6144; code here for hex and binary numbers
6145
6146LAB_289D
6147	CMP	#'$'			; else compare with "$"
6148	BNE	LAB_NHEX		; branch if not "$"
6149
6150	JMP	LAB_CHEX		; branch if "$"
6151
6152LAB_NHEX
6153	CMP	#'%'			; else compare with "%"
6154	BNE	LAB_28A3		; branch if not "%" (continue original code)
6155
6156	JMP	LAB_CBIN		; branch if "%"
6157
6158LAB_289E
6159	JSR	LAB_IGBY		; increment and scan memory (ignore + or get next number)
6160LAB_28A1
6161	BCC	LAB_28FE		; branch if numeric character
6162
6163; get FAC1 from string .. character wasn't numeric, -, +, hex or binary
6164
6165LAB_28A3
6166	CMP	#'.'			; else compare with "."
6167	BEQ	LAB_28D5		; branch if "."
6168
6169; get FAC1 from string .. character wasn't numeric, -, + or .
6170
6171	CMP	#'E'			; else compare with "E"
6172	BNE	LAB_28DB		; branch if not "E"
6173
6174					; was "E" so evaluate exponential part
6175	JSR	LAB_IGBY		; increment and scan memory
6176	BCC	LAB_28C7		; branch if numeric character
6177
6178	CMP	#TK_MINUS		; else compare with token for -
6179	BEQ	LAB_28C2		; branch if token for -
6180
6181	CMP	#'-'			; else compare with "-"
6182	BEQ	LAB_28C2		; branch if "-"
6183
6184	CMP	#TK_PLUS		; else compare with token for +
6185	BEQ	LAB_28C4		; branch if token for +
6186
6187	CMP	#'+'			; else compare with "+"
6188	BEQ	LAB_28C4		; branch if "+"
6189
6190	BNE	LAB_28C9		; branch always
6191
6192LAB_28C2
6193	ROR	expneg		; set exponent -ve flag (C, which=1, into b7)
6194LAB_28C4
6195	JSR	LAB_IGBY		; increment and scan memory
6196LAB_28C7
6197	BCC	LAB_2925		; branch if numeric character
6198
6199LAB_28C9
6200	BIT	expneg		; test exponent -ve flag
6201	BPL	LAB_28DB		; if +ve go evaluate exponent
6202
6203					; else do exponent = -exponent 
6204	LDA	#$00			; clear result
6205	SEC				; set carry for subtract
6206	SBC	expcnt		; subtract exponent byte
6207	JMP	LAB_28DD		; go evaluate exponent
6208
6209LAB_28D5
6210	ROR	numdpf		; set decimal point flag
6211	BIT	numdpf		; test decimal point flag
6212	BVC	LAB_289E		; branch if only one decimal point so far
6213
6214					; evaluate exponent
6215LAB_28DB
6216	LDA	expcnt		; get exponent count byte
6217LAB_28DD
6218	SEC				; set carry for subtract
6219	SBC	numexp		; subtract numerator exponent
6220	STA	expcnt		; save exponent count byte
6221	BEQ	LAB_28F6		; branch if no adjustment
6222
6223	BPL	LAB_28EF		; else if +ve go do FAC1*10^expcnt
6224
6225					; else go do FAC1/10^(0-expcnt)
6226LAB_28E6
6227	JSR	LAB_26B9		; divide by 10
6228	INC	expcnt		; increment exponent count byte
6229	BNE	LAB_28E6		; loop until all done
6230
6231	BEQ	LAB_28F6		; branch always
6232
6233LAB_28EF
6234	JSR	LAB_269E		; multiply by 10
6235	DEC	expcnt		; decrement exponent count byte
6236	BNE	LAB_28EF		; loop until all done
6237
6238LAB_28F6
6239	LDA	negnum		; get -ve flag
6240	BMI	LAB_28FB		; if -ve do - FAC1 and return
6241
6242	RTS
6243
6244; do - FAC1 and return
6245
6246LAB_28FB
6247	JMP	LAB_GTHAN		; do - FAC1 and return
6248
6249; do unsigned FAC1*10+number
6250
6251LAB_28FE
6252	PHA				; save character
6253	BIT	numdpf		; test decimal point flag
6254	BPL	LAB_2905		; skip exponent increment if not set
6255
6256	INC	numexp		; else increment number exponent
6257LAB_2905
6258	JSR	LAB_269E		; multiply FAC1 by 10
6259	PLA				; restore character
6260	AND	#$0F			; convert to binary
6261	JSR	LAB_2912		; evaluate new ASCII digit
6262	JMP	LAB_289E		; go do next character
6263
6264; evaluate new ASCII digit
6265
6266LAB_2912
6267	PHA				; save digit
6268	JSR	LAB_27AB		; round and copy FAC1 to FAC2
6269	PLA				; restore digit
6270	JSR	LAB_27DB		; save A as integer byte
6271	LDA	FAC2_s		; get FAC2 sign (b7)
6272	EOR	FAC1_s		; toggle with FAC1 sign (b7)
6273	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
6274	LDX	FAC1_e		; get FAC1 exponent
6275	JMP	LAB_ADD		; add FAC2 to FAC1 and return
6276
6277; evaluate next character of exponential part of number
6278
6279LAB_2925
6280	LDA	expcnt		; get exponent count byte
6281	CMP	#$0A			; compare with 10 decimal
6282	BCC	LAB_2934		; branch if less
6283
6284	LDA	#$64			; make all -ve exponents = -100 decimal (causes underflow)
6285	BIT	expneg		; test exponent -ve flag
6286	BMI	LAB_2942		; branch if -ve
6287
6288	JMP	LAB_2564		; else do overflow error
6289
6290LAB_2934
6291	ASL				; * 2
6292	ASL				; * 4
6293	ADC	expcnt		; * 5
6294	ASL				; * 10
6295	LDY	#$00			; set index
6296	ADC	(Bpntrl),Y		; add character (will be $30 too much!)
6297	SBC	#'0'-1		; convert character to binary
6298LAB_2942
6299	STA	expcnt		; save exponent count byte
6300	JMP	LAB_28C4		; go get next character
6301
6302; print " in line [LINE #]"
6303
6304LAB_2953
6305	LDA	#<LAB_LMSG		; point to " in line " message low byte
6306	LDY	#>LAB_LMSG		; point to " in line " message high byte
6307	JSR	LAB_18C3		; print null terminated string from memory
6308
6309					; print Basic line #
6310	LDA	Clineh		; get current line high byte
6311	LDX	Clinel		; get current line low byte
6312
6313; print XA as unsigned integer
6314
6315LAB_295E
6316	STA	FAC1_1		; save low byte as FAC1 mantissa1
6317	STX	FAC1_2		; save high byte as FAC1 mantissa2
6318	LDX	#$90			; set exponent to 16d bits
6319	SEC				; set integer is +ve flag
6320	JSR	LAB_STFA		; set exp=X, clearFAC1 mantissa3 and normalise
6321	LDY	#$00			; clear index
6322	TYA				; clear A
6323	JSR	LAB_297B		; convert FAC1 to string, skip sign character save
6324	JMP	LAB_18C3		; print null terminated string from memory and return
6325
6326; convert FAC1 to ASCII string result in (AY)
6327; not any more, moved scratchpad to page 0
6328
6329LAB_296E
6330	LDY	#$01			; set index = 1
6331	LDA	#$20			; character = " " (assume +ve)
6332	BIT	FAC1_s		; test FAC1 sign (b7)
6333	BPL	LAB_2978		; branch if +ve
6334
6335	LDA	#$2D			; else character = "-"
6336LAB_2978
6337	STA	Decss,Y		; save leading character (" " or "-")
6338LAB_297B
6339	STA	FAC1_s		; clear FAC1 sign (b7)
6340	STY	Sendl			; save index
6341	INY				; increment index
6342	LDX	FAC1_e		; get FAC1 exponent
6343	BNE	LAB_2989		; branch if FAC1<>0
6344
6345					; exponent was $00 so FAC1 is 0
6346	LDA	#'0'			; set character = "0"
6347	JMP	LAB_2A89		; save last character, [EOT] and exit
6348
6349					; FAC1 is some non zero value
6350LAB_2989
6351	LDA	#$00			; clear (number exponent count)
6352	CPX	#$81			; compare FAC1 exponent with $81 (>1.00000)
6353
6354	BCS	LAB_299A		; branch if FAC1=>1
6355
6356					; FAC1<1
6357	LDA	#<LAB_294F		; set pointer low byte to 1,000,000
6358	LDY	#>LAB_294F		; set pointer high byte to 1,000,000
6359	JSR	LAB_25FB		; do convert AY, FCA1*(AY)
6360	LDA	#$FA			; set number exponent count (-6)
6361LAB_299A
6362	STA	numexp		; save number exponent count
6363LAB_299C
6364	LDA	#<LAB_294B		; set pointer low byte to 999999.4375 (max before sci note)
6365	LDY	#>LAB_294B		; set pointer high byte to 999999.4375
6366	JSR	LAB_27F8		; compare FAC1 with (AY)
6367	BEQ	LAB_29C3		; exit if FAC1 = (AY)
6368
6369	BPL	LAB_29B9		; go do /10 if FAC1 > (AY)
6370
6371					; FAC1 < (AY)
6372LAB_29A7
6373	LDA	#<LAB_2947		; set pointer low byte to 99999.9375
6374	LDY	#>LAB_2947		; set pointer high byte to 99999.9375
6375	JSR	LAB_27F8		; compare FAC1 with (AY)
6376	BEQ	LAB_29B2		; branch if FAC1 = (AY) (allow decimal places)
6377
6378	BPL	LAB_29C0		; branch if FAC1 > (AY) (no decimal places)
6379
6380					; FAC1 <= (AY)
6381LAB_29B2
6382	JSR	LAB_269E		; multiply by 10
6383	DEC	numexp		; decrement number exponent count
6384	BNE	LAB_29A7		; go test again (branch always)
6385
6386LAB_29B9
6387	JSR	LAB_26B9		; divide by 10
6388	INC	numexp		; increment number exponent count
6389	BNE	LAB_299C		; go test again (branch always)
6390
6391; now we have just the digits to do
6392
6393LAB_29C0
6394	JSR	LAB_244E		; add 0.5 to FAC1 (round FAC1)
6395LAB_29C3
6396	JSR	LAB_2831		; convert FAC1 floating-to-fixed
6397	LDX	#$01			; set default digits before dp = 1
6398	LDA	numexp		; get number exponent count
6399	CLC				; clear carry for add
6400	ADC	#$07			; up to 6 digits before point
6401	BMI	LAB_29D8		; if -ve then 1 digit before dp
6402
6403	CMP	#$08			; A>=8 if n>=1E6
6404	BCS	LAB_29D9		; branch if >= $08
6405
6406					; carry is clear
6407	ADC	#$FF			; take 1 from digit count
6408	TAX				; copy to A
6409	LDA	#$02			;.set exponent adjust
6410LAB_29D8
6411	SEC				; set carry for subtract
6412LAB_29D9
6413	SBC	#$02			; -2
6414	STA	expcnt		;.save exponent adjust
6415	STX	numexp		; save digits before dp count
6416	TXA				; copy to A
6417	BEQ	LAB_29E4		; branch if no digits before dp
6418
6419	BPL	LAB_29F7		; branch if digits before dp
6420
6421LAB_29E4
6422	LDY	Sendl			; get output string index
6423	LDA	#$2E			; character "."
6424	INY				; increment index
6425	STA	Decss,Y		; save to output string
6426	TXA				;.
6427	BEQ	LAB_29F5		;.
6428
6429	LDA	#'0'			; character "0"
6430	INY				; increment index
6431	STA	Decss,Y		; save to output string
6432LAB_29F5
6433	STY	Sendl			; save output string index
6434LAB_29F7
6435	LDY	#$00			; clear index (point to 100,000)
6436	LDX	#$80			; 
6437LAB_29FB
6438	LDA	FAC1_3		; get FAC1 mantissa3
6439	CLC				; clear carry for add
6440	ADC	LAB_2A9C,Y		; add -ve LSB
6441	STA	FAC1_3		; save FAC1 mantissa3
6442	LDA	FAC1_2		; get FAC1 mantissa2
6443	ADC	LAB_2A9B,Y		; add -ve NMSB
6444	STA	FAC1_2		; save FAC1 mantissa2
6445	LDA	FAC1_1		; get FAC1 mantissa1
6446	ADC	LAB_2A9A,Y		; add -ve MSB
6447	STA	FAC1_1		; save FAC1 mantissa1
6448	INX				; 
6449	BCS	LAB_2A18		; 
6450
6451	BPL	LAB_29FB		; not -ve so try again
6452
6453	BMI	LAB_2A1A		; 
6454
6455LAB_2A18
6456	BMI	LAB_29FB		; 
6457
6458LAB_2A1A
6459	TXA				; 
6460	BCC	LAB_2A21		; 
6461
6462	EOR	#$FF			; 
6463	ADC	#$0A			; 
6464LAB_2A21
6465	ADC	#'0'-1		; add "0"-1 to result
6466	INY				; increment index ..
6467	INY				; .. to next less ..
6468	INY				; .. power of ten
6469	STY	Cvaral		; save as current var address low byte
6470	LDY	Sendl			; get output string index
6471	INY				; increment output string index
6472	TAX				; copy character to X
6473	AND	#$7F			; mask out top bit
6474	STA	Decss,Y		; save to output string
6475	DEC	numexp		; decrement # of characters before the dp
6476	BNE	LAB_2A3B		; branch if still characters to do
6477
6478					; else output the point
6479	LDA	#$2E			; character "."
6480	INY				; increment output string index
6481	STA	Decss,Y		; save to output string
6482LAB_2A3B
6483	STY	Sendl			; save output string index
6484	LDY	Cvaral		; get current var address low byte
6485	TXA				; get character back
6486	EOR	#$FF			; 
6487	AND	#$80			; 
6488	TAX				; 
6489	CPY	#$12			; compare index with max
6490	BNE	LAB_29FB		; loop if not max
6491
6492					; now remove trailing zeroes
6493	LDY	Sendl			; get output string index
6494LAB_2A4B
6495	LDA	Decss,Y		; get character from output string
6496	DEY				; decrement output string index
6497	CMP	#'0'			; compare with "0"
6498	BEQ	LAB_2A4B		; loop until non "0" character found
6499
6500	CMP	#'.'			; compare with "."
6501	BEQ	LAB_2A58		; branch if was dp
6502
6503					; restore last character
6504	INY				; increment output string index
6505LAB_2A58
6506	LDA	#$2B			; character "+"
6507	LDX	expcnt		; get exponent count
6508	BEQ	LAB_2A8C		; if zero go set null terminator and exit
6509
6510					; exponent isn't zero so write exponent
6511	BPL	LAB_2A68		; branch if exponent count +ve
6512
6513	LDA	#$00			; clear A
6514	SEC				; set carry for subtract
6515	SBC	expcnt		; subtract exponent count adjust (convert -ve to +ve)
6516	TAX				; copy exponent count to X
6517	LDA	#'-'			; character "-"
6518LAB_2A68
6519	STA	Decss+2,Y		; save to output string
6520	LDA	#$45			; character "E"
6521	STA	Decss+1,Y		; save exponent sign to output string
6522	TXA				; get exponent count back
6523	LDX	#'0'-1		; one less than "0" character
6524	SEC				; set carry for subtract
6525LAB_2A74
6526	INX				; increment 10's character
6527	SBC	#$0A			;.subtract 10 from exponent count
6528	BCS	LAB_2A74		; loop while still >= 0
6529
6530	ADC	#':'			; add character ":" ($30+$0A, result is 10 less that value)
6531	STA	Decss+4,Y		; save to output string
6532	TXA				; copy 10's character
6533	STA	Decss+3,Y		; save to output string
6534	LDA	#$00			; set null terminator
6535	STA	Decss+5,Y		; save to output string
6536	BEQ	LAB_2A91		; go set string pointer (AY) and exit (branch always)
6537
6538					; save last character, [EOT] and exit
6539LAB_2A89
6540	STA	Decss,Y		; save last character to output string
6541
6542					; set null terminator and exit
6543LAB_2A8C
6544	LDA	#$00			; set null terminator
6545	STA	Decss+1,Y		; save after last character
6546
6547					; set string pointer (AY) and exit
6548LAB_2A91
6549	LDA	#<Decssp1		; set result string low pointer
6550	LDY	#>Decssp1		; set result string high pointer
6551	RTS
6552
6553; perform power function
6554
6555LAB_POWER
6556	BEQ	LAB_EXP		; go do  EXP()
6557
6558	LDA	FAC2_e		; get FAC2 exponent
6559	BNE	LAB_2ABF		; branch if FAC2<>0
6560
6561	JMP	LAB_24F3		; clear FAC1 exponent and sign and return
6562
6563LAB_2ABF
6564	LDX	#<func_l		; set destination pointer low byte
6565	LDY	#>func_l		; set destination pointer high byte
6566	JSR	LAB_2778		; pack FAC1 into (XY)
6567	LDA	FAC2_s		; get FAC2 sign (b7)
6568	BPL	LAB_2AD9		; branch if FAC2>0
6569
6570					; else FAC2 is -ve and can only be raised to an
6571					; integer power which gives an x +j0 result
6572	JSR	LAB_INT		; perform INT
6573	LDA	#<func_l		; set source pointer low byte
6574	LDY	#>func_l		; set source pointer high byte
6575	JSR	LAB_27F8		; compare FAC1 with (AY)
6576	BNE	LAB_2AD9		; branch if FAC1 <> (AY) to allow Function Call error
6577					; this will leave FAC1 -ve and cause a Function Call
6578					; error when LOG() is called
6579
6580	TYA				; clear sign b7
6581	LDY	Temp3			; save mantissa 3 from INT() function as sign in Y
6582					; for possible later negation, b0
6583LAB_2AD9
6584	JSR	LAB_279D		; save FAC1 sign and copy ABS(FAC2) to FAC1
6585	TYA				; copy sign back ..
6586	PHA				; .. and save it
6587	JSR	LAB_LOG		; do LOG(n)
6588	LDA	#<garb_l		; set pointer low byte
6589	LDY	#>garb_l		; set pointer high byte
6590	JSR	LAB_25FB		; do convert AY, FCA1*(AY) (square the value)
6591	JSR	LAB_EXP		; go do EXP(n)
6592	PLA				; pull sign from stack
6593	LSR				; b0 is to be tested, shift to Cb
6594	BCC	LAB_2AF9		; if no bit then exit
6595
6596					; Perform negation
6597; do - FAC1
6598
6599LAB_GTHAN
6600	LDA	FAC1_e		; get FAC1 exponent
6601	BEQ	LAB_2AF9		; exit if FAC1_e = $00
6602
6603	LDA	FAC1_s		; get FAC1 sign (b7)
6604	EOR	#$FF			; complement it
6605	STA	FAC1_s		; save FAC1 sign (b7)
6606LAB_2AF9
6607	RTS
6608
6609; perform EXP()	(x^e)
6610
6611LAB_EXP
6612	LDA	#<LAB_2AFA		; set 1.443 pointer low byte
6613	LDY	#>LAB_2AFA		; set 1.443 pointer high byte
6614	JSR	LAB_25FB		; do convert AY, FCA1*(AY)
6615	LDA	FAC1_r		; get FAC1 rounding byte
6616	ADC	#$50			; +$50/$100
6617	BCC	LAB_2B2B		; skip rounding if no carry
6618
6619	JSR	LAB_27C2		; round FAC1 (no check)
6620LAB_2B2B
6621	STA	FAC2_r		; save FAC2 rounding byte
6622	JSR	LAB_27AE		; copy FAC1 to FAC2
6623	LDA	FAC1_e		; get FAC1 exponent
6624	CMP	#$88			; compare with EXP limit (256d)
6625	BCC	LAB_2B39		; branch if less
6626
6627LAB_2B36
6628	JSR	LAB_2690		; handle overflow and underflow
6629LAB_2B39
6630	JSR	LAB_INT		; perform INT
6631	LDA	Temp3			; get mantissa 3 from INT() function
6632	CLC				; clear carry for add
6633	ADC	#$81			; normalise +1
6634	BEQ	LAB_2B36		; if $00 go handle overflow
6635
6636	SEC				; set carry for subtract
6637	SBC	#$01			; now correct for exponent
6638	PHA				; save FAC2 exponent
6639
6640					; swap FAC1 and FAC2
6641	LDX	#$04			; 4 bytes to do
6642LAB_2B49
6643	LDA	FAC2_e,X		; get FAC2,X
6644	LDY	FAC1_e,X		; get FAC1,X
6645	STA	FAC1_e,X		; save FAC1,X
6646	STY	FAC2_e,X		; save FAC2,X
6647	DEX				; decrement count/index
6648	BPL	LAB_2B49		; loop if not all done
6649
6650	LDA	FAC2_r		; get FAC2 rounding byte
6651	STA	FAC1_r		; save as FAC1 rounding byte
6652	JSR	LAB_SUBTRACT	; perform subtraction, FAC2 from FAC1
6653	JSR	LAB_GTHAN		; do - FAC1
6654	LDA	#<LAB_2AFE		; set counter pointer low byte
6655	LDY	#>LAB_2AFE		; set counter pointer high byte
6656	JSR	LAB_2B84		; go do series evaluation
6657	LDA	#$00			; clear A
6658	STA	FAC_sc		; clear sign compare (FAC1 EOR FAC2)
6659	PLA				;.get saved FAC2 exponent
6660	JMP	LAB_2675		; test and adjust accumulators and return
6661
6662; ^2 then series evaluation
6663
6664LAB_2B6E
6665	STA	Cptrl			; save count pointer low byte
6666	STY	Cptrh			; save count pointer high byte
6667	JSR	LAB_276E		; pack FAC1 into Adatal
6668	LDA	#<Adatal		; set pointer low byte (Y already $00)
6669	JSR	LAB_25FB		; do convert AY, FCA1*(AY)
6670	JSR	LAB_2B88		; go do series evaluation
6671	LDA	#<Adatal		; pointer to original # low byte
6672	LDY	#>Adatal		; pointer to original # high byte
6673	JMP	LAB_25FB		; do convert AY, FCA1*(AY) and return
6674
6675; series evaluation
6676
6677LAB_2B84
6678	STA	Cptrl			; save count pointer low byte
6679	STY	Cptrh			; save count pointer high byte
6680LAB_2B88
6681	LDX	#<numexp		; set pointer low byte
6682	JSR	LAB_2770		; set pointer high byte and pack FAC1 into numexp
6683	LDA	(Cptrl),Y		; get constants count
6684	STA	numcon		; save constants count
6685	LDY	Cptrl			; get count pointer low byte
6686	INY				; increment it (now constants pointer)
6687	TYA				; copy it
6688	BNE	LAB_2B97		; skip next if no overflow
6689
6690	INC	Cptrh			; else increment high byte
6691LAB_2B97
6692	STA	Cptrl			; save low byte
6693	LDY	Cptrh			; get high byte
6694LAB_2B9B
6695	JSR	LAB_25FB		; do convert AY, FCA1*(AY)
6696	LDA	Cptrl			; get constants pointer low byte
6697	LDY	Cptrh			; get constants pointer high byte
6698	CLC				; clear carry for add
6699	ADC	#$04			; +4 to  low pointer (4 bytes per constant)
6700	BCC	LAB_2BA8		; skip next if no overflow
6701
6702	INY				; increment high byte
6703LAB_2BA8
6704	STA	Cptrl			; save pointer low byte
6705	STY	Cptrh			; save pointer high byte
6706	JSR	LAB_246C		; add (AY) to FAC1
6707	LDA	#<numexp		; set pointer low byte to partial @ numexp
6708	LDY	#>numexp		; set pointer high byte to partial @ numexp
6709	DEC	numcon		; decrement constants count
6710	BNE	LAB_2B9B		; loop until all done
6711
6712	RTS
6713
6714; RND(n), 32 bit Galoise version. make n=0 for 19th next number in sequence or n<>0
6715; to get 19th next number in sequence after seed n. This version of the PRNG uses
6716; the Galois method and a sample of 65536 bytes produced gives the following values.
6717
6718; Entropy = 7.997442 bits per byte
6719; Optimum compression would reduce these 65536 bytes by 0 percent
6720
6721; Chi square distribution for 65536 samples is 232.01, and
6722; randomly would exceed this value 75.00 percent of the time
6723
6724; Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
6725; Monte Carlo value for Pi is 3.122871269, error 0.60 percent
6726; Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0
6727
6728LAB_RND
6729	LDA	FAC1_e		; get FAC1 exponent
6730	BEQ	NextPRN		; do next random # if zero
6731
6732					; else get seed into random number store
6733	LDX	#Rbyte4		; set PRNG pointer low byte
6734	LDY	#$00			; set PRNG pointer high byte
6735	JSR	LAB_2778		; pack FAC1 into (XY)
6736NextPRN
6737	LDX	#$AF			; set EOR byte
6738	LDY	#$13			; do this nineteen times
6739LoopPRN
6740	ASL	Rbyte1		; shift PRNG most significant byte
6741	ROL	Rbyte2		; shift PRNG middle byte
6742	ROL	Rbyte3		; shift PRNG least significant byte
6743	ROL	Rbyte4		; shift PRNG extra byte
6744	BCC	Ninc1			; branch if bit 32 clear
6745
6746	TXA				; set EOR byte
6747	EOR	Rbyte1		; EOR PRNG extra byte
6748	STA	Rbyte1		; save new PRNG extra byte
6749Ninc1
6750	DEY				; decrement loop count
6751	BNE	LoopPRN		; loop if not all done
6752
6753	LDX	#$02			; three bytes to copy
6754CopyPRNG
6755	LDA	Rbyte1,X		; get PRNG byte
6756	STA	FAC1_1,X		; save FAC1 byte
6757	DEX
6758	BPL	CopyPRNG		; loop if not complete
6759
6760	LDA	#$80			; set the exponent
6761	STA	FAC1_e		; save FAC1 exponent
6762
6763	ASL				; clear A
6764	STA	FAC1_s		; save FAC1 sign
6765
6766	JMP	LAB_24D5		; normalise FAC1 and return
6767
6768; perform COS()
6769
6770LAB_COS
6771	LDA	#<LAB_2C78		; set (pi/2) pointer low byte
6772	LDY	#>LAB_2C78		; set (pi/2) pointer high byte
6773	JSR	LAB_246C		; add (AY) to FAC1
6774
6775; perform SIN()
6776
6777LAB_SIN
6778	JSR	LAB_27AB		; round and copy FAC1 to FAC2
6779	LDA	#<LAB_2C7C		; set (2*pi) pointer low byte
6780	LDY	#>LAB_2C7C		; set (2*pi) pointer high byte
6781	LDX	FAC2_s		; get FAC2 sign (b7)
6782	JSR	LAB_26C2		; divide by (AY) (X=sign)
6783	JSR	LAB_27AB		; round and copy FAC1 to FAC2
6784	JSR	LAB_INT		; perform INT
6785	LDA	#$00			; clear byte
6786	STA	FAC_sc		; clear sign compare (FAC1 EOR FAC2)
6787	JSR	LAB_SUBTRACT	; perform subtraction, FAC2 from FAC1
6788	LDA	#<LAB_2C80		; set 0.25 pointer low byte
6789	LDY	#>LAB_2C80		; set 0.25 pointer high byte
6790	JSR	LAB_2455		; perform subtraction, (AY) from FAC1
6791	LDA	FAC1_s		; get FAC1 sign (b7)
6792	PHA				; save FAC1 sign
6793	BPL	LAB_2C35		; branch if +ve
6794
6795					; FAC1 sign was -ve
6796	JSR	LAB_244E		; add 0.5 to FAC1
6797	LDA	FAC1_s		; get FAC1 sign (b7)
6798	BMI	LAB_2C38		; branch if -ve
6799
6800	LDA	Cflag			; get comparison evaluation flag
6801	EOR	#$FF			; toggle flag
6802	STA	Cflag			; save comparison evaluation flag
6803LAB_2C35
6804	JSR	LAB_GTHAN		; do - FAC1
6805LAB_2C38
6806	LDA	#<LAB_2C80		; set 0.25 pointer low byte
6807	LDY	#>LAB_2C80		; set 0.25 pointer high byte
6808	JSR	LAB_246C		; add (AY) to FAC1
6809	PLA				; restore FAC1 sign
6810	BPL	LAB_2C45		; branch if was +ve
6811
6812					; else correct FAC1
6813	JSR	LAB_GTHAN		; do - FAC1
6814LAB_2C45
6815	LDA	#<LAB_2C84		; set pointer low byte to counter
6816	LDY	#>LAB_2C84		; set pointer high byte to counter
6817	JMP	LAB_2B6E		; ^2 then series evaluation and return
6818
6819; perform TAN()
6820
6821LAB_TAN
6822	JSR	LAB_276E		; pack FAC1 into Adatal
6823	LDA	#$00			; clear byte
6824	STA	Cflag			; clear comparison evaluation flag
6825	JSR	LAB_SIN		; go do SIN(n)
6826	LDX	#<func_l		; set sin(n) pointer low byte
6827	LDY	#>func_l		; set sin(n) pointer high byte
6828	JSR	LAB_2778		; pack FAC1 into (XY)
6829	LDA	#<Adatal		; set n pointer low addr
6830	LDY	#>Adatal		; set n pointer high addr
6831	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
6832	LDA	#$00			; clear byte
6833	STA	FAC1_s		; clear FAC1 sign (b7)
6834	LDA	Cflag			; get comparison evaluation flag
6835	JSR	LAB_2C74		; save flag and go do series evaluation
6836
6837	LDA	#<func_l		; set sin(n) pointer low byte
6838	LDY	#>func_l		; set sin(n) pointer high byte
6839	JMP	LAB_26CA		; convert AY and do (AY)/FAC1
6840
6841LAB_2C74
6842	PHA				; save comparison evaluation flag
6843	JMP	LAB_2C35		; go do series evaluation
6844
6845; perform USR()
6846
6847LAB_USR
6848	JSR	Usrjmp		; call user code
6849	JMP	LAB_1BFB		; scan for ")", else do syntax error then warm start
6850
6851; perform ATN()
6852
6853LAB_ATN
6854	LDA	FAC1_s		; get FAC1 sign (b7)
6855	PHA				; save sign
6856	BPL	LAB_2CA1		; branch if +ve
6857
6858	JSR	LAB_GTHAN		; else do - FAC1
6859LAB_2CA1
6860	LDA	FAC1_e		; get FAC1 exponent
6861	PHA				; push exponent
6862	CMP	#$81			; compare with 1
6863	BCC	LAB_2CAF		; branch if FAC1<1
6864
6865	LDA	#<LAB_259C		; set 1 pointer low byte
6866	LDY	#>LAB_259C		; set 1 pointer high byte
6867	JSR	LAB_26CA		; convert AY and do (AY)/FAC1
6868LAB_2CAF
6869	LDA	#<LAB_2CC9		; set pointer low byte to counter
6870	LDY	#>LAB_2CC9		; set pointer high byte to counter
6871	JSR	LAB_2B6E		; ^2 then series evaluation
6872	PLA				; restore old FAC1 exponent
6873	CMP	#$81			; compare with 1
6874	BCC	LAB_2CC2		; branch if FAC1<1
6875
6876	LDA	#<LAB_2C78		; set (pi/2) pointer low byte
6877	LDY	#>LAB_2C78		; set (pi/2) pointer high byte
6878	JSR	LAB_2455		; perform subtraction, (AY) from FAC1
6879LAB_2CC2
6880	PLA				; restore FAC1 sign
6881	BPL	LAB_2D04		; exit if was +ve
6882
6883	JMP	LAB_GTHAN		; else do - FAC1 and return
6884
6885; perform BITSET
6886
6887LAB_BITSET
6888	JSR	LAB_GADB		; get two parameters for POKE or WAIT
6889	CPX	#$08			; only 0 to 7 are allowed
6890	BCS	FCError		; branch if > 7
6891
6892	LDA	#$00			; clear A
6893	SEC				; set the carry
6894S_Bits
6895	ROL				; shift bit
6896	DEX				; decrement bit number
6897	BPL	S_Bits		; loop if still +ve
6898
6899	INX				; make X = $00
6900	ORA	(Itempl,X)		; or with byte via temporary integer (addr)
6901	STA	(Itempl,X)		; save byte via temporary integer (addr)
6902LAB_2D04
6903	RTS
6904
6905; perform BITCLR
6906
6907LAB_BITCLR
6908	JSR	LAB_GADB		; get two parameters for POKE or WAIT
6909	CPX	#$08			; only 0 to 7 are allowed
6910	BCS	FCError		; branch if > 7
6911
6912	LDA	#$FF			; set A
6913S_Bitc
6914	ROL				; shift bit
6915	DEX				; decrement bit number
6916	BPL	S_Bitc		; loop if still +ve
6917
6918	INX				; make X = $00
6919	AND	(Itempl,X)		; and with byte via temporary integer (addr)
6920	STA	(Itempl,X)		; save byte via temporary integer (addr)
6921	RTS
6922
6923FCError
6924	JMP	LAB_FCER		; do function call error then warm start
6925
6926; perform BITTST()
6927
6928LAB_BTST
6929	JSR	LAB_IGBY		; increment BASIC pointer
6930	JSR	LAB_GADB		; get two parameters for POKE or WAIT
6931	CPX	#$08			; only 0 to 7 are allowed
6932	BCS	FCError		; branch if > 7
6933
6934	JSR	LAB_GBYT		; get next BASIC byte
6935	CMP	#')'			; is next character ")"
6936	BEQ	TST_OK		; if ")" go do rest of function
6937
6938	JMP	LAB_SNER		; do syntax error then warm start
6939
6940TST_OK
6941	JSR	LAB_IGBY		; update BASIC execute pointer (to character past ")")
6942	LDA	#$00			; clear A
6943	SEC				; set the carry
6944T_Bits
6945	ROL				; shift bit
6946	DEX				; decrement bit number
6947	BPL	T_Bits		; loop if still +ve
6948
6949	INX				; make X = $00
6950	AND	(Itempl,X)		; AND with byte via temporary integer (addr)
6951	BEQ	LAB_NOTT		; branch if zero (already correct)
6952
6953	LDA	#$FF			; set for -1 result
6954LAB_NOTT
6955	JMP	LAB_27DB		; go do SGN tail
6956
6957; perform BIN$()
6958
6959LAB_BINS
6960	CPX	#$19			; max + 1
6961	BCS	BinFErr		; exit if too big ( > or = )
6962
6963	STX	TempB			; save # of characters ($00 = leading zero remove)
6964	LDA	#$18			; need A byte long space
6965	JSR	LAB_MSSP		; make string space A bytes long
6966	LDY	#$17			; set index
6967	LDX	#$18			; character count
6968NextB1
6969	LSR	nums_1		; shift highest byte
6970	ROR	nums_2		; shift middle byte
6971	ROR	nums_3		; shift lowest byte bit 0 to carry
6972	TXA				; load with "0"/2
6973	ROL				; shift in carry
6974	STA	(str_pl),Y		; save to temp string + index
6975	DEY				; decrement index
6976	BPL	NextB1		; loop if not done
6977
6978	LDA	TempB			; get # of characters
6979	BEQ	EndBHS		; branch if truncate
6980
6981	TAX				; copy length to X
6982	SEC				; set carry for add !
6983	EOR	#$FF			; 1's complement
6984	ADC	#$18			; add 24d
6985	BEQ	GoPr2			; if zero print whole string
6986
6987	BNE	GoPr1			; else go make output string
6988	
6989; this is the exit code and is also used by HEX$()
6990; truncate string to remove leading "0"s
6991
6992EndBHS
6993	TAY				; clear index (A=0, X=length here)
6994NextB2
6995	LDA	(str_pl),Y		; get character from string
6996	CMP	#'0'			; compare with "0"
6997	BNE	GoPr			; if not "0" then go print string from here
6998
6999	DEX				; decrement character count
7000	BEQ	GoPr3			; if zero then end of string so go print it
7001
7002	INY				; else increment index
7003	BPL	NextB2		; loop always
7004
7005; make fixed length output string - ignore overflows!
7006
7007GoPr3
7008	INX				; need at least 1 character
7009GoPr
7010	TYA				; copy result
7011GoPr1
7012	CLC				; clear carry for add
7013	ADC	str_pl		; add low address
7014	STA	str_pl		; save low address
7015	LDA	#$00			; do high byte
7016	ADC	str_ph		; add high address
7017	STA	str_ph		; save high address
7018GoPr2
7019	STX	str_ln		; X holds string length
7020	JSR	LAB_IGBY		; update BASIC execute pointer (to character past ")")
7021	JMP	LAB_RTST		; check for space on descriptor stack then put address
7022					; and length on descriptor stack and update stack pointers
7023
7024BinFErr
7025	JMP	LAB_FCER		; do function call error then warm start
7026
7027; perform HEX$()
7028
7029LAB_HEXS
7030	CPX	#$07			; max + 1
7031	BCS	BinFErr		; exit if too big ( > or = )
7032
7033	STX	TempB			; save # of characters
7034
7035	LDA	#$06			; need 6 bytes for string
7036	JSR	LAB_MSSP		; make string space A bytes long
7037	LDY	#$05			; set string index
7038
7039	SED				; need decimal mode for nibble convert
7040	LDA	nums_3		; get lowest byte
7041	JSR	LAB_A2HX		; convert A to ASCII hex byte and output
7042	LDA	nums_2		; get middle byte
7043	JSR	LAB_A2HX		; convert A to ASCII hex byte and output
7044	LDA	nums_1		; get highest byte
7045	JSR	LAB_A2HX		; convert A to ASCII hex byte and output
7046	CLD				; back to binary
7047
7048	LDX	#$06			; character count
7049	LDA	TempB			; get # of characters
7050	BEQ	EndBHS		; branch if truncate
7051
7052	TAX				; copy length to X
7053	SEC				; set carry for add !
7054	EOR	#$FF			; 1's complement
7055	ADC	#$06			; add 6d
7056	BEQ	GoPr2			; if zero print whole string
7057
7058	BNE	GoPr1			; else go make output string (branch always)
7059
7060; convert A to ASCII hex byte and output .. note set decimal mode before calling
7061
7062LAB_A2HX
7063	TAX				; save byte
7064	AND	#$0F			; mask off top bits
7065	JSR	LAB_AL2X		; convert low nibble to ASCII and output
7066	TXA				; get byte back
7067	LSR				; /2	shift high nibble to low nibble
7068	LSR				; /4
7069	LSR				; /8
7070	LSR				; /16
7071LAB_AL2X
7072	CMP	#$0A			; set carry for +1 if >9
7073	ADC	#'0'			; add ASCII "0"
7074	STA	(str_pl),Y		; save to temp string
7075	DEY				; decrement counter
7076	RTS
7077
7078LAB_NLTO
7079	STA	FAC1_e		; save FAC1 exponent
7080	LDA	#$00			; clear sign compare
7081LAB_MLTE
7082	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
7083	TXA				; restore character
7084	JSR	LAB_2912		; evaluate new ASCII digit
7085
7086; gets here if the first character was "$" for hex
7087; get hex number
7088
7089LAB_CHEX
7090	JSR	LAB_IGBY		; increment and scan memory
7091	BCC	LAB_ISHN		; branch if numeric character
7092
7093	ORA	#$20			; case convert, allow "A" to "F" and "a" to "f"
7094	SBC	#'a'			; subtract "a" (carry set here)
7095	CMP	#$06			; compare normalised with $06 (max+1)
7096	BCS	LAB_EXCH		; exit if >"f" or <"0"
7097
7098	ADC	#$0A			; convert to nibble
7099LAB_ISHN
7100	AND	#$0F			; convert to binary
7101	TAX				; save nibble
7102	LDA	FAC1_e		; get FAC1 exponent
7103	BEQ	LAB_MLTE		; skip multiply if zero
7104
7105	ADC	#$04			; add four to exponent (*16 - carry clear here)
7106	BCC	LAB_NLTO		; if no overflow do evaluate digit
7107
7108LAB_MLTO
7109	JMP	LAB_2564		; do overflow error and warm start
7110
7111LAB_NXCH
7112	TAX				; save bit
7113	LDA	FAC1_e		; get FAC1 exponent
7114	BEQ	LAB_MLBT		; skip multiply if zero
7115
7116	INC	FAC1_e		; increment FAC1 exponent (*2)
7117	BEQ	LAB_MLTO		; do overflow error if = $00
7118
7119	LDA	#$00			; clear sign compare
7120LAB_MLBT
7121	STA	FAC_sc		; save sign compare (FAC1 EOR FAC2)
7122	TXA				; restore bit
7123	JSR	LAB_2912		; evaluate new ASCII digit
7124
7125; gets here if the first character was  "%" for binary
7126; get binary number
7127
7128LAB_CBIN
7129	JSR	LAB_IGBY		; increment and scan memory
7130	EOR	#'0'			; convert "0" to 0 etc.
7131	CMP	#$02			; compare with max+1
7132	BCC	LAB_NXCH		; branch exit if < 2
7133
7134LAB_EXCH
7135	JMP	LAB_28F6		; evaluate -ve flag and return
7136
7137; ctrl-c check routine. includes limited "life" byte save for INGET routine
7138; now also the code that checks to see if an interrupt has occurred
7139
7140CTRLC
7141	LDA	ccflag		; get [CTRL-C] check flag
7142	BNE	LAB_FBA2		; exit if inhibited
7143
7144	JSR	V_INPT		; scan input device
7145	BCC	LAB_FBA0		; exit if buffer empty
7146
7147	STA	ccbyte		; save received byte
7148	LDX	#$20			; "life" timer for bytes
7149	STX	ccnull		; set countdown
7150	JMP	LAB_1636		; return to BASIC
7151
7152LAB_FBA0
7153	LDX	ccnull		; get countdown byte
7154	BEQ	LAB_FBA2		; exit if finished
7155
7156	DEC	ccnull		; else decrement countdown
7157LAB_FBA2
7158	LDX	#NmiBase		; set pointer to NMI values
7159	JSR	LAB_CKIN		; go check interrupt
7160	LDX	#IrqBase		; set pointer to IRQ values
7161	JSR	LAB_CKIN		; go check interrupt
7162LAB_CRTS
7163	RTS
7164
7165; check whichever interrupt is indexed by X
7166
7167LAB_CKIN
7168	LDA	PLUS_0,X		; get interrupt flag byte
7169	BPL	LAB_CRTS		; branch if interrupt not enabled
7170
7171; we disable the interrupt here and make two new commands RETIRQ and RETNMI to
7172; automatically enable the interrupt when we exit
7173
7174	ASL				; move happened bit to setup bit
7175	AND	#$40			; mask happened bits
7176	BEQ	LAB_CRTS		; if no interrupt then exit
7177
7178	STA	PLUS_0,X		; save interrupt flag byte
7179
7180	TXA				; copy index ..
7181	TAY				; .. to Y
7182
7183	PLA				; dump return address low byte, call from CTRL-C
7184	PLA				; dump return address high byte
7185
7186	LDA	#$05			; need 5 bytes for GOSUB
7187	JSR	LAB_1212		; check room on stack for A bytes
7188	LDA	Bpntrh		; get BASIC execute pointer high byte
7189	PHA				; push on stack
7190	LDA	Bpntrl		; get BASIC execute pointer low byte
7191	PHA				; push on stack
7192	LDA	Clineh		; get current line high byte
7193	PHA				; push on stack
7194	LDA	Clinel		; get current line low byte
7195	PHA				; push on stack
7196	LDA	#TK_GOSUB		; token for GOSUB
7197	PHA				; push on stack
7198
7199	LDA	PLUS_1,Y		; get interrupt code pointer low byte
7200	STA	Bpntrl		; save as BASIC execute pointer low byte
7201	LDA	PLUS_2,Y		; get interrupt code pointer high byte
7202	STA	Bpntrh		; save as BASIC execute pointer high byte
7203
7204	JMP	LAB_15C2		; go do interpreter inner loop
7205					; can't RTS, we used the stack! the RTS from the ctrl-c
7206					; check will be taken when the RETIRQ/RETNMI/RETURN is
7207					; executed at the end of the subroutine
7208
7209; get byte from input device, no waiting
7210; returns with carry set if byte in A
7211
7212INGET
7213	JSR	V_INPT		; call scan input device
7214	BCS	LAB_FB95		; if byte go reset timer
7215
7216	LDA	ccnull		; get countdown
7217	BEQ	LAB_FB96		; exit if empty
7218
7219	LDA	ccbyte		; get last received byte
7220	SEC				; flag we got a byte
7221LAB_FB95
7222	LDX	#$00			; clear X
7223	STX	ccnull		; clear timer because we got a byte
7224LAB_FB96
7225	RTS
7226
7227; these routines only enable the interrupts if the set-up flag is set
7228; if not they have no effect
7229
7230; perform IRQ {ON|OFF|CLEAR}
7231
7232LAB_IRQ
7233	LDX	#IrqBase		; set pointer to IRQ values
7234	.byte	$2C			; make next line BIT abs.
7235
7236; perform NMI {ON|OFF|CLEAR}
7237
7238LAB_NMI
7239	LDX	#NmiBase		; set pointer to NMI values
7240	CMP	#TK_ON		; compare with token for ON
7241	BEQ	LAB_INON		; go turn on interrupt
7242
7243	CMP	#TK_OFF		; compare with token for OFF
7244	BEQ	LAB_IOFF		; go turn off interrupt
7245
7246	EOR	#TK_CLEAR		; compare with token for CLEAR, A = $00 if = TK_CLEAR
7247	BEQ	LAB_INEX		; go clear interrupt flags and return
7248
7249	JMP	LAB_SNER		; do syntax error then warm start
7250
7251LAB_IOFF
7252	LDA	#$7F			; clear A
7253	AND	PLUS_0,X		; AND with interrupt setup flag
7254	BPL	LAB_INEX		; go clear interrupt enabled flag and return
7255
7256LAB_INON
7257	LDA	PLUS_0,X		; get interrupt setup flag
7258	ASL				; Shift bit to enabled flag
7259	ORA	PLUS_0,X		; OR with flag byte
7260LAB_INEX
7261	STA	PLUS_0,X		; save interrupt flag byte
7262	JMP	LAB_IGBY		; update BASIC execute pointer and return
7263
7264; these routines set up the pointers and flags for the interrupt routines
7265; note that the interrupts are also enabled by these commands
7266
7267; perform ON IRQ
7268
7269LAB_SIRQ
7270	CLI				; enable interrupts
7271	LDX	#IrqBase		; set pointer to IRQ values
7272	.byte	$2C			; make next line BIT abs.
7273
7274; perform ON NMI
7275
7276LAB_SNMI
7277	LDX	#NmiBase		; set pointer to NMI values
7278
7279	STX	TempB			; save interrupt pointer
7280	JSR	LAB_IGBY		; increment and scan memory (past token)
7281	JSR	LAB_GFPN		; get fixed-point number into temp integer
7282	LDA	Smeml			; get start of mem low byte
7283	LDX	Smemh			; get start of mem high byte
7284	JSR	LAB_SHLN		; search Basic for temp integer line number from AX
7285	BCS	LAB_LFND		; if carry set go set-up interrupt
7286
7287	JMP	LAB_16F7		; else go do "Undefined statement" error and warm start
7288
7289LAB_LFND
7290	LDX	TempB			; get interrupt pointer
7291	LDA	Baslnl		; get pointer low byte
7292	SBC	#$01			; -1 (carry already set for subtract)
7293	STA	PLUS_1,X		; save as interrupt pointer low byte
7294	LDA	Baslnh		; get pointer high byte
7295	SBC	#$00			; subtract carry
7296	STA	PLUS_2,X		; save as interrupt pointer high byte
7297
7298	LDA	#$C0			; set interrupt enabled/setup bits
7299	STA	PLUS_0,X		; set interrupt flags
7300LAB_IRTS
7301	RTS
7302
7303; return from IRQ service, restores the enabled flag.
7304
7305; perform RETIRQ
7306
7307LAB_RETIRQ
7308	BNE	LAB_IRTS		; exit if following token (to allow syntax error)
7309
7310	LDA	IrqBase		; get interrupt flags
7311	ASL				; copy setup to enabled (b7)
7312	ORA	IrqBase		; OR in setup flag
7313	STA	IrqBase		; save enabled flag
7314	JMP	LAB_16E8		; go do rest of RETURN
7315
7316; return from NMI service, restores the enabled flag.
7317
7318; perform RETNMI
7319
7320LAB_RETNMI
7321	BNE	LAB_IRTS		; exit if following token (to allow syntax error)
7322
7323	LDA	NmiBase		; get set-up flag
7324	ASL				; copy setup to enabled (b7)
7325	ORA	NmiBase		; OR in setup flag
7326	STA	NmiBase		; save enabled flag
7327	JMP	LAB_16E8		; go do rest of RETURN
7328
7329; MAX() MIN() pre process
7330
7331LAB_MMPP
7332	JSR	LAB_EVEZ		; process expression
7333	JMP	LAB_CTNM		; check if source is numeric, else do type mismatch
7334
7335; perform MAX()
7336
7337LAB_MAX
7338	JSR	LAB_PHFA		; push FAC1, evaluate expression,
7339					; pull FAC2 and compare with FAC1
7340	BPL	LAB_MAX		; branch if no swap to do
7341
7342	LDA	FAC2_1		; get FAC2 mantissa1
7343	ORA	#$80			; set top bit (clear sign from compare)
7344	STA	FAC2_1		; save FAC2 mantissa1
7345	JSR	LAB_279B		; copy FAC2 to FAC1
7346	BEQ	LAB_MAX		; go do next (branch always)
7347
7348; perform MIN()
7349
7350LAB_MIN
7351	JSR	LAB_PHFA		; push FAC1, evaluate expression,
7352					; pull FAC2 and compare with FAC1
7353	BMI	LAB_MIN		; branch if no swap to do
7354
7355	BEQ	LAB_MIN		; branch if no swap to do
7356
7357	LDA	FAC2_1		; get FAC2 mantissa1
7358	ORA	#$80			; set top bit (clear sign from compare)
7359	STA	FAC2_1		; save FAC2 mantissa1
7360	JSR	LAB_279B		; copy FAC2 to FAC1
7361	BEQ	LAB_MIN		; go do next (branch always)
7362
7363; exit routine. don't bother returning to the loop code
7364; check for correct exit, else so syntax error
7365
7366LAB_MMEC
7367	CMP	#')'			; is it end of function?
7368	BNE	LAB_MMSE		; if not do MAX MIN syntax error
7369
7370	PLA				; dump return address low byte
7371	PLA				; dump return address high byte
7372	JMP	LAB_IGBY		; update BASIC execute pointer (to chr past ")")
7373
7374LAB_MMSE
7375	JMP	LAB_SNER		; do syntax error then warm start
7376
7377; check for next, evaluate and return or exit
7378; this is the routine that does most of the work
7379
7380LAB_PHFA
7381	JSR	LAB_GBYT		; get next BASIC byte
7382	CMP	#','			; is there more ?
7383	BNE	LAB_MMEC		; if not go do end check
7384
7385					; push FAC1
7386	JSR	LAB_27BA		; round FAC1
7387	LDA	FAC1_s		; get FAC1 sign
7388	ORA	#$7F			; set all non sign bits
7389	AND	FAC1_1		; AND FAC1 mantissa1 (AND in sign bit)
7390	PHA				; push on stack
7391	LDA	FAC1_2		; get FAC1 mantissa2
7392	PHA				; push on stack
7393	LDA	FAC1_3		; get FAC1 mantissa3
7394	PHA				; push on stack
7395	LDA	FAC1_e		; get FAC1 exponent
7396	PHA				; push on stack
7397
7398	JSR	LAB_IGBY		; scan and get next BASIC byte (after ",")
7399	JSR	LAB_EVNM		; evaluate expression and check is numeric,
7400					; else do type mismatch
7401
7402					; pop FAC2 (MAX/MIN expression so far)
7403	PLA				; pop exponent
7404	STA	FAC2_e		; save FAC2 exponent
7405	PLA				; pop mantissa3
7406	STA	FAC2_3		; save FAC2 mantissa3
7407	PLA				; pop mantissa1
7408	STA	FAC2_2		; save FAC2 mantissa2
7409	PLA				; pop sign/mantissa1
7410	STA	FAC2_1		; save FAC2 sign/mantissa1
7411	STA	FAC2_s		; save FAC2 sign
7412
7413					; compare FAC1 with (packed) FAC2
7414	LDA	#<FAC2_e		; set pointer low byte to FAC2
7415	LDY	#>FAC2_e		; set pointer high byte to FAC2
7416	JMP	LAB_27F8		; compare FAC1 with FAC2 (AY) and return
7417					; returns A=$00 if FAC1 = (AY)
7418					; returns A=$01 if FAC1 > (AY)
7419					; returns A=$FF if FAC1 < (AY)
7420
7421; perform WIDTH
7422
7423LAB_WDTH
7424	CMP	#','			; is next byte ","
7425	BEQ	LAB_TBSZ		; if so do tab size
7426
7427	JSR	LAB_GTBY		; get byte parameter
7428	TXA				; copy width to A
7429	BEQ	LAB_NSTT		; branch if set for infinite line
7430
7431	CPX	#$10			; else make min width = 16d
7432	BCC	TabErr		; if less do function call error and exit
7433
7434; this next compare ensures that we can't exit WIDTH via an error leaving the
7435; tab size greater than the line length.
7436
7437	CPX	TabSiz		; compare with tab size
7438	BCS	LAB_NSTT		; branch if >= tab size
7439
7440	STX	TabSiz		; else make tab size = terminal width
7441LAB_NSTT
7442	STX	TWidth		; set the terminal width
7443	JSR	LAB_GBYT		; get BASIC byte back
7444	BEQ	WExit			; exit if no following
7445
7446	CMP	#','			; else is it ","
7447	BNE	LAB_MMSE		; if not do syntax error
7448
7449LAB_TBSZ
7450	JSR	LAB_SGBY		; scan and get byte parameter
7451	TXA				; copy TAB size
7452	BMI	TabErr		; if >127 do function call error and exit
7453
7454	CPX	#$01			; compare with min-1
7455	BCC	TabErr		; if <=1 do function call error and exit
7456
7457	LDA	TWidth		; set flags for width
7458	BEQ	LAB_SVTB		; skip check if infinite line
7459
7460	CPX	TWidth		; compare TAB with width
7461	BEQ	LAB_SVTB		; ok if =
7462
7463	BCS	TabErr		; branch if too big
7464
7465LAB_SVTB
7466	STX	TabSiz		; save TAB size
7467
7468; calculate tab column limit from TAB size. The Iclim is set to the last tab
7469; position on a line that still has at least one whole tab width between it
7470; and the end of the line.
7471
7472WExit
7473	LDA	TWidth		; get width
7474	BEQ	LAB_SULP		; branch if infinite line
7475
7476	CMP	TabSiz		; compare with tab size
7477	BCS	LAB_WDLP		; branch if >= tab size
7478
7479	STA	TabSiz		; else make tab size = terminal width
7480LAB_SULP
7481	SEC				; set carry for subtract
7482LAB_WDLP
7483	SBC	TabSiz		; subtract tab size
7484	BCS	LAB_WDLP		; loop while no borrow
7485
7486	ADC	TabSiz		; add tab size back
7487	CLC				; clear carry for add
7488	ADC	TabSiz		; add tab size back again
7489	STA	Iclim			; save for now
7490	LDA	TWidth		; get width back
7491	SEC				; set carry for subtract
7492	SBC	Iclim			; subtract remainder
7493	STA	Iclim			; save tab column limit
7494LAB_NOSQ
7495	RTS
7496
7497TabErr
7498	JMP	LAB_FCER		; do function call error then warm start
7499
7500; perform SQR()
7501
7502LAB_SQR
7503	LDA	FAC1_s		; get FAC1 sign
7504	BMI	TabErr		; if -ve do function call error
7505
7506	LDA	FAC1_e		; get exponent
7507	BEQ	LAB_NOSQ		; do root if non zero
7508
7509	JSR	LAB_27AB		; round and copy FAC1 to FAC2
7510	LDA	#$00			; clear A
7511
7512	STA	FACt_3		; clear remainder
7513	STA	FACt_2		; ..
7514	STA	FACt_1		; ..
7515	STA	TempB			; ..
7516
7517	STA	FAC1_3		; clear root
7518	STA	FAC1_2		; ..
7519	STA	FAC1_1		; ..
7520
7521	LDX	#$18			; 24 pairs of bits to do
7522	LDA	FAC2_e		; get exponent
7523	LSR				; check odd/even
7524	BCS	LAB_SQE2		; if odd only 1 shift first time
7525
7526LAB_SQE1
7527	ASL	FAC2_3		; shift highest bit of number ..
7528	ROL	FAC2_2		; ..
7529	ROL	FAC2_1		; ..
7530	ROL	FACt_3		; .. into remainder
7531	ROL	FACt_2		; ..
7532	ROL	FACt_1		; ..
7533	ROL	TempB			; .. never overflows
7534LAB_SQE2
7535	ASL	FAC2_3		; shift highest bit of number ..
7536	ROL	FAC2_2		; ..
7537	ROL	FAC2_1		; ..
7538	ROL	FACt_3		; .. into remainder
7539	ROL	FACt_2		; ..
7540	ROL	FACt_1		; ..
7541	ROL	TempB			; .. never overflows
7542
7543	ASL	FAC1_3		; root = root * 2
7544	ROL	FAC1_2		; ..
7545	ROL	FAC1_1		; .. never overflows
7546
7547	LDA	FAC1_3		; get root low byte
7548	ROL				; *2
7549	STA	Temp3			; save partial low byte
7550	LDA	FAC1_2		; get root low mid byte
7551	ROL				; *2
7552	STA	Temp3+1		; save partial low mid byte
7553	LDA	FAC1_1		; get root high mid byte
7554	ROL				; *2
7555	STA	Temp3+2		; save partial high mid byte
7556	LDA	#$00			; get root high byte (always $00)
7557	ROL				; *2
7558	STA	Temp3+3		; save partial high byte
7559
7560					; carry clear for subtract +1
7561	LDA	FACt_3		; get remainder low byte
7562	SBC	Temp3			; subtract partial low byte
7563	STA	Temp3			; save partial low byte
7564
7565	LDA	FACt_2		; get remainder low mid byte
7566	SBC	Temp3+1		; subtract partial low mid byte
7567	STA	Temp3+1		; save partial low mid byte
7568
7569	LDA	FACt_1		; get remainder high mid byte
7570	SBC	Temp3+2		; subtract partial high mid byte
7571	TAY				; copy partial high mid byte
7572
7573	LDA	TempB			; get remainder high byte
7574	SBC	Temp3+3		; subtract partial high byte
7575	BCC	LAB_SQNS		; skip sub if remainder smaller
7576
7577	STA	TempB			; save remainder high byte
7578
7579	STY	FACt_1		; save remainder high mid byte
7580
7581	LDA	Temp3+1		; get remainder low mid byte
7582	STA	FACt_2		; save remainder low mid byte
7583
7584	LDA	Temp3			; get partial low byte
7585	STA	FACt_3		; save remainder low byte
7586
7587	INC	FAC1_3		; increment root low byte (never any rollover)
7588LAB_SQNS
7589	DEX				; decrement bit pair count
7590	BNE	LAB_SQE1		; loop if not all done
7591
7592	SEC				; set carry for subtract
7593	LDA	FAC2_e		; get exponent
7594	SBC	#$80			; normalise
7595	ROR				; /2 and re-bias to $80
7596	ADC	#$00			; add bit zero back in (allow for half shift)
7597	STA	FAC1_e		; save it
7598	JMP	LAB_24D5		; normalise FAC1 and return
7599
7600; perform VARPTR()
7601
7602LAB_VARPTR
7603	JSR	LAB_IGBY		; increment and scan memory
7604	JSR	LAB_GVAR		; get var address
7605	JSR	LAB_1BFB		; scan for ")" , else do syntax error then warm start
7606	LDY	Cvaral		; get var address low byte
7607	LDA	Cvarah		; get var address high byte
7608	JMP	LAB_AYFC		; save and convert integer AY to FAC1 and return
7609
7610; perform PI
7611
7612LAB_PI
7613	LDA	#<LAB_2C7C		; set (2*pi) pointer low byte
7614	LDY	#>LAB_2C7C		; set (2*pi) pointer high byte
7615	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
7616	DEC	FAC1_e		; make result = PI
7617	RTS
7618
7619; perform TWOPI
7620
7621LAB_TWOPI
7622	LDA	#<LAB_2C7C		; set (2*pi) pointer low byte
7623	LDY	#>LAB_2C7C		; set (2*pi) pointer high byte
7624	JMP	LAB_UFAC		; unpack memory (AY) into FAC1 and return
7625
7626; system dependant i/o vectors
7627; these are in RAM and are set by the monitor at start-up
7628
7629V_INPT
7630	JMP	(VEC_IN)		; non halting scan input device
7631V_OUTP
7632	JMP	(VEC_OUT)		; send byte to output device
7633V_LOAD
7634	JMP	(VEC_LD)		; load BASIC program
7635V_SAVE
7636	JMP	(VEC_SV)		; save BASIC program
7637
7638; The rest are tables messages and code for RAM
7639
7640; the rest of the code is tables and BASIC start-up code
7641
7642PG2_TABS
7643	.byte	$00			; ctrl-c flag		-	$00 = enabled
7644	.byte	$00			; ctrl-c byte		-	GET needs this
7645	.byte	$00			; ctrl-c byte timeout	-	GET needs this
7646	.word	CTRLC			; ctrl c check vector
7647;	.word	xxxx			; non halting key input	-	monitor to set this
7648;	.word	xxxx			; output vector		-	monitor to set this
7649;	.word	xxxx			; load vector		-	monitor to set this
7650;	.word	xxxx			; save vector		-	monitor to set this
7651PG2_TABE
7652
7653; character get subroutine for zero page
7654
7655; For a 1.8432MHz 6502 including the JSR and RTS
7656; fastest (>=":")	=  29 cycles =  15.7uS
7657; slowest (<":")	=  40 cycles =  21.7uS
7658; space skip	= +21 cycles = +11.4uS
7659; inc across page	=  +4 cycles =  +2.2uS
7660
7661; the target address for the LDA at LAB_2CF4 becomes the BASIC execute pointer once the
7662; block is copied to it's destination, any non zero page address will do at assembly
7663; time, to assemble a three byte instruction.
7664
7665; page 0 initialisation table from $BC
7666; increment and scan memory
7667
7668LAB_2CEE
7669	INC	Bpntrl		; increment BASIC execute pointer low byte
7670	BNE	LAB_2CF4		; branch if no carry
7671					; else
7672	INC	Bpntrh		; increment BASIC execute pointer high byte
7673
7674; page 0 initialisation table from $C2
7675; scan memory
7676
7677LAB_2CF4
7678	LDA	$FFFF			; get byte to scan (addr set by call routine)
7679	CMP	#':'			; compare with ":"
7680	BCS	LAB_2D05		; exit if >= ":", not numeric, carry set
7681
7682	CMP	#' '			; compare with " "
7683	BEQ	LAB_2CEE		; if " " go do next
7684
7685	SEC				; set carry for SBC
7686	SBC	#'0'			; subtract "0"
7687	SEC				; set carry for SBC
7688	SBC	#$D0			; subtract -"0"
7689					; clear carry if byte = "0"-"9"
7690LAB_2D05
7691	RTS
7692
7693; page zero initialisation table $00-$12 inclusive
7694
7695StrTab
7696	.byte	$4C			; JMP opcode
7697	.word LAB_COLD		; initial warm start vector (cold start)
7698
7699	.byte	$00			; these bytes are not used by BASIC
7700	.word	$0000			; 
7701	.word	$0000			; 
7702	.word	$0000			; 
7703
7704	.byte	$4C			; JMP opcode
7705	.word	LAB_FCER		; initial user function vector ("Function call" error)
7706	.byte	$00			; default NULL count
7707	.byte	$00			; clear terminal position
7708	.byte	$00			; default terminal width byte
7709	.byte	$F2			; default limit for TAB = 14
7710	.word	Ram_base		; start of user RAM
7711EndTab
7712
7713LAB_MSZM
7714	.byte	$0D,$0A,"Memory size ",$00
7715
7716LAB_SMSG
7717	.byte	" Bytes free",$0D,$0A,$0A
7718	.byte	"Enhanced BASIC 2.10",$0A,$00
7719
7720; numeric constants and series
7721
7722					; constants and series for LOG(n)
7723LAB_25A0
7724	.byte	$02			; counter
7725	.byte	$80,$19,$56,$62	; 0.59898
7726	.byte	$80,$76,$22,$F3	; 0.96147
7727	.byte	$82,$38,$AA,$40	; 2.88539
7728
7729LAB_25AD
7730	.byte	$80,$35,$04,$F3	; 0.70711	1/root 2
7731LAB_25B1
7732	.byte	$81,$35,$04,$F3	; 1.41421	root 2
7733LAB_25B5
7734	.byte	$80,$80,$00,$00	; -0.5
7735LAB_25B9
7736	.byte	$80,$31,$72,$18	; 0.69315	LOG(2)
7737
7738					; numeric PRINT constants
7739LAB_2947
7740	.byte	$91,$43,$4F,$F8	; 99999.9375 (max value with at least one decimal)
7741LAB_294B
7742	.byte	$94,$74,$23,$F7	; 999999.4375 (max value before scientific notation)
7743LAB_294F
7744	.byte	$94,$74,$24,$00	; 1000000
7745
7746					; EXP(n) constants and series
7747LAB_2AFA
7748	.byte	$81,$38,$AA,$3B	; 1.4427	(1/LOG base 2 e)
7749LAB_2AFE
7750	.byte	$06			; counter
7751	.byte	$74,$63,$90,$8C	; 2.17023e-4
7752	.byte	$77,$23,$0C,$AB	; 0.00124
7753	.byte	$7A,$1E,$94,$00	; 0.00968
7754	.byte	$7C,$63,$42,$80	; 0.05548
7755	.byte	$7E,$75,$FE,$D0	; 0.24023
7756	.byte	$80,$31,$72,$15	; 0.69315
7757	.byte	$81,$00,$00,$00	; 1.00000
7758
7759					; trigonometric constants and series
7760LAB_2C78
7761	.byte	$81,$49,$0F,$DB	; 1.570796371 (pi/2) as floating #
7762LAB_2C84
7763	.byte	$04			; counter
7764	.byte	$86,$1E,$D7,$FB	; 39.7109
7765	.byte	$87,$99,$26,$65	;-76.575
7766	.byte	$87,$23,$34,$58	; 81.6022
7767	.byte	$86,$A5,$5D,$E1	;-41.3417
7768LAB_2C7C
7769	.byte	$83,$49,$0F,$DB	; 6.28319 (2*pi) as floating #
7770
7771LAB_2CC9
7772	.byte	$08			; counter
7773	.byte	$78,$3A,$C5,$37	; 0.00285
7774	.byte	$7B,$83,$A2,$5C	;-0.0160686
7775	.byte	$7C,$2E,$DD,$4D	; 0.0426915
7776	.byte	$7D,$99,$B0,$1E	;-0.0750429
7777	.byte	$7D,$59,$ED,$24	; 0.106409
7778	.byte	$7E,$91,$72,$00	;-0.142036
7779	.byte	$7E,$4C,$B9,$73	; 0.199926
7780	.byte	$7F,$AA,$AA,$53	;-0.333331
7781LAB_1D96	= *+1			; $00,$00 used for undefined variables
7782LAB_259C
7783	.byte	$81,$00,$00,$00	; 1.000000, used for INC
7784LAB_2AFD
7785	.byte	$81,$80,$00,$00	; -1.00000, used for DEC. must be on the same page as +1.00
7786
7787					; misc constants
7788LAB_1DF7
7789	.byte	$90			;-32768 (uses first three bytes from 0.5)
7790LAB_2A96
7791	.byte	$80,$00,$00,$00	; 0.5
7792LAB_2C80
7793	.byte	$7F,$00,$00,$00	; 0.25
7794LAB_26B5
7795	.byte	$84,$20,$00,$00	; 10.0000 divide by 10 constant
7796
7797; This table is used in converting numbers to ASCII.
7798
7799LAB_2A9A
7800LAB_2A9B = LAB_2A9A+1
7801LAB_2A9C = LAB_2A9B+1
7802	.byte	$FE,$79,$60		; -100000
7803	.byte	$00,$27,$10		; 10000
7804	.byte	$FF,$FC,$18		; -1000
7805	.byte	$00,$00,$64		; 100
7806	.byte	$FF,$FF,$F6		; -10
7807	.byte	$00,$00,$01		; 1
7808
7809LAB_CTBL
7810	.word	LAB_END-1		; END
7811	.word	LAB_FOR-1		; FOR
7812	.word	LAB_NEXT-1		; NEXT
7813	.word	LAB_DATA-1		; DATA
7814	.word	LAB_INPUT-1		; INPUT
7815	.word	LAB_DIM-1		; DIM
7816	.word	LAB_READ-1		; READ
7817	.word	LAB_LET-1		; LET
7818	.word	LAB_DEC-1		; DEC			new command
7819	.word	LAB_GOTO-1		; GOTO
7820	.word	LAB_RUN-1		; RUN
7821	.word	LAB_IF-1		; IF
7822	.word	LAB_RESTORE-1	; RESTORE		modified command
7823	.word	LAB_GOSUB-1		; GOSUB
7824	.word	LAB_RETIRQ-1	; RETIRQ		new command
7825	.word	LAB_RETNMI-1	; RETNMI		new command
7826	.word	LAB_RETURN-1	; RETURN
7827	.word	LAB_REM-1		; REM
7828	.word	LAB_STOP-1		; STOP
7829	.word	LAB_ON-1		; ON			modified command
7830	.word	LAB_NULL-1		; NULL		modified command
7831	.word	LAB_INC-1		; INC			new command
7832	.word	LAB_WAIT-1		; WAIT
7833	.word	V_LOAD-1		; LOAD
7834	.word	V_SAVE-1		; SAVE
7835	.word	LAB_DEF-1		; DEF
7836	.word	LAB_POKE-1		; POKE
7837	.word	LAB_DOKE-1		; DOKE		new command
7838	.word	LAB_CALL-1		; CALL		new command
7839	.word	LAB_DO-1		; DO			new command
7840	.word	LAB_LOOP-1		; LOOP		new command
7841	.word	LAB_PRINT-1		; PRINT
7842	.word	LAB_CONT-1		; CONT
7843	.word	LAB_LIST-1		; LIST
7844	.word	LAB_CLEAR-1		; CLEAR
7845	.word	LAB_NEW-1		; NEW
7846	.word	LAB_WDTH-1		; WIDTH		new command
7847	.word	LAB_GET-1		; GET			new command
7848	.word	LAB_SWAP-1		; SWAP		new command
7849	.word	LAB_BITSET-1	; BITSET		new command
7850	.word	LAB_BITCLR-1	; BITCLR		new command
7851	.word	LAB_IRQ-1		; IRQ			new command
7852	.word	LAB_NMI-1		; NMI			new command
7853
7854; function pre process routine table
7855
7856LAB_FTPL
7857LAB_FTPM	= LAB_FTPL+$01
7858	.word	LAB_PPFN-1		; SGN(n)	process numeric expression in ()
7859	.word	LAB_PPFN-1		; INT(n)		"
7860	.word	LAB_PPFN-1		; ABS(n)		"
7861	.word	LAB_EVEZ-1		; USR(x)	process any expression
7862	.word	LAB_1BF7-1		; FRE(x)		"
7863	.word	LAB_1BF7-1		; POS(x)		"
7864	.word	LAB_PPFN-1		; SQR(n)	process numeric expression in ()
7865	.word	LAB_PPFN-1		; RND(n)		"
7866	.word	LAB_PPFN-1		; LOG(n)		"
7867	.word	LAB_PPFN-1		; EXP(n)		"
7868	.word	LAB_PPFN-1		; COS(n)		"
7869	.word	LAB_PPFN-1		; SIN(n)		"
7870	.word	LAB_PPFN-1		; TAN(n)		"
7871	.word	LAB_PPFN-1		; ATN(n)		"
7872	.word	LAB_PPFN-1		; PEEK(n)		"
7873	.word	LAB_PPFN-1		; DEEK(n)		"
7874	.word	$0000			; SADD()	none
7875	.word	LAB_PPFS-1		; LEN($)	process string expression in ()
7876	.word	LAB_PPFN-1		; STR$(n)	process numeric expression in ()
7877	.word	LAB_PPFS-1		; VAL($)	process string expression in ()
7878	.word	LAB_PPFS-1		; ASC($)		"
7879	.word	LAB_PPFS-1		; UCASE$($)		"
7880	.word	LAB_PPFS-1		; LCASE$($)		"
7881	.word	LAB_PPFN-1		; CHR$(n)	process numeric expression in ()
7882	.word	LAB_BHSS-1		; HEX$(n)		"
7883	.word	LAB_BHSS-1		; BIN$(n)		"
7884	.word	$0000			; BITTST()	none
7885	.word	LAB_MMPP-1		; MAX()	process numeric expression
7886	.word	LAB_MMPP-1		; MIN()		"
7887	.word	LAB_PPBI-1		; PI		advance pointer
7888	.word	LAB_PPBI-1		; TWOPI		"
7889	.word	$0000			; VARPTR()	none
7890	.word	LAB_LRMS-1		; LEFT$()	process string expression
7891	.word	LAB_LRMS-1		; RIGHT$()		"
7892	.word	LAB_LRMS-1		; MID$()		"
7893
7894; action addresses for functions
7895
7896LAB_FTBL
7897LAB_FTBM	= LAB_FTBL+$01
7898	.word	LAB_SGN-1		; SGN()
7899	.word	LAB_INT-1		; INT()
7900	.word	LAB_ABS-1		; ABS()
7901	.word	LAB_USR-1		; USR()
7902	.word	LAB_FRE-1		; FRE()
7903	.word	LAB_POS-1		; POS()
7904	.word	LAB_SQR-1		; SQR()
7905	.word	LAB_RND-1		; RND()		modified function
7906	.word	LAB_LOG-1		; LOG()
7907	.word	LAB_EXP-1		; EXP()
7908	.word	LAB_COS-1		; COS()
7909	.word	LAB_SIN-1		; SIN()
7910	.word	LAB_TAN-1		; TAN()
7911	.word	LAB_ATN-1		; ATN()
7912	.word	LAB_PEEK-1		; PEEK()
7913	.word	LAB_DEEK-1		; DEEK()		new function
7914	.word	LAB_SADD-1		; SADD()		new function
7915	.word	LAB_LENS-1		; LEN()
7916	.word	LAB_STRS-1		; STR$()
7917	.word	LAB_VAL-1		; VAL()
7918	.word	LAB_ASC-1		; ASC()
7919	.word	LAB_UCASE-1		; UCASE$()		new function
7920	.word	LAB_LCASE-1		; LCASE$()		new function
7921	.word	LAB_CHRS-1		; CHR$()
7922	.word	LAB_HEXS-1		; HEX$()		new function
7923	.word	LAB_BINS-1		; BIN$()		new function
7924	.word	LAB_BTST-1		; BITTST()		new function
7925	.word	LAB_MAX-1		; MAX()		new function
7926	.word	LAB_MIN-1		; MIN()		new function
7927	.word	LAB_PI-1		; PI			new function
7928	.word	LAB_TWOPI-1		; TWOPI		new function
7929	.word	LAB_VARPTR-1	; VARPTR()		new function
7930	.word	LAB_LEFT-1		; LEFT$()
7931	.word	LAB_RIGHT-1		; RIGHT$()
7932	.word	LAB_MIDS-1		; MID$()
7933
7934; hierarchy and action addresses for operator
7935
7936LAB_OPPT
7937	.byte	$79			; +
7938	.word	LAB_ADD-1
7939	.byte	$79			; -
7940	.word	LAB_SUBTRACT-1
7941	.byte	$7B			; *
7942	.word	LAB_MULTIPLY-1
7943	.byte	$7B			; /
7944	.word	LAB_DIVIDE-1
7945	.byte	$7F			; ^
7946	.word	LAB_POWER-1
7947	.byte	$50			; AND
7948	.word	LAB_AND-1
7949	.byte	$46			; EOR			new operator
7950	.word	LAB_EOR-1
7951	.byte	$46			; OR
7952	.word	LAB_OR-1
7953	.byte	$56			; >>			new operator
7954	.word	LAB_RSHIFT-1
7955	.byte	$56			; <<			new operator
7956	.word	LAB_LSHIFT-1
7957	.byte	$7D			; >
7958	.word	LAB_GTHAN-1
7959	.byte	$5A			; =
7960	.word	LAB_EQUAL-1
7961	.byte	$64			; <
7962	.word	LAB_LTHAN-1
7963
7964; keywords start with ..
7965; this is the first character table and must be in alphabetic order
7966
7967TAB_1STC
7968	.byte	"*"
7969	.byte	"+"
7970	.byte	"-"
7971	.byte	"/"
7972	.byte	"<"
7973	.byte	"="
7974	.byte	">"
7975	.byte	"?"
7976	.byte	"A"
7977	.byte	"B"
7978	.byte	"C"
7979	.byte	"D"
7980	.byte	"E"
7981	.byte	"F"
7982	.byte	"G"
7983	.byte	"H"
7984	.byte	"I"
7985	.byte	"L"
7986	.byte	"M"
7987	.byte	"N"
7988	.byte	"O"
7989	.byte	"P"
7990	.byte	"R"
7991	.byte	"S"
7992	.byte	"T"
7993	.byte	"U"
7994	.byte	"V"
7995	.byte	"W"
7996	.byte	"^"
7997	.byte	$00			; table terminator
7998
7999; pointers to keyword tables
8000
8001TAB_CHRT
8002	.word	TAB_STAR		; table for "*"
8003	.word	TAB_PLUS		; table for "+"
8004	.word	TAB_MNUS		; table for "-"
8005	.word	TAB_SLAS		; table for "/"
8006	.word	TAB_LESS		; table for "<"
8007	.word	TAB_EQUL		; table for "="
8008	.word	TAB_MORE		; table for ">"
8009	.word	TAB_QEST		; table for "?"
8010	.word	TAB_ASCA		; table for "A"
8011	.word	TAB_ASCB		; table for "B"
8012	.word	TAB_ASCC		; table for "C"
8013	.word	TAB_ASCD		; table for "D"
8014	.word	TAB_ASCE		; table for "E"
8015	.word	TAB_ASCF		; table for "F"
8016	.word	TAB_ASCG		; table for "G"
8017	.word	TAB_ASCH		; table for "H"
8018	.word	TAB_ASCI		; table for "I"
8019	.word	TAB_ASCL		; table for "L"
8020	.word	TAB_ASCM		; table for "M"
8021	.word	TAB_ASCN		; table for "N"
8022	.word	TAB_ASCO		; table for "O"
8023	.word	TAB_ASCP		; table for "P"
8024	.word	TAB_ASCR		; table for "R"
8025	.word	TAB_ASCS		; table for "S"
8026	.word	TAB_ASCT		; table for "T"
8027	.word	TAB_ASCU		; table for "U"
8028	.word	TAB_ASCV		; table for "V"
8029	.word	TAB_ASCW		; table for "W"
8030	.word	TAB_POWR		; table for "^"
8031
8032; tables for each start character, note if a longer keyword with the same start
8033; letters as a shorter one exists then it must come first, else the list is in
8034; alphabetical order as follows ..
8035
8036; [keyword,token
8037; [keyword,token]]
8038; end marker (#$00)
8039
8040TAB_STAR
8041	.byte TK_MUL,$00		; *
8042TAB_PLUS
8043	.byte TK_PLUS,$00		; +
8044TAB_MNUS
8045	.byte TK_MINUS,$00	; -
8046TAB_SLAS
8047	.byte TK_DIV,$00		; /
8048TAB_LESS
8049LBB_LSHIFT
8050	.byte	"<",TK_LSHIFT	; <<	note - "<<" must come before "<"
8051	.byte TK_LT			; <
8052	.byte	$00
8053TAB_EQUL
8054	.byte TK_EQUAL,$00	; =
8055TAB_MORE
8056LBB_RSHIFT
8057	.byte	">",TK_RSHIFT	; >>	note - ">>" must come before ">"
8058	.byte TK_GT			; >
8059	.byte	$00
8060TAB_QEST
8061	.byte TK_PRINT,$00	; ?
8062TAB_ASCA
8063LBB_ABS
8064	.byte	"BS(",TK_ABS	; ABS(
8065LBB_AND
8066	.byte	"ND",TK_AND		; AND
8067LBB_ASC
8068	.byte	"SC(",TK_ASC	; ASC(
8069LBB_ATN
8070	.byte	"TN(",TK_ATN	; ATN(
8071	.byte	$00
8072TAB_ASCB
8073LBB_BINS
8074	.byte	"IN$(",TK_BINS	; BIN$(
8075LBB_BITCLR
8076	.byte	"ITCLR",TK_BITCLR	; BITCLR
8077LBB_BITSET
8078	.byte	"ITSET",TK_BITSET	; BITSET
8079LBB_BITTST
8080	.byte	"ITTST(",TK_BITTST
8081					; BITTST(
8082	.byte	$00
8083TAB_ASCC
8084LBB_CALL
8085	.byte	"ALL",TK_CALL	; CALL
8086LBB_CHRS
8087	.byte	"HR$(",TK_CHRS	; CHR$(
8088LBB_CLEAR
8089	.byte	"LEAR",TK_CLEAR	; CLEAR
8090LBB_CONT
8091	.byte	"ONT",TK_CONT	; CONT
8092LBB_COS
8093	.byte	"OS(",TK_COS	; COS(
8094	.byte	$00
8095TAB_ASCD
8096LBB_DATA
8097	.byte	"ATA",TK_DATA	; DATA
8098LBB_DEC
8099	.byte	"EC",TK_DEC		; DEC
8100LBB_DEEK
8101	.byte	"EEK(",TK_DEEK	; DEEK(
8102LBB_DEF
8103	.byte	"EF",TK_DEF		; DEF
8104LBB_DIM
8105	.byte	"IM",TK_DIM		; DIM
8106LBB_DOKE
8107	.byte	"OKE",TK_DOKE	; DOKE note - "DOKE" must come before "DO"
8108LBB_DO
8109	.byte	"O",TK_DO		; DO
8110	.byte	$00
8111TAB_ASCE
8112LBB_END
8113	.byte	"ND",TK_END		; END
8114LBB_EOR
8115	.byte	"OR",TK_EOR		; EOR
8116LBB_EXP
8117	.byte	"XP(",TK_EXP	; EXP(
8118	.byte	$00
8119TAB_ASCF
8120LBB_FN
8121	.byte	"N",TK_FN		; FN
8122LBB_FOR
8123	.byte	"OR",TK_FOR		; FOR
8124LBB_FRE
8125	.byte	"RE(",TK_FRE	; FRE(
8126	.byte	$00
8127TAB_ASCG
8128LBB_GET
8129	.byte	"ET",TK_GET		; GET
8130LBB_GOSUB
8131	.byte	"OSUB",TK_GOSUB	; GOSUB
8132LBB_GOTO
8133	.byte	"OTO",TK_GOTO	; GOTO
8134	.byte	$00
8135TAB_ASCH
8136LBB_HEXS
8137	.byte	"EX$(",TK_HEXS	; HEX$(
8138	.byte	$00
8139TAB_ASCI
8140LBB_IF
8141	.byte	"F",TK_IF		; IF
8142LBB_INC
8143	.byte	"NC",TK_INC		; INC
8144LBB_INPUT
8145	.byte	"NPUT",TK_INPUT	; INPUT
8146LBB_INT
8147	.byte	"NT(",TK_INT	; INT(
8148LBB_IRQ
8149	.byte	"RQ",TK_IRQ		; IRQ
8150	.byte	$00
8151TAB_ASCL
8152LBB_LCASES
8153	.byte	"CASE$(",TK_LCASES
8154					; LCASE$(
8155LBB_LEFTS
8156	.byte	"EFT$(",TK_LEFTS	; LEFT$(
8157LBB_LEN
8158	.byte	"EN(",TK_LEN	; LEN(
8159LBB_LET
8160	.byte	"ET",TK_LET		; LET
8161LBB_LIST
8162	.byte	"IST",TK_LIST	; LIST
8163LBB_LOAD
8164	.byte	"OAD",TK_LOAD	; LOAD
8165LBB_LOG
8166	.byte	"OG(",TK_LOG	; LOG(
8167LBB_LOOP
8168	.byte	"OOP",TK_LOOP	; LOOP
8169	.byte	$00
8170TAB_ASCM
8171LBB_MAX
8172	.byte	"AX(",TK_MAX	; MAX(
8173LBB_MIDS
8174	.byte	"ID$(",TK_MIDS	; MID$(
8175LBB_MIN
8176	.byte	"IN(",TK_MIN	; MIN(
8177	.byte	$00
8178TAB_ASCN
8179LBB_NEW
8180	.byte	"EW",TK_NEW		; NEW
8181LBB_NEXT
8182	.byte	"EXT",TK_NEXT	; NEXT
8183LBB_NMI
8184	.byte	"MI",TK_NMI		; NMI
8185LBB_NOT
8186	.byte	"OT",TK_NOT		; NOT
8187LBB_NULL
8188	.byte	"ULL",TK_NULL	; NULL
8189	.byte	$00
8190TAB_ASCO
8191LBB_OFF
8192	.byte	"FF",TK_OFF		; OFF
8193LBB_ON
8194	.byte	"N",TK_ON		; ON
8195LBB_OR
8196	.byte	"R",TK_OR		; OR
8197	.byte	$00
8198TAB_ASCP
8199LBB_PEEK
8200	.byte	"EEK(",TK_PEEK	; PEEK(
8201LBB_PI
8202	.byte	"I",TK_PI		; PI
8203LBB_POKE
8204	.byte	"OKE",TK_POKE	; POKE
8205LBB_POS
8206	.byte	"OS(",TK_POS	; POS(
8207LBB_PRINT
8208	.byte	"RINT",TK_PRINT	; PRINT
8209	.byte	$00
8210TAB_ASCR
8211LBB_READ
8212	.byte	"EAD",TK_READ	; READ
8213LBB_REM
8214	.byte	"EM",TK_REM		; REM
8215LBB_RESTORE
8216	.byte	"ESTORE",TK_RESTORE
8217					; RESTORE
8218LBB_RETIRQ
8219	.byte	"ETIRQ",TK_RETIRQ	; RETIRQ
8220LBB_RETNMI
8221	.byte	"ETNMI",TK_RETNMI	; RETNMI
8222LBB_RETURN
8223	.byte	"ETURN",TK_RETURN	; RETURN
8224LBB_RIGHTS
8225	.byte	"IGHT$(",TK_RIGHTS
8226					; RIGHT$(
8227LBB_RND
8228	.byte	"ND(",TK_RND	; RND(
8229LBB_RUN
8230	.byte	"UN",TK_RUN		; RUN
8231	.byte	$00
8232TAB_ASCS
8233LBB_SADD
8234	.byte	"ADD(",TK_SADD	; SADD(
8235LBB_SAVE
8236	.byte	"AVE",TK_SAVE	; SAVE
8237LBB_SGN
8238	.byte	"GN(",TK_SGN	; SGN(
8239LBB_SIN
8240	.byte	"IN(",TK_SIN	; SIN(
8241LBB_SPC
8242	.byte	"PC(",TK_SPC	; SPC(
8243LBB_SQR
8244	.byte	"QR(",TK_SQR	; SQR(
8245LBB_STEP
8246	.byte	"TEP",TK_STEP	; STEP
8247LBB_STOP
8248	.byte	"TOP",TK_STOP	; STOP
8249LBB_STRS
8250	.byte	"TR$(",TK_STRS	; STR$(
8251LBB_SWAP
8252	.byte	"WAP",TK_SWAP	; SWAP
8253	.byte	$00
8254TAB_ASCT
8255LBB_TAB
8256	.byte	"AB(",TK_TAB	; TAB(
8257LBB_TAN
8258	.byte	"AN(",TK_TAN	; TAN(
8259LBB_THEN
8260	.byte	"HEN",TK_THEN	; THEN
8261LBB_TO
8262	.byte	"O",TK_TO		; TO
8263LBB_TWOPI
8264	.byte	"WOPI",TK_TWOPI	; TWOPI
8265	.byte	$00
8266TAB_ASCU
8267LBB_UCASES
8268	.byte	"CASE$(",TK_UCASES
8269					; UCASE$(
8270LBB_UNTIL
8271	.byte	"NTIL",TK_UNTIL	; UNTIL
8272LBB_USR
8273	.byte	"SR(",TK_USR	; USR(
8274	.byte	$00
8275TAB_ASCV
8276LBB_VAL
8277	.byte	"AL(",TK_VAL	; VAL(
8278LBB_VPTR
8279	.byte	"ARPTR(",TK_VPTR	; VARPTR(
8280	.byte	$00
8281TAB_ASCW
8282LBB_WAIT
8283	.byte	"AIT",TK_WAIT	; WAIT
8284LBB_WHILE
8285	.byte	"HILE",TK_WHILE	; WHILE
8286LBB_WIDTH
8287	.byte	"IDTH",TK_WIDTH	; WIDTH
8288	.byte	$00
8289TAB_POWR
8290	.byte	TK_POWER,$00	; ^
8291
8292; new decode table for LIST
8293; Table is ..
8294; byte - keyword length, keyword first character
8295; word - pointer to rest of keyword from dictionary
8296
8297; note if length is 1 then the pointer is ignored
8298
8299LAB_KEYT
8300	.byte	3,'E'
8301	.word	LBB_END		; END
8302	.byte	3,'F'
8303	.word	LBB_FOR		; FOR
8304	.byte	4,'N'
8305	.word	LBB_NEXT		; NEXT
8306	.byte	4,'D'
8307	.word	LBB_DATA		; DATA
8308	.byte	5,'I'
8309	.word	LBB_INPUT		; INPUT
8310	.byte	3,'D'
8311	.word	LBB_DIM		; DIM
8312	.byte	4,'R'
8313	.word	LBB_READ		; READ
8314	.byte	3,'L'
8315	.word	LBB_LET		; LET
8316	.byte	3,'D'
8317	.word	LBB_DEC		; DEC
8318	.byte	4,'G'
8319	.word	LBB_GOTO		; GOTO
8320	.byte	3,'R'
8321	.word	LBB_RUN		; RUN
8322	.byte	2,'I'
8323	.word	LBB_IF		; IF
8324	.byte	7,'R'
8325	.word	LBB_RESTORE		; RESTORE
8326	.byte	5,'G'
8327	.word	LBB_GOSUB		; GOSUB
8328	.byte	6,'R'
8329	.word	LBB_RETIRQ		; RETIRQ
8330	.byte	6,'R'
8331	.word	LBB_RETNMI		; RETNMI
8332	.byte	6,'R'
8333	.word	LBB_RETURN		; RETURN
8334	.byte	3,'R'
8335	.word	LBB_REM		; REM
8336	.byte	4,'S'
8337	.word	LBB_STOP		; STOP
8338	.byte	2,'O'
8339	.word	LBB_ON		; ON
8340	.byte	4,'N'
8341	.word	LBB_NULL		; NULL
8342	.byte	3,'I'
8343	.word	LBB_INC		; INC
8344	.byte	4,'W'
8345	.word	LBB_WAIT		; WAIT
8346	.byte	4,'L'
8347	.word	LBB_LOAD		; LOAD
8348	.byte	4,'S'
8349	.word	LBB_SAVE		; SAVE
8350	.byte	3,'D'
8351	.word	LBB_DEF		; DEF
8352	.byte	4,'P'
8353	.word	LBB_POKE		; POKE
8354	.byte	4,'D'
8355	.word	LBB_DOKE		; DOKE
8356	.byte	4,'C'
8357	.word	LBB_CALL		; CALL
8358	.byte	2,'D'
8359	.word	LBB_DO		; DO
8360	.byte	4,'L'
8361	.word	LBB_LOOP		; LOOP
8362	.byte	5,'P'
8363	.word	LBB_PRINT		; PRINT
8364	.byte	4,'C'
8365	.word	LBB_CONT		; CONT
8366	.byte	4,'L'
8367	.word	LBB_LIST		; LIST
8368	.byte	5,'C'
8369	.word	LBB_CLEAR		; CLEAR
8370	.byte	3,'N'
8371	.word	LBB_NEW		; NEW
8372	.byte	5,'W'
8373	.word	LBB_WIDTH		; WIDTH
8374	.byte	3,'G'
8375	.word	LBB_GET		; GET
8376	.byte	4,'S'
8377	.word	LBB_SWAP		; SWAP
8378	.byte	6,'B'
8379	.word	LBB_BITSET		; BITSET
8380	.byte	6,'B'
8381	.word	LBB_BITCLR		; BITCLR
8382	.byte	3,'I'
8383	.word	LBB_IRQ		; IRQ
8384	.byte	3,'N'
8385	.word	LBB_NMI		; NMI
8386
8387; secondary commands (can't start a statement)
8388
8389	.byte	4,'T'
8390	.word	LBB_TAB		; TAB
8391	.byte	2,'T'
8392	.word	LBB_TO		; TO
8393	.byte	2,'F'
8394	.word	LBB_FN		; FN
8395	.byte	4,'S'
8396	.word	LBB_SPC		; SPC
8397	.byte	4,'T'
8398	.word	LBB_THEN		; THEN
8399	.byte	3,'N'
8400	.word	LBB_NOT		; NOT
8401	.byte	4,'S'
8402	.word	LBB_STEP		; STEP
8403	.byte	5,'U'
8404	.word	LBB_UNTIL		; UNTIL
8405	.byte	5,'W'
8406	.word	LBB_WHILE		; WHILE
8407	.byte	3,'O'
8408	.word	LBB_OFF		; OFF
8409
8410; opperators
8411
8412	.byte	1,'+'
8413	.word	$0000			; +
8414	.byte	1,'-'
8415	.word	$0000			; -
8416	.byte	1,'*'
8417	.word	$0000			; *
8418	.byte	1,'/'
8419	.word	$0000			; /
8420	.byte	1,'^'
8421	.word	$0000			; ^
8422	.byte	3,'A'
8423	.word	LBB_AND		; AND
8424	.byte	3,'E'
8425	.word	LBB_EOR		; EOR
8426	.byte	2,'O'
8427	.word	LBB_OR		; OR
8428	.byte	2,'>'
8429	.word	LBB_RSHIFT		; >>
8430	.byte	2,'<'
8431	.word	LBB_LSHIFT		; <<
8432	.byte	1,'>'
8433	.word	$0000			; >
8434	.byte	1,'='
8435	.word	$0000			; =
8436	.byte	1,'<'
8437	.word	$0000			; <
8438
8439; functions
8440
8441	.byte	4,'S'			;
8442	.word	LBB_SGN		; SGN
8443	.byte	4,'I'			;
8444	.word	LBB_INT		; INT
8445	.byte	4,'A'			;
8446	.word	LBB_ABS		; ABS
8447	.byte	4,'U'			;
8448	.word	LBB_USR		; USR
8449	.byte	4,'F'			;
8450	.word	LBB_FRE		; FRE
8451	.byte	4,'P'			;
8452	.word	LBB_POS		; POS
8453	.byte	4,'S'			;
8454	.word	LBB_SQR		; SQR
8455	.byte	4,'R'			;
8456	.word	LBB_RND		; RND
8457	.byte	4,'L'			;
8458	.word	LBB_LOG		; LOG
8459	.byte	4,'E'			;
8460	.word	LBB_EXP		; EXP
8461	.byte	4,'C'			;
8462	.word	LBB_COS		; COS
8463	.byte	4,'S'			;
8464	.word	LBB_SIN		; SIN
8465	.byte	4,'T'			;
8466	.word	LBB_TAN		; TAN
8467	.byte	4,'A'			;
8468	.word	LBB_ATN		; ATN
8469	.byte	5,'P'			;
8470	.word	LBB_PEEK		; PEEK
8471	.byte	5,'D'			;
8472	.word	LBB_DEEK		; DEEK
8473	.byte	5,'S'			;
8474	.word	LBB_SADD		; SADD
8475	.byte	4,'L'			;
8476	.word	LBB_LEN		; LEN
8477	.byte	5,'S'			;
8478	.word	LBB_STRS		; STR$
8479	.byte	4,'V'			;
8480	.word	LBB_VAL		; VAL
8481	.byte	4,'A'			;
8482	.word	LBB_ASC		; ASC
8483	.byte	7,'U'			;
8484	.word	LBB_UCASES		; UCASE$
8485	.byte	7,'L'			;
8486	.word	LBB_LCASES		; LCASE$
8487	.byte	5,'C'			;
8488	.word	LBB_CHRS		; CHR$
8489	.byte	5,'H'			;
8490	.word	LBB_HEXS		; HEX$
8491	.byte	5,'B'			;
8492	.word	LBB_BINS		; BIN$
8493	.byte	7,'B'			;
8494	.word	LBB_BITTST		; BITTST
8495	.byte	4,'M'			;
8496	.word	LBB_MAX		; MAX
8497	.byte	4,'M'			;
8498	.word	LBB_MIN		; MIN
8499	.byte	2,'P'			;
8500	.word	LBB_PI		; PI
8501	.byte	5,'T'			;
8502	.word	LBB_TWOPI		; TWOPI
8503	.byte	7,'V'			;
8504	.word	LBB_VPTR		; VARPTR
8505	.byte	6,'L'			;
8506	.word	LBB_LEFTS		; LEFT$
8507	.byte	7,'R'			;
8508	.word	LBB_RIGHTS		; RIGHT$
8509	.byte	5,'M'			;
8510	.word	LBB_MIDS		; MID$
8511
8512; BASIC messages, mostly error messages
8513
8514LAB_BAER
8515	.word	ERR_NF		;$00 NEXT without FOR
8516	.word	ERR_SN		;$02 syntax
8517	.word	ERR_RG		;$04 RETURN without GOSUB
8518	.word	ERR_OD		;$06 out of data
8519	.word	ERR_FC		;$08 function call
8520	.word	ERR_OV		;$0A overflow
8521	.word	ERR_OM		;$0C out of memory
8522	.word	ERR_US		;$0E undefined statement
8523	.word	ERR_BS		;$10 array bounds
8524	.word	ERR_DD		;$12 double dimension array
8525	.word	ERR_D0		;$14 divide by 0
8526	.word	ERR_ID		;$16 illegal direct
8527	.word	ERR_TM		;$18 type mismatch
8528	.word	ERR_LS		;$1A long string
8529	.word	ERR_ST		;$1C string too complex
8530	.word	ERR_CN		;$1E continue error
8531	.word	ERR_UF		;$20 undefined function
8532	.word ERR_LD		;$22 LOOP without DO
8533
8534; I may implement these two errors to force definition of variables and
8535; dimensioning of arrays before use.
8536
8537;	.word ERR_UV		;$24 undefined variable
8538
8539; the above error has been tested and works (see code and comments below LAB_1D8B)
8540
8541;	.word ERR_UA		;$26 undimensioned array
8542
8543ERR_NF	.byte	"NEXT without FOR",$00
8544ERR_SN	.byte	"Syntax",$00
8545ERR_RG	.byte	"RETURN without GOSUB",$00
8546ERR_OD	.byte	"Out of DATA",$00
8547ERR_FC	.byte	"Function call",$00
8548ERR_OV	.byte	"Overflow",$00
8549ERR_OM	.byte	"Out of memory",$00
8550ERR_US	.byte	"Undefined statement",$00
8551ERR_BS	.byte	"Array bounds",$00
8552ERR_DD	.byte	"Double dimension",$00
8553ERR_D0	.byte	"Divide by zero",$00
8554ERR_ID	.byte	"Illegal direct",$00
8555ERR_TM	.byte	"Type mismatch",$00
8556ERR_LS	.byte	"String too long",$00
8557ERR_ST	.byte	"String too complex",$00
8558ERR_CN	.byte	"Can't continue",$00
8559ERR_UF	.byte	"Undefined function",$00
8560ERR_LD	.byte	"LOOP without DO",$00
8561
8562;ERR_UV	.byte	"Undefined variable",$00
8563
8564; the above error has been tested and works (see code and comments below LAB_1D8B)
8565
8566;ERR_UA	.byte	"Undimensioned array",$00
8567
8568LAB_BMSG	.byte	$0D,$0A,"Break",$00
8569LAB_EMSG	.byte	" Error",$00
8570LAB_LMSG	.byte	" in line ",$00
8571LAB_RMSG	.byte	$0D,$0A,"Ready",$0D,$0A,$00
8572
8573LAB_IMSG	.byte	" Extra ignored",$0D,$0A,$00
8574LAB_REDO	.byte	" Redo from start",$0D,$0A,$00
8575
8576AA_end_basic