1 |
40 |
robfinch |
|
2 |
|
|
; Enhanced BASIC to assemble under 6502 simulator, $ver 2.22
|
3 |
|
|
|
4 |
|
|
; $E7E1 $E7CF $E7C6 $E7D3 $E7D1 $E7D5 $E7CF $E81E $E825
|
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 |
|
|
; 2.20 added ELSE to IF .. THEN and fixed IF .. GOTO to cause error
|
18 |
|
|
; 2.21 fixed IF .. THEN RETURN to not cause error
|
19 |
|
|
; 2.22 fixed RND() breaking the get byte routine
|
20 |
|
|
|
21 |
|
|
macro nat
|
22 |
|
|
.byte $42
|
23 |
|
|
xce
|
24 |
|
|
cpu RTF65002
|
25 |
|
|
endm
|
26 |
|
|
|
27 |
|
|
macro emm
|
28 |
|
|
sec
|
29 |
|
|
xce
|
30 |
|
|
endm
|
31 |
|
|
|
32 |
|
|
macro emm816
|
33 |
|
|
clc
|
34 |
|
|
xce
|
35 |
|
|
cpu W65C816S
|
36 |
|
|
endm
|
37 |
|
|
|
38 |
|
|
DisplayChar = $FFFF8000
|
39 |
|
|
KeybdCheckForKeyDirect = $FFFF8004
|
40 |
|
|
KeybdGetCharDirect = $FFFF8008
|
41 |
|
|
KeybdGetChar = $FFFF800C
|
42 |
|
|
KeybdCheckForChar = $FFFF8010
|
43 |
|
|
RequestIOFocus = $FFFF8014
|
44 |
|
|
ReleaseIOFocus = $FFFF8018
|
45 |
|
|
ClearScreen = $FFFF801C
|
46 |
|
|
HomeCursor = $FFFF8020
|
47 |
|
|
ExitTask = $FFFF8024
|
48 |
|
|
SetKeyboardEcho = $FFFF8028
|
49 |
|
|
Sleep = $FFFF802C
|
50 |
|
|
LoadFile = $FFFF8030
|
51 |
|
|
SaveFile = $FFFF8034
|
52 |
|
|
ICacheInvalidateAll = $FFFF8038
|
53 |
|
|
ICacheInvalidateLine = $FFFF803C
|
54 |
|
|
|
55 |
|
|
LEDS =$FFDC0600
|
56 |
|
|
|
57 |
|
|
OUTNDX EQU 0x778
|
58 |
|
|
INPNDX EQU 0x779
|
59 |
|
|
FILENAME EQU 0x6C0
|
60 |
|
|
FILEBUF EQU 0x05F60000
|
61 |
|
|
|
62 |
|
|
; zero page use ..
|
63 |
|
|
|
64 |
|
|
LAB_WARM = $00 ; BASIC warm start entry point
|
65 |
|
|
Wrmjpl = LAB_WARM+1; BASIC warm start vector jump low byte
|
66 |
|
|
Wrmjph = LAB_WARM+2; BASIC warm start vector jump high byte
|
67 |
|
|
|
68 |
|
|
Usrjmp = $0A ; USR function JMP address
|
69 |
|
|
Usrjpl = Usrjmp+1 ; USR function JMP vector low byte
|
70 |
|
|
Usrjph = Usrjmp+2 ; USR function JMP vector high byte
|
71 |
|
|
Nullct = $0D ; nulls output after each line
|
72 |
|
|
TPos = $0E ; BASIC terminal position byte
|
73 |
|
|
TWidth = $0F ; BASIC terminal width byte
|
74 |
|
|
Iclim = $10 ; input column limit
|
75 |
|
|
Itempl = $11 ; temporary integer low byte
|
76 |
|
|
Itemph = Itempl+1 ; temporary integer high byte
|
77 |
|
|
|
78 |
|
|
nums_1 = Itempl ; number to bin/hex string convert MSB
|
79 |
|
|
nums_2 = nums_1+1 ; number to bin/hex string convert
|
80 |
|
|
nums_3 = nums_1+2 ; number to bin/hex string convert LSB
|
81 |
|
|
|
82 |
|
|
Srchc = $5B ; search character
|
83 |
|
|
Temp3 = Srchc ; temp byte used in number routines
|
84 |
|
|
Scnquo = $5C ; scan-between-quotes flag
|
85 |
|
|
Asrch = Scnquo ; alt search character
|
86 |
|
|
|
87 |
|
|
XOAw_l = Srchc ; eXclusive OR, OR and AND word low byte
|
88 |
|
|
XOAw_h = Scnquo ; eXclusive OR, OR and AND word high byte
|
89 |
|
|
|
90 |
|
|
Ibptr = $5D ; input buffer pointer
|
91 |
|
|
Dimcnt = Ibptr ; # of dimensions
|
92 |
|
|
Tindx = Ibptr ; token index
|
93 |
|
|
|
94 |
|
|
Defdim = $5E ; default DIM flag
|
95 |
|
|
Dtypef = $5F ; data type flag, $FF=string, $00=numeric
|
96 |
|
|
Oquote = $60 ; open quote flag (b7) (Flag: DATA scan; LIST quote; memory)
|
97 |
|
|
Gclctd = $60 ; garbage collected flag
|
98 |
|
|
Sufnxf = $61 ; subscript/FNX flag, 1xxx xxx = FN(0xxx xxx)
|
99 |
|
|
Imode = $62 ; input mode flag, $00=INPUT, $80=READ
|
100 |
|
|
|
101 |
|
|
Cflag = $63 ; comparison evaluation flag
|
102 |
|
|
|
103 |
|
|
TabSiz = $64 ; TAB step size (was input flag)
|
104 |
|
|
|
105 |
|
|
next_s = $65 ; next descriptor stack address
|
106 |
|
|
|
107 |
|
|
; these two bytes form a word pointer to the item
|
108 |
|
|
; currently on top of the descriptor stack
|
109 |
|
|
last_sl = $66 ; last descriptor stack address low byte
|
110 |
|
|
last_sh = $67 ; last descriptor stack address high byte (always $00)
|
111 |
|
|
|
112 |
|
|
des_sk = $68 ; descriptor stack start address (temp strings)
|
113 |
|
|
|
114 |
|
|
; = $70 ; End of descriptor stack
|
115 |
|
|
|
116 |
|
|
ut1_pl = $71 ; utility pointer 1 low byte
|
117 |
|
|
ut1_ph = ut1_pl+1 ; utility pointer 1 high byte
|
118 |
|
|
ut2_pl = $73 ; utility pointer 2 low byte
|
119 |
|
|
ut2_ph = ut2_pl+1 ; utility pointer 2 high byte
|
120 |
|
|
|
121 |
|
|
Temp_2 = ut1_pl ; temp byte for block move
|
122 |
|
|
|
123 |
|
|
FACt_1 = $75 ; FAC temp mantissa1
|
124 |
|
|
FACt_2 = FACt_1+1 ; FAC temp mantissa2
|
125 |
|
|
FACt_3 = FACt_2+1 ; FAC temp mantissa3
|
126 |
|
|
|
127 |
|
|
dims_l = FACt_2 ; array dimension size low byte
|
128 |
|
|
dims_h = FACt_3 ; array dimension size high byte
|
129 |
|
|
|
130 |
|
|
TempB = $78 ; temp page 0 byte
|
131 |
|
|
|
132 |
|
|
Smeml = $79 ; start of mem low byte (Start-of-Basic)
|
133 |
|
|
Smemh = Smeml+1 ; start of mem high byte (Start-of-Basic)
|
134 |
|
|
Svarl = $7B ; start of vars low byte (Start-of-Variables)
|
135 |
|
|
Svarh = Svarl+1 ; start of vars high byte (Start-of-Variables)
|
136 |
|
|
Sarryl = $7D ; var mem end low byte (Start-of-Arrays)
|
137 |
|
|
Sarryh = Sarryl+1 ; var mem end high byte (Start-of-Arrays)
|
138 |
|
|
Earryl = $7F ; array mem end low byte (End-of-Arrays)
|
139 |
|
|
Earryh = Earryl+1 ; array mem end high byte (End-of-Arrays)
|
140 |
|
|
Sstorl = $81 ; string storage low byte (String storage (moving down))
|
141 |
|
|
Sstorh = Sstorl+1 ; string storage high byte (String storage (moving down))
|
142 |
|
|
Sutill = $83 ; string utility ptr low byte
|
143 |
|
|
Sutilh = Sutill+1 ; string utility ptr high byte
|
144 |
|
|
Ememl = $85 ; end of mem low byte (Limit-of-memory)
|
145 |
|
|
Ememh = Ememl+1 ; end of mem high byte (Limit-of-memory)
|
146 |
|
|
Clinel = $87 ; current line low byte (Basic line number)
|
147 |
|
|
Clineh = Clinel+1 ; current line high byte (Basic line number)
|
148 |
|
|
Blinel = $89 ; break line low byte (Previous Basic line number)
|
149 |
|
|
Blineh = Blinel+1 ; break line high byte (Previous Basic line number)
|
150 |
|
|
|
151 |
|
|
Cpntrl = $8B ; continue pointer low byte
|
152 |
|
|
Cpntrh = Cpntrl+1 ; continue pointer high byte
|
153 |
|
|
|
154 |
|
|
Dlinel = $8D ; current DATA line low byte
|
155 |
|
|
Dlineh = Dlinel+1 ; current DATA line high byte
|
156 |
|
|
|
157 |
|
|
Dptrl = $8F ; DATA pointer low byte
|
158 |
|
|
Dptrh = Dptrl+1 ; DATA pointer high byte
|
159 |
|
|
|
160 |
|
|
Rdptrl = $91 ; read pointer low byte
|
161 |
|
|
Rdptrh = Rdptrl+1 ; read pointer high byte
|
162 |
|
|
|
163 |
|
|
Varnm1 = $93 ; current var name 1st byte
|
164 |
|
|
Varnm2 = Varnm1+1 ; current var name 2nd byte
|
165 |
|
|
|
166 |
|
|
Cvaral = $95 ; current var address low byte
|
167 |
|
|
Cvarah = Cvaral+1 ; current var address high byte
|
168 |
|
|
|
169 |
|
|
Frnxtl = $97 ; var pointer for FOR/NEXT low byte
|
170 |
|
|
Frnxth = Frnxtl+1 ; var pointer for FOR/NEXT high byte
|
171 |
|
|
|
172 |
|
|
Tidx1 = Frnxtl ; temp line index
|
173 |
|
|
|
174 |
|
|
Lvarpl = Frnxtl ; let var pointer low byte
|
175 |
|
|
Lvarph = Frnxth ; let var pointer high byte
|
176 |
|
|
|
177 |
|
|
prstk = $99 ; precedence stacked flag
|
178 |
|
|
|
179 |
|
|
comp_f = $9B ; compare function flag, bits 0,1 and 2 used
|
180 |
|
|
; bit 2 set if >
|
181 |
|
|
; bit 1 set if =
|
182 |
|
|
; bit 0 set if <
|
183 |
|
|
|
184 |
|
|
func_l = $9C ; function pointer low byte
|
185 |
|
|
func_h = func_l+1 ; function pointer high byte
|
186 |
|
|
|
187 |
|
|
garb_l = func_l ; garbage collection working pointer low byte
|
188 |
|
|
garb_h = func_h ; garbage collection working pointer high byte
|
189 |
|
|
|
190 |
|
|
des_2l = $9E ; string descriptor_2 pointer low byte
|
191 |
|
|
des_2h = des_2l+1 ; string descriptor_2 pointer high byte
|
192 |
|
|
|
193 |
|
|
g_step = $A0 ; garbage collect step size
|
194 |
|
|
|
195 |
|
|
Fnxjmp = $A1 ; jump vector for functions
|
196 |
|
|
Fnxjpl = Fnxjmp+1 ; functions jump vector low byte
|
197 |
|
|
Fnxjph = Fnxjmp+2 ; functions jump vector high byte
|
198 |
|
|
|
199 |
|
|
g_indx = Fnxjpl ; garbage collect temp index
|
200 |
|
|
|
201 |
|
|
FAC2_r = $A3 ; FAC2 rounding byte
|
202 |
|
|
|
203 |
|
|
Adatal = $A4 ; array data pointer low byte
|
204 |
|
|
Adatah = Adatal+1 ; array data pointer high byte
|
205 |
|
|
|
206 |
|
|
Nbendl = Adatal ; new block end pointer low byte
|
207 |
|
|
Nbendh = Adatah ; new block end pointer high byte
|
208 |
|
|
|
209 |
|
|
Obendl = $A6 ; old block end pointer low byte
|
210 |
|
|
Obendh = Obendl+1 ; old block end pointer high byte
|
211 |
|
|
|
212 |
|
|
numexp = $A8 ; string to float number exponent count
|
213 |
|
|
expcnt = $A9 ; string to float exponent count
|
214 |
|
|
|
215 |
|
|
numbit = numexp ; bit count for array element calculations
|
216 |
|
|
|
217 |
|
|
numdpf = $AA ; string to float decimal point flag
|
218 |
|
|
expneg = $AB ; string to float eval exponent -ve flag
|
219 |
|
|
|
220 |
|
|
Astrtl = numdpf ; array start pointer low byte
|
221 |
|
|
Astrth = expneg ; array start pointer high byte
|
222 |
|
|
|
223 |
|
|
Histrl = numdpf ; highest string low byte
|
224 |
|
|
Histrh = expneg ; highest string high byte
|
225 |
|
|
|
226 |
|
|
Baslnl = numdpf ; BASIC search line pointer low byte
|
227 |
|
|
Baslnh = expneg ; BASIC search line pointer high byte
|
228 |
|
|
|
229 |
|
|
Fvar_l = numdpf ; find/found variable pointer low byte
|
230 |
|
|
Fvar_h = expneg ; find/found variable pointer high byte
|
231 |
|
|
|
232 |
|
|
Ostrtl = numdpf ; old block start pointer low byte
|
233 |
|
|
Ostrth = expneg ; old block start pointer high byte
|
234 |
|
|
|
235 |
|
|
Vrschl = numdpf ; variable search pointer low byte
|
236 |
|
|
Vrschh = expneg ; variable search pointer high byte
|
237 |
|
|
|
238 |
|
|
FAC1_e = $AC ; FAC1 exponent
|
239 |
|
|
FAC1_1 = FAC1_e+1 ; FAC1 mantissa1
|
240 |
|
|
FAC1_2 = FAC1_e+2 ; FAC1 mantissa2
|
241 |
|
|
FAC1_3 = FAC1_e+3 ; FAC1 mantissa3
|
242 |
|
|
FAC1_s = FAC1_e+4 ; FAC1 sign (b7)
|
243 |
|
|
|
244 |
|
|
str_ln = FAC1_e ; string length
|
245 |
|
|
str_pl = FAC1_1 ; string pointer low byte
|
246 |
|
|
str_ph = FAC1_2 ; string pointer high byte
|
247 |
|
|
|
248 |
|
|
des_pl = FAC1_2 ; string descriptor pointer low byte
|
249 |
|
|
des_ph = FAC1_3 ; string descriptor pointer high byte
|
250 |
|
|
|
251 |
|
|
mids_l = FAC1_3 ; MID$ string temp length byte
|
252 |
|
|
|
253 |
|
|
negnum = $B1 ; string to float eval -ve flag
|
254 |
|
|
numcon = $B1 ; series evaluation constant count
|
255 |
|
|
|
256 |
|
|
FAC1_o = $B2 ; FAC1 overflow byte
|
257 |
|
|
|
258 |
|
|
FAC2_e = $B3 ; FAC2 exponent
|
259 |
|
|
FAC2_1 = FAC2_e+1 ; FAC2 mantissa1
|
260 |
|
|
FAC2_2 = FAC2_e+2 ; FAC2 mantissa2
|
261 |
|
|
FAC2_3 = FAC2_e+3 ; FAC2 mantissa3
|
262 |
|
|
FAC2_s = FAC2_e+4 ; FAC2 sign (b7)
|
263 |
|
|
|
264 |
|
|
FAC_sc = $B8 ; FAC sign comparison, Acc#1 vs #2
|
265 |
|
|
FAC1_r = $B9 ; FAC1 rounding byte
|
266 |
|
|
|
267 |
|
|
ssptr_l = FAC_sc ; string start pointer low byte
|
268 |
|
|
ssptr_h = FAC1_r ; string start pointer high byte
|
269 |
|
|
|
270 |
|
|
sdescr = FAC_sc ; string descriptor pointer
|
271 |
|
|
|
272 |
|
|
csidx = $BA ; line crunch save index
|
273 |
|
|
Asptl = csidx ; array size/pointer low byte
|
274 |
|
|
Aspth = $BB ; array size/pointer high byte
|
275 |
|
|
|
276 |
|
|
Btmpl = Asptl ; BASIC pointer temp low byte
|
277 |
|
|
Btmph = Aspth ; BASIC pointer temp low byte
|
278 |
|
|
|
279 |
|
|
Cptrl = Asptl ; BASIC pointer temp low byte
|
280 |
|
|
Cptrh = Aspth ; BASIC pointer temp low byte
|
281 |
|
|
|
282 |
|
|
Sendl = Asptl ; BASIC pointer temp low byte
|
283 |
|
|
Sendh = Aspth ; BASIC pointer temp low byte
|
284 |
|
|
|
285 |
|
|
LAB_IGBY = $BC ; get next BASIC byte subroutine
|
286 |
|
|
|
287 |
|
|
LAB_GBYT = $C2 ; get current BASIC byte subroutine
|
288 |
|
|
Bpntrl = $C3 ; BASIC execute (get byte) pointer low byte
|
289 |
|
|
Bpntrh = Bpntrl+1 ; BASIC execute (get byte) pointer high byte
|
290 |
|
|
|
291 |
|
|
; = $D7 ; end of get BASIC char subroutine
|
292 |
|
|
|
293 |
|
|
Rbyte4 = $D8 ; extra PRNG byte
|
294 |
|
|
Rbyte1 = Rbyte4+1 ; most significant PRNG byte
|
295 |
|
|
Rbyte2 = Rbyte4+2 ; middle PRNG byte
|
296 |
|
|
Rbyte3 = Rbyte4+3 ; least significant PRNG byte
|
297 |
|
|
|
298 |
|
|
NmiBase = $DC ; NMI handler enabled/setup/triggered flags
|
299 |
|
|
; bit function
|
300 |
|
|
; === ========
|
301 |
|
|
; 7 interrupt enabled
|
302 |
|
|
; 6 interrupt setup
|
303 |
|
|
; 5 interrupt happened
|
304 |
|
|
; = $DD ; NMI handler addr low byte
|
305 |
|
|
; = $DE ; NMI handler addr high byte
|
306 |
|
|
IrqBase = $DF ; IRQ handler enabled/setup/triggered flags
|
307 |
|
|
; = $E0 ; IRQ handler addr low byte
|
308 |
|
|
; = $E1 ; IRQ handler addr high byte
|
309 |
|
|
|
310 |
|
|
; = $DE ; unused
|
311 |
|
|
; = $DF ; unused
|
312 |
|
|
; = $E0 ; unused
|
313 |
|
|
; = $E1 ; unused
|
314 |
|
|
; = $E2 ; unused
|
315 |
|
|
; = $E3 ; unused
|
316 |
|
|
; = $E4 ; unused
|
317 |
|
|
; = $E5 ; unused
|
318 |
|
|
; = $E6 ; unused
|
319 |
|
|
; = $E7 ; unused
|
320 |
|
|
; = $E8 ; unused
|
321 |
|
|
; = $E9 ; unused
|
322 |
|
|
; = $EA ; unused
|
323 |
|
|
; = $EB ; unused
|
324 |
|
|
; = $EC ; unused
|
325 |
|
|
; = $ED ; unused
|
326 |
|
|
; = $EE ; unused
|
327 |
|
|
|
328 |
|
|
Decss = $EF ; number to decimal string start
|
329 |
|
|
Decssp1 = Decss+1 ; number to decimal string start
|
330 |
|
|
|
331 |
|
|
; = $FF ; decimal string end
|
332 |
|
|
|
333 |
|
|
; token values needed for BASIC
|
334 |
|
|
|
335 |
|
|
; primary command tokens (can start a statement)
|
336 |
|
|
|
337 |
|
|
TK_END = $80 ; END token
|
338 |
|
|
TK_FOR = TK_END+1 ; FOR token
|
339 |
|
|
TK_NEXT = TK_FOR+1 ; NEXT token
|
340 |
|
|
TK_DATA = TK_NEXT+1 ; DATA token
|
341 |
|
|
TK_INPUT = TK_DATA+1 ; INPUT token
|
342 |
|
|
TK_DIM = TK_INPUT+1 ; DIM token
|
343 |
|
|
TK_READ = TK_DIM+1 ; READ token
|
344 |
|
|
TK_LET = TK_READ+1 ; LET token
|
345 |
|
|
TK_DEC = TK_LET+1 ; DEC token
|
346 |
|
|
TK_GOTO = TK_DEC+1 ; GOTO token
|
347 |
|
|
TK_RUN = TK_GOTO+1 ; RUN token
|
348 |
|
|
TK_IF = TK_RUN+1 ; IF token
|
349 |
|
|
TK_RESTORE = TK_IF+1 ; RESTORE token
|
350 |
|
|
TK_GOSUB = TK_RESTORE+1 ; GOSUB token
|
351 |
|
|
TK_RETIRQ = TK_GOSUB+1 ; RETIRQ token
|
352 |
|
|
TK_RETNMI = TK_RETIRQ+1 ; RETNMI token
|
353 |
|
|
TK_RETURN = TK_RETNMI+1 ; RETURN token
|
354 |
|
|
TK_REM = TK_RETURN+1 ; REM token
|
355 |
|
|
TK_STOP = TK_REM+1 ; STOP token
|
356 |
|
|
TK_ON = TK_STOP+1 ; ON token
|
357 |
|
|
TK_NULL = TK_ON+1 ; NULL token
|
358 |
|
|
TK_INC = TK_NULL+1 ; INC token
|
359 |
|
|
TK_WAIT = TK_INC+1 ; WAIT token
|
360 |
|
|
TK_LOAD = TK_WAIT+1 ; LOAD token
|
361 |
|
|
TK_SAVE = TK_LOAD+1 ; SAVE token
|
362 |
|
|
TK_DEF = TK_SAVE+1 ; DEF token
|
363 |
|
|
TK_POKE = TK_DEF+1 ; POKE token
|
364 |
|
|
TK_DOKE = TK_POKE+1 ; DOKE token
|
365 |
|
|
TK_CALL = TK_DOKE+1 ; CALL token
|
366 |
|
|
TK_DO = TK_CALL+1 ; DO token
|
367 |
|
|
TK_LOOP = TK_DO+1 ; LOOP token
|
368 |
|
|
TK_PRINT = TK_LOOP+1 ; PRINT token
|
369 |
|
|
TK_CONT = TK_PRINT+1 ; CONT token
|
370 |
|
|
TK_LIST = TK_CONT+1 ; LIST token
|
371 |
|
|
TK_CLEAR = TK_LIST+1 ; CLEAR token
|
372 |
|
|
TK_NEW = TK_CLEAR+1 ; NEW token
|
373 |
|
|
TK_WIDTH = TK_NEW+1 ; WIDTH token
|
374 |
|
|
TK_GET = TK_WIDTH+1 ; GET token
|
375 |
|
|
TK_SWAP = TK_GET+1 ; SWAP token
|
376 |
|
|
TK_BITSET = TK_SWAP+1 ; BITSET token
|
377 |
|
|
TK_BITCLR = TK_BITSET+1 ; BITCLR token
|
378 |
|
|
TK_IRQ = TK_BITCLR+1 ; IRQ token
|
379 |
|
|
TK_NMI = TK_IRQ+1 ; NMI token
|
380 |
|
|
TK_BYE = TK_NMI+1
|
381 |
|
|
|
382 |
|
|
; secondary command tokens, can't start a statement
|
383 |
|
|
|
384 |
|
|
TK_TAB = TK_BYE+1 ; TAB token
|
385 |
|
|
TK_ELSE = TK_TAB+1 ; ELSE token
|
386 |
|
|
TK_TO = TK_ELSE+1 ; TO token
|
387 |
|
|
TK_FN = TK_TO+1 ; FN token
|
388 |
|
|
TK_SPC = TK_FN+1 ; SPC token
|
389 |
|
|
TK_THEN = TK_SPC+1 ; THEN token
|
390 |
|
|
TK_NOT = TK_THEN+1 ; NOT token
|
391 |
|
|
TK_STEP = TK_NOT+1 ; STEP token
|
392 |
|
|
TK_UNTIL = TK_STEP+1 ; UNTIL token
|
393 |
|
|
TK_WHILE = TK_UNTIL+1 ; WHILE token
|
394 |
|
|
TK_OFF = TK_WHILE+1 ; OFF token
|
395 |
|
|
|
396 |
|
|
; opperator tokens
|
397 |
|
|
|
398 |
|
|
TK_PLUS = TK_OFF+1 ; + token
|
399 |
|
|
TK_MINUS = TK_PLUS+1 ; - token
|
400 |
|
|
TK_MUL = TK_MINUS+1 ; * token
|
401 |
|
|
TK_DIV = TK_MUL+1 ; / token
|
402 |
|
|
TK_POWER = TK_DIV+1 ; ^ token
|
403 |
|
|
TK_AND = TK_POWER+1 ; AND token
|
404 |
|
|
TK_EOR = TK_AND+1 ; EOR token
|
405 |
|
|
TK_OR = TK_EOR+1 ; OR token
|
406 |
|
|
TK_RSHIFT = TK_OR+1 ; RSHIFT token
|
407 |
|
|
TK_LSHIFT = TK_RSHIFT+1 ; LSHIFT token
|
408 |
|
|
TK_GT = TK_LSHIFT+1 ; > token
|
409 |
|
|
TK_EQUAL = TK_GT+1 ; = token
|
410 |
|
|
TK_LT = TK_EQUAL+1 ; < token
|
411 |
|
|
|
412 |
|
|
; functions tokens
|
413 |
|
|
|
414 |
|
|
TK_SGN = TK_LT+1 ; SGN token
|
415 |
|
|
TK_INT = TK_SGN+1 ; INT token
|
416 |
|
|
TK_ABS = TK_INT+1 ; ABS token
|
417 |
|
|
TK_USR = TK_ABS+1 ; USR token
|
418 |
|
|
TK_FRE = TK_USR+1 ; FRE token
|
419 |
|
|
TK_POS = TK_FRE+1 ; POS token
|
420 |
|
|
TK_SQR = TK_POS+1 ; SQR token
|
421 |
|
|
TK_RND = TK_SQR+1 ; RND token
|
422 |
|
|
TK_LOG = TK_RND+1 ; LOG token
|
423 |
|
|
TK_EXP = TK_LOG+1 ; EXP token
|
424 |
|
|
TK_COS = TK_EXP+1 ; COS token
|
425 |
|
|
TK_SIN = TK_COS+1 ; SIN token
|
426 |
|
|
TK_TAN = TK_SIN+1 ; TAN token
|
427 |
|
|
TK_ATN = TK_TAN+1 ; ATN token
|
428 |
|
|
TK_PEEK = TK_ATN+1 ; PEEK token
|
429 |
|
|
TK_DEEK = TK_PEEK+1 ; DEEK token
|
430 |
|
|
TK_SADD = TK_DEEK+1 ; SADD token
|
431 |
|
|
TK_LEN = TK_SADD+1 ; LEN token
|
432 |
|
|
TK_STRS = TK_LEN+1 ; STR$ token
|
433 |
|
|
TK_VAL = TK_STRS+1 ; VAL token
|
434 |
|
|
TK_ASC = TK_VAL+1 ; ASC token
|
435 |
|
|
TK_UCASES = TK_ASC+1 ; UCASE$ token
|
436 |
|
|
TK_LCASES = TK_UCASES+1 ; LCASE$ token
|
437 |
|
|
TK_CHRS = TK_LCASES+1 ; CHR$ token
|
438 |
|
|
TK_HEXS = TK_CHRS+1 ; HEX$ token
|
439 |
|
|
TK_BINS = TK_HEXS+1 ; BIN$ token
|
440 |
|
|
TK_BITTST = TK_BINS+1 ; BITTST token
|
441 |
|
|
TK_MAX = TK_BITTST+1 ; MAX token
|
442 |
|
|
TK_MIN = TK_MAX+1 ; MIN token
|
443 |
|
|
TK_PI = TK_MIN+1 ; PI token
|
444 |
|
|
TK_TWOPI = TK_PI+1 ; TWOPI token
|
445 |
|
|
TK_VPTR = TK_TWOPI+1 ; VARPTR token
|
446 |
|
|
TK_LEFTS = TK_VPTR+1 ; LEFT$ token
|
447 |
|
|
TK_RIGHTS = TK_LEFTS+1 ; RIGHT$ token
|
448 |
|
|
TK_MIDS = TK_RIGHTS+1 ; MID$ token
|
449 |
|
|
|
450 |
|
|
; offsets from a base of X or Y
|
451 |
|
|
|
452 |
|
|
PLUS_0 = $00 ; X or Y plus 0
|
453 |
|
|
PLUS_1 = $01 ; X or Y plus 1
|
454 |
|
|
PLUS_2 = $02 ; X or Y plus 2
|
455 |
|
|
PLUS_3 = $03 ; X or Y plus 3
|
456 |
|
|
|
457 |
|
|
LAB_STAK = $0100 ; stack bottom, no offset
|
458 |
|
|
|
459 |
|
|
LAB_SKFE = LAB_STAK+$FE
|
460 |
|
|
; flushed stack address
|
461 |
|
|
LAB_SKFF = LAB_STAK+$FF
|
462 |
|
|
; flushed stack address
|
463 |
|
|
|
464 |
|
|
ccflag = $0200 ; BASIC CTRL-C flag, 00 = enabled, 01 = dis
|
465 |
|
|
ccbyte = ccflag+1 ; BASIC CTRL-C byte
|
466 |
|
|
ccnull = ccbyte+1 ; BASIC CTRL-C byte timeout
|
467 |
|
|
|
468 |
|
|
VEC_CC = ccnull+1 ; ctrl c check vector
|
469 |
|
|
|
470 |
|
|
VEC_IN = VEC_CC+2 ; input vector
|
471 |
|
|
VEC_OUT = VEC_IN+2 ; output vector
|
472 |
|
|
VEC_LD = VEC_OUT+2 ; load vector
|
473 |
|
|
VEC_SV = VEC_LD+2 ; save vector
|
474 |
|
|
|
475 |
|
|
; Ibuffs can now be anywhere in RAM, ensure that the max length is < $80
|
476 |
|
|
|
477 |
|
|
;Ibuffs = IRQ_vec+$14
|
478 |
|
|
Ibuffs = VEC_SV+$14
|
479 |
|
|
; start of input buffer after IRQ/NMI code
|
480 |
|
|
Ibuffe = Ibuffs+$47; end of input buffer
|
481 |
|
|
|
482 |
|
|
Ram_base = $0400 ; start of user RAM (set as needed, should be page aligned)
|
483 |
|
|
Ram_top = $1800 ; end of user RAM+1 (set as needed, should be page aligned)
|
484 |
|
|
|
485 |
|
|
include "supermon816.asm"
|
486 |
|
|
|
487 |
|
|
; This start can be changed to suit your system
|
488 |
|
|
|
489 |
|
|
; *= $C000
|
490 |
|
|
cpu W65C02
|
491 |
|
|
org $C000
|
492 |
|
|
|
493 |
|
|
; BASIC cold start entry point
|
494 |
|
|
|
495 |
|
|
; new page 2 initialisation, copy block to ccflag on
|
496 |
|
|
message "LAB_COLD"
|
497 |
|
|
LAB_COLD
|
498 |
|
|
LDY #PG2_TABE-PG2_TABS-1
|
499 |
|
|
; byte count-1
|
500 |
|
|
LAB_2D13
|
501 |
|
|
LDA PG2_TABS,Y ; get byte
|
502 |
|
|
STA ccflag,Y ; store in page 2
|
503 |
|
|
DEY ; decrement count
|
504 |
|
|
BPL LAB_2D13 ; loop if not done
|
505 |
|
|
LDX #$FF ; set byte
|
506 |
|
|
STX Ibuffs-1 ; *** Added by Daryl Rictor for SBC-2 compatibility
|
507 |
|
|
STX Clineh ; set current line high byte (set immediate mode)
|
508 |
|
|
TXS ; reset stack pointer
|
509 |
|
|
|
510 |
|
|
LDA #$4C ; code for JMP
|
511 |
|
|
STA Fnxjmp ; save for jump vector for functions
|
512 |
|
|
|
513 |
|
|
; copy block from LAB_2CEE to $00BC - $00D3
|
514 |
|
|
|
515 |
|
|
LDX #StrTab-LAB_2CEE ; set byte count
|
516 |
|
|
LAB_2D4E
|
517 |
|
|
LDA LAB_2CEE-1,X ; get byte from table
|
518 |
|
|
STA LAB_IGBY-1,X ; save byte in page zero
|
519 |
|
|
DEX ; decrement count
|
520 |
|
|
BNE LAB_2D4E ; loop if not all done
|
521 |
|
|
|
522 |
|
|
; copy block from StrTab to $0000 - $0012
|
523 |
|
|
|
524 |
|
|
LAB_GMEM
|
525 |
|
|
LDX #EndTab-StrTab-1 ; set byte count-1
|
526 |
|
|
TabLoop
|
527 |
|
|
LDA StrTab,X ; get byte from table
|
528 |
|
|
STA PLUS_0,X ; save byte in page zero
|
529 |
|
|
DEX ; decrement count
|
530 |
|
|
BPL TabLoop ; loop if not all done
|
531 |
|
|
|
532 |
|
|
; set-up start values
|
533 |
|
|
|
534 |
|
|
LDA #$00 ; clear A
|
535 |
|
|
STA NmiBase ; clear NMI handler enabled flag
|
536 |
|
|
STA IrqBase ; clear IRQ handler enabled flag
|
537 |
|
|
STA FAC1_o ; clear FAC1 overflow byte
|
538 |
|
|
STA last_sh ; clear descriptor stack top item pointer high byte
|
539 |
|
|
|
540 |
|
|
LDA #$0E ; set default tab size
|
541 |
|
|
STA TabSiz ; save it
|
542 |
|
|
LDA #$03 ; set garbage collect step size for descriptor stack
|
543 |
|
|
STA g_step ; save it
|
544 |
|
|
LDX #des_sk ; descriptor stack start
|
545 |
|
|
STX next_s ; set descriptor stack pointer
|
546 |
|
|
|
547 |
|
|
JSR LAB_CRLF ; print CR/LF
|
548 |
|
|
LDA #
|
549 |
|
|
LDY #>LAB_MSZM ; point to memory size message (high addr)
|
550 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
551 |
|
|
JSR LAB_INLN ; print "? " and get BASIC input
|
552 |
|
|
STX Bpntrl ; set BASIC execute pointer low byte
|
553 |
|
|
STY Bpntrh ; set BASIC execute pointer high byte
|
554 |
|
|
JSR LAB_GBYT ; get last byte back
|
555 |
|
|
|
556 |
|
|
BNE LAB_2DAA ; branch if not null (user typed something)
|
557 |
|
|
|
558 |
|
|
LDY #$00 ; else clear Y
|
559 |
|
|
; character was null so get memory size the hard way
|
560 |
|
|
; we get here with Y=0 and Itempl/h = Ram_base
|
561 |
|
|
LAB_2D93
|
562 |
|
|
INC Itempl ; increment temporary integer low byte
|
563 |
|
|
BNE LAB_2D99 ; branch if no overflow
|
564 |
|
|
|
565 |
|
|
INC Itemph ; increment temporary integer high byte
|
566 |
|
|
LDA Itemph ; get high byte
|
567 |
|
|
CMP #>Ram_top ; compare with top of RAM+1
|
568 |
|
|
BEQ LAB_2DB6 ; branch if match (end of user RAM)
|
569 |
|
|
|
570 |
|
|
LAB_2D99
|
571 |
|
|
LDA #$55 ; set test byte
|
572 |
|
|
STA (Itempl),Y ; save via temporary integer
|
573 |
|
|
CMP (Itempl),Y ; compare via temporary integer
|
574 |
|
|
BNE LAB_2DB6 ; branch if fail
|
575 |
|
|
|
576 |
|
|
ASL ; shift test byte left (now $AA)
|
577 |
|
|
STA (Itempl),Y ; save via temporary integer
|
578 |
|
|
CMP (Itempl),Y ; compare via temporary integer
|
579 |
|
|
BEQ LAB_2D93 ; if ok go do next byte
|
580 |
|
|
|
581 |
|
|
BNE LAB_2DB6 ; branch if fail
|
582 |
|
|
|
583 |
|
|
LAB_2DAA
|
584 |
|
|
JSR LAB_2887 ; get FAC1 from string
|
585 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
586 |
|
|
CMP #$98 ; compare with exponent = 2^24
|
587 |
|
|
BCS LAB_GMEM ; if too large go try again
|
588 |
|
|
|
589 |
|
|
JSR LAB_F2FU ; save integer part of FAC1 in temporary integer
|
590 |
|
|
; (no range check)
|
591 |
|
|
|
592 |
|
|
LAB_2DB6
|
593 |
|
|
LDA Itempl ; get temporary integer low byte
|
594 |
|
|
LDY Itemph ; get temporary integer high byte
|
595 |
|
|
CPY #
|
596 |
|
|
BCC LAB_GMEM ; if too small go try again
|
597 |
|
|
|
598 |
|
|
|
599 |
|
|
; uncomment these lines if you want to check on the high limit of memory. Note if
|
600 |
|
|
; Ram_top is set too low then this will fail. default is ignore it and assume the
|
601 |
|
|
; users know what they're doing!
|
602 |
|
|
|
603 |
|
|
; CPY #>Ram_top ; compare with top of RAM high byte
|
604 |
|
|
; BCC MEM_OK ; branch if < RAM top
|
605 |
|
|
|
606 |
|
|
; BNE LAB_GMEM ; if too large go try again
|
607 |
|
|
; else was = so compare low bytes
|
608 |
|
|
; CMP #
|
609 |
|
|
; BEQ MEM_OK ; branch if = RAM top
|
610 |
|
|
|
611 |
|
|
; BCS LAB_GMEM ; if too large go try again
|
612 |
|
|
|
613 |
|
|
;MEM_OK
|
614 |
|
|
STA Ememl ; set end of mem low byte
|
615 |
|
|
STY Ememh ; set end of mem high byte
|
616 |
|
|
STA Sstorl ; set bottom of string space low byte
|
617 |
|
|
STY Sstorh ; set bottom of string space high byte
|
618 |
|
|
|
619 |
|
|
LDY #
|
620 |
|
|
LDX #>Ram_base ; set start addr high byte
|
621 |
|
|
STY Smeml ; save start of mem low byte
|
622 |
|
|
STX Smemh ; save start of mem high byte
|
623 |
|
|
|
624 |
|
|
; this line is only needed if Ram_base is not $xx00
|
625 |
|
|
|
626 |
|
|
; LDY #$00 ; clear Y
|
627 |
|
|
TYA ; clear A
|
628 |
|
|
STA (Smeml),Y ; clear first byte
|
629 |
|
|
INC Smeml ; increment start of mem low byte
|
630 |
|
|
|
631 |
|
|
; these two lines are only needed if Ram_base is $xxFF
|
632 |
|
|
|
633 |
|
|
; BNE LAB_2E05 ; branch if no rollover
|
634 |
|
|
|
635 |
|
|
; INC Smemh ; increment start of mem high byte
|
636 |
|
|
LAB_2E05
|
637 |
|
|
JSR LAB_CRLF ; print CR/LF
|
638 |
|
|
JSR LAB_1463 ; do "NEW" and "CLEAR"
|
639 |
|
|
LDA Ememl ; get end of mem low byte
|
640 |
|
|
SEC ; set carry for subtract
|
641 |
|
|
SBC Smeml ; subtract start of mem low byte
|
642 |
|
|
TAX ; copy to X
|
643 |
|
|
LDA Ememh ; get end of mem high byte
|
644 |
|
|
SBC Smemh ; subtract start of mem high byte
|
645 |
|
|
JSR LAB_295E ; print XA as unsigned integer (bytes free)
|
646 |
|
|
LDA #
|
647 |
|
|
LDY #>LAB_SMSG ; point to sign-on message (high addr)
|
648 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
649 |
|
|
LDA #
|
650 |
|
|
LDY #>LAB_1274 ; warm start vector high byte
|
651 |
|
|
STA Wrmjpl ; save warm start vector low byte
|
652 |
|
|
STY Wrmjph ; save warm start vector high byte
|
653 |
|
|
JMP (Wrmjpl) ; go do warm start
|
654 |
|
|
|
655 |
|
|
; open up space in memory
|
656 |
|
|
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)
|
657 |
|
|
|
658 |
|
|
; Nbendl,Nbendh - new block end address (A/Y)
|
659 |
|
|
; Obendl,Obendh - old block end address
|
660 |
|
|
; Ostrtl,Ostrth - old block start address
|
661 |
|
|
|
662 |
|
|
; returns with ..
|
663 |
|
|
|
664 |
|
|
; Nbendl,Nbendh - new block start address (high byte - $100)
|
665 |
|
|
; Obendl,Obendh - old block start address (high byte - $100)
|
666 |
|
|
; Ostrtl,Ostrth - old block start address (unchanged)
|
667 |
|
|
|
668 |
|
|
LAB_11CF
|
669 |
|
|
JSR LAB_121F ; check available memory, "Out of memory" error if no room
|
670 |
|
|
; addr to check is in AY (low/high)
|
671 |
|
|
STA Earryl ; save new array mem end low byte
|
672 |
|
|
STY Earryh ; save new array mem end high byte
|
673 |
|
|
|
674 |
|
|
; open up space in memory
|
675 |
|
|
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)
|
676 |
|
|
; don't set array end
|
677 |
|
|
|
678 |
|
|
LAB_11D6
|
679 |
|
|
SEC ; set carry for subtract
|
680 |
|
|
LDA Obendl ; get block end low byte
|
681 |
|
|
SBC Ostrtl ; subtract block start low byte
|
682 |
|
|
TAY ; copy MOD(block length/$100) byte to Y
|
683 |
|
|
LDA Obendh ; get block end high byte
|
684 |
|
|
SBC Ostrth ; subtract block start high byte
|
685 |
|
|
TAX ; copy block length high byte to X
|
686 |
|
|
INX ; +1 to allow for count=0 exit
|
687 |
|
|
TYA ; copy block length low byte to A
|
688 |
|
|
BEQ LAB_120A ; branch if length low byte=0
|
689 |
|
|
|
690 |
|
|
; block is (X-1)*256+Y bytes, do the Y bytes first
|
691 |
|
|
|
692 |
|
|
SEC ; set carry for add + 1, two's complement
|
693 |
|
|
EOR #$FF ; invert low byte for subtract
|
694 |
|
|
ADC Obendl ; add block end low byte
|
695 |
|
|
|
696 |
|
|
STA Obendl ; save corrected old block end low byte
|
697 |
|
|
BCS LAB_11F3 ; branch if no underflow
|
698 |
|
|
|
699 |
|
|
DEC Obendh ; else decrement block end high byte
|
700 |
|
|
SEC ; set carry for add + 1, two's complement
|
701 |
|
|
LAB_11F3
|
702 |
|
|
TYA ; get MOD(block length/$100) byte
|
703 |
|
|
EOR #$FF ; invert low byte for subtract
|
704 |
|
|
ADC Nbendl ; add destination end low byte
|
705 |
|
|
STA Nbendl ; save modified new block end low byte
|
706 |
|
|
BCS LAB_1203 ; branch if no underflow
|
707 |
|
|
|
708 |
|
|
DEC Nbendh ; else decrement block end high byte
|
709 |
|
|
BCC LAB_1203 ; branch always
|
710 |
|
|
|
711 |
|
|
LAB_11FF
|
712 |
|
|
LDA (Obendl),Y ; get byte from source
|
713 |
|
|
STA (Nbendl),Y ; copy byte to destination
|
714 |
|
|
LAB_1203
|
715 |
|
|
DEY ; decrement index
|
716 |
|
|
BNE LAB_11FF ; loop until Y=0
|
717 |
|
|
|
718 |
|
|
; now do Y=0 indexed byte
|
719 |
|
|
LDA (Obendl),Y ; get byte from source
|
720 |
|
|
STA (Nbendl),Y ; save byte to destination
|
721 |
|
|
LAB_120A
|
722 |
|
|
DEC Obendh ; decrement source pointer high byte
|
723 |
|
|
DEC Nbendh ; decrement destination pointer high byte
|
724 |
|
|
DEX ; decrement block count
|
725 |
|
|
BNE LAB_1203 ; loop until count = $0
|
726 |
|
|
|
727 |
|
|
RTS
|
728 |
|
|
|
729 |
|
|
; check room on stack for A bytes
|
730 |
|
|
; stack too deep? do OM error
|
731 |
|
|
|
732 |
|
|
LAB_1212
|
733 |
|
|
STA TempB ; save result in temp byte
|
734 |
|
|
TSX ; copy stack
|
735 |
|
|
CPX TempB ; compare new "limit" with stack
|
736 |
|
|
BCC LAB_OMER ; if stack < limit do "Out of memory" error then warm start
|
737 |
|
|
|
738 |
|
|
RTS
|
739 |
|
|
|
740 |
|
|
; check available memory, "Out of memory" error if no room
|
741 |
|
|
; addr to check is in AY (low/high)
|
742 |
|
|
|
743 |
|
|
LAB_121F
|
744 |
|
|
CPY Sstorh ; compare bottom of string mem high byte
|
745 |
|
|
BCC LAB_124B ; if less then exit (is ok)
|
746 |
|
|
|
747 |
|
|
BNE LAB_1229 ; skip next test if greater (tested <)
|
748 |
|
|
|
749 |
|
|
; high byte was =, now do low byte
|
750 |
|
|
CMP Sstorl ; compare with bottom of string mem low byte
|
751 |
|
|
BCC LAB_124B ; if less then exit (is ok)
|
752 |
|
|
|
753 |
|
|
; addr is > string storage ptr (oops!)
|
754 |
|
|
LAB_1229
|
755 |
|
|
PHA ; push addr low byte
|
756 |
|
|
LDX #$08 ; set index to save Adatal to expneg inclusive
|
757 |
|
|
TYA ; copy addr high byte (to push on stack)
|
758 |
|
|
|
759 |
|
|
; save misc numeric work area
|
760 |
|
|
LAB_122D
|
761 |
|
|
PHA ; push byte
|
762 |
|
|
LDA Adatal-1,X ; get byte from Adatal to expneg ( ,$00 not pushed)
|
763 |
|
|
DEX ; decrement index
|
764 |
|
|
BPL LAB_122D ; loop until all done
|
765 |
|
|
|
766 |
|
|
JSR LAB_GARB ; garbage collection routine
|
767 |
|
|
|
768 |
|
|
; restore misc numeric work area
|
769 |
|
|
LDX #$00 ; clear the index to restore bytes
|
770 |
|
|
LAB_1238
|
771 |
|
|
PLA ; pop byte
|
772 |
|
|
STA Adatal,X ; save byte to Adatal to expneg
|
773 |
|
|
INX ; increment index
|
774 |
|
|
CPX #$08 ; compare with end + 1
|
775 |
|
|
BMI LAB_1238 ; loop if more to do
|
776 |
|
|
|
777 |
|
|
PLA ; pop addr high byte
|
778 |
|
|
TAY ; copy back to Y
|
779 |
|
|
PLA ; pop addr low byte
|
780 |
|
|
CPY Sstorh ; compare bottom of string mem high byte
|
781 |
|
|
BCC LAB_124B ; if less then exit (is ok)
|
782 |
|
|
|
783 |
|
|
BNE LAB_OMER ; if greater do "Out of memory" error then warm start
|
784 |
|
|
|
785 |
|
|
; high byte was =, now do low byte
|
786 |
|
|
CMP Sstorl ; compare with bottom of string mem low byte
|
787 |
|
|
BCS LAB_OMER ; if >= do "Out of memory" error then warm start
|
788 |
|
|
|
789 |
|
|
; ok exit, carry clear
|
790 |
|
|
LAB_124B
|
791 |
|
|
RTS
|
792 |
|
|
|
793 |
|
|
; do "Out of memory" error then warm start
|
794 |
|
|
|
795 |
|
|
LAB_OMER
|
796 |
|
|
LDX #$0C ; error code $0C ("Out of memory" error)
|
797 |
|
|
|
798 |
|
|
; do error #X, then warm start
|
799 |
|
|
|
800 |
|
|
LAB_XERR
|
801 |
|
|
JSR LAB_CRLF ; print CR/LF
|
802 |
|
|
|
803 |
|
|
LDA LAB_BAER,X ; get error message pointer low byte
|
804 |
|
|
LDY LAB_BAER+1,X ; get error message pointer high byte
|
805 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
806 |
|
|
|
807 |
|
|
JSR LAB_1491 ; flush stack and clear continue flag
|
808 |
|
|
LDA #
|
809 |
|
|
LDY #>LAB_EMSG ; point to " Error" high addr
|
810 |
|
|
LAB_1269
|
811 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
812 |
|
|
LDY Clineh ; get current line high byte
|
813 |
|
|
INY ; increment it
|
814 |
|
|
BEQ LAB_1274 ; go do warm start (was immediate mode)
|
815 |
|
|
|
816 |
|
|
; else print line number
|
817 |
|
|
JSR LAB_2953 ; print " in line [LINE #]"
|
818 |
|
|
|
819 |
|
|
; BASIC warm start entry point
|
820 |
|
|
; wait for Basic command
|
821 |
|
|
|
822 |
|
|
LAB_1274
|
823 |
|
|
; clear ON IRQ/NMI bytes
|
824 |
|
|
LDA #$00 ; clear A
|
825 |
|
|
STA IrqBase ; clear enabled byte
|
826 |
|
|
STA NmiBase ; clear enabled byte
|
827 |
|
|
LDA #
|
828 |
|
|
LDY #>LAB_RMSG ; point to "Ready" message high byte
|
829 |
|
|
|
830 |
|
|
JSR LAB_18C3 ; go do print string
|
831 |
|
|
|
832 |
|
|
; wait for Basic command (no "Ready")
|
833 |
|
|
|
834 |
|
|
LAB_127D
|
835 |
|
|
JSR LAB_1357 ; call for BASIC input
|
836 |
|
|
LAB_1280
|
837 |
|
|
STX Bpntrl ; set BASIC execute pointer low byte
|
838 |
|
|
STY Bpntrh ; set BASIC execute pointer high byte
|
839 |
|
|
JSR LAB_GBYT ; scan memory
|
840 |
|
|
BEQ LAB_127D ; loop while null
|
841 |
|
|
|
842 |
|
|
; got to interpret input line now ..
|
843 |
|
|
|
844 |
|
|
LDX #$FF ; current line to null value
|
845 |
|
|
STX Clineh ; set current line high byte
|
846 |
|
|
BCC LAB_1295 ; branch if numeric character (handle new BASIC line)
|
847 |
|
|
|
848 |
|
|
; no line number .. immediate mode
|
849 |
|
|
JSR LAB_13A6 ; crunch keywords into Basic tokens
|
850 |
|
|
JMP LAB_15F6 ; go scan and interpret code
|
851 |
|
|
|
852 |
|
|
; handle new BASIC line
|
853 |
|
|
|
854 |
|
|
LAB_1295
|
855 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
856 |
|
|
JSR LAB_13A6 ; crunch keywords into Basic tokens
|
857 |
|
|
STY Ibptr ; save index pointer to end of crunched line
|
858 |
|
|
JSR LAB_SSLN ; search BASIC for temp integer line number
|
859 |
|
|
BCC LAB_12E6 ; branch if not found
|
860 |
|
|
|
861 |
|
|
; aroooogah! line # already exists! delete it
|
862 |
|
|
LDY #$01 ; set index to next line pointer high byte
|
863 |
|
|
LDA (Baslnl),Y ; get next line pointer high byte
|
864 |
|
|
STA ut1_ph ; save it
|
865 |
|
|
LDA Svarl ; get start of vars low byte
|
866 |
|
|
STA ut1_pl ; save it
|
867 |
|
|
LDA Baslnh ; get found line pointer high byte
|
868 |
|
|
STA ut2_ph ; save it
|
869 |
|
|
LDA Baslnl ; get found line pointer low byte
|
870 |
|
|
DEY ; decrement index
|
871 |
|
|
SBC (Baslnl),Y ; subtract next line pointer low byte
|
872 |
|
|
CLC ; clear carry for add
|
873 |
|
|
ADC Svarl ; add start of vars low byte
|
874 |
|
|
STA Svarl ; save new start of vars low byte
|
875 |
|
|
STA ut2_pl ; save destination pointer low byte
|
876 |
|
|
LDA Svarh ; get start of vars high byte
|
877 |
|
|
ADC #$FF ; -1 + carry
|
878 |
|
|
STA Svarh ; save start of vars high byte
|
879 |
|
|
SBC Baslnh ; subtract found line pointer high byte
|
880 |
|
|
TAX ; copy to block count
|
881 |
|
|
SEC ; set carry for subtract
|
882 |
|
|
LDA Baslnl ; get found line pointer low byte
|
883 |
|
|
SBC Svarl ; subtract start of vars low byte
|
884 |
|
|
TAY ; copy to bytes in first block count
|
885 |
|
|
BCS LAB_12D0 ; branch if overflow
|
886 |
|
|
|
887 |
|
|
INX ; increment block count (correct for =0 loop exit)
|
888 |
|
|
DEC ut2_ph ; decrement destination high byte
|
889 |
|
|
LAB_12D0
|
890 |
|
|
CLC ; clear carry for add
|
891 |
|
|
ADC ut1_pl ; add source pointer low byte
|
892 |
|
|
BCC LAB_12D8 ; branch if no overflow
|
893 |
|
|
|
894 |
|
|
DEC ut1_ph ; else decrement source pointer high byte
|
895 |
|
|
CLC ; clear carry
|
896 |
|
|
|
897 |
|
|
; close up memory to delete old line
|
898 |
|
|
LAB_12D8
|
899 |
|
|
LDA (ut1_pl),Y ; get byte from source
|
900 |
|
|
STA (ut2_pl),Y ; copy to destination
|
901 |
|
|
INY ; increment index
|
902 |
|
|
BNE LAB_12D8 ; while <> 0 do this block
|
903 |
|
|
|
904 |
|
|
INC ut1_ph ; increment source pointer high byte
|
905 |
|
|
INC ut2_ph ; increment destination pointer high byte
|
906 |
|
|
DEX ; decrement block count
|
907 |
|
|
BNE LAB_12D8 ; loop until all done
|
908 |
|
|
|
909 |
|
|
; got new line in buffer and no existing same #
|
910 |
|
|
LAB_12E6
|
911 |
|
|
LDA Ibuffs ; get byte from start of input buffer
|
912 |
|
|
BEQ LAB_1319 ; if null line just go flush stack/vars and exit
|
913 |
|
|
|
914 |
|
|
; got new line and it isn't empty line
|
915 |
|
|
LDA Ememl ; get end of mem low byte
|
916 |
|
|
LDY Ememh ; get end of mem high byte
|
917 |
|
|
STA Sstorl ; set bottom of string space low byte
|
918 |
|
|
STY Sstorh ; set bottom of string space high byte
|
919 |
|
|
LDA Svarl ; get start of vars low byte (end of BASIC)
|
920 |
|
|
STA Obendl ; save old block end low byte
|
921 |
|
|
LDY Svarh ; get start of vars high byte (end of BASIC)
|
922 |
|
|
STY Obendh ; save old block end high byte
|
923 |
|
|
ADC Ibptr ; add input buffer pointer (also buffer length)
|
924 |
|
|
BCC LAB_1301 ; branch if no overflow from add
|
925 |
|
|
|
926 |
|
|
INY ; else increment high byte
|
927 |
|
|
LAB_1301
|
928 |
|
|
STA Nbendl ; save new block end low byte (move to, low byte)
|
929 |
|
|
STY Nbendh ; save new block end high byte
|
930 |
|
|
JSR LAB_11CF ; open up space in memory
|
931 |
|
|
; old start pointer Ostrtl,Ostrth set by the find line call
|
932 |
|
|
LDA Earryl ; get array mem end low byte
|
933 |
|
|
LDY Earryh ; get array mem end high byte
|
934 |
|
|
STA Svarl ; save start of vars low byte
|
935 |
|
|
STY Svarh ; save start of vars high byte
|
936 |
|
|
LDY Ibptr ; get input buffer pointer (also buffer length)
|
937 |
|
|
DEY ; adjust for loop type
|
938 |
|
|
LAB_1311
|
939 |
|
|
LDA Ibuffs-4,Y ; get byte from crunched line
|
940 |
|
|
STA (Baslnl),Y ; save it to program memory
|
941 |
|
|
DEY ; decrement count
|
942 |
|
|
CPY #$03 ; compare with first byte-1
|
943 |
|
|
BNE LAB_1311 ; continue while count <> 3
|
944 |
|
|
|
945 |
|
|
LDA Itemph ; get line # high byte
|
946 |
|
|
STA (Baslnl),Y ; save it to program memory
|
947 |
|
|
DEY ; decrement count
|
948 |
|
|
LDA Itempl ; get line # low byte
|
949 |
|
|
STA (Baslnl),Y ; save it to program memory
|
950 |
|
|
DEY ; decrement count
|
951 |
|
|
LDA #$FF ; set byte to allow chain rebuild. if you didn't set this
|
952 |
|
|
; byte then a zero already here would stop the chain rebuild
|
953 |
|
|
; as it would think it was the [EOT] marker.
|
954 |
|
|
STA (Baslnl),Y ; save it to program memory
|
955 |
|
|
|
956 |
|
|
LAB_1319
|
957 |
|
|
JSR LAB_1477 ; reset execution to start, clear vars and flush stack
|
958 |
|
|
LDX Smeml ; get start of mem low byte
|
959 |
|
|
LDA Smemh ; get start of mem high byte
|
960 |
|
|
LDY #$01 ; index to high byte of next line pointer
|
961 |
|
|
LAB_1325
|
962 |
|
|
STX ut1_pl ; set line start pointer low byte
|
963 |
|
|
STA ut1_ph ; set line start pointer high byte
|
964 |
|
|
LDA (ut1_pl),Y ; get it
|
965 |
|
|
BEQ LAB_133E ; exit if end of program
|
966 |
|
|
|
967 |
|
|
; rebuild chaining of Basic lines
|
968 |
|
|
|
969 |
|
|
LDY #$04 ; point to first code byte of line
|
970 |
|
|
; there is always 1 byte + [EOL] as null entries are deleted
|
971 |
|
|
LAB_1330
|
972 |
|
|
INY ; next code byte
|
973 |
|
|
LDA (ut1_pl),Y ; get byte
|
974 |
|
|
BNE LAB_1330 ; loop if not [EOL]
|
975 |
|
|
|
976 |
|
|
SEC ; set carry for add + 1
|
977 |
|
|
TYA ; copy end index
|
978 |
|
|
ADC ut1_pl ; add to line start pointer low byte
|
979 |
|
|
TAX ; copy to X
|
980 |
|
|
LDY #$00 ; clear index, point to this line's next line pointer
|
981 |
|
|
STA (ut1_pl),Y ; set next line pointer low byte
|
982 |
|
|
TYA ; clear A
|
983 |
|
|
ADC ut1_ph ; add line start pointer high byte + carry
|
984 |
|
|
INY ; increment index to high byte
|
985 |
|
|
STA (ut1_pl),Y ; save next line pointer low byte
|
986 |
|
|
BCC LAB_1325 ; go do next line, branch always, carry clear
|
987 |
|
|
|
988 |
|
|
|
989 |
|
|
LAB_133E
|
990 |
|
|
JMP LAB_127D ; else we just wait for Basic command, no "Ready"
|
991 |
|
|
|
992 |
|
|
; print "? " and get BASIC input
|
993 |
|
|
|
994 |
|
|
LAB_INLN
|
995 |
|
|
JSR LAB_18E3 ; print "?" character
|
996 |
|
|
JSR LAB_18E0 ; print " "
|
997 |
|
|
BNE LAB_1357 ; call for BASIC input and return
|
998 |
|
|
|
999 |
|
|
; receive line from keyboard
|
1000 |
|
|
|
1001 |
|
|
; $08 as delete key (BACKSPACE on standard keyboard)
|
1002 |
|
|
LAB_134B
|
1003 |
|
|
JSR LAB_PRNA ; go print the character
|
1004 |
|
|
DEX ; decrement the buffer counter (delete)
|
1005 |
|
|
.byte $2C ; make LDX into BIT abs
|
1006 |
|
|
|
1007 |
|
|
; call for BASIC input (main entry point)
|
1008 |
|
|
|
1009 |
|
|
LAB_1357
|
1010 |
|
|
LDX #$00 ; clear BASIC line buffer pointer
|
1011 |
|
|
LAB_1359
|
1012 |
|
|
JSR V_INPT ; call scan input device
|
1013 |
|
|
BCC LAB_1359 ; loop if no byte
|
1014 |
|
|
|
1015 |
|
|
BEQ LAB_1359 ; loop until valid input (ignore NULLs)
|
1016 |
|
|
|
1017 |
|
|
CMP #$07 ; compare with [BELL]
|
1018 |
|
|
BEQ LAB_1378 ; branch if [BELL]
|
1019 |
|
|
|
1020 |
|
|
CMP #$0D ; compare with [CR]
|
1021 |
|
|
BEQ LAB_1384 ; do CR/LF exit if [CR]
|
1022 |
|
|
|
1023 |
|
|
CPX #$00 ; compare pointer with $00
|
1024 |
|
|
BNE LAB_1374 ; branch if not empty
|
1025 |
|
|
|
1026 |
|
|
; next two lines ignore any non print character and [SPACE] if input buffer empty
|
1027 |
|
|
|
1028 |
|
|
CMP #$21 ; compare with [SP]+1
|
1029 |
|
|
BCC LAB_1359 ; if < ignore character
|
1030 |
|
|
|
1031 |
|
|
LAB_1374
|
1032 |
|
|
CMP #$08 ; compare with [BACKSPACE] (delete last character)
|
1033 |
|
|
BEQ LAB_134B ; go delete last character
|
1034 |
|
|
|
1035 |
|
|
LAB_1378
|
1036 |
|
|
CPX #Ibuffe-Ibuffs ; compare character count with max
|
1037 |
|
|
BCS LAB_138E ; skip store and do [BELL] if buffer full
|
1038 |
|
|
|
1039 |
|
|
STA Ibuffs,X ; else store in buffer
|
1040 |
|
|
INX ; increment pointer
|
1041 |
|
|
LAB_137F
|
1042 |
|
|
JSR LAB_PRNA ; go print the character
|
1043 |
|
|
BNE LAB_1359 ; always loop for next character
|
1044 |
|
|
|
1045 |
|
|
LAB_1384
|
1046 |
|
|
JMP LAB_1866 ; do CR/LF exit to BASIC
|
1047 |
|
|
message "LAB_138E"
|
1048 |
|
|
; announce buffer full
|
1049 |
|
|
|
1050 |
|
|
LAB_138E
|
1051 |
|
|
LDA #$07 ; [BELL] character into A
|
1052 |
|
|
BNE LAB_137F ; go print the [BELL] but ignore input character
|
1053 |
|
|
; branch always
|
1054 |
|
|
|
1055 |
|
|
; crunch keywords into Basic tokens
|
1056 |
|
|
; position independent buffer version ..
|
1057 |
|
|
; faster, dictionary search version ....
|
1058 |
|
|
|
1059 |
|
|
LAB_13A6
|
1060 |
|
|
LDY #$FF ; set save index (makes for easy math later)
|
1061 |
|
|
|
1062 |
|
|
SEC ; set carry for subtract
|
1063 |
|
|
LDA Bpntrl ; get basic execute pointer low byte
|
1064 |
|
|
SBC #
|
1065 |
|
|
TAX ; copy result to X (index past line # if any)
|
1066 |
|
|
|
1067 |
|
|
STX Oquote ; clear open quote/DATA flag
|
1068 |
|
|
LAB_13AC
|
1069 |
|
|
LDA Ibuffs,X ; get byte from input buffer
|
1070 |
|
|
BEQ LAB_13EC ; if null save byte then exit
|
1071 |
|
|
|
1072 |
|
|
CMP #'_' ; compare with "_"
|
1073 |
|
|
BCS LAB_13EC ; if >= go save byte then continue crunching
|
1074 |
|
|
|
1075 |
|
|
CMP #'<' ; compare with "<"
|
1076 |
|
|
BCS LAB_13CC ; if >= go crunch now
|
1077 |
|
|
|
1078 |
|
|
CMP #'0' ; compare with "0"
|
1079 |
|
|
BCS LAB_13EC ; if >= go save byte then continue crunching
|
1080 |
|
|
|
1081 |
|
|
STA Scnquo ; save buffer byte as search character
|
1082 |
|
|
CMP #$22 ; is it quote character?
|
1083 |
|
|
BEQ LAB_1410 ; branch if so (copy quoted string)
|
1084 |
|
|
|
1085 |
|
|
CMP #'*' ; compare with "*"
|
1086 |
|
|
BCC LAB_13EC ; if < go save byte then continue crunching
|
1087 |
|
|
|
1088 |
|
|
; else crunch now
|
1089 |
|
|
LAB_13CC
|
1090 |
|
|
BIT Oquote ; get open quote/DATA token flag
|
1091 |
|
|
BVS LAB_13EC ; branch if b6 of Oquote set (was DATA)
|
1092 |
|
|
; go save byte then continue crunching
|
1093 |
|
|
|
1094 |
|
|
STX TempB ; save buffer read index
|
1095 |
|
|
STY csidx ; copy buffer save index
|
1096 |
|
|
LDY #
|
1097 |
|
|
STY ut2_pl ; save pointer low byte
|
1098 |
|
|
LDY #>TAB_1STC ; get keyword first character table high address
|
1099 |
|
|
STY ut2_ph ; save pointer high byte
|
1100 |
|
|
LDY #$00 ; clear table pointer
|
1101 |
|
|
|
1102 |
|
|
LAB_13D0
|
1103 |
|
|
CMP (ut2_pl),Y ; compare with keyword first character table byte
|
1104 |
|
|
BEQ LAB_13D1 ; go do word_table_chr if match
|
1105 |
|
|
|
1106 |
|
|
BCC LAB_13EA ; if < keyword first character table byte go restore
|
1107 |
|
|
; Y and save to crunched
|
1108 |
|
|
|
1109 |
|
|
INY ; else increment pointer
|
1110 |
|
|
BNE LAB_13D0 ; and loop (branch always)
|
1111 |
|
|
|
1112 |
|
|
; have matched first character of some keyword
|
1113 |
|
|
|
1114 |
|
|
LAB_13D1
|
1115 |
|
|
TYA ; copy matching index
|
1116 |
|
|
ASL ; *2 (bytes per pointer)
|
1117 |
|
|
TAX ; copy to new index
|
1118 |
|
|
LDA TAB_CHRT,X ; get keyword table pointer low byte
|
1119 |
|
|
STA ut2_pl ; save pointer low byte
|
1120 |
|
|
LDA TAB_CHRT+1,X ; get keyword table pointer high byte
|
1121 |
|
|
STA ut2_ph ; save pointer high byte
|
1122 |
|
|
|
1123 |
|
|
LDY #$FF ; clear table pointer (make -1 for start)
|
1124 |
|
|
|
1125 |
|
|
LDX TempB ; restore buffer read index
|
1126 |
|
|
|
1127 |
|
|
LAB_13D6
|
1128 |
|
|
INY ; next table byte
|
1129 |
|
|
LDA (ut2_pl),Y ; get byte from table
|
1130 |
|
|
LAB_13D8
|
1131 |
|
|
BMI LAB_13EA ; all bytes matched so go save token
|
1132 |
|
|
|
1133 |
|
|
INX ; next buffer byte
|
1134 |
|
|
CMP Ibuffs,X ; compare with byte from input buffer
|
1135 |
|
|
BEQ LAB_13D6 ; go compare next if match
|
1136 |
|
|
|
1137 |
|
|
BNE LAB_1417 ; branch if >< (not found keyword)
|
1138 |
|
|
|
1139 |
|
|
LAB_13EA
|
1140 |
|
|
LDY csidx ; restore save index
|
1141 |
|
|
|
1142 |
|
|
; save crunched to output
|
1143 |
|
|
LAB_13EC
|
1144 |
|
|
INX ; increment buffer index (to next input byte)
|
1145 |
|
|
INY ; increment save index (to next output byte)
|
1146 |
|
|
STA Ibuffs,Y ; save byte to output
|
1147 |
|
|
CMP #$00 ; set the flags, set carry
|
1148 |
|
|
BEQ LAB_142A ; do exit if was null [EOL]
|
1149 |
|
|
|
1150 |
|
|
; A holds token or byte here
|
1151 |
|
|
SBC #':' ; subtract ":" (carry set by CMP #00)
|
1152 |
|
|
BEQ LAB_13FF ; branch if it was ":" (is now $00)
|
1153 |
|
|
|
1154 |
|
|
; A now holds token-$3A
|
1155 |
|
|
CMP #TK_DATA-$3A ; compare with DATA token - $3A
|
1156 |
|
|
BNE LAB_1401 ; branch if not DATA
|
1157 |
|
|
|
1158 |
|
|
; token was : or DATA
|
1159 |
|
|
LAB_13FF
|
1160 |
|
|
STA Oquote ; save token-$3A (clear for ":", TK_DATA-$3A for DATA)
|
1161 |
|
|
LAB_1401
|
1162 |
|
|
EOR #TK_REM-$3A ; effectively subtract REM token offset
|
1163 |
|
|
BNE LAB_13AC ; If wasn't REM then go crunch rest of line
|
1164 |
|
|
|
1165 |
|
|
STA Asrch ; else was REM so set search for [EOL]
|
1166 |
|
|
|
1167 |
|
|
; loop for REM, "..." etc.
|
1168 |
|
|
LAB_1408
|
1169 |
|
|
LDA Ibuffs,X ; get byte from input buffer
|
1170 |
|
|
BEQ LAB_13EC ; branch if null [EOL]
|
1171 |
|
|
|
1172 |
|
|
CMP Asrch ; compare with stored character
|
1173 |
|
|
BEQ LAB_13EC ; branch if match (end quote)
|
1174 |
|
|
|
1175 |
|
|
; entry for copy string in quotes, don't crunch
|
1176 |
|
|
LAB_1410
|
1177 |
|
|
INY ; increment buffer save index
|
1178 |
|
|
STA Ibuffs,Y ; save byte to output
|
1179 |
|
|
INX ; increment buffer read index
|
1180 |
|
|
BNE LAB_1408 ; loop while <> 0 (should never be 0!)
|
1181 |
|
|
|
1182 |
|
|
; not found keyword this go
|
1183 |
|
|
LAB_1417
|
1184 |
|
|
LDX TempB ; compare has failed, restore buffer index (start byte!)
|
1185 |
|
|
|
1186 |
|
|
; now find the end of this word in the table
|
1187 |
|
|
LAB_141B
|
1188 |
|
|
LDA (ut2_pl),Y ; get table byte
|
1189 |
|
|
PHP ; save status
|
1190 |
|
|
INY ; increment table index
|
1191 |
|
|
PLP ; restore byte status
|
1192 |
|
|
BPL LAB_141B ; if not end of keyword go do next
|
1193 |
|
|
|
1194 |
|
|
LDA (ut2_pl),Y ; get byte from keyword table
|
1195 |
|
|
BNE LAB_13D8 ; go test next word if not zero byte (end of table)
|
1196 |
|
|
|
1197 |
|
|
; reached end of table with no match
|
1198 |
|
|
LDA Ibuffs,X ; restore byte from input buffer
|
1199 |
|
|
BPL LAB_13EA ; branch always (all bytes in buffer are $00-$7F)
|
1200 |
|
|
; go save byte in output and continue crunching
|
1201 |
|
|
|
1202 |
|
|
; reached [EOL]
|
1203 |
|
|
LAB_142A
|
1204 |
|
|
INY ; increment pointer
|
1205 |
|
|
INY ; increment pointer (makes it next line pointer high byte)
|
1206 |
|
|
STA Ibuffs,Y ; save [EOL] (marks [EOT] in immediate mode)
|
1207 |
|
|
INY ; adjust for line copy
|
1208 |
|
|
INY ; adjust for line copy
|
1209 |
|
|
INY ; adjust for line copy
|
1210 |
|
|
DEC Bpntrl ; allow for increment (change if buffer starts at $xxFF)
|
1211 |
|
|
RTS
|
1212 |
|
|
|
1213 |
|
|
; search Basic for temp integer line number from start of mem
|
1214 |
|
|
|
1215 |
|
|
LAB_SSLN
|
1216 |
|
|
LDA Smeml ; get start of mem low byte
|
1217 |
|
|
LDX Smemh ; get start of mem high byte
|
1218 |
|
|
|
1219 |
|
|
; search Basic for temp integer line number from AX
|
1220 |
|
|
; returns carry set if found
|
1221 |
|
|
; returns Baslnl/Baslnh pointer to found or next higher (not found) line
|
1222 |
|
|
|
1223 |
|
|
; old 541 new 507
|
1224 |
|
|
|
1225 |
|
|
LAB_SHLN
|
1226 |
|
|
LDY #$01 ; set index
|
1227 |
|
|
STA Baslnl ; save low byte as current
|
1228 |
|
|
STX Baslnh ; save high byte as current
|
1229 |
|
|
LDA (Baslnl),Y ; get pointer high byte from addr
|
1230 |
|
|
BEQ LAB_145F ; pointer was zero so we're done, do 'not found' exit
|
1231 |
|
|
|
1232 |
|
|
LDY #$03 ; set index to line # high byte
|
1233 |
|
|
LDA (Baslnl),Y ; get line # high byte
|
1234 |
|
|
DEY ; decrement index (point to low byte)
|
1235 |
|
|
CMP Itemph ; compare with temporary integer high byte
|
1236 |
|
|
BNE LAB_1455 ; if <> skip low byte check
|
1237 |
|
|
|
1238 |
|
|
LDA (Baslnl),Y ; get line # low byte
|
1239 |
|
|
CMP Itempl ; compare with temporary integer low byte
|
1240 |
|
|
LAB_1455
|
1241 |
|
|
BCS LAB_145E ; else if temp < this line, exit (passed line#)
|
1242 |
|
|
|
1243 |
|
|
LAB_1456
|
1244 |
|
|
DEY ; decrement index to next line ptr high byte
|
1245 |
|
|
LDA (Baslnl),Y ; get next line pointer high byte
|
1246 |
|
|
TAX ; copy to X
|
1247 |
|
|
DEY ; decrement index to next line ptr low byte
|
1248 |
|
|
LDA (Baslnl),Y ; get next line pointer low byte
|
1249 |
|
|
BCC LAB_SHLN ; go search for line # in temp (Itempl/Itemph) from AX
|
1250 |
|
|
; (carry always clear)
|
1251 |
|
|
|
1252 |
|
|
LAB_145E
|
1253 |
|
|
BEQ LAB_1460 ; exit if temp = found line #, carry is set
|
1254 |
|
|
|
1255 |
|
|
LAB_145F
|
1256 |
|
|
CLC ; clear found flag
|
1257 |
|
|
LAB_1460
|
1258 |
|
|
RTS
|
1259 |
|
|
|
1260 |
|
|
; perform NEW
|
1261 |
|
|
|
1262 |
|
|
LAB_NEW
|
1263 |
|
|
BNE LAB_1460 ; exit if not end of statement (to do syntax error)
|
1264 |
|
|
|
1265 |
|
|
LAB_1463
|
1266 |
|
|
LDA #$00 ; clear A
|
1267 |
|
|
TAY ; clear Y
|
1268 |
|
|
STA (Smeml),Y ; clear first line, next line pointer, low byte
|
1269 |
|
|
INY ; increment index
|
1270 |
|
|
STA (Smeml),Y ; clear first line, next line pointer, high byte
|
1271 |
|
|
CLC ; clear carry
|
1272 |
|
|
LDA Smeml ; get start of mem low byte
|
1273 |
|
|
ADC #$02 ; calculate end of BASIC low byte
|
1274 |
|
|
STA Svarl ; save start of vars low byte
|
1275 |
|
|
LDA Smemh ; get start of mem high byte
|
1276 |
|
|
ADC #$00 ; add any carry
|
1277 |
|
|
STA Svarh ; save start of vars high byte
|
1278 |
|
|
|
1279 |
|
|
; reset execution to start, clear vars and flush stack
|
1280 |
|
|
|
1281 |
|
|
LAB_1477
|
1282 |
|
|
CLC ; clear carry
|
1283 |
|
|
LDA Smeml ; get start of mem low byte
|
1284 |
|
|
ADC #$FF ; -1
|
1285 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1286 |
|
|
LDA Smemh ; get start of mem high byte
|
1287 |
|
|
ADC #$FF ; -1+carry
|
1288 |
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
1289 |
|
|
|
1290 |
|
|
; "CLEAR" command gets here
|
1291 |
|
|
|
1292 |
|
|
LAB_147A
|
1293 |
|
|
LDA Ememl ; get end of mem low byte
|
1294 |
|
|
LDY Ememh ; get end of mem high byte
|
1295 |
|
|
STA Sstorl ; set bottom of string space low byte
|
1296 |
|
|
STY Sstorh ; set bottom of string space high byte
|
1297 |
|
|
LDA Svarl ; get start of vars low byte
|
1298 |
|
|
LDY Svarh ; get start of vars high byte
|
1299 |
|
|
STA Sarryl ; save var mem end low byte
|
1300 |
|
|
STY Sarryh ; save var mem end high byte
|
1301 |
|
|
STA Earryl ; save array mem end low byte
|
1302 |
|
|
STY Earryh ; save array mem end high byte
|
1303 |
|
|
JSR LAB_161A ; perform RESTORE command
|
1304 |
|
|
|
1305 |
|
|
; flush stack and clear continue flag
|
1306 |
|
|
|
1307 |
|
|
LAB_1491
|
1308 |
|
|
LDX #des_sk ; set descriptor stack pointer
|
1309 |
|
|
STX next_s ; save descriptor stack pointer
|
1310 |
|
|
PLA ; pull return address low byte
|
1311 |
|
|
TAX ; copy return address low byte
|
1312 |
|
|
PLA ; pull return address high byte
|
1313 |
|
|
STX LAB_SKFE ; save to cleared stack
|
1314 |
|
|
STA LAB_SKFF ; save to cleared stack
|
1315 |
|
|
LDX #$FD ; new stack pointer
|
1316 |
|
|
TXS ; reset stack
|
1317 |
|
|
LDA #$00 ; clear byte
|
1318 |
|
|
STA Cpntrh ; clear continue pointer high byte
|
1319 |
|
|
STA Sufnxf ; clear subscript/FNX flag
|
1320 |
|
|
LAB_14A6
|
1321 |
|
|
RTS
|
1322 |
|
|
|
1323 |
|
|
; perform CLEAR
|
1324 |
|
|
|
1325 |
|
|
LAB_CLEAR
|
1326 |
|
|
BEQ LAB_147A ; if no following token go do "CLEAR"
|
1327 |
|
|
|
1328 |
|
|
; else there was a following token (go do syntax error)
|
1329 |
|
|
RTS
|
1330 |
|
|
|
1331 |
|
|
; perform LIST [n][-m]
|
1332 |
|
|
; bigger, faster version (a _lot_ faster)
|
1333 |
|
|
|
1334 |
|
|
LAB_LIST
|
1335 |
|
|
BCC LAB_14BD ; branch if next character numeric (LIST n..)
|
1336 |
|
|
|
1337 |
|
|
BEQ LAB_14BD ; branch if next character [NULL] (LIST)
|
1338 |
|
|
|
1339 |
|
|
CMP #TK_MINUS ; compare with token for -
|
1340 |
|
|
BNE LAB_14A6 ; exit if not - (LIST -m)
|
1341 |
|
|
|
1342 |
|
|
; LIST [[n][-m]]
|
1343 |
|
|
; this bit sets the n , if present, as the start and end
|
1344 |
|
|
LAB_14BD
|
1345 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
1346 |
|
|
JSR LAB_SSLN ; search BASIC for temp integer line number
|
1347 |
|
|
; (pointer in Baslnl/Baslnh)
|
1348 |
|
|
JSR LAB_GBYT ; scan memory
|
1349 |
|
|
BEQ LAB_14D4 ; branch if no more characters
|
1350 |
|
|
|
1351 |
|
|
; this bit checks the - is present
|
1352 |
|
|
CMP #TK_MINUS ; compare with token for -
|
1353 |
|
|
BNE LAB_1460 ; return if not "-" (will be Syntax error)
|
1354 |
|
|
|
1355 |
|
|
; LIST [n]-m
|
1356 |
|
|
; the - was there so set m as the end value
|
1357 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
1358 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
1359 |
|
|
BNE LAB_1460 ; exit if not ok
|
1360 |
|
|
|
1361 |
|
|
LAB_14D4
|
1362 |
|
|
LDA Itempl ; get temporary integer low byte
|
1363 |
|
|
ORA Itemph ; OR temporary integer high byte
|
1364 |
|
|
BNE LAB_14E2 ; branch if start set
|
1365 |
|
|
|
1366 |
|
|
LDA #$FF ; set for -1
|
1367 |
|
|
STA Itempl ; set temporary integer low byte
|
1368 |
|
|
STA Itemph ; set temporary integer high byte
|
1369 |
|
|
LAB_14E2
|
1370 |
|
|
LDY #$01 ; set index for line
|
1371 |
|
|
STY Oquote ; clear open quote flag
|
1372 |
|
|
JSR LAB_CRLF ; print CR/LF
|
1373 |
|
|
LDA (Baslnl),Y ; get next line pointer high byte
|
1374 |
|
|
; pointer initially set by search at LAB_14BD
|
1375 |
|
|
BEQ LAB_152B ; if null all done so exit
|
1376 |
|
|
JSR LAB_1629 ; do CRTL-C check vector
|
1377 |
|
|
|
1378 |
|
|
INY ; increment index for line
|
1379 |
|
|
LDA (Baslnl),Y ; get line # low byte
|
1380 |
|
|
TAX ; copy to X
|
1381 |
|
|
INY ; increment index
|
1382 |
|
|
LDA (Baslnl),Y ; get line # high byte
|
1383 |
|
|
CMP Itemph ; compare with temporary integer high byte
|
1384 |
|
|
BNE LAB_14FF ; branch if no high byte match
|
1385 |
|
|
|
1386 |
|
|
CPX Itempl ; compare with temporary integer low byte
|
1387 |
|
|
BEQ LAB_1501 ; branch if = last line to do (< will pass next branch)
|
1388 |
|
|
|
1389 |
|
|
LAB_14FF ; else ..
|
1390 |
|
|
BCS LAB_152B ; if greater all done so exit
|
1391 |
|
|
|
1392 |
|
|
LAB_1501
|
1393 |
|
|
STY Tidx1 ; save index for line
|
1394 |
|
|
JSR LAB_295E ; print XA as unsigned integer
|
1395 |
|
|
LDA #$20 ; space is the next character
|
1396 |
|
|
LAB_1508
|
1397 |
|
|
LDY Tidx1 ; get index for line
|
1398 |
|
|
AND #$7F ; mask top out bit of character
|
1399 |
|
|
LAB_150C
|
1400 |
|
|
JSR LAB_PRNA ; go print the character
|
1401 |
|
|
CMP #$22 ; was it " character
|
1402 |
|
|
BNE LAB_1519 ; branch if not
|
1403 |
|
|
|
1404 |
|
|
; we are either entering or leaving a pair of quotes
|
1405 |
|
|
LDA Oquote ; get open quote flag
|
1406 |
|
|
EOR #$FF ; toggle it
|
1407 |
|
|
STA Oquote ; save it back
|
1408 |
|
|
LAB_1519
|
1409 |
|
|
INY ; increment index
|
1410 |
|
|
LDA (Baslnl),Y ; get next byte
|
1411 |
|
|
BNE LAB_152E ; branch if not [EOL] (go print character)
|
1412 |
|
|
TAY ; else clear index
|
1413 |
|
|
LDA (Baslnl),Y ; get next line pointer low byte
|
1414 |
|
|
TAX ; copy to X
|
1415 |
|
|
INY ; increment index
|
1416 |
|
|
LDA (Baslnl),Y ; get next line pointer high byte
|
1417 |
|
|
STX Baslnl ; set pointer to line low byte
|
1418 |
|
|
STA Baslnh ; set pointer to line high byte
|
1419 |
|
|
BNE LAB_14E2 ; go do next line if not [EOT]
|
1420 |
|
|
; else ..
|
1421 |
|
|
LAB_152B
|
1422 |
|
|
RTS
|
1423 |
|
|
|
1424 |
|
|
LAB_152E
|
1425 |
|
|
BPL LAB_150C ; just go print it if not token byte
|
1426 |
|
|
|
1427 |
|
|
; else was token byte so uncrunch it (maybe)
|
1428 |
|
|
BIT Oquote ; test the open quote flag
|
1429 |
|
|
BMI LAB_150C ; just go print character if open quote set
|
1430 |
|
|
|
1431 |
|
|
LDX #>LAB_KEYT ; get table address high byte
|
1432 |
|
|
ASL ; *2
|
1433 |
|
|
ASL ; *4
|
1434 |
|
|
BCC LAB_152F ; branch if no carry
|
1435 |
|
|
|
1436 |
|
|
INX ; else increment high byte
|
1437 |
|
|
CLC ; clear carry for add
|
1438 |
|
|
LAB_152F
|
1439 |
|
|
ADC #
|
1440 |
|
|
BCC LAB_1530 ; branch if no carry
|
1441 |
|
|
|
1442 |
|
|
INX ; else increment high byte
|
1443 |
|
|
LAB_1530
|
1444 |
|
|
STA ut2_pl ; save table pointer low byte
|
1445 |
|
|
STX ut2_ph ; save table pointer high byte
|
1446 |
|
|
STY Tidx1 ; save index for line
|
1447 |
|
|
LDY #$00 ; clear index
|
1448 |
|
|
LDA (ut2_pl),Y ; get length
|
1449 |
|
|
TAX ; copy length
|
1450 |
|
|
INY ; increment index
|
1451 |
|
|
LDA (ut2_pl),Y ; get 1st character
|
1452 |
|
|
DEX ; decrement length
|
1453 |
|
|
BEQ LAB_1508 ; if no more characters exit and print
|
1454 |
|
|
|
1455 |
|
|
JSR LAB_PRNA ; go print the character
|
1456 |
|
|
INY ; increment index
|
1457 |
|
|
LDA (ut2_pl),Y ; get keyword address low byte
|
1458 |
|
|
PHA ; save it for now
|
1459 |
|
|
INY ; increment index
|
1460 |
|
|
LDA (ut2_pl),Y ; get keyword address high byte
|
1461 |
|
|
LDY #$00
|
1462 |
|
|
STA ut2_ph ; save keyword pointer high byte
|
1463 |
|
|
PLA ; pull low byte
|
1464 |
|
|
STA ut2_pl ; save keyword pointer low byte
|
1465 |
|
|
LAB_1540
|
1466 |
|
|
LDA (ut2_pl),Y ; get character
|
1467 |
|
|
DEX ; decrement character count
|
1468 |
|
|
BEQ LAB_1508 ; if last character exit and print
|
1469 |
|
|
|
1470 |
|
|
JSR LAB_PRNA ; go print the character
|
1471 |
|
|
INY ; increment index
|
1472 |
|
|
BNE LAB_1540 ; loop for next character
|
1473 |
|
|
|
1474 |
|
|
; perform FOR
|
1475 |
|
|
|
1476 |
|
|
LAB_FOR
|
1477 |
|
|
LDA #$80 ; set FNX
|
1478 |
|
|
STA Sufnxf ; set subscript/FNX flag
|
1479 |
|
|
JSR LAB_LET ; go do LET
|
1480 |
|
|
PLA ; pull return address
|
1481 |
|
|
PLA ; pull return address
|
1482 |
|
|
LDA #$10 ; we need 16d bytes !
|
1483 |
|
|
JSR LAB_1212 ; check room on stack for A bytes
|
1484 |
|
|
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
|
1485 |
|
|
CLC ; clear carry for add
|
1486 |
|
|
TYA ; copy index to A
|
1487 |
|
|
ADC Bpntrl ; add BASIC execute pointer low byte
|
1488 |
|
|
PHA ; push onto stack
|
1489 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
1490 |
|
|
ADC #$00 ; add carry
|
1491 |
|
|
PHA ; push onto stack
|
1492 |
|
|
LDA Clineh ; get current line high byte
|
1493 |
|
|
PHA ; push onto stack
|
1494 |
|
|
LDA Clinel ; get current line low byte
|
1495 |
|
|
PHA ; push onto stack
|
1496 |
|
|
LDA #TK_TO ; get "TO" token
|
1497 |
|
|
JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start
|
1498 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
1499 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
1500 |
|
|
; else do type mismatch
|
1501 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
1502 |
|
|
ORA #$7F ; set all non sign bits
|
1503 |
|
|
AND FAC1_1 ; and FAC1 mantissa1
|
1504 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
1505 |
|
|
LDA #
|
1506 |
|
|
LDY #>LAB_159F ; set return address high byte
|
1507 |
|
|
STA ut1_pl ; save return address low byte
|
1508 |
|
|
STY ut1_ph ; save return address high byte
|
1509 |
|
|
JMP LAB_1B66 ; round FAC1 and put on stack (returns to next instruction)
|
1510 |
|
|
|
1511 |
|
|
LAB_159F
|
1512 |
|
|
LDA #
|
1513 |
|
|
LDY #>LAB_259C ; set 1 pointer high addr
|
1514 |
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
1515 |
|
|
JSR LAB_GBYT ; scan memory
|
1516 |
|
|
CMP #TK_STEP ; compare with STEP token
|
1517 |
|
|
BNE LAB_15B3 ; jump if not "STEP"
|
1518 |
|
|
|
1519 |
|
|
;.was step so ..
|
1520 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
1521 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
1522 |
|
|
; else do type mismatch
|
1523 |
|
|
LAB_15B3
|
1524 |
|
|
JSR LAB_27CA ; return A=FF,C=1/-ve A=01,C=0/+ve
|
1525 |
|
|
STA FAC1_s ; set FAC1 sign (b7)
|
1526 |
|
|
; this is +1 for +ve step and -1 for -ve step, in NEXT we
|
1527 |
|
|
; compare the FOR value and the TO value and return +1 if
|
1528 |
|
|
; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value
|
1529 |
|
|
; here (+/-1) is then compared to that result and if they
|
1530 |
|
|
; are the same (+ve and FOR > TO or -ve and FOR < TO) then
|
1531 |
|
|
; the loop is done
|
1532 |
|
|
JSR LAB_1B5B ; push sign, round FAC1 and put on stack
|
1533 |
|
|
LDA Frnxth ; get var pointer for FOR/NEXT high byte
|
1534 |
|
|
PHA ; push on stack
|
1535 |
|
|
LDA Frnxtl ; get var pointer for FOR/NEXT low byte
|
1536 |
|
|
PHA ; push on stack
|
1537 |
|
|
LDA #TK_FOR ; get FOR token
|
1538 |
|
|
PHA ; push on stack
|
1539 |
|
|
|
1540 |
|
|
; interpreter inner loop
|
1541 |
|
|
message "LAB_15C2"
|
1542 |
|
|
LAB_15C2
|
1543 |
|
|
JSR LAB_1629 ; do CRTL-C check vector
|
1544 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
1545 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte
|
1546 |
|
|
|
1547 |
|
|
LDX Clineh ; continue line is $FFxx for immediate mode
|
1548 |
|
|
; ($00xx for RUN from immediate mode)
|
1549 |
|
|
INX ; increment it (now $00 if immediate mode)
|
1550 |
|
|
BEQ LAB_15D1 ; branch if null (immediate mode)
|
1551 |
|
|
|
1552 |
|
|
STA Cpntrl ; save continue pointer low byte
|
1553 |
|
|
STY Cpntrh ; save continue pointer high byte
|
1554 |
|
|
LAB_15D1
|
1555 |
|
|
LDY #$00 ; clear index
|
1556 |
|
|
LDA (Bpntrl),Y ; get next byte
|
1557 |
|
|
BEQ LAB_15DC ; branch if null [EOL]
|
1558 |
|
|
|
1559 |
|
|
CMP #':' ; compare with ":"
|
1560 |
|
|
BEQ LAB_15F6 ; branch if = (statement separator)
|
1561 |
|
|
|
1562 |
|
|
LAB_15D9
|
1563 |
|
|
JMP LAB_SNER ; else syntax error then warm start
|
1564 |
|
|
|
1565 |
|
|
; have reached [EOL]
|
1566 |
|
|
LAB_15DC
|
1567 |
|
|
LDY #$02 ; set index
|
1568 |
|
|
LDA (Bpntrl),Y ; get next line pointer high byte
|
1569 |
|
|
CLC ; clear carry for no "BREAK" message
|
1570 |
|
|
BEQ LAB_1651 ; if null go to immediate mode (was immediate or [EOT]
|
1571 |
|
|
; marker)
|
1572 |
|
|
|
1573 |
|
|
INY ; increment index
|
1574 |
|
|
LDA (Bpntrl),Y ; get line # low byte
|
1575 |
|
|
STA Clinel ; save current line low byte
|
1576 |
|
|
INY ; increment index
|
1577 |
|
|
LDA (Bpntrl),Y ; get line # high byte
|
1578 |
|
|
STA Clineh ; save current line high byte
|
1579 |
|
|
TYA ; A now = 4
|
1580 |
|
|
ADC Bpntrl ; add BASIC execute pointer low byte
|
1581 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1582 |
|
|
BCC LAB_15F6 ; branch if no overflow
|
1583 |
|
|
|
1584 |
|
|
INC Bpntrh ; else increment BASIC execute pointer high byte
|
1585 |
|
|
LAB_15F6
|
1586 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
1587 |
|
|
|
1588 |
|
|
LAB_15F9
|
1589 |
|
|
JSR LAB_15FF ; go interpret BASIC code from (Bpntrl)
|
1590 |
|
|
|
1591 |
|
|
LAB_15FC
|
1592 |
|
|
JMP LAB_15C2 ; loop
|
1593 |
|
|
|
1594 |
|
|
; interpret BASIC code from (Bpntrl)
|
1595 |
|
|
|
1596 |
|
|
LAB_15FF
|
1597 |
|
|
BEQ LAB_1628 ; exit if zero [EOL]
|
1598 |
|
|
|
1599 |
|
|
LAB_1602
|
1600 |
|
|
ASL ; *2 bytes per vector and normalise token
|
1601 |
|
|
BCS LAB_1609 ; branch if was token
|
1602 |
|
|
|
1603 |
|
|
JMP LAB_LET ; else go do implied LET
|
1604 |
|
|
message "LAB_1609"
|
1605 |
|
|
LAB_1609
|
1606 |
|
|
CMP #[TK_TAB-$80]*2 ; compare normalised token * 2 with TAB
|
1607 |
|
|
BCS LAB_15D9 ; branch if A>=TAB (do syntax error then warm start)
|
1608 |
|
|
; only tokens before TAB can start a line
|
1609 |
|
|
TAY ; copy to index
|
1610 |
|
|
LDA LAB_CTBL+1,Y ; get vector high byte
|
1611 |
|
|
PHA ; onto stack
|
1612 |
|
|
LDA LAB_CTBL,Y ; get vector low byte
|
1613 |
|
|
PHA ; onto stack
|
1614 |
|
|
JMP LAB_IGBY ; jump to increment and scan memory
|
1615 |
|
|
; then "return" to vector
|
1616 |
|
|
|
1617 |
|
|
; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
|
1618 |
|
|
; key press is detected.
|
1619 |
|
|
message "LAB_1629"
|
1620 |
|
|
LAB_1629
|
1621 |
|
|
JMP (VEC_CC) ; ctrl c check vector
|
1622 |
|
|
|
1623 |
|
|
; if there was a key press it gets back here ..
|
1624 |
|
|
|
1625 |
|
|
LAB_1636
|
1626 |
|
|
CMP #$03 ; compare with CTRL-C
|
1627 |
|
|
|
1628 |
|
|
; perform STOP
|
1629 |
|
|
|
1630 |
|
|
LAB_STOP
|
1631 |
|
|
BCS LAB_163B ; branch if token follows STOP
|
1632 |
|
|
; else just END
|
1633 |
|
|
; END
|
1634 |
|
|
|
1635 |
|
|
LAB_END
|
1636 |
|
|
CLC ; clear the carry, indicate a normal program end
|
1637 |
|
|
LAB_163B
|
1638 |
|
|
BNE LAB_167A ; if wasn't CTRL-C or there is a following byte return
|
1639 |
|
|
|
1640 |
|
|
LDA Bpntrh ; get the BASIC execute pointer high byte
|
1641 |
|
|
EOR #>Ibuffs ; compare with buffer address high byte (Cb unchanged)
|
1642 |
|
|
BEQ LAB_164F ; branch if the BASIC pointer is in the input buffer
|
1643 |
|
|
; (can't continue in immediate mode)
|
1644 |
|
|
|
1645 |
|
|
; else ..
|
1646 |
|
|
EOR #>Ibuffs ; correct the bits
|
1647 |
|
|
LDY Bpntrl ; get BASIC execute pointer low byte
|
1648 |
|
|
STY Cpntrl ; save continue pointer low byte
|
1649 |
|
|
STA Cpntrh ; save continue pointer high byte
|
1650 |
|
|
LAB_1647
|
1651 |
|
|
LDA Clinel ; get current line low byte
|
1652 |
|
|
LDY Clineh ; get current line high byte
|
1653 |
|
|
STA Blinel ; save break line low byte
|
1654 |
|
|
STY Blineh ; save break line high byte
|
1655 |
|
|
LAB_164F
|
1656 |
|
|
PLA ; pull return address low
|
1657 |
|
|
PLA ; pull return address high
|
1658 |
|
|
LAB_1651
|
1659 |
|
|
BCC LAB_165E ; if was program end just do warm start
|
1660 |
|
|
|
1661 |
|
|
; else ..
|
1662 |
|
|
LDA #
|
1663 |
|
|
LDY #>LAB_BMSG ; point to "Break" high byte
|
1664 |
|
|
JMP LAB_1269 ; print "Break" and do warm start
|
1665 |
|
|
|
1666 |
|
|
LAB_165E
|
1667 |
|
|
JMP LAB_1274 ; go do warm start
|
1668 |
|
|
|
1669 |
|
|
; perform RESTORE
|
1670 |
|
|
|
1671 |
|
|
LAB_RESTORE
|
1672 |
|
|
BNE LAB_RESTOREn ; branch if next character not null (RESTORE n)
|
1673 |
|
|
|
1674 |
|
|
LAB_161A
|
1675 |
|
|
SEC ; set carry for subtract
|
1676 |
|
|
LDA Smeml ; get start of mem low byte
|
1677 |
|
|
SBC #$01 ; -1
|
1678 |
|
|
LDY Smemh ; get start of mem high byte
|
1679 |
|
|
BCS LAB_1624 ; branch if no underflow
|
1680 |
|
|
|
1681 |
|
|
LAB_uflow
|
1682 |
|
|
DEY ; else decrement high byte
|
1683 |
|
|
LAB_1624
|
1684 |
|
|
STA Dptrl ; save DATA pointer low byte
|
1685 |
|
|
STY Dptrh ; save DATA pointer high byte
|
1686 |
|
|
LAB_1628
|
1687 |
|
|
RTS
|
1688 |
|
|
|
1689 |
|
|
; is RESTORE n
|
1690 |
|
|
LAB_RESTOREn
|
1691 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
1692 |
|
|
JSR LAB_SNBL ; scan for next BASIC line
|
1693 |
|
|
LDA Clineh ; get current line high byte
|
1694 |
|
|
CMP Itemph ; compare with temporary integer high byte
|
1695 |
|
|
BCS LAB_reset_search ; branch if >= (start search from beginning)
|
1696 |
|
|
|
1697 |
|
|
TYA ; else copy line index to A
|
1698 |
|
|
SEC ; set carry (+1)
|
1699 |
|
|
ADC Bpntrl ; add BASIC execute pointer low byte
|
1700 |
|
|
LDX Bpntrh ; get BASIC execute pointer high byte
|
1701 |
|
|
BCC LAB_go_search ; branch if no overflow to high byte
|
1702 |
|
|
|
1703 |
|
|
INX ; increment high byte
|
1704 |
|
|
BCS LAB_go_search ; branch always (can never be carry clear)
|
1705 |
|
|
|
1706 |
|
|
; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)
|
1707 |
|
|
|
1708 |
|
|
LAB_reset_search
|
1709 |
|
|
LDA Smeml ; get start of mem low byte
|
1710 |
|
|
LDX Smemh ; get start of mem high byte
|
1711 |
|
|
|
1712 |
|
|
; search for line # in temp (Itempl/Itemph) from (AX)
|
1713 |
|
|
|
1714 |
|
|
LAB_go_search
|
1715 |
|
|
|
1716 |
|
|
JSR LAB_SHLN ; search Basic for temp integer line number from AX
|
1717 |
|
|
BCS LAB_line_found ; if carry set go set pointer
|
1718 |
|
|
|
1719 |
|
|
JMP LAB_16F7 ; else go do "Undefined statement" error
|
1720 |
|
|
|
1721 |
|
|
LAB_line_found
|
1722 |
|
|
; carry already set for subtract
|
1723 |
|
|
LDA Baslnl ; get pointer low byte
|
1724 |
|
|
SBC #$01 ; -1
|
1725 |
|
|
LDY Baslnh ; get pointer high byte
|
1726 |
|
|
BCS LAB_1624 ; branch if no underflow (save DATA pointer and return)
|
1727 |
|
|
|
1728 |
|
|
BCC LAB_uflow ; else decrement high byte then save DATA pointer and
|
1729 |
|
|
; return (branch always)
|
1730 |
|
|
|
1731 |
|
|
; perform NULL
|
1732 |
|
|
|
1733 |
|
|
LAB_NULL
|
1734 |
|
|
JSR LAB_GTBY ; get byte parameter
|
1735 |
|
|
STX Nullct ; save new NULL count
|
1736 |
|
|
LAB_167A
|
1737 |
|
|
RTS
|
1738 |
|
|
|
1739 |
|
|
; perform CONT
|
1740 |
|
|
message "LAB_CONT"
|
1741 |
|
|
LAB_CONT
|
1742 |
|
|
BNE LAB_167A ; if following byte exit to do syntax error
|
1743 |
|
|
|
1744 |
|
|
LDY Cpntrh ; get continue pointer high byte
|
1745 |
|
|
BNE LAB_166C ; go do continue if we can
|
1746 |
|
|
|
1747 |
|
|
LDX #$1E ; error code $1E ("Can't continue" error)
|
1748 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
1749 |
|
|
|
1750 |
|
|
; we can continue so ..
|
1751 |
|
|
LAB_166C
|
1752 |
|
|
LDA #TK_ON ; set token for ON
|
1753 |
|
|
JSR LAB_IRQ ; set IRQ flags
|
1754 |
|
|
LDA #TK_ON ; set token for ON
|
1755 |
|
|
JSR LAB_NMI ; set NMI flags
|
1756 |
|
|
|
1757 |
|
|
STY Bpntrh ; save BASIC execute pointer high byte
|
1758 |
|
|
LDA Cpntrl ; get continue pointer low byte
|
1759 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1760 |
|
|
LDA Blinel ; get break line low byte
|
1761 |
|
|
LDY Blineh ; get break line high byte
|
1762 |
|
|
STA Clinel ; set current line low byte
|
1763 |
|
|
STY Clineh ; set current line high byte
|
1764 |
|
|
RTS
|
1765 |
|
|
|
1766 |
|
|
; perform RUN
|
1767 |
|
|
|
1768 |
|
|
LAB_RUN
|
1769 |
|
|
BNE LAB_1696 ; branch if RUN n
|
1770 |
|
|
JMP LAB_1477 ; reset execution to start, clear variables, flush stack and
|
1771 |
|
|
; return
|
1772 |
|
|
|
1773 |
|
|
; does RUN n
|
1774 |
|
|
|
1775 |
|
|
LAB_1696
|
1776 |
|
|
JSR LAB_147A ; go do "CLEAR"
|
1777 |
|
|
BEQ LAB_16B0 ; get n and do GOTO n (branch always as CLEAR sets Z=1)
|
1778 |
|
|
|
1779 |
|
|
; perform DO
|
1780 |
|
|
|
1781 |
|
|
LAB_DO
|
1782 |
|
|
LDA #$05 ; need 5 bytes for DO
|
1783 |
|
|
JSR LAB_1212 ; check room on stack for A bytes
|
1784 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
1785 |
|
|
PHA ; push on stack
|
1786 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
1787 |
|
|
PHA ; push on stack
|
1788 |
|
|
LDA Clineh ; get current line high byte
|
1789 |
|
|
PHA ; push on stack
|
1790 |
|
|
LDA Clinel ; get current line low byte
|
1791 |
|
|
PHA ; push on stack
|
1792 |
|
|
LDA #TK_DO ; token for DO
|
1793 |
|
|
PHA ; push on stack
|
1794 |
|
|
JSR LAB_GBYT ; scan memory
|
1795 |
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
1796 |
|
|
|
1797 |
|
|
; perform GOSUB
|
1798 |
|
|
|
1799 |
|
|
LAB_GOSUB
|
1800 |
|
|
LDA #$05 ; need 5 bytes for GOSUB
|
1801 |
|
|
JSR LAB_1212 ; check room on stack for A bytes
|
1802 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
1803 |
|
|
PHA ; push on stack
|
1804 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
1805 |
|
|
PHA ; push on stack
|
1806 |
|
|
LDA Clineh ; get current line high byte
|
1807 |
|
|
PHA ; push on stack
|
1808 |
|
|
LDA Clinel ; get current line low byte
|
1809 |
|
|
PHA ; push on stack
|
1810 |
|
|
LDA #TK_GOSUB ; token for GOSUB
|
1811 |
|
|
PHA ; push on stack
|
1812 |
|
|
LAB_16B0
|
1813 |
|
|
JSR LAB_GBYT ; scan memory
|
1814 |
|
|
JSR LAB_GOTO ; perform GOTO n
|
1815 |
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
1816 |
|
|
; (can't RTS, we used the stack!)
|
1817 |
|
|
|
1818 |
|
|
; perform GOTO
|
1819 |
|
|
|
1820 |
|
|
LAB_GOTO
|
1821 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
1822 |
|
|
JSR LAB_SNBL ; scan for next BASIC line
|
1823 |
|
|
LDA Clineh ; get current line high byte
|
1824 |
|
|
CMP Itemph ; compare with temporary integer high byte
|
1825 |
|
|
BCS LAB_16D0 ; branch if >= (start search from beginning)
|
1826 |
|
|
|
1827 |
|
|
TYA ; else copy line index to A
|
1828 |
|
|
SEC ; set carry (+1)
|
1829 |
|
|
ADC Bpntrl ; add BASIC execute pointer low byte
|
1830 |
|
|
LDX Bpntrh ; get BASIC execute pointer high byte
|
1831 |
|
|
BCC LAB_16D4 ; branch if no overflow to high byte
|
1832 |
|
|
|
1833 |
|
|
INX ; increment high byte
|
1834 |
|
|
BCS LAB_16D4 ; branch always (can never be carry)
|
1835 |
|
|
|
1836 |
|
|
; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)
|
1837 |
|
|
|
1838 |
|
|
LAB_16D0
|
1839 |
|
|
LDA Smeml ; get start of mem low byte
|
1840 |
|
|
LDX Smemh ; get start of mem high byte
|
1841 |
|
|
|
1842 |
|
|
; search for line # in temp (Itempl/Itemph) from (AX)
|
1843 |
|
|
|
1844 |
|
|
LAB_16D4
|
1845 |
|
|
JSR LAB_SHLN ; search Basic for temp integer line number from AX
|
1846 |
|
|
BCC LAB_16F7 ; if carry clear go do "Undefined statement" error
|
1847 |
|
|
; (unspecified statement)
|
1848 |
|
|
|
1849 |
|
|
; carry already set for subtract
|
1850 |
|
|
LDA Baslnl ; get pointer low byte
|
1851 |
|
|
SBC #$01 ; -1
|
1852 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1853 |
|
|
LDA Baslnh ; get pointer high byte
|
1854 |
|
|
SBC #$00 ; subtract carry
|
1855 |
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
1856 |
|
|
LAB_16E5
|
1857 |
|
|
RTS
|
1858 |
|
|
|
1859 |
|
|
LAB_DONOK
|
1860 |
|
|
LDX #$22 ; error code $22 ("LOOP without DO" error)
|
1861 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
1862 |
|
|
|
1863 |
|
|
; perform LOOP
|
1864 |
|
|
|
1865 |
|
|
LAB_LOOP
|
1866 |
|
|
TAY ; save following token
|
1867 |
|
|
TSX ; copy stack pointer
|
1868 |
|
|
LDA LAB_STAK+3,X ; get token byte from stack
|
1869 |
|
|
CMP #TK_DO ; compare with DO token
|
1870 |
|
|
BNE LAB_DONOK ; branch if no matching DO
|
1871 |
|
|
|
1872 |
|
|
INX ; dump calling routine return address
|
1873 |
|
|
INX ; dump calling routine return address
|
1874 |
|
|
TXS ; correct stack
|
1875 |
|
|
TYA ; get saved following token back
|
1876 |
|
|
BEQ LoopAlways ; if no following token loop forever
|
1877 |
|
|
; (stack pointer in X)
|
1878 |
|
|
|
1879 |
|
|
CMP #':' ; could be ':'
|
1880 |
|
|
BEQ LoopAlways ; if :... loop forever
|
1881 |
|
|
|
1882 |
|
|
SBC #TK_UNTIL ; subtract token for UNTIL, we know carry is set here
|
1883 |
|
|
TAX ; copy to X (if it was UNTIL then Y will be correct)
|
1884 |
|
|
BEQ DoRest ; branch if was UNTIL
|
1885 |
|
|
|
1886 |
|
|
DEX ; decrement result
|
1887 |
|
|
BNE LAB_16FC ; if not WHILE go do syntax error and warm start
|
1888 |
|
|
; only if the token was WHILE will this fail
|
1889 |
|
|
|
1890 |
|
|
DEX ; set invert result byte
|
1891 |
|
|
DoRest
|
1892 |
|
|
STX Frnxth ; save invert result byte
|
1893 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
1894 |
|
|
JSR LAB_EVEX ; evaluate expression
|
1895 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
1896 |
|
|
BEQ DoCmp ; if =0 go do straight compare
|
1897 |
|
|
|
1898 |
|
|
LDA #$FF ; else set all bits
|
1899 |
|
|
DoCmp
|
1900 |
|
|
TSX ; copy stack pointer
|
1901 |
|
|
EOR Frnxth ; EOR with invert byte
|
1902 |
|
|
BNE LoopDone ; if <> 0 clear stack and back to interpreter loop
|
1903 |
|
|
|
1904 |
|
|
; loop condition wasn't met so do it again
|
1905 |
|
|
LoopAlways
|
1906 |
|
|
LDA LAB_STAK+2,X ; get current line low byte
|
1907 |
|
|
STA Clinel ; save current line low byte
|
1908 |
|
|
LDA LAB_STAK+3,X ; get current line high byte
|
1909 |
|
|
STA Clineh ; save current line high byte
|
1910 |
|
|
LDA LAB_STAK+4,X ; get BASIC execute pointer low byte
|
1911 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1912 |
|
|
LDA LAB_STAK+5,X ; get BASIC execute pointer high byte
|
1913 |
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
1914 |
|
|
JSR LAB_GBYT ; scan memory
|
1915 |
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
1916 |
|
|
|
1917 |
|
|
; clear stack and back to interpreter loop
|
1918 |
|
|
LoopDone
|
1919 |
|
|
INX ; dump DO token
|
1920 |
|
|
INX ; dump current line low byte
|
1921 |
|
|
INX ; dump current line high byte
|
1922 |
|
|
INX ; dump BASIC execute pointer low byte
|
1923 |
|
|
INX ; dump BASIC execute pointer high byte
|
1924 |
|
|
TXS ; correct stack
|
1925 |
|
|
JMP LAB_DATA ; go perform DATA (find : or [EOL])
|
1926 |
|
|
|
1927 |
|
|
; do the return without gosub error
|
1928 |
|
|
|
1929 |
|
|
LAB_16F4
|
1930 |
|
|
LDX #$04 ; error code $04 ("RETURN without GOSUB" error)
|
1931 |
|
|
.byte $2C ; makes next line BIT LAB_0EA2
|
1932 |
|
|
|
1933 |
|
|
LAB_16F7 ; do undefined statement error
|
1934 |
|
|
LDX #$0E ; error code $0E ("Undefined statement" error)
|
1935 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
1936 |
|
|
|
1937 |
|
|
; perform RETURN
|
1938 |
|
|
|
1939 |
|
|
LAB_RETURN
|
1940 |
|
|
BNE LAB_16E5 ; exit if following token (to allow syntax error)
|
1941 |
|
|
|
1942 |
|
|
LAB_16E8
|
1943 |
|
|
PLA ; dump calling routine return address
|
1944 |
|
|
PLA ; dump calling routine return address
|
1945 |
|
|
PLA ; pull token
|
1946 |
|
|
CMP #TK_GOSUB ; compare with GOSUB token
|
1947 |
|
|
BNE LAB_16F4 ; branch if no matching GOSUB
|
1948 |
|
|
|
1949 |
|
|
LAB_16FF
|
1950 |
|
|
PLA ; pull current line low byte
|
1951 |
|
|
STA Clinel ; save current line low byte
|
1952 |
|
|
PLA ; pull current line high byte
|
1953 |
|
|
STA Clineh ; save current line high byte
|
1954 |
|
|
PLA ; pull BASIC execute pointer low byte
|
1955 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1956 |
|
|
PLA ; pull BASIC execute pointer high byte
|
1957 |
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
1958 |
|
|
|
1959 |
|
|
; now do the DATA statement as we could be returning into
|
1960 |
|
|
; the middle of an ON GOSUB n,m,p,q line
|
1961 |
|
|
; (the return address used by the DATA statement is the one
|
1962 |
|
|
; pushed before the GOSUB was executed!)
|
1963 |
|
|
|
1964 |
|
|
; perform DATA
|
1965 |
|
|
|
1966 |
|
|
LAB_DATA
|
1967 |
|
|
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
|
1968 |
|
|
|
1969 |
|
|
; set BASIC execute pointer
|
1970 |
|
|
LAB_170F
|
1971 |
|
|
TYA ; copy index to A
|
1972 |
|
|
CLC ; clear carry for add
|
1973 |
|
|
ADC Bpntrl ; add BASIC execute pointer low byte
|
1974 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
1975 |
|
|
BCC LAB_1719 ; skip next if no carry
|
1976 |
|
|
|
1977 |
|
|
INC Bpntrh ; else increment BASIC execute pointer high byte
|
1978 |
|
|
LAB_1719
|
1979 |
|
|
RTS
|
1980 |
|
|
|
1981 |
|
|
LAB_16FC
|
1982 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
1983 |
|
|
|
1984 |
|
|
; scan for next BASIC statement ([:] or [EOL])
|
1985 |
|
|
; returns Y as index to [:] or [EOL]
|
1986 |
|
|
|
1987 |
|
|
LAB_SNBS
|
1988 |
|
|
LDX #':' ; set look for character = ":"
|
1989 |
|
|
.byte $2C ; makes next line BIT $00A2
|
1990 |
|
|
|
1991 |
|
|
; scan for next BASIC line
|
1992 |
|
|
; returns Y as index to [EOL]
|
1993 |
|
|
|
1994 |
|
|
LAB_SNBL
|
1995 |
|
|
LDX #$00 ; set alt search character = [EOL]
|
1996 |
|
|
LDY #$00 ; set search character = [EOL]
|
1997 |
|
|
STY Asrch ; store search character
|
1998 |
|
|
LAB_1725
|
1999 |
|
|
TXA ; get alt search character
|
2000 |
|
|
EOR Asrch ; toggle search character, effectively swap with $00
|
2001 |
|
|
STA Asrch ; save swapped search character
|
2002 |
|
|
LAB_172D
|
2003 |
|
|
LDA (Bpntrl),Y ; get next byte
|
2004 |
|
|
BEQ LAB_1719 ; exit if null [EOL]
|
2005 |
|
|
|
2006 |
|
|
CMP Asrch ; compare with search character
|
2007 |
|
|
BEQ LAB_1719 ; exit if found
|
2008 |
|
|
|
2009 |
|
|
INY ; increment index
|
2010 |
|
|
CMP #$22 ; compare current character with open quote
|
2011 |
|
|
BNE LAB_172D ; if not open quote go get next character
|
2012 |
|
|
|
2013 |
|
|
BEQ LAB_1725 ; if found go swap search character for alt search character
|
2014 |
|
|
|
2015 |
|
|
; perform IF
|
2016 |
|
|
|
2017 |
|
|
LAB_IF
|
2018 |
|
|
JSR LAB_EVEX ; evaluate the expression
|
2019 |
|
|
JSR LAB_GBYT ; scan memory
|
2020 |
|
|
CMP #TK_THEN ; compare with THEN token
|
2021 |
|
|
BEQ LAB_174B ; if it was THEN go do IF
|
2022 |
|
|
|
2023 |
|
|
; wasn't IF .. THEN so must be IF .. GOTO
|
2024 |
|
|
CMP #TK_GOTO ; compare with GOTO token
|
2025 |
|
|
BNE LAB_16FC ; if it wasn't GOTO go do syntax error
|
2026 |
|
|
|
2027 |
|
|
LDX Bpntrl ; save the basic pointer low byte
|
2028 |
|
|
LDY Bpntrh ; save the basic pointer high byte
|
2029 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2030 |
|
|
BCS LAB_16FC ; if not numeric go do syntax error
|
2031 |
|
|
|
2032 |
|
|
STX Bpntrl ; restore the basic pointer low byte
|
2033 |
|
|
STY Bpntrh ; restore the basic pointer high byte
|
2034 |
|
|
LAB_174B
|
2035 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
2036 |
|
|
BEQ LAB_174E ; if the result was zero go look for an ELSE
|
2037 |
|
|
|
2038 |
|
|
JSR LAB_IGBY ; else increment and scan memory
|
2039 |
|
|
BCS LAB_174D ; if not numeric go do var or keyword
|
2040 |
|
|
|
2041 |
|
|
LAB_174C
|
2042 |
|
|
JMP LAB_GOTO ; else was numeric so do GOTO n
|
2043 |
|
|
message "LAB_174D"
|
2044 |
|
|
; is var or keyword
|
2045 |
|
|
LAB_174D
|
2046 |
|
|
CMP #TK_RETURN ; compare the byte with the token for RETURN
|
2047 |
|
|
BNE LAB_174G ; if it wasn't RETURN go interpret BASIC code from (Bpntrl)
|
2048 |
|
|
; and return to this code to process any following code
|
2049 |
|
|
|
2050 |
|
|
JMP LAB_1602 ; else it was RETURN so interpret BASIC code from (Bpntrl)
|
2051 |
|
|
; but don't return here
|
2052 |
|
|
|
2053 |
|
|
LAB_174G
|
2054 |
|
|
JSR LAB_15FF ; interpret BASIC code from (Bpntrl)
|
2055 |
|
|
|
2056 |
|
|
; the IF was executed and there may be a following ELSE so the code needs to return
|
2057 |
|
|
; here to check and ignore the ELSE if present
|
2058 |
|
|
|
2059 |
|
|
LDY #$00 ; clear the index
|
2060 |
|
|
LDA (Bpntrl),Y ; get the next BASIC byte
|
2061 |
|
|
CMP #TK_ELSE ; compare it with the token for ELSE
|
2062 |
|
|
BEQ LAB_DATA ; if ELSE ignore the following statement
|
2063 |
|
|
|
2064 |
|
|
; there was no ELSE so continue execution of IF THEN [: ]. any
|
2065 |
|
|
; following ELSE will, correctly, cause a syntax error
|
2066 |
|
|
|
2067 |
|
|
RTS ; else return to the interpreter inner loop
|
2068 |
|
|
|
2069 |
|
|
; perform ELSE after IF
|
2070 |
|
|
|
2071 |
|
|
LAB_174E
|
2072 |
|
|
LDY #$00 ; clear the BASIC byte index
|
2073 |
|
|
LDX #$01 ; clear the nesting depth
|
2074 |
|
|
LAB_1750
|
2075 |
|
|
INY ; increment the BASIC byte index
|
2076 |
|
|
LDA (Bpntrl),Y ; get the next BASIC byte
|
2077 |
|
|
BEQ LAB_1753 ; if EOL go add the pointer and return
|
2078 |
|
|
|
2079 |
|
|
CMP #TK_IF ; compare the byte with the token for IF
|
2080 |
|
|
BNE LAB_1752 ; if not IF token skip the depth increment
|
2081 |
|
|
|
2082 |
|
|
INX ; else increment the nesting depth ..
|
2083 |
|
|
BNE LAB_1750 ; .. and continue looking
|
2084 |
|
|
|
2085 |
|
|
LAB_1752
|
2086 |
|
|
CMP #TK_ELSE ; compare the byte with the token for ELSE
|
2087 |
|
|
BNE LAB_1750 ; if not ELSE token continue looking
|
2088 |
|
|
|
2089 |
|
|
DEX ; was ELSE so decrement the nesting depth
|
2090 |
|
|
BNE LAB_1750 ; loop if still nested
|
2091 |
|
|
|
2092 |
|
|
INY ; increment the BASIC byte index past the ELSE
|
2093 |
|
|
|
2094 |
|
|
; found the matching ELSE, now do <{n|statement}>
|
2095 |
|
|
|
2096 |
|
|
LAB_1753
|
2097 |
|
|
TYA ; else copy line index to A
|
2098 |
|
|
CLC ; clear carry for add
|
2099 |
|
|
ADC Bpntrl ; add the BASIC execute pointer low byte
|
2100 |
|
|
STA Bpntrl ; save the BASIC execute pointer low byte
|
2101 |
|
|
BCC LAB_1754 ; branch if no overflow to high byte
|
2102 |
|
|
|
2103 |
|
|
INC Bpntrh ; else increment the BASIC execute pointer high byte
|
2104 |
|
|
LAB_1754
|
2105 |
|
|
JSR LAB_GBYT ; scan memory
|
2106 |
|
|
BCC LAB_174C ; if numeric do GOTO n
|
2107 |
|
|
; the code will return to the interpreter loop at the
|
2108 |
|
|
; tail end of the GOTO
|
2109 |
|
|
|
2110 |
|
|
JMP LAB_15FF ; interpret BASIC code from (Bpntrl)
|
2111 |
|
|
; the code will return to the interpreter loop at the
|
2112 |
|
|
; tail end of the
|
2113 |
|
|
|
2114 |
|
|
; perform REM, skip (rest of) line
|
2115 |
|
|
|
2116 |
|
|
LAB_REM
|
2117 |
|
|
JSR LAB_SNBL ; scan for next BASIC line
|
2118 |
|
|
JMP LAB_170F ; go set BASIC execute pointer and return, branch always
|
2119 |
|
|
|
2120 |
|
|
LAB_16FD
|
2121 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
2122 |
|
|
|
2123 |
|
|
; perform ON
|
2124 |
|
|
|
2125 |
|
|
LAB_ON
|
2126 |
|
|
CMP #TK_IRQ ; was it IRQ token ?
|
2127 |
|
|
BNE LAB_NOIN ; if not go check NMI
|
2128 |
|
|
|
2129 |
|
|
JMP LAB_SIRQ ; else go set-up IRQ
|
2130 |
|
|
|
2131 |
|
|
LAB_NOIN
|
2132 |
|
|
CMP #TK_NMI ; was it NMI token ?
|
2133 |
|
|
BNE LAB_NONM ; if not go do normal ON command
|
2134 |
|
|
|
2135 |
|
|
JMP LAB_SNMI ; else go set-up NMI
|
2136 |
|
|
|
2137 |
|
|
LAB_NONM
|
2138 |
|
|
JSR LAB_GTBY ; get byte parameter
|
2139 |
|
|
PHA ; push GOTO/GOSUB token
|
2140 |
|
|
CMP #TK_GOSUB ; compare with GOSUB token
|
2141 |
|
|
BEQ LAB_176B ; branch if GOSUB
|
2142 |
|
|
|
2143 |
|
|
CMP #TK_GOTO ; compare with GOTO token
|
2144 |
|
|
LAB_1767
|
2145 |
|
|
BNE LAB_16FD ; if not GOTO do syntax error then warm start
|
2146 |
|
|
|
2147 |
|
|
|
2148 |
|
|
; next character was GOTO or GOSUB
|
2149 |
|
|
|
2150 |
|
|
LAB_176B
|
2151 |
|
|
DEC FAC1_3 ; decrement index (byte value)
|
2152 |
|
|
BNE LAB_1773 ; branch if not zero
|
2153 |
|
|
|
2154 |
|
|
PLA ; pull GOTO/GOSUB token
|
2155 |
|
|
JMP LAB_1602 ; go execute it
|
2156 |
|
|
|
2157 |
|
|
LAB_1773
|
2158 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2159 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer (skip this n)
|
2160 |
|
|
; (we could LDX #',' and JSR LAB_SNBL+2, then we
|
2161 |
|
|
; just BNE LAB_176B for the loop. should be quicker ..
|
2162 |
|
|
; no we can't, what if we meet a colon or [EOL]?)
|
2163 |
|
|
CMP #$2C ; compare next character with ","
|
2164 |
|
|
BEQ LAB_176B ; loop if ","
|
2165 |
|
|
|
2166 |
|
|
LAB_177E
|
2167 |
|
|
PLA ; else pull keyword token (run out of options)
|
2168 |
|
|
; also dump +/-1 pointer low byte and exit
|
2169 |
|
|
LAB_177F
|
2170 |
|
|
RTS
|
2171 |
|
|
|
2172 |
|
|
; takes n * 106 + 11 cycles where n is the number of digits
|
2173 |
|
|
|
2174 |
|
|
; get fixed-point number into temp integer
|
2175 |
|
|
|
2176 |
|
|
LAB_GFPN
|
2177 |
|
|
LDX #$00 ; clear reg
|
2178 |
|
|
STX Itempl ; clear temporary integer low byte
|
2179 |
|
|
LAB_1785
|
2180 |
|
|
STX Itemph ; save temporary integer high byte
|
2181 |
|
|
BCS LAB_177F ; return if carry set, end of scan, character was
|
2182 |
|
|
; not 0-9
|
2183 |
|
|
|
2184 |
|
|
CPX #$19 ; compare high byte with $19
|
2185 |
|
|
TAY ; ensure Zb = 0 if the branch is taken
|
2186 |
|
|
BCS LAB_1767 ; branch if >=, makes max line # 63999 because next
|
2187 |
|
|
; bit does *$0A, = 64000, compare at target will fail
|
2188 |
|
|
; and do syntax error
|
2189 |
|
|
|
2190 |
|
|
SBC #'0'-1 ; subtract "0", $2F + carry, from byte
|
2191 |
|
|
TAY ; copy binary digit
|
2192 |
|
|
LDA Itempl ; get temporary integer low byte
|
2193 |
|
|
ASL ; *2 low byte
|
2194 |
|
|
ROL Itemph ; *2 high byte
|
2195 |
|
|
ASL ; *2 low byte
|
2196 |
|
|
ROL Itemph ; *2 high byte, *4
|
2197 |
|
|
ADC Itempl ; + low byte, *5
|
2198 |
|
|
STA Itempl ; save it
|
2199 |
|
|
TXA ; get high byte copy to A
|
2200 |
|
|
ADC Itemph ; + high byte, *5
|
2201 |
|
|
ASL Itempl ; *2 low byte, *10d
|
2202 |
|
|
ROL ; *2 high byte, *10d
|
2203 |
|
|
TAX ; copy high byte back to X
|
2204 |
|
|
TYA ; get binary digit back
|
2205 |
|
|
ADC Itempl ; add number low byte
|
2206 |
|
|
STA Itempl ; save number low byte
|
2207 |
|
|
BCC LAB_17B3 ; if no overflow to high byte get next character
|
2208 |
|
|
|
2209 |
|
|
INX ; else increment high byte
|
2210 |
|
|
LAB_17B3
|
2211 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2212 |
|
|
JMP LAB_1785 ; loop for next character
|
2213 |
|
|
|
2214 |
|
|
; perform DEC
|
2215 |
|
|
|
2216 |
|
|
LAB_DEC
|
2217 |
|
|
LDA #
|
2218 |
|
|
.byte $2C ; BIT abs to skip the LDA below
|
2219 |
|
|
|
2220 |
|
|
; perform INC
|
2221 |
|
|
|
2222 |
|
|
LAB_INC
|
2223 |
|
|
LDA #
|
2224 |
|
|
LAB_17B5
|
2225 |
|
|
PHA ; save +/-1 pointer low byte
|
2226 |
|
|
LAB_17B7
|
2227 |
|
|
JSR LAB_GVAR ; get var address
|
2228 |
|
|
LDX Dtypef ; get data type flag, $FF=string, $00=numeric
|
2229 |
|
|
BMI IncrErr ; exit if string
|
2230 |
|
|
|
2231 |
|
|
STA Lvarpl ; save var address low byte
|
2232 |
|
|
STY Lvarph ; save var address high byte
|
2233 |
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
2234 |
|
|
PLA ; get +/-1 pointer low byte
|
2235 |
|
|
PHA ; save +/-1 pointer low byte
|
2236 |
|
|
LDY #>LAB_259C ; set +/-1 pointer high byte (both the same)
|
2237 |
|
|
JSR LAB_246C ; add (AY) to FAC1
|
2238 |
|
|
JSR LAB_PFAC ; pack FAC1 into variable (Lvarpl)
|
2239 |
|
|
|
2240 |
|
|
JSR LAB_GBYT ; scan memory
|
2241 |
|
|
CMP #',' ; compare with ","
|
2242 |
|
|
BNE LAB_177E ; exit if not "," (either end or error)
|
2243 |
|
|
|
2244 |
|
|
; was "," so another INCR variable to do
|
2245 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2246 |
|
|
JMP LAB_17B7 ; go do next var
|
2247 |
|
|
|
2248 |
|
|
IncrErr
|
2249 |
|
|
JMP LAB_1ABC ; do "Type mismatch" error then warm start
|
2250 |
|
|
|
2251 |
|
|
; perform LET
|
2252 |
|
|
|
2253 |
|
|
LAB_LET
|
2254 |
|
|
JSR LAB_GVAR ; get var address
|
2255 |
|
|
STA Lvarpl ; save var address low byte
|
2256 |
|
|
STY Lvarph ; save var address high byte
|
2257 |
|
|
LDA #TK_EQUAL ; get = token
|
2258 |
|
|
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
2259 |
|
|
LDA Dtypef ; get data type flag, $FF=string, $00=numeric
|
2260 |
|
|
PHA ; push data type flag
|
2261 |
|
|
JSR LAB_EVEX ; evaluate expression
|
2262 |
|
|
PLA ; pop data type flag
|
2263 |
|
|
ROL ; set carry if type = string
|
2264 |
|
|
JSR LAB_CKTM ; type match check, set C for string
|
2265 |
|
|
BNE LAB_17D5 ; branch if string
|
2266 |
|
|
|
2267 |
|
|
JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return
|
2268 |
|
|
|
2269 |
|
|
; string LET
|
2270 |
|
|
|
2271 |
|
|
LAB_17D5
|
2272 |
|
|
LDY #$02 ; set index to pointer high byte
|
2273 |
|
|
LDA (des_pl),Y ; get string pointer high byte
|
2274 |
|
|
CMP Sstorh ; compare bottom of string space high byte
|
2275 |
|
|
BCC LAB_17F4 ; if less assign value and exit (was in program memory)
|
2276 |
|
|
|
2277 |
|
|
BNE LAB_17E6 ; branch if >
|
2278 |
|
|
; else was equal so compare low bytes
|
2279 |
|
|
DEY ; decrement index
|
2280 |
|
|
LDA (des_pl),Y ; get pointer low byte
|
2281 |
|
|
CMP Sstorl ; compare bottom of string space low byte
|
2282 |
|
|
BCC LAB_17F4 ; if less assign value and exit (was in program memory)
|
2283 |
|
|
|
2284 |
|
|
; pointer was >= to bottom of string space pointer
|
2285 |
|
|
LAB_17E6
|
2286 |
|
|
LDY des_ph ; get descriptor pointer high byte
|
2287 |
|
|
CPY Svarh ; compare start of vars high byte
|
2288 |
|
|
BCC LAB_17F4 ; branch if less (descriptor is on stack)
|
2289 |
|
|
|
2290 |
|
|
BNE LAB_17FB ; branch if greater (descriptor is not on stack)
|
2291 |
|
|
|
2292 |
|
|
; else high bytes were equal so ..
|
2293 |
|
|
LDA des_pl ; get descriptor pointer low byte
|
2294 |
|
|
CMP Svarl ; compare start of vars low byte
|
2295 |
|
|
BCS LAB_17FB ; branch if >= (descriptor is not on stack)
|
2296 |
|
|
|
2297 |
|
|
LAB_17F4
|
2298 |
|
|
LDA des_pl ; get descriptor pointer low byte
|
2299 |
|
|
LDY des_ph ; get descriptor pointer high byte
|
2300 |
|
|
JMP LAB_1811 ; clean stack, copy descriptor to variable and return
|
2301 |
|
|
|
2302 |
|
|
; make space and copy string
|
2303 |
|
|
LAB_17FB
|
2304 |
|
|
LDY #$00 ; index to length
|
2305 |
|
|
LDA (des_pl),Y ; get string length
|
2306 |
|
|
JSR LAB_209C ; copy string
|
2307 |
|
|
LDA des_2l ; get descriptor pointer low byte
|
2308 |
|
|
LDY des_2h ; get descriptor pointer high byte
|
2309 |
|
|
STA ssptr_l ; save descriptor pointer low byte
|
2310 |
|
|
STY ssptr_h ; save descriptor pointer high byte
|
2311 |
|
|
JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill)
|
2312 |
|
|
LDA #
|
2313 |
|
|
LDY #>FAC1_e ; get descriptor pointer high byte
|
2314 |
|
|
|
2315 |
|
|
; clean stack and assign value to string variable
|
2316 |
|
|
LAB_1811
|
2317 |
|
|
STA des_2l ; save descriptor_2 pointer low byte
|
2318 |
|
|
STY des_2h ; save descriptor_2 pointer high byte
|
2319 |
|
|
JSR LAB_22EB ; clean descriptor stack, YA = pointer
|
2320 |
|
|
LDY #$00 ; index to length
|
2321 |
|
|
LDA (des_2l),Y ; get string length
|
2322 |
|
|
STA (Lvarpl),Y ; copy to let string variable
|
2323 |
|
|
INY ; index to string pointer low byte
|
2324 |
|
|
LDA (des_2l),Y ; get string pointer low byte
|
2325 |
|
|
STA (Lvarpl),Y ; copy to let string variable
|
2326 |
|
|
INY ; index to string pointer high byte
|
2327 |
|
|
LDA (des_2l),Y ; get string pointer high byte
|
2328 |
|
|
STA (Lvarpl),Y ; copy to let string variable
|
2329 |
|
|
RTS
|
2330 |
|
|
|
2331 |
|
|
; perform GET
|
2332 |
|
|
|
2333 |
|
|
LAB_GET
|
2334 |
|
|
JSR LAB_GVAR ; get var address
|
2335 |
|
|
STA Lvarpl ; save var address low byte
|
2336 |
|
|
STY Lvarph ; save var address high byte
|
2337 |
|
|
JSR INGET ; get input byte
|
2338 |
|
|
LDX Dtypef ; get data type flag, $FF=string, $00=numeric
|
2339 |
|
|
BMI LAB_GETS ; go get string character
|
2340 |
|
|
|
2341 |
|
|
; was numeric get
|
2342 |
|
|
TAY ; copy character to Y
|
2343 |
|
|
JSR LAB_1FD0 ; convert Y to byte in FAC1
|
2344 |
|
|
JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return
|
2345 |
|
|
|
2346 |
|
|
LAB_GETS
|
2347 |
|
|
PHA ; save character
|
2348 |
|
|
LDA #$01 ; string is single byte
|
2349 |
|
|
BCS LAB_IsByte ; branch if byte received
|
2350 |
|
|
|
2351 |
|
|
PLA ; string is null
|
2352 |
|
|
LAB_IsByte
|
2353 |
|
|
JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
|
2354 |
|
|
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
|
2355 |
|
|
BEQ LAB_NoSt ; skip store if null string
|
2356 |
|
|
|
2357 |
|
|
PLA ; get character back
|
2358 |
|
|
LDY #$00 ; clear index
|
2359 |
|
|
STA (str_pl),Y ; save byte in string (byte IS string!)
|
2360 |
|
|
LAB_NoSt
|
2361 |
|
|
JSR LAB_RTST ; check for space on descriptor stack then put address
|
2362 |
|
|
; and length on descriptor stack and update stack pointers
|
2363 |
|
|
|
2364 |
|
|
JMP LAB_17D5 ; do string LET and return
|
2365 |
|
|
|
2366 |
|
|
; perform PRINT
|
2367 |
|
|
|
2368 |
|
|
LAB_1829
|
2369 |
|
|
JSR LAB_18C6 ; print string from Sutill/Sutilh
|
2370 |
|
|
LAB_182C
|
2371 |
|
|
JSR LAB_GBYT ; scan memory
|
2372 |
|
|
|
2373 |
|
|
; PRINT
|
2374 |
|
|
|
2375 |
|
|
LAB_PRINT
|
2376 |
|
|
BEQ LAB_CRLF ; if nothing following just print CR/LF
|
2377 |
|
|
|
2378 |
|
|
LAB_1831
|
2379 |
|
|
CMP #TK_TAB ; compare with TAB( token
|
2380 |
|
|
BEQ LAB_18A2 ; go do TAB/SPC
|
2381 |
|
|
|
2382 |
|
|
CMP #TK_SPC ; compare with SPC( token
|
2383 |
|
|
BEQ LAB_18A2 ; go do TAB/SPC
|
2384 |
|
|
|
2385 |
|
|
CMP #',' ; compare with ","
|
2386 |
|
|
BEQ LAB_188B ; go do move to next TAB mark
|
2387 |
|
|
|
2388 |
|
|
CMP #';' ; compare with ";"
|
2389 |
|
|
BEQ LAB_18BD ; if ";" continue with PRINT processing
|
2390 |
|
|
|
2391 |
|
|
JSR LAB_EVEX ; evaluate expression
|
2392 |
|
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric
|
2393 |
|
|
BMI LAB_1829 ; branch if string
|
2394 |
|
|
|
2395 |
|
|
JSR LAB_296E ; convert FAC1 to string
|
2396 |
|
|
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
|
2397 |
|
|
LDY #$00 ; clear index
|
2398 |
|
|
|
2399 |
|
|
; don't check fit if terminal width byte is zero
|
2400 |
|
|
|
2401 |
|
|
LDA TWidth ; get terminal width byte
|
2402 |
|
|
BEQ LAB_185E ; skip check if zero
|
2403 |
|
|
|
2404 |
|
|
SEC ; set carry for subtract
|
2405 |
|
|
SBC TPos ; subtract terminal position
|
2406 |
|
|
SBC (des_pl),Y ; subtract string length
|
2407 |
|
|
BCS LAB_185E ; branch if less than terminal width
|
2408 |
|
|
|
2409 |
|
|
JSR LAB_CRLF ; else print CR/LF
|
2410 |
|
|
LAB_185E
|
2411 |
|
|
JSR LAB_18C6 ; print string from Sutill/Sutilh
|
2412 |
|
|
BEQ LAB_182C ; always go continue processing line
|
2413 |
|
|
|
2414 |
|
|
; CR/LF return to BASIC from BASIC input handler
|
2415 |
|
|
|
2416 |
|
|
LAB_1866
|
2417 |
|
|
LDA #$00 ; clear byte
|
2418 |
|
|
STA Ibuffs,X ; null terminate input
|
2419 |
|
|
LDX #
|
2420 |
|
|
LDY #>Ibuffs ; set Y to buffer start-1 high byte
|
2421 |
|
|
|
2422 |
|
|
; print CR/LF
|
2423 |
|
|
|
2424 |
|
|
LAB_CRLF
|
2425 |
|
|
LDA #$0D ; load [CR]
|
2426 |
|
|
JSR LAB_PRNA ; go print the character
|
2427 |
|
|
LDA #$0A ; load [LF]
|
2428 |
|
|
BNE LAB_PRNA ; go print the character and return, branch always
|
2429 |
|
|
|
2430 |
|
|
LAB_188B
|
2431 |
|
|
LDA TPos ; get terminal position
|
2432 |
|
|
CMP Iclim ; compare with input column limit
|
2433 |
|
|
BCC LAB_1897 ; branch if less
|
2434 |
|
|
|
2435 |
|
|
JSR LAB_CRLF ; else print CR/LF (next line)
|
2436 |
|
|
BNE LAB_18BD ; continue with PRINT processing (branch always)
|
2437 |
|
|
|
2438 |
|
|
LAB_1897
|
2439 |
|
|
SEC ; set carry for subtract
|
2440 |
|
|
LAB_1898
|
2441 |
|
|
SBC TabSiz ; subtract TAB size
|
2442 |
|
|
BCS LAB_1898 ; loop if result was +ve
|
2443 |
|
|
|
2444 |
|
|
EOR #$FF ; complement it
|
2445 |
|
|
ADC #$01 ; +1 (twos complement)
|
2446 |
|
|
BNE LAB_18B6 ; always print A spaces (result is never $00)
|
2447 |
|
|
|
2448 |
|
|
; do TAB/SPC
|
2449 |
|
|
LAB_18A2
|
2450 |
|
|
PHA ; save token
|
2451 |
|
|
JSR LAB_SGBY ; scan and get byte parameter
|
2452 |
|
|
CMP #$29 ; is next character )
|
2453 |
|
|
BNE LAB_1910 ; if not do syntax error then warm start
|
2454 |
|
|
|
2455 |
|
|
PLA ; get token back
|
2456 |
|
|
CMP #TK_TAB ; was it TAB ?
|
2457 |
|
|
BNE LAB_18B7 ; if not go do SPC
|
2458 |
|
|
|
2459 |
|
|
; calculate TAB offset
|
2460 |
|
|
TXA ; copy integer value to A
|
2461 |
|
|
SBC TPos ; subtract terminal position
|
2462 |
|
|
BCC LAB_18BD ; branch if result was < 0 (can't TAB backwards)
|
2463 |
|
|
|
2464 |
|
|
; print A spaces
|
2465 |
|
|
LAB_18B6
|
2466 |
|
|
TAX ; copy result to X
|
2467 |
|
|
LAB_18B7
|
2468 |
|
|
TXA ; set flags on size for SPC
|
2469 |
|
|
BEQ LAB_18BD ; branch if result was = $0, already here
|
2470 |
|
|
|
2471 |
|
|
; print X spaces
|
2472 |
|
|
LAB_18BA
|
2473 |
|
|
JSR LAB_18E0 ; print " "
|
2474 |
|
|
DEX ; decrement count
|
2475 |
|
|
BNE LAB_18BA ; loop if not all done
|
2476 |
|
|
|
2477 |
|
|
; continue with PRINT processing
|
2478 |
|
|
LAB_18BD
|
2479 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2480 |
|
|
BNE LAB_1831 ; if more to print go do it
|
2481 |
|
|
|
2482 |
|
|
RTS
|
2483 |
|
|
|
2484 |
|
|
; print null terminated string from memory
|
2485 |
|
|
|
2486 |
|
|
LAB_18C3
|
2487 |
|
|
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
|
2488 |
|
|
|
2489 |
|
|
; print string from Sutill/Sutilh
|
2490 |
|
|
|
2491 |
|
|
LAB_18C6
|
2492 |
|
|
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
|
2493 |
|
|
; space returns with A = length, X=$71=pointer low byte,
|
2494 |
|
|
; Y=$72=pointer high byte
|
2495 |
|
|
LDY #$00 ; reset index
|
2496 |
|
|
TAX ; copy length to X
|
2497 |
|
|
BEQ LAB_188C ; exit (RTS) if null string
|
2498 |
|
|
|
2499 |
|
|
LAB_18CD
|
2500 |
|
|
|
2501 |
|
|
LDA (ut1_pl),Y ; get next byte
|
2502 |
|
|
JSR LAB_PRNA ; go print the character
|
2503 |
|
|
INY ; increment index
|
2504 |
|
|
DEX ; decrement count
|
2505 |
|
|
BNE LAB_18CD ; loop if not done yet
|
2506 |
|
|
|
2507 |
|
|
RTS
|
2508 |
|
|
|
2509 |
|
|
; Print single format character
|
2510 |
|
|
; print " "
|
2511 |
|
|
|
2512 |
|
|
LAB_18E0
|
2513 |
|
|
LDA #$20 ; load " "
|
2514 |
|
|
.byte $2C ; change next line to BIT LAB_3FA9
|
2515 |
|
|
|
2516 |
|
|
; print "?" character
|
2517 |
|
|
|
2518 |
|
|
LAB_18E3
|
2519 |
|
|
LDA #$3F ; load "?" character
|
2520 |
|
|
|
2521 |
|
|
; print character in A
|
2522 |
|
|
; now includes the null handler
|
2523 |
|
|
; also includes infinite line length code
|
2524 |
|
|
; note! some routines expect this one to exit with Zb=0
|
2525 |
|
|
|
2526 |
|
|
LAB_PRNA
|
2527 |
|
|
CMP #' ' ; compare with " "
|
2528 |
|
|
BCC LAB_18F9 ; branch if less (non printing)
|
2529 |
|
|
|
2530 |
|
|
; else printable character
|
2531 |
|
|
PHA ; save the character
|
2532 |
|
|
|
2533 |
|
|
; don't check fit if terminal width byte is zero
|
2534 |
|
|
|
2535 |
|
|
LDA TWidth ; get terminal width
|
2536 |
|
|
BNE LAB_18F0 ; branch if not zero (not infinite length)
|
2537 |
|
|
|
2538 |
|
|
; is "infinite line" so check TAB position
|
2539 |
|
|
|
2540 |
|
|
LDA TPos ; get position
|
2541 |
|
|
SBC TabSiz ; subtract TAB size, carry set by CMP #$20 above
|
2542 |
|
|
BNE LAB_18F7 ; skip reset if different
|
2543 |
|
|
|
2544 |
|
|
STA TPos ; else reset position
|
2545 |
|
|
BEQ LAB_18F7 ; go print character
|
2546 |
|
|
|
2547 |
|
|
LAB_18F0
|
2548 |
|
|
CMP TPos ; compare with terminal character position
|
2549 |
|
|
BNE LAB_18F7 ; branch if not at end of line
|
2550 |
|
|
|
2551 |
|
|
JSR LAB_CRLF ; else print CR/LF
|
2552 |
|
|
LAB_18F7
|
2553 |
|
|
INC TPos ; increment terminal position
|
2554 |
|
|
PLA ; get character back
|
2555 |
|
|
LAB_18F9
|
2556 |
|
|
JSR V_OUTP ; output byte via output vector
|
2557 |
|
|
CMP #$0D ; compare with [CR]
|
2558 |
|
|
BNE LAB_188A ; branch if not [CR]
|
2559 |
|
|
|
2560 |
|
|
; else print nullct nulls after the [CR]
|
2561 |
|
|
STX TempB ; save buffer index
|
2562 |
|
|
LDX Nullct ; get null count
|
2563 |
|
|
BEQ LAB_1886 ; branch if no nulls
|
2564 |
|
|
|
2565 |
|
|
LDA #$00 ; load [NULL]
|
2566 |
|
|
LAB_1880
|
2567 |
|
|
JSR LAB_PRNA ; go print the character
|
2568 |
|
|
DEX ; decrement count
|
2569 |
|
|
BNE LAB_1880 ; loop if not all done
|
2570 |
|
|
|
2571 |
|
|
LDA #$0D ; restore the character (and set the flags)
|
2572 |
|
|
LAB_1886
|
2573 |
|
|
STX TPos ; clear terminal position (X always = zero when we get here)
|
2574 |
|
|
LDX TempB ; restore buffer index
|
2575 |
|
|
LAB_188A
|
2576 |
|
|
AND #$FF ; set the flags
|
2577 |
|
|
LAB_188C
|
2578 |
|
|
RTS
|
2579 |
|
|
|
2580 |
|
|
; handle bad input data
|
2581 |
|
|
|
2582 |
|
|
LAB_1904
|
2583 |
|
|
LDA Imode ; get input mode flag, $00=INPUT, $00=READ
|
2584 |
|
|
BPL LAB_1913 ; branch if INPUT (go do redo)
|
2585 |
|
|
|
2586 |
|
|
LDA Dlinel ; get current DATA line low byte
|
2587 |
|
|
LDY Dlineh ; get current DATA line high byte
|
2588 |
|
|
STA Clinel ; save current line low byte
|
2589 |
|
|
STY Clineh ; save current line high byte
|
2590 |
|
|
LAB_1910
|
2591 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
2592 |
|
|
|
2593 |
|
|
; mode was INPUT
|
2594 |
|
|
LAB_1913
|
2595 |
|
|
LDA #
|
2596 |
|
|
LDY #>LAB_REDO ; point to redo message (high addr)
|
2597 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
2598 |
|
|
LDA Cpntrl ; get continue pointer low byte
|
2599 |
|
|
LDY Cpntrh ; get continue pointer high byte
|
2600 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
2601 |
|
|
STY Bpntrh ; save BASIC execute pointer high byte
|
2602 |
|
|
RTS
|
2603 |
|
|
|
2604 |
|
|
; perform INPUT
|
2605 |
|
|
|
2606 |
|
|
LAB_INPUT
|
2607 |
|
|
CMP #$22 ; compare next byte with open quote
|
2608 |
|
|
BNE LAB_1934 ; branch if no prompt string
|
2609 |
|
|
|
2610 |
|
|
JSR LAB_1BC1 ; print "..." string
|
2611 |
|
|
LDA #$3B ; load A with ";"
|
2612 |
|
|
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
2613 |
|
|
JSR LAB_18C6 ; print string from Sutill/Sutilh
|
2614 |
|
|
|
2615 |
|
|
; done with prompt, now get data
|
2616 |
|
|
LAB_1934
|
2617 |
|
|
JSR LAB_CKRN ; check not Direct, back here if ok
|
2618 |
|
|
JSR LAB_INLN ; print "? " and get BASIC input
|
2619 |
|
|
LDA #$00 ; set mode = INPUT
|
2620 |
|
|
CMP Ibuffs ; test first byte in buffer
|
2621 |
|
|
BNE LAB_1953 ; branch if not null input
|
2622 |
|
|
|
2623 |
|
|
CLC ; was null input so clear carry to exit program
|
2624 |
|
|
JMP LAB_1647 ; go do BREAK exit
|
2625 |
|
|
|
2626 |
|
|
; perform READ
|
2627 |
|
|
|
2628 |
|
|
LAB_READ
|
2629 |
|
|
LDX Dptrl ; get DATA pointer low byte
|
2630 |
|
|
LDY Dptrh ; get DATA pointer high byte
|
2631 |
|
|
LDA #$80 ; set mode = READ
|
2632 |
|
|
|
2633 |
|
|
LAB_1953
|
2634 |
|
|
STA Imode ; set input mode flag, $00=INPUT, $80=READ
|
2635 |
|
|
STX Rdptrl ; save READ pointer low byte
|
2636 |
|
|
STY Rdptrh ; save READ pointer high byte
|
2637 |
|
|
|
2638 |
|
|
; READ or INPUT next variable from list
|
2639 |
|
|
LAB_195B
|
2640 |
|
|
JSR LAB_GVAR ; get (var) address
|
2641 |
|
|
STA Lvarpl ; save address low byte
|
2642 |
|
|
STY Lvarph ; save address high byte
|
2643 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
2644 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte
|
2645 |
|
|
STA Itempl ; save as temporary integer low byte
|
2646 |
|
|
STY Itemph ; save as temporary integer high byte
|
2647 |
|
|
LDX Rdptrl ; get READ pointer low byte
|
2648 |
|
|
LDY Rdptrh ; get READ pointer high byte
|
2649 |
|
|
STX Bpntrl ; set BASIC execute pointer low byte
|
2650 |
|
|
STY Bpntrh ; set BASIC execute pointer high byte
|
2651 |
|
|
JSR LAB_GBYT ; scan memory
|
2652 |
|
|
BNE LAB_1988 ; branch if not null
|
2653 |
|
|
|
2654 |
|
|
; pointer was to null entry
|
2655 |
|
|
BIT Imode ; test input mode flag, $00=INPUT, $80=READ
|
2656 |
|
|
BMI LAB_19DD ; branch if READ
|
2657 |
|
|
|
2658 |
|
|
; mode was INPUT
|
2659 |
|
|
JSR LAB_18E3 ; print "?" character (double ? for extended input)
|
2660 |
|
|
JSR LAB_INLN ; print "? " and get BASIC input
|
2661 |
|
|
STX Bpntrl ; set BASIC execute pointer low byte
|
2662 |
|
|
STY Bpntrh ; set BASIC execute pointer high byte
|
2663 |
|
|
LAB_1985
|
2664 |
|
|
JSR LAB_GBYT ; scan memory
|
2665 |
|
|
LAB_1988
|
2666 |
|
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric
|
2667 |
|
|
BPL LAB_19B0 ; branch if numeric
|
2668 |
|
|
|
2669 |
|
|
; else get string
|
2670 |
|
|
STA Srchc ; save search character
|
2671 |
|
|
CMP #$22 ; was it " ?
|
2672 |
|
|
BEQ LAB_1999 ; branch if so
|
2673 |
|
|
|
2674 |
|
|
LDA #':' ; else search character is ":"
|
2675 |
|
|
STA Srchc ; set new search character
|
2676 |
|
|
LDA #',' ; other search character is ","
|
2677 |
|
|
CLC ; clear carry for add
|
2678 |
|
|
LAB_1999
|
2679 |
|
|
STA Asrch ; set second search character
|
2680 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
2681 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte
|
2682 |
|
|
|
2683 |
|
|
ADC #$00 ; c is =1 if we came via the BEQ LAB_1999, else =0
|
2684 |
|
|
BCC LAB_19A4 ; branch if no execute pointer low byte rollover
|
2685 |
|
|
|
2686 |
|
|
INY ; else increment high byte
|
2687 |
|
|
LAB_19A4
|
2688 |
|
|
JSR LAB_20B4 ; print Srchc or Asrch terminated string to Sutill/Sutilh
|
2689 |
|
|
JSR LAB_23F3 ; restore BASIC execute pointer from temp (Btmpl/Btmph)
|
2690 |
|
|
JSR LAB_17D5 ; go do string LET
|
2691 |
|
|
JMP LAB_19B6 ; go check string terminator
|
2692 |
|
|
|
2693 |
|
|
; get numeric INPUT
|
2694 |
|
|
LAB_19B0
|
2695 |
|
|
JSR LAB_2887 ; get FAC1 from string
|
2696 |
|
|
JSR LAB_PFAC ; pack FAC1 into (Lvarpl)
|
2697 |
|
|
LAB_19B6
|
2698 |
|
|
JSR LAB_GBYT ; scan memory
|
2699 |
|
|
BEQ LAB_19C5 ; branch if null (last entry)
|
2700 |
|
|
|
2701 |
|
|
CMP #',' ; else compare with ","
|
2702 |
|
|
BEQ LAB_19C2 ; branch if ","
|
2703 |
|
|
|
2704 |
|
|
JMP LAB_1904 ; else go handle bad input data
|
2705 |
|
|
|
2706 |
|
|
; got good input data
|
2707 |
|
|
LAB_19C2
|
2708 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2709 |
|
|
LAB_19C5
|
2710 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte (temp READ/INPUT ptr)
|
2711 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte (temp READ/INPUT ptr)
|
2712 |
|
|
STA Rdptrl ; save for now
|
2713 |
|
|
STY Rdptrh ; save for now
|
2714 |
|
|
LDA Itempl ; get temporary integer low byte (temp BASIC execute ptr)
|
2715 |
|
|
LDY Itemph ; get temporary integer high byte (temp BASIC execute ptr)
|
2716 |
|
|
STA Bpntrl ; set BASIC execute pointer low byte
|
2717 |
|
|
STY Bpntrh ; set BASIC execute pointer high byte
|
2718 |
|
|
JSR LAB_GBYT ; scan memory
|
2719 |
|
|
BEQ LAB_1A03 ; if null go do extra ignored message
|
2720 |
|
|
|
2721 |
|
|
JSR LAB_1C01 ; else scan for "," , else do syntax error then warm start
|
2722 |
|
|
JMP LAB_195B ; go INPUT next variable from list
|
2723 |
|
|
|
2724 |
|
|
; find next DATA statement or do "Out of DATA" error
|
2725 |
|
|
LAB_19DD
|
2726 |
|
|
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL])
|
2727 |
|
|
INY ; increment index
|
2728 |
|
|
TAX ; copy character ([:] or [EOL])
|
2729 |
|
|
BNE LAB_19F6 ; branch if [:]
|
2730 |
|
|
|
2731 |
|
|
LDX #$06 ; set for "Out of DATA" error
|
2732 |
|
|
INY ; increment index, now points to next line pointer high byte
|
2733 |
|
|
LDA (Bpntrl),Y ; get next line pointer high byte
|
2734 |
|
|
BEQ LAB_1A54 ; branch if end (eventually does error X)
|
2735 |
|
|
|
2736 |
|
|
INY ; increment index
|
2737 |
|
|
LDA (Bpntrl),Y ; get next line # low byte
|
2738 |
|
|
STA Dlinel ; save current DATA line low byte
|
2739 |
|
|
INY ; increment index
|
2740 |
|
|
LDA (Bpntrl),Y ; get next line # high byte
|
2741 |
|
|
INY ; increment index
|
2742 |
|
|
STA Dlineh ; save current DATA line high byte
|
2743 |
|
|
LAB_19F6
|
2744 |
|
|
LDA (Bpntrl),Y ; get byte
|
2745 |
|
|
INY ; increment index
|
2746 |
|
|
TAX ; copy to X
|
2747 |
|
|
JSR LAB_170F ; set BASIC execute pointer
|
2748 |
|
|
CPX #TK_DATA ; compare with "DATA" token
|
2749 |
|
|
BEQ LAB_1985 ; was "DATA" so go do next READ
|
2750 |
|
|
|
2751 |
|
|
BNE LAB_19DD ; go find next statement if not "DATA"
|
2752 |
|
|
|
2753 |
|
|
; end of INPUT/READ routine
|
2754 |
|
|
|
2755 |
|
|
LAB_1A03
|
2756 |
|
|
LDA Rdptrl ; get temp READ pointer low byte
|
2757 |
|
|
LDY Rdptrh ; get temp READ pointer high byte
|
2758 |
|
|
LDX Imode ; get input mode flag, $00=INPUT, $80=READ
|
2759 |
|
|
BPL LAB_1A0E ; branch if INPUT
|
2760 |
|
|
|
2761 |
|
|
JMP LAB_1624 ; save AY as DATA pointer and return
|
2762 |
|
|
|
2763 |
|
|
; we were getting INPUT
|
2764 |
|
|
LAB_1A0E
|
2765 |
|
|
LDY #$00 ; clear index
|
2766 |
|
|
LDA (Rdptrl),Y ; get next byte
|
2767 |
|
|
BNE LAB_1A1B ; error if not end of INPUT
|
2768 |
|
|
|
2769 |
|
|
RTS
|
2770 |
|
|
|
2771 |
|
|
; user typed too much
|
2772 |
|
|
LAB_1A1B
|
2773 |
|
|
LDA #
|
2774 |
|
|
LDY #>LAB_IMSG ; point to extra ignored message (high addr)
|
2775 |
|
|
JMP LAB_18C3 ; print null terminated string from memory and return
|
2776 |
|
|
|
2777 |
|
|
; search the stack for FOR activity
|
2778 |
|
|
; exit with z=1 if FOR else exit with z=0
|
2779 |
|
|
|
2780 |
|
|
LAB_11A1
|
2781 |
|
|
TSX ; copy stack pointer
|
2782 |
|
|
INX ; +1 pass return address
|
2783 |
|
|
INX ; +2 pass return address
|
2784 |
|
|
INX ; +3 pass calling routine return address
|
2785 |
|
|
INX ; +4 pass calling routine return address
|
2786 |
|
|
LAB_11A6
|
2787 |
|
|
LDA LAB_STAK+1,X ; get token byte from stack
|
2788 |
|
|
CMP #TK_FOR ; is it FOR token
|
2789 |
|
|
BNE LAB_11CE ; exit if not FOR token
|
2790 |
|
|
|
2791 |
|
|
; was FOR token
|
2792 |
|
|
LDA Frnxth ; get var pointer for FOR/NEXT high byte
|
2793 |
|
|
BNE LAB_11BB ; branch if not null
|
2794 |
|
|
|
2795 |
|
|
LDA LAB_STAK+2,X ; get FOR variable pointer low byte
|
2796 |
|
|
STA Frnxtl ; save var pointer for FOR/NEXT low byte
|
2797 |
|
|
LDA LAB_STAK+3,X ; get FOR variable pointer high byte
|
2798 |
|
|
STA Frnxth ; save var pointer for FOR/NEXT high byte
|
2799 |
|
|
LAB_11BB
|
2800 |
|
|
CMP LAB_STAK+3,X ; compare var pointer with stacked var pointer (high byte)
|
2801 |
|
|
BNE LAB_11C7 ; branch if no match
|
2802 |
|
|
|
2803 |
|
|
LDA Frnxtl ; get var pointer for FOR/NEXT low byte
|
2804 |
|
|
CMP LAB_STAK+2,X ; compare var pointer with stacked var pointer (low byte)
|
2805 |
|
|
BEQ LAB_11CE ; exit if match found
|
2806 |
|
|
|
2807 |
|
|
LAB_11C7
|
2808 |
|
|
TXA ; copy index
|
2809 |
|
|
CLC ; clear carry for add
|
2810 |
|
|
ADC #$10 ; add FOR stack use size
|
2811 |
|
|
TAX ; copy back to index
|
2812 |
|
|
BNE LAB_11A6 ; loop if not at start of stack
|
2813 |
|
|
|
2814 |
|
|
LAB_11CE
|
2815 |
|
|
RTS
|
2816 |
|
|
|
2817 |
|
|
; perform NEXT
|
2818 |
|
|
|
2819 |
|
|
LAB_NEXT
|
2820 |
|
|
BNE LAB_1A46 ; branch if NEXT var
|
2821 |
|
|
|
2822 |
|
|
LDY #$00 ; else clear Y
|
2823 |
|
|
BEQ LAB_1A49 ; branch always (no variable to search for)
|
2824 |
|
|
|
2825 |
|
|
; NEXT var
|
2826 |
|
|
|
2827 |
|
|
LAB_1A46
|
2828 |
|
|
JSR LAB_GVAR ; get variable address
|
2829 |
|
|
LAB_1A49
|
2830 |
|
|
STA Frnxtl ; store variable pointer low byte
|
2831 |
|
|
STY Frnxth ; store variable pointer high byte
|
2832 |
|
|
; (both cleared if no variable defined)
|
2833 |
|
|
JSR LAB_11A1 ; search the stack for FOR activity
|
2834 |
|
|
BEQ LAB_1A56 ; branch if found
|
2835 |
|
|
|
2836 |
|
|
LDX #$00 ; else set error $00 ("NEXT without FOR" error)
|
2837 |
|
|
LAB_1A54
|
2838 |
|
|
BEQ LAB_1ABE ; do error #X, then warm start
|
2839 |
|
|
|
2840 |
|
|
LAB_1A56
|
2841 |
|
|
TXS ; set stack pointer, X set by search, dumps return addresses
|
2842 |
|
|
|
2843 |
|
|
TXA ; copy stack pointer
|
2844 |
|
|
SEC ; set carry for subtract
|
2845 |
|
|
SBC #$F7 ; point to TO var
|
2846 |
|
|
STA ut2_pl ; save pointer to TO var for compare
|
2847 |
|
|
ADC #$FB ; point to STEP var
|
2848 |
|
|
|
2849 |
|
|
LDY #>LAB_STAK ; point to stack page high byte
|
2850 |
|
|
JSR LAB_UFAC ; unpack memory (STEP value) into FAC1
|
2851 |
|
|
TSX ; get stack pointer back
|
2852 |
|
|
LDA LAB_STAK+8,X ; get step sign
|
2853 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
2854 |
|
|
LDA Frnxtl ; get FOR variable pointer low byte
|
2855 |
|
|
LDY Frnxth ; get FOR variable pointer high byte
|
2856 |
|
|
JSR LAB_246C ; add (FOR variable) to FAC1
|
2857 |
|
|
JSR LAB_PFAC ; pack FAC1 into (FOR variable)
|
2858 |
|
|
LDY #>LAB_STAK ; point to stack page high byte
|
2859 |
|
|
JSR LAB_27FA ; compare FAC1 with (Y,ut2_pl) (TO value)
|
2860 |
|
|
TSX ; get stack pointer back
|
2861 |
|
|
CMP LAB_STAK+8,X ; compare step sign
|
2862 |
|
|
BEQ LAB_1A9B ; branch if = (loop complete)
|
2863 |
|
|
|
2864 |
|
|
; loop back and do it all again
|
2865 |
|
|
LDA LAB_STAK+$0D,X ; get FOR line low byte
|
2866 |
|
|
STA Clinel ; save current line low byte
|
2867 |
|
|
LDA LAB_STAK+$0E,X ; get FOR line high byte
|
2868 |
|
|
STA Clineh ; save current line high byte
|
2869 |
|
|
LDA LAB_STAK+$10,X ; get BASIC execute pointer low byte
|
2870 |
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
2871 |
|
|
LDA LAB_STAK+$0F,X ; get BASIC execute pointer high byte
|
2872 |
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
2873 |
|
|
LAB_1A98
|
2874 |
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
2875 |
|
|
|
2876 |
|
|
; loop complete so carry on
|
2877 |
|
|
LAB_1A9B
|
2878 |
|
|
TXA ; stack copy to A
|
2879 |
|
|
ADC #$0F ; add $10 ($0F+carry) to dump FOR structure
|
2880 |
|
|
TAX ; copy back to index
|
2881 |
|
|
TXS ; copy to stack pointer
|
2882 |
|
|
JSR LAB_GBYT ; scan memory
|
2883 |
|
|
CMP #',' ; compare with ","
|
2884 |
|
|
BNE LAB_1A98 ; branch if not "," (go do interpreter inner loop)
|
2885 |
|
|
|
2886 |
|
|
; was "," so another NEXT variable to do
|
2887 |
|
|
JSR LAB_IGBY ; else increment and scan memory
|
2888 |
|
|
JSR LAB_1A46 ; do NEXT (var)
|
2889 |
|
|
|
2890 |
|
|
; evaluate expression and check is numeric, else do type mismatch
|
2891 |
|
|
|
2892 |
|
|
LAB_EVNM
|
2893 |
|
|
JSR LAB_EVEX ; evaluate expression
|
2894 |
|
|
|
2895 |
|
|
; check if source is numeric, else do type mismatch
|
2896 |
|
|
|
2897 |
|
|
LAB_CTNM
|
2898 |
|
|
CLC ; destination is numeric
|
2899 |
|
|
.byte $24 ; makes next line BIT $38
|
2900 |
|
|
|
2901 |
|
|
; check if source is string, else do type mismatch
|
2902 |
|
|
|
2903 |
|
|
LAB_CTST
|
2904 |
|
|
SEC ; required type is string
|
2905 |
|
|
|
2906 |
|
|
; type match check, set C for string, clear C for numeric
|
2907 |
|
|
|
2908 |
|
|
LAB_CKTM
|
2909 |
|
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric
|
2910 |
|
|
BMI LAB_1ABA ; branch if data type is string
|
2911 |
|
|
|
2912 |
|
|
; else data type was numeric
|
2913 |
|
|
BCS LAB_1ABC ; if required type is string do type mismatch error
|
2914 |
|
|
LAB_1AB9
|
2915 |
|
|
RTS
|
2916 |
|
|
|
2917 |
|
|
; data type was string, now check required type
|
2918 |
|
|
LAB_1ABA
|
2919 |
|
|
BCS LAB_1AB9 ; exit if required type is string
|
2920 |
|
|
|
2921 |
|
|
; else do type mismatch error
|
2922 |
|
|
LAB_1ABC
|
2923 |
|
|
LDX #$18 ; error code $18 ("Type mismatch" error)
|
2924 |
|
|
LAB_1ABE
|
2925 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
2926 |
|
|
|
2927 |
|
|
; evaluate expression
|
2928 |
|
|
|
2929 |
|
|
LAB_EVEX
|
2930 |
|
|
LDX Bpntrl ; get BASIC execute pointer low byte
|
2931 |
|
|
BNE LAB_1AC7 ; skip next if not zero
|
2932 |
|
|
|
2933 |
|
|
DEC Bpntrh ; else decrement BASIC execute pointer high byte
|
2934 |
|
|
LAB_1AC7
|
2935 |
|
|
DEC Bpntrl ; decrement BASIC execute pointer low byte
|
2936 |
|
|
|
2937 |
|
|
LAB_EVEZ
|
2938 |
|
|
LDA #$00 ; set null precedence (flag done)
|
2939 |
|
|
LAB_1ACC
|
2940 |
|
|
PHA ; push precedence byte
|
2941 |
|
|
LDA #$02 ; 2 bytes
|
2942 |
|
|
JSR LAB_1212 ; check room on stack for A bytes
|
2943 |
|
|
JSR LAB_GVAL ; get value from line
|
2944 |
|
|
LDA #$00 ; clear A
|
2945 |
|
|
STA comp_f ; clear compare function flag
|
2946 |
|
|
LAB_1ADB
|
2947 |
|
|
JSR LAB_GBYT ; scan memory
|
2948 |
|
|
LAB_1ADE
|
2949 |
|
|
SEC ; set carry for subtract
|
2950 |
|
|
SBC #TK_GT ; subtract token for > (lowest comparison function)
|
2951 |
|
|
BCC LAB_1AFA ; branch if < TK_GT
|
2952 |
|
|
|
2953 |
|
|
CMP #$03 ; compare with ">" to "<" tokens
|
2954 |
|
|
BCS LAB_1AFA ; branch if >= TK_SGN (highest evaluation function +1)
|
2955 |
|
|
|
2956 |
|
|
; was token for > = or < (A = 0, 1 or 2)
|
2957 |
|
|
CMP #$01 ; compare with token for =
|
2958 |
|
|
ROL ; *2, b0 = carry (=1 if token was = or <)
|
2959 |
|
|
; (A = 0, 3 or 5)
|
2960 |
|
|
EOR #$01 ; toggle b0
|
2961 |
|
|
; (A = 1, 2 or 4. 1 if >, 2 if =, 4 if <)
|
2962 |
|
|
EOR comp_f ; EOR with compare function flag bits
|
2963 |
|
|
CMP comp_f ; compare with compare function flag
|
2964 |
|
|
BCC LAB_1B53 ; if <(comp_f) do syntax error then warm start
|
2965 |
|
|
; was more than one <, = or >)
|
2966 |
|
|
|
2967 |
|
|
STA comp_f ; save new compare function flag
|
2968 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
2969 |
|
|
JMP LAB_1ADE ; go do next character
|
2970 |
|
|
|
2971 |
|
|
; token is < ">" or > "<" tokens
|
2972 |
|
|
LAB_1AFA
|
2973 |
|
|
LDX comp_f ; get compare function flag
|
2974 |
|
|
BNE LAB_1B2A ; branch if compare function
|
2975 |
|
|
|
2976 |
|
|
BCS LAB_1B78 ; go do functions
|
2977 |
|
|
|
2978 |
|
|
; else was < TK_GT so is operator or lower
|
2979 |
|
|
ADC #TK_GT-TK_PLUS ; add # of operators (+, -, *, /, ^, AND, OR or EOR)
|
2980 |
|
|
BCC LAB_1B78 ; branch if < + operator
|
2981 |
|
|
|
2982 |
|
|
; carry was set so token was +, -, *, /, ^, AND, OR or EOR
|
2983 |
|
|
BNE LAB_1B0B ; branch if not + token
|
2984 |
|
|
|
2985 |
|
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric
|
2986 |
|
|
BPL LAB_1B0B ; branch if not string
|
2987 |
|
|
|
2988 |
|
|
; will only be $00 if type is string and token was +
|
2989 |
|
|
JMP LAB_224D ; add strings, string 1 is in descriptor des_pl, string 2
|
2990 |
|
|
; is in line, and return
|
2991 |
|
|
|
2992 |
|
|
LAB_1B0B
|
2993 |
|
|
STA ut1_pl ; save it
|
2994 |
|
|
ASL ; *2
|
2995 |
|
|
ADC ut1_pl ; *3
|
2996 |
|
|
TAY ; copy to index
|
2997 |
|
|
LAB_1B13
|
2998 |
|
|
PLA ; pull previous precedence
|
2999 |
|
|
CMP LAB_OPPT,Y ; compare with precedence byte
|
3000 |
|
|
BCS LAB_1B7D ; branch if A >=
|
3001 |
|
|
|
3002 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
3003 |
|
|
LAB_1B1C
|
3004 |
|
|
PHA ; save precedence
|
3005 |
|
|
LAB_1B1D
|
3006 |
|
|
JSR LAB_1B43 ; get vector, execute function then continue evaluation
|
3007 |
|
|
PLA ; restore precedence
|
3008 |
|
|
LDY prstk ; get precedence stacked flag
|
3009 |
|
|
BPL LAB_1B3C ; branch if stacked values
|
3010 |
|
|
|
3011 |
|
|
TAX ; copy precedence (set flags)
|
3012 |
|
|
BEQ LAB_1B9D ; exit if done
|
3013 |
|
|
|
3014 |
|
|
BNE LAB_1B86 ; else pop FAC2 and return, branch always
|
3015 |
|
|
|
3016 |
|
|
LAB_1B2A
|
3017 |
|
|
ROL Dtypef ; shift data type flag into Cb
|
3018 |
|
|
TXA ; copy compare function flag
|
3019 |
|
|
STA Dtypef ; clear data type flag, X is 0xxx xxxx
|
3020 |
|
|
ROL ; shift data type into compare function byte b0
|
3021 |
|
|
LDX Bpntrl ; get BASIC execute pointer low byte
|
3022 |
|
|
BNE LAB_1B34 ; branch if no underflow
|
3023 |
|
|
|
3024 |
|
|
DEC Bpntrh ; else decrement BASIC execute pointer high byte
|
3025 |
|
|
LAB_1B34
|
3026 |
|
|
DEC Bpntrl ; decrement BASIC execute pointer low byte
|
3027 |
|
|
TK_LT_PLUS = TK_LT-TK_PLUS
|
3028 |
|
|
LDY #TK_LT_PLUS*3 ; set offset to last operator entry
|
3029 |
|
|
STA comp_f ; save new compare function flag
|
3030 |
|
|
BNE LAB_1B13 ; branch always
|
3031 |
|
|
|
3032 |
|
|
LAB_1B3C
|
3033 |
|
|
CMP LAB_OPPT,Y ;.compare with stacked function precedence
|
3034 |
|
|
BCS LAB_1B86 ; branch if A >=, pop FAC2 and return
|
3035 |
|
|
|
3036 |
|
|
BCC LAB_1B1C ; branch always
|
3037 |
|
|
|
3038 |
|
|
;.get vector, execute function then continue evaluation
|
3039 |
|
|
|
3040 |
|
|
LAB_1B43
|
3041 |
|
|
LDA LAB_OPPT+2,Y ; get function vector high byte
|
3042 |
|
|
PHA ; onto stack
|
3043 |
|
|
LDA LAB_OPPT+1,Y ; get function vector low byte
|
3044 |
|
|
PHA ; onto stack
|
3045 |
|
|
; now push sign, round FAC1 and put on stack
|
3046 |
|
|
JSR LAB_1B5B ; function will return here, then the next RTS will call
|
3047 |
|
|
; the function
|
3048 |
|
|
LDA comp_f ; get compare function flag
|
3049 |
|
|
PHA ; push compare evaluation byte
|
3050 |
|
|
LDA LAB_OPPT,Y ; get precedence byte
|
3051 |
|
|
JMP LAB_1ACC ; continue evaluating expression
|
3052 |
|
|
|
3053 |
|
|
LAB_1B53
|
3054 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
3055 |
|
|
|
3056 |
|
|
; push sign, round FAC1 and put on stack
|
3057 |
|
|
|
3058 |
|
|
LAB_1B5B
|
3059 |
|
|
PLA ; get return addr low byte
|
3060 |
|
|
STA ut1_pl ; save it
|
3061 |
|
|
INC ut1_pl ; increment it (was ret-1 pushed? yes!)
|
3062 |
|
|
; note! no check is made on the high byte! if the calling
|
3063 |
|
|
; routine assembles to a page edge then this all goes
|
3064 |
|
|
; horribly wrong !!!
|
3065 |
|
|
PLA ; get return addr high byte
|
3066 |
|
|
STA ut1_ph ; save it
|
3067 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
3068 |
|
|
PHA ; push sign
|
3069 |
|
|
|
3070 |
|
|
; round FAC1 and put on stack
|
3071 |
|
|
|
3072 |
|
|
LAB_1B66
|
3073 |
|
|
JSR LAB_27BA ; round FAC1
|
3074 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
3075 |
|
|
PHA ; push on stack
|
3076 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3077 |
|
|
PHA ; push on stack
|
3078 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
3079 |
|
|
PHA ; push on stack
|
3080 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
3081 |
|
|
PHA ; push on stack
|
3082 |
|
|
JMP (ut1_pl) ; return, sort of
|
3083 |
|
|
|
3084 |
|
|
; do functions
|
3085 |
|
|
|
3086 |
|
|
LAB_1B78
|
3087 |
|
|
LDY #$FF ; flag function
|
3088 |
|
|
PLA ; pull precedence byte
|
3089 |
|
|
LAB_1B7B
|
3090 |
|
|
BEQ LAB_1B9D ; exit if done
|
3091 |
|
|
|
3092 |
|
|
LAB_1B7D
|
3093 |
|
|
CMP #$64 ; compare previous precedence with $64
|
3094 |
|
|
BEQ LAB_1B84 ; branch if was $64 (< function)
|
3095 |
|
|
|
3096 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
3097 |
|
|
LAB_1B84
|
3098 |
|
|
STY prstk ; save precedence stacked flag
|
3099 |
|
|
|
3100 |
|
|
; pop FAC2 and return
|
3101 |
|
|
LAB_1B86
|
3102 |
|
|
PLA ; pop byte
|
3103 |
|
|
LSR ; shift out comparison evaluation lowest bit
|
3104 |
|
|
STA Cflag ; save comparison evaluation flag
|
3105 |
|
|
PLA ; pop exponent
|
3106 |
|
|
STA FAC2_e ; save FAC2 exponent
|
3107 |
|
|
PLA ; pop mantissa1
|
3108 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
3109 |
|
|
PLA ; pop mantissa2
|
3110 |
|
|
STA FAC2_2 ; save FAC2 mantissa2
|
3111 |
|
|
PLA ; pop mantissa3
|
3112 |
|
|
STA FAC2_3 ; save FAC2 mantissa3
|
3113 |
|
|
PLA ; pop sign
|
3114 |
|
|
STA FAC2_s ; save FAC2 sign (b7)
|
3115 |
|
|
EOR FAC1_s ; EOR FAC1 sign (b7)
|
3116 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
3117 |
|
|
LAB_1B9D
|
3118 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
3119 |
|
|
RTS
|
3120 |
|
|
|
3121 |
|
|
; print "..." string to string util area
|
3122 |
|
|
|
3123 |
|
|
LAB_1BC1
|
3124 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
3125 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte
|
3126 |
|
|
ADC #$00 ; add carry to low byte
|
3127 |
|
|
BCC LAB_1BCA ; branch if no overflow
|
3128 |
|
|
|
3129 |
|
|
INY ; increment high byte
|
3130 |
|
|
LAB_1BCA
|
3131 |
|
|
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh
|
3132 |
|
|
JMP LAB_23F3 ; restore BASIC execute pointer from temp and return
|
3133 |
|
|
|
3134 |
|
|
; get value from line
|
3135 |
|
|
|
3136 |
|
|
LAB_GVAL
|
3137 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
3138 |
|
|
BCS LAB_1BAC ; branch if not numeric character
|
3139 |
|
|
|
3140 |
|
|
; else numeric string found (e.g. 123)
|
3141 |
|
|
LAB_1BA9
|
3142 |
|
|
JMP LAB_2887 ; get FAC1 from string and return
|
3143 |
|
|
|
3144 |
|
|
; get value from line .. continued
|
3145 |
|
|
|
3146 |
|
|
; wasn't a number so ..
|
3147 |
|
|
LAB_1BAC
|
3148 |
|
|
TAX ; set the flags
|
3149 |
|
|
BMI LAB_1BD0 ; if -ve go test token values
|
3150 |
|
|
|
3151 |
|
|
; else it is either a string, number, variable or ()
|
3152 |
|
|
CMP #'$' ; compare with "$"
|
3153 |
|
|
BEQ LAB_1BA9 ; branch if "$", hex number
|
3154 |
|
|
|
3155 |
|
|
CMP #'%' ; else compare with "%"
|
3156 |
|
|
BEQ LAB_1BA9 ; branch if "%", binary number
|
3157 |
|
|
|
3158 |
|
|
CMP #'.' ; compare with "."
|
3159 |
|
|
BEQ LAB_1BA9 ; if so get FAC1 from string and return (e.g. was .123)
|
3160 |
|
|
|
3161 |
|
|
; it wasn't any sort of number so ..
|
3162 |
|
|
CMP #$22 ; compare with "
|
3163 |
|
|
BEQ LAB_1BC1 ; branch if open quote
|
3164 |
|
|
|
3165 |
|
|
; wasn't any sort of number so ..
|
3166 |
|
|
|
3167 |
|
|
; evaluate expression within parentheses
|
3168 |
|
|
|
3169 |
|
|
CMP #'(' ; compare with "("
|
3170 |
|
|
BNE LAB_1C18 ; if not "(" get (var), return value in FAC1 and $ flag
|
3171 |
|
|
|
3172 |
|
|
LAB_1BF7
|
3173 |
|
|
JSR LAB_EVEZ ; evaluate expression, no decrement
|
3174 |
|
|
|
3175 |
|
|
; all the 'scan for' routines return the character after the sought character
|
3176 |
|
|
|
3177 |
|
|
; scan for ")" , else do syntax error then warm start
|
3178 |
|
|
|
3179 |
|
|
LAB_1BFB
|
3180 |
|
|
LDA #$29 ; load A with ")"
|
3181 |
|
|
|
3182 |
|
|
; scan for CHR$(A) , else do syntax error then warm start
|
3183 |
|
|
|
3184 |
|
|
LAB_SCCA
|
3185 |
|
|
LDY #$00 ; clear index
|
3186 |
|
|
CMP (Bpntrl),Y ; check next byte is = A
|
3187 |
|
|
BNE LAB_SNER ; if not do syntax error then warm start
|
3188 |
|
|
|
3189 |
|
|
JMP LAB_IGBY ; increment and scan memory then return
|
3190 |
|
|
|
3191 |
|
|
; scan for "(" , else do syntax error then warm start
|
3192 |
|
|
|
3193 |
|
|
LAB_1BFE
|
3194 |
|
|
LDA #$28 ; load A with "("
|
3195 |
|
|
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
3196 |
|
|
; (branch always)
|
3197 |
|
|
|
3198 |
|
|
; scan for "," , else do syntax error then warm start
|
3199 |
|
|
|
3200 |
|
|
LAB_1C01
|
3201 |
|
|
LDA #$2C ; load A with ","
|
3202 |
|
|
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
3203 |
|
|
; (branch always)
|
3204 |
|
|
|
3205 |
|
|
; syntax error then warm start
|
3206 |
|
|
|
3207 |
|
|
LAB_SNER
|
3208 |
|
|
LDX #$02 ; error code $02 ("Syntax" error)
|
3209 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
3210 |
|
|
|
3211 |
|
|
; get value from line .. continued
|
3212 |
|
|
; do tokens
|
3213 |
|
|
|
3214 |
|
|
LAB_1BD0
|
3215 |
|
|
CMP #TK_MINUS ; compare with token for -
|
3216 |
|
|
BEQ LAB_1C11 ; branch if - token (do set-up for functions)
|
3217 |
|
|
|
3218 |
|
|
; wasn't -n so ..
|
3219 |
|
|
CMP #TK_PLUS ; compare with token for +
|
3220 |
|
|
BEQ LAB_GVAL ; branch if + token (+n = n so ignore leading +)
|
3221 |
|
|
|
3222 |
|
|
CMP #TK_NOT ; compare with token for NOT
|
3223 |
|
|
BNE LAB_1BE7 ; branch if not token for NOT
|
3224 |
|
|
|
3225 |
|
|
; was NOT token
|
3226 |
|
|
TK_EQUAL_PLUS = TK_EQUAL-TK_PLUS
|
3227 |
|
|
LDY #TK_EQUAL_PLUS*3 ; offset to NOT function
|
3228 |
|
|
BNE LAB_1C13 ; do set-up for function then execute (branch always)
|
3229 |
|
|
|
3230 |
|
|
; do = compare
|
3231 |
|
|
|
3232 |
|
|
LAB_EQUAL
|
3233 |
|
|
JSR LAB_EVIR ; evaluate integer expression (no sign check)
|
3234 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
3235 |
|
|
EOR #$FF ; invert it
|
3236 |
|
|
TAY ; copy it
|
3237 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3238 |
|
|
EOR #$FF ; invert it
|
3239 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3240 |
|
|
|
3241 |
|
|
; get value from line .. continued
|
3242 |
|
|
|
3243 |
|
|
; wasn't +, -, or NOT so ..
|
3244 |
|
|
LAB_1BE7
|
3245 |
|
|
CMP #TK_FN ; compare with token for FN
|
3246 |
|
|
BNE LAB_1BEE ; branch if not token for FN
|
3247 |
|
|
|
3248 |
|
|
JMP LAB_201E ; go evaluate FNx
|
3249 |
|
|
|
3250 |
|
|
; get value from line .. continued
|
3251 |
|
|
|
3252 |
|
|
; wasn't +, -, NOT or FN so ..
|
3253 |
|
|
LAB_1BEE
|
3254 |
|
|
SBC #TK_SGN ; subtract with token for SGN
|
3255 |
|
|
BCS LAB_1C27 ; if a function token go do it
|
3256 |
|
|
|
3257 |
|
|
JMP LAB_SNER ; else do syntax error
|
3258 |
|
|
|
3259 |
|
|
; set-up for functions
|
3260 |
|
|
|
3261 |
|
|
LAB_1C11
|
3262 |
|
|
TK_GT_PLUS = TK_GT-TK_PLUS
|
3263 |
|
|
LDY #TK_GT_PLUS*3 ; set offset from base to > operator
|
3264 |
|
|
LAB_1C13
|
3265 |
|
|
PLA ; dump return address low byte
|
3266 |
|
|
PLA ; dump return address high byte
|
3267 |
|
|
JMP LAB_1B1D ; execute function then continue evaluation
|
3268 |
|
|
|
3269 |
|
|
; variable name set-up
|
3270 |
|
|
; get (var), return value in FAC_1 and $ flag
|
3271 |
|
|
|
3272 |
|
|
LAB_1C18
|
3273 |
|
|
JSR LAB_GVAR ; get (var) address
|
3274 |
|
|
STA FAC1_2 ; save address low byte in FAC1 mantissa2
|
3275 |
|
|
STY FAC1_3 ; save address high byte in FAC1 mantissa3
|
3276 |
|
|
LDX Dtypef ; get data type flag, $FF=string, $00=numeric
|
3277 |
|
|
BMI LAB_1C25 ; if string then return (does RTS)
|
3278 |
|
|
|
3279 |
|
|
LAB_1C24
|
3280 |
|
|
JMP LAB_UFAC ; unpack memory (AY) into FAC1
|
3281 |
|
|
|
3282 |
|
|
LAB_1C25
|
3283 |
|
|
RTS
|
3284 |
|
|
|
3285 |
|
|
; get value from line .. continued
|
3286 |
|
|
; only functions left so ..
|
3287 |
|
|
|
3288 |
|
|
; set up function references
|
3289 |
|
|
|
3290 |
|
|
; new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
|
3291 |
|
|
; to process function calls. now the function vector is computed and pushed on the stack
|
3292 |
|
|
; and the preprocess offset is read. if the preprocess offset is non zero then the vector
|
3293 |
|
|
; is calculated and the routine called, if not this routine just does RTS. whichever
|
3294 |
|
|
; happens the RTS at the end of this routine, or the end of the preprocess routine, calls
|
3295 |
|
|
; the function code
|
3296 |
|
|
|
3297 |
|
|
; this also removes some less than elegant code that was used to bypass type checking
|
3298 |
|
|
; for functions that returned strings
|
3299 |
|
|
|
3300 |
|
|
LAB_1C27
|
3301 |
|
|
ASL ; *2 (2 bytes per function address)
|
3302 |
|
|
TAY ; copy to index
|
3303 |
|
|
|
3304 |
|
|
LDA LAB_FTBM,Y ; get function jump vector high byte
|
3305 |
|
|
PHA ; push functions jump vector high byte
|
3306 |
|
|
LDA LAB_FTBL,Y ; get function jump vector low byte
|
3307 |
|
|
PHA ; push functions jump vector low byte
|
3308 |
|
|
|
3309 |
|
|
LDA LAB_FTPM,Y ; get function pre process vector high byte
|
3310 |
|
|
BEQ LAB_1C56 ; skip pre process if null vector
|
3311 |
|
|
|
3312 |
|
|
PHA ; push functions pre process vector high byte
|
3313 |
|
|
LDA LAB_FTPL,Y ; get function pre process vector low byte
|
3314 |
|
|
PHA ; push functions pre process vector low byte
|
3315 |
|
|
|
3316 |
|
|
LAB_1C56
|
3317 |
|
|
RTS ; do function, or pre process, call
|
3318 |
|
|
|
3319 |
|
|
; process string expression in parenthesis
|
3320 |
|
|
|
3321 |
|
|
LAB_PPFS
|
3322 |
|
|
JSR LAB_1BF7 ; process expression in parenthesis
|
3323 |
|
|
JMP LAB_CTST ; check if source is string then do function,
|
3324 |
|
|
; else do type mismatch
|
3325 |
|
|
|
3326 |
|
|
; process numeric expression in parenthesis
|
3327 |
|
|
|
3328 |
|
|
LAB_PPFN
|
3329 |
|
|
JSR LAB_1BF7 ; process expression in parenthesis
|
3330 |
|
|
JMP LAB_CTNM ; check if source is numeric then do function,
|
3331 |
|
|
; else do type mismatch
|
3332 |
|
|
|
3333 |
|
|
; set numeric data type and increment BASIC execute pointer
|
3334 |
|
|
|
3335 |
|
|
LAB_PPBI
|
3336 |
|
|
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
|
3337 |
|
|
JMP LAB_IGBY ; increment and scan memory then do function
|
3338 |
|
|
|
3339 |
|
|
; process string for LEFT$, RIGHT$ or MID$
|
3340 |
|
|
|
3341 |
|
|
LAB_LRMS
|
3342 |
|
|
JSR LAB_EVEZ ; evaluate (should be string) expression
|
3343 |
|
|
JSR LAB_1C01 ; scan for ",", else do syntax error then warm start
|
3344 |
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
3345 |
|
|
|
3346 |
|
|
PLA ; get function jump vector low byte
|
3347 |
|
|
TAX ; save functions jump vector low byte
|
3348 |
|
|
PLA ; get function jump vector high byte
|
3349 |
|
|
TAY ; save functions jump vector high byte
|
3350 |
|
|
LDA des_ph ; get descriptor pointer high byte
|
3351 |
|
|
PHA ; push string pointer high byte
|
3352 |
|
|
LDA des_pl ; get descriptor pointer low byte
|
3353 |
|
|
PHA ; push string pointer low byte
|
3354 |
|
|
TYA ; get function jump vector high byte back
|
3355 |
|
|
PHA ; save functions jump vector high byte
|
3356 |
|
|
TXA ; get function jump vector low byte back
|
3357 |
|
|
PHA ; save functions jump vector low byte
|
3358 |
|
|
JSR LAB_GTBY ; get byte parameter
|
3359 |
|
|
TXA ; copy byte parameter to A
|
3360 |
|
|
RTS ; go do function
|
3361 |
|
|
|
3362 |
|
|
; process numeric expression(s) for BIN$ or HEX$
|
3363 |
|
|
|
3364 |
|
|
LAB_BHSS
|
3365 |
|
|
JSR LAB_EVEZ ; process expression
|
3366 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
3367 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
3368 |
|
|
CMP #$98 ; compare with exponent = 2^24
|
3369 |
|
|
BCS LAB_BHER ; branch if n>=2^24 (is too big)
|
3370 |
|
|
|
3371 |
|
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed
|
3372 |
|
|
LDX #$02 ; 3 bytes to do
|
3373 |
|
|
LAB_CFAC
|
3374 |
|
|
LDA FAC1_1,X ; get byte from FAC1
|
3375 |
|
|
STA nums_1,X ; save byte to temp
|
3376 |
|
|
DEX ; decrement index
|
3377 |
|
|
BPL LAB_CFAC ; copy FAC1 mantissa to temp
|
3378 |
|
|
|
3379 |
|
|
JSR LAB_GBYT ; get next BASIC byte
|
3380 |
|
|
LDX #$00 ; set default to no leading "0"s
|
3381 |
|
|
CMP #')' ; compare with close bracket
|
3382 |
|
|
BEQ LAB_1C54 ; if ")" go do rest of function
|
3383 |
|
|
|
3384 |
|
|
JSR LAB_SCGB ; scan for "," and get byte
|
3385 |
|
|
JSR LAB_GBYT ; get last byte back
|
3386 |
|
|
CMP #')' ; is next character )
|
3387 |
|
|
BNE LAB_BHER ; if not ")" go do error
|
3388 |
|
|
|
3389 |
|
|
LAB_1C54
|
3390 |
|
|
RTS ; else do function
|
3391 |
|
|
|
3392 |
|
|
LAB_BHER
|
3393 |
|
|
JMP LAB_FCER ; do function call error then warm start
|
3394 |
|
|
|
3395 |
|
|
; perform EOR
|
3396 |
|
|
|
3397 |
|
|
; added operator format is the same as AND or OR, precedence is the same as OR
|
3398 |
|
|
|
3399 |
|
|
; this bit worked first time but it took a while to sort out the operator table
|
3400 |
|
|
; pointers and offsets afterwards!
|
3401 |
|
|
|
3402 |
|
|
LAB_EOR
|
3403 |
|
|
JSR GetFirst ; get first integer expression (no sign check)
|
3404 |
|
|
EOR XOAw_l ; EOR with expression 1 low byte
|
3405 |
|
|
TAY ; save in Y
|
3406 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3407 |
|
|
EOR XOAw_h ; EOR with expression 1 high byte
|
3408 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3409 |
|
|
|
3410 |
|
|
; perform OR
|
3411 |
|
|
|
3412 |
|
|
LAB_OR
|
3413 |
|
|
JSR GetFirst ; get first integer expression (no sign check)
|
3414 |
|
|
ORA XOAw_l ; OR with expression 1 low byte
|
3415 |
|
|
TAY ; save in Y
|
3416 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3417 |
|
|
ORA XOAw_h ; OR with expression 1 high byte
|
3418 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3419 |
|
|
|
3420 |
|
|
; perform AND
|
3421 |
|
|
|
3422 |
|
|
LAB_AND
|
3423 |
|
|
JSR GetFirst ; get first integer expression (no sign check)
|
3424 |
|
|
AND XOAw_l ; AND with expression 1 low byte
|
3425 |
|
|
TAY ; save in Y
|
3426 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3427 |
|
|
AND XOAw_h ; AND with expression 1 high byte
|
3428 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3429 |
|
|
|
3430 |
|
|
; get first value for OR, AND or EOR
|
3431 |
|
|
|
3432 |
|
|
GetFirst
|
3433 |
|
|
JSR LAB_EVIR ; evaluate integer expression (no sign check)
|
3434 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
3435 |
|
|
STA XOAw_h ; save it
|
3436 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
3437 |
|
|
STA XOAw_l ; save it
|
3438 |
|
|
JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression)
|
3439 |
|
|
JSR LAB_EVIR ; evaluate integer expression (no sign check)
|
3440 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
3441 |
|
|
LAB_1C95
|
3442 |
|
|
RTS
|
3443 |
|
|
|
3444 |
|
|
; perform comparisons
|
3445 |
|
|
|
3446 |
|
|
; do < compare
|
3447 |
|
|
|
3448 |
|
|
LAB_LTHAN
|
3449 |
|
|
JSR LAB_CKTM ; type match check, set C for string
|
3450 |
|
|
BCS LAB_1CAE ; branch if string
|
3451 |
|
|
|
3452 |
|
|
; do numeric < compare
|
3453 |
|
|
LDA FAC2_s ; get FAC2 sign (b7)
|
3454 |
|
|
ORA #$7F ; set all non sign bits
|
3455 |
|
|
AND FAC2_1 ; and FAC2 mantissa1 (AND in sign bit)
|
3456 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
3457 |
|
|
LDA #
|
3458 |
|
|
LDY #>FAC2_e ; set pointer high byte to FAC2
|
3459 |
|
|
JSR LAB_27F8 ; compare FAC1 with FAC2 (AY)
|
3460 |
|
|
TAX ; copy result
|
3461 |
|
|
JMP LAB_1CE1 ; go evaluate result
|
3462 |
|
|
|
3463 |
|
|
; do string < compare
|
3464 |
|
|
LAB_1CAE
|
3465 |
|
|
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
|
3466 |
|
|
DEC comp_f ; clear < bit in compare function flag
|
3467 |
|
|
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
|
3468 |
|
|
; space returns with A = length, X=pointer low byte,
|
3469 |
|
|
; Y=pointer high byte
|
3470 |
|
|
STA str_ln ; save length
|
3471 |
|
|
STX str_pl ; save string pointer low byte
|
3472 |
|
|
STY str_ph ; save string pointer high byte
|
3473 |
|
|
LDA FAC2_2 ; get descriptor pointer low byte
|
3474 |
|
|
LDY FAC2_3 ; get descriptor pointer high byte
|
3475 |
|
|
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
|
3476 |
|
|
; returns with A = length, X=pointer low byte,
|
3477 |
|
|
; Y=pointer high byte
|
3478 |
|
|
STX FAC2_2 ; save string pointer low byte
|
3479 |
|
|
STY FAC2_3 ; save string pointer high byte
|
3480 |
|
|
TAX ; copy length
|
3481 |
|
|
SEC ; set carry for subtract
|
3482 |
|
|
SBC str_ln ; subtract string 1 length
|
3483 |
|
|
BEQ LAB_1CD6 ; branch if str 1 length = string 2 length
|
3484 |
|
|
|
3485 |
|
|
LDA #$01 ; set str 1 length > string 2 length
|
3486 |
|
|
BCC LAB_1CD6 ; branch if so
|
3487 |
|
|
|
3488 |
|
|
LDX str_ln ; get string 1 length
|
3489 |
|
|
LDA #$FF ; set str 1 length < string 2 length
|
3490 |
|
|
LAB_1CD6
|
3491 |
|
|
STA FAC1_s ; save length compare
|
3492 |
|
|
LDY #$FF ; set index
|
3493 |
|
|
INX ; adjust for loop
|
3494 |
|
|
LAB_1CDB
|
3495 |
|
|
INY ; increment index
|
3496 |
|
|
DEX ; decrement count
|
3497 |
|
|
BNE LAB_1CE6 ; branch if still bytes to do
|
3498 |
|
|
|
3499 |
|
|
LDX FAC1_s ; get length compare back
|
3500 |
|
|
LAB_1CE1
|
3501 |
|
|
BMI LAB_1CF2 ; branch if str 1 < str 2
|
3502 |
|
|
|
3503 |
|
|
CLC ; flag str 1 <= str 2
|
3504 |
|
|
BCC LAB_1CF2 ; go evaluate result
|
3505 |
|
|
|
3506 |
|
|
LAB_1CE6
|
3507 |
|
|
LDA (FAC2_2),Y ; get string 2 byte
|
3508 |
|
|
CMP (FAC1_1),Y ; compare with string 1 byte
|
3509 |
|
|
BEQ LAB_1CDB ; loop if bytes =
|
3510 |
|
|
|
3511 |
|
|
LDX #$FF ; set str 1 < string 2
|
3512 |
|
|
BCS LAB_1CF2 ; branch if so
|
3513 |
|
|
|
3514 |
|
|
LDX #$01 ; set str 1 > string 2
|
3515 |
|
|
LAB_1CF2
|
3516 |
|
|
INX ; x = 0, 1 or 2
|
3517 |
|
|
TXA ; copy to A
|
3518 |
|
|
ROL ; *2 (1, 2 or 4)
|
3519 |
|
|
AND Cflag ; AND with comparison evaluation flag
|
3520 |
|
|
BEQ LAB_1CFB ; branch if 0 (compare is false)
|
3521 |
|
|
|
3522 |
|
|
LDA #$FF ; else set result true
|
3523 |
|
|
LAB_1CFB
|
3524 |
|
|
JMP LAB_27DB ; save A as integer byte and return
|
3525 |
|
|
|
3526 |
|
|
LAB_1CFE
|
3527 |
|
|
JSR LAB_1C01 ; scan for ",", else do syntax error then warm start
|
3528 |
|
|
|
3529 |
|
|
; perform DIM
|
3530 |
|
|
|
3531 |
|
|
LAB_DIM
|
3532 |
|
|
TAX ; copy "DIM" flag to X
|
3533 |
|
|
JSR LAB_1D10 ; search for variable
|
3534 |
|
|
JSR LAB_GBYT ; scan memory
|
3535 |
|
|
BNE LAB_1CFE ; scan for "," and loop if not null
|
3536 |
|
|
|
3537 |
|
|
RTS
|
3538 |
|
|
|
3539 |
|
|
; perform << (left shift)
|
3540 |
|
|
|
3541 |
|
|
LAB_LSHIFT
|
3542 |
|
|
JSR GetPair ; get integer expression and byte (no sign check)
|
3543 |
|
|
LDA FAC1_2 ; get expression high byte
|
3544 |
|
|
LDX TempB ; get shift count
|
3545 |
|
|
BEQ NoShift ; branch if zero
|
3546 |
|
|
|
3547 |
|
|
CPX #$10 ; compare bit count with 16d
|
3548 |
|
|
BCS TooBig ; branch if >=
|
3549 |
|
|
|
3550 |
|
|
Ls_loop
|
3551 |
|
|
ASL FAC1_3 ; shift low byte
|
3552 |
|
|
ROL ; shift high byte
|
3553 |
|
|
DEX ; decrement bit count
|
3554 |
|
|
BNE Ls_loop ; loop if shift not complete
|
3555 |
|
|
|
3556 |
|
|
LDY FAC1_3 ; get expression low byte
|
3557 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3558 |
|
|
|
3559 |
|
|
; perform >> (right shift)
|
3560 |
|
|
|
3561 |
|
|
LAB_RSHIFT
|
3562 |
|
|
JSR GetPair ; get integer expression and byte (no sign check)
|
3563 |
|
|
LDA FAC1_2 ; get expression high byte
|
3564 |
|
|
LDX TempB ; get shift count
|
3565 |
|
|
BEQ NoShift ; branch if zero
|
3566 |
|
|
|
3567 |
|
|
CPX #$10 ; compare bit count with 16d
|
3568 |
|
|
BCS TooBig ; branch if >=
|
3569 |
|
|
|
3570 |
|
|
Rs_loop
|
3571 |
|
|
LSR ; shift high byte
|
3572 |
|
|
ROR FAC1_3 ; shift low byte
|
3573 |
|
|
DEX ; decrement bit count
|
3574 |
|
|
BNE Rs_loop ; loop if shift not complete
|
3575 |
|
|
|
3576 |
|
|
NoShift
|
3577 |
|
|
LDY FAC1_3 ; get expression low byte
|
3578 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3579 |
|
|
|
3580 |
|
|
TooBig
|
3581 |
|
|
LDA #$00 ; clear high byte
|
3582 |
|
|
TAY ; copy to low byte
|
3583 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
3584 |
|
|
|
3585 |
|
|
GetPair
|
3586 |
|
|
JSR LAB_EVBY ; evaluate byte expression, result in X
|
3587 |
|
|
STX TempB ; save it
|
3588 |
|
|
JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression)
|
3589 |
|
|
JMP LAB_EVIR ; evaluate integer expression (no sign check)
|
3590 |
|
|
|
3591 |
|
|
; search for variable
|
3592 |
|
|
|
3593 |
|
|
; return pointer to variable in Cvaral/Cvarah
|
3594 |
|
|
|
3595 |
|
|
LAB_GVAR
|
3596 |
|
|
LDX #$00 ; set DIM flag = $00
|
3597 |
|
|
JSR LAB_GBYT ; scan memory (1st character)
|
3598 |
|
|
LAB_1D10
|
3599 |
|
|
STX Defdim ; save DIM flag
|
3600 |
|
|
LAB_1D12
|
3601 |
|
|
STA Varnm1 ; save 1st character
|
3602 |
|
|
AND #$7F ; clear FN flag bit
|
3603 |
|
|
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
|
3604 |
|
|
BCS LAB_1D1F ; branch if ok
|
3605 |
|
|
|
3606 |
|
|
JMP LAB_SNER ; else syntax error then warm start
|
3607 |
|
|
|
3608 |
|
|
; was variable name so ..
|
3609 |
|
|
LAB_1D1F
|
3610 |
|
|
LDX #$00 ; clear 2nd character temp
|
3611 |
|
|
STX Dtypef ; clear data type flag, $FF=string, $00=numeric
|
3612 |
|
|
JSR LAB_IGBY ; increment and scan memory (2nd character)
|
3613 |
|
|
BCC LAB_1D2D ; branch if character = "0"-"9" (ok)
|
3614 |
|
|
|
3615 |
|
|
; 2nd character wasn't "0" to "9" so ..
|
3616 |
|
|
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
|
3617 |
|
|
BCC LAB_1D38 ; branch if <"A" or >"Z" (go check if string)
|
3618 |
|
|
|
3619 |
|
|
LAB_1D2D
|
3620 |
|
|
TAX ; copy 2nd character
|
3621 |
|
|
|
3622 |
|
|
; ignore further (valid) characters in the variable name
|
3623 |
|
|
LAB_1D2E
|
3624 |
|
|
JSR LAB_IGBY ; increment and scan memory (3rd character)
|
3625 |
|
|
BCC LAB_1D2E ; loop if character = "0"-"9" (ignore)
|
3626 |
|
|
|
3627 |
|
|
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z"
|
3628 |
|
|
BCS LAB_1D2E ; loop if character = "A"-"Z" (ignore)
|
3629 |
|
|
|
3630 |
|
|
; check if string variable
|
3631 |
|
|
LAB_1D38
|
3632 |
|
|
CMP #'$' ; compare with "$"
|
3633 |
|
|
BNE LAB_1D47 ; branch if not string
|
3634 |
|
|
|
3635 |
|
|
; to introduce a new variable type (% suffix for integers say) then this branch
|
3636 |
|
|
; will need to go to that check and then that branch, if it fails, go to LAB_1D47
|
3637 |
|
|
|
3638 |
|
|
; type is string
|
3639 |
|
|
LDA #$FF ; set data type = string
|
3640 |
|
|
STA Dtypef ; set data type flag, $FF=string, $00=numeric
|
3641 |
|
|
TXA ; get 2nd character back
|
3642 |
|
|
ORA #$80 ; set top bit (indicate string var)
|
3643 |
|
|
TAX ; copy back to 2nd character temp
|
3644 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
3645 |
|
|
|
3646 |
|
|
; after we have determined the variable type we need to come back here to determine
|
3647 |
|
|
; if it's an array of type. this would plug in a%(b[,c[,d]])) integer arrays nicely
|
3648 |
|
|
|
3649 |
|
|
|
3650 |
|
|
LAB_1D47 ; gets here with character after var name in A
|
3651 |
|
|
STX Varnm2 ; save 2nd character
|
3652 |
|
|
ORA Sufnxf ; or with subscript/FNX flag (or FN name)
|
3653 |
|
|
CMP #'(' ; compare with "("
|
3654 |
|
|
BNE LAB_1D53 ; branch if not "("
|
3655 |
|
|
|
3656 |
|
|
JMP LAB_1E17 ; go find, or make, array
|
3657 |
|
|
|
3658 |
|
|
; either find or create var
|
3659 |
|
|
; var name (1st two characters only!) is in Varnm1,Varnm2
|
3660 |
|
|
|
3661 |
|
|
; variable name wasn't var(... so look for plain var
|
3662 |
|
|
LAB_1D53
|
3663 |
|
|
LDA #$00 ; clear A
|
3664 |
|
|
STA Sufnxf ; clear subscript/FNX flag
|
3665 |
|
|
LDA Svarl ; get start of vars low byte
|
3666 |
|
|
LDX Svarh ; get start of vars high byte
|
3667 |
|
|
LDY #$00 ; clear index
|
3668 |
|
|
LAB_1D5D
|
3669 |
|
|
STX Vrschh ; save search address high byte
|
3670 |
|
|
LAB_1D5F
|
3671 |
|
|
STA Vrschl ; save search address low byte
|
3672 |
|
|
CPX Sarryh ; compare high address with var space end
|
3673 |
|
|
BNE LAB_1D69 ; skip next compare if <>
|
3674 |
|
|
|
3675 |
|
|
; high addresses were = so compare low addresses
|
3676 |
|
|
CMP Sarryl ; compare low address with var space end
|
3677 |
|
|
BEQ LAB_1D8B ; if not found go make new var
|
3678 |
|
|
|
3679 |
|
|
LAB_1D69
|
3680 |
|
|
LDA Varnm1 ; get 1st character of var to find
|
3681 |
|
|
CMP (Vrschl),Y ; compare with variable name 1st character
|
3682 |
|
|
BNE LAB_1D77 ; branch if no match
|
3683 |
|
|
|
3684 |
|
|
; 1st characters match so compare 2nd characters
|
3685 |
|
|
LDA Varnm2 ; get 2nd character of var to find
|
3686 |
|
|
INY ; index to point to variable name 2nd character
|
3687 |
|
|
CMP (Vrschl),Y ; compare with variable name 2nd character
|
3688 |
|
|
BEQ LAB_1DD7 ; branch if match (found var)
|
3689 |
|
|
|
3690 |
|
|
DEY ; else decrement index (now = $00)
|
3691 |
|
|
LAB_1D77
|
3692 |
|
|
CLC ; clear carry for add
|
3693 |
|
|
LDA Vrschl ; get search address low byte
|
3694 |
|
|
ADC #$06 ; +6 (offset to next var name)
|
3695 |
|
|
BCC LAB_1D5F ; loop if no overflow to high byte
|
3696 |
|
|
|
3697 |
|
|
INX ; else increment high byte
|
3698 |
|
|
BNE LAB_1D5D ; loop always (RAM doesn't extend to $FFFF !)
|
3699 |
|
|
|
3700 |
|
|
; check byte, return C=0 if<"A" or >"Z" or "a" to "z"
|
3701 |
|
|
|
3702 |
|
|
LAB_CASC
|
3703 |
|
|
CMP #'a' ; compare with "a"
|
3704 |
|
|
BCS LAB_1D83 ; go check <"z"+1
|
3705 |
|
|
|
3706 |
|
|
; check byte, return C=0 if<"A" or >"Z"
|
3707 |
|
|
|
3708 |
|
|
LAB_1D82
|
3709 |
|
|
CMP #'A' ; compare with "A"
|
3710 |
|
|
BCC LAB_1D8A ; exit if less
|
3711 |
|
|
|
3712 |
|
|
; carry is set
|
3713 |
|
|
SBC #$5B ; subtract "Z"+1
|
3714 |
|
|
SEC ; set carry
|
3715 |
|
|
SBC #$A5 ; subtract $A5 (restore byte)
|
3716 |
|
|
; carry clear if byte>$5A
|
3717 |
|
|
LAB_1D8A
|
3718 |
|
|
RTS
|
3719 |
|
|
|
3720 |
|
|
LAB_1D83
|
3721 |
|
|
SBC #$7B ; subtract "z"+1
|
3722 |
|
|
SEC ; set carry
|
3723 |
|
|
SBC #$85 ; subtract $85 (restore byte)
|
3724 |
|
|
; carry clear if byte>$7A
|
3725 |
|
|
RTS
|
3726 |
|
|
|
3727 |
|
|
; reached end of variable mem without match
|
3728 |
|
|
; .. so create new variable
|
3729 |
|
|
LAB_1D8B
|
3730 |
|
|
PLA ; pop return address low byte
|
3731 |
|
|
PHA ; push return address low byte
|
3732 |
|
|
LAB_1C18p2 = LAB_1C18+2
|
3733 |
|
|
CMP #
|
3734 |
|
|
BNE LAB_1D98 ; if not get (var) go create new var
|
3735 |
|
|
|
3736 |
|
|
; This will only drop through if the call was from LAB_1C18 and is only called
|
3737 |
|
|
; from there if it is searching for a variable from the RHS of a LET a=b statement
|
3738 |
|
|
; it prevents the creation of variables not assigned a value.
|
3739 |
|
|
|
3740 |
|
|
; value returned by this is either numeric zero (exponent byte is $00) or null string
|
3741 |
|
|
; (descriptor length byte is $00). in fact a pointer to any $00 byte would have done.
|
3742 |
|
|
|
3743 |
|
|
; doing this saves 6 bytes of variable memory and 168 machine cycles of time
|
3744 |
|
|
|
3745 |
|
|
; this is where you would put the undefined variable error call e.g.
|
3746 |
|
|
|
3747 |
|
|
; ; variable doesn't exist so flag error
|
3748 |
|
|
; LDX #$24 ; error code $24 ("undefined variable" error)
|
3749 |
|
|
; JMP LAB_XERR ; do error #X then warm start
|
3750 |
|
|
|
3751 |
|
|
; the above code has been tested and works a treat! (it replaces the three code lines
|
3752 |
|
|
; below)
|
3753 |
|
|
|
3754 |
|
|
; else return dummy null value
|
3755 |
|
|
LDA #
|
3756 |
|
|
; (uses part of misc constants table)
|
3757 |
|
|
LDY #>LAB_1D96 ; high byte point to $00,$00
|
3758 |
|
|
RTS
|
3759 |
|
|
|
3760 |
|
|
; create new numeric variable
|
3761 |
|
|
LAB_1D98
|
3762 |
|
|
LDA Sarryl ; get var mem end low byte
|
3763 |
|
|
LDY Sarryh ; get var mem end high byte
|
3764 |
|
|
STA Ostrtl ; save old block start low byte
|
3765 |
|
|
STY Ostrth ; save old block start high byte
|
3766 |
|
|
LDA Earryl ; get array mem end low byte
|
3767 |
|
|
LDY Earryh ; get array mem end high byte
|
3768 |
|
|
STA Obendl ; save old block end low byte
|
3769 |
|
|
STY Obendh ; save old block end high byte
|
3770 |
|
|
CLC ; clear carry for add
|
3771 |
|
|
ADC #$06 ; +6 (space for one var)
|
3772 |
|
|
BCC LAB_1DAE ; branch if no overflow to high byte
|
3773 |
|
|
|
3774 |
|
|
INY ; else increment high byte
|
3775 |
|
|
LAB_1DAE
|
3776 |
|
|
STA Nbendl ; set new block end low byte
|
3777 |
|
|
STY Nbendh ; set new block end high byte
|
3778 |
|
|
JSR LAB_11CF ; open up space in memory
|
3779 |
|
|
LDA Nbendl ; get new start low byte
|
3780 |
|
|
LDY Nbendh ; get new start high byte (-$100)
|
3781 |
|
|
INY ; correct high byte
|
3782 |
|
|
STA Sarryl ; save new var mem end low byte
|
3783 |
|
|
STY Sarryh ; save new var mem end high byte
|
3784 |
|
|
LDY #$00 ; clear index
|
3785 |
|
|
LDA Varnm1 ; get var name 1st character
|
3786 |
|
|
STA (Vrschl),Y ; save var name 1st character
|
3787 |
|
|
INY ; increment index
|
3788 |
|
|
LDA Varnm2 ; get var name 2nd character
|
3789 |
|
|
STA (Vrschl),Y ; save var name 2nd character
|
3790 |
|
|
LDA #$00 ; clear A
|
3791 |
|
|
INY ; increment index
|
3792 |
|
|
STA (Vrschl),Y ; initialise var byte
|
3793 |
|
|
INY ; increment index
|
3794 |
|
|
STA (Vrschl),Y ; initialise var byte
|
3795 |
|
|
INY ; increment index
|
3796 |
|
|
STA (Vrschl),Y ; initialise var byte
|
3797 |
|
|
INY ; increment index
|
3798 |
|
|
STA (Vrschl),Y ; initialise var byte
|
3799 |
|
|
|
3800 |
|
|
; found a match for var ((Vrschl) = ptr)
|
3801 |
|
|
LAB_1DD7
|
3802 |
|
|
LDA Vrschl ; get var address low byte
|
3803 |
|
|
CLC ; clear carry for add
|
3804 |
|
|
ADC #$02 ; +2 (offset past var name bytes)
|
3805 |
|
|
LDY Vrschh ; get var address high byte
|
3806 |
|
|
BCC LAB_1DE1 ; branch if no overflow from add
|
3807 |
|
|
|
3808 |
|
|
INY ; else increment high byte
|
3809 |
|
|
LAB_1DE1
|
3810 |
|
|
STA Cvaral ; save current var address low byte
|
3811 |
|
|
STY Cvarah ; save current var address high byte
|
3812 |
|
|
RTS
|
3813 |
|
|
|
3814 |
|
|
; set-up array pointer (Adatal/h) to first element in array
|
3815 |
|
|
; set Adatal,Adatah to Astrtl,Astrth+2*Dimcnt+#$05
|
3816 |
|
|
|
3817 |
|
|
LAB_1DE6
|
3818 |
|
|
LDA Dimcnt ; get # of dimensions (1, 2 or 3)
|
3819 |
|
|
ASL ; *2 (also clears the carry !)
|
3820 |
|
|
ADC #$05 ; +5 (result is 7, 9 or 11 here)
|
3821 |
|
|
ADC Astrtl ; add array start pointer low byte
|
3822 |
|
|
LDY Astrth ; get array pointer high byte
|
3823 |
|
|
BCC LAB_1DF2 ; branch if no overflow
|
3824 |
|
|
|
3825 |
|
|
INY ; else increment high byte
|
3826 |
|
|
LAB_1DF2
|
3827 |
|
|
STA Adatal ; save array data pointer low byte
|
3828 |
|
|
STY Adatah ; save array data pointer high byte
|
3829 |
|
|
RTS
|
3830 |
|
|
|
3831 |
|
|
; evaluate integer expression
|
3832 |
|
|
|
3833 |
|
|
LAB_EVIN
|
3834 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
3835 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
3836 |
|
|
; else do type mismatch
|
3837 |
|
|
|
3838 |
|
|
; evaluate integer expression (no check)
|
3839 |
|
|
|
3840 |
|
|
LAB_EVPI
|
3841 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
3842 |
|
|
BMI LAB_1E12 ; do function call error if -ve
|
3843 |
|
|
|
3844 |
|
|
; evaluate integer expression (no sign check)
|
3845 |
|
|
|
3846 |
|
|
LAB_EVIR
|
3847 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
3848 |
|
|
CMP #$90 ; compare with exponent = 2^16 (n>2^15)
|
3849 |
|
|
BCC LAB_1E14 ; branch if n<2^16 (is ok)
|
3850 |
|
|
|
3851 |
|
|
LDA #
|
3852 |
|
|
LDY #>LAB_1DF7 ; set pointer high byte to -32768
|
3853 |
|
|
JSR LAB_27F8 ; compare FAC1 with (AY)
|
3854 |
|
|
LAB_1E12
|
3855 |
|
|
BNE LAB_FCER ; if <> do function call error then warm start
|
3856 |
|
|
|
3857 |
|
|
LAB_1E14
|
3858 |
|
|
JMP LAB_2831 ; convert FAC1 floating-to-fixed and return
|
3859 |
|
|
|
3860 |
|
|
; find or make array
|
3861 |
|
|
|
3862 |
|
|
LAB_1E17
|
3863 |
|
|
LDA Defdim ; get DIM flag
|
3864 |
|
|
PHA ; push it
|
3865 |
|
|
LDA Dtypef ; get data type flag, $FF=string, $00=numeric
|
3866 |
|
|
PHA ; push it
|
3867 |
|
|
LDY #$00 ; clear dimensions count
|
3868 |
|
|
|
3869 |
|
|
; now get the array dimension(s) and stack it (them) before the data type and DIM flag
|
3870 |
|
|
|
3871 |
|
|
LAB_1E1F
|
3872 |
|
|
TYA ; copy dimensions count
|
3873 |
|
|
PHA ; save it
|
3874 |
|
|
LDA Varnm2 ; get array name 2nd byte
|
3875 |
|
|
PHA ; save it
|
3876 |
|
|
LDA Varnm1 ; get array name 1st byte
|
3877 |
|
|
PHA ; save it
|
3878 |
|
|
JSR LAB_EVIN ; evaluate integer expression
|
3879 |
|
|
PLA ; pull array name 1st byte
|
3880 |
|
|
STA Varnm1 ; restore array name 1st byte
|
3881 |
|
|
PLA ; pull array name 2nd byte
|
3882 |
|
|
STA Varnm2 ; restore array name 2nd byte
|
3883 |
|
|
PLA ; pull dimensions count
|
3884 |
|
|
TAY ; restore it
|
3885 |
|
|
TSX ; copy stack pointer
|
3886 |
|
|
LDA LAB_STAK+2,X ; get DIM flag
|
3887 |
|
|
PHA ; push it
|
3888 |
|
|
LDA LAB_STAK+1,X ; get data type flag
|
3889 |
|
|
PHA ; push it
|
3890 |
|
|
LDA FAC1_2 ; get this dimension size high byte
|
3891 |
|
|
STA LAB_STAK+2,X ; stack before flag bytes
|
3892 |
|
|
LDA FAC1_3 ; get this dimension size low byte
|
3893 |
|
|
STA LAB_STAK+1,X ; stack before flag bytes
|
3894 |
|
|
INY ; increment dimensions count
|
3895 |
|
|
JSR LAB_GBYT ; scan memory
|
3896 |
|
|
CMP #',' ; compare with ","
|
3897 |
|
|
BEQ LAB_1E1F ; if found go do next dimension
|
3898 |
|
|
|
3899 |
|
|
STY Dimcnt ; store dimensions count
|
3900 |
|
|
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
|
3901 |
|
|
PLA ; pull data type flag
|
3902 |
|
|
STA Dtypef ; restore data type flag, $FF=string, $00=numeric
|
3903 |
|
|
PLA ; pull DIM flag
|
3904 |
|
|
STA Defdim ; restore DIM flag
|
3905 |
|
|
LDX Sarryl ; get array mem start low byte
|
3906 |
|
|
LDA Sarryh ; get array mem start high byte
|
3907 |
|
|
|
3908 |
|
|
; now check to see if we are at the end of array memory (we would be if there were
|
3909 |
|
|
; no arrays).
|
3910 |
|
|
|
3911 |
|
|
LAB_1E5C
|
3912 |
|
|
STX Astrtl ; save as array start pointer low byte
|
3913 |
|
|
STA Astrth ; save as array start pointer high byte
|
3914 |
|
|
CMP Earryh ; compare with array mem end high byte
|
3915 |
|
|
BNE LAB_1E68 ; branch if not reached array mem end
|
3916 |
|
|
|
3917 |
|
|
CPX Earryl ; else compare with array mem end low byte
|
3918 |
|
|
BEQ LAB_1EA1 ; go build array if not found
|
3919 |
|
|
|
3920 |
|
|
; search for array
|
3921 |
|
|
LAB_1E68
|
3922 |
|
|
LDY #$00 ; clear index
|
3923 |
|
|
LDA (Astrtl),Y ; get array name first byte
|
3924 |
|
|
INY ; increment index to second name byte
|
3925 |
|
|
CMP Varnm1 ; compare with this array name first byte
|
3926 |
|
|
BNE LAB_1E77 ; branch if no match
|
3927 |
|
|
|
3928 |
|
|
LDA Varnm2 ; else get this array name second byte
|
3929 |
|
|
CMP (Astrtl),Y ; compare with array name second byte
|
3930 |
|
|
BEQ LAB_1E8D ; array found so branch
|
3931 |
|
|
|
3932 |
|
|
; no match
|
3933 |
|
|
LAB_1E77
|
3934 |
|
|
INY ; increment index
|
3935 |
|
|
LDA (Astrtl),Y ; get array size low byte
|
3936 |
|
|
CLC ; clear carry for add
|
3937 |
|
|
ADC Astrtl ; add array start pointer low byte
|
3938 |
|
|
TAX ; copy low byte to X
|
3939 |
|
|
INY ; increment index
|
3940 |
|
|
LDA (Astrtl),Y ; get array size high byte
|
3941 |
|
|
ADC Astrth ; add array mem pointer high byte
|
3942 |
|
|
BCC LAB_1E5C ; if no overflow go check next array
|
3943 |
|
|
|
3944 |
|
|
; do array bounds error
|
3945 |
|
|
|
3946 |
|
|
LAB_1E85
|
3947 |
|
|
LDX #$10 ; error code $10 ("Array bounds" error)
|
3948 |
|
|
.byte $2C ; makes next bit BIT LAB_08A2
|
3949 |
|
|
|
3950 |
|
|
; do function call error
|
3951 |
|
|
|
3952 |
|
|
LAB_FCER
|
3953 |
|
|
LDX #$08 ; error code $08 ("Function call" error)
|
3954 |
|
|
LAB_1E8A
|
3955 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
3956 |
|
|
|
3957 |
|
|
; found array, are we trying to dimension it?
|
3958 |
|
|
LAB_1E8D
|
3959 |
|
|
LDX #$12 ; set error $12 ("Double dimension" error)
|
3960 |
|
|
LDA Defdim ; get DIM flag
|
3961 |
|
|
BNE LAB_1E8A ; if we are trying to dimension it do error #X, then warm
|
3962 |
|
|
; start
|
3963 |
|
|
|
3964 |
|
|
; found the array and we're not dimensioning it so we must find an element in it
|
3965 |
|
|
|
3966 |
|
|
JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array
|
3967 |
|
|
; (Astrtl,Astrth points to start of array)
|
3968 |
|
|
LDA Dimcnt ; get dimensions count
|
3969 |
|
|
LDY #$04 ; set index to array's # of dimensions
|
3970 |
|
|
CMP (Astrtl),Y ; compare with no of dimensions
|
3971 |
|
|
BNE LAB_1E85 ; if wrong do array bounds error, could do "Wrong
|
3972 |
|
|
; dimensions" error here .. if we want a different
|
3973 |
|
|
; error message
|
3974 |
|
|
|
3975 |
|
|
JMP LAB_1F28 ; found array so go get element
|
3976 |
|
|
; (could jump to LAB_1F28 as all LAB_1F24 does is take
|
3977 |
|
|
; Dimcnt and save it at (Astrtl),Y which is already the
|
3978 |
|
|
; same or we would have taken the BNE)
|
3979 |
|
|
|
3980 |
|
|
; array not found, so build it
|
3981 |
|
|
LAB_1EA1
|
3982 |
|
|
JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array
|
3983 |
|
|
; (Astrtl,Astrth points to start of array)
|
3984 |
|
|
JSR LAB_121F ; check available memory, "Out of memory" error if no room
|
3985 |
|
|
; addr to check is in AY (low/high)
|
3986 |
|
|
LDY #$00 ; clear Y (don't need to clear A)
|
3987 |
|
|
STY Aspth ; clear array data size high byte
|
3988 |
|
|
LDA Varnm1 ; get variable name 1st byte
|
3989 |
|
|
STA (Astrtl),Y ; save array name 1st byte
|
3990 |
|
|
INY ; increment index
|
3991 |
|
|
LDA Varnm2 ; get variable name 2nd byte
|
3992 |
|
|
STA (Astrtl),Y ; save array name 2nd byte
|
3993 |
|
|
LDA Dimcnt ; get dimensions count
|
3994 |
|
|
LDY #$04 ; index to dimension count
|
3995 |
|
|
STY Asptl ; set array data size low byte (four bytes per element)
|
3996 |
|
|
STA (Astrtl),Y ; set array's dimensions count
|
3997 |
|
|
|
3998 |
|
|
; now calculate the size of the data space for the array
|
3999 |
|
|
CLC ; clear carry for add (clear on subsequent loops)
|
4000 |
|
|
LAB_1EC0
|
4001 |
|
|
LDX #$0B ; set default dimension value low byte
|
4002 |
|
|
LDA #$00 ; set default dimension value high byte
|
4003 |
|
|
BIT Defdim ; test default DIM flag
|
4004 |
|
|
BVC LAB_1ED0 ; branch if b6 of Defdim is clear
|
4005 |
|
|
|
4006 |
|
|
PLA ; else pull dimension value low byte
|
4007 |
|
|
ADC #$01 ; +1 (allow for zeroeth element)
|
4008 |
|
|
TAX ; copy low byte to X
|
4009 |
|
|
PLA ; pull dimension value high byte
|
4010 |
|
|
ADC #$00 ; add carry from low byte
|
4011 |
|
|
|
4012 |
|
|
LAB_1ED0
|
4013 |
|
|
INY ; index to dimension value high byte
|
4014 |
|
|
STA (Astrtl),Y ; save dimension value high byte
|
4015 |
|
|
INY ; index to dimension value high byte
|
4016 |
|
|
TXA ; get dimension value low byte
|
4017 |
|
|
STA (Astrtl),Y ; save dimension value low byte
|
4018 |
|
|
JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl)
|
4019 |
|
|
STX Asptl ; save array data size low byte
|
4020 |
|
|
STA Aspth ; save array data size high byte
|
4021 |
|
|
LDY ut1_pl ; restore index (saved by subroutine)
|
4022 |
|
|
DEC Dimcnt ; decrement dimensions count
|
4023 |
|
|
BNE LAB_1EC0 ; loop while not = 0
|
4024 |
|
|
|
4025 |
|
|
ADC Adatah ; add size high byte to first element high byte
|
4026 |
|
|
; (carry is always clear here)
|
4027 |
|
|
BCS LAB_1F45 ; if overflow go do "Out of memory" error
|
4028 |
|
|
|
4029 |
|
|
STA Adatah ; save end of array high byte
|
4030 |
|
|
TAY ; copy end high byte to Y
|
4031 |
|
|
TXA ; get array size low byte
|
4032 |
|
|
ADC Adatal ; add array start low byte
|
4033 |
|
|
BCC LAB_1EF3 ; branch if no carry
|
4034 |
|
|
|
4035 |
|
|
INY ; else increment end of array high byte
|
4036 |
|
|
BEQ LAB_1F45 ; if overflow go do "Out of memory" error
|
4037 |
|
|
|
4038 |
|
|
; set-up mostly complete, now zero the array
|
4039 |
|
|
LAB_1EF3
|
4040 |
|
|
JSR LAB_121F ; check available memory, "Out of memory" error if no room
|
4041 |
|
|
; addr to check is in AY (low/high)
|
4042 |
|
|
STA Earryl ; save array mem end low byte
|
4043 |
|
|
STY Earryh ; save array mem end high byte
|
4044 |
|
|
LDA #$00 ; clear byte for array clear
|
4045 |
|
|
INC Aspth ; increment array size high byte (now block count)
|
4046 |
|
|
LDY Asptl ; get array size low byte (now index to block)
|
4047 |
|
|
BEQ LAB_1F07 ; branch if low byte = $00
|
4048 |
|
|
message "LAB_1F02"
|
4049 |
|
|
LAB_1F02
|
4050 |
|
|
DEY ; decrement index (do 0 to n-1)
|
4051 |
|
|
STA (Adatal),Y ; zero byte
|
4052 |
|
|
BNE LAB_1F02 ; loop until this block done
|
4053 |
|
|
|
4054 |
|
|
LAB_1F07
|
4055 |
|
|
DEC Adatah ; decrement array pointer high byte
|
4056 |
|
|
DEC Aspth ; decrement block count high byte
|
4057 |
|
|
BNE LAB_1F02 ; loop until all blocks done
|
4058 |
|
|
|
4059 |
|
|
INC Adatah ; correct for last loop
|
4060 |
|
|
SEC ; set carry for subtract
|
4061 |
|
|
LDY #$02 ; index to array size low byte
|
4062 |
|
|
LDA Earryl ; get array mem end low byte
|
4063 |
|
|
SBC Astrtl ; subtract array start low byte
|
4064 |
|
|
STA (Astrtl),Y ; save array size low byte
|
4065 |
|
|
INY ; index to array size high byte
|
4066 |
|
|
LDA Earryh ; get array mem end high byte
|
4067 |
|
|
SBC Astrth ; subtract array start high byte
|
4068 |
|
|
STA (Astrtl),Y ; save array size high byte
|
4069 |
|
|
LDA Defdim ; get default DIM flag
|
4070 |
|
|
BNE LAB_1F7B ; exit (RET) if this was a DIM command
|
4071 |
|
|
|
4072 |
|
|
; else, find element
|
4073 |
|
|
INY ; index to # of dimensions
|
4074 |
|
|
|
4075 |
|
|
LAB_1F24
|
4076 |
|
|
LDA (Astrtl),Y ; get array's dimension count
|
4077 |
|
|
STA Dimcnt ; save it
|
4078 |
|
|
|
4079 |
|
|
; we have found, or built, the array. now we need to find the element
|
4080 |
|
|
|
4081 |
|
|
LAB_1F28
|
4082 |
|
|
LDA #$00 ; clear byte
|
4083 |
|
|
STA Asptl ; clear array data pointer low byte
|
4084 |
|
|
LAB_1F2C
|
4085 |
|
|
STA Aspth ; save array data pointer high byte
|
4086 |
|
|
INY ; increment index (point to array bound high byte)
|
4087 |
|
|
PLA ; pull array index low byte
|
4088 |
|
|
TAX ; copy to X
|
4089 |
|
|
STA FAC1_2 ; save index low byte to FAC1 mantissa2
|
4090 |
|
|
PLA ; pull array index high byte
|
4091 |
|
|
STA FAC1_3 ; save index high byte to FAC1 mantissa3
|
4092 |
|
|
CMP (Astrtl),Y ; compare with array bound high byte
|
4093 |
|
|
BCC LAB_1F48 ; branch if within bounds
|
4094 |
|
|
|
4095 |
|
|
BNE LAB_1F42 ; if outside bounds do array bounds error
|
4096 |
|
|
|
4097 |
|
|
; else high byte was = so test low bytes
|
4098 |
|
|
INY ; index to array bound low byte
|
4099 |
|
|
TXA ; get array index low byte
|
4100 |
|
|
CMP (Astrtl),Y ; compare with array bound low byte
|
4101 |
|
|
BCC LAB_1F49 ; branch if within bounds
|
4102 |
|
|
|
4103 |
|
|
LAB_1F42
|
4104 |
|
|
JMP LAB_1E85 ; else do array bounds error
|
4105 |
|
|
|
4106 |
|
|
LAB_1F45
|
4107 |
|
|
JMP LAB_OMER ; do "Out of memory" error then warm start
|
4108 |
|
|
|
4109 |
|
|
LAB_1F48
|
4110 |
|
|
INY ; index to array bound low byte
|
4111 |
|
|
LAB_1F49
|
4112 |
|
|
LDA Aspth ; get array data pointer high byte
|
4113 |
|
|
ORA Asptl ; OR with array data pointer low byte
|
4114 |
|
|
BEQ LAB_1F5A ; branch if array data pointer = null (skip multiply)
|
4115 |
|
|
|
4116 |
|
|
JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl)
|
4117 |
|
|
TXA ; get result low byte
|
4118 |
|
|
ADC FAC1_2 ; add index low byte from FAC1 mantissa2
|
4119 |
|
|
TAX ; save result low byte
|
4120 |
|
|
TYA ; get result high byte
|
4121 |
|
|
LDY ut1_pl ; restore index
|
4122 |
|
|
LAB_1F5A
|
4123 |
|
|
ADC FAC1_3 ; add index high byte from FAC1 mantissa3
|
4124 |
|
|
STX Asptl ; save array data pointer low byte
|
4125 |
|
|
DEC Dimcnt ; decrement dimensions count
|
4126 |
|
|
BNE LAB_1F2C ; loop if dimensions still to do
|
4127 |
|
|
|
4128 |
|
|
ASL Asptl ; array data pointer low byte * 2
|
4129 |
|
|
ROL ; array data pointer high byte * 2
|
4130 |
|
|
ASL Asptl ; array data pointer low byte * 4
|
4131 |
|
|
ROL ; array data pointer high byte * 4
|
4132 |
|
|
TAY ; copy high byte
|
4133 |
|
|
LDA Asptl ; get low byte
|
4134 |
|
|
ADC Adatal ; add array data start pointer low byte
|
4135 |
|
|
STA Cvaral ; save as current var address low byte
|
4136 |
|
|
TYA ; get high byte back
|
4137 |
|
|
ADC Adatah ; add array data start pointer high byte
|
4138 |
|
|
STA Cvarah ; save as current var address high byte
|
4139 |
|
|
TAY ; copy high byte to Y
|
4140 |
|
|
LDA Cvaral ; get current var address low byte
|
4141 |
|
|
LAB_1F7B
|
4142 |
|
|
RTS
|
4143 |
|
|
|
4144 |
|
|
; does XY = (Astrtl),Y * (Asptl)
|
4145 |
|
|
|
4146 |
|
|
LAB_1F7C
|
4147 |
|
|
STY ut1_pl ; save index
|
4148 |
|
|
LDA (Astrtl),Y ; get dimension size low byte
|
4149 |
|
|
STA dims_l ; save dimension size low byte
|
4150 |
|
|
DEY ; decrement index
|
4151 |
|
|
LDA (Astrtl),Y ; get dimension size high byte
|
4152 |
|
|
STA dims_h ; save dimension size high byte
|
4153 |
|
|
|
4154 |
|
|
LDA #$10 ; count = $10 (16 bit multiply)
|
4155 |
|
|
STA numbit ; save bit count
|
4156 |
|
|
LDX #$00 ; clear result low byte
|
4157 |
|
|
LDY #$00 ; clear result high byte
|
4158 |
|
|
LAB_1F8F
|
4159 |
|
|
TXA ; get result low byte
|
4160 |
|
|
ASL ; *2
|
4161 |
|
|
TAX ; save result low byte
|
4162 |
|
|
TYA ; get result high byte
|
4163 |
|
|
ROL ; *2
|
4164 |
|
|
TAY ; save result high byte
|
4165 |
|
|
BCS LAB_1F45 ; if overflow go do "Out of memory" error
|
4166 |
|
|
|
4167 |
|
|
ASL Asptl ; shift multiplier low byte
|
4168 |
|
|
ROL Aspth ; shift multiplier high byte
|
4169 |
|
|
BCC LAB_1FA8 ; skip add if no carry
|
4170 |
|
|
|
4171 |
|
|
CLC ; else clear carry for add
|
4172 |
|
|
TXA ; get result low byte
|
4173 |
|
|
ADC dims_l ; add dimension size low byte
|
4174 |
|
|
TAX ; save result low byte
|
4175 |
|
|
TYA ; get result high byte
|
4176 |
|
|
ADC dims_h ; add dimension size high byte
|
4177 |
|
|
TAY ; save result high byte
|
4178 |
|
|
BCS LAB_1F45 ; if overflow go do "Out of memory" error
|
4179 |
|
|
|
4180 |
|
|
LAB_1FA8
|
4181 |
|
|
DEC numbit ; decrement bit count
|
4182 |
|
|
BNE LAB_1F8F ; loop until all done
|
4183 |
|
|
|
4184 |
|
|
RTS
|
4185 |
|
|
|
4186 |
|
|
; perform FRE()
|
4187 |
|
|
|
4188 |
|
|
LAB_FRE
|
4189 |
|
|
LDA Dtypef ; get data type flag, $FF=string, $00=numeric
|
4190 |
|
|
BPL LAB_1FB4 ; branch if numeric
|
4191 |
|
|
|
4192 |
|
|
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string
|
4193 |
|
|
; space returns with A = length, X=$71=pointer low byte,
|
4194 |
|
|
; Y=$72=pointer high byte
|
4195 |
|
|
|
4196 |
|
|
; FRE(n) was numeric so do this
|
4197 |
|
|
LAB_1FB4
|
4198 |
|
|
JSR LAB_GARB ; go do garbage collection
|
4199 |
|
|
SEC ; set carry for subtract
|
4200 |
|
|
LDA Sstorl ; get bottom of string space low byte
|
4201 |
|
|
SBC Earryl ; subtract array mem end low byte
|
4202 |
|
|
TAY ; copy result to Y
|
4203 |
|
|
LDA Sstorh ; get bottom of string space high byte
|
4204 |
|
|
SBC Earryh ; subtract array mem end high byte
|
4205 |
|
|
|
4206 |
|
|
; save and convert integer AY to FAC1
|
4207 |
|
|
|
4208 |
|
|
LAB_AYFC
|
4209 |
|
|
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
|
4210 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
4211 |
|
|
STY FAC1_2 ; save FAC1 mantissa2
|
4212 |
|
|
LDX #$90 ; set exponent=2^16 (integer)
|
4213 |
|
|
JMP LAB_27E3 ; set exp=X, clear FAC1_3, normalise and return
|
4214 |
|
|
|
4215 |
|
|
; perform POS()
|
4216 |
|
|
|
4217 |
|
|
LAB_POS
|
4218 |
|
|
LDY TPos ; get terminal position
|
4219 |
|
|
|
4220 |
|
|
; convert Y to byte in FAC1
|
4221 |
|
|
|
4222 |
|
|
LAB_1FD0
|
4223 |
|
|
LDA #$00 ; clear high byte
|
4224 |
|
|
BEQ LAB_AYFC ; always save and convert integer AY to FAC1 and return
|
4225 |
|
|
|
4226 |
|
|
; check not Direct (used by DEF and INPUT)
|
4227 |
|
|
|
4228 |
|
|
LAB_CKRN
|
4229 |
|
|
LDX Clineh ; get current line high byte
|
4230 |
|
|
INX ; increment it
|
4231 |
|
|
BNE LAB_1F7B ; return if can continue not direct mode
|
4232 |
|
|
|
4233 |
|
|
; else do illegal direct error
|
4234 |
|
|
LAB_1FD9
|
4235 |
|
|
LDX #$16 ; error code $16 ("Illegal direct" error)
|
4236 |
|
|
LAB_1FDB
|
4237 |
|
|
JMP LAB_XERR ; go do error #X, then warm start
|
4238 |
|
|
|
4239 |
|
|
; perform DEF
|
4240 |
|
|
|
4241 |
|
|
LAB_DEF
|
4242 |
|
|
JSR LAB_200B ; check FNx syntax
|
4243 |
|
|
STA func_l ; save function pointer low byte
|
4244 |
|
|
STY func_h ; save function pointer high byte
|
4245 |
|
|
JSR LAB_CKRN ; check not Direct (back here if ok)
|
4246 |
|
|
JSR LAB_1BFE ; scan for "(" , else do syntax error then warm start
|
4247 |
|
|
LDA #$80 ; set flag for FNx
|
4248 |
|
|
STA Sufnxf ; save subscript/FNx flag
|
4249 |
|
|
JSR LAB_GVAR ; get (var) address
|
4250 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
4251 |
|
|
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
|
4252 |
|
|
LDA #TK_EQUAL ; get = token
|
4253 |
|
|
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
4254 |
|
|
LDA Cvarah ; get current var address high byte
|
4255 |
|
|
PHA ; push it
|
4256 |
|
|
LDA Cvaral ; get current var address low byte
|
4257 |
|
|
PHA ; push it
|
4258 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
4259 |
|
|
PHA ; push it
|
4260 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
4261 |
|
|
PHA ; push it
|
4262 |
|
|
JSR LAB_DATA ; go perform DATA
|
4263 |
|
|
JMP LAB_207A ; put execute pointer and variable pointer into function
|
4264 |
|
|
; and return
|
4265 |
|
|
|
4266 |
|
|
; check FNx syntax
|
4267 |
|
|
|
4268 |
|
|
LAB_200B
|
4269 |
|
|
LDA #TK_FN ; get FN" token
|
4270 |
|
|
JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start
|
4271 |
|
|
; return character after A
|
4272 |
|
|
ORA #$80 ; set FN flag bit
|
4273 |
|
|
STA Sufnxf ; save FN flag so array variable test fails
|
4274 |
|
|
JSR LAB_1D12 ; search for FN variable
|
4275 |
|
|
JMP LAB_CTNM ; check if source is numeric and return, else do type
|
4276 |
|
|
; mismatch
|
4277 |
|
|
|
4278 |
|
|
; Evaluate FNx
|
4279 |
|
|
LAB_201E
|
4280 |
|
|
JSR LAB_200B ; check FNx syntax
|
4281 |
|
|
PHA ; push function pointer low byte
|
4282 |
|
|
TYA ; copy function pointer high byte
|
4283 |
|
|
PHA ; push function pointer high byte
|
4284 |
|
|
JSR LAB_1BFE ; scan for "(", else do syntax error then warm start
|
4285 |
|
|
JSR LAB_EVEX ; evaluate expression
|
4286 |
|
|
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
|
4287 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
4288 |
|
|
PLA ; pop function pointer high byte
|
4289 |
|
|
STA func_h ; restore it
|
4290 |
|
|
PLA ; pop function pointer low byte
|
4291 |
|
|
STA func_l ; restore it
|
4292 |
|
|
LDX #$20 ; error code $20 ("Undefined function" error)
|
4293 |
|
|
LDY #$03 ; index to variable pointer high byte
|
4294 |
|
|
LDA (func_l),Y ; get variable pointer high byte
|
4295 |
|
|
BEQ LAB_1FDB ; if zero go do undefined function error
|
4296 |
|
|
|
4297 |
|
|
STA Cvarah ; save variable address high byte
|
4298 |
|
|
DEY ; index to variable address low byte
|
4299 |
|
|
LDA (func_l),Y ; get variable address low byte
|
4300 |
|
|
STA Cvaral ; save variable address low byte
|
4301 |
|
|
TAX ; copy address low byte
|
4302 |
|
|
|
4303 |
|
|
; now stack the function variable value before use
|
4304 |
|
|
INY ; index to mantissa_3
|
4305 |
|
|
LAB_2043
|
4306 |
|
|
LDA (Cvaral),Y ; get byte from variable
|
4307 |
|
|
PHA ; stack it
|
4308 |
|
|
DEY ; decrement index
|
4309 |
|
|
BPL LAB_2043 ; loop until variable stacked
|
4310 |
|
|
|
4311 |
|
|
LDY Cvarah ; get variable address high byte
|
4312 |
|
|
JSR LAB_2778 ; pack FAC1 (function expression value) into (XY)
|
4313 |
|
|
; (function variable), return Y=0, always
|
4314 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
4315 |
|
|
PHA ; push it
|
4316 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
4317 |
|
|
PHA ; push it
|
4318 |
|
|
LDA (func_l),Y ; get function execute pointer low byte
|
4319 |
|
|
STA Bpntrl ; save as BASIC execute pointer low byte
|
4320 |
|
|
INY ; index to high byte
|
4321 |
|
|
LDA (func_l),Y ; get function execute pointer high byte
|
4322 |
|
|
STA Bpntrh ; save as BASIC execute pointer high byte
|
4323 |
|
|
LDA Cvarah ; get variable address high byte
|
4324 |
|
|
PHA ; push it
|
4325 |
|
|
LDA Cvaral ; get variable address low byte
|
4326 |
|
|
PHA ; push it
|
4327 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
4328 |
|
|
; else do type mismatch
|
4329 |
|
|
PLA ; pull variable address low byte
|
4330 |
|
|
STA func_l ; save variable address low byte
|
4331 |
|
|
PLA ; pull variable address high byte
|
4332 |
|
|
STA func_h ; save variable address high byte
|
4333 |
|
|
JSR LAB_GBYT ; scan memory
|
4334 |
|
|
BEQ LAB_2074 ; branch if null (should be [EOL] marker)
|
4335 |
|
|
|
4336 |
|
|
JMP LAB_SNER ; else syntax error then warm start
|
4337 |
|
|
|
4338 |
|
|
; restore Bpntrl,Bpntrh and function variable from stack
|
4339 |
|
|
|
4340 |
|
|
LAB_2074
|
4341 |
|
|
PLA ; pull BASIC execute pointer low byte
|
4342 |
|
|
STA Bpntrl ; restore BASIC execute pointer low byte
|
4343 |
|
|
PLA ; pull BASIC execute pointer high byte
|
4344 |
|
|
STA Bpntrh ; restore BASIC execute pointer high byte
|
4345 |
|
|
|
4346 |
|
|
; put execute pointer and variable pointer into function
|
4347 |
|
|
|
4348 |
|
|
LAB_207A
|
4349 |
|
|
LDY #$00 ; clear index
|
4350 |
|
|
PLA ; pull BASIC execute pointer low byte
|
4351 |
|
|
STA (func_l),Y ; save to function
|
4352 |
|
|
INY ; increment index
|
4353 |
|
|
PLA ; pull BASIC execute pointer high byte
|
4354 |
|
|
STA (func_l),Y ; save to function
|
4355 |
|
|
INY ; increment index
|
4356 |
|
|
PLA ; pull current var address low byte
|
4357 |
|
|
STA (func_l),Y ; save to function
|
4358 |
|
|
INY ; increment index
|
4359 |
|
|
PLA ; pull current var address high byte
|
4360 |
|
|
STA (func_l),Y ; save to function
|
4361 |
|
|
RTS
|
4362 |
|
|
|
4363 |
|
|
; perform STR$()
|
4364 |
|
|
|
4365 |
|
|
LAB_STRS
|
4366 |
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
4367 |
|
|
JSR LAB_296E ; convert FAC1 to string
|
4368 |
|
|
LDA #
|
4369 |
|
|
LDY #>Decssp1 ; set result string high pointer
|
4370 |
|
|
BEQ LAB_20AE ; print null terminated string to Sutill/Sutilh
|
4371 |
|
|
|
4372 |
|
|
; Do string vector
|
4373 |
|
|
; copy des_pl/h to des_2l/h and make string space A bytes long
|
4374 |
|
|
|
4375 |
|
|
LAB_209C
|
4376 |
|
|
LDX des_pl ; get descriptor pointer low byte
|
4377 |
|
|
LDY des_ph ; get descriptor pointer high byte
|
4378 |
|
|
STX des_2l ; save descriptor pointer low byte
|
4379 |
|
|
STY des_2h ; save descriptor pointer high byte
|
4380 |
|
|
|
4381 |
|
|
; make string space A bytes long
|
4382 |
|
|
; A=length, X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
|
4383 |
|
|
|
4384 |
|
|
LAB_MSSP
|
4385 |
|
|
JSR LAB_2115 ; make space in string memory for string A long
|
4386 |
|
|
; return X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
|
4387 |
|
|
STX str_pl ; save string pointer low byte
|
4388 |
|
|
STY str_ph ; save string pointer high byte
|
4389 |
|
|
STA str_ln ; save length
|
4390 |
|
|
RTS
|
4391 |
|
|
|
4392 |
|
|
; Scan, set up string
|
4393 |
|
|
; print " terminated string to Sutill/Sutilh
|
4394 |
|
|
|
4395 |
|
|
LAB_20AE
|
4396 |
|
|
LDX #$22 ; set terminator to "
|
4397 |
|
|
STX Srchc ; set search character (terminator 1)
|
4398 |
|
|
STX Asrch ; set terminator 2
|
4399 |
|
|
|
4400 |
|
|
; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh
|
4401 |
|
|
; source is AY
|
4402 |
|
|
|
4403 |
|
|
LAB_20B4
|
4404 |
|
|
STA ssptr_l ; store string start low byte
|
4405 |
|
|
STY ssptr_h ; store string start high byte
|
4406 |
|
|
STA str_pl ; save string pointer low byte
|
4407 |
|
|
STY str_ph ; save string pointer high byte
|
4408 |
|
|
LDY #$FF ; set length to -1
|
4409 |
|
|
LAB_20BE
|
4410 |
|
|
INY ; increment length
|
4411 |
|
|
LDA (ssptr_l),Y ; get byte from string
|
4412 |
|
|
BEQ LAB_20CF ; exit loop if null byte [EOS]
|
4413 |
|
|
|
4414 |
|
|
CMP Srchc ; compare with search character (terminator 1)
|
4415 |
|
|
BEQ LAB_20CB ; branch if terminator
|
4416 |
|
|
|
4417 |
|
|
CMP Asrch ; compare with terminator 2
|
4418 |
|
|
BNE LAB_20BE ; loop if not terminator 2
|
4419 |
|
|
|
4420 |
|
|
LAB_20CB
|
4421 |
|
|
CMP #$22 ; compare with "
|
4422 |
|
|
BEQ LAB_20D0 ; branch if " (carry set if = !)
|
4423 |
|
|
|
4424 |
|
|
LAB_20CF
|
4425 |
|
|
CLC ; clear carry for add (only if [EOL] terminated string)
|
4426 |
|
|
LAB_20D0
|
4427 |
|
|
STY str_ln ; save length in FAC1 exponent
|
4428 |
|
|
TYA ; copy length to A
|
4429 |
|
|
ADC ssptr_l ; add string start low byte
|
4430 |
|
|
STA Sendl ; save string end low byte
|
4431 |
|
|
LDX ssptr_h ; get string start high byte
|
4432 |
|
|
BCC LAB_20DC ; branch if no low byte overflow
|
4433 |
|
|
|
4434 |
|
|
INX ; else increment high byte
|
4435 |
|
|
LAB_20DC
|
4436 |
|
|
STX Sendh ; save string end high byte
|
4437 |
|
|
LDA ssptr_h ; get string start high byte
|
4438 |
|
|
CMP #>Ram_base ; compare with start of program memory
|
4439 |
|
|
BCS LAB_RTST ; branch if not in utility area
|
4440 |
|
|
|
4441 |
|
|
; string in utility area, move to string memory
|
4442 |
|
|
TYA ; copy length to A
|
4443 |
|
|
JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes
|
4444 |
|
|
; long
|
4445 |
|
|
LDX ssptr_l ; get string start low byte
|
4446 |
|
|
LDY ssptr_h ; get string start high byte
|
4447 |
|
|
JSR LAB_2298 ; store string A bytes long from XY to (Sutill)
|
4448 |
|
|
|
4449 |
|
|
; check for space on descriptor stack then ..
|
4450 |
|
|
; put string address and length on descriptor stack and update stack pointers
|
4451 |
|
|
|
4452 |
|
|
LAB_RTST
|
4453 |
|
|
LDX next_s ; get string stack pointer
|
4454 |
|
|
CPX #des_sk+$09 ; compare with max+1
|
4455 |
|
|
BNE LAB_20F8 ; branch if space on string stack
|
4456 |
|
|
|
4457 |
|
|
; else do string too complex error
|
4458 |
|
|
LDX #$1C ; error code $1C ("String too complex" error)
|
4459 |
|
|
LAB_20F5
|
4460 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
4461 |
|
|
|
4462 |
|
|
; put string address and length on descriptor stack and update stack pointers
|
4463 |
|
|
|
4464 |
|
|
LAB_20F8
|
4465 |
|
|
LDA str_ln ; get string length
|
4466 |
|
|
STA PLUS_0,X ; put on string stack
|
4467 |
|
|
LDA str_pl ; get string pointer low byte
|
4468 |
|
|
STA PLUS_1,X ; put on string stack
|
4469 |
|
|
LDA str_ph ; get string pointer high byte
|
4470 |
|
|
STA PLUS_2,X ; put on string stack
|
4471 |
|
|
LDY #$00 ; clear Y
|
4472 |
|
|
STX des_pl ; save string descriptor pointer low byte
|
4473 |
|
|
STY des_ph ; save string descriptor pointer high byte (always $00)
|
4474 |
|
|
DEY ; Y = $FF
|
4475 |
|
|
STY Dtypef ; save data type flag, $FF=string
|
4476 |
|
|
STX last_sl ; save old stack pointer (current top item)
|
4477 |
|
|
INX ; update stack pointer
|
4478 |
|
|
INX ; update stack pointer
|
4479 |
|
|
INX ; update stack pointer
|
4480 |
|
|
STX next_s ; save new top item value
|
4481 |
|
|
RTS
|
4482 |
|
|
|
4483 |
|
|
; Build descriptor
|
4484 |
|
|
; make space in string memory for string A long
|
4485 |
|
|
; return X=Sutill=ptr low byte, Y=Sutill=ptr high byte
|
4486 |
|
|
|
4487 |
|
|
LAB_2115
|
4488 |
|
|
LSR Gclctd ; clear garbage collected flag (b7)
|
4489 |
|
|
|
4490 |
|
|
; make space for string A long
|
4491 |
|
|
LAB_2117
|
4492 |
|
|
PHA ; save string length
|
4493 |
|
|
EOR #$FF ; complement it
|
4494 |
|
|
SEC ; set carry for subtract (twos comp add)
|
4495 |
|
|
ADC Sstorl ; add bottom of string space low byte (subtract length)
|
4496 |
|
|
LDY Sstorh ; get bottom of string space high byte
|
4497 |
|
|
BCS LAB_2122 ; skip decrement if no underflow
|
4498 |
|
|
|
4499 |
|
|
DEY ; decrement bottom of string space high byte
|
4500 |
|
|
LAB_2122
|
4501 |
|
|
CPY Earryh ; compare with array mem end high byte
|
4502 |
|
|
BCC LAB_2137 ; do out of memory error if less
|
4503 |
|
|
|
4504 |
|
|
BNE LAB_212C ; if not = skip next test
|
4505 |
|
|
|
4506 |
|
|
CMP Earryl ; compare with array mem end low byte
|
4507 |
|
|
BCC LAB_2137 ; do out of memory error if less
|
4508 |
|
|
|
4509 |
|
|
LAB_212C
|
4510 |
|
|
STA Sstorl ; save bottom of string space low byte
|
4511 |
|
|
STY Sstorh ; save bottom of string space high byte
|
4512 |
|
|
STA Sutill ; save string utility ptr low byte
|
4513 |
|
|
STY Sutilh ; save string utility ptr high byte
|
4514 |
|
|
TAX ; copy low byte to X
|
4515 |
|
|
PLA ; get string length back
|
4516 |
|
|
RTS
|
4517 |
|
|
|
4518 |
|
|
LAB_2137
|
4519 |
|
|
LDX #$0C ; error code $0C ("Out of memory" error)
|
4520 |
|
|
LDA Gclctd ; get garbage collected flag
|
4521 |
|
|
BMI LAB_20F5 ; if set then do error code X
|
4522 |
|
|
|
4523 |
|
|
JSR LAB_GARB ; else go do garbage collection
|
4524 |
|
|
LDA #$80 ; flag for garbage collected
|
4525 |
|
|
STA Gclctd ; set garbage collected flag
|
4526 |
|
|
PLA ; pull length
|
4527 |
|
|
BNE LAB_2117 ; go try again (loop always, length should never be = $00)
|
4528 |
|
|
|
4529 |
|
|
; garbage collection routine
|
4530 |
|
|
|
4531 |
|
|
LAB_GARB
|
4532 |
|
|
LDX Ememl ; get end of mem low byte
|
4533 |
|
|
LDA Ememh ; get end of mem high byte
|
4534 |
|
|
|
4535 |
|
|
; re-run routine from last ending
|
4536 |
|
|
|
4537 |
|
|
LAB_214B
|
4538 |
|
|
STX Sstorl ; set string storage low byte
|
4539 |
|
|
STA Sstorh ; set string storage high byte
|
4540 |
|
|
LDY #$00 ; clear index
|
4541 |
|
|
STY garb_h ; clear working pointer high byte (flag no strings to move)
|
4542 |
|
|
LDA Earryl ; get array mem end low byte
|
4543 |
|
|
LDX Earryh ; get array mem end high byte
|
4544 |
|
|
STA Histrl ; save as highest string low byte
|
4545 |
|
|
STX Histrh ; save as highest string high byte
|
4546 |
|
|
LDA #des_sk ; set descriptor stack pointer
|
4547 |
|
|
STA ut1_pl ; save descriptor stack pointer low byte
|
4548 |
|
|
STY ut1_ph ; save descriptor stack pointer high byte ($00)
|
4549 |
|
|
LAB_2161
|
4550 |
|
|
CMP next_s ; compare with descriptor stack pointer
|
4551 |
|
|
BEQ LAB_216A ; branch if =
|
4552 |
|
|
|
4553 |
|
|
JSR LAB_21D7 ; go garbage collect descriptor stack
|
4554 |
|
|
BEQ LAB_2161 ; loop always
|
4555 |
|
|
|
4556 |
|
|
; done stacked strings, now do string vars
|
4557 |
|
|
LAB_216A
|
4558 |
|
|
ASL g_step ; set step size = $06
|
4559 |
|
|
LDA Svarl ; get start of vars low byte
|
4560 |
|
|
LDX Svarh ; get start of vars high byte
|
4561 |
|
|
STA ut1_pl ; save as pointer low byte
|
4562 |
|
|
STX ut1_ph ; save as pointer high byte
|
4563 |
|
|
LAB_2176
|
4564 |
|
|
CPX Sarryh ; compare start of arrays high byte
|
4565 |
|
|
BNE LAB_217E ; branch if no high byte match
|
4566 |
|
|
|
4567 |
|
|
CMP Sarryl ; else compare start of arrays low byte
|
4568 |
|
|
BEQ LAB_2183 ; branch if = var mem end
|
4569 |
|
|
|
4570 |
|
|
LAB_217E
|
4571 |
|
|
JSR LAB_21D1 ; go garbage collect strings
|
4572 |
|
|
BEQ LAB_2176 ; loop always
|
4573 |
|
|
|
4574 |
|
|
; done string vars, now do string arrays
|
4575 |
|
|
LAB_2183
|
4576 |
|
|
STA Nbendl ; save start of arrays low byte as working pointer
|
4577 |
|
|
STX Nbendh ; save start of arrays high byte as working pointer
|
4578 |
|
|
LDA #$04 ; set step size
|
4579 |
|
|
STA g_step ; save step size
|
4580 |
|
|
LAB_218B
|
4581 |
|
|
LDA Nbendl ; get pointer low byte
|
4582 |
|
|
LDX Nbendh ; get pointer high byte
|
4583 |
|
|
LAB_218F
|
4584 |
|
|
CPX Earryh ; compare with array mem end high byte
|
4585 |
|
|
BNE LAB_219A ; branch if not at end
|
4586 |
|
|
|
4587 |
|
|
CMP Earryl ; else compare with array mem end low byte
|
4588 |
|
|
BEQ LAB_2216 ; tidy up and exit if at end
|
4589 |
|
|
|
4590 |
|
|
LAB_219A
|
4591 |
|
|
STA ut1_pl ; save pointer low byte
|
4592 |
|
|
STX ut1_ph ; save pointer high byte
|
4593 |
|
|
LDY #$02 ; set index
|
4594 |
|
|
LDA (ut1_pl),Y ; get array size low byte
|
4595 |
|
|
ADC Nbendl ; add start of this array low byte
|
4596 |
|
|
STA Nbendl ; save start of next array low byte
|
4597 |
|
|
INY ; increment index
|
4598 |
|
|
LDA (ut1_pl),Y ; get array size high byte
|
4599 |
|
|
ADC Nbendh ; add start of this array high byte
|
4600 |
|
|
STA Nbendh ; save start of next array high byte
|
4601 |
|
|
LDY #$01 ; set index
|
4602 |
|
|
LDA (ut1_pl),Y ; get name second byte
|
4603 |
|
|
BPL LAB_218B ; skip if not string array
|
4604 |
|
|
|
4605 |
|
|
; was string array so ..
|
4606 |
|
|
|
4607 |
|
|
LDY #$04 ; set index
|
4608 |
|
|
LDA (ut1_pl),Y ; get # of dimensions
|
4609 |
|
|
ASL ; *2
|
4610 |
|
|
ADC #$05 ; +5 (array header size)
|
4611 |
|
|
JSR LAB_2208 ; go set up for first element
|
4612 |
|
|
LAB_21C4
|
4613 |
|
|
CPX Nbendh ; compare with start of next array high byte
|
4614 |
|
|
BNE LAB_21CC ; branch if <> (go do this array)
|
4615 |
|
|
|
4616 |
|
|
CMP Nbendl ; else compare element pointer low byte with next array
|
4617 |
|
|
; low byte
|
4618 |
|
|
BEQ LAB_218F ; if equal then go do next array
|
4619 |
|
|
|
4620 |
|
|
LAB_21CC
|
4621 |
|
|
JSR LAB_21D7 ; go defrag array strings
|
4622 |
|
|
BEQ LAB_21C4 ; go do next array string (loop always)
|
4623 |
|
|
|
4624 |
|
|
; defrag string variables
|
4625 |
|
|
; enter with XA = variable pointer
|
4626 |
|
|
; return with XA = next variable pointer
|
4627 |
|
|
|
4628 |
|
|
LAB_21D1
|
4629 |
|
|
INY ; increment index (Y was $00)
|
4630 |
|
|
LDA (ut1_pl),Y ; get var name byte 2
|
4631 |
|
|
BPL LAB_2206 ; if not string, step pointer to next var and return
|
4632 |
|
|
|
4633 |
|
|
INY ; else increment index
|
4634 |
|
|
LAB_21D7
|
4635 |
|
|
LDA (ut1_pl),Y ; get string length
|
4636 |
|
|
BEQ LAB_2206 ; if null, step pointer to next string and return
|
4637 |
|
|
|
4638 |
|
|
INY ; else increment index
|
4639 |
|
|
LDA (ut1_pl),Y ; get string pointer low byte
|
4640 |
|
|
TAX ; copy to X
|
4641 |
|
|
INY ; increment index
|
4642 |
|
|
LDA (ut1_pl),Y ; get string pointer high byte
|
4643 |
|
|
CMP Sstorh ; compare bottom of string space high byte
|
4644 |
|
|
BCC LAB_21EC ; branch if less
|
4645 |
|
|
|
4646 |
|
|
BNE LAB_2206 ; if greater, step pointer to next string and return
|
4647 |
|
|
|
4648 |
|
|
; high bytes were = so compare low bytes
|
4649 |
|
|
CPX Sstorl ; compare bottom of string space low byte
|
4650 |
|
|
BCS LAB_2206 ; if >=, step pointer to next string and return
|
4651 |
|
|
|
4652 |
|
|
; string pointer is < string storage pointer (pos in mem)
|
4653 |
|
|
LAB_21EC
|
4654 |
|
|
CMP Histrh ; compare to highest string high byte
|
4655 |
|
|
BCC LAB_2207 ; if <, step pointer to next string and return
|
4656 |
|
|
|
4657 |
|
|
BNE LAB_21F6 ; if > update pointers, step to next and return
|
4658 |
|
|
|
4659 |
|
|
; high bytes were = so compare low bytes
|
4660 |
|
|
CPX Histrl ; compare to highest string low byte
|
4661 |
|
|
BCC LAB_2207 ; if <, step pointer to next string and return
|
4662 |
|
|
|
4663 |
|
|
; string is in string memory space
|
4664 |
|
|
LAB_21F6
|
4665 |
|
|
STX Histrl ; save as new highest string low byte
|
4666 |
|
|
STA Histrh ; save as new highest string high byte
|
4667 |
|
|
LDA ut1_pl ; get start of vars(descriptors) low byte
|
4668 |
|
|
LDX ut1_ph ; get start of vars(descriptors) high byte
|
4669 |
|
|
STA garb_l ; save as working pointer low byte
|
4670 |
|
|
STX garb_h ; save as working pointer high byte
|
4671 |
|
|
DEY ; decrement index DIFFERS
|
4672 |
|
|
DEY ; decrement index (should point to descriptor start)
|
4673 |
|
|
STY g_indx ; save index pointer
|
4674 |
|
|
|
4675 |
|
|
; step pointer to next string
|
4676 |
|
|
LAB_2206
|
4677 |
|
|
CLC ; clear carry for add
|
4678 |
|
|
LAB_2207
|
4679 |
|
|
LDA g_step ; get step size
|
4680 |
|
|
LAB_2208
|
4681 |
|
|
ADC ut1_pl ; add pointer low byte
|
4682 |
|
|
STA ut1_pl ; save pointer low byte
|
4683 |
|
|
BCC LAB_2211 ; branch if no overflow
|
4684 |
|
|
|
4685 |
|
|
INC ut1_ph ; else increment high byte
|
4686 |
|
|
LAB_2211
|
4687 |
|
|
LDX ut1_ph ; get pointer high byte
|
4688 |
|
|
LDY #$00 ; clear Y
|
4689 |
|
|
RTS
|
4690 |
|
|
|
4691 |
|
|
; search complete, now either exit or set-up and move string
|
4692 |
|
|
|
4693 |
|
|
LAB_2216
|
4694 |
|
|
DEC g_step ; decrement step size (now $03 for descriptor stack)
|
4695 |
|
|
LDX garb_h ; get string to move high byte
|
4696 |
|
|
BEQ LAB_2211 ; exit if nothing to move
|
4697 |
|
|
|
4698 |
|
|
LDY g_indx ; get index byte back (points to descriptor)
|
4699 |
|
|
CLC ; clear carry for add
|
4700 |
|
|
LDA (garb_l),Y ; get string length
|
4701 |
|
|
ADC Histrl ; add highest string low byte
|
4702 |
|
|
STA Obendl ; save old block end low pointer
|
4703 |
|
|
LDA Histrh ; get highest string high byte
|
4704 |
|
|
ADC #$00 ; add any carry
|
4705 |
|
|
STA Obendh ; save old block end high byte
|
4706 |
|
|
LDA Sstorl ; get bottom of string space low byte
|
4707 |
|
|
LDX Sstorh ; get bottom of string space high byte
|
4708 |
|
|
STA Nbendl ; save new block end low byte
|
4709 |
|
|
STX Nbendh ; save new block end high byte
|
4710 |
|
|
JSR LAB_11D6 ; open up space in memory, don't set array end
|
4711 |
|
|
LDY g_indx ; get index byte
|
4712 |
|
|
INY ; point to descriptor low byte
|
4713 |
|
|
LDA Nbendl ; get string pointer low byte
|
4714 |
|
|
STA (garb_l),Y ; save new string pointer low byte
|
4715 |
|
|
TAX ; copy string pointer low byte
|
4716 |
|
|
INC Nbendh ; correct high byte (move sets high byte -1)
|
4717 |
|
|
LDA Nbendh ; get new string pointer high byte
|
4718 |
|
|
INY ; point to descriptor high byte
|
4719 |
|
|
STA (garb_l),Y ; save new string pointer high byte
|
4720 |
|
|
JMP LAB_214B ; re-run routine from last ending
|
4721 |
|
|
; (but don't collect this string)
|
4722 |
|
|
|
4723 |
|
|
; concatenate
|
4724 |
|
|
; add strings, string 1 is in descriptor des_pl, string 2 is in line
|
4725 |
|
|
|
4726 |
|
|
LAB_224D
|
4727 |
|
|
LDA des_ph ; get descriptor pointer high byte
|
4728 |
|
|
PHA ; put on stack
|
4729 |
|
|
LDA des_pl ; get descriptor pointer low byte
|
4730 |
|
|
PHA ; put on stack
|
4731 |
|
|
JSR LAB_GVAL ; get value from line
|
4732 |
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
4733 |
|
|
PLA ; get descriptor pointer low byte back
|
4734 |
|
|
STA ssptr_l ; set pointer low byte
|
4735 |
|
|
PLA ; get descriptor pointer high byte back
|
4736 |
|
|
STA ssptr_h ; set pointer high byte
|
4737 |
|
|
LDY #$00 ; clear index
|
4738 |
|
|
LDA (ssptr_l),Y ; get length_1 from descriptor
|
4739 |
|
|
CLC ; clear carry for add
|
4740 |
|
|
ADC (des_pl),Y ; add length_2
|
4741 |
|
|
BCC LAB_226D ; branch if no overflow
|
4742 |
|
|
|
4743 |
|
|
LDX #$1A ; else set error code $1A ("String too long" error)
|
4744 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
4745 |
|
|
|
4746 |
|
|
LAB_226D
|
4747 |
|
|
JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes
|
4748 |
|
|
; long
|
4749 |
|
|
JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill)
|
4750 |
|
|
LDA des_2l ; get descriptor pointer low byte
|
4751 |
|
|
LDY des_2h ; get descriptor pointer high byte
|
4752 |
|
|
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
|
4753 |
|
|
; returns with A = length, ut1_pl = pointer low byte,
|
4754 |
|
|
; ut1_ph = pointer high byte
|
4755 |
|
|
JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill)
|
4756 |
|
|
LDA ssptr_l ;.set descriptor pointer low byte
|
4757 |
|
|
LDY ssptr_h ;.set descriptor pointer high byte
|
4758 |
|
|
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
|
4759 |
|
|
; returns with A = length, X=ut1_pl=pointer low byte,
|
4760 |
|
|
; Y=ut1_ph=pointer high byte
|
4761 |
|
|
JSR LAB_RTST ; check for space on descriptor stack then put string
|
4762 |
|
|
; address and length on descriptor stack and update stack
|
4763 |
|
|
; pointers
|
4764 |
|
|
JMP LAB_1ADB ;.continue evaluation
|
4765 |
|
|
|
4766 |
|
|
; copy string from descriptor (sdescr) to (Sutill)
|
4767 |
|
|
|
4768 |
|
|
LAB_228A
|
4769 |
|
|
LDY #$00 ; clear index
|
4770 |
|
|
LDA (sdescr),Y ; get string length
|
4771 |
|
|
PHA ; save on stack
|
4772 |
|
|
INY ; increment index
|
4773 |
|
|
LDA (sdescr),Y ; get source string pointer low byte
|
4774 |
|
|
TAX ; copy to X
|
4775 |
|
|
INY ; increment index
|
4776 |
|
|
LDA (sdescr),Y ; get source string pointer high byte
|
4777 |
|
|
TAY ; copy to Y
|
4778 |
|
|
PLA ; get length back
|
4779 |
|
|
|
4780 |
|
|
; store string A bytes long from YX to (Sutill)
|
4781 |
|
|
|
4782 |
|
|
LAB_2298
|
4783 |
|
|
STX ut1_pl ; save source string pointer low byte
|
4784 |
|
|
STY ut1_ph ; save source string pointer high byte
|
4785 |
|
|
|
4786 |
|
|
; store string A bytes long from (ut1_pl) to (Sutill)
|
4787 |
|
|
|
4788 |
|
|
LAB_229C
|
4789 |
|
|
TAX ; copy length to index (don't count with Y)
|
4790 |
|
|
BEQ LAB_22B2 ; branch if = $0 (null string) no need to add zero length
|
4791 |
|
|
|
4792 |
|
|
LDY #$00 ; zero pointer (copy forward)
|
4793 |
|
|
LAB_22A0
|
4794 |
|
|
LDA (ut1_pl),Y ; get source byte
|
4795 |
|
|
STA (Sutill),Y ; save destination byte
|
4796 |
|
|
|
4797 |
|
|
INY ; increment index
|
4798 |
|
|
DEX ; decrement counter
|
4799 |
|
|
BNE LAB_22A0 ; loop while <> 0
|
4800 |
|
|
|
4801 |
|
|
TYA ; restore length from Y
|
4802 |
|
|
LAB_22A9
|
4803 |
|
|
CLC ; clear carry for add
|
4804 |
|
|
ADC Sutill ; add string utility ptr low byte
|
4805 |
|
|
STA Sutill ; save string utility ptr low byte
|
4806 |
|
|
BCC LAB_22B2 ; branch if no carry
|
4807 |
|
|
|
4808 |
|
|
INC Sutilh ; else increment string utility ptr high byte
|
4809 |
|
|
LAB_22B2
|
4810 |
|
|
RTS
|
4811 |
|
|
|
4812 |
|
|
; evaluate string
|
4813 |
|
|
|
4814 |
|
|
LAB_EVST
|
4815 |
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
4816 |
|
|
|
4817 |
|
|
; pop string off descriptor stack, or from top of string space
|
4818 |
|
|
; returns with A = length, X=pointer low byte, Y=pointer high byte
|
4819 |
|
|
|
4820 |
|
|
LAB_22B6
|
4821 |
|
|
LDA des_pl ; get descriptor pointer low byte
|
4822 |
|
|
LDY des_ph ; get descriptor pointer high byte
|
4823 |
|
|
|
4824 |
|
|
; pop (YA) descriptor off stack or from top of string space
|
4825 |
|
|
; returns with A = length, X=ut1_pl=pointer low byte, Y=ut1_ph=pointer high byte
|
4826 |
|
|
|
4827 |
|
|
LAB_22BA
|
4828 |
|
|
STA ut1_pl ; save descriptor pointer low byte
|
4829 |
|
|
STY ut1_ph ; save descriptor pointer high byte
|
4830 |
|
|
JSR LAB_22EB ; clean descriptor stack, YA = pointer
|
4831 |
|
|
PHP ; save status flags
|
4832 |
|
|
LDY #$00 ; clear index
|
4833 |
|
|
LDA (ut1_pl),Y ; get length from string descriptor
|
4834 |
|
|
PHA ; put on stack
|
4835 |
|
|
INY ; increment index
|
4836 |
|
|
LDA (ut1_pl),Y ; get string pointer low byte from descriptor
|
4837 |
|
|
TAX ; copy to X
|
4838 |
|
|
INY ; increment index
|
4839 |
|
|
LDA (ut1_pl),Y ; get string pointer high byte from descriptor
|
4840 |
|
|
TAY ; copy to Y
|
4841 |
|
|
PLA ; get string length back
|
4842 |
|
|
PLP ; restore status
|
4843 |
|
|
BNE LAB_22E6 ; branch if pointer <> last_sl,last_sh
|
4844 |
|
|
|
4845 |
|
|
CPY Sstorh ; compare bottom of string space high byte
|
4846 |
|
|
BNE LAB_22E6 ; branch if <>
|
4847 |
|
|
|
4848 |
|
|
CPX Sstorl ; else compare bottom of string space low byte
|
4849 |
|
|
BNE LAB_22E6 ; branch if <>
|
4850 |
|
|
|
4851 |
|
|
PHA ; save string length
|
4852 |
|
|
CLC ; clear carry for add
|
4853 |
|
|
ADC Sstorl ; add bottom of string space low byte
|
4854 |
|
|
STA Sstorl ; save bottom of string space low byte
|
4855 |
|
|
BCC LAB_22E5 ; skip increment if no overflow
|
4856 |
|
|
|
4857 |
|
|
INC Sstorh ; increment bottom of string space high byte
|
4858 |
|
|
LAB_22E5
|
4859 |
|
|
PLA ; restore string length
|
4860 |
|
|
LAB_22E6
|
4861 |
|
|
STX ut1_pl ; save string pointer low byte
|
4862 |
|
|
STY ut1_ph ; save string pointer high byte
|
4863 |
|
|
RTS
|
4864 |
|
|
|
4865 |
|
|
; clean descriptor stack, YA = pointer
|
4866 |
|
|
; checks if AY is on the descriptor stack, if so does a stack discard
|
4867 |
|
|
|
4868 |
|
|
LAB_22EB
|
4869 |
|
|
CPY last_sh ; compare pointer high byte
|
4870 |
|
|
BNE LAB_22FB ; exit if <>
|
4871 |
|
|
|
4872 |
|
|
CMP last_sl ; compare pointer low byte
|
4873 |
|
|
BNE LAB_22FB ; exit if <>
|
4874 |
|
|
|
4875 |
|
|
STA next_s ; save descriptor stack pointer
|
4876 |
|
|
SBC #$03 ; -3
|
4877 |
|
|
STA last_sl ; save low byte -3
|
4878 |
|
|
LDY #$00 ; clear high byte
|
4879 |
|
|
LAB_22FB
|
4880 |
|
|
RTS
|
4881 |
|
|
|
4882 |
|
|
; perform CHR$()
|
4883 |
|
|
|
4884 |
|
|
LAB_CHRS
|
4885 |
|
|
JSR LAB_EVBY ; evaluate byte expression, result in X
|
4886 |
|
|
TXA ; copy to A
|
4887 |
|
|
PHA ; save character
|
4888 |
|
|
LDA #$01 ; string is single byte
|
4889 |
|
|
JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
|
4890 |
|
|
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
|
4891 |
|
|
PLA ; get character back
|
4892 |
|
|
LDY #$00 ; clear index
|
4893 |
|
|
STA (str_pl),Y ; save byte in string (byte IS string!)
|
4894 |
|
|
JMP LAB_RTST ; check for space on descriptor stack then put string
|
4895 |
|
|
; address and length on descriptor stack and update stack
|
4896 |
|
|
; pointers
|
4897 |
|
|
|
4898 |
|
|
; perform LEFT$()
|
4899 |
|
|
|
4900 |
|
|
LAB_LEFT
|
4901 |
|
|
PHA ; push byte parameter
|
4902 |
|
|
JSR LAB_236F ; pull string data and byte parameter from stack
|
4903 |
|
|
; return pointer in des_2l/h, byte in A (and X), Y=0
|
4904 |
|
|
CMP (des_2l),Y ; compare byte parameter with string length
|
4905 |
|
|
TYA ; clear A
|
4906 |
|
|
BEQ LAB_2316 ; go do string copy (branch always)
|
4907 |
|
|
|
4908 |
|
|
; perform RIGHT$()
|
4909 |
|
|
|
4910 |
|
|
LAB_RIGHT
|
4911 |
|
|
PHA ; push byte parameter
|
4912 |
|
|
JSR LAB_236F ; pull string data and byte parameter from stack
|
4913 |
|
|
; return pointer in des_2l/h, byte in A (and X), Y=0
|
4914 |
|
|
CLC ; clear carry for add-1
|
4915 |
|
|
SBC (des_2l),Y ; subtract string length
|
4916 |
|
|
EOR #$FF ; invert it (A=LEN(expression$)-l)
|
4917 |
|
|
|
4918 |
|
|
LAB_2316
|
4919 |
|
|
BCC LAB_231C ; branch if string length > byte parameter
|
4920 |
|
|
|
4921 |
|
|
LDA (des_2l),Y ; else make parameter = length
|
4922 |
|
|
TAX ; copy to byte parameter copy
|
4923 |
|
|
TYA ; clear string start offset
|
4924 |
|
|
LAB_231C
|
4925 |
|
|
PHA ; save string start offset
|
4926 |
|
|
LAB_231D
|
4927 |
|
|
TXA ; copy byte parameter (or string length if <)
|
4928 |
|
|
LAB_231E
|
4929 |
|
|
PHA ; save string length
|
4930 |
|
|
JSR LAB_MSSP ; make string space A bytes long A=$AC=length,
|
4931 |
|
|
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
|
4932 |
|
|
LDA des_2l ; get descriptor pointer low byte
|
4933 |
|
|
LDY des_2h ; get descriptor pointer high byte
|
4934 |
|
|
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space
|
4935 |
|
|
; returns with A = length, X=ut1_pl=pointer low byte,
|
4936 |
|
|
; Y=ut1_ph=pointer high byte
|
4937 |
|
|
PLA ; get string length back
|
4938 |
|
|
TAY ; copy length to Y
|
4939 |
|
|
PLA ; get string start offset back
|
4940 |
|
|
CLC ; clear carry for add
|
4941 |
|
|
ADC ut1_pl ; add start offset to string start pointer low byte
|
4942 |
|
|
STA ut1_pl ; save string start pointer low byte
|
4943 |
|
|
BCC LAB_2335 ; branch if no overflow
|
4944 |
|
|
|
4945 |
|
|
INC ut1_ph ; else increment string start pointer high byte
|
4946 |
|
|
LAB_2335
|
4947 |
|
|
TYA ; copy length to A
|
4948 |
|
|
JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill)
|
4949 |
|
|
JMP LAB_RTST ; check for space on descriptor stack then put string
|
4950 |
|
|
; address and length on descriptor stack and update stack
|
4951 |
|
|
; pointers
|
4952 |
|
|
|
4953 |
|
|
; perform MID$()
|
4954 |
|
|
|
4955 |
|
|
LAB_MIDS
|
4956 |
|
|
PHA ; push byte parameter
|
4957 |
|
|
LDA #$FF ; set default length = 255
|
4958 |
|
|
STA mids_l ; save default length
|
4959 |
|
|
JSR LAB_GBYT ; scan memory
|
4960 |
|
|
CMP #')' ; compare with ")"
|
4961 |
|
|
BEQ LAB_2358 ; branch if = ")" (skip second byte get)
|
4962 |
|
|
|
4963 |
|
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
|
4964 |
|
|
JSR LAB_GTBY ; get byte parameter (use copy in mids_l)
|
4965 |
|
|
LAB_2358
|
4966 |
|
|
JSR LAB_236F ; pull string data and byte parameter from stack
|
4967 |
|
|
; return pointer in des_2l/h, byte in A (and X), Y=0
|
4968 |
|
|
DEX ; decrement start index
|
4969 |
|
|
TXA ; copy to A
|
4970 |
|
|
PHA ; save string start offset
|
4971 |
|
|
CLC ; clear carry for sub-1
|
4972 |
|
|
LDX #$00 ; clear output string length
|
4973 |
|
|
SBC (des_2l),Y ; subtract string length
|
4974 |
|
|
BCS LAB_231D ; if start>string length go do null string
|
4975 |
|
|
|
4976 |
|
|
EOR #$FF ; complement -length
|
4977 |
|
|
CMP mids_l ; compare byte parameter
|
4978 |
|
|
BCC LAB_231E ; if length>remaining string go do RIGHT$
|
4979 |
|
|
|
4980 |
|
|
LDA mids_l ; get length byte
|
4981 |
|
|
BCS LAB_231E ; go do string copy (branch always)
|
4982 |
|
|
|
4983 |
|
|
; pull string data and byte parameter from stack
|
4984 |
|
|
; return pointer in des_2l/h, byte in A (and X), Y=0
|
4985 |
|
|
|
4986 |
|
|
LAB_236F
|
4987 |
|
|
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
|
4988 |
|
|
PLA ; pull return address low byte (return address)
|
4989 |
|
|
STA Fnxjpl ; save functions jump vector low byte
|
4990 |
|
|
PLA ; pull return address high byte (return address)
|
4991 |
|
|
STA Fnxjph ; save functions jump vector high byte
|
4992 |
|
|
PLA ; pull byte parameter
|
4993 |
|
|
TAX ; copy byte parameter to X
|
4994 |
|
|
PLA ; pull string pointer low byte
|
4995 |
|
|
STA des_2l ; save it
|
4996 |
|
|
PLA ; pull string pointer high byte
|
4997 |
|
|
STA des_2h ; save it
|
4998 |
|
|
LDY #$00 ; clear index
|
4999 |
|
|
TXA ; copy byte parameter
|
5000 |
|
|
BEQ LAB_23A8 ; if null do function call error then warm start
|
5001 |
|
|
|
5002 |
|
|
INC Fnxjpl ; increment function jump vector low byte
|
5003 |
|
|
; (JSR pushes return addr-1. this is all very nice
|
5004 |
|
|
; but will go tits up if either call is on a page
|
5005 |
|
|
; boundary!)
|
5006 |
|
|
JMP (Fnxjpl) ; in effect, RTS
|
5007 |
|
|
|
5008 |
|
|
; perform LCASE$()
|
5009 |
|
|
|
5010 |
|
|
LAB_LCASE
|
5011 |
|
|
JSR LAB_EVST ; evaluate string
|
5012 |
|
|
STA str_ln ; set string length
|
5013 |
|
|
TAY ; copy length to Y
|
5014 |
|
|
BEQ NoString ; branch if null string
|
5015 |
|
|
|
5016 |
|
|
JSR LAB_MSSP ; make string space A bytes long A=length,
|
5017 |
|
|
; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
|
5018 |
|
|
STX str_pl ; save string pointer low byte
|
5019 |
|
|
STY str_ph ; save string pointer high byte
|
5020 |
|
|
TAY ; get string length back
|
5021 |
|
|
|
5022 |
|
|
LC_loop
|
5023 |
|
|
DEY ; decrement index
|
5024 |
|
|
LDA (ut1_pl),Y ; get byte from string
|
5025 |
|
|
JSR LAB_1D82 ; is character "A" to "Z"
|
5026 |
|
|
BCC NoUcase ; branch if not upper case alpha
|
5027 |
|
|
|
5028 |
|
|
ORA #$20 ; convert upper to lower case
|
5029 |
|
|
NoUcase
|
5030 |
|
|
STA (Sutill),Y ; save byte back to string
|
5031 |
|
|
TYA ; test index
|
5032 |
|
|
BNE LC_loop ; loop if not all done
|
5033 |
|
|
|
5034 |
|
|
BEQ NoString ; tidy up and exit, branch always
|
5035 |
|
|
|
5036 |
|
|
; perform UCASE$()
|
5037 |
|
|
|
5038 |
|
|
LAB_UCASE
|
5039 |
|
|
JSR LAB_EVST ; evaluate string
|
5040 |
|
|
STA str_ln ; set string length
|
5041 |
|
|
TAY ; copy length to Y
|
5042 |
|
|
BEQ NoString ; branch if null string
|
5043 |
|
|
|
5044 |
|
|
JSR LAB_MSSP ; make string space A bytes long A=length,
|
5045 |
|
|
; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
|
5046 |
|
|
STX str_pl ; save string pointer low byte
|
5047 |
|
|
STY str_ph ; save string pointer high byte
|
5048 |
|
|
TAY ; get string length back
|
5049 |
|
|
|
5050 |
|
|
UC_loop
|
5051 |
|
|
DEY ; decrement index
|
5052 |
|
|
LDA (ut1_pl),Y ; get byte from string
|
5053 |
|
|
JSR LAB_CASC ; is character "a" to "z" (or "A" to "Z")
|
5054 |
|
|
BCC NoLcase ; branch if not alpha
|
5055 |
|
|
|
5056 |
|
|
AND #$DF ; convert lower to upper case
|
5057 |
|
|
NoLcase
|
5058 |
|
|
STA (Sutill),Y ; save byte back to string
|
5059 |
|
|
TYA ; test index
|
5060 |
|
|
BNE UC_loop ; loop if not all done
|
5061 |
|
|
|
5062 |
|
|
NoString
|
5063 |
|
|
JMP LAB_RTST ; check for space on descriptor stack then put string
|
5064 |
|
|
; address and length on descriptor stack and update stack
|
5065 |
|
|
; pointers
|
5066 |
|
|
|
5067 |
|
|
; perform SADD()
|
5068 |
|
|
|
5069 |
|
|
LAB_SADD
|
5070 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
5071 |
|
|
JSR LAB_GVAR ; get var address
|
5072 |
|
|
|
5073 |
|
|
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
|
5074 |
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
5075 |
|
|
|
5076 |
|
|
LDY #$02 ; index to string pointer high byte
|
5077 |
|
|
LDA (Cvaral),Y ; get string pointer high byte
|
5078 |
|
|
TAX ; copy string pointer high byte to X
|
5079 |
|
|
DEY ; index to string pointer low byte
|
5080 |
|
|
LDA (Cvaral),Y ; get string pointer low byte
|
5081 |
|
|
TAY ; copy string pointer low byte to Y
|
5082 |
|
|
TXA ; copy string pointer high byte to A
|
5083 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
5084 |
|
|
|
5085 |
|
|
; perform LEN()
|
5086 |
|
|
|
5087 |
|
|
LAB_LENS
|
5088 |
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and Y)
|
5089 |
|
|
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
|
5090 |
|
|
|
5091 |
|
|
; evaluate string, get length in Y
|
5092 |
|
|
|
5093 |
|
|
LAB_ESGL
|
5094 |
|
|
JSR LAB_EVST ; evaluate string
|
5095 |
|
|
TAY ; copy length to Y
|
5096 |
|
|
RTS
|
5097 |
|
|
|
5098 |
|
|
; perform ASC()
|
5099 |
|
|
|
5100 |
|
|
LAB_ASC
|
5101 |
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and Y)
|
5102 |
|
|
BEQ LAB_23A8 ; if null do function call error then warm start
|
5103 |
|
|
|
5104 |
|
|
LDY #$00 ; set index to first character
|
5105 |
|
|
LDA (ut1_pl),Y ; get byte
|
5106 |
|
|
TAY ; copy to Y
|
5107 |
|
|
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
|
5108 |
|
|
|
5109 |
|
|
; do function call error then warm start
|
5110 |
|
|
|
5111 |
|
|
LAB_23A8
|
5112 |
|
|
JMP LAB_FCER ; do function call error then warm start
|
5113 |
|
|
|
5114 |
|
|
; scan and get byte parameter
|
5115 |
|
|
|
5116 |
|
|
LAB_SGBY
|
5117 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
5118 |
|
|
|
5119 |
|
|
; get byte parameter
|
5120 |
|
|
|
5121 |
|
|
LAB_GTBY
|
5122 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
5123 |
|
|
; else do type mismatch
|
5124 |
|
|
|
5125 |
|
|
; evaluate byte expression, result in X
|
5126 |
|
|
|
5127 |
|
|
LAB_EVBY
|
5128 |
|
|
JSR LAB_EVPI ; evaluate integer expression (no check)
|
5129 |
|
|
|
5130 |
|
|
LDY FAC1_2 ; get FAC1 mantissa2
|
5131 |
|
|
BNE LAB_23A8 ; if top byte <> 0 do function call error then warm start
|
5132 |
|
|
|
5133 |
|
|
LDX FAC1_3 ; get FAC1 mantissa3
|
5134 |
|
|
JMP LAB_GBYT ; scan memory and return
|
5135 |
|
|
|
5136 |
|
|
; perform VAL()
|
5137 |
|
|
|
5138 |
|
|
LAB_VAL
|
5139 |
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and Y)
|
5140 |
|
|
BNE LAB_23C5 ; branch if not null string
|
5141 |
|
|
|
5142 |
|
|
; string was null so set result = $00
|
5143 |
|
|
JMP LAB_24F1 ; clear FAC1 exponent and sign and return
|
5144 |
|
|
|
5145 |
|
|
LAB_23C5
|
5146 |
|
|
LDX Bpntrl ; get BASIC execute pointer low byte
|
5147 |
|
|
LDY Bpntrh ; get BASIC execute pointer high byte
|
5148 |
|
|
STX Btmpl ; save BASIC execute pointer low byte
|
5149 |
|
|
STY Btmph ; save BASIC execute pointer high byte
|
5150 |
|
|
LDX ut1_pl ; get string pointer low byte
|
5151 |
|
|
STX Bpntrl ; save as BASIC execute pointer low byte
|
5152 |
|
|
CLC ; clear carry
|
5153 |
|
|
ADC ut1_pl ; add string length
|
5154 |
|
|
STA ut2_pl ; save string end low byte
|
5155 |
|
|
LDA ut1_ph ; get string pointer high byte
|
5156 |
|
|
STA Bpntrh ; save as BASIC execute pointer high byte
|
5157 |
|
|
ADC #$00 ; add carry to high byte
|
5158 |
|
|
STA ut2_ph ; save string end high byte
|
5159 |
|
|
LDY #$00 ; set index to $00
|
5160 |
|
|
LDA (ut2_pl),Y ; get string end +1 byte
|
5161 |
|
|
PHA ; push it
|
5162 |
|
|
TYA ; clear A
|
5163 |
|
|
STA (ut2_pl),Y ; terminate string with $00
|
5164 |
|
|
JSR LAB_GBYT ; scan memory
|
5165 |
|
|
JSR LAB_2887 ; get FAC1 from string
|
5166 |
|
|
PLA ; restore string end +1 byte
|
5167 |
|
|
LDY #$00 ; set index to zero
|
5168 |
|
|
STA (ut2_pl),Y ; put string end byte back
|
5169 |
|
|
|
5170 |
|
|
; restore BASIC execute pointer from temp (Btmpl/Btmph)
|
5171 |
|
|
|
5172 |
|
|
LAB_23F3
|
5173 |
|
|
LDX Btmpl ; get BASIC execute pointer low byte back
|
5174 |
|
|
LDY Btmph ; get BASIC execute pointer high byte back
|
5175 |
|
|
STX Bpntrl ; save BASIC execute pointer low byte
|
5176 |
|
|
STY Bpntrh ; save BASIC execute pointer high byte
|
5177 |
|
|
RTS
|
5178 |
|
|
|
5179 |
|
|
; get two parameters for POKE or WAIT
|
5180 |
|
|
|
5181 |
|
|
LAB_GADB
|
5182 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
5183 |
|
|
; else do type mismatch
|
5184 |
|
|
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
|
5185 |
|
|
|
5186 |
|
|
; scan for "," and get byte, else do Syntax error then warm start
|
5187 |
|
|
|
5188 |
|
|
LAB_SCGB
|
5189 |
|
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
|
5190 |
|
|
LDA Itemph ; save temporary integer high byte
|
5191 |
|
|
PHA ; on stack
|
5192 |
|
|
LDA Itempl ; save temporary integer low byte
|
5193 |
|
|
PHA ; on stack
|
5194 |
|
|
JSR LAB_GTBY ; get byte parameter
|
5195 |
|
|
PLA ; pull low byte
|
5196 |
|
|
STA Itempl ; restore temporary integer low byte
|
5197 |
|
|
PLA ; pull high byte
|
5198 |
|
|
STA Itemph ; restore temporary integer high byte
|
5199 |
|
|
RTS
|
5200 |
|
|
|
5201 |
|
|
; convert float to fixed routine. accepts any value that fits in 24 bits, +ve or
|
5202 |
|
|
; -ve and converts it into a right truncated integer in Itempl and Itemph
|
5203 |
|
|
|
5204 |
|
|
; save unsigned 16 bit integer part of FAC1 in temporary integer
|
5205 |
|
|
|
5206 |
|
|
LAB_F2FX
|
5207 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
5208 |
|
|
CMP #$98 ; compare with exponent = 2^24
|
5209 |
|
|
BCS LAB_23A8 ; if >= do function call error then warm start
|
5210 |
|
|
|
5211 |
|
|
LAB_F2FU
|
5212 |
|
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed
|
5213 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
5214 |
|
|
LDY FAC1_3 ; get FAC1 mantissa3
|
5215 |
|
|
STY Itempl ; save temporary integer low byte
|
5216 |
|
|
STA Itemph ; save temporary integer high byte
|
5217 |
|
|
RTS
|
5218 |
|
|
|
5219 |
|
|
; perform PEEK()
|
5220 |
|
|
|
5221 |
|
|
LAB_PEEK
|
5222 |
|
|
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
|
5223 |
|
|
LDX #$00 ; clear index
|
5224 |
|
|
LDA (Itempl,X) ; get byte via temporary integer (addr)
|
5225 |
|
|
TAY ; copy byte to Y
|
5226 |
|
|
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
|
5227 |
|
|
|
5228 |
|
|
; perform POKE
|
5229 |
|
|
|
5230 |
|
|
LAB_POKE
|
5231 |
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
5232 |
|
|
TXA ; copy byte argument to A
|
5233 |
|
|
LDX #$00 ; clear index
|
5234 |
|
|
STA (Itempl,X) ; save byte via temporary integer (addr)
|
5235 |
|
|
RTS
|
5236 |
|
|
|
5237 |
|
|
; perform DEEK()
|
5238 |
|
|
|
5239 |
|
|
LAB_DEEK
|
5240 |
|
|
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer
|
5241 |
|
|
LDX #$00 ; clear index
|
5242 |
|
|
LDA (Itempl,X) ; PEEK low byte
|
5243 |
|
|
TAY ; copy to Y
|
5244 |
|
|
INC Itempl ; increment pointer low byte
|
5245 |
|
|
BNE Deekh ; skip high increment if no rollover
|
5246 |
|
|
|
5247 |
|
|
INC Itemph ; increment pointer high byte
|
5248 |
|
|
Deekh
|
5249 |
|
|
LDA (Itempl,X) ; PEEK high byte
|
5250 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
5251 |
|
|
|
5252 |
|
|
; perform DOKE
|
5253 |
|
|
|
5254 |
|
|
LAB_DOKE
|
5255 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
5256 |
|
|
; else do type mismatch
|
5257 |
|
|
JSR LAB_F2FX ; convert floating-to-fixed
|
5258 |
|
|
|
5259 |
|
|
STY Frnxtl ; save pointer low byte (float to fixed returns word in AY)
|
5260 |
|
|
STA Frnxth ; save pointer high byte
|
5261 |
|
|
|
5262 |
|
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
|
5263 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
5264 |
|
|
; else do type mismatch
|
5265 |
|
|
JSR LAB_F2FX ; convert floating-to-fixed
|
5266 |
|
|
|
5267 |
|
|
TYA ; copy value low byte (float to fixed returns word in AY)
|
5268 |
|
|
LDX #$00 ; clear index
|
5269 |
|
|
STA (Frnxtl,X) ; POKE low byte
|
5270 |
|
|
INC Frnxtl ; increment pointer low byte
|
5271 |
|
|
BNE Dokeh ; skip high increment if no rollover
|
5272 |
|
|
|
5273 |
|
|
INC Frnxth ; increment pointer high byte
|
5274 |
|
|
Dokeh
|
5275 |
|
|
LDA Itemph ; get value high byte
|
5276 |
|
|
STA (Frnxtl,X) ; POKE high byte
|
5277 |
|
|
JMP LAB_GBYT ; scan memory and return
|
5278 |
|
|
|
5279 |
|
|
; perform SWAP
|
5280 |
|
|
|
5281 |
|
|
LAB_SWAP
|
5282 |
|
|
JSR LAB_GVAR ; get var1 address
|
5283 |
|
|
STA Lvarpl ; save var1 address low byte
|
5284 |
|
|
STY Lvarph ; save var1 address high byte
|
5285 |
|
|
LDA Dtypef ; get data type flag, $FF=string, $00=numeric
|
5286 |
|
|
PHA ; save data type flag
|
5287 |
|
|
|
5288 |
|
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start
|
5289 |
|
|
JSR LAB_GVAR ; get var2 address (pointer in Cvaral/h)
|
5290 |
|
|
PLA ; pull var1 data type flag
|
5291 |
|
|
EOR Dtypef ; compare with var2 data type
|
5292 |
|
|
BPL SwapErr ; exit if not both the same type
|
5293 |
|
|
|
5294 |
|
|
LDY #$03 ; four bytes to swap (either value or descriptor+1)
|
5295 |
|
|
SwapLp
|
5296 |
|
|
LDA (Lvarpl),Y ; get byte from var1
|
5297 |
|
|
TAX ; save var1 byte
|
5298 |
|
|
LDA (Cvaral),Y ; get byte from var2
|
5299 |
|
|
STA (Lvarpl),Y ; save byte to var1
|
5300 |
|
|
TXA ; restore var1 byte
|
5301 |
|
|
STA (Cvaral),Y ; save byte to var2
|
5302 |
|
|
DEY ; decrement index
|
5303 |
|
|
BPL SwapLp ; loop until done
|
5304 |
|
|
|
5305 |
|
|
RTS
|
5306 |
|
|
|
5307 |
|
|
SwapErr
|
5308 |
|
|
JMP LAB_1ABC ; do "Type mismatch" error then warm start
|
5309 |
|
|
|
5310 |
|
|
; perform CALL
|
5311 |
|
|
|
5312 |
|
|
LAB_CALL
|
5313 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
5314 |
|
|
; else do type mismatch
|
5315 |
|
|
JSR LAB_F2FX ; convert floating-to-fixed
|
5316 |
|
|
LDA #>CallExit ; set return address high byte
|
5317 |
|
|
PHA ; put on stack
|
5318 |
|
|
LDA #
|
5319 |
|
|
PHA ; put on stack
|
5320 |
|
|
JMP (Itempl) ; do indirect jump to user routine
|
5321 |
|
|
|
5322 |
|
|
; if the called routine exits correctly then it will return to here. this will then get
|
5323 |
|
|
; the next byte for the interpreter and return
|
5324 |
|
|
|
5325 |
|
|
CallExit
|
5326 |
|
|
JMP LAB_GBYT ; scan memory and return
|
5327 |
|
|
|
5328 |
|
|
; perform WAIT
|
5329 |
|
|
|
5330 |
|
|
LAB_WAIT
|
5331 |
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
5332 |
|
|
STX Frnxtl ; save byte
|
5333 |
|
|
LDX #$00 ; clear mask
|
5334 |
|
|
JSR LAB_GBYT ; scan memory
|
5335 |
|
|
BEQ LAB_2441 ; skip if no third argument
|
5336 |
|
|
|
5337 |
|
|
JSR LAB_SCGB ; scan for "," and get byte, else SN error then warm start
|
5338 |
|
|
LAB_2441
|
5339 |
|
|
STX Frnxth ; save EOR argument
|
5340 |
|
|
LAB_2445
|
5341 |
|
|
LDA (Itempl),Y ; get byte via temporary integer (addr)
|
5342 |
|
|
EOR Frnxth ; EOR with second argument (mask)
|
5343 |
|
|
AND Frnxtl ; AND with first argument (byte)
|
5344 |
|
|
BEQ LAB_2445 ; loop if result is zero
|
5345 |
|
|
|
5346 |
|
|
LAB_244D
|
5347 |
|
|
RTS
|
5348 |
|
|
|
5349 |
|
|
; perform subtraction, FAC1 from (AY)
|
5350 |
|
|
|
5351 |
|
|
LAB_2455
|
5352 |
|
|
JSR LAB_264D ; unpack memory (AY) into FAC2
|
5353 |
|
|
|
5354 |
|
|
; perform subtraction, FAC1 from FAC2
|
5355 |
|
|
|
5356 |
|
|
LAB_SUBTRACT
|
5357 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
5358 |
|
|
EOR #$FF ; complement it
|
5359 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5360 |
|
|
EOR FAC2_s ; EOR with FAC2 sign (b7)
|
5361 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
5362 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
5363 |
|
|
JMP LAB_ADD ; go add FAC2 to FAC1
|
5364 |
|
|
|
5365 |
|
|
; perform addition
|
5366 |
|
|
|
5367 |
|
|
LAB_2467
|
5368 |
|
|
JSR LAB_257B ; shift FACX A times right (>8 shifts)
|
5369 |
|
|
BCC LAB_24A8 ;.go subtract mantissas
|
5370 |
|
|
|
5371 |
|
|
; add 0.5 to FAC1
|
5372 |
|
|
|
5373 |
|
|
LAB_244E
|
5374 |
|
|
LDA #
|
5375 |
|
|
LDY #>LAB_2A96 ; set 0.5 pointer high byte
|
5376 |
|
|
|
5377 |
|
|
; add (AY) to FAC1
|
5378 |
|
|
|
5379 |
|
|
LAB_246C
|
5380 |
|
|
JSR LAB_264D ; unpack memory (AY) into FAC2
|
5381 |
|
|
|
5382 |
|
|
; add FAC2 to FAC1
|
5383 |
|
|
|
5384 |
|
|
LAB_ADD
|
5385 |
|
|
BNE LAB_2474 ; branch if FAC1 was not zero
|
5386 |
|
|
|
5387 |
|
|
; copy FAC2 to FAC1
|
5388 |
|
|
|
5389 |
|
|
LAB_279B
|
5390 |
|
|
LDA FAC2_s ; get FAC2 sign (b7)
|
5391 |
|
|
|
5392 |
|
|
; save FAC1 sign and copy ABS(FAC2) to FAC1
|
5393 |
|
|
|
5394 |
|
|
LAB_279D
|
5395 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5396 |
|
|
LDX #$04 ; 4 bytes to copy
|
5397 |
|
|
LAB_27A1
|
5398 |
|
|
LDA FAC1_o,X ; get byte from FAC2,X
|
5399 |
|
|
STA FAC1_e-1,X ; save byte at FAC1,X
|
5400 |
|
|
DEX ; decrement count
|
5401 |
|
|
BNE LAB_27A1 ; loop if not all done
|
5402 |
|
|
|
5403 |
|
|
STX FAC1_r ; clear FAC1 rounding byte
|
5404 |
|
|
RTS
|
5405 |
|
|
|
5406 |
|
|
; FAC1 is non zero
|
5407 |
|
|
LAB_2474
|
5408 |
|
|
LDX FAC1_r ; get FAC1 rounding byte
|
5409 |
|
|
STX FAC2_r ; save as FAC2 rounding byte
|
5410 |
|
|
LDX #FAC2_e ; set index to FAC2 exponent addr
|
5411 |
|
|
LDA FAC2_e ; get FAC2 exponent
|
5412 |
|
|
LAB_247C
|
5413 |
|
|
TAY ; copy exponent
|
5414 |
|
|
BEQ LAB_244D ; exit if zero
|
5415 |
|
|
|
5416 |
|
|
SEC ; set carry for subtract
|
5417 |
|
|
SBC FAC1_e ; subtract FAC1 exponent
|
5418 |
|
|
BEQ LAB_24A8 ; branch if = (go add mantissa)
|
5419 |
|
|
|
5420 |
|
|
BCC LAB_2498 ; branch if <
|
5421 |
|
|
|
5422 |
|
|
; FAC2>FAC1
|
5423 |
|
|
STY FAC1_e ; save FAC1 exponent
|
5424 |
|
|
LDY FAC2_s ; get FAC2 sign (b7)
|
5425 |
|
|
STY FAC1_s ; save FAC1 sign (b7)
|
5426 |
|
|
EOR #$FF ; complement A
|
5427 |
|
|
ADC #$00 ; +1 (twos complement, carry is set)
|
5428 |
|
|
LDY #$00 ; clear Y
|
5429 |
|
|
STY FAC2_r ; clear FAC2 rounding byte
|
5430 |
|
|
LDX #FAC1_e ; set index to FAC1 exponent addr
|
5431 |
|
|
BNE LAB_249C ; branch always
|
5432 |
|
|
|
5433 |
|
|
LAB_2498
|
5434 |
|
|
LDY #$00 ; clear Y
|
5435 |
|
|
STY FAC1_r ; clear FAC1 rounding byte
|
5436 |
|
|
LAB_249C
|
5437 |
|
|
CMP #$F9 ; compare exponent diff with $F9
|
5438 |
|
|
BMI LAB_2467 ; branch if range $79-$F8
|
5439 |
|
|
|
5440 |
|
|
TAY ; copy exponent difference to Y
|
5441 |
|
|
LDA FAC1_r ; get FAC1 rounding byte
|
5442 |
|
|
LSR PLUS_1,X ; shift FAC? mantissa1
|
5443 |
|
|
JSR LAB_2592 ; shift FACX Y times right
|
5444 |
|
|
|
5445 |
|
|
; exponents are equal now do mantissa subtract
|
5446 |
|
|
LAB_24A8
|
5447 |
|
|
BIT FAC_sc ; test sign compare (FAC1 EOR FAC2)
|
5448 |
|
|
BPL LAB_24F8 ; if = add FAC2 mantissa to FAC1 mantissa and return
|
5449 |
|
|
|
5450 |
|
|
LDY #FAC1_e ; set index to FAC1 exponent addr
|
5451 |
|
|
CPX #FAC2_e ; compare X to FAC2 exponent addr
|
5452 |
|
|
BEQ LAB_24B4 ; branch if =
|
5453 |
|
|
|
5454 |
|
|
LDY #FAC2_e ; else set index to FAC2 exponent addr
|
5455 |
|
|
|
5456 |
|
|
; subtract smaller from bigger (take sign of bigger)
|
5457 |
|
|
LAB_24B4
|
5458 |
|
|
SEC ; set carry for subtract
|
5459 |
|
|
EOR #$FF ; ones complement A
|
5460 |
|
|
ADC FAC2_r ; add FAC2 rounding byte
|
5461 |
|
|
STA FAC1_r ; save FAC1 rounding byte
|
5462 |
|
|
LDA PLUS_3,Y ; get FACY mantissa3
|
5463 |
|
|
SBC PLUS_3,X ; subtract FACX mantissa3
|
5464 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
5465 |
|
|
LDA PLUS_2,Y ; get FACY mantissa2
|
5466 |
|
|
SBC PLUS_2,X ; subtract FACX mantissa2
|
5467 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
5468 |
|
|
LDA PLUS_1,Y ; get FACY mantissa1
|
5469 |
|
|
SBC PLUS_1,X ; subtract FACX mantissa1
|
5470 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
5471 |
|
|
|
5472 |
|
|
; do ABS and normalise FAC1
|
5473 |
|
|
|
5474 |
|
|
LAB_24D0
|
5475 |
|
|
BCS LAB_24D5 ; branch if number is +ve
|
5476 |
|
|
|
5477 |
|
|
JSR LAB_2537 ; negate FAC1
|
5478 |
|
|
|
5479 |
|
|
; normalise FAC1
|
5480 |
|
|
|
5481 |
|
|
LAB_24D5
|
5482 |
|
|
LDY #$00 ; clear Y
|
5483 |
|
|
TYA ; clear A
|
5484 |
|
|
CLC ; clear carry for add
|
5485 |
|
|
LAB_24D9
|
5486 |
|
|
LDX FAC1_1 ; get FAC1 mantissa1
|
5487 |
|
|
BNE LAB_251B ; if not zero normalise FAC1
|
5488 |
|
|
|
5489 |
|
|
LDX FAC1_2 ; get FAC1 mantissa2
|
5490 |
|
|
STX FAC1_1 ; save FAC1 mantissa1
|
5491 |
|
|
LDX FAC1_3 ; get FAC1 mantissa3
|
5492 |
|
|
STX FAC1_2 ; save FAC1 mantissa2
|
5493 |
|
|
LDX FAC1_r ; get FAC1 rounding byte
|
5494 |
|
|
STX FAC1_3 ; save FAC1 mantissa3
|
5495 |
|
|
STY FAC1_r ; clear FAC1 rounding byte
|
5496 |
|
|
ADC #$08 ; add x to exponent offset
|
5497 |
|
|
CMP #$18 ; compare with $18 (max offset, all bits would be =0)
|
5498 |
|
|
BNE LAB_24D9 ; loop if not max
|
5499 |
|
|
|
5500 |
|
|
; clear FAC1 exponent and sign
|
5501 |
|
|
|
5502 |
|
|
LAB_24F1
|
5503 |
|
|
LDA #$00 ; clear A
|
5504 |
|
|
LAB_24F3
|
5505 |
|
|
STA FAC1_e ; set FAC1 exponent
|
5506 |
|
|
|
5507 |
|
|
; save FAC1 sign
|
5508 |
|
|
|
5509 |
|
|
LAB_24F5
|
5510 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5511 |
|
|
RTS
|
5512 |
|
|
|
5513 |
|
|
; add FAC2 mantissa to FAC1 mantissa
|
5514 |
|
|
|
5515 |
|
|
LAB_24F8
|
5516 |
|
|
ADC FAC2_r ; add FAC2 rounding byte
|
5517 |
|
|
STA FAC1_r ; save FAC1 rounding byte
|
5518 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
5519 |
|
|
ADC FAC2_3 ; add FAC2 mantissa3
|
5520 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
5521 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
5522 |
|
|
ADC FAC2_2 ; add FAC2 mantissa2
|
5523 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
5524 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
5525 |
|
|
ADC FAC2_1 ; add FAC2 mantissa1
|
5526 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
5527 |
|
|
BCS LAB_252A ; if carry then normalise FAC1 for C=1
|
5528 |
|
|
|
5529 |
|
|
RTS ; else just exit
|
5530 |
|
|
|
5531 |
|
|
LAB_2511
|
5532 |
|
|
ADC #$01 ; add 1 to exponent offset
|
5533 |
|
|
ASL FAC1_r ; shift FAC1 rounding byte
|
5534 |
|
|
ROL FAC1_3 ; shift FAC1 mantissa3
|
5535 |
|
|
ROL FAC1_2 ; shift FAC1 mantissa2
|
5536 |
|
|
ROL FAC1_1 ; shift FAC1 mantissa1
|
5537 |
|
|
|
5538 |
|
|
; normalise FAC1
|
5539 |
|
|
|
5540 |
|
|
LAB_251B
|
5541 |
|
|
BPL LAB_2511 ; loop if not normalised
|
5542 |
|
|
|
5543 |
|
|
SEC ; set carry for subtract
|
5544 |
|
|
SBC FAC1_e ; subtract FAC1 exponent
|
5545 |
|
|
BCS LAB_24F1 ; branch if underflow (set result = $0)
|
5546 |
|
|
|
5547 |
|
|
EOR #$FF ; complement exponent
|
5548 |
|
|
ADC #$01 ; +1 (twos complement)
|
5549 |
|
|
STA FAC1_e ; save FAC1 exponent
|
5550 |
|
|
|
5551 |
|
|
; test and normalise FAC1 for C=0/1
|
5552 |
|
|
|
5553 |
|
|
LAB_2528
|
5554 |
|
|
BCC LAB_2536 ; exit if no overflow
|
5555 |
|
|
|
5556 |
|
|
; normalise FAC1 for C=1
|
5557 |
|
|
|
5558 |
|
|
LAB_252A
|
5559 |
|
|
INC FAC1_e ; increment FAC1 exponent
|
5560 |
|
|
BEQ LAB_2564 ; if zero do overflow error and warm start
|
5561 |
|
|
|
5562 |
|
|
ROR FAC1_1 ; shift FAC1 mantissa1
|
5563 |
|
|
ROR FAC1_2 ; shift FAC1 mantissa2
|
5564 |
|
|
ROR FAC1_3 ; shift FAC1 mantissa3
|
5565 |
|
|
ROR FAC1_r ; shift FAC1 rounding byte
|
5566 |
|
|
LAB_2536
|
5567 |
|
|
RTS
|
5568 |
|
|
|
5569 |
|
|
; negate FAC1
|
5570 |
|
|
|
5571 |
|
|
LAB_2537
|
5572 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
5573 |
|
|
EOR #$FF ; complement it
|
5574 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5575 |
|
|
|
5576 |
|
|
; twos complement FAC1 mantissa
|
5577 |
|
|
|
5578 |
|
|
LAB_253D
|
5579 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
5580 |
|
|
EOR #$FF ; complement it
|
5581 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
5582 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
5583 |
|
|
EOR #$FF ; complement it
|
5584 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
5585 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
5586 |
|
|
EOR #$FF ; complement it
|
5587 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
5588 |
|
|
LDA FAC1_r ; get FAC1 rounding byte
|
5589 |
|
|
EOR #$FF ; complement it
|
5590 |
|
|
STA FAC1_r ; save FAC1 rounding byte
|
5591 |
|
|
INC FAC1_r ; increment FAC1 rounding byte
|
5592 |
|
|
BNE LAB_2563 ; exit if no overflow
|
5593 |
|
|
|
5594 |
|
|
; increment FAC1 mantissa
|
5595 |
|
|
|
5596 |
|
|
LAB_2559
|
5597 |
|
|
INC FAC1_3 ; increment FAC1 mantissa3
|
5598 |
|
|
BNE LAB_2563 ; finished if no rollover
|
5599 |
|
|
|
5600 |
|
|
INC FAC1_2 ; increment FAC1 mantissa2
|
5601 |
|
|
BNE LAB_2563 ; finished if no rollover
|
5602 |
|
|
|
5603 |
|
|
INC FAC1_1 ; increment FAC1 mantissa1
|
5604 |
|
|
LAB_2563
|
5605 |
|
|
RTS
|
5606 |
|
|
|
5607 |
|
|
; do overflow error (overflow exit)
|
5608 |
|
|
|
5609 |
|
|
LAB_2564
|
5610 |
|
|
LDX #$0A ; error code $0A ("Overflow" error)
|
5611 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
5612 |
|
|
|
5613 |
|
|
; shift FCAtemp << A+8 times
|
5614 |
|
|
|
5615 |
|
|
LAB_2569
|
5616 |
|
|
LDX #FACt_1-1 ; set offset to FACtemp
|
5617 |
|
|
LAB_256B
|
5618 |
|
|
LDY PLUS_3,X ; get FACX mantissa3
|
5619 |
|
|
STY FAC1_r ; save as FAC1 rounding byte
|
5620 |
|
|
LDY PLUS_2,X ; get FACX mantissa2
|
5621 |
|
|
STY PLUS_3,X ; save FACX mantissa3
|
5622 |
|
|
LDY PLUS_1,X ; get FACX mantissa1
|
5623 |
|
|
STY PLUS_2,X ; save FACX mantissa2
|
5624 |
|
|
LDY FAC1_o ; get FAC1 overflow byte
|
5625 |
|
|
STY PLUS_1,X ; save FACX mantissa1
|
5626 |
|
|
|
5627 |
|
|
; shift FACX -A times right (> 8 shifts)
|
5628 |
|
|
|
5629 |
|
|
LAB_257B
|
5630 |
|
|
ADC #$08 ; add 8 to shift count
|
5631 |
|
|
BMI LAB_256B ; go do 8 shift if still -ve
|
5632 |
|
|
|
5633 |
|
|
BEQ LAB_256B ; go do 8 shift if zero
|
5634 |
|
|
|
5635 |
|
|
SBC #$08 ; else subtract 8 again
|
5636 |
|
|
TAY ; save count to Y
|
5637 |
|
|
LDA FAC1_r ; get FAC1 rounding byte
|
5638 |
|
|
BCS LAB_259A ;.
|
5639 |
|
|
|
5640 |
|
|
LAB_2588
|
5641 |
|
|
ASL PLUS_1,X ; shift FACX mantissa1
|
5642 |
|
|
BCC LAB_258E ; branch if +ve
|
5643 |
|
|
|
5644 |
|
|
INC PLUS_1,X ; this sets b7 eventually
|
5645 |
|
|
LAB_258E
|
5646 |
|
|
ROR PLUS_1,X ; shift FACX mantissa1 (correct for ASL)
|
5647 |
|
|
ROR PLUS_1,X ; shift FACX mantissa1 (put carry in b7)
|
5648 |
|
|
|
5649 |
|
|
; shift FACX Y times right
|
5650 |
|
|
|
5651 |
|
|
LAB_2592
|
5652 |
|
|
ROR PLUS_2,X ; shift FACX mantissa2
|
5653 |
|
|
ROR PLUS_3,X ; shift FACX mantissa3
|
5654 |
|
|
ROR ; shift FACX rounding byte
|
5655 |
|
|
INY ; increment exponent diff
|
5656 |
|
|
BNE LAB_2588 ; branch if range adjust not complete
|
5657 |
|
|
|
5658 |
|
|
LAB_259A
|
5659 |
|
|
CLC ; just clear it
|
5660 |
|
|
RTS
|
5661 |
|
|
|
5662 |
|
|
; perform LOG()
|
5663 |
|
|
|
5664 |
|
|
LAB_LOG
|
5665 |
|
|
JSR LAB_27CA ; test sign and zero
|
5666 |
|
|
BEQ LAB_25C4 ; if zero do function call error then warm start
|
5667 |
|
|
|
5668 |
|
|
BPL LAB_25C7 ; skip error if +ve
|
5669 |
|
|
|
5670 |
|
|
LAB_25C4
|
5671 |
|
|
JMP LAB_FCER ; do function call error then warm start (-ve)
|
5672 |
|
|
|
5673 |
|
|
LAB_25C7
|
5674 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
5675 |
|
|
SBC #$7F ; normalise it
|
5676 |
|
|
PHA ; save it
|
5677 |
|
|
LDA #$80 ; set exponent to zero
|
5678 |
|
|
STA FAC1_e ; save FAC1 exponent
|
5679 |
|
|
LDA #
|
5680 |
|
|
LDY #>LAB_25AD ; set 1/root2 pointer high byte
|
5681 |
|
|
JSR LAB_246C ; add (AY) to FAC1 (1/root2)
|
5682 |
|
|
LDA #
|
5683 |
|
|
LDY #>LAB_25B1 ; set root2 pointer high byte
|
5684 |
|
|
JSR LAB_26CA ; convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
|
5685 |
|
|
LDA #
|
5686 |
|
|
LDY #>LAB_259C ; set 1 pointer high byte
|
5687 |
|
|
JSR LAB_2455 ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1)
|
5688 |
|
|
LDA #
|
5689 |
|
|
LDY #>LAB_25A0 ; set pointer high byte to counter
|
5690 |
|
|
JSR LAB_2B6E ; ^2 then series evaluation
|
5691 |
|
|
LDA #
|
5692 |
|
|
LDY #>LAB_25B5 ; set -0.5 pointer high byte
|
5693 |
|
|
JSR LAB_246C ; add (AY) to FAC1
|
5694 |
|
|
PLA ; restore FAC1 exponent
|
5695 |
|
|
JSR LAB_2912 ; evaluate new ASCII digit
|
5696 |
|
|
LDA #
|
5697 |
|
|
LDY #>LAB_25B9 ; set LOG(2) pointer high byte
|
5698 |
|
|
|
5699 |
|
|
; do convert AY, FCA1*(AY)
|
5700 |
|
|
|
5701 |
|
|
LAB_25FB
|
5702 |
|
|
JSR LAB_264D ; unpack memory (AY) into FAC2
|
5703 |
|
|
LAB_MULTIPLY
|
5704 |
|
|
BEQ LAB_264C ; exit if zero
|
5705 |
|
|
|
5706 |
|
|
JSR LAB_2673 ; test and adjust accumulators
|
5707 |
|
|
LDA #$00 ; clear A
|
5708 |
|
|
STA FACt_1 ; clear temp mantissa1
|
5709 |
|
|
STA FACt_2 ; clear temp mantissa2
|
5710 |
|
|
STA FACt_3 ; clear temp mantissa3
|
5711 |
|
|
LDA FAC1_r ; get FAC1 rounding byte
|
5712 |
|
|
JSR LAB_2622 ; go do shift/add FAC2
|
5713 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
5714 |
|
|
JSR LAB_2622 ; go do shift/add FAC2
|
5715 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
5716 |
|
|
JSR LAB_2622 ; go do shift/add FAC2
|
5717 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
5718 |
|
|
JSR LAB_2627 ; go do shift/add FAC2
|
5719 |
|
|
JMP LAB_273C ; copy temp to FAC1, normalise and return
|
5720 |
|
|
|
5721 |
|
|
LAB_2622
|
5722 |
|
|
BNE LAB_2627 ; branch if byte <> zero
|
5723 |
|
|
|
5724 |
|
|
JMP LAB_2569 ; shift FCAtemp << A+8 times
|
5725 |
|
|
|
5726 |
|
|
; else do shift and add
|
5727 |
|
|
LAB_2627
|
5728 |
|
|
LSR ; shift byte
|
5729 |
|
|
ORA #$80 ; set top bit (mark for 8 times)
|
5730 |
|
|
LAB_262A
|
5731 |
|
|
TAY ; copy result
|
5732 |
|
|
BCC LAB_2640 ; skip next if bit was zero
|
5733 |
|
|
|
5734 |
|
|
CLC ; clear carry for add
|
5735 |
|
|
LDA FACt_3 ; get temp mantissa3
|
5736 |
|
|
ADC FAC2_3 ; add FAC2 mantissa3
|
5737 |
|
|
STA FACt_3 ; save temp mantissa3
|
5738 |
|
|
LDA FACt_2 ; get temp mantissa2
|
5739 |
|
|
ADC FAC2_2 ; add FAC2 mantissa2
|
5740 |
|
|
STA FACt_2 ; save temp mantissa2
|
5741 |
|
|
LDA FACt_1 ; get temp mantissa1
|
5742 |
|
|
ADC FAC2_1 ; add FAC2 mantissa1
|
5743 |
|
|
STA FACt_1 ; save temp mantissa1
|
5744 |
|
|
LAB_2640
|
5745 |
|
|
ROR FACt_1 ; shift temp mantissa1
|
5746 |
|
|
ROR FACt_2 ; shift temp mantissa2
|
5747 |
|
|
ROR FACt_3 ; shift temp mantissa3
|
5748 |
|
|
ROR FAC1_r ; shift temp rounding byte
|
5749 |
|
|
TYA ; get byte back
|
5750 |
|
|
LSR ; shift byte
|
5751 |
|
|
BNE LAB_262A ; loop if all bits not done
|
5752 |
|
|
|
5753 |
|
|
LAB_264C
|
5754 |
|
|
RTS
|
5755 |
|
|
|
5756 |
|
|
; unpack memory (AY) into FAC2
|
5757 |
|
|
|
5758 |
|
|
LAB_264D
|
5759 |
|
|
STA ut1_pl ; save pointer low byte
|
5760 |
|
|
STY ut1_ph ; save pointer high byte
|
5761 |
|
|
LDY #$03 ; 4 bytes to get (0-3)
|
5762 |
|
|
LDA (ut1_pl),Y ; get mantissa3
|
5763 |
|
|
STA FAC2_3 ; save FAC2 mantissa3
|
5764 |
|
|
DEY ; decrement index
|
5765 |
|
|
LDA (ut1_pl),Y ; get mantissa2
|
5766 |
|
|
STA FAC2_2 ; save FAC2 mantissa2
|
5767 |
|
|
DEY ; decrement index
|
5768 |
|
|
LDA (ut1_pl),Y ; get mantissa1+sign
|
5769 |
|
|
STA FAC2_s ; save FAC2 sign (b7)
|
5770 |
|
|
EOR FAC1_s ; EOR with FAC1 sign (b7)
|
5771 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
5772 |
|
|
LDA FAC2_s ; recover FAC2 sign (b7)
|
5773 |
|
|
ORA #$80 ; set 1xxx xxx (set normal bit)
|
5774 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
5775 |
|
|
DEY ; decrement index
|
5776 |
|
|
LDA (ut1_pl),Y ; get exponent byte
|
5777 |
|
|
STA FAC2_e ; save FAC2 exponent
|
5778 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
5779 |
|
|
RTS
|
5780 |
|
|
|
5781 |
|
|
; test and adjust accumulators
|
5782 |
|
|
|
5783 |
|
|
LAB_2673
|
5784 |
|
|
LDA FAC2_e ; get FAC2 exponent
|
5785 |
|
|
LAB_2675
|
5786 |
|
|
BEQ LAB_2696 ; branch if FAC2 = $00 (handle underflow)
|
5787 |
|
|
|
5788 |
|
|
CLC ; clear carry for add
|
5789 |
|
|
ADC FAC1_e ; add FAC1 exponent
|
5790 |
|
|
BCC LAB_2680 ; branch if sum of exponents <$0100
|
5791 |
|
|
|
5792 |
|
|
BMI LAB_269B ; do overflow error
|
5793 |
|
|
|
5794 |
|
|
CLC ; clear carry for the add
|
5795 |
|
|
.byte $2C ; makes next line BIT $1410
|
5796 |
|
|
LAB_2680
|
5797 |
|
|
BPL LAB_2696 ; if +ve go handle underflow
|
5798 |
|
|
|
5799 |
|
|
ADC #$80 ; adjust exponent
|
5800 |
|
|
STA FAC1_e ; save FAC1 exponent
|
5801 |
|
|
BNE LAB_268B ; branch if not zero
|
5802 |
|
|
|
5803 |
|
|
JMP LAB_24F5 ; save FAC1 sign and return
|
5804 |
|
|
|
5805 |
|
|
LAB_268B
|
5806 |
|
|
LDA FAC_sc ; get sign compare (FAC1 EOR FAC2)
|
5807 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5808 |
|
|
LAB_268F
|
5809 |
|
|
RTS
|
5810 |
|
|
|
5811 |
|
|
; handle overflow and underflow
|
5812 |
|
|
|
5813 |
|
|
LAB_2690
|
5814 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
5815 |
|
|
BPL LAB_269B ; do overflow error
|
5816 |
|
|
|
5817 |
|
|
; handle underflow
|
5818 |
|
|
LAB_2696
|
5819 |
|
|
PLA ; pop return address low byte
|
5820 |
|
|
PLA ; pop return address high byte
|
5821 |
|
|
JMP LAB_24F1 ; clear FAC1 exponent and sign and return
|
5822 |
|
|
|
5823 |
|
|
; multiply by 10
|
5824 |
|
|
|
5825 |
|
|
LAB_269E
|
5826 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
5827 |
|
|
TAX ; copy exponent (set the flags)
|
5828 |
|
|
BEQ LAB_268F ; exit if zero
|
5829 |
|
|
|
5830 |
|
|
CLC ; clear carry for add
|
5831 |
|
|
ADC #$02 ; add two to exponent (*4)
|
5832 |
|
|
BCS LAB_269B ; do overflow error if > $FF
|
5833 |
|
|
|
5834 |
|
|
LDX #$00 ; clear byte
|
5835 |
|
|
STX FAC_sc ; clear sign compare (FAC1 EOR FAC2)
|
5836 |
|
|
JSR LAB_247C ; add FAC2 to FAC1 (*5)
|
5837 |
|
|
INC FAC1_e ; increment FAC1 exponent (*10)
|
5838 |
|
|
BNE LAB_268F ; if non zero just do RTS
|
5839 |
|
|
|
5840 |
|
|
LAB_269B
|
5841 |
|
|
JMP LAB_2564 ; do overflow error and warm start
|
5842 |
|
|
|
5843 |
|
|
; divide by 10
|
5844 |
|
|
|
5845 |
|
|
LAB_26B9
|
5846 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
5847 |
|
|
LDA #
|
5848 |
|
|
LDY #>LAB_26B5 ; set pointer to 10d high addr
|
5849 |
|
|
LDX #$00 ; clear sign
|
5850 |
|
|
|
5851 |
|
|
; divide by (AY) (X=sign)
|
5852 |
|
|
|
5853 |
|
|
LAB_26C2
|
5854 |
|
|
STX FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
5855 |
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
5856 |
|
|
JMP LAB_DIVIDE ; do FAC2/FAC1
|
5857 |
|
|
|
5858 |
|
|
; Perform divide-by
|
5859 |
|
|
; convert AY and do (AY)/FAC1
|
5860 |
|
|
|
5861 |
|
|
LAB_26CA
|
5862 |
|
|
JSR LAB_264D ; unpack memory (AY) into FAC2
|
5863 |
|
|
|
5864 |
|
|
; Perform divide-into
|
5865 |
|
|
LAB_DIVIDE
|
5866 |
|
|
BEQ LAB_2737 ; if zero go do /0 error
|
5867 |
|
|
|
5868 |
|
|
JSR LAB_27BA ; round FAC1
|
5869 |
|
|
LDA #$00 ; clear A
|
5870 |
|
|
SEC ; set carry for subtract
|
5871 |
|
|
SBC FAC1_e ; subtract FAC1 exponent (2s complement)
|
5872 |
|
|
STA FAC1_e ; save FAC1 exponent
|
5873 |
|
|
JSR LAB_2673 ; test and adjust accumulators
|
5874 |
|
|
INC FAC1_e ; increment FAC1 exponent
|
5875 |
|
|
BEQ LAB_269B ; if zero do overflow error
|
5876 |
|
|
|
5877 |
|
|
LDX #$FF ; set index for pre increment
|
5878 |
|
|
LDA #$01 ; set bit to flag byte save
|
5879 |
|
|
LAB_26E4
|
5880 |
|
|
LDY FAC2_1 ; get FAC2 mantissa1
|
5881 |
|
|
CPY FAC1_1 ; compare FAC1 mantissa1
|
5882 |
|
|
BNE LAB_26F4 ; branch if <>
|
5883 |
|
|
|
5884 |
|
|
LDY FAC2_2 ; get FAC2 mantissa2
|
5885 |
|
|
CPY FAC1_2 ; compare FAC1 mantissa2
|
5886 |
|
|
BNE LAB_26F4 ; branch if <>
|
5887 |
|
|
|
5888 |
|
|
LDY FAC2_3 ; get FAC2 mantissa3
|
5889 |
|
|
CPY FAC1_3 ; compare FAC1 mantissa3
|
5890 |
|
|
LAB_26F4
|
5891 |
|
|
PHP ; save FAC2-FAC1 compare status
|
5892 |
|
|
ROL ; shift the result byte
|
5893 |
|
|
BCC LAB_2702 ; if no carry skip the byte save
|
5894 |
|
|
|
5895 |
|
|
LDY #$01 ; set bit to flag byte save
|
5896 |
|
|
INX ; else increment the index to FACt
|
5897 |
|
|
CPX #$02 ; compare with the index to FACt_3
|
5898 |
|
|
BMI LAB_2701 ; if not last byte just go save it
|
5899 |
|
|
|
5900 |
|
|
BNE LAB_272B ; if all done go save FAC1 rounding byte, normalise and
|
5901 |
|
|
; return
|
5902 |
|
|
|
5903 |
|
|
LDY #$40 ; set bit to flag byte save for the rounding byte
|
5904 |
|
|
LAB_2701
|
5905 |
|
|
STA FACt_1,X ; write result byte to FACt_1 + index
|
5906 |
|
|
TYA ; copy the next save byte flag
|
5907 |
|
|
LAB_2702
|
5908 |
|
|
PLP ; restore FAC2-FAC1 compare status
|
5909 |
|
|
BCC LAB_2704 ; if FAC2 < FAC1 then skip the subtract
|
5910 |
|
|
|
5911 |
|
|
TAY ; save FAC2-FAC1 compare status
|
5912 |
|
|
LDA FAC2_3 ; get FAC2 mantissa3
|
5913 |
|
|
SBC FAC1_3 ; subtract FAC1 mantissa3
|
5914 |
|
|
STA FAC2_3 ; save FAC2 mantissa3
|
5915 |
|
|
LDA FAC2_2 ; get FAC2 mantissa2
|
5916 |
|
|
SBC FAC1_2 ; subtract FAC1 mantissa2
|
5917 |
|
|
STA FAC2_2 ; save FAC2 mantissa2
|
5918 |
|
|
LDA FAC2_1 ; get FAC2 mantissa1
|
5919 |
|
|
SBC FAC1_1 ; subtract FAC1 mantissa1
|
5920 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
5921 |
|
|
TYA ; restore FAC2-FAC1 compare status
|
5922 |
|
|
|
5923 |
|
|
; FAC2 = FAC2*2
|
5924 |
|
|
LAB_2704
|
5925 |
|
|
ASL FAC2_3 ; shift FAC2 mantissa3
|
5926 |
|
|
ROL FAC2_2 ; shift FAC2 mantissa2
|
5927 |
|
|
ROL FAC2_1 ; shift FAC2 mantissa1
|
5928 |
|
|
BCS LAB_26F4 ; loop with no compare
|
5929 |
|
|
|
5930 |
|
|
BMI LAB_26E4 ; loop with compare
|
5931 |
|
|
|
5932 |
|
|
BPL LAB_26F4 ; loop always with no compare
|
5933 |
|
|
|
5934 |
|
|
; do A<<6, save as FAC1 rounding byte, normalise and return
|
5935 |
|
|
|
5936 |
|
|
LAB_272B
|
5937 |
|
|
LSR ; shift b1 - b0 ..
|
5938 |
|
|
ROR ; ..
|
5939 |
|
|
ROR ; .. to b7 - b6
|
5940 |
|
|
STA FAC1_r ; save FAC1 rounding byte
|
5941 |
|
|
PLP ; dump FAC2-FAC1 compare status
|
5942 |
|
|
JMP LAB_273C ; copy temp to FAC1, normalise and return
|
5943 |
|
|
|
5944 |
|
|
; do "Divide by zero" error
|
5945 |
|
|
|
5946 |
|
|
LAB_2737
|
5947 |
|
|
LDX #$14 ; error code $14 ("Divide by zero" error)
|
5948 |
|
|
JMP LAB_XERR ; do error #X, then warm start
|
5949 |
|
|
|
5950 |
|
|
; copy temp to FAC1 and normalise
|
5951 |
|
|
|
5952 |
|
|
LAB_273C
|
5953 |
|
|
LDA FACt_1 ; get temp mantissa1
|
5954 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
5955 |
|
|
LDA FACt_2 ; get temp mantissa2
|
5956 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
5957 |
|
|
LDA FACt_3 ; get temp mantissa3
|
5958 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
5959 |
|
|
JMP LAB_24D5 ; normalise FAC1 and return
|
5960 |
|
|
|
5961 |
|
|
; unpack memory (AY) into FAC1
|
5962 |
|
|
|
5963 |
|
|
LAB_UFAC
|
5964 |
|
|
STA ut1_pl ; save pointer low byte
|
5965 |
|
|
STY ut1_ph ; save pointer high byte
|
5966 |
|
|
LDY #$03 ; 4 bytes to do
|
5967 |
|
|
LDA (ut1_pl),Y ; get last byte
|
5968 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
5969 |
|
|
DEY ; decrement index
|
5970 |
|
|
LDA (ut1_pl),Y ; get last-1 byte
|
5971 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
5972 |
|
|
DEY ; decrement index
|
5973 |
|
|
LDA (ut1_pl),Y ; get second byte
|
5974 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
5975 |
|
|
ORA #$80 ; set 1xxx xxxx (add normal bit)
|
5976 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
5977 |
|
|
DEY ; decrement index
|
5978 |
|
|
LDA (ut1_pl),Y ; get first byte (exponent)
|
5979 |
|
|
STA FAC1_e ; save FAC1 exponent
|
5980 |
|
|
STY FAC1_r ; clear FAC1 rounding byte
|
5981 |
|
|
RTS
|
5982 |
|
|
|
5983 |
|
|
; pack FAC1 into Adatal
|
5984 |
|
|
|
5985 |
|
|
LAB_276E
|
5986 |
|
|
LDX #
|
5987 |
|
|
LAB_2770
|
5988 |
|
|
LDY #>Adatal ; set pointer high byte
|
5989 |
|
|
BEQ LAB_2778 ; pack FAC1 into (XY) and return
|
5990 |
|
|
|
5991 |
|
|
; pack FAC1 into (Lvarpl)
|
5992 |
|
|
|
5993 |
|
|
LAB_PFAC
|
5994 |
|
|
LDX Lvarpl ; get destination pointer low byte
|
5995 |
|
|
LDY Lvarph ; get destination pointer high byte
|
5996 |
|
|
|
5997 |
|
|
; pack FAC1 into (XY)
|
5998 |
|
|
|
5999 |
|
|
LAB_2778
|
6000 |
|
|
JSR LAB_27BA ; round FAC1
|
6001 |
|
|
STX ut1_pl ; save pointer low byte
|
6002 |
|
|
STY ut1_ph ; save pointer high byte
|
6003 |
|
|
LDY #$03 ; set index
|
6004 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
6005 |
|
|
STA (ut1_pl),Y ; store in destination
|
6006 |
|
|
DEY ; decrement index
|
6007 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
6008 |
|
|
STA (ut1_pl),Y ; store in destination
|
6009 |
|
|
DEY ; decrement index
|
6010 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6011 |
|
|
ORA #$7F ; set bits x111 1111
|
6012 |
|
|
AND FAC1_1 ; AND in FAC1 mantissa1
|
6013 |
|
|
STA (ut1_pl),Y ; store in destination
|
6014 |
|
|
DEY ; decrement index
|
6015 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6016 |
|
|
STA (ut1_pl),Y ; store in destination
|
6017 |
|
|
STY FAC1_r ; clear FAC1 rounding byte
|
6018 |
|
|
RTS
|
6019 |
|
|
|
6020 |
|
|
; round and copy FAC1 to FAC2
|
6021 |
|
|
|
6022 |
|
|
LAB_27AB
|
6023 |
|
|
JSR LAB_27BA ; round FAC1
|
6024 |
|
|
|
6025 |
|
|
; copy FAC1 to FAC2
|
6026 |
|
|
|
6027 |
|
|
LAB_27AE
|
6028 |
|
|
LDX #$05 ; 5 bytes to copy
|
6029 |
|
|
LAB_27B0
|
6030 |
|
|
LDA FAC1_e-1,X ; get byte from FAC1,X
|
6031 |
|
|
STA FAC1_o,X ; save byte at FAC2,X
|
6032 |
|
|
DEX ; decrement count
|
6033 |
|
|
BNE LAB_27B0 ; loop if not all done
|
6034 |
|
|
|
6035 |
|
|
STX FAC1_r ; clear FAC1 rounding byte
|
6036 |
|
|
LAB_27B9
|
6037 |
|
|
RTS
|
6038 |
|
|
|
6039 |
|
|
; round FAC1
|
6040 |
|
|
|
6041 |
|
|
LAB_27BA
|
6042 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6043 |
|
|
BEQ LAB_27B9 ; exit if zero
|
6044 |
|
|
|
6045 |
|
|
ASL FAC1_r ; shift FAC1 rounding byte
|
6046 |
|
|
BCC LAB_27B9 ; exit if no overflow
|
6047 |
|
|
|
6048 |
|
|
; round FAC1 (no check)
|
6049 |
|
|
|
6050 |
|
|
LAB_27C2
|
6051 |
|
|
JSR LAB_2559 ; increment FAC1 mantissa
|
6052 |
|
|
BNE LAB_27B9 ; branch if no overflow
|
6053 |
|
|
|
6054 |
|
|
JMP LAB_252A ; normalise FAC1 for C=1 and return
|
6055 |
|
|
|
6056 |
|
|
; get FAC1 sign
|
6057 |
|
|
; return A=FF,C=1/-ve A=01,C=0/+ve
|
6058 |
|
|
|
6059 |
|
|
LAB_27CA
|
6060 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6061 |
|
|
BEQ LAB_27D7 ; exit if zero (already correct SGN(0)=0)
|
6062 |
|
|
|
6063 |
|
|
; return A=FF,C=1/-ve A=01,C=0/+ve
|
6064 |
|
|
; no = 0 check
|
6065 |
|
|
|
6066 |
|
|
LAB_27CE
|
6067 |
|
|
LDA FAC1_s ; else get FAC1 sign (b7)
|
6068 |
|
|
|
6069 |
|
|
; return A=FF,C=1/-ve A=01,C=0/+ve
|
6070 |
|
|
; no = 0 check, sign in A
|
6071 |
|
|
|
6072 |
|
|
LAB_27D0
|
6073 |
|
|
ROL ; move sign bit to carry
|
6074 |
|
|
LDA #$FF ; set byte for -ve result
|
6075 |
|
|
BCS LAB_27D7 ; return if sign was set (-ve)
|
6076 |
|
|
|
6077 |
|
|
LDA #$01 ; else set byte for +ve result
|
6078 |
|
|
LAB_27D7
|
6079 |
|
|
RTS
|
6080 |
|
|
|
6081 |
|
|
; perform SGN()
|
6082 |
|
|
|
6083 |
|
|
LAB_SGN
|
6084 |
|
|
JSR LAB_27CA ; get FAC1 sign
|
6085 |
|
|
; return A=$FF/-ve A=$01/+ve
|
6086 |
|
|
; save A as integer byte
|
6087 |
|
|
|
6088 |
|
|
LAB_27DB
|
6089 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
6090 |
|
|
LDA #$00 ; clear A
|
6091 |
|
|
STA FAC1_2 ; clear FAC1 mantissa2
|
6092 |
|
|
LDX #$88 ; set exponent
|
6093 |
|
|
|
6094 |
|
|
; set exp=X, clearFAC1 mantissa3 and normalise
|
6095 |
|
|
|
6096 |
|
|
LAB_27E3
|
6097 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
6098 |
|
|
EOR #$FF ; complement it
|
6099 |
|
|
ROL ; sign bit into carry
|
6100 |
|
|
|
6101 |
|
|
; set exp=X, clearFAC1 mantissa3 and normalise
|
6102 |
|
|
|
6103 |
|
|
LAB_STFA
|
6104 |
|
|
LDA #$00 ; clear A
|
6105 |
|
|
STA FAC1_3 ; clear FAC1 mantissa3
|
6106 |
|
|
STX FAC1_e ; set FAC1 exponent
|
6107 |
|
|
STA FAC1_r ; clear FAC1 rounding byte
|
6108 |
|
|
STA FAC1_s ; clear FAC1 sign (b7)
|
6109 |
|
|
JMP LAB_24D0 ; do ABS and normalise FAC1
|
6110 |
|
|
|
6111 |
|
|
; perform ABS()
|
6112 |
|
|
|
6113 |
|
|
LAB_ABS
|
6114 |
|
|
LSR FAC1_s ; clear FAC1 sign (put zero in b7)
|
6115 |
|
|
RTS
|
6116 |
|
|
|
6117 |
|
|
; compare FAC1 with (AY)
|
6118 |
|
|
; returns A=$00 if FAC1 = (AY)
|
6119 |
|
|
; returns A=$01 if FAC1 > (AY)
|
6120 |
|
|
; returns A=$FF if FAC1 < (AY)
|
6121 |
|
|
|
6122 |
|
|
LAB_27F8
|
6123 |
|
|
STA ut2_pl ; save pointer low byte
|
6124 |
|
|
LAB_27FA
|
6125 |
|
|
STY ut2_ph ; save pointer high byte
|
6126 |
|
|
LDY #$00 ; clear index
|
6127 |
|
|
LDA (ut2_pl),Y ; get exponent
|
6128 |
|
|
INY ; increment index
|
6129 |
|
|
TAX ; copy (AY) exponent to X
|
6130 |
|
|
BEQ LAB_27CA ; branch if (AY) exponent=0 and get FAC1 sign
|
6131 |
|
|
; A=FF,C=1/-ve A=01,C=0/+ve
|
6132 |
|
|
|
6133 |
|
|
LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign)
|
6134 |
|
|
EOR FAC1_s ; EOR FAC1 sign (b7)
|
6135 |
|
|
BMI LAB_27CE ; if signs <> do return A=FF,C=1/-ve
|
6136 |
|
|
; A=01,C=0/+ve and return
|
6137 |
|
|
|
6138 |
|
|
CPX FAC1_e ; compare (AY) exponent with FAC1 exponent
|
6139 |
|
|
BNE LAB_2828 ; branch if different
|
6140 |
|
|
|
6141 |
|
|
LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign)
|
6142 |
|
|
ORA #$80 ; normalise top bit
|
6143 |
|
|
CMP FAC1_1 ; compare with FAC1 mantissa1
|
6144 |
|
|
BNE LAB_2828 ; branch if different
|
6145 |
|
|
|
6146 |
|
|
INY ; increment index
|
6147 |
|
|
LDA (ut2_pl),Y ; get mantissa2
|
6148 |
|
|
CMP FAC1_2 ; compare with FAC1 mantissa2
|
6149 |
|
|
BNE LAB_2828 ; branch if different
|
6150 |
|
|
|
6151 |
|
|
INY ; increment index
|
6152 |
|
|
LDA #$7F ; set for 1/2 value rounding byte
|
6153 |
|
|
CMP FAC1_r ; compare with FAC1 rounding byte (set carry)
|
6154 |
|
|
LDA (ut2_pl),Y ; get mantissa3
|
6155 |
|
|
SBC FAC1_3 ; subtract FAC1 mantissa3
|
6156 |
|
|
BEQ LAB_2850 ; exit if mantissa3 equal
|
6157 |
|
|
|
6158 |
|
|
; gets here if number <> FAC1
|
6159 |
|
|
|
6160 |
|
|
LAB_2828
|
6161 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6162 |
|
|
BCC LAB_282E ; branch if FAC1 > (AY)
|
6163 |
|
|
|
6164 |
|
|
EOR #$FF ; else toggle FAC1 sign
|
6165 |
|
|
LAB_282E
|
6166 |
|
|
JMP LAB_27D0 ; return A=FF,C=1/-ve A=01,C=0/+ve
|
6167 |
|
|
|
6168 |
|
|
; convert FAC1 floating-to-fixed
|
6169 |
|
|
|
6170 |
|
|
LAB_2831
|
6171 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6172 |
|
|
BEQ LAB_287F ; if zero go clear FAC1 and return
|
6173 |
|
|
|
6174 |
|
|
SEC ; set carry for subtract
|
6175 |
|
|
SBC #$98 ; subtract maximum integer range exponent
|
6176 |
|
|
BIT FAC1_s ; test FAC1 sign (b7)
|
6177 |
|
|
BPL LAB_2845 ; branch if FAC1 +ve
|
6178 |
|
|
|
6179 |
|
|
; FAC1 was -ve
|
6180 |
|
|
TAX ; copy subtracted exponent
|
6181 |
|
|
LDA #$FF ; overflow for -ve number
|
6182 |
|
|
STA FAC1_o ; set FAC1 overflow byte
|
6183 |
|
|
JSR LAB_253D ; twos complement FAC1 mantissa
|
6184 |
|
|
TXA ; restore subtracted exponent
|
6185 |
|
|
LAB_2845
|
6186 |
|
|
LDX #FAC1_e ; set index to FAC1
|
6187 |
|
|
CMP #$F9 ; compare exponent result
|
6188 |
|
|
BPL LAB_2851 ; if < 8 shifts shift FAC1 A times right and return
|
6189 |
|
|
|
6190 |
|
|
JSR LAB_257B ; shift FAC1 A times right (> 8 shifts)
|
6191 |
|
|
STY FAC1_o ; clear FAC1 overflow byte
|
6192 |
|
|
LAB_2850
|
6193 |
|
|
RTS
|
6194 |
|
|
|
6195 |
|
|
; shift FAC1 A times right
|
6196 |
|
|
|
6197 |
|
|
LAB_2851
|
6198 |
|
|
TAY ; copy shift count
|
6199 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6200 |
|
|
AND #$80 ; mask sign bit only (x000 0000)
|
6201 |
|
|
LSR FAC1_1 ; shift FAC1 mantissa1
|
6202 |
|
|
ORA FAC1_1 ; OR sign in b7 FAC1 mantissa1
|
6203 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
6204 |
|
|
JSR LAB_2592 ; shift FAC1 Y times right
|
6205 |
|
|
STY FAC1_o ; clear FAC1 overflow byte
|
6206 |
|
|
RTS
|
6207 |
|
|
|
6208 |
|
|
; perform INT()
|
6209 |
|
|
|
6210 |
|
|
LAB_INT
|
6211 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6212 |
|
|
CMP #$98 ; compare with max int
|
6213 |
|
|
BCS LAB_2886 ; exit if >= (already int, too big for fractional part!)
|
6214 |
|
|
|
6215 |
|
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed
|
6216 |
|
|
STY FAC1_r ; save FAC1 rounding byte
|
6217 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6218 |
|
|
STY FAC1_s ; save FAC1 sign (b7)
|
6219 |
|
|
EOR #$80 ; toggle FAC1 sign
|
6220 |
|
|
ROL ; shift into carry
|
6221 |
|
|
LDA #$98 ; set new exponent
|
6222 |
|
|
STA FAC1_e ; save FAC1 exponent
|
6223 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
6224 |
|
|
STA Temp3 ; save for EXP() function
|
6225 |
|
|
JMP LAB_24D0 ; do ABS and normalise FAC1
|
6226 |
|
|
|
6227 |
|
|
; clear FAC1 and return
|
6228 |
|
|
|
6229 |
|
|
LAB_287F
|
6230 |
|
|
STA FAC1_1 ; clear FAC1 mantissa1
|
6231 |
|
|
STA FAC1_2 ; clear FAC1 mantissa2
|
6232 |
|
|
STA FAC1_3 ; clear FAC1 mantissa3
|
6233 |
|
|
TAY ; clear Y
|
6234 |
|
|
LAB_2886
|
6235 |
|
|
RTS
|
6236 |
|
|
|
6237 |
|
|
; get FAC1 from string
|
6238 |
|
|
; this routine now handles hex and binary values from strings
|
6239 |
|
|
; starting with "$" and "%" respectively
|
6240 |
|
|
|
6241 |
|
|
LAB_2887
|
6242 |
|
|
LDY #$00 ; clear Y
|
6243 |
|
|
STY Dtypef ; clear data type flag, $FF=string, $00=numeric
|
6244 |
|
|
LDX #$09 ; set index
|
6245 |
|
|
LAB_288B
|
6246 |
|
|
STY numexp,X ; clear byte
|
6247 |
|
|
DEX ; decrement index
|
6248 |
|
|
BPL LAB_288B ; loop until numexp to negnum (and FAC1) = $00
|
6249 |
|
|
|
6250 |
|
|
BCC LAB_28FE ; branch if 1st character numeric
|
6251 |
|
|
|
6252 |
|
|
; get FAC1 from string .. first character wasn't numeric
|
6253 |
|
|
|
6254 |
|
|
CMP #'-' ; else compare with "-"
|
6255 |
|
|
BNE LAB_289A ; branch if not "-"
|
6256 |
|
|
|
6257 |
|
|
STX negnum ; set flag for -ve number (X = $FF)
|
6258 |
|
|
BEQ LAB_289C ; branch always (go scan and check for hex/bin)
|
6259 |
|
|
|
6260 |
|
|
; get FAC1 from string .. first character wasn't numeric or -
|
6261 |
|
|
|
6262 |
|
|
LAB_289A
|
6263 |
|
|
CMP #'+' ; else compare with "+"
|
6264 |
|
|
BNE LAB_289D ; branch if not "+" (go check for hex/bin)
|
6265 |
|
|
|
6266 |
|
|
; was "+" or "-" to start, so get next character
|
6267 |
|
|
|
6268 |
|
|
LAB_289C
|
6269 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
6270 |
|
|
BCC LAB_28FE ; branch if numeric character
|
6271 |
|
|
|
6272 |
|
|
; code here for hex and binary numbers
|
6273 |
|
|
|
6274 |
|
|
LAB_289D
|
6275 |
|
|
CMP #'$' ; else compare with "$"
|
6276 |
|
|
BNE LAB_NHEX ; branch if not "$"
|
6277 |
|
|
|
6278 |
|
|
JMP LAB_CHEX ; branch if "$"
|
6279 |
|
|
|
6280 |
|
|
LAB_NHEX
|
6281 |
|
|
CMP #'%' ; else compare with "%"
|
6282 |
|
|
BNE LAB_28A3 ; branch if not "%" (continue original code)
|
6283 |
|
|
|
6284 |
|
|
JMP LAB_CBIN ; branch if "%"
|
6285 |
|
|
|
6286 |
|
|
LAB_289E
|
6287 |
|
|
JSR LAB_IGBY ; increment and scan memory (ignore + or get next number)
|
6288 |
|
|
LAB_28A1
|
6289 |
|
|
BCC LAB_28FE ; branch if numeric character
|
6290 |
|
|
|
6291 |
|
|
; get FAC1 from string .. character wasn't numeric, -, +, hex or binary
|
6292 |
|
|
|
6293 |
|
|
LAB_28A3
|
6294 |
|
|
CMP #'.' ; else compare with "."
|
6295 |
|
|
BEQ LAB_28D5 ; branch if "."
|
6296 |
|
|
|
6297 |
|
|
; get FAC1 from string .. character wasn't numeric, -, + or .
|
6298 |
|
|
|
6299 |
|
|
CMP #'E' ; else compare with "E"
|
6300 |
|
|
BNE LAB_28DB ; branch if not "E"
|
6301 |
|
|
|
6302 |
|
|
; was "E" so evaluate exponential part
|
6303 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
6304 |
|
|
BCC LAB_28C7 ; branch if numeric character
|
6305 |
|
|
|
6306 |
|
|
CMP #TK_MINUS ; else compare with token for -
|
6307 |
|
|
BEQ LAB_28C2 ; branch if token for -
|
6308 |
|
|
|
6309 |
|
|
CMP #'-' ; else compare with "-"
|
6310 |
|
|
BEQ LAB_28C2 ; branch if "-"
|
6311 |
|
|
|
6312 |
|
|
CMP #TK_PLUS ; else compare with token for +
|
6313 |
|
|
BEQ LAB_28C4 ; branch if token for +
|
6314 |
|
|
|
6315 |
|
|
CMP #'+' ; else compare with "+"
|
6316 |
|
|
BEQ LAB_28C4 ; branch if "+"
|
6317 |
|
|
|
6318 |
|
|
BNE LAB_28C9 ; branch always
|
6319 |
|
|
|
6320 |
|
|
LAB_28C2
|
6321 |
|
|
ROR expneg ; set exponent -ve flag (C, which=1, into b7)
|
6322 |
|
|
LAB_28C4
|
6323 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
6324 |
|
|
LAB_28C7
|
6325 |
|
|
BCC LAB_2925 ; branch if numeric character
|
6326 |
|
|
|
6327 |
|
|
LAB_28C9
|
6328 |
|
|
BIT expneg ; test exponent -ve flag
|
6329 |
|
|
BPL LAB_28DB ; if +ve go evaluate exponent
|
6330 |
|
|
|
6331 |
|
|
; else do exponent = -exponent
|
6332 |
|
|
LDA #$00 ; clear result
|
6333 |
|
|
SEC ; set carry for subtract
|
6334 |
|
|
SBC expcnt ; subtract exponent byte
|
6335 |
|
|
JMP LAB_28DD ; go evaluate exponent
|
6336 |
|
|
|
6337 |
|
|
LAB_28D5
|
6338 |
|
|
ROR numdpf ; set decimal point flag
|
6339 |
|
|
BIT numdpf ; test decimal point flag
|
6340 |
|
|
BVC LAB_289E ; branch if only one decimal point so far
|
6341 |
|
|
|
6342 |
|
|
; evaluate exponent
|
6343 |
|
|
LAB_28DB
|
6344 |
|
|
LDA expcnt ; get exponent count byte
|
6345 |
|
|
LAB_28DD
|
6346 |
|
|
SEC ; set carry for subtract
|
6347 |
|
|
SBC numexp ; subtract numerator exponent
|
6348 |
|
|
STA expcnt ; save exponent count byte
|
6349 |
|
|
BEQ LAB_28F6 ; branch if no adjustment
|
6350 |
|
|
|
6351 |
|
|
BPL LAB_28EF ; else if +ve go do FAC1*10^expcnt
|
6352 |
|
|
|
6353 |
|
|
; else go do FAC1/10^(0-expcnt)
|
6354 |
|
|
LAB_28E6
|
6355 |
|
|
JSR LAB_26B9 ; divide by 10
|
6356 |
|
|
INC expcnt ; increment exponent count byte
|
6357 |
|
|
BNE LAB_28E6 ; loop until all done
|
6358 |
|
|
|
6359 |
|
|
BEQ LAB_28F6 ; branch always
|
6360 |
|
|
|
6361 |
|
|
LAB_28EF
|
6362 |
|
|
JSR LAB_269E ; multiply by 10
|
6363 |
|
|
DEC expcnt ; decrement exponent count byte
|
6364 |
|
|
BNE LAB_28EF ; loop until all done
|
6365 |
|
|
|
6366 |
|
|
LAB_28F6
|
6367 |
|
|
LDA negnum ; get -ve flag
|
6368 |
|
|
BMI LAB_28FB ; if -ve do - FAC1 and return
|
6369 |
|
|
|
6370 |
|
|
RTS
|
6371 |
|
|
|
6372 |
|
|
; do - FAC1 and return
|
6373 |
|
|
|
6374 |
|
|
LAB_28FB
|
6375 |
|
|
JMP LAB_GTHAN ; do - FAC1 and return
|
6376 |
|
|
|
6377 |
|
|
; do unsigned FAC1*10+number
|
6378 |
|
|
|
6379 |
|
|
LAB_28FE
|
6380 |
|
|
PHA ; save character
|
6381 |
|
|
BIT numdpf ; test decimal point flag
|
6382 |
|
|
BPL LAB_2905 ; skip exponent increment if not set
|
6383 |
|
|
|
6384 |
|
|
INC numexp ; else increment number exponent
|
6385 |
|
|
LAB_2905
|
6386 |
|
|
JSR LAB_269E ; multiply FAC1 by 10
|
6387 |
|
|
PLA ; restore character
|
6388 |
|
|
AND #$0F ; convert to binary
|
6389 |
|
|
JSR LAB_2912 ; evaluate new ASCII digit
|
6390 |
|
|
JMP LAB_289E ; go do next character
|
6391 |
|
|
|
6392 |
|
|
; evaluate new ASCII digit
|
6393 |
|
|
|
6394 |
|
|
LAB_2912
|
6395 |
|
|
PHA ; save digit
|
6396 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
6397 |
|
|
PLA ; restore digit
|
6398 |
|
|
JSR LAB_27DB ; save A as integer byte
|
6399 |
|
|
LDA FAC2_s ; get FAC2 sign (b7)
|
6400 |
|
|
EOR FAC1_s ; toggle with FAC1 sign (b7)
|
6401 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
6402 |
|
|
LDX FAC1_e ; get FAC1 exponent
|
6403 |
|
|
JMP LAB_ADD ; add FAC2 to FAC1 and return
|
6404 |
|
|
|
6405 |
|
|
; evaluate next character of exponential part of number
|
6406 |
|
|
|
6407 |
|
|
LAB_2925
|
6408 |
|
|
LDA expcnt ; get exponent count byte
|
6409 |
|
|
CMP #$0A ; compare with 10 decimal
|
6410 |
|
|
BCC LAB_2934 ; branch if less
|
6411 |
|
|
|
6412 |
|
|
LDA #$64 ; make all -ve exponents = -100 decimal (causes underflow)
|
6413 |
|
|
BIT expneg ; test exponent -ve flag
|
6414 |
|
|
BMI LAB_2942 ; branch if -ve
|
6415 |
|
|
|
6416 |
|
|
JMP LAB_2564 ; else do overflow error
|
6417 |
|
|
|
6418 |
|
|
LAB_2934
|
6419 |
|
|
ASL ; * 2
|
6420 |
|
|
ASL ; * 4
|
6421 |
|
|
ADC expcnt ; * 5
|
6422 |
|
|
ASL ; * 10
|
6423 |
|
|
LDY #$00 ; set index
|
6424 |
|
|
ADC (Bpntrl),Y ; add character (will be $30 too much!)
|
6425 |
|
|
SBC #'0'-1 ; convert character to binary
|
6426 |
|
|
LAB_2942
|
6427 |
|
|
STA expcnt ; save exponent count byte
|
6428 |
|
|
JMP LAB_28C4 ; go get next character
|
6429 |
|
|
|
6430 |
|
|
; print " in line [LINE #]"
|
6431 |
|
|
|
6432 |
|
|
LAB_2953
|
6433 |
|
|
LDA #
|
6434 |
|
|
LDY #>LAB_LMSG ; point to " in line " message high byte
|
6435 |
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
6436 |
|
|
|
6437 |
|
|
; print Basic line #
|
6438 |
|
|
LDA Clineh ; get current line high byte
|
6439 |
|
|
LDX Clinel ; get current line low byte
|
6440 |
|
|
|
6441 |
|
|
; print XA as unsigned integer
|
6442 |
|
|
|
6443 |
|
|
LAB_295E
|
6444 |
|
|
STA FAC1_1 ; save low byte as FAC1 mantissa1
|
6445 |
|
|
STX FAC1_2 ; save high byte as FAC1 mantissa2
|
6446 |
|
|
LDX #$90 ; set exponent to 16d bits
|
6447 |
|
|
SEC ; set integer is +ve flag
|
6448 |
|
|
JSR LAB_STFA ; set exp=X, clearFAC1 mantissa3 and normalise
|
6449 |
|
|
LDY #$00 ; clear index
|
6450 |
|
|
TYA ; clear A
|
6451 |
|
|
JSR LAB_297B ; convert FAC1 to string, skip sign character save
|
6452 |
|
|
JMP LAB_18C3 ; print null terminated string from memory and return
|
6453 |
|
|
|
6454 |
|
|
; convert FAC1 to ASCII string result in (AY)
|
6455 |
|
|
; not any more, moved scratchpad to page 0
|
6456 |
|
|
|
6457 |
|
|
LAB_296E
|
6458 |
|
|
LDY #$01 ; set index = 1
|
6459 |
|
|
LDA #$20 ; character = " " (assume +ve)
|
6460 |
|
|
BIT FAC1_s ; test FAC1 sign (b7)
|
6461 |
|
|
BPL LAB_2978 ; branch if +ve
|
6462 |
|
|
|
6463 |
|
|
LDA #$2D ; else character = "-"
|
6464 |
|
|
LAB_2978
|
6465 |
|
|
STA Decss,Y ; save leading character (" " or "-")
|
6466 |
|
|
LAB_297B
|
6467 |
|
|
STA FAC1_s ; clear FAC1 sign (b7)
|
6468 |
|
|
STY Sendl ; save index
|
6469 |
|
|
INY ; increment index
|
6470 |
|
|
LDX FAC1_e ; get FAC1 exponent
|
6471 |
|
|
BNE LAB_2989 ; branch if FAC1<>0
|
6472 |
|
|
|
6473 |
|
|
; exponent was $00 so FAC1 is 0
|
6474 |
|
|
LDA #'0' ; set character = "0"
|
6475 |
|
|
JMP LAB_2A89 ; save last character, [EOT] and exit
|
6476 |
|
|
|
6477 |
|
|
; FAC1 is some non zero value
|
6478 |
|
|
LAB_2989
|
6479 |
|
|
LDA #$00 ; clear (number exponent count)
|
6480 |
|
|
CPX #$81 ; compare FAC1 exponent with $81 (>1.00000)
|
6481 |
|
|
|
6482 |
|
|
BCS LAB_299A ; branch if FAC1=>1
|
6483 |
|
|
|
6484 |
|
|
; FAC1<1
|
6485 |
|
|
LDA #
|
6486 |
|
|
LDY #>LAB_294F ; set pointer high byte to 1,000,000
|
6487 |
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY)
|
6488 |
|
|
LDA #$FA ; set number exponent count (-6)
|
6489 |
|
|
LAB_299A
|
6490 |
|
|
STA numexp ; save number exponent count
|
6491 |
|
|
LAB_299C
|
6492 |
|
|
LDA #
|
6493 |
|
|
LDY #>LAB_294B ; set pointer high byte to 999999.4375
|
6494 |
|
|
JSR LAB_27F8 ; compare FAC1 with (AY)
|
6495 |
|
|
BEQ LAB_29C3 ; exit if FAC1 = (AY)
|
6496 |
|
|
|
6497 |
|
|
BPL LAB_29B9 ; go do /10 if FAC1 > (AY)
|
6498 |
|
|
|
6499 |
|
|
; FAC1 < (AY)
|
6500 |
|
|
LAB_29A7
|
6501 |
|
|
LDA #
|
6502 |
|
|
LDY #>LAB_2947 ; set pointer high byte to 99999.9375
|
6503 |
|
|
JSR LAB_27F8 ; compare FAC1 with (AY)
|
6504 |
|
|
BEQ LAB_29B2 ; branch if FAC1 = (AY) (allow decimal places)
|
6505 |
|
|
|
6506 |
|
|
BPL LAB_29C0 ; branch if FAC1 > (AY) (no decimal places)
|
6507 |
|
|
|
6508 |
|
|
; FAC1 <= (AY)
|
6509 |
|
|
LAB_29B2
|
6510 |
|
|
JSR LAB_269E ; multiply by 10
|
6511 |
|
|
DEC numexp ; decrement number exponent count
|
6512 |
|
|
BNE LAB_29A7 ; go test again (branch always)
|
6513 |
|
|
|
6514 |
|
|
LAB_29B9
|
6515 |
|
|
JSR LAB_26B9 ; divide by 10
|
6516 |
|
|
INC numexp ; increment number exponent count
|
6517 |
|
|
BNE LAB_299C ; go test again (branch always)
|
6518 |
|
|
|
6519 |
|
|
; now we have just the digits to do
|
6520 |
|
|
|
6521 |
|
|
LAB_29C0
|
6522 |
|
|
JSR LAB_244E ; add 0.5 to FAC1 (round FAC1)
|
6523 |
|
|
LAB_29C3
|
6524 |
|
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed
|
6525 |
|
|
LDX #$01 ; set default digits before dp = 1
|
6526 |
|
|
LDA numexp ; get number exponent count
|
6527 |
|
|
CLC ; clear carry for add
|
6528 |
|
|
ADC #$07 ; up to 6 digits before point
|
6529 |
|
|
BMI LAB_29D8 ; if -ve then 1 digit before dp
|
6530 |
|
|
|
6531 |
|
|
CMP #$08 ; A>=8 if n>=1E6
|
6532 |
|
|
BCS LAB_29D9 ; branch if >= $08
|
6533 |
|
|
|
6534 |
|
|
; carry is clear
|
6535 |
|
|
ADC #$FF ; take 1 from digit count
|
6536 |
|
|
TAX ; copy to A
|
6537 |
|
|
LDA #$02 ;.set exponent adjust
|
6538 |
|
|
LAB_29D8
|
6539 |
|
|
SEC ; set carry for subtract
|
6540 |
|
|
LAB_29D9
|
6541 |
|
|
SBC #$02 ; -2
|
6542 |
|
|
STA expcnt ;.save exponent adjust
|
6543 |
|
|
STX numexp ; save digits before dp count
|
6544 |
|
|
TXA ; copy to A
|
6545 |
|
|
BEQ LAB_29E4 ; branch if no digits before dp
|
6546 |
|
|
|
6547 |
|
|
BPL LAB_29F7 ; branch if digits before dp
|
6548 |
|
|
|
6549 |
|
|
LAB_29E4
|
6550 |
|
|
LDY Sendl ; get output string index
|
6551 |
|
|
LDA #$2E ; character "."
|
6552 |
|
|
INY ; increment index
|
6553 |
|
|
STA Decss,Y ; save to output string
|
6554 |
|
|
TXA ;.
|
6555 |
|
|
BEQ LAB_29F5 ;.
|
6556 |
|
|
|
6557 |
|
|
LDA #'0' ; character "0"
|
6558 |
|
|
INY ; increment index
|
6559 |
|
|
STA Decss,Y ; save to output string
|
6560 |
|
|
LAB_29F5
|
6561 |
|
|
STY Sendl ; save output string index
|
6562 |
|
|
LAB_29F7
|
6563 |
|
|
LDY #$00 ; clear index (point to 100,000)
|
6564 |
|
|
LDX #$80 ;
|
6565 |
|
|
LAB_29FB
|
6566 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
6567 |
|
|
CLC ; clear carry for add
|
6568 |
|
|
ADC LAB_2A9C,Y ; add -ve LSB
|
6569 |
|
|
STA FAC1_3 ; save FAC1 mantissa3
|
6570 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
6571 |
|
|
ADC LAB_2A9B,Y ; add -ve NMSB
|
6572 |
|
|
STA FAC1_2 ; save FAC1 mantissa2
|
6573 |
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
6574 |
|
|
ADC LAB_2A9A,Y ; add -ve MSB
|
6575 |
|
|
STA FAC1_1 ; save FAC1 mantissa1
|
6576 |
|
|
INX ;
|
6577 |
|
|
BCS LAB_2A18 ;
|
6578 |
|
|
|
6579 |
|
|
BPL LAB_29FB ; not -ve so try again
|
6580 |
|
|
|
6581 |
|
|
BMI LAB_2A1A ;
|
6582 |
|
|
|
6583 |
|
|
LAB_2A18
|
6584 |
|
|
BMI LAB_29FB ;
|
6585 |
|
|
|
6586 |
|
|
LAB_2A1A
|
6587 |
|
|
TXA ;
|
6588 |
|
|
BCC LAB_2A21 ;
|
6589 |
|
|
|
6590 |
|
|
EOR #$FF ;
|
6591 |
|
|
ADC #$0A ;
|
6592 |
|
|
LAB_2A21
|
6593 |
|
|
ADC #'0'-1 ; add "0"-1 to result
|
6594 |
|
|
INY ; increment index ..
|
6595 |
|
|
INY ; .. to next less ..
|
6596 |
|
|
INY ; .. power of ten
|
6597 |
|
|
STY Cvaral ; save as current var address low byte
|
6598 |
|
|
LDY Sendl ; get output string index
|
6599 |
|
|
INY ; increment output string index
|
6600 |
|
|
TAX ; copy character to X
|
6601 |
|
|
AND #$7F ; mask out top bit
|
6602 |
|
|
STA Decss,Y ; save to output string
|
6603 |
|
|
DEC numexp ; decrement # of characters before the dp
|
6604 |
|
|
BNE LAB_2A3B ; branch if still characters to do
|
6605 |
|
|
|
6606 |
|
|
; else output the point
|
6607 |
|
|
LDA #$2E ; character "."
|
6608 |
|
|
INY ; increment output string index
|
6609 |
|
|
STA Decss,Y ; save to output string
|
6610 |
|
|
LAB_2A3B
|
6611 |
|
|
STY Sendl ; save output string index
|
6612 |
|
|
LDY Cvaral ; get current var address low byte
|
6613 |
|
|
TXA ; get character back
|
6614 |
|
|
EOR #$FF ;
|
6615 |
|
|
AND #$80 ;
|
6616 |
|
|
TAX ;
|
6617 |
|
|
CPY #$12 ; compare index with max
|
6618 |
|
|
BNE LAB_29FB ; loop if not max
|
6619 |
|
|
|
6620 |
|
|
; now remove trailing zeroes
|
6621 |
|
|
LDY Sendl ; get output string index
|
6622 |
|
|
LAB_2A4B
|
6623 |
|
|
LDA Decss,Y ; get character from output string
|
6624 |
|
|
DEY ; decrement output string index
|
6625 |
|
|
CMP #'0' ; compare with "0"
|
6626 |
|
|
BEQ LAB_2A4B ; loop until non "0" character found
|
6627 |
|
|
|
6628 |
|
|
CMP #'.' ; compare with "."
|
6629 |
|
|
BEQ LAB_2A58 ; branch if was dp
|
6630 |
|
|
|
6631 |
|
|
; restore last character
|
6632 |
|
|
INY ; increment output string index
|
6633 |
|
|
LAB_2A58
|
6634 |
|
|
LDA #$2B ; character "+"
|
6635 |
|
|
LDX expcnt ; get exponent count
|
6636 |
|
|
BEQ LAB_2A8C ; if zero go set null terminator and exit
|
6637 |
|
|
|
6638 |
|
|
; exponent isn't zero so write exponent
|
6639 |
|
|
BPL LAB_2A68 ; branch if exponent count +ve
|
6640 |
|
|
|
6641 |
|
|
LDA #$00 ; clear A
|
6642 |
|
|
SEC ; set carry for subtract
|
6643 |
|
|
SBC expcnt ; subtract exponent count adjust (convert -ve to +ve)
|
6644 |
|
|
TAX ; copy exponent count to X
|
6645 |
|
|
LDA #'-' ; character "-"
|
6646 |
|
|
LAB_2A68
|
6647 |
|
|
STA Decss+2,Y ; save to output string
|
6648 |
|
|
LDA #$45 ; character "E"
|
6649 |
|
|
STA Decss+1,Y ; save exponent sign to output string
|
6650 |
|
|
TXA ; get exponent count back
|
6651 |
|
|
LDX #'0'-1 ; one less than "0" character
|
6652 |
|
|
SEC ; set carry for subtract
|
6653 |
|
|
LAB_2A74
|
6654 |
|
|
INX ; increment 10's character
|
6655 |
|
|
SBC #$0A ;.subtract 10 from exponent count
|
6656 |
|
|
BCS LAB_2A74 ; loop while still >= 0
|
6657 |
|
|
|
6658 |
|
|
ADC #':' ; add character ":" ($30+$0A, result is 10 less that value)
|
6659 |
|
|
STA Decss+4,Y ; save to output string
|
6660 |
|
|
TXA ; copy 10's character
|
6661 |
|
|
STA Decss+3,Y ; save to output string
|
6662 |
|
|
LDA #$00 ; set null terminator
|
6663 |
|
|
STA Decss+5,Y ; save to output string
|
6664 |
|
|
BEQ LAB_2A91 ; go set string pointer (AY) and exit (branch always)
|
6665 |
|
|
|
6666 |
|
|
; save last character, [EOT] and exit
|
6667 |
|
|
LAB_2A89
|
6668 |
|
|
STA Decss,Y ; save last character to output string
|
6669 |
|
|
|
6670 |
|
|
; set null terminator and exit
|
6671 |
|
|
LAB_2A8C
|
6672 |
|
|
LDA #$00 ; set null terminator
|
6673 |
|
|
STA Decss+1,Y ; save after last character
|
6674 |
|
|
|
6675 |
|
|
; set string pointer (AY) and exit
|
6676 |
|
|
LAB_2A91
|
6677 |
|
|
LDA #
|
6678 |
|
|
LDY #>Decssp1 ; set result string high pointer
|
6679 |
|
|
RTS
|
6680 |
|
|
|
6681 |
|
|
; perform power function
|
6682 |
|
|
|
6683 |
|
|
LAB_POWER
|
6684 |
|
|
BEQ LAB_EXP ; go do EXP()
|
6685 |
|
|
|
6686 |
|
|
LDA FAC2_e ; get FAC2 exponent
|
6687 |
|
|
BNE LAB_2ABF ; branch if FAC2<>0
|
6688 |
|
|
|
6689 |
|
|
JMP LAB_24F3 ; clear FAC1 exponent and sign and return
|
6690 |
|
|
|
6691 |
|
|
LAB_2ABF
|
6692 |
|
|
LDX #
|
6693 |
|
|
LDY #>func_l ; set destination pointer high byte
|
6694 |
|
|
JSR LAB_2778 ; pack FAC1 into (XY)
|
6695 |
|
|
LDA FAC2_s ; get FAC2 sign (b7)
|
6696 |
|
|
BPL LAB_2AD9 ; branch if FAC2>0
|
6697 |
|
|
|
6698 |
|
|
; else FAC2 is -ve and can only be raised to an
|
6699 |
|
|
; integer power which gives an x +j0 result
|
6700 |
|
|
JSR LAB_INT ; perform INT
|
6701 |
|
|
LDA #
|
6702 |
|
|
LDY #>func_l ; set source pointer high byte
|
6703 |
|
|
JSR LAB_27F8 ; compare FAC1 with (AY)
|
6704 |
|
|
BNE LAB_2AD9 ; branch if FAC1 <> (AY) to allow Function Call error
|
6705 |
|
|
; this will leave FAC1 -ve and cause a Function Call
|
6706 |
|
|
; error when LOG() is called
|
6707 |
|
|
|
6708 |
|
|
TYA ; clear sign b7
|
6709 |
|
|
LDY Temp3 ; save mantissa 3 from INT() function as sign in Y
|
6710 |
|
|
; for possible later negation, b0
|
6711 |
|
|
LAB_2AD9
|
6712 |
|
|
JSR LAB_279D ; save FAC1 sign and copy ABS(FAC2) to FAC1
|
6713 |
|
|
TYA ; copy sign back ..
|
6714 |
|
|
PHA ; .. and save it
|
6715 |
|
|
JSR LAB_LOG ; do LOG(n)
|
6716 |
|
|
LDA #
|
6717 |
|
|
LDY #>garb_l ; set pointer high byte
|
6718 |
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY) (square the value)
|
6719 |
|
|
JSR LAB_EXP ; go do EXP(n)
|
6720 |
|
|
PLA ; pull sign from stack
|
6721 |
|
|
LSR ; b0 is to be tested, shift to Cb
|
6722 |
|
|
BCC LAB_2AF9 ; if no bit then exit
|
6723 |
|
|
|
6724 |
|
|
; Perform negation
|
6725 |
|
|
; do - FAC1
|
6726 |
|
|
|
6727 |
|
|
LAB_GTHAN
|
6728 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6729 |
|
|
BEQ LAB_2AF9 ; exit if FAC1_e = $00
|
6730 |
|
|
|
6731 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6732 |
|
|
EOR #$FF ; complement it
|
6733 |
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
6734 |
|
|
LAB_2AF9
|
6735 |
|
|
RTS
|
6736 |
|
|
|
6737 |
|
|
; perform EXP() (x^e)
|
6738 |
|
|
|
6739 |
|
|
LAB_EXP
|
6740 |
|
|
LDA #
|
6741 |
|
|
LDY #>LAB_2AFA ; set 1.443 pointer high byte
|
6742 |
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY)
|
6743 |
|
|
LDA FAC1_r ; get FAC1 rounding byte
|
6744 |
|
|
ADC #$50 ; +$50/$100
|
6745 |
|
|
BCC LAB_2B2B ; skip rounding if no carry
|
6746 |
|
|
|
6747 |
|
|
JSR LAB_27C2 ; round FAC1 (no check)
|
6748 |
|
|
LAB_2B2B
|
6749 |
|
|
STA FAC2_r ; save FAC2 rounding byte
|
6750 |
|
|
JSR LAB_27AE ; copy FAC1 to FAC2
|
6751 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6752 |
|
|
CMP #$88 ; compare with EXP limit (256d)
|
6753 |
|
|
BCC LAB_2B39 ; branch if less
|
6754 |
|
|
|
6755 |
|
|
LAB_2B36
|
6756 |
|
|
JSR LAB_2690 ; handle overflow and underflow
|
6757 |
|
|
LAB_2B39
|
6758 |
|
|
JSR LAB_INT ; perform INT
|
6759 |
|
|
LDA Temp3 ; get mantissa 3 from INT() function
|
6760 |
|
|
CLC ; clear carry for add
|
6761 |
|
|
ADC #$81 ; normalise +1
|
6762 |
|
|
BEQ LAB_2B36 ; if $00 go handle overflow
|
6763 |
|
|
|
6764 |
|
|
SEC ; set carry for subtract
|
6765 |
|
|
SBC #$01 ; now correct for exponent
|
6766 |
|
|
PHA ; save FAC2 exponent
|
6767 |
|
|
|
6768 |
|
|
; swap FAC1 and FAC2
|
6769 |
|
|
LDX #$04 ; 4 bytes to do
|
6770 |
|
|
LAB_2B49
|
6771 |
|
|
LDA FAC2_e,X ; get FAC2,X
|
6772 |
|
|
LDY FAC1_e,X ; get FAC1,X
|
6773 |
|
|
STA FAC1_e,X ; save FAC1,X
|
6774 |
|
|
STY FAC2_e,X ; save FAC2,X
|
6775 |
|
|
DEX ; decrement count/index
|
6776 |
|
|
BPL LAB_2B49 ; loop if not all done
|
6777 |
|
|
|
6778 |
|
|
LDA FAC2_r ; get FAC2 rounding byte
|
6779 |
|
|
STA FAC1_r ; save as FAC1 rounding byte
|
6780 |
|
|
JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1
|
6781 |
|
|
JSR LAB_GTHAN ; do - FAC1
|
6782 |
|
|
LDA #
|
6783 |
|
|
LDY #>LAB_2AFE ; set counter pointer high byte
|
6784 |
|
|
JSR LAB_2B84 ; go do series evaluation
|
6785 |
|
|
LDA #$00 ; clear A
|
6786 |
|
|
STA FAC_sc ; clear sign compare (FAC1 EOR FAC2)
|
6787 |
|
|
PLA ;.get saved FAC2 exponent
|
6788 |
|
|
JMP LAB_2675 ; test and adjust accumulators and return
|
6789 |
|
|
|
6790 |
|
|
; ^2 then series evaluation
|
6791 |
|
|
|
6792 |
|
|
LAB_2B6E
|
6793 |
|
|
STA Cptrl ; save count pointer low byte
|
6794 |
|
|
STY Cptrh ; save count pointer high byte
|
6795 |
|
|
JSR LAB_276E ; pack FAC1 into Adatal
|
6796 |
|
|
LDA #
|
6797 |
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY)
|
6798 |
|
|
JSR LAB_2B88 ; go do series evaluation
|
6799 |
|
|
LDA #
|
6800 |
|
|
LDY #>Adatal ; pointer to original # high byte
|
6801 |
|
|
JMP LAB_25FB ; do convert AY, FCA1*(AY) and return
|
6802 |
|
|
|
6803 |
|
|
; series evaluation
|
6804 |
|
|
|
6805 |
|
|
LAB_2B84
|
6806 |
|
|
STA Cptrl ; save count pointer low byte
|
6807 |
|
|
STY Cptrh ; save count pointer high byte
|
6808 |
|
|
LAB_2B88
|
6809 |
|
|
LDX #
|
6810 |
|
|
JSR LAB_2770 ; set pointer high byte and pack FAC1 into numexp
|
6811 |
|
|
LDA (Cptrl),Y ; get constants count
|
6812 |
|
|
STA numcon ; save constants count
|
6813 |
|
|
LDY Cptrl ; get count pointer low byte
|
6814 |
|
|
INY ; increment it (now constants pointer)
|
6815 |
|
|
TYA ; copy it
|
6816 |
|
|
BNE LAB_2B97 ; skip next if no overflow
|
6817 |
|
|
|
6818 |
|
|
INC Cptrh ; else increment high byte
|
6819 |
|
|
LAB_2B97
|
6820 |
|
|
STA Cptrl ; save low byte
|
6821 |
|
|
LDY Cptrh ; get high byte
|
6822 |
|
|
LAB_2B9B
|
6823 |
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY)
|
6824 |
|
|
LDA Cptrl ; get constants pointer low byte
|
6825 |
|
|
LDY Cptrh ; get constants pointer high byte
|
6826 |
|
|
CLC ; clear carry for add
|
6827 |
|
|
ADC #$04 ; +4 to low pointer (4 bytes per constant)
|
6828 |
|
|
BCC LAB_2BA8 ; skip next if no overflow
|
6829 |
|
|
|
6830 |
|
|
INY ; increment high byte
|
6831 |
|
|
LAB_2BA8
|
6832 |
|
|
STA Cptrl ; save pointer low byte
|
6833 |
|
|
STY Cptrh ; save pointer high byte
|
6834 |
|
|
JSR LAB_246C ; add (AY) to FAC1
|
6835 |
|
|
LDA #
|
6836 |
|
|
LDY #>numexp ; set pointer high byte to partial @ numexp
|
6837 |
|
|
DEC numcon ; decrement constants count
|
6838 |
|
|
BNE LAB_2B9B ; loop until all done
|
6839 |
|
|
|
6840 |
|
|
RTS
|
6841 |
|
|
|
6842 |
|
|
; RND(n), 32 bit Galoise version. make n=0 for 19th next number in sequence or n<>0
|
6843 |
|
|
; to get 19th next number in sequence after seed n. This version of the PRNG uses
|
6844 |
|
|
; the Galois method and a sample of 65536 bytes produced gives the following values.
|
6845 |
|
|
|
6846 |
|
|
; Entropy = 7.997442 bits per byte
|
6847 |
|
|
; Optimum compression would reduce these 65536 bytes by 0 percent
|
6848 |
|
|
|
6849 |
|
|
; Chi square distribution for 65536 samples is 232.01, and
|
6850 |
|
|
; randomly would exceed this value 75.00 percent of the time
|
6851 |
|
|
|
6852 |
|
|
; Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
|
6853 |
|
|
; Monte Carlo value for Pi is 3.122871269, error 0.60 percent
|
6854 |
|
|
; Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0
|
6855 |
|
|
|
6856 |
|
|
LAB_RND
|
6857 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6858 |
|
|
BEQ NextPRN ; do next random # if zero
|
6859 |
|
|
|
6860 |
|
|
; else get seed into random number store
|
6861 |
|
|
LDX #Rbyte4 ; set PRNG pointer low byte
|
6862 |
|
|
LDY #$00 ; set PRNG pointer high byte
|
6863 |
|
|
JSR LAB_2778 ; pack FAC1 into (XY)
|
6864 |
|
|
NextPRN
|
6865 |
|
|
LDX #$AF ; set EOR byte
|
6866 |
|
|
LDY #$13 ; do this nineteen times
|
6867 |
|
|
LoopPRN
|
6868 |
|
|
ASL Rbyte1 ; shift PRNG most significant byte
|
6869 |
|
|
ROL Rbyte2 ; shift PRNG middle byte
|
6870 |
|
|
ROL Rbyte3 ; shift PRNG least significant byte
|
6871 |
|
|
ROL Rbyte4 ; shift PRNG extra byte
|
6872 |
|
|
BCC Ninc1 ; branch if bit 32 clear
|
6873 |
|
|
|
6874 |
|
|
TXA ; set EOR byte
|
6875 |
|
|
EOR Rbyte1 ; EOR PRNG extra byte
|
6876 |
|
|
STA Rbyte1 ; save new PRNG extra byte
|
6877 |
|
|
Ninc1
|
6878 |
|
|
DEY ; decrement loop count
|
6879 |
|
|
BNE LoopPRN ; loop if not all done
|
6880 |
|
|
|
6881 |
|
|
LDX #$02 ; three bytes to copy
|
6882 |
|
|
CopyPRNG
|
6883 |
|
|
LDA Rbyte1,X ; get PRNG byte
|
6884 |
|
|
STA FAC1_1,X ; save FAC1 byte
|
6885 |
|
|
DEX
|
6886 |
|
|
BPL CopyPRNG ; loop if not complete
|
6887 |
|
|
|
6888 |
|
|
LDA #$80 ; set the exponent
|
6889 |
|
|
STA FAC1_e ; save FAC1 exponent
|
6890 |
|
|
|
6891 |
|
|
ASL ; clear A
|
6892 |
|
|
STA FAC1_s ; save FAC1 sign
|
6893 |
|
|
|
6894 |
|
|
JMP LAB_24D5 ; normalise FAC1 and return
|
6895 |
|
|
|
6896 |
|
|
; perform COS()
|
6897 |
|
|
|
6898 |
|
|
LAB_COS
|
6899 |
|
|
LDA #
|
6900 |
|
|
LDY #>LAB_2C78 ; set (pi/2) pointer high byte
|
6901 |
|
|
JSR LAB_246C ; add (AY) to FAC1
|
6902 |
|
|
|
6903 |
|
|
; perform SIN()
|
6904 |
|
|
|
6905 |
|
|
LAB_SIN
|
6906 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
6907 |
|
|
LDA #
|
6908 |
|
|
LDY #>LAB_2C7C ; set (2*pi) pointer high byte
|
6909 |
|
|
LDX FAC2_s ; get FAC2 sign (b7)
|
6910 |
|
|
JSR LAB_26C2 ; divide by (AY) (X=sign)
|
6911 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
6912 |
|
|
JSR LAB_INT ; perform INT
|
6913 |
|
|
LDA #$00 ; clear byte
|
6914 |
|
|
STA FAC_sc ; clear sign compare (FAC1 EOR FAC2)
|
6915 |
|
|
JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1
|
6916 |
|
|
LDA #
|
6917 |
|
|
LDY #>LAB_2C80 ; set 0.25 pointer high byte
|
6918 |
|
|
JSR LAB_2455 ; perform subtraction, (AY) from FAC1
|
6919 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6920 |
|
|
PHA ; save FAC1 sign
|
6921 |
|
|
BPL LAB_2C35 ; branch if +ve
|
6922 |
|
|
|
6923 |
|
|
; FAC1 sign was -ve
|
6924 |
|
|
JSR LAB_244E ; add 0.5 to FAC1
|
6925 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6926 |
|
|
BMI LAB_2C38 ; branch if -ve
|
6927 |
|
|
|
6928 |
|
|
LDA Cflag ; get comparison evaluation flag
|
6929 |
|
|
EOR #$FF ; toggle flag
|
6930 |
|
|
STA Cflag ; save comparison evaluation flag
|
6931 |
|
|
LAB_2C35
|
6932 |
|
|
JSR LAB_GTHAN ; do - FAC1
|
6933 |
|
|
LAB_2C38
|
6934 |
|
|
LDA #
|
6935 |
|
|
LDY #>LAB_2C80 ; set 0.25 pointer high byte
|
6936 |
|
|
JSR LAB_246C ; add (AY) to FAC1
|
6937 |
|
|
PLA ; restore FAC1 sign
|
6938 |
|
|
BPL LAB_2C45 ; branch if was +ve
|
6939 |
|
|
|
6940 |
|
|
; else correct FAC1
|
6941 |
|
|
JSR LAB_GTHAN ; do - FAC1
|
6942 |
|
|
LAB_2C45
|
6943 |
|
|
LDA #
|
6944 |
|
|
LDY #>LAB_2C84 ; set pointer high byte to counter
|
6945 |
|
|
JMP LAB_2B6E ; ^2 then series evaluation and return
|
6946 |
|
|
|
6947 |
|
|
; perform TAN()
|
6948 |
|
|
|
6949 |
|
|
LAB_TAN
|
6950 |
|
|
JSR LAB_276E ; pack FAC1 into Adatal
|
6951 |
|
|
LDA #$00 ; clear byte
|
6952 |
|
|
STA Cflag ; clear comparison evaluation flag
|
6953 |
|
|
JSR LAB_SIN ; go do SIN(n)
|
6954 |
|
|
LDX #
|
6955 |
|
|
LDY #>func_l ; set sin(n) pointer high byte
|
6956 |
|
|
JSR LAB_2778 ; pack FAC1 into (XY)
|
6957 |
|
|
LDA #
|
6958 |
|
|
LDY #>Adatal ; set n pointer high addr
|
6959 |
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
6960 |
|
|
LDA #$00 ; clear byte
|
6961 |
|
|
STA FAC1_s ; clear FAC1 sign (b7)
|
6962 |
|
|
LDA Cflag ; get comparison evaluation flag
|
6963 |
|
|
JSR LAB_2C74 ; save flag and go do series evaluation
|
6964 |
|
|
|
6965 |
|
|
LDA #
|
6966 |
|
|
LDY #>func_l ; set sin(n) pointer high byte
|
6967 |
|
|
JMP LAB_26CA ; convert AY and do (AY)/FAC1
|
6968 |
|
|
|
6969 |
|
|
LAB_2C74
|
6970 |
|
|
PHA ; save comparison evaluation flag
|
6971 |
|
|
JMP LAB_2C35 ; go do series evaluation
|
6972 |
|
|
|
6973 |
|
|
; perform USR()
|
6974 |
|
|
|
6975 |
|
|
LAB_USR
|
6976 |
|
|
JSR Usrjmp ; call user code
|
6977 |
|
|
JMP LAB_1BFB ; scan for ")", else do syntax error then warm start
|
6978 |
|
|
|
6979 |
|
|
; perform ATN()
|
6980 |
|
|
|
6981 |
|
|
LAB_ATN
|
6982 |
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
6983 |
|
|
PHA ; save sign
|
6984 |
|
|
BPL LAB_2CA1 ; branch if +ve
|
6985 |
|
|
|
6986 |
|
|
JSR LAB_GTHAN ; else do - FAC1
|
6987 |
|
|
LAB_2CA1
|
6988 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
6989 |
|
|
PHA ; push exponent
|
6990 |
|
|
CMP #$81 ; compare with 1
|
6991 |
|
|
BCC LAB_2CAF ; branch if FAC1<1
|
6992 |
|
|
|
6993 |
|
|
LDA #
|
6994 |
|
|
LDY #>LAB_259C ; set 1 pointer high byte
|
6995 |
|
|
JSR LAB_26CA ; convert AY and do (AY)/FAC1
|
6996 |
|
|
LAB_2CAF
|
6997 |
|
|
LDA #
|
6998 |
|
|
LDY #>LAB_2CC9 ; set pointer high byte to counter
|
6999 |
|
|
JSR LAB_2B6E ; ^2 then series evaluation
|
7000 |
|
|
PLA ; restore old FAC1 exponent
|
7001 |
|
|
CMP #$81 ; compare with 1
|
7002 |
|
|
BCC LAB_2CC2 ; branch if FAC1<1
|
7003 |
|
|
|
7004 |
|
|
LDA #
|
7005 |
|
|
LDY #>LAB_2C78 ; set (pi/2) pointer high byte
|
7006 |
|
|
JSR LAB_2455 ; perform subtraction, (AY) from FAC1
|
7007 |
|
|
LAB_2CC2
|
7008 |
|
|
PLA ; restore FAC1 sign
|
7009 |
|
|
BPL LAB_2D04 ; exit if was +ve
|
7010 |
|
|
|
7011 |
|
|
JMP LAB_GTHAN ; else do - FAC1 and return
|
7012 |
|
|
|
7013 |
|
|
; perform BITSET
|
7014 |
|
|
|
7015 |
|
|
LAB_BITSET
|
7016 |
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
7017 |
|
|
CPX #$08 ; only 0 to 7 are allowed
|
7018 |
|
|
BCS FCError ; branch if > 7
|
7019 |
|
|
|
7020 |
|
|
LDA #$00 ; clear A
|
7021 |
|
|
SEC ; set the carry
|
7022 |
|
|
S_Bits
|
7023 |
|
|
ROL ; shift bit
|
7024 |
|
|
DEX ; decrement bit number
|
7025 |
|
|
BPL S_Bits ; loop if still +ve
|
7026 |
|
|
|
7027 |
|
|
INX ; make X = $00
|
7028 |
|
|
ORA (Itempl,X) ; or with byte via temporary integer (addr)
|
7029 |
|
|
STA (Itempl,X) ; save byte via temporary integer (addr)
|
7030 |
|
|
LAB_2D04
|
7031 |
|
|
RTS
|
7032 |
|
|
|
7033 |
|
|
; perform BITCLR
|
7034 |
|
|
|
7035 |
|
|
LAB_BITCLR
|
7036 |
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
7037 |
|
|
CPX #$08 ; only 0 to 7 are allowed
|
7038 |
|
|
BCS FCError ; branch if > 7
|
7039 |
|
|
|
7040 |
|
|
LDA #$FF ; set A
|
7041 |
|
|
S_Bitc
|
7042 |
|
|
ROL ; shift bit
|
7043 |
|
|
DEX ; decrement bit number
|
7044 |
|
|
BPL S_Bitc ; loop if still +ve
|
7045 |
|
|
|
7046 |
|
|
INX ; make X = $00
|
7047 |
|
|
AND (Itempl,X) ; and with byte via temporary integer (addr)
|
7048 |
|
|
STA (Itempl,X) ; save byte via temporary integer (addr)
|
7049 |
|
|
RTS
|
7050 |
|
|
|
7051 |
|
|
FCError
|
7052 |
|
|
JMP LAB_FCER ; do function call error then warm start
|
7053 |
|
|
|
7054 |
|
|
; perform BITTST()
|
7055 |
|
|
|
7056 |
|
|
LAB_BTST
|
7057 |
|
|
JSR LAB_IGBY ; increment BASIC pointer
|
7058 |
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
7059 |
|
|
CPX #$08 ; only 0 to 7 are allowed
|
7060 |
|
|
BCS FCError ; branch if > 7
|
7061 |
|
|
|
7062 |
|
|
JSR LAB_GBYT ; get next BASIC byte
|
7063 |
|
|
CMP #')' ; is next character ")"
|
7064 |
|
|
BEQ TST_OK ; if ")" go do rest of function
|
7065 |
|
|
|
7066 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
7067 |
|
|
|
7068 |
|
|
TST_OK
|
7069 |
|
|
JSR LAB_IGBY ; update BASIC execute pointer (to character past ")")
|
7070 |
|
|
LDA #$00 ; clear A
|
7071 |
|
|
SEC ; set the carry
|
7072 |
|
|
T_Bits
|
7073 |
|
|
ROL ; shift bit
|
7074 |
|
|
DEX ; decrement bit number
|
7075 |
|
|
BPL T_Bits ; loop if still +ve
|
7076 |
|
|
|
7077 |
|
|
INX ; make X = $00
|
7078 |
|
|
AND (Itempl,X) ; AND with byte via temporary integer (addr)
|
7079 |
|
|
BEQ LAB_NOTT ; branch if zero (already correct)
|
7080 |
|
|
|
7081 |
|
|
LDA #$FF ; set for -1 result
|
7082 |
|
|
LAB_NOTT
|
7083 |
|
|
JMP LAB_27DB ; go do SGN tail
|
7084 |
|
|
|
7085 |
|
|
; perform BIN$()
|
7086 |
|
|
|
7087 |
|
|
LAB_BINS
|
7088 |
|
|
CPX #$19 ; max + 1
|
7089 |
|
|
BCS BinFErr ; exit if too big ( > or = )
|
7090 |
|
|
|
7091 |
|
|
STX TempB ; save # of characters ($00 = leading zero remove)
|
7092 |
|
|
LDA #$18 ; need A byte long space
|
7093 |
|
|
JSR LAB_MSSP ; make string space A bytes long
|
7094 |
|
|
LDY #$17 ; set index
|
7095 |
|
|
LDX #$18 ; character count
|
7096 |
|
|
NextB1
|
7097 |
|
|
LSR nums_1 ; shift highest byte
|
7098 |
|
|
ROR nums_2 ; shift middle byte
|
7099 |
|
|
ROR nums_3 ; shift lowest byte bit 0 to carry
|
7100 |
|
|
TXA ; load with "0"/2
|
7101 |
|
|
ROL ; shift in carry
|
7102 |
|
|
STA (str_pl),Y ; save to temp string + index
|
7103 |
|
|
DEY ; decrement index
|
7104 |
|
|
BPL NextB1 ; loop if not done
|
7105 |
|
|
|
7106 |
|
|
LDA TempB ; get # of characters
|
7107 |
|
|
BEQ EndBHS ; branch if truncate
|
7108 |
|
|
|
7109 |
|
|
TAX ; copy length to X
|
7110 |
|
|
SEC ; set carry for add !
|
7111 |
|
|
EOR #$FF ; 1's complement
|
7112 |
|
|
ADC #$18 ; add 24d
|
7113 |
|
|
BEQ GoPr2 ; if zero print whole string
|
7114 |
|
|
|
7115 |
|
|
BNE GoPr1 ; else go make output string
|
7116 |
|
|
|
7117 |
|
|
; this is the exit code and is also used by HEX$()
|
7118 |
|
|
; truncate string to remove leading "0"s
|
7119 |
|
|
|
7120 |
|
|
EndBHS
|
7121 |
|
|
TAY ; clear index (A=0, X=length here)
|
7122 |
|
|
NextB2
|
7123 |
|
|
LDA (str_pl),Y ; get character from string
|
7124 |
|
|
CMP #'0' ; compare with "0"
|
7125 |
|
|
BNE GoPr ; if not "0" then go print string from here
|
7126 |
|
|
|
7127 |
|
|
DEX ; decrement character count
|
7128 |
|
|
BEQ GoPr3 ; if zero then end of string so go print it
|
7129 |
|
|
|
7130 |
|
|
INY ; else increment index
|
7131 |
|
|
BPL NextB2 ; loop always
|
7132 |
|
|
|
7133 |
|
|
; make fixed length output string - ignore overflows!
|
7134 |
|
|
|
7135 |
|
|
GoPr3
|
7136 |
|
|
INX ; need at least 1 character
|
7137 |
|
|
GoPr
|
7138 |
|
|
TYA ; copy result
|
7139 |
|
|
GoPr1
|
7140 |
|
|
CLC ; clear carry for add
|
7141 |
|
|
ADC str_pl ; add low address
|
7142 |
|
|
STA str_pl ; save low address
|
7143 |
|
|
LDA #$00 ; do high byte
|
7144 |
|
|
ADC str_ph ; add high address
|
7145 |
|
|
STA str_ph ; save high address
|
7146 |
|
|
GoPr2
|
7147 |
|
|
STX str_ln ; X holds string length
|
7148 |
|
|
JSR LAB_IGBY ; update BASIC execute pointer (to character past ")")
|
7149 |
|
|
JMP LAB_RTST ; check for space on descriptor stack then put address
|
7150 |
|
|
; and length on descriptor stack and update stack pointers
|
7151 |
|
|
|
7152 |
|
|
BinFErr
|
7153 |
|
|
JMP LAB_FCER ; do function call error then warm start
|
7154 |
|
|
|
7155 |
|
|
; perform HEX$()
|
7156 |
|
|
|
7157 |
|
|
LAB_HEXS
|
7158 |
|
|
CPX #$07 ; max + 1
|
7159 |
|
|
BCS BinFErr ; exit if too big ( > or = )
|
7160 |
|
|
|
7161 |
|
|
STX TempB ; save # of characters
|
7162 |
|
|
|
7163 |
|
|
LDA #$06 ; need 6 bytes for string
|
7164 |
|
|
JSR LAB_MSSP ; make string space A bytes long
|
7165 |
|
|
LDY #$05 ; set string index
|
7166 |
|
|
|
7167 |
|
|
SED ; need decimal mode for nibble convert
|
7168 |
|
|
LDA nums_3 ; get lowest byte
|
7169 |
|
|
JSR LAB_A2HX ; convert A to ASCII hex byte and output
|
7170 |
|
|
LDA nums_2 ; get middle byte
|
7171 |
|
|
JSR LAB_A2HX ; convert A to ASCII hex byte and output
|
7172 |
|
|
LDA nums_1 ; get highest byte
|
7173 |
|
|
JSR LAB_A2HX ; convert A to ASCII hex byte and output
|
7174 |
|
|
CLD ; back to binary
|
7175 |
|
|
|
7176 |
|
|
LDX #$06 ; character count
|
7177 |
|
|
LDA TempB ; get # of characters
|
7178 |
|
|
BEQ EndBHS ; branch if truncate
|
7179 |
|
|
|
7180 |
|
|
TAX ; copy length to X
|
7181 |
|
|
SEC ; set carry for add !
|
7182 |
|
|
EOR #$FF ; 1's complement
|
7183 |
|
|
ADC #$06 ; add 6d
|
7184 |
|
|
BEQ GoPr2 ; if zero print whole string
|
7185 |
|
|
|
7186 |
|
|
BNE GoPr1 ; else go make output string (branch always)
|
7187 |
|
|
|
7188 |
|
|
; convert A to ASCII hex byte and output .. note set decimal mode before calling
|
7189 |
|
|
|
7190 |
|
|
LAB_A2HX
|
7191 |
|
|
TAX ; save byte
|
7192 |
|
|
AND #$0F ; mask off top bits
|
7193 |
|
|
JSR LAB_AL2X ; convert low nibble to ASCII and output
|
7194 |
|
|
TXA ; get byte back
|
7195 |
|
|
LSR ; /2 shift high nibble to low nibble
|
7196 |
|
|
LSR ; /4
|
7197 |
|
|
LSR ; /8
|
7198 |
|
|
LSR ; /16
|
7199 |
|
|
LAB_AL2X
|
7200 |
|
|
CMP #$0A ; set carry for +1 if >9
|
7201 |
|
|
ADC #'0' ; add ASCII "0"
|
7202 |
|
|
STA (str_pl),Y ; save to temp string
|
7203 |
|
|
DEY ; decrement counter
|
7204 |
|
|
RTS
|
7205 |
|
|
|
7206 |
|
|
LAB_NLTO
|
7207 |
|
|
STA FAC1_e ; save FAC1 exponent
|
7208 |
|
|
LDA #$00 ; clear sign compare
|
7209 |
|
|
LAB_MLTE
|
7210 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
7211 |
|
|
TXA ; restore character
|
7212 |
|
|
JSR LAB_2912 ; evaluate new ASCII digit
|
7213 |
|
|
|
7214 |
|
|
; gets here if the first character was "$" for hex
|
7215 |
|
|
; get hex number
|
7216 |
|
|
|
7217 |
|
|
LAB_CHEX
|
7218 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
7219 |
|
|
BCC LAB_ISHN ; branch if numeric character
|
7220 |
|
|
|
7221 |
|
|
ORA #$20 ; case convert, allow "A" to "F" and "a" to "f"
|
7222 |
|
|
SBC #'a' ; subtract "a" (carry set here)
|
7223 |
|
|
CMP #$06 ; compare normalised with $06 (max+1)
|
7224 |
|
|
BCS LAB_EXCH ; exit if >"f" or <"0"
|
7225 |
|
|
|
7226 |
|
|
ADC #$0A ; convert to nibble
|
7227 |
|
|
LAB_ISHN
|
7228 |
|
|
AND #$0F ; convert to binary
|
7229 |
|
|
TAX ; save nibble
|
7230 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
7231 |
|
|
BEQ LAB_MLTE ; skip multiply if zero
|
7232 |
|
|
|
7233 |
|
|
ADC #$04 ; add four to exponent (*16 - carry clear here)
|
7234 |
|
|
BCC LAB_NLTO ; if no overflow do evaluate digit
|
7235 |
|
|
|
7236 |
|
|
LAB_MLTO
|
7237 |
|
|
JMP LAB_2564 ; do overflow error and warm start
|
7238 |
|
|
|
7239 |
|
|
LAB_NXCH
|
7240 |
|
|
TAX ; save bit
|
7241 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
7242 |
|
|
BEQ LAB_MLBT ; skip multiply if zero
|
7243 |
|
|
|
7244 |
|
|
INC FAC1_e ; increment FAC1 exponent (*2)
|
7245 |
|
|
BEQ LAB_MLTO ; do overflow error if = $00
|
7246 |
|
|
|
7247 |
|
|
LDA #$00 ; clear sign compare
|
7248 |
|
|
LAB_MLBT
|
7249 |
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
7250 |
|
|
TXA ; restore bit
|
7251 |
|
|
JSR LAB_2912 ; evaluate new ASCII digit
|
7252 |
|
|
|
7253 |
|
|
; gets here if the first character was "%" for binary
|
7254 |
|
|
; get binary number
|
7255 |
|
|
|
7256 |
|
|
LAB_CBIN
|
7257 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
7258 |
|
|
EOR #'0' ; convert "0" to 0 etc.
|
7259 |
|
|
CMP #$02 ; compare with max+1
|
7260 |
|
|
BCC LAB_NXCH ; branch exit if < 2
|
7261 |
|
|
|
7262 |
|
|
LAB_EXCH
|
7263 |
|
|
JMP LAB_28F6 ; evaluate -ve flag and return
|
7264 |
|
|
|
7265 |
|
|
; ctrl-c check routine. includes limited "life" byte save for INGET routine
|
7266 |
|
|
; now also the code that checks to see if an interrupt has occurred
|
7267 |
|
|
|
7268 |
|
|
CTRLC
|
7269 |
|
|
LDA ccflag ; get [CTRL-C] check flag
|
7270 |
|
|
BNE LAB_FBA2 ; exit if inhibited
|
7271 |
|
|
|
7272 |
|
|
JSR V_INPT ; scan input device
|
7273 |
|
|
BCC LAB_FBA0 ; exit if buffer empty
|
7274 |
|
|
|
7275 |
|
|
STA ccbyte ; save received byte
|
7276 |
|
|
LDX #$20 ; "life" timer for bytes
|
7277 |
|
|
STX ccnull ; set countdown
|
7278 |
|
|
JMP LAB_1636 ; return to BASIC
|
7279 |
|
|
|
7280 |
|
|
LAB_FBA0
|
7281 |
|
|
LDX ccnull ; get countdown byte
|
7282 |
|
|
BEQ LAB_FBA2 ; exit if finished
|
7283 |
|
|
|
7284 |
|
|
DEC ccnull ; else decrement countdown
|
7285 |
|
|
LAB_FBA2
|
7286 |
|
|
LDX #NmiBase ; set pointer to NMI values
|
7287 |
|
|
JSR LAB_CKIN ; go check interrupt
|
7288 |
|
|
LDX #IrqBase ; set pointer to IRQ values
|
7289 |
|
|
JSR LAB_CKIN ; go check interrupt
|
7290 |
|
|
LAB_CRTS
|
7291 |
|
|
RTS
|
7292 |
|
|
|
7293 |
|
|
; check whichever interrupt is indexed by X
|
7294 |
|
|
|
7295 |
|
|
LAB_CKIN
|
7296 |
|
|
LDA PLUS_0,X ; get interrupt flag byte
|
7297 |
|
|
BPL LAB_CRTS ; branch if interrupt not enabled
|
7298 |
|
|
|
7299 |
|
|
; we disable the interrupt here and make two new commands RETIRQ and RETNMI to
|
7300 |
|
|
; automatically enable the interrupt when we exit
|
7301 |
|
|
|
7302 |
|
|
ASL ; move happened bit to setup bit
|
7303 |
|
|
AND #$40 ; mask happened bits
|
7304 |
|
|
BEQ LAB_CRTS ; if no interrupt then exit
|
7305 |
|
|
|
7306 |
|
|
STA PLUS_0,X ; save interrupt flag byte
|
7307 |
|
|
|
7308 |
|
|
TXA ; copy index ..
|
7309 |
|
|
TAY ; .. to Y
|
7310 |
|
|
|
7311 |
|
|
PLA ; dump return address low byte, call from CTRL-C
|
7312 |
|
|
PLA ; dump return address high byte
|
7313 |
|
|
|
7314 |
|
|
LDA #$05 ; need 5 bytes for GOSUB
|
7315 |
|
|
JSR LAB_1212 ; check room on stack for A bytes
|
7316 |
|
|
LDA Bpntrh ; get BASIC execute pointer high byte
|
7317 |
|
|
PHA ; push on stack
|
7318 |
|
|
LDA Bpntrl ; get BASIC execute pointer low byte
|
7319 |
|
|
PHA ; push on stack
|
7320 |
|
|
LDA Clineh ; get current line high byte
|
7321 |
|
|
PHA ; push on stack
|
7322 |
|
|
LDA Clinel ; get current line low byte
|
7323 |
|
|
PHA ; push on stack
|
7324 |
|
|
LDA #TK_GOSUB ; token for GOSUB
|
7325 |
|
|
PHA ; push on stack
|
7326 |
|
|
|
7327 |
|
|
LDA PLUS_1,Y ; get interrupt code pointer low byte
|
7328 |
|
|
STA Bpntrl ; save as BASIC execute pointer low byte
|
7329 |
|
|
LDA PLUS_2,Y ; get interrupt code pointer high byte
|
7330 |
|
|
STA Bpntrh ; save as BASIC execute pointer high byte
|
7331 |
|
|
|
7332 |
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
7333 |
|
|
; can't RTS, we used the stack! the RTS from the ctrl-c
|
7334 |
|
|
; check will be taken when the RETIRQ/RETNMI/RETURN is
|
7335 |
|
|
; executed at the end of the subroutine
|
7336 |
|
|
|
7337 |
|
|
; get byte from input device, no waiting
|
7338 |
|
|
; returns with carry set if byte in A
|
7339 |
|
|
|
7340 |
|
|
INGET
|
7341 |
|
|
JSR V_INPT ; call scan input device
|
7342 |
|
|
BCS LAB_FB95 ; if byte go reset timer
|
7343 |
|
|
|
7344 |
|
|
LDA ccnull ; get countdown
|
7345 |
|
|
BEQ LAB_FB96 ; exit if empty
|
7346 |
|
|
|
7347 |
|
|
LDA ccbyte ; get last received byte
|
7348 |
|
|
SEC ; flag we got a byte
|
7349 |
|
|
LAB_FB95
|
7350 |
|
|
LDX #$00 ; clear X
|
7351 |
|
|
STX ccnull ; clear timer because we got a byte
|
7352 |
|
|
LAB_FB96
|
7353 |
|
|
RTS
|
7354 |
|
|
|
7355 |
|
|
; these routines only enable the interrupts if the set-up flag is set
|
7356 |
|
|
; if not they have no effect
|
7357 |
|
|
|
7358 |
|
|
; perform IRQ {ON|OFF|CLEAR}
|
7359 |
|
|
|
7360 |
|
|
LAB_IRQ
|
7361 |
|
|
LDX #IrqBase ; set pointer to IRQ values
|
7362 |
|
|
.byte $2C ; make next line BIT abs.
|
7363 |
|
|
|
7364 |
|
|
; perform NMI {ON|OFF|CLEAR}
|
7365 |
|
|
|
7366 |
|
|
LAB_NMI
|
7367 |
|
|
LDX #NmiBase ; set pointer to NMI values
|
7368 |
|
|
CMP #TK_ON ; compare with token for ON
|
7369 |
|
|
BEQ LAB_INON ; go turn on interrupt
|
7370 |
|
|
|
7371 |
|
|
CMP #TK_OFF ; compare with token for OFF
|
7372 |
|
|
BEQ LAB_IOFF ; go turn off interrupt
|
7373 |
|
|
|
7374 |
|
|
EOR #TK_CLEAR ; compare with token for CLEAR, A = $00 if = TK_CLEAR
|
7375 |
|
|
BEQ LAB_INEX ; go clear interrupt flags and return
|
7376 |
|
|
|
7377 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
7378 |
|
|
|
7379 |
|
|
LAB_IOFF
|
7380 |
|
|
LDA #$7F ; clear A
|
7381 |
|
|
AND PLUS_0,X ; AND with interrupt setup flag
|
7382 |
|
|
BPL LAB_INEX ; go clear interrupt enabled flag and return
|
7383 |
|
|
|
7384 |
|
|
LAB_INON
|
7385 |
|
|
LDA PLUS_0,X ; get interrupt setup flag
|
7386 |
|
|
ASL ; Shift bit to enabled flag
|
7387 |
|
|
ORA PLUS_0,X ; OR with flag byte
|
7388 |
|
|
LAB_INEX
|
7389 |
|
|
STA PLUS_0,X ; save interrupt flag byte
|
7390 |
|
|
JMP LAB_IGBY ; update BASIC execute pointer and return
|
7391 |
|
|
|
7392 |
|
|
; these routines set up the pointers and flags for the interrupt routines
|
7393 |
|
|
; note that the interrupts are also enabled by these commands
|
7394 |
|
|
|
7395 |
|
|
; perform ON IRQ
|
7396 |
|
|
|
7397 |
|
|
LAB_SIRQ
|
7398 |
|
|
CLI ; enable interrupts
|
7399 |
|
|
LDX #IrqBase ; set pointer to IRQ values
|
7400 |
|
|
.byte $2C ; make next line BIT abs.
|
7401 |
|
|
|
7402 |
|
|
; perform ON NMI
|
7403 |
|
|
|
7404 |
|
|
LAB_SNMI
|
7405 |
|
|
LDX #NmiBase ; set pointer to NMI values
|
7406 |
|
|
|
7407 |
|
|
STX TempB ; save interrupt pointer
|
7408 |
|
|
JSR LAB_IGBY ; increment and scan memory (past token)
|
7409 |
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
7410 |
|
|
LDA Smeml ; get start of mem low byte
|
7411 |
|
|
LDX Smemh ; get start of mem high byte
|
7412 |
|
|
JSR LAB_SHLN ; search Basic for temp integer line number from AX
|
7413 |
|
|
BCS LAB_LFND ; if carry set go set-up interrupt
|
7414 |
|
|
|
7415 |
|
|
JMP LAB_16F7 ; else go do "Undefined statement" error and warm start
|
7416 |
|
|
|
7417 |
|
|
LAB_LFND
|
7418 |
|
|
LDX TempB ; get interrupt pointer
|
7419 |
|
|
LDA Baslnl ; get pointer low byte
|
7420 |
|
|
SBC #$01 ; -1 (carry already set for subtract)
|
7421 |
|
|
STA PLUS_1,X ; save as interrupt pointer low byte
|
7422 |
|
|
LDA Baslnh ; get pointer high byte
|
7423 |
|
|
SBC #$00 ; subtract carry
|
7424 |
|
|
STA PLUS_2,X ; save as interrupt pointer high byte
|
7425 |
|
|
|
7426 |
|
|
LDA #$C0 ; set interrupt enabled/setup bits
|
7427 |
|
|
STA PLUS_0,X ; set interrupt flags
|
7428 |
|
|
LAB_IRTS
|
7429 |
|
|
RTS
|
7430 |
|
|
|
7431 |
|
|
; return from IRQ service, restores the enabled flag.
|
7432 |
|
|
|
7433 |
|
|
; perform RETIRQ
|
7434 |
|
|
|
7435 |
|
|
LAB_RETIRQ
|
7436 |
|
|
BNE LAB_IRTS ; exit if following token (to allow syntax error)
|
7437 |
|
|
|
7438 |
|
|
LDA IrqBase ; get interrupt flags
|
7439 |
|
|
ASL ; copy setup to enabled (b7)
|
7440 |
|
|
ORA IrqBase ; OR in setup flag
|
7441 |
|
|
STA IrqBase ; save enabled flag
|
7442 |
|
|
JMP LAB_16E8 ; go do rest of RETURN
|
7443 |
|
|
|
7444 |
|
|
; return from NMI service, restores the enabled flag.
|
7445 |
|
|
|
7446 |
|
|
; perform RETNMI
|
7447 |
|
|
|
7448 |
|
|
LAB_RETNMI
|
7449 |
|
|
BNE LAB_IRTS ; exit if following token (to allow syntax error)
|
7450 |
|
|
|
7451 |
|
|
LDA NmiBase ; get set-up flag
|
7452 |
|
|
ASL ; copy setup to enabled (b7)
|
7453 |
|
|
ORA NmiBase ; OR in setup flag
|
7454 |
|
|
STA NmiBase ; save enabled flag
|
7455 |
|
|
JMP LAB_16E8 ; go do rest of RETURN
|
7456 |
|
|
|
7457 |
|
|
; MAX() MIN() pre process
|
7458 |
|
|
|
7459 |
|
|
LAB_MMPP
|
7460 |
|
|
JSR LAB_EVEZ ; process expression
|
7461 |
|
|
JMP LAB_CTNM ; check if source is numeric, else do type mismatch
|
7462 |
|
|
|
7463 |
|
|
; perform MAX()
|
7464 |
|
|
|
7465 |
|
|
LAB_MAX
|
7466 |
|
|
JSR LAB_PHFA ; push FAC1, evaluate expression,
|
7467 |
|
|
; pull FAC2 and compare with FAC1
|
7468 |
|
|
BPL LAB_MAX ; branch if no swap to do
|
7469 |
|
|
|
7470 |
|
|
LDA FAC2_1 ; get FAC2 mantissa1
|
7471 |
|
|
ORA #$80 ; set top bit (clear sign from compare)
|
7472 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
7473 |
|
|
JSR LAB_279B ; copy FAC2 to FAC1
|
7474 |
|
|
BEQ LAB_MAX ; go do next (branch always)
|
7475 |
|
|
|
7476 |
|
|
; perform MIN()
|
7477 |
|
|
|
7478 |
|
|
LAB_MIN
|
7479 |
|
|
JSR LAB_PHFA ; push FAC1, evaluate expression,
|
7480 |
|
|
; pull FAC2 and compare with FAC1
|
7481 |
|
|
BMI LAB_MIN ; branch if no swap to do
|
7482 |
|
|
|
7483 |
|
|
BEQ LAB_MIN ; branch if no swap to do
|
7484 |
|
|
|
7485 |
|
|
LDA FAC2_1 ; get FAC2 mantissa1
|
7486 |
|
|
ORA #$80 ; set top bit (clear sign from compare)
|
7487 |
|
|
STA FAC2_1 ; save FAC2 mantissa1
|
7488 |
|
|
JSR LAB_279B ; copy FAC2 to FAC1
|
7489 |
|
|
BEQ LAB_MIN ; go do next (branch always)
|
7490 |
|
|
|
7491 |
|
|
; exit routine. don't bother returning to the loop code
|
7492 |
|
|
; check for correct exit, else so syntax error
|
7493 |
|
|
|
7494 |
|
|
LAB_MMEC
|
7495 |
|
|
CMP #')' ; is it end of function?
|
7496 |
|
|
BNE LAB_MMSE ; if not do MAX MIN syntax error
|
7497 |
|
|
|
7498 |
|
|
PLA ; dump return address low byte
|
7499 |
|
|
PLA ; dump return address high byte
|
7500 |
|
|
JMP LAB_IGBY ; update BASIC execute pointer (to chr past ")")
|
7501 |
|
|
|
7502 |
|
|
LAB_MMSE
|
7503 |
|
|
JMP LAB_SNER ; do syntax error then warm start
|
7504 |
|
|
|
7505 |
|
|
; check for next, evaluate and return or exit
|
7506 |
|
|
; this is the routine that does most of the work
|
7507 |
|
|
|
7508 |
|
|
LAB_PHFA
|
7509 |
|
|
JSR LAB_GBYT ; get next BASIC byte
|
7510 |
|
|
CMP #',' ; is there more ?
|
7511 |
|
|
BNE LAB_MMEC ; if not go do end check
|
7512 |
|
|
|
7513 |
|
|
; push FAC1
|
7514 |
|
|
JSR LAB_27BA ; round FAC1
|
7515 |
|
|
LDA FAC1_s ; get FAC1 sign
|
7516 |
|
|
ORA #$7F ; set all non sign bits
|
7517 |
|
|
AND FAC1_1 ; AND FAC1 mantissa1 (AND in sign bit)
|
7518 |
|
|
PHA ; push on stack
|
7519 |
|
|
LDA FAC1_2 ; get FAC1 mantissa2
|
7520 |
|
|
PHA ; push on stack
|
7521 |
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
7522 |
|
|
PHA ; push on stack
|
7523 |
|
|
LDA FAC1_e ; get FAC1 exponent
|
7524 |
|
|
PHA ; push on stack
|
7525 |
|
|
|
7526 |
|
|
JSR LAB_IGBY ; scan and get next BASIC byte (after ",")
|
7527 |
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
7528 |
|
|
; else do type mismatch
|
7529 |
|
|
|
7530 |
|
|
; pop FAC2 (MAX/MIN expression so far)
|
7531 |
|
|
PLA ; pop exponent
|
7532 |
|
|
STA FAC2_e ; save FAC2 exponent
|
7533 |
|
|
PLA ; pop mantissa3
|
7534 |
|
|
STA FAC2_3 ; save FAC2 mantissa3
|
7535 |
|
|
PLA ; pop mantissa1
|
7536 |
|
|
STA FAC2_2 ; save FAC2 mantissa2
|
7537 |
|
|
PLA ; pop sign/mantissa1
|
7538 |
|
|
STA FAC2_1 ; save FAC2 sign/mantissa1
|
7539 |
|
|
STA FAC2_s ; save FAC2 sign
|
7540 |
|
|
|
7541 |
|
|
; compare FAC1 with (packed) FAC2
|
7542 |
|
|
LDA #
|
7543 |
|
|
LDY #>FAC2_e ; set pointer high byte to FAC2
|
7544 |
|
|
JMP LAB_27F8 ; compare FAC1 with FAC2 (AY) and return
|
7545 |
|
|
; returns A=$00 if FAC1 = (AY)
|
7546 |
|
|
; returns A=$01 if FAC1 > (AY)
|
7547 |
|
|
; returns A=$FF if FAC1 < (AY)
|
7548 |
|
|
|
7549 |
|
|
; perform WIDTH
|
7550 |
|
|
|
7551 |
|
|
LAB_WDTH
|
7552 |
|
|
CMP #',' ; is next byte ","
|
7553 |
|
|
BEQ LAB_TBSZ ; if so do tab size
|
7554 |
|
|
|
7555 |
|
|
JSR LAB_GTBY ; get byte parameter
|
7556 |
|
|
TXA ; copy width to A
|
7557 |
|
|
BEQ LAB_NSTT ; branch if set for infinite line
|
7558 |
|
|
|
7559 |
|
|
CPX #$10 ; else make min width = 16d
|
7560 |
|
|
BCC TabErr ; if less do function call error and exit
|
7561 |
|
|
|
7562 |
|
|
; this next compare ensures that we can't exit WIDTH via an error leaving the
|
7563 |
|
|
; tab size greater than the line length.
|
7564 |
|
|
|
7565 |
|
|
CPX TabSiz ; compare with tab size
|
7566 |
|
|
BCS LAB_NSTT ; branch if >= tab size
|
7567 |
|
|
|
7568 |
|
|
STX TabSiz ; else make tab size = terminal width
|
7569 |
|
|
LAB_NSTT
|
7570 |
|
|
STX TWidth ; set the terminal width
|
7571 |
|
|
JSR LAB_GBYT ; get BASIC byte back
|
7572 |
|
|
BEQ WExit ; exit if no following
|
7573 |
|
|
|
7574 |
|
|
CMP #',' ; else is it ","
|
7575 |
|
|
BNE LAB_MMSE ; if not do syntax error
|
7576 |
|
|
|
7577 |
|
|
LAB_TBSZ
|
7578 |
|
|
JSR LAB_SGBY ; scan and get byte parameter
|
7579 |
|
|
TXA ; copy TAB size
|
7580 |
|
|
BMI TabErr ; if >127 do function call error and exit
|
7581 |
|
|
|
7582 |
|
|
CPX #$01 ; compare with min-1
|
7583 |
|
|
BCC TabErr ; if <=1 do function call error and exit
|
7584 |
|
|
|
7585 |
|
|
LDA TWidth ; set flags for width
|
7586 |
|
|
BEQ LAB_SVTB ; skip check if infinite line
|
7587 |
|
|
|
7588 |
|
|
CPX TWidth ; compare TAB with width
|
7589 |
|
|
BEQ LAB_SVTB ; ok if =
|
7590 |
|
|
|
7591 |
|
|
BCS TabErr ; branch if too big
|
7592 |
|
|
|
7593 |
|
|
LAB_SVTB
|
7594 |
|
|
STX TabSiz ; save TAB size
|
7595 |
|
|
|
7596 |
|
|
; calculate tab column limit from TAB size. The Iclim is set to the last tab
|
7597 |
|
|
; position on a line that still has at least one whole tab width between it
|
7598 |
|
|
; and the end of the line.
|
7599 |
|
|
|
7600 |
|
|
WExit
|
7601 |
|
|
LDA TWidth ; get width
|
7602 |
|
|
BEQ LAB_SULP ; branch if infinite line
|
7603 |
|
|
|
7604 |
|
|
CMP TabSiz ; compare with tab size
|
7605 |
|
|
BCS LAB_WDLP ; branch if >= tab size
|
7606 |
|
|
|
7607 |
|
|
STA TabSiz ; else make tab size = terminal width
|
7608 |
|
|
LAB_SULP
|
7609 |
|
|
SEC ; set carry for subtract
|
7610 |
|
|
LAB_WDLP
|
7611 |
|
|
SBC TabSiz ; subtract tab size
|
7612 |
|
|
BCS LAB_WDLP ; loop while no borrow
|
7613 |
|
|
|
7614 |
|
|
ADC TabSiz ; add tab size back
|
7615 |
|
|
CLC ; clear carry for add
|
7616 |
|
|
ADC TabSiz ; add tab size back again
|
7617 |
|
|
STA Iclim ; save for now
|
7618 |
|
|
LDA TWidth ; get width back
|
7619 |
|
|
SEC ; set carry for subtract
|
7620 |
|
|
SBC Iclim ; subtract remainder
|
7621 |
|
|
STA Iclim ; save tab column limit
|
7622 |
|
|
LAB_NOSQ
|
7623 |
|
|
RTS
|
7624 |
|
|
|
7625 |
|
|
TabErr
|
7626 |
|
|
JMP LAB_FCER ; do function call error then warm start
|
7627 |
|
|
|
7628 |
|
|
; perform SQR()
|
7629 |
|
|
|
7630 |
|
|
LAB_SQR
|
7631 |
|
|
LDA FAC1_s ; get FAC1 sign
|
7632 |
|
|
BMI TabErr ; if -ve do function call error
|
7633 |
|
|
|
7634 |
|
|
LDA FAC1_e ; get exponent
|
7635 |
|
|
BEQ LAB_NOSQ ; if zero just return
|
7636 |
|
|
|
7637 |
|
|
; else do root
|
7638 |
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
7639 |
|
|
LDA #$00 ; clear A
|
7640 |
|
|
|
7641 |
|
|
STA FACt_3 ; clear remainder
|
7642 |
|
|
STA FACt_2 ; ..
|
7643 |
|
|
STA FACt_1 ; ..
|
7644 |
|
|
STA TempB ; ..
|
7645 |
|
|
|
7646 |
|
|
STA FAC1_3 ; clear root
|
7647 |
|
|
STA FAC1_2 ; ..
|
7648 |
|
|
STA FAC1_1 ; ..
|
7649 |
|
|
|
7650 |
|
|
LDX #$18 ; 24 pairs of bits to do
|
7651 |
|
|
LDA FAC2_e ; get exponent
|
7652 |
|
|
LSR ; check odd/even
|
7653 |
|
|
BCS LAB_SQE2 ; if odd only 1 shift first time
|
7654 |
|
|
|
7655 |
|
|
LAB_SQE1
|
7656 |
|
|
ASL FAC2_3 ; shift highest bit of number ..
|
7657 |
|
|
ROL FAC2_2 ; ..
|
7658 |
|
|
ROL FAC2_1 ; ..
|
7659 |
|
|
ROL FACt_3 ; .. into remainder
|
7660 |
|
|
ROL FACt_2 ; ..
|
7661 |
|
|
ROL FACt_1 ; ..
|
7662 |
|
|
ROL TempB ; .. never overflows
|
7663 |
|
|
LAB_SQE2
|
7664 |
|
|
ASL FAC2_3 ; shift highest bit of number ..
|
7665 |
|
|
ROL FAC2_2 ; ..
|
7666 |
|
|
ROL FAC2_1 ; ..
|
7667 |
|
|
ROL FACt_3 ; .. into remainder
|
7668 |
|
|
ROL FACt_2 ; ..
|
7669 |
|
|
ROL FACt_1 ; ..
|
7670 |
|
|
ROL TempB ; .. never overflows
|
7671 |
|
|
|
7672 |
|
|
ASL FAC1_3 ; root = root * 2
|
7673 |
|
|
ROL FAC1_2 ; ..
|
7674 |
|
|
ROL FAC1_1 ; .. never overflows
|
7675 |
|
|
|
7676 |
|
|
LDA FAC1_3 ; get root low byte
|
7677 |
|
|
ROL ; *2
|
7678 |
|
|
STA Temp3 ; save partial low byte
|
7679 |
|
|
LDA FAC1_2 ; get root low mid byte
|
7680 |
|
|
ROL ; *2
|
7681 |
|
|
STA Temp3+1 ; save partial low mid byte
|
7682 |
|
|
LDA FAC1_1 ; get root high mid byte
|
7683 |
|
|
ROL ; *2
|
7684 |
|
|
STA Temp3+2 ; save partial high mid byte
|
7685 |
|
|
LDA #$00 ; get root high byte (always $00)
|
7686 |
|
|
ROL ; *2
|
7687 |
|
|
STA Temp3+3 ; save partial high byte
|
7688 |
|
|
|
7689 |
|
|
; carry clear for subtract +1
|
7690 |
|
|
LDA FACt_3 ; get remainder low byte
|
7691 |
|
|
SBC Temp3 ; subtract partial low byte
|
7692 |
|
|
STA Temp3 ; save partial low byte
|
7693 |
|
|
|
7694 |
|
|
LDA FACt_2 ; get remainder low mid byte
|
7695 |
|
|
SBC Temp3+1 ; subtract partial low mid byte
|
7696 |
|
|
STA Temp3+1 ; save partial low mid byte
|
7697 |
|
|
|
7698 |
|
|
LDA FACt_1 ; get remainder high mid byte
|
7699 |
|
|
SBC Temp3+2 ; subtract partial high mid byte
|
7700 |
|
|
TAY ; copy partial high mid byte
|
7701 |
|
|
|
7702 |
|
|
LDA TempB ; get remainder high byte
|
7703 |
|
|
SBC Temp3+3 ; subtract partial high byte
|
7704 |
|
|
BCC LAB_SQNS ; skip sub if remainder smaller
|
7705 |
|
|
|
7706 |
|
|
STA TempB ; save remainder high byte
|
7707 |
|
|
|
7708 |
|
|
STY FACt_1 ; save remainder high mid byte
|
7709 |
|
|
|
7710 |
|
|
LDA Temp3+1 ; get remainder low mid byte
|
7711 |
|
|
STA FACt_2 ; save remainder low mid byte
|
7712 |
|
|
|
7713 |
|
|
LDA Temp3 ; get partial low byte
|
7714 |
|
|
STA FACt_3 ; save remainder low byte
|
7715 |
|
|
|
7716 |
|
|
INC FAC1_3 ; increment root low byte (never any rollover)
|
7717 |
|
|
LAB_SQNS
|
7718 |
|
|
DEX ; decrement bit pair count
|
7719 |
|
|
BNE LAB_SQE1 ; loop if not all done
|
7720 |
|
|
|
7721 |
|
|
SEC ; set carry for subtract
|
7722 |
|
|
LDA FAC2_e ; get exponent
|
7723 |
|
|
SBC #$80 ; normalise
|
7724 |
|
|
ROR ; /2 and re-bias to $80
|
7725 |
|
|
ADC #$00 ; add bit zero back in (allow for half shift)
|
7726 |
|
|
STA FAC1_e ; save it
|
7727 |
|
|
JMP LAB_24D5 ; normalise FAC1 and return
|
7728 |
|
|
|
7729 |
|
|
; perform VARPTR()
|
7730 |
|
|
|
7731 |
|
|
LAB_VARPTR
|
7732 |
|
|
JSR LAB_IGBY ; increment and scan memory
|
7733 |
|
|
JSR LAB_GVAR ; get var address
|
7734 |
|
|
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start
|
7735 |
|
|
LDY Cvaral ; get var address low byte
|
7736 |
|
|
LDA Cvarah ; get var address high byte
|
7737 |
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
7738 |
|
|
|
7739 |
|
|
; perform PI
|
7740 |
|
|
|
7741 |
|
|
LAB_PI
|
7742 |
|
|
LDA #
|
7743 |
|
|
LDY #>LAB_2C7C ; set (2*pi) pointer high byte
|
7744 |
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
7745 |
|
|
DEC FAC1_e ; make result = PI
|
7746 |
|
|
RTS
|
7747 |
|
|
|
7748 |
|
|
; perform TWOPI
|
7749 |
|
|
|
7750 |
|
|
LAB_TWOPI
|
7751 |
|
|
LDA #
|
7752 |
|
|
LDY #>LAB_2C7C ; set (2*pi) pointer high byte
|
7753 |
|
|
JMP LAB_UFAC ; unpack memory (AY) into FAC1 and return
|
7754 |
|
|
|
7755 |
|
|
; system dependant i/o vectors
|
7756 |
|
|
; these are in RAM and are set by the monitor at start-up
|
7757 |
|
|
|
7758 |
|
|
V_INPT
|
7759 |
|
|
JMP (VEC_IN) ; non halting scan input device
|
7760 |
|
|
V_OUTP
|
7761 |
|
|
JMP (VEC_OUT) ; send byte to output device
|
7762 |
|
|
V_LOAD
|
7763 |
|
|
JMP (VEC_LD) ; load BASIC program
|
7764 |
|
|
V_SAVE
|
7765 |
|
|
JMP (VEC_SV) ; save BASIC program
|
7766 |
|
|
|
7767 |
|
|
LAB_BYE:
|
7768 |
|
|
; nat
|
7769 |
|
|
.byte $42 ; WDM
|
7770 |
|
|
xce
|
7771 |
|
|
cpu rtf65002
|
7772 |
|
|
jmp (ExitTask>>2)
|
7773 |
|
|
cpu W65C02
|
7774 |
|
|
|
7775 |
|
|
; The rest are tables messages and code for RAM
|
7776 |
|
|
|
7777 |
|
|
; the rest of the code is tables and BASIC start-up code
|
7778 |
|
|
|
7779 |
|
|
PG2_TABS
|
7780 |
|
|
.byte $00 ; ctrl-c flag - $00 = enabled
|
7781 |
|
|
.byte $00 ; ctrl-c byte - GET needs this
|
7782 |
|
|
.byte $00 ; ctrl-c byte timeout - GET needs this
|
7783 |
|
|
.word CTRLC ; ctrl c check vector
|
7784 |
|
|
; .word xxxx ; non halting key input - monitor to set this
|
7785 |
|
|
; .word xxxx ; output vector - monitor to set this
|
7786 |
|
|
; .word xxxx ; load vector - monitor to set this
|
7787 |
|
|
; .word xxxx ; save vector - monitor to set this
|
7788 |
|
|
PG2_TABE
|
7789 |
|
|
|
7790 |
|
|
; character get subroutine for zero page
|
7791 |
|
|
|
7792 |
|
|
; For a 1.8432MHz 6502 including the JSR and RTS
|
7793 |
|
|
; fastest (>=":") = 29 cycles = 15.7uS
|
7794 |
|
|
; slowest (<":") = 40 cycles = 21.7uS
|
7795 |
|
|
; space skip = +21 cycles = +11.4uS
|
7796 |
|
|
; inc across page = +4 cycles = +2.2uS
|
7797 |
|
|
|
7798 |
|
|
; the target address for the LDA at LAB_2CF4 becomes the BASIC execute pointer once the
|
7799 |
|
|
; block is copied to it's destination, any non zero page address will do at assembly
|
7800 |
|
|
; time, to assemble a three byte instruction.
|
7801 |
|
|
|
7802 |
|
|
; page 0 initialisation table from $BC
|
7803 |
|
|
; increment and scan memory
|
7804 |
|
|
|
7805 |
|
|
LAB_2CEE
|
7806 |
|
|
INC Bpntrl ; increment BASIC execute pointer low byte
|
7807 |
|
|
BNE LAB_2CF4 ; branch if no carry
|
7808 |
|
|
; else
|
7809 |
|
|
INC Bpntrh ; increment BASIC execute pointer high byte
|
7810 |
|
|
|
7811 |
|
|
; page 0 initialisation table from $C2
|
7812 |
|
|
; scan memory
|
7813 |
|
|
|
7814 |
|
|
LAB_2CF4
|
7815 |
|
|
LDA $FFFF ; get byte to scan (addr set by call routine)
|
7816 |
|
|
CMP #TK_ELSE ; compare with the token for ELSE
|
7817 |
|
|
BEQ LAB_2D05 ; exit if ELSE, not numeric, carry set
|
7818 |
|
|
|
7819 |
|
|
CMP #':' ; compare with ":"
|
7820 |
|
|
BCS LAB_2D05 ; exit if >= ":", not numeric, carry set
|
7821 |
|
|
|
7822 |
|
|
CMP #' ' ; compare with " "
|
7823 |
|
|
BEQ LAB_2CEE ; if " " go do next
|
7824 |
|
|
|
7825 |
|
|
SEC ; set carry for SBC
|
7826 |
|
|
SBC #'0' ; subtract "0"
|
7827 |
|
|
SEC ; set carry for SBC
|
7828 |
|
|
SBC #$D0 ; subtract -"0"
|
7829 |
|
|
; clear carry if byte = "0"-"9"
|
7830 |
|
|
LAB_2D05
|
7831 |
|
|
RTS
|
7832 |
|
|
|
7833 |
|
|
; page zero initialisation table $00-$12 inclusive
|
7834 |
|
|
|
7835 |
|
|
StrTab
|
7836 |
|
|
.byte $4C ; JMP opcode
|
7837 |
|
|
.word LAB_COLD ; initial warm start vector (cold start)
|
7838 |
|
|
|
7839 |
|
|
.byte $00 ; these bytes are not used by BASIC
|
7840 |
|
|
.word $0000 ;
|
7841 |
|
|
.word $0000 ;
|
7842 |
|
|
.word $0000 ;
|
7843 |
|
|
|
7844 |
|
|
.byte $4C ; JMP opcode
|
7845 |
|
|
.word LAB_FCER ; initial user function vector ("Function call" error)
|
7846 |
|
|
.byte $00 ; default NULL count
|
7847 |
|
|
.byte $00 ; clear terminal position
|
7848 |
|
|
.byte $00 ; default terminal width byte
|
7849 |
|
|
.byte $F2 ; default limit for TAB = 14
|
7850 |
|
|
.word Ram_base ; start of user RAM
|
7851 |
|
|
EndTab
|
7852 |
|
|
|
7853 |
|
|
LAB_MSZM
|
7854 |
|
|
.byte $0D,$0A,"Memory size ",$00
|
7855 |
|
|
|
7856 |
|
|
LAB_SMSG
|
7857 |
|
|
.byte " Bytes free",$0D,$0A,$0A
|
7858 |
|
|
.byte "Enhanced BASIC 2.22",$0A,$00
|
7859 |
|
|
|
7860 |
|
|
; numeric constants and series
|
7861 |
|
|
|
7862 |
|
|
; constants and series for LOG(n)
|
7863 |
|
|
LAB_25A0
|
7864 |
|
|
.byte $02 ; counter
|
7865 |
|
|
.byte $80,$19,$56,$62 ; 0.59898
|
7866 |
|
|
.byte $80,$76,$22,$F3 ; 0.96147
|
7867 |
|
|
;## .byte $80,$76,$22,$F1 ; 0.96147
|
7868 |
|
|
.byte $82,$38,$AA,$40 ; 2.88539
|
7869 |
|
|
;## .byte $82,$38,$AA,$45 ; 2.88539
|
7870 |
|
|
|
7871 |
|
|
LAB_25AD
|
7872 |
|
|
.byte $80,$35,$04,$F3 ; 0.70711 1/root 2
|
7873 |
|
|
LAB_25B1
|
7874 |
|
|
.byte $81,$35,$04,$F3 ; 1.41421 root 2
|
7875 |
|
|
LAB_25B5
|
7876 |
|
|
.byte $80,$80,$00,$00 ; -0.5
|
7877 |
|
|
LAB_25B9
|
7878 |
|
|
.byte $80,$31,$72,$18 ; 0.69315 LOG(2)
|
7879 |
|
|
|
7880 |
|
|
; numeric PRINT constants
|
7881 |
|
|
LAB_2947
|
7882 |
|
|
.byte $91,$43,$4F,$F8 ; 99999.9375 (max value with at least one decimal)
|
7883 |
|
|
LAB_294B
|
7884 |
|
|
.byte $94,$74,$23,$F7 ; 999999.4375 (max value before scientific notation)
|
7885 |
|
|
LAB_294F
|
7886 |
|
|
.byte $94,$74,$24,$00 ; 1000000
|
7887 |
|
|
|
7888 |
|
|
; EXP(n) constants and series
|
7889 |
|
|
LAB_2AFA
|
7890 |
|
|
.byte $81,$38,$AA,$3B ; 1.4427 (1/LOG base 2 e)
|
7891 |
|
|
LAB_2AFE
|
7892 |
|
|
.byte $06 ; counter
|
7893 |
|
|
.byte $74,$63,$90,$8C ; 2.17023e-4
|
7894 |
|
|
.byte $77,$23,$0C,$AB ; 0.00124
|
7895 |
|
|
.byte $7A,$1E,$94,$00 ; 0.00968
|
7896 |
|
|
.byte $7C,$63,$42,$80 ; 0.05548
|
7897 |
|
|
.byte $7E,$75,$FE,$D0 ; 0.24023
|
7898 |
|
|
.byte $80,$31,$72,$15 ; 0.69315
|
7899 |
|
|
.byte $81,$00,$00,$00 ; 1.00000
|
7900 |
|
|
|
7901 |
|
|
;## .byte $07 ; counter
|
7902 |
|
|
;## .byte $74,$94,$2E,$40 ; -1/7! (-1/5040)
|
7903 |
|
|
;## .byte $77,$2E,$4F,$70 ; 1/6! ( 1/720)
|
7904 |
|
|
;## .byte $7A,$88,$02,$6E ; -1/5! (-1/120)
|
7905 |
|
|
;## .byte $7C,$2A,$A0,$E6 ; 1/4! ( 1/24)
|
7906 |
|
|
;## .byte $7E,$AA,$AA,$50 ; -1/3! (-1/6)
|
7907 |
|
|
;## .byte $7F,$7F,$FF,$FF ; 1/2! ( 1/2)
|
7908 |
|
|
;## .byte $81,$80,$00,$00 ; -1/1! (-1/1)
|
7909 |
|
|
;## .byte $81,$00,$00,$00 ; 1/0! ( 1/1)
|
7910 |
|
|
|
7911 |
|
|
; trigonometric constants and series
|
7912 |
|
|
LAB_2C78
|
7913 |
|
|
.byte $81,$49,$0F,$DB ; 1.570796371 (pi/2) as floating #
|
7914 |
|
|
LAB_2C84
|
7915 |
|
|
.byte $04 ; counter
|
7916 |
|
|
.byte $86,$1E,$D7,$FB ; 39.7109
|
7917 |
|
|
;## .byte $86,$1E,$D7,$BA ; 39.7109
|
7918 |
|
|
.byte $87,$99,$26,$65 ;-76.575
|
7919 |
|
|
;## .byte $87,$99,$26,$64 ;-76.575
|
7920 |
|
|
.byte $87,$23,$34,$58 ; 81.6022
|
7921 |
|
|
.byte $86,$A5,$5D,$E1 ;-41.3417
|
7922 |
|
|
;## .byte $86,$A5,$5D,$E0 ;-41.3417
|
7923 |
|
|
LAB_2C7C
|
7924 |
|
|
.byte $83,$49,$0F,$DB ; 6.28319 (2*pi) as floating #
|
7925 |
|
|
;## .byte $83,$49,$0F,$DA ; 6.28319 (2*pi) as floating #
|
7926 |
|
|
|
7927 |
|
|
LAB_2CC9
|
7928 |
|
|
.byte $08 ; counter
|
7929 |
|
|
.byte $78,$3A,$C5,$37 ; 0.00285
|
7930 |
|
|
.byte $7B,$83,$A2,$5C ;-0.0160686
|
7931 |
|
|
.byte $7C,$2E,$DD,$4D ; 0.0426915
|
7932 |
|
|
.byte $7D,$99,$B0,$1E ;-0.0750429
|
7933 |
|
|
.byte $7D,$59,$ED,$24 ; 0.106409
|
7934 |
|
|
.byte $7E,$91,$72,$00 ;-0.142036
|
7935 |
|
|
.byte $7E,$4C,$B9,$73 ; 0.199926
|
7936 |
|
|
.byte $7F,$AA,$AA,$53 ;-0.333331
|
7937 |
|
|
|
7938 |
|
|
;## .byte $08 ; counter
|
7939 |
|
|
;## .byte $78,$3B,$D7,$4A ; 1/17
|
7940 |
|
|
;## .byte $7B,$84,$6E,$02 ;-1/15
|
7941 |
|
|
;## .byte $7C,$2F,$C1,$FE ; 1/13
|
7942 |
|
|
;## .byte $7D,$9A,$31,$74 ;-1/11
|
7943 |
|
|
;## .byte $7D,$5A,$3D,$84 ; 1/9
|
7944 |
|
|
;## .byte $7E,$91,$7F,$C8 ;-1/7
|
7945 |
|
|
;## .byte $7E,$4C,$BB,$E4 ; 1/5
|
7946 |
|
|
;## .byte $7F,$AA,$AA,$6C ;-1/3
|
7947 |
|
|
|
7948 |
|
|
LAB_1D96 = *+1 ; $00,$00 used for undefined variables
|
7949 |
|
|
LAB_259C
|
7950 |
|
|
.byte $81,$00,$00,$00 ; 1.000000, used for INC
|
7951 |
|
|
LAB_2AFD
|
7952 |
|
|
.byte $81,$80,$00,$00 ; -1.00000, used for DEC. must be on the same page as +1.00
|
7953 |
|
|
|
7954 |
|
|
; misc constants
|
7955 |
|
|
LAB_1DF7
|
7956 |
|
|
.byte $90 ;-32768 (uses first three bytes from 0.5)
|
7957 |
|
|
LAB_2A96
|
7958 |
|
|
.byte $80,$00,$00,$00 ; 0.5
|
7959 |
|
|
LAB_2C80
|
7960 |
|
|
.byte $7F,$00,$00,$00 ; 0.25
|
7961 |
|
|
LAB_26B5
|
7962 |
|
|
.byte $84,$20,$00,$00 ; 10.0000 divide by 10 constant
|
7963 |
|
|
|
7964 |
|
|
; This table is used in converting numbers to ASCII.
|
7965 |
|
|
|
7966 |
|
|
LAB_2A9A
|
7967 |
|
|
LAB_2A9B = LAB_2A9A+1
|
7968 |
|
|
LAB_2A9C = LAB_2A9B+1
|
7969 |
|
|
.byte $FE,$79,$60 ; -100000
|
7970 |
|
|
.byte $00,$27,$10 ; 10000
|
7971 |
|
|
.byte $FF,$FC,$18 ; -1000
|
7972 |
|
|
.byte $00,$00,$64 ; 100
|
7973 |
|
|
.byte $FF,$FF,$F6 ; -10
|
7974 |
|
|
.byte $00,$00,$01 ; 1
|
7975 |
|
|
|
7976 |
|
|
LAB_CTBL
|
7977 |
|
|
.word LAB_END-1 ; END
|
7978 |
|
|
.word LAB_FOR-1 ; FOR
|
7979 |
|
|
.word LAB_NEXT-1 ; NEXT
|
7980 |
|
|
.word LAB_DATA-1 ; DATA
|
7981 |
|
|
.word LAB_INPUT-1 ; INPUT
|
7982 |
|
|
.word LAB_DIM-1 ; DIM
|
7983 |
|
|
.word LAB_READ-1 ; READ
|
7984 |
|
|
.word LAB_LET-1 ; LET
|
7985 |
|
|
.word LAB_DEC-1 ; DEC new command
|
7986 |
|
|
.word LAB_GOTO-1 ; GOTO
|
7987 |
|
|
.word LAB_RUN-1 ; RUN
|
7988 |
|
|
.word LAB_IF-1 ; IF
|
7989 |
|
|
.word LAB_RESTORE-1 ; RESTORE modified command
|
7990 |
|
|
.word LAB_GOSUB-1 ; GOSUB
|
7991 |
|
|
.word LAB_RETIRQ-1 ; RETIRQ new command
|
7992 |
|
|
.word LAB_RETNMI-1 ; RETNMI new command
|
7993 |
|
|
.word LAB_RETURN-1 ; RETURN
|
7994 |
|
|
.word LAB_REM-1 ; REM
|
7995 |
|
|
.word LAB_STOP-1 ; STOP
|
7996 |
|
|
.word LAB_ON-1 ; ON modified command
|
7997 |
|
|
.word LAB_NULL-1 ; NULL modified command
|
7998 |
|
|
.word LAB_INC-1 ; INC new command
|
7999 |
|
|
.word LAB_WAIT-1 ; WAIT
|
8000 |
|
|
.word V_LOAD-1 ; LOAD
|
8001 |
|
|
.word V_SAVE-1 ; SAVE
|
8002 |
|
|
.word LAB_DEF-1 ; DEF
|
8003 |
|
|
.word LAB_POKE-1 ; POKE
|
8004 |
|
|
.word LAB_DOKE-1 ; DOKE new command
|
8005 |
|
|
.word LAB_CALL-1 ; CALL new command
|
8006 |
|
|
.word LAB_DO-1 ; DO new command
|
8007 |
|
|
.word LAB_LOOP-1 ; LOOP new command
|
8008 |
|
|
.word LAB_PRINT-1 ; PRINT
|
8009 |
|
|
.word LAB_CONT-1 ; CONT
|
8010 |
|
|
.word LAB_LIST-1 ; LIST
|
8011 |
|
|
.word LAB_CLEAR-1 ; CLEAR
|
8012 |
|
|
.word LAB_NEW-1 ; NEW
|
8013 |
|
|
.word LAB_WDTH-1 ; WIDTH new command
|
8014 |
|
|
.word LAB_GET-1 ; GET new command
|
8015 |
|
|
.word LAB_SWAP-1 ; SWAP new command
|
8016 |
|
|
.word LAB_BITSET-1 ; BITSET new command
|
8017 |
|
|
.word LAB_BITCLR-1 ; BITCLR new command
|
8018 |
|
|
.word LAB_IRQ-1 ; IRQ new command
|
8019 |
|
|
.word LAB_NMI-1 ; NMI new command
|
8020 |
|
|
.word LAB_BYE-1 ; BYE new command
|
8021 |
|
|
|
8022 |
|
|
; function pre process routine table
|
8023 |
|
|
|
8024 |
|
|
LAB_FTPL
|
8025 |
|
|
LAB_FTPM = LAB_FTPL+$01
|
8026 |
|
|
.word LAB_PPFN-1 ; SGN(n) process numeric expression in ()
|
8027 |
|
|
.word LAB_PPFN-1 ; INT(n) "
|
8028 |
|
|
.word LAB_PPFN-1 ; ABS(n) "
|
8029 |
|
|
.word LAB_EVEZ-1 ; USR(x) process any expression
|
8030 |
|
|
.word LAB_1BF7-1 ; FRE(x) "
|
8031 |
|
|
.word LAB_1BF7-1 ; POS(x) "
|
8032 |
|
|
.word LAB_PPFN-1 ; SQR(n) process numeric expression in ()
|
8033 |
|
|
.word LAB_PPFN-1 ; RND(n) "
|
8034 |
|
|
.word LAB_PPFN-1 ; LOG(n) "
|
8035 |
|
|
.word LAB_PPFN-1 ; EXP(n) "
|
8036 |
|
|
.word LAB_PPFN-1 ; COS(n) "
|
8037 |
|
|
.word LAB_PPFN-1 ; SIN(n) "
|
8038 |
|
|
.word LAB_PPFN-1 ; TAN(n) "
|
8039 |
|
|
.word LAB_PPFN-1 ; ATN(n) "
|
8040 |
|
|
.word LAB_PPFN-1 ; PEEK(n) "
|
8041 |
|
|
.word LAB_PPFN-1 ; DEEK(n) "
|
8042 |
|
|
.word $0000 ; SADD() none
|
8043 |
|
|
.word LAB_PPFS-1 ; LEN($) process string expression in ()
|
8044 |
|
|
.word LAB_PPFN-1 ; STR$(n) process numeric expression in ()
|
8045 |
|
|
.word LAB_PPFS-1 ; VAL($) process string expression in ()
|
8046 |
|
|
.word LAB_PPFS-1 ; ASC($) "
|
8047 |
|
|
.word LAB_PPFS-1 ; UCASE$($) "
|
8048 |
|
|
.word LAB_PPFS-1 ; LCASE$($) "
|
8049 |
|
|
.word LAB_PPFN-1 ; CHR$(n) process numeric expression in ()
|
8050 |
|
|
.word LAB_BHSS-1 ; HEX$(n) "
|
8051 |
|
|
.word LAB_BHSS-1 ; BIN$(n) "
|
8052 |
|
|
.word $0000 ; BITTST() none
|
8053 |
|
|
.word LAB_MMPP-1 ; MAX() process numeric expression
|
8054 |
|
|
.word LAB_MMPP-1 ; MIN() "
|
8055 |
|
|
.word LAB_PPBI-1 ; PI advance pointer
|
8056 |
|
|
.word LAB_PPBI-1 ; TWOPI "
|
8057 |
|
|
.word $0000 ; VARPTR() none
|
8058 |
|
|
.word LAB_LRMS-1 ; LEFT$() process string expression
|
8059 |
|
|
.word LAB_LRMS-1 ; RIGHT$() "
|
8060 |
|
|
.word LAB_LRMS-1 ; MID$() "
|
8061 |
|
|
|
8062 |
|
|
; action addresses for functions
|
8063 |
|
|
|
8064 |
|
|
LAB_FTBL
|
8065 |
|
|
LAB_FTBM = LAB_FTBL+$01
|
8066 |
|
|
.word LAB_SGN-1 ; SGN()
|
8067 |
|
|
.word LAB_INT-1 ; INT()
|
8068 |
|
|
.word LAB_ABS-1 ; ABS()
|
8069 |
|
|
.word LAB_USR-1 ; USR()
|
8070 |
|
|
.word LAB_FRE-1 ; FRE()
|
8071 |
|
|
.word LAB_POS-1 ; POS()
|
8072 |
|
|
.word LAB_SQR-1 ; SQR()
|
8073 |
|
|
.word LAB_RND-1 ; RND() modified function
|
8074 |
|
|
.word LAB_LOG-1 ; LOG()
|
8075 |
|
|
.word LAB_EXP-1 ; EXP()
|
8076 |
|
|
.word LAB_COS-1 ; COS()
|
8077 |
|
|
.word LAB_SIN-1 ; SIN()
|
8078 |
|
|
.word LAB_TAN-1 ; TAN()
|
8079 |
|
|
.word LAB_ATN-1 ; ATN()
|
8080 |
|
|
.word LAB_PEEK-1 ; PEEK()
|
8081 |
|
|
.word LAB_DEEK-1 ; DEEK() new function
|
8082 |
|
|
.word LAB_SADD-1 ; SADD() new function
|
8083 |
|
|
.word LAB_LENS-1 ; LEN()
|
8084 |
|
|
.word LAB_STRS-1 ; STR$()
|
8085 |
|
|
.word LAB_VAL-1 ; VAL()
|
8086 |
|
|
.word LAB_ASC-1 ; ASC()
|
8087 |
|
|
.word LAB_UCASE-1 ; UCASE$() new function
|
8088 |
|
|
.word LAB_LCASE-1 ; LCASE$() new function
|
8089 |
|
|
.word LAB_CHRS-1 ; CHR$()
|
8090 |
|
|
.word LAB_HEXS-1 ; HEX$() new function
|
8091 |
|
|
.word LAB_BINS-1 ; BIN$() new function
|
8092 |
|
|
.word LAB_BTST-1 ; BITTST() new function
|
8093 |
|
|
.word LAB_MAX-1 ; MAX() new function
|
8094 |
|
|
.word LAB_MIN-1 ; MIN() new function
|
8095 |
|
|
.word LAB_PI-1 ; PI new function
|
8096 |
|
|
.word LAB_TWOPI-1 ; TWOPI new function
|
8097 |
|
|
.word LAB_VARPTR-1 ; VARPTR() new function
|
8098 |
|
|
.word LAB_LEFT-1 ; LEFT$()
|
8099 |
|
|
.word LAB_RIGHT-1 ; RIGHT$()
|
8100 |
|
|
.word LAB_MIDS-1 ; MID$()
|
8101 |
|
|
|
8102 |
|
|
; hierarchy and action addresses for operator
|
8103 |
|
|
|
8104 |
|
|
LAB_OPPT
|
8105 |
|
|
.byte $79 ; +
|
8106 |
|
|
.word LAB_ADD-1
|
8107 |
|
|
.byte $79 ; -
|
8108 |
|
|
.word LAB_SUBTRACT-1
|
8109 |
|
|
.byte $7B ; *
|
8110 |
|
|
.word LAB_MULTIPLY-1
|
8111 |
|
|
.byte $7B ; /
|
8112 |
|
|
.word LAB_DIVIDE-1
|
8113 |
|
|
.byte $7F ; ^
|
8114 |
|
|
.word LAB_POWER-1
|
8115 |
|
|
.byte $50 ; AND
|
8116 |
|
|
.word LAB_AND-1
|
8117 |
|
|
.byte $46 ; EOR new operator
|
8118 |
|
|
.word LAB_EOR-1
|
8119 |
|
|
.byte $46 ; OR
|
8120 |
|
|
.word LAB_OR-1
|
8121 |
|
|
.byte $56 ; >> new operator
|
8122 |
|
|
.word LAB_RSHIFT-1
|
8123 |
|
|
.byte $56 ; << new operator
|
8124 |
|
|
.word LAB_LSHIFT-1
|
8125 |
|
|
.byte $7D ; >
|
8126 |
|
|
.word LAB_GTHAN-1
|
8127 |
|
|
.byte $5A ; =
|
8128 |
|
|
.word LAB_EQUAL-1
|
8129 |
|
|
.byte $64 ; <
|
8130 |
|
|
.word LAB_LTHAN-1
|
8131 |
|
|
|
8132 |
|
|
; keywords start with ..
|
8133 |
|
|
; this is the first character table and must be in alphabetic order
|
8134 |
|
|
|
8135 |
|
|
TAB_1STC
|
8136 |
|
|
.byte "*"
|
8137 |
|
|
.byte "+"
|
8138 |
|
|
.byte "-"
|
8139 |
|
|
.byte "/"
|
8140 |
|
|
.byte "<"
|
8141 |
|
|
.byte "="
|
8142 |
|
|
.byte ">"
|
8143 |
|
|
.byte "?"
|
8144 |
|
|
.byte "A"
|
8145 |
|
|
.byte "B"
|
8146 |
|
|
.byte "C"
|
8147 |
|
|
.byte "D"
|
8148 |
|
|
.byte "E"
|
8149 |
|
|
.byte "F"
|
8150 |
|
|
.byte "G"
|
8151 |
|
|
.byte "H"
|
8152 |
|
|
.byte "I"
|
8153 |
|
|
.byte "L"
|
8154 |
|
|
.byte "M"
|
8155 |
|
|
.byte "N"
|
8156 |
|
|
.byte "O"
|
8157 |
|
|
.byte "P"
|
8158 |
|
|
.byte "R"
|
8159 |
|
|
.byte "S"
|
8160 |
|
|
.byte "T"
|
8161 |
|
|
.byte "U"
|
8162 |
|
|
.byte "V"
|
8163 |
|
|
.byte "W"
|
8164 |
|
|
.byte "^"
|
8165 |
|
|
.byte $00 ; table terminator
|
8166 |
|
|
|
8167 |
|
|
; pointers to keyword tables
|
8168 |
|
|
|
8169 |
|
|
TAB_CHRT
|
8170 |
|
|
.word TAB_STAR ; table for "*"
|
8171 |
|
|
.word TAB_PLUS ; table for "+"
|
8172 |
|
|
.word TAB_MNUS ; table for "-"
|
8173 |
|
|
.word TAB_SLAS ; table for "/"
|
8174 |
|
|
.word TAB_LESS ; table for "<"
|
8175 |
|
|
.word TAB_EQUL ; table for "="
|
8176 |
|
|
.word TAB_MORE ; table for ">"
|
8177 |
|
|
.word TAB_QEST ; table for "?"
|
8178 |
|
|
.word TAB_ASCA ; table for "A"
|
8179 |
|
|
.word TAB_ASCB ; table for "B"
|
8180 |
|
|
.word TAB_ASCC ; table for "C"
|
8181 |
|
|
.word TAB_ASCD ; table for "D"
|
8182 |
|
|
.word TAB_ASCE ; table for "E"
|
8183 |
|
|
.word TAB_ASCF ; table for "F"
|
8184 |
|
|
.word TAB_ASCG ; table for "G"
|
8185 |
|
|
.word TAB_ASCH ; table for "H"
|
8186 |
|
|
.word TAB_ASCI ; table for "I"
|
8187 |
|
|
.word TAB_ASCL ; table for "L"
|
8188 |
|
|
.word TAB_ASCM ; table for "M"
|
8189 |
|
|
.word TAB_ASCN ; table for "N"
|
8190 |
|
|
.word TAB_ASCO ; table for "O"
|
8191 |
|
|
.word TAB_ASCP ; table for "P"
|
8192 |
|
|
.word TAB_ASCR ; table for "R"
|
8193 |
|
|
.word TAB_ASCS ; table for "S"
|
8194 |
|
|
.word TAB_ASCT ; table for "T"
|
8195 |
|
|
.word TAB_ASCU ; table for "U"
|
8196 |
|
|
.word TAB_ASCV ; table for "V"
|
8197 |
|
|
.word TAB_ASCW ; table for "W"
|
8198 |
|
|
.word TAB_POWR ; table for "^"
|
8199 |
|
|
|
8200 |
|
|
; tables for each start character, note if a longer keyword with the same start
|
8201 |
|
|
; letters as a shorter one exists then it must come first, else the list is in
|
8202 |
|
|
; alphabetical order as follows ..
|
8203 |
|
|
|
8204 |
|
|
; [keyword,token
|
8205 |
|
|
; [keyword,token]]
|
8206 |
|
|
; end marker (#$00)
|
8207 |
|
|
|
8208 |
|
|
TAB_STAR
|
8209 |
|
|
.byte TK_MUL,$00 ; *
|
8210 |
|
|
TAB_PLUS
|
8211 |
|
|
.byte TK_PLUS,$00 ; +
|
8212 |
|
|
TAB_MNUS
|
8213 |
|
|
.byte TK_MINUS,$00 ; -
|
8214 |
|
|
TAB_SLAS
|
8215 |
|
|
.byte TK_DIV,$00 ; /
|
8216 |
|
|
TAB_LESS
|
8217 |
|
|
LBB_LSHIFT
|
8218 |
|
|
.byte "<",TK_LSHIFT ; << note - "<<" must come before "<"
|
8219 |
|
|
.byte TK_LT ; <
|
8220 |
|
|
.byte $00
|
8221 |
|
|
TAB_EQUL
|
8222 |
|
|
.byte TK_EQUAL,$00 ; =
|
8223 |
|
|
TAB_MORE
|
8224 |
|
|
LBB_RSHIFT
|
8225 |
|
|
.byte ">",TK_RSHIFT ; >> note - ">>" must come before ">"
|
8226 |
|
|
.byte TK_GT ; >
|
8227 |
|
|
.byte $00
|
8228 |
|
|
TAB_QEST
|
8229 |
|
|
.byte TK_PRINT,$00 ; ?
|
8230 |
|
|
TAB_ASCA
|
8231 |
|
|
LBB_ABS
|
8232 |
|
|
.byte "BS(",TK_ABS ; ABS(
|
8233 |
|
|
LBB_AND
|
8234 |
|
|
.byte "ND",TK_AND ; AND
|
8235 |
|
|
LBB_ASC
|
8236 |
|
|
.byte "SC(",TK_ASC ; ASC(
|
8237 |
|
|
LBB_ATN
|
8238 |
|
|
.byte "TN(",TK_ATN ; ATN(
|
8239 |
|
|
.byte $00
|
8240 |
|
|
TAB_ASCB
|
8241 |
|
|
LBB_BINS
|
8242 |
|
|
.byte "IN$(",TK_BINS ; BIN$(
|
8243 |
|
|
LBB_BITCLR
|
8244 |
|
|
.byte "ITCLR",TK_BITCLR ; BITCLR
|
8245 |
|
|
LBB_BITSET
|
8246 |
|
|
.byte "ITSET",TK_BITSET ; BITSET
|
8247 |
|
|
LBB_BITTST
|
8248 |
|
|
.byte "ITTST(",TK_BITTST
|
8249 |
|
|
; BITTST(
|
8250 |
|
|
LBB_BYE
|
8251 |
|
|
.byte "YE", TK_BYE ; BYE
|
8252 |
|
|
.byte $00
|
8253 |
|
|
TAB_ASCC
|
8254 |
|
|
LBB_CALL
|
8255 |
|
|
.byte "ALL",TK_CALL ; CALL
|
8256 |
|
|
LBB_CHRS
|
8257 |
|
|
.byte "HR$(",TK_CHRS ; CHR$(
|
8258 |
|
|
LBB_CLEAR
|
8259 |
|
|
.byte "LEAR",TK_CLEAR ; CLEAR
|
8260 |
|
|
LBB_CONT
|
8261 |
|
|
.byte "ONT",TK_CONT ; CONT
|
8262 |
|
|
LBB_COS
|
8263 |
|
|
.byte "OS(",TK_COS ; COS(
|
8264 |
|
|
.byte $00
|
8265 |
|
|
TAB_ASCD
|
8266 |
|
|
LBB_DATA
|
8267 |
|
|
.byte "ATA",TK_DATA ; DATA
|
8268 |
|
|
LBB_DEC
|
8269 |
|
|
.byte "EC",TK_DEC ; DEC
|
8270 |
|
|
LBB_DEEK
|
8271 |
|
|
.byte "EEK(",TK_DEEK ; DEEK(
|
8272 |
|
|
LBB_DEF
|
8273 |
|
|
.byte "EF",TK_DEF ; DEF
|
8274 |
|
|
LBB_DIM
|
8275 |
|
|
.byte "IM",TK_DIM ; DIM
|
8276 |
|
|
LBB_DOKE
|
8277 |
|
|
.byte "OKE",TK_DOKE ; DOKE note - "DOKE" must come before "DO"
|
8278 |
|
|
LBB_DO
|
8279 |
|
|
.byte "O",TK_DO ; DO
|
8280 |
|
|
.byte $00
|
8281 |
|
|
TAB_ASCE
|
8282 |
|
|
LBB_ELSE
|
8283 |
|
|
.byte "LSE",TK_ELSE ; ELSE
|
8284 |
|
|
LBB_END
|
8285 |
|
|
.byte "ND",TK_END ; END
|
8286 |
|
|
LBB_EOR
|
8287 |
|
|
.byte "OR",TK_EOR ; EOR
|
8288 |
|
|
LBB_EXP
|
8289 |
|
|
.byte "XP(",TK_EXP ; EXP(
|
8290 |
|
|
.byte $00
|
8291 |
|
|
TAB_ASCF
|
8292 |
|
|
LBB_FN
|
8293 |
|
|
.byte "N",TK_FN ; FN
|
8294 |
|
|
LBB_FOR
|
8295 |
|
|
.byte "OR",TK_FOR ; FOR
|
8296 |
|
|
LBB_FRE
|
8297 |
|
|
.byte "RE(",TK_FRE ; FRE(
|
8298 |
|
|
.byte $00
|
8299 |
|
|
TAB_ASCG
|
8300 |
|
|
LBB_GET
|
8301 |
|
|
.byte "ET",TK_GET ; GET
|
8302 |
|
|
LBB_GOSUB
|
8303 |
|
|
.byte "OSUB",TK_GOSUB ; GOSUB
|
8304 |
|
|
LBB_GOTO
|
8305 |
|
|
.byte "OTO",TK_GOTO ; GOTO
|
8306 |
|
|
.byte $00
|
8307 |
|
|
TAB_ASCH
|
8308 |
|
|
LBB_HEXS
|
8309 |
|
|
.byte "EX$(",TK_HEXS ; HEX$(
|
8310 |
|
|
.byte $00
|
8311 |
|
|
TAB_ASCI
|
8312 |
|
|
LBB_IF
|
8313 |
|
|
.byte "F",TK_IF ; IF
|
8314 |
|
|
LBB_INC
|
8315 |
|
|
.byte "NC",TK_INC ; INC
|
8316 |
|
|
LBB_INPUT
|
8317 |
|
|
.byte "NPUT",TK_INPUT ; INPUT
|
8318 |
|
|
LBB_INT
|
8319 |
|
|
.byte "NT(",TK_INT ; INT(
|
8320 |
|
|
LBB_IRQ
|
8321 |
|
|
.byte "RQ",TK_IRQ ; IRQ
|
8322 |
|
|
.byte $00
|
8323 |
|
|
TAB_ASCL
|
8324 |
|
|
LBB_LCASES
|
8325 |
|
|
.byte "CASE$(",TK_LCASES
|
8326 |
|
|
; LCASE$(
|
8327 |
|
|
LBB_LEFTS
|
8328 |
|
|
.byte "EFT$(",TK_LEFTS ; LEFT$(
|
8329 |
|
|
LBB_LEN
|
8330 |
|
|
.byte "EN(",TK_LEN ; LEN(
|
8331 |
|
|
LBB_LET
|
8332 |
|
|
.byte "ET",TK_LET ; LET
|
8333 |
|
|
LBB_LIST
|
8334 |
|
|
.byte "IST",TK_LIST ; LIST
|
8335 |
|
|
LBB_LOAD
|
8336 |
|
|
.byte "OAD",TK_LOAD ; LOAD
|
8337 |
|
|
LBB_LOG
|
8338 |
|
|
.byte "OG(",TK_LOG ; LOG(
|
8339 |
|
|
LBB_LOOP
|
8340 |
|
|
.byte "OOP",TK_LOOP ; LOOP
|
8341 |
|
|
.byte $00
|
8342 |
|
|
TAB_ASCM
|
8343 |
|
|
LBB_MAX
|
8344 |
|
|
.byte "AX(",TK_MAX ; MAX(
|
8345 |
|
|
LBB_MIDS
|
8346 |
|
|
.byte "ID$(",TK_MIDS ; MID$(
|
8347 |
|
|
LBB_MIN
|
8348 |
|
|
.byte "IN(",TK_MIN ; MIN(
|
8349 |
|
|
.byte $00
|
8350 |
|
|
TAB_ASCN
|
8351 |
|
|
LBB_NEW
|
8352 |
|
|
.byte "EW",TK_NEW ; NEW
|
8353 |
|
|
LBB_NEXT
|
8354 |
|
|
.byte "EXT",TK_NEXT ; NEXT
|
8355 |
|
|
LBB_NMI
|
8356 |
|
|
.byte "MI",TK_NMI ; NMI
|
8357 |
|
|
LBB_NOT
|
8358 |
|
|
.byte "OT",TK_NOT ; NOT
|
8359 |
|
|
LBB_NULL
|
8360 |
|
|
.byte "ULL",TK_NULL ; NULL
|
8361 |
|
|
.byte $00
|
8362 |
|
|
TAB_ASCO
|
8363 |
|
|
LBB_OFF
|
8364 |
|
|
.byte "FF",TK_OFF ; OFF
|
8365 |
|
|
LBB_ON
|
8366 |
|
|
.byte "N",TK_ON ; ON
|
8367 |
|
|
LBB_OR
|
8368 |
|
|
.byte "R",TK_OR ; OR
|
8369 |
|
|
.byte $00
|
8370 |
|
|
TAB_ASCP
|
8371 |
|
|
LBB_PEEK
|
8372 |
|
|
.byte "EEK(",TK_PEEK ; PEEK(
|
8373 |
|
|
LBB_PI
|
8374 |
|
|
.byte "I",TK_PI ; PI
|
8375 |
|
|
LBB_POKE
|
8376 |
|
|
.byte "OKE",TK_POKE ; POKE
|
8377 |
|
|
LBB_POS
|
8378 |
|
|
.byte "OS(",TK_POS ; POS(
|
8379 |
|
|
LBB_PRINT
|
8380 |
|
|
.byte "RINT",TK_PRINT ; PRINT
|
8381 |
|
|
.byte $00
|
8382 |
|
|
TAB_ASCR
|
8383 |
|
|
LBB_READ
|
8384 |
|
|
.byte "EAD",TK_READ ; READ
|
8385 |
|
|
LBB_REM
|
8386 |
|
|
.byte "EM",TK_REM ; REM
|
8387 |
|
|
LBB_RESTORE
|
8388 |
|
|
.byte "ESTORE",TK_RESTORE
|
8389 |
|
|
; RESTORE
|
8390 |
|
|
LBB_RETIRQ
|
8391 |
|
|
.byte "ETIRQ",TK_RETIRQ ; RETIRQ
|
8392 |
|
|
LBB_RETNMI
|
8393 |
|
|
.byte "ETNMI",TK_RETNMI ; RETNMI
|
8394 |
|
|
LBB_RETURN
|
8395 |
|
|
.byte "ETURN",TK_RETURN ; RETURN
|
8396 |
|
|
LBB_RIGHTS
|
8397 |
|
|
.byte "IGHT$(",TK_RIGHTS
|
8398 |
|
|
; RIGHT$(
|
8399 |
|
|
LBB_RND
|
8400 |
|
|
.byte "ND(",TK_RND ; RND(
|
8401 |
|
|
LBB_RUN
|
8402 |
|
|
.byte "UN",TK_RUN ; RUN
|
8403 |
|
|
.byte $00
|
8404 |
|
|
TAB_ASCS
|
8405 |
|
|
LBB_SADD
|
8406 |
|
|
.byte "ADD(",TK_SADD ; SADD(
|
8407 |
|
|
LBB_SAVE
|
8408 |
|
|
.byte "AVE",TK_SAVE ; SAVE
|
8409 |
|
|
LBB_SGN
|
8410 |
|
|
.byte "GN(",TK_SGN ; SGN(
|
8411 |
|
|
LBB_SIN
|
8412 |
|
|
.byte "IN(",TK_SIN ; SIN(
|
8413 |
|
|
LBB_SPC
|
8414 |
|
|
.byte "PC(",TK_SPC ; SPC(
|
8415 |
|
|
LBB_SQR
|
8416 |
|
|
.byte "QR(",TK_SQR ; SQR(
|
8417 |
|
|
LBB_STEP
|
8418 |
|
|
.byte "TEP",TK_STEP ; STEP
|
8419 |
|
|
LBB_STOP
|
8420 |
|
|
.byte "TOP",TK_STOP ; STOP
|
8421 |
|
|
LBB_STRS
|
8422 |
|
|
.byte "TR$(",TK_STRS ; STR$(
|
8423 |
|
|
LBB_SWAP
|
8424 |
|
|
.byte "WAP",TK_SWAP ; SWAP
|
8425 |
|
|
.byte $00
|
8426 |
|
|
TAB_ASCT
|
8427 |
|
|
LBB_TAB
|
8428 |
|
|
.byte "AB(",TK_TAB ; TAB(
|
8429 |
|
|
LBB_TAN
|
8430 |
|
|
.byte "AN(",TK_TAN ; TAN(
|
8431 |
|
|
LBB_THEN
|
8432 |
|
|
.byte "HEN",TK_THEN ; THEN
|
8433 |
|
|
LBB_TO
|
8434 |
|
|
.byte "O",TK_TO ; TO
|
8435 |
|
|
LBB_TWOPI
|
8436 |
|
|
.byte "WOPI",TK_TWOPI ; TWOPI
|
8437 |
|
|
.byte $00
|
8438 |
|
|
TAB_ASCU
|
8439 |
|
|
LBB_UCASES
|
8440 |
|
|
.byte "CASE$(",TK_UCASES
|
8441 |
|
|
; UCASE$(
|
8442 |
|
|
LBB_UNTIL
|
8443 |
|
|
.byte "NTIL",TK_UNTIL ; UNTIL
|
8444 |
|
|
LBB_USR
|
8445 |
|
|
.byte "SR(",TK_USR ; USR(
|
8446 |
|
|
.byte $00
|
8447 |
|
|
TAB_ASCV
|
8448 |
|
|
LBB_VAL
|
8449 |
|
|
.byte "AL(",TK_VAL ; VAL(
|
8450 |
|
|
LBB_VPTR
|
8451 |
|
|
.byte "ARPTR(",TK_VPTR ; VARPTR(
|
8452 |
|
|
.byte $00
|
8453 |
|
|
TAB_ASCW
|
8454 |
|
|
LBB_WAIT
|
8455 |
|
|
.byte "AIT",TK_WAIT ; WAIT
|
8456 |
|
|
LBB_WHILE
|
8457 |
|
|
.byte "HILE",TK_WHILE ; WHILE
|
8458 |
|
|
LBB_WIDTH
|
8459 |
|
|
.byte "IDTH",TK_WIDTH ; WIDTH
|
8460 |
|
|
.byte $00
|
8461 |
|
|
TAB_POWR
|
8462 |
|
|
.byte TK_POWER,$00 ; ^
|
8463 |
|
|
|
8464 |
|
|
; new decode table for LIST
|
8465 |
|
|
; Table is ..
|
8466 |
|
|
; byte - keyword length, keyword first character
|
8467 |
|
|
; word - pointer to rest of keyword from dictionary
|
8468 |
|
|
|
8469 |
|
|
; note if length is 1 then the pointer is ignored
|
8470 |
|
|
|
8471 |
|
|
LAB_KEYT
|
8472 |
|
|
.byte 3,'E'
|
8473 |
|
|
.word LBB_END ; END
|
8474 |
|
|
.byte 3,'F'
|
8475 |
|
|
.word LBB_FOR ; FOR
|
8476 |
|
|
.byte 4,'N'
|
8477 |
|
|
.word LBB_NEXT ; NEXT
|
8478 |
|
|
.byte 4,'D'
|
8479 |
|
|
.word LBB_DATA ; DATA
|
8480 |
|
|
.byte 5,'I'
|
8481 |
|
|
.word LBB_INPUT ; INPUT
|
8482 |
|
|
.byte 3,'D'
|
8483 |
|
|
.word LBB_DIM ; DIM
|
8484 |
|
|
.byte 4,'R'
|
8485 |
|
|
.word LBB_READ ; READ
|
8486 |
|
|
.byte 3,'L'
|
8487 |
|
|
.word LBB_LET ; LET
|
8488 |
|
|
.byte 3,'D'
|
8489 |
|
|
.word LBB_DEC ; DEC
|
8490 |
|
|
.byte 4,'G'
|
8491 |
|
|
.word LBB_GOTO ; GOTO
|
8492 |
|
|
.byte 3,'R'
|
8493 |
|
|
.word LBB_RUN ; RUN
|
8494 |
|
|
.byte 2,'I'
|
8495 |
|
|
.word LBB_IF ; IF
|
8496 |
|
|
.byte 7,'R'
|
8497 |
|
|
.word LBB_RESTORE ; RESTORE
|
8498 |
|
|
.byte 5,'G'
|
8499 |
|
|
.word LBB_GOSUB ; GOSUB
|
8500 |
|
|
.byte 6,'R'
|
8501 |
|
|
.word LBB_RETIRQ ; RETIRQ
|
8502 |
|
|
.byte 6,'R'
|
8503 |
|
|
.word LBB_RETNMI ; RETNMI
|
8504 |
|
|
.byte 6,'R'
|
8505 |
|
|
.word LBB_RETURN ; RETURN
|
8506 |
|
|
.byte 3,'R'
|
8507 |
|
|
.word LBB_REM ; REM
|
8508 |
|
|
.byte 4,'S'
|
8509 |
|
|
.word LBB_STOP ; STOP
|
8510 |
|
|
.byte 2,'O'
|
8511 |
|
|
.word LBB_ON ; ON
|
8512 |
|
|
.byte 4,'N'
|
8513 |
|
|
.word LBB_NULL ; NULL
|
8514 |
|
|
.byte 3,'I'
|
8515 |
|
|
.word LBB_INC ; INC
|
8516 |
|
|
.byte 4,'W'
|
8517 |
|
|
.word LBB_WAIT ; WAIT
|
8518 |
|
|
.byte 4,'L'
|
8519 |
|
|
.word LBB_LOAD ; LOAD
|
8520 |
|
|
.byte 4,'S'
|
8521 |
|
|
.word LBB_SAVE ; SAVE
|
8522 |
|
|
.byte 3,'D'
|
8523 |
|
|
.word LBB_DEF ; DEF
|
8524 |
|
|
.byte 4,'P'
|
8525 |
|
|
.word LBB_POKE ; POKE
|
8526 |
|
|
.byte 4,'D'
|
8527 |
|
|
.word LBB_DOKE ; DOKE
|
8528 |
|
|
.byte 4,'C'
|
8529 |
|
|
.word LBB_CALL ; CALL
|
8530 |
|
|
.byte 2,'D'
|
8531 |
|
|
.word LBB_DO ; DO
|
8532 |
|
|
.byte 4,'L'
|
8533 |
|
|
.word LBB_LOOP ; LOOP
|
8534 |
|
|
.byte 5,'P'
|
8535 |
|
|
.word LBB_PRINT ; PRINT
|
8536 |
|
|
.byte 4,'C'
|
8537 |
|
|
.word LBB_CONT ; CONT
|
8538 |
|
|
.byte 4,'L'
|
8539 |
|
|
.word LBB_LIST ; LIST
|
8540 |
|
|
.byte 5,'C'
|
8541 |
|
|
.word LBB_CLEAR ; CLEAR
|
8542 |
|
|
.byte 3,'N'
|
8543 |
|
|
.word LBB_NEW ; NEW
|
8544 |
|
|
.byte 5,'W'
|
8545 |
|
|
.word LBB_WIDTH ; WIDTH
|
8546 |
|
|
.byte 3,'G'
|
8547 |
|
|
.word LBB_GET ; GET
|
8548 |
|
|
.byte 4,'S'
|
8549 |
|
|
.word LBB_SWAP ; SWAP
|
8550 |
|
|
.byte 6,'B'
|
8551 |
|
|
.word LBB_BITSET ; BITSET
|
8552 |
|
|
.byte 6,'B'
|
8553 |
|
|
.word LBB_BITCLR ; BITCLR
|
8554 |
|
|
.byte 3,'I'
|
8555 |
|
|
.word LBB_IRQ ; IRQ
|
8556 |
|
|
.byte 3,'N'
|
8557 |
|
|
.word LBB_NMI ; NMI
|
8558 |
|
|
.byte 3,'B'
|
8559 |
|
|
.word LBB_BYE ; BYE
|
8560 |
|
|
|
8561 |
|
|
; secondary commands (can't start a statement)
|
8562 |
|
|
|
8563 |
|
|
.byte 4,'T'
|
8564 |
|
|
.word LBB_TAB ; TAB
|
8565 |
|
|
.byte 4,'E'
|
8566 |
|
|
.word LBB_ELSE ; ELSE
|
8567 |
|
|
.byte 2,'T'
|
8568 |
|
|
.word LBB_TO ; TO
|
8569 |
|
|
.byte 2,'F'
|
8570 |
|
|
.word LBB_FN ; FN
|
8571 |
|
|
.byte 4,'S'
|
8572 |
|
|
.word LBB_SPC ; SPC
|
8573 |
|
|
.byte 4,'T'
|
8574 |
|
|
.word LBB_THEN ; THEN
|
8575 |
|
|
.byte 3,'N'
|
8576 |
|
|
.word LBB_NOT ; NOT
|
8577 |
|
|
.byte 4,'S'
|
8578 |
|
|
.word LBB_STEP ; STEP
|
8579 |
|
|
.byte 5,'U'
|
8580 |
|
|
.word LBB_UNTIL ; UNTIL
|
8581 |
|
|
.byte 5,'W'
|
8582 |
|
|
.word LBB_WHILE ; WHILE
|
8583 |
|
|
.byte 3,'O'
|
8584 |
|
|
.word LBB_OFF ; OFF
|
8585 |
|
|
|
8586 |
|
|
; opperators
|
8587 |
|
|
|
8588 |
|
|
.byte 1,'+'
|
8589 |
|
|
.word $0000 ; +
|
8590 |
|
|
.byte 1,'-'
|
8591 |
|
|
.word $0000 ; -
|
8592 |
|
|
.byte 1,'*'
|
8593 |
|
|
.word $0000 ; *
|
8594 |
|
|
.byte 1,'/'
|
8595 |
|
|
.word $0000 ; /
|
8596 |
|
|
.byte 1,'^'
|
8597 |
|
|
.word $0000 ; ^
|
8598 |
|
|
.byte 3,'A'
|
8599 |
|
|
.word LBB_AND ; AND
|
8600 |
|
|
.byte 3,'E'
|
8601 |
|
|
.word LBB_EOR ; EOR
|
8602 |
|
|
.byte 2,'O'
|
8603 |
|
|
.word LBB_OR ; OR
|
8604 |
|
|
.byte 2,'>'
|
8605 |
|
|
.word LBB_RSHIFT ; >>
|
8606 |
|
|
.byte 2,'<'
|
8607 |
|
|
.word LBB_LSHIFT ; <<
|
8608 |
|
|
.byte 1,'>'
|
8609 |
|
|
.word $0000 ; >
|
8610 |
|
|
.byte 1,'='
|
8611 |
|
|
.word $0000 ; =
|
8612 |
|
|
.byte 1,'<'
|
8613 |
|
|
.word $0000 ; <
|
8614 |
|
|
|
8615 |
|
|
; functions
|
8616 |
|
|
|
8617 |
|
|
.byte 4,'S' ;
|
8618 |
|
|
.word LBB_SGN ; SGN
|
8619 |
|
|
.byte 4,'I' ;
|
8620 |
|
|
.word LBB_INT ; INT
|
8621 |
|
|
.byte 4,'A' ;
|
8622 |
|
|
.word LBB_ABS ; ABS
|
8623 |
|
|
.byte 4,'U' ;
|
8624 |
|
|
.word LBB_USR ; USR
|
8625 |
|
|
.byte 4,'F' ;
|
8626 |
|
|
.word LBB_FRE ; FRE
|
8627 |
|
|
.byte 4,'P' ;
|
8628 |
|
|
.word LBB_POS ; POS
|
8629 |
|
|
.byte 4,'S' ;
|
8630 |
|
|
.word LBB_SQR ; SQR
|
8631 |
|
|
.byte 4,'R' ;
|
8632 |
|
|
.word LBB_RND ; RND
|
8633 |
|
|
.byte 4,'L' ;
|
8634 |
|
|
.word LBB_LOG ; LOG
|
8635 |
|
|
.byte 4,'E' ;
|
8636 |
|
|
.word LBB_EXP ; EXP
|
8637 |
|
|
.byte 4,'C' ;
|
8638 |
|
|
.word LBB_COS ; COS
|
8639 |
|
|
.byte 4,'S' ;
|
8640 |
|
|
.word LBB_SIN ; SIN
|
8641 |
|
|
.byte 4,'T' ;
|
8642 |
|
|
.word LBB_TAN ; TAN
|
8643 |
|
|
.byte 4,'A' ;
|
8644 |
|
|
.word LBB_ATN ; ATN
|
8645 |
|
|
.byte 5,'P' ;
|
8646 |
|
|
.word LBB_PEEK ; PEEK
|
8647 |
|
|
.byte 5,'D' ;
|
8648 |
|
|
.word LBB_DEEK ; DEEK
|
8649 |
|
|
.byte 5,'S' ;
|
8650 |
|
|
.word LBB_SADD ; SADD
|
8651 |
|
|
.byte 4,'L' ;
|
8652 |
|
|
.word LBB_LEN ; LEN
|
8653 |
|
|
.byte 5,'S' ;
|
8654 |
|
|
.word LBB_STRS ; STR$
|
8655 |
|
|
.byte 4,'V' ;
|
8656 |
|
|
.word LBB_VAL ; VAL
|
8657 |
|
|
.byte 4,'A' ;
|
8658 |
|
|
.word LBB_ASC ; ASC
|
8659 |
|
|
.byte 7,'U' ;
|
8660 |
|
|
.word LBB_UCASES ; UCASE$
|
8661 |
|
|
.byte 7,'L' ;
|
8662 |
|
|
.word LBB_LCASES ; LCASE$
|
8663 |
|
|
.byte 5,'C' ;
|
8664 |
|
|
.word LBB_CHRS ; CHR$
|
8665 |
|
|
.byte 5,'H' ;
|
8666 |
|
|
.word LBB_HEXS ; HEX$
|
8667 |
|
|
.byte 5,'B' ;
|
8668 |
|
|
.word LBB_BINS ; BIN$
|
8669 |
|
|
.byte 7,'B' ;
|
8670 |
|
|
.word LBB_BITTST ; BITTST
|
8671 |
|
|
.byte 4,'M' ;
|
8672 |
|
|
.word LBB_MAX ; MAX
|
8673 |
|
|
.byte 4,'M' ;
|
8674 |
|
|
.word LBB_MIN ; MIN
|
8675 |
|
|
.byte 2,'P' ;
|
8676 |
|
|
.word LBB_PI ; PI
|
8677 |
|
|
.byte 5,'T' ;
|
8678 |
|
|
.word LBB_TWOPI ; TWOPI
|
8679 |
|
|
.byte 7,'V' ;
|
8680 |
|
|
.word LBB_VPTR ; VARPTR
|
8681 |
|
|
.byte 6,'L' ;
|
8682 |
|
|
.word LBB_LEFTS ; LEFT$
|
8683 |
|
|
.byte 7,'R' ;
|
8684 |
|
|
.word LBB_RIGHTS ; RIGHT$
|
8685 |
|
|
.byte 5,'M' ;
|
8686 |
|
|
.word LBB_MIDS ; MID$
|
8687 |
|
|
|
8688 |
|
|
; BASIC messages, mostly error messages
|
8689 |
|
|
|
8690 |
|
|
LAB_BAER
|
8691 |
|
|
.word ERR_NF ;$00 NEXT without FOR
|
8692 |
|
|
.word ERR_SN ;$02 syntax
|
8693 |
|
|
.word ERR_RG ;$04 RETURN without GOSUB
|
8694 |
|
|
.word ERR_OD ;$06 out of data
|
8695 |
|
|
.word ERR_FC ;$08 function call
|
8696 |
|
|
.word ERR_OV ;$0A overflow
|
8697 |
|
|
.word ERR_OM ;$0C out of memory
|
8698 |
|
|
.word ERR_US ;$0E undefined statement
|
8699 |
|
|
.word ERR_BS ;$10 array bounds
|
8700 |
|
|
.word ERR_DD ;$12 double dimension array
|
8701 |
|
|
.word ERR_D0 ;$14 divide by 0
|
8702 |
|
|
.word ERR_ID ;$16 illegal direct
|
8703 |
|
|
.word ERR_TM ;$18 type mismatch
|
8704 |
|
|
.word ERR_LS ;$1A long string
|
8705 |
|
|
.word ERR_ST ;$1C string too complex
|
8706 |
|
|
.word ERR_CN ;$1E continue error
|
8707 |
|
|
.word ERR_UF ;$20 undefined function
|
8708 |
|
|
.word ERR_LD ;$22 LOOP without DO
|
8709 |
|
|
|
8710 |
|
|
; I may implement these two errors to force definition of variables and
|
8711 |
|
|
; dimensioning of arrays before use.
|
8712 |
|
|
|
8713 |
|
|
; .word ERR_UV ;$24 undefined variable
|
8714 |
|
|
|
8715 |
|
|
; the above error has been tested and works (see code and comments below LAB_1D8B)
|
8716 |
|
|
|
8717 |
|
|
; .word ERR_UA ;$26 undimensioned array
|
8718 |
|
|
|
8719 |
|
|
ERR_NF .byte "NEXT without FOR",$00
|
8720 |
|
|
ERR_SN .byte "Syntax",$00
|
8721 |
|
|
ERR_RG .byte "RETURN without GOSUB",$00
|
8722 |
|
|
ERR_OD .byte "Out of DATA",$00
|
8723 |
|
|
ERR_FC .byte "Function call",$00
|
8724 |
|
|
ERR_OV .byte "Overflow",$00
|
8725 |
|
|
ERR_OM .byte "Out of memory",$00
|
8726 |
|
|
ERR_US .byte "Undefined statement",$00
|
8727 |
|
|
ERR_BS .byte "Array bounds",$00
|
8728 |
|
|
ERR_DD .byte "Double dimension",$00
|
8729 |
|
|
ERR_D0 .byte "Divide by zero",$00
|
8730 |
|
|
ERR_ID .byte "Illegal direct",$00
|
8731 |
|
|
ERR_TM .byte "Type mismatch",$00
|
8732 |
|
|
ERR_LS .byte "String too long",$00
|
8733 |
|
|
ERR_ST .byte "String too complex",$00
|
8734 |
|
|
ERR_CN .byte "Can't continue",$00
|
8735 |
|
|
ERR_UF .byte "Undefined function",$00
|
8736 |
|
|
ERR_LD .byte "LOOP without DO",$00
|
8737 |
|
|
|
8738 |
|
|
;ERR_UV .byte "Undefined variable",$00
|
8739 |
|
|
|
8740 |
|
|
; the above error has been tested and works (see code and comments below LAB_1D8B)
|
8741 |
|
|
|
8742 |
|
|
;ERR_UA .byte "Undimensioned array",$00
|
8743 |
|
|
|
8744 |
|
|
LAB_BMSG .byte $0D,$0A,"Break",$00
|
8745 |
|
|
LAB_EMSG .byte " Error",$00
|
8746 |
|
|
LAB_LMSG .byte " in line ",$00
|
8747 |
|
|
LAB_RMSG .byte $0D,$0A,"Ready",$0D,$0A,$00
|
8748 |
|
|
|
8749 |
|
|
LAB_IMSG .byte " Extra ignored",$0D,$0A,$00
|
8750 |
|
|
LAB_REDO .byte " Redo from start",$0D,$0A,$00
|
8751 |
|
|
|
8752 |
|
|
AA_end_basic
|
8753 |
|
|
|
8754 |
|
|
vecbrki=$0102
|
8755 |
|
|
|
8756 |
|
|
org $F000
|
8757 |
|
|
|
8758 |
|
|
cpu rtf65002
|
8759 |
|
|
jsr (RequestIOFocus>>2)
|
8760 |
|
|
jsr (ClearScreen>>2)
|
8761 |
|
|
jsr (HomeCursor>>2)
|
8762 |
|
|
lda #0 ; turn off keyboard echoing
|
8763 |
|
|
jsr (SetKeyboardEcho>>2)
|
8764 |
|
|
emm
|
8765 |
|
|
cpu W65C02
|
8766 |
|
|
LDA #
|
8767 |
|
|
STA VEC_IN
|
8768 |
|
|
LDA #>V__INPT
|
8769 |
|
|
STA VEC_IN+1
|
8770 |
|
|
LDA #
|
8771 |
|
|
STA VEC_OUT
|
8772 |
|
|
LDA #>V__OUTP
|
8773 |
|
|
STA VEC_OUT+1
|
8774 |
|
|
LDA #
|
8775 |
|
|
STA VEC_LD
|
8776 |
|
|
LDA #>LOAD3
|
8777 |
|
|
STA VEC_LD+1
|
8778 |
|
|
LDA #
|
8779 |
|
|
STA VEC_SV
|
8780 |
|
|
LDA #>SAVE3
|
8781 |
|
|
STA VEC_SV+1
|
8782 |
|
|
JMP LAB_COLD
|
8783 |
|
|
|
8784 |
|
|
; ===== Output character to the console from register r1
|
8785 |
|
|
; (Preserves all registers.)
|
8786 |
|
|
; Does a far indirect subroutine call to native code.
|
8787 |
|
|
;
|
8788 |
|
|
V__OUTP:
|
8789 |
|
|
nat
|
8790 |
|
|
cpu rtf65002
|
8791 |
|
|
pha
|
8792 |
|
|
jsr (DisplayChar>>2) ; should not trash char
|
8793 |
|
|
pla
|
8794 |
|
|
emm
|
8795 |
|
|
cpu W65C02
|
8796 |
|
|
and #$FF ; set Z, N according to char in accumulator
|
8797 |
|
|
rts
|
8798 |
|
|
|
8799 |
|
|
; ===== Output character to the console from register r1
|
8800 |
|
|
; (Preserves all registers.)
|
8801 |
|
|
; Does a far indirect subroutine call to native code.
|
8802 |
|
|
;
|
8803 |
|
|
V__OUTP816:
|
8804 |
|
|
nat
|
8805 |
|
|
cpu rtf65002
|
8806 |
|
|
pha
|
8807 |
|
|
jsr (DisplayChar>>2) ; should not trash char
|
8808 |
|
|
pla
|
8809 |
|
|
clc
|
8810 |
|
|
xce
|
8811 |
|
|
cpu W65C02
|
8812 |
|
|
rts
|
8813 |
|
|
|
8814 |
|
|
|
8815 |
|
|
; ===== Input a character from the console into register R1
|
8816 |
|
|
; set C if a char is available
|
8817 |
|
|
; clear C if no char is available
|
8818 |
|
|
;
|
8819 |
|
|
;
|
8820 |
|
|
V__INPT:
|
8821 |
|
|
nat
|
8822 |
|
|
cpu rtf65002
|
8823 |
|
|
jsr (KeybdGetChar>>2)
|
8824 |
|
|
cmp #-1
|
8825 |
|
|
beq .0001
|
8826 |
|
|
emm
|
8827 |
|
|
cpu W65C02
|
8828 |
|
|
sec
|
8829 |
|
|
rts
|
8830 |
|
|
.0001:
|
8831 |
|
|
cpu rtf65002
|
8832 |
|
|
emm
|
8833 |
|
|
cpu W65C02
|
8834 |
|
|
clc
|
8835 |
|
|
rts
|
8836 |
|
|
|
8837 |
|
|
; ===== Input a character from the console into register R1
|
8838 |
|
|
; clear C if a char is available
|
8839 |
|
|
; set C if no char is available
|
8840 |
|
|
;
|
8841 |
|
|
;
|
8842 |
|
|
V__INPT816:
|
8843 |
|
|
nat
|
8844 |
|
|
cpu rtf65002
|
8845 |
|
|
jsr (KeybdGetChar>>2)
|
8846 |
|
|
cmp #-1
|
8847 |
|
|
beq .001
|
8848 |
|
|
clc
|
8849 |
|
|
xce
|
8850 |
|
|
cpu W65C02
|
8851 |
|
|
clc
|
8852 |
|
|
rts
|
8853 |
|
|
.001:
|
8854 |
|
|
cpu rtf65002
|
8855 |
|
|
clc
|
8856 |
|
|
xce
|
8857 |
|
|
cpu W65C02
|
8858 |
|
|
sec
|
8859 |
|
|
rts
|
8860 |
|
|
|
8861 |
|
|
Resched816:
|
8862 |
|
|
nat
|
8863 |
|
|
cpu rtf65002
|
8864 |
|
|
int #2
|
8865 |
|
|
clc
|
8866 |
|
|
xce
|
8867 |
|
|
cpu W65C816S
|
8868 |
|
|
rts
|
8869 |
|
|
|
8870 |
|
|
;*
|
8871 |
|
|
;* ===== Input a character from the host into register r1 (or
|
8872 |
|
|
;* return Zero status if there's no character available).
|
8873 |
|
|
;*
|
8874 |
|
|
cpu rtf65002
|
8875 |
|
|
AUXIN_INIT:
|
8876 |
|
|
stz INPNDX
|
8877 |
|
|
lda #FILENAME
|
8878 |
|
|
ldx #FILEBUF<<2
|
8879 |
|
|
ldy #$3800 ; max length
|
8880 |
|
|
jsr (LoadFile>>2)
|
8881 |
|
|
rts
|
8882 |
|
|
|
8883 |
|
|
cpu W65C02
|
8884 |
|
|
AUXIN:
|
8885 |
|
|
nat
|
8886 |
|
|
cpu RTF65002
|
8887 |
|
|
phx
|
8888 |
|
|
ldx INPNDX
|
8889 |
|
|
lb r1,FILEBUF<<2,x
|
8890 |
|
|
cmp #$1A ; end of file ?
|
8891 |
|
|
bne AUXIN1
|
8892 |
|
|
sec
|
8893 |
|
|
xce
|
8894 |
|
|
cpu W65C02
|
8895 |
|
|
; restore the regular output
|
8896 |
|
|
lda $E0
|
8897 |
|
|
sta VEC_IN
|
8898 |
|
|
lda $E1
|
8899 |
|
|
sta VEC_IN+1
|
8900 |
|
|
lda #$0D
|
8901 |
|
|
sec
|
8902 |
|
|
rts
|
8903 |
|
|
cpu RTF65002
|
8904 |
|
|
AUXIN1:
|
8905 |
|
|
inx
|
8906 |
|
|
stx INPNDX
|
8907 |
|
|
plx
|
8908 |
|
|
emm
|
8909 |
|
|
cpu W65C02
|
8910 |
|
|
sec
|
8911 |
|
|
rts
|
8912 |
|
|
|
8913 |
|
|
; ===== Output character to the host (Port 2) from register r1
|
8914 |
|
|
; (Preserves all registers.)
|
8915 |
|
|
;
|
8916 |
|
|
AUXOUT_INIT:
|
8917 |
|
|
stz OUTNDX
|
8918 |
|
|
rts
|
8919 |
|
|
|
8920 |
|
|
AUXOUT:
|
8921 |
|
|
cpu W65C02
|
8922 |
|
|
nat
|
8923 |
|
|
cpu RTF65002
|
8924 |
|
|
phx
|
8925 |
|
|
ldx OUTNDX
|
8926 |
|
|
sb r1,FILEBUF<<2,x
|
8927 |
|
|
inx
|
8928 |
|
|
stx OUTNDX
|
8929 |
|
|
plx
|
8930 |
|
|
emm
|
8931 |
|
|
cpu W65C02
|
8932 |
|
|
rts
|
8933 |
|
|
|
8934 |
|
|
cpu RTF65002
|
8935 |
|
|
AUXOUT_FLUSH:
|
8936 |
|
|
lda #FILENAME
|
8937 |
|
|
ldx #FILEBUF<<2
|
8938 |
|
|
ldy OUTNDX
|
8939 |
|
|
jsr (SaveFile>>2)
|
8940 |
|
|
rts
|
8941 |
|
|
|
8942 |
|
|
LOAD3:
|
8943 |
|
|
jsr LAB_EVEZ ; get a string parameter
|
8944 |
|
|
lda Dtypef
|
8945 |
|
|
bpl LOAD4
|
8946 |
|
|
ldy #0
|
8947 |
|
|
lda (des_pl),y
|
8948 |
|
|
sta str_ln
|
8949 |
|
|
iny
|
8950 |
|
|
lda (des_pl),y
|
8951 |
|
|
sta str_pl
|
8952 |
|
|
iny
|
8953 |
|
|
lda (des_ph),y
|
8954 |
|
|
sta str_ph
|
8955 |
|
|
nat
|
8956 |
|
|
cpu RTF65002
|
8957 |
|
|
lb r4,str_ph ; r4 = pointer to file name
|
8958 |
|
|
asl r4,r4,#8
|
8959 |
|
|
orb r4,r4,str_pl
|
8960 |
|
|
lda #8 ; 8 words to zero out
|
8961 |
|
|
ldx #0 ; the value we want to use
|
8962 |
|
|
ldy #FILENAME ; the target address
|
8963 |
|
|
stos ; zap the memory
|
8964 |
|
|
lda str_ln ; number of bytes to move
|
8965 |
|
|
ld r2,r4 ; x = source
|
8966 |
|
|
ldy #FILENAME ; y = dest
|
8967 |
|
|
LOAD2:
|
8968 |
|
|
lb r4,0,r2
|
8969 |
|
|
sb r4,0,r3
|
8970 |
|
|
inx
|
8971 |
|
|
iny
|
8972 |
|
|
dea
|
8973 |
|
|
bne LOAD2
|
8974 |
|
|
jsr AUXIN_INIT ; initialize for file input (get the file)
|
8975 |
|
|
emm
|
8976 |
|
|
cpu W65C02
|
8977 |
|
|
; Save off the output vector and switch output to the
|
8978 |
|
|
; auxiallry output routine.
|
8979 |
|
|
sei
|
8980 |
|
|
lda VEC_IN ; save off the output vector to $E0
|
8981 |
|
|
sta $E0
|
8982 |
|
|
lda VEC_IN+1
|
8983 |
|
|
sta $E1
|
8984 |
|
|
lda #
|
8985 |
|
|
sta VEC_IN
|
8986 |
|
|
lda #>AUXIN
|
8987 |
|
|
sta VEC_IN+1
|
8988 |
|
|
jsr LAB_22B6 ; pop string descriptor from stack
|
8989 |
|
|
LOAD4:
|
8990 |
|
|
rts
|
8991 |
|
|
|
8992 |
|
|
SAVE3:
|
8993 |
|
|
JSR LAB_EVEZ ; get string parameter
|
8994 |
|
|
lda Dtypef
|
8995 |
|
|
bpl SAVE4 ; branch if not a string
|
8996 |
|
|
ldy #0
|
8997 |
|
|
lda (des_pl),y
|
8998 |
|
|
sta str_ln
|
8999 |
|
|
iny
|
9000 |
|
|
lda (des_pl),y
|
9001 |
|
|
sta str_pl
|
9002 |
|
|
iny
|
9003 |
|
|
lda (des_ph),y
|
9004 |
|
|
sta str_ph
|
9005 |
|
|
nat
|
9006 |
|
|
cpu RTF65002
|
9007 |
|
|
jsr AUXOUT_INIT ; initialize for file output
|
9008 |
|
|
lb r4,str_ph ; r4 = pointer to file name
|
9009 |
|
|
asl r4,r4,#8
|
9010 |
|
|
orb r4,r4,str_pl
|
9011 |
|
|
lda #8 ; 8 words to zero out
|
9012 |
|
|
ldx #0 ; the value we want to use
|
9013 |
|
|
ldy #FILENAME ; the target address
|
9014 |
|
|
stos ; zap the memory
|
9015 |
|
|
lda str_ln ; number of bytes to move
|
9016 |
|
|
ld r2,r4 ; x = source
|
9017 |
|
|
ldy #FILENAME ; y = dest
|
9018 |
|
|
SAVE2:
|
9019 |
|
|
lb r4,0,r2
|
9020 |
|
|
sb r4,0,r3
|
9021 |
|
|
inx
|
9022 |
|
|
iny
|
9023 |
|
|
dea
|
9024 |
|
|
bne SAVE2
|
9025 |
|
|
|
9026 |
|
|
emm
|
9027 |
|
|
cpu W65C02
|
9028 |
|
|
; Save off the output vector and switch output to the
|
9029 |
|
|
; auxiallry output routine.
|
9030 |
|
|
sei
|
9031 |
|
|
lda VEC_OUT ; save off the output vector to $E0
|
9032 |
|
|
sta $E0
|
9033 |
|
|
lda VEC_OUT+1
|
9034 |
|
|
sta $E1
|
9035 |
|
|
lda #
|
9036 |
|
|
sta VEC_OUT
|
9037 |
|
|
lda #>AUXOUT
|
9038 |
|
|
sta VEC_OUT+1
|
9039 |
|
|
; Invoke the LIST command
|
9040 |
|
|
lda #0
|
9041 |
|
|
jsr LAB_LIST
|
9042 |
|
|
lda #$1A ; spit out end-of-file marker
|
9043 |
|
|
jsr AUXOUT
|
9044 |
|
|
; restore the regular output
|
9045 |
|
|
lda $E0
|
9046 |
|
|
sta VEC_OUT
|
9047 |
|
|
lda $E1
|
9048 |
|
|
sta VEC_OUT+1
|
9049 |
|
|
nat
|
9050 |
|
|
cpu RTF65002
|
9051 |
|
|
jsr AUXOUT_FLUSH
|
9052 |
|
|
emm
|
9053 |
|
|
cpu W65C02
|
9054 |
|
|
jsr LAB_22B6 ; pop string descriptor from stack
|
9055 |
|
|
SAVE4:
|
9056 |
|
|
rts
|
9057 |
|
|
|
9058 |
|
|
cpu rtf65002
|
9059 |
|
|
outchar:
|
9060 |
|
|
jsr (DisplayChar>>2) ; should not trash char
|
9061 |
|
|
rts
|
9062 |
|
|
cpu rtf65002
|
9063 |
|
|
|
9064 |
|
|
ICacheIA816:
|
9065 |
|
|
nat
|
9066 |
|
|
jsr (ICacheInvalidateAll>>2)
|
9067 |
|
|
emm816
|
9068 |
|
|
rts
|
9069 |
|
|
|
9070 |
|
|
;------------------------------------------------------------------------------
|
9071 |
|
|
;------------------------------------------------------------------------------
|
9072 |
|
|
|
9073 |
|
|
ICacheIL816:
|
9074 |
|
|
nat
|
9075 |
|
|
jsr (ICacheInvalidateLine>>2)
|
9076 |
|
|
emm816
|
9077 |
|
|
rts
|
9078 |
|
|
|
9079 |
|
|
;==============================================================================
|
9080 |
|
|
;==============================================================================
|
9081 |
|
|
SPIMASTER EQU 0xFFDC0500
|
9082 |
|
|
SPI_MASTER_VERSION_REG EQU 0x00
|
9083 |
|
|
SPI_MASTER_CONTROL_REG EQU 0x01
|
9084 |
|
|
SPI_TRANS_TYPE_REG EQU 0x02
|
9085 |
|
|
SPI_TRANS_CTRL_REG EQU 0x03
|
9086 |
|
|
SPI_TRANS_STATUS_REG EQU 0x04
|
9087 |
|
|
SPI_TRANS_ERROR_REG EQU 0x05
|
9088 |
|
|
SPI_DIRECT_ACCESS_DATA_REG EQU 0x06
|
9089 |
|
|
SPI_SD_SECT_7_0_REG EQU 0x07
|
9090 |
|
|
SPI_SD_SECT_15_8_REG EQU 0x08
|
9091 |
|
|
SPI_SD_SECT_23_16_REG EQU 0x09
|
9092 |
|
|
SPI_SD_SECT_31_24_REG EQU 0x0a
|
9093 |
|
|
SPI_RX_FIFO_DATA_REG EQU 0x10
|
9094 |
|
|
SPI_RX_FIFO_DATA_COUNT_MSB EQU 0x12
|
9095 |
|
|
SPI_RX_FIFO_DATA_COUNT_LSB EQU 0x13
|
9096 |
|
|
SPI_RX_FIFO_CTRL_REG EQU 0x14
|
9097 |
|
|
SPI_TX_FIFO_DATA_REG EQU 0x20
|
9098 |
|
|
SPI_TX_FIFO_CTRL_REG EQU 0x24
|
9099 |
|
|
SPI_RESP_BYTE1 EQU 0x30
|
9100 |
|
|
SPI_RESP_BYTE2 EQU 0x31
|
9101 |
|
|
SPI_RESP_BYTE3 EQU 0x32
|
9102 |
|
|
SPI_RESP_BYTE4 EQU 0x33
|
9103 |
|
|
SPI_INIT_SD EQU 0x01
|
9104 |
|
|
SPI_TRANS_START EQU 0x01
|
9105 |
|
|
SPI_TRANS_BUSY EQU 0x01
|
9106 |
|
|
SPI_INIT_NO_ERROR EQU 0x00
|
9107 |
|
|
SPI_READ_NO_ERROR EQU 0x00
|
9108 |
|
|
SPI_WRITE_NO_ERROR EQU 0x00
|
9109 |
|
|
RW_READ_SD_BLOCK EQU 0x02
|
9110 |
|
|
RW_WRITE_SD_BLOCK EQU 0x03
|
9111 |
|
|
;
|
9112 |
|
|
; Initialize the SD card
|
9113 |
|
|
; Returns
|
9114 |
|
|
; acc = 0 if successful, 1 otherwise
|
9115 |
|
|
; Z=1 if successful, otherwise Z=0
|
9116 |
|
|
;
|
9117 |
|
|
message "spi_init"
|
9118 |
|
|
spi_init
|
9119 |
|
|
lda #SPI_INIT_SD
|
9120 |
|
|
sta SPIMASTER+SPI_TRANS_TYPE_REG
|
9121 |
|
|
lda #SPI_TRANS_START
|
9122 |
|
|
sta SPIMASTER+SPI_TRANS_CTRL_REG
|
9123 |
|
|
nop
|
9124 |
|
|
spi_init1
|
9125 |
|
|
lda SPIMASTER+SPI_TRANS_STATUS_REG
|
9126 |
|
|
nop
|
9127 |
|
|
nop
|
9128 |
|
|
cmp #SPI_TRANS_BUSY
|
9129 |
|
|
beq spi_init1
|
9130 |
|
|
lda SPIMASTER+SPI_TRANS_ERROR_REG
|
9131 |
|
|
and #3
|
9132 |
|
|
cmp #SPI_INIT_NO_ERROR
|
9133 |
|
|
bne spi_error
|
9134 |
|
|
; lda #spi_init_ok_msg
|
9135 |
|
|
; jsr DisplayStringB
|
9136 |
|
|
lda #0
|
9137 |
|
|
rts
|
9138 |
|
|
spi_error
|
9139 |
|
|
; jsr DisplayByte
|
9140 |
|
|
; lda #spi_init_error_msg
|
9141 |
|
|
; jsr DisplayStringB
|
9142 |
|
|
; lda SPIMASTER+SPI_RESP_BYTE1
|
9143 |
|
|
; jsr DisplayByte
|
9144 |
|
|
; lda SPIMASTER+SPI_RESP_BYTE2
|
9145 |
|
|
; jsr DisplayByte
|
9146 |
|
|
; lda SPIMASTER+SPI_RESP_BYTE3
|
9147 |
|
|
; jsr DisplayByte
|
9148 |
|
|
; lda SPIMASTER+SPI_RESP_BYTE4
|
9149 |
|
|
; jsr DisplayByte
|
9150 |
|
|
lda #1
|
9151 |
|
|
rts
|
9152 |
|
|
|
9153 |
|
|
spi_delay:
|
9154 |
|
|
nop
|
9155 |
|
|
nop
|
9156 |
|
|
rts
|
9157 |
|
|
|
9158 |
|
|
|
9159 |
|
|
; SPI read sector
|
9160 |
|
|
;
|
9161 |
|
|
; r1= sector number to read
|
9162 |
|
|
; r2= address to place read data
|
9163 |
|
|
; Returns:
|
9164 |
|
|
; r1 = 0 if successful
|
9165 |
|
|
;
|
9166 |
|
|
spi_read_sector:
|
9167 |
|
|
phx
|
9168 |
|
|
phy
|
9169 |
|
|
push r4
|
9170 |
|
|
|
9171 |
|
|
sta SPIMASTER+SPI_SD_SECT_7_0_REG
|
9172 |
|
|
lsr r1,r1,#8
|
9173 |
|
|
sta SPIMASTER+SPI_SD_SECT_15_8_REG
|
9174 |
|
|
lsr r1,r1,#8
|
9175 |
|
|
sta SPIMASTER+SPI_SD_SECT_23_16_REG
|
9176 |
|
|
lsr r1,r1,#8
|
9177 |
|
|
sta SPIMASTER+SPI_SD_SECT_31_24_REG
|
9178 |
|
|
|
9179 |
|
|
ld r4,#20 ; retry count
|
9180 |
|
|
|
9181 |
|
|
spi_read_retry:
|
9182 |
|
|
; Force the reciever fifo to be empty, in case a prior error leaves it
|
9183 |
|
|
; in an unknown state.
|
9184 |
|
|
lda #1
|
9185 |
|
|
sta SPIMASTER+SPI_RX_FIFO_CTRL_REG
|
9186 |
|
|
|
9187 |
|
|
lda #RW_READ_SD_BLOCK
|
9188 |
|
|
sta SPIMASTER+SPI_TRANS_TYPE_REG
|
9189 |
|
|
lda #SPI_TRANS_START
|
9190 |
|
|
sta SPIMASTER+SPI_TRANS_CTRL_REG
|
9191 |
|
|
nop
|
9192 |
|
|
spi_read_sect1:
|
9193 |
|
|
lda SPIMASTER+SPI_TRANS_STATUS_REG
|
9194 |
|
|
jsr spi_delay ; just a delay between consecutive status reg reads
|
9195 |
|
|
cmp #SPI_TRANS_BUSY
|
9196 |
|
|
beq spi_read_sect1
|
9197 |
|
|
lda SPIMASTER+SPI_TRANS_ERROR_REG
|
9198 |
|
|
lsr
|
9199 |
|
|
lsr
|
9200 |
|
|
and #3
|
9201 |
|
|
cmp #SPI_READ_NO_ERROR
|
9202 |
|
|
bne spi_read_error
|
9203 |
|
|
ldy #512 ; read 512 bytes from fifo
|
9204 |
|
|
spi_read_sect2:
|
9205 |
|
|
lda SPIMASTER+SPI_RX_FIFO_DATA_REG
|
9206 |
|
|
sb r1,0,x
|
9207 |
|
|
inx
|
9208 |
|
|
dey
|
9209 |
|
|
bne spi_read_sect2
|
9210 |
|
|
lda #0
|
9211 |
|
|
bra spi_read_ret
|
9212 |
|
|
spi_read_error:
|
9213 |
|
|
dec r4
|
9214 |
|
|
bne spi_read_retry
|
9215 |
|
|
; jsr DisplayByte
|
9216 |
|
|
; lda #spi_read_error_msg
|
9217 |
|
|
; jsr DisplayStringB
|
9218 |
|
|
lda #1
|
9219 |
|
|
spi_read_ret:
|
9220 |
|
|
pop r4
|
9221 |
|
|
ply
|
9222 |
|
|
plx
|
9223 |
|
|
rts
|
9224 |
|
|
|
9225 |
|
|
; SPI write sector
|
9226 |
|
|
;
|
9227 |
|
|
; r1= sector number to write
|
9228 |
|
|
; r2= address to get data from
|
9229 |
|
|
; Returns:
|
9230 |
|
|
; r1 = 0 if successful
|
9231 |
|
|
;
|
9232 |
|
|
spi_write_sector:
|
9233 |
|
|
phx
|
9234 |
|
|
phy
|
9235 |
|
|
pha
|
9236 |
|
|
; Force the transmitter fifo to be empty, in case a prior error leaves it
|
9237 |
|
|
; in an unknown state.
|
9238 |
|
|
lda #1
|
9239 |
|
|
sta SPIMASTER+SPI_TX_FIFO_CTRL_REG
|
9240 |
|
|
nop ; give I/O time to respond
|
9241 |
|
|
nop
|
9242 |
|
|
|
9243 |
|
|
; now fill up the transmitter fifo
|
9244 |
|
|
ldy #512
|
9245 |
|
|
spi_write_sect1:
|
9246 |
|
|
lb r1,0,x
|
9247 |
|
|
sta SPIMASTER+SPI_TX_FIFO_DATA_REG
|
9248 |
|
|
nop ; give the I/O time to respond
|
9249 |
|
|
nop
|
9250 |
|
|
inx
|
9251 |
|
|
dey
|
9252 |
|
|
bne spi_write_sect1
|
9253 |
|
|
|
9254 |
|
|
; set the sector number in the spi master address registers
|
9255 |
|
|
pla
|
9256 |
|
|
sta SPIMASTER+SPI_SD_SECT_7_0_REG
|
9257 |
|
|
lsr r1,r1,#8
|
9258 |
|
|
sta SPIMASTER+SPI_SD_SECT_15_8_REG
|
9259 |
|
|
lsr r1,r1,#8
|
9260 |
|
|
sta SPIMASTER+SPI_SD_SECT_23_16_REG
|
9261 |
|
|
lsr r1,r1,#8
|
9262 |
|
|
sta SPIMASTER+SPI_SD_SECT_31_24_REG
|
9263 |
|
|
|
9264 |
|
|
; issue the write command
|
9265 |
|
|
lda #RW_WRITE_SD_BLOCK
|
9266 |
|
|
sta SPIMASTER+SPI_TRANS_TYPE_REG
|
9267 |
|
|
lda #SPI_TRANS_START
|
9268 |
|
|
sta SPIMASTER+SPI_TRANS_CTRL_REG
|
9269 |
|
|
nop
|
9270 |
|
|
spi_write_sect2:
|
9271 |
|
|
lda SPIMASTER+SPI_TRANS_STATUS_REG
|
9272 |
|
|
nop ; just a delay between consecutive status reg reads
|
9273 |
|
|
nop
|
9274 |
|
|
cmp #SPI_TRANS_BUSY
|
9275 |
|
|
beq spi_write_sect2
|
9276 |
|
|
lda SPIMASTER+SPI_TRANS_ERROR_REG
|
9277 |
|
|
lsr r1,r1,#4
|
9278 |
|
|
and #3
|
9279 |
|
|
cmp #SPI_WRITE_NO_ERROR
|
9280 |
|
|
bne spi_write_error
|
9281 |
|
|
lda #0
|
9282 |
|
|
bra spi_write_ret
|
9283 |
|
|
spi_write_error:
|
9284 |
|
|
; jsr DisplayByte
|
9285 |
|
|
; lda #spi_write_error_msg
|
9286 |
|
|
; jsr DisplayStringB
|
9287 |
|
|
lda #1
|
9288 |
|
|
|
9289 |
|
|
spi_write_ret:
|
9290 |
|
|
ply
|
9291 |
|
|
plx
|
9292 |
|
|
rts
|
9293 |
|
|
|
9294 |
|
|
|
9295 |
|
|
cpu W65C816S
|
9296 |
|
|
brk_rout:
|
9297 |
|
|
phb ;save DB
|
9298 |
|
|
phd ;save DP
|
9299 |
|
|
rep #%00110000 ;16 bit registers
|
9300 |
|
|
pha
|
9301 |
|
|
phx
|
9302 |
|
|
phy
|
9303 |
|
|
jmp (vecbrki) ;indirect vector
|
9304 |
|
|
brk1:
|
9305 |
|
|
rep #%00110000 ;16 bit registers
|
9306 |
|
|
ply
|
9307 |
|
|
plx
|
9308 |
|
|
pla
|
9309 |
|
|
pld
|
9310 |
|
|
plb
|
9311 |
|
|
rti
|
9312 |
|
|
|
9313 |
|
|
cpu W65C02
|
9314 |
|
|
org $F400
|
9315 |
|
|
jmp V__INPT816
|
9316 |
|
|
jmp LAB_BYE
|
9317 |
|
|
jmp V__OUTP816
|
9318 |
|
|
jmp Resched816
|
9319 |
|
|
|
9320 |
|
|
cpu RTF65002
|
9321 |
|
|
org $F500
|
9322 |
|
|
jsr (RequestIOFocus>>2)
|
9323 |
|
|
jsr (ClearScreen>>2)
|
9324 |
|
|
jsr (HomeCursor>>2)
|
9325 |
|
|
lda #0 ; turn off keyboard echoing
|
9326 |
|
|
jsr (SetKeyboardEcho>>2)
|
9327 |
|
|
; trs r0,cc ; turn caches off
|
9328 |
|
|
clc
|
9329 |
|
|
xce
|
9330 |
|
|
cpu W65C816S
|
9331 |
|
|
rep #%00110000 ;16 bit registers
|
9332 |
|
|
mem 16
|
9333 |
|
|
ndx 16
|
9334 |
|
|
lda #brk1 ; initialize the break routine vector
|
9335 |
|
|
sta vecbrki
|
9336 |
|
|
jmp $008000
|
9337 |
|
|
|
9338 |
|
|
org $FFE6
|
9339 |
|
|
dw brk_rout
|
9340 |
|
|
|