Mercurial > hg > index.cgi
comparison exbas11.s @ 0:605ff82c4618
Initial check in with cleaned up sources
This is the initial check in the source code in a state where it builds byte
accurate copies of all the various ROM versions included.
author | William Astle <lost@l-w.ca> |
---|---|
date | Sat, 08 Dec 2018 19:57:01 -0700 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:605ff82c4618 |
---|---|
1 *pragma nolist | |
2 include defs.s | |
3 ; These are the entry points in the Color Basic ROM which are used the the Extended Basic ROM. | |
4 ; They are included here in order to keep the Extended Basic ROM separate from the Color Basic | |
5 ; ROM. | |
6 BAWMST EQU 0xA0E8 | |
7 CLOAD EQU 0xA498 | |
8 CSAVE EQU 0xA44C | |
9 DATA EQU 0xAEE0 | |
10 EVALEXPB EQU 0xB70B | |
11 GIVABF EQU 0xB4F4 | |
12 INT EQU 0xBCEE | |
13 LA0E2 EQU 0xA0E2 | |
14 LA171 EQU 0xA171 | |
15 LA176 EQU 0xA176 | |
16 LA35F EQU 0xA35F | |
17 LA3ED EQU 0xA3ED | |
18 LA406 EQU 0xA406 | |
19 LA429 EQU 0xA429 | |
20 LA42D EQU 0xA42D | |
21 LA444 EQU 0xA444 | |
22 LA491 EQU 0xA491 | |
23 LA505 EQU 0xA505 | |
24 LA578 EQU 0xA578 | |
25 LA59A EQU 0xA59A | |
26 LA5A5 EQU 0xA5A5 | |
27 LA5AE EQU 0xA5AE | |
28 LA5C7 EQU 0xA5C7 | |
29 LA5E4 EQU 0xA5E4 | |
30 LA616 EQU 0xA616 | |
31 LA619 EQU 0xA619 | |
32 LA635 EQU 0xA635 | |
33 LA644 EQU 0xA644 | |
34 LA648 EQU 0xA648 | |
35 LA65F EQU 0xA65F | |
36 LA7E9 EQU 0xA7E9 | |
37 LA974 EQU 0xA974 | |
38 LA976 EQU 0xA976 | |
39 LA9A2 EQU 0xA9A2 | |
40 LA9BB EQU 0xA9BB | |
41 LAC1E EQU 0xAC1E | |
42 LAC33 EQU 0xAC33 | |
43 LAC46 EQU 0xAC46 | |
44 LAC60 EQU 0xAC60 | |
45 LAC73 EQU 0xAC73 | |
46 LAC7C EQU 0xAC7C | |
47 LAC9D EQU 0xAC9D | |
48 LACA8 EQU 0xACA8 | |
49 LACEF EQU 0xACEF | |
50 LACF1 EQU 0xACF1 | |
51 LAD01 EQU 0xAD01 | |
52 LAD19 EQU 0xAD19 | |
53 LAD21 EQU 0xAD21 | |
54 LAD26 EQU 0xAD26 | |
55 LAD33 EQU 0xAD33 | |
56 LAD9E EQU 0xAD9E | |
57 LADC6 EQU 0xADC6 | |
58 LADD4 EQU 0xADD4 | |
59 LADEB EQU 0xADEB | |
60 LAE15 EQU 0xAE15 | |
61 LAED2 EQU 0xAED2 | |
62 LAF67 EQU 0xAF67 | |
63 LAFA4 EQU 0xAFA4 | |
64 LB035 EQU 0xB035 | |
65 LB141 EQU 0xB141 | |
66 LB143 EQU 0xB143 | |
67 LB146 EQU 0xB146 | |
68 LB156 EQU 0xB156 | |
69 LB158 EQU 0xB158 | |
70 LB244 EQU 0xB244 | |
71 LB262 EQU 0xB262 | |
72 LB267 EQU 0xB267 | |
73 LB26A EQU 0xB26A | |
74 LB26F EQU 0xB26F | |
75 LB277 EQU 0xB277 | |
76 LB284 EQU 0xB284 | |
77 LB2CE EQU 0xB2CE | |
78 LB357 EQU 0xB357 | |
79 LB35C EQU 0xB35C | |
80 LB3A2 EQU 0xB3A2 | |
81 LB44A EQU 0xB44A | |
82 LB4F3 EQU 0xB4F3 | |
83 LB50F EQU 0xB50F | |
84 LB518 EQU 0xB518 | |
85 LB51A EQU 0xB51A | |
86 LB56D EQU 0xB56D | |
87 LB643 EQU 0xB643 | |
88 LB654 EQU 0xB654 | |
89 LB657 EQU 0xB657 | |
90 LB659 EQU 0xB659 | |
91 LB69B EQU 0xB69B | |
92 LB6A4 EQU 0xB6A4 | |
93 LB6AD EQU 0xB6AD | |
94 LB70E EQU 0xB70E | |
95 LB734 EQU 0xB734 | |
96 LB738 EQU 0xB738 | |
97 LB73D EQU 0xB73D | |
98 LB740 EQU 0xB740 | |
99 LB7C2 EQU 0xB7C2 | |
100 LB958 EQU 0xB958 | |
101 LB95C EQU 0xB95C | |
102 LB99F EQU 0xB99F | |
103 LB9AC EQU 0xB9AC | |
104 LB9AF EQU 0xB9AF | |
105 LB9B4 EQU 0xB9B4 | |
106 LB9B9 EQU 0xB9B9 | |
107 LB9C2 EQU 0xB9C2 | |
108 LBA1C EQU 0xBA1C | |
109 LBA3A EQU 0xBA3A | |
110 LBA92 EQU 0xBA92 | |
111 LBAC5 EQU 0xBAC5 | |
112 LBACA EQU 0xBACA | |
113 LBB48 EQU 0xBB48 | |
114 LBB5C EQU 0xBB5C | |
115 LBB6A EQU 0xBB6A | |
116 LBB82 EQU 0xBB82 | |
117 LBB8F EQU 0xBB8F | |
118 LBC14 EQU 0xBC14 | |
119 LBC2F EQU 0xBC2F | |
120 LBC35 EQU 0xBC35 | |
121 LBC4C EQU 0xBC4C | |
122 LBC5F EQU 0xBC5F | |
123 LBC6D EQU 0xBC6D | |
124 LBCA0 EQU 0xBCA0 | |
125 LBCC8 EQU 0xBCC8 | |
126 LBD99 EQU 0xBD99 | |
127 LBDB6 EQU 0xBDB6 | |
128 LBDBB EQU 0xBDBB | |
129 LBDC0 EQU 0xBDC0 | |
130 LBDC5 EQU 0xBDC5 | |
131 LBDCC EQU 0xBDCC | |
132 LBDD9 EQU 0xBDD9 | |
133 LBEC0 EQU 0xBEC0 | |
134 LBEC5 EQU 0xBEC5 | |
135 LBEE9 EQU 0xBEE9 | |
136 LBEF0 EQU 0xBEF0 | |
137 LBEFF EQU 0xBEFF | |
138 LBFA6 EQU 0xBFA6 | |
139 LET EQU 0xAF89 | |
140 PUTCHR EQU 0xA282 | |
141 SIN EQU 0xBF78 | |
142 SNDBLK EQU 0xA7F4 | |
143 STRINOUT EQU 0xB99C | |
144 SYNCOMMA EQU 0xB26D | |
145 WRLDR EQU 0xA7D8 | |
146 *pragma list | |
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
148 ; EXTENDED COLOR BASIC ROM | |
149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
150 org EXBAS | |
151 fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic | |
152 L8002 ldx #L80DE ; point to command interpretation table information | |
153 ldu #COMVEC+10 ; point to command interpretation table location | |
154 ldb #10 ; 10 bytes to move | |
155 jsr LA59A ; copy command interpretation table | |
156 ldx #LB277 ; initialize Disk Basic's entries to error | |
157 stx 3,u | |
158 stx 8,u | |
159 ldx #XIRQSV ; set up IRQ service routine | |
160 stx IRQVEC+1 | |
161 ldx ZERO ; reset the TIMER value | |
162 stx TIMVAL | |
163 jsr XVEC18 ; do a bunch of initialization | |
164 ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout | |
165 std DLBAUD | |
166 ldx #USR0 ; set up pointer to USR routine addresses | |
167 stx USRADR | |
168 ldu #LB44A ; set up USR routine addresses to "FC error" | |
169 ldb #10 ; there are 10 routines | |
170 L8031 stu ,x++ ; set a routine to FC error | |
171 decb ; done all? | |
172 bne L8031 ; brif not | |
173 lda #0x7e ; op code of JMP extended (for RAM hook intialization) | |
174 sta RVEC20 ; command interpretation loop | |
175 ldx #XVEC20 | |
176 stx RVEC20+1 | |
177 sta RVEC15 ; expression evaluation | |
178 ldx #XVEC15 | |
179 stx RVEC15+1 | |
180 sta RVEC19 ; number parsing | |
181 ldx #XVEC19 | |
182 stx RVEC19+1 | |
183 sta RVEC9 ; PRINT | |
184 ldx #XVEC9 | |
185 stx RVEC9+1 | |
186 sta RVEC17 ; error handler | |
187 ldx #XVEC17 | |
188 stx RVEC17+1 | |
189 sta RVEC4 ; generic input | |
190 ldx #XVEC4 | |
191 stx RVEC4+1 | |
192 sta RVEC3 ; generic output | |
193 ldx #XVEC3 | |
194 stx RVEC3+1 | |
195 sta RVEC8 ; close file | |
196 ldx #XVEC8 | |
197 stx RVEC8+1 | |
198 sta RVEC23 ; tokenize line | |
199 ldx #XVEC23 | |
200 stx RVEC23+1 | |
201 sta RVEC18 ; RUN | |
202 ldx #XVEC18 | |
203 stx RVEC18+1 | |
204 sta EXPJMP ; exponentiation | |
205 ldx #L8489 | |
206 stx EXPJMP+1 | |
207 jsr L96E6 ; initialize graphics stuff | |
208 lda PIA0+3 ; enable 60Hz interrupt | |
209 ora #1 | |
210 sta PIA0+3 | |
211 ldx #'D*256+'K ; magic number for a Disk Basic ROM | |
212 cmpx DOSBAS ; do we have a Disk Basic ROM? | |
213 lbeq DOSBAS+2 ; brif so - launch it | |
214 andcc #0xaf ; enable interrupts | |
215 ldx #L80E8-1 ; show sign on message | |
216 jsr STRINOUT | |
217 ldx #XBWMST ; install warm start handler | |
218 stx RSTVEC | |
219 jmp LA0E2 ; set up warm start flag and launch immediate mode | |
220 ; Extended Basic warm start code | |
221 XBWMST nop ; flag to mark routine as valid | |
222 clr PLYTMR ; cancel any PLAY command in progress | |
223 clr PLYTMR+1 | |
224 lda PIA0+3 ; enable 60Hz interrupt | |
225 ora #1 | |
226 sta PIA0+3 | |
227 jmp BAWMST ; let Color Basic's warm start process run | |
228 ; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects | |
229 ; the input pointer so that it points to the correct place after the program has been relocated by | |
230 ; PCLEAR instead of continuing with something that, in the best case, is a syntax error. | |
231 L80D0 lda CURLIN ; immediate mode? | |
232 inca | |
233 beq L80DD ; brif so | |
234 tfr y,d ; save offset to D | |
235 subd TXTTAB ; see how far into the program we are | |
236 addd CHARAD ; now adjust the input pointer based on that | |
237 std CHARAD ; save corrected input pointer | |
238 L80DD rts | |
239 L80DE fcb 25 ; 25 Extended Basic commands | |
240 fdb L8183 ; reserved word table (commands) | |
241 fdb L813C ; interpretation handler (commands) | |
242 fcb 14 ; 14 Extended Basic functions | |
243 fdb L821E ; reserved word table (functions) | |
244 fdb L8168 ; function handler | |
245 L80E8 fcc 'EXTENDED COLOR BASIC 1.1' | |
246 fcb 0x0d | |
247 fcc 'COPYRIGHT (C) 1982 BY TANDY' | |
248 fcb 0x0d | |
249 fcc 'UNDER LICENSE FROM MICROSOFT' | |
250 fcb 0x0d,0x0d,0x00 | |
251 ; Extended Basic command interpretation loop | |
252 L813C cmpa #0xcb ; is it an Extended Basic command? | |
253 bhi L8148 ; brif not | |
254 ldx #L81F0 ; point to dispatch table | |
255 suba #0xb5 ; normalize the token number so 0 is the first entry | |
256 jmp LADD4 ; go transfer control to the command | |
257 L8148 cmpa #0xff ; is it a function token? | |
258 beq L8154 ; brif so - for MID$()=, TIMER= | |
259 cmpa #0xcd ; is it a token for a keyword that isn't a command? | |
260 bls L8165 ; brif so - error for USING and FN | |
261 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present | |
262 L8154 jsr GETNCH ; get token after the function flag | |
263 cmpa #0x90 ; MID$? | |
264 lbeq L86D6 ; brif so (substring replacement) | |
265 cmpa #0x9f ; TIMER? | |
266 lbeq L8960 ; brif so - TIMER setting | |
267 jsr RVEC22 ; do a RAM hook in case something wants to extend this | |
268 L8165 jmp LB277 ; we have nothing valid here | |
269 ; Function handler | |
270 L8168 cmpb #2*33 ; is it a valid Extended Basic function? | |
271 bls L8170 ; brif so | |
272 jmp [COMVEC+28] ; transfer control to Disk Basic if it is present | |
273 L8170 subb #2*20 ; normalize Extended Basic functions to 0 | |
274 cmpb #2*8 ; Above HEX$? | |
275 bhi L817D ; brif so - we don't pre-evaluate an argument | |
276 pshs b ; save token value | |
277 jsr LB262 ; evaluate the function parameter | |
278 puls b ; get back token value | |
279 L817D ldx #L8257 ; point to dispatch table | |
280 jmp LB2CE ; go transfer control to the function | |
281 ; Reserved words (commands) | |
282 L8183 fcs 'DEL' ; 0xb5 | |
283 fcs 'EDIT' ; 0xb6 | |
284 fcs 'TRON' ; 0xb7 | |
285 fcs 'TROFF' ; 0xb8 | |
286 fcs 'DEF' ; 0xb9 | |
287 fcs 'LET' ; 0xba | |
288 fcs 'LINE' ; 0xbb | |
289 fcs 'PCLS' ; 0xbc | |
290 fcs 'PSET' ; 0xbd | |
291 fcs 'PRESET' ; 0xbe | |
292 fcs 'SCREEN' ; 0xbf | |
293 fcs 'PCLEAR' ; 0xc0 | |
294 fcs 'COLOR' ; 0xc1 | |
295 fcs 'CIRCLE' ; 0xc2 | |
296 fcs 'PAINT' ; 0xc3 | |
297 fcs 'GET' ; 0xc4 | |
298 fcs 'PUT' ; 0xc5 | |
299 fcs 'DRAW' ; 0xc6 | |
300 fcs 'PCOPY' ; 0xc7 | |
301 fcs 'PMODE' ; 0xc8 | |
302 fcs 'PLAY' ; 0xc9 | |
303 fcs 'DLOAD' ; 0xca | |
304 fcs 'RENUM' ; 0xcb | |
305 fcs 'FN' ; 0xcc | |
306 fcs 'USING' ; 0xcd | |
307 ; Dispatch table (commands) | |
308 L81F0 fdb DEL ; 0xb5 DEL | |
309 fdb EDIT ; 0xb6 EDIT | |
310 fdb TRON ; 0xb7 TRON | |
311 fdb TROFF ; 0xb8 TROFF | |
312 fdb DEF ; 0xb9 DEF | |
313 fdb LET ; 0xba LET (note: implemented by Color Basic!) | |
314 fdb LINE ; 0xbb LINE | |
315 fdb PCLS ; 0xbc PCLS | |
316 fdb PSET ; 0xbd PSET | |
317 fdb PRESET ; 0xbe PRESET | |
318 fdb SCREEN ; 0xbf SCREEN | |
319 fdb PCLEAR ; 0xc0 PCLEAR | |
320 fdb COLOR ; 0xc1 COLOR | |
321 fdb CIRCLE ; 0xc2 CIRCLE | |
322 fdb PAINT ; 0xc3 PAINT | |
323 fdb GET ; 0xc4 GET | |
324 fdb PUT ; 0xc5 PUT | |
325 fdb DRAW ; 0xc6 DRAW | |
326 fdb PCOPY ; 0xc7 PCOPY | |
327 fdb PMODETOK ; 0xc8 PMODE | |
328 fdb PLAY ; 0xc9 PLAY | |
329 fdb DLOAD ; 0xca DLOAD | |
330 fdb RENUM ; 0xcb RENUM | |
331 ; Reserved words (functions) | |
332 L821E fcs 'ATN' ; 0x94 | |
333 fcs 'COS' ; 0x95 | |
334 fcs 'TAN' ; 0x96 | |
335 fcs 'EXP' ; 0x97 | |
336 fcs 'FIX' ; 0x98 | |
337 fcs 'LOG' ; 0x99 | |
338 fcs 'POS' ; 0x9a | |
339 fcs 'SQR' ; 0x9b | |
340 fcs 'HEX$' ; 0x9c | |
341 fcs 'VARPTR' ; 0x9d | |
342 fcs 'INSTR' ; 0x9e | |
343 fcs 'TIMER' ; 0x9f | |
344 fcs 'PPOINT' ; 0xa0 | |
345 fcs 'STRING$' ; 0xa1 | |
346 ; Dispatch table (functions) | |
347 L8257 fdb ATN ; 0x94 ATN | |
348 fdb COS ; 0x95 COS | |
349 fdb TAN ; 0x96 TAN | |
350 fdb EXP ; 0x97 EXP | |
351 fdb FIX ; 0x98 FIX | |
352 fdb LOG ; 0x99 LOG | |
353 fdb POS ; 0x9a POS | |
354 fdb SQR ; 0x9b SQR | |
355 fdb HEXDOL ; 0x9c HEX$ | |
356 fdb VARPTRTOK ; 0x9d VARPTR | |
357 fdb INSTR ; 0x9e INSTR | |
358 fdb TIMER ; 0x9f TIMER | |
359 fdb PPOINT ; 0xa0 PPOINT | |
360 fdb STRING ; 0xa1 STRING$ | |
361 ; Generic output handler | |
362 XVEC3 tst DEVNUM ; screen? | |
363 lbeq L95AC ; brif so - force text screen active | |
364 pshs b ; save register | |
365 ldb DEVNUM ; get output device | |
366 cmpb #-3 ; check for DLOAD | |
367 puls b ; restore register | |
368 bne L8285 ; brif not DLOAD | |
369 leas 2,s ; bail out of output handler if DLOAD | |
370 L8285 rts | |
371 ; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the | |
372 ; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required | |
373 ; if a recent enough version of Color Basic is installed. | |
374 XVEC8 lda DEVNUM ; get device number | |
375 inca ; is it tape? | |
376 bne L8285 ; brif not - we aren't going to mess with it | |
377 lda FILSTA ; get tape file status | |
378 cmpa #2 ; output file? | |
379 bne L8285 ; brif not | |
380 lda CINCTR ; is there anything waiting to be written out? | |
381 bne L8285 ; brif so - mainline code will handle it properly | |
382 clr DEVNUM ; reset output to screen | |
383 leas 2,s ; don't return to mainline code | |
384 jmp LA444 ; write EOF block | |
385 ; RUN handler - sets up some Extended Basic stuff to defaults at program start | |
386 XVEC18 ldd #0xba42 ; initialize PLAY volume | |
387 std VOLHI | |
388 lda #2 ; set PLAY tempo to 2, PLAY octave to 3 | |
389 sta TEMPO | |
390 sta OCTAVE | |
391 asla ; set default note length to 5 | |
392 sta NOTELN | |
393 clr DOTVAL ; don't do any note length extension | |
394 ldd ZERO ; initialize DRAW angle and scale to default 1 | |
395 std ANGLE | |
396 ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen | |
397 std HORDEF | |
398 ldb #96 | |
399 std VERDEF | |
400 rts | |
401 ; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF | |
402 XVEC20 leas 2,s ; don't return to the mainline code | |
403 L82BB andcc #0xaf ; make sure interrupts are running | |
404 jsr LADEB ; do a BREAK/pause check | |
405 ldx CHARAD ; save input pointer | |
406 stx TINPTR | |
407 lda ,x+ ; get current input character | |
408 beq L82CF ; brif end of line | |
409 cmpa #': ; statement separator? | |
410 beq L82F1 ; brif so | |
411 jmp LB277 ; raise error we got here with extra junk | |
412 L82CF lda ,x++ ; get first byte of next line address | |
413 sta ENDFLG ; use it to set "END" flag to "END" | |
414 bne L82D8 ; brif not end of program | |
415 jmp LAE15 ; go do the "END" | |
416 L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text) | |
417 std CURLIN ; set current line number | |
418 stx CHARAD ; save input pointer | |
419 lda TRCFLG ; are we tracing? | |
420 beq L82F1 ; brif not | |
421 lda #'[ ; show opening marker for TRON line number | |
422 jsr PUTCHR | |
423 lda CURLIN ; restore MSB of line number | |
424 jsr LBDCC ; show line number | |
425 lda #'] ; show closing marker for TRON line number | |
426 jsr PUTCHR | |
427 L82F1 jsr GETNCH ; get the start of the statement | |
428 tfr cc,b ; save status flags | |
429 cmpa #0x98 ; is it CSAVE? | |
430 beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM) | |
431 cmpa #0x97 ; is it CLOAD? | |
432 beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries) | |
433 tfr b,cc ; restore character status | |
434 jsr LADC6 ; go process command | |
435 bra L82BB ; restart interpretation loop | |
436 ; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the | |
437 ; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This | |
438 ; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation | |
439 ; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all. | |
440 XVEC23 ldx 2,s ; get return address of caller to the tokenizer | |
441 cmpx #LAC9D ; is it coming from immediate mode prior to executing the line? | |
442 bne L8310 ; brif not | |
443 ldx #L82F1 ; force return to Extended Basic's main loop patch above | |
444 stx 2,s | |
445 L8310 rts | |
446 ; These two patches are set up this way so that control can be transferred back to the original Color Basic | |
447 ; implementations if the Extended Basic addons are not triggered. | |
448 L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler | |
449 bra L82BB ; go do another command | |
450 L8316 bsr L831A ; go do Extended Basic's CSAVE handler | |
451 bra L82BB ; go do another command | |
452 ; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have) | |
453 L831A jsr GETNCH ; get character after CSAVE | |
454 cmpa #'M ; is it CSAVEM? | |
455 lbne CSAVE ; brif not - Color Basic can handle this | |
456 jsr GETNCH ; eat the "M" | |
457 jsr LA578 ; parse file name | |
458 bsr L836C ; get start address | |
459 stx CASBUF+13 ; save it in file header | |
460 bsr L836C ; get end address | |
461 cmpx 2,s ; compare to start address | |
462 lblo LB44A ; brif end address is before the start address | |
463 bsr L836C ; get execution address | |
464 stx CASBUF+11 ; put in file header | |
465 jsr GETCCH ; are we at the end of the commmand? | |
466 bne L8310 ; brif not | |
467 lda #2 ; file type to machine language | |
468 ldx ZERO ; set to binary and single block | |
469 jsr LA65F ; write header | |
470 clr FILSTA ; mark any open tape file closed | |
471 inc BLKTYP ; set block type to data | |
472 jsr WRLDR ; write a data leader | |
473 ldx 4,s ; get starting address | |
474 L834D stx CBUFAD ; set start of data address | |
475 lda #255 ; try a full length block by default | |
476 sta BLKLEN | |
477 ldd 2,s ; get ending address | |
478 subd CBUFAD ; see how much is left | |
479 bhs L835E ; brif we have more to write | |
480 leas 6,s ; clean up stack | |
481 jmp LA491 ; write EOF block | |
482 L835E cmpd #255 ; do we have a full block left? | |
483 bhs L8367 ; brif so | |
484 incb ; set block size to remainder | |
485 stb BLKLEN | |
486 L8367 jsr SNDBLK ; write a data block | |
487 bra L834D ; go see if we have more to write | |
488 L836C jsr SYNCOMMA ; make sure we have a comma | |
489 jsr LB73D ; evaluate unsigned expression to X | |
490 ldu ,s ; get return address | |
491 stx ,s ; save result on stack | |
492 tfr u,pc ; return to caller | |
493 ; COS function | |
494 COS ldx #L83AB ; point to PI/2 constant | |
495 jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) ) | |
496 L837E jmp SIN ; now calculate sin((pi/2)+x) | |
497 ; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X) | |
498 TAN jsr LBC2F ; save FPA0 in FPA3 | |
499 clr RELFLG ; reset quadrant flag | |
500 bsr L837E ; calculate SIN(x) | |
501 ldx #V4A ; save result in FPA5 | |
502 jsr LBC35 | |
503 ldx #V40 ; get back original argument | |
504 jsr LBC14 | |
505 clr FP0SGN ; force result positive | |
506 lda RELFLG ; get quadrant flag | |
507 bsr L83A6 ; calculate COS(x) | |
508 tst FP0EXP ; did we get 0 for COS(x) | |
509 lbeq LBA92 ; brif so - overflow | |
510 ldx #V4A ; point to sin(x) | |
511 L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value | |
512 L83A6 pshs a ; save sign flag | |
513 jmp LBFA6 ; expand polynomial | |
514 L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant | |
515 ; ATN function (inverse tangent). There are two calculation streams used to improve precision. | |
516 ; One if the parameter is >= 1.0 and the other if it is < 1.0 | |
517 ATN lda FP0SGN ; get sign of argument | |
518 pshs a ; save it | |
519 bpl L83B8 ; brif positive | |
520 bsr L83DC ; flip sign of argument | |
521 L83B8 lda FP0EXP ; get exponent | |
522 pshs a ; save it | |
523 cmpa #0x81 ; exponent for 1.0 | |
524 blo L83C5 ; brif less - value is less than 1.0 | |
525 ldx #LBAC5 ; point to FP constant 1.0 | |
526 bsr L83A3 ; calculate reciprocal | |
527 L83C5 ldx #L83E0 ; point to polynomical coefficients | |
528 jsr LBEF0 ; expand polynomial | |
529 puls a ; get exponent of argument | |
530 cmpa #0x81 ; did we do a reciprocal calculation? | |
531 blo L83D7 ; brif not | |
532 ldx #L83AB ; subtract result from pi/2 if we did | |
533 jsr LB9B9 | |
534 L83D7 puls a ; get sign of original | |
535 tsta ; was it positive? | |
536 bpl L83DF ; brif so | |
537 L83DC jmp LBEE9 ; flip sign of result | |
538 L83DF rts | |
539 ; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly | |
540 ; from the standard taylor series after 1/9. The standard coefficients are 1/1,-1/3, 1/5, -1/7, 1/9, -1/11, and | |
541 ; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with | |
542 ; fewer coefficients. | |
543 L83E0 fcb 11 ; 12 coefficients | |
544 fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912 | |
545 fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216 | |
546 fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018 | |
547 fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381 | |
548 fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328 | |
549 fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965 | |
550 fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954 | |
551 fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413 | |
552 fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808 | |
553 fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121 | |
554 fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316 | |
555 fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0 | |
556 ; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x) | |
557 L841D fcb 3 ; four coefficients | |
558 fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2) | |
559 fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2) | |
560 fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2) | |
561 fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2) | |
562 L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2) | |
563 L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2) | |
564 L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5 | |
565 L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2) | |
566 ; LOG function (natural log, ln) | |
567 ; FP representation is of the form A*2^B. Thus, the log routine determines the value of | |
568 ; ln(A*2^B). | |
569 ; | |
570 ; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR: | |
571 ; (log2(A) + B)*ln(2) | |
572 ; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so: | |
573 ; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2) | |
574 ; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2) | |
575 ; | |
576 ; Everything except log2(A*sqrt(2)) is either constant or trivial. | |
577 ; | |
578 ; What the actual code below feeds into the modified taylor series is actually: | |
579 ; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1) | |
580 ; | |
581 ; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would | |
582 ; expect from the identities. However, the modified coefficients in the series above | |
583 ; could be correcting for that or the introduced error was deemed acceptable. | |
584 ; NOTE: this routine does NOT return 0 for LOG(1) | |
585 LOG jsr LBC6D ; get status of FPA0 | |
586 lble LB44A ; brif <= 0 - logarithms don't exist in that case | |
587 ldx #L8432 ; point to 1/sqrt(2) | |
588 lda FP0EXP ; get exponent of argument | |
589 suba #0x80 ; remove bias | |
590 pshs a ; save it for later | |
591 lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description) | |
592 sta FP0EXP | |
593 jsr LB9C2 ; add 1/sqrt(2) to A | |
594 ldx #L8437 ; point to sqrt(2) | |
595 jsr LBB8F ; divide that by FPA0 | |
596 ldx #LBAC5 ; point to 1.0 | |
597 jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2))) | |
598 ldx #L841D ; point to coefficients | |
599 jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument) | |
600 ldx #L843C ; point to -0.5 | |
601 jsr LB9C2 ; add result | |
602 puls b ; get original exponent back | |
603 jsr LBD99 ; add B to FPA0 | |
604 ldx #L8441 ; point to ln(2) | |
605 jmp LBACA ; multiply by ln(2) which gives us the result in base e | |
606 ; SQR function (square root) - returns the principle root (positive) | |
607 SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation) | |
608 ldx #LBEC0 ; point to 0.5 (exponent for square root) | |
609 jsr LBC14 ; set up second argument to exponentiation (the exponent) | |
610 ; Exponentiation operator | |
611 ; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0 | |
612 L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0) | |
613 tsta ; check that the base is not 0 | |
614 bne L8491 ; brif base is not 0 | |
615 jmp LBA3A ; 0^(nonzero) is 0 | |
616 L8491 ldx #V4A ; save exponent (to FPA5) | |
617 jsr LBC35 | |
618 clrb ; result sign will default to positive | |
619 lda FP1SGN ; check if base is positive | |
620 bpl L84AC ; brif so | |
621 jsr INT ; convert exponent to integer | |
622 ldx #V4A ; point to original expoent | |
623 lda FP1SGN ; get sign of FPA1 | |
624 jsr LBCA0 ; compare original exponent with truncated one | |
625 bne L84AC ; brif not equal | |
626 coma ; flip sign | |
627 ldb CHARAC ; get LS byte of integer exponent (result sign flag) | |
628 L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign) | |
629 pshs b ; save result sign | |
630 jsr LOG ; get natural log of the base | |
631 ldx #V4A ; multiply the log by the exponent | |
632 jsr LBACA | |
633 bsr EXP ; now raise e to the resulting power | |
634 puls a ; get result sign | |
635 rora ; brif it was negative | |
636 lbcs LBEE9 ; brif negative - flip sign | |
637 rts | |
638 L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function) | |
639 ; Chebyshev modified taylor series coefficients for e^x | |
640 L84C9 fcb 7 ; eight coefficients | |
641 fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7)) | |
642 fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6)) | |
643 fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5)) | |
644 fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4)) | |
645 fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3)) | |
646 fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2)) | |
647 fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1)) | |
648 fcb 0x81,0x00,0x00,0x00,0x00 ; 1 | |
649 ; EXP function (e^x) | |
650 EXP ldx #L84C4 ; point to correction factor | |
651 jsr LBACA ; multiply it | |
652 jsr LBC2F ; save corrected argument to FPA3 | |
653 lda FP0EXP ; get exponent of FPA0 | |
654 cmpa #0x88 ; is it too big? | |
655 blo L8504 ; brif not | |
656 L8501 jmp LBB5C ; to 0 (underflow) or overflow error | |
657 L8504 jsr INT ; convert argument to an integer | |
658 lda CHARAC ; get ls byte of integer | |
659 adda #0x81 ; was argument 127? if so, the OV error; adds bias | |
660 beq L8501 | |
661 deca ; adjust for the extra +1 above | |
662 pshs a ; save integer exponent | |
663 ldx #V40 ; get fractional part of argument | |
664 jsr LB9B9 | |
665 ldx #L84C9 ; point to coefficients | |
666 jsr LBEFF ; evaluate polynomial on the fractional part | |
667 clr RESSGN ; force result to be positive | |
668 puls a ; get back original exponent | |
669 jsr LBB48 ; add original exponent to the fractional result | |
670 rts | |
671 ; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0) | |
672 FIX jsr LBC6D ; get status of argument | |
673 bmi L852C ; brif negative | |
674 L8529 jmp INT ; do regular "int" if positive | |
675 L852C com FP0SGN ; flip the sign | |
676 bsr L8529 ; do "INT" on this | |
677 jmp LBEE9 ; flip the sign back | |
678 ; EDIT command | |
679 EDIT jsr L89AE ; get line number | |
680 leas 2,s ; we're not going to return to the main loop | |
681 L8538 lda #1 ; "LIST" flag | |
682 sta VD8 ; set to list the line | |
683 jsr LAD01 ; find line number | |
684 lbcs LAED2 ; brif line wasn't found | |
685 jsr LB7C2 ; go unpack the line into the buffer | |
686 tfr y,d ; calculate the actual length of the line | |
687 subd #LINBUF+2 | |
688 stb VD7 ; save line length (it will only be 8 bits) | |
689 L854D ldd BINVAL ; get the line number | |
690 jsr LBDCC ; display it | |
691 jsr LB9AC ; put a space after it | |
692 ldx #LINBUF+1 ; point to iput uffer | |
693 ldb VD8 ; are we listing? | |
694 bne L8581 ; brif so | |
695 L855C clrb ; reset digit accumulator | |
696 L855D jsr L8687 ; get a keypress | |
697 jsr L90AA ; set carry if not numeric | |
698 bcs L8570 ; brif not a number | |
699 suba #'0 ; remove ASCII bias | |
700 pshs a ; save digit value | |
701 lda #10 ; multiply accumulator by 10 | |
702 mul | |
703 addb ,s+ ; add in new digit | |
704 bra L855D ; go check for another digit | |
705 L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1 | |
706 adcb #1 | |
707 cmpa #'A ; abort? | |
708 bne L857D ; brif not | |
709 jsr LB958 ; to a CR | |
710 bra L8538 ; restart EDIT process | |
711 L857D cmpa #'L ; list? | |
712 bne L858C ; brif not | |
713 L8581 bsr L85B4 ; list the line | |
714 clr VD8 ; reset to "not listing" | |
715 jsr LB958 ; do a CR | |
716 bra L854D ; start editing | |
717 L858A leas 2,s ; lose return address | |
718 L858C cmpa #0x0d ; ENTER? | |
719 bne L859D ; brif not | |
720 bsr L85B4 ; echo out the line | |
721 L8592 jsr LB958 ; do a CR | |
722 ldx #LINBUF+1 ; reset input pointer to start of buffer | |
723 stx CHARAD | |
724 jmp LACA8 ; join immediate mode to replace the line in the program | |
725 L859D cmpa #'E ; exit? | |
726 beq L8592 ; brif so - end edit with no echo | |
727 cmpa #'Q ; quit? | |
728 bne L85AB ; brif not | |
729 jsr LB958 ; do a CR | |
730 jmp LAC73 ; go to immediate mode with no fanfare - no changes saved | |
731 L85AB bsr L85AF ; go do commands | |
732 bra L855C ; go handle another command | |
733 L85AF cmpa #0x20 ; space? | |
734 bne L85C3 ; brif not | |
735 skip2 | |
736 L85B4 ldb #LBUFMX-1 ; display up to a whole line | |
737 L85B6 lda ,x ; get buffer chracter | |
738 beq L85C2 ; brif end of line | |
739 jsr PUTCHR ; output character | |
740 leax 1,x ; move to next character | |
741 decb ; done? | |
742 bne L85B6 ; brif not | |
743 L85C2 rts | |
744 L85C3 cmpa #'D ; delete? | |
745 bne L860F ; brif not | |
746 L85C7 tst ,x ; end of line? | |
747 beq L85C2 ; brif so - can't delete | |
748 bsr L85D1 ; remove a character | |
749 decb ; done all requested? | |
750 bne L85C7 ; brif not | |
751 rts | |
752 L85D1 dec VD7 ; account for character being removed | |
753 leay -1,x ; set pointer and compensate for increment below | |
754 L85D5 leay 1,y ; move to next character | |
755 lda 1,y ; get next character | |
756 sta ,y ; move it forward | |
757 bne L85D5 ; brif we didn't hit the end of the buffer | |
758 rts | |
759 L85DE cmpa #'I ; insert? | |
760 beq L85F5 ; brif so | |
761 cmpa #'X ; extend? | |
762 beq L85F3 ; brif so | |
763 cmpa #'H ; "hack"? | |
764 bne L8646 ; brif not | |
765 clr ,x ; mark current location as end of line | |
766 tfr x,d ; calculate new line length | |
767 subd #LINBUF+2 | |
768 stb VD7 ; save new length | |
769 L85F3 bsr L85B4 ; display the line | |
770 L85F5 jsr L8687 ; read a character | |
771 cmpa #0x0d ; ENTER? | |
772 beq L858A ; brif so - terminate entry | |
773 cmpa #0x1b ; ESC? | |
774 beq L8625 ; brif so - back to command mode | |
775 cmpa #0x08 ; backspace? | |
776 bne L8626 ; brif no | |
777 cmpx #LINBUF+1 ; are we at the start of the buffer? | |
778 beq L85F5 ; brif so - it's a no-op | |
779 bsr L8650 ; move pointer back one, do a BS | |
780 bsr L85D1 ; remove character from the buffer | |
781 bra L85F5 ; go handle more input | |
782 L860F cmpa #'C ; change? | |
783 bne L85DE ; brif not | |
784 L8613 tst ,x ; is there something to change? | |
785 beq L8625 ; brif not | |
786 jsr L8687 ; get a key stroke | |
787 bcs L861E ; brif valid key | |
788 bra L8613 ; try again if invalid key | |
789 L861E sta ,x+ ; put new character in the buffer | |
790 bsr L8659 ; echo it | |
791 decb ; changed number requested? | |
792 bne L8613 ; brif not | |
793 L8625 rts | |
794 L8626 ldb VD7 ; get length of line | |
795 cmpb #LBUFMX-1 ; at maximum line length? | |
796 bne L862E ; brif not | |
797 bra L85F5 ; process another input character | |
798 L862E pshs x ; save input pointer | |
799 L8630 tst ,x+ ; are we at the end of the line? | |
800 bne L8630 ; brif not | |
801 L8634 ldb ,-x ; get character before current pointer, move back | |
802 stb 1,x ; move it forward | |
803 cmpx ,s ; at the original buffer pointer? | |
804 bne L8634 ; brif not | |
805 leas 2,s ; remove saved buffer pointer | |
806 sta ,x+ ; save input character in newly made hole | |
807 bsr L8659 ; echo it | |
808 inc VD7 ; bump line length counter | |
809 bra L85F5 ; go handle more stuff | |
810 L8646 cmpa #0x08 ; backspace? | |
811 bne L865C ; brif not | |
812 L864A bsr L8650 ; move pointer back, echo BS | |
813 decb ; done enough of them? | |
814 bne L864A ; brif not | |
815 rts | |
816 L8650 cmpx #LINBUF+1 ; at start of buffer? | |
817 beq L8625 ; brif so | |
818 leax -1,x ; move pointer back | |
819 lda #0x08 ; character to echo - BS | |
820 L8659 jmp PUTCHR ; echo character to screen | |
821 L865C cmpa #'K ; "kill"? | |
822 beq L8665 ; brif so | |
823 suba #'S ; search? | |
824 beq L8665 ; brif so | |
825 rts | |
826 L8665 pshs a ; save kill/search flag | |
827 bsr L8687 ; read target | |
828 pshs a ; save search character | |
829 L866B lda ,x ; get current character in buffer | |
830 beq L8685 ; brif end of line - nothing more to search | |
831 tst 1,s ; is it KILL? | |
832 bne L8679 ; brif so | |
833 bsr L8659 ; echo the character | |
834 leax 1,x ; move ahead | |
835 bra L867C ; check next character | |
836 L8679 jsr L85D1 ; remove character from buffer | |
837 L867C lda ,x ; get character in buffer | |
838 cmpa ,s ; are we at the target? | |
839 bne L866B ; brif not | |
840 decb ; have we found enough of them? | |
841 bne L866B ; brif not | |
842 L8685 puls y,pc ; clean up stack and return to main EDIT routine | |
843 L8687 jsr LA171 ; get input from the generic input handler (will show the cursor) | |
844 cmpa #0x7f ; graphics (or DEL)? | |
845 bhs L8687 ; brif so - ignore it | |
846 cmpa #0x5f ; SHIFT-UP? | |
847 bne L8694 ; brif not | |
848 lda #0x1b ; replace with ESC | |
849 L8694 cmpa #0x0d ; carriage return? | |
850 beq L86A6 ; brif so (C=0) | |
851 cmpa #0x1b ; ESC | |
852 beq L86A6 ; brif so (C=0) | |
853 cmpa #0x08 ; backspace? | |
854 beq L86A6 ; brif so (C=0) | |
855 cmpa #32 ; control code? | |
856 blo L8687 ; brif control code - try again | |
857 orcc #1 ; set C for "valid" (printable) character | |
858 L86A6 rts | |
859 ; TRON and TROFF commands | |
860 TRON skip1lda ; load flag with nonzero for trace enabled (and skip next) | |
861 TROFF clra ; clear flag for trace disabled | |
862 sta TRCFLG ; save trace status | |
863 rts | |
864 ; POS function | |
865 POS lda DEVNUM ; get original device number | |
866 pshs a ; save it for later | |
867 jsr LA5AE ; fetch device number | |
868 jsr LA406 ; check for open file | |
869 jsr LA35F ; set up print parameters | |
870 ldb DEVPOS ; get current line position for the device | |
871 jmp LA5E4 ; return position in B as unsigned | |
872 ; VARPTR function | |
873 VARPTRTOK jsr LB26A ; make sure we have ( | |
874 ldd ARYEND ; get address of end of arrays | |
875 pshs d ; save it | |
876 jsr LB357 ; parse variable descriptor | |
877 jsr LB267 ; make sure there is a ) | |
878 puls d ; get original end of arrays | |
879 exg x,d ; swap original end of arrays and the discovered variable pointer | |
880 cmpx ARYEND ; did array end move (variable created?) | |
881 bne L8724 ; brif so (FC error) | |
882 jmp GIVABF ; return the pointer (NOTE: as signed) | |
883 ; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter | |
884 ; than the specified size, only the number of characters actually in the replacement will be used. | |
885 L86D6 jsr GETNCH ; eat the MID$ token | |
886 jsr LB26A ; force ( | |
887 jsr LB357 ; evaluate the variable | |
888 pshs x ; save variable descriptor | |
889 ldd 2,x ; point to start of original string | |
890 cmpd FRETOP ; is it in string space? | |
891 bls L86EB ; brif not | |
892 subd MEMSIZ ; is it still in string space (top end)? | |
893 bls L86FD ; brif so | |
894 L86EB ldb ,x ; get length of original string | |
895 jsr LB56D ; allocate space in string space | |
896 pshs x ; save pointer to string space | |
897 ldx 2,s ; get to original string descriptor | |
898 jsr LB643 ; move the string into string space | |
899 puls x,u ; get new string address and string descriptor | |
900 stx 2,u ; save new data address for the string | |
901 pshs u ; save descriptor address again | |
902 L86FD jsr LB738 ; evaluate ",start" | |
903 pshs b ; save start offset | |
904 tstb ; is start 0? | |
905 beq L8724 ; brif so - strings offsets are 1-based | |
906 ldb #255 ; default use the entire string | |
907 cmpa #') ; end of parameters? | |
908 beq L870E ; brif so | |
909 jsr LB738 ; evaluate ",length" | |
910 L870E pshs b ; save length | |
911 jsr LB267 ; make sure we have a ) | |
912 ldb #0xb3 ; make sure we have = | |
913 jsr LB26F | |
914 bsr L8748 ; evaluate replacement string | |
915 tfr x,u ; save replacement string address | |
916 ldx 2,s ; get original string descriptor | |
917 lda ,x ; get length of original string | |
918 suba 1,s ; subtract start position | |
919 bhs L8727 ; brif within the string - insert replacement | |
920 L8724 jmp LB44A ; raise illegal function call | |
921 L8727 inca ; A is now number of characters to the right of the position parameter | |
922 cmpa ,s ; compare to length desired | |
923 bhs L872E ; brif new length fits | |
924 sta ,s ; only use as much of the length as will fit | |
925 L872E lda 1,s ; get position offset | |
926 exg a,b ; swap replacement length and position | |
927 ldx 2,x ; point to original string address | |
928 decb ; we work with 0-based offsets | |
929 abx ; now X points to start of replacement | |
930 tsta ; replacing 0? | |
931 beq L8746 ; brif so - done | |
932 cmpa ,s ; is replacement shorter than the hole? | |
933 bls L873F ; brif so | |
934 lda ,s ; use copy the maximum number specified | |
935 L873F tfr a,b ; save number to move in B | |
936 exg u,x ; swap pointers so they are right for the routine | |
937 jsr LA59A ; copy string data | |
938 L8746 puls a,b,x,pc ; clean up stack and return | |
939 L8748 jsr LB156 ; evaluate expression | |
940 jmp LB654 ; make sure it's a string and return string details | |
941 ; STRING$ function | |
942 STRING jsr LB26A ; make sure we have ( | |
943 jsr EVALEXPB ; evaluate repeat count (error if > 255) | |
944 pshs b ; save repeat count | |
945 jsr SYNCOMMA ; make sure there's a comma | |
946 jsr LB156 ; evaluate the thing to repeat | |
947 jsr LB267 ; make sure we have a ) | |
948 lda VALTYP ; is it string? | |
949 bne L8768 ; brif so | |
950 jsr LB70E ; get 8 bit character code | |
951 bra L876B ; use that | |
952 L8768 jsr LB6A4 ; get first character of string | |
953 L876B pshs b ; save repeat character | |
954 ldb 1,s ; get repeat count | |
955 jsr LB50F ; reserve space for the string | |
956 puls a,b ; get character and repeat count | |
957 beq L877B ; brif NULL string | |
958 L8776 sta ,x+ ; put character into string | |
959 decb ; put enough? | |
960 bne L8776 ; brif not | |
961 L877B jmp LB69B ; return the newly created string | |
962 ; INSTR function | |
963 INSTR jsr LB26A ; evaluate ( | |
964 jsr LB156 ; evaluate first argument | |
965 ldb #1 ; default start position is 1 (start of string) | |
966 pshs b ; save start position | |
967 lda VALTYP ; get type of first argument | |
968 bne L879C ; brif string - use default starting position | |
969 jsr LB70E ; convert first argument into string offset | |
970 stb ,s ; save offset | |
971 beq L8724 ; brif starting at 0 - not allowed | |
972 jsr SYNCOMMA ; make sure there's a comma | |
973 jsr LB156 ; evaluate the search string | |
974 jsr LB146 ; make sure it *is* a string | |
975 L879C ldx FPA0+2 ; get search string descriptor | |
976 pshs x ; save it | |
977 jsr SYNCOMMA ; make sure we have a comma | |
978 jsr L8748 ; evalute the target string | |
979 pshs x,b ; save address and length of target string | |
980 jsr LB267 ; make sure we have a ) | |
981 ldx 3,s ; get search string address | |
982 jsr LB659 ; get string details | |
983 pshs b ; save search string length | |
984 cmpb 6,s ; compare length of search string to the start | |
985 blo L87D9 ; brif start position is beyond the search string - return 0 | |
986 lda 1,s ; get length of target string | |
987 beq L87D6 ; brif targetstring is NULL - match will be immediate | |
988 ldb 6,s ; get start position | |
989 decb ; zero-base it | |
990 abx ; now X points to the start position for the search | |
991 L87BE leay ,x ; point to start of search | |
992 ldu 2,s ; get target string pointer | |
993 ldb 1,s ; get targetlength | |
994 lda ,s ; get length of serach | |
995 suba 6,s ; see how much is left in searh | |
996 inca ; add one for "inclusivity" | |
997 cmpa 1,s ; do we have less than the target string? | |
998 blo L87D9 ; brif so - we obviously won't match | |
999 L87CD lda ,x+ ; compare a byte | |
1000 cmpa ,u+ | |
1001 bne L87DF ; brif no match | |
1002 decb ; compared all of target? | |
1003 bne L87CD ; brif not | |
1004 L87D6 ldb 6,s ; get position where we matched | |
1005 skip1 | |
1006 L87D9 clrb ; flag no match | |
1007 leas 7,s ; clean up stack | |
1008 jmp LB4F3 ; return unsigned B | |
1009 L87DF inc 6,s ; bump start position | |
1010 leax 1,y ; move starting pointer | |
1011 bra L87BE ; see if we match now | |
1012 ; Number parsing handler | |
1013 XVEC19 cmpa #'& ; do we have & (hex or octal)? | |
1014 bne L8845 ; brif not | |
1015 leas 2,s ; we won't return to the original invoker | |
1016 L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value | |
1017 clr FPA0+3 | |
1018 ldx #FPA0+2 ; point to accumulator | |
1019 jsr GETNCH ; eat the & | |
1020 cmpa #'O ; octal? | |
1021 beq L880A ; brif so | |
1022 cmpa #'H ; hex? | |
1023 beq L881F ; brif so | |
1024 jsr GETCCH ; reset flags on input | |
1025 bra L880C ; go process octal (default) | |
1026 L8800 cmpa #'8 ; is it a valid octal character? | |
1027 lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7) | |
1028 ldb #3 ; base 8 multiplier | |
1029 bsr L8834 ; add digit to accumulator | |
1030 L880A jsr GETNCH ; get input character | |
1031 L880C bcs L8800 ; brif numeric | |
1032 L880E clr FPA0 ; clear upper bytes of FPA0 | |
1033 clr FPA0+1 | |
1034 clr VALTYP ; result is numeric | |
1035 clr FPSBYT ; clear out any extra precision | |
1036 clr FP0SGN ; make it positive | |
1037 ldb #0xa0 ; exponent for integer aligned to right of FPA0 | |
1038 stb FP0EXP | |
1039 jmp LBA1C ; go normalize the result and return | |
1040 L881F jsr GETNCH ; get input character | |
1041 bcs L882E ; brif digit | |
1042 jsr LB3A2 ; set carry if not alpha | |
1043 L8826 bcs L880E ; brif not alpha | |
1044 cmpa #'G ; is it valid HEX digit? | |
1045 bhs L880E ; brif not | |
1046 suba #7 ; normalize A-F to be just above 0-9 | |
1047 L882E ldb #4 ; four bits per digit | |
1048 bsr L8834 ; add digit to accumlator | |
1049 bra L881F ; process another digit | |
1050 L8834 asl 1,x ; shift accumulator one bit left | |
1051 rol ,x | |
1052 lbcs LBA92 ; brif too big - overflow | |
1053 decb ; done enough bit shifts? | |
1054 bne L8834 ; brif not | |
1055 L883F suba #'0 ; remove ASCII bias | |
1056 adda 1,x ; merge digit into accumlator (this cannot cause carry) | |
1057 sta 1,x | |
1058 L8845 rts | |
1059 ; Expression evaluation handler | |
1060 XVEC15 puls u ; get back return address | |
1061 clr VALTYP ; set result to numeric | |
1062 ldx CHARAD ; save input pointer | |
1063 jsr GETNCH ; get the input character | |
1064 cmpa #'& ; HEX or OCTAL? | |
1065 beq L87EB ; brif so | |
1066 cmpa #0xcc ; FN? | |
1067 beq L88B4 ; brif so - do "FNx()" | |
1068 cmpa #0xff ; function token? | |
1069 bne L8862 ; brif not | |
1070 jsr GETNCH ; get function token value | |
1071 cmpa #0x83 ; USR? | |
1072 lbeq L892C ; brif so - short circuit Color Basic's USR handler | |
1073 L8862 stx CHARAD ; restore input pointer | |
1074 jmp ,u ; return to mainline code | |
1075 L8866 ldx CURLIN ; are we in immediate mode? | |
1076 leax 1,x | |
1077 bne L8845 ; brif not - we're good | |
1078 ldb #2*11 ; code for illegal direct statement | |
1079 L886E jmp LAC46 ; raise error | |
1080 ; DEF command (DEF FN, DEF USR) | |
1081 DEF ldx [CHARAD] ; get two input characters | |
1082 cmpx #0xff83 ; USR? | |
1083 lbeq L890F ; brif so - do DEF USR | |
1084 bsr L88A1 ; get descriptor address for FN variable | |
1085 bsr L8866 ; disallow DEF FN in immediate mode | |
1086 jsr LB26A ; make sure we have ( | |
1087 ldb #0x80 ; disallow arrays as arguments | |
1088 stb ARYDIS | |
1089 jsr LB357 ; evaluate variable | |
1090 bsr L88B1 ; make sure it's numeric | |
1091 jsr LB267 ; make sure we have ) | |
1092 ldb #0xb3 ; make sure we have = | |
1093 jsr LB26F | |
1094 ldx V4B ; get variable descriptor address | |
1095 ldd CHARAD ; get input pointer | |
1096 std ,x ; save address of the actual function code in variable descriptor | |
1097 ldd VARPTR ; get descriptor address of argument | |
1098 std 2,x ; save argument descriptor address | |
1099 jmp DATA ; move to the end of this statement | |
1100 L88A1 ldb #0xcc ; make sure we have FN | |
1101 jsr LB26F | |
1102 ldb #0x80 ; disable array lookup | |
1103 stb ARYDIS | |
1104 ora #0x80 ; set bit 7 of first character (to indicate FN variable) | |
1105 jsr LB35C ; find the variable | |
1106 stx V4B ; save descriptor pointer | |
1107 L88B1 jmp LB143 ; make sure we have a numeric variable | |
1108 ; Evaluate an FN call | |
1109 L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor | |
1110 pshs x ; save descriptor | |
1111 jsr LB262 ; evaluate parameter | |
1112 bsr L88B1 ; make sure it's a number | |
1113 puls u ; get FN descriptor | |
1114 ldb #2*25 ; code for undefined function | |
1115 ldx 2,u ; point to argument variable descriptor | |
1116 beq L886E ; brif nothing doing there (if it was just created, this will be NULL) | |
1117 ldy CHARAD ; save current input pointer | |
1118 ldu ,u ; point to start of FN definition | |
1119 stu CHARAD ; put input pointer there | |
1120 lda 4,x ; save original value of argument and save it with current input, and variable pointers | |
1121 pshs a | |
1122 ldd ,x | |
1123 ldu 2,x | |
1124 pshs u,y,x,d | |
1125 jsr LBC35 ; set argument variable to the argument | |
1126 L88D9 jsr LB141 ; go evaluate the FN expression | |
1127 puls d,x,y,u ; get back variable pointers, input pointer, and original variable value | |
1128 std ,x | |
1129 stu 2,x | |
1130 puls a | |
1131 sta 4,x | |
1132 jsr GETCCH ; test end of FN formula | |
1133 lbne LB277 ; brif not end of statement - problem with the function | |
1134 sty CHARAD ; restore input pointer | |
1135 L88EF rts | |
1136 ; Error handler | |
1137 XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code? | |
1138 blo L88EF ; brif not - return to mainline | |
1139 jsr LA7E9 ; turn off tape | |
1140 jsr LA974 ; turn off sound | |
1141 jsr LAD33 ; clean up stack and other bits | |
1142 clr DEVNUM ; reset output to screen | |
1143 jsr LB95C ; do a newline if needed | |
1144 jsr LB9AF ; do a ? | |
1145 ldx #L890B-25*2 ; point to error message table | |
1146 jmp LAC60 ; go display error message | |
1147 ; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the | |
1148 ; Disk Basic documentation. It is here for the use of DLOAD. | |
1149 L890B fcc 'UF' ; 25 undefined function call | |
1150 fcc 'NE' ; 26 File not found | |
1151 ; DEF USR | |
1152 L890F jsr GETNCH ; eat the USR token | |
1153 bsr L891C ; get pointer to USR call | |
1154 pshs x ; save FN exec address location | |
1155 bsr L8944 ; calculate execution address | |
1156 puls u ; get FN address pointer | |
1157 stx ,u ; save new address | |
1158 rts | |
1159 L891C clrb ; default routine number is 0 | |
1160 jsr GETNCH ; fetch the call number | |
1161 bcc L8927 ; brif not a number | |
1162 suba #'0 ; remove ASCII bias | |
1163 tfr a,b ; save it in the right place | |
1164 jsr GETNCH ; eat the call number | |
1165 L8927 ldx USRADR ; get start address of USR jump table | |
1166 aslb ; two bytes per address | |
1167 abx ; now X points to the right entry | |
1168 rts | |
1169 ; Evaluate a USR call | |
1170 L892C bsr L891C ; find the correct routine address location | |
1171 ldx ,x ; get routine address | |
1172 pshs x ; save it | |
1173 jsr LB262 ; evaluate argument | |
1174 ldx #FP0EXP ; point to FPA0 (argument value) | |
1175 lda VALTYP ; is it string? | |
1176 beq L8943 ; brif not | |
1177 jsr LB657 ; fetch string details (removes it from the string stack) | |
1178 ldx FPA0+2 ; get string descriptor pointer | |
1179 lda VALTYP ; set flags for the value type | |
1180 L8943 rts ; call the routine and return to mainline code | |
1181 L8944 ldb #0xb3 ; check for "=" | |
1182 jsr LB26F | |
1183 jmp LB73D ; evaluate integer expression to X and return | |
1184 ; Extended Basic IRQ handler | |
1185 XIRQSV lda PIA0+3 ; is it VSYNC interrupt? | |
1186 bmi L8952 ; brif so | |
1187 rti ; really should clear the HSYNC interrupt here | |
1188 L8952 lda PIA0+2 ; clear VSYNC interrupt | |
1189 ldx TIMVAL ; increment the TIMER value | |
1190 leax 1,x | |
1191 stx TIMVAL | |
1192 jmp L9C3E ; check for other stuff | |
1193 ; TIMER= | |
1194 L8960 jsr GETNCH ; eat the TIMER token | |
1195 bsr L8944 ; evaluate =nnnn to X | |
1196 stx TIMVAL ; set the timer | |
1197 rts | |
1198 ; TIMER function | |
1199 TIMER ldx TIMVAL ; get timer value | |
1200 stx FPA0+2 ; set it in FPA0 | |
1201 jmp L880E ; return as positive 16 bit value | |
1202 ; DEL command | |
1203 DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0) | |
1204 jsr LAF67 ; parse line number | |
1205 jsr LAD01 ; find line | |
1206 stx VD3 ; save address of line | |
1207 jsr GETCCH ; is there something more? | |
1208 beq L8990 ; brif not | |
1209 cmpa #0xac ; dash? | |
1210 bne L89BF ; brif not - error out | |
1211 jsr GETNCH ; each the - | |
1212 beq L898C ; brif no ending line - use default line number | |
1213 bsr L89AE ; parse second line number and save in BINVAL | |
1214 bra L8990 ; do the deletion | |
1215 L898C lda #0xff ; set to maximum line number | |
1216 sta BINVAL | |
1217 L8990 ldu VD3 ; point end to start | |
1218 skip2 | |
1219 L8993 ldu ,u ; point to start of next line | |
1220 ldd ,u ; check for end of program | |
1221 beq L899F ; brif end of program | |
1222 ldd 2,u ; get line number | |
1223 subd BINVAL ; is it in range? | |
1224 bls L8993 ; brif so | |
1225 L899F ldx VD3 ; get starting line address | |
1226 bsr L89B8 ; close up gap | |
1227 jsr LAD21 ; reset input pointer and erase variables | |
1228 ldx VD3 ; get start of program after the deletion | |
1229 jsr LACF1 ; recompute netl ine pointers | |
1230 jmp LAC73 ; return to immediate mode | |
1231 L89AE jsr LAF67 ; parse a line number | |
1232 jmp LA5C7 ; make sure there's nothing more | |
1233 L89B4 lda ,u+ ; copy a byte | |
1234 sta ,x+ | |
1235 L89B8 cmpu VARTAB ; end of program? | |
1236 bne L89B4 ; brif not | |
1237 stx VARTAB ; save new start of variables/end of program | |
1238 L89BF rts | |
1239 ; LINE INPUT | |
1240 L89C0 jsr L8866 ; raise error if in immediate mode | |
1241 jsr GETNCH ; eat the "INPUT" token | |
1242 cmpa #'# ; device number? | |
1243 bne L89D2 ; brif not | |
1244 jsr LA5A5 ; parse device number | |
1245 jsr LA3ED ; make sure it's valid for input | |
1246 jsr SYNCOMMA ; make sure there's a comma after the device number | |
1247 L89D2 cmpa #'" ; is there a prompt? | |
1248 bne L89E1 ; brif not | |
1249 jsr LB244 ; parse the string | |
1250 ldb #'; ; make sure there's a semicolon after the prompt | |
1251 jsr LB26F | |
1252 jsr LB99F ; go actually display the prompt | |
1253 L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right) | |
1254 jsr LB035 ; read an input line from current device | |
1255 leas 2,s ; clean up stack | |
1256 clr DEVNUM ; reset to screen/keyboard | |
1257 jsr LB357 ; parse a variable | |
1258 stx VARDES ; save pointer to it | |
1259 jsr LB146 ; make sure it's a string | |
1260 ldx #LINBUF ; point to input buffer | |
1261 clra ; make sure we terminate on NUL only | |
1262 jsr LB51A ; parse string and store it in string space | |
1263 jmp LAFA4 ; go assign the string to its final resting place | |
1264 ; RENUM command | |
1265 L89FC jsr LAF67 ; read a line number | |
1266 ldx BINVAL ; get value | |
1267 rts | |
1268 L8A02 ldx VD1 ; get current old number being renumbered | |
1269 L8A04 stx BINVAL ; save number being searched for | |
1270 jmp LAD01 ; go find line number | |
1271 RENUM jsr LAD26 ; erase variables | |
1272 ldd #10 ; default line number interval and start | |
1273 std VD5 ; set starting line number | |
1274 std VCF ; set number interval | |
1275 clrb ; now D is 0 | |
1276 std VD1 ; save default start for renumbering | |
1277 jsr GETCCH ; are there any arguments | |
1278 bcc L8A20 ; brif not numeric | |
1279 bsr L89FC ; fetch line number | |
1280 stx VD5 ; save line beginning number | |
1281 jsr GETCCH ; get input character | |
1282 L8A20 beq L8A3D ; brif end of line | |
1283 jsr SYNCOMMA ; make sure we have a comma | |
1284 bcc L8A2D ; brif next isn't numeric | |
1285 bsr L89FC ; fetch starting line number | |
1286 stx VD1 ; save the number where we start working | |
1287 jsr GETCCH ; fetch input character | |
1288 L8A2D beq L8A3D ; brif end of line | |
1289 jsr SYNCOMMA ; make sure we have a comma | |
1290 bcc L8A3A ; brif we don't have a number | |
1291 bsr L89FC ; parse the number | |
1292 stx VCF ; save interval | |
1293 beq L8A83 ; brif we ave a zero interval | |
1294 L8A3A jsr LA5C7 ; raise error if more stuff | |
1295 L8A3D bsr L8A02 ; get address of old number to process | |
1296 stx VD3 ; save address | |
1297 ldx VD5 ; get the next renumbered line to use | |
1298 bsr L8A04 ; find that line | |
1299 cmpx VD3 ; is it before the previous one? | |
1300 blo L8A83 ; brif so - raise error | |
1301 bsr L8A67 ; make sure renumbered line numbers will be in range | |
1302 jsr L8ADD ; convert line numbers to "expanded" binary | |
1303 jsr LACEF ; recalculate next line pointers | |
1304 bsr L8A02 ; get address of first line to renumber | |
1305 stx VD3 ; save it | |
1306 bsr L8A91 ; make sure line numbers exist | |
1307 bsr L8A68 ; renumber the actual lines | |
1308 bsr L8A91 ; update line numbers in program text | |
1309 jsr L8B7B ; convert packed binary line numbers to text | |
1310 jsr LAD26 ; erase variables, reset stack, etc. | |
1311 jsr LACEF ; recalculate next line pointers | |
1312 jmp LAC73 ; bounce back to immediate mode | |
1313 L8A67 skip1lda ; set line number flag to nonzero (skip next instruction) | |
1314 L8A68 clra ; set line number flag to zero (insert new numbers) | |
1315 sta VD8 ; save line number flag | |
1316 ldx VD3 ; get address of line being renumbered | |
1317 ldd VD5 ; get the current renumbering number | |
1318 bsr L8A86 ; return if end of program | |
1319 L8A71 tst VD8 ; test line number flag | |
1320 bne L8A77 ; brif not adding new numbers | |
1321 std 2,x ; set new number | |
1322 L8A77 ldx ,x ; point to next line | |
1323 bsr L8A86 ; return if end of program | |
1324 addd VCF ; add interval to current number | |
1325 bcs L8A83 ; brif we overflowed - bad line number | |
1326 cmpa #MAXLIN ; maximum legal number? | |
1327 blo L8A71 ; brif so - do another | |
1328 L8A83 jmp LB44A ; raise FC error | |
1329 L8A86 pshs d ; save D (we're going to clobber it) | |
1330 ldd ,x ; get next line pointer | |
1331 puls d ; unclobber D | |
1332 bne L8A90 ; brif not end of program | |
1333 leas 2,s ; return to caller's caller | |
1334 L8A90 rts | |
1335 L8A91 ldx TXTTAB ; get start of program | |
1336 leax -1,x ; move pointer back one (compensate for leax 1,x below) | |
1337 L8A95 leax 1,x ; move to next line | |
1338 bsr L8A86 ; return if end of program | |
1339 L8A99 leax 3,x ; move past next line address and line number, go one before line | |
1340 L8A9B leax 1,x ; move to next character | |
1341 lda ,x ; check input character | |
1342 beq L8A95 ; brif end of line | |
1343 stx TEMPTR ; save current pointer | |
1344 deca ; is it start of packed numeric line number? | |
1345 beq L8AB2 ; brif so | |
1346 deca ; does line exist? | |
1347 beq L8AD3 ; brif line number exists | |
1348 deca ; not part of something to process? | |
1349 bne L8A9B ; brif so | |
1350 L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing | |
1351 sta ,x+ | |
1352 bra L8A99 ; go process another | |
1353 L8AB2 ldd 1,x ; get MSB of line number | |
1354 dec 2,x ; is MS byte zero? | |
1355 beq L8AB9 ; brif not | |
1356 clra ; set MS byte to 0 | |
1357 L8AB9 ldb 3,x ; get LSB of line number | |
1358 dec 4,x ; is it zero? | |
1359 beq L8AC0 ; brif not | |
1360 clrb ; clear byte | |
1361 L8AC0 std 1,x ; save binary number | |
1362 std BINVAL ; save trial number | |
1363 jsr LAD01 ; find the line number | |
1364 L8AC7 ldx TEMPTR ; get start of packed line | |
1365 bcs L8AAC ; brif line number not found | |
1366 ldd V47 ; get address of line number | |
1367 inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting | |
1368 std ,x ; save address of correct number | |
1369 bra L8A99 ; go process more | |
1370 L8AD3 clr ,x ; clear carry and first byte | |
1371 ldx 1,x ; point to address of correct line | |
1372 ldx 2,x ; get correct line number | |
1373 stx V47 ; save it | |
1374 bra L8AC7 ; insert into line | |
1375 L8ADD ldx TXTTAB ; get beginning of program | |
1376 bra L8AE5 | |
1377 L8AE1 ldx CHARAD ; get input pointer | |
1378 leax 1,x ; move it forward | |
1379 L8AE5 bsr L8A86 ; return if end of program | |
1380 leax 2,x ; move past line address | |
1381 L8AE9 leax 1,x ; move forward | |
1382 L8AEB stx CHARAD ; save input pointer | |
1383 L8AED jsr GETNCH ; get an input character | |
1384 L8AEF tsta ; is it actual 0? | |
1385 beq L8AE1 ; brif end of line | |
1386 bpl L8AED ; brif not a token | |
1387 ldx CHARAD ; get input pointer | |
1388 cmpa #0xff ; function? | |
1389 beq L8AE9 ; brif so - ignore it (and following byte) | |
1390 jsr RVEC22 ; do the RAM hook thing | |
1391 cmpa #0xa7 ; THEN? | |
1392 beq L8B13 ; brif so | |
1393 cmpa #0x84 ; ELSE? | |
1394 beq L8B13 ; brif so | |
1395 cmpa #0x81 ; GO(TO|SUB)? | |
1396 bne L8AED ; brif not - we don't have a line number | |
1397 jsr GETNCH ; get TO/SUB | |
1398 cmpa #0xa5 ; GOTO? | |
1399 beq L8B13 ; brif so | |
1400 cmpa #0xa6 ; GOSUB? | |
1401 bne L8AEB ; brif not | |
1402 L8B13 jsr GETNCH ; fetch character after token | |
1403 bcs L8B1B ; brif numeric (line number) | |
1404 L8B17 jsr GETCCH ; set flags on input character | |
1405 bra L8AEF ; keep checking for line numbers | |
1406 L8B1B ldx CHARAD ; get input pointer | |
1407 pshs x ; save it | |
1408 jsr LAF67 ; parse line number | |
1409 ldx CHARAD ; get input pointer after line | |
1410 L8B24 lda ,-x ; get character before pointer | |
1411 jsr L90AA ; set C if numeric | |
1412 bcs L8B24 ; brif not numeric | |
1413 leax 1,x ; move pointer up | |
1414 tfr x,d ; calculate size of line number | |
1415 subb 1,s | |
1416 subb #5 ; make sure at least 5 bytes | |
1417 beq L8B55 ; brif exactly 5 bytes - no change | |
1418 blo L8B41 ; brif less than 5 bytes | |
1419 leau ,x ; move remainder of program backward | |
1420 negb ; negate extra number of bytes (to subtract from X) | |
1421 leax b,x ; now X is the correct position to move program to | |
1422 jsr L89B8 ; shift program backward | |
1423 bra L8B55 | |
1424 L8B41 stx V47 ; save end of line number space (end of copy) | |
1425 ldx VARTAB ; get end of program | |
1426 stx V43 ; set source pointer | |
1427 negb ; get positive difference | |
1428 leax b,x ; now X is the top of the destination block | |
1429 stx V41 ; set copy destination | |
1430 stx VARTAB ; save new end of program | |
1431 jsr LAC1E ; make sure enough room and make a hole in the program | |
1432 ldx V45 ; get end address of destination block | |
1433 stx CHARAD ; set input there | |
1434 L8B55 puls x ; get starting address of the line number | |
1435 lda #1 ; set "new number" flag | |
1436 sta ,x | |
1437 sta 2,x | |
1438 sta 4,x | |
1439 ldb BINVAL ; get MS byte of line number | |
1440 bne L8B67 ; brif it is not zero | |
1441 ldb #1 ; set to 1 if MSB is 0 | |
1442 inc 2,x ; flag MSB as 0 | |
1443 L8B67 stb 1,x ; set MSB of line number | |
1444 ldb BINVAL+1 ; get LSB of number | |
1445 bne L8B71 ; brif nonzero | |
1446 ldb #1 ; set to 1 if LSB is 0 | |
1447 inc 4,x ; flag LSB as 0 | |
1448 L8B71 stb 3,x ; save LSB of line number | |
1449 jsr GETCCH ; get input character | |
1450 cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB) | |
1451 beq L8B13 ; brif so - process another | |
1452 bra L8B17 ; go look for more line numbers | |
1453 L8B7B ldx TXTTAB ; point to start of program | |
1454 leax -1,x ; move back (compensate for inc below) | |
1455 L8B7F leax 1,x ; move forward | |
1456 ldd 2,x ; get this line number | |
1457 std CURLIN ; save it (for error message) | |
1458 jsr L8A86 ; return if end of program | |
1459 leax 3,x ; skip address and line number, stay one before line text | |
1460 L8B8A leax 1,x ; move to next character | |
1461 L8B8C lda ,x ; get input character | |
1462 beq L8B7F ; brif end of line | |
1463 deca ; valid line new line number? | |
1464 beq L8BAE ; brif so | |
1465 suba #2 ; undefined line? | |
1466 bne L8B8A ; brif not | |
1467 pshs x ; save line number pointer | |
1468 ldx #L8BD9-1 ; show UL message | |
1469 jsr STRINOUT | |
1470 ldx ,s ; get input pointer | |
1471 ldd 1,x ; get undefined line number | |
1472 jsr LBDCC ; display line number | |
1473 jsr LBDC5 ; print out "IN XXXX" | |
1474 jsr LB958 ; do a newline | |
1475 puls x ; get input pointer back | |
1476 L8BAE pshs x ; save input pointer | |
1477 ldd 1,x ; get binary value of line number | |
1478 std FPA0+2 ; save it in FPA0 | |
1479 jsr L880E ; adjust FPA0 as integer | |
1480 jsr LBDD9 ; convert to text string | |
1481 puls u ; get previous input pointer address | |
1482 ldb #5 ; each expanded line uses 5 bytes | |
1483 L8BBE leax 1,x ; move pointer forward (in string number) past sign | |
1484 lda ,x ; do we have a digit? | |
1485 beq L8BC9 ; brif not - end of number | |
1486 decb ; mark a byte consumed | |
1487 sta ,u+ ; put digit in program | |
1488 bra L8BBE ; copy another digit | |
1489 L8BC9 leax ,u ; point to address at end of text number | |
1490 tstb ; did number fill whole space? | |
1491 beq L8B8C ; brif so - move on | |
1492 leay ,u ; save end of number pointer | |
1493 leau b,u ; point to the end of the original expanded number | |
1494 jsr L89B8 ; close up gap in program | |
1495 leax ,y ; get end of line number pointer back | |
1496 bra L8B8C ; go process more | |
1497 L8BD9 fcn 'UL ' | |
1498 ; HEX$ function | |
1499 HEXDOL jsr LB740 ; convert argument to positive integer | |
1500 ldx #STRBUF+2 ; point to string buffer | |
1501 ldb #4 ; convert 4 nibbles | |
1502 L8BE5 pshs b ; save nibble counter | |
1503 clrb ; clear digit accumulator | |
1504 lda #4 ; do 4 shifts | |
1505 L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B | |
1506 rol FPA0+2 | |
1507 rolb | |
1508 deca ; done all shifts? | |
1509 bne L8BEA ; brif not | |
1510 tstb ; do we have a nonzero digit? | |
1511 bne L8BFF ; brif so | |
1512 lda ,s ; is it last digit? | |
1513 deca | |
1514 beq L8BFF ; brif so - keep the 0 | |
1515 cmpx #STRBUF+2 ; is it a middle zero? | |
1516 beq L8C0B ; brif not | |
1517 L8BFF addb #'0 ; add ASCII bias | |
1518 cmpb #'9 ; above 9? | |
1519 bls L8C07 ; brif not | |
1520 addb #7 ; adjust into alpha range | |
1521 L8C07 stb ,x+ ; save digit in output | |
1522 clr ,x ; make sure we have a NUL term | |
1523 L8C0B puls b ; get back nibble counter | |
1524 decb ; done all? | |
1525 bne L8BE5 ; brif not | |
1526 leas 2,s ; don't return mainline (we're returning a string) | |
1527 ldx #STRBUF+1 ; point to start of converted number | |
1528 jmp LB518 ; save string in string space, etc., and return it | |
1529 ; DLOAD command | |
1530 DLOAD jsr LA429 ; close files | |
1531 L8C1B jsr GETCCH ; get back input character | |
1532 suba #'M ; is it DLOADM? | |
1533 pshs a ; save DLOADM flag | |
1534 bne L8C25 ; brif DLOAD | |
1535 jsr GETNCH ; eat the "M" | |
1536 L8C25 jsr LA578 ; parse the file name | |
1537 jsr GETCCH ; get character after file name | |
1538 beq L8C44 ; brif end of line | |
1539 jsr SYNCOMMA ; make sure we have a comma | |
1540 cmpa #', ; do we have 2 commas? | |
1541 beq L8C44 ; brif so - use default baud rate | |
1542 jsr EVALEXPB ; evaluate baud rate | |
1543 L8C36 lda #44*4 ; delay for 300 baud | |
1544 tstb ; was argument 0? | |
1545 beq L8C42 ; brif so - 300 baud | |
1546 lda #44 ; constant for 1200 baud | |
1547 decb ; was it 1? | |
1548 lbne LB44A ; raise error if not | |
1549 L8C42 sta DLBAUD ; save baud rate constant | |
1550 L8C44 jsr L8CD0 ; transmit file name and read in file status | |
1551 pshs a ; save register | |
1552 lda #-3 ; set input to DLOAD | |
1553 sta DEVNUM | |
1554 puls a ; restore register | |
1555 tst ,s+ ; is it DLOADM? | |
1556 beq L8C85 ; brif so | |
1557 jsr LA5C7 ; check for end of line - error if not | |
1558 tstb ; ASCII? | |
1559 beq L8C5F ; brif not - do error | |
1560 jsr LAD19 ; clear out program | |
1561 jmp LAC7C ; go read program | |
1562 L8C5F jmp LA616 ; raise bad file mode | |
1563 ; CLOADM patch for Extended Basic | |
1564 L8C62 jsr GETNCH ; get character after CLOAD | |
1565 cmpa #'M ; CLOADM? | |
1566 lbne CLOAD ; brif not - Color Basic's CLOAD can handle it | |
1567 clr FILSTA ; close tape file | |
1568 jsr GETNCH ; eat the "M" | |
1569 jsr LA578 ; parse file name | |
1570 jsr LA648 ; find the file | |
1571 tst CASBUF+10 ; is it a chunked file? | |
1572 lbeq LA505 ; brif not - Color Basic's CLOADM can handle it | |
1573 ldu CASBUF+8 ; get file type and ASCII flag | |
1574 dec DEVNUM ; set source device to tape | |
1575 jsr LA635 ; go read the first block | |
1576 tfr u,d ; put type and ASCII flag somewhere more useful | |
1577 ; NOTE: DLOADM comes here to do the final processing | |
1578 L8C85 subd #0x200 ; is it binary and "machine language"? | |
1579 bne L8C5F ; brif not - raise an error | |
1580 ldx ZERO ; default load offset | |
1581 jsr GETCCH ; is there any offset? | |
1582 beq L8C96 ; brif not | |
1583 jsr SYNCOMMA ; make sure there's a comma | |
1584 jsr LB73D ; evaluate offset in X | |
1585 L8C96 stx VD3 ; save offset | |
1586 jsr LA5C7 ; raise error if more stuff follows | |
1587 L8C9B bsr L8CC6 ; get type of "amble" | |
1588 pshs a ; save it | |
1589 bsr L8CBF ; read in block length | |
1590 tfr d,y ; save it | |
1591 bsr L8CBF ; read in load address | |
1592 addd VD3 ; add in offset | |
1593 std EXECJP ; save it as the execution address | |
1594 tfr d,x ; put load address in a pointer | |
1595 lda ,s+ ; get "amble" type | |
1596 lbne LA42D ; brif postamble - close file | |
1597 L8CB1 bsr L8CC6 ; read a data byte | |
1598 sta ,x ; save in memory | |
1599 cmpa ,x+ ; did it actually save? | |
1600 bne L8CCD ; brif not RAM - raise error | |
1601 leay -1,y ; done yet? | |
1602 bne L8CB1 ; brif not | |
1603 bra L8C9B ; look for another "amble" | |
1604 L8CBF bsr L8CC1 ; read a character to B | |
1605 L8CC1 bsr L8CC6 ; read character to A | |
1606 exg a,b ; swap character with previously read one | |
1607 L8CC5 rts | |
1608 L8CC6 jsr LA176 ; read a character from input | |
1609 tst CINBFL ; EOF? | |
1610 beq L8CC5 ; brif not | |
1611 L8CCD jmp LA619 ; raise I/O error if EOF | |
1612 L8CD0 bsr L8D14 ; transmit file name | |
1613 pshs b,a ; save file status | |
1614 inca ; was file found? | |
1615 beq L8CDD ; brif not | |
1616 ldu ZERO ; zero U - first block | |
1617 bsr L8CE4 ; read block | |
1618 puls a,b,pc ; restore status and return | |
1619 L8CDD ldb #2*26 ; code for NE error | |
1620 jmp LAC46 ; raise error | |
1621 L8CE2 ldu CBUFAD ; get block number | |
1622 L8CE4 leax 1,u ; bump block number | |
1623 stx CBUFAD ; save new block number | |
1624 ldx #CASBUF ; use cassette buffer | |
1625 jsr L8D7C ; read a block | |
1626 jmp LA644 ; reset input buffer pointers | |
1627 ; Generic input handler for Extended Basic | |
1628 XVEC4 lda DEVNUM ; get device number | |
1629 cmpa #-3 ; DLOAD? | |
1630 bne L8D01 ; brif not | |
1631 leas 2,s ; don't return to mainline code | |
1632 clr CINBFL ; reset EOF flag to not EOF | |
1633 tst CINCTR ; anything available? | |
1634 bne L8D02 ; brif so - fetch one | |
1635 com CINBFL ; flag EOF | |
1636 L8D01 rts | |
1637 L8D02 pshs u,y,x,b ; save registers | |
1638 ldx CINPTR ; get buffer pointer | |
1639 lda ,x+ ; get character from buffer | |
1640 pshs a ; save it for return | |
1641 stx CINPTR ; save new input pointer | |
1642 dec CINCTR ; account for byte removed from buffer | |
1643 bne L8D12 ; brif buffer not empty | |
1644 bsr L8CE2 ; go read a block | |
1645 L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return | |
1646 L8D14 clra ; clear attempt counter | |
1647 pshs x,b,a ; make a hole for variables | |
1648 leay ,s ; set up frame pointer | |
1649 bra L8D1D ; go read block | |
1650 L8D1B bsr L8D48 ; bump attempt counter | |
1651 L8D1D lda #0x8a ; send file request control code | |
1652 bsr L8D58 | |
1653 bne L8D1B ; brif no echo or error | |
1654 ldx #CFNBUF+1 ; point to file name | |
1655 L8D26 lda ,x+ ; get file name characater | |
1656 jsr L8E04 ; send it | |
1657 cmpx #CFNBUF+9 ; end of file name? | |
1658 bne L8D26 ; brif not | |
1659 bsr L8D62 ; output check byte and look for response | |
1660 bne L8D1B ; transmit name again if not ack | |
1661 bsr L8D72 ; get file type (0xff is not found) | |
1662 bne L8D1B ; brif error | |
1663 sta 2,y ; save file type | |
1664 bsr L8D72 ; read ASCII flag | |
1665 bne L8D1B ; brif error | |
1666 sta 3,y ; save ASCII flag | |
1667 bsr L8D6B ; read check byte | |
1668 bne L8D1B ; brif error | |
1669 leas 2,s ; lose attempt counter and check byte | |
1670 puls a,b,pc ; return file type and ascii flag | |
1671 L8D48 inc ,y ; bump attempt counter | |
1672 lda ,y ; get new count | |
1673 cmpa #5 ; done 5 times? | |
1674 blo L8D6A ; brif not | |
1675 lda #0xbc ; send abort code | |
1676 jsr L8E0C | |
1677 jmp LA619 ; raise an I/O error | |
1678 L8D58 pshs a ; save compare character | |
1679 bsr L8DB8 ; send character | |
1680 bne L8D60 ; brif read error | |
1681 cmpa ,s ; does it match? (set Z if good) | |
1682 L8D60 puls a,pc ; restore character and return | |
1683 L8D62 lda 1,y ; get XOR check byte | |
1684 bsr L8DB8 ; send it and read | |
1685 bne L8D6A ; brif read error | |
1686 cmpa #0xc8 ; is it ack? (set Z if so) | |
1687 L8D6A rts | |
1688 L8D6B bsr L8D72 ; read character from rs232 | |
1689 bne L8D6A ; brif error | |
1690 lda 1,y ; get check byte | |
1691 rts | |
1692 L8D72 bsr L8DBC ; read a character from rs232 | |
1693 pshs a,cc ; save result (and flags) | |
1694 eora 1,y ; accumulate xor checksum | |
1695 sta 1,y | |
1696 puls cc,a,pc ; restore byte, flags, and return | |
1697 L8D7C clra ; reset attempt counter | |
1698 pshs u,y,x,b,a ; make a stack frame | |
1699 asl 7,s ; split block number into two 7 bit chuncks | |
1700 rol 6,s | |
1701 lsr 7,s | |
1702 leay ,s ; set up frame pointer | |
1703 bra L8D8B | |
1704 L8D89 bsr L8D48 ; bump attempt counter | |
1705 L8D8B lda #0x97 ; send block request code | |
1706 bsr L8D58 | |
1707 bne L8D89 ; brif error | |
1708 lda 6,y ; send out block number (high bits first) | |
1709 bsr L8E04 | |
1710 lda 7,y | |
1711 bsr L8E04 | |
1712 bsr L8D62 ; send check byte and get ack | |
1713 bne L8D89 ; brif error | |
1714 bsr L8D72 ; read block size | |
1715 bne L8D89 ; brif read error | |
1716 sta 4,y ; save character count | |
1717 ldx 2,y ; get buffer pointer | |
1718 ldb #128 ; length of data block | |
1719 L8DA7 bsr L8D72 ; read a data byte | |
1720 bne L8D89 ; brif error | |
1721 sta ,x+ ; save byte in buffer | |
1722 decb ; done a whole block? | |
1723 bne L8DA7 ; brif not | |
1724 bsr L8D6B ; read check byte | |
1725 bne L8D89 ; brif error | |
1726 leas 4,s ; lose attempt counter, check byte, and buffer pointer | |
1727 puls a,b,x,pc ; return with character count in A, clean rest of stack | |
1728 L8DB8 clr 1,y ; clear check byte | |
1729 bsr L8E0C ; output character | |
1730 L8DBC clra ; clear attempt counter | |
1731 pshs x,b,cc ; save registers and interrupt status | |
1732 orcc #0x50 ; disable interrupts | |
1733 lda TIMOUT ; get timout delay (variable) | |
1734 ldx ZERO ; get constant timeout value | |
1735 L8DC5 bsr L8DE6 ; get RS232 status | |
1736 bcc L8DC5 ; brif "space" - waiting for "mark" | |
1737 L8DC9 bsr L8DE6 ; get RS232 status | |
1738 bcs L8DC9 ; brif "mark" - waiting for "space" (start bit) | |
1739 bsr L8DF9 ; delay for half of bit time | |
1740 ldb #1 ; set bit probe | |
1741 pshs b ; save it | |
1742 clra ; reset data byte | |
1743 L8DD4 bsr L8DF7 ; wait one bit time | |
1744 ldb PIA1+2 ; get input bit to carry | |
1745 rorb | |
1746 bcc L8DDE ; brif "space" (0) | |
1747 ora ,s ; merge bit probe in | |
1748 L8DDE asl ,s ; shift bit probe over | |
1749 bcc L8DD4 ; brif we haven't done 8 bits | |
1750 leas 1,s ; remove bit probe | |
1751 puls cc,b,x,pc ; restore interrupts, registers, and return | |
1752 L8DE6 ldb PIA1+2 ; get RS232 value | |
1753 rorb ; put in C | |
1754 leax 1,x ; bump timeout | |
1755 bne L8DF6 ; brif nonzero | |
1756 deca ; did the number of waits expire? | |
1757 bne L8DF6 ; brif not | |
1758 leas 2,s ; don't return - we timed out | |
1759 puls cc,b,x ; restore interrupts and registers | |
1760 inca ; clear Z (A was zero above) | |
1761 L8DF6 rts | |
1762 L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second | |
1763 L8DF9 pshs a ; save register | |
1764 lda DLBAUD ; get baud rate constant | |
1765 L8DFD brn L8DFD ; do nothing - delay | |
1766 deca ; time expired? | |
1767 bne L8DFD ; brif not | |
1768 puls a,pc ; restore register and return | |
1769 L8E04 pshs a ; save character to send | |
1770 eora 1,y ; accumulate chechsum | |
1771 sta 1,y | |
1772 puls a ; get character back | |
1773 L8E0C pshs b,a,cc ; save registers and interrupt status | |
1774 orcc #0x50 ; disable interrupts | |
1775 bsr L8DF7 ; do a bit delay | |
1776 bsr L8DF7 ; do another bit delay | |
1777 clr PIA1 ; set output to space (start bit) | |
1778 bsr L8DF7 ; do a bit delay | |
1779 ldb #1 ; bit probe start at LSB | |
1780 pshs b ; save bitprobe | |
1781 L8E1D lda 2,s ; get output byte | |
1782 anda ,s ; see what our current bit is | |
1783 beq L8E25 ; brif output is 0 | |
1784 lda #2 ; set output to "marking" | |
1785 L8E25 sta PIA1 ; send bit | |
1786 bsr L8DF7 ; do a bit delay | |
1787 asl ,s ; shift bit probe | |
1788 bcc L8E1D ; brif not last bit | |
1789 lda #2 ; set output to marking ("stop" bit) | |
1790 sta PIA1 | |
1791 leas 1,s ; lose bit probe | |
1792 puls cc,a,b,pc ; restore registers, interrupts, and return | |
1793 ; PRINT USING | |
1794 ; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to | |
1795 ; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total | |
1796 ; Extended Color Basic ROM. | |
1797 ; | |
1798 ; This uses several variables: | |
1799 ; VD5: pointer to format string descriptor | |
1800 ; VD7: next print item flag | |
1801 ; VD8: right digit counter | |
1802 ; VD9: left digit counter (or length of string argument) | |
1803 ; VDA: status byte (bits as follows): | |
1804 ; 6: force comma | |
1805 ; 5: force leading * | |
1806 ; 4: floating $ | |
1807 ; 3: pre-sign | |
1808 ; 2: post-sign | |
1809 ; 0: scientific notation | |
1810 L8E37 lda #1 ; set length to use to 1 | |
1811 sta VD9 | |
1812 L8E3B decb ; consume character from format string | |
1813 jsr L8FD8 ; show error flag if flags set | |
1814 jsr GETCCH ; get input character | |
1815 lbeq L8ED8 ; brif end of line - bail | |
1816 stb VD3 ; save remaining string length | |
1817 jsr LB156 ; evaluate the argument | |
1818 jsr LB146 ; error if numeric | |
1819 ldx FPA0+2 ; get descriptor for argument | |
1820 stx V4D ; save it for later | |
1821 ldb VD9 ; get length counter to use | |
1822 jsr LB6AD ; get B bytes of string space (do a LEFT$) | |
1823 jsr LB99F ; print the formatted string | |
1824 ldx FPA0+2 ; get formatted string descriptor | |
1825 ldb VD9 ; get requested length | |
1826 subb ,x ; see if we have any left over | |
1827 L8E5F decb ; have we got the right width? | |
1828 lbmi L8FB3 ; brif so - go process more | |
1829 jsr LB9AC ; output a space | |
1830 bra L8E5F ; go see if we're done yet | |
1831 L8E69 stb VD3 ; save current format string counter and pointer | |
1832 stx TEMPTR | |
1833 lda #2 ; initial spaces count = 2 (for the two %s) | |
1834 sta VD9 ; save length counter | |
1835 L8E71 lda ,x ; get character in string | |
1836 cmpa #'% ; is it the end of the sequence? | |
1837 beq L8E3B ; brif so - display requested part of the strign | |
1838 cmpa #0x20 ; space? | |
1839 bne L8E82 ; brif not | |
1840 inc VD9 ; bump spaces count | |
1841 leax 1,x ; move format pointer forward | |
1842 decb ; consume character | |
1843 bne L8E71 ; brif not end of format string | |
1844 L8E82 ldx TEMPTR ; restore format string pointer | |
1845 ldb VD3 ; get back format string length | |
1846 lda #'% ; show % as debugging aid | |
1847 L8E88 jsr L8FD8 ; send error indicator if flags set | |
1848 jsr PUTCHR ; output character | |
1849 bra L8EB9 ; go process more format string | |
1850 ; PRINT extension for USING | |
1851 XVEC9 cmpa #0xcd ; USING? | |
1852 beq L8E95 ; brif so | |
1853 rts ; return to mainline code | |
1854 ; This is the main entry point for PRINT USING | |
1855 L8E95 leas 2,s ; don't return to the mainline code | |
1856 jsr LB158 ; evaluate the format string | |
1857 jsr LB146 ; error if numeric | |
1858 ldb #'; ; make sure there's a ; after the string | |
1859 jsr LB26F | |
1860 ldx FPA0+2 ; get format string descriptor | |
1861 stx VD5 ; save it for later | |
1862 bra L8EAE ; process format string | |
1863 L8EA8 lda VD7 ; is there a print item? | |
1864 beq L8EB4 ; brif not | |
1865 ldx VD5 ; get back format string descriptor | |
1866 L8EAE clr VD7 ; reset next print item flag | |
1867 ldb ,x ; get length of format string | |
1868 bne L8EB7 ; brif string is non-null | |
1869 L8EB4 jmp LB44A ; raise FC error | |
1870 L8EB7 ldx 2,x ; point to start of string | |
1871 L8EB9 clr VDA ; clear status (new item) | |
1872 L8EBB clr VD9 ; clear left digit counter | |
1873 lda ,x+ ; get character from format string | |
1874 cmpa #'! ; ! (use first character of string)? | |
1875 lbeq L8E37 ; brif so | |
1876 cmpa #'# ; digit? | |
1877 beq L8F24 ; brif so - handle numeric | |
1878 decb ; consume format character | |
1879 bne L8EE2 ; brif not done | |
1880 jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string | |
1881 jsr PUTCHR ; output format string character | |
1882 L8ED2 jsr GETCCH ; get current input character | |
1883 bne L8EA8 ; brif not end of statement | |
1884 lda VD7 ; get next item flag | |
1885 L8ED8 bne L8EDD ; brif more print items | |
1886 jsr LB958 ; do newline | |
1887 L8EDD ldx VD5 ; point to format string descriptor | |
1888 jmp LB659 ; remove from string stack, etc., if appropriate (and return) | |
1889 L8EE2 cmpa #'+ ; is it + (pre-sign)? | |
1890 bne L8EEF ; brif not | |
1891 jsr L8FD8 ; send a "+" if flags set | |
1892 lda #8 ; flag for pre-sign | |
1893 sta VDA ; set flags | |
1894 bra L8EBB ; go interpret some more stuff | |
1895 L8EEF cmpa #'. ; decimal? | |
1896 beq L8F41 ; brif so - numeric | |
1897 cmpa #'% ; % (show string)? | |
1898 lbeq L8E69 ; brif so | |
1899 cmpa ,x ; do we have two identical characters? | |
1900 L8EFB bne L8E88 ; brif not - invalid format character | |
1901 cmpa #'$ ; double $? | |
1902 beq L8F1A ; brif so - floating $ | |
1903 cmpa #'* ; double *? | |
1904 bne L8EFB ; brif not | |
1905 lda VDA ; get status byte | |
1906 ora #0x20 ; enable * padding | |
1907 sta VDA | |
1908 cmpb #2 ; is $$ the last two? | |
1909 blo L8F20 ; brif so | |
1910 lda 1,x ; is it $ after? | |
1911 cmpa #'$ | |
1912 bne L8F20 ; brif not | |
1913 decb ; consume the "$" | |
1914 leax 1,x | |
1915 inc VD9 ; add to digit counter * pad + $ counter | |
1916 L8F1A lda VDA ; indicate floating $ | |
1917 ora #0x10 | |
1918 sta VDA | |
1919 L8F20 leax 1,x ; consume the second format character | |
1920 inc VD9 ; add one more left place | |
1921 L8F24 clr VD8 ; clear right digit counter | |
1922 L8F26 inc VD9 ; bump left digit counter | |
1923 decb ; consume character | |
1924 beq L8F74 ; brif end of string | |
1925 lda ,x+ ; get next format character | |
1926 cmpa #'. ; decimal? | |
1927 beq L8F4F ; brif so | |
1928 cmpa #'# ; digit? | |
1929 beq L8F26 ; brif so | |
1930 cmpa #', ; comma flag? | |
1931 bne L8F5A ; brif not | |
1932 lda VDA ; set commas flag | |
1933 ora #0x40 | |
1934 sta VDA | |
1935 bra L8F26 ; handle more characters to left of decimal | |
1936 L8F41 lda ,x ; get character after . | |
1937 cmpa #'# ; digit? | |
1938 lbne L8E88 ; brif not - invalid | |
1939 lda #1 ; set right digit counter to 1 (for the .) | |
1940 sta VD8 | |
1941 leax 1,x ; consume the . | |
1942 L8F4F inc VD8 ; add one to right digit counter | |
1943 decb ; consume character | |
1944 beq L8F74 ; brif end of format string | |
1945 lda ,x+ ; get another format character | |
1946 cmpa #'# ; digit? | |
1947 beq L8F4F ; brif so | |
1948 L8F5A cmpa #0x5e ; up arrow? | |
1949 bne L8F74 ; brif not | |
1950 cmpa ,x ; two of them? | |
1951 bne L8F74 ; brif not | |
1952 cmpa 1,x ; three of them? | |
1953 bne L8F74 ; brif not | |
1954 cmpa 2,x ; four of them? | |
1955 bne L8F74 ; brif not | |
1956 cmpb #4 ; string actually has the characters? | |
1957 blo L8F74 ; brif not | |
1958 subb #4 ; consome them | |
1959 leax 4,x | |
1960 inc VDA ; set scientific notation bit | |
1961 L8F74 leax -1,x ; back up input pointer | |
1962 inc VD9 ; add one digit for pre-sign force | |
1963 lda VDA ; is it pre-sign? | |
1964 bita #8 | |
1965 bne L8F96 ; brif so | |
1966 dec VD9 ; undo pre-sign adjustment | |
1967 tstb ; end of string? | |
1968 beq L8F96 ; brif so | |
1969 lda ,x ; get next character | |
1970 suba #'- ; post sign force? | |
1971 beq L8F8F ; brif so | |
1972 cmpa #'+-'- ; plus? | |
1973 bne L8F96 ; brif not | |
1974 lda #8 ; trailing + is a pre-sign force | |
1975 L8F8F ora #4 ; add in post sign flag | |
1976 ora VDA ; merge with flags | |
1977 sta VDA | |
1978 decb ; consume character | |
1979 L8F96 jsr GETCCH ; do we have an argument | |
1980 lbeq L8ED8 ; brif not | |
1981 stb VD3 ; save format string length | |
1982 jsr LB141 ; evluate numeric expression | |
1983 lda VD9 ; get left digit counter | |
1984 adda VD8 ; add in right digit counter | |
1985 cmpa #17 ; is it more than 16 digits + decimal? | |
1986 lbhi LB44A ; brif so - this is a problem | |
1987 jsr L8FE5 ; format value according to settings | |
1988 leax -1,x ; move buffer pointer back | |
1989 jsr STRINOUT ; display formatted number string | |
1990 L8FB3 clr VD7 ; reset next print item flag | |
1991 jsr GETCCH ; get current input character | |
1992 beq L8FC6 ; brif end of statement | |
1993 sta VD7 ; set next print flag to nonzero | |
1994 cmpa #'; ; list separator ;? | |
1995 beq L8FC4 ; brif so | |
1996 jsr SYNCOMMA ; require a comma between if not ; | |
1997 bra L8FC6 ; process next item | |
1998 L8FC4 jsr GETNCH ; munch the semicolon | |
1999 L8FC6 ldx VD5 ; get format string descriptor | |
2000 ldb ,x ; get length of string | |
2001 subb VD3 ; subtract amount left after last item | |
2002 ldx 2,x ; point to string address | |
2003 abx ; move pointer to correct spot | |
2004 ldb VD3 ; get remaining string length | |
2005 lbne L8EB9 ; if we have more, interpret from there | |
2006 jmp L8ED2 ; re-interpret from start if we hit the end | |
2007 L8FD8 pshs a ; save character | |
2008 lda #'+ ; "error" flag character | |
2009 tst VDA ; did we have some flags set? | |
2010 beq L8FE3 ; brif not | |
2011 jsr PUTCHR ; output error flag | |
2012 L8FE3 puls a,pc ; restore character and return | |
2013 L8FE5 ldu #STRBUF+4 ; point to string buffer | |
2014 ldb #0x20 ; blank space | |
2015 lda VDA ; get flags | |
2016 bita #8 ; pre-sign? | |
2017 beq L8FF2 ; brif not | |
2018 ldb #'+ ; plus sign | |
2019 L8FF2 tst FP0SGN ; get sign of value | |
2020 bpl L8FFA ; brif positive | |
2021 clr FP0SGN ; make number positive (for later) | |
2022 ldb #'- ; negative sign | |
2023 L8FFA stb ,u+ ; put sign in buffer | |
2024 ldb #'0 ; put a zero there | |
2025 stb ,u+ | |
2026 anda #1 ; check scientific notation force | |
2027 lbne L910D ; brif so | |
2028 ldx #LBDC0 ; point to FP 1E+9 | |
2029 jsr LBCA0 ; is it less? | |
2030 bmi L9023 ; brif so | |
2031 jsr LBDD9 ; convert FP number to string (we're doing scientific notation) | |
2032 L9011 lda ,x+ ; advance pointer to end of string | |
2033 bne L9011 | |
2034 L9015 lda ,-x ; make a hole at the start | |
2035 sta 1,x | |
2036 cmpx #STRBUF+3 ; done yet? | |
2037 bne L9015 ; brif not | |
2038 lda #'% ; put "overflow" flag at start | |
2039 sta ,x | |
2040 rts | |
2041 L9023 lda FP0EXP ; get exponent of value | |
2042 sta V47 ; save it | |
2043 beq L902C ; brif value is 0 | |
2044 jsr L91CD ; convert to number with 9 significant figures to left of decimal | |
2045 L902C lda V47 ; get base 10 exponent offset | |
2046 lbmi L90B3 ; brif < 100,000,000 | |
2047 nega ; get negative difference | |
2048 adda VD9 ; add to number of left digits | |
2049 suba #9 ; account for the 9 we actually have | |
2050 jsr L90EA ; put leading zeroes in buffer | |
2051 jsr L9263 ; initialize the decimal point and comma counters | |
2052 jsr L9202 ; convert FPA0 to decimal ASCII in buffer | |
2053 lda V47 ; get base 10 exponent | |
2054 jsr L9281 ; put that many zeroes in buffer, stop at decimal point | |
2055 lda V47 ; get base 10 exponent | |
2056 jsr L9249 ; check for decimal | |
2057 lda VD8 ; get right digit counter | |
2058 bne L9050 ; brif we want stuff after decimal | |
2059 leau -1,u ; delete decimal if not needed | |
2060 L9050 deca ; subtract one place (for decimal) | |
2061 jsr L90EA ; put zeroes in buffer (trailing) | |
2062 L9054 jsr L9185 ; insert * padding, floating $, and post-sign | |
2063 tsta ; was there a post sign? | |
2064 beq L9060 ; brif not | |
2065 cmpb #'* ; was first character a *? | |
2066 beq L9060 ; brif so | |
2067 stb ,u+ ; store the post sign | |
2068 L9060 clr ,u ; make srue it's NUL terminated | |
2069 ldx #STRBUF+3 ; point to start of buffer | |
2070 L9065 leax 1,x ; move to next character | |
2071 stx TEMPTR ; save it for later | |
2072 lda VARPTR+1 ; get address of decimal point | |
2073 suba TEMPTR+1 ; subtract out actual digits left of decimal | |
2074 suba VD9 ; subtract out required left digits | |
2075 beq L90A9 ; brif no padding needed | |
2076 lda ,x ; get current character | |
2077 cmpa #0x20 ; space? | |
2078 beq L9065 ; brif so - advance pointer | |
2079 cmpa #'* ; *? | |
2080 beq L9065 ; brif so - advance pointer | |
2081 clra ; zero on stack is end of data ponter | |
2082 L907C pshs a ; save character on stack | |
2083 lda ,x+ ; get next character | |
2084 cmpa #'- ; minus? | |
2085 beq L907C ; brif so | |
2086 cmpa #'+ ; plus? | |
2087 beq L907C ; brif so | |
2088 cmpa #'$ ; $? | |
2089 beq L907C ; brif so | |
2090 cmpa #'0 ; zero? | |
2091 bne L909E ; brif not | |
2092 lda 1,x ; get character after 0 | |
2093 bsr L90AA ; clear carry if number | |
2094 bcs L909E ; brif not number | |
2095 L9096 puls a ; get character off stack | |
2096 sta ,-x ; put it back in string buffer | |
2097 bne L9096 ; brif not - restore another | |
2098 bra L9065 ; keep cleaning up buffer | |
2099 L909E puls a ; get the character on the stack | |
2100 tsta ; is it NUL? | |
2101 bne L909E ; brif not | |
2102 ldx TEMPTR ; get string buffer start pointer | |
2103 lda #'% ; put error flag in front | |
2104 sta ,-x | |
2105 L90A9 rts | |
2106 L90AA cmpa #'0 ; zero? | |
2107 blo L90B2 ; brif not | |
2108 suba #'9+1 ; set C if > "9" | |
2109 suba #-('9+1) | |
2110 L90B2 rts | |
2111 L90B3 lda VD8 ; get right digit counter | |
2112 beq L90B8 ; brif not right digits | |
2113 deca ; account for decimal point | |
2114 L90B8 adda V47 ; add base 10 exponent offset | |
2115 bmi L90BD ; if >= 0, no shifts are required | |
2116 clra ; force shift counter to 0 | |
2117 L90BD pshs a ; save shift counter | |
2118 L90BF bpl L90CB ; brif positive count | |
2119 pshs a ; save shift counter | |
2120 jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right) | |
2121 puls a ; get shift counter back | |
2122 inca ; account for the shift | |
2123 bra L90BF ; see if we're done yet | |
2124 L90CB lda V47 ; get base 10 exponent offset | |
2125 suba ,s+ ; account for adjustment | |
2126 sta V47 ; save new exponent offset | |
2127 adda #9 ; account for significant places | |
2128 bmi L90EE ; brif we don't need zeroes to left | |
2129 lda VD9 ; get left decimal counter | |
2130 suba #9 ; account for significant figures | |
2131 suba V47 ; subtract exponent offset | |
2132 bsr L90EA ; output leading zeroes | |
2133 jsr L9263 ; initialize decimal and comma counters | |
2134 bra L90FF ; process remainder of digits | |
2135 L90E2 pshs a ; save zero counter | |
2136 lda #'0 ; insert a 0 | |
2137 sta ,u+ | |
2138 puls a ; get back counter | |
2139 L90EA deca ; do we need more zeroes? | |
2140 bpl L90E2 ; brif so | |
2141 rts | |
2142 L90EE lda VD9 ; get left digit counter | |
2143 bsr L90EA ; put that many zeroes in | |
2144 jsr L924D ; put decimal in buffer | |
2145 lda #-9 ; figure out filler zeroes | |
2146 suba V47 | |
2147 bsr L90EA ; output required leader zeroes | |
2148 clr V45 ; clear decimal pointer counter | |
2149 clr VD7 ; clear comma counter | |
2150 L90FF jsr L9202 ; decode FPA0 to decimal string | |
2151 lda VD8 ; get right digit counter | |
2152 bne L9108 ; brif there are right digits | |
2153 ldu VARPTR ; point to decimal location of decimal | |
2154 L9108 adda V47 ; add base 10 exponent | |
2155 lbra L9050 ; add in leading astrisks, etc. | |
2156 L910D lda FP0EXP ; get exponent of FPA0 | |
2157 pshs a ; save it | |
2158 beq L9116 ; brif 0 | |
2159 jsr L91CD ; convert to number with 9 figures | |
2160 L9116 lda VD8 ; get right digit counter | |
2161 beq L911B ; brif no right digits | |
2162 deca ; account for decimal point | |
2163 L911B adda VD9 ; get left digit counter | |
2164 clr STRBUF+3 ; use buffer byte as temporary storage | |
2165 ldb VDA ; get status flags | |
2166 andb #4 ; post-sign? | |
2167 bne L9129 ; brif so | |
2168 com STRBUF+3 ; flip byte if no post sign | |
2169 L9129 adda STRBUF+3 ; subtract 1 if no post sign | |
2170 suba #9 ; account for significant figures | |
2171 pshs a ; save shift counter | |
2172 L9130 bpl L913C ; brif no more shifts needed | |
2173 pshs a ; save counter | |
2174 jsr LBB82 ; divide by 10 (shift right one) | |
2175 puls a ; get back counter | |
2176 inca ; account for the shift | |
2177 bra L9130 ; see if we need more | |
2178 L913C lda ,s ; get original shift count | |
2179 bmi L9141 ; brif shifting happened | |
2180 clra ; flag for no shifting | |
2181 L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed) | |
2182 adda VD9 ; add left digit counter | |
2183 inca ; and post sign | |
2184 adda STRBUF+3 | |
2185 sta V45 ; save decimal counter | |
2186 clr VD7 ; clear comma counter | |
2187 jsr L9202 ; convert to decimal string | |
2188 puls a ; get shift counter | |
2189 jsr L9281 ; put the needed zeroes in | |
2190 lda VD8 ; get right digit counter | |
2191 bne L915A ; brif we want some | |
2192 leau -1,u ; remove te decimal point | |
2193 L915A ldb ,s+ ; get original exponent | |
2194 beq L9167 ; brif it was 0 | |
2195 ldb V47 ; get base 10 exponent | |
2196 addb #9 ; account for significant figures | |
2197 subb VD9 ; remove left digit count | |
2198 subb STRBUF+3 ; add one if post sign | |
2199 L9167 lda #'+ ; positive sign | |
2200 tstb ; is base 10 exponent positive? | |
2201 bpl L916F ; brif so | |
2202 lda #'- ; negative sign | |
2203 negb ; flip exponent | |
2204 L916F sta 1,u ; put exponent sign | |
2205 lda #'E ; put "E" and advance output pointer | |
2206 sta ,u++ | |
2207 lda #'0-1 ; initialize digit accumulator | |
2208 L9177 inca ; bump digit | |
2209 subb #10 ; are we at the right digit? | |
2210 bcc L9177 ; brif not | |
2211 addb #'0+10 ; add ASCII bias and undo extra subtraction | |
2212 std ,u++ ; save exponent in buffer | |
2213 clr ,u ; clear final byte in buffer | |
2214 jmp L9054 ; insert *, $, etc. | |
2215 L9185 ldx #STRBUF+4 ; point to start of result | |
2216 ldb ,x ; get sign | |
2217 pshs b ; save it | |
2218 lda #0x20 ; default pad with spaces | |
2219 ldb VDA ; get flags | |
2220 bitb #0x20 ; padding with *? | |
2221 puls b | |
2222 beq L919E ; brif no padding | |
2223 lda #'* ; pad with * | |
2224 cmpb #0x20 ; do we have a blank? (positive) | |
2225 bne L919E ; brif not | |
2226 tfr a,b ; use pad character | |
2227 L919E pshs b ; save first character | |
2228 L91A0 sta ,x+ ; store padding | |
2229 ldb ,x ; get next character | |
2230 beq L91B6 ; brif end of string | |
2231 cmpb #'E ; exponent? | |
2232 beq L91B6 ; brif so - treat as 0 | |
2233 cmpb #'0 ; zero? | |
2234 beq L91A0 ; brif so - pad it | |
2235 cmpb #', ; leading comma? | |
2236 beq L91A0 ; brif so - pad it | |
2237 cmpb #'. ; decimal? | |
2238 bne L91BA ; brif so - don't put a 0 before it | |
2239 L91B6 lda #'0 ; put a zero before | |
2240 sta ,-x | |
2241 L91BA lda VDA ; get status byte | |
2242 bita #0x10 ; floating $? | |
2243 beq L91C4 ; brif not | |
2244 ldb #'$ ; stuff a $ in | |
2245 stb ,-x | |
2246 L91C4 anda #4 ; pre-sgn? | |
2247 puls b ; get back first character | |
2248 bne L91CC ; brif not | |
2249 stb ,-x ; save leading character (sign) | |
2250 L91CC rts | |
2251 L91CD pshs u ; save buffer pointer | |
2252 clra ; initial exponent offset is 0 | |
2253 L91D0 sta V47 ; save exponent offset | |
2254 ldb FP0EXP ; get actual exponent | |
2255 cmpb #0x80 ; is value >= 1.0? | |
2256 bhi L91E9 ; brif so | |
2257 ldx #LBDC0 ; point to FP number 1E9 | |
2258 jsr LBACA ; multiply by 1000000000 | |
2259 lda V47 ; account for 9 shifts | |
2260 suba #9 | |
2261 bra L91D0 ; brif not there yet | |
2262 L91E4 jsr LBB82 ; divide by 10 | |
2263 inc V47 ; account for shift | |
2264 L91E9 ldx #LBDBB ; point to 999999999 | |
2265 jsr LBCA0 ; compare it | |
2266 bgt L91E4 ; brif not in range yet | |
2267 L91F1 ldx #LBDB6 ; point to 99999999.9 | |
2268 jsr LBCA0 ; compare | |
2269 bgt L9200 ; brif in range | |
2270 jsr LBB6A ; multiply by 10 | |
2271 dec V47 ; account for shift | |
2272 bra L91F1 ; see if we're in range yet | |
2273 L9200 puls u,pc ; restore buffer pointer and return | |
2274 L9202 pshs u ; save buffer pointer | |
2275 jsr LB9B4 ; add .5 (round off) | |
2276 jsr LBCC8 ; convert to integer format | |
2277 puls u ; restore buffer pointer | |
2278 ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs) | |
2279 ldb #0x80 ; intitial digit counter is 0 with 0x80 bias | |
2280 L9211 bsr L9249 ; check for comma | |
2281 L9213 lda FPA0+3 ; add a power of 10 | |
2282 adda 3,x | |
2283 sta FPA0+3 | |
2284 lda FPA0+2 | |
2285 adca 2,x | |
2286 sta FPA0+2 | |
2287 lda FPA0+1 | |
2288 adca 1,x | |
2289 sta FPA0+1 | |
2290 lda FPA0 | |
2291 adca ,x | |
2292 sta FPA0 | |
2293 incb ; add one to digit counter | |
2294 rorb ; set V if carry and sign differ | |
2295 rolb | |
2296 bvc L9213 ; brif we haven't "wrapped" | |
2297 bcc L9235 ; brif subtracting | |
2298 subb #10+1 ; take 9's complement if adding | |
2299 negb | |
2300 L9235 addb #'0-1 ; add in ASCII bias | |
2301 leax 4,x ; move to next power | |
2302 tfr b,a ; save digit | |
2303 anda #0x7f ; mask off subtract flag | |
2304 sta ,u+ ; save digit | |
2305 comb ; toggle add/subtract | |
2306 andb #0x80 | |
2307 cmpx #LBEE9 ; done all places? | |
2308 bne L9211 ; brif not | |
2309 clr ,u ; but NUL at end | |
2310 L9249 dec V45 ; at decimal? | |
2311 bne L9256 ; brif not | |
2312 L924D stu VARPTR ; save decimal point pointer | |
2313 lda #'. ; insert decimal | |
2314 sta ,u+ | |
2315 clr VD7 ; clear comma counter | |
2316 rts | |
2317 L9256 dec VD7 ; do we need a comma? | |
2318 bne L9262 ; brif not | |
2319 lda #3 ; reset comma counter | |
2320 sta VD7 | |
2321 lda #', ; insert comma | |
2322 sta ,u+ | |
2323 L9262 rts | |
2324 L9263 lda V47 ; get base 10 exponent offset | |
2325 adda #10 ; account for significant figures | |
2326 sta V45 ; save decimal counter | |
2327 inca ; add one for decimal point | |
2328 L926A suba #3 ; divide by 3, leave remainder in A | |
2329 bcc L926A | |
2330 adda #5 ; renormalize to range 1-3 | |
2331 sta VD7 ; save comma counter | |
2332 lda VDA ; get status | |
2333 anda #0x40 ; commas wanted? | |
2334 bne L927A ; brif not | |
2335 sta VD7 ; clear comma counter | |
2336 L927A rts | |
2337 L927B pshs a ; save zeroes counter | |
2338 bsr L9249 ; check for decimal | |
2339 puls a ; get back counter | |
2340 L9281 deca ; need a zero? | |
2341 bmi L928E ; brif not | |
2342 pshs a ; save counter | |
2343 lda #'0 ; put a zero | |
2344 sta ,u+ | |
2345 lda ,s+ ; get back counter and set flags | |
2346 bne L927B ; brif not done enough | |
2347 L928E rts | |
2348 ; From here to the end of the Extended Basic ROM is the PMODE graphics system and related | |
2349 ; infrastructure with the exception of the PLAY command which shares some of its machinery | |
2350 ; with the DRAW command. | |
2351 ; | |
2352 ; Fetch screen address calculation routine address for the selected graphics mode | |
2353 L928F ldu #L929C ; point to normalization routine jump table | |
2354 lda PMODE ; get graphics mode | |
2355 asla ; two bytes per address | |
2356 ldu a,u ; get routine address | |
2357 rts | |
2358 ; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A. | |
2359 L9298 bsr L928F ; fetch normalization routine pointer | |
2360 jmp ,u ; transfer control to it | |
2361 L929C fdb L92A6 ; PMODE 0 | |
2362 fdb L92C2 ; PMODE 1 | |
2363 fdb L92A6 ; PMODE 2 | |
2364 fdb L92C2 ; PMODE 3 | |
2365 fdb L92A6 ; PMODE 4 | |
2366 ; Two colour mode address calculatoin | |
2367 L92A6 pshs u,b ; savce registers | |
2368 ldb HORBYT ; get number of bytes in each graphics row | |
2369 lda VERBEG+1 ; get vertical coordinate | |
2370 mul | |
2371 addd BEGGRP ; now D is the absolute address of the start of the row | |
2372 tfr d,x ; get address to the return location | |
2373 ldb HORBEG+1 ; get horizontal coordinate | |
2374 lsrb ; divide by 8 (8 pixels per byte in 2 colour mode) | |
2375 lsrb | |
2376 lsrb | |
2377 abx ; now X is the address of the actual pixel byte | |
2378 lda HORBEG+1 ; get horizontal coordinate | |
2379 anda #7 ; keep only the low 3 bits which contain the pixel number | |
2380 ldu #L92DD ; point to pixel mask lookup | |
2381 lda a,u ; get pixel mask | |
2382 puls b,u,pc ; restore registers and return result | |
2383 ; four colour address calculation | |
2384 L92C2 pshs u,b ; save registers | |
2385 ldb HORBYT ; get bytes per graphics row | |
2386 lda VERBEG+1 ; get vertical coordinate | |
2387 mul | |
2388 addd BEGGRP ; now D is the address of the start of the row | |
2389 tfr d,x ; put it in returnlocatin | |
2390 ldb HORBEG+1 ; get horizontal coordinate | |
2391 lsrb ; divide by 4 (four colour modes have four pixels per byte) | |
2392 lsrb | |
2393 abx ; now X points to the screen byte | |
2394 lda HORBEG+1 ; get horizontal coordinate | |
2395 anda #3 ; keep low two bits for pixel number | |
2396 ldu #L92E5 ; point to four colour pixel masks | |
2397 lda a,u ; get pixel mask | |
2398 puls b,u,pc ; restore registers and return result | |
2399 L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks | |
2400 fcb 0x08,0x04,0x02,0x01 | |
2401 L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks | |
2402 ; Move X down one graphics row | |
2403 L92E9 ldb HORBYT ; get bytes per row | |
2404 abx ; add to screen address | |
2405 rts | |
2406 ; Move one pixel right in 2 colour mode | |
2407 L92ED lsra ; move pixel mask right | |
2408 bcc L92F3 ; brif same byte | |
2409 rora ; move pixel mask to left of byte | |
2410 leax 1,x ; move to next byte | |
2411 L92F3 rts | |
2412 ; Move one pixel right in 4 colour mode | |
2413 L92F4 lsra ; shift mask half a pixel right | |
2414 bcc L92ED ; brif not past end of byte - shift one more | |
2415 lda #0xc0 ; set mask on left of byte | |
2416 leax 1,x ; move to next byte | |
2417 rts | |
2418 ; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG. | |
2419 L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B | |
2420 ldy #HORBEG ; point to storage location | |
2421 L9303 cmpb #192 ; is vertical outside range? | |
2422 blo L9309 ; brif not | |
2423 ldb #191 ; max it at bottom of screen | |
2424 L9309 clra ; zero extend vertical coordinate | |
2425 std 2,y ; save vertical coordinate | |
2426 ldd BINVAL ; get horizontal coordinate | |
2427 cmpd #256 ; in range? | |
2428 blo L9317 ; brif so | |
2429 ldd #255 ; max it out to right side of screen | |
2430 L9317 std ,y ; save horizontal coordinate | |
2431 rts | |
2432 ; Normalize coordinates for proper PMODE | |
2433 L931A jsr L92FC ; parse coordinates | |
2434 L931D ldu #HORBEG ; point to start coordinates | |
2435 L9320 lda PMODE ; get graphics mode | |
2436 cmpa #2 ; is it pmode 0 or 1? | |
2437 bhs L932C ; brif not | |
2438 ldd 2,u ; get vertical coordinate | |
2439 lsra ; divide it by two | |
2440 rorb | |
2441 std 2,u ; save it back | |
2442 L932C lda PMODE ; get graphics mode | |
2443 cmpa #4 ; pmode 4? | |
2444 bhs L9338 ; brif so | |
2445 ldd ,u ; cut horizontal coordinate in half | |
2446 lsra | |
2447 rorb | |
2448 std ,u ; save new coordinate | |
2449 L9338 rts | |
2450 ; PPOINT function | |
2451 PPOINT jsr L93B2 ; evaluate two expressions (coordinates) | |
2452 jsr L931D ; normalize coordinates | |
2453 jsr L9298 ; get screen address | |
2454 anda ,x ; get colour value of desired screen coordinate | |
2455 ldb PMODE ; get graphics mode | |
2456 rorb ; is it a two colour m ode? | |
2457 bcc L935B ; brif so | |
2458 L9349 cmpa #4 ; is it on rightmost bits? | |
2459 blo L9351 ; brif not | |
2460 rora ; shift right | |
2461 rora | |
2462 bra L9349 ; see if we're there yet | |
2463 L9351 inca ; colour numbers start at 1 | |
2464 asla ; add in colour set (0 or 8) | |
2465 adda CSSVAL | |
2466 lsra ; get colour in range of 0 to 8 | |
2467 L9356 tfr a,b ; put result to B | |
2468 jmp LB4F3 ; return B as FP number | |
2469 L935B tsta ; is pixel on? | |
2470 beq L9356 ; brif not, return 0 (off) | |
2471 clra ; set colour number to "1" | |
2472 bra L9351 ; make it 1 or 5 and return | |
2473 ; PSET command | |
2474 PSET lda #1 ; PSET flag | |
2475 bra L9366 ; go turn on the pixel | |
2476 ; PRESET command | |
2477 PRESET clra ; PRESET flag | |
2478 L9366 sta SETFLG ; store whether we're setting or resetting | |
2479 jsr LB26A ; enforce ( | |
2480 jsr L931A ; evaluate coordinates | |
2481 jsr L9581 ; evaluate colour | |
2482 jsr LB267 ; enforce ) | |
2483 jsr L9298 ; get address of pixel | |
2484 L9377 ldb ,x ; get screen data | |
2485 pshs b ; save it | |
2486 tfr a,b ; duplicate pixel mask | |
2487 coma ; invert mask | |
2488 anda ,x ; turn off screen pixel | |
2489 andb ALLCOL ; adjust pixel mask to be the current colour | |
2490 pshs b ; merge pixel data into the screen data | |
2491 ora ,s+ | |
2492 sta ,x ; put it on screen | |
2493 suba ,s+ ; nonzero if screen data changed | |
2494 ora CHGFLG ; propagate change flag | |
2495 sta CHGFLG | |
2496 rts | |
2497 ; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and | |
2498 ; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF. | |
2499 L938F ldx HORDEF ; set default start coords | |
2500 stx HORBEG | |
2501 ldx VERDEF | |
2502 stx VERBEG | |
2503 cmpa #0xac ; do we start with a -? | |
2504 beq L939E ; brif no starting coordinates | |
2505 jsr L93B2 ; parse coordinates | |
2506 L939E ldb #0xac ; make sure we have a - | |
2507 jsr LB26F | |
2508 jsr LB26A ; require a ( | |
2509 jsr LB734 ; evaluate two expressions | |
2510 ldy #HOREND ; point to storage location | |
2511 jsr L9303 ; process coordinates | |
2512 bra L93B8 ; finish up with a ) | |
2513 L93B2 jsr LB26A ; make sure there's a ( | |
2514 jsr L92FC ; evaluate coordinates | |
2515 L93B8 jmp LB267 ; force a ) | |
2516 ; LINE command | |
2517 LINE cmpa #0x89 ; is it LINE INPUT? | |
2518 lbeq L89C0 ; brif so - go handle it | |
2519 cmpa #'( ; starting coord? | |
2520 beq L93CE ; brif so | |
2521 cmpa #0xac ; leading -? | |
2522 beq L93CE ; brif so | |
2523 ldb #'@ ; if it isn't the above, make sure it's @ | |
2524 jsr LB26F | |
2525 L93CE jsr L938F ; parse coordinates | |
2526 ldx HOREND ; set ending coordinates as the defaults | |
2527 stx HORDEF | |
2528 ldx VEREND | |
2529 stx VERDEF | |
2530 jsr SYNCOMMA ; make sure we have a comma | |
2531 cmpa #0xbe ; PRESET? | |
2532 beq L93E9 ; brif so | |
2533 cmpa #0xbd ; PSET? | |
2534 lbne LB277 ; brif not | |
2535 ldb #01 ; PSET flag | |
2536 skip1lda ; skip byte and set A nonzero | |
2537 L93E9 clrb ; PRESET flag | |
2538 pshs b ; save PSET/PRESET flag | |
2539 jsr GETNCH ; eat the PSET/PRESET | |
2540 jsr L9420 ; normalize coordinates | |
2541 puls b ; get back PSET/PRESET flag | |
2542 stb SETFLG ; flag which we're doing | |
2543 jsr L959A ; set colour byte | |
2544 jsr GETCCH ; get next bit | |
2545 lbeq L94A1 ; brif no box option | |
2546 jsr SYNCOMMA ; make sure it's comma | |
2547 ldb #'B ; make sure "B" for "box" | |
2548 jsr LB26F | |
2549 bne L9429 ; brif something follows the B | |
2550 bsr L9444 ; draw horizontal line | |
2551 bsr L946E ; draw vertical line | |
2552 ldx HORBEG ; save horizontal coordinate | |
2553 pshs x ; save it | |
2554 ldx HOREND ; switch in horizontal end | |
2555 stx HORBEG | |
2556 bsr L946E ; draw vertical line | |
2557 puls x ; get back original start | |
2558 stx HORBEG ; put it back | |
2559 ldx VEREND ; do the same dance with the vertical end | |
2560 stx VERBEG | |
2561 bra L9444 ; draw horizontal line | |
2562 L9420 jsr L931D ; normalize the start coordinates | |
2563 ldu #HOREND ; point to end coords | |
2564 jmp L9320 ; normalize those coordinates | |
2565 L9429 ldb #'F ; make sure we have "BF" for "filled box" | |
2566 jsr LB26F | |
2567 bra L9434 ; fill the box | |
2568 L9430 leax -1,x ; move vertical coordinate up one | |
2569 L9432 stx VERBEG ; save new vertical coordinate | |
2570 L9434 jsr L9444 ; draw a horizontal line | |
2571 ldx VERBEG ; are we at the end of the box? | |
2572 cmpx VEREND | |
2573 beq L9443 ; brif so | |
2574 bcc L9430 ; brif we're moving up the screen | |
2575 leax 1,x ; move down the screen | |
2576 bra L9432 ; go draw another line | |
2577 L9443 rts | |
2578 ; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL | |
2579 L9444 ldx HORBEG ; get starting horizontal coordinate | |
2580 pshs x ; save it | |
2581 jsr L971D ; get absolute value of HOREND-HORBEG | |
2582 bcc L9451 ; brif end is > start | |
2583 ldx HOREND ; copy end coordinate to start it is smaller | |
2584 stx HORBEG | |
2585 L9451 tfr d,y ; save difference - it's a pixel count | |
2586 leay 1,y ; coordinates are inclusive | |
2587 jsr L9298 ; get screen position of start coord | |
2588 puls u ; restore original start coordinate | |
2589 stu HORBEG | |
2590 bsr L9494 ; point to routine to move pizel pointers to right | |
2591 L945E sta VD7 ; save pixel mask | |
2592 jsr L9377 ; turn on pixel | |
2593 lda VD7 ; get pixel mask back | |
2594 jsr ,u ; move one pixel right | |
2595 leay -1,y ; turned on enough pixels yet? | |
2596 bne L945E ; brif not | |
2597 L946B rts | |
2598 L946C puls b,a ; clean up stack | |
2599 L946E ldd VERBEG ; save original vertical start coordinate | |
2600 pshs b,a | |
2601 jsr L9710 ; get vertical difference | |
2602 bcc L947B ; brif end coordinate > start | |
2603 ldx VEREND ; swap in end coordinate if not | |
2604 stx VERBEG | |
2605 L947B tfr d,y ; save number of pixels to set | |
2606 leay 1,y ; the coordinates are inclusive | |
2607 jsr L9298 ; get screen pointer | |
2608 puls u ; restore start coordinate | |
2609 stu VERBEG | |
2610 bsr L949D ; point to routine to move down one row | |
2611 bra L945E ; draw vertical line | |
2612 ; Point to routine which will move one pixel right | |
2613 L948A fdb L92ED ; PMODE 0 | |
2614 fdb L92F4 ; PMODE 1 | |
2615 fdb L92ED ; PMODE 2 | |
2616 fdb L92F4 ; PMODE 3 | |
2617 fdb L92ED ; PMODE 4 | |
2618 L9494 ldu #L948A ; point to jump table | |
2619 ldb PMODE ; get graphics mode | |
2620 aslb ; two bytes per address | |
2621 ldu b,u ; get jump address | |
2622 rts | |
2623 ; Point to routine to move down one row | |
2624 L949D ldu #L92E9 ; point to "move down one row" routien | |
2625 rts | |
2626 ; Draw a line from HORBEG,VERBEG to HOREND,VEREND | |
2627 L94A1 ldy #L950D ; point to increase vertical coord | |
2628 jsr L9710 ; calculate difference | |
2629 lbeq L9444 ; brif none - draw a horizontal line | |
2630 bcc L94B2 ; brif vertical end is > vertical start | |
2631 ldy #L951B ; point to decrease vertical coord | |
2632 L94B2 pshs d ; save vertical difference | |
2633 ldu #L9506 ; point to increase horizontal coord | |
2634 jsr L971D ; get difference | |
2635 beq L946C ; brif none - draw a vertical line | |
2636 bcc L94C1 ; brif horizontal end > horizontal start | |
2637 ldu #L9514 ; point to decrease hoizontal coord | |
2638 L94C1 cmpd ,s ; compare vert and horiz differences | |
2639 puls x ; get X difference | |
2640 bcc L94CC ; brif horiz diff > vert diff | |
2641 exg u,y ; swap change routine pointers | |
2642 exg d,x ; swap differences | |
2643 L94CC pshs u,d ; save larger difference and routine | |
2644 pshs d ; save larger difference | |
2645 lsra ; divide by two | |
2646 rorb | |
2647 bcs L94DD ; brif odd number | |
2648 cmpu #L950D+1 ; increase or decrease? | |
2649 blo L94DD ; brif increase | |
2650 subd #1 ; back up one | |
2651 L94DD pshs x,b,a ; save smallest difference and initial middle offset | |
2652 jsr L928F ; point to proper coordinate to screen conversion routine | |
2653 L94E2 jsr ,u ; convert coordinates to screen address | |
2654 jsr L9377 ; turn on a pixel | |
2655 ldx 6,s ; get distnace counter | |
2656 beq L9502 ; brif line is completely drawn | |
2657 leax -1,x ; account for one pixel drawn | |
2658 stx 6,s ; save new counter | |
2659 jsr [8,s] ; increment/decrement larger delta | |
2660 ldd ,s ; get the minor coordinate increment counter | |
2661 addd 2,s ; add the smallest difference | |
2662 std ,s ; save new minor coordinate incrementcounter | |
2663 subd 4,s ; subtractout the largest difference | |
2664 bcs L94E2 ; brif not greater - draw another pixel | |
2665 std ,s ; save new minor coordinate increment | |
2666 jsr ,y ; adjust minor coordinate | |
2667 bra L94E2 ; go draw another pixel | |
2668 L9502 puls x ; clean up stack and return | |
2669 puls a,b,x,y,u,pc | |
2670 L9506 ldx HORBEG ; bump horizontal coordinate | |
2671 leax 1,x | |
2672 stx HORBEG | |
2673 rts | |
2674 L950D ldx VERBEG ; bump vertical coordinate | |
2675 leax 1,x | |
2676 stx VERBEG | |
2677 rts | |
2678 L9514 ldx HORBEG ; decrement horizontal coordinate | |
2679 leax -1,x | |
2680 stx HORBEG | |
2681 rts | |
2682 L951B ldx VERBEG ; decrement vertical coordinate | |
2683 leax -1,x | |
2684 stx VERBEG | |
2685 rts | |
2686 ; Get normalized maximum coordinate values in VD3 and VD5 | |
2687 L9522 ldu #VD3 ; point to temp storage | |
2688 ldx #255 ; set maximum horizontal | |
2689 stx ,u | |
2690 ldx #191 ; set maximum vertical | |
2691 stx 2,u | |
2692 jmp L9320 ; normalize them | |
2693 ; PCLS command | |
2694 PCLS beq L9542 ; clear to background colour if no argument | |
2695 bsr L955A ; evaluate colour | |
2696 L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles | |
2697 mul ; now colour is in all four sub-pixels | |
2698 ldx BEGGRP ; get start of graphics screen | |
2699 L953B stb ,x+ ; set byte to proper colour | |
2700 cmpx ENDGRP ; at end of graphics page? | |
2701 bne L953B ; brif not | |
2702 rts | |
2703 L9542 ldb BAKCOL ; get background colour | |
2704 bra L9536 ; do the clearing dance | |
2705 ; COLOR command | |
2706 COLOR cmpa #', ; check for comma | |
2707 beq L9552 ; brif no foreground colour | |
2708 bsr L955A ; evaluate first colour | |
2709 stb FORCOL ; set foreground colour | |
2710 jsr GETCCH ; is there a background colour? | |
2711 beq L9559 ; brif not | |
2712 L9552 jsr SYNCOMMA ; make sure we have a comma | |
2713 bsr L955A ; evaluate background colour argument | |
2714 stb BAKCOL ; set background colour | |
2715 L9559 rts | |
2716 ; Evaluate a colour agument and convert to proper code based on graphics mode | |
2717 L955A jsr EVALEXPB ; evaluate colour code | |
2718 L955D cmpb #9 ; is it in range of 0-8? | |
2719 lbhs LB44A ; brif not - raise error | |
2720 clra ; CSS value for first colour set | |
2721 cmpb #5 ; is it first or second colour set? | |
2722 blo L956C ; brif first colour set | |
2723 lda #8 ; flag second colour set | |
2724 subb #4 ; adjust into basic range | |
2725 L956C pshs a ; save CSS value | |
2726 lda PMODE ; get graphics mode | |
2727 rora ; 4 colour or 2? | |
2728 bcc L957B ; brif 2 colour | |
2729 tstb ; was it 0? | |
2730 bne L9578 ; brif not | |
2731 L9576 ldb #4 ; if so, make it 4 | |
2732 L9578 decb ; convert to zero based | |
2733 L9579 puls a,pc ; get back CSS value and return | |
2734 L957B rorb ; is colour number odd? | |
2735 bcs L9576 ; brif so - force all bits set colour | |
2736 clrb ; force colour 0 if not | |
2737 bra L9579 | |
2738 ; Set all pixel byte and active colour | |
2739 L9581 jsr L959A ; set colour byte | |
2740 jsr GETCCH ; is there something to evaluate? | |
2741 beq L9598 ; brif not | |
2742 cmpa #') ; )? | |
2743 beq L9598 ; brif so | |
2744 jsr SYNCOMMA ; force comma | |
2745 cmpa #', ; another comma? | |
2746 beq L9598 ; brif so | |
2747 jsr L955A ; evaluate expression and return colour | |
2748 bsr L95A2 ; save colour and pixel byte | |
2749 L9598 jmp GETCCH ; re-fetch input character and return | |
2750 L959A ldb FORCOL ; use foreground colour by default | |
2751 tst SETFLG ; doing PRESET? | |
2752 bne L95A2 ; brif not | |
2753 ldb BAKCOL ; default to background colour | |
2754 L95A2 stb WCOLOR ; save working colour | |
2755 lda #0x55 ; consider a byte as 4 pixels | |
2756 mul ; now all pixels are set to the same bit pattern | |
2757 stb ALLCOL ; set all pixels byte | |
2758 rts | |
2759 L95AA bne L95CF ; brif graphics mode | |
2760 L95AC pshs x,b,a ; save registers | |
2761 ldx #SAMREG+8 ; point to middle of control register | |
2762 sta 10,x ; reset display page to 0x400 | |
2763 sta 8,x | |
2764 sta 6,x | |
2765 sta 4,x | |
2766 sta 2,x | |
2767 sta 1,x | |
2768 sta -2,x | |
2769 sta -4,x ; reset to alpha mode | |
2770 sta -6,x | |
2771 sta -8,x | |
2772 lda PIA1+2 ; set VDG to alpha mode, colour set 0 | |
2773 anda #7 | |
2774 sta PIA1+2 | |
2775 puls a,b,x,pc ;restore registers and return | |
2776 L95CF pshs x,b,a ; save registers | |
2777 lda PMODE ; get graphics mode | |
2778 adda #3 ; offset to 3-7 (we don't use the bottom 3 modes) | |
2779 ldb #0x10 ; shift to high 4 bits | |
2780 mul | |
2781 orb #0x80 ; set to graphics mode | |
2782 orb CSSVAL ; set the desired colour set | |
2783 lda PIA1+2 ; get get original PIA values | |
2784 anda #7 ; mask off VDG control | |
2785 pshs a ; merge with new VDG control | |
2786 orb ,s+ | |
2787 stb PIA1+2 ; set new VDG mode | |
2788 lda BEGGRP ; get start of graphics page | |
2789 lsra ; divide by two - pages are on 512 byte boundaries | |
2790 jsr L960F ; set SAM control register | |
2791 lda PMODE ; get graphics mode | |
2792 adda #3 ; shift to VDG values | |
2793 cmpa #7 ; PMODE 4? | |
2794 bne L95F7 ; brif not | |
2795 deca ; treat PMODE 4 the same as PMODE 3 | |
2796 L95F7 bsr L95FB ; program SAM's VDG bits | |
2797 puls a,b,x,pc ; restore registers and return | |
2798 L95FB ldb #3 ; set 3 bits in register | |
2799 ldx #SAMREG ; point to VDG control bits | |
2800 L9600 rora ; get bit to set | |
2801 bcc L9607 ; brif we need to clear the bit | |
2802 sta 1,x ; set the bit | |
2803 bra L9609 | |
2804 L9607 sta ,x ; clear the bit | |
2805 L9609 leax 2,x ; move to next bit | |
2806 decb ; done all bits? | |
2807 bne L9600 ; brif not | |
2808 rts | |
2809 L960F ldb #7 ; 7 screen address bits | |
2810 ldx #SAMREG+6 ; point to screen address bits in SAM | |
2811 bra L9600 ; go program SAM bits | |
2812 L9616 lda PIA1+2 ; get VDG bits | |
2813 anda #0xf7 ; keep everything but CSS bit | |
2814 ora CSSVAL ; set correct CSS bit | |
2815 sta PIA1+2 ; set desired CSS | |
2816 rts | |
2817 ; PMODE command | |
2818 PMODETOK cmpa #', ; is first argument missing? | |
2819 beq L9650 ; brif so | |
2820 jsr EVALEXPB ; evaluate PMODE number | |
2821 cmpb #5 ; valid (0-4)? | |
2822 bhs L966D ; brif not | |
2823 lda GRPRAM ; get start of graphics memory | |
2824 L962E sta BEGGRP ; set start of graphics page | |
2825 aslb ; multiply mode by two (table has two bytes per entry) | |
2826 ldu #L9706+1 ; point to lookup table | |
2827 adda b,u ; add in number of 256 byte pages used for graphics screen | |
2828 cmpa TXTTAB ; does it fit? | |
2829 bhi L966D ; brif not | |
2830 sta ENDGRP ; save end of graphics | |
2831 leau -1,u ; point to bytes per horizontal row | |
2832 lda b,u ; get bytes per row | |
2833 sta HORBYT ; set it | |
2834 lsrb ; restore PMODE value | |
2835 stb PMODE ; set graphics mode | |
2836 clra ; set background colour to 0 | |
2837 sta BAKCOL | |
2838 lda #3 ; set foreground colour to maximum (3) | |
2839 sta FORCOL | |
2840 jsr GETCCH ; is there a starting page number? | |
2841 beq L966C ; brif not | |
2842 L9650 jsr LB738 ; evaluate an expression following a comma | |
2843 tstb ; page 0? | |
2844 beq L966D ; brif so - not valid | |
2845 decb ; zero-base it | |
2846 lda #6 ; each graphics page is 6*256 | |
2847 mul | |
2848 addb GRPRAM ; add to start of graphics memory | |
2849 pshs b ; save start of screen memory | |
2850 addb ENDGRP ; add current and address | |
2851 subb BEGGRP ; subtract current start (adds size of screen) | |
2852 cmpb TXTTAB ; does it fit? | |
2853 bhi L966D ; brif not | |
2854 stb ENDGRP ; save new end of graphics | |
2855 puls b ; get back start of graphics | |
2856 stb BEGGRP ; set start of graphics | |
2857 L966C rts | |
2858 L966D jmp LB44A ; raise FC error | |
2859 ; SCREEN command | |
2860 SCREEN cmpa #', ; is there a mode? | |
2861 beq L967F ; brif no mode | |
2862 jsr EVALEXPB ; get mode argument | |
2863 tstb ; set Z if alpha | |
2864 jsr L95AA ; set SAM/VDG for graphics mode | |
2865 jsr GETCCH ; is there a second argument? | |
2866 beq L966C ; brif not | |
2867 L967F jsr LB738 ; evaluate ,<expr> | |
2868 tstb ; colour set 0? | |
2869 beq L9687 ; brif so | |
2870 ldb #8 ; flag for colour set 1 | |
2871 L9687 stb CSSVAL ; set colour set | |
2872 bra L9616 ; set up VDG | |
2873 ; PCLEAR command | |
2874 PCLEAR jsr EVALEXPB ; evaulate number of pages requested | |
2875 tstb ; 0? | |
2876 beq L966D ; brif zero - not allowed | |
2877 cmpb #9 ; more than 8? | |
2878 bhs L966D ; brif so - not allowed | |
2879 lda #6 ; there are 6 "pages" per graphics page | |
2880 mul ; now B is the number of pages to reserve | |
2881 addb GRPRAM ; add to start of graphics memory | |
2882 tfr b,a ; now A is the MSB of the start of free memory | |
2883 ldb #1 ; program memory always starts one above | |
2884 tfr d,y ; save pointer to program memory | |
2885 cmpd ENDGRP ; are we trying to deallocate the current graphics page? | |
2886 blo L966D ; brif so (note that this prevents PCLEAR 0 anyway) | |
2887 subd TXTTAB ; subtract out current start of basic program | |
2888 addd VARTAB ; add in end of program - now D is new top of program | |
2889 tfr d,x ; save new end of program | |
2890 inca ; make some extra space (for stack) | |
2891 subd FRETOP ; see if new top of program fits | |
2892 bhs L966D ; brif there isn't enough space | |
2893 jsr L80D0 ; adjust input pointer | |
2894 nop ; space filler for 1.1 patch (the JSR above) | |
2895 ldu VARTAB ; get end of program | |
2896 stx VARTAB ; save new end of program | |
2897 cmpu VARTAB ; is old end higher? | |
2898 bhs L96D4 ; brif so | |
2899 L96BD lda ,-u ; copy a byte upward | |
2900 sta ,-x | |
2901 cmpu TXTTAB ; at beginning? | |
2902 bne L96BD ; brif not | |
2903 sty TXTTAB ; save new start of program | |
2904 clr -1,y ; there must always be a NUL before the program | |
2905 L96CB jsr LACEF ; re-assign basic program addresses | |
2906 jsr LAD26 ; reset variables and stack | |
2907 jmp LAD9E ; return to interpretation loop | |
2908 L96D4 ldu TXTTAB ; get start of program | |
2909 sty TXTTAB ; save new start of program | |
2910 clr -1,y ; there must be a NUL at the start of the program | |
2911 L96DB lda ,u+ ; move a byte downward | |
2912 sta ,y+ | |
2913 cmpy VARTAB ; at the top of the program? | |
2914 bne L96DB ; brif not | |
2915 bra L96CB ; finish up | |
2916 ; Graphics initialization routine - this really should be up at the start of the ROM with the | |
2917 ; rest of the initialization code. | |
2918 L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4") | |
2919 stb TXTTAB | |
2920 lda #6 ; graphics memory starts immediately after the screen | |
2921 L96EC sta GRPRAM ; set graphics memory start | |
2922 sta BEGGRP ; set start of current graphics page | |
2923 clra ; set PMODE to 0 | |
2924 sta PMODE | |
2925 lda #16 ; 16 bytes per graphics row | |
2926 sta HORBYT | |
2927 lda #3 ; set foreground colour to 3 | |
2928 sta FORCOL | |
2929 lda #0x0c ; set ending graphics page (for PMODE 0) | |
2930 sta ENDGRP | |
2931 ldx TXTTAB ; get start of program | |
2932 clr -1,x ; make sure there's a NUL before it | |
2933 L9703 jmp LAD19 ; do a "NEW" | |
2934 ; PMODE data table (bytes per row and number of 256 byte pages required for a screen) | |
2935 L9706 fcb 16,6 ; PMODE 0 | |
2936 fcb 32,12 ; PMODE 1 | |
2937 fcb 16,12 ; PMODE 2 | |
2938 fcb 32,24 ; PMODE 3 | |
2939 fcb 32,24 ; PMODE 4 | |
2940 ; Calculate absolute value of vertical coordinate difference | |
2941 L9710 ldd VEREND ; get ending address | |
2942 subd VERBEG ; get difference | |
2943 L9714 bcc L9751 ; brif we didn't carry | |
2944 pshs cc ; save status (C set if start > end) | |
2945 jsr L9DC3 ; negate the difference to be positive | |
2946 puls cc,pc ; restore C and return | |
2947 ; Calculate absolute value of horizontal coordinate difference | |
2948 L971D ldd HOREND ; get end coordinate | |
2949 subd HORBEG ; calculate difference | |
2950 bra L9714 ; turn into absolute value | |
2951 ; PCOPY command | |
2952 PCOPY bsr L973F ; fetch address of the source page | |
2953 pshs d ; save address | |
2954 ldb #0xa5 ; make sure we have TO | |
2955 jsr LB26F | |
2956 bsr L973F ; fetch address of the second page | |
2957 puls x ; get back source | |
2958 tfr d,u ; put destination into a pointer | |
2959 ldy #0x300 ; 0x300 words to copy | |
2960 L9736 ldd ,x++ ; copy a word | |
2961 std ,u++ | |
2962 leay -1,y ; done? | |
2963 bne L9736 ; brif not | |
2964 rts | |
2965 L973F jsr EVALEXPB ; evaluate page number | |
2966 tstb ; zero? | |
2967 beq L9752 ; brif invalid page number | |
2968 ; BUG: this should be deferred until after the address is calculated at which point it should | |
2969 ; be bhs instead of bhi. There should also be a check to make sure the page number is less than | |
2970 ; or equal to 8 above so we don't have to test for overflows below. | |
2971 cmpb TXTTAB ; is page number higher than start of program (BUG!) | |
2972 bhi L9752 ; brif so - error | |
2973 decb ; zero-base the page number | |
2974 lda #6 ; 6 "pages" per graphics page | |
2975 mul ; now we have proper number of "pages" for the offset | |
2976 addb GRPRAM ; add start of graphics memory | |
2977 exg a,b ; put MSB into A, 0 into B. | |
2978 L9751 rts | |
2979 L9752 jmp LB44A ; raise illegal function call | |
2980 ; GET command | |
2981 GET clrb ; GET flag | |
2982 bra L975A ; go on to the main body | |
2983 PUT ldb #1 ; PUT flag | |
2984 L975A stb VD8 ; save GET/PUT flag | |
2985 jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing) | |
2986 L975F cmpa #'@ ; @ before coordinates? | |
2987 bne L9765 ; brif not | |
2988 jsr GETNCH ; eat the @ | |
2989 L9765 jsr L938F ; evaluate start/end coordinates | |
2990 jsr SYNCOMMA ; make sure we have a comma | |
2991 jsr L98CC ; get pointer to array | |
2992 tfr X,D ; save descriptor pointer | |
2993 ldu ,x ; get offset to next descriptor | |
2994 leau -2,u ; move back to array name | |
2995 leau d,u ; point to end of array | |
2996 stu VD1 ; save end of data | |
2997 leax 2,x ; point to number of dimensions | |
2998 ldb ,x ; get dimension count | |
2999 aslb ; two bytes per dimension size | |
3000 abx ; now X points to start of data | |
3001 stx VCF ; save start of array data | |
3002 lda VALTYP ; is it numeric | |
3003 bne L9752 ; brif not | |
3004 clr VD4 ; set default graphic action to PSET | |
3005 jsr GETCCH ; get input character | |
3006 beq L97B7 ; brif no action flag | |
3007 com VD4 ; flag action enabled | |
3008 jsr SYNCOMMA ; make sure there's a comma | |
3009 tst VD8 ; PUT? | |
3010 bne L979A ; brif so | |
3011 ldb #'G ; check for full graphics option | |
3012 jsr LB26F | |
3013 bra L97CA ; handle the rest of the process | |
3014 L979A ldb #5 ; 5 legal actions for PUT | |
3015 ldx #L9839 ; point to action table | |
3016 L979F ldu ,x++ ; get "clear bit" action routine | |
3017 ldy ,x++ ; get "set bit" action routine | |
3018 cmpa ,x+ ; does token match? | |
3019 beq L97AE ; brif so | |
3020 decb ; checked all? | |
3021 bne L979F ; brif not | |
3022 jmp LB277 ; raise error | |
3023 L97AE sty VD5 ; save set bit action address | |
3024 stu VD9 ; save clear bit action address | |
3025 jsr GETNCH ; munch the acton token | |
3026 bra L97CA ; handle rest of process | |
3027 L97B7 ldb #0xf8 ; mask for bottom three bits | |
3028 lda PMODE ; get graphics mode | |
3029 rora ; odd number mode? | |
3030 bcc L97C0 ; brif even | |
3031 ldb #0xfc ; bottom 2 bits mask | |
3032 L97C0 tfr b,a ; save mask | |
3033 andb HORBEG+1 ; round down the start address | |
3034 stb HORBEG+1 | |
3035 anda HOREND+1 ; round down end address | |
3036 sta HOREND+1 | |
3037 L97CA jsr L971D ; get horizontal size | |
3038 bcc L97D3 ; brif end > start | |
3039 ldx HOREND ; switch end in for start | |
3040 stx HORBEG | |
3041 L97D3 std HOREND ; save size | |
3042 jsr L9710 ; calculate vertical size | |
3043 bcc L97DE ; brif end > start | |
3044 ldx VEREND ; swap in vertical end for the start | |
3045 stx VERBEG | |
3046 L97DE std VEREND ; save vertical size | |
3047 lda PMODE ; get graphics mode | |
3048 rora ; even? | |
3049 ldd HOREND ; get difference | |
3050 bcc L97EB ; brif even (2 colour) | |
3051 addd HOREND ; add in size (double it) | |
3052 std HOREND ; save adjusted end size | |
3053 L97EB jsr L9420 ; normalize differences | |
3054 ldd HOREND ; get end coord | |
3055 ldx VEREND ; get end size | |
3056 leax 1,x ; make vertical size inclusive | |
3057 stx VEREND ; save it back | |
3058 tst VD4 ; got "G" or GET action | |
3059 bne L9852 ; brif given | |
3060 lsra ; we're going for whole bytes here | |
3061 rorb | |
3062 lsra | |
3063 rorb | |
3064 lsra | |
3065 rorb | |
3066 addd #1 ; make it inclusive | |
3067 std HOREND ; save new coordinate | |
3068 jsr L9298 ; convert to screen address | |
3069 L9808 ldb HOREND+1 ; get horizontal size | |
3070 pshs x ; save screen position | |
3071 L980C tst VD8 ; get/put flag | |
3072 beq L9831 ; brif get | |
3073 bsr L9823 ; bump array data pointer | |
3074 lda ,u ; copy data from array to screen | |
3075 sta ,x+ | |
3076 L9816 decb ; are we done the row? | |
3077 bne L980C ; brif not | |
3078 puls x ; get screen address | |
3079 jsr L92E9 ; move to next row | |
3080 dec VEREND+1 ; done? | |
3081 bne L9808 ; brif not | |
3082 L9822 rts | |
3083 L9823 ldu VCF ; get array data location | |
3084 leau 1,u ; bump it | |
3085 stu VCF ; save new array data location | |
3086 cmpu VD1 ; did we hit the end of the array? | |
3087 bne L9822 ; brif not | |
3088 L982E jmp LB44A ; raise function call error | |
3089 L9831 lda ,x+ ; get data from screen | |
3090 bsr L9823 ; bump array data pointer | |
3091 sta ,u ; put data in array | |
3092 bra L9816 ; do the loopy thing | |
3093 ; PUT actions | |
3094 L9839 fdb L9894,L989B ; PSET | |
3095 fcb 0xbd | |
3096 fdb L989B,L9894 ; PRESET | |
3097 fcb 0xbe | |
3098 fdb L98B1,L989B ; OR | |
3099 fcb 0xb1 | |
3100 fdb L9894,L98B1 ; AND | |
3101 fcb 0xb0 | |
3102 fdb L98A1,L98A1 ; NOT | |
3103 fcb 0xa8 | |
3104 L9852 addd #1 ; add to horiz difference | |
3105 std HOREND ; save it | |
3106 lda VD8 ; PUT? | |
3107 bne L9864 ; brif so | |
3108 ldu VD1 ; get end of array | |
3109 L985D sta ,-u ; zero out a byte | |
3110 cmpu VCF ; done? | |
3111 bhi L985D ; brif not | |
3112 L9864 jsr L9298 ; get screen address | |
3113 ldb PMODE ; get graphics mode | |
3114 rorb ; even? | |
3115 bcc L986E ; brif so | |
3116 anda #0xaa ; use as pixel mask for 4 colour mode | |
3117 L986E ldb #1 ; set bit probe | |
3118 ldy VCF ; point to start of array data | |
3119 L9873 pshs x,a ; save screen address | |
3120 ldu HOREND ; get horizontal size | |
3121 L9877 pshs u,a ; save horizontal size and pixel mask | |
3122 lsrb ; move bit probe right | |
3123 bcc L9884 ; brif we didn't fall off a byte | |
3124 rorb ; shift carry back in on the left | |
3125 leay 1,y ; move ahead a byte in the array | |
3126 cmpy VD1 ; end of array data? | |
3127 beq L982E ; raise error if so | |
3128 L9884 tst VD8 ; PUT? | |
3129 beq L98A7 ; brif not | |
3130 bitb ,y ; test bit in array | |
3131 beq L9890 ; brif not set | |
3132 jmp [VD5] ; do action routine for bit set | |
3133 L9890 jmp [VD9] ; do action routine for bit clear | |
3134 L9894 coma ; invert mask | |
3135 anda ,x ; read screen data and reset the desired bit | |
3136 sta ,x ; save on screen | |
3137 bra L98B1 | |
3138 L989B ora ,x ; merge pixel mask with screen data (turn on bit) | |
3139 sta ,x ; save on screen | |
3140 bra L98B1 | |
3141 L98A1 eora ,x ; invert the pixel in the screen data | |
3142 sta ,x ; save on screen | |
3143 bra L98B1 | |
3144 L98A7 bita ,x ; is the bit set? | |
3145 beq L98B1 ; brif not - do nothing | |
3146 tfr b,a ; get bit probe | |
3147 ora ,y ; turn on proper bit in data | |
3148 sta ,y | |
3149 L98B1 puls a,u ; get back array address | |
3150 jsr L92ED ; move screen address to the right | |
3151 leau -1,u ; account for consumed pixel | |
3152 cmpu ZERO ; done yet? | |
3153 bne L9877 ; brif not | |
3154 ldx 1,s ; get start of row back | |
3155 lda HORBYT ; get number of bytes per row | |
3156 leax a,x ; move ahead one line | |
3157 puls a ; get back screen pixel mask | |
3158 leas 2,s ; lose the screen pointer | |
3159 dec VEREND+1 ; done all rows? | |
3160 bne L9873 ; brif not | |
3161 rts | |
3162 L98CC jsr LB357 ; evaluate a variable | |
3163 ldb ,-x ; get variable name | |
3164 lda ,-x | |
3165 tfr d,u ; save it | |
3166 ldx ARYTAB ; get start of arrays | |
3167 L98D7 cmpx ARYEND ; end of arrays? | |
3168 lbeq LB44A ; brif not found | |
3169 cmpu ,x ; correct variable? | |
3170 beq L98E8 ; brif so | |
3171 ldd 2,x ; get array size | |
3172 leax d,x ; move to next array | |
3173 bra L98D7 ; check this array | |
3174 L98E8 leax 2,x ; move pointer to the array header | |
3175 rts ; obviously this rts is not needed | |
3176 L98EB rts | |
3177 ; PAINT command | |
3178 PAINT cmpa #'@ ; do we have @ before coords? | |
3179 bne L98F2 ; brif not | |
3180 jsr GETNCH ; eat the @ | |
3181 L98F2 jsr L93B2 ; evaluate coordinates | |
3182 jsr L931D ; normalize coordinates | |
3183 lda #1 ; PSET flag (use working colour) | |
3184 sta SETFLG | |
3185 jsr L9581 ; parse colour and set working colour, etc. | |
3186 ldd WCOLOR ; get working colour and all pixels byte | |
3187 pshs d ; save them | |
3188 jsr GETCCH ; is there anything else? | |
3189 beq L990A ; brif not | |
3190 jsr L9581 ; evaluate border colour | |
3191 L990A lda ALLCOL ; get border colour all pixel byte | |
3192 sta VD8 ; save border colour pixel byte | |
3193 puls d ; get back working colour details | |
3194 std WCOLOR | |
3195 clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding | |
3196 pshs u,x,b,a | |
3197 jsr L9522 ; set up starting coordinates | |
3198 jsr L928F ; point to pixel mask routine | |
3199 stu VD9 ; save pixel mask routine | |
3200 jsr L99DF ; paint from current horizontal coordinate to zero (left) | |
3201 beq L9931 ; brif hit border immediately | |
3202 jsr L99CB ; paint from current horizontal coordinate upward (right) | |
3203 lda #1 ; set direction to "down" | |
3204 sta VD7 | |
3205 jsr L99BA ; save "down" frame | |
3206 neg VD7 ; set direction to "up" | |
3207 jsr L99BA ; save "up" frame | |
3208 L9931 sts TMPSTK ; save stack pointer | |
3209 L9934 tst CHGFLG ; did the paint change anything? | |
3210 bne L993B ; brif so | |
3211 lds TMPSTK ; get back stack pointer | |
3212 L993B puls a,b,x,u ; get frame from stack | |
3213 clr CHGFLG ; mark nothing changed | |
3214 sts TMPSTK ; save stack pointer | |
3215 leax 1,x ; move start coordinate right | |
3216 stx HORBEG ; save new coordinate | |
3217 stu VD1 ; save length of line | |
3218 sta VD7 ; save up/down flag | |
3219 beq L98EB ; did we hit the "stop" frame? | |
3220 bmi L9954 ; brif negative going (up)? | |
3221 incb ; bump vertical coordinate | |
3222 cmpb VD6 ; at end? | |
3223 bls L9958 ; brif not | |
3224 clrb ; set vertical to 0 (wrap around) | |
3225 L9954 tstb ; did we wrap? | |
3226 beq L9934 ; do another block if so | |
3227 decb ; move up a row | |
3228 L9958 stb VERBEG+1 ; save vertical coordinate | |
3229 jsr L99DF ; paint from horizontal to 0 | |
3230 beq L996E ; brif we hit the border immediately | |
3231 cmpd #3 ; less than 3 pixels? | |
3232 blo L9969 ; brif so | |
3233 leax -2,x ; move two pixels left | |
3234 bsr L99A1 ; save paint block on the stack | |
3235 L9969 jsr L99CB ; continue painting to the right | |
3236 L996C bsr L99BA ; save paint data frame | |
3237 L996E coma ; complement length of line just painted and add to length of line | |
3238 comb | |
3239 L9970 addd VD1 ; save difference between this line and parent line | |
3240 std VD1 | |
3241 ble L998C ; brif parent line is shorter | |
3242 jsr L9506 ; bump horizontal coordinate | |
3243 jsr L9A12 ; see if we bounced into the border | |
3244 bne L9983 ; brif not border | |
3245 ldd #-1 ; move left | |
3246 bra L9970 ; keep looking | |
3247 L9983 jsr L9514 ; move horizontally left | |
3248 bsr L99C6 ; save horizontal coordinate | |
3249 bsr L99E8 ; paint right | |
3250 bra L996C ; save paint block and do more | |
3251 L998C jsr L9506 ; bump horizontal coordinate | |
3252 leax d,x ; point to right end of parent line | |
3253 stx HORBEG ; set as curent coordinate | |
3254 coma ; get amount we extend past parent line | |
3255 comb | |
3256 subd #1 | |
3257 ble L999E ; brif doesn't extend | |
3258 tfr d,x ; save length of line | |
3259 bsr L99A1 ; save paint frame | |
3260 L999E jmp L9934 | |
3261 L99A1 std VCB ; save number of pixels painted | |
3262 puls y ; get return address | |
3263 ldd HORBEG ; get horizontal coordinate | |
3264 pshs x,b,a ; save horizontal coordinate and pointer | |
3265 lda VD7 ; get up/down flag | |
3266 nega ; reverse it | |
3267 L99AC ldb VERBEG+1 ; get vertical coordainte | |
3268 pshs b,a ; save vertical coord and up/down flag | |
3269 pshs y ; put return address back | |
3270 ldb #2 ; make sure we haven't overflowed memory | |
3271 jsr LAC33 | |
3272 ldd VCB ; get line length back | |
3273 rts | |
3274 L99BA std VCB ; save length of painted line | |
3275 puls y ; get return address | |
3276 ldd HOREND ; get start coord | |
3277 pshs x,b,a ; save horizontal start and length | |
3278 lda VD7 ; get up/down flag | |
3279 bra L99AC ; finish up with the stack | |
3280 L99C6 ldx HORBEG ; save current horizontal coord and save it | |
3281 stx HOREND | |
3282 rts | |
3283 L99CB std VCD ; save number of pixels painted | |
3284 ldy HOREND ; get last horizontal start | |
3285 bsr L99C6 ; save current coordinate | |
3286 sty HORBEG ; save coordinate | |
3287 bsr L99E8 ; paint a line | |
3288 ldx VCD ; get number painted | |
3289 leax d,x ; add to the number painted going the other way | |
3290 addd #1 ; now D is length of line | |
3291 rts | |
3292 L99DF jsr L99C6 ; put starting coordinate in end | |
3293 ldy #L9514 ; decrement horizontal coordinate address | |
3294 bra L99EE ; go paint line | |
3295 L99E8 ldy #L9506 ; increment horizontal coordinate address | |
3296 jsr ,y ; bump coordinate | |
3297 L99EE ldu ZERO ; initialize pixel count | |
3298 ldx HORBEG ; get starting coordinate | |
3299 L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate | |
3300 cmpx VD3 ; at end? | |
3301 bhi L9A0B ; brif right of max | |
3302 pshs u,y ; save counter and inc/dec routine pointer | |
3303 bsr L9A12 ; at border? | |
3304 beq L9A09 ; brif so | |
3305 jsr L9377 ; set pixel to paint colour | |
3306 puls y,u ; restore counter and inc/dec/pointer | |
3307 leau 1,u ; bump number of painted pixels | |
3308 jsr ,y ; inc/dec screen address | |
3309 bra L99F2 ; go do another pixel | |
3310 L9A09 puls y,u ; get back counter and inc/dec routine | |
3311 L9A0B tfr u,d ; save count in D | |
3312 tfr d,x ; and in X | |
3313 subd ZERO ; set flags on D (smaller/faster than cmpd ZERO) | |
3314 rts | |
3315 L9A12 jsr [VD9] ; get the screen address | |
3316 tfr a,b ; save pixel mask | |
3317 andb VD8 ; set pixel to border colour | |
3318 pshs b,a ; save mask and border | |
3319 anda ,x ; mask current pixel into A | |
3320 cmpa 1,s ; does it match border? Z=1 if so | |
3321 puls a,b,pc ; restore mask, border pixel, and return | |
3322 ; PLAY command | |
3323 ; This is here mixed in with the graphics package because it shares some machinery with DRAW. | |
3324 PLAY ldx ZERO ; default values for note length, etc. | |
3325 ldb #1 | |
3326 pshs x,b ; save default values | |
3327 jsr LB156 ; evaluate argument | |
3328 clrb ; enable DA and sound output | |
3329 jsr LA9A2 | |
3330 jsr LA976 | |
3331 L9A32 jsr LB654 ; fetch PLAY string details | |
3332 bra L9A39 ; go evaluate the string | |
3333 L9A37 puls b,x ; get back play string details | |
3334 L9A39 stb VD8 ; save length of string | |
3335 beq L9A37 ; brif end of string | |
3336 stx VD9 ; save start of string | |
3337 lbeq LA974 ; brif NULL string - disable sound and return | |
3338 L9A43 tst VD8 ; have anything left? | |
3339 beq L9A37 ; brif not | |
3340 jsr L9B98 ; get command character | |
3341 cmpa #'; ; command separator? | |
3342 beq L9A43 ; brif so - ignore it | |
3343 cmpa #'' ; '? | |
3344 beq L9A43 ; brif so - ignore it | |
3345 cmpa #'X ; execuate sub string? | |
3346 lbeq L9C0A ; brif so - handle it | |
3347 bsr L9A5C ; handle other commands | |
3348 bra L9A43 ; look for more stuff | |
3349 L9A5C cmpa #'O ; octave? | |
3350 bne L9A6D ; brif not | |
3351 ldb OCTAVE ; get current octave | |
3352 incb ; 1-base it | |
3353 bsr L9AC0 ; get value if present | |
3354 decb ; zero-base it | |
3355 cmpb #4 ; valid octave? | |
3356 bhi L9ACD ; raise error if not | |
3357 stb OCTAVE ; save new octave | |
3358 rts | |
3359 L9A6D cmpa #'V ; volume? | |
3360 bne L9A8B ; brif not | |
3361 ldb VOLHI ; get current high volume limit | |
3362 lsrb ; shift 2 bits right (DA is 6 bits in high bits) | |
3363 lsrb | |
3364 subb #31 ; subtract out mid value offset | |
3365 bsr L9AC0 ; read argument | |
3366 cmpb #31 ; maximum range is 31 | |
3367 bhi L9ACD ; brif out of range | |
3368 aslb ; adjust back in range | |
3369 aslb | |
3370 pshs b ; save new volume | |
3371 ldd #0x7e7e ; midrange value for both high and low | |
3372 adda ,s ; add new volume to high limit | |
3373 subb ,s+ ; subtract volume from low limit | |
3374 std VOLHI ; save new volume limits (sets high and low amplitudes) | |
3375 rts | |
3376 L9A8B cmpa #'L ; note length? | |
3377 bne L9AB2 ; brif not | |
3378 ldb NOTELN ; get current length | |
3379 bsr L9AC0 ; read parameter | |
3380 tstb ; resulting length 0? | |
3381 beq L9ACD ; brif so - problem | |
3382 stb NOTELN ; save new length | |
3383 clr DOTVAL ; reset note timer scale factor | |
3384 L9A9A bsr L9A9F ; check for dot | |
3385 bcc L9A9A ; brif there was one | |
3386 rts | |
3387 L9A9F tst VD8 ; check length | |
3388 beq L9AAD ; brif zero | |
3389 jsr L9B98 ; get command character | |
3390 cmpa #'. ; dot? | |
3391 beq L9AAF ; brif so | |
3392 jsr L9BE2 ; move input back and bump length | |
3393 L9AAD coma ; set C to indicate nothing found | |
3394 rts | |
3395 L9AAF inc DOTVAL ; bump number of dots | |
3396 rts | |
3397 L9AB2 cmpa #'T ; tempo? | |
3398 bne L9AC3 ; brif not | |
3399 ldb TEMPO ; get current tempo | |
3400 bsr L9AC0 ; parse tempo argument | |
3401 tstb ; 0? | |
3402 beq L9ACD ; brif so - invalid | |
3403 stb TEMPO ; save new tempo | |
3404 rts | |
3405 L9AC0 jmp L9BAC ; evaluate various operators | |
3406 L9AC3 cmpa #'P ; pause? | |
3407 bne L9AEB ; brif not | |
3408 jsr L9CCB ; evaluate parameter | |
3409 tstb ; is the pause number 0? | |
3410 bne L9AD0 ; brif not | |
3411 L9ACD jmp LB44A ; raise FC error | |
3412 L9AD0 lda DOTVAL ; save current volume and note scale | |
3413 ldx VOLHI | |
3414 pshs x,a | |
3415 lda #0x7e ; drop DA to mid range | |
3416 sta VOLHI | |
3417 sta VOLLOW | |
3418 clr DOTVAL | |
3419 bsr L9AE7 ; go play a "silence" | |
3420 puls a,x ; restore volume and note scale | |
3421 sta DOTVAL | |
3422 stx VOLHI | |
3423 rts | |
3424 L9AE7 clr ,-s ; set not number 0 | |
3425 bra L9B2B ; go play it | |
3426 L9AEB cmpa #'N ; N for "note"? | |
3427 bne L9AF2 ; brif not - it's optional | |
3428 jsr L9B98 ; skip the "N" | |
3429 L9AF2 cmpa #'A ; is it a valid note? | |
3430 blo L9AFA ; brif not | |
3431 cmpa #'G ; is it above the note range? | |
3432 bls L9AFF ; brif not - valid note | |
3433 L9AFA jsr L9BBE ; evaluate a number | |
3434 bra L9B22 ; process note value | |
3435 L9AFF suba #'A ; normalize note number to 0 | |
3436 ldx #L9C5B ; point to note number lookup table | |
3437 ldb a,x ; get not number | |
3438 tst VD8 ; any command characters left? | |
3439 beq L9B22 ; brif not | |
3440 jsr L9B98 ; get character | |
3441 cmpa #'# ; sharp? | |
3442 beq L9B15 ; brif so | |
3443 cmpa #'+ ; also sharp? | |
3444 bne L9B18 ; brif not | |
3445 L9B15 incb ; add one half tone | |
3446 bra L9B22 | |
3447 L9B18 cmpa #'- ; flat? | |
3448 bne L9B1F ; brif not | |
3449 decb ; subtract one half tone | |
3450 bra L9B22 | |
3451 L9B1F jsr L9BE2 ; back up command pointer | |
3452 L9B22 decb ; adjust note number (zero base it) | |
3453 cmpb #11 ; is it valid? | |
3454 bhi L9ACD ; raise error if not | |
3455 pshs b ; save note value | |
3456 ldb NOTELN ; get note length | |
3457 L9B2B lda TEMPO ; get tempo value | |
3458 mul ; calculate note duration | |
3459 std VD5 ; save duration | |
3460 leau 1,s ; point to where the stack goes after we're done | |
3461 lda OCTAVE ; get current octave | |
3462 cmpa #1 ; 0 or 1? | |
3463 bhi L9B64 ; brif not | |
3464 ldx #L9C62 ; point to delay table | |
3465 ldb #2*12 ; 24 bytes per octave | |
3466 mul ; now we have the base address | |
3467 abx ; now X points to the octave base | |
3468 puls b ; get back note value | |
3469 aslb ; two bytes per delay | |
3470 abx ; now we're pointing to the delay | |
3471 leay ,x ; save pointer to note value | |
3472 bsr L9B8C ; calculate note timer value | |
3473 std PLYTMR ; set timer for note playing (IRQ will count this down) | |
3474 L9B49 bsr L9B57 ; set to mid range and delay | |
3475 lda VOLHI ; get high value | |
3476 bsr L9B5A ; set to high value and delay | |
3477 bsr L9B57 ; set to mid range and delay | |
3478 lda VOLLOW ; get low value | |
3479 bsr L9B5A ; set to low value and delay | |
3480 bra L9B49 ; do it again (IRQ will break the loop) | |
3481 L9B57 lda #0x7e ; mid value for DA with RS232 marking | |
3482 nop ; a delay to fine tune frequencies | |
3483 L9B5A sta PIA1 ; set DA | |
3484 ldx ,y ; get delay value | |
3485 L9B5F leax -1,x ; count down | |
3486 bne L9B5F ; brif not done yet | |
3487 rts | |
3488 L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+ | |
3489 ldb #12 ; 12 bytes per octave | |
3490 mul ; now we have the offset to the desired octave | |
3491 abx ; now we point to the start of the octave | |
3492 puls b ; get back note value | |
3493 abx ; now we point to the delay value | |
3494 bsr L9B8C ; calculate timer value | |
3495 std PLYTMR ; set play timer (IRQ counts this down) | |
3496 L9B72 bsr L9B80 ; send mid value and delay | |
3497 lda VOLHI ; get high value | |
3498 bsr L9B83 ; send high value and delay | |
3499 bsr L9B80 ; send low value and delay | |
3500 lda VOLLOW ; get low value | |
3501 bsr L9B83 ; send low value and delay | |
3502 bra L9B72 ; do it again (IRQ will break the loop) | |
3503 L9B80 lda #0x7e ; mid range value with RS232 marking | |
3504 nop ; fine tuning delay | |
3505 L9B83 sta PIA1 ; set DA | |
3506 lda ,x ; get delay value | |
3507 L9B88 deca ; count down | |
3508 bne L9B88 ; brif not done | |
3509 rts | |
3510 L9B8C ldb #0xff ; base timer value | |
3511 lda DOTVAL ; get number of dots | |
3512 beq L9B97 ; use default value if 0 | |
3513 adda #2 ; add in constant timer factor | |
3514 mul ; multiply scale by base | |
3515 lsra ; divide by two - each increment will increase note timer by 128 | |
3516 rorb | |
3517 L9B97 rts | |
3518 L9B98 pshs x ; save register | |
3519 L9B9A tst VD8 ; do we have anything left? | |
3520 beq L9BEB ; brif not - raise error | |
3521 ldx VD9 ; get parsing address | |
3522 lda ,x+ ; get character | |
3523 stx VD9 ; save pointer | |
3524 dec VD8 ; account for character consumed | |
3525 cmpa #0x20 ; space? | |
3526 beq L9B9A ; brif so - skip it | |
3527 puls x,pc ; restore register and return | |
3528 L9BAC bsr L9B98 ; get character | |
3529 cmpa #'+ ; add one? | |
3530 beq L9BEE ; brif so | |
3531 cmpa #'- ; subtract one? | |
3532 beq L9BF2 ; brif so | |
3533 cmpa #'> ; double? | |
3534 beq L9BFC ; brif so | |
3535 cmpa #'< ; halve? | |
3536 beq L9BF7 ; brif so | |
3537 L9BBE cmpa #'= ; variable equate? | |
3538 beq L9C01 ; brif so | |
3539 jsr L90AA ; clear carry if numeric | |
3540 bcs L9BEB ; brif not numeric | |
3541 clrb ; initialize value to 0 | |
3542 L9BC8 suba #'0 ; remove ASCII bias | |
3543 sta VD7 ; save digit | |
3544 lda #10 ; make room for digit | |
3545 mul | |
3546 tsta ; did we overflow 8 bits? | |
3547 bne L9BEB ; brif so | |
3548 addb VD7 ; add in digit | |
3549 bcs L9BEB ; brif that overflowed | |
3550 tst VD8 ; more digits? | |
3551 beq L9BF1 ; brif not | |
3552 jsr L9B98 ; get character | |
3553 jsr L90AA ; clear carry if numeric | |
3554 bcc L9BC8 ; brif another digit | |
3555 L9BE2 inc VD8 ; unaccount for character just read | |
3556 ldx VD9 ; move pointer back | |
3557 leax -1,x | |
3558 stx VD9 | |
3559 rts | |
3560 L9BEB jmp LB44A ; raise FC error | |
3561 L9BEE incb ; bump param | |
3562 beq L9BEB ; brif overflow | |
3563 L9BF1 rts | |
3564 L9BF2 tstb ; already zero? | |
3565 beq L9BEB ; brif so - underflow | |
3566 decb ; decrease parameter | |
3567 rts | |
3568 L9BF7 tstb ; already at 0? | |
3569 beq L9BEB ; brif so - raise error | |
3570 lsrb ; halve it | |
3571 rts | |
3572 L9BFC tstb ; will it overflow? | |
3573 bmi L9BEB ; brif so | |
3574 aslb ; double it | |
3575 rts | |
3576 L9C01 pshs u,y ; save registers | |
3577 bsr L9C1B ; interpret command string as a variable | |
3578 jsr LB70E ; convert it to an 8 bit number | |
3579 puls y,u,pc ; restore registers and return | |
3580 L9C0A jsr L9C1B ; evaluate expression in command string | |
3581 ldb #2 ; room for 4 bytes? | |
3582 jsr LAC33 | |
3583 ldb VD8 ; get the command length and pointer | |
3584 ldx VD9 | |
3585 pshs x,b ; save them | |
3586 jmp L9A32 ; go process the sub string | |
3587 L9C1B ldx VD9 ; get command pointer | |
3588 pshs x ; save it | |
3589 jsr L9B98 ; get input character | |
3590 jsr LB3A2 ; set carry if not alpha | |
3591 bcs L9BEB ; brif not a variable reference | |
3592 L9C27 jsr L9B98 ; get command character | |
3593 cmpa #'; ; semicolon? | |
3594 bne L9C27 ; keep scanning if not | |
3595 puls x ; get back start of variable string | |
3596 ldu CHARAD ; get current interpreter input pointer | |
3597 pshs u ; save it | |
3598 stx CHARAD ; point interpreter at command string | |
3599 jsr LB284 ; evaluate expression as string | |
3600 puls x ; restore interpeter input pointer | |
3601 stx CHARAD | |
3602 rts | |
3603 ; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after | |
3604 ; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts. | |
3605 L9C3E clra ; make sure DP is set to 0 | |
3606 tfr a,dp | |
3607 ldd PLYTMR ; is PLAY running? | |
3608 lbeq LA9BB ; brif not - transfer control on the Color Basic's routine | |
3609 subd VD5 ; subtract out the interval | |
3610 std PLYTMR ; save new timer value | |
3611 bhi L9C5A ; brif it isn't <= 0 | |
3612 clr PLYTMR ; disable the timer | |
3613 clr PLYTMR+1 | |
3614 puls a ; get saved CC | |
3615 lds 7,s ; set stack to saved U value | |
3616 anda #0x7f ; clear E flag (to return minimal state) | |
3617 pshs a ; set fake "FIRQ" stack frame | |
3618 L9C5A rti | |
3619 L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G | |
3620 L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1 | |
3621 fdb 0x0150,0x013d,0x012b,0x011a | |
3622 fdb 0x010a,0x00fb,0x00ed,0x00df | |
3623 fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2 | |
3624 fdb 0x00a6,0x009d,0x0094,0x008b | |
3625 fdb 0x0083,0x007c,0x0075,0x006e | |
3626 L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3 | |
3627 fcb 0x83,0x7b,0x74,0x6d | |
3628 fcb 0x67,0x61,0x5b,0x56 | |
3629 fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4 | |
3630 fcb 0x3f,0x3b,0x37,0x34 | |
3631 fcb 0x31,0x2e,0x2b,0x28 | |
3632 fcb 0x26,0x23,0x21,0x1f ; delays for octave 5 | |
3633 fcb 0x1d,0x1b,0x19,0x18 | |
3634 fcb 0x16,0x14,0x13,0x12 | |
3635 ; DRAW command | |
3636 DRAW ldx ZERO ; create an empty "DRAW" frame | |
3637 ldb #1 | |
3638 pshs x,b | |
3639 stb SETFLG ; set to "PSET" mode | |
3640 stx VD5 ; clear update and draw flag | |
3641 jsr L959A ; set active colour byte | |
3642 jsr LB156 ; evaluate command string | |
3643 L9CC6 jsr LB654 ; fetch command string details | |
3644 bra L9CD3 ; interpret the command string | |
3645 L9CCB jsr L9B98 ; fetch command character | |
3646 jmp L9BBE ; evaluate a number | |
3647 L9CD1 puls b,x ; get previously saved command string | |
3648 L9CD3 stb VD8 ; save length counter | |
3649 beq L9CD1 ; brif end of string | |
3650 stx VD9 ; save pointer | |
3651 lbeq L9DC7 ; brif overall end of command | |
3652 L9CDD tst VD8 ; are we at the end of the string? | |
3653 beq L9CD1 ; brif so - return to previous string | |
3654 jsr L9B98 ; get command character | |
3655 cmpa #'; ; semicolon? | |
3656 beq L9CDD ; brif so - ignore it | |
3657 cmpa #'' ; '? | |
3658 beq L9CDD ; brif so - ignore that too | |
3659 cmpa #'N ; update position toggle? | |
3660 bne L9CF4 ; brif not | |
3661 com VD5 ; toggle update position flag | |
3662 bra L9CDD ; get on for another command | |
3663 L9CF4 cmpa #'B ; blank flag? | |
3664 bne L9CFC ; brif not | |
3665 com VD6 ; toggle blank flag | |
3666 bra L9CDD ; get on for another command | |
3667 L9CFC cmpa #'X ; substring? | |
3668 lbeq L9D98 ; brif so - execute command | |
3669 cmpa #'M ; move draw position? | |
3670 lbeq L9E32 ; brif so | |
3671 pshs a ; save command character | |
3672 ldb #1 ; default value if no number follows | |
3673 tst VD8 ; is there something there? | |
3674 beq L9D21 ; brif not | |
3675 jsr L9B98 ; get character | |
3676 jsr LB3A2 ; set C if not alpha | |
3677 pshs cc ; save alpha state | |
3678 jsr L9BE2 ; move back pointer | |
3679 puls cc ; get back alpha flag | |
3680 bcc L9D21 ; brif it's alpha | |
3681 bsr L9CCB ; evaluate a number | |
3682 L9D21 puls a ; get command back | |
3683 cmpa #'C ; color change? | |
3684 beq L9D4F ; brif so | |
3685 cmpa #'A ; angle? | |
3686 beq L9D59 ; brif so | |
3687 cmpa #'S ; scale? | |
3688 beq L9D61 ; brif so | |
3689 cmpa #'U ; up? | |
3690 beq L9D8F ; brif so | |
3691 cmpa #'D ; down? | |
3692 beq L9D8C ; brif so | |
3693 cmpa #'L ; left? | |
3694 beq L9D87 ; brif so | |
3695 cmpa #'R ; right? | |
3696 beq L9D82 ; brif so | |
3697 suba #'E ; normalize the half cardinals to 0 | |
3698 beq L9D72 ; brif E (45°) | |
3699 deca ; F (135°?) | |
3700 beq L9D6D ; brif so | |
3701 deca ; G (225°?) | |
3702 beq L9D7B ; brif so | |
3703 deca ; H (315°?) | |
3704 beq L9D69 ; brif so | |
3705 L9D4C jmp LB44A ; raise FC error | |
3706 L9D4F jsr L955D ; adjust colour for PMODE | |
3707 stb FORCOL ; save new foreground colour | |
3708 jsr L959A ; set up working colour and all pixels byte | |
3709 L9D57 bra L9CDD ; go process another command | |
3710 L9D59 cmpb #4 ; only 3 angles are valid | |
3711 bhs L9D4C ; brif not valid | |
3712 stb ANGLE ; save new angle | |
3713 bra L9D57 ; go process another command | |
3714 L9D61 cmpb #63 ; only 64 scale values are possible | |
3715 bhs L9D4C ; brif out of range | |
3716 stb SCALE ; save new scale factor | |
3717 bra L9D57 ; go process another command | |
3718 L9D69 clra ; make horizontal negative | |
3719 bsr L9DC4 | |
3720 skip1 | |
3721 L9D6D clra ; keep horizontal distance positive | |
3722 tfr d,x ; make horizontal distance and vertical distance the same | |
3723 bra L9DCB ; go do the draw thing | |
3724 L9D72 clra ; zero extend horizontal distance | |
3725 tfr d,x ; set it as vertical | |
3726 bsr L9DC4 ; negate horizontal distance | |
3727 exg d,x ; swap directions (vertical is now negative) | |
3728 bra L9DCB ; go do the draw thing | |
3729 L9D7B clra ; zero extend horizontal distance | |
3730 tfr d,x ; copy horizontal to vertical | |
3731 bsr L9DC4 ; negate horizontal | |
3732 bra L9DCB ; go do the drawing thing | |
3733 L9D82 clra ; zero extend horizontal distance | |
3734 L9DB3 ldx ZERO ; no vertical distance | |
3735 bra L9DCB ; go do the drawing things | |
3736 L9D87 clra ; zero extend horizontal | |
3737 bsr L9DC4 ; negate horizontal | |
3738 bra L9DB3 ; zero out vertical and do the drawing thing | |
3739 L9D8C clra ; zero extend distance | |
3740 bra L9D92 ; make the distance vertical and zero out horizontal | |
3741 L9D8F clra ; zero extend distance | |
3742 bsr L9DC4 ; negate distance | |
3743 L9D92 ldx ZERO ; zero out vertical distance | |
3744 exg x,d ; swap vertical and horizontal | |
3745 bra L9DCB ; go do the drawing thing | |
3746 L9D98 jsr L9C1B ; evaluate substring expression | |
3747 ldb #2 ; is there enough room for the state? | |
3748 jsr LAC33 | |
3749 ldb VD8 ; save current command string state | |
3750 ldx VD9 | |
3751 pshs x,b | |
3752 jmp L9CC6 ; go evaluate the sub string | |
3753 L9DA9 ldb SCALE ; get scale factor | |
3754 beq L9DC8 ; brif zero - default to full size | |
3755 clra ; zero extend | |
3756 exg d,x ; put distance somewhere useful | |
3757 sta ,-s ; save MS of distance | |
3758 bpl L9DB6 ; brif positive distance | |
3759 bsr L9DC3 ; negate the distance | |
3760 L9DB6 jsr L9FB5 ; multiply D and X | |
3761 tfr u,d ; save ms bytes in D | |
3762 lsra ; divide by 2 | |
3763 rorb | |
3764 L9DBD lsra ; ...divide by 4 | |
3765 rorb | |
3766 tst ,s+ ; negative distance? | |
3767 bpl L9DC7 ; brif it was positive | |
3768 L9DC3 nega ; negate D | |
3769 L9DC4 negb | |
3770 sbca #0 | |
3771 L9DC7 rts | |
3772 L9DC8 tfr x,d ; copy unchanged sitance to D | |
3773 rts | |
3774 L9DCB pshs b,a ; save horizontal distance | |
3775 bsr L9DA9 ; apply scale factor to vertical | |
3776 puls x ; get horizontal distance | |
3777 pshs b,a ; save scaled vertical | |
3778 bsr L9DA9 ; apply scale to horizontal | |
3779 puls x ; get back vertical distance | |
3780 ldy ANGLE ; get draw angle and scale | |
3781 pshs y ; save them | |
3782 L9DDC tst ,s ; is there an angle? | |
3783 beq L9DE8 ; brif no angle | |
3784 exg x,d ; swap distances | |
3785 bsr L9DC3 ; negate D | |
3786 dec ,s ; account for one tick around the rotation | |
3787 bra L9DDC ; see if we're there yet | |
3788 L9DE8 puls y ; get angle and scale back | |
3789 ldu ZERO ; default end position (horizontal) is 0 | |
3790 addd HORDEF ; add default horizontal to horizontal distance | |
3791 bmi L9DF2 ; brif we went negative | |
3792 tfr d,u ; save calculated end coordindate | |
3793 L9DF2 tfr x,d ; get vertical distance somewhere useful | |
3794 ldx ZERO ; default vertical end is 0 | |
3795 addd VERDEF ; add distance to default vertical start | |
3796 bmi L9DFC ; brif negative - use 0 | |
3797 tfr d,x ; save calculated end coordinate | |
3798 L9DFC cmpu #256 ; is horizontal in range? | |
3799 blo L9E05 ; brif su | |
3800 ldu #255 ; maximize it | |
3801 L9E05 cmpx #192 ; is vertical in range? | |
3802 blo L9E0D ; brif so | |
3803 ldx #191 ; maximize it | |
3804 L9E0D ldd HORDEF ; set starting coordinates for the line | |
3805 std HORBEG | |
3806 ldd VERDEF | |
3807 std VERBEG | |
3808 stx VEREND ; set end coordinates | |
3809 stu HOREND | |
3810 tst VD5 ; are we updating position? | |
3811 bne L9E21 ; brif not | |
3812 stx VERDEF ; update default coordinates | |
3813 stu HORDEF | |
3814 L9E21 jsr L9420 ; normalize coordindates | |
3815 tst VD6 ; are we drawing something? | |
3816 bne L9E2B ; brif not | |
3817 jsr L94A1 ; draw the line | |
3818 L9E2B clr VD5 ; reset draw and update flags | |
3819 clr VD6 | |
3820 jmp L9CDD ; do another command | |
3821 L9E32 jsr L9B98 ; get a command character | |
3822 pshs a ; save it | |
3823 jsr L9E5E ; evaluate horizontal distance | |
3824 pshs b,a ; save it | |
3825 jsr L9B98 ; get character | |
3826 cmpa #', ; comma between coordinates? | |
3827 lbne L9D4C ; brif not - raise error | |
3828 jsr L9E5B ; evaluate vertical distance | |
3829 tfr d,x ; save vertical distance | |
3830 puls u ; get horizontal distance | |
3831 puls a ; get back first command character | |
3832 cmpa #'+ ; was it + at start? | |
3833 beq L9E56 ; brif +; treat values as positive | |
3834 cmpa #'- ; was it -? | |
3835 bne L9DFC ; brif not - treat it as absolute | |
3836 L9E56 tfr u,d ; put horizontal distance somewhere useful | |
3837 jmp L9DCB ; move draw position (relative) | |
3838 L9E5B jsr L9B98 ; get input character | |
3839 L9E5E cmpa #'+ ; leading +? | |
3840 beq L9E69 ; brif so | |
3841 cmpa #'- ; leading -? | |
3842 beq L9E6A ; brif so - negative | |
3843 jsr L9BE2 ; move pointer back one | |
3844 L9E69 clra ; 0 for +, nonzero for - | |
3845 L9E6A pshs a ; save sign flag | |
3846 jsr L9CCB ; evaluate number | |
3847 puls a ; get sign flag | |
3848 tsta ; negative? | |
3849 beq L9E78 ; brif not | |
3850 clra ; zero extend and negate | |
3851 negb | |
3852 sbca #0 | |
3853 L9E78 rts | |
3854 ; Table of sines and cosines for CIRCLE | |
3855 L9E79 fdb 0x0000,0x0001 ; subarc 0 | |
3856 fdb 0xfec5,0x1919 ; subarc 1 | |
3857 fdb 0xfb16,0x31f2 ; subarc 2 | |
3858 fdb 0xf4fb,0x4a51 ; subarc 3 | |
3859 fdb 0xec84,0x61f9 ; subarc 4 | |
3860 fdb 0xe1c7,0x78ae ; subarc 5 | |
3861 fdb 0xd4dc,0x8e3b ; subarc 6 | |
3862 fdb 0xc5e5,0xa269 ; subarc 7 | |
3863 fdb 0xb506,0xb506 ; subarc 8 | |
3864 ; CIRCLE command | |
3865 ; The circle is drawn as a 64 sided polygon (64 LINE commands essentially) | |
3866 CIRCLE cmpa #'@ ; is there an @ before coordinates? | |
3867 bne L9EA3 ; brif not | |
3868 jsr GETNCH ; eat the @ | |
3869 L9EA3 jsr L9522 ; get max coordinates for screen | |
3870 jsr L93B2 ; parse coordinates for circle centre | |
3871 jsr L931D ; normalize the start coordinates | |
3872 ldx ,u ; get horizontal coordinate | |
3873 stx VCB ; save it | |
3874 ldx 2,u ; get vertical coordinate | |
3875 stx VCD ; saveit | |
3876 jsr SYNCOMMA ; make sure we have a comma | |
3877 jsr LB73D ; evaluate radius expression | |
3878 ldu #VCF ; point to temp storage | |
3879 stx ,u ; save radius | |
3880 jsr L9320 ; normalize radius | |
3881 lda #1 ; default to PSET | |
3882 sta SETFLG | |
3883 jsr L9581 ; evaluate the colour expression | |
3884 ldx #0x100 ; height/width default value | |
3885 jsr GETCCH ; is there a ratio? | |
3886 beq L9EDF ; brif not | |
3887 jsr SYNCOMMA ; make sure we have a comma | |
3888 jsr LB141 ; evaluate the ratio | |
3889 lda FP0EXP ; multiply ratio by 256 | |
3890 adda #8 | |
3891 sta FP0EXP | |
3892 jsr LB740 ; evaluate ratio to X (fraction part in LSB) | |
3893 L9EDF lda PMODE ; get graphics mode | |
3894 bita #2 ; is it even? | |
3895 beq L9EE9 ; brif so | |
3896 tfr x,d ; double the ratio | |
3897 leax d,x | |
3898 L9EE9 stx VD1 ; save height/width ratio | |
3899 ldb #1 ; set the SET flag to PSET | |
3900 stb SETFLG | |
3901 stb VD8 ; set first time flag (set to 0 after arc drawn) | |
3902 jsr L9FE2 ; evaluate circle starting point (octant, subarc) | |
3903 pshs b,a ; save startpoint | |
3904 jsr L9FE2 ; evaluate circle end point (octant, subarc) | |
3905 std VD9 ; save endp oint | |
3906 puls a,b | |
3907 L9EFD pshs b,a ; save current circle position | |
3908 ldx HOREND ; move end coordinates to start coordinates | |
3909 stx HORBEG | |
3910 ldx VEREND | |
3911 stx VERBEG | |
3912 ldu #L9E79+2 ; point to sine/cosine table | |
3913 anda #1 ; even octant? | |
3914 beq L9F11 ; brif so | |
3915 negb ; convert 0-7 to 8-1 for odd octants | |
3916 addb #8 | |
3917 L9F11 aslb ; four bytes per table entry | |
3918 aslb | |
3919 leau b,u ; point to correct table entry | |
3920 pshs u ; save sine/cosine table entry pointer | |
3921 jsr L9FA7 ; calculate horizontal offset | |
3922 puls u ; get back table entry pointer | |
3923 leau -2,u ; move to cosine entry | |
3924 pshs x ; save horizontal offset | |
3925 jsr L9FA7 ; calculate vertical offset | |
3926 puls y ; put horizontal in Y | |
3927 lda ,s ; get octant number | |
3928 anda #3 ; is it 0 or 4? | |
3929 beq L9F31 ; brif so | |
3930 cmpa #3 ; is it 3 or 7? | |
3931 beq L9F31 ; brif so | |
3932 exg x,y ; swap horizontal and vertical | |
3933 L9F31 stx HOREND ; save horizontal offset | |
3934 tfr y,x ; put vertical offset in X | |
3935 ldd VD1 ; get height/width ratio | |
3936 jsr L9FB5 ; multiply vertical by h/w ratio | |
3937 tfr y,d ; save the product to D | |
3938 tsta ; did it overflow? | |
3939 lbne LB44A ; brif so | |
3940 stb VEREND ; save vertical coordinate MSB | |
3941 tfr u,d ; get LSW of product | |
3942 sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio) | |
3943 lda ,s ; get octant | |
3944 cmpa #2 ; is it 0 or 1? | |
3945 blo L9F5B ; brif so | |
3946 cmpa #6 ; is it 6 or 7? | |
3947 bhs L9F5B ; brif so | |
3948 ldd VCB ; get horizontal centre | |
3949 subd HOREND ; subtract horizontal displacement | |
3950 bcc L9F68 ; brif we didn't overflow the screen | |
3951 clra ; zero out coordinate if we overflowed the screen | |
3952 clrb | |
3953 bra L9F68 | |
3954 L9F5B ldd VCB ; get horizontal coordinate of the centre | |
3955 addd HOREND ; add displacement | |
3956 bcs L9F66 ; brif overlod | |
3957 cmpd VD3 ; larger than max horizontal coord? | |
3958 blo L9F68 ; brif not | |
3959 L9F66 ldd VD3 ; maximize the coordinate | |
3960 L9F68 std HOREND ; save horizontal ending coordainte | |
3961 lda ,s ; get octant | |
3962 cmpa #4 ; is it 0-3? | |
3963 blo L9F7A ; brif so | |
3964 ldd VCD ; get vertical coordinate of centre | |
3965 subd VEREND ; subtract displacement | |
3966 bcc L9F87 ; brif we didn't overflow the screen | |
3967 clra ; minimize to top of screen | |
3968 clrb | |
3969 bra L9F87 | |
3970 L9F7A ldd VCD ; get vertical centre coordinate | |
3971 addd VEREND ; add displacement | |
3972 bcs L9F85 ; brif we overflowed the screen | |
3973 cmpd VD5 ; did we go past max coordinate? | |
3974 blo L9F87 ; brif not | |
3975 L9F85 ldd VD5 ; maximize the coordinate | |
3976 L9F87 std VEREND ; save end coordinate | |
3977 tst VD8 ; check first time flag | |
3978 bne L9F8F ; do not draw if first time through (it was setting start coord) | |
3979 bsr L9FDF ; draw the line | |
3980 L9F8F puls a,b ; get arc number and sub arc | |
3981 lsr VD8 ; get first time flag value (and clear it!) | |
3982 bcs L9F9A ; do not check for end point after drawing for first coordinate | |
3983 cmpd VD9 ; at end point? | |
3984 beq L9FA6 ; brif drawing finished | |
3985 L9F9A incb ; bump arc counter | |
3986 cmpb #8 ; done 8 arcs? | |
3987 bne L9FA3 ; brif not | |
3988 inca ; bump octant | |
3989 clrb ; reset subarc number | |
3990 anda #7 ; make sure octant number stays in 0-7 range | |
3991 L9FA3 jmp L9EFD ; go do another arc | |
3992 L9FA6 rts | |
3993 L9FA7 ldx VCF ; get radius | |
3994 ldd ,u ; get sine/cosine table entry | |
3995 beq L9FB4 ; brif 0 - offset = radius | |
3996 subd #1 ; adjust values to correct range | |
3997 bsr L9FB5 ; multiply radius by sine/cosine | |
3998 tfr y,x ; resturn result in X | |
3999 L9FB4 rts | |
4000 L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space | |
4001 clr 4,s ; reset overflow byte (YH) | |
4002 lda 3,s ; calcuate B*XL | |
4003 mul | |
4004 std 6,s ; put in "U" | |
4005 ldd 1,s ; calculate B*XH | |
4006 mul | |
4007 addb 6,s ; accumluate with previous product | |
4008 adca #0 | |
4009 std 5,s ; save in YL,UH | |
4010 ldb ,s ; calculate A*XL | |
4011 lda 3,s | |
4012 mul | |
4013 addd 5,s ; accumulate with previous partical product | |
4014 std 5,s ; save in YL,UH | |
4015 bcc L9FD4 ; brif no carry | |
4016 inc 4,s ; bump YH for carry | |
4017 L9FD4 lda ,s ; calculate A*XH | |
4018 ldb 2,s | |
4019 mul | |
4020 addd 4,s ; accumulate with previous partial product | |
4021 std 4,s ; save in Y (we can't have a carry here) | |
4022 puls a,b,x,y,u,pc ; restore multiplicands and return results | |
4023 L9FDF jmp L94A1 ; go draw a line | |
4024 L9FE2 clrb ; default arc number (0) | |
4025 jsr GETCCH ; is there something there for a value? | |
4026 beq L9FF8 ; brif not | |
4027 jsr SYNCOMMA ; evaluate , + expression | |
4028 jsr LB141 | |
4029 lda FP0EXP ; multiply by 64 | |
4030 adda #6 | |
4031 sta FP0EXP | |
4032 jsr LB70E ; get integer value of circle fraction | |
4033 andb #0x3f ; max value of 63 | |
4034 L9FF8 tfr b,a ; save arc value in A to calculate octant | |
4035 andb #7 ; calculate subarc | |
4036 lsra ; calculate octant | |
4037 lsra | |
4038 lsra | |
4039 rts |