Mercurial > hg > index.cgi

comparison secb.s @ 0:605ff82c4618

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 DC0DC equ 0xC0DC ; needed for Disk Basic path jump backs
4 *pragma list
5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6 ; EXTENDED COLOR BASIC ROM area
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 org EXBAS
9 fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic
10 L8002 ldx #L80DE ; point to command interpretation table information
11 ldu #COMVEC+10 ; point to command interpretation table location
12 ldb #10 ; 10 bytes to move
13 jsr LA59A ; copy command interpretation table
14 ldx #LB277 ; initialize Disk Basic's entries to error
15 stx 3,u
16 stx 8,u
17 ldx #XIRQSV ; set up IRQ service routine
18 stx IRQVEC+1
19 ldx ZERO ; reset the TIMER value
20 stx TIMVAL
21 jsr XVEC18 ; do a bunch of initialization
22 ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout
23 std DLBAUD
24 ldx #USR0 ; set up pointer to USR routine addresses
25 stx USRADR
26 ldu #LB44A ; set up USR routine addresses to "FC error"
27 ldb #10 ; there are 10 routines
28 L8031 stu ,x++ ; set a routine to FC error
29 decb ; done all?
30 bne L8031 ; brif not
31 lda #0x7e ; op code of JMP extended (for RAM hook intialization)
32 sta RVEC20 ; command interpretation loop
33 ldx #XVEC20
34 stx RVEC20+1
35 sta RVEC15 ; expression evaluation
36 ldx #XVEC15
37 stx RVEC15+1
38 sta RVEC19 ; number parsing
39 ldx #XVEC19
40 stx RVEC19+1
41 sta RVEC9 ; PRINT
42 ldx #XVEC9
43 stx RVEC9+1
44 sta RVEC17 ; error handler
45 ldx #XVEC17
46 stx RVEC17+1
47 sta RVEC4 ; generic input
48 ldx #XVEC4
49 stx RVEC4+1
50 sta RVEC3 ; generic output
51 ldx #XVEC3
52 stx RVEC3+1
53 sta RVEC8 ; close file
54 ldx #XVEC8
55 stx RVEC8+1
56 sta RVEC23 ; tokenize line
57 ldx #XVEC23
58 stx RVEC23+1
59 sta RVEC18 ; RUN
60 ldx #XVEC18
61 stx RVEC18+1
62 sta EXPJMP ; exponentiation
63 ldx #L8489
64 stx EXPJMP+1
65 jsr L96E6 ; initialize graphics stuff
66 lda PIA0+3 ; enable 60Hz interrupt
67 ora #1
68 sta PIA0+3
69 ldx #'D*256+'K ; magic number for a Disk Basic ROM
70 cmpx DOSBAS ; do we have a Disk Basic ROM?
71 lbeq DOSBAS+2 ; brif so - launch it
72 andcc #0xaf ; enable interrupts
73 L80B2 ldx #L80E8-1 ; show sign on message
74 jsr STRINOUT
75 L80B8 ldx #XBWMST ; install warm start handler
76 stx RSTVEC
77 jmp LA0E2 ; set up warm start flag and launch immediate mode
78 ; Extended Basic warm start code
79 XBWMST fcb 0xff ; mark routine as invalid so that ROMs are always copied to RAM on RESET
80 clr PLYTMR ; cancel any PLAY command in progress
81 clr PLYTMR+1
82 lda PIA0+3 ; enable 60Hz interrupt
83 ora #1
84 sta PIA0+3
85 jmp BAWMST ; let Color Basic's warm start process run
86 ; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects
87 ; the input pointer so that it points to the correct place after the program has been relocated by
88 ; PCLEAR instead of continuing with something that, in the best case, is a syntax error.
89 L80D0 lda CURLIN ; immediate mode?
90 inca
91 beq L80DD ; brif so
92 tfr y,d ; save offset to D
93 subd TXTTAB ; see how far into the program we are
94 addd CHARAD ; now adjust the input pointer based on that
95 std CHARAD ; save corrected input pointer
96 L80DD rts
97 L80DE fcb 25 ; 25 Extended Basic commands
98 fdb L8183 ; reserved word table (commands)
99 fdb L813C ; interpretation handler (commands)
100 fcb 14 ; 14 Extended Basic functions
101 fdb L821E ; reserved word table (functions)
102 fdb L8168 ; function handler
103 L80E8 fcc 'EXTENDED COLOR BASIC 2.0'
104 fcb 0x0d
105 fcc 'COPR. 1982, 1986 BY TANDY '
106 fcb 0x0d
107 fcc 'UNDER LICENSE FROM MICROSOFT'
108 fcb 0x0d,0x0d,0x00
109 ; Extended Basic command interpretation loop
110 L813C cmpa #0xcb ; is it an Extended Basic command?
111 bhi L8148 ; brif not
112 ldx #L81F0 ; point to dispatch table
113 suba #0xb5 ; normalize the token number so 0 is the first entry
114 jmp LADD4 ; go transfer control to the command
115 L8148 cmpa #0xff ; is it a function token?
116 beq L8154 ; brif so - for MID$()=, TIMER=
117 cmpa #0xcd ; is it a token for a keyword that isn't a command?
118 bls L8165 ; brif so - error for USING and FN
119 L8150 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present
120 L8154 jsr GETNCH ; get token after the function flag
121 cmpa #0x90 ; MID$?
122 lbeq L86D6 ; brif so (substring replacement)
123 cmpa #0x9f ; TIMER?
124 lbeq L8960 ; brif so - TIMER setting
125 jsr RVEC22 ; do a RAM hook in case something wants to extend this
126 L8165 jmp LB277 ; we have nothing valid here
127 ; Function handler
128 L8168 cmpb #2*33 ; is it a valid Extended Basic function?
129 bls L8170 ; brif so
130 L816C jmp [COMVEC+28] ; transfer control to Disk Basic if it is present
131 L8170 subb #2*20 ; normalize Extended Basic functions to 0
132 cmpb #2*8 ; Above HEX$?
133 bhi L817D ; brif so - we don't pre-evaluate an argument
134 pshs b ; save token value
135 jsr LB262 ; evaluate the function parameter
136 puls b ; get back token value
137 L817D ldx #L8257 ; point to dispatch table
138 jmp LB2CE ; go transfer control to the function
139 ; Reserved words (commands)
140 L8183 fcs 'DEL' ; 0xb5
141 fcs 'EDIT' ; 0xb6
142 fcs 'TRON' ; 0xb7
143 fcs 'TROFF' ; 0xb8
144 fcs 'DEF' ; 0xb9
145 fcs 'LET' ; 0xba
146 fcs 'LINE' ; 0xbb
147 fcs 'PCLS' ; 0xbc
148 fcs 'PSET' ; 0xbd
149 fcs 'PRESET' ; 0xbe
150 fcs 'SCREEN' ; 0xbf
151 fcs 'PCLEAR' ; 0xc0
152 fcs 'COLOR' ; 0xc1
153 fcs 'CIRCLE' ; 0xc2
154 fcs 'PAINT' ; 0xc3
155 fcs 'GET' ; 0xc4
156 fcs 'PUT' ; 0xc5
157 fcs 'DRAW' ; 0xc6
158 fcs 'PCOPY' ; 0xc7
159 fcs 'PMODE' ; 0xc8
160 fcs 'PLAY' ; 0xc9
161 fcs 'DLOAD' ; 0xca
162 fcs 'RENUM' ; 0xcb
163 fcs 'FN' ; 0xcc
164 fcs 'USING' ; 0xcd
165 ; Dispatch table (commands)
166 L81F0 fdb DEL ; 0xb5 DEL
167 fdb EDIT ; 0xb6 EDIT
168 fdb TRON ; 0xb7 TRON
169 fdb TROFF ; 0xb8 TROFF
170 fdb DEF ; 0xb9 DEF
171 fdb LET ; 0xba LET (note: implemented by Color Basic!)
172 fdb LINE ; 0xbb LINE
173 fdb PCLS ; 0xbc PCLS
174 fdb PSET ; 0xbd PSET
175 fdb PRESET ; 0xbe PRESET
176 fdb SCREEN ; 0xbf SCREEN
177 fdb PCLEAR ; 0xc0 PCLEAR
178 fdb COLOR ; 0xc1 COLOR
179 fdb CIRCLE ; 0xc2 CIRCLE
180 fdb PAINT ; 0xc3 PAINT
181 fdb GET ; 0xc4 GET
182 fdb PUT ; 0xc5 PUT
183 fdb DRAW ; 0xc6 DRAW
184 fdb PCOPY ; 0xc7 PCOPY
185 fdb PMODETOK ; 0xc8 PMODE
186 fdb PLAY ; 0xc9 PLAY
187 fdb DLOAD ; 0xca DLOAD
188 fdb RENUM ; 0xcb RENUM
189 ; Reserved words (functions)
190 L821E fcs 'ATN' ; 0x94
191 fcs 'COS' ; 0x95
192 fcs 'TAN' ; 0x96
193 fcs 'EXP' ; 0x97
194 fcs 'FIX' ; 0x98
195 fcs 'LOG' ; 0x99
196 fcs 'POS' ; 0x9a
197 fcs 'SQR' ; 0x9b
198 fcs 'HEX$' ; 0x9c
199 fcs 'VARPTR' ; 0x9d
200 fcs 'INSTR' ; 0x9e
201 fcs 'TIMER' ; 0x9f
202 fcs 'PPOINT' ; 0xa0
203 fcs 'STRING$' ; 0xa1
204 ; Dispatch table (functions)
205 L8257 fdb ATN ; 0x94 ATN
206 fdb COS ; 0x95 COS
207 fdb TAN ; 0x96 TAN
208 fdb EXP ; 0x97 EXP
209 fdb FIX ; 0x98 FIX
210 fdb LOG ; 0x99 LOG
211 fdb POS ; 0x9a POS
212 fdb SQR ; 0x9b SQR
213 fdb HEXDOL ; 0x9c HEX$
214 fdb VARPTRTOK ; 0x9d VARPTR
215 fdb INSTR ; 0x9e INSTR
216 fdb TIMER ; 0x9f TIMER
217 fdb PPOINT ; 0xa0 PPOINT
218 fdb STRING ; 0xa1 STRING$
219 ; Generic output handler
220 XVEC3 tst DEVNUM ; screen?
221 lbeq L95AC ; brif so - force text screen active
222 pshs b ; save register
223 ldb DEVNUM ; get output device
224 cmpb #-3 ; check for DLOAD
225 puls b ; restore register
226 bne L8285 ; brif not DLOAD
227 leas 2,s ; bail out of output handler if DLOAD
228 L8285 rts
229 ; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the
230 ; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required
231 ; if a recent enough version of Color Basic is installed.
232 XVEC8 lda DEVNUM ; get device number
233 inca ; is it tape?
234 bne L8285 ; brif not - we aren't going to mess with it
235 lda FILSTA ; get tape file status
236 cmpa #2 ; output file?
237 bne L8285 ; brif not
238 lda CINCTR ; is there anything waiting to be written out?
239 bne L8285 ; brif so - mainline code will handle it properly
240 clr DEVNUM ; reset output to screen
241 leas 2,s ; don't return to mainline code
242 jmp LA444 ; write EOF block
243 ; RUN handler - sets up some Extended Basic stuff to defaults at program start
244 XVEC18 ldd #0xba42 ; initialize PLAY volume
245 std VOLHI
246 lda #2 ; set PLAY tempo to 2, PLAY octave to 3
247 sta TEMPO
248 sta OCTAVE
249 asla ; set default note length to 5
250 sta NOTELN
251 clr DOTVAL ; don't do any note length extension
252 ldd ZERO ; initialize DRAW angle and scale to default 1
253 std ANGLE
254 ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen
255 std HORDEF
256 ldb #96
257 std VERDEF
258 rts
259 ; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF
260 XVEC20 leas 2,s ; don't return to the mainline code
261 L82BB andcc #0xaf ; make sure interrupts are running
262 jsr LADEB ; do a BREAK/pause check
263 ldx CHARAD ; save input pointer
264 stx TINPTR
265 lda ,x+ ; get current input character
266 beq L82CF ; brif end of line
267 cmpa #': ; statement separator?
268 beq L82F1 ; brif so
269 jmp LB277 ; raise error we got here with extra junk
270 L82CF lda ,x++ ; get first byte of next line address
271 sta ENDFLG ; use it to set "END" flag to "END"
272 bne L82D8 ; brif not end of program
273 jmp LAE15 ; go do the "END"
274 L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text)
275 std CURLIN ; set current line number
276 stx CHARAD ; save input pointer
277 lda TRCFLG ; are we tracing?
278 beq L82F1 ; brif not
279 lda #'[ ; show opening marker for TRON line number
280 jsr PUTCHR
281 lda CURLIN ; restore MSB of line number
282 jsr LBDCC ; show line number
283 lda #'] ; show closing marker for TRON line number
284 jsr PUTCHR
285 L82F1 jsr GETNCH ; get the start of the statement
286 tfr cc,b ; save status flags
287 cmpa #0x98 ; is it CSAVE?
288 beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM)
289 cmpa #0x97 ; is it CLOAD?
290 beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries)
291 tfr b,cc ; restore character status
292 jsr LADC6 ; go process command
293 bra L82BB ; restart interpretation loop
294 ; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the
295 ; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This
296 ; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation
297 ; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all.
298 XVEC23 ldx 2,s ; get return address of caller to the tokenizer
299 cmpx #LAC9D ; is it coming from immediate mode prior to executing the line?
300 bne L8310 ; brif not
301 ldx #L82F1 ; force return to Extended Basic's main loop patch above
302 stx 2,s
303 L8310 rts
304 ; These two patches are set up this way so that control can be transferred back to the original Color Basic
305 ; implementations if the Extended Basic addons are not triggered.
306 L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler
307 bra L82BB ; go do another command
308 L8316 bsr L831A ; go do Extended Basic's CSAVE handler
309 bra L82BB ; go do another command
310 ; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have)
311 L831A jsr GETNCH ; get character after CSAVE
312 cmpa #'M ; is it CSAVEM?
313 lbne CSAVE ; brif not - Color Basic can handle this
314 jsr GETNCH ; eat the "M"
315 jsr LA578 ; parse file name
316 bsr L836C ; get start address
317 stx CASBUF+13 ; save it in file header
318 bsr L836C ; get end address
319 cmpx 2,s ; compare to start address
320 lblo LB44A ; brif end address is before the start address
321 bsr L836C ; get execution address
322 stx CASBUF+11 ; put in file header
323 jsr GETCCH ; are we at the end of the commmand?
324 bne L8310 ; brif not
325 lda #2 ; file type to machine language
326 ldx ZERO ; set to binary and single block
327 jsr LA65F ; write header
328 clr FILSTA ; mark any open tape file closed
329 inc BLKTYP ; set block type to data
330 jsr WRLDR ; write a data leader
331 ldx 4,s ; get starting address
332 L834D stx CBUFAD ; set start of data address
333 lda #255 ; try a full length block by default
334 sta BLKLEN
335 ldd 2,s ; get ending address
336 subd CBUFAD ; see how much is left
337 bhs L835E ; brif we have more to write
338 leas 6,s ; clean up stack
339 jmp LA491 ; write EOF block
340 L835E cmpd #255 ; do we have a full block left?
341 bhs L8367 ; brif so
342 incb ; set block size to remainder
343 stb BLKLEN
344 L8367 jsr SNDBLK ; write a data block
345 bra L834D ; go see if we have more to write
346 L836C jsr SYNCOMMA ; make sure we have a comma
347 jsr LB73D ; evaluate unsigned expression to X
348 ldu ,s ; get return address
349 stx ,s ; save result on stack
350 tfr u,pc ; return to caller
351 ; COS function
352 COS ldx #L83AB ; point to PI/2 constant
353 jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) )
354 L837E jmp SIN ; now calculate sin((pi/2)+x)
355 ; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X)
356 TAN jsr LBC2F ; save FPA0 in FPA3
357 clr RELFLG ; reset quadrant flag
358 bsr L837E ; calculate SIN(x)
359 ldx #V4A ; save result in FPA5
360 jsr LBC35
361 ldx #V40 ; get back original argument
362 jsr LBC14
363 clr FP0SGN ; force result positive
364 lda RELFLG ; get quadrant flag
365 bsr L83A6 ; calculate COS(x)
366 tst FP0EXP ; did we get 0 for COS(x)
367 lbeq LBA92 ; brif so - overflow
368 ldx #V4A ; point to sin(x)
369 L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value
370 L83A6 pshs a ; save sign flag
371 jmp LBFA6 ; expand polynomial
372 L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant
373 ; ATN function (inverse tangent). There are two calculation streams used to improve precision.
374 ; One if the parameter is >= 1.0 and the other if it is < 1.0
375 ATN lda FP0SGN ; get sign of argument
376 pshs a ; save it
377 bpl L83B8 ; brif positive
378 bsr L83DC ; flip sign of argument
379 L83B8 lda FP0EXP ; get exponent
380 pshs a ; save it
381 cmpa #0x81 ; exponent for 1.0
382 blo L83C5 ; brif less - value is less than 1.0
383 ldx #LBAC5 ; point to FP constant 1.0
384 bsr L83A3 ; calculate reciprocal
385 L83C5 ldx #L83E0 ; point to polynomical coefficients
386 jsr LBEF0 ; expand polynomial
387 puls a ; get exponent of argument
388 cmpa #0x81 ; did we do a reciprocal calculation?
389 blo L83D7 ; brif not
390 ldx #L83AB ; subtract result from pi/2 if we did
391 jsr LB9B9
392 L83D7 puls a ; get sign of original
393 tsta ; was it positive?
394 bpl L83DF ; brif so
395 L83DC jmp LBEE9 ; flip sign of result
396 L83DF rts
397 ; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly
398 ; 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
399 ; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with
400 ; fewer coefficients.
401 L83E0 fcb 11 ; 12 coefficients
402 fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912
403 fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216
404 fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018
405 fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381
406 fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328
407 fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965
408 fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954
409 fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413
410 fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808
411 fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121
412 fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316
413 fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0
414 ; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x)
415 L841D fcb 3 ; four coefficients
416 fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2)
417 fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2)
418 fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2)
419 fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2)
420 L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2)
421 L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2)
422 L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5
423 L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2)
424 ; LOG function (natural log, ln)
425 ; FP representation is of the form A*2^B. Thus, the log routine determines the value of
426 ; ln(A*2^B).
427 ;
428 ; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR:
429 ; (log2(A) + B)*ln(2)
430 ; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so:
431 ; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2)
432 ; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2)
433 ;
434 ; Everything except log2(A*sqrt(2)) is either constant or trivial.
435 ;
436 ; What the actual code below feeds into the modified taylor series is actually:
437 ; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1)
438 ;
439 ; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would
440 ; expect from the identities. However, the modified coefficients in the series above
441 ; could be correcting for that or the introduced error was deemed acceptable.
442 ; NOTE: this routine does NOT return 0 for LOG(1)
443 LOG jsr LBC6D ; get status of FPA0
444 lble LB44A ; brif <= 0 - logarithms don't exist in that case
445 ldx #L8432 ; point to 1/sqrt(2)
446 lda FP0EXP ; get exponent of argument
447 suba #0x80 ; remove bias
448 pshs a ; save it for later
449 lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description)
450 sta FP0EXP
451 jsr LB9C2 ; add 1/sqrt(2) to A
452 ldx #L8437 ; point to sqrt(2)
453 jsr LBB8F ; divide that by FPA0
454 ldx #LBAC5 ; point to 1.0
455 jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2)))
456 ldx #L841D ; point to coefficients
457 jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument)
458 ldx #L843C ; point to -0.5
459 jsr LB9C2 ; add result
460 puls b ; get original exponent back
461 jsr LBD99 ; add B to FPA0
462 ldx #L8441 ; point to ln(2)
463 jmp LBACA ; multiply by ln(2) which gives us the result in base e
464 ; SQR function (square root) - returns the principle root (positive)
465 SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation)
466 ldx #LBEC0 ; point to 0.5 (exponent for square root)
467 jsr LBC14 ; set up second argument to exponentiation (the exponent)
468 ; Exponentiation operator
469 ; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0
470 L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0)
471 tsta ; check that the base is not 0
472 bne L8491 ; brif base is not 0
473 jmp LBA3A ; 0^(nonzero) is 0
474 L8491 ldx #V4A ; save exponent (to FPA5)
475 jsr LBC35
476 clrb ; result sign will default to positive
477 lda FP1SGN ; check if base is positive
478 bpl L84AC ; brif so
479 jsr INT ; convert exponent to integer
480 ldx #V4A ; point to original expoent
481 lda FP1SGN ; get sign of FPA1
482 jsr LBCA0 ; compare original exponent with truncated one
483 bne L84AC ; brif not equal
484 coma ; flip sign
485 ldb CHARAC ; get LS byte of integer exponent (result sign flag)
486 L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign)
487 pshs b ; save result sign
488 jsr LOG ; get natural log of the base
489 ldx #V4A ; multiply the log by the exponent
490 jsr LBACA
491 bsr EXP ; now raise e to the resulting power
492 puls a ; get result sign
493 rora ; brif it was negative
494 lbcs LBEE9 ; brif negative - flip sign
495 rts
496 L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function)
497 ; Chebyshev modified taylor series coefficients for e^x
498 L84C9 fcb 7 ; eight coefficients
499 fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7))
500 fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6))
501 fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5))
502 fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4))
503 fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3))
504 fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2))
505 fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1))
506 fcb 0x81,0x00,0x00,0x00,0x00 ; 1
507 ; EXP function (e^x)
508 EXP ldx #L84C4 ; point to correction factor
509 jsr LBACA ; multiply it
510 jsr LBC2F ; save corrected argument to FPA3
511 lda FP0EXP ; get exponent of FPA0
512 cmpa #0x88 ; is it too big?
513 blo L8504 ; brif not
514 L8501 jmp LBB5C ; to 0 (underflow) or overflow error
515 L8504 jsr INT ; convert argument to an integer
516 lda CHARAC ; get ls byte of integer
517 adda #0x81 ; was argument 127? if so, the OV error; adds bias
518 beq L8501
519 deca ; adjust for the extra +1 above
520 pshs a ; save integer exponent
521 ldx #V40 ; get fractional part of argument
522 jsr LB9B9
523 ldx #L84C9 ; point to coefficients
524 jsr LBEFF ; evaluate polynomial on the fractional part
525 clr RESSGN ; force result to be positive
526 puls a ; get back original exponent
527 jsr LBB48 ; add original exponent to the fractional result
528 rts
529 ; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0)
530 FIX jsr LBC6D ; get status of argument
531 bmi L852C ; brif negative
532 L8529 jmp INT ; do regular "int" if positive
533 L852C com FP0SGN ; flip the sign
534 bsr L8529 ; do "INT" on this
535 jmp LBEE9 ; flip the sign back
536 ; EDIT command
537 EDIT jsr L89AE ; get line number
538 leas 2,s ; we're not going to return to the main loop
539 L8538 lda #1 ; "LIST" flag
540 sta VD8 ; set to list the line
541 jsr LAD01 ; find line number
542 lbcs LAED2 ; brif line wasn't found
543 jsr LB7C2 ; go unpack the line into the buffer
544 tfr y,d ; calculate the actual length of the line
545 subd #LINBUF+2
546 stb VD7 ; save line length (it will only be 8 bits)
547 L854D ldd BINVAL ; get the line number
548 jsr LBDCC ; display it
549 jsr LB9AC ; put a space after it
550 ldx #LINBUF+1 ; point to iput uffer
551 ldb VD8 ; are we listing?
552 bne L8581 ; brif so
553 L855C clrb ; reset digit accumulator
554 L855D jsr L8687 ; get a keypress
555 jsr L90AA ; set carry if not numeric
556 bcs L8570 ; brif not a number
557 suba #'0 ; remove ASCII bias
558 pshs a ; save digit value
559 lda #10 ; multiply accumulator by 10
560 mul
561 addb ,s+ ; add in new digit
562 bra L855D ; go check for another digit
563 L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1
564 adcb #1
565 cmpa #'A ; abort?
566 bne L857D ; brif not
567 jsr LB958 ; to a CR
568 bra L8538 ; restart EDIT process
569 L857D cmpa #'L ; list?
570 bne L858C ; brif not
571 L8581 bsr L85B4 ; list the line
572 clr VD8 ; reset to "not listing"
573 jsr LB958 ; do a CR
574 bra L854D ; start editing
575 L858A leas 2,s ; lose return address
576 L858C cmpa #0x0d ; ENTER?
577 bne L859D ; brif not
578 bsr L85B4 ; echo out the line
579 L8592 jsr LB958 ; do a CR
580 ldx #LINBUF+1 ; reset input pointer to start of buffer
581 stx CHARAD
582 jmp LACA8 ; join immediate mode to replace the line in the program
583 L859D cmpa #'E ; exit?
584 beq L8592 ; brif so - end edit with no echo
585 cmpa #'Q ; quit?
586 bne L85AB ; brif not
587 jsr LB958 ; do a CR
588 jmp LAC73 ; go to immediate mode with no fanfare - no changes saved
589 L85AB bsr L85AF ; go do commands
590 bra L855C ; go handle another command
591 L85AF cmpa #0x20 ; space?
592 bne L85C3 ; brif not
593 skip2
594 L85B4 ldb #LBUFMX-1 ; display up to a whole line
595 L85B6 lda ,x ; get buffer chracter
596 beq L85C2 ; brif end of line
597 jsr PUTCHR ; output character
598 leax 1,x ; move to next character
599 decb ; done?
600 bne L85B6 ; brif not
601 L85C2 rts
602 L85C3 cmpa #'D ; delete?
603 bne L860F ; brif not
604 L85C7 tst ,x ; end of line?
605 beq L85C2 ; brif so - can't delete
606 bsr L85D1 ; remove a character
607 decb ; done all requested?
608 bne L85C7 ; brif not
609 rts
610 L85D1 dec VD7 ; account for character being removed
611 leay -1,x ; set pointer and compensate for increment below
612 L85D5 leay 1,y ; move to next character
613 lda 1,y ; get next character
614 sta ,y ; move it forward
615 bne L85D5 ; brif we didn't hit the end of the buffer
616 rts
617 L85DE cmpa #'I ; insert?
618 beq L85F5 ; brif so
619 cmpa #'X ; extend?
620 beq L85F3 ; brif so
621 cmpa #'H ; "hack"?
622 bne L8646 ; brif not
623 clr ,x ; mark current location as end of line
624 tfr x,d ; calculate new line length
625 subd #LINBUF+2
626 stb VD7 ; save new length
627 L85F3 bsr L85B4 ; display the line
628 L85F5 jsr L8687 ; read a character
629 cmpa #0x0d ; ENTER?
630 beq L858A ; brif so - terminate entry
631 cmpa #0x1b ; ESC?
632 beq L8625 ; brif so - back to command mode
633 cmpa #0x08 ; backspace?
634 bne L8626 ; brif no
635 cmpx #LINBUF+1 ; are we at the start of the buffer?
636 beq L85F5 ; brif so - it's a no-op
637 bsr L8650 ; move pointer back one, do a BS
638 bsr L85D1 ; remove character from the buffer
639 bra L85F5 ; go handle more input
640 L860F cmpa #'C ; change?
641 bne L85DE ; brif not
642 L8613 tst ,x ; is there something to change?
643 beq L8625 ; brif not
644 jsr L8687 ; get a key stroke
645 bcs L861E ; brif valid key
646 bra L8613 ; try again if invalid key
647 L861E sta ,x+ ; put new character in the buffer
648 bsr L8659 ; echo it
649 decb ; changed number requested?
650 bne L8613 ; brif not
651 L8625 rts
652 L8626 ldb VD7 ; get length of line
653 cmpb #LBUFMX-1 ; at maximum line length?
654 bne L862E ; brif not
655 bra L85F5 ; process another input character
656 L862E pshs x ; save input pointer
657 L8630 tst ,x+ ; are we at the end of the line?
658 bne L8630 ; brif not
659 L8634 ldb ,-x ; get character before current pointer, move back
660 stb 1,x ; move it forward
661 cmpx ,s ; at the original buffer pointer?
662 bne L8634 ; brif not
663 leas 2,s ; remove saved buffer pointer
664 sta ,x+ ; save input character in newly made hole
665 bsr L8659 ; echo it
666 inc VD7 ; bump line length counter
667 bra L85F5 ; go handle more stuff
668 L8646 cmpa #0x08 ; backspace?
669 bne L865C ; brif not
670 L864A bsr L8650 ; move pointer back, echo BS
671 decb ; done enough of them?
672 bne L864A ; brif not
673 rts
674 L8650 cmpx #LINBUF+1 ; at start of buffer?
675 beq L8625 ; brif so
676 leax -1,x ; move pointer back
677 lda #0x08 ; character to echo - BS
678 L8659 jmp PUTCHR ; echo character to screen
679 L865C cmpa #'K ; "kill"?
680 beq L8665 ; brif so
681 suba #'S ; search?
682 beq L8665 ; brif so
683 rts
684 L8665 pshs a ; save kill/search flag
685 bsr L8687 ; read target
686 pshs a ; save search character
687 L866B lda ,x ; get current character in buffer
688 beq L8685 ; brif end of line - nothing more to search
689 tst 1,s ; is it KILL?
690 bne L8679 ; brif so
691 bsr L8659 ; echo the character
692 leax 1,x ; move ahead
693 bra L867C ; check next character
694 L8679 jsr L85D1 ; remove character from buffer
695 L867C lda ,x ; get character in buffer
696 cmpa ,s ; are we at the target?
697 bne L866B ; brif not
698 decb ; have we found enough of them?
699 bne L866B ; brif not
700 L8685 puls y,pc ; clean up stack and return to main EDIT routine
701 L8687 jsr LA171 ; get input from the generic input handler (will show the cursor)
702 cmpa #0x7f ; graphics (or DEL)?
703 bhs L8687 ; brif so - ignore it
704 cmpa #0x5f ; SHIFT-UP?
705 bne L8694 ; brif not
706 lda #0x1b ; replace with ESC
707 L8694 cmpa #0x0d ; carriage return?
708 beq L86A6 ; brif so (C=0)
709 cmpa #0x1b ; ESC
710 beq L86A6 ; brif so (C=0)
711 cmpa #0x08 ; backspace?
712 beq L86A6 ; brif so (C=0)
713 cmpa #32 ; control code?
714 blo L8687 ; brif control code - try again
715 orcc #1 ; set C for "valid" (printable) character
716 L86A6 rts
717 ; TRON and TROFF commands
718 TRON skip1lda ; load flag with nonzero for trace enabled (and skip next)
719 TROFF clra ; clear flag for trace disabled
720 sta TRCFLG ; save trace status
721 rts
722 ; POS function
723 POS lda DEVNUM ; get original device number
724 pshs a ; save it for later
725 jsr LA5AE ; fetch device number
726 jsr LA406 ; check for open file
727 jsr LA35F ; set up print parameters
728 ldb DEVPOS ; get current line position for the device
729 jmp LA5E4 ; return position in B as unsigned
730 ; VARPTR function
731 VARPTRTOK jsr LB26A ; make sure we have (
732 ldd ARYEND ; get address of end of arrays
733 pshs d ; save it
734 jsr LB357 ; parse variable descriptor
735 jsr LB267 ; make sure there is a )
736 puls d ; get original end of arrays
737 exg x,d ; swap original end of arrays and the discovered variable pointer
738 cmpx ARYEND ; did array end move (variable created?)
739 bne L8724 ; brif so (FC error)
740 jmp GIVABF ; return the pointer (NOTE: as signed)
741 ; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter
742 ; than the specified size, only the number of characters actually in the replacement will be used.
743 L86D6 jsr GETNCH ; eat the MID$ token
744 jsr LB26A ; force (
745 jsr LB357 ; evaluate the variable
746 pshs x ; save variable descriptor
747 ldd 2,x ; point to start of original string
748 cmpd FRETOP ; is it in string space?
749 bls L86EB ; brif not
750 subd MEMSIZ ; is it still in string space (top end)?
751 bls L86FD ; brif so
752 L86EB ldb ,x ; get length of original string
753 jsr LB56D ; allocate space in string space
754 pshs x ; save pointer to string space
755 ldx 2,s ; get to original string descriptor
756 jsr LB643 ; move the string into string space
757 puls x,u ; get new string address and string descriptor
758 stx 2,u ; save new data address for the string
759 pshs u ; save descriptor address again
760 L86FD jsr LB738 ; evaluate ",start"
761 pshs b ; save start offset
762 tstb ; is start 0?
763 beq L8724 ; brif so - strings offsets are 1-based
764 ldb #255 ; default use the entire string
765 cmpa #') ; end of parameters?
766 beq L870E ; brif so
767 jsr LB738 ; evaluate ",length"
768 L870E pshs b ; save length
769 jsr LB267 ; make sure we have a )
770 ldb #0xb3 ; make sure we have =
771 jsr LB26F
772 bsr L8748 ; evaluate replacement string
773 tfr x,u ; save replacement string address
774 ldx 2,s ; get original string descriptor
775 lda ,x ; get length of original string
776 suba 1,s ; subtract start position
777 bhs L8727 ; brif within the string - insert replacement
778 L8724 jmp LB44A ; raise illegal function call
779 L8727 inca ; A is now number of characters to the right of the position parameter
780 cmpa ,s ; compare to length desired
781 bhs L872E ; brif new length fits
782 sta ,s ; only use as much of the length as will fit
783 L872E lda 1,s ; get position offset
784 exg a,b ; swap replacement length and position
785 ldx 2,x ; point to original string address
786 decb ; we work with 0-based offsets
787 abx ; now X points to start of replacement
788 tsta ; replacing 0?
789 beq L8746 ; brif so - done
790 cmpa ,s ; is replacement shorter than the hole?
791 bls L873F ; brif so
792 lda ,s ; use copy the maximum number specified
793 L873F tfr a,b ; save number to move in B
794 exg u,x ; swap pointers so they are right for the routine
795 jsr LA59A ; copy string data
796 L8746 puls a,b,x,pc ; clean up stack and return
797 L8748 jsr LB156 ; evaluate expression
798 jmp LB654 ; make sure it's a string and return string details
799 ; STRING$ function
800 STRING jsr LB26A ; make sure we have (
801 jsr EVALEXPB ; evaluate repeat count (error if > 255)
802 pshs b ; save repeat count
803 jsr SYNCOMMA ; make sure there's a comma
804 jsr LB156 ; evaluate the thing to repeat
805 jsr LB267 ; make sure we have a )
806 lda VALTYP ; is it string?
807 bne L8768 ; brif so
808 jsr LB70E ; get 8 bit character code
809 bra L876B ; use that
810 L8768 jsr LB6A4 ; get first character of string
811 L876B pshs b ; save repeat character
812 ldb 1,s ; get repeat count
813 jsr LB50F ; reserve space for the string
814 puls a,b ; get character and repeat count
815 beq L877B ; brif NULL string
816 L8776 sta ,x+ ; put character into string
817 decb ; put enough?
818 bne L8776 ; brif not
819 L877B jmp LB69B ; return the newly created string
820 ; INSTR function
821 INSTR jsr LB26A ; evaluate (
822 jsr LB156 ; evaluate first argument
823 ldb #1 ; default start position is 1 (start of string)
824 pshs b ; save start position
825 lda VALTYP ; get type of first argument
826 bne L879C ; brif string - use default starting position
827 jsr LB70E ; convert first argument into string offset
828 stb ,s ; save offset
829 beq L8724 ; brif starting at 0 - not allowed
830 jsr SYNCOMMA ; make sure there's a comma
831 jsr LB156 ; evaluate the search string
832 jsr LB146 ; make sure it *is* a string
833 L879C ldx FPA0+2 ; get search string descriptor
834 pshs x ; save it
835 jsr SYNCOMMA ; make sure we have a comma
836 jsr L8748 ; evalute the target string
837 pshs x,b ; save address and length of target string
838 jsr LB267 ; make sure we have a )
839 ldx 3,s ; get search string address
840 jsr LB659 ; get string details
841 pshs b ; save search string length
842 cmpb 6,s ; compare length of search string to the start
843 blo L87D9 ; brif start position is beyond the search string - return 0
844 lda 1,s ; get length of target string
845 beq L87D6 ; brif targetstring is NULL - match will be immediate
846 ldb 6,s ; get start position
847 decb ; zero-base it
848 abx ; now X points to the start position for the search
849 L87BE leay ,x ; point to start of search
850 ldu 2,s ; get target string pointer
851 ldb 1,s ; get targetlength
852 lda ,s ; get length of serach
853 suba 6,s ; see how much is left in searh
854 inca ; add one for "inclusivity"
855 cmpa 1,s ; do we have less than the target string?
856 blo L87D9 ; brif so - we obviously won't match
857 L87CD lda ,x+ ; compare a byte
858 cmpa ,u+
859 bne L87DF ; brif no match
860 decb ; compared all of target?
861 bne L87CD ; brif not
862 L87D6 ldb 6,s ; get position where we matched
863 skip1
864 L87D9 clrb ; flag no match
865 leas 7,s ; clean up stack
866 jmp LB4F3 ; return unsigned B
867 L87DF inc 6,s ; bump start position
868 leax 1,y ; move starting pointer
869 bra L87BE ; see if we match now
870 ; Number parsing handler
871 XVEC19 cmpa #'& ; do we have & (hex or octal)?
872 L87E7 bne L8845 ; brif not
873 leas 2,s ; we won't return to the original invoker
874 L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value
875 clr FPA0+3
876 ldx #FPA0+2 ; point to accumulator
877 jsr GETNCH ; eat the &
878 cmpa #'O ; octal?
879 beq L880A ; brif so
880 cmpa #'H ; hex?
881 beq L881F ; brif so
882 jsr GETCCH ; reset flags on input
883 bra L880C ; go process octal (default)
884 L8800 cmpa #'8 ; is it a valid octal character?
885 lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7)
886 ldb #3 ; base 8 multiplier
887 bsr L8834 ; add digit to accumulator
888 L880A jsr GETNCH ; get input character
889 L880C bcs L8800 ; brif numeric
890 L880E clr FPA0 ; clear upper bytes of FPA0
891 clr FPA0+1
892 clr VALTYP ; result is numeric
893 clr FPSBYT ; clear out any extra precision
894 clr FP0SGN ; make it positive
895 ldb #0xa0 ; exponent for integer aligned to right of FPA0
896 stb FP0EXP
897 jmp LBA1C ; go normalize the result and return
898 L881F jsr GETNCH ; get input character
899 bcs L882E ; brif digit
900 jsr LB3A2 ; set carry if not alpha
901 L8826 bcs L880E ; brif not alpha
902 cmpa #'G ; is it valid HEX digit?
903 bhs L880E ; brif not
904 suba #7 ; normalize A-F to be just above 0-9
905 L882E ldb #4 ; four bits per digit
906 bsr L8834 ; add digit to accumlator
907 bra L881F ; process another digit
908 L8834 asl 1,x ; shift accumulator one bit left
909 rol ,x
910 lbcs LBA92 ; brif too big - overflow
911 decb ; done enough bit shifts?
912 bne L8834 ; brif not
913 L883F suba #'0 ; remove ASCII bias
914 adda 1,x ; merge digit into accumlator (this cannot cause carry)
915 sta 1,x
916 L8845 rts
917 ; Expression evaluation handler
918 XVEC15 puls u ; get back return address
919 clr VALTYP ; set result to numeric
920 ldx CHARAD ; save input pointer
921 jsr GETNCH ; get the input character
922 cmpa #'& ; HEX or OCTAL?
923 beq L87EB ; brif so
924 cmpa #0xcc ; FN?
925 beq L88B4 ; brif so - do "FNx()"
926 cmpa #0xff ; function token?
927 bne L8862 ; brif not
928 jsr GETNCH ; get function token value
929 cmpa #0x83 ; USR?
930 lbeq L892C ; brif so - short circuit Color Basic's USR handler
931 L8862 stx CHARAD ; restore input pointer
932 jmp ,u ; return to mainline code
933 L8866 ldx CURLIN ; are we in immediate mode?
934 leax 1,x
935 L886A bne L8845 ; brif not - we're good
936 ldb #2*11 ; code for illegal direct statement
937 L886E jmp LAC46 ; raise error
938 ; DEF command (DEF FN, DEF USR)
939 DEF ldx [CHARAD] ; get two input characters
940 cmpx #0xff83 ; USR?
941 lbeq L890F ; brif so - do DEF USR
942 bsr L88A1 ; get descriptor address for FN variable
943 bsr L8866 ; disallow DEF FN in immediate mode
944 jsr LB26A ; make sure we have (
945 ldb #0x80 ; disallow arrays as arguments
946 stb ARYDIS
947 jsr LB357 ; evaluate variable
948 bsr L88B1 ; make sure it's numeric
949 jsr LB267 ; make sure we have )
950 ldb #0xb3 ; make sure we have =
951 jsr LB26F
952 ldx V4B ; get variable descriptor address
953 ldd CHARAD ; get input pointer
954 std ,x ; save address of the actual function code in variable descriptor
955 ldd VARPTR ; get descriptor address of argument
956 std 2,x ; save argument descriptor address
957 jmp DATA ; move to the end of this statement
958 L88A1 ldb #0xcc ; make sure we have FN
959 jsr LB26F
960 ldb #0x80 ; disable array lookup
961 stb ARYDIS
962 ora #0x80 ; set bit 7 of first character (to indicate FN variable)
963 jsr LB35C ; find the variable
964 stx V4B ; save descriptor pointer
965 L88B1 jmp LB143 ; make sure we have a numeric variable
966 ; Evaluate an FN call
967 L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor
968 pshs x ; save descriptor
969 jsr LB262 ; evaluate parameter
970 bsr L88B1 ; make sure it's a number
971 puls u ; get FN descriptor
972 ldb #2*25 ; code for undefined function
973 ldx 2,u ; point to argument variable descriptor
974 beq L886E ; brif nothing doing there (if it was just created, this will be NULL)
975 ldy CHARAD ; save current input pointer
976 ldu ,u ; point to start of FN definition
977 stu CHARAD ; put input pointer there
978 lda 4,x ; save original value of argument and save it with current input, and variable pointers
979 pshs a
980 ldd ,x
981 ldu 2,x
982 pshs u,y,x,d
983 jsr LBC35 ; set argument variable to the argument
984 L88D9 jsr LB141 ; go evaluate the FN expression
985 puls d,x,y,u ; get back variable pointers, input pointer, and original variable value
986 std ,x
987 stu 2,x
988 puls a
989 sta 4,x
990 jsr GETCCH ; test end of FN formula
991 lbne LB277 ; brif not end of statement - problem with the function
992 sty CHARAD ; restore input pointer
993 L88EF rts
994 ; Error handler
995 XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code?
996 blo L88EF ; brif not - return to mainline
997 jsr LA7E9 ; turn off tape
998 jsr LA974 ; turn off sound
999 jsr LAD33 ; clean up stack and other bits
1000 clr DEVNUM ; reset output to screen
1001 jsr LB95C ; do a newline if needed
1002 jsr LB9AF ; do a ?
1003 ldx #L890B-25*2 ; point to error message table
1004 jmp LAC60 ; go display error message
1005 ; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the
1006 ; Disk Basic documentation. It is here for the use of DLOAD.
1007 L890B fcc 'UF' ; 25 undefined function call
1008 fcc 'NE' ; 26 File not found
1009 ; DEF USR
1010 L890F jsr GETNCH ; eat the USR token
1011 bsr L891C ; get pointer to USR call
1012 pshs x ; save FN exec address location
1013 bsr L8944 ; calculate execution address
1014 puls u ; get FN address pointer
1015 stx ,u ; save new address
1016 rts
1017 L891C clrb ; default routine number is 0
1018 jsr GETNCH ; fetch the call number
1019 bcc L8927 ; brif not a number
1020 suba #'0 ; remove ASCII bias
1021 tfr a,b ; save it in the right place
1022 jsr GETNCH ; eat the call number
1023 L8927 ldx USRADR ; get start address of USR jump table
1024 aslb ; two bytes per address
1025 abx ; now X points to the right entry
1026 rts
1027 ; Evaluate a USR call
1028 L892C bsr L891C ; find the correct routine address location
1029 ldx ,x ; get routine address
1030 pshs x ; save it
1031 jsr LB262 ; evaluate argument
1032 ldx #FP0EXP ; point to FPA0 (argument value)
1033 lda VALTYP ; is it string?
1034 beq L8943 ; brif not
1035 jsr LB657 ; fetch string details (removes it from the string stack)
1036 ldx FPA0+2 ; get string descriptor pointer
1037 lda VALTYP ; set flags for the value type
1038 L8943 rts ; call the routine and return to mainline code
1039 L8944 ldb #0xb3 ; check for "="
1040 jsr LB26F
1041 jmp LB73D ; evaluate integer expression to X and return
1042 ; Extended Basic IRQ handler
1043 XIRQSV lda PIA0+3 ; is it VSYNC interrupt?
1044 bmi L8952 ; brif so
1045 rti ; really should clear the HSYNC interrupt here
1046 L8952 lda PIA0+2 ; clear VSYNC interrupt
1047 ldx TIMVAL ; increment the TIMER value
1048 leax 1,x
1049 stx TIMVAL
1050 jmp L9C3E ; check for other stuff
1051 ; TIMER=
1052 L8960 jsr GETNCH ; eat the TIMER token
1053 bsr L8944 ; evaluate =nnnn to X
1054 stx TIMVAL ; set the timer
1055 rts
1056 ; TIMER function
1057 TIMER ldx TIMVAL ; get timer value
1058 stx FPA0+2 ; set it in FPA0
1059 jmp L880E ; return as positive 16 bit value
1060 ; DEL command
1061 DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0)
1062 jsr LAF67 ; parse line number
1063 jsr LAD01 ; find line
1064 stx VD3 ; save address of line
1065 jsr GETCCH ; is there something more?
1066 beq L8990 ; brif not
1067 cmpa #0xac ; dash?
1068 bne L89BF ; brif not - error out
1069 jsr GETNCH ; each the -
1070 beq L898C ; brif no ending line - use default line number
1071 bsr L89AE ; parse second line number and save in BINVAL
1072 bra L8990 ; do the deletion
1073 L898C lda #0xff ; set to maximum line number
1074 sta BINVAL
1075 L8990 ldu VD3 ; point end to start
1076 skip2
1077 L8993 ldu ,u ; point to start of next line
1078 ldd ,u ; check for end of program
1079 beq L899F ; brif end of program
1080 ldd 2,u ; get line number
1081 subd BINVAL ; is it in range?
1082 bls L8993 ; brif so
1083 L899F ldx VD3 ; get starting line address
1084 bsr L89B8 ; close up gap
1085 jsr LAD21 ; reset input pointer and erase variables
1086 ldx VD3 ; get start of program after the deletion
1087 jsr LACF1 ; recompute netl ine pointers
1088 jmp LAC73 ; return to immediate mode
1089 L89AE jsr LAF67 ; parse a line number
1090 jmp LA5C7 ; make sure there's nothing more
1091 L89B4 lda ,u+ ; copy a byte
1092 sta ,x+
1093 L89B8 cmpu VARTAB ; end of program?
1094 bne L89B4 ; brif not
1095 stx VARTAB ; save new start of variables/end of program
1096 L89BF rts
1097 ; LINE INPUT
1098 L89C0 jsr L8866 ; raise error if in immediate mode
1099 jsr GETNCH ; eat the "INPUT" token
1100 cmpa #'# ; device number?
1101 bne L89D2 ; brif not
1102 jsr LA5A5 ; parse device number
1103 jsr LA3ED ; make sure it's valid for input
1104 jsr SYNCOMMA ; make sure there's a comma after the device number
1105 L89D2 cmpa #'" ; is there a prompt?
1106 bne L89E1 ; brif not
1107 jsr LB244 ; parse the string
1108 ldb #'; ; make sure there's a semicolon after the prompt
1109 jsr LB26F
1110 jsr LB99F ; go actually display the prompt
1111 L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right)
1112 jsr LB035 ; read an input line from current device
1113 leas 2,s ; clean up stack
1114 clr DEVNUM ; reset to screen/keyboard
1115 jsr LB357 ; parse a variable
1116 stx VARDES ; save pointer to it
1117 jsr LB146 ; make sure it's a string
1118 ldx #LINBUF ; point to input buffer
1119 clra ; make sure we terminate on NUL only
1120 jsr LB51A ; parse string and store it in string space
1121 jmp LAFA4 ; go assign the string to its final resting place
1122 ; RENUM command
1123 L89FC jsr LAF67 ; read a line number
1124 ldx BINVAL ; get value
1125 rts
1126 L8A02 ldx VD1 ; get current old number being renumbered
1127 L8A04 stx BINVAL ; save number being searched for
1128 jmp LAD01 ; go find line number
1129 RENUM jsr LAD26 ; erase variables
1130 ldd #10 ; default line number interval and start
1131 std VD5 ; set starting line number
1132 std VCF ; set number interval
1133 clrb ; now D is 0
1134 std VD1 ; save default start for renumbering
1135 jsr GETCCH ; are there any arguments
1136 bcc L8A20 ; brif not numeric
1137 bsr L89FC ; fetch line number
1138 stx VD5 ; save line beginning number
1139 jsr GETCCH ; get input character
1140 L8A20 beq L8A3D ; brif end of line
1141 jsr SYNCOMMA ; make sure we have a comma
1142 bcc L8A2D ; brif next isn't numeric
1143 bsr L89FC ; fetch starting line number
1144 stx VD1 ; save the number where we start working
1145 jsr GETCCH ; fetch input character
1146 L8A2D beq L8A3D ; brif end of line
1147 jsr SYNCOMMA ; make sure we have a comma
1148 bcc L8A3A ; brif we don't have a number
1149 bsr L89FC ; parse the number
1150 stx VCF ; save interval
1151 beq L8A83 ; brif we ave a zero interval
1152 L8A3A jsr LA5C7 ; raise error if more stuff
1153 L8A3D bsr L8A02 ; get address of old number to process
1154 stx VD3 ; save address
1155 ldx VD5 ; get the next renumbered line to use
1156 bsr L8A04 ; find that line
1157 cmpx VD3 ; is it before the previous one?
1158 blo L8A83 ; brif so - raise error
1159 bsr L8A67 ; make sure renumbered line numbers will be in range
1160 jsr L8ADD ; convert line numbers to "expanded" binary
1161 jsr LACEF ; recalculate next line pointers
1162 bsr L8A02 ; get address of first line to renumber
1163 stx VD3 ; save it
1164 bsr L8A91 ; make sure line numbers exist
1165 bsr L8A68 ; renumber the actual lines
1166 bsr L8A91 ; update line numbers in program text
1167 jsr L8B7B ; convert packed binary line numbers to text
1168 jsr LAD26 ; erase variables, reset stack, etc.
1169 jsr LACEF ; recalculate next line pointers
1170 jmp LAC73 ; bounce back to immediate mode
1171 L8A67 skip1lda ; set line number flag to nonzero (skip next instruction)
1172 L8A68 clra ; set line number flag to zero (insert new numbers)
1173 sta VD8 ; save line number flag
1174 ldx VD3 ; get address of line being renumbered
1175 ldd VD5 ; get the current renumbering number
1176 bsr L8A86 ; return if end of program
1177 L8A71 tst VD8 ; test line number flag
1178 bne L8A77 ; brif not adding new numbers
1179 std 2,x ; set new number
1180 L8A77 ldx ,x ; point to next line
1181 bsr L8A86 ; return if end of program
1182 addd VCF ; add interval to current number
1183 bcs L8A83 ; brif we overflowed - bad line number
1184 cmpa #MAXLIN ; maximum legal number?
1185 blo L8A71 ; brif so - do another
1186 L8A83 jmp LB44A ; raise FC error
1187 L8A86 pshs d ; save D (we're going to clobber it)
1188 ldd ,x ; get next line pointer
1189 puls d ; unclobber D
1190 bne L8A90 ; brif not end of program
1191 leas 2,s ; return to caller's caller
1192 L8A90 rts
1193 L8A91 ldx TXTTAB ; get start of program
1194 leax -1,x ; move pointer back one (compensate for leax 1,x below)
1195 L8A95 leax 1,x ; move to next line
1196 bsr L8A86 ; return if end of program
1197 L8A99 leax 3,x ; move past next line address and line number, go one before line
1198 L8A9B leax 1,x ; move to next character
1199 lda ,x ; check input character
1200 beq L8A95 ; brif end of line
1201 stx TEMPTR ; save current pointer
1202 deca ; is it start of packed numeric line number?
1203 beq L8AB2 ; brif so
1204 deca ; does line exist?
1205 beq L8AD3 ; brif line number exists
1206 deca ; not part of something to process?
1207 bne L8A9B ; brif so
1208 L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing
1209 sta ,x+
1210 bra L8A99 ; go process another
1211 L8AB2 ldd 1,x ; get MSB of line number
1212 dec 2,x ; is MS byte zero?
1213 beq L8AB9 ; brif not
1214 clra ; set MS byte to 0
1215 L8AB9 ldb 3,x ; get LSB of line number
1216 dec 4,x ; is it zero?
1217 beq L8AC0 ; brif not
1218 clrb ; clear byte
1219 L8AC0 std 1,x ; save binary number
1220 std BINVAL ; save trial number
1221 jsr LAD01 ; find the line number
1222 L8AC7 ldx TEMPTR ; get start of packed line
1223 bcs L8AAC ; brif line number not found
1224 ldd V47 ; get address of line number
1225 inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting
1226 std ,x ; save address of correct number
1227 bra L8A99 ; go process more
1228 L8AD3 clr ,x ; clear carry and first byte
1229 ldx 1,x ; point to address of correct line
1230 ldx 2,x ; get correct line number
1231 stx V47 ; save it
1232 bra L8AC7 ; insert into line
1233 L8ADD ldx TXTTAB ; get beginning of program
1234 bra L8AE5
1235 L8AE1 ldx CHARAD ; get input pointer
1236 leax 1,x ; move it forward
1237 L8AE5 bsr L8A86 ; return if end of program
1238 leax 2,x ; move past line address
1239 L8AE9 leax 1,x ; move forward
1240 L8AEB stx CHARAD ; save input pointer
1241 L8AED jsr GETNCH ; get an input character
1242 L8AEF tsta ; is it actual 0?
1243 beq L8AE1 ; brif end of line
1244 bpl L8AED ; brif not a token
1245 ldx CHARAD ; get input pointer
1246 cmpa #0xff ; function?
1247 beq L8AE9 ; brif so - ignore it (and following byte)
1248 jsr RVEC22 ; do the RAM hook thing
1249 cmpa #0xa7 ; THEN?
1250 beq L8B13 ; brif so
1251 cmpa #0x84 ; ELSE?
1252 beq L8B13 ; brif so
1253 cmpa #0x81 ; GO(TO|SUB)?
1254 bne L8AED ; brif not - we don't have a line number
1255 jsr GETNCH ; get TO/SUB
1256 cmpa #0xa5 ; GOTO?
1257 beq L8B13 ; brif so
1258 cmpa #0xa6 ; GOSUB?
1259 bne L8AEB ; brif not
1260 L8B13 jsr GETNCH ; fetch character after token
1261 bcs L8B1B ; brif numeric (line number)
1262 L8B17 jsr GETCCH ; set flags on input character
1263 bra L8AEF ; keep checking for line numbers
1264 L8B1B ldx CHARAD ; get input pointer
1265 pshs x ; save it
1266 jsr LAF67 ; parse line number
1267 ldx CHARAD ; get input pointer after line
1268 L8B24 lda ,-x ; get character before pointer
1269 jsr L90AA ; set C if numeric
1270 bcs L8B24 ; brif not numeric
1271 leax 1,x ; move pointer up
1272 tfr x,d ; calculate size of line number
1273 subb 1,s
1274 subb #5 ; make sure at least 5 bytes
1275 beq L8B55 ; brif exactly 5 bytes - no change
1276 blo L8B41 ; brif less than 5 bytes
1277 leau ,x ; move remainder of program backward
1278 negb ; negate extra number of bytes (to subtract from X)
1279 leax b,x ; now X is the correct position to move program to
1280 jsr L89B8 ; shift program backward
1281 bra L8B55
1282 L8B41 stx V47 ; save end of line number space (end of copy)
1283 ldx VARTAB ; get end of program
1284 stx V43 ; set source pointer
1285 negb ; get positive difference
1286 leax b,x ; now X is the top of the destination block
1287 stx V41 ; set copy destination
1288 stx VARTAB ; save new end of program
1289 jsr LAC1E ; make sure enough room and make a hole in the program
1290 ldx V45 ; get end address of destination block
1291 stx CHARAD ; set input there
1292 L8B55 puls x ; get starting address of the line number
1293 lda #1 ; set "new number" flag
1294 sta ,x
1295 sta 2,x
1296 sta 4,x
1297 ldb BINVAL ; get MS byte of line number
1298 bne L8B67 ; brif it is not zero
1299 ldb #1 ; set to 1 if MSB is 0
1300 inc 2,x ; flag MSB as 0
1301 L8B67 stb 1,x ; set MSB of line number
1302 ldb BINVAL+1 ; get LSB of number
1303 bne L8B71 ; brif nonzero
1304 ldb #1 ; set to 1 if LSB is 0
1305 inc 4,x ; flag LSB as 0
1306 L8B71 stb 3,x ; save LSB of line number
1307 jsr GETCCH ; get input character
1308 cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB)
1309 beq L8B13 ; brif so - process another
1310 bra L8B17 ; go look for more line numbers
1311 L8B7B ldx TXTTAB ; point to start of program
1312 leax -1,x ; move back (compensate for inc below)
1313 L8B7F leax 1,x ; move forward
1314 ldd 2,x ; get this line number
1315 std CURLIN ; save it (for error message)
1316 jsr L8A86 ; return if end of program
1317 leax 3,x ; skip address and line number, stay one before line text
1318 L8B8A leax 1,x ; move to next character
1319 L8B8C lda ,x ; get input character
1320 beq L8B7F ; brif end of line
1321 deca ; valid line new line number?
1322 beq L8BAE ; brif so
1323 suba #2 ; undefined line?
1324 bne L8B8A ; brif not
1325 pshs x ; save line number pointer
1326 ldx #L8BD9-1 ; show UL message
1327 jsr STRINOUT
1328 ldx ,s ; get input pointer
1329 ldd 1,x ; get undefined line number
1330 jsr LBDCC ; display line number
1331 jsr LBDC5 ; print out "IN XXXX"
1332 jsr LB958 ; do a newline
1333 puls x ; get input pointer back
1334 L8BAE pshs x ; save input pointer
1335 ldd 1,x ; get binary value of line number
1336 std FPA0+2 ; save it in FPA0
1337 jsr L880E ; adjust FPA0 as integer
1338 jsr LBDD9 ; convert to text string
1339 puls u ; get previous input pointer address
1340 ldb #5 ; each expanded line uses 5 bytes
1341 L8BBE leax 1,x ; move pointer forward (in string number) past sign
1342 lda ,x ; do we have a digit?
1343 beq L8BC9 ; brif not - end of number
1344 decb ; mark a byte consumed
1345 sta ,u+ ; put digit in program
1346 bra L8BBE ; copy another digit
1347 L8BC9 leax ,u ; point to address at end of text number
1348 tstb ; did number fill whole space?
1349 beq L8B8C ; brif so - move on
1350 leay ,u ; save end of number pointer
1351 leau b,u ; point to the end of the original expanded number
1352 jsr L89B8 ; close up gap in program
1353 leax ,y ; get end of line number pointer back
1354 bra L8B8C ; go process more
1355 L8BD9 fcn 'UL '
1356 ; HEX$ function
1357 HEXDOL jsr LB740 ; convert argument to positive integer
1358 ldx #STRBUF+2 ; point to string buffer
1359 ldb #4 ; convert 4 nibbles
1360 L8BE5 pshs b ; save nibble counter
1361 clrb ; clear digit accumulator
1362 lda #4 ; do 4 shifts
1363 L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B
1364 rol FPA0+2
1365 rolb
1366 deca ; done all shifts?
1367 bne L8BEA ; brif not
1368 tstb ; do we have a nonzero digit?
1369 bne L8BFF ; brif so
1370 lda ,s ; is it last digit?
1371 deca
1372 beq L8BFF ; brif so - keep the 0
1373 cmpx #STRBUF+2 ; is it a middle zero?
1374 beq L8C0B ; brif not
1375 L8BFF addb #'0 ; add ASCII bias
1376 cmpb #'9 ; above 9?
1377 bls L8C07 ; brif not
1378 addb #7 ; adjust into alpha range
1379 L8C07 stb ,x+ ; save digit in output
1380 clr ,x ; make sure we have a NUL term
1381 L8C0B puls b ; get back nibble counter
1382 decb ; done all?
1383 bne L8BE5 ; brif not
1384 leas 2,s ; don't return mainline (we're returning a string)
1385 ldx #STRBUF+1 ; point to start of converted number
1386 jmp LB518 ; save string in string space, etc., and return it
1387 ; DLOAD command; this is eliminated on the Coco3. It was basically useless anyway so it was
1388 ; a good candidate to overwrite for some extra code space in the lower 16K of the internal
1389 ; ROM. Now, DLOAD functions as another entry into the RESET sequence.
1390 DLOAD jsr LA429 ; close tape file
1391 L8C1B orcc #0x50 ; make sure interrupts are disabled
1392 lda #MC3+MC1 ; disable MMU, 32K internal ROM, not "coco" compatible
1393 sta INIT0
1394 clr TYCLR ; go to ROM mapping mode
1395 jmp SC000 ; transfer control to the "hidden" init code
1396 L8C28 clr INT.FLAG ; set the interrupt flag to not valid
1397 clr PIA1+3 ; disable cartridge interrupt
1398 L8C2E lda #COCO+MMUEN+MC3+MC2 ; enable SCS, 16K split, MMU, COCO mode
1399 sta INIT0
1400 clr TYCLR ; go to ROM mode
1401 L8C36 rts
1402 L8C37 pshs a,b,x ; save registers
1403 ldx CURPOS ; get cursor position
1404 ldb HRWIDTH ; hi-res mode?
1405 lbne ALINK22 ; brif so
1406 ldb 1,s ; restore B
1407 jmp LA30E ; go back to mainline code
1408 L8C46 pshs cc ; save Z
1409 tst HRWIDTH ; hi-res?
1410 beq L8C4F ; brif not
1411 jmp ALINK23 ; go to hi-res handler
1412 L8C4F puls cc ; get back Z
1413 jmp LA913 ; go back to mainline code
1414 nop
1415 fcb 0xc7 ; junk byte (too few NOPs above)
1416 ; This returns to the remainder of the original ECB 1.1 DLOAD code
1417 tstb ; ASCII?
1418 beq L8C5F ; brif not - do error
1419 jsr LAD19 ; clear out program
1420 jmp LAC7C ; go read program
1421 L8C5F jmp LA616 ; raise bad file mode
1422 ; CLOADM patch for Extended Basic
1423 L8C62 jsr GETNCH ; get character after CLOAD
1424 cmpa #'M ; CLOADM?
1425 lbne CLOAD ; brif not - Color Basic's CLOAD can handle it
1426 clr FILSTA ; close tape file
1427 jsr GETNCH ; eat the "M"
1428 jsr LA578 ; parse file name
1429 jsr LA648 ; find the file
1430 tst CASBUF+10 ; is it a chunked file?
1431 lbeq LA505 ; brif not - Color Basic's CLOADM can handle it
1432 ldu CASBUF+8 ; get file type and ASCII flag
1433 dec DEVNUM ; set source device to tape
1434 jsr LA635 ; go read the first block
1435 tfr u,d ; put type and ASCII flag somewhere more useful
1436 ; NOTE: DLOADM comes here to do the final processing
1437 L8C85 subd #0x200 ; is it binary and "machine language"?
1438 bne L8C5F ; brif not - raise an error
1439 ldx ZERO ; default load offset
1440 jsr GETCCH ; is there any offset?
1441 beq L8C96 ; brif not
1442 jsr SYNCOMMA ; make sure there's a comma
1443 jsr LB73D ; evaluate offset in X
1444 L8C96 stx VD3 ; save offset
1445 jsr LA5C7 ; raise error if more stuff follows
1446 L8C9B bsr L8CC6 ; get type of "amble"
1447 pshs a ; save it
1448 bsr L8CBF ; read in block length
1449 tfr d,y ; save it
1450 bsr L8CBF ; read in load address
1451 addd VD3 ; add in offset
1452 std EXECJP ; save it as the execution address
1453 tfr d,x ; put load address in a pointer
1454 lda ,s+ ; get "amble" type
1455 lbne LA42D ; brif postamble - close file
1456 L8CB1 bsr L8CC6 ; read a data byte
1457 sta ,x ; save in memory
1458 cmpa ,x+ ; did it actually save?
1459 bne L8CCD ; brif not RAM - raise error
1460 leay -1,y ; done yet?
1461 bne L8CB1 ; brif not
1462 bra L8C9B ; look for another "amble"
1463 L8CBF bsr L8CC1 ; read a character to B
1464 L8CC1 bsr L8CC6 ; read character to A
1465 exg a,b ; swap character with previously read one
1466 L8CC5 rts
1467 L8CC6 jsr LA176 ; read a character from input
1468 tst CINBFL ; EOF?
1469 beq L8CC5 ; brif not
1470 L8CCD jmp LA619 ; raise I/O error if EOF
1471 L8CD0 bsr L8D14 ; transmit file name
1472 pshs b,a ; save file status
1473 inca ; was file found?
1474 beq L8CDD ; brif not
1475 ldu ZERO ; zero U - first block
1476 bsr L8CE4 ; read block
1477 puls a,b,pc ; restore status and return
1478 L8CDD ldb #2*26 ; code for NE error
1479 jmp LAC46 ; raise error
1480 L8CE2 ldu CBUFAD ; get block number
1481 L8CE4 leax 1,u ; bump block number
1482 stx CBUFAD ; save new block number
1483 ldx #CASBUF ; use cassette buffer
1484 jsr L8D7C ; read a block
1485 jmp LA644 ; reset input buffer pointers
1486 ; Generic input handler for Extended Basic
1487 XVEC4 lda DEVNUM ; get device number
1488 cmpa #-3 ; DLOAD?
1489 bne L8D01 ; brif not
1490 leas 2,s ; don't return to mainline code
1491 clr CINBFL ; reset EOF flag to not EOF
1492 tst CINCTR ; anything available?
1493 bne L8D02 ; brif so - fetch one
1494 com CINBFL ; flag EOF
1495 L8D01 rts
1496 L8D02 pshs u,y,x,b ; save registers
1497 ldx CINPTR ; get buffer pointer
1498 lda ,x+ ; get character from buffer
1499 pshs a ; save it for return
1500 stx CINPTR ; save new input pointer
1501 dec CINCTR ; account for byte removed from buffer
1502 bne L8D12 ; brif buffer not empty
1503 bsr L8CE2 ; go read a block
1504 L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return
1505 L8D14 clra ; clear attempt counter
1506 pshs x,b,a ; make a hole for variables
1507 leay ,s ; set up frame pointer
1508 bra L8D1D ; go read block
1509 L8D1B bsr L8D48 ; bump attempt counter
1510 L8D1D lda #0x8a ; send file request control code
1511 bsr L8D58
1512 bne L8D1B ; brif no echo or error
1513 ldx #CFNBUF+1 ; point to file name
1514 L8D26 lda ,x+ ; get file name characater
1515 jsr L8E04 ; send it
1516 cmpx #CFNBUF+9 ; end of file name?
1517 bne L8D26 ; brif not
1518 bsr L8D62 ; output check byte and look for response
1519 bne L8D1B ; transmit name again if not ack
1520 bsr L8D72 ; get file type (0xff is not found)
1521 bne L8D1B ; brif error
1522 sta 2,y ; save file type
1523 bsr L8D72 ; read ASCII flag
1524 bne L8D1B ; brif error
1525 sta 3,y ; save ASCII flag
1526 bsr L8D6B ; read check byte
1527 bne L8D1B ; brif error
1528 leas 2,s ; lose attempt counter and check byte
1529 puls a,b,pc ; return file type and ascii flag
1530 L8D48 inc ,y ; bump attempt counter
1531 lda ,y ; get new count
1532 cmpa #5 ; done 5 times?
1533 blo L8D6A ; brif not
1534 lda #0xbc ; send abort code
1535 jsr L8E0C
1536 jmp LA619 ; raise an I/O error
1537 L8D58 pshs a ; save compare character
1538 bsr L8DB8 ; send character
1539 bne L8D60 ; brif read error
1540 cmpa ,s ; does it match? (set Z if good)
1541 L8D60 puls a,pc ; restore character and return
1542 L8D62 lda 1,y ; get XOR check byte
1543 bsr L8DB8 ; send it and read
1544 bne L8D6A ; brif read error
1545 cmpa #0xc8 ; is it ack? (set Z if so)
1546 L8D6A rts
1547 L8D6B bsr L8D72 ; read character from rs232
1548 bne L8D6A ; brif error
1549 lda 1,y ; get check byte
1550 rts
1551 L8D72 bsr L8DBC ; read a character from rs232
1552 pshs a,cc ; save result (and flags)
1553 eora 1,y ; accumulate xor checksum
1554 sta 1,y
1555 puls cc,a,pc ; restore byte, flags, and return
1556 L8D7C clra ; reset attempt counter
1557 pshs u,y,x,b,a ; make a stack frame
1558 asl 7,s ; split block number into two 7 bit chuncks
1559 rol 6,s
1560 lsr 7,s
1561 leay ,s ; set up frame pointer
1562 bra L8D8B
1563 L8D89 bsr L8D48 ; bump attempt counter
1564 L8D8B lda #0x97 ; send block request code
1565 bsr L8D58
1566 bne L8D89 ; brif error
1567 lda 6,y ; send out block number (high bits first)
1568 bsr L8E04
1569 lda 7,y
1570 bsr L8E04
1571 bsr L8D62 ; send check byte and get ack
1572 bne L8D89 ; brif error
1573 bsr L8D72 ; read block size
1574 bne L8D89 ; brif read error
1575 sta 4,y ; save character count
1576 ldx 2,y ; get buffer pointer
1577 ldb #128 ; length of data block
1578 L8DA7 bsr L8D72 ; read a data byte
1579 bne L8D89 ; brif error
1580 sta ,x+ ; save byte in buffer
1581 decb ; done a whole block?
1582 bne L8DA7 ; brif not
1583 bsr L8D6B ; read check byte
1584 bne L8D89 ; brif error
1585 leas 4,s ; lose attempt counter, check byte, and buffer pointer
1586 puls a,b,x,pc ; return with character count in A, clean rest of stack
1587 L8DB8 clr 1,y ; clear check byte
1588 bsr L8E0C ; output character
1589 L8DBC clra ; clear attempt counter
1590 pshs x,b,cc ; save registers and interrupt status
1591 orcc #0x50 ; disable interrupts
1592 lda TIMOUT ; get timout delay (variable)
1593 ldx ZERO ; get constant timeout value
1594 L8DC5 bsr L8DE6 ; get RS232 status
1595 bcc L8DC5 ; brif "space" - waiting for "mark"
1596 L8DC9 bsr L8DE6 ; get RS232 status
1597 bcs L8DC9 ; brif "mark" - waiting for "space" (start bit)
1598 bsr L8DF9 ; delay for half of bit time
1599 ldb #1 ; set bit probe
1600 pshs b ; save it
1601 clra ; reset data byte
1602 L8DD4 bsr L8DF7 ; wait one bit time
1603 ldb PIA1+2 ; get input bit to carry
1604 rorb
1605 bcc L8DDE ; brif "space" (0)
1606 ora ,s ; merge bit probe in
1607 L8DDE asl ,s ; shift bit probe over
1608 bcc L8DD4 ; brif we haven't done 8 bits
1609 leas 1,s ; remove bit probe
1610 puls cc,b,x,pc ; restore interrupts, registers, and return
1611 L8DE6 ldb PIA1+2 ; get RS232 value
1612 rorb ; put in C
1613 leax 1,x ; bump timeout
1614 bne L8DF6 ; brif nonzero
1615 deca ; did the number of waits expire?
1616 bne L8DF6 ; brif not
1617 leas 2,s ; don't return - we timed out
1618 puls cc,b,x ; restore interrupts and registers
1619 inca ; clear Z (A was zero above)
1620 L8DF6 rts
1621 L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second
1622 L8DF9 pshs a ; save register
1623 lda DLBAUD ; get baud rate constant
1624 L8DFD brn L8DFD ; do nothing - delay
1625 deca ; time expired?
1626 bne L8DFD ; brif not
1627 puls a,pc ; restore register and return
1628 L8E04 pshs a ; save character to send
1629 eora 1,y ; accumulate chechsum
1630 sta 1,y
1631 puls a ; get character back
1632 L8E0C pshs b,a,cc ; save registers and interrupt status
1633 orcc #0x50 ; disable interrupts
1634 bsr L8DF7 ; do a bit delay
1635 bsr L8DF7 ; do another bit delay
1636 clr PIA1 ; set output to space (start bit)
1637 bsr L8DF7 ; do a bit delay
1638 ldb #1 ; bit probe start at LSB
1639 pshs b ; save bitprobe
1640 L8E1D lda 2,s ; get output byte
1641 anda ,s ; see what our current bit is
1642 beq L8E25 ; brif output is 0
1643 lda #2 ; set output to "marking"
1644 L8E25 sta PIA1 ; send bit
1645 bsr L8DF7 ; do a bit delay
1646 asl ,s ; shift bit probe
1647 bcc L8E1D ; brif not last bit
1648 lda #2 ; set output to marking ("stop" bit)
1649 sta PIA1
1650 leas 1,s ; lose bit probe
1651 puls cc,a,b,pc ; restore registers, interrupts, and return
1652 ; PRINT USING
1653 ; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to
1654 ; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total
1655 ; Extended Color Basic ROM.
1656 ;
1657 ; This uses several variables:
1658 ; VD5: pointer to format string descriptor
1659 ; VD7: next print item flag
1660 ; VD8: right digit counter
1661 ; VD9: left digit counter (or length of string argument)
1662 ; VDA: status byte (bits as follows):
1663 ; 6: force comma
1664 ; 5: force leading *
1665 ; 4: floating $
1666 ; 3: pre-sign
1667 ; 2: post-sign
1668 ; 0: scientific notation
1669 L8E37 lda #1 ; set length to use to 1
1670 sta VD9
1671 L8E3B decb ; consume character from format string
1672 jsr L8FD8 ; show error flag if flags set
1673 jsr GETCCH ; get input character
1674 lbeq L8ED8 ; brif end of line - bail
1675 stb VD3 ; save remaining string length
1676 jsr LB156 ; evaluate the argument
1677 jsr LB146 ; error if numeric
1678 ldx FPA0+2 ; get descriptor for argument
1679 stx V4D ; save it for later
1680 ldb VD9 ; get length counter to use
1681 jsr LB6AD ; get B bytes of string space (do a LEFT$)
1682 jsr LB99F ; print the formatted string
1683 ldx FPA0+2 ; get formatted string descriptor
1684 ldb VD9 ; get requested length
1685 subb ,x ; see if we have any left over
1686 L8E5F decb ; have we got the right width?
1687 lbmi L8FB3 ; brif so - go process more
1688 jsr LB9AC ; output a space
1689 bra L8E5F ; go see if we're done yet
1690 L8E69 stb VD3 ; save current format string counter and pointer
1691 stx TEMPTR
1692 lda #2 ; initial spaces count = 2 (for the two %s)
1693 sta VD9 ; save length counter
1694 L8E71 lda ,x ; get character in string
1695 cmpa #'% ; is it the end of the sequence?
1696 beq L8E3B ; brif so - display requested part of the strign
1697 cmpa #0x20 ; space?
1698 bne L8E82 ; brif not
1699 inc VD9 ; bump spaces count
1700 leax 1,x ; move format pointer forward
1701 decb ; consume character
1702 bne L8E71 ; brif not end of format string
1703 L8E82 ldx TEMPTR ; restore format string pointer
1704 ldb VD3 ; get back format string length
1705 lda #'% ; show % as debugging aid
1706 L8E88 jsr L8FD8 ; send error indicator if flags set
1707 jsr PUTCHR ; output character
1708 bra L8EB9 ; go process more format string
1709 ; PRINT extension for USING
1710 XVEC9 cmpa #0xcd ; USING?
1711 beq L8E95 ; brif so
1712 rts ; return to mainline code
1713 ; This is the main entry point for PRINT USING
1714 L8E95 leas 2,s ; don't return to the mainline code
1715 jsr LB158 ; evaluate the format string
1716 jsr LB146 ; error if numeric
1717 ldb #'; ; make sure there's a ; after the string
1718 jsr LB26F
1719 ldx FPA0+2 ; get format string descriptor
1720 stx VD5 ; save it for later
1721 bra L8EAE ; process format string
1722 L8EA8 lda VD7 ; is there a print item?
1723 beq L8EB4 ; brif not
1724 ldx VD5 ; get back format string descriptor
1725 L8EAE clr VD7 ; reset next print item flag
1726 ldb ,x ; get length of format string
1727 bne L8EB7 ; brif string is non-null
1728 L8EB4 jmp LB44A ; raise FC error
1729 L8EB7 ldx 2,x ; point to start of string
1730 L8EB9 clr VDA ; clear status (new item)
1731 L8EBB clr VD9 ; clear left digit counter
1732 lda ,x+ ; get character from format string
1733 cmpa #'! ; ! (use first character of string)?
1734 lbeq L8E37 ; brif so
1735 cmpa #'# ; digit?
1736 beq L8F24 ; brif so - handle numeric
1737 decb ; consume format character
1738 bne L8EE2 ; brif not done
1739 jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string
1740 jsr PUTCHR ; output format string character
1741 L8ED2 jsr GETCCH ; get current input character
1742 bne L8EA8 ; brif not end of statement
1743 lda VD7 ; get next item flag
1744 L8ED8 bne L8EDD ; brif more print items
1745 jsr LB958 ; do newline
1746 L8EDD ldx VD5 ; point to format string descriptor
1747 jmp LB659 ; remove from string stack, etc., if appropriate (and return)
1748 L8EE2 cmpa #'+ ; is it + (pre-sign)?
1749 bne L8EEF ; brif not
1750 jsr L8FD8 ; send a "+" if flags set
1751 lda #8 ; flag for pre-sign
1752 sta VDA ; set flags
1753 bra L8EBB ; go interpret some more stuff
1754 L8EEF cmpa #'. ; decimal?
1755 beq L8F41 ; brif so - numeric
1756 cmpa #'% ; % (show string)?
1757 lbeq L8E69 ; brif so
1758 cmpa ,x ; do we have two identical characters?
1759 L8EFB bne L8E88 ; brif not - invalid format character
1760 cmpa #'$ ; double $?
1761 beq L8F1A ; brif so - floating $
1762 cmpa #'* ; double *?
1763 bne L8EFB ; brif not
1764 lda VDA ; get status byte
1765 ora #0x20 ; enable * padding
1766 sta VDA
1767 cmpb #2 ; is $$ the last two?
1768 blo L8F20 ; brif so
1769 lda 1,x ; is it $ after?
1770 cmpa #'$
1771 bne L8F20 ; brif not
1772 decb ; consume the "$"
1773 leax 1,x
1774 inc VD9 ; add to digit counter * pad + $ counter
1775 L8F1A lda VDA ; indicate floating $
1776 ora #0x10
1777 sta VDA
1778 L8F20 leax 1,x ; consume the second format character
1779 inc VD9 ; add one more left place
1780 L8F24 clr VD8 ; clear right digit counter
1781 L8F26 inc VD9 ; bump left digit counter
1782 decb ; consume character
1783 beq L8F74 ; brif end of string
1784 lda ,x+ ; get next format character
1785 cmpa #'. ; decimal?
1786 beq L8F4F ; brif so
1787 cmpa #'# ; digit?
1788 beq L8F26 ; brif so
1789 cmpa #', ; comma flag?
1790 bne L8F5A ; brif not
1791 lda VDA ; set commas flag
1792 ora #0x40
1793 sta VDA
1794 bra L8F26 ; handle more characters to left of decimal
1795 L8F41 lda ,x ; get character after .
1796 cmpa #'# ; digit?
1797 lbne L8E88 ; brif not - invalid
1798 lda #1 ; set right digit counter to 1 (for the .)
1799 sta VD8
1800 leax 1,x ; consume the .
1801 L8F4F inc VD8 ; add one to right digit counter
1802 decb ; consume character
1803 beq L8F74 ; brif end of format string
1804 lda ,x+ ; get another format character
1805 cmpa #'# ; digit?
1806 beq L8F4F ; brif so
1807 L8F5A cmpa #0x5e ; up arrow?
1808 bne L8F74 ; brif not
1809 cmpa ,x ; two of them?
1810 bne L8F74 ; brif not
1811 cmpa 1,x ; three of them?
1812 bne L8F74 ; brif not
1813 cmpa 2,x ; four of them?
1814 bne L8F74 ; brif not
1815 cmpb #4 ; string actually has the characters?
1816 blo L8F74 ; brif not
1817 subb #4 ; consome them
1818 leax 4,x
1819 inc VDA ; set scientific notation bit
1820 L8F74 leax -1,x ; back up input pointer
1821 inc VD9 ; add one digit for pre-sign force
1822 lda VDA ; is it pre-sign?
1823 bita #8
1824 bne L8F96 ; brif so
1825 dec VD9 ; undo pre-sign adjustment
1826 tstb ; end of string?
1827 beq L8F96 ; brif so
1828 lda ,x ; get next character
1829 suba #'- ; post sign force?
1830 beq L8F8F ; brif so
1831 cmpa #'+-'- ; plus?
1832 bne L8F96 ; brif not
1833 lda #8 ; trailing + is a pre-sign force
1834 L8F8F ora #4 ; add in post sign flag
1835 ora VDA ; merge with flags
1836 sta VDA
1837 decb ; consume character
1838 L8F96 jsr GETCCH ; do we have an argument
1839 lbeq L8ED8 ; brif not
1840 stb VD3 ; save format string length
1841 jsr LB141 ; evluate numeric expression
1842 lda VD9 ; get left digit counter
1843 adda VD8 ; add in right digit counter
1844 cmpa #17 ; is it more than 16 digits + decimal?
1845 lbhi LB44A ; brif so - this is a problem
1846 jsr L8FE5 ; format value according to settings
1847 leax -1,x ; move buffer pointer back
1848 jsr STRINOUT ; display formatted number string
1849 L8FB3 clr VD7 ; reset next print item flag
1850 jsr GETCCH ; get current input character
1851 beq L8FC6 ; brif end of statement
1852 sta VD7 ; set next print flag to nonzero
1853 cmpa #'; ; list separator ;?
1854 beq L8FC4 ; brif so
1855 jsr SYNCOMMA ; require a comma between if not ;
1856 bra L8FC6 ; process next item
1857 L8FC4 jsr GETNCH ; munch the semicolon
1858 L8FC6 ldx VD5 ; get format string descriptor
1859 ldb ,x ; get length of string
1860 subb VD3 ; subtract amount left after last item
1861 ldx 2,x ; point to string address
1862 abx ; move pointer to correct spot
1863 ldb VD3 ; get remaining string length
1864 lbne L8EB9 ; if we have more, interpret from there
1865 jmp L8ED2 ; re-interpret from start if we hit the end
1866 L8FD8 pshs a ; save character
1867 lda #'+ ; "error" flag character
1868 tst VDA ; did we have some flags set?
1869 beq L8FE3 ; brif not
1870 jsr PUTCHR ; output error flag
1871 L8FE3 puls a,pc ; restore character and return
1872 L8FE5 ldu #STRBUF+4 ; point to string buffer
1873 ldb #0x20 ; blank space
1874 lda VDA ; get flags
1875 bita #8 ; pre-sign?
1876 beq L8FF2 ; brif not
1877 ldb #'+ ; plus sign
1878 L8FF2 tst FP0SGN ; get sign of value
1879 bpl L8FFA ; brif positive
1880 clr FP0SGN ; make number positive (for later)
1881 ldb #'- ; negative sign
1882 L8FFA stb ,u+ ; put sign in buffer
1883 ldb #'0 ; put a zero there
1884 stb ,u+
1885 anda #1 ; check scientific notation force
1886 lbne L910D ; brif so
1887 ldx #LBDC0 ; point to FP 1E+9
1888 jsr LBCA0 ; is it less?
1889 bmi L9023 ; brif so
1890 jsr LBDD9 ; convert FP number to string (we're doing scientific notation)
1891 L9011 lda ,x+ ; advance pointer to end of string
1892 bne L9011
1893 L9015 lda ,-x ; make a hole at the start
1894 sta 1,x
1895 cmpx #STRBUF+3 ; done yet?
1896 bne L9015 ; brif not
1897 lda #'% ; put "overflow" flag at start
1898 sta ,x
1899 rts
1900 L9023 lda FP0EXP ; get exponent of value
1901 sta V47 ; save it
1902 beq L902C ; brif value is 0
1903 jsr L91CD ; convert to number with 9 significant figures to left of decimal
1904 L902C lda V47 ; get base 10 exponent offset
1905 lbmi L90B3 ; brif < 100,000,000
1906 nega ; get negative difference
1907 adda VD9 ; add to number of left digits
1908 suba #9 ; account for the 9 we actually have
1909 jsr L90EA ; put leading zeroes in buffer
1910 jsr L9263 ; initialize the decimal point and comma counters
1911 jsr L9202 ; convert FPA0 to decimal ASCII in buffer
1912 lda V47 ; get base 10 exponent
1913 jsr L9281 ; put that many zeroes in buffer, stop at decimal point
1914 lda V47 ; get base 10 exponent
1915 jsr L9249 ; check for decimal
1916 lda VD8 ; get right digit counter
1917 bne L9050 ; brif we want stuff after decimal
1918 leau -1,u ; delete decimal if not needed
1919 L9050 deca ; subtract one place (for decimal)
1920 jsr L90EA ; put zeroes in buffer (trailing)
1921 L9054 jsr L9185 ; insert * padding, floating $, and post-sign
1922 tsta ; was there a post sign?
1923 beq L9060 ; brif not
1924 cmpb #'* ; was first character a *?
1925 beq L9060 ; brif so
1926 stb ,u+ ; store the post sign
1927 L9060 clr ,u ; make srue it's NUL terminated
1928 ldx #STRBUF+3 ; point to start of buffer
1929 L9065 leax 1,x ; move to next character
1930 stx TEMPTR ; save it for later
1931 lda VARPTR+1 ; get address of decimal point
1932 suba TEMPTR+1 ; subtract out actual digits left of decimal
1933 suba VD9 ; subtract out required left digits
1934 beq L90A9 ; brif no padding needed
1935 lda ,x ; get current character
1936 cmpa #0x20 ; space?
1937 beq L9065 ; brif so - advance pointer
1938 cmpa #'* ; *?
1939 beq L9065 ; brif so - advance pointer
1940 clra ; zero on stack is end of data ponter
1941 L907C pshs a ; save character on stack
1942 lda ,x+ ; get next character
1943 cmpa #'- ; minus?
1944 beq L907C ; brif so
1945 cmpa #'+ ; plus?
1946 beq L907C ; brif so
1947 cmpa #'$ ; $?
1948 beq L907C ; brif so
1949 cmpa #'0 ; zero?
1950 bne L909E ; brif not
1951 lda 1,x ; get character after 0
1952 bsr L90AA ; clear carry if number
1953 bcs L909E ; brif not number
1954 L9096 puls a ; get character off stack
1955 sta ,-x ; put it back in string buffer
1956 bne L9096 ; brif not - restore another
1957 bra L9065 ; keep cleaning up buffer
1958 L909E puls a ; get the character on the stack
1959 tsta ; is it NUL?
1960 bne L909E ; brif not
1961 ldx TEMPTR ; get string buffer start pointer
1962 lda #'% ; put error flag in front
1963 sta ,-x
1964 L90A9 rts
1965 L90AA cmpa #'0 ; zero?
1966 blo L90B2 ; brif not
1967 suba #'9+1 ; set C if > "9"
1968 suba #-('9+1)
1969 L90B2 rts
1970 L90B3 lda VD8 ; get right digit counter
1971 beq L90B8 ; brif not right digits
1972 deca ; account for decimal point
1973 L90B8 adda V47 ; add base 10 exponent offset
1974 bmi L90BD ; if >= 0, no shifts are required
1975 clra ; force shift counter to 0
1976 L90BD pshs a ; save shift counter
1977 L90BF bpl L90CB ; brif positive count
1978 pshs a ; save shift counter
1979 jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right)
1980 puls a ; get shift counter back
1981 inca ; account for the shift
1982 bra L90BF ; see if we're done yet
1983 L90CB lda V47 ; get base 10 exponent offset
1984 suba ,s+ ; account for adjustment
1985 sta V47 ; save new exponent offset
1986 adda #9 ; account for significant places
1987 bmi L90EE ; brif we don't need zeroes to left
1988 lda VD9 ; get left decimal counter
1989 suba #9 ; account for significant figures
1990 suba V47 ; subtract exponent offset
1991 bsr L90EA ; output leading zeroes
1992 jsr L9263 ; initialize decimal and comma counters
1993 bra L90FF ; process remainder of digits
1994 L90E2 pshs a ; save zero counter
1995 lda #'0 ; insert a 0
1996 sta ,u+
1997 puls a ; get back counter
1998 L90EA deca ; do we need more zeroes?
1999 bpl L90E2 ; brif so
2000 rts
2001 L90EE lda VD9 ; get left digit counter
2002 bsr L90EA ; put that many zeroes in
2003 jsr L924D ; put decimal in buffer
2004 lda #-9 ; figure out filler zeroes
2005 suba V47
2006 bsr L90EA ; output required leader zeroes
2007 clr V45 ; clear decimal pointer counter
2008 clr VD7 ; clear comma counter
2009 L90FF jsr L9202 ; decode FPA0 to decimal string
2010 lda VD8 ; get right digit counter
2011 bne L9108 ; brif there are right digits
2012 ldu VARPTR ; point to decimal location of decimal
2013 L9108 adda V47 ; add base 10 exponent
2014 lbra L9050 ; add in leading astrisks, etc.
2015 L910D lda FP0EXP ; get exponent of FPA0
2016 pshs a ; save it
2017 beq L9116 ; brif 0
2018 jsr L91CD ; convert to number with 9 figures
2019 L9116 lda VD8 ; get right digit counter
2020 beq L911B ; brif no right digits
2021 deca ; account for decimal point
2022 L911B adda VD9 ; get left digit counter
2023 clr STRBUF+3 ; use buffer byte as temporary storage
2024 ldb VDA ; get status flags
2025 andb #4 ; post-sign?
2026 bne L9129 ; brif so
2027 com STRBUF+3 ; flip byte if no post sign
2028 L9129 adda STRBUF+3 ; subtract 1 if no post sign
2029 suba #9 ; account for significant figures
2030 pshs a ; save shift counter
2031 L9130 bpl L913C ; brif no more shifts needed
2032 pshs a ; save counter
2033 jsr LBB82 ; divide by 10 (shift right one)
2034 puls a ; get back counter
2035 inca ; account for the shift
2036 bra L9130 ; see if we need more
2037 L913C lda ,s ; get original shift count
2038 bmi L9141 ; brif shifting happened
2039 clra ; flag for no shifting
2040 L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed)
2041 adda VD9 ; add left digit counter
2042 inca ; and post sign
2043 adda STRBUF+3
2044 sta V45 ; save decimal counter
2045 clr VD7 ; clear comma counter
2046 jsr L9202 ; convert to decimal string
2047 puls a ; get shift counter
2048 jsr L9281 ; put the needed zeroes in
2049 lda VD8 ; get right digit counter
2050 bne L915A ; brif we want some
2051 leau -1,u ; remove te decimal point
2052 L915A ldb ,s+ ; get original exponent
2053 beq L9167 ; brif it was 0
2054 ldb V47 ; get base 10 exponent
2055 addb #9 ; account for significant figures
2056 subb VD9 ; remove left digit count
2057 subb STRBUF+3 ; add one if post sign
2058 L9167 lda #'+ ; positive sign
2059 tstb ; is base 10 exponent positive?
2060 bpl L916F ; brif so
2061 lda #'- ; negative sign
2062 negb ; flip exponent
2063 L916F sta 1,u ; put exponent sign
2064 lda #'E ; put "E" and advance output pointer
2065 sta ,u++
2066 lda #'0-1 ; initialize digit accumulator
2067 L9177 inca ; bump digit
2068 subb #10 ; are we at the right digit?
2069 bcc L9177 ; brif not
2070 addb #'0+10 ; add ASCII bias and undo extra subtraction
2071 std ,u++ ; save exponent in buffer
2072 clr ,u ; clear final byte in buffer
2073 jmp L9054 ; insert *, $, etc.
2074 L9185 ldx #STRBUF+4 ; point to start of result
2075 ldb ,x ; get sign
2076 pshs b ; save it
2077 lda #0x20 ; default pad with spaces
2078 ldb VDA ; get flags
2079 bitb #0x20 ; padding with *?
2080 puls b
2081 beq L919E ; brif no padding
2082 lda #'* ; pad with *
2083 cmpb #0x20 ; do we have a blank? (positive)
2084 bne L919E ; brif not
2085 tfr a,b ; use pad character
2086 L919E pshs b ; save first character
2087 L91A0 sta ,x+ ; store padding
2088 ldb ,x ; get next character
2089 beq L91B6 ; brif end of string
2090 cmpb #'E ; exponent?
2091 beq L91B6 ; brif so - treat as 0
2092 cmpb #'0 ; zero?
2093 beq L91A0 ; brif so - pad it
2094 cmpb #', ; leading comma?
2095 beq L91A0 ; brif so - pad it
2096 cmpb #'. ; decimal?
2097 bne L91BA ; brif so - don't put a 0 before it
2098 L91B6 lda #'0 ; put a zero before
2099 sta ,-x
2100 L91BA lda VDA ; get status byte
2101 bita #0x10 ; floating $?
2102 beq L91C4 ; brif not
2103 ldb #'$ ; stuff a $ in
2104 stb ,-x
2105 L91C4 anda #4 ; pre-sgn?
2106 puls b ; get back first character
2107 bne L91CC ; brif not
2108 stb ,-x ; save leading character (sign)
2109 L91CC rts
2110 L91CD pshs u ; save buffer pointer
2111 clra ; initial exponent offset is 0
2112 L91D0 sta V47 ; save exponent offset
2113 ldb FP0EXP ; get actual exponent
2114 cmpb #0x80 ; is value >= 1.0?
2115 bhi L91E9 ; brif so
2116 ldx #LBDC0 ; point to FP number 1E9
2117 jsr LBACA ; multiply by 1000000000
2118 lda V47 ; account for 9 shifts
2119 suba #9
2120 bra L91D0 ; brif not there yet
2121 L91E4 jsr LBB82 ; divide by 10
2122 inc V47 ; account for shift
2123 L91E9 ldx #LBDBB ; point to 999999999
2124 jsr LBCA0 ; compare it
2125 bgt L91E4 ; brif not in range yet
2126 L91F1 ldx #LBDB6 ; point to 99999999.9
2127 jsr LBCA0 ; compare
2128 bgt L9200 ; brif in range
2129 jsr LBB6A ; multiply by 10
2130 dec V47 ; account for shift
2131 bra L91F1 ; see if we're in range yet
2132 L9200 puls u,pc ; restore buffer pointer and return
2133 L9202 pshs u ; save buffer pointer
2134 jsr LB9B4 ; add .5 (round off)
2135 jsr LBCC8 ; convert to integer format
2136 puls u ; restore buffer pointer
2137 ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs)
2138 ldb #0x80 ; intitial digit counter is 0 with 0x80 bias
2139 L9211 bsr L9249 ; check for comma
2140 L9213 lda FPA0+3 ; add a power of 10
2141 adda 3,x
2142 sta FPA0+3
2143 lda FPA0+2
2144 adca 2,x
2145 sta FPA0+2
2146 lda FPA0+1
2147 adca 1,x
2148 sta FPA0+1
2149 lda FPA0
2150 adca ,x
2151 sta FPA0
2152 incb ; add one to digit counter
2153 rorb ; set V if carry and sign differ
2154 rolb
2155 bvc L9213 ; brif we haven't "wrapped"
2156 bcc L9235 ; brif subtracting
2157 subb #10+1 ; take 9's complement if adding
2158 negb
2159 L9235 addb #'0-1 ; add in ASCII bias
2160 leax 4,x ; move to next power
2161 tfr b,a ; save digit
2162 anda #0x7f ; mask off subtract flag
2163 sta ,u+ ; save digit
2164 comb ; toggle add/subtract
2165 andb #0x80
2166 cmpx #LBEE9 ; done all places?
2167 bne L9211 ; brif not
2168 clr ,u ; but NUL at end
2169 L9249 dec V45 ; at decimal?
2170 bne L9256 ; brif not
2171 L924D stu VARPTR ; save decimal point pointer
2172 lda #'. ; insert decimal
2173 sta ,u+
2174 clr VD7 ; clear comma counter
2175 rts
2176 L9256 dec VD7 ; do we need a comma?
2177 bne L9262 ; brif not
2178 lda #3 ; reset comma counter
2179 sta VD7
2180 lda #', ; insert comma
2181 sta ,u+
2182 L9262 rts
2183 L9263 lda V47 ; get base 10 exponent offset
2184 adda #10 ; account for significant figures
2185 sta V45 ; save decimal counter
2186 inca ; add one for decimal point
2187 L926A suba #3 ; divide by 3, leave remainder in A
2188 bcc L926A
2189 adda #5 ; renormalize to range 1-3
2190 sta VD7 ; save comma counter
2191 lda VDA ; get status
2192 anda #0x40 ; commas wanted?
2193 bne L927A ; brif not
2194 sta VD7 ; clear comma counter
2195 L927A rts
2196 L927B pshs a ; save zeroes counter
2197 bsr L9249 ; check for decimal
2198 puls a ; get back counter
2199 L9281 deca ; need a zero?
2200 bmi L928E ; brif not
2201 pshs a ; save counter
2202 lda #'0 ; put a zero
2203 sta ,u+
2204 lda ,s+ ; get back counter and set flags
2205 bne L927B ; brif not done enough
2206 L928E rts
2207 ; From here to the end of the Extended Basic ROM is the PMODE graphics system and related
2208 ; infrastructure with the exception of the PLAY command which shares some of its machinery
2209 ; with the DRAW command.
2210 ;
2211 ; Fetch screen address calculation routine address for the selected graphics mode
2212 L928F ldu #L929C ; point to normalization routine jump table
2213 lda PMODE ; get graphics mode
2214 asla ; two bytes per address
2215 ldu a,u ; get routine address
2216 rts
2217 ; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A.
2218 L9298 bsr L928F ; fetch normalization routine pointer
2219 jmp ,u ; transfer control to it
2220 L929C fdb L92A6 ; PMODE 0
2221 fdb L92C2 ; PMODE 1
2222 fdb L92A6 ; PMODE 2
2223 fdb L92C2 ; PMODE 3
2224 fdb L92A6 ; PMODE 4
2225 ; Two colour mode address calculatoin
2226 L92A6 pshs u,b ; savce registers
2227 ldb HORBYT ; get number of bytes in each graphics row
2228 lda VERBEG+1 ; get vertical coordinate
2229 mul
2230 addd BEGGRP ; now D is the absolute address of the start of the row
2231 tfr d,x ; get address to the return location
2232 ldb HORBEG+1 ; get horizontal coordinate
2233 lsrb ; divide by 8 (8 pixels per byte in 2 colour mode)
2234 lsrb
2235 lsrb
2236 abx ; now X is the address of the actual pixel byte
2237 lda HORBEG+1 ; get horizontal coordinate
2238 anda #7 ; keep only the low 3 bits which contain the pixel number
2239 ldu #L92DD ; point to pixel mask lookup
2240 lda a,u ; get pixel mask
2241 puls b,u,pc ; restore registers and return result
2242 ; four colour address calculation
2243 L92C2 pshs u,b ; save registers
2244 ldb HORBYT ; get bytes per graphics row
2245 lda VERBEG+1 ; get vertical coordinate
2246 mul
2247 addd BEGGRP ; now D is the address of the start of the row
2248 tfr d,x ; put it in returnlocatin
2249 ldb HORBEG+1 ; get horizontal coordinate
2250 lsrb ; divide by 4 (four colour modes have four pixels per byte)
2251 lsrb
2252 abx ; now X points to the screen byte
2253 lda HORBEG+1 ; get horizontal coordinate
2254 anda #3 ; keep low two bits for pixel number
2255 ldu #L92E5 ; point to four colour pixel masks
2256 lda a,u ; get pixel mask
2257 puls b,u,pc ; restore registers and return result
2258 L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks
2259 fcb 0x08,0x04,0x02,0x01
2260 L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks
2261 ; Move X down one graphics row
2262 L92E9 ldb HORBYT ; get bytes per row
2263 abx ; add to screen address
2264 rts
2265 ; Move one pixel right in 2 colour mode
2266 L92ED lsra ; move pixel mask right
2267 bcc L92F3 ; brif same byte
2268 rora ; move pixel mask to left of byte
2269 leax 1,x ; move to next byte
2270 L92F3 rts
2271 ; Move one pixel right in 4 colour mode
2272 L92F4 lsra ; shift mask half a pixel right
2273 bcc L92ED ; brif not past end of byte - shift one more
2274 lda #0xc0 ; set mask on left of byte
2275 leax 1,x ; move to next byte
2276 rts
2277 ; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG.
2278 L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B
2279 ldy #HORBEG ; point to storage location
2280 L9303 cmpb #192 ; is vertical outside range?
2281 blo L9309 ; brif not
2282 ldb #191 ; max it at bottom of screen
2283 L9309 clra ; zero extend vertical coordinate
2284 std 2,y ; save vertical coordinate
2285 ldd BINVAL ; get horizontal coordinate
2286 cmpd #256 ; in range?
2287 blo L9317 ; brif so
2288 ldd #255 ; max it out to right side of screen
2289 L9317 std ,y ; save horizontal coordinate
2290 rts
2291 ; Normalize coordinates for proper PMODE
2292 L931A jsr L92FC ; parse coordinates
2293 L931D ldu #HORBEG ; point to start coordinates
2294 L9320 lda PMODE ; get graphics mode
2295 cmpa #2 ; is it pmode 0 or 1?
2296 bhs L932C ; brif not
2297 ldd 2,u ; get vertical coordinate
2298 lsra ; divide it by two
2299 rorb
2300 std 2,u ; save it back
2301 L932C lda PMODE ; get graphics mode
2302 cmpa #4 ; pmode 4?
2303 bhs L9338 ; brif so
2304 ldd ,u ; cut horizontal coordinate in half
2305 lsra
2306 rorb
2307 std ,u ; save new coordinate
2308 L9338 rts
2309 ; PPOINT function
2310 PPOINT jsr L93B2 ; evaluate two expressions (coordinates)
2311 jsr L931D ; normalize coordinates
2312 jsr L9298 ; get screen address
2313 anda ,x ; get colour value of desired screen coordinate
2314 ldb PMODE ; get graphics mode
2315 rorb ; is it a two colour m ode?
2316 bcc L935B ; brif so
2317 L9349 cmpa #4 ; is it on rightmost bits?
2318 blo L9351 ; brif not
2319 rora ; shift right
2320 rora
2321 bra L9349 ; see if we're there yet
2322 L9351 inca ; colour numbers start at 1
2323 asla ; add in colour set (0 or 8)
2324 adda CSSVAL
2325 lsra ; get colour in range of 0 to 8
2326 L9356 tfr a,b ; put result to B
2327 jmp LB4F3 ; return B as FP number
2328 L935B tsta ; is pixel on?
2329 beq L9356 ; brif not, return 0 (off)
2330 clra ; set colour number to "1"
2331 bra L9351 ; make it 1 or 5 and return
2332 ; PSET command
2333 PSET lda #1 ; PSET flag
2334 bra L9366 ; go turn on the pixel
2335 ; PRESET command
2336 PRESET clra ; PRESET flag
2337 L9366 sta SETFLG ; store whether we're setting or resetting
2338 jsr LB26A ; enforce (
2339 jsr L931A ; evaluate coordinates
2340 jsr L9581 ; evaluate colour
2341 jsr LB267 ; enforce )
2342 jsr L9298 ; get address of pixel
2343 L9377 ldb ,x ; get screen data
2344 pshs b ; save it
2345 tfr a,b ; duplicate pixel mask
2346 coma ; invert mask
2347 anda ,x ; turn off screen pixel
2348 andb ALLCOL ; adjust pixel mask to be the current colour
2349 pshs b ; merge pixel data into the screen data
2350 ora ,s+
2351 sta ,x ; put it on screen
2352 suba ,s+ ; nonzero if screen data changed
2353 ora CHGFLG ; propagate change flag
2354 sta CHGFLG
2355 rts
2356 ; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and
2357 ; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF.
2358 L938F ldx HORDEF ; set default start coords
2359 stx HORBEG
2360 ldx VERDEF
2361 stx VERBEG
2362 cmpa #0xac ; do we start with a -?
2363 beq L939E ; brif no starting coordinates
2364 jsr L93B2 ; parse coordinates
2365 L939E ldb #0xac ; make sure we have a -
2366 jsr LB26F
2367 jsr LB26A ; require a (
2368 jsr LB734 ; evaluate two expressions
2369 ldy #HOREND ; point to storage location
2370 jsr L9303 ; process coordinates
2371 bra L93B8 ; finish up with a )
2372 L93B2 jsr LB26A ; make sure there's a (
2373 jsr L92FC ; evaluate coordinates
2374 L93B8 jmp LB267 ; force a )
2375 ; LINE command
2376 LINE cmpa #0x89 ; is it LINE INPUT?
2377 lbeq L89C0 ; brif so - go handle it
2378 cmpa #'( ; starting coord?
2379 beq L93CE ; brif so
2380 cmpa #0xac ; leading -?
2381 beq L93CE ; brif so
2382 ldb #'@ ; if it isn't the above, make sure it's @
2383 jsr LB26F
2384 L93CE jsr L938F ; parse coordinates
2385 ldx HOREND ; set ending coordinates as the defaults
2386 stx HORDEF
2387 ldx VEREND
2388 stx VERDEF
2389 jsr SYNCOMMA ; make sure we have a comma
2390 cmpa #0xbe ; PRESET?
2391 beq L93E9 ; brif so
2392 cmpa #0xbd ; PSET?
2393 lbne LB277 ; brif not
2394 ldb #01 ; PSET flag
2395 skip1lda ; skip byte and set A nonzero
2396 L93E9 clrb ; PRESET flag
2397 pshs b ; save PSET/PRESET flag
2398 jsr GETNCH ; eat the PSET/PRESET
2399 jsr L9420 ; normalize coordinates
2400 puls b ; get back PSET/PRESET flag
2401 stb SETFLG ; flag which we're doing
2402 jsr L959A ; set colour byte
2403 jsr GETCCH ; get next bit
2404 lbeq L94A1 ; brif no box option
2405 jsr SYNCOMMA ; make sure it's comma
2406 ldb #'B ; make sure "B" for "box"
2407 jsr LB26F
2408 bne L9429 ; brif something follows the B
2409 bsr L9444 ; draw horizontal line
2410 bsr L946E ; draw vertical line
2411 ldx HORBEG ; save horizontal coordinate
2412 pshs x ; save it
2413 ldx HOREND ; switch in horizontal end
2414 stx HORBEG
2415 bsr L946E ; draw vertical line
2416 puls x ; get back original start
2417 stx HORBEG ; put it back
2418 ldx VEREND ; do the same dance with the vertical end
2419 stx VERBEG
2420 bra L9444 ; draw horizontal line
2421 L9420 jsr L931D ; normalize the start coordinates
2422 ldu #HOREND ; point to end coords
2423 jmp L9320 ; normalize those coordinates
2424 L9429 ldb #'F ; make sure we have "BF" for "filled box"
2425 jsr LB26F
2426 bra L9434 ; fill the box
2427 L9430 leax -1,x ; move vertical coordinate up one
2428 L9432 stx VERBEG ; save new vertical coordinate
2429 L9434 jsr L9444 ; draw a horizontal line
2430 ldx VERBEG ; are we at the end of the box?
2431 cmpx VEREND
2432 beq L9443 ; brif so
2433 bcc L9430 ; brif we're moving up the screen
2434 leax 1,x ; move down the screen
2435 bra L9432 ; go draw another line
2436 L9443 rts
2437 ; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL
2438 L9444 ldx HORBEG ; get starting horizontal coordinate
2439 pshs x ; save it
2440 jsr L971D ; get absolute value of HOREND-HORBEG
2441 bcc L9451 ; brif end is > start
2442 ldx HOREND ; copy end coordinate to start it is smaller
2443 stx HORBEG
2444 L9451 tfr d,y ; save difference - it's a pixel count
2445 leay 1,y ; coordinates are inclusive
2446 jsr L9298 ; get screen position of start coord
2447 puls u ; restore original start coordinate
2448 stu HORBEG
2449 bsr L9494 ; point to routine to move pizel pointers to right
2450 L945E sta VD7 ; save pixel mask
2451 jsr L9377 ; turn on pixel
2452 lda VD7 ; get pixel mask back
2453 jsr ,u ; move one pixel right
2454 leay -1,y ; turned on enough pixels yet?
2455 bne L945E ; brif not
2456 L946B rts
2457 L946C puls b,a ; clean up stack
2458 L946E ldd VERBEG ; save original vertical start coordinate
2459 pshs b,a
2460 jsr L9710 ; get vertical difference
2461 bcc L947B ; brif end coordinate > start
2462 ldx VEREND ; swap in end coordinate if not
2463 stx VERBEG
2464 L947B tfr d,y ; save number of pixels to set
2465 leay 1,y ; the coordinates are inclusive
2466 jsr L9298 ; get screen pointer
2467 puls u ; restore start coordinate
2468 stu VERBEG
2469 bsr L949D ; point to routine to move down one row
2470 bra L945E ; draw vertical line
2471 ; Point to routine which will move one pixel right
2472 L948A fdb L92ED ; PMODE 0
2473 fdb L92F4 ; PMODE 1
2474 fdb L92ED ; PMODE 2
2475 fdb L92F4 ; PMODE 3
2476 fdb L92ED ; PMODE 4
2477 L9494 ldu #L948A ; point to jump table
2478 ldb PMODE ; get graphics mode
2479 aslb ; two bytes per address
2480 ldu b,u ; get jump address
2481 rts
2482 ; Point to routine to move down one row
2483 L949D ldu #L92E9 ; point to "move down one row" routien
2484 rts
2485 ; Draw a line from HORBEG,VERBEG to HOREND,VEREND
2486 L94A1 ldy #L950D ; point to increase vertical coord
2487 jsr L9710 ; calculate difference
2488 lbeq L9444 ; brif none - draw a horizontal line
2489 bcc L94B2 ; brif vertical end is > vertical start
2490 ldy #L951B ; point to decrease vertical coord
2491 L94B2 pshs d ; save vertical difference
2492 ldu #L9506 ; point to increase horizontal coord
2493 jsr L971D ; get difference
2494 beq L946C ; brif none - draw a vertical line
2495 bcc L94C1 ; brif horizontal end > horizontal start
2496 ldu #L9514 ; point to decrease hoizontal coord
2497 L94C1 cmpd ,s ; compare vert and horiz differences
2498 puls x ; get X difference
2499 bcc L94CC ; brif horiz diff > vert diff
2500 exg u,y ; swap change routine pointers
2501 exg d,x ; swap differences
2502 L94CC pshs u,d ; save larger difference and routine
2503 pshs d ; save larger difference
2504 lsra ; divide by two
2505 rorb
2506 bcs L94DD ; brif odd number
2507 cmpu #L950D+1 ; increase or decrease?
2508 blo L94DD ; brif increase
2509 subd #1 ; back up one
2510 L94DD pshs x,b,a ; save smallest difference and initial middle offset
2511 jsr L928F ; point to proper coordinate to screen conversion routine
2512 L94E2 jsr ,u ; convert coordinates to screen address
2513 jsr L9377 ; turn on a pixel
2514 ldx 6,s ; get distnace counter
2515 beq L9502 ; brif line is completely drawn
2516 leax -1,x ; account for one pixel drawn
2517 stx 6,s ; save new counter
2518 jsr [8,s] ; increment/decrement larger delta
2519 ldd ,s ; get the minor coordinate increment counter
2520 addd 2,s ; add the smallest difference
2521 std ,s ; save new minor coordinate incrementcounter
2522 subd 4,s ; subtractout the largest difference
2523 bcs L94E2 ; brif not greater - draw another pixel
2524 std ,s ; save new minor coordinate increment
2525 jsr ,y ; adjust minor coordinate
2526 bra L94E2 ; go draw another pixel
2527 L9502 puls x ; clean up stack and return
2528 puls a,b,x,y,u,pc
2529 L9506 ldx HORBEG ; bump horizontal coordinate
2530 leax 1,x
2531 stx HORBEG
2532 rts
2533 L950D ldx VERBEG ; bump vertical coordinate
2534 leax 1,x
2535 stx VERBEG
2536 rts
2537 L9514 ldx HORBEG ; decrement horizontal coordinate
2538 leax -1,x
2539 stx HORBEG
2540 rts
2541 L951B ldx VERBEG ; decrement vertical coordinate
2542 leax -1,x
2543 stx VERBEG
2544 rts
2545 ; Get normalized maximum coordinate values in VD3 and VD5
2546 L9522 ldu #VD3 ; point to temp storage
2547 ldx #255 ; set maximum horizontal
2548 stx ,u
2549 ldx #191 ; set maximum vertical
2550 stx 2,u
2551 jmp L9320 ; normalize them
2552 ; PCLS command
2553 PCLS beq L9542 ; clear to background colour if no argument
2554 bsr L955A ; evaluate colour
2555 L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles
2556 mul ; now colour is in all four sub-pixels
2557 ldx BEGGRP ; get start of graphics screen
2558 L953B stb ,x+ ; set byte to proper colour
2559 cmpx ENDGRP ; at end of graphics page?
2560 bne L953B ; brif not
2561 rts
2562 L9542 ldb BAKCOL ; get background colour
2563 bra L9536 ; do the clearing dance
2564 ; COLOR command
2565 COLOR cmpa #', ; check for comma
2566 beq L9552 ; brif no foreground colour
2567 bsr L955A ; evaluate first colour
2568 stb FORCOL ; set foreground colour
2569 jsr GETCCH ; is there a background colour?
2570 beq L9559 ; brif not
2571 L9552 jsr SYNCOMMA ; make sure we have a comma
2572 bsr L955A ; evaluate background colour argument
2573 stb BAKCOL ; set background colour
2574 L9559 rts
2575 ; Evaluate a colour agument and convert to proper code based on graphics mode
2576 L955A jsr EVALEXPB ; evaluate colour code
2577 L955D cmpb #9 ; is it in range of 0-8?
2578 lbhs LB44A ; brif not - raise error
2579 clra ; CSS value for first colour set
2580 cmpb #5 ; is it first or second colour set?
2581 blo L956C ; brif first colour set
2582 lda #8 ; flag second colour set
2583 subb #4 ; adjust into basic range
2584 L956C pshs a ; save CSS value
2585 lda PMODE ; get graphics mode
2586 rora ; 4 colour or 2?
2587 bcc L957B ; brif 2 colour
2588 tstb ; was it 0?
2589 bne L9578 ; brif not
2590 L9576 ldb #4 ; if so, make it 4
2591 L9578 decb ; convert to zero based
2592 L9579 puls a,pc ; get back CSS value and return
2593 L957B rorb ; is colour number odd?
2594 bcs L9576 ; brif so - force all bits set colour
2595 clrb ; force colour 0 if not
2596 bra L9579
2597 ; Set all pixel byte and active colour
2598 L9581 jsr L959A ; set colour byte
2599 jsr GETCCH ; is there something to evaluate?
2600 beq L9598 ; brif not
2601 cmpa #') ; )?
2602 beq L9598 ; brif so
2603 jsr SYNCOMMA ; force comma
2604 cmpa #', ; another comma?
2605 beq L9598 ; brif so
2606 jsr L955A ; evaluate expression and return colour
2607 bsr L95A2 ; save colour and pixel byte
2608 L9598 jmp GETCCH ; re-fetch input character and return
2609 L959A ldb FORCOL ; use foreground colour by default
2610 tst SETFLG ; doing PRESET?
2611 bne L95A2 ; brif not
2612 ldb BAKCOL ; default to background colour
2613 L95A2 stb WCOLOR ; save working colour
2614 lda #0x55 ; consider a byte as 4 pixels
2615 mul ; now all pixels are set to the same bit pattern
2616 stb ALLCOL ; set all pixels byte
2617 rts
2618 L95AA bne L95CF ; brif graphics mode
2619 L95AC pshs x,b,a ; save registers
2620 ldx #SAMREG+8 ; point to middle of control register
2621 sta 10,x ; reset display page to 0x400
2622 sta 8,x
2623 sta 6,x
2624 sta 4,x
2625 sta 2,x
2626 sta 1,x
2627 sta -2,x
2628 sta -4,x ; reset to alpha mode
2629 sta -6,x
2630 sta -8,x
2631 lda PIA1+2 ; set VDG to alpha mode, colour set 0
2632 anda #7
2633 sta PIA1+2
2634 puls a,b,x,pc ;restore registers and return
2635 L95CF pshs x,b,a ; save registers
2636 lda PMODE ; get graphics mode
2637 adda #3 ; offset to 3-7 (we don't use the bottom 3 modes)
2638 ldb #0x10 ; shift to high 4 bits
2639 mul
2640 orb #0x80 ; set to graphics mode
2641 orb CSSVAL ; set the desired colour set
2642 lda PIA1+2 ; get get original PIA values
2643 anda #7 ; mask off VDG control
2644 pshs a ; merge with new VDG control
2645 orb ,s+
2646 stb PIA1+2 ; set new VDG mode
2647 lda BEGGRP ; get start of graphics page
2648 lsra ; divide by two - pages are on 512 byte boundaries
2649 jsr L960F ; set SAM control register
2650 lda PMODE ; get graphics mode
2651 adda #3 ; shift to VDG values
2652 cmpa #7 ; PMODE 4?
2653 bne L95F7 ; brif not
2654 deca ; treat PMODE 4 the same as PMODE 3
2655 L95F7 bsr L95FB ; program SAM's VDG bits
2656 puls a,b,x,pc ; restore registers and return
2657 L95FB ldb #3 ; set 3 bits in register
2658 ldx #SAMREG ; point to VDG control bits
2659 L9600 rora ; get bit to set
2660 bcc L9607 ; brif we need to clear the bit
2661 sta 1,x ; set the bit
2662 bra L9609
2663 L9607 sta ,x ; clear the bit
2664 L9609 leax 2,x ; move to next bit
2665 decb ; done all bits?
2666 bne L9600 ; brif not
2667 rts
2668 L960F ldb #7 ; 7 screen address bits
2669 ldx #SAMREG+6 ; point to screen address bits in SAM
2670 bra L9600 ; go program SAM bits
2671 L9616 lda PIA1+2 ; get VDG bits
2672 anda #0xf7 ; keep everything but CSS bit
2673 ora CSSVAL ; set correct CSS bit
2674 sta PIA1+2 ; set desired CSS
2675 rts
2676 ; PMODE command
2677 PMODETOK cmpa #', ; is first argument missing?
2678 beq L9650 ; brif so
2679 jsr EVALEXPB ; evaluate PMODE number
2680 cmpb #5 ; valid (0-4)?
2681 bhs L966D ; brif not
2682 lda GRPRAM ; get start of graphics memory
2683 L962E sta BEGGRP ; set start of graphics page
2684 aslb ; multiply mode by two (table has two bytes per entry)
2685 ldu #L9706+1 ; point to lookup table
2686 adda b,u ; add in number of 256 byte pages used for graphics screen
2687 cmpa TXTTAB ; does it fit?
2688 bhi L966D ; brif not
2689 sta ENDGRP ; save end of graphics
2690 leau -1,u ; point to bytes per horizontal row
2691 lda b,u ; get bytes per row
2692 sta HORBYT ; set it
2693 lsrb ; restore PMODE value
2694 stb PMODE ; set graphics mode
2695 clra ; set background colour to 0
2696 sta BAKCOL
2697 lda #3 ; set foreground colour to maximum (3)
2698 sta FORCOL
2699 jsr GETCCH ; is there a starting page number?
2700 beq L966C ; brif not
2701 L9650 jsr LB738 ; evaluate an expression following a comma
2702 tstb ; page 0?
2703 beq L966D ; brif so - not valid
2704 decb ; zero-base it
2705 lda #6 ; each graphics page is 6*256
2706 mul
2707 addb GRPRAM ; add to start of graphics memory
2708 pshs b ; save start of screen memory
2709 addb ENDGRP ; add current and address
2710 subb BEGGRP ; subtract current start (adds size of screen)
2711 cmpb TXTTAB ; does it fit?
2712 bhi L966D ; brif not
2713 stb ENDGRP ; save new end of graphics
2714 puls b ; get back start of graphics
2715 stb BEGGRP ; set start of graphics
2716 L966C rts
2717 L966D jmp LB44A ; raise FC error
2718 ; SCREEN command
2719 SCREEN cmpa #', ; is there a mode?
2720 beq L967F ; brif no mode
2721 jsr EVALEXPB ; get mode argument
2722 tstb ; set Z if alpha
2723 jsr L95AA ; set SAM/VDG for graphics mode
2724 jsr GETCCH ; is there a second argument?
2725 beq L966C ; brif not
2726 L967F jsr LB738 ; evaluate ,<expr>
2727 tstb ; colour set 0?
2728 beq L9687 ; brif so
2729 ldb #8 ; flag for colour set 1
2730 L9687 stb CSSVAL ; set colour set
2731 bra L9616 ; set up VDG
2732 ; PCLEAR command
2733 PCLEAR jsr EVALEXPB ; evaulate number of pages requested
2734 tstb ; 0?
2735 beq L966D ; brif zero - not allowed
2736 cmpb #9 ; more than 8?
2737 bhs L966D ; brif so - not allowed
2738 lda #6 ; there are 6 "pages" per graphics page
2739 mul ; now B is the number of pages to reserve
2740 addb GRPRAM ; add to start of graphics memory
2741 tfr b,a ; now A is the MSB of the start of free memory
2742 ldb #1 ; program memory always starts one above
2743 tfr d,y ; save pointer to program memory
2744 cmpd ENDGRP ; are we trying to deallocate the current graphics page?
2745 blo L966D ; brif so (note that this prevents PCLEAR 0 anyway)
2746 subd TXTTAB ; subtract out current start of basic program
2747 addd VARTAB ; add in end of program - now D is new top of program
2748 tfr d,x ; save new end of program
2749 inca ; make some extra space (for stack)
2750 subd FRETOP ; see if new top of program fits
2751 bhs L966D ; brif there isn't enough space
2752 jsr L80D0 ; adjust input pointer
2753 nop ; space filler for 1.1 patch (the JSR above)
2754 ldu VARTAB ; get end of program
2755 stx VARTAB ; save new end of program
2756 cmpu VARTAB ; is old end higher?
2757 bhs L96D4 ; brif so
2758 L96BD lda ,-u ; copy a byte upward
2759 sta ,-x
2760 cmpu TXTTAB ; at beginning?
2761 bne L96BD ; brif not
2762 sty TXTTAB ; save new start of program
2763 clr -1,y ; there must always be a NUL before the program
2764 L96CB jsr LACEF ; re-assign basic program addresses
2765 jsr LAD26 ; reset variables and stack
2766 jmp LAD9E ; return to interpretation loop
2767 L96D4 ldu TXTTAB ; get start of program
2768 sty TXTTAB ; save new start of program
2769 clr -1,y ; there must be a NUL at the start of the program
2770 L96DB lda ,u+ ; move a byte downward
2771 sta ,y+
2772 cmpy VARTAB ; at the top of the program?
2773 bne L96DB ; brif not
2774 bra L96CB ; finish up
2775 ; Graphics initialization routine - this really should be up at the start of the ROM with the
2776 ; rest of the initialization code.
2777 L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4")
2778 stb TXTTAB
2779 lda #6 ; graphics memory starts immediately after the screen
2780 L96EC sta GRPRAM ; set graphics memory start
2781 sta BEGGRP ; set start of current graphics page
2782 clra ; set PMODE to 0
2783 sta PMODE
2784 lda #16 ; 16 bytes per graphics row
2785 sta HORBYT
2786 lda #3 ; set foreground colour to 3
2787 sta FORCOL
2788 lda #0x0c ; set ending graphics page (for PMODE 0)
2789 sta ENDGRP
2790 ldx TXTTAB ; get start of program
2791 clr -1,x ; make sure there's a NUL before it
2792 L9703 jmp LAD19 ; do a "NEW"
2793 ; PMODE data table (bytes per row and number of 256 byte pages required for a screen)
2794 L9706 fcb 16,6 ; PMODE 0
2795 fcb 32,12 ; PMODE 1
2796 fcb 16,12 ; PMODE 2
2797 fcb 32,24 ; PMODE 3
2798 fcb 32,24 ; PMODE 4
2799 ; Calculate absolute value of vertical coordinate difference
2800 L9710 ldd VEREND ; get ending address
2801 subd VERBEG ; get difference
2802 L9714 bcc L9751 ; brif we didn't carry
2803 pshs cc ; save status (C set if start > end)
2804 jsr L9DC3 ; negate the difference to be positive
2805 puls cc,pc ; restore C and return
2806 ; Calculate absolute value of horizontal coordinate difference
2807 L971D ldd HOREND ; get end coordinate
2808 subd HORBEG ; calculate difference
2809 bra L9714 ; turn into absolute value
2810 ; PCOPY command
2811 PCOPY bsr L973F ; fetch address of the source page
2812 pshs d ; save address
2813 ldb #0xa5 ; make sure we have TO
2814 jsr LB26F
2815 bsr L973F ; fetch address of the second page
2816 puls x ; get back source
2817 tfr d,u ; put destination into a pointer
2818 ldy #0x300 ; 0x300 words to copy
2819 L9736 ldd ,x++ ; copy a word
2820 std ,u++
2821 leay -1,y ; done?
2822 bne L9736 ; brif not
2823 rts
2824 L973F jsr EVALEXPB ; evaluate page number
2825 tstb ; zero?
2826 beq L9752 ; brif invalid page number
2827 ; BUG: this should be deferred until after the address is calculated at which point it should
2828 ; be bhs instead of bhi. There should also be a check to make sure the page number is less than
2829 ; or equal to 8 above so we don't have to test for overflows below.
2830 cmpb TXTTAB ; is page number higher than start of program (BUG!)
2831 bhi L9752 ; brif so - error
2832 decb ; zero-base the page number
2833 lda #6 ; 6 "pages" per graphics page
2834 mul ; now we have proper number of "pages" for the offset
2835 addb GRPRAM ; add start of graphics memory
2836 exg a,b ; put MSB into A, 0 into B.
2837 L9751 rts
2838 L9752 jmp LB44A ; raise illegal function call
2839 ; GET command
2840 GET clrb ; GET flag
2841 bra L975A ; go on to the main body
2842 PUT ldb #1 ; PUT flag
2843 L975A stb VD8 ; save GET/PUT flag
2844 jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing)
2845 L975F cmpa #'@ ; @ before coordinates?
2846 bne L9765 ; brif not
2847 jsr GETNCH ; eat the @
2848 L9765 jsr L938F ; evaluate start/end coordinates
2849 jsr SYNCOMMA ; make sure we have a comma
2850 jsr L98CC ; get pointer to array
2851 tfr X,D ; save descriptor pointer
2852 ldu ,x ; get offset to next descriptor
2853 leau -2,u ; move back to array name
2854 leau d,u ; point to end of array
2855 stu VD1 ; save end of data
2856 leax 2,x ; point to number of dimensions
2857 ldb ,x ; get dimension count
2858 aslb ; two bytes per dimension size
2859 abx ; now X points to start of data
2860 stx VCF ; save start of array data
2861 lda VALTYP ; is it numeric
2862 bne L9752 ; brif not
2863 clr VD4 ; set default graphic action to PSET
2864 jsr GETCCH ; get input character
2865 beq L97B7 ; brif no action flag
2866 com VD4 ; flag action enabled
2867 jsr SYNCOMMA ; make sure there's a comma
2868 tst VD8 ; PUT?
2869 bne L979A ; brif so
2870 ldb #'G ; check for full graphics option
2871 jsr LB26F
2872 bra L97CA ; handle the rest of the process
2873 L979A ldb #5 ; 5 legal actions for PUT
2874 ldx #L9839 ; point to action table
2875 L979F ldu ,x++ ; get "clear bit" action routine
2876 ldy ,x++ ; get "set bit" action routine
2877 cmpa ,x+ ; does token match?
2878 beq L97AE ; brif so
2879 decb ; checked all?
2880 bne L979F ; brif not
2881 jmp LB277 ; raise error
2882 L97AE sty VD5 ; save set bit action address
2883 stu VD9 ; save clear bit action address
2884 jsr GETNCH ; munch the acton token
2885 bra L97CA ; handle rest of process
2886 L97B7 ldb #0xf8 ; mask for bottom three bits
2887 lda PMODE ; get graphics mode
2888 rora ; odd number mode?
2889 bcc L97C0 ; brif even
2890 ldb #0xfc ; bottom 2 bits mask
2891 L97C0 tfr b,a ; save mask
2892 andb HORBEG+1 ; round down the start address
2893 stb HORBEG+1
2894 anda HOREND+1 ; round down end address
2895 sta HOREND+1
2896 L97CA jsr L971D ; get horizontal size
2897 bcc L97D3 ; brif end > start
2898 ldx HOREND ; switch end in for start
2899 stx HORBEG
2900 L97D3 std HOREND ; save size
2901 jsr L9710 ; calculate vertical size
2902 bcc L97DE ; brif end > start
2903 ldx VEREND ; swap in vertical end for the start
2904 stx VERBEG
2905 L97DE std VEREND ; save vertical size
2906 lda PMODE ; get graphics mode
2907 rora ; even?
2908 ldd HOREND ; get difference
2909 bcc L97EB ; brif even (2 colour)
2910 addd HOREND ; add in size (double it)
2911 std HOREND ; save adjusted end size
2912 L97EB jsr L9420 ; normalize differences
2913 ldd HOREND ; get end coord
2914 ldx VEREND ; get end size
2915 leax 1,x ; make vertical size inclusive
2916 stx VEREND ; save it back
2917 tst VD4 ; got "G" or GET action
2918 bne L9852 ; brif given
2919 lsra ; we're going for whole bytes here
2920 rorb
2921 lsra
2922 rorb
2923 lsra
2924 rorb
2925 addd #1 ; make it inclusive
2926 std HOREND ; save new coordinate
2927 jsr L9298 ; convert to screen address
2928 L9808 ldb HOREND+1 ; get horizontal size
2929 pshs x ; save screen position
2930 L980C tst VD8 ; get/put flag
2931 beq L9831 ; brif get
2932 bsr L9823 ; bump array data pointer
2933 lda ,u ; copy data from array to screen
2934 sta ,x+
2935 L9816 decb ; are we done the row?
2936 bne L980C ; brif not
2937 puls x ; get screen address
2938 jsr L92E9 ; move to next row
2939 dec VEREND+1 ; done?
2940 bne L9808 ; brif not
2941 L9822 rts
2942 L9823 ldu VCF ; get array data location
2943 leau 1,u ; bump it
2944 stu VCF ; save new array data location
2945 cmpu VD1 ; did we hit the end of the array?
2946 bne L9822 ; brif not
2947 L982E jmp LB44A ; raise function call error
2948 L9831 lda ,x+ ; get data from screen
2949 bsr L9823 ; bump array data pointer
2950 sta ,u ; put data in array
2951 bra L9816 ; do the loopy thing
2952 ; PUT actions
2953 L9839 fdb L9894,L989B ; PSET
2954 fcb 0xbd
2955 fdb L989B,L9894 ; PRESET
2956 fcb 0xbe
2957 fdb L98B1,L989B ; OR
2958 fcb 0xb1
2959 fdb L9894,L98B1 ; AND
2960 fcb 0xb0
2961 fdb L98A1,L98A1 ; NOT
2962 fcb 0xa8
2963 L9852 addd #1 ; add to horiz difference
2964 std HOREND ; save it
2965 lda VD8 ; PUT?
2966 bne L9864 ; brif so
2967 ldu VD1 ; get end of array
2968 L985D sta ,-u ; zero out a byte
2969 cmpu VCF ; done?
2970 bhi L985D ; brif not
2971 L9864 jsr L9298 ; get screen address
2972 ldb PMODE ; get graphics mode
2973 rorb ; even?
2974 bcc L986E ; brif so
2975 anda #0xaa ; use as pixel mask for 4 colour mode
2976 L986E ldb #1 ; set bit probe
2977 ldy VCF ; point to start of array data
2978 L9873 pshs x,a ; save screen address
2979 ldu HOREND ; get horizontal size
2980 L9877 pshs u,a ; save horizontal size and pixel mask
2981 lsrb ; move bit probe right
2982 bcc L9884 ; brif we didn't fall off a byte
2983 rorb ; shift carry back in on the left
2984 leay 1,y ; move ahead a byte in the array
2985 cmpy VD1 ; end of array data?
2986 beq L982E ; raise error if so
2987 L9884 tst VD8 ; PUT?
2988 beq L98A7 ; brif not
2989 bitb ,y ; test bit in array
2990 beq L9890 ; brif not set
2991 jmp [VD5] ; do action routine for bit set
2992 L9890 jmp [VD9] ; do action routine for bit clear
2993 L9894 coma ; invert mask
2994 anda ,x ; read screen data and reset the desired bit
2995 sta ,x ; save on screen
2996 bra L98B1
2997 L989B ora ,x ; merge pixel mask with screen data (turn on bit)
2998 sta ,x ; save on screen
2999 bra L98B1
3000 L98A1 eora ,x ; invert the pixel in the screen data
3001 sta ,x ; save on screen
3002 bra L98B1
3003 L98A7 bita ,x ; is the bit set?
3004 beq L98B1 ; brif not - do nothing
3005 tfr b,a ; get bit probe
3006 ora ,y ; turn on proper bit in data
3007 sta ,y
3008 L98B1 puls a,u ; get back array address
3009 jsr L92ED ; move screen address to the right
3010 leau -1,u ; account for consumed pixel
3011 cmpu ZERO ; done yet?
3012 bne L9877 ; brif not
3013 ldx 1,s ; get start of row back
3014 lda HORBYT ; get number of bytes per row
3015 leax a,x ; move ahead one line
3016 puls a ; get back screen pixel mask
3017 leas 2,s ; lose the screen pointer
3018 dec VEREND+1 ; done all rows?
3019 bne L9873 ; brif not
3020 rts
3021 L98CC jsr LB357 ; evaluate a variable
3022 ldb ,-x ; get variable name
3023 lda ,-x
3024 tfr d,u ; save it
3025 ldx ARYTAB ; get start of arrays
3026 L98D7 cmpx ARYEND ; end of arrays?
3027 lbeq LB44A ; brif not found
3028 cmpu ,x ; correct variable?
3029 beq L98E8 ; brif so
3030 ldd 2,x ; get array size
3031 leax d,x ; move to next array
3032 bra L98D7 ; check this array
3033 L98E8 leax 2,x ; move pointer to the array header
3034 rts ; obviously this rts is not needed
3035 L98EB rts
3036 ; PAINT command
3037 PAINT cmpa #'@ ; do we have @ before coords?
3038 bne L98F2 ; brif not
3039 jsr GETNCH ; eat the @
3040 L98F2 jsr L93B2 ; evaluate coordinates
3041 jsr L931D ; normalize coordinates
3042 lda #1 ; PSET flag (use working colour)
3043 sta SETFLG
3044 jsr L9581 ; parse colour and set working colour, etc.
3045 ldd WCOLOR ; get working colour and all pixels byte
3046 pshs d ; save them
3047 jsr GETCCH ; is there anything else?
3048 beq L990A ; brif not
3049 jsr L9581 ; evaluate border colour
3050 L990A lda ALLCOL ; get border colour all pixel byte
3051 sta VD8 ; save border colour pixel byte
3052 puls d ; get back working colour details
3053 std WCOLOR
3054 clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding
3055 pshs u,x,b,a
3056 jsr L9522 ; set up starting coordinates
3057 jsr L928F ; point to pixel mask routine
3058 stu VD9 ; save pixel mask routine
3059 jsr L99DF ; paint from current horizontal coordinate to zero (left)
3060 beq L9931 ; brif hit border immediately
3061 jsr L99CB ; paint from current horizontal coordinate upward (right)
3062 lda #1 ; set direction to "down"
3063 sta VD7
3064 jsr L99BA ; save "down" frame
3065 neg VD7 ; set direction to "up"
3066 jsr L99BA ; save "up" frame
3067 L9931 sts TMPSTK ; save stack pointer
3068 L9934 tst CHGFLG ; did the paint change anything?
3069 bne L993B ; brif so
3070 lds TMPSTK ; get back stack pointer
3071 L993B puls a,b,x,u ; get frame from stack
3072 clr CHGFLG ; mark nothing changed
3073 sts TMPSTK ; save stack pointer
3074 leax 1,x ; move start coordinate right
3075 stx HORBEG ; save new coordinate
3076 stu VD1 ; save length of line
3077 sta VD7 ; save up/down flag
3078 beq L98EB ; did we hit the "stop" frame?
3079 bmi L9954 ; brif negative going (up)?
3080 incb ; bump vertical coordinate
3081 cmpb VD6 ; at end?
3082 bls L9958 ; brif not
3083 clrb ; set vertical to 0 (wrap around)
3084 L9954 tstb ; did we wrap?
3085 beq L9934 ; do another block if so
3086 decb ; move up a row
3087 L9958 stb VERBEG+1 ; save vertical coordinate
3088 jsr L99DF ; paint from horizontal to 0
3089 beq L996E ; brif we hit the border immediately
3090 cmpd #3 ; less than 3 pixels?
3091 blo L9969 ; brif so
3092 leax -2,x ; move two pixels left
3093 bsr L99A1 ; save paint block on the stack
3094 L9969 jsr L99CB ; continue painting to the right
3095 L996C bsr L99BA ; save paint data frame
3096 L996E coma ; complement length of line just painted and add to length of line
3097 comb
3098 L9970 addd VD1 ; save difference between this line and parent line
3099 std VD1
3100 ble L998C ; brif parent line is shorter
3101 jsr L9506 ; bump horizontal coordinate
3102 jsr L9A12 ; see if we bounced into the border
3103 bne L9983 ; brif not border
3104 ldd #-1 ; move left
3105 bra L9970 ; keep looking
3106 L9983 jsr L9514 ; move horizontally left
3107 bsr L99C6 ; save horizontal coordinate
3108 bsr L99E8 ; paint right
3109 bra L996C ; save paint block and do more
3110 L998C jsr L9506 ; bump horizontal coordinate
3111 leax d,x ; point to right end of parent line
3112 stx HORBEG ; set as curent coordinate
3113 coma ; get amount we extend past parent line
3114 comb
3115 subd #1
3116 ble L999E ; brif doesn't extend
3117 tfr d,x ; save length of line
3118 bsr L99A1 ; save paint frame
3119 L999E jmp L9934
3120 L99A1 std VCB ; save number of pixels painted
3121 puls y ; get return address
3122 ldd HORBEG ; get horizontal coordinate
3123 pshs x,b,a ; save horizontal coordinate and pointer
3124 lda VD7 ; get up/down flag
3125 nega ; reverse it
3126 L99AC ldb VERBEG+1 ; get vertical coordainte
3127 pshs b,a ; save vertical coord and up/down flag
3128 pshs y ; put return address back
3129 ldb #2 ; make sure we haven't overflowed memory
3130 jsr LAC33
3131 ldd VCB ; get line length back
3132 rts
3133 L99BA std VCB ; save length of painted line
3134 puls y ; get return address
3135 ldd HOREND ; get start coord
3136 pshs x,b,a ; save horizontal start and length
3137 lda VD7 ; get up/down flag
3138 bra L99AC ; finish up with the stack
3139 L99C6 ldx HORBEG ; save current horizontal coord and save it
3140 stx HOREND
3141 rts
3142 L99CB std VCD ; save number of pixels painted
3143 ldy HOREND ; get last horizontal start
3144 bsr L99C6 ; save current coordinate
3145 sty HORBEG ; save coordinate
3146 bsr L99E8 ; paint a line
3147 ldx VCD ; get number painted
3148 leax d,x ; add to the number painted going the other way
3149 addd #1 ; now D is length of line
3150 rts
3151 L99DF jsr L99C6 ; put starting coordinate in end
3152 ldy #L9514 ; decrement horizontal coordinate address
3153 bra L99EE ; go paint line
3154 L99E8 ldy #L9506 ; increment horizontal coordinate address
3155 jsr ,y ; bump coordinate
3156 L99EE ldu ZERO ; initialize pixel count
3157 ldx HORBEG ; get starting coordinate
3158 L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate
3159 cmpx VD3 ; at end?
3160 bhi L9A0B ; brif right of max
3161 pshs u,y ; save counter and inc/dec routine pointer
3162 bsr L9A12 ; at border?
3163 beq L9A09 ; brif so
3164 jsr L9377 ; set pixel to paint colour
3165 puls y,u ; restore counter and inc/dec/pointer
3166 leau 1,u ; bump number of painted pixels
3167 jsr ,y ; inc/dec screen address
3168 bra L99F2 ; go do another pixel
3169 L9A09 puls y,u ; get back counter and inc/dec routine
3170 L9A0B tfr u,d ; save count in D
3171 tfr d,x ; and in X
3172 subd ZERO ; set flags on D (smaller/faster than cmpd ZERO)
3173 rts
3174 L9A12 jsr [VD9] ; get the screen address
3175 tfr a,b ; save pixel mask
3176 andb VD8 ; set pixel to border colour
3177 pshs b,a ; save mask and border
3178 anda ,x ; mask current pixel into A
3179 cmpa 1,s ; does it match border? Z=1 if so
3180 puls a,b,pc ; restore mask, border pixel, and return
3181 ; PLAY command
3182 ; This is here mixed in with the graphics package because it shares some machinery with DRAW.
3183 PLAY ldx ZERO ; default values for note length, etc.
3184 ldb #1
3185 pshs x,b ; save default values
3186 jsr LB156 ; evaluate argument
3187 clrb ; enable DA and sound output
3188 jsr LA9A2
3189 jsr LA976
3190 L9A32 jsr LB654 ; fetch PLAY string details
3191 bra L9A39 ; go evaluate the string
3192 L9A37 puls b,x ; get back play string details
3193 L9A39 stb VD8 ; save length of string
3194 beq L9A37 ; brif end of string
3195 stx VD9 ; save start of string
3196 lbeq LA974 ; brif NULL string - disable sound and return
3197 L9A43 tst VD8 ; have anything left?
3198 beq L9A37 ; brif not
3199 jsr L9B98 ; get command character
3200 cmpa #'; ; command separator?
3201 beq L9A43 ; brif so - ignore it
3202 cmpa #'' ; '?
3203 beq L9A43 ; brif so - ignore it
3204 cmpa #'X ; execuate sub string?
3205 lbeq L9C0A ; brif so - handle it
3206 bsr L9A5C ; handle other commands
3207 bra L9A43 ; look for more stuff
3208 L9A5C cmpa #'O ; octave?
3209 bne L9A6D ; brif not
3210 ldb OCTAVE ; get current octave
3211 incb ; 1-base it
3212 bsr L9AC0 ; get value if present
3213 decb ; zero-base it
3214 cmpb #4 ; valid octave?
3215 bhi L9ACD ; raise error if not
3216 stb OCTAVE ; save new octave
3217 rts
3218 L9A6D cmpa #'V ; volume?
3219 bne L9A8B ; brif not
3220 ldb VOLHI ; get current high volume limit
3221 lsrb ; shift 2 bits right (DA is 6 bits in high bits)
3222 lsrb
3223 subb #31 ; subtract out mid value offset
3224 bsr L9AC0 ; read argument
3225 cmpb #31 ; maximum range is 31
3226 bhi L9ACD ; brif out of range
3227 aslb ; adjust back in range
3228 aslb
3229 pshs b ; save new volume
3230 ldd #0x7e7e ; midrange value for both high and low
3231 adda ,s ; add new volume to high limit
3232 subb ,s+ ; subtract volume from low limit
3233 std VOLHI ; save new volume limits (sets high and low amplitudes)
3234 rts
3235 L9A8B cmpa #'L ; note length?
3236 bne L9AB2 ; brif not
3237 ldb NOTELN ; get current length
3238 bsr L9AC0 ; read parameter
3239 tstb ; resulting length 0?
3240 beq L9ACD ; brif so - problem
3241 stb NOTELN ; save new length
3242 clr DOTVAL ; reset note timer scale factor
3243 L9A9A bsr L9A9F ; check for dot
3244 bcc L9A9A ; brif there was one
3245 rts
3246 L9A9F tst VD8 ; check length
3247 beq L9AAD ; brif zero
3248 jsr L9B98 ; get command character
3249 cmpa #'. ; dot?
3250 beq L9AAF ; brif so
3251 jsr L9BE2 ; move input back and bump length
3252 L9AAD coma ; set C to indicate nothing found
3253 rts
3254 L9AAF inc DOTVAL ; bump number of dots
3255 rts
3256 L9AB2 cmpa #'T ; tempo?
3257 bne L9AC3 ; brif not
3258 ldb TEMPO ; get current tempo
3259 bsr L9AC0 ; parse tempo argument
3260 tstb ; 0?
3261 beq L9ACD ; brif so - invalid
3262 stb TEMPO ; save new tempo
3263 rts
3264 L9AC0 jmp L9BAC ; evaluate various operators
3265 L9AC3 cmpa #'P ; pause?
3266 bne L9AEB ; brif not
3267 jsr L9CCB ; evaluate parameter
3268 tstb ; is the pause number 0?
3269 bne L9AD0 ; brif not
3270 L9ACD jmp LB44A ; raise FC error
3271 L9AD0 lda DOTVAL ; save current volume and note scale
3272 ldx VOLHI
3273 pshs x,a
3274 lda #0x7e ; drop DA to mid range
3275 sta VOLHI
3276 sta VOLLOW
3277 clr DOTVAL
3278 bsr L9AE7 ; go play a "silence"
3279 puls a,x ; restore volume and note scale
3280 sta DOTVAL
3281 stx VOLHI
3282 rts
3283 L9AE7 clr ,-s ; set not number 0
3284 bra L9B2B ; go play it
3285 L9AEB cmpa #'N ; N for "note"?
3286 bne L9AF2 ; brif not - it's optional
3287 jsr L9B98 ; skip the "N"
3288 L9AF2 cmpa #'A ; is it a valid note?
3289 blo L9AFA ; brif not
3290 cmpa #'G ; is it above the note range?
3291 bls L9AFF ; brif not - valid note
3292 L9AFA jsr L9BBE ; evaluate a number
3293 bra L9B22 ; process note value
3294 L9AFF suba #'A ; normalize note number to 0
3295 ldx #L9C5B ; point to note number lookup table
3296 ldb a,x ; get not number
3297 tst VD8 ; any command characters left?
3298 beq L9B22 ; brif not
3299 jsr L9B98 ; get character
3300 cmpa #'# ; sharp?
3301 beq L9B15 ; brif so
3302 cmpa #'+ ; also sharp?
3303 bne L9B18 ; brif not
3304 L9B15 incb ; add one half tone
3305 bra L9B22
3306 L9B18 cmpa #'- ; flat?
3307 bne L9B1F ; brif not
3308 decb ; subtract one half tone
3309 bra L9B22
3310 L9B1F jsr L9BE2 ; back up command pointer
3311 L9B22 decb ; adjust note number (zero base it)
3312 cmpb #11 ; is it valid?
3313 bhi L9ACD ; raise error if not
3314 pshs b ; save note value
3315 ldb NOTELN ; get note length
3316 L9B2B lda TEMPO ; get tempo value
3317 mul ; calculate note duration
3318 std VD5 ; save duration
3319 leau 1,s ; point to where the stack goes after we're done
3320 lda OCTAVE ; get current octave
3321 cmpa #1 ; 0 or 1?
3322 bhi L9B64 ; brif not
3323 ldx #L9C62 ; point to delay table
3324 ldb #2*12 ; 24 bytes per octave
3325 mul ; now we have the base address
3326 abx ; now X points to the octave base
3327 puls b ; get back note value
3328 aslb ; two bytes per delay
3329 abx ; now we're pointing to the delay
3330 leay ,x ; save pointer to note value
3331 bsr L9B8C ; calculate note timer value
3332 std PLYTMR ; set timer for note playing (IRQ will count this down)
3333 L9B49 bsr L9B57 ; set to mid range and delay
3334 lda VOLHI ; get high value
3335 bsr L9B5A ; set to high value and delay
3336 bsr L9B57 ; set to mid range and delay
3337 lda VOLLOW ; get low value
3338 bsr L9B5A ; set to low value and delay
3339 bra L9B49 ; do it again (IRQ will break the loop)
3340 L9B57 lda #0x7e ; mid value for DA with RS232 marking
3341 nop ; a delay to fine tune frequencies
3342 L9B5A sta PIA1 ; set DA
3343 ldx ,y ; get delay value
3344 L9B5F leax -1,x ; count down
3345 bne L9B5F ; brif not done yet
3346 rts
3347 L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+
3348 ldb #12 ; 12 bytes per octave
3349 mul ; now we have the offset to the desired octave
3350 abx ; now we point to the start of the octave
3351 puls b ; get back note value
3352 abx ; now we point to the delay value
3353 bsr L9B8C ; calculate timer value
3354 std PLYTMR ; set play timer (IRQ counts this down)
3355 L9B72 bsr L9B80 ; send mid value and delay
3356 lda VOLHI ; get high value
3357 bsr L9B83 ; send high value and delay
3358 bsr L9B80 ; send low value and delay
3359 lda VOLLOW ; get low value
3360 bsr L9B83 ; send low value and delay
3361 bra L9B72 ; do it again (IRQ will break the loop)
3362 L9B80 lda #0x7e ; mid range value with RS232 marking
3363 nop ; fine tuning delay
3364 L9B83 sta PIA1 ; set DA
3365 lda ,x ; get delay value
3366 L9B88 deca ; count down
3367 bne L9B88 ; brif not done
3368 rts
3369 L9B8C ldb #0xff ; base timer value
3370 lda DOTVAL ; get number of dots
3371 beq L9B97 ; use default value if 0
3372 adda #2 ; add in constant timer factor
3373 mul ; multiply scale by base
3374 lsra ; divide by two - each increment will increase note timer by 128
3375 rorb
3376 L9B97 rts
3377 L9B98 pshs x ; save register
3378 L9B9A tst VD8 ; do we have anything left?
3379 beq L9BEB ; brif not - raise error
3380 ldx VD9 ; get parsing address
3381 lda ,x+ ; get character
3382 stx VD9 ; save pointer
3383 dec VD8 ; account for character consumed
3384 cmpa #0x20 ; space?
3385 beq L9B9A ; brif so - skip it
3386 puls x,pc ; restore register and return
3387 L9BAC bsr L9B98 ; get character
3388 cmpa #'+ ; add one?
3389 beq L9BEE ; brif so
3390 cmpa #'- ; subtract one?
3391 beq L9BF2 ; brif so
3392 cmpa #'> ; double?
3393 beq L9BFC ; brif so
3394 cmpa #'< ; halve?
3395 beq L9BF7 ; brif so
3396 L9BBE cmpa #'= ; variable equate?
3397 beq L9C01 ; brif so
3398 jsr L90AA ; clear carry if numeric
3399 bcs L9BEB ; brif not numeric
3400 clrb ; initialize value to 0
3401 L9BC8 suba #'0 ; remove ASCII bias
3402 sta VD7 ; save digit
3403 lda #10 ; make room for digit
3404 mul
3405 tsta ; did we overflow 8 bits?
3406 bne L9BEB ; brif so
3407 addb VD7 ; add in digit
3408 bcs L9BEB ; brif that overflowed
3409 tst VD8 ; more digits?
3410 beq L9BF1 ; brif not
3411 jsr L9B98 ; get character
3412 jsr L90AA ; clear carry if numeric
3413 bcc L9BC8 ; brif another digit
3414 L9BE2 inc VD8 ; unaccount for character just read
3415 ldx VD9 ; move pointer back
3416 leax -1,x
3417 stx VD9
3418 rts
3419 L9BEB jmp LB44A ; raise FC error
3420 L9BEE incb ; bump param
3421 beq L9BEB ; brif overflow
3422 L9BF1 rts
3423 L9BF2 tstb ; already zero?
3424 beq L9BEB ; brif so - underflow
3425 decb ; decrease parameter
3426 rts
3427 L9BF7 tstb ; already at 0?
3428 beq L9BEB ; brif so - raise error
3429 lsrb ; halve it
3430 rts
3431 L9BFC tstb ; will it overflow?
3432 bmi L9BEB ; brif so
3433 aslb ; double it
3434 rts
3435 L9C01 pshs u,y ; save registers
3436 bsr L9C1B ; interpret command string as a variable
3437 jsr LB70E ; convert it to an 8 bit number
3438 puls y,u,pc ; restore registers and return
3439 L9C0A jsr L9C1B ; evaluate expression in command string
3440 ldb #2 ; room for 4 bytes?
3441 jsr LAC33
3442 ldb VD8 ; get the command length and pointer
3443 ldx VD9
3444 pshs x,b ; save them
3445 jmp L9A32 ; go process the sub string
3446 L9C1B ldx VD9 ; get command pointer
3447 pshs x ; save it
3448 jsr L9B98 ; get input character
3449 jsr LB3A2 ; set carry if not alpha
3450 bcs L9BEB ; brif not a variable reference
3451 L9C27 jsr L9B98 ; get command character
3452 cmpa #'; ; semicolon?
3453 bne L9C27 ; keep scanning if not
3454 puls x ; get back start of variable string
3455 ldu CHARAD ; get current interpreter input pointer
3456 pshs u ; save it
3457 stx CHARAD ; point interpreter at command string
3458 jsr LB284 ; evaluate expression as string
3459 puls x ; restore interpeter input pointer
3460 stx CHARAD
3461 rts
3462 ; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after
3463 ; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts.
3464 L9C3E clra ; make sure DP is set to 0
3465 tfr a,dp
3466 ldd PLYTMR ; is PLAY running?
3467 lbeq LA9BB ; brif not - transfer control on the Color Basic's routine
3468 subd VD5 ; subtract out the interval
3469 std PLYTMR ; save new timer value
3470 bhi L9C5A ; brif it isn't <= 0
3471 clr PLYTMR ; disable the timer
3472 clr PLYTMR+1
3473 puls a ; get saved CC
3474 lds 7,s ; set stack to saved U value
3475 anda #0x7f ; clear E flag (to return minimal state)
3476 pshs a ; set fake "FIRQ" stack frame
3477 L9C5A rti
3478 L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G
3479 L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1
3480 fdb 0x0150,0x013d,0x012b,0x011a
3481 fdb 0x010a,0x00fb,0x00ed,0x00df
3482 fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2
3483 fdb 0x00a6,0x009d,0x0094,0x008b
3484 fdb 0x0083,0x007c,0x0075,0x006e
3485 L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3
3486 fcb 0x83,0x7b,0x74,0x6d
3487 fcb 0x67,0x61,0x5b,0x56
3488 fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4
3489 fcb 0x3f,0x3b,0x37,0x34
3490 fcb 0x31,0x2e,0x2b,0x28
3491 fcb 0x26,0x23,0x21,0x1f ; delays for octave 5
3492 fcb 0x1d,0x1b,0x19,0x18
3493 fcb 0x16,0x14,0x13,0x12
3494 ; DRAW command
3495 DRAW ldx ZERO ; create an empty "DRAW" frame
3496 ldb #1
3497 pshs x,b
3498 stb SETFLG ; set to "PSET" mode
3499 stx VD5 ; clear update and draw flag
3500 jsr L959A ; set active colour byte
3501 jsr LB156 ; evaluate command string
3502 L9CC6 jsr LB654 ; fetch command string details
3503 bra L9CD3 ; interpret the command string
3504 L9CCB jsr L9B98 ; fetch command character
3505 jmp L9BBE ; evaluate a number
3506 L9CD1 puls b,x ; get previously saved command string
3507 L9CD3 stb VD8 ; save length counter
3508 beq L9CD1 ; brif end of string
3509 stx VD9 ; save pointer
3510 lbeq L9DC7 ; brif overall end of command
3511 L9CDD tst VD8 ; are we at the end of the string?
3512 beq L9CD1 ; brif so - return to previous string
3513 jsr L9B98 ; get command character
3514 cmpa #'; ; semicolon?
3515 beq L9CDD ; brif so - ignore it
3516 cmpa #'' ; '?
3517 beq L9CDD ; brif so - ignore that too
3518 cmpa #'N ; update position toggle?
3519 bne L9CF4 ; brif not
3520 com VD5 ; toggle update position flag
3521 bra L9CDD ; get on for another command
3522 L9CF4 cmpa #'B ; blank flag?
3523 bne L9CFC ; brif not
3524 com VD6 ; toggle blank flag
3525 bra L9CDD ; get on for another command
3526 L9CFC cmpa #'X ; substring?
3527 lbeq L9D98 ; brif so - execute command
3528 cmpa #'M ; move draw position?
3529 lbeq L9E32 ; brif so
3530 pshs a ; save command character
3531 ldb #1 ; default value if no number follows
3532 tst VD8 ; is there something there?
3533 beq L9D21 ; brif not
3534 jsr L9B98 ; get character
3535 jsr LB3A2 ; set C if not alpha
3536 pshs cc ; save alpha state
3537 jsr L9BE2 ; move back pointer
3538 puls cc ; get back alpha flag
3539 bcc L9D21 ; brif it's alpha
3540 bsr L9CCB ; evaluate a number
3541 L9D21 puls a ; get command back
3542 cmpa #'C ; color change?
3543 beq L9D4F ; brif so
3544 cmpa #'A ; angle?
3545 beq L9D59 ; brif so
3546 cmpa #'S ; scale?
3547 beq L9D61 ; brif so
3548 cmpa #'U ; up?
3549 beq L9D8F ; brif so
3550 cmpa #'D ; down?
3551 beq L9D8C ; brif so
3552 cmpa #'L ; left?
3553 beq L9D87 ; brif so
3554 cmpa #'R ; right?
3555 beq L9D82 ; brif so
3556 suba #'E ; normalize the half cardinals to 0
3557 beq L9D72 ; brif E (45°)
3558 deca ; F (135°?)
3559 beq L9D6D ; brif so
3560 deca ; G (225°?)
3561 beq L9D7B ; brif so
3562 deca ; H (315°?)
3563 beq L9D69 ; brif so
3564 L9D4C jmp LB44A ; raise FC error
3565 L9D4F jsr L955D ; adjust colour for PMODE
3566 stb FORCOL ; save new foreground colour
3567 jsr L959A ; set up working colour and all pixels byte
3568 L9D57 bra L9CDD ; go process another command
3569 L9D59 cmpb #4 ; only 3 angles are valid
3570 bhs L9D4C ; brif not valid
3571 stb ANGLE ; save new angle
3572 bra L9D57 ; go process another command
3573 L9D61 cmpb #63 ; only 64 scale values are possible
3574 bhs L9D4C ; brif out of range
3575 stb SCALE ; save new scale factor
3576 bra L9D57 ; go process another command
3577 L9D69 clra ; make horizontal negative
3578 bsr L9DC4
3579 skip1
3580 L9D6D clra ; keep horizontal distance positive
3581 tfr d,x ; make horizontal distance and vertical distance the same
3582 bra L9DCB ; go do the draw thing
3583 L9D72 clra ; zero extend horizontal distance
3584 tfr d,x ; set it as vertical
3585 bsr L9DC4 ; negate horizontal distance
3586 exg d,x ; swap directions (vertical is now negative)
3587 bra L9DCB ; go do the draw thing
3588 L9D7B clra ; zero extend horizontal distance
3589 tfr d,x ; copy horizontal to vertical
3590 bsr L9DC4 ; negate horizontal
3591 bra L9DCB ; go do the drawing thing
3592 L9D82 clra ; zero extend horizontal distance
3593 L9DB3 ldx ZERO ; no vertical distance
3594 bra L9DCB ; go do the drawing things
3595 L9D87 clra ; zero extend horizontal
3596 bsr L9DC4 ; negate horizontal
3597 bra L9DB3 ; zero out vertical and do the drawing thing
3598 L9D8C clra ; zero extend distance
3599 bra L9D92 ; make the distance vertical and zero out horizontal
3600 L9D8F clra ; zero extend distance
3601 bsr L9DC4 ; negate distance
3602 L9D92 ldx ZERO ; zero out vertical distance
3603 exg x,d ; swap vertical and horizontal
3604 bra L9DCB ; go do the drawing thing
3605 L9D98 jsr L9C1B ; evaluate substring expression
3606 ldb #2 ; is there enough room for the state?
3607 jsr LAC33
3608 ldb VD8 ; save current command string state
3609 ldx VD9
3610 pshs x,b
3611 jmp L9CC6 ; go evaluate the sub string
3612 L9DA9 ldb SCALE ; get scale factor
3613 beq L9DC8 ; brif zero - default to full size
3614 clra ; zero extend
3615 exg d,x ; put distance somewhere useful
3616 sta ,-s ; save MS of distance
3617 bpl L9DB6 ; brif positive distance
3618 bsr L9DC3 ; negate the distance
3619 L9DB6 jsr L9FB5 ; multiply D and X
3620 tfr u,d ; save ms bytes in D
3621 lsra ; divide by 2
3622 rorb
3623 L9DBD lsra ; ...divide by 4
3624 rorb
3625 tst ,s+ ; negative distance?
3626 bpl L9DC7 ; brif it was positive
3627 L9DC3 nega ; negate D
3628 L9DC4 negb
3629 sbca #0
3630 L9DC7 rts
3631 L9DC8 tfr x,d ; copy unchanged sitance to D
3632 rts
3633 L9DCB pshs b,a ; save horizontal distance
3634 bsr L9DA9 ; apply scale factor to vertical
3635 puls x ; get horizontal distance
3636 pshs b,a ; save scaled vertical
3637 bsr L9DA9 ; apply scale to horizontal
3638 puls x ; get back vertical distance
3639 ldy ANGLE ; get draw angle and scale
3640 pshs y ; save them
3641 L9DDC tst ,s ; is there an angle?
3642 beq L9DE8 ; brif no angle
3643 exg x,d ; swap distances
3644 bsr L9DC3 ; negate D
3645 dec ,s ; account for one tick around the rotation
3646 bra L9DDC ; see if we're there yet
3647 L9DE8 puls y ; get angle and scale back
3648 ldu ZERO ; default end position (horizontal) is 0
3649 addd HORDEF ; add default horizontal to horizontal distance
3650 bmi L9DF2 ; brif we went negative
3651 tfr d,u ; save calculated end coordindate
3652 L9DF2 tfr x,d ; get vertical distance somewhere useful
3653 ldx ZERO ; default vertical end is 0
3654 addd VERDEF ; add distance to default vertical start
3655 bmi L9DFC ; brif negative - use 0
3656 tfr d,x ; save calculated end coordinate
3657 L9DFC cmpu #256 ; is horizontal in range?
3658 blo L9E05 ; brif su
3659 ldu #255 ; maximize it
3660 L9E05 cmpx #192 ; is vertical in range?
3661 blo L9E0D ; brif so
3662 ldx #191 ; maximize it
3663 L9E0D ldd HORDEF ; set starting coordinates for the line
3664 std HORBEG
3665 ldd VERDEF
3666 std VERBEG
3667 stx VEREND ; set end coordinates
3668 stu HOREND
3669 tst VD5 ; are we updating position?
3670 bne L9E21 ; brif not
3671 stx VERDEF ; update default coordinates
3672 stu HORDEF
3673 L9E21 jsr L9420 ; normalize coordindates
3674 tst VD6 ; are we drawing something?
3675 bne L9E2B ; brif not
3676 jsr L94A1 ; draw the line
3677 L9E2B clr VD5 ; reset draw and update flags
3678 clr VD6
3679 jmp L9CDD ; do another command
3680 L9E32 jsr L9B98 ; get a command character
3681 pshs a ; save it
3682 jsr L9E5E ; evaluate horizontal distance
3683 pshs b,a ; save it
3684 jsr L9B98 ; get character
3685 cmpa #', ; comma between coordinates?
3686 lbne L9D4C ; brif not - raise error
3687 jsr L9E5B ; evaluate vertical distance
3688 tfr d,x ; save vertical distance
3689 puls u ; get horizontal distance
3690 puls a ; get back first command character
3691 cmpa #'+ ; was it + at start?
3692 beq L9E56 ; brif +; treat values as positive
3693 cmpa #'- ; was it -?
3694 bne L9DFC ; brif not - treat it as absolute
3695 L9E56 tfr u,d ; put horizontal distance somewhere useful
3696 jmp L9DCB ; move draw position (relative)
3697 L9E5B jsr L9B98 ; get input character
3698 L9E5E cmpa #'+ ; leading +?
3699 beq L9E69 ; brif so
3700 cmpa #'- ; leading -?
3701 beq L9E6A ; brif so - negative
3702 jsr L9BE2 ; move pointer back one
3703 L9E69 clra ; 0 for +, nonzero for -
3704 L9E6A pshs a ; save sign flag
3705 jsr L9CCB ; evaluate number
3706 puls a ; get sign flag
3707 tsta ; negative?
3708 beq L9E78 ; brif not
3709 clra ; zero extend and negate
3710 negb
3711 sbca #0
3712 L9E78 rts
3713 ; Table of sines and cosines for CIRCLE
3714 L9E79 fdb 0x0000,0x0001 ; subarc 0
3715 fdb 0xfec5,0x1919 ; subarc 1
3716 fdb 0xfb16,0x31f2 ; subarc 2
3717 fdb 0xf4fb,0x4a51 ; subarc 3
3718 fdb 0xec84,0x61f9 ; subarc 4
3719 fdb 0xe1c7,0x78ae ; subarc 5
3720 fdb 0xd4dc,0x8e3b ; subarc 6
3721 fdb 0xc5e5,0xa269 ; subarc 7
3722 fdb 0xb506,0xb506 ; subarc 8
3723 ; CIRCLE command
3724 ; The circle is drawn as a 64 sided polygon (64 LINE commands essentially)
3725 CIRCLE cmpa #'@ ; is there an @ before coordinates?
3726 bne L9EA3 ; brif not
3727 jsr GETNCH ; eat the @
3728 L9EA3 jsr L9522 ; get max coordinates for screen
3729 jsr L93B2 ; parse coordinates for circle centre
3730 jsr L931D ; normalize the start coordinates
3731 ldx ,u ; get horizontal coordinate
3732 stx VCB ; save it
3733 ldx 2,u ; get vertical coordinate
3734 stx VCD ; saveit
3735 jsr SYNCOMMA ; make sure we have a comma
3736 jsr LB73D ; evaluate radius expression
3737 ldu #VCF ; point to temp storage
3738 stx ,u ; save radius
3739 jsr L9320 ; normalize radius
3740 lda #1 ; default to PSET
3741 sta SETFLG
3742 jsr L9581 ; evaluate the colour expression
3743 ldx #0x100 ; height/width default value
3744 jsr GETCCH ; is there a ratio?
3745 beq L9EDF ; brif not
3746 jsr SYNCOMMA ; make sure we have a comma
3747 jsr LB141 ; evaluate the ratio
3748 lda FP0EXP ; multiply ratio by 256
3749 adda #8
3750 sta FP0EXP
3751 jsr LB740 ; evaluate ratio to X (fraction part in LSB)
3752 L9EDF lda PMODE ; get graphics mode
3753 bita #2 ; is it even?
3754 beq L9EE9 ; brif so
3755 tfr x,d ; double the ratio
3756 leax d,x
3757 L9EE9 stx VD1 ; save height/width ratio
3758 ldb #1 ; set the SET flag to PSET
3759 stb SETFLG
3760 stb VD8 ; set first time flag (set to 0 after arc drawn)
3761 jsr L9FE2 ; evaluate circle starting point (octant, subarc)
3762 pshs b,a ; save startpoint
3763 jsr L9FE2 ; evaluate circle end point (octant, subarc)
3764 std VD9 ; save endp oint
3765 puls a,b
3766 L9EFD pshs b,a ; save current circle position
3767 ldx HOREND ; move end coordinates to start coordinates
3768 stx HORBEG
3769 ldx VEREND
3770 stx VERBEG
3771 ldu #L9E79+2 ; point to sine/cosine table
3772 anda #1 ; even octant?
3773 beq L9F11 ; brif so
3774 negb ; convert 0-7 to 8-1 for odd octants
3775 addb #8
3776 L9F11 aslb ; four bytes per table entry
3777 aslb
3778 leau b,u ; point to correct table entry
3779 pshs u ; save sine/cosine table entry pointer
3780 jsr L9FA7 ; calculate horizontal offset
3781 puls u ; get back table entry pointer
3782 leau -2,u ; move to cosine entry
3783 pshs x ; save horizontal offset
3784 jsr L9FA7 ; calculate vertical offset
3785 puls y ; put horizontal in Y
3786 lda ,s ; get octant number
3787 anda #3 ; is it 0 or 4?
3788 beq L9F31 ; brif so
3789 cmpa #3 ; is it 3 or 7?
3790 beq L9F31 ; brif so
3791 exg x,y ; swap horizontal and vertical
3792 L9F31 stx HOREND ; save horizontal offset
3793 tfr y,x ; put vertical offset in X
3794 ldd VD1 ; get height/width ratio
3795 jsr L9FB5 ; multiply vertical by h/w ratio
3796 tfr y,d ; save the product to D
3797 tsta ; did it overflow?
3798 lbne LB44A ; brif so
3799 stb VEREND ; save vertical coordinate MSB
3800 tfr u,d ; get LSW of product
3801 sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio)
3802 lda ,s ; get octant
3803 cmpa #2 ; is it 0 or 1?
3804 blo L9F5B ; brif so
3805 cmpa #6 ; is it 6 or 7?
3806 bhs L9F5B ; brif so
3807 ldd VCB ; get horizontal centre
3808 subd HOREND ; subtract horizontal displacement
3809 bcc L9F68 ; brif we didn't overflow the screen
3810 clra ; zero out coordinate if we overflowed the screen
3811 clrb
3812 bra L9F68
3813 L9F5B ldd VCB ; get horizontal coordinate of the centre
3814 addd HOREND ; add displacement
3815 bcs L9F66 ; brif overlod
3816 cmpd VD3 ; larger than max horizontal coord?
3817 blo L9F68 ; brif not
3818 L9F66 ldd VD3 ; maximize the coordinate
3819 L9F68 std HOREND ; save horizontal ending coordainte
3820 lda ,s ; get octant
3821 cmpa #4 ; is it 0-3?
3822 blo L9F7A ; brif so
3823 ldd VCD ; get vertical coordinate of centre
3824 subd VEREND ; subtract displacement
3825 bcc L9F87 ; brif we didn't overflow the screen
3826 clra ; minimize to top of screen
3827 clrb
3828 bra L9F87
3829 L9F7A ldd VCD ; get vertical centre coordinate
3830 addd VEREND ; add displacement
3831 bcs L9F85 ; brif we overflowed the screen
3832 cmpd VD5 ; did we go past max coordinate?
3833 blo L9F87 ; brif not
3834 L9F85 ldd VD5 ; maximize the coordinate
3835 L9F87 std VEREND ; save end coordinate
3836 tst VD8 ; check first time flag
3837 bne L9F8F ; do not draw if first time through (it was setting start coord)
3838 bsr L9FDF ; draw the line
3839 L9F8F puls a,b ; get arc number and sub arc
3840 lsr VD8 ; get first time flag value (and clear it!)
3841 bcs L9F9A ; do not check for end point after drawing for first coordinate
3842 cmpd VD9 ; at end point?
3843 beq L9FA6 ; brif drawing finished
3844 L9F9A incb ; bump arc counter
3845 cmpb #8 ; done 8 arcs?
3846 bne L9FA3 ; brif not
3847 inca ; bump octant
3848 clrb ; reset subarc number
3849 anda #7 ; make sure octant number stays in 0-7 range
3850 L9FA3 jmp L9EFD ; go do another arc
3851 L9FA6 rts
3852 L9FA7 ldx VCF ; get radius
3853 ldd ,u ; get sine/cosine table entry
3854 beq L9FB4 ; brif 0 - offset = radius
3855 subd #1 ; adjust values to correct range
3856 bsr L9FB5 ; multiply radius by sine/cosine
3857 tfr y,x ; resturn result in X
3858 L9FB4 rts
3859 L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space
3860 clr 4,s ; reset overflow byte (YH)
3861 lda 3,s ; calcuate B*XL
3862 mul
3863 std 6,s ; put in "U"
3864 ldd 1,s ; calculate B*XH
3865 mul
3866 addb 6,s ; accumluate with previous product
3867 adca #0
3868 std 5,s ; save in YL,UH
3869 ldb ,s ; calculate A*XL
3870 lda 3,s
3871 mul
3872 addd 5,s ; accumulate with previous partical product
3873 std 5,s ; save in YL,UH
3874 bcc L9FD4 ; brif no carry
3875 inc 4,s ; bump YH for carry
3876 L9FD4 lda ,s ; calculate A*XH
3877 ldb 2,s
3878 mul
3879 addd 4,s ; accumulate with previous partial product
3880 std 4,s ; save in Y (we can't have a carry here)
3881 puls a,b,x,y,u,pc ; restore multiplicands and return results
3882 L9FDF jmp L94A1 ; go draw a line
3883 L9FE2 clrb ; default arc number (0)
3884 jsr GETCCH ; is there something there for a value?
3885 beq L9FF8 ; brif not
3886 jsr SYNCOMMA ; evaluate , + expression
3887 jsr LB141
3888 lda FP0EXP ; multiply by 64
3889 adda #6
3890 sta FP0EXP
3891 jsr LB70E ; get integer value of circle fraction
3892 andb #0x3f ; max value of 63
3893 L9FF8 tfr b,a ; save arc value in A to calculate octant
3894 andb #7 ; calculate subarc
3895 lsra ; calculate octant
3896 lsra
3897 lsra
3898 rts
3899 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3900 ; COLOR BASIC ROM area
3901 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3902 ; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed
3903 ; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of
3904 ; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points.
3905 POLCAT fdb KEYIN ; indirect jump, get a keystroke
3906 CHROUT fdb PUTCHR ; indirect jump, output character
3907 CSRDON fdb CASON ; indirect jump, turn cassette on and start reading
3908 BLKIN fdb GETBLK ; indirect jump, read a block from tape
3909 BLKOUT fdb SNDBLK ; indirect jump, write a block to tape
3910 JOYIN fdb GETJOY ; indirect jump, read joystick axes
3911 WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader
3912 ; Initialization code.
3913 LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now
3914 lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges)
3915 sta PIA1+3
3916 lda RSTFLG ; get warm start flag
3917 cmpa #0x55 ; is it valid?
3918 bne BACDST ; brif not - cold start
3919 ldx RSTVEC ; get warm start routine pointer
3920 lda ,x ; get first byte of the routine
3921 cmpa #0x12 ; is it NOP?
3922 bne BACDST ; brif not - the routine is invalid so do a cold start
3923 jmp ,x ; transfer control to the warm start routine
3924 ; RESET/power on comes here
3925 RESVEC leay LA00E,pcr ; point to warm start check code
3926 LA02A lda #0x3a ; restore MMU block in 0x4000-0x5fff block
3927 sta MMUREG+2
3928 ldx #PIA1 ; point to PIA1
3929 ldd #0xff34 ; set up for initializing PIAs
3930 clr 1,x ; set PIA1 DA to direction mode
3931 clr 3,x ; set PIA1 DB to direction mode
3932 deca
3933 sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input
3934 lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input
3935 sta 2,x
3936 stb 1,x ; set PIA1 DA to data mode
3937 stb 3,x ; set PIA1 DB to data mode
3938 clr 2,x ; set VDG to alpha-numeric
3939 lda #2 ; set RS232 to marking
3940 sta ,x
3941 lda #0xff
3942 ldx #PIA0 ; point to PIA0
3943 clr 1,x ; set PIA0 DA to direction mode
3944 clr 3,x ; set PIA0 DB to direction mode
3945 clr ,x ; set PIA0 DA to input
3946 sta 2,x ; set PIA0 DB to output
3947 stb 1,x ; set PIA0 DA to direction mode
3948 stb 3,x ; set PIA0 DB to direction mode
3949 jmp LA072 ; continue initializing
3950 LA05E jsr L8C2E ; map ROM pack
3951 jmp 0xc000 ; transfer control to ROM pack
3952 ; Left over initialization code from Color Basic 1.2 follows
3953 bitb 2,x ; check RAMSZ input
3954 beq LA072 ; brif set for 4K RAMs
3955 clr -2,x ; set strobe low
3956 bitb 2,x ; check input
3957 beq LA070 ; brif set for 64K rams
3958 leau -2,u ; adjust pointer to set SAM for 16K RAMs
3959 LA070 sta -3,u ; program SAM for either 16K or 64K RAMs
3960 LA072 jmp ,y ; transfer control to startup routine
3961 ; Cold start jumps here
3962 BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below)
3963 LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM)
3964 leax 1,x ; move forward one byte (will set Z if we're done)
3965 bne LA077 ; brif not donw yet
3966 jsr LA928 ; clear the screen
3967 clr ,x+ ; put the constant zero that lives before the program
3968 stx TXTTAB ; set beginning of program storage
3969 LA084 ldx #0x7fff ; set to of available RAM to just below the "ROM" area
3970 bra LA093
3971 nop
3972 nop
3973 nop
3974 nop
3975 nop
3976 nop
3977 nop
3978 nop
3979 nop
3980 nop
3981 LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work)
3982 stx MEMSIZ ; save top of string space
3983 stx STRTAB ; set bottom of allocated string space
3984 leax -200,x ; allocate 200 bytes of string space
3985 stx FRETOP ; set top of actually free memory
3986 tfr x,s ; put the stack there
3987 ldx #LA10D ; point to variable initializer
3988 ldu #CMPMID ; point to variables to initialize (first batch)
3989 ldb #28 ; 28 bytes in first batch
3990 jsr LA59A ; copy bytes to variables
3991 ldu #IRQVEC ; point to variables to initialize (second batch)
3992 ldb #30 ; 30 bytes this time
3993 jsr LA59A ; copy bytes to variables
3994 ldx -12,x ; get SN error address
3995 stx 3,u ; set ECB's command handlers to error
3996 stx 8,u
3997 ldx #RVEC0 ; point to RAM vectors
3998 ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors)
3999 LA0C0 sta ,x+ ; put an RTS
4000 decb ; done?
4001 bne LA0C0 ; brif not
4002 sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer
4003 jsr LAD19 ; do a "NEW"
4004 jmp L8002 ; transfer control to ECB's initialization routine
4005 LA0CE pshs b,x ; save registers
4006 tst HRWIDTH ; is it VDG mode?
4007 lbne ALINK24 ; brif not
4008 LA0D6 jsr LA199 ; do a "cursor"
4009 jsr KEYIN ; read a key
4010 beq LA0D6 ; brif no key
4011 LA0DE jmp LA1B9 ; return to mainline
4012 fcb 0x72 ; left-over from code replacement above
4013 LA0E2 lda #0x55 ; warm start valid flag
4014 sta RSTFLG ; mark warm start valid
4015 bra LA0F3 ; go to direct mode
4016 ; Warm start entry point
4017 BAWMST nop ; valid routine marker
4018 clr DEVNUM ; reset output/input to screen
4019 jsr LAD33 ; do a partial NEW
4020 andcc #0xaf ; start interrupts
4021 jsr CLS ; clear the screen
4022 LA0F3 jmp LAC73 ; go to direct mode
4023 ; FIRQ service routine - this handles starting autostart cartridges
4024 BFRQSV tst PIA1+3 ; is it the cartridge interrupt?
4025 bmi LA0FC ; brif so
4026 rti
4027 LA0FC jsr L8C28 ; map cartridge
4028 jsr LA7D1 ; delay for another while
4029 leay <LA108,pcr ; point to cartridge starter
4030 jmp LA02A ; go initialize everything clean for the cartridge
4031 LA108 clr RSTFLG ; force a cold start a cartridge reset
4032 jmp ROMPAK ; transfer control to the cartridge
4033 ; Variable initializers (first batch)
4034 LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period
4035 fcb 24 ; upper limit of 1200 Hz period
4036 fcb 10 ; upper limit of 2400 Hz period
4037 fdb 128 ; number of 0x55s for cassette leader
4038 fcb 11 ; cursor blink delay
4039 fdb 88 ; 600 baud delay constant
4040 fdb 1 ; printer carriage return delay constant
4041 fcb 16 ; printer tab field width
4042 fcb 112 ; last printer tab zone
4043 fcb 132 ; printer carriage width
4044 fcb 0 ; printer carriage position
4045 fdb LB44A ; default execution address for EXEC
4046 inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two
4047 bne LA123 ;* two stage increment of CHARAD then load the value into A
4048 inc CHARAD ;* before transferring control to the bottom half routine in ROM
4049 LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required
4050 jmp BROMHK
4051 ; Variable initializers (second batch)
4052 jmp BIRQSV ; IRQ handler
4053 jmp BFRQSV ; FIRQ handler
4054 jmp LB44A ; default USR() address
4055 fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed
4056 fcb 0xff ; capslock flag - default to upper case
4057 fdb DEBDEL ; keyboard debounce delay (why is it a variable?)
4058 jmp LB277 ; exponentiation handler vector
4059 fcb 53 ; (command interpretation table) 53 commands
4060 fdb LAA66 ; (command interpretation table) reserved words list (commands)
4061 fdb LAB67 ; (command interpretation table) jump table (commands)
4062 fcb 20 ; (command interpretation table) 20 functions
4063 fdb LAB1A ; (command interpretation table) reserved words list (functions)
4064 fdb LAA29 ; (command interpretation table) jump table (functions)
4065 ; This is the signon message.
4066 LA147 fcc 'COLOR BASIC 1.2'
4067 fcb 0x0d
4068 fcc '(C) 1982 TANDY'
4069 fcb 0
4070 ; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes
4071 LA166 fcc 'MICROSOFT'
4072 fcb 0x0d,0
4073 ; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII)
4074 LA171 bsr LA176 ; get character
4075 anda #0x7f ; mask off high bit
4076 rts
4077 ; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available,
4078 ; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine
4079 ; has undefined results when called on an output only device. All registers except CC and A are preserved.
4080 LA176 jsr RVEC4 ; do RAM hook
4081 clr CINBFL ; flag data available
4082 tst DEVNUM ; is it keyboard?
4083 beq LA1B1 ; brif so - blink cursor and wait for key press
4084 tst CINCTR ; is there anything in cassette input buffer?
4085 bne LA186 ; brif so
4086 com CINBFL ; flag EOF
4087 rts
4088 ; Read character from cassette file
4089 LA186 pshs u,y,x,b ; preserve registers
4090 ldx CINPTR ; get input buffer pointer
4091 lda ,x+ ; get character from buffer
4092 pshs a ; save it for return
4093 stx CINPTR ; save new input buffer pointer
4094 dec CINCTR ; count character just consumed
4095 bne LA197 ; brif buffer is not empty yet
4096 jsr LA635 ; go read another block, if any, to refill the buffer
4097 LA197 puls a,b,x,y,u,pc ; restore registers and return the character
4098 ; Blink the cursor. This might be better timed via an interrupt or something.
4099 LA199 dec BLKCNT ; is it time to blink the cursor?
4100 bne LA1AB ; brif not
4101 ldb #11 ; reset blink timer
4102 stb BLKCNT
4103 ldx CURPOS ; get cursor position
4104 lda ,x ; get character at the cursor
4105 adda #0x10 ; move to next color
4106 ora #0x8f ; make sure it's a grahpics block with all elements lit
4107 sta ,x ; put new cursor block on screen
4108 LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms)
4109 LA1AE jmp LA7D3 ; go count X down
4110 ; Blink cursor while waiting for a key press
4111 LA1B1 pshs x,b ; save registers
4112 LA1B3 bsr LA199 ; go do a cursor iteration
4113 bsr KEYIN ; go read a key
4114 beq LA1B3 ; brif no key pressed
4115 LA1B9 ldb #0x60 ; VDG screen space character
4116 stb [CURPOS] ; blank cursor out
4117 puls b,x,pc ; restore registers and return
4118 ; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1
4119 ; ROMs, this routine is quite a lot more compact and robust.
4120 LA1C1 jmp KEYIN ; transfer control to actual keyboard scan
4121 rts ;* this actually removes a check to see if any keys are actually down
4122 rts ;* which is unfortunate because it makes programs run slower.
4123 rts
4124 rts
4125 rts
4126 rts
4127 rts
4128 KEYIN pshs u,x,b ; save registers
4129 ldu #PIA0 ; point to keyboard PIA
4130 ldx #KEYBUF ; point to state table
4131 clra ; clear carry, set column to 0xff (no strobe)
4132 deca ; (note: deca does not affect C)
4133 pshs x,a ; save column counter and make a couple of holes for temporaries
4134 sta 2,u ; set strobe to no columns
4135 LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after)
4136 bcc LA220 ; brif we shifted out a 0 - we've done 8 columns
4137 inc 0,s ; bump column counter (first bump goes to 0)
4138 bsr LA23A ; read row data
4139 sta 1,s ; save key data (for debounce check and later saving)
4140 eora ,x ; now bits set if key state changed
4141 anda ,x ; now bits are only set if a key has been pressed
4142 ldb 1,s ; get new key data
4143 stb ,x+ ; save in state table
4144 tsta ; was a key down?
4145 beq LA1D9 ; brif not - do another (nothing above cleared C)
4146 ldb 2,u ; get strobe data
4147 stb 2,s ; save it for debounce check
4148 ldb #0xf8 ; set up so B is 0 after first add
4149 LA1F4 addb #8 ; add 8 for each row
4150 lsra ; did we hit the right row?
4151 bcc LA1F4 ; brif not
4152 addb 0,s ; add in column number
4153 beq LA245 ; brif @
4154 cmpb #26 ; letter?
4155 bhi LA247 ; brif not
4156 orb #0x40 ; bias into letter range
4157 bsr LA22E ; check for SHIFT
4158 ora CASFLG ; merge in capslock state
4159 bne LA20C ; brif either capslock or SHIFT - keep upper case
4160 orb #0x20 ; move to lower case
4161 LA20C stb 0,s ; save ASCII value
4162 ldx DEBVAL ; get debounce delay
4163 bsr LA1AE ; do the 10ms debounce delay
4164 ldb #0xff ; set strobe to none - only joystick buttons register now
4165 bsr LA238 ; read keyboard
4166 inca ; A now 0 if no buttons down
4167 bne LA220 ; brif button down - return nothing since we have interference
4168 LA21A ldb 2,s ; get column strobe data
4169 bsr LA238 ; read row data
4170 cmpa 1,s ; does it match original read?
4171 LA220 puls a,x ; clean up stack and get return value
4172 bne LA22B ; brif failed debounce or a joystick button down
4173 cmpa #0x12 ; is it SHIFT-0?
4174 bne LA22C ; brif not
4175 com CASFLG ; swap capslock state
4176 LA22B clra ; set no key down
4177 LA22C puls b,x,u,pc ; restore registers and return
4178 LA22E lda #0x7f ; column strobe for SHIFT
4179 sta 2,u ; set column
4180 lda ,u ; get row data
4181 coma ; set if key down
4182 anda #0x40 ; only keep SHIFT state
4183 rts
4184 LA238 stb 2,u ; save strobe data
4185 LA23A lda ,u ; get row data
4186 ora #0x80 ; mask off comparator so it doesn't interfere
4187 tst 2,u ; are we on column 7?
4188 bmi LA244 ; brif not
4189 ora #0xc0 ; also mask off SHIFT
4190 LA244 rts
4191 LA245 ldb #51 ; scan code for @
4192 LA247 ldx #CONTAB-0x36 ; point to code table
4193 cmpb #33 ; arrows, space, zero?
4194 blo LA264 ; brif so
4195 ldx #CONTAB-0x54 ; adjust to other half of table
4196 cmpb #48 ; ENTER, CLEAR, BREAK, @?
4197 bhs LA264 ; brif so
4198 bsr LA22E ; read shift state
4199 cmpb #43 ; is it a number, colon, semicolon?
4200 bls LA25D ; brif so
4201 eora #0x40 ; invert shift state for others
4202 LA25D tsta ; shift down?
4203 bne LA20C ; brif not - return result
4204 addb #0x10 ; add in offset to shifted character
4205 bra LA20C ; go return result
4206 LA264 lslb ; two entries per key
4207 bsr LA22E ; check SHIFT state
4208 beq LA26A ; brif not shift
4209 incb ; point to shifted entry
4210 LA26A ldb b,x ; get actual key code
4211 bra LA20C ; go return result
4212 CONTAB fcb 0x5e,0x5f ; <UP> (^, _)
4213 fcb 0x0a,0x5b ; <DOWN> (LF, [)
4214 fcb 0x08,0x15 ; <LEFT> (BS, ^U)
4215 fcb 0x09,0x5d ; <RIGHT> (TAB, ])
4216 fcb 0x20,0x20 ; <SPACE>
4217 fcb 0x30,0x12 ; <0> (0, ^R)
4218 fcb 0x0d,0x0d ; <ENTER> (CR, CR)
4219 fcb 0x0c,0x5c ; <CLEAR> (FF, \)
4220 fcb 0x03,0x03 ; <BREAK> (^C, ^C)
4221 fcb 0x40,0x13 ; <@> (@, ^S)
4222 ; Generic output routine.
4223 ; Output character in A to the device specified by DEVNUM. All registers are preserved except CC.
4224 ; Sending output to a device that does not support output is undefined.
4225 PUTCHR jsr RVEC3 ; call RAM hook
4226 pshs b ; save B
4227 ldb DEVNUM ; get desired device number
4228 incb ; set flags (Z for -1, etc.)
4229 puls b ; restore B
4230 bmi LA2BF ; brif < -1 (line printer)
4231 bne LA30A ; brif > -1 (screen)
4232 ; Write character to tape file
4233 pshs x,b,a ; save registers
4234 ldb FILSTA ; get file status
4235 decb ; input file?
4236 beq LA2A6 ; brif so
4237 ldb CINCTR ; get character count
4238 incb ; account for this character
4239 bne LA29E ; brif buffer not full
4240 bsr LA2A8 ; write previously full block to tape
4241 LA29E ldx CINPTR ; get output buffer pointer
4242 sta ,x+ ; put character in output
4243 stx CINPTR ; save new buffer pointer
4244 inc CINCTR ; account for this character
4245 LA2A6 puls a,b,x,pc ; restore registers and return
4246 ; Write a block of data to tape.
4247 LA2A8 ldb #1 ; data block type
4248 LA2AA stb BLKTYP ; set block type
4249 ldx #CASBUF ; point to output buffer
4250 stx CBUFAD ; set buffer pointer
4251 ldb CINCTR ; get number of bytes in the block
4252 stb BLKLEN ; set length to write
4253 pshs u,y,a ; save registers
4254 jsr LA7E5 ; write a block to tape
4255 puls a,y,u ; restore registers
4256 jmp LA650 ; reset buffer pointers
4257 ; Send byte to line printer
4258 LA2BF pshs x,b,a,cc ; save registers and interrupt status
4259 orcc #0x50 ; disable interrupts
4260 LA2C3 ldb PIA1+2 ; get RS232 status
4261 lsrb ; get status to C
4262 bcs LA2C3 ; brif busy - loop until not busy
4263 bsr LA2FB ; set output to marking
4264 clrb ; transmit one start bit
4265 bsr LA2FD
4266 ldb #8 ; counter for 8 bits
4267 LA2D0 pshs b ; save bit count
4268 clrb ; zero output bits
4269 lsra ; bet output bit to C
4270 rolb ; get output bit to correct bit for output byte
4271 lslb
4272 bsr LA2FD ; transmit bit
4273 puls b ; get back bit counter
4274 decb ; are we done yet?
4275 bne LA2D0 ; brif not
4276 bsr LA2FB ; send stop bit (marking)
4277 puls cc,a ; restore interrupt status and output character
4278 cmpa #0x0d ; carriage return?
4279 beq LA2ED ; brif so
4280 inc LPTPOS ; bump output position
4281 ldb LPTPOS ; get new position
4282 cmpb LPTWID ; end of line?
4283 blo LA2F3 ; brif not
4284 LA2ED clr LPTPOS ; reset position to start of line
4285 bsr LA305 ; do carriage return delay
4286 bsr LA305
4287 LA2F3 ldb PIA1+2 ; get RS232 status
4288 lsrb ; get status to C
4289 bcs LA2F3 ; brif still busy, keep waiting
4290 puls b,x,pc ; restore registers and return
4291 LA2FB ldb #2 ; set output to high (marking)
4292 LA2FD stb PIA1 ; set RS232 output
4293 bsr LA302 ; do baud delay (first iteration) then fall through for second
4294 LA302 ldx LPTBTD ; get buard rate delay constant
4295 skip2
4296 LA305 ldx LPTLND ; get carriage return delay constant
4297 jmp LA7D3 ; count X down
4298 ; Output character to screen
4299 LA30A pshs x,b,a ; save registers
4300 ldx CURPOS ; get cursor pointer
4301 LA30E cmpa #0x08 ; backspace?
4302 bne LA31D ; brif not
4303 cmpx #VIDRAM ; at top of screen?
4304 beq LA35D ; brif so - it's a no-op
4305 lda #0x60 ; VDG space character
4306 sta ,-x ; put a space at previous location and move pointer back
4307 bra LA344 ; save new cursor position and return
4308 LA31D cmpa #0x0d ; carriage return?
4309 bne LA32F ; brif not
4310 ldx CURPOS ; get cursor pointer (why? we already have it)
4311 LA323 lda #0x60 ; VDG space character
4312 sta ,x+ ; put output space
4313 tfr x,d ; see if we at a multiple of 32 now
4314 bitb #0x1f
4315 bne LA323 ; brif not
4316 bra LA344 ; go check for scrolling
4317 LA32F cmpa #0x20 ; control character?
4318 blo LA35D ; brif so
4319 tsta ; is it graphics block?
4320 bmi LA342 ; brif so
4321 cmpa #0x40 ; number or special?
4322 blo LA340 ; brif so (flip "case" bit)
4323 cmpa #0x60 ; upper case alpha?
4324 blo LA342 ; brif so - keep it unmodified
4325 anda #0xdf ; clear bit 5 (inverse video)
4326 LA340 eora #0x40 ; flip inverse video bit
4327 LA342 sta ,x+ ; output character
4328 LA344 stx CURPOS ; save new cursor position
4329 cmpx #VIDRAM+511 ; end of screen?
4330 bls LA35D ; brif not
4331 ldx #VIDRAM ; point to start of screen
4332 LA34E ldd 32,x ; get two characters from next row
4333 std ,x++ ; put them on this row
4334 cmpx #VIDRAM+0x1e0 ; at start of last row on screen?
4335 blo LA34E ; brif not
4336 ldb #0x60 ; VDG space
4337 jsr LA92D ; blank out last line (borrow CLS's loop)
4338 LA35D puls a,b,x,pc ; restore registers and return
4339 ; Set up device parameters for output
4340 LA35F jsr RVEC2 ; do the RAM hook dance
4341 pshs x,b,a ; save registers
4342 clr PRTDEV ; flag device as a screen
4343 lda DEVNUM ; get devicenumber
4344 beq LA373 ; brif screen
4345 inca ; is it tape?
4346 beq LA384 ; brif so
4347 ldx LPTCFW ; get tab width and last tab stop for printer
4348 ldd LPTWID ; get line width and current position for printer
4349 bra LA37C ; set parameters
4350 LA373 ldb CURPOS+1 ; get LSB of cursor position
4351 andb #0x1f ; now we have the offset into the line
4352 ldx #0x1010 ; 16 character tab, position 16 is last tab stop
4353 lda #32 ; screen is 32 characters wide
4354 LA37C stx DEVCFW ; save tab width and last tab stop for active device
4355 stb DEVPOS ; save line position for current device
4356 sta DEVWID ; save line width for current device
4357 puls a,b,x,pc ; restore registers and return
4358 LA384 com PRTDEV ; flag device as non-display
4359 ldx #0x0100 ; tab width is 1, last tab field is 0
4360 clra ; line width is 0
4361 clrb ; character position on line is 0
4362 bra LA37C ; go set parameters
4363 ; This is the line input routine used for reading lines for Basic, both in immediate mode and for
4364 ; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER.
4365 ; The actualy entry point is LA390. Note that this routine echoes to *all* devices.
4366 LA38D jsr LA928 ; clear screen (CLEAR key handling)
4367 LA390 jsr RVEC12 ; do the RAM hook dance
4368 clr IKEYIM ; reset cached input character from BREAK check
4369 ldx #LINBUF+1 ; point to line input buffer (input pointer)
4370 ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier)
4371 LA39A jsr LA171 ; get an input character, only keep low 7 bits
4372 tst CINBFL ; is it EOF?
4373 bne LA3CC ; brif EOF
4374 tst DEVNUM ; is it keyboard input?
4375 bne LA3C8 ; brif not - don't do line editing
4376 cmpa #0x0c ; form feed (CLEAR)?
4377 beq LA38D ; brif so - clear screen and reset
4378 cmpa #0x08 ; backspace?
4379 bne LA3B4 ; brif not
4380 decb ; move back one character
4381 beq LA390 ; brif we were at the start of the line - reset and start again
4382 leax -1,x ; move input pointer back
4383 bra LA3E8 ; echo the backspace and continue
4384 LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)?
4385 bne LA3C2 ; brif not
4386 LA3B8 decb ; at start of line?
4387 beq LA390 ; brif so - reset and restart
4388 lda #0x08 ; echo a backspace
4389 jsr PUTCHR
4390 bra LA3B8 ; see if we've erased everything yet
4391 LA3C2 cmpa #0x03 ; BREAK?
4392 orcc #1 ; set C if it is (only need Z for the next test
4393 LA3C6 beq LA3CD ; brif BREAK - exit
4394 LA3C8 cmpa #0x0d ; ENTER (CR)
4395 bne LA3D9 ; brif not
4396 LA3CC clra ; clear carry (it might not be clear on EOF)
4397 LA3CD pshs cc ; save ENTER/BREAK flag
4398 jsr LB958 ; echo a carriage return
4399 clr ,x ; make sure we have a NUL at the end of the buffer
4400 ldx #LINBUF ; point to input buffer
4401 puls cc,pc ; restore ENTER/BREAK flag and return
4402 LA3D9 cmpa #0x20 ; control character?
4403 blo LA39A ; brif so - skip it
4404 cmpa #'z+1 ; above z?
4405 bhs LA39A ; brif so - ignore it
4406 cmpb #LBUFMX ; is the buffer full?
4407 bhs LA39A ; brif so - ignore extra characters
4408 sta ,x+ ; put character in the buffer
4409 incb ; bump character count
4410 LA3E8 jsr PUTCHR ; echo character
4411 bra LA39A ; go handle next input character
4412 ; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open.
4413 LA3ED jsr RVEC5 ; do the RAM hook dance
4414 lda DEVNUM ; get device number
4415 beq LA415 ; brif keyboard - always valid
4416 inca ; is it tape?
4417 bne LA403 ; brif not
4418 lda FILSTA ; get tape file status
4419 bne LA400 ; brif file is open
4420 LA3FB ldb #22*2 ; raise NO error
4421 jmp LAC46
4422 LA400 deca ; is it in input mode?
4423 beq LA415 ; brif so
4424 LA403 jmp LA616 ; raise FM error
4425 ; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open.
4426 LA406 jsr RVEC6 ; do the RAM hook dance
4427 lda DEVNUM ; get device number
4428 inca ; is it tape?
4429 bne LA415 ; brif not
4430 lda FILSTA ; get file status
4431 beq LA3FB ; brif not open
4432 deca ; is it open for reading?
4433 beq LA403 ; brif so - bad mode
4434 LA415 rts
4435 ; CLOSE command
4436 CLOSE beq LA426 ; brif no file specified - close all files
4437 jsr LA5A5 ; parse device number
4438 LA41B bsr LA42D ; close specified file
4439 jsr GETCCH ; is there more?
4440 beq LA44B ; brif not
4441 jsr LA5A2 ; check for comma and parse another device number
4442 bra LA41B ; go close this one
4443 ; Close all files handler.
4444 LA426 jsr RVEC7 ; Yup. The RAM hook dance.
4445 LA429 lda #-1 ; start with tape file
4446 sta DEVNUM
4447 ; Close file specified in DEVNUM. Note that this never fails.
4448 LA42D jsr RVEC8 ; You know it. RAM hook.
4449 lda DEVNUM ; get device we're closing
4450 clr DEVNUM ; reset to screen/keyboard
4451 inca ; is it tape?
4452 bne LA44B ; brif not
4453 lda FILSTA ; get file status
4454 cmpa #2 ; is it output?
4455 bne LA449 ; brif not
4456 lda CINCTR ; is there anything waiting to be written?
4457 beq LA444 ; brif not
4458 jsr LA2A8 ; write final block of data
4459 LA444 ldb #0xff ; write EOF block
4460 jsr LA2AA
4461 LA449 clr FILSTA ; mark tape file closed
4462 LA44B rts
4463 ; CSAVE command
4464 CSAVE jsr LA578 ; parse filename
4465 jsr GETCCH ; see what we have after the file name
4466 beq LA469 ; brif none
4467 jsr SYNCOMMA ; make sure there's a comma
4468 ldb #'A ; make sure there's an A after
4469 jsr LB26F
4470 bne LA44B ; brif not end of line
4471 clra ; file type 0 (basic program)
4472 jsr LA65C ; write out header block
4473 lda #-1 ; set output to tape
4474 sta DEVNUM
4475 clra ; set Z so we list the whole program
4476 jmp LIST ; go list the program to tape
4477 LA469 clra ; file type 0 (basic program)
4478 ldx ZERO ; set to binary file mode
4479 jsr LA65F ; write header block
4480 clr FILSTA ; close files
4481 inc BLKTYP ; set block type to data
4482 jsr WRLDR ; write out a leader
4483 ldx TXTTAB ; point to start of program
4484 LA478 stx CBUFAD ; set buffer location
4485 lda #255 ; block size to 255 bytes (max size)
4486 sta BLKLEN
4487 ldd VARTAB ; get end of program
4488 subd CBUFAD ; how much is left?
4489 beq LA491 ; brif we have nothing left
4490 cmpd #255 ; do we have a full block worth?
4491 bhs LA48C ; brif so
4492 stb BLKLEN ; save actual remainder as block length
4493 LA48C jsr SNDBLK ; write a block out
4494 bra LA478 ; go do another block
4495 LA491 neg BLKTYP ; set block type to 0xff (EOF)
4496 clr BLKLEN ; no data in EOF block
4497 jmp LA7E7 ; write EOF, stop tape, and return
4498 ; CLOAD and CLOADM commands
4499 CLOAD clr FILSTA ; close tape file
4500 cmpa #'M ; is it ClOADM?
4501 beq LA4FE ; brif so
4502 leas 2,s ; clean up stack
4503 jsr LA5C5 ; parse file name
4504 jsr LA648 ; go find the file
4505 tst CASBUF+10 ; is it binary?
4506 beq LA4C8 ; brif so
4507 lda CASBUF+9 ; is it ASCII?
4508 beq LA4CD ; brif not
4509 jsr LAD19 ; clear out existing program
4510 lda #-1 ; set up for reading from tape
4511 sta DEVNUM
4512 inc FILSTA ; set tape file to input
4513 jsr LA635 ; go read first block
4514 jmp LAC7C ; go to immediate mode to read in the program
4515 ; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is
4516 ; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in
4517 ; 8K.
4518 LA4BF jsr RVEC13 ; do the RAM hook dance
4519 jsr LA42D ; close file
4520 jmp LAC73 ; go back to immediate mode
4521 LA4C8 lda CASBUF+8 ; get file type
4522 beq LA4D0 ; brif basic program
4523 LA4CD jmp LA616 ; raise FM error
4524 LA4D0 jsr LAD19 ; erase existing program
4525 jsr CASON ; start reading tape
4526 ldx TXTTAB ; get start of program storage
4527 LA4D8 stx CBUFAD ; set load address for block
4528 ldd CBUFAD ; get start of block
4529 inca ; bump by 256
4530 jsr LAC37 ; check if there's room for a maximum sized block of 255
4531 jsr GETBLK ; go read a block
4532 bne LA4F8 ; brif there was an error during reading
4533 lda BLKTYP ; get type of block read
4534 beq LA4F8 ; brif header block - IO error
4535 bpl LA4D8 ; brif data block - read another
4536 stx VARTAB ; save new end of program
4537 bsr LA53B ; stop tape
4538 ldx #LABED-1 ; point to "OK" prompt
4539 jsr STRINOUT ; show prompt
4540 jmp LACE9 ; reset various things and return
4541 LA4F8 jsr LAD19 ; clear out partial program load
4542 LA4FB jmp LA619 ; raise IO error
4543 ; This is the CLOADM command
4544 LA4FE jsr GETNCH ; eat the "M"
4545 bsr LA578 ; parse file name
4546 jsr LA648 ; go find the file
4547 LA505 ldx ZERO ; default offset is 0
4548 jsr GETCCH ; see if there's something after the file name
4549 beq LA511 ; brif no offset
4550 jsr SYNCOMMA ; make sure there's a comma
4551 jsr LB73D ; evaluate offset to X
4552 LA511 lda CASBUF+8 ; get file mode
4553 cmpa #2 ; M/L program?
4554 bne LA4CD ; brif not - FM error
4555 ldd CASBUF+11 ; get load address
4556 leau D,x ; add in offset
4557 stu EXECJP ; set EXEC default address
4558 tst CASBUF+10 ; is it binary?
4559 bne LA4CD ; brif not
4560 ldd CASBUF+13 ; get load address
4561 leax d,x ; add in offset
4562 stx CBUFAD ; set buffer address for loading
4563 jsr CASON ; start up tape
4564 LA52E jsr GETBLK ; read a block
4565 bne LA4FB ; brif error reading
4566 stx CBUFAD ; save new load address
4567 tst BLKTYP ; set flags on block type
4568 beq LA4FB ; brif another header - IO error
4569 bpl LA52E ; brif it was data - read more
4570 LA53B jmp LA7E9 ; turn off tape and return
4571 ; The EXEC command
4572 EXEC beq LA545 ; brif no argument - use default address
4573 jsr LB73D ; evaluate EXEC address to X
4574 stx EXECJP ; set new default EXEC address
4575 LA545 jmp [EXECJP] ; transfer control to execution address
4576 ; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break
4577 ; check logic or packaged up with LIST?
4578 LA549 jsr RVEC11 ; do the RAM hook dance
4579 lda DEVNUM ; get device number
4580 inca ; is it tape?
4581 beq LA5A1 ; brif so - don't do break check
4582 jmp LADEB ; do the actual break check
4583 ; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position.
4584 ; This really should be located with the PRINT command.
4585 LA554 jsr LB3E4 ; evaluate a positive expression to D
4586 subd #511 ; is it within bounds?
4587 lbhi LB44A ; brif not - error out
4588 addd #VIDRAM+511 ; adjust to be within the screen (and undo the SUBD above)
4589 std CURPOS ; set cursor position
4590 rts
4591 ; INKEY$ function
4592 INKEY lda IKEYIM ; was a key down during break check?
4593 bne LA56B ; brif so
4594 jsr KEYIN ; poll the keyboard
4595 LA56B clr IKEYIM ; reset the break check cache
4596 sta FPA0+3 ; store result for later return
4597 lbne LB68F ; brif a key was down - return it as a string
4598 sta STRDES ; set string length to 0 (no key down)
4599 jmp LB69B ; return the NULL string
4600 ; Parse a filename
4601 LA578 ldx #CFNBUF ; point to file name buffer
4602 clr ,x+ ; zero out file name length
4603 lda #0x20 ; space character to initialize file name
4604 LA57F sta ,x+ ; put a space in the buffer
4605 cmpx #CASBUF ; at end of file name?
4606 bne LA57F ; brif not
4607 jsr GETCCH ; get input character
4608 beq LA5A1 ; brif no name present
4609 jsr LB156 ; evaluate the file name expression
4610 jsr LB654 ; point to start of the file name
4611 ldu #CFNBUF ; point to file name buffer
4612 stb ,u+ ; save string length
4613 beq LA5A1 ; brif empty - we're done
4614 skip2
4615 LA598 ldb #8 ; copy 8 bytes
4616 ; Move B bytes from (X) to (U)
4617 LA59A lda ,x+ ; copy a byte
4618 sta ,u+
4619 decb ; done yet?
4620 bne LA59A ; brif not
4621 LA5A1 rts
4622 ; Parse a device number and check validity
4623 LA5A2 jsr SYNCOMMA ; check for comma and SN error if not
4624 LA5A5 cmpa #'# ; do we have a #?
4625 bne LA5AB ; brif not (it's optional)
4626 jsr GETNCH ; munch the #
4627 LA5AB jsr LB141 ; evaluate the expression
4628 LA5AE jsr INTCNV ; convert it to an integer in D
4629 rolb ; move sign of B into C
4630 adca #0 ; add sign of B to A
4631 bne LA61F ; brif A doesn't match the sign of B
4632 rorb ; restore B (ADCA will have set C if B was negative)
4633 stb DEVNUM ; set device number
4634 jsr RVEC1 ; do the RAM hook dance
4635 beq LA5C4 ; brif device number set to screen/keyboard (valid)
4636 bpl LA61F ; brif not negative (not valid)
4637 cmpb #-2 ; is it printer or tape?
4638 blt LA61F ; brif not (not valid)
4639 LA5C4 rts
4640 ; Read file name from the line and do an error if anything follows it
4641 LA5C5 bsr LA578 ; parse file name
4642 LA5C7 jsr GETCCH ; set flags on current character
4643 LA5C9 beq LA5C4 ; brif nothing there - it's good
4644 jmp LB277 ; raise SN error
4645 ; EOF function
4646 EOF jsr RVEC14 ; do the RAM hook dance
4647 lda DEVNUM ; get device number
4648 pshs a ; save it (so we can restore it later)
4649 bsr LA5AE ; check the device number (which is in FPA0)
4650 jsr LA3ED ; check validity for reading
4651 LA5DA clrb ; not EOF = 0 (FALSE)
4652 lda DEVNUM ; get device number
4653 beq LA5E4 ; brif keyboard - never EOF
4654 tst CINCTR ; is there anything in the input buffer?
4655 bne LA5E4 ; brif so - not EOF
4656 comb ; set EOF flag to -1 (true)
4657 LA5E4 puls a ; get back original device
4658 sta DEVNUM ; restore it
4659 LA5E8 sex ; sign extend result to 16 bits
4660 jmp GIVABF ; go return the result
4661 ; SKIPF command
4662 SKIPF bsr LA5C5 ; parse file name
4663 bsr LA648 ; look for the file
4664 jsr LA6D1 ; read the file
4665 bne LA619 ; brif error reading file
4666 rts
4667 ; OPEN command
4668 OPEN jsr RVEC0 ; do the RAM hook dance
4669 jsr LB156 ; get file status (input/output)
4670 jsr LB6A4 ; get first character of status string
4671 pshs b ; save status
4672 bsr LA5A2 ; parse a comma then the device number
4673 jsr SYNCOMMA ; make sure there's a comma
4674 bsr LA5C5 ; parse the file name
4675 lda DEVNUM ; get device number of the file
4676 clr DEVNUM ; reset actual device to the screen
4677 puls b ; get back status
4678 cmpb #'I ; INPUT?
4679 beq LA624 ; brif so - open a file for INPUT
4680 cmpb #'O ; OUTPUT?
4681 beq LA658 ; brif so - open a file for OUTPUT
4682 LA616 ldb #21*2 ; raise FM error
4683 skip2
4684 LA619 ldb #20*2 ; raise I/O error
4685 skip2
4686 LA61C ldb #18*2 ; raise AO error
4687 skip2
4688 LA61F ldb #19*2 ; raise DN error
4689 jmp LAC46
4690 LA624 inca ; are we opening the tape?
4691 bmi LA616 ; brif printer - FM error; printer can't be opened for READ
4692 bne LA657 ; brif screen - screen is always open
4693 bsr LA648 ; read header block
4694 lda CASBUF+9 ; clear A if binary or machine language file
4695 anda CASBUF+10
4696 beq LA616 ; bad file mode if not data file
4697 inc FILSTA ; open file for input
4698 LA635 jsr LA701 ; start tape, read block
4699 bne LA619 ; brif error during read
4700 tst BLKTYP ; check block type
4701 beq LA619 ; brif header block - something's wrong
4702 bmi LA657 ; brif EOF
4703 lda BLKLEN ; get length of block
4704 beq LA635 ; brif empty block - read another
4705 LA644 sta CINCTR ; set buffer count
4706 bra LA652 ; reset buffer pointer
4707 LA648 tst FILSTA ; is the file open?
4708 bne LA61C ; brif so - AO error
4709 bsr LA681 ; search for file
4710 bne LA619 ; brif error on read
4711 LA650 clr CINCTR ; mark buffer empty
4712 LA652 ldx #CASBUF ; set buffer pointer to start of buffer
4713 stx CINPTR
4714 LA657 rts
4715 LA658 inca ; check for tape device
4716 bne LA657 ; brif not tape (nothing doing - it's always open)
4717 inca ; make file type 1
4718 LA65C ldx #0xffff ; ASCII and data mode
4719 LA65F tst FILSTA ; is file open?
4720 bne LA61C ; brif so - raise error
4721 ldu #CASBUF ; point to tape buffer
4722 stu CBUFAD ; set address of block to write
4723 sta 8,u ; set file type
4724 stx 9,u ; set ASCII flag and mode
4725 ldx #CFNBUF+1 ; point to file name
4726 jsr LA598 ; move file name to the tape buffer
4727 clr BLKTYP ; set for header block
4728 lda #15 ; 15 bytes in a header block
4729 sta BLKLEN ; set block length
4730 jsr LA7E5 ; write the block
4731 lda #2 ; set file type to output
4732 sta FILSTA
4733 bra LA650 ; reset file pointers
4734 ; Search for correct cassette file name
4735 LA681 ldx #CASBUF ; point to cassette buffer
4736 stx CBUFAD ; set location to read blocks to
4737 LA686 lda CURLIN ; are we in immediate mode?
4738 inca
4739 bne LA696 ; brif not
4740 jsr LA928 ; clear screen
4741 ldx CURPOS ; get start of screen (set after clear)
4742 ldb #'S ; for "searching"
4743 stb ,x++ ; put it on the screen
4744 stx CURPOS ; save cursor position to be one past the search indicator
4745 LA696 bsr LA701 ; read a block
4746 orb BLKTYP ; merge error flag with block type
4747 bne LA6D0 ; brif error or not header
4748 ldx #CASBUF ; point to block just read
4749 ldu #CFNBUF+1 ; point to the desired name
4750 ldb #8 ; compare 8 characters
4751 clr ,-s ; set flag to "match"
4752 LA6A6 lda ,x+ ; get character from just read block
4753 ldy CURLIN ; immediate mode?
4754 leay 1,y
4755 bne LA6B4 ; brif not
4756 clr DEVNUM ; set output to screen
4757 jsr PUTCHR ; display character
4758 LA6B4 suba ,u+ ; subtract from desired file name (nonzero if no match)
4759 ora ,s ; merge with match flag
4760 sta ,s ; save new match flag (will be nonzero if any character differs)
4761 decb ; done all characters?
4762 bne LA6A6 ; brif not - do another
4763 lda ,s+ ; get match flag (and set flags)
4764 beq LA6CB ; brif we have a match
4765 tst -9,u ; did we actually have a file name or will any file do?
4766 beq LA6CB ; brif any file will do
4767 bsr LA6D1 ; go read past the file
4768 bne LA6D0 ; return on error
4769 bra LA686 ; keep looking
4770 LA6CB lda #'F ; for "found"
4771 bsr LA6F8 ; put "F" on screen
4772 clra ; set Z to indicat eno errors
4773 LA6D0 rts
4774 LA6D1 tst CASBUF+10 ; check type of file
4775 bne LA6DF ; brif "blocked" file
4776 jsr CASON ; turn on tape
4777 LA6D9 bsr GETBLK ; read a block
4778 bsr LA6E5 ; error or EOF?
4779 bra LA6D9 ; read another block
4780 LA6DF bsr LA701 ; read a single block
4781 bsr LA6E5 ; error or EOF?
4782 bra LA6DF ; read another block
4783 LA6E5 bne LA6ED ; got error reading block
4784 lda BLKTYP ; check block type
4785 nega ; A is 0 now if EOF
4786 bmi LA700 ; brif not end of file
4787 deca ; clear error indicator
4788 LA6ED sta CSRERR ; set error flag
4789 leas 2,s ; don't return to original caller
4790 bra LA705 ; turn off motor and return
4791 LA6F3 lda VIDRAM ; get first char on screen
4792 eora #0x40 ; flip case
4793 LA6F8 ldb CURLIN ; immediate mode?
4794 incb
4795 bne LA700 ; brif not
4796 sta VIDRAM ; save flipped case character
4797 LA700 rts
4798 ; Read a single block from tape (for a "blocked" file)
4799 LA701 bsr CASON ; start tape going
4800 bsr GETBLK ; read block
4801 LA705 jsr LA7E9 ; stop tape
4802 ldb CSRERR ; get error status
4803 rts
4804 ; Read a block from tape - this does the heavy lifting
4805 GETBLK orcc #0x50 ; disable interrupts (timing is important)
4806 bsr LA6F3 ; reverse video of upper left character in direct mode
4807 ldx CBUFAD ; point to destination buffer
4808 clra ; reset read byte
4809 LA712 bsr LA755 ; read a bit
4810 rora ; move bit into accumulator
4811 cmpa #0x3c ; have we synched on the start of the block data yet?
4812 bne LA712 ; brif not
4813 bsr LA749 ; read block type
4814 sta BLKTYP
4815 bsr LA749 ; get block size
4816 sta BLKLEN
4817 adda BLKTYP ; accumulate checksum
4818 sta CCKSUM ; save current checksum
4819 lda BLKLEN ; get back count
4820 sta CSRERR ; initialize counter; we use this since it will be ovewritten later anyway
4821 beq LA73B ; brif empty block
4822 LA72B bsr LA749 ; read a byte
4823 sta ,x ; save in buffer
4824 cmpa ,x+ ; make sure it wrote
4825 bne LA744 ; brif error if it didn't match
4826 adda CCKSUM ; accumulate checksum
4827 sta CCKSUM
4828 dec CSRERR ; read all bytes?
4829 bne LA72B ; brif not
4830 LA73B bsr LA749 ; read checksum from tape
4831 suba CCKSUM ; does it match?
4832 beq LA746 ; brif so
4833 lda #1 ; checksum error flag
4834 skip2
4835 LA744 lda #2 ; non-RAM error flag
4836 LA746 sta CSRERR ; save error status
4837 rts
4838 LA749 lda #8 ; read 8 bits
4839 sta CPULWD ; initialize counter
4840 LA74D bsr LA755 ; read a bit
4841 rora ; put it into accumulator
4842 dec CPULWD ; got all 8 bits?
4843 bne LA74D ; brif not
4844 rts
4845 LA755 bsr LA75D ; get time between transitions
4846 ldb CPERTM ; get timer
4847 decb
4848 cmpb CMPMID ; set C if timer is below the transition point - high or 1; clear otherwise
4849 rts
4850 LA75D clr CPERTM ; reset timer
4851 tst CBTPHA ; check which phase we synched on
4852 bne LA773 ; brif HI-LO synch
4853 LA763 bsr LA76C ; read input
4854 bcs LA763 ; brif still high
4855 LA767 bsr LA76C ; read input
4856 bcc LA767 ; brif still low
4857 rts
4858 LA76C inc CPERTM ; bump timer
4859 ldb PIA1 ; get input bit to C
4860 rorb
4861 rts
4862 LA773 bsr LA76C ; read input
4863 bcc LA773 ; brif still low
4864 LA777 bsr LA76C ; read output
4865 bcs LA777 ; brif still high
4866 rts
4867 ; Start tape and look for sync bytes
4868 CASON orcc #0x50 ; disable interrupts
4869 bsr LA7CA ; turn on tape
4870 clr CPULWD ; reset timer
4871 LA782 bsr LA763 ; wait for low-high transition
4872 LA784 bsr LA7AD ; wait for it to go low again
4873 bhi LA797 ; brif in range for 1200 Hz
4874 LA788 bsr LA7A7 ; wait for it to go high again
4875 blo LA79B ; brif in range for 2400 Hz
4876 dec CPULWD ; decrement counter (synched on low-high)
4877 lda CPULWD ; get counter
4878 cmpa #-96 ; have we seen 96 1-0-1-0 patterns (48 0x55s)?
4879 LA792 bne LA782 ; brif not - wait some more
4880 sta CBTPHA ; save phase we synched on
4881 rts
4882 LA797 bsr LA7A7 ; wait for it to go high again
4883 bhi LA784 ; brif another 1200 Hz, 2 in a row, try again
4884 LA79B bsr LA7AD ; wait for it to go low again
4885 blo LA788 ; brif another 2400 Hz; go try again for high
4886 inc CPULWD ; bump counter
4887 lda CPULWD ; get counter
4888 suba #96 ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa)
4889 bra LA792 ; set phase and return or keep waiting
4890 LA7A7 clr CPERTM ; reset period timer
4891 bsr LA767 ; wait for high
4892 bra LA7B1 ; set flags on result
4893 LA7AD clr CPERTM ; reset period timer
4894 bsr LA777 ; wait for low
4895 LA7B1 ldb CPERTM ; get period count
4896 cmpb CMP0 ; is it too long for 1200Hz?
4897 bhi LA7BA ; brif so - reset counts
4898 cmpb CMP1 ; set C if 2400Hz, clear C if 1200 Hz
4899 rts
4900 LA7BA clr CPULWD ; reset sync counter (too slow or drop out)
4901 rts
4902 ; MOTOR command
4903 MOTOR tfr a,b ; save ON/OFF
4904 jsr GETNCH ; eat the ON/OFF token
4905 cmpb #0xaa ; OFF?
4906 beq LA7E9 ; brif so - turn off tape
4907 cmpb #0x88 ; ON?
4908 jsr LA5C9 ; SN error if no match
4909 ; Turn on tape
4910 LA7CA lda PIA1+1 ; get motor control value
4911 ora #8 ; turn on bit 3 (starts motor)
4912 bsr LA7F0 ; put it back (dumb but it saves a byte)
4913 LA7D1 ldx ZERO ; maximum delay timer
4914 LA7D3 leax -1,x ; count down
4915 bne LA7D3 ; brif not at 0 yet
4916 rts
4917 ; Write a synch leader to tape
4918 WRLDR orcc #0x50 ; disable interrupts
4919 bsr LA7CA ; turn on tape
4920 ldx SYNCLN ; get count of 0x55s to write
4921 LA7DE bsr LA828 ; write a 0x55
4922 leax -1,x ; done?
4923 bne LA7DE ; brif not
4924 rts
4925 ; Write sync bytes and a block, then stop tape
4926 LA7E5 bsr WRLDR ; write sync
4927 LA7E7 bsr SNDBLK ; write block
4928 ; Turn off tape
4929 LA7E9 andcc #0xaf ; enable interrupts
4930 lda PIA1+1 ; get control register
4931 anda #0xf7 ; disable motor bit
4932 LA7F0 sta PIA1+1 ; set motor enable bit
4933 rts
4934 ; Write a block to tape.
4935 SNDBLK orcc #0x50 ; disable interrupts
4936 ldb BLKLEN ; get block size
4937 stb CSRERR ; initialize character counter
4938 lda BLKLEN ; initialize checksum
4939 beq LA805 ; brif empty block
4940 ldx CBUFAD ; point to tape buffer
4941 LA800 adda ,x+ ; accumulate checksum
4942 decb ; end of block data?
4943 bne LA800 ; brif not
4944 LA805 adda BLKTYP ; accumulate block type into checksum
4945 sta CCKSUM ; save calculated checksum
4946 ldx CBUFAD ; point to buffer
4947 bsr LA828 ; send a 0x55
4948 lda #0x3c ; and then a 0x3c
4949 bsr LA82A
4950 lda BLKTYP ; send block type
4951 bsr LA82A
4952 lda BLKLEN ; send block size
4953 bsr LA82A
4954 tsta ; empty block?
4955 beq LA824 ; brif so
4956 LA81C lda ,x+ ; send character from block data
4957 bsr LA82A
4958 dec CSRERR ; are we done yet?
4959 bne LA81C ; brif not
4960 LA824 lda CCKSUM ; send checksum
4961 bsr LA82A
4962 LA828 lda #0x55 ; send a 0x55
4963 LA82A pshs a ; save output byte
4964 ldb #1 ; initialize bit probe
4965 LA82E lda CLSTSN ; get ending value of last cycle
4966 sta PIA1 ; set DA
4967 ldy #LA85C ; point to sine wave table
4968 bitb ,s ; is bit set?
4969 bne LA848 ; brif so - do high frequency
4970 LA83B lda ,y+ ; get next sample (use all for low frequency)
4971 cmpy #LA85C+36 ; end of table?
4972 beq LA855 ; brif so
4973 sta PIA1 ; set output sample
4974 bra LA83B ; do another sample
4975 LA848 lda ,y++ ; get next sample (use every other for high frequency)
4976 cmpy #LA85C+36 ; end of table?
4977 beq LA855 ; brif so
4978 sta PIA1 ; send output sample
4979 bra LA848 ; do another sample
4980 LA855 sta CLSTSN ; save last sample that *would* have been sent
4981 lslb ; shift mask to next bit
4982 bcc LA82E ; brif not done all 8 bits
4983 puls a,pc ; get back original character and return
4984 ; This is the sample table for the tape sine wave
4985 LA85C fcb 0x82,0x92,0xaa,0xba,0xca,0xda
4986 fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2
4987 fcb 0xea,0xda,0xca,0xba,0xaa,0x92
4988 fcb 0x7a,0x6a,0x52,0x42,0x32,0x22
4989 fcb 0x12,0x0a,0x02,0x02,0x02,0x0a
4990 fcb 0x12,0x22,0x32,0x42,0x52,0x6a
4991 ; SET command
4992 SET bsr LA8C1 ; get absolute screen position of graphics block
4993 pshs x ; save character location
4994 jsr LB738 ; evaluate comma then expression in B
4995 puls x ; get back character pointer
4996 cmpb #8 ; valid colour?
4997 bhi LA8D5 ; brif not
4998 decb ; normalize colours
4999 bmi LA895 ; brif colour 0 (use current colour)
5000 lda #0x10 ; 16 patterns per colour
5001 mul
5002 bra LA89D ; go save the colour
5003 LA895 ldb ,x ; get current value
5004 bpl LA89C ; brif not grahpic
5005 andb #0x70 ; keep only the colour
5006 skip1
5007 LA89C clrb ; reset block to all black
5008 LA89D pshs b ; save colour
5009 bsr LA90D ; force a )
5010 lda ,x ; get current screen value
5011 bmi LA8A6 ; brif graphic block already
5012 clra ; force all pixels off
5013 LA8A6 anda #0x0f ; keep only pixel data
5014 ora GRBLOK ; set the desired pixel
5015 ora ,s+ ; merge with desired colour
5016 LA8AC ora #0x80 ; force it to be a graphic block
5017 sta ,x ; put new block on screen
5018 rts
5019 ; RESET command
5020 RESET bsr LA8C1 ; get address of desired block
5021 bsr LA90D ; force a )
5022 clra ; zero block (no pixels)
5023 ldb ,x ; is it graphics?
5024 bpl LA8AC ; brif not - just blank the block
5025 com GRBLOK ; invert pixel data
5026 andb GRBLOK ; turn off the desired pixel
5027 stb ,x ; put new pixel data on screen
5028 rts
5029 ; Parse SET/RESET/POINT coordinates except for closing )
5030 LA8C1 jsr LB26A ; make sure it starts with (
5031 LA8C4 jsr RVEC21 ; do the RAM hook dance
5032 jsr EVALEXPB ; get first coordinate
5033 cmpb #63 ; valid horizontal coordinate
5034 bhi LA8D5 ; brif out of range
5035 pshs b ; save horizontal coordinate
5036 jsr LB738 ; look for , followed by vertical coordinate
5037 cmpb #31 ; in range for vertical?
5038 LA8D5 bhi LA948 ; brif not
5039 pshs b ; save vertical coordinate
5040 lsrb ; divide by two (two blocks per row)
5041 lda #32 ; 32 bytes per row
5042 mul ; now we have the offset into video RAM
5043 ldx #VIDRAM ; point to start of screen
5044 leax d,x ; now X points to the correct character row
5045 ldb 1,s ; get horizontal coordinate
5046 lsrb ; divide by two (two per character cell)
5047 abx ; now we're pointing to the correct character cell
5048 puls a,b ; get back coordinates (vertical in A)
5049 anda #1 ; keep only row offset of vertical
5050 rorb ; get column offset of horizontal to C
5051 rola ; now we have "row * 2 + col" in A
5052 ldb #0x10 ; make a bit mask (one bit left of first pixel)
5053 LA8EE lsrb ; move mask right
5054 deca ; at the right pixel?
5055 bpl LA8EE ; brif not
5056 stb GRBLOK ; save graphics block mask
5057 rts
5058 ; POINT function
5059 POINT bsr LA8C4 ; evaluate coordinates
5060 ldb #0xff ; default colour value is -1 (not graphics)
5061 lda ,x ; get character
5062 bpl LA90A ; brif not graphics
5063 anda GRBLOK ; is desired pixel set?
5064 beq LA909 ; brif not - return 0 for "black"
5065 ldb ,x ; get graphics data
5066 lsrb ; shift right 4 to get colour in low bits
5067 lsrb
5068 lsrb
5069 lsrb
5070 andb #7 ; lose the graphics block bias
5071 LA909 incb ; shift colours into 1 to 8 range
5072 LA90A jsr LA5E8 ; convert B to floating point
5073 LA90D jmp LB267 ; make sure we have a ) and return
5074 ; CLS command
5075 CLS jsr RVEC22 ; do the RAM hook dance
5076 LA913 beq LA928 ; brif no colour - just do a basic screen clear
5077 jsr EVALEXPB ; evaluate colour number
5078 cmpb #8 ; valid colour?
5079 bhi LA937 ; brif not - do the easter egg
5080 tstb ; color 0?
5081 beq LA925 ; brif so
5082 decb ; normalize to 0 based colour numbers
5083 lda #0x10 ; 16 blocks per colour
5084 mul ; now we have the base code for that colour
5085 orb #0x0f ; set all pixels
5086 LA925 orb #0x80 ; make it a graphics block
5087 skip2
5088 LA928 ldb #0x60 ; VDG screen space character
5089 ldx #VIDRAM ; point to start of screen
5090 LA92D stx CURPOS ; set cursor position
5091 LA92F stb ,x+ ; blank a character
5092 cmpx #VIDRAM+511 ; end of screen?
5093 bls LA92F ; brif not
5094 rts
5095 LA937 bsr LA928 ; clear te screen
5096 ldx #LA166-1 ; point to the easter egg
5097 jmp STRINOUT ; go display it
5098 ; Evaluate an expression to B, prefixed by a comma, and do FC error if 0
5099 LA93F jsr SYNCOMMA ; force a comma
5100 LA942 jsr EVALEXPB ; evaluate expression to B
5101 tstb ; is it 0?
5102 bne LA984 ; brif not - return
5103 LA948 jmp LB44A ; raise FC error
5104 ; SOUND command
5105 SOUND bsr LA942 ; evaluate frequency
5106 stb SNDTON ; save it
5107 bsr LA93F ; evaluate duration (after a comma)
5108 LA951 lda #4 ; constant factor for duration (each increment is 1/15 of a second)
5109 mul
5110 std SNDDUR ; save length of sound (IRQ will count it down)
5111 lda PIA0+3 ; enable 60 Hz interrupt
5112 ora #1
5113 sta PIA0+3
5114 clr ARYDIS ; clear array disable flag for some reason
5115 bsr LA9A2 ; connect DAC to MUX output
5116 bsr LA976 ; turn on sound
5117 LA964 bsr LA985 ; store mid range output value and delay
5118 lda #0xfe ; store high value and delay
5119 bsr LA987
5120 bsr LA985 ; store mid range value and delay
5121 lda #2 ; store low value and delay
5122 bsr LA987
5123 ldx SNDDUR ; has timer expired?
5124 bne LA964 ; brif not, do another wave
5125 ; Disable sound output
5126 LA974 clra ; bit 3 to 0 will disable output
5127 skip2
5128 ; Enable sound output
5129 LA976 lda #8 ; bit 3 set to enable output
5130 sta ,-s ; save desired value
5131 lda PIA1+3 ; get control register value
5132 anda #0xf7 ; reset value
5133 ora ,s+ ; set to desired value
5134 sta PIA1+3 ; set new sound output status
5135 LA984 rts
5136 LA985 lda #0x7e ; mid range value for DAC
5137 LA987 sta PIA1 ; set DAC output value
5138 lda SNDTON ; get frequency
5139 LA98C inca ; increment it (gives shorter count with higher values, so higher frequencies work)
5140 bne LA98C ; brif not done yet
5141 rts
5142 ; AUDIO command
5143 AUDIO tfr a,b ; save ON/OFF token
5144 jsr GETNCH ; munch the ON/OFF token
5145 cmpb #0xaa ; OFF?
5146 beq LA974 ; brif so
5147 subb #0x88 ; ON?
5148 jsr LA5C9 ; do SN error if not
5149 incb ; now B is 1 - cassette sound source
5150 bsr LA9A2 ; set MUX input to tape
5151 bra LA976 ; enable sound
5152 ; Set MUX source to value in B
5153 LA9A2 ldu #PIA0+1 ; point to PIA0 control register A
5154 bsr LA9A7 ; program bit 0 then fall through for bit 1
5155 LA9A7 lda ,u ; get control register value
5156 anda #0xf7 ; reset mux control bit
5157 asrb ; shift desired value to C
5158 bcc LA9B0 ; brif this bit is clear
5159 ora #8 ; set the bit
5160 LA9B0 sta ,u++ ; set register value and move to next register
5161 rts
5162 ; IRQ service routine
5163 BIRQSV lda PIA0+3 ; check for VSYNC interrupt
5164 bpl LA9C5 ; brif not - return. BUG: should clear HSYNC interrupt status first
5165 lda PIA0+2 ; clear VSYNC interrupt status
5166 LA9BB ldx >SNDDUR ; are we counting down for SOUND? (force extended in case DP is modified)
5167 beq LA9C5 ; brif not
5168 leax -1,x ; count down one tick
5169 stx >SNDDUR ; save new count (forced extended in case DP is modified)
5170 LA9C5 rti
5171 ; JOYSTK function
5172 JOYSTK jsr LB70E ; evaluate which joystick axis is desired
5173 cmpb #3 ; valid axis?
5174 lbhi LB44A ; brif not
5175 tstb ; want axis 0?
5176 bne LA9D4 ; brif not
5177 bsr GETJOY ; read axis data if axis 0
5178 LA9D4 ldx #POTVAL ; point to axis values
5179 ldb FPA0+3 ; get desired axis
5180 ldb b,x ; get axis value
5181 jmp LB4F3 ; return value
5182 ; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches
5183 ; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed,
5184 ; this routine will do the read *ten times* before just returning the last value. This is assininely
5185 ; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note
5186 ; also that this routine should be using PSHS and PULS but it doesn't.
5187 GETJOY bsr LA974 ; turn off sound
5188 ldx #POTVAL+4 ; point to the end of the axis data (we'll work backwards)
5189 ldb #3 ; start with axis 3
5190 LA9E5 lda #10 ; 10 tries to see if we match *the last call* to this routine
5191 std ,--s ; save retry counter and axis number
5192 bsr LA9A2 ; set MUX for the correct axis
5193 LA9EB ldd #0x4080 ; set initial trial value to mid range and the next difference to add/subtract to half
5194 LA9EE sta ,-s ; store the add/subtract value
5195 orb #2 ; keep rs232 output marking
5196 stb PIA1 ; set DAC output to the trial value
5197 eorb #2 ; remove RS232 output value
5198 lda PIA0 ; read the comparator
5199 bmi LA9FF ; brif comparator output is high (DAC is lower than the axis value)
5200 subb ,s ; subtract next bit value (split the difference toward 0)
5201 skip2
5202 LA9FF addb ,s ; add next bit value (split the different toward infinity)
5203 lda ,s+ ; get bit value back
5204 lsra ; cut in half
5205 cmpa #1 ; have we done that last value for the DAC?
5206 bne LA9EE ; brif not
5207 lsrb ; normalize the axis value
5208 lsrb
5209 cmpb -1,x ; does it match the read from the last call to this routine?
5210 beq LAA12 ; brif so
5211 dec ,s ; are we out of retries?
5212 bne LA9EB ; brif not - try again
5213 LAA12 stb ,-x ; save new value and move pointer back
5214 ldd ,s++ ; get axis counter and clean up retry counter
5215 decb ; move to next axis
5216 bpl LA9E5 ; brif still more axes to do
5217 rts
5218 ; This is the "bottom half" of the character fetching routines.
5219 BROMHK cmpa #'9+1 ; is it >= colon?
5220 bhs LAA28 ; brif so Z set if colon, C clear.
5221 cmpa #0x20 ; space?
5222 bne LAA24 ; brif not
5223 jmp GETNCH ; move on to another character if space
5224 LAA24 suba #'0 ; normalize ascii digit to 0-9; we already handled above digit 9
5225 suba #-'0 ; this will cause a carry for any value that was already positive
5226 LAA28 rts
5227 ; Jump table for functions
5228 LAA29 fdb SGN ; SGN 0x80
5229 fdb INT ; INT 0x81
5230 fdb ABS ; ABS 0x82
5231 fdb USRJMP ; USR 0x83
5232 fdb RND ; RND 0x84
5233 fdb SIN ; SIN 0x85
5234 fdb PEEK ; PEEK 0x86
5235 fdb LEN ; LEN 0x87
5236 fdb STR ; STR$ 0x88
5237 fdb VAL ; VAL 0x89
5238 fdb ASC ; ASC 0x8a
5239 fdb CHR ; CHR$ 0x8b
5240 fdb EOF ; EOF 0x8c
5241 fdb JOYSTK ; JOYSTK 0x8d
5242 fdb LEFT ; LEFT$ 0x8e
5243 fdb RIGHT ; RIGHT$ 0x8f
5244 fdb MID ; MID$ 0x90
5245 fdb POINT ; POINT 0x91
5246 fdb INKEY ; INKEY$ 0x92
5247 fdb MEM ; MEM 0x93
5248 ; Operator precedence and jump table (binary ops except relational)
5249 LAA51 fcb 0x79 ; +
5250 fdb LB9C5
5251 fcb 0x79 ; -
5252 fdb LB9BC
5253 fcb 0x7b ; *
5254 fdb LBACC
5255 fcb 0x7b ; /
5256 fdb LBB91
5257 fcb 0x7f ; ^ (exponentiation)
5258 fdb EXPJMP
5259 fcb 0x50 ; AND
5260 fdb LB2D5
5261 fcb 0x46 ; OR
5262 fdb LB2D4
5263 ; Reserved words table for commands
5264 LAA66 fcs 'FOR' ; 0x80
5265 fcs 'GO' ; 0x81
5266 fcs 'REM' ; 0x82
5267 fcs "'" ; 0x83
5268 fcs 'ELSE' ; 0x84
5269 fcs 'IF' ; 0x85
5270 fcs 'DATA' ; 0x86
5271 fcs 'PRINT' ; 0x87
5272 fcs 'ON' ; 0x88
5273 fcs 'INPUT' ; 0x89
5274 fcs 'END' ; 0x8a
5275 fcs 'NEXT' ; 0x8b
5276 fcs 'DIM' ; 0x8c
5277 fcs 'READ' ; 0x8d
5278 fcs 'RUN' ; 0x8e
5279 fcs 'RESTORE' ; 0x8f
5280 fcs 'RETURN' ; 0x90
5281 fcs 'STOP' ; 0x91
5282 fcs 'POKE' ; 0x92
5283 fcs 'CONT' ; 0x93
5284 fcs 'LIST' ; 0x94
5285 fcs 'CLEAR' ; 0x95
5286 fcs 'NEW' ; 0x96
5287 fcs 'CLOAD' ; 0x97
5288 fcs 'CSAVE' ; 0x98
5289 fcs 'OPEN' ; 0x99
5290 fcs 'CLOSE' ; 0x9a
5291 fcs 'LLIST' ; 0x9b
5292 fcs 'SET' ; 0x9c
5293 fcs 'RESET' ; 0x9d
5294 fcs 'CLS' ; 0x9e
5295 fcs 'MOTOR' ; 0x9f
5296 fcs 'SOUND' ; 0xa0
5297 fcs 'AUDIO' ; 0xa1
5298 fcs 'EXEC' ; 0xa2
5299 fcs 'SKIPF' ; 0xa3
5300 fcs 'TAB(' ; 0xa4
5301 fcs 'TO' ; 0xa5
5302 fcs 'SUB' ; 0xa6
5303 fcs 'THEN' ; 0xa7
5304 fcs 'NOT' ; 0xa8
5305 fcs 'STEP' ; 0xa9
5306 fcs 'OFF' ; 0xaa
5307 fcs '+' ; 0xab
5308 fcs '-' ; 0xac
5309 fcs '*' ; 0xad
5310 fcs '/' ; 0xae
5311 fcs '^' ; 0xaf
5312 fcs 'AND' ; 0xb0
5313 fcs 'OR' ; 0xb1
5314 fcs '>' ; 0xb2
5315 fcs '=' ; 0xb3
5316 fcs '<' ; 0xb4
5317 ; Reserved word list for functions
5318 LAB1A fcs 'SGN' ; 0x80
5319 fcs 'INT' ; 0x81
5320 fcs 'ABS' ; 0x82
5321 fcs 'USR' ; 0x83
5322 fcs 'RND' ; 0x84
5323 fcs 'SIN' ; 0x85
5324 fcs 'PEEK' ; 0x86
5325 fcs 'LEN' ; 0x87
5326 fcs 'STR$' ; 0x88
5327 fcs 'VAL' ; 0x89
5328 fcs 'ASC' ; 0x8a
5329 fcs 'CHR$' ; 0x8b
5330 fcs 'EOF' ; 0x8c
5331 fcs 'JOYSTK' ; 0x8d
5332 fcs 'LEFT$' ; 0x8e
5333 fcs 'RIGHT$' ; 0x8f
5334 fcs 'MID$' ; 0x90
5335 fcs 'POINT' ; 0x91
5336 fcs 'INKEY$' ; 0x92
5337 fcs 'MEM' ; 0x93
5338 ; Jump table for commands
5339 LAB67 fdb FOR ; 0x80 FOR
5340 fdb GO ; 0x81 GO
5341 fdb REM ; 0x82 REM
5342 fdb REM ; 0x83 '
5343 fdb REM ; 0x84 ELSE
5344 fdb IFTOK ; 0x85 IF
5345 fdb DATA ; 0x86 DATA
5346 fdb PRINT ; 0x87 PRINT
5347 fdb ON ; 0x88 ON
5348 fdb INPUT ; 0x89 INPUT
5349 fdb ENDTOK ; 0x8a END
5350 fdb NEXT ; 0x8b NEXT
5351 fdb DIM ; 0x8c DIM
5352 fdb READ ; 0x8d READ
5353 fdb RUN ; 0x8e RUN
5354 fdb RESTOR ; 0x8f RESTORE
5355 fdb RETURN ; 0x90 RETURN
5356 fdb STOP ; 0x91 STOP
5357 fdb POKE ; 0x92 POKE
5358 fdb CONT ; 0x93 CONT
5359 fdb LIST ; 0x94 LIST
5360 fdb CLEAR ; 0x95 CLEAR
5361 fdb NEW ; 0x96 NEW
5362 fdb CLOAD ; 0x97 CLOAD
5363 fdb CSAVE ; 0x98 CSAVE
5364 fdb OPEN ; 0x99 OPEN
5365 fdb CLOSE ; 0x9a CLOSE
5366 fdb LLIST ; 0x9b LLIST
5367 fdb SET ; 0x9c SET
5368 fdb RESET ; 0x9d RESET
5369 fdb CLS ; 0x9e CLS
5370 fdb MOTOR ; 0x9f MOTOR
5371 fdb SOUND ; 0xa0 SOUND
5372 fdb AUDIO ; 0xa1 AUDIO
5373 fdb EXEC ; 0xa2 EXEC
5374 fdb SKIPF ; 0xa3 SKIPF
5375 ; Error message table
5376 LABAF fcc 'NF' ; 0 NEXT without FOR
5377 fcc 'SN' ; 1 Syntax error
5378 fcc 'RG' ; 2 RETURN without GOSUB
5379 fcc 'OD' ; 3 Out of data
5380 fcc 'FC' ; 4 Illegal function call
5381 fcc 'OV' ; 5 Overflow
5382 fcc 'OM' ; 6 Out of memory
5383 fcc 'UL' ; 7 Undefined line number
5384 fcc 'BS' ; 8 Bad subscript
5385 fcc 'DD' ; 9 Redimensioned array
5386 fcc '/0' ; 10 Division by 0
5387 fcc 'ID' ; 11 Illegal direct statement
5388 fcc 'TM' ; 12 Type mismatch
5389 fcc 'OS' ; 13 Out of string space
5390 fcc 'LS' ; 14 String too long
5391 fcc 'ST' ; 15 String formula too complex
5392 fcc 'CN' ; 16 Can't continue
5393 fcc 'FD' ; 17 Bad file data
5394 fcc 'AO' ; 18 File already open
5395 fcc 'DN' ; 19 Device number error
5396 fcc 'IO' ; 20 Input/output error
5397 fcc 'FM' ; 21 Bad file mode
5398 fcc 'NO' ; 22 File not open
5399 fcc 'IE' ; 23 Input past end of file
5400 fcc 'DS' ; 24 Direct statement in file
5401 LABE1 fcn ' ERROR'
5402 LABE8 fcn ' IN '
5403 LABED fcb 0x0d
5404 LABEE fcc 'OK'
5405 fcb 0x0d,0x00
5406 LABF2 fcb 0x0d
5407 fcn 'BREAK'
5408 ; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT
5409 ; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL
5410 ; for the first match.
5411 ;
5412 ; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the
5413 ; 6809's registers. This requires some minor tweaks where the routine is called. Further, the
5414 ; use of B is completely pointless and, even if B is going to be used, why is it reloaded on
5415 ; every loop?
5416 LABF9 leax 4,s ; skip past our caller and the main command loop return address
5417 LABFB ldb #18 ; each FOR/NEXT frame is 18 bytes
5418 stx TEMPTR ; save current search pointer
5419 lda ,x ; get first byte of this frame
5420 suba #0x80 ; set to 0 if FOR/NEXT
5421 bne LAC1A ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame)
5422 ldx 1,x ; get index variable descriptor
5423 stx TMPTR1 ; save it
5424 ldx VARDES ; get desired index descriptor
5425 beq LAC16 ; brif NULL - we found something
5426 cmpx TMPTR1 ; does this one match?
5427 beq LAC1A ; brif so
5428 ldx TEMPTR ; get back frame pointer
5429 abx ; move to next entry
5430 bra LABFB ; check next block of data
5431 LAC16 ldx TMPTR1 ; get index variable of this frame
5432 stx VARDES ; set it as the one found
5433 LAC1A ldx TEMPTR ; get matching frame pointer
5434 tsta ; set Z if FOR/NEXT
5435 rts
5436 ; This is a block copy routine which copies from top to bottom. It's not clear that the use of
5437 ; this routine actually saves any ROM space compared to just implementing the copies directly
5438 ; once all the marshalling to set up the parameter variables is taken into account.
5439 LAC1E bsr LAC37 ; check to see if stack collides with D
5440 LAC20 ldu V41 ; point to destination
5441 leau 1,u ; offset for pre-dec
5442 ldx V43 ; point to source
5443 leax 1,x ; offset for pre-dec
5444 LAC28 lda ,-x ; get source byte
5445 pshu a ; store at destination (sta ,-u would be less weird)
5446 cmpx V47 ; at the bottom of the copy?
5447 bne LAC28 ; brif not
5448 stu V45 ; save final destination address
5449 LAC32 rts
5450 ; Check for 2*B (0 <= B <= 127) bytes for free memory
5451 LAC33 clra ; zero extend
5452 aslb ; times 2 (loses bit 7 of B)
5453 addd ARYEND ; add to top of used memory
5454 LAC37 addd #STKBUF ; add a fudge factor for interpreter operation
5455 bcs LAC44 ; brif >65535!
5456 sts BOTSTK ; get current stack pointer
5457 cmpd BOTSTK ; is our new address above that?
5458 blo LAC32 ; brif not - no error
5459 LAC44 ldb #6*2 ; raise OM error
5460 ; The error servicing routine
5461 LAC46 jsr RVEC16 ; do the RAM hook dance (ON ERROR reserved hook)
5462 LAC49 jsr RVEC17 ; do the RAM hook dance again
5463 jsr LA7E9 ; turn off tape
5464 jsr LA974 ; disable sound
5465 jsr LAD33 ; reset stack, etc.
5466 clr DEVNUM ; reset output to screen
5467 jsr LB95C ; do a newline
5468 jsr LB9AF ; send a ?
5469 ldx #LABAF ; point to error table
5470 LAC60 abx ; offset to correct message
5471 bsr LACA0 ; send a char from X
5472 bsr LACA0 ; send another char from X
5473 LAC65 ldx #LABE1-1 ; point to "ERROR" message
5474 LAC68 jsr STRINOUT ; print ERROR message (or BREAK)
5475 lda CURLIN ; are we in immediate mode?
5476 inca
5477 beq LAC73 ; brif not - go to immediate mode
5478 jsr LBDC5 ; print "IN ****"
5479 ; This is the immediate mode loop
5480 LAC73 jsr LB95C ; do a newline if needed
5481 LAC76 ldx #LABEE-1 ; point to prompt (without leading CR)
5482 jsr STRINOUT ; show prompt
5483 LAC7C jsr LA390 ; read an input line
5484 ldu #0xffff ; flag immediate mode
5485 stu CURLIN
5486 bcs LAC7C ; brif we ended on BREAK - just go for another line
5487 tst CINBFL ; EOF?
5488 lbne LA4BF ; brif so
5489 stx CHARAD ; save start of input line as input pointer
5490 jsr GETNCH ; get character from input line
5491 beq LAC7C ; brif no input
5492 bcs LACA5 ; brif numeric - adding or removing a line number
5493 ldb #2*24 ; code for "direct statement in file"
5494 tst DEVNUM ; keyboard input?
5495 bne LAC46 ; brif not - complain about direct statement
5496 jsr LB821 ; go tokenize the input line
5497 LAC9D jmp LADC0 ; go execute the newly tokenized line
5498 LACA0 lda ,x+ ; get character and advance pointer
5499 jmp LB9B1 ; output it
5500 LACA5 jsr LAF67 ; convert line number to binary
5501 LACA8 ldx BINVAL ; get converted number
5502 stx LINHDR ; put it before the line we just read
5503 jsr LB821 ; tokenize the input line
5504 stb TMPLOC ; save line length
5505 bsr LAD01 ; find where the line should be in the program
5506 bcs LACC8 ; brif the line number isn't already present
5507 ldd V47 ; get address where the line is in the program
5508 subd ,x ; get the difference between here and the end of the line (negative)
5509 addd VARTAB ; subtract line length from the end of the program
5510 std VARTAB ; save new end of program address
5511 ldu ,x ; get start of next line
5512 LACC0 pulu a ; get source byte (lda ,u+ would be less weird)
5513 sta ,x+ ; move it down
5514 cmpx VARTAB ; have we moved everything yet?
5515 bne LACC0 ; brif not
5516 LACC8 lda LINBUF ; see if there is actually a line to input
5517 beq LACE9 ; brif not - we just needed to remove the line
5518 ldd VARTAB ; get current end of program
5519 std V43 ; set as source pointer
5520 addb TMPLOC ; add in the length of the new line
5521 adca #0
5522 std V41 ; save destination pointer
5523 jsr LAC1E ; make sure there's enough room and then make a hole for the new line
5524 ldu #LINHDR-2 ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer)
5525 LACDD pulu a ; get byte from new line (lda ,u+ would be less weird)
5526 sta ,x+ ; stow it
5527 cmpx V45 ; at the end of the hole we just made?
5528 bne LACDD ; brif not
5529 ldx V41 ; get save new top of program address
5530 stx VARTAB
5531 LACE9 bsr LAD21 ; reset variables, etc.
5532 bsr LACEF ; adjust next line pointers
5533 bra LAC7C ; go read another input line
5534 ; Recompute next line pointers
5535 LACEF ldx TXTTAB ; point to start of program
5536 LACF1 ldd ,x ; get address of next line
5537 beq LAD16 ; brif end of program
5538 leau 4,x ; move past pointer and line number
5539 LACF7 lda ,u+ ; are we at the end of the line?
5540 bne LACF7 ; brif not
5541 stu ,x ; save new next line pointer
5542 ldx ,x ; point to next line
5543 bra LACF1 ; process the next line
5544 ; Find a line in the program
5545 LAD01 ldd BINVAL ; get desired line number
5546 ldx TXTTAB ; point to start of program
5547 LAD05 ldu ,x ; get address of next line
5548 beq LAD12 ; brif end of program
5549 cmpd 2,x ; do we have a match?
5550 bls LAD14 ; brif our search number is <= the number here
5551 ldx ,x ; move to next line
5552 bra LAD05 ; check another line
5553 LAD12 orcc #1 ; set C for not found
5554 LAD14 stx V47 ; save address of matching line *or* line just after where it would have been
5555 LAD16 rts
5556 ; NEW command
5557 ; This routine has multiple entry points used for various "levels" of NEW
5558 NEW bne LAD14 ; brif there was input given; should be LAD16!
5559 LAD19 ldx TXTTAB ; point to start of program
5560 clr ,x+ ; blank out program (with NULL next line pointer)
5561 clr ,x+
5562 stx VARTAB ; save end of program
5563 LAD21 ldx TXTTAB ; get start of program
5564 jsr LAEBB ; put input pointer there
5565 LAD26 ldx MEMSIZ ; reset string space
5566 stx STRTAB
5567 jsr RESTOR ; reset DATA pointer
5568 ldx VARTAB ; clear out scalars and arrays
5569 stx ARYTAB
5570 stx ARYEND
5571 LAD33 ldx #STRSTK ; reset the string stack
5572 stx TEMPPT
5573 ldx ,s ; get return address (we're going to reset the stack)
5574 lds FRETOP ; reset the stack to top of memory
5575 clr ,-s ; put stopper so FOR/NEXT search will actually stop here
5576 LAD3F clr OLDPTR ; reset "CONT" state
5577 clr OLDPTR+1
5578 LAD43 clr ARYDIS ; un-disable arrays
5579 jmp ,x ; return to original caller
5580 ; FOR command
5581 FOR lda #0x80 ; disable array parsing
5582 sta ARYDIS
5583 jsr LET ; assign start value to index
5584 jsr LABF9 ; search stack for matching FOR/NEXT frame
5585 leas 2,s ; lose return address
5586 bne LAD59 ; brif variable not already being used
5587 ldx TEMPTR ; get address of matched data
5588 leas b,x ; move stack pointer to the end of it (B is set to 18 in the stack search)
5589 LAD59 ldb #9 ; is there room for 18 bytes in memory?
5590 jsr LAC33
5591 jsr LAEE8 ; get address of the end of this statement in X
5592 ldd CURLIN ; get line number
5593 pshs x,b,a ; save next line address and current line number
5594 ldb #0xa5 ; make sure we have TO
5595 jsr LB26F
5596 jsr LB143 ; make sure we have a numeric index
5597 jsr LB141 ; evaluate terminal condition value
5598 ldb FP0SGN ; pack FPA0 in place
5599 orb #0x7f
5600 andb FPA0
5601 stb FPA0
5602 ldy #LAD7F ; where to come back to
5603 jmp LB1EA ; stash terminal condition on the stack
5604 LAD7F ldx #LBAC5 ; point to FP 1.0 (default step)
5605 jsr LBC14 ; unpack it to FPA0
5606 jsr GETCCH ; get character after the terminal
5607 cmpa #0xa9 ; is it STEP?
5608 bne LAD90 ; brif not
5609 jsr GETNCH ; eat STEP
5610 jsr LB141 ; evaluate step condition
5611 LAD90 jsr LBC6D ; get "status" of FPA0
5612 jsr LB1E6 ; stash FPA0 on the stack (for step value)
5613 ldd VARDES ; get variable descriptor pointer
5614 pshs d ; put that on the stack too
5615 lda #0x80 ; flag the frame as a FOR/NEXT frame
5616 pshs a
5617 ; Main command interpretation loop
5618 LAD9E jsr RVEC20 ; do the RAM hook dance
5619 andcc #0xaf ; make sure interrupts are running
5620 bsr LADEB ; check for BREAK/pause
5621 ldx CHARAD ; get input pointer
5622 stx TINPTR ; save input pointer for start of line
5623 lda ,x+ ; get current input character
5624 beq LADB4 ; brif end of line - move to another line
5625 cmpa #': ; end of statement?
5626 beq LADC0 ; brif so - keep processing
5627 LADB1 jmp LB277 ; raise a syntax error
5628 LADB4 lda ,x++ ; get MSB of next line pointer and skip past pointer
5629 sta ENDFLG
5630 beq LAE15 ; brif MSB of next line address is 0 (do END)
5631 ldd ,x+ ; get line number but only advance one
5632 std CURLIN ; set current line number
5633 stx CHARAD ; set input pointer to one before line text
5634 LADC0 jsr GETNCH ; move past statement separator or to first character in line
5635 bsr LADC6 ; process a command
5636 LADC4 bra LAD9E ; handle next statement or line
5637 LADC6 beq LAE40 ; return if end of statement
5638 tsta ; is it a token?
5639 lbpl LET ; brif not - do a LET
5640 cmpa #0xa3 ; above SKIPF?
5641 bhi LADDC ; brif so
5642 ldx COMVEC+3 ; point to jump table
5643 LADD4 lsla ; two bytes per entry (loses the token bias)
5644 tfr a,b ; put it in B for unsigned ABX
5645 abx
5646 jsr GETNCH ; move past token
5647 jmp [,x] ; transfer control to the handler (which will return to the main loop)
5648 LADDC cmpa #0xb4 ; is it a non-executable token?
5649 bls LADB1 ; brif so
5650 jmp [COMVEC+13] ; transfer control to ECB command handler
5651 ; RESTORE command
5652 RESTOR ldx TXTTAB ; point to beginning of the program
5653 leax -1,x ; move back one (to compensate for "GETNCH")
5654 LADE8 stx DATPTR ; save as new data pointer
5655 rts
5656 ; BREAK check
5657 LADEB jsr LA1C1 ; read keyboard
5658 beq LADFA ; brif no key down
5659 LADF0 cmpa #3 ; BREAK?
5660 beq STOP ; brif so - do a STOP
5661 LADF4 cmpa #0x13 ; pause (SHIFT-@)?
5662 beq LADFB ; brif so
5663 sta IKEYIM ; cache key for later INKEY$ so break check doesn't break INKEY$
5664 LADFA rts
5665 LADFB jsr KEYIN ; read keyboard
5666 beq LADFB ; brif no key down
5667 bra LADF0 ; process pressed key in case BREAK or SHIFT-@ again
5668 ; END command
5669 ENDTOK jsr LA426 ; close files
5670 jsr GETCCH ; re-get input character
5671 bra LAE0B
5672 ; STOP command
5673 STOP orcc #1 ; flag "STOP"
5674 LAE0B bne LAE40 ; brif not end of statement
5675 ldx CHARAD ; save current input pointer
5676 stx TINPTR
5677 LAE11 ror ENDFLG ; save END/STOP flag (C)
5678 leas 2,s ; lose return address
5679 LAE15 ldx CURLIN ; get current input line (end of program comes here)
5680 cmpx #0xffff ; immediate mode?
5681 beq LAE22 ; brif so
5682 stx OLDTXT ; save line where we stopped executing
5683 ldx TINPTR ; get input pointer
5684 stx OLDPTR ; save location where we stopped executing
5685 LAE22 clr DEVNUM ; reset to screen/keyboard
5686 ldx #LABF2-1 ; point to BREAK message
5687 tst ENDFLG ; are we doing "BREAK"?
5688 lbpl LAC73 ; brif not
5689 jmp LAC68 ; go do the BREAK message and return to main loop
5690 ; CONT command
5691 CONT bne LAE40 ; brif not end of statement
5692 ldb #2*16 ; code for can't continue
5693 ldx OLDPTR ; get saved execution pointer
5694 lbeq LAC46 ; brif no saved pointer - raise CN error
5695 stx CHARAD ; reset input pointer
5696 ldx OLDTXT ; reset current line number
5697 stx CURLIN
5698 LAE40 rts
5699 ; CLEAR command
5700 CLEAR beq LAE6F ; brif no argument
5701 jsr LB3E6 ; evaluate string space size
5702 pshs d ; save it
5703 ldx MEMSIZ ; get memory size (top of memory)
5704 jsr GETCCH ; is there anything after the string space size?
5705 beq LAE5A ; brif not
5706 jsr SYNCOMMA ; force a comma
5707 jsr LB73D ; get top of memory value in X
5708 leax -1,x ; move back one (top of cleared space)
5709 cmpx TOPRAM ; is it within the memory available?
5710 bhi LAE72 ; brif higher than top of memory - OM error
5711 LAE5A tfr x,d ; so we can do math for checking memory usage
5712 subd ,s++ ; subtract out string space value
5713 bcs LAE72 ; brif less than 0
5714 tfr d,u ; U is bottom of cleared space
5715 subd #STKBUF ; also account for slop space
5716 bcs LAE72 ; brif less than 0
5717 subd VARTAB ; is there still room for the program?
5718 blo LAE72 ; brif not
5719 stu FRETOP ; set top of free memory
5720 stx MEMSIZ ; set size of usable memory
5721 LAE6F jmp LAD26 ; erase variables, etc.
5722 LAE72 jmp LAC44 ; raise OM error
5723 ; RUN command
5724 RUN jsr RVEC18 ; do the RAM hook dance
5725 jsr LA426 ; close any open files
5726 jsr GETCCH ; is there a line number
5727 lbeq LAD21 ; brif no line number - start from beginning
5728 jsr LAD26 ; clear variables, etc.
5729 bra LAE9F ; "GOTO" the line number
5730 ; GO command (GOTO and GOSUB)
5731 GO tfr a,b ; save TO/SUB
5732 LAE88 jsr GETNCH ; eat the TO/SUB token
5733 cmpb #0xa5 ; TO?
5734 beq LAEA4 ; brif GOTO
5735 cmpb #0xa6 ; SUB?
5736 bne LAED7 ; brif not
5737 ldb #3 ; room for 6 bytes?
5738 jsr LAC33
5739 ldu CHARAD ; get input pointer
5740 ldx CURLIN ; get line number
5741 lda #0xa6 ; flag for GOSUB frame
5742 pshs u,x,a ; set stack frame
5743 LAE9F bsr LAEA4 ; do "GOTO"
5744 jmp LAD9E ; go back to main loop
5745 ; Actual GOTO is here
5746 LAEA4 jsr GETCCH ; get current input
5747 jsr LAF67 ; convert number to binary
5748 bsr LAEEB ; move input pointer to end of statement
5749 leax 1,x ; point to start of next line
5750 ldd BINVAL ; get desired line number
5751 cmpd CURLIN ; is it beyond here?
5752 bhi LAEB6 ; brif so
5753 ldx TXTTAB ; start search at beginning of program
5754 LAEB6 jsr LAD05 ; find line number
5755 bcs LAED2 ; brif not found
5756 LAEBB leax -1,x ; move to just before start of line
5757 stx CHARAD ; reset input pointer
5758 LAEBF rts
5759 ; RETURN command
5760 RETURN bne LAEBF ; exit if argument given
5761 lda #0xff ; set VARDES to an illegal value so we ignore FOR frames
5762 sta VARDES
5763 jsr LABF9 ; look for a GOSUB frame
5764 tfr x,s ; reset stack
5765 cmpa #0xa6-0x80 ; is it a GOSUB frame?
5766 beq LAEDA ; brif so
5767 ldb #2*2 ; code for RETURN without GOSUB
5768 skip2
5769 LAED2 ldb #7*2 ; code for undefined line number
5770 jmp LAC46 ; raise error
5771 LAED7 jmp LB277 ; raise syntax error
5772 LAEDA puls a,x,u ; get back saved line number and input pointer
5773 stx CURLIN ; reset line number
5774 stu CHARAD ; reset input pointer
5775 ; DATA command
5776 DATA bsr LAEE8 ; move input pointer to end of statement
5777 skip2
5778 ; REM command (also ELSE)
5779 REM bsr LAEEB ; move input pointer to end of line
5780 stx CHARAD ; save new input pointer
5781 LAEE7 rts
5782 ; Return end of statement (LAEE8) or line (AEEB) in X
5783 LAEE8 ldb #': ; colon is statement terminator
5784 skip1lda
5785 LAEEB clrb ; make main terminator NUL
5786 stb CHARAC ; save terminator
5787 clrb ; end of line - always terminates
5788 ldx CHARAD ; get input pointer
5789 LAEF1 tfr b,a ; save secondary terminator
5790 ldb CHARAC ; get main terminator
5791 sta CHARAC ; save secondary
5792 LAEF7 lda ,x ; get input character
5793 beq LAEE7 ; brif end of line
5794 pshs b ; save terminator
5795 cmpa ,s+ ; does it match?
5796 beq LAEE7 ; brif so - bail
5797 leax 1,x ; move pointer ahead
5798 cmpa #'" ; start of string?
5799 beq LAEF1 ; brif so
5800 inca ; functon token?
5801 bne LAF0C ; brif not
5802 leax 1,x ; skip second part of function token
5803 LAF0C cmpa #0x85+1 ; IF?
5804 bne LAEF7 ; brif not
5805 inc IFCTR ; bump "IF" count
5806 bra LAEF7 ; get check another input character
5807 ; IF command
5808 IFTOK jsr LB141 ; evaluate condition
5809 jsr GETCCH ; find out what's after the conditin
5810 cmpa #0x81 ; GO?
5811 beq LAF22 ; treat same as THEN
5812 ldb #0xa7 ; make sure we have a THEN
5813 jsr LB26F
5814 LAF22 lda FP0EXP ; get true/false (false is 0)
5815 bne LAF39 ; brif condition true
5816 clr IFCTR ; reset IF counter
5817 LAF28 bsr DATA ; skip over statement
5818 tsta ; end of line?
5819 beq LAEE7 ; brif so
5820 jsr GETNCH ; get start of this statement
5821 cmpa #0x84 ; ELSE?
5822 bne LAF28 ; brif not
5823 dec IFCTR ; is it a matching ELSE?
5824 bpl LAF28 ; brif not - keep looking
5825 jsr GETNCH ; eat the ELSE
5826 LAF39 jsr GETCCH ; get current input
5827 lbcs LAEA4 ; brif numeric - to a GOTO
5828 jmp LADC6 ; let main loop interpret the next command
5829 ; ON command
5830 ON jsr EVALEXPB ; evaluate index expression
5831 LAF45 ldb #0x81 ; make sure we have "GO"
5832 jsr LB26F
5833 pshs a ; save TO/SUB
5834 cmpa #0xa6 ; SUB?
5835 beq LAF54 ; brif so
5836 cmpa #0xa5 ; TO?
5837 LAF52 bne LAED7 ; brif not
5838 LAF54 dec FPA0+3 ; are we at the right index?
5839 bne LAF5D ; brif not
5840 puls b ; get TO/SUB token
5841 jmp LAE88 ; go do GOTO or GOSUB
5842 LAF5D jsr GETNCH ; munch a character
5843 bsr LAF67 ; parse line number
5844 cmpa #', ; is there another line following?
5845 beq LAF54 ; brif so - see if we're there yet
5846 puls b,pc ; clean up TO/SUB token and return - we fell through
5847 ; Parse a line number
5848 LAF67 ldx ZERO ; initialize line number accumulator to 0
5849 stx BINVAL
5850 LAF6B bcc LAFCE ; brif not numeric
5851 suba #'0 ; adjust to actual value of digit
5852 sta CHARAC ; save digit
5853 ldd BINVAL ; get accumulated number
5854 cmpa #24 ; will this overflow?
5855 bhi LAF52 ; brif so - raise syntax error
5856 aslb ; times 2
5857 rola
5858 aslb ; times 4
5859 rola
5860 addd BINVAL ; times 5
5861 aslb ; times 10
5862 rola
5863 addb CHARAC ; add in digit
5864 adca #0
5865 std BINVAL ; save new accumulated number
5866 jsr GETNCH ; fetch next character
5867 bra LAF6B ; process next digit
5868 ; LET command (the LET keyword requires Extended Basic)
5869 LET jsr LB357 ; evaluate destination variable
5870 stx VARDES ; save descriptor pointer
5871 ldb #0xb3 ; make sure we have =
5872 jsr LB26F
5873 lda VALTYP ; get destination variable type
5874 pshs a ; save it for later
5875 jsr LB156 ; evaluate the expression to assign
5876 puls a ; get back original variable type
5877 rora ; put type in C
5878 jsr LB148 ; make sure the current result matches the type
5879 lbeq LBC33 ; bri fnumeric - copy FPA0 to variable
5880 LAFA4 ldx FPA0+2 ; point to descriptor of replacement string
5881 ldd FRETOP ; get bottom of string space
5882 cmpd 2,x ; is the string already in string space?
5883 bhs LAFBE ; brif so
5884 cmpx VARTAB ; is the descriptor in variable space?
5885 blo LAFBE ; brif not
5886 LAFB1 ldb ,x ; get length of string
5887 jsr LB50D ; allocate space for this string
5888 ldx V4D ; get descriptor pointer back
5889 jsr LB643 ; copy string into string space
5890 ldx #STRDES ; point to temporary string descriptor
5891 LAFBE stx V4D ; save descriptor pointer
5892 jsr LB675 ; remove string from string stack if appropriate
5893 ldu V4D ; get back replacement descriptor
5894 ldx VARDES ; get target descriptor
5895 pulu a,b,y ; get string length (A) and data pointer (Y)
5896 sta ,x ; save new length
5897 sty 2,x ; save new pointer
5898 LAFCE rts
5899 ; READ and INPUT commands.
5900 LAFCF fcc '?REDO' ; The ?REDO message
5901 fcb 0x0d,0x00
5902 LAFD6 ldb #2*17 ; bad file data code
5903 tst DEVNUM ; are we reading from the keyboard?
5904 beq LAFDF ; brif so
5905 LAFDC jmp LAC46 ; raise the error
5906 LAFDF lda INPFLG ; are we doing INPUT?
5907 beq LAFEA ; brif so
5908 ldx DATTXT ; get line number where the DATA statement happened
5909 stx CURLIN ; set current line number to that so can report the correct location
5910 jmp LB277 ; raise a syntax error on bad data
5911 LAFEA ldx #LAFCF-1 ; show the ?REDO if we're doing INPUT
5912 jsr STRINOUT
5913 ldx TINPTR ;* reset input pointer to start of statement (this will cause the
5914 stx CHARAD ;* INPUT statement to be re-executed
5915 rts
5916 INPUT ldb #11*2 ; code for illegal direct statement
5917 ldx CURLIN ; are we in immediate mode?
5918 leax 1,x
5919 beq LAFDC ; brif so - raise ID error
5920 bsr LB002 ; go do the INPUT thing
5921 clr DEVNUM ; reset device to screen/keyboard
5922 rts
5923 LB002 cmpa #'# ; is there a device number?
5924 bne LB00F ; brif not
5925 jsr LA5A5 ; parse device number
5926 jsr LA3ED ; make sure it's valid for input
5927 jsr SYNCOMMA ; make sure we have a comma after the device number
5928 LB00F cmpa #'" ; is there a prompt string?
5929 bne LB01E ; brif not
5930 jsr LB244 ; parse the prompt string
5931 ldb #'; ; make sure we have a semicolon after the prompt
5932 jsr LB26F
5933 jsr LB99F ; print the prompt
5934 LB01E ldx #LINBUF ; point to line input buffer
5935 clr ,x ; NUL first byte to indicate no data
5936 tst DEVNUM ; is it keyboard input?
5937 bne LB049 ; brif not
5938 bsr LB02F ; read a line from the keyboard
5939 ldb #', ; put a comma at the start of the buffer
5940 stb ,x
5941 bra LB049 ; go process some input
5942 LB02F jsr LB9AF ; send a ?
5943 jsr LB9AC ; send a space
5944 LB035 jsr LA390 ; read input from the keyboard
5945 bcc LB03F ; brif not BREAK
5946 leas 4,s ; clean up stack
5947 LB03C jmp LAE11 ; go process BREAK
5948 LB03F ldb #2*23 ; input past end of file error code
5949 tst CINBFL ; was it EOF?
5950 bne LAFDC ; brif so - raise the error
5951 rts
5952 READ ldx DATPTR ; fetch current DATA pointer
5953 skip1lda ; set A to nonzero (for READ)
5954 LB049 clra ; set A to zero (for INPUT)
5955 sta INPFLG ; record whether we're doing READ or INPUT
5956 stx DATTMP ; save current input location
5957 LB04E jsr LB357 ; evaluate a variable (destination of data)
5958 stx VARDES ; save descriptor
5959 ldx CHARAD ; save interpreter input pointer
5960 stx BINVAL
5961 ldx DATTMP ; get data pointer
5962 lda ,x ; is there anything to read?
5963 bne LB069 ; brif so
5964 lda INPFLG ; is it INPUT?
5965 bne LB0B9 ; brif not
5966 jsr RVEC10 ; do the RAM hook dance
5967 jsr LB9AF ; send a ? (so subsequent lines get ??)
5968 bsr LB02F ; go read an input line
5969 LB069 stx CHARAD ; save data pointer
5970 jsr GETNCH ; fetch next data character
5971 ldb VALTYP ; do we want a number?
5972 beq LB098 ; brif so
5973 ldx CHARAD ; get input pointer
5974 sta CHARAC ; save initial character as the delimiter
5975 cmpa #'" ; do we have a string delimiter?
5976 beq LB08B ; brif so - use " as both delimiters
5977 leax -1,x ; back up input if we don't have a delimiter
5978 clra ; set delimiter to NUL (end of line)
5979 sta CHARAC
5980 jsr LA35F ; set up print parameters
5981 tst PRTDEV ; is it a file type device?
5982 bne LB08B ; brif so - use two NULs
5983 lda #': ; use colon as one delimiter
5984 sta CHARAC
5985 lda #', ; and use comma as the other
5986 LB08B sta ENDCHR ; save second terminator
5987 jsr LB51E ; parse out the string
5988 jsr LB249 ; move input pointer past the string
5989 jsr LAFA4 ; assign the string to the variable
5990 bra LB09E ; go see if there's more to read
5991 LB098 jsr LBD12 ; parse a numeric string
5992 jsr LBC33 ; assign the numbe to the variable
5993 LB09E jsr GETCCH ; get current input character
5994 beq LB0A8 ; brif end of line
5995 cmpa #', ; check for comma
5996 lbne LAFD6 ; brif not - we have bad data
5997 LB0A8 ldx CHARAD ; get current data pointer
5998 stx DATTMP ; save the data pointer
5999 ldx BINVAL ; restore the interpreter input pointer
6000 stx CHARAD
6001 jsr GETCCH ; get current input from program
6002 beq LB0D5 ; brif end of statement
6003 jsr SYNCOMMA ; make sure there's a comma between variables
6004 bra LB04E ; go read another item
6005 LB0B9 stx CHARAD ; reset input pointer
6006 jsr LAEE8 ; search for end of statement
6007 leax 1,x ; move past end of statement
6008 tsta ; was it end of line?
6009 bne LB0CD ; brif not
6010 ldb #2*3 ; code for out of data
6011 ldu ,x++ ; get pointer to next line
6012 beq LB10A ; brif end of program - raise OD error
6013 ldd ,x++ ; get line number
6014 std DATTXT ; record it for raising errors in DATA statements
6015 LB0CD lda ,x ; do we have a DATA statement?
6016 cmpa #0x86
6017 bne LB0B9 ; brif not - keep scanning
6018 bra LB069 ; go process the input
6019 LB0D5 ldx DATTMP ; get data pointer
6020 ldb INPFLG ; were we doing READ?
6021 lbne LADE8 ; brif so - save DATA pointer
6022 lda ,x ; is there something after the input in the input buffer?
6023 beq LB0E7 ; brif not - we consumed everything
6024 ldx #LB0E8-1 ; print the ?EXTRA IGNORED message
6025 jmp STRINOUT
6026 LB0E7 rts
6027 LB0E8 fcc '?EXTRA IGNORED'
6028 fcb 0x0d,0x00
6029 ; NEXT command
6030 NEXT bne LB0FE ; brif argument given
6031 ldx ZERO ; set to NULL descriptor pointer
6032 bra LB101 ; go process "any index will do"
6033 LB0FE jsr LB357 ; evaluate the variable
6034 LB101 stx VARDES ; save the index we're looking for
6035 jsr LABF9 ; search the stack for the matching frame
6036 beq LB10C ; brif we found a matching frame
6037 ldb #0 ; code for NEXT without FOR
6038 LB10A bra LB153 ; raise the error
6039 LB10C tfr x,s ; reset the stack to the start of the stack frame
6040 leax 3,x ; point to the STEP value
6041 jsr LBC14 ; copy the value to FPA0
6042 lda 8,s ; get step direction
6043 sta FP0SGN ; save as sign of FPA0
6044 ldx VARDES ; point to index variable
6045 jsr LB9C2 ; add (X) to FPA0 (steps the index)
6046 jsr LBC33 ; save new value to the index
6047 leax 9,s ; point to terminal condition
6048 jsr LBC96 ; compare the new index value with the terminal
6049 subb 8,s ; set B=0 if we hit the terminal (or passed it with nonzero step)
6050 beq LB134 ; brif loop complete
6051 ldx 14,s ; restore line number and input pointer to start of loop
6052 stx CURLIN
6053 ldx 16,s
6054 stx CHARAD
6055 LB131 jmp LAD9E ; return to interpretation loop
6056 LB134 leas 18,s ; remove the frame from the stack
6057 jsr GETCCH ; get character after the index
6058 cmpa #', ; do we have more indexes?
6059 bne LB131 ; brif not
6060 jsr GETNCH ; munch the comma
6061 bsr LB0FE ; go process another value
6062 ; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall
6063 ; through this point, nor will the stack grow without bound. The BSR is required to make sure
6064 ; the stack is aligned properly for the stack search for the subsequent index variable.
6065 ;
6066 ; The following is the expression evaluation system. It has various entry points including for type
6067 ; checking. This really consists of two co-routines, one for evaluating operators and one for individual
6068 ; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow
6069 ; just how some of this works.
6070 ;
6071 ; Evaluate numeric expression
6072 LB141 bsr LB156 ; evaluate an expression
6073 ; TM error if string
6074 LB143 andcc #0xfe ; clear C to indicate we want a number
6075 skip2keepc
6076 ; TM error if numeric
6077 LB146 orcc #1 ; set C to indicate we want a string
6078 ; TM error if: C = 1 and number, OR C = 0 and string
6079 LB148 tst VALTYP ; set flags on the current value to (doesn't change C)
6080 bcs LB14F ; brif we want a string
6081 bpl LB0E7 ; brif we have a number (we want a number)
6082 skip2
6083 LB14F bmi LB0E7 ; brif we have a string (we want a string)
6084 LB151 ldb #12*2 ; code for TM error
6085 LB153 jmp LAC46 ; raise the error
6086 ; The general expression evaluation entry point
6087 LB156 bsr LB1C6 ; back up input pointer to compensate for GETNCH below
6088 LB158 clra ; set operator precedence to 0 (no previous operator)
6089 skip2
6090 LB15A pshs b ; save relational operator flags
6091 pshs a ; save previous operator precedence
6092 ldb #1 ; make sure we aren't overflowing the stack
6093 jsr LAC33
6094 jsr LB223 ; go evaluate the first term
6095 LB166 clr TRELFL ; flag no relational operators seen
6096 LB168 jsr GETCCH ; get input character
6097 LB16A suba #0xb2 ; token for > (lowest relational operator)
6098 blo LB181 ; brif below relational operators
6099 cmpa #3 ; there are three relational operators, is it one?
6100 bhs LB181 ; brif not
6101 cmpa #1 ; set C if >
6102 rola ; shift C into bit 0 (4: <, 2: =, 1: >)
6103 eora TRELFL ; flip the bit for this operator
6104 cmpa TRELFL ; did the result get lower?
6105 blo LB1DF ; brif so - we have a duplicate so raise an error
6106 sta TRELFL ; save new operator flags
6107 jsr GETNCH ; munch the operator
6108 bra LB16A ; go see if we have another one
6109 LB181 ldb TRELFL ; do we have a relational comparison?
6110 bne LB1B8 ; brif so
6111 lbcc LB1F4 ; brif the token is above the relational operators
6112 adda #7 ; put operators starting at 0
6113 bhs LB1F4 ; brif we're above 0 - it's an operator, Jim
6114 adca VALTYP ; add carry, numeric flag, and modified token number
6115 lbeq LB60F ; brif we have string and A is + - do concatenation
6116 adca #-1 ; restore operator number
6117 pshs a ; save operator number
6118 asla ; times 2
6119 adda ,s+ ; and times 3 (3 bytes per entry)
6120 ldx #LAA51 ; point to operator pecedence and jump table
6121 leax a,x ; point to correct entry
6122 LB19F puls a ; get precedence of previous operation
6123 cmpa ,x ; is hit higher (or same) than the current one?
6124 bhs LB1FA ; brif so - we need to process that operator
6125 bsr LB143 ; TM error if we have a string
6126 LB1A7 pshs a ; save previous operation precedence
6127 bsr LB1D4 ; push operator handler address and FPA0 onto the stack
6128 ldx RELPTR ; get pointer to arithmetic/logical table entry for last operation
6129 puls a ; get back precedence
6130 bne LB1CE ; brif we had a relational operation
6131 tsta ; check precedence of previous operation
6132 lbeq LB220 ; brif end of expression
6133 bra LB203 ; go handle operation
6134 LB1B8 asl VALTYP ; get type of value to C
6135 rolb ; mix it in to bit 0 of relational flags
6136 bsr LB1C6 ; back up input pointer
6137 ldx #LB1CB ; point to relational operator precedence and handler
6138 stb TRELFL ; save relational comparison flags
6139 clr VALTYP ; result will be numeric
6140 bra LB19F ; to process the operation
6141 LB1C6 ldx CHARAD ; get input pointer
6142 jmp LAEBB ; back it up one and put it back
6143 LB1CB fcb 0x64 ; precedence of relational comparison
6144 fdb LB2F4 ; handler address for relational comparison
6145 LB1CE cmpa ,x ; is last done operation higher (or same) precedence?
6146 bhs LB203 ; brif so - go process it
6147 bra LB1A7 ; go push things on the stack and process this operation otherwise
6148 LB1D4 ldd 1,x ; get address of operatorroutine
6149 pshs d ; save it
6150 bsr LB1E2 ; push FPA0 onto the stack
6151 ldb TRELFL ; get back relational operator flags
6152 lbra LB15A ; go evaluate another operation
6153 LB1DF jmp LB277 ; raise a syntax error
6154 LB1E2 ldb FP0SGN ; get sign of FPA0
6155 lda ,x ; get precedence of this operation
6156 LB1E6 puls y ; get back original caller
6157 pshs b ; save sign
6158 LB1EA ldb FP0EXP ; get exponent
6159 ldx FPA0 ; get mantissa
6160 ldu FPA0+2
6161 pshs u,x,b ; stow FPA0 sign and mantissa
6162 jmp ,y ; return to caller
6163 LB1F4 ldx ZERO ; point to dummy value
6164 lda ,s+ ; get precedence of previous operation (and set flags)
6165 beq LB220 ; brif end of expression
6166 LB1FA cmpa #0x64 ; relational operation?
6167 beq LB201 ; brif so
6168 jsr LB143 ; type mismatch if string
6169 LB201 stx RELPTR ; save pointer to operator routine
6170 LB203 puls b ; get relational flags
6171 cmpa #0x5a ; NOT operation?
6172 beq LB222 ; brif so (it was unary)
6173 cmpa #0x7d ; unary negation?
6174 beq LB222 ; brif so
6175 lsrb ; shift value type flag out of relational flags
6176 stb RELFLG ; save relational operator flag
6177 puls a,x,u ; get FP value back
6178 sta FP1EXP ; set exponent and mantissa in FPA1
6179 stx FPA1
6180 stu FPA1+2
6181 puls b ; and the sign
6182 stb FP1SGN
6183 eorb FP0SGN ; set RESSGN if the two operand signs differ
6184 stb RESSGN
6185 LB220 ldb FP0EXP ; get exponent of FPA0
6186 LB222 rts ; return or transfer control to operator handler routine
6187 LB223 jsr RVEC15 ; do the RAM hook dance
6188 clr VALTYP ; set type to numeric
6189 jsr GETNCH ; get first character in the term
6190 bcc LB22F ; brif not numeric
6191 LB22C jmp LBD12 ; parse a number (and return)
6192 LB22F jsr LB3A2 ; set carry if not alpha
6193 bcc LB284 ; brif alpha character (variable)
6194 cmpa #'. ; decimal point?
6195 beq LB22C ; brif so - evaluate number
6196 cmpa #0xac ; minus?
6197 beq LB27C ; brif so - process unary negation
6198 cmpa #0xab ; plus?
6199 beq LB223 ; brif so - ignore unary "posation"
6200 cmpa #'" ; string delimiter?
6201 bne LB24E ; brif not
6202 LB244 ldx CHARAD ; get input pointer
6203 jsr LB518 ; go parse the string
6204 LB249 ldx COEFPT ; get address of end of string
6205 stx CHARAD ; move input pointer past string
6206 rts
6207 LB24E cmpa #0xa8 ; NOT?
6208 bne LB25F ; brif not
6209 lda #0x5a ; precedence of unary NOT
6210 jsr LB15A ; process the operand of NOT
6211 jsr INTCNV ; convert to integer in D
6212 coma ; do a bitwise complement
6213 comb
6214 jmp GIVABF ; resturn the result
6215 LB25F inca ; is it a function token?
6216 beq LB290 ; brif so
6217 LB262 bsr LB26A ; only other legal thing must be a (expr)
6218 jsr LB156 ; evaluate parentheticized expression
6219 LB267 ldb #') ; force a )
6220 skip2
6221 LB26A ldb #'( ; force a (
6222 skip2
6223 SYNCOMMA ldb #', ; force a ,
6224 LB26F cmpb [CHARAD] ; does character match?
6225 bne LB277 ; brif not
6226 jmp GETNCH ; each the character and return the next
6227 LB277 ldb #2*1 ; raise syntax error
6228 jmp LAC46
6229 LB27C lda #0x7d ; unary negation precedence
6230 jsr LB15A ; evaluate argument
6231 jmp LBEE9 ; flip sign of FPA0 and return
6232 LB284 jsr LB357 ; evaluate variable
6233 LB287 stx FPA0+2 ; save descriptor address in FPA0
6234 lda VALTYP ; test variable type
6235 bne LB222 ; brif string - we're done
6236 jmp LBC14 ; copy FP number from (X) into FPA0
6237 LB290 jsr GETNCH ; get the actual token number
6238 tfr a,b ; save it (for offsetting X)
6239 lslb ; two bytes per jump table entry (and lose high bit)
6240 jsr GETNCH ; eat the token byte
6241 cmpb #2*19 ; is it a valid token for Color Basic?
6242 bls LB29F ; brif so
6243 jmp [COMVEC+18] ; transfer control to Extended Basic if not
6244 LB29F pshs b ; save jump table offset
6245 cmpb #2*14 ; does it expect a numeric argument?
6246 blo LB2C7 ; brif so
6247 cmpb #2*18 ; does it need no arguments?
6248 bhs LB2C9 ; brif so
6249 bsr LB26A ; force a (
6250 lda ,s ; get token value
6251 cmpa #2*17 ; is it POINT?
6252 bhs LB2C9 ; brif so
6253 jsr LB156 ; evaluate first argument string
6254 bsr SYNCOMMA ; force a comma
6255 jsr LB146 ; TM error if string
6256 puls a ; get token value
6257 ldu FPA0+2 ; get string descriptor
6258 pshs u,a ; now we save the first string argument and the token value
6259 jsr EVALEXPB ; evaluate first numeric argument
6260 puls a ; get back token value
6261 pshs b,a ; save second argument and token value
6262 fcb 0x8e ; opcode of LDX immediate (skips two bytes)
6263 LB2C7 bsr LB262 ; force a (
6264 LB2C9 puls b ; get offset
6265 ldx COMVEC+8 ; get jump table pointer
6266 LB2CE abx ; add offset into table
6267 jsr [,x] ; go process function
6268 jmp LB143 ; make sure result is numeric
6269 ; operator OR
6270 LB2D4 skip1lda ; set flag to nonzero to signal OR
6271 ; operator AND
6272 LB2D5 clra ; set flag to zero to signal AND
6273 sta TMPLOC ; save AND/OR flag
6274 jsr INTCNV ; convert second argument to intenger
6275 std CHARAC ; save it
6276 jsr LBC4A ; move first argument to FPA0
6277 jsr INTCNV ; convert first argument to integer
6278 tst TMPLOC ; is it AND or OR?
6279 bne LB2ED ; brif OR
6280 anda CHARAC ; do the bitwise AND
6281 andb ENDCHR
6282 bra LB2F1 ; finish up
6283 LB2ED ora CHARAC ; do the bitwise OR
6284 orb ENDCHR
6285 LB2F1 jmp GIVABF ; return integer result
6286 ; relational comparision operators
6287 LB2F4 jsr LB148 ; TM error if type mismatch
6288 BNE LB309 ; brif we have a string comparison
6289 lda FP1SGN ; pack FPA1
6290 ora #0x7f
6291 anda FPA1
6292 sta FPA1
6293 ldx #FP1EXP ; point to packed FPA1
6294 jsr LBC96 ; compare FPA0 to FPA1
6295 bra LB33F ; handle truth comparison
6296 LB309 clr VALTYP ; the result of a comparison is always a number
6297 dec TRELFL ; remove the string flag from the comparison data
6298 jsr LB657 ; get string details for second argument
6299 stb STRDES ; save them in the temporary string descriptor
6300 stx STRDES+2
6301 ldx FPA1+2 ; get pointer to first argument descriptor
6302 jsr LB659 ; get string details for second argument
6303 lda STRDES ; get length of second argument
6304 pshs b ; save length of first argument
6305 suba ,s+ ; now A is the difference in string lengths
6306 beq LB328 ; brif string lengths are equal
6307 lda #1 ; flag for second argument is longer than first
6308 bcc LB328 ; brif second string is longer than first
6309 ldb STRDES ; get length of second string (shorter)
6310 nega ; invert default comparison result
6311 LB328 sta FP0SGN ; save default truth flag
6312 ldu STRDES+2 ; get pointer to start of second string
6313 incb ; compensate for DECB
6314 LB32D decb ; have we compared everything?
6315 bne LB334 ; brif not
6316 ldb FP0SGN ; get default truth value
6317 bra LB33F ; decide comparison truth
6318 LB334 lda ,x+ ; get byte from first argument
6319 cmpa ,u+ ; compare with second argument
6320 beq LB32D ; brif equal - keep comparing
6321 ldb #0xff ; negative if first string is > second
6322 bcc LB33F ; brif string A > string B
6323 negb ; invert result
6324 LB33F addb #1 ; convert to 0,1,2
6325 rolb ; shift left - now it's 4,2,1 for <, =, >
6326 andb RELFLG ; keep only the truth we care about
6327 beq LB348 ; brif no matching bits - it's false
6328 ldb #0xff ; set true
6329 LB348 jmp LBC7C ; convert result to FP and return it
6330 ; DIM command
6331 LB34B jsr SYNCOMMA ; make sure there's a comma between variables
6332 DIM ldb #1 ; flag that we're dimensioning
6333 bsr LB35A ; go allocate the variable
6334 jsr GETCCH ; are we done?
6335 bne LB34B ; brif not
6336 rts
6337 ; This routine parses a variable. For scalars, it will return a NULL string or 0 value number
6338 ; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will
6339 ; allocate a default sized array if dimensioning is not underway and then attempt to look up
6340 ; the requested coordinates in that array. Otherwise, it will allocate an array based on the
6341 ; specified dimension values.
6342 LB357 clrb ; flag that we're not setting up an array
6343 jsr GETCCH
6344 LB35A stb DIMFLG ; save dimensioning flag
6345 LB35C sta VARNAM ; save first character of variable name
6346 jsr GETCCH ; get input character (why? we already have it)
6347 bsr LB3A2 ; set carry if not alpha
6348 lbcs LB277 ; brif our variable doesn't start with a letter
6349 clrb ; default second variable character to NUL
6350 stb VALTYP ; set value type to numeric
6351 jsr GETNCH ; get second character
6352 bcs LB371 ; brif numeric - numbers are allowed
6353 bsr LB3A2 ; set carry if not alpha
6354 bcs LB37B ; brif not alpha
6355 LB371 tfr a,b ; save set second character of variable name
6356 LB373 jsr GETNCH ; get an input character
6357 bcs LB373 ; brif numeric - still in variable name
6358 bsr LB3A2 ; set carry if not alpha
6359 bcc LB373 ; brif alpha - still in variable name
6360 LB37B cmpa #'$ ; do we have the string sigil?
6361 bne LB385 ; brif not
6362 com VALTYP ; set value type to string
6363 addb #0x80 ; set bit 7 of second variable character to indicate string
6364 jsr GETNCH ; eat the sigil
6365 LB385 stb VARNAM+1 ; save second variable name character
6366 ora ARYDIS ; merge array disable flag (will set bit 7 of input character if no arrays)
6367 suba #'( ; do we have a subscript?
6368 lbeq LB404 ; brif so
6369 clr ARYDIS ; disable the array disable flag - it's single use
6370 ldx VARTAB ; point to the start of the variable table
6371 ldd VARNAM ; get variable name
6372 LB395 cmpx ARYTAB ; are we at the top of the variable table?
6373 beq LB3AB ; brif so
6374 cmpd ,x++ ; does the variable name match (and move pointer to variable data)
6375 beq LB3DC ; brif so
6376 leax 5,x ; move to next table entry
6377 bra LB395 ; see if we have a match
6378 ; Set carry if not upper case alpha
6379 LB3A2 cmpa #'A ; set C if less than A
6380 bcs LB3AA ; brif less than A
6381 suba #'Z+1 ; set C if greater than Z
6382 suba #-('Z+1)
6383 LB3AA rts
6384 LB3AB ldx #ZERO ; point to empty location (NULL/0 value)
6385 ldu ,s ; get caller address
6386 cmpu #LB287 ; coming from "evaluate term"?
6387 beq LB3DE ; brif so - don't allocate
6388 ldd ARYEND ; get end of arrays
6389 std V43 ; save as top of source block
6390 addd #7 ; 7 bytes per scalar entry
6391 std V41 ; save as top of destination block
6392 ldx ARYTAB ; get bottom of arrays
6393 stx V47 ; save as bottom of source block
6394 jsr LAC1E ; move the arrays up to make a hole
6395 ldx V41 ; get new top of arrays
6396 stx ARYEND ; set new end of arrays
6397 ldx V45 ; get bottom of destination block
6398 stx ARYTAB ; set as new start of arrays
6399 ldx V47 ; get old end of variables
6400 ldd VARNAM ; get name of variable
6401 std ,x++ ; set variable name and advance X to the value
6402 clra ; zero out the variable value
6403 clrb
6404 std ,x
6405 std 2,x
6406 sta 4,x
6407 LB3DC stx VARPTR ; save descriptor address of return value
6408 LB3DE rts
6409 ; Various integer conversion routines
6410 LB3DF fcb 0x90,0x80,0x00,0x00,0x00 ; FP constant -32768
6411 LB3E4 jsr GETNCH ; fetch input character
6412 LB3E6 jsr LB141 ; evaluate numeric expression
6413 LB3E9 lda FP0SGN ; get sign of value
6414 bmi LB44A ; brif negative (raise FC error)
6415 INTCNV jsr LB143 ; TM error if string
6416 lda FP0EXP ; get exponent
6417 cmpa #0x90 ; is it within the range for a 16 bit integer?
6418 blo LB3FE ; brif smaller than 32768
6419 ldx #LB3DF ; point to -32678 constant
6420 jsr LBC96 ; is FPA0 equal to -32768?
6421 bne LB44A ; brif not - magnitude is too far negative
6422 LB3FE jsr LBCC8 ; move binary point to the right of FPA0 and correct sign
6423 ldd FPA0+2 ; get the resulting integer
6424 rts
6425 LB404 ldd DIMFLG ; get dimensioning flag and variable type
6426 pshs b,a ; save them (to avoid issues while evaluating dimension values)
6427 nop ; dead space caused by 1.2 revision
6428 clrb ; reset dimension counter
6429 LB40A ldx VARNAM ; get variable name
6430 pshs x,b ; save dimension counter and variable name
6431 bsr LB3E4 ; evaluate a dimension value (and skip either ( or ,)
6432 puls b,x,y ; get variable name, dimension counter, and dimensioning/type flag
6433 stx VARNAM ; restore variable name
6434 ldu FPA0+2 ; get dimension size/index
6435 pshs u,y ; save dimension size and dimensioning/type flag
6436 incb ; bump dimension counter
6437 jsr GETCCH ; get what's after the dimension count
6438 cmpa #', ; do we have another dimension?
6439 beq LB40A ; brif so - parse it
6440 stb TMPLOC ; save dimension counter
6441 jsr LB267 ; make sure we have a )
6442 puls a,b ; get back variable type and dimensioning flag
6443 std DIMFLG ; restore variable type and dimensioning flag
6444 ldx ARYTAB ; get start of arrays
6445 LB42A cmpx ARYEND ; are we at the end of the array table
6446 beq LB44F ; brif so
6447 ldd VARNAM ; get variable name
6448 cmpd ,x ; does it match?
6449 beq LB43B ; brif so
6450 ldd 2,x ; get length of this array
6451 leax d,x ; move to next array
6452 bra LB42A ; go check another entry
6453 LB43B ldb #2*9 ; code for redimensioned array error
6454 lda DIMFLG ; are we dimensioning?
6455 bne LB44C ; brif so - raise error
6456 ldb TMPLOC ; get number of dimensions given
6457 cmpb 4,x ; does it match?
6458 beq LB4A0 ; brif so
6459 LB447 ldb #8*2 ; raise "bad subscript"
6460 skip2
6461 LB44A ldb #4*2 ; raise "illegal function call"
6462 LB44C jmp LAC46 ; raise error
6463 LB44F ldd #5 ; 5 bytes per array entry
6464 std COEFPT ; initialize array size to entry size
6465 ldd VARNAM ; get variable name
6466 std ,x ; set array name
6467 ldb TMPLOC ; get dimension count
6468 stb 4,x ; set dimension count
6469 jsr LAC33 ; make sure we haven't overflowed memory
6470 stx V41 ; save array descriptor address
6471 LB461 ldb #11 ; default dimension value (zero-based, gives max index of 10)
6472 clra ; zero extend (??? why not LDD above?)
6473 tst DIMFLG ; are we dimensioning?
6474 beq LB46D ; brif not
6475 puls a,b ; get dimension size
6476 addd #1 ; account for zero based indexing
6477 LB46D std 5,x ; save dimension size
6478 bsr LB4CE ; multiply by accumulated array size
6479 std COEFPT ; save new array size
6480 leax 2,x ; move to next dimension
6481 dec TMPLOC ; have we done all dimensions?
6482 bne LB461 ; brif not
6483 stx TEMPTR ; save end of array descriptor (minus 5)
6484 addd TEMPTR ; add total size of array to address of descriptor
6485 lbcs LAC44 ; brif it overflows memory
6486 tfr d,x ; save end of array for later
6487 jsr LAC37 ; does array fit in memory?
6488 subd #STKBUF-5 ; subtract out the "stack fudge factor" but add 5 to the result
6489 std ARYEND ; save new end of arrays
6490 clra ; set up for clearing
6491 LB48C leax -1,x ; move back one
6492 sta 5,x ; blank out a byte in the array data
6493 cmpx TEMPTR ; have we reached the array header?
6494 bne LB48C ; brif not
6495 ldx V41 ; get address of start of descriptor
6496 lda ARYEND ; get MSB of end of array back (B still has LSB)
6497 subd V41 ; subtract start of descriptor
6498 std 2,x ; save length of array in array header
6499 lda DIMFLG ; are we dimensioning?
6500 bne LB4CD ; brif so - we're done
6501 LB4A0 ldb 4,x ; get number of dimensions
6502 stb TMPLOC ; initialize counter
6503 clra ; initialize accumulated offset
6504 clrb
6505 LB4A6 std COEFPT ; save accumulated offset
6506 puls a,b ; get desired index
6507 std FPA0+2 ; save it
6508 cmpd 5,x ; is it in range for this dimension?
6509 bhs LB4EB ; brif not
6510 ldu COEFPT ; get accumulated offset
6511 beq LB4B9 ; brif first dimension
6512 bsr LB4CE ; multiply accumulated offset by dimension length
6513 addd FPA0+2 ; add in offset into this dimension
6514 LB4B9 leax 2,x ; move to next dimension in header
6515 dec TMPLOC ; done all dimensions?
6516 bne LB4A6 ; brif not
6517 std ,--s ; save D for multiply by 5 (should be pshs d)
6518 aslb ; times 2
6519 rola
6520 aslb ; times 4
6521 rola
6522 addd ,s++ ; times 5
6523 leax d,x ; add in offset from start of array data
6524 leax 5,x ; offset to end of header
6525 stx VARPTR ; save pointer to element data
6526 LB4CD rts
6527 ; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry
6528 LB4CE lda #16 ; 16 shifts to do a multiply
6529 sta V45 ; save shift counter
6530 ldd 5,x ; get multiplier
6531 std BOTSTK ; save it
6532 clra ; zero out product
6533 clrb
6534 LB4D8 aslb ; shift product left
6535 rola
6536 bcs LB4EB ; brif we have a carry
6537 asl COEFPT+1 ; shift other factor left
6538 rol COEFPT
6539 bcc LB4E6 ; brif no carry - this bit position is 0
6540 addd BOTSTK ; add in multiplier at this bit position
6541 bcs LB4EB ; brif carry - do an error
6542 LB4E6 dec V45 ; have we done all 16 bits?
6543 bne LB4D8 ; brif not
6544 rts
6545 LB4EB jmp LB447 ; raise a BS error
6546 ; MEM function
6547 ; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks
6548 MEM tfr s,d ; get stack pointer where we can do math
6549 subd ARYEND ; calculate number of bytes between the stack and the top of arrays
6550 skip1 ; return result
6551 ; Convert unsigned value in B to FP
6552 LB4F3 clra ; zero extend
6553 ; Convert signed value in D to FP
6554 GIVABF clr VALTYP ; set value type to numeric
6555 std FPA0 ; save value in FPA0
6556 ldb #0x90 ; exponent for top two bytes to be an integer
6557 jmp LBC82 ; finish conversion to integer
6558 ; STR$ function
6559 STR jsr LB143 ; make sure we have a number
6560 ldu #STRBUF+2 ; convert FP number to string in temporary string buffer
6561 jsr LBDDC
6562 leas 2,s ; don't return to the function evaluator (which will do a numeric type check)
6563 ldx #STRBUF+1 ; point to number string
6564 bra LB518 ; to stash the string in string space and return to the "evaluate term" caller
6565 ; Reserve B bytes of string space. Return start in X and FRESPC
6566 LB50D stx V4D ; save X somewhere in case the caller needs it
6567 LB50F bsr LB56D ; allocate string space
6568 LB511 stx STRDES+2 ; save pointer to allocated space in the temporary descriptor
6569 stb STRDES ; save length in the temporary descriptor
6570 rts
6571 LB516 leax -1,x ; move pointer back one (to compensate for the increment below)
6572 ; Scan from X until either NUL or one of the string terminators is found
6573 LB518 lda #'" ; set terminator to be string delimiter
6574 LB51A sta CHARAC ; set both delimiters
6575 sta ENDCHR
6576 LB51E leax 1,x ; move to next character
6577 stx RESSGN ; save start of string
6578 stx STRDES+2 ; save start of string in the temporary string descriptor
6579 ldb #-1 ; initialize length counter to -1 (compensate for initial INCB)
6580 LB526 incb ; bump string length
6581 lda ,x+ ; get character from string
6582 beq LB537 ; brif end of line
6583 cmpa CHARAC ; is it delimiter #1?
6584 beq LB533 ; brif so
6585 cmpa ENDCHR ; is it delimiter #2?
6586 bne LB526 ; brif not - keep scanning
6587 LB533 cmpa #'" ; string delimiter?
6588 beq LB539 ; brif so - don't move pointer back
6589 LB537 leax -1,x ; move pointer back (so we don't consume the delimiter)
6590 LB539 stx COEFPT ; save end of string address
6591 stb STRDES ; save string length
6592 ldu RESSGN ; get start of string
6593 cmpu #STRBUF+2 ; is it at the start of the string buffer?
6594 bhi LB54C ; brif so - don't copy it to string space
6595 bsr LB50D ; allocate string space
6596 ldx RESSGN ; point to beginning of the string
6597 jsr LB645 ; copy string data (B bytes) from (X) to (FRESPC)
6598 ; Put temporary string descriptor on the string stack
6599 LB54C ldx TEMPPT ; get top of string stack
6600 cmpx #CFNBUF ; is the string stack full?
6601 bne LB558 ; brif not
6602 ldb #15*2 ; code for "string formula too complex"
6603 LB555 jmp LAC46 ; raise error
6604 LB558 lda STRDES ; get string length
6605 sta 0,x ; save it in the string stack descriptor
6606 ldd STRDES+2 ; get string data pointer
6607 std 2,x ; save in string stack descriptor
6608 lda #0xff ; set value type to string
6609 sta VALTYP
6610 stx LASTPT ; set pointer to last used entry on the string stack
6611 stx FPA0+2 ; set pointer to descriptor in the current evaluation value
6612 leax 5,x ; advance string stack pointer
6613 stx TEMPPT
6614 rts
6615 ; Reserve B bytes in string space. If there isn't enough space, try compacting string space and
6616 ; then try the allocation again. If it still fails, raise OS error.
6617 LB56D clr GARBFL ; flag that compaction not yet done
6618 LB56F clra ; zero extend the length
6619 pshs d ; save requested string length
6620 ldd STRTAB ; get current bottom of strings
6621 subd ,s+ ; calculate new bottom of strings and remove zero extension
6622 cmpd FRETOP ; does the string fit?
6623 blo LB585 ; brif not - try compaction
6624 std STRTAB ; save new bottom of strings
6625 ldx STRTAB ; get bottom of strings
6626 leax 1,x ; now X points to the real start of the allocated space
6627 stx FRESPC ; save the string pointer
6628 puls b,pc ; restore length and return
6629 LB585 ldb #2*13 ; code for out of string space
6630 com GARBFL ; have we compacted string space yet?
6631 beq LB555 ; brif so - raise error
6632 bsr LB591 ; compact string space
6633 puls b ; get back string length
6634 bra LB56F ; go try allocation again
6635 ; Compact string space
6636 ; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer
6637 ; that hasn't already been moved into the freshly compacted string space. If then moves that string data
6638 ; up to the highest address it can go to. It repeats this process over and over until it finds no string
6639 ; that isn't already in the compacted space. While doing this, it has to search all strings on the string
6640 ; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string
6641 ; variables, and *every* entry in every string array.
6642 LB591 ldx MEMSIZ ; get to of string space
6643 LB593 stx STRTAB ; save top of uncompacted stringspace
6644 clra ; zero out D and reset pointer to discovered variable to NULL
6645 clrb
6646 std V4B
6647 ldx FRETOP ; point to bottom of string space
6648 stx V47 ; save as lowest match address (match will be higher)
6649 ldx #STRSTK ; point to start of string stack
6650 LB5A0 cmpx TEMPPT ; are we at the top of the string stack?
6651 beq LB5A8 ; brif so - done with the string stack
6652 bsr LB5D8 ; check for string in uncompacted space (and advance pointer)
6653 bra LB5A0 ; check another on the string stack
6654 LB5A8 ldx VARTAB ; point to start of scalar variables
6655 LB5AA cmpx ARYTAB ; end of scalars?
6656 beq LB5B2 ; brif so
6657 bsr LB5D2 ; check for string in uncompacted space and advance pointer
6658 bra LB5AA ; check another variable
6659 LB5B2 stx V41 ; save address of end of variables (address of first array)
6660 LB5B4 ldx V41 ; get start of the next array
6661 LB5B6 cmpx ARYEND ; end of arrays?
6662 beq LB5EF ; brif so
6663 ldd 2,x ; get length of array
6664 addd V41 ; add to start of array
6665 std V41 ; save address of next array
6666 lda 1,x ; get second character of variable name
6667 bpl LB5B4 ; brif numeric
6668 ldb 4,x ; get number of dimensions
6669 aslb ; two bytes per dimension size
6670 addb #5 ; add in fixed overhead for array descriptor
6671 abx ; now X points to first array element
6672 LB5CA cmpx V41 ; at the start of the next array?
6673 beq LB5B6 ; brif so - go handle another array
6674 bsr LB5D8 ; check for string in uncompacted space (and advance pointer)
6675 bra LB5CA ; process next array element
6676 LB5D2 lda 1,x ; get second character of variable name
6677 leax 2,x ; move to variable data
6678 bpl LB5EC ; brif numeric
6679 LB5D8 ldb ,x ; get length of string
6680 beq LB5EC ; brif NULL - don't need to check data pointer
6681 ldd 2,x ; get data pointer
6682 cmpd STRTAB ; is it in compacted string space?
6683 bhi LB5EC ; brif so
6684 cmpd V47 ; is it better match than previous best?
6685 bls LB5EC ; brif not
6686 stx V4B ; save descriptor address of best match
6687 std V47 ; save new best data pointer match
6688 LB5EC leax 5,x ; move to next descriptor
6689 LB5EE rts
6690 LB5EF ldx V4B ; get descriptor address of the matched string
6691 beq LB5EE ; brif we didn't find one - we're done
6692 clra ; zero extend length
6693 ldb ,x ; get string length
6694 decb ; subtract one (we won't have a NULL string here)
6695 addd V47 ; now D points to the address of the end of the string data
6696 std V43 ; save as top address of move
6697 ldx STRTAB ; set top of uncompacted space as destination
6698 stx V41
6699 jsr LAC20 ; move string to top of uncompactedspace
6700 ldx V4B ; point to string descriptor
6701 ldd V45 ; get new data pointer address
6702 std 2,x ; update descriptor
6703 ldx V45 ; get bottom of copy destination
6704 leax -1,x ; move back below it
6705 jmp LB593 ; go search for another string to move (and set new bottom of string space)
6706 ; Concatenate two strings. We come here directly from the operator handler rather than via a JSR.
6707 LB60F ldd FPA0+2 ; get string descriptor for the first string
6708 pshs d ; save it
6709 jsr LB223 ; evaluate a second string (concatenation is left associative)
6710 jsr LB146 ; make sure we have a string
6711 puls x ; get back first string descriptor
6712 stx RESSGN ; save it
6713 ldb ,x ; get length of first string
6714 ldx FPA0+2 ; get pointer to second string
6715 addb ,x ; add length of second string
6716 bcc LB62A ; brif combined length is OK
6717 ldb #2*14 ; raise string too long error
6718 jmp LAC46
6719 LB62A jsr LB50D ; reserve room for new string
6720 ldx RESSGN ; get descriptor address of the first string
6721 ldb ,x ; get length of first string
6722 bsr LB643 ; copy it to string space
6723 ldx V4D ; get descriptor address of second string
6724 bsr LB659 ; get string details for second string
6725 bsr LB645 ; copy second string into new string space
6726 ldx RESSGN ; get pointer to first string
6727 bsr LB659 ; remove it from the string stack if possible
6728 jsr LB54C ; put new string on the string stack
6729 jmp LB168 ; return to expression evaluator
6730 ; Copy B bytes to space pointed to by FRESPC
6731 LB643 ldx 2,x ; get source address from string descriptor
6732 LB645 ldu FRESPC ; get destination address
6733 incb ; compensate for decb
6734 bra LB64E ; do the copy
6735 LB64A lda ,x+ ; copy a byte
6736 sta ,u+
6737 LB64E decb ; done yet?
6738 bne LB64A ; brif not
6739 stu FRESPC ; save destination pointer
6740 rts
6741 ; Fetch details of string in FPA0+2 and remove from the string stack if possible
6742 LB654 jsr LB146 ; make sure we have a string
6743 LB657 ldx FPA0+2 ; get descriptor pointer
6744 LB659 ldb ,x ; get length of string
6745 bsr LB675 ; see if it's at the top of the string stack and remove it if so
6746 bne LB672 ; brif not removed
6747 ldx 5+2,x ; get start address of string just removed
6748 leax -1,x ; move pointer down 1
6749 cmpx STRTAB ; is it at the bottom of string space?
6750 bne LB66F ; brif not
6751 pshs b ; save length
6752 addd STRTAB ; add length to start of strings (A was cleared previously)
6753 std STRTAB ; save new string space start (deallocated space for this string)
6754 puls b ; get back string length
6755 LB66F leax 1,x ; restore pointer to pointing at the actual string data
6756 rts
6757 LB672 ldx 2,x ; get data pointer for the string
6758 rts
6759 ; Remove string pointed to by X from the string stack if it is at the top of the stack; return with
6760 ; A clear and Z set if string removed
6761 LB675 cmpx LASTPT ; is it at the top of the string stack?
6762 bne LB680 ; brif not - do nothing
6763 stx TEMPPT ; save new top of stack
6764 leax -5,x ; move the "last" pointer back as well
6765 stx LASTPT
6766 clra ; flag string removed
6767 LB680 rts
6768 ; LEN function
6769 LEN bsr LB686 ; get string details
6770 LB683 jmp LB4F3 ; return unsigned length in B
6771 LB686 bsr LB654 ; get string details and remove from string stack
6772 clr VALTYP ; set value type to numeric
6773 tstb ; set flags according to length
6774 rts
6775 ; CHR$ function
6776 CHR jsr LB70E ; get 8 bit unsigned integer to B
6777 LB68F ldb #1 ; allocate a one byte string
6778 jsr LB56D
6779 lda FPA0+3 ; get character code
6780 jsr LB511 ; save reserved string details in temp descriptor
6781 sta ,x ; put character in string
6782 LB69B leas 2,s ; don't go back to function handler - avoid numeric type check
6783 LB69D jmp LB54C ; return temporary string on string stack
6784 ; ASC function
6785 ASC bsr LB6A4 ; get first character of argument
6786 bra LB683 ; return unsigned code in B
6787 LB6A4 bsr LB686 ; fetch string details
6788 beq LB706 ; brif NULL string
6789 ldb ,x ; get character at start of string
6790 rts
6791 ; LEFT$ function
6792 LEFT bsr LB6F5 ; get arguments from the stack
6793 LB6AD clra ; clear pointer offset (set to start of string)
6794 LB6AE cmpb ,x ; are we asking for more characters than there are in the string?
6795 bls LB6B5 ; brif not
6796 ldb ,x ; only return the number that are in the string
6797 clra ; force starting offset to be the start of the string
6798 LB6B5 pshs b,a ; save offset and length
6799 jsr LB50F ; reserve space in string space
6800 ldx V4D ; point to original string descriptor
6801 bsr LB659 ; get string details
6802 puls b ; get string offset
6803 abx ; now X points to the start of the data to copy
6804 puls b ; get length of copy
6805 jsr LB645 ; copy the data to the allocated space
6806 bra LB69D ; return temp string on string stack
6807 ; RIGHT$ function
6808 RIGHT bsr LB6F5 ; get arguments from stack
6809 suba ,x ; subtract length of original string from desired length
6810 nega ; now A is offset into old string where we start copying
6811 bra LB6AE ; go handle everything else
6812 ; MID$ function
6813 MID ldb #255 ; default length is the whole string
6814 stb FPA0+3 ; save it
6815 jsr GETCCH ; see what we have after offset
6816 cmpa #') ; end of function?
6817 beq LB6DE ; brif so - no length
6818 jsr SYNCOMMA ; force a comma
6819 bsr EVALEXPB ; get length parameter
6820 LB6DE bsr LB6F5 ; get string and offset parameters from the stack
6821 beq LB706 ; brif we have a 0 offset requested (string offsets are 1-based)
6822 clrb ; clear length counter
6823 deca ; subtract one from position parameter (we work on 0-based, param is 1-based)
6824 cmpa ,x ; is start greater than length of string?
6825 bhs LB6B5 ; brif so - return NULL string
6826 tfr a,b ; save absolute position parameter
6827 subb ,x ; now B is postition less length
6828 negb ; now B is amount of string to copy
6829 cmpb FPA0+3 ; is it less than the length requested?
6830 bls LB6B5 ; brif so
6831 ldb FPA0+3 ; set length to the requested length
6832 bra LB6B5 ; go finish up copying the substring
6833 ; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter
6834 ; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing
6835 ; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.)
6836 LB6F5 jsr LB267 ; make sure we have )
6837 ldu ,s ; get return address - we're going to mess with the stack
6838 ldx 5,s ; get address of string descriptor
6839 stx V4D ; save descriptor adddress
6840 lda 4,s ; get first numeric parameter in both A and B
6841 ldb 4,s
6842 leas 7,s ; clean up stack
6843 tfr u,pc ; return to original caller
6844 LB706 jmp LB44A ; raise FC error
6845 ; Evaluate an unsigned 8 bit expression to B
6846 LB709 jsr GETNCH ; move to next character
6847 EVALEXPB jsr LB141 ; evaluate a numeric expression
6848 LB70E jsr LB3E9 ; convert to integer in D
6849 tsta ; are we negative or > 255?
6850 bne LB706 ; brif so - FC error
6851 jmp GETCCH ; fetch current input character and return
6852 ; VAL function
6853 VAL jsr LB686 ; get string details
6854 lbeq LBA39 ; brif NULL string - return 0
6855 ldu CHARAD ; get input pointer so we can replace it later
6856 stx CHARAD ; point interpreter at string data
6857 abx ; calculate end address of the string
6858 lda ,x ; get byte after the end of the string
6859 pshs u,x,a ; save end of string address, input pointer, and character after end of string
6860 clr ,x ; put a NUL after the string (stops the number interpreter)
6861 jsr GETCCH ; get input character at start of string
6862 jsr LBD12 ; evaluate numeric expression in string
6863 puls a,x,u ; get back saved character and pointers
6864 sta ,x ; restore byte after string
6865 stu CHARAD ; restore interpeter's input pointer
6866 rts
6867 ; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B
6868 LB734 bsr LB73D ; evaluate expression
6869 stx BINVAL ; save result
6870 LB738 jsr SYNCOMMA ; make sure there's a comma
6871 bra EVALEXPB ; evaluate unsigned expression to B
6872 ; Evaluate unsigned expression in X
6873 LB73D jsr LB141 ; evaluate numeric expression
6874 LB740 lda FP0SGN ; is it negative?
6875 bmi LB706 ; brif so
6876 lda FP0EXP ; get exponent
6877 cmpa #0x90 ; largest possible exponent for 16 bits
6878 bhi LB706 ; brif too large
6879 jsr LBCC8 ; move binary point to right of FPA0
6880 ldx FPA0+2 ; get resulting unsigned value
6881 rts
6882 ; PEEK function
6883 PEEK bsr LB740 ; get address to X
6884 ldb ,x ; get the value at that address
6885 jmp LB4F3 ; return B as unsigned value
6886 ; POKE function
6887 POKE bsr LB734 ; evaluate address and byte value
6888 ldx BINVAL ; get address
6889 stb ,x ; put value there
6890 rts
6891 ; LLIST command
6892 LLIST ldb #-2 ; set output device to printer
6893 stb DEVNUM
6894 jsr GETCCH ; reset flags for input character and fall through to LIST
6895 ; LIST command
6896 LIST pshs cc ; save zero flag (end of statement)
6897 jsr LAF67 ; parse line number
6898 jsr LAD01 ; find address of that line
6899 stx LSTTXT ; save that address as the start of the list
6900 puls cc ; get back ent of statement flag
6901 beq LB784 ; brif end of line - list whole program
6902 jsr GETCCH ; are we at the end of the line (one number)?
6903 beq LB789 ; brif end of line
6904 cmpa #0xac ; is it "-"?
6905 bne LB783 ; brif not
6906 jsr GETNCH ; eat the "-"
6907 beq LB784 ; brif no second number - list to end of program
6908 jsr LAF67 ; evaluate the second number
6909 beq LB789 ; brif illegal number
6910 LB783 rts
6911 LB784 ldu #0xffff ; this will cause listing to do the entire program
6912 stu BINVAL
6913 LB789 leas 2,s ; don't return to the caller - we'll jump back to the main loop
6914 ldx LSTTXT ; get address of line to list
6915 LB78D jsr LB95C ; do a newline if needed
6916 jsr LA549 ; do a break check
6917 ldd ,x ; get address of next line
6918 bne LB79F ; brif not end of program
6919 LB797 jsr LA42D ; close output file
6920 clr DEVNUM ; reset device to screen
6921 jmp LAC73 ; go back to immediate mode
6922 LB79F stx LSTTXT ; save new line address
6923 ldd 2,x ; get line number of this line
6924 cmpd BINVAL ; is it above the end line?
6925 bhi LB797 ; brif so - return
6926 jsr LBDCC ; display line number
6927 jsr LB9AC ; put a space after it
6928 ldx LSTTXT ; get line address
6929 bsr LB7C2 ; detokenize the line
6930 ldx [LSTTXT] ; get pointer to next line
6931 ldu #LINBUF+1 ; point to start of detokenized line
6932 LB7B9 lda ,u+ ; get byte from detokenized line
6933 beq LB78D ; brif end of line
6934 jsr LB9B1 ; output character
6935 bra LB7B9 ; handle next character
6936 ; Detokenize a line from (X) to the line input buffer
6937 LB7C2 jsr RVEC24 ; do the RAM hook dance
6938 leax 4,x ; move past next line pointer and line number
6939 ldy #LINBUF+1 ; point to line input buffer (destination)
6940 LB7CB lda ,x+ ; get character from tokenized line
6941 beq LB820 ; brif end of input
6942 bmi LB7E6 ; brif it's a token
6943 cmpa #': ; colon?
6944 bne LB7E2 ; brif not
6945 ldb ,x ; get what's after the colon
6946 cmpb #0x84 ; ELSE?
6947 beq LB7CB ; brif so - suppress the colon
6948 cmpb #0x83 ; '?
6949 beq LB7CB ; brif so - suppress the colon
6950 skip2
6951 LB7E0 lda #'! ; placeholder for unknown token
6952 LB7E2 bsr LB814 ; stow output character
6953 bra LB7CB ; go process another input character
6954 LB7E6 ldu #COMVEC-10 ; point to command interptation table
6955 cmpa #0xff ; is it a function?
6956 bne LB7F1 ; brif not
6957 lda ,x+ ; get function token
6958 leau 5,u ; shift to the function half of the interpretation tables
6959 LB7F1 anda #0x7f ; remove token bias
6960 LB7F3 leau 10,u ; move to next command/function table
6961 tst ,u ; is this table active?
6962 beq LB7E0 ; brif not - use place holder
6963 LB7F9 suba ,u ; subtract number of tokens handled by this table entry
6964 bpl LB7F3 ; brif this token isn't handled here
6965 adda ,u ; undo extra subtraction
6966 ldu 1,u ; get reserved word list for this table
6967 LB801 deca ; are we at the right entry?
6968 bmi LB80A ; brif so
6969 LB804 tst ,u+ ; end of entry?
6970 bpl LB804 ; brif not
6971 bra LB801 ; see if we're there yet
6972 LB80A lda ,u ; get character from wordlist
6973 bsr LB814 ; put character in the buffer
6974 tst ,u+ ; end of word?
6975 bpl LB80A ; brif not
6976 bra LB7CB ; go handle another input character
6977 LB814 cmpy #LINBUF+LBUFMX ; is there room?
6978 bhs LB820 ; brif not
6979 anda #0x7f ; lose bit 7
6980 sta ,y+ ; save character in output
6981 clr ,y ; make sure there's always a NUL terminator
6982 LB820 rts
6983 ; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return
6984 ; length in D
6985 LB821 jsr RVEC23 ; do the RAM hook dance
6986 ldx CHARAD ; get input pointer
6987 ldu #LINBUF ; set destination pointer
6988 LB829 clr V43 ; clear alpha string flag
6989 clr V44 ; clear DATA flag
6990 LB82D lda ,x+ ; get input character
6991 beq LB852 ; brif end of input
6992 tst V43 ; are we handling an alphanumeric string?
6993 beq LB844 ; brif not
6994 jsr LB3A2 ; set carry if not alpha
6995 bcc LB852 ; brif alpha
6996 cmpa #'0 ; is it below the digits?
6997 blo LB842 ; brif so
6998 cmpa #'9 ; is it within the digits?
6999 bls LB852 ; brif so
7000 LB842 clr V43 ; flag that we're past the alphanumeric string
7001 LB844 cmpa #0x20 ; space?
7002 beq LB852 ; brif so - keep it
7003 sta V42 ; save scan delimiter
7004 cmpa #'" ; string delimiter?
7005 beq LB886 ; brif so - copy until another "
7006 tst V44 ; doing "DATA"?
7007 beq LB86B ; brif not
7008 LB852 sta ,u+ ; put character in output
7009 beq LB85C ; brif end of input
7010 cmpa #': ; colon?
7011 beq LB829 ; brif so - reset DATA and alpha string flags
7012 LB85A bra LB82D ; go process another input character
7013 LB85C clr ,u+ ; put a double NUL at the end
7014 clr ,u+
7015 tfr u,d ; calculate length of result (includes double NUL and an extra two bytes)
7016 subd #LINHDR
7017 ldx #LINBUF-1 ; point to one before the output
7018 stx CHARAD ; set input pointer there
7019 rts
7020 LB86B cmpa #'? ; print abbreviation?
7021 bne LB873 ; brif not
7022 lda #0x87 ; token for PRINT
7023 bra LB852 ; go stash it
7024 LB873 cmpa #'' ; REM abbreviation?
7025 bne LB88A ; brif not
7026 ldd #0x3a83 ; colon plus ' token
7027 std ,u++ ; put it in the output
7028 LB87C clr V42 ; set delimiter to NUL
7029 LB87E lda ,x+ ; get input
7030 beq LB852 ; brif end of line
7031 cmpa V42 ; at the delimiter?
7032 beq LB852 ; brif so
7033 LB886 sta ,u+ ; save in output
7034 bra LB87E ; keep scanning for delimiter
7035 LB88A cmpa #'0 ; is it below digits?
7036 blo LB892 ; brif so
7037 cmpa #';+1 ; is it digit, colon, or semicolon?
7038 blo LB852 ; brif so
7039 LB892 leax -1,x ; move input pointer back one (to point at this input character)
7040 pshs u,x ; save input and output pointers
7041 clr V41 ; set token type to 0 (command)
7042 ldu #COMVEC-10 ; point to command interpretation table
7043 LB89B clr V42 ; set token counter to 0 (0x80)
7044 LB89D leau 10,u ;
7045 lda ,u ; get number of reserved words
7046 beq LB8D4 ; brif this table isn't active
7047 ldy 1,u ; point to reserved words list
7048 LB8A6 ldx ,s ; get input pointer
7049 LB8A8 ldb ,y+ ; get character from reserved word table
7050 subb ,x+ ; compare with input character
7051 beq LB8A8 ; brif exact match
7052 cmpb #0x80 ; brif it was the last character in word and exact match
7053 bne LB8EA ; brif not
7054 leas 2,s ; remove original input pointer from stack
7055 puls u ; get back output pointer
7056 orb V42 ; create token value (B has 0x80 from above)
7057 lda V41 ; get token type
7058 bne LB8C2 ; brif function
7059 cmpb #0x84 ; is it ELSE?
7060 bne LB8C6 ; brif not
7061 lda #': ; silently add a colon before ELSE
7062 LB8C2 std ,u++ ; put two byte token into output
7063 bra LB85A ; go handle more input
7064 LB8C6 stb ,u+ ; save single byte token
7065 cmpb #0x86 ; DATA?
7066 bne LB8CE ; brif not
7067 inc V44 ; set DATA flag
7068 LB8CE cmpb #0x82 ; REM?
7069 beq LB87C ; brif so - skip over rest of line
7070 LB8D2 bra LB85A ; go handle more input
7071 LB8D4 ldu #COMVEC-5 ; point to interpretation table, function style
7072 LB8D7 com V41 ; invert token flag
7073 bne LB89B ; brif we haven't already done functions
7074 puls x,u ; restore input and output pointers
7075 lda ,x+ ; copy first character
7076 sta ,u+
7077 jsr LB3A2 ; set C if not alpha
7078 bcs LB8D2 ; brif not alpha - it isn't a variable
7079 com V43 ; set alphanumeric string flag
7080 bra LB8D2 ; process more input
7081 LB8EA inc V42 ; bump token number
7082 deca ; checked all in this table?
7083 beq LB89D ; brif so
7084 leay -1,y ; unconsume last compared character
7085 LB8F1 ldb ,y+ ; end of entry?
7086 bpl LB8F1 ; brif not
7087 bra LB8A6 ; check next reserved word
7088 ; PRINT command
7089 PRINT beq LB958 ; brif no argument - do a newline
7090 bsr LB8FE ; process print options
7091 clr DEVNUM ; reset output to screen
7092 rts
7093 LB8FE cmpa #'@ ; is it PRINT @?
7094 bne LB907 ; brif not
7095 LB902 jsr LA554 ; move cursor to correct location
7096 LB905 bra LB911 ; handle some more
7097 LB907 cmpa #'# ; device number specified?
7098 bne LB918 ; brif not
7099 jsr LA5A5 ; parse device number
7100 jsr LA406 ; check for valid output file
7101 LB911 jsr GETCCH ; get input character
7102 beq LB958 ; brif nothing - do newline
7103 jsr SYNCOMMA ; need comma after @ or #
7104 LB918 jsr RVEC9 ; do the RAM hook boogaloo
7105 LB91B beq LB965 ; brif end of input
7106 LB91D cmpa #0xa4 ; TAB(?
7107 beq LB97E ; brif so
7108 cmpa #', ; comma (next tab field)?
7109 beq LB966 ; brif so
7110 cmpa #'; ; semicolon (do not advance print position)
7111 beq LB997 ; brif so
7112 jsr LB156 ; evaluate expression
7113 lda VALTYP ; get type of value
7114 pshs a ; save it
7115 bne LB938 ; brif string
7116 jsr LBDD9 ; convert FP number to string
7117 jsr LB516 ; parse a string and put on string stack
7118 LB938 bsr LB99F ; print string
7119 puls b ; get back variable type
7120 jsr LA35F ; set up print parameters
7121 tst PRTDEV ; is it a display device?
7122 beq LB949 ; brif so
7123 bsr LB958 ; do a newline
7124 jsr GETCCH ; get input
7125 bra LB91B ; process more print stuff
7126 LB949 tstb ; set flags on print position
7127 bne LB954 ; brif not at start of line
7128 jsr GETCCH ; get current input
7129 cmpa #', ; comma?
7130 beq LB966 ; skip to next tab field if so
7131 bsr LB9AC ; send a space
7132 LB954 jsr GETCCH ; get input character
7133 bne LB91D ; brif not end of statement
7134 LB958 lda #0x0d ; carriage return
7135 bra LB9B1 ; send it to output
7136 LB95C jsr LA35F ; set up print parameters
7137 LB95F beq LB958 ; brif width is 0
7138 lda DEVPOS ; get line position
7139 bne LB958 ; brif not at start of line
7140 LB965 rts
7141 LB966 jsr LA35F ; set up print parameters
7142 beq LB975 ; brif line width is 0
7143 ldb DEVPOS ; get line position
7144 cmpb DEVLCF ; at or past last comma field?
7145 blo LB977 ; brif so
7146 bsr LB958 ; move to next line
7147 bra LB997 ; handle more stuff
7148 LB975 ldb DEVPOS ; get line position
7149 LB977 subb DEVCFW ; subtract a comma field width
7150 bhs LB977 ; brif we don't have a remainder yet
7151 negb ; now B is number of of spaces needed
7152 bra LB98E ; go advance
7153 LB97E jsr LB709 ; evaluate TAB distance
7154 cmpa #') ; closing )?
7155 lbne LB277 ; brif not
7156 jsr LA35F ; set up print parameters
7157 subb DEVPOS ; subtract print position from desired position
7158 bls LB997 ; brif we're already past it
7159 LB98E tst PRTDEV ; is it a display device?
7160 bne LB997 ; brif not
7161 LB992 bsr LB9AC ; output a space
7162 decb ; done enough?
7163 bne LB992 ; brif not
7164 LB997 jsr GETNCH ; get input character
7165 jmp LB91B ; process more items
7166 ; cpoy string from (X-1) to output
7167 STRINOUT jsr LB518 ; parse the string
7168 LB99F jsr LB657 ; get string details
7169 LB9A2 incb ; compensate for decb
7170 LB9A3 decb ; done all of the string?
7171 beq LB965 ; brif so
7172 lda ,x+ ; get character from string
7173 bsr LB9B1 ; send to output
7174 bra LB9A3 ; go do another character
7175 LB9AC lda #0x20 ; space character
7176 skip2
7177 LB9AF lda #'? ; question mark character
7178 LB9B1 jmp PUTCHR ; output character
7179 ; The floating point math package and related functions and operations follow from here
7180 ; to the end of the Color Basic ROM area
7181 LB9B4 ldx #LBEC0 ; point to FP constant 0.5
7182 bra LB9C2 ; add 0.5 to FPA0
7183 LB9B9 jsr LBB2F ; unpack FP data from (X) to FPA1
7184 ; subtraction operator
7185 LB9BC com FP0SGN ; invert sign of FPA0 (subtracting is adding the negative)
7186 com RESSGN ; that also inverts the sign differential
7187 bra LB9C5 ; go add the negative of FPA0 to FPA1
7188 LB9C2 jsr LBB2F ; unpack FP data from (X) to FPA1
7189 ; addition operator
7190 LB9C5 tstb ; check exponent of FPA0
7191 lbeq LBC4A ; copy FPA1 to FPA0 if FPA0 is 0
7192 ldx #FP1EXP ; point X to FPA1 (first operand) as the operand to denormalize
7193 LB9CD tfr a,b ; put exponent of FPA1 into B
7194 tstb ; is FPA1 0?
7195 beq LBA3E ; brif exponent is 0 - no-op; adding 0 to FPA0
7196 subb FP0EXP ; get difference in exponents - number of bits to shift the smaller mantissa
7197 beq LBA3F ; brif exponents are equal - no need to denormalize
7198 blo LB9E2 ; brif FPA0 > FPA1
7199 sta FP0EXP ; replace result exponent with FPA1's (FPA1 is bigger)
7200 lda FP1SGN ; also copy sign over
7201 sta FP0SGN
7202 ldx #FP0EXP ; point to FPA0 (we need to denormalize the smaller number)
7203 negb ; invert the difference - this is the number of bits to shift the mantissa
7204 LB9E2 cmpb #-8 ; do we have to shift by a whole byte?
7205 ble LBA3F ; brif so start by shifting whole bytes to the right
7206 clra ; clear overflow byte
7207 lsr 1,x ; shift high bit of mantissa right (LSR will force a zero into the high bit)
7208 jsr LBABA ; shift remainder of mantissa right -B times
7209 LB9EC ldb RESSGN ; get the sign flag
7210 bpl LB9FB ; brif signs are the same (we add the mantissas then)
7211 com 1,x ; complement the mantissa and extra precision bytes
7212 com 2,x
7213 com 3,x
7214 com 4,x
7215 coma
7216 adca #0 ; add one to A (COM sets C); this may cause a carry to enter the ADD below
7217 LB9FB sta FPSBYT ; save extra precision byte
7218 lda FPA0+3 ; add the main mantissa bytes (and propage carry from above)
7219 adca FPA1+3
7220 sta FPA0+3
7221 lda FPA0+2
7222 adca FPA1+2
7223 sta FPA0+2
7224 lda FPA0+1
7225 adca FPA1+1
7226 sta FPA0+1
7227 lda FPA0
7228 adca FPA1
7229 sta FPA0
7230 tstb ; were signs the same?
7231 bpl LBA5C ; brif so - number may have gotten bigger so normalize if needed
7232 LBA18 bcs LBA1C ; brif we had a carry - result is positive?)
7233 bsr LBA79 ; do a proper negation of FPA0 mantissa
7234 LBA1C clrb ; clear temporary exponent accumulator
7235 LBA1D lda FPA0 ; test high byte of mantissa
7236 bne LBA4F ; brif not 0 - we need to do bit shifting
7237 lda FPA0+1 ; shift left 8 bits
7238 sta FPA0
7239 lda FPA0+2
7240 sta FPA0+1
7241 lda FPA0+3
7242 sta FPA0+2
7243 lda FPSBYT
7244 sta FPA0+3
7245 clr FPSBYT
7246 addb #8 ; account for 8 bits shifted
7247 cmpb #5*8 ; shifted 5 bytes worth?
7248 blt LBA1D ; brif not
7249 LBA39 clra ; zero out exponent and sign - result is 0
7250 LBA3A sta FP0EXP ; set exponent and sign
7251 sta FP0SGN
7252 LBA3E rts
7253 LBA3F bsr LBAAE ; shift FPA0 mantissa to the right
7254 clrb ; clear carry
7255 bra LB9EC ; get on with adding
7256 LBA44 incb ; account for one bit shift
7257 asl FPSBYT ; shift mantissa and extra precision left
7258 rol FPA0+3
7259 rol FPA0+2
7260 rol FPA0+1
7261 rol FPA0
7262 LBA4F bpl LBA44 ; brif we haven't got a 1 in bit 7
7263 lda FP0EXP ; get exponent of result
7264 pshs b ; subtract shift count from exponent
7265 suba ,s+
7266 sta FP0EXP ; save adjusted exponent
7267 bls LBA39 ; brif we underflowed - set result to 0
7268 skip2
7269 LBA5C bcs LBA66 ; brif mantissa overflowed
7270 asl FPSBYT ; get bit 7 of expra precision to C (used for round off)
7271 lda #0 ; set to 0 without affecting C
7272 sta FPSBYT ; clear out extra precision bits
7273 bra LBA72 ; go round off result
7274 LBA66 inc FP0EXP ; bump exponent (for a right shift to bring carry in)
7275 beq LBA92 ; brif we overflowed
7276 ror FPA0 ; shift carry into mantissa, shift right
7277 ror FPA0+1
7278 ror FPA0+2
7279 ror FPA0+3
7280 LBA72 bcc LBA78 ; brif no round-off needed
7281 bsr LBA83 ; add one to mantissa
7282 beq LBA66 ; brif carry - need to shift right again
7283 LBA78 rts
7284 LBA79 com FP0SGN ; invert sign of value
7285 LBA7B com FPA0 ; first do a one's copmlement
7286 com FPA0+1
7287 com FPA0+2
7288 com FPA0+3
7289 LBA83 ldx FPA0+2 ; add one to mantissa (after one's complement gives two's complement)
7290 leax 1,x ; bump low word
7291 stx FPA0+2
7292 bne LBA91 ; brif no carry from low word
7293 ldx FPA0 ; bump high word
7294 leax 1,x
7295 stx FPA0
7296 LBA91 rts
7297 LBA92 ldb #2*5 ; code for overflow
7298 jmp LAC46 ; raise error
7299 LBA97 ldx #FPA2-1 ; point to FPA2
7300 LBA9A lda 4,x ; shift mantissa right by 8 bits
7301 sta FPSBYT
7302 lda 3,x
7303 sta 4,x
7304 lda 2,x
7305 sta 3,x
7306 lda 1,x
7307 sta 2,x
7308 lda FPCARY ; and handle extra precision on the left
7309 sta 1,x
7310 LBAAE addb #8 ; account for 8 bits shifted
7311 ble LBA9A ; brif more shifts needed
7312 lda FPSBYT ; get sub byte (extra precision)
7313 subb #8 ; undo the 8 added above
7314 beq LBAC4 ; brif difference is 0
7315 LBAB8 asr 1,x ; shift mantissa and sub byte one bit (keep mantissa high bit set)
7316 LBABA ror 2,x
7317 ror 3,x
7318 ror 4,x
7319 rora
7320 incb ; account for one shift
7321 bne LBAB8 ; brif not enought shifts yet
7322 LBAC4 rts
7323 LBAC5 fcb 0x81,0x00,0x00,0x00,0x00 ; packed FP 1.0
7324 LBACA bsr LBB2F ; unpack FP value from (X) to FPA1
7325 ; multiplication operator
7326 LBACC beq LBB2E ; brif exponent of FPA0 is 0 (result is 0)
7327 bsr LBB48 ; calculate exponent of product
7328 LBAD0 lda #0 ; zero out mantissa of FPA2
7329 sta FPA2
7330 sta FPA2+1
7331 sta FPA2+2
7332 sta FPA2+3
7333 ldb FPA0+3 ; multiply FPA1 by LSB of FPA0
7334 bsr LBB00
7335 ldb FPSBYT ; save extra precision byte
7336 stb VAE
7337 ldb FPA0+2
7338 bsr LBB00 ; again for next byte of FPA0
7339 ldb FPSBYT
7340 stb VAD
7341 ldb FPA0+1 ; again for next byte of FPA0
7342 bsr LBB00
7343 ldb FPSBYT
7344 stb VAC
7345 ldb FPA0 ; and finally for the high byte
7346 bsr LBB02
7347 ldb FPSBYT
7348 stb VAB
7349 jsr LBC0B ; copy mantissa from FPA2 to FPA0 (result)
7350 jmp LBA1C ; normalize
7351 LBB00 beq LBA97 ; brif multiplier is 0 - just shift, don't multiply
7352 LBB02 coma ; set carry
7353 LBB03 lda FPA2 ; get FPA2 MS byte
7354 rorb ; data bit to carry; will be 0 when all shifts done
7355 beq LBB2E ; brif 8 shifts done
7356 bcc LBB20 ; brif data bit is 0 - no addition
7357 lda FPA2+3 ; add mantissa of FPA1 and FPA2
7358 adda FPA1+3
7359 sta FPA2+3
7360 lda FPA2+2
7361 adca FPA1+2
7362 sta FPA2+2
7363 lda FPA2+1
7364 adca FPA1+1
7365 sta FPA2+1
7366 lda FPA2
7367 adca FPA1
7368 LBB20 rora ; shift carry into FPA2
7369 sta FPA2
7370 ror FPA2+1
7371 ror FPA2+2
7372 ror FPA2+3
7373 ror FPSBYT
7374 clra ; clear carry
7375 bra LBB03
7376 LBB2E rts
7377 ; Unpack FP value from (X) to FPA1
7378 LBB2F ldd 1,x ; copy mantissa (and sign)
7379 sta FP1SGN ; save sign bit
7380 ora #0x80 ; make sure mantissa has bit 7 set
7381 std FPA1
7382 ldb FP1SGN ; get sign
7383 eorb FP0SGN ; set if FPA0 sign differs
7384 stb RESSGN
7385 ldd 3,x ; copy remainder of mantissa
7386 std FPA1+2
7387 lda ,x ; and exponent
7388 sta FP1EXP
7389 ldb FP0EXP ; fetch FPA0 exponent and set flags
7390 rts
7391 ; Calculate eponent for product of FPA0 and FPA1
7392 LBB48 tsta ; is FPA1 zero?
7393 beq LBB61 ; brif so
7394 adda FP0EXP ; add to exponent of FPA0 (this is how scientific notation works)
7395 rora ; set V if we *don't* have an overflow
7396 rola
7397 bvc LBB61 ; brif exponent too larger or small
7398 adda #0x80 ; restore the bias
7399 sta FP0EXP ; set result exponent
7400 beq LBB63 ; brif 0 - clear FPA0
7401 lda RESSGN ; the result sign (negative if signs differ) is the result sign
7402 sta FP0SGN ; so set it as such
7403 rts
7404 LBB5C lda FP0SGN ; get sign of FPA0
7405 coma ; invert sign
7406 bra LBB63 ; zero sign and exponent
7407 LBB61 leas 2,s ; don't go back to caller (mul/div) - return to previous caller
7408 LBB63 lbpl LBA39 ; brif we underflowed - go zero things out
7409 LBB67 jmp LBA92 ; raise overflow error
7410 ; fast multiply by 10 - leave result in FPA0
7411 LBB6A jsr LBC5F ; copy FPA0 to FPA1 (for addition later)
7412 beq LBB7C ; brif exponent is 0 - it's a no-op then
7413 adda #2 ; this gives "times 4"
7414 bcs LBB67 ; raise overflow if required
7415 clr RESSGN ; set result sign to "signs the same"
7416 jsr LB9CD ; add FPA1 to FPA0 "times 5"
7417 inc FP0EXP ; times 10
7418 beq LBB67 ; brif overflow
7419 LBB7C rts
7420 LBB7D fcb 0x84,0x20,0x00,0x00,0x00 ; packed FP constant 10.0
7421 ; Divide by 10
7422 LBB82 jsr LBC5F ; move FPA0 to FPA1
7423 ldx #LBB7D ; point to constant 10
7424 clrb ; zero sign
7425 LBB89 stb RESSGN ; result will be positive or zero
7426 jsr LBC14 ; unpack constant 10 to FPA0
7427 skip2 ; fall through to division (divide FPA1 by 10)
7428 LBB8F bsr LBB2F ; unpack FP number from (X) to FPA1
7429 ; division operator
7430 LBB91 beq LBC06 ; brif FPA0 is 0 - division by zero
7431 neg FP0EXP ; get exponent of reciprocal of the divisor
7432 bsr LBB48 ; calculate exponent of quotient
7433 inc FP0EXP ; bump exponent (due to division algorithm below)
7434 beq LBB67 ; brif overflow
7435 ldx #FPA2 ; point to temporary storage location
7436 ldb #4 ; do 5 bytes
7437 stb TMPLOC ; save counter
7438 ldb #1 ; shift counter and quotient byte
7439 LBBA4 lda FPA0 ; compare mantissa of FPA0 to FPA1, set C if FPA1 less
7440 cmpa FPA1
7441 bne LBBBD
7442 lda FPA0+1
7443 cmpa FPA1+1
7444 bne LBBBD
7445 lda FPA0+2
7446 cmpa FPA1+2
7447 bne LBBBD
7448 lda FPA0+3
7449 cmpa FPA1+3
7450 bne LBBBD
7451 coma ; set C if FPA0 = FPA1 (it "goes")
7452 LBBBD tfr cc,a ; save "it goes" status
7453 rolb ; rotate carry into quotient
7454 bcc LBBCC ; brif carry clear - haven't done 8 shifts yet
7455 stb ,x+ ; save quotient byte
7456 dec TMPLOC ; done enough bytes?
7457 bmi LBBFC ; brif done all 5
7458 beq LBBF8 ; brif last byte
7459 ldb #1 ; reset shift counter and quotient byte
7460 LBBCC tfr a,cc ; get back carry status
7461 bcs LBBDE ; brif it "went"
7462 LBBD0 asl FPA1+3 ; shift mantissa (dividend) left
7463 rol FPA1+2
7464 rol FPA1+1
7465 rol FPA1
7466 bcs LBBBD ; brif carry - it "goes" so we have to bump quotient
7467 bmi LBBA4 ; brif high order bit is set - compare mantissas
7468 bra LBBBD ; otherwise, count a 0 bit and try next bit
7469 LBBDE lda FPA1+3 ; subtract mantissa of FPA0 from mantissa of FPA1
7470 suba FPA0+3
7471 sta FPA1+3
7472 lda FPA1+2
7473 sbca FPA0+2
7474 sta FPA1+2
7475 lda FPA1+1
7476 sbca FPA0+1
7477 sta FPA1+1
7478 lda FPA1
7479 sbca FPA0
7480 sta FPA1
7481 bra LBBD0 ; go check for another go
7482 LBBF8 ldb #0x40 ; only two bits in last byte (for rounding)
7483 bra LBBCC ; go do the last byte
7484 LBBFC rorb ; get low bits to bits 7,6 and C to bit 5
7485 rorb
7486 rorb
7487 stb FPSBYT ; save result extra precision
7488 bsr LBC0B ; move FPA2 mantissa to FPA0 (result)
7489 jmp LBA1C ; go normalize the result
7490 LBC06 ldb #2*10 ; division by zero
7491 jmp LAC46 ; raise error
7492 ; Copy mantissa of FPA2 to FPA0
7493 LBC0B ldx FPA2 ; copy high word
7494 stx FPA0
7495 ldx FPA2+2 ; copy low word
7496 stx FPA0+2
7497 rts
7498 ; unpack FP number at (X) to FPA0
7499 LBC14 pshs a ; save register
7500 ldd 1,x ; get mantissa high word and sign
7501 sta FP0SGN ; set sign
7502 ora #0x80 ; make sure mantissa always has bit 7 set
7503 std FPA0
7504 clr FPSBYT ; clear extra precision
7505 ldb ,x ; get exponent
7506 ldx 3,x ; copy mantissa low word
7507 stx FPA0+2
7508 stb FP0EXP ; save exponent (and set flags)
7509 puls a,pc ; restore register and return
7510 LBC2A ldx #V45 ; point to FPA4
7511 bra LBC35 ; pack FPA0 there
7512 LBC2F ldx #V40 ; point to FPA3
7513 skip2 ; fall through to pack FPA0 there
7514 LBC33 ldx VARDES ; get variable descriptor pointer
7515 ; Pack FPA0 to (X)
7516 LBC35 lda FP0EXP ; get exponent
7517 sta ,x ; save it
7518 lda FP0SGN ; get sign
7519 ora #0x7f ; force set low bits - only keep sign in high bit
7520 anda FPA0 ; merge in bits 6-0 of high byte of mantissa
7521 sta 1,x ; save it
7522 lda FPA0+1 ; copy next highest byte
7523 sta 2,x
7524 ldu FPA0+2 ; and the low word of the mantissa
7525 stu 3,x
7526 rts
7527 ; Copy FPA1 to FPA0; return with sign in A
7528 LBC4A lda FP1SGN ; copy sign
7529 LBC4C sta FP0SGN
7530 ldx FP1EXP ; copy exponent, mantissa high byte
7531 stx FP0EXP
7532 clr FPSBYT ; clear extra precision
7533 lda FPA1+1 ; copy mantissa second highest byte
7534 sta FPA0+1
7535 lda FP0SGN ; set sign for return
7536 ldx FPA1+2 ; copy low word of mantissa
7537 stx FPA0+2
7538 rts
7539 ; Copy FPA0 to FPA1
7540 LBC5F ldd FP0EXP ; copy exponent and high byte of mantissa
7541 std FP1EXP
7542 ldx FPA0+1 ; copy middle bytes of mantissa
7543 stx FPA1+1
7544 ldx FPA0+3 ; copy low byte of mantissa and sign
7545 stx FPA1+3
7546 tsta ; set flags on exponent
7547 rts
7548 ; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive
7549 LBC6D ldb FP0EXP ; get exponent
7550 beq LBC79 ; brif 0
7551 LBC71 ldb FP0SGN ; get sign
7552 LBC73 rolb ; get sign to C
7553 ldb #0xff ; set for negative result
7554 bcs LBC79 ; brif negative
7555 negb ; set to 1 for positive
7556 LBC79 rts
7557 ; SGN function
7558 SGN bsr LBC6D ; get sign of FPA0
7559 LBC7C stb FPA0 ; save result
7560 clr FPA0+1 ; clear next lower 8 bits
7561 ldb #0x88 ; exponent if mantissa is 8 bit integer
7562 LBC82 lda FPA0 ; get high bits of mantissa
7563 suba #0x80 ; set C if mantissa was positive (will cause a negation if it was negative)
7564 LBC86 stb FP0EXP ; set exponent
7565 ldd ZERO ; clear out low word
7566 std FPA0+2
7567 sta FPSBYT ; clear extra precision
7568 sta FP0SGN ; set sign to positive
7569 jmp LBA18 ; normalize the result
7570 ; ABS function
7571 ABS clr FP0SGN ; force FPA0 to be positive (yes, it's that simple)
7572 rts
7573 ; Compare packed FP number at (X) to FPA0
7574 ; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that
7575 LBC96 ldb ,x ; get exponent of (X)
7576 beq LBC6D ; brif (X) is 0
7577 ldb 1,x ; get MS byte of mantissa of (X)
7578 eorb FP0SGN ; set bit 7 if signs of (X) and FPA0 differ
7579 bmi LBC71 ; brif signs differ - no need to compare the magnitude
7580 LBCA0 ldb FP0EXP ; compare exponents and brif different
7581 cmpb ,x
7582 bne LBCC3
7583 ldb 1,x ; compare mantissa (but we have to pack the FPA0 bits first
7584 orb #0x7f ; keep only sign bit (note: signs are the same)
7585 andb FPA0 ; merge in the mantissa bits from FPA0
7586 cmpb 1,x ; do the packed versions match?
7587 bne LBCC3 ; brif not
7588 ldb FPA0+1 ; compare second byte of mantissas
7589 cmpb 2,x
7590 bne LBCC3
7591 ldb FPA0+2 ; compare third byte of mantissas
7592 cmpb 3,x
7593 bne LBCC3
7594 ldb FPA0+3 ; compare low byte of mantissas, but use subtraction so B = 0 on match
7595 subb 4,x
7596 bne LBCC3
7597 rts ; return B = 0 if (X) = FPA0
7598 LBCC3 rorb ; shift carry to bit 7 (C set if FPA0 < (X))
7599 eorb FP0SGN ; invert the comparision sense if the signs are negative
7600 bra LBC73 ; interpret comparison result
7601 ; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the
7602 ; result as a two's complement value.
7603 LBCC8 ldb FP0EXP ; get exponent of FPA0
7604 beq LBD09 ; brif FPA0 is zero - we don't have to do anything, just blank it
7605 subb #0xa0 ; calculate number of shifts to get to the correct exponent (binary point to the right)
7606 lda FP0SGN ; do we have a positive number?
7607 bpl LBCD7 ; brif so
7608 com FPCARY ; negate the mantissa and set extra inbound precision to the correct sign
7609 jsr LBA7B
7610 LBCD7 ldx #FP0EXP ; point to FPA0
7611 cmpb #-8 ; moving by whole bytes?
7612 bgt LBCE4 ; brif not
7613 jsr LBAAE ; do bit shifting
7614 clr FPCARY ; clear carry in byte
7615 rts
7616 LBCE4 clr FPCARY ; clear the extra carry in precision
7617 lda FP0SGN ; get sign of value
7618 rola ; get sign to carry (so rotate repeats the sign)
7619 ror FPA0 ; shift the first bit
7620 jmp LBABA ; do the shifting dance
7621 ; INT function
7622 INT ldb FP0EXP ; get exponent
7623 cmpb #0xa0 ; is the number big enough that there can be no fractional part?
7624 bhs LBD11 ; brif so - we don't have to do anything
7625 bsr LBCC8 ; go shift binary point to the right of the mantissa
7626 stb FPSBYT ; save extra precision bits
7627 lda FP0SGN ; get original sign
7628 stb FP0SGN ; force result to be positive
7629 suba #0x80 ; set C if we had a positive result
7630 lda #0xa0 ; set exponent to match denormalized result
7631 sta FP0EXP
7632 lda FPA0+3 ; save low byte
7633 sta CHARAC
7634 jmp LBA18 ; go normalize (this will correct for the two's complement representation of negatives)
7635 LBD09 stb FPA0 ; replace mantissa of FPA0 with contents of B
7636 stb FPA0+1
7637 stb FPA0+2
7638 stb FPA0+3
7639 LBD11 rts
7640 ; Convert ASCII string to FP
7641 ; BUG: no overflow is checked on the decimal exponent in exponential notation.
7642 LBD12 ldx ZERO ; zero out FPA0 and temporaries
7643 stx FP0SGN
7644 stx FP0EXP
7645 stx FPA0+1
7646 stx FPA0+2
7647 stx V47
7648 stx V45
7649 bcs LBD86 ; brif input character is numeric
7650 jsr RVEC19 ; do the RAM hook dance
7651 cmpa #'- ; regular negative sign
7652 bne LBD2D ; brif not
7653 com COEFCT ; invert sign
7654 bra LBD31 ; process stuff after the sign
7655 LBD2D cmpa #'+ ; regular plus?
7656 bne LBD35 ; brif not
7657 LBD31 jsr GETNCH ; get character after sign
7658 bcs LBD86 ; brif numeric
7659 LBD35 cmpa #'. ; decimal point?
7660 beq LBD61 ; brif so
7661 cmpa #'E ; scientific notation
7662 bne LBD65 ; brif not
7663 jsr GETNCH ; eat the "E"
7664 bcs LBDA5 ; brif numeric
7665 cmpa #0xac ; negative sign (token)?
7666 beq LBD53 ; brif so
7667 cmpa #'- ; regular negative?
7668 beq LBD53 ; brif so
7669 cmpa #0xab ; plus sign (token)?
7670 beq LBD55 ; brif so
7671 cmpa #'+ ; regular plus?
7672 beq LBD55
7673 bra LBD59 ; brif no sign found
7674 LBD53 com V48 ; set exponent sign to negative
7675 LBD55 jsr GETNCH ; eat the sign
7676 bcs LBDA5 ; brif numeric
7677 LBD59 tst V48 ; is the exponent sign negatvie?
7678 beq LBD65 ; brif not
7679 neg V47 ; negate base 10 exponent
7680 bra LBD65
7681 LBD61 com V46 ; toggle decimal point flag
7682 bne LBD31 ; brif we haven't seen two decimal points
7683 LBD65 lda V47 ; get base 10 exponent
7684 suba V45 ; subtract number of places to the right
7685 sta V47 ; we now have a complete decimal exponent
7686 beq LBD7F ; brif we have no base 10 shifting required
7687 bpl LBD78 ; brif positive exponent
7688 LBD6F jsr LBB82 ; divide FPA0 by 10 (shift decimal point left)
7689 inc V47 ; bump exponent
7690 bne LBD6F ; brif we haven't reached 0 yet
7691 bra LBD7F ; return result
7692 LBD78 jsr LBB6A ; multiply by 10
7693 dec V47 ; downshift the exponent
7694 bne LBD78 ; brif not at 0 yet
7695 LBD7F lda COEFCT ; get desired sign
7696 bpl LBD11 ; brif it will be positive - no need to do anything
7697 jmp LBEE9 ; flip the sign of FPA0
7698 LBD86 ldb V45 ; get the decimal count
7699 subb V46 ; (if decimal seen, will add one; otherwise it does nothing)
7700 stb V45
7701 pshs a ; save new digit
7702 jsr LBB6A ; multiply partial result by 10
7703 puls b ; get back digit
7704 subb #'0 ; remove ASCII bias
7705 bsr LBD99 ; add B to FPA0
7706 bra LBD31 ; go process another digit
7707 LBD99 jsr LBC2F ; save FPA0 to FPA3
7708 jsr LBC7C ; convert B to FP number
7709 ldx #V40 ; point to FPA3
7710 jmp LB9C2 ; add FPA3 and FPA0
7711 LBDA5 ldb V47 ; get exponent value
7712 aslb ; times 2
7713 aslb ; times 4
7714 addb V47 ; times 5
7715 aslb ; times 10
7716 suba #'0 ; remove ASCII bias
7717 pshs b ; save acculated result
7718 adda ,s+ ; add new digit to accumulated result
7719 sta V47 ; save new accumulated decimal exponent
7720 bra LBD55 ; interpret another exponent character
7721 LBDB6 fcb 0x9b,0x3e,0xbc,0x1f,0xfd ; packed FP: 99999999.9
7722 LBDBB fcb 0x9e,0x6e,0x6b,0x27,0xfd ; packed FP: 999999999
7723 LBDC0 fcb 0x9e,0x6e,0x6b,0x28,0x00 ; pakced FP: 1E9
7724 LBDC5 ldx #LABE8-1 ; point to "IN" message
7725 bsr LBDD6 ; output the string
7726 ldd CURLIN ; get basic line number
7727 LBDCC std FPA0 ; save 16 bit unsigned integer
7728 ldb #0x90 ; exponent for upper 16 bits of FPA0 to be an integer
7729 coma ; set C (force normalization to treat as positive)
7730 jsr LBC86 ; zero bottom half, save exponent, and normalize
7731 bsr LBDD9 ; convert FP number to ASCII string
7732 LBDD6 jmp STRINOUT ; output string
7733 ; Convert FP number to ASCII string
7734 LBDD9 ldu #STRBUF+3 ; point to buffer address that will not cause string to go to string space
7735 LBDDC lda #0x20 ; default sign is a space character
7736 ldb FP0SGN ; get sign of value
7737 bpl LBDE4 ; brif positive
7738 lda #'- ; use negative sign
7739 LBDE4 sta ,u+ ; save sign
7740 stu COEFPT ; save output buffer pointer
7741 sta FP0SGN ; save sign character
7742 lda #'0 ; result is 0 if exponent is 0
7743 ldb FP0EXP ; get exponent
7744 lbeq LBEB8 ; brif FPA0 is 0
7745 clra ; base 10 exponent is 0 for > 1
7746 cmpb #0x80 ; is number > 1?
7747 bhi LBDFF ; brif so
7748 ldx #LBDC0 ; point to 1E+09
7749 jsr LBACA ; shift decimal to the right by 9 spaces
7750 lda #-9 ; account for shift
7751 LBDFF sta V45 ; save base 10 exponent
7752 LBE01 ldx #LBDBB ; point to 999999999
7753 jsr LBCA0 ; are we above that?
7754 bgt LBE18 ; brif so
7755 LBE09 ldx #LBDB6 ; point to 99999999.9
7756 jsr LBCA0 ; are we above that?
7757 bgt LBE1F ; brif in range
7758 jsr LBB6A ; multiply by 10 (we were small)
7759 dec V45 ; account for shift
7760 bra LBE09 ; see if we've come into range
7761 LBE18 jsr LBB82 ; divide by 10
7762 inc V45 ; account for shift
7763 bra LBE01 ; see if we've come into range
7764 LBE1F jsr LB9B4 ; add 0.5 to FPA0 (rounding)
7765 jsr LBCC8 ; do the integer dance
7766 ldb #1 ; default decimal flag (force immediate decimal)
7767 lda V45 ; get base 10 exponent
7768 adda #10 ; account for "unormalized" number
7769 bmi LBE36 ; brif number < 1.0
7770 cmpa #11 ; do we have more than 9 places?
7771 bhs LBE36 ; brif so - do scientific notation
7772 deca
7773 tfr a,b
7774 lda #2 ; force no scientific notation
7775 LBE36 deca ; subtract wo without affecting carry
7776 deca
7777 sta V47 ; save exponent - 0 is do not display in scientific notation
7778 stb V45 ; save number of places to left of decimal
7779 bgt LBE4B ; brif >= 1
7780 ldu COEFPT ; point to string buffer
7781 lda #'. ; put decimal
7782 sta ,u+
7783 tstb ; is there anything to left of decimal?
7784 beq LBE4B ; brif not
7785 lda #'0 ; store a zero
7786 sta ,u+
7787 LBE4B ldx #LBEC5 ; point to powers of 10
7788 ldb #0x80 ; set digit counter to 0x80
7789 LBE50 lda FPA0+3 ; add mantissa to power of 10
7790 adda 3,x
7791 sta FPA0+3
7792 lda FPA0+2
7793 adca 2,x
7794 sta FPA0+2
7795 lda FPA0+1
7796 adca 1,x
7797 sta FPA0+1
7798 lda FPA0
7799 adca ,x
7800 sta FPA0
7801 incb ; add one to digit counter
7802 rorb ; put carry into bit 7
7803 rolb ; set V if carry and sign differ
7804 bvc LBE50 ; brif positive mantissa or carry is 0 and negative mantissa
7805 bcc LBE72 ; brif negative mantissa
7806 subb #10+1 ; take 9's complement if adding mantissa
7807 negb
7808 LBE72 addb #'0-1 ; add ASCII bias
7809 leax 4,x ; move to next power of 10
7810 tfr b,a ; save digit
7811 anda #0x7f ; remove add/subtract flag
7812 sta ,u+ ; put in output
7813 dec V45 ; do we need a decimal yet?
7814 bne LBE84 ; brif not
7815 lda #'. ; put decimal
7816 sta ,u+
7817 LBE84 comb ; toggle bit 7 (add/sub flag)
7818 andb #0x80 ; only keep bit 7
7819 cmpx #LBEC5+9*4 ; done all places?
7820 bne LBE50 ; brif not
7821 LBE8C lda ,-u ; get last character
7822 cmpa #'0 ; was it 0?
7823 beq LBE8C ; brif so
7824 cmpa #'. ; decimal?
7825 bne LBE98 ; brif not
7826 leau -1,u ; move past decimal if it isn't needed
7827 LBE98 lda #'+ ; plus sign
7828 ldb V47 ; get scientific notation exponent
7829 beq LBEBA ; brif not scientific notation
7830 bpl LBEA3 ; brif positive exponent
7831 lda #'- ; negative sign for base 10 exponent
7832 negb ; switch to positive exponent
7833 LBEA3 sta 2,u ; put sign
7834 lda #'E ; put "E"
7835 sta 1,u
7836 lda #'0-1 ; init to ASCII 0 (compensate for INC)
7837 LBEAB inca ; bump digit
7838 subb #10 ; have we hit the correct one yet?
7839 bcc LBEAB ; brif not
7840 addb #'9+1 ; convert units digit to ASCII
7841 std 3,u ; put exponent in output
7842 clr 5,u ; put trailing NUL
7843 bra LBEBC ; go reset pointer
7844 LBEB8 sta ,u ; store last character
7845 LBEBA clr 1,u ; put NUL at the end
7846 LBEBC ldx #STRBUF+3 ; point to start of string
7847 rts
7848 LBEC0 fcb 0x80,0x00,0x00,0x00,0x00 ; packed FP 0.5
7849 LBEC5 fqb -100000000
7850 fqb 10000000
7851 fqb -1000000
7852 fqb 100000
7853 fqb -10000
7854 fqb 1000
7855 fqb -100
7856 fqb 10
7857 fqb -1
7858 LBEE9 lda FP0EXP ; get exponent of FPA0
7859 beq LBEEF ; brif 0 - don't flip sign
7860 com FP0SGN ; flip sign
7861 LBEEF rts
7862 ; Expand a polynomial of the form
7863 ; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table
7864 LBEF0 stx COEFPT ; save coefficient table pointer
7865 jsr LBC2F ; copy FPA0 to FPA3
7866 bsr LBEFC ; multiply FPA3 by FPA0
7867 bsr LBF01 ; expand polynomial
7868 ldx #V40 ; point to FPA3
7869 LBEFC jmp LBACA ; multiply FPA0 by FPA3
7870 LBEFF stx COEFPT ; save coefficient table counter
7871 LBF01 jsr LBC2A ; move FPA0 to FPA4
7872 ldx COEFPT ; get the current coefficient
7873 ldb ,x+ ; get the number of entries
7874 stb COEFCT ; save as counter
7875 stx COEFPT ; save new pointer
7876 LBF0C bsr LBEFC ; multiply (X) and FPA0
7877 ldx COEFPT ; get this coefficient
7878 leax 5,x ; move to next one
7879 stx COEFPT ; save new pointer
7880 jsr LB9C2 ; add (X) to FPA0
7881 ldx #V45 ; point X to FPA4
7882 dec COEFCT ; done all coefficients?
7883 bne LBF0C ; brif more left
7884 rts
7885 ; RND function
7886 RND jsr LBC6D ; set flags on FPA0
7887 bmi LBF45 ; brif negative - set seed
7888 beq LBF3B ; brif 0 - do random between 0 and 1
7889 bsr LBF38 ; convert to integer
7890 jsr LBC2F ; save range value
7891 bsr LBF3B ; get random number
7892 ldx #V40 ; point to FPA3
7893 bsr LBEFC ; multply (X) by FPA0
7894 ldx #LBAC5 ; point to FP 1.0
7895 jsr LB9C2 ; add 1 to FPA0
7896 LBF38 jmp INT ; return integer value
7897 LBF3B ldx RVSEED+1 ; move variable random number seed to FPA0
7898 stx FPA0
7899 ldx RVSEED+3
7900 stx FPA0+2
7901 LBF45 ldx RSEED ; move fixed seed to FPA1
7902 stx FPA1
7903 ldx RSEED+2
7904 stx FPA1+2
7905 jsr LBAD0 ; multiply them
7906 ldd VAD ; get lowest order product bytes
7907 addd #0x658b ; add a constant
7908 std RVSEED+3 ; save it as new seed
7909 std FPA0+2 ; save in result
7910 ldd VAB ; get high order extra product bytes
7911 adcb #0xb0 ; add upper bytes of constant
7912 adca #5
7913 std RVSEED+1 ; save as new seed
7914 std FPA0 ; save as result
7915 clr FP0SGN ; set result to positive
7916 lda #0x80 ; set exponent to 0 < FPA0 < 1
7917 sta FP0EXP
7918 lda FPA2+2 ; get a byte from FPA2
7919 sta FPSBYT ; save as extra precision
7920 jmp LBA1C ; go normalize FPA0
7921 RSEED fqb 0x40e64dab ; constant random number generator seed
7922 ; SIN function
7923 SIN jsr LBC5F ; copy FPA0 to FPA1
7924 ldx #LBFBD ; point to 2*pi
7925 ldb FP1SGN ; get sign of FPA1
7926 jsr LBB89 ; divide FPA0 by 2*pi
7927 jsr LBC5F ; copy FPA0 to FPA1
7928 bsr LBF38 ; convert FPA0 to an integer
7929 clr RESSGN ; set result to positive
7930 lda FP1EXP ; get exponent of FPA1
7931 ldb FP0EXP ; get exponent of FPA0
7932 jsr LB9BC ; subtract FPA0 from FPA1
7933 ldx #LBFC2 ; point to FP 0.25
7934 jsr LB9B9 ; subtract FPA0 from 0.25 (pi/2)
7935 lda FP0SGN ; get result sign
7936 pshs a ; save it
7937 bpl LBFA6 ; brif positive
7938 jsr LB9B4 ; add 0.5 (pi) to FPA0
7939 lda FP0SGN ; get sign of result
7940 bmi LBFA9 ; brif negative
7941 com RELFLG ; if 3pi/2 >= arg >= pi/2
7942 LBFA6 jsr LBEE9 ; flip sign of FPA0
7943 LBFA9 ldx #LBFC2 ; point to 0.25
7944 jsr LB9C2 ; add 0.25 (pi/2) to FPA0
7945 puls a ; get original sign
7946 tsta ; was it positive
7947 bpl LBFB7 ; brif so
7948 jsr LBEE9 ; flip result sign
7949 LBFB7 ldx #LBFC7 ; point to series coefficients
7950 jmp LBEF0 ; go calculate value
7951 LBFBD fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi
7952 LBFC2 fcb 0x7f,0x00,0x00,0x00,0x00 ; 0.25
7953 ; modified taylor series SIN coefficients
7954 LBFC7 fcb 6-1 ; six coefficients
7955 fcb 0x84,0xe6,0x1a,0x2d,0x1b ; -((2pi)^11)/11!
7956 fcb 0x86,0x28,0x07,0xfb,0xf8 ; ((2pi)^9)/9!
7957 fcb 0x87,0x99,0x68,0x89,0x01 ; -((2pi)^7)/7!
7958 fcb 0x87,0x23,0x35,0xdf,0xe1 ; ((2pi)^5)/5!
7959 fcb 0x86,0xa5,0x5d,0xe7,0x28 ; -(2pi)^3)/3!
7960 fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi
7961 ; these 12 bytes are unused
7962 fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43
7963 fcb 0x89,0xcd,0xa6,0x81
7964 ; these are a copy of the interrupt vectors that live at the top of the ROM. It's not clear
7965 ; why these vectors have been modified since they are not actually used.
7966 fdb INT.SWI3 ; SWI3
7967 fdb INT.SWI2 ; SWI2
7968 fdb INT.FIRQ ; FIRQ
7969 fdb INT.IRQ ; IRQ
7970 fdb INT.SWI ; SWI
7971 fdb INT.NMI ; NMI
7972 fdb L8C1B ; RESET
7973 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7974 ; Coco3 internal ROM, upper 32K
7975 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7976 ; This is the initialization code specific to the Coco3. This handles copying the ROMs to RAM and adding various patches in.
7977 ; This sequence of code demonstrates clearly that the creators of the Coco3 additions were rushed and didn't have a clear
7978 ; understanding of the Coco3 hardware or how Color Basic works. There is evidence of last minute adjustments along with code
7979 ; that serves no purpose but which is still present.
7980 ;
7981 ; There is also a major bug. The F1 for burst phase invert enable is clearly supposed to be enabled for the HSCREEN graphics
7982 ; modes. However, the code that enables it actually patches the wrong byte in the graphics mode initializers. Instead of enabling
7983 ; the burst phase invert bit in FF98, it actually enables the FIRQ enable bit in FF90.
7984 SC000 orcc #0x50 ; make sure interrupts are disabled
7985 lds #0x5eff ; put the stack somewhere
7986 lda #0x12 ; nuclear green colour
7987 ldb #16 ; 16 palette registers
7988 ldx #PALETREG ; point to palette registers
7989 SC00D sta ,x+ ; set a palette register to green
7990 decb ; done?
7991 bne SC00D ; brif not
7992 ldx #MMUREG ; point to MMU registers
7993 leay MMUIMAGE,pcr ; point to MMU initializer
7994 ldb #16 ; there are 16 MMU registers
7995 SC01B lda ,y+ ; copy an MMU initializer
7996 sta ,x+
7997 decb ; done all?
7998 bne SC01B ; brif not
7999 lda #COCO+MMUEN+MC3+MC2+MC1 ; enable coco compatible, mmu, SCS, FExx, and 32K internal
8000 sta INIT0
8001 leax BEGMOVE,pcr ; point to start of relocated initialization code
8002 ldy #0x4000 ; point to RAM address where it goes
8003 SC02F ldd ,x++ ; copy four bytes
8004 ldu ,x++
8005 std ,y++
8006 stu ,y++
8007 cmpx #ENDMOVE ; copied everything?
8008 blo SC02F ; brif not
8009 jmp 0x4000 ; transfer control to code in RAM
8010 ; The rest runs from RAM. This allows it to mess with the ROM mapping (for the ROM/RAM copy). Unfortunately,
8011 ; this clobbers an 8K memory block *before* it determines that it isn't going to copy ROM to RAM which is
8012 ; somewhat problematic for things that intercept a warm start.
8013 BEGMOVE leas -1,s ; make a hole on the stack
8014 nop ; space fillers; probably something removed at the eleventh hour
8015 nop
8016 nop
8017 nop
8018 nop
8019 lda #0xff ; set GIME timer to maximum value and start it counting
8020 sta V.TIMER
8021 sta V.TIMER+1
8022 leax VIDIMAGE,pcr ; point to video mode initializer
8023 ldy #VIDEOMOD ; point to video mode registers
8024 SC056 lda ,x+ ; copy a byte
8025 sta ,y+
8026 cmpy #MMUREG ; done?
8027 bne SC056 ; brif not
8028 ldx #PIA1 ; point to PIA1
8029 ldd #0xff34 ; set up for initializing PIAs
8030 clr 1,x ; set PIA1 DA to direction mode
8031 clr 3,x ; set PIA1 DB to direction mode
8032 deca
8033 sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input
8034 lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input
8035 sta 2,x
8036 stb 1,x ; set PIA1 DA to data mode
8037 stb 3,x ; set PIA1 DB to data mode
8038 clr 2,x ; set VDG to alpha-numeric
8039 lda #2 ; set RS232 to marking
8040 sta ,x
8041 lda #0xff
8042 ldx #PIA0 ; point to PIA0
8043 clr 1,x ; set PIA0 DA to direction mode
8044 clr 3,x ; set PIA0 DB to direction mode
8045 clr ,x ; set PIA0 DA to input
8046 sta 2,x ; set PIA0 DB to output
8047 stb 1,x ; set PIA0 DA to direction mode
8048 stb 3,x ; set PIA0 DB to direction mode
8049 ldb #12 ; there are 12 SAM bits to reset
8050 ldu #SAMREG ; point to SAM register
8051 SC091 sta ,u++ ; clear a bit
8052 decb ; done all?
8053 bne SC091 ; brif not
8054 sta SAMREG+9 ; put VDG display at 0x400
8055 tfr b,dp ; set direct page to 0
8056 clr 2,x ; strobe all keyboard columns (pointless)
8057 sta -3,u ; select RAM page 1 (also pointless)
8058 ldx #PIA0 ; point to PIA0 (unneeded - already points there)
8059 ldb #0xdf ; column strobe for F1
8060 stb 2,x ; strobe for F1
8061 lda ,x ; get row data
8062 coma ; set nonzero if F1 down
8063 anda #0x40
8064 sta ,s ; save F1 state for later
8065 ldy #2 ; check for two keys
8066 SC0B1 asrb ; shift strobe (why not just shift directly in the PIA?)
8067 stb 2,x ; strobe new column
8068 lda ,x ; get row data
8069 coma ; set nonzero if CTRL or ALT is down
8070 anda #0x40
8071 beq SC0C2 ; brif not - we don't have C-A-RESET
8072 leay -1,y ; done both?
8073 bne SC0B1 ; brif not
8074 lbra SC1F0 ; go do easter egg picture if C-A-RESET
8075 SC0C2 lda #COCO+MMUEN+MC3+MC1 ; turn off standard SCS (why?)
8076 sta INIT0
8077 ; This checks if we have a valid warm start routine. If there is one, we don't do a ROM/RAM copy. This and
8078 ; everything above could just as easily have been done from ROM.
8079 lda INT.FLAG ; are the bounce vectors valid?
8080 cmpa #0x55
8081 bne SC0F6 ; brif not - copy ROM to RAM
8082 lda RSTFLG ; is the DP reset vector marked valid?
8083 cmpa #0x55
8084 bne NOWARM ; brif not
8085 ldx RSTVEC ; does the vector point to NOP?
8086 lda ,x
8087 cmpa #0x12
8088 lbeq SC18C ; brif so - don't do ROM/RAM copy
8089 NOWARM clr MMUREG ; put bottom memory block in logical block 0 (replaces DP)
8090 lda RSTFLG ; does this give us a valid reset vector?
8091 cmpa #0x55
8092 bne SC0F1 ; brif not
8093 ldx RSTVEC ; does this routine point to a NOP?
8094 lda ,x
8095 cmpa #0x12
8096 lbeq SC18C ; brif so - don't do ROM/RAM copy and keep modified memory map
8097 SC0F1 lda #BLOCK7.0 ; restore memory map
8098 sta MMUREG
8099 SC0F6 ldx #DOSBAS ; point to the end of Color Basic
8100 ldy #EXBAS ; point to start of Extended Basic
8101 lbsr SC1AA ; copy them to RAM
8102 leay PATCHTAB,pcr ; point to patch table
8103 lda ,y+ ; get number of patches to be made
8104 SC106 pshs a ; save patch counter
8105 ldx ,y++ ; get address to patch
8106 ldb ,y+ ; get number of bytes in the patch
8107 SC10C lda ,y+ ; copy a byte
8108 sta ,x+
8109 decb ; done all in this patch?
8110 bne SC10C
8111 puls a ; get back patch counter
8112 deca ; done all patches?
8113 bne SC106 ; brif not
8114 clr TYCLR ; got back to ROM mode
8115 lda #COCO+MMUEN+MC3 ; set up for 16K split mode
8116 sta INIT0
8117 ldd DOSBAS ; is there a Disk Basic ROM signature?
8118 cmpa #'D ; (note that this should just be CMPD)
8119 bne SC137
8120 cmpb #'K
8121 bne SC137
8122 ldx #SUPERVAR ; point to end of Disk Basic ROM
8123 ldy #DOSBAS ; point to start of Disk Basic ROM
8124 bsr SC1AA ; copy it to RAM
8125 lbsr SC322 ; add patches to Disk Basic
8126 SC137 clr TYCLR ; go back to ROM mode
8127 lda #COCO+MMUEN+MC3+MC1 ; set 32K internal mocde
8128 sta INIT0
8129 ldx #H.CRSLOC ; point to end of the Coco3 additions
8130 ldy #SUPERVAR ; point to start of the Coco3 additions
8131 bsr SC1AA ; copy it to RAM
8132 lbsr SC1DE ; set up an easter egg
8133 leay INTIMAGE,pcr ; point to bounce vector initializer
8134 ldx #INT.FLAG ; point to bounce vectors
8135 ldb #19 ; 19 bytes in bounce vectors
8136 lbsr MOVE.XY ; initialize the bounce vectors
8137 clr TYSET ; enable RAM mode (the ROM/RAM copy already did this)
8138 tst ,s ; was F1 pressed?
8139 beq SC180 ; brif not
8140 ldx #IM.TEXT ; point to text mode initializers
8141 ldb #3 ; there are three sets of them
8142 leax 1,x ; move past the FF90 initializer
8143 SC165 lda ,x ; get video mode initializer
8144 ora #0x20 ; enable burst phase invert
8145 sta ,x ; update initializer
8146 leax 9,x ; move to next mode
8147 decb ; done all of them?
8148 bne SC165 ; brif not
8149 ldb #2 ; two graphics mode initalizers
8150 ldx #IM.GRAPH ; point to graphics mode initializers (should be +1; we're actually enabling GIME FIRQ)
8151 SC175 lda ,x ; get initializer
8152 ora #0x20 ; enable burst phase invert (or it would if X pointed to the right place)
8153 sta ,x ; save modified initializer
8154 leax 9,x ; move to next set
8155 decb ; done all of them?
8156 bne SC175 ; brif not
8157 SC180 ldx #VIDRAM ; point to start of VDG text screen
8158 lda #0x60 ; VDG space character
8159 SC185 sta ,x+ ; blank a character
8160 cmpx #VIDRAM+512 ; end of screen?
8161 blo SC185 ; brif not
8162 SC18C lda #COCO+MMUEN+MC3+MC2+MC1 ; turn the SCS back on
8163 sta INIT0
8164 tst ,s ; F1?
8165 beq SC19A ; brif not
8166 lda #0x20 ; enable burst phase invert
8167 sta VIDEOMOD
8168 SC19A ldx #PALETREG ; point to palette registers
8169 leay PALIMAGE,PCR ; point to palette initializer
8170 ldb #16 ; do 16 palette registers
8171 bsr MOVE.XY ; initialize palette
8172 leas 1,s ; clean up stack (not much point since it will be reset anyway)
8173 jmp RESVEC ; transfer control to the original Color Basic initialization routine
8174 SC1AA stx 0x5f02 ; save end copy address
8175 sts 0x5f00 ; save stack
8176 SC1B1 clr TYCLR ; go to ROM mode
8177 ldd ,y ; grab 8 bytes
8178 ldx 2,y
8179 ldu 4,y
8180 lds 6,y
8181 clr TYSET ; go to RAM mode
8182 std ,y ; save the 8 bytes
8183 stx 2,y
8184 stu 4,y
8185 sts 6,y
8186 leay 8,y ; move pointer forward
8187 cmpy 0x5f02 ; done yet?
8188 blo SC1B1 ; brif not
8189 lds 0x5f00 ; restore stack pointer
8190 rts
8191 MOVE.XY lda ,y+ ; copy a byte
8192 sta ,x+
8193 decb ; done all?
8194 bne MOVE.XY ; brif not
8195 rts
8196 SC1DE ldx #AUTHORMS ; point to author name easter egg
8197 leay SC30D,pcr ; point to encoded names
8198 ldb #21 ; 21 bytes in names
8199 SC1E7 lda ,y+ ; get encoded byte
8200 coma ; decode (wow. one's complement encoding.)
8201 sta ,x+ ; put in copied ROM
8202 decb ; done all?
8203 bne SC1E7 ; brif not
8204 rts
8205 SC1F0 clra ; set up to mark things as invalid
8206 sta INT.FLAG ; mark bounce vectors invalid
8207 sta RSTFLG ; mark reset vector invalid
8208 sta TYCLR ; go to ROM mode
8209 ldb #9 ; foreground colour for image
8210 stb PALETREG+10
8211 ldb #63 ; white background
8212 stb PALETREG+11
8213 ldx #AUTHPIC ; point to author picture data
8214 ldy #0xe00 ; put picture at 0xe00 in memory
8215 SC20A ldd ,x++ ; copy four bytes
8216 ldu ,x++
8217 std ,y++
8218 stu ,y++
8219 cmpx #AUTHPICe ; at end of picture data?
8220 blo SC20A ; brif not
8221 lda #0xf9 ; 256x192, CSS0 VDG mode
8222 sta PIA1+2
8223 clra ; this instruction is useless
8224 ldx #SAMREG ; point to SAM register
8225 sta ,x ; set SAM address to 0xe00 and video mode to 256x192
8226 sta 3,x
8227 sta 5,x
8228 sta 7,x
8229 sta 9,x
8230 sta 11,x
8231 WAITLOOP bra WAITLOOP ; freeze the system
8232 VIDIMAGE fcb 0x00,0x00,0x00,0x00,0x0f,0xe0,0x00,0x00
8233 PALIMAGE fcb 18,36,11,7,63,31,9,38,0,18,0,63,0,18,0,38
8234 MMUIMAGE fcb BLOCK7.0,BLOCK7.1,BLOCK6.4,BLOCK7.3
8235 fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7
8236 fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2
8237 fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7
8238 PATCHTAB fcb 27 ; 27 patches to install
8239 ; Patch #1: enable warm start routine after ROM/RAM copy
8240 patch1 fdb XBWMST
8241 fcb patch2-*-1
8242 nop
8243 ; Patch #2: intercept tokenization routine
8244 patch2 fdb LB8D4
8245 fcb patch3-*-1
8246 jmp ALINK2
8247 ; Patch #3: intercept detokenization routine
8248 patch3 fdb LB7F3
8249 fcb patch4-*-1
8250 jmp ALINK3
8251 ; Patch #4: intercept Extended Basic's command interpretation handler
8252 patch4 fdb L8150
8253 fcb patch5-*-1
8254 jmp ALINK4
8255 nop
8256 ; Patch #5: intercept Extended Basic's function handler
8257 patch5 fdb L816C
8258 fcb patch6-*-1
8259 jmp ALINK5
8260 nop
8261 ; Patch #6 through patch #10 - extend &H and &O to allow 24 bit values
8262 patch6 fdb L8834
8263 fcb patch7-*-1
8264 jmp ALINK6A
8265 clr FPA0+1
8266 clr FPA0+2
8267 clr FPA0+3
8268 bra *-78
8269 clr FPA0
8270 bra *-47
8271 jmp ALINK6B
8272 patch7 fdb L87EB
8273 fcb patch8-*-1
8274 bra *+76
8275 nop
8276 rts
8277 ldx #FPA0+1
8278 patch8 fdb L880C
8279 fcb patch9-*-1
8280 bra *+55
8281 patch9 fdb L8826
8282 fcb patch10-*-1
8283 bcs *+25
8284 patch10 fdb L87E7
8285 fcb patch11-*-1
8286 bne *+7
8287 ; Patch #11 is needed because the above removed an RTS used by this routine
8288 patch11 fdb L886A
8289 fcb patch12-*-1
8290 bne *-124
8291 ; Patch #12 - intercept signon message display
8292 patch12 fdb L80B2
8293 fcb patch13-*-1
8294 jmp ALINK12
8295 ; Patch #13 - remove one carriage return from signon message
8296 patch13 fdb L80E8+82
8297 fcb patch14-*-1
8298 fcb 0
8299 ; Patch #14 - extend Extended Basic's graphics initialization routine
8300 patch14 fdb L9703
8301 fcb patch15-*-1
8302 jmp ALINK14
8303 ; Patch #15 - intercept break check
8304 patch15 fdb LADF0
8305 fcb patch16-*-1
8306 jmp ALINK15
8307 nop
8308 ; Patch #16 - intercept break check when handling "line input"
8309 patch16 fdb LA3C2
8310 fcb patch17-*-1
8311 jmp ALINK16
8312 nop
8313 ; Patch #17 - cause INPUT to respond to ON BRK
8314 patch17 fdb LB03C+1
8315 fcb patch18-*-1
8316 fdb ALINK17
8317 ; Patch #18 - intercept ON command
8318 patch18 fdb ON
8319 fcb patch19-*-1
8320 jmp ALINK18
8321 ; Patch #19 - add on extra stuff to end of NEW
8322 patch19 fdb LAD3F
8323 fcb patch20-*-1
8324 jmp ALINK19
8325 nop
8326 ; Patch #20 - intercept error handler
8327 patch20 fdb LAC46
8328 fcb patch21-*-1
8329 jmp ALINK20
8330 ; Patch #21 - intercept immediate mode loop
8331 patch21 fdb LAC73
8332 fcb patch22-*-1
8333 jmp ALINK21
8334 ; Patch #22 - intercept character to screen routine
8335 patch22 fdb LA30A
8336 fcb patch23-*-1
8337 jmp L8C37
8338 ; Patch #23 - intercept CLS
8339 patch23 fdb CLS
8340 fcb patch24-*-1
8341 jmp L8C46
8342 ; Patch #24 - intercept waiting for keypress with cursor routine
8343 patch24 fdb LA1B1
8344 fcb patch25-*-1
8345 jmp LA0CE
8346 nop
8347 nop
8348 nop
8349 nop
8350 nop
8351 ; Patch #25 - intercept PRINT @
8352 patch25 fdb LB902
8353 fcb patch26-*-1
8354 jmp ALINK25
8355 ; Patch #26 - intercept conditional newline routine
8356 patch26 fdb LB95C
8357 fcb patch27-*-1
8358 jmp ALINK26
8359 ; Patch #27 - intercept CLEAR handling in line input routine
8360 patch27 fdb LA38D
8361 fcb patch27e-*-1
8362 jmp ALINK27
8363 patch27e equ *
8364 ; Names of the authors in one's complemented ASCII
8365 SC30D fcb 0xab,0xd1,0xb7,0x9e,0x8d,0x8d,0x96,0x8c
8366 fcb 0xdf,0xd9,0xdf,0xab,0xd1,0xba,0x9e,0x8d
8367 fcb 0x93,0x9a,0x8c,0xf2,0xff
8368 SC322 lda DOSBAS+4 ; get MSB of DSKCON vector
8369 cmpa #0xd6 ; is it 0xd6?
8370 bne SC334 ; brif not - we have Disk Basic 1.1
8371 ldx #0xc0c6 ; point to patch address in Disk Basic 1.0
8372 leay SC355,pcr ; point to patch for Disk Basic 1.0
8373 ldb ,y+ ; get number of bytes to patch
8374 bra SC349 ; go patch it
8375 SC334 ldx #0xC8B4 ; point to Disk Basic 1.1 keyboard check (in the interpretation loop handler)
8376 lda #0x12 ; NOP opcode
8377 ldb #11 ; clobber 11 bytes (which check for a key down before calling the break check)
8378 SC33B sta ,x+ ; put a NOP
8379 decb ; done?
8380 bne SC33B ; brif not
8381 ldx #0xc0d9 ; point to the Disk Basic 1.1 patch address
8382 leay SC351,pcr ; point to patch for Disk Basic 1.1
8383 ldb ,y+ ; get number of bytes in patch
8384 SC349 lda ,y+ ; put a byte from the patch
8385 sta ,x+
8386 decb ; done yet?
8387 bne SC349 ; brif not
8388 rts
8389 ; Copyright message patch for Disk Basic 1.1
8390 SC351 fcb SC355-*-1
8391 jmp ALINK29
8392 ; Copyright message patch for Disk Basic 1.0
8393 SC355 fcb SC355e-*-1
8394 jmp ALINK28
8395 SC355e equ *
8396 ; This is the initializer for the bounce vector table. It sets up to transfer control to Color Basic's
8397 ; interrupt vectors at 0x100. These really should be JMP instead of LBRA, if only because JMP is faster.
8398 INTIMAGE fcb 0x55 ; valid vector table flag
8399 lbra (INTIMAGE+1)-(INT.JUMP)+SW3VEC ; SWI3
8400 lbra (INTIMAGE+1)-(INT.JUMP)+SW2VEC ; SWI2
8401 lbra (INTIMAGE+1)-(INT.JUMP)+FRQVEC ; FIRQ
8402 lbra (INTIMAGE+1)-(INT.JUMP)+IRQVEC ; IRQ
8403 lbra (INTIMAGE+1)-(INT.JUMP)+SWIVEC ; SWI
8404 lbra (INTIMAGE+1)-(INT.JUMP)+NMIVEC ; NMI
8405 ENDMOVE equ *
8406 ; Unused bytes
8407 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8408 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x55,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8409 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8410 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8411 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8412 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8413 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8414 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8415 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF
8416 fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x18,0x00,0x0E,0x00
8417 ; This is the "pmode 4" author picture easter egg
8418 AUTHPIC fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8419 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8420 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8421 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8422 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8423 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8424 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8425 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8426 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8427 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8428 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8429 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8430 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8431 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8432 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8433 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF
8434 fcb 0xFF,0xF7,0xFF,0xFB,0xEE,0xEF,0xFB,0xFF,0xBB,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB
8435 fcb 0xBB,0xBB,0xBF,0xBB,0xBB,0xFF,0xBF,0xFF,0xFE,0xEF,0xFF,0xFF,0xFF,0xEF,0x7F,0xFF
8436 fcb 0xFF,0xF7,0xBB,0xFF,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8437 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xBB,0xFF,0xBB,0x7F,0xFF
8438 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEE,0xFE,0xEE
8439 fcb 0xEE,0xEE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEE,0x7F,0xFF
8440 fcb 0xFF,0xF3,0xBB,0xFF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8441 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF
8442 fcb 0xFF,0xF6,0xAA,0xAE,0xAA,0xAE,0xAA,0xEA,0xBB,0xBB,0xFB,0xFF,0xBB,0xFF,0xBF,0xBF
8443 fcb 0xFF,0xFB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBB,0xBA,0xEA,0xAA,0xEE,0xAE,0xEE,0x7F,0xFF
8444 fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8445 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF
8446 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF
8447 fcb 0xFF,0xFE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF
8448 fcb 0xFF,0xF7,0xBB,0xBB,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8449 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF
8450 fcb 0xFF,0xF6,0xAA,0xEE,0xAA,0xAA,0xAA,0xEA,0xAB,0xBB,0xBB,0xFF,0xBB,0xFF,0xFF,0xFF
8451 fcb 0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xFF,0xBB,0xBB,0xEA,0xAE,0xAA,0xAA,0xAF,0x7F,0xFF
8452 fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8453 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF
8454 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEF,0xEE,0xEE,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8455 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEE,0xFF,0xEF,0xEE,0xEE,0xEF,0x7F,0xFF
8456 fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8457 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0x7F,0xFF
8458 fcb 0xFF,0xF7,0xEA,0xAA,0xBB,0xBB,0xBB,0xBB,0xBB,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF
8459 fcb 0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFB,0xFB,0xBB,0xBB,0xBA,0xAA,0xAA,0xEF,0x7F,0xFF
8460 fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8461 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF
8462 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8463 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEE,0xEF,0xFE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF
8464 fcb 0xFF,0xF7,0xBB,0xBB,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00
8465 fcb 0x00,0x00,0x00,0x00,0x0F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF
8466 fcb 0xFF,0xF6,0xEA,0xAB,0xAA,0xAB,0xBB,0xBB,0xBF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x7F
8467 fcb 0xFF,0xFF,0xC0,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xBF,0xAA,0xAA,0xAA,0xEF,0x7F,0xFF
8468 fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8469 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF
8470 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEE,0xFF,0xFF,0xFF,0xEE,0xFF,0xFF,0x80,0x00,0x3F
8471 fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF
8472 fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8473 fcb 0x00,0x00,0x00,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF
8474 fcb 0xFF,0xF6,0xEE,0xAB,0xAE,0xEB,0xBB,0xBF,0xFB,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x1F
8475 fcb 0xFF,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xBB,0xAA,0xAA,0xBE,0xAB,0x7F,0xFF
8476 fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8477 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xFB,0xBB,0xBB,0xBF,0x7F,0xFF
8478 fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF,0x80,0x00,0x0F
8479 fcb 0xFF,0xFE,0x00,0x00,0x3F,0xFF,0xFF,0xEF,0xEF,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF
8480 fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8481 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF
8482 fcb 0xFF,0xF6,0xEA,0xAB,0xBA,0xAB,0xBB,0xFB,0xFF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x07
8483 fcb 0xFF,0xFC,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFB,0xAA,0xFF,0xFE,0xEA,0xAB,0x7F,0xFF
8484 fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8485 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF
8486 fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x03
8487 fcb 0xFF,0xF8,0x00,0x00,0x3F,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0xFE,0xEE,0xEF,0x7F,0xFF
8488 fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8489 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xFF,0x7F,0xFF
8490 fcb 0xFF,0xF7,0xAA,0xFB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x01
8491 fcb 0xFF,0xF0,0x00,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xAE,0xBB,0xBE,0xAF,0xBB,0x7F,0xFF
8492 fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8493 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF
8494 fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFE,0xFF,0xFF,0xFF,0xFF,0x80,0x08,0x00
8495 fcb 0xFF,0xE0,0x02,0x00,0x3F,0xFF,0xFF,0xFE,0xEF,0xEE,0xFF,0xEE,0xEF,0xEF,0x7F,0xFF
8496 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8497 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF
8498 fcb 0xFF,0xF7,0xAA,0xBB,0xBB,0xFB,0xBB,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00
8499 fcb 0x7F,0xC0,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBF,0xEB,0xBB,0x7F,0xFF
8500 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8501 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8502 fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0E,0x00
8503 fcb 0x3F,0x80,0x0E,0x00,0x3F,0xFF,0xFF,0xFE,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0x7F,0xFF
8504 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8505 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8506 fcb 0xFF,0xF3,0xEA,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x00
8507 fcb 0x1F,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF
8508 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8509 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8510 fcb 0xFF,0xF7,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x80
8511 fcb 0x0E,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xEE,0xFF,0xFF,0xFF,0xFE,0xEF,0xEF,0x7F,0xFF
8512 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8513 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF
8514 fcb 0xFF,0xF6,0xEA,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0
8515 fcb 0x00,0x00,0x7E,0x00,0x3F,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBA,0xEF,0x7F,0xFF
8516 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8517 fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF
8518 fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xE0
8519 fcb 0x00,0x00,0xFE,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xFE,0xEF,0x7F,0xFF
8520 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8521 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF
8522 fcb 0xFF,0xF6,0xEB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0
8523 fcb 0x00,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEB,0x7F,0xFF
8524 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00
8525 fcb 0x00,0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBA,0x7F,0xFF
8526 fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00
8527 fcb 0x00,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEB,0x7F,0xFF
8528 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFC,0x00,0x0F,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00
8529 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xAA,0x7F,0xFF
8530 fcb 0xFF,0xF6,0xAB,0xBB,0xFF,0xFF,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00
8531 fcb 0x00,0x00,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x79,0x9F,0xFB,0xAB,0x7F,0xFF
8532 fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xF8,0x00,0x00,0x01,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00
8533 fcb 0x00,0x38,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x03,0xFE,0xEE,0x7F,0xFF
8534 fcb 0xFF,0xF6,0xEF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x4F,0xFF,0xFF,0xFF,0x80,0x00,0x00
8535 fcb 0x01,0x7C,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x00,0xFA,0xBB,0x7F,0xFF
8536 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x01,0xFF,0xFF,0xF0,0x00,0x00,0x00
8537 fcb 0x03,0xFE,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x7E,0xEE,0x7F,0xFF
8538 fcb 0xFF,0xF3,0xBB,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0x80,0x00,0x00
8539 fcb 0x0F,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x3B,0xBB,0x7F,0xFF
8540 fcb 0xFF,0xF7,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xFF,0xFF,0x00,0x00
8541 fcb 0x2F,0xFF,0x00,0x7F,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00,0x0E,0xEE,0x7F,0xFF
8542 fcb 0xFF,0xF6,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xFF,0x80,0x00,0x01
8543 fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x07,0xBB,0x7F,0xFF
8544 fcb 0xFF,0xF7,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF0,0x00,0x00,0x03
8545 fcb 0xFF,0xFF,0x40,0x00,0x03,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x03,0xEE,0x7F,0xFF
8546 fcb 0xFF,0xF3,0xBB,0xFF,0xF0,0x00,0x00,0x00,0x01,0x00,0x1F,0xFF,0xFF,0x80,0x01,0x07
8547 fcb 0xFF,0xFF,0xA0,0x00,0x3F,0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x01,0xBB,0x7F,0xFF
8548 fcb 0xFF,0xF7,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x01,0x80,0x1F,0xFF,0xFF,0xFE,0x0E,0x2F
8549 fcb 0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xEE,0x7F,0xFF
8550 fcb 0xFF,0xF6,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x65,0xE0,0x0F,0xFF,0xFF,0x80,0x0C,0x1F
8551 fcb 0xFF,0xFF,0xE0,0x00,0x3F,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x3B,0x7F,0xFF
8552 fcb 0xFF,0xF7,0xFF,0xFF,0xC0,0x00,0x00,0x0B,0xFF,0xF0,0x0F,0xFF,0xFC,0x00,0x18,0x0F
8553 fcb 0xF8,0x00,0x60,0x00,0x07,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF
8554 fcb 0xFF,0xF3,0xBB,0xFF,0xC0,0x00,0x01,0xFF,0xFF,0xF8,0x0F,0xFF,0xFF,0x80,0x00,0x01
8555 fcb 0xF8,0x00,0x20,0x00,0x3F,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x1B,0x7F,0xFF
8556 fcb 0xFF,0xF7,0xFF,0xFF,0x80,0x00,0x03,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xFC,0x03,0x03
8557 fcb 0xFF,0x7F,0xF0,0x03,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF
8558 fcb 0xFF,0xF7,0xFE,0xFF,0x80,0x01,0x5D,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xC0,0x07,0xF1
8559 fcb 0xFC,0x07,0xFC,0x00,0x3F,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x03,0x7F,0xFF
8560 fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x02,0xEF,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0x00,0x0E,0x00
8561 fcb 0x7C,0x00,0xF4,0x00,0x0C,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF
8562 fcb 0xFF,0xF2,0xAB,0xFF,0x00,0x05,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1C,0x00
8563 fcb 0xFC,0x01,0xF8,0x01,0xFB,0xBF,0xFF,0xF8,0x00,0x00,0x0F,0xE1,0x80,0x0B,0x7F,0xFF
8564 fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x03,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1F,0xC0
8565 fcb 0xFE,0x3F,0xFC,0x01,0xF6,0xDF,0xFF,0xF8,0x00,0x3F,0xFF,0xFF,0x80,0x0E,0x7F,0xFF
8566 fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x07,0xFF,0xFF,0xFF,0xFE,0x0F,0xFE,0xFF,0xFC,0x1F,0xF1
8567 fcb 0xFF,0x9F,0xF8,0x37,0xF5,0xDF,0xFF,0xF8,0x00,0xFF,0xFF,0xFF,0x80,0x0B,0x7F,0xFF
8568 fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xF8,0x0F,0xEF
8569 fcb 0x7F,0xFF,0xFC,0x03,0xF6,0xDF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0x80,0x06,0x7F,0xFF
8570 fcb 0xFF,0xF6,0xFF,0xBF,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x07,0xFB,0xBB,0xFD,0xDF,0xFF
8571 fcb 0xEF,0xFF,0xF9,0x7F,0xFB,0xBF,0xFF,0xFC,0x7F,0xFF,0xFF,0xFF,0xC0,0x0B,0x7F,0xFF
8572 fcb 0xFF,0xF7,0xBF,0xFE,0x00,0x03,0xFF,0xFF,0xFF,0xF8,0x07,0xFF,0xFF,0xFF,0x9F,0xFF
8573 fcb 0xFF,0xFF,0xFF,0xBF,0xFC,0x7F,0xFF,0xFC,0x75,0x0F,0xFF,0xCF,0xC0,0x0E,0x7F,0xFF
8574 fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x07,0xF5,0x47,0xFF,0xE0,0x07,0xFF,0xEF,0xFF,0xCF,0xFD
8575 fcb 0xFF,0xFF,0xFF,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0xE0,0x07,0xC0,0x0F,0x7F,0xFF
8576 fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x0F,0xF8,0x07,0xFF,0xDC,0x07,0xFF,0xFF,0xFF,0xCF,0xFB
8577 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x03,0xE0,0x0D,0x7F,0xFF
8578 fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x1F,0xD1,0x1F,0xFF,0xEF,0x07,0xFF,0xFF,0xFF,0xFF,0xFF
8579 fcb 0xF1,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x7B,0xF0,0x0B,0x7F,0xFF
8580 fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xFF,0xEF,0xFE,0x81,0x07,0xFF,0xFF,0xFF,0x7F,0xF8
8581 fcb 0x40,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x60,0x01,0xFC,0x1D,0xF0,0x0D,0x7F,0xFF
8582 fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0x01,0xFE,0x01,0x87,0xFE,0xEE,0xFF,0xFF,0xF0
8583 fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xE0,0x03,0xF0,0x67,0xF0,0x17,0x7F,0xFF
8584 fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xF8,0x01,0xFC,0x03,0x87,0xFF,0xFF,0xFF,0xFF,0xC0
8585 fcb 0x00,0x0F,0xFC,0x3F,0xFF,0xFF,0xFF,0xFF,0xC0,0x03,0xF0,0x33,0xF0,0x5F,0x7F,0xFF
8586 fcb 0xFF,0xF6,0xAF,0xFE,0x00,0x1F,0xFF,0xF0,0xFE,0x0F,0x87,0xFF,0xBF,0xFF,0xFF,0x80
8587 fcb 0xFF,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x03,0xFA,0xFF,0xF1,0xBB,0x7F,0xFF
8588 fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x1F,0xFF,0xFE,0xFE,0x9B,0x87,0xFF,0xFF,0xFF,0xFF,0xBD
8589 fcb 0x80,0xF3,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x17,0xFF,0xFF,0xF4,0xEE,0x7F,0xFF
8590 fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0xFF,0xFF,0x03,0x87,0xEF,0xEE,0xEF,0xFF,0x00
8591 fcb 0x00,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x77,0xFF,0xFF,0xFE,0xBB,0x7F,0xFF
8592 fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x0F,0xFF,0xEF,0xF8,0x83,0x87,0xFF,0xFF,0xFF,0xFF,0xBE
8593 fcb 0xBF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0xFF,0xFD,0xB3,0xFF,0xFF,0xFD,0xEE,0x7F,0xFF
8594 fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFF,0xF8,0x7F,0xF7,0x8F,0xFF,0xFB,0xBF,0xFF,0xFF
8595 fcb 0xFF,0xF7,0xFC,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF
8596 fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x0F,0xFF,0xF3,0x7F,0x0F,0x8F,0xFF,0xFF,0xFF,0xFF,0xFF
8597 fcb 0xBF,0xE3,0xFC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xEE,0x7F,0xFF
8598 fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFE,0xF7,0xFF,0xCF,0x8E,0xFF,0xFF,0xEF,0xFF,0xFF
8599 fcb 0x17,0xF7,0xFD,0xEF,0xEF,0xFE,0xFF,0xFF,0xFF,0x9F,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF
8600 fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x07,0xFF,0xFE,0xFF,0xC1,0x9F,0xFF,0xFF,0xFF,0xFF,0xFE
8601 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xF7,0xFF,0xFE,0xEE,0x7F,0xFF
8602 fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x03,0xFF,0xC4,0x1C,0x03,0x9B,0xFB,0xAF,0xBF,0xFF,0xFF
8603 fcb 0xFF,0xFF,0xFE,0xFB,0xFB,0xBB,0xFF,0xBF,0xFE,0x02,0xAB,0xFF,0xF8,0xFB,0x7F,0xFF
8604 fcb 0xFF,0xF3,0xBF,0xBA,0x04,0x03,0xFA,0x00,0x00,0x01,0x9F,0xFF,0xBB,0xFF,0xFB,0xFF
8605 fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xFE,0xEF,0xFC,0x00,0x05,0xFF,0xF9,0xEE,0x7F,0xFF
8606 fcb 0xFF,0xF6,0xEE,0xEC,0x06,0x01,0xFC,0xA2,0x00,0x03,0x9F,0xEE,0xEE,0xEF,0xFE,0xFF
8607 fcb 0xFF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEF,0xBF,0xFE,0x00,0x00,0x3F,0xFB,0xBB,0x7F,0xFF
8608 fcb 0xFF,0xF3,0xBB,0xB0,0x00,0x01,0xFA,0x10,0x00,0x03,0x9F,0xFB,0xBB,0xFF,0xFB,0xFF
8609 fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xBE,0xEF,0xFC,0x0F,0x80,0x1F,0xF6,0xEE,0x7F,0xFF
8610 fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x68,0x5F,0xFE,0x03,0x1B,0xAE,0xAE,0xFB,0xEE,0xFD
8611 fcb 0xFF,0xFF,0xFE,0xAB,0xBB,0xEA,0xFF,0xBF,0xF8,0x0B,0xFC,0x1F,0xFF,0xBB,0x7F,0xFF
8612 fcb 0xFF,0xF3,0xBB,0xBA,0x00,0x00,0x7B,0x0F,0xFE,0x00,0x1F,0xBB,0xBB,0xFF,0xFB,0xFF
8613 fcb 0xFF,0xFF,0xFB,0xBB,0xFF,0xBB,0xBE,0xEF,0xFC,0x07,0xFC,0x5F,0xF6,0xEE,0x7F,0xFF
8614 fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x14,0x40,0x3C,0x00,0x0E,0xEE,0xEE,0xFF,0xFF,0xFF
8615 fcb 0xFF,0xFF,0xFE,0xEE,0xEE,0xEE,0xEF,0xBF,0xFE,0x00,0x61,0xFF,0xFF,0xBB,0x7F,0xFF
8616 fcb 0xFF,0xF3,0xBB,0x80,0x00,0x00,0x00,0x7E,0x00,0x00,0x3F,0xBB,0xFF,0xFF,0xBF,0xFF
8617 fcb 0xFF,0xFF,0xFF,0xBB,0xFF,0xBB,0xBE,0xEF,0xFF,0xE0,0x07,0xFF,0xFF,0xEE,0x7F,0xFF
8618 fcb 0xFF,0xF6,0xEE,0x00,0x00,0x00,0x00,0x3F,0xEE,0x80,0x2E,0xAB,0xBF,0xBE,0xFC,0xFF
8619 fcb 0xFF,0xFF,0xFE,0xEB,0xBB,0xAA,0xBB,0xBF,0xEF,0xFA,0xFF,0xFF,0xF8,0x0B,0x7F,0xFF
8620 fcb 0xFF,0xF3,0xBA,0x00,0x00,0xC0,0x00,0x0F,0xFE,0x00,0x3B,0xBF,0xFF,0xFB,0xB1,0xFF
8621 fcb 0xFF,0xFF,0xF3,0xBB,0xFF,0xBB,0xAE,0xEF,0xBF,0xD9,0x7F,0xFF,0xF8,0x02,0x7F,0xFF
8622 fcb 0xFF,0xF6,0xEC,0x00,0x00,0xE0,0x00,0x00,0x00,0x00,0xEE,0xEE,0xEF,0xEE,0xE1,0xFF
8623 fcb 0xFF,0xFF,0xF0,0xEE,0xEE,0xEE,0xEB,0xBF,0xEF,0x8E,0x3F,0xFF,0xF8,0x00,0x7F,0xFF
8624 fcb 0xFF,0xF3,0xBA,0x00,0x00,0xF0,0x00,0x00,0x00,0x00,0xBB,0xBB,0xBF,0xBB,0xB1,0xFF
8625 fcb 0xFF,0xFF,0xE0,0x3B,0xFF,0xBB,0xEE,0xFF,0xBB,0x00,0x5F,0xFF,0xF8,0x00,0x7F,0xFF
8626 fcb 0xFF,0xF6,0xE0,0x04,0x00,0x78,0x00,0x00,0x00,0x01,0xEE,0xAA,0xAE,0xEA,0xC0,0x7F
8627 fcb 0xFF,0xFF,0x80,0x0B,0xFF,0xEF,0xAB,0xFF,0xEF,0xC2,0x3F,0xFF,0xFF,0xE0,0x7F,0xFF
8628 fcb 0xFF,0xF3,0x80,0x00,0x00,0x7C,0x00,0x00,0x00,0x00,0x3B,0xBB,0xBB,0xBB,0x00,0x3F
8629 fcb 0xFF,0xFF,0x00,0x03,0xFF,0xFE,0xEE,0xEF,0xBB,0xC0,0x7F,0xFF,0xFE,0xF8,0x7F,0xFF
8630 fcb 0xFF,0xF6,0x60,0xC0,0x00,0x7F,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEE,0xEC,0x00,0x01
8631 fcb 0x3F,0xFC,0x00,0x00,0x6E,0xEF,0xFF,0xFB,0xEE,0xE2,0x3F,0xFF,0xFE,0x78,0x7F,0xFF
8632 fcb 0xFF,0xF0,0x98,0x60,0x00,0x3F,0x80,0x00,0x00,0x00,0x03,0xBB,0xBB,0xB8,0x00,0x00
8633 fcb 0x00,0x00,0x00,0x00,0x01,0xBB,0xBB,0xBA,0xBB,0x5F,0x9F,0xFF,0xFC,0xF8,0x7F,0xFF
8634 fcb 0xFF,0xF6,0x00,0x30,0x00,0x0F,0xC0,0x00,0x00,0x00,0x00,0x6A,0xEE,0xA0,0x00,0x00
8635 fcb 0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFA,0xEE,0x83,0xFF,0xFF,0xFC,0xF8,0x7F,0xFF
8636 fcb 0xFF,0xF4,0x00,0x00,0x00,0x07,0xE0,0x00,0x00,0x00,0x05,0x13,0xBB,0x80,0x00,0x00
8637 fcb 0x00,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEA,0x9B,0xA3,0xFF,0xFF,0xFD,0xF0,0x7F,0xFF
8638 fcb 0xFF,0xF0,0x00,0x00,0x00,0x01,0xF0,0x00,0x00,0x00,0x00,0x0E,0xEE,0x80,0x00,0x00
8639 fcb 0x00,0x00,0x00,0x00,0x00,0x2F,0xFE,0xAA,0x0E,0xED,0xFF,0xFF,0xF9,0xF0,0x7F,0xFF
8640 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x03,0xBB,0x80,0x00,0x00
8641 fcb 0x00,0x00,0x00,0x00,0x00,0x0A,0xBA,0xA8,0x0B,0xFB,0x7F,0xFF,0xF3,0xF0,0x7F,0xFF
8642 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x3C,0x00,0x00,0x00,0x00,0x02,0x8A,0x80,0x00,0x00
8643 fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xFE,0xA0,0x06,0xFE,0xFF,0xFF,0x07,0xF0,0x7F,0xFF
8644 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x1E,0x00,0x00,0x00,0x00,0x07,0x03,0x80,0x00,0x00
8645 fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xAA,0x80,0x07,0xF9,0xFF,0xFC,0x07,0xF4,0x7F,0xFF
8646 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x0F,0x14,0x0E,0x00,0x00,0x02,0x80,0x80,0x00,0x00
8647 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xAA,0x80,0xBF,0xFF,0xBF,0xF0,0x0F,0xF6,0x7F,0xFF
8648 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x03,0xFF,0xFC,0x00,0x00,0x03,0x00,0x00,0x00,0x00
8649 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xEA,0x0F,0xFE,0x7C,0x77,0x80,0x1F,0xF6,0x7F,0xFF
8650 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0xF8,0x00,0x00,0x03,0x00,0x00,0x00,0x00
8651 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x28,0x7F,0xFC,0xFE,0x80,0x00,0x1F,0xF7,0x7F,0xFF
8652 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0xF0,0x00,0x00,0x03,0x00,0x00,0x00,0x00
8653 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x37,0x3C,0xFE,0xC0,0x00,0xBF,0xF7,0x7F,0xFF
8654 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x07,0x7F,0xE0,0x00,0x00,0xF3,0x00,0x00,0x00,0x00
8655 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0x3E,0xFF,0x80,0x01,0xFF,0xF7,0x7F,0xFF
8656 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0xA3,0xFF,0xC0,0x00,0x00,0x63,0x00,0x00,0x00,0x00
8657 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0xFD,0xEE,0x80,0x07,0xFF,0xF7,0x7F,0xFF
8658 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x63,0xFF,0xC0,0x00,0x00,0x73,0x00,0x00,0x00,0x00
8659 fcb 0xFF,0x00,0x00,0x00,0x00,0x00,0x08,0x1F,0x78,0xF7,0xE8,0x9F,0xFF,0xFC,0x7F,0xFF
8660 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x77,0xBF,0x80,0x00,0x00,0x33,0x00,0x00,0x00,0x3F
8661 fcb 0xBB,0xE0,0x00,0x00,0x00,0x00,0x00,0x1F,0xF8,0x3B,0x55,0x7F,0x80,0x70,0x7F,0xFF
8662 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0x00,0x00,0x00,0x3B,0x00,0x00,0x00,0xFF
8663 fcb 0x3B,0xFC,0x00,0x00,0x00,0x00,0x00,0x1F,0xFF,0x1D,0x8E,0xE7,0x82,0xF8,0x7F,0xFF
8664 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0x00,0x00,0x00,0x30,0x00,0x00,0x01,0xFE
8665 fcb 0xF9,0x9F,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF,0xC1,0x17,0xFF,0xFF,0xC0,0x7F,0xFF
8666 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x18,0x00,0x00,0x00,0xF8
8667 fcb 0xFF,0x3F,0xE0,0x00,0x04,0x00,0x00,0x0F,0xBF,0xC2,0xEF,0xFF,0xFF,0x80,0x7F,0xFF
8668 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x1C,0x00,0x00,0x08,0xFB
8669 fcb 0xFF,0x37,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xC1,0x1F,0xFF,0xFF,0x00,0x7F,0xFF
8670 fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x1D,0x07
8671 fcb 0xFF,0xE3,0x68,0x00,0x00,0x00,0x00,0x07,0x7F,0xC7,0x3F,0xFF,0xFE,0x00,0x7F,0xFF
8672 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F
8673 fcb 0xFF,0xFB,0xF6,0x00,0x00,0x00,0x00,0x07,0x7F,0xE1,0x7F,0xFF,0xFC,0x00,0x7F,0xFF
8674 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x01,0xC6,0x7F
8675 fcb 0xFF,0xFF,0xE8,0x00,0x00,0x00,0x00,0x07,0x0F,0xF3,0x8F,0x97,0xFC,0x00,0x7F,0xFF
8676 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xB1,0xEF
8677 fcb 0xFF,0xEF,0xB7,0x00,0x00,0x00,0x00,0x07,0x83,0xE1,0xC6,0x00,0x78,0x00,0x7F,0xFF
8678 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21,0xDF
8679 fcb 0xFF,0xD1,0xA2,0x00,0x00,0x40,0x00,0x03,0x00,0xF1,0xFF,0x14,0x20,0x00,0x7F,0xFF
8680 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3E,0xFF
8681 fcb 0xFF,0xFF,0xDF,0x00,0x00,0x00,0x00,0x03,0x06,0x70,0x7C,0x00,0xC0,0x00,0x7F,0xFF
8682 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF
8683 fcb 0xFF,0xFF,0xE7,0xE0,0x00,0x00,0x00,0x03,0x87,0xF1,0xF8,0x03,0x80,0x00,0x7F,0xFF
8684 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xAF
8685 fcb 0xFF,0xFF,0xF7,0x00,0x00,0x00,0x00,0x03,0x8F,0xFB,0xF8,0x20,0x00,0x00,0x7F,0xFF
8686 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1F,0xBF
8687 fcb 0xFF,0xFF,0xBF,0xE0,0x00,0x00,0x00,0xF3,0x8D,0xFF,0xF8,0x5F,0x00,0x00,0x7F,0xFF
8688 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xFF
8689 fcb 0xFF,0xFF,0x4F,0xF0,0x00,0x00,0x01,0xE3,0x87,0xFF,0xFC,0x6E,0x00,0x00,0x7F,0xFF
8690 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0D,0xF7
8691 fcb 0xBF,0xFF,0xEF,0xE8,0x00,0x00,0x00,0x01,0x1F,0xFF,0xFF,0xFE,0x00,0x00,0x7F,0xFF
8692 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0B,0xFF
8693 fcb 0x9F,0xFF,0xFD,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFF,0x00,0x00,0x7F,0xFF
8694 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8695 fcb 0xFF,0xFF,0x8F,0xE8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFC,0x00,0x00,0x7F,0xFF
8696 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8697 fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xF8,0x00,0x00,0x7F,0xFF
8698 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8699 fcb 0xFF,0x9F,0xFF,0xF8,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xF0,0x00,0x00,0x7F,0xFF
8700 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFE,0x00,0x00,0x07,0xFF
8701 fcb 0x1F,0xFF,0xF5,0xFC,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xE0,0x00,0x00,0x7F,0xFF
8702 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFC
8703 fcb 0x3F,0xFF,0xBF,0xF8,0x00,0x00,0x00,0x01,0x3F,0x85,0xFF,0xC0,0x00,0x00,0x7F,0xFF
8704 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF
8705 fcb 0xF7,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x00,0x1D,0x2A,0x07,0x80,0x00,0x00,0x7F,0xFF
8706 fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8707 fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0x06,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF
8708 fcb 0xFF,0xF0,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x1F,0xFF
8709 fcb 0xFF,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x01,0x17,0x3D,0x95,0x00,0x00,0x00,0x7F,0xFF
8710 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF,0x80,0x00,0x07,0xFF
8711 fcb 0xFF,0xFF,0xEF,0xF8,0x00,0x00,0x00,0x00,0x0E,0xEF,0xDA,0x00,0x00,0x00,0x7F,0xFF
8712 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF
8713 fcb 0xFF,0xFF,0xF7,0xF0,0x00,0x00,0x00,0x00,0x15,0xF7,0x80,0x00,0x00,0x00,0x7F,0xFF
8714 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF
8715 fcb 0xFF,0xFF,0xED,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xEC,0x00,0x00,0x00,0x7F,0xFF
8716 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8717 fcb 0xFF,0xFF,0xDC,0xE0,0x00,0x00,0x00,0x00,0x17,0x7F,0xD8,0x00,0x00,0x00,0x7F,0xFF
8718 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF
8719 fcb 0xFF,0xFF,0xBC,0xC0,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF
8720 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF
8721 fcb 0xFF,0xFF,0xDE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF
8722 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF
8723 fcb 0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF
8724 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF
8725 fcb 0xFF,0xFB,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF
8726 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xDF
8727 fcb 0xFE,0xC1,0xF2,0x00,0x00,0x00,0x00,0x18,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF
8728 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x83
8729 fcb 0x00,0x1F,0xCC,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF
8730 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0x00
8731 fcb 0x80,0x3F,0x98,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF
8732 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE2
8733 fcb 0x46,0x3E,0x60,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xE0,0x00,0x00,0x00,0x7F,0xFF
8734 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x80
8735 fcb 0x33,0x3C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xC0,0x60,0x00,0x00,0x00,0x7F,0xFF
8736 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xA0
8737 fcb 0x73,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x15,0x3A,0x80,0x00,0x00,0x00,0x7F,0xFF
8738 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0
8739 fcb 0x08,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xF6,0x00,0x00,0x00,0x00,0x7F,0xFF
8740 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0
8741 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x17,0xB6,0x00,0x00,0x00,0x00,0x7F,0xFF
8742 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8743 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xED,0x80,0x00,0x00,0x00,0x7F,0xFF
8744 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8745 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x05,0x2C,0x00,0x00,0x00,0x00,0x7F,0xFF
8746 fcb 0xFF,0xF0,0x00,0x00,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8747 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xB0,0x80,0x00,0x00,0x00,0x7F,0xFF
8748 fcb 0xFF,0xF0,0x00,0x00,0x70,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8749 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF
8750 fcb 0xFF,0xF0,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8751 fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF
8752 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8753 fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0xC0,0x00,0x00,0x00,0x7F,0xFF
8754 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8755 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF
8756 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8757 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF
8758 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8759 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF
8760 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8761 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8762 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8763 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8764 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8765 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8766 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8767 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8768 fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x3F,0xFF,0xCF,0x9F,0xFF,0xFF,0xFF,0x03,0xFF
8769 fcb 0xCC,0xFF,0xFF,0xF3,0xFF,0xFF,0xF8,0x1F,0xFE,0x0F,0xFF,0x8F,0xFF,0xFF,0x7F,0xFF
8770 fcb 0xFF,0xF7,0xFF,0xFF,0x18,0xFF,0xF3,0x3F,0xFF,0xCF,0xFF,0xFF,0xFF,0xFF,0xCF,0xFF
8771 fcb 0xCC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x7F,0xFE,0x7F,0xFF,0xCF,0xFF,0xFF,0x7F,0xFF
8772 fcb 0xFF,0xF7,0xFF,0xFF,0x00,0xFF,0xF3,0x31,0x9E,0x49,0x10,0xE1,0xFF,0xFF,0xCF,0xFF
8773 fcb 0xCC,0xC6,0x08,0x23,0x0F,0xFF,0xFE,0x7F,0xFE,0x7C,0x60,0xCC,0x70,0xFF,0x7F,0xFF
8774 fcb 0xFF,0xF7,0xFF,0xFF,0x24,0xFF,0xF0,0x3C,0xC0,0xC3,0x92,0x4F,0xFF,0xFF,0xCF,0xFF
8775 fcb 0xC0,0xF2,0x38,0xF2,0x7F,0xFF,0xFE,0x7F,0xFE,0x1F,0x23,0xC9,0x27,0xFF,0x7F,0xFF
8776 fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x30,0xC0,0xC7,0x92,0x63,0xFF,0xFF,0xCF,0xFF
8777 fcb 0xCC,0xC2,0x79,0xF3,0x1F,0xFF,0xFE,0x7F,0xFE,0x7C,0x27,0xC8,0x31,0xFF,0x7F,0xFF
8778 fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x24,0xE1,0xC3,0x92,0x79,0xFF,0xFF,0xCF,0xFF
8779 fcb 0xCC,0x92,0x79,0xF3,0xCF,0xFF,0xFE,0x7F,0xFE,0x79,0x27,0xC9,0xFC,0xFF,0x7F,0xFF
8780 fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0x9F,0xF3,0x30,0xE1,0xC9,0x92,0x43,0xFF,0xFF,0xCE,0x7F
8781 fcb 0xCC,0xC2,0x79,0xF2,0x1F,0xFF,0xFE,0x73,0xFE,0x0C,0x27,0xCC,0x61,0xFF,0x7F,0xFF
8782 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8783 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8784 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8785 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8786 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8787 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8788 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8789 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8790 fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8791 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF
8792 fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8793 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF
8794 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8795 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8796 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8797 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8798 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8799 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8800 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8801 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8802 AUTHPICe equ *
8803 ; Unused
8804 fcb 0xFF,0x00,0x00,0xA0,0x27,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8805 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8806 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8807 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8808 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8809 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8810 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8811 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8812 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8813 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8814 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8815 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xEF,0xFF,0xFF,0xFF,0xFF
8816 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8817 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8818 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8819 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8820 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8821 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8822 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8823 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8824 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8825 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8826 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8827 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8828 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8829 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8830 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8831 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8832 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8833 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8834 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8835 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8836 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8837 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8838 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8839 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8840 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8841 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8842 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8843 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8844 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8845 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8846 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8847 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8848 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8849 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8850 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF
8851 fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
8852 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8853 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8854 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8855 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8856 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8857 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8858 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8859 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8860 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8861 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8862 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8863 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8864 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x40,0x00
8865 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8866 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00
8867 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
8868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8869 ; The actual Super Extended Basic (SECB) extensions start here.
8870 ;
8871 ; Note that many routines in this area feature a "lbrn 0" instruction. This appears to be intended as a placeholder to allow
8872 ; patching into the routines similar to the RAM hooks in Color Basic except using direct overwiting of the instruction. It's
8873 ; completely pointless and probably illustrates that the writers of this code didn't really think through what they were doing.
8874 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8875 SUPERVAR fdb HRMODE ; address of direct page variables unique to SECB
8876 PRGTEXT fdb SETTEXT ; set video registers for text mode (indirect)
8877 PRGGRAPH fdb SETGRAPH ; set video registers for graphics mode (indirect)
8878 PRGMMU fdb SETMMU ; set MMU registers to their "default" (indirect)
8879 GETTEXT fdb SELTEXT ; put hi-res text screen in logical block 1 (indirect)
8880 GETBLOK0 fdb SELBLOK0 ; put block in B in logical block 0 (indirect)
8881 GETTASK0 fdb SELTASK0 ; re-select MMU task 0 (indirect)
8882 GETTAKS1 fdb SELTASK1 ; select MMU task 1(indirect)
8883 jmp LA05E ; execute non-self starting ROM
8884 SPARE0 fdb 0 ; undefined
8885 SPARE1 fdb 0 ; undefined
8886 SPARE2 fdb 0 ; undefined
8887 ; Set up video registers for the selected text screen. Given that the sets of video mode initializers are contiguous in
8888 ; memory, this would probably be better done with a simple sequence of MUL and ABX.
8889 SETTEXT pshs y,x,a ; save registers
8890 lbrn 0
8891 ldx #IM.TEXT ; point to 32 column video mode registers
8892 lda HRWIDTH ; get text mode
8893 beq SETVIDEO ; brif 32 column
8894 ldx #SE03B ; point to 40 column mode data
8895 cmpa #1 ; is it 40 column?
8896 beq SETVIDEO ; brif so
8897 ldx #SE044 ; assume 80 column
8898 bra SETVIDEO ; program video registers
8899 ; 32 column (VDG) initializer
8900 IM.TEXT fcb COCO+MMUEN+MC3+MC2 ; INIT0 (COCO bit enables VDG modes)
8901 fcb 0x00 ; VIDEOMOD (unused for VDG modes)
8902 fcb 0x00 ; VIDEORES (unused for VDG modes)
8903 fcb 0x00 ; V.BORDER (black)
8904 fcb 0x00 ; filler for reserved
8905 fcb 0x0f ; V.SCROLL - this value is needed to show a proper 12 lines per text row
8906 fdb 0xe000 ; V.OFFSET - SAM offsets operate in 0x7xxx
8907 fcb 0x00 ; H.OFFSET - no horizontal offset
8908 ; 40 column screen
8909 SE03B fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes)
8910 fcb 0x03 ; VIDEOMOD - 8 lines per row
8911 fcb 0x05 ; VIDEORES - 40 columns, attributes enabled, 192 lines per field
8912 fcb 0x12 ; V.BORDER - nuclear green
8913 fcb 0x00 ; filler for reserved
8914 fcb 0x00 ; V.SCROLL - no offset
8915 fdb 0xd800 ; V.OFFSET - screen at 0x6c000
8916 fcb 0x00 ; H.OFFSET - no offset
8917 ; 80 column screen
8918 SE044 fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes)
8919 fcb 0x03 ; VIDEOMOD - 8 lines per row
8920 fcb 0x15 ; VIDEORES - 80 columns, attributes enabled, 192 lines per field
8921 fcb 0x12 ; V.BORDER - nuclear green
8922 fcb 0x00 ; filler for reserved
8923 fcb 0x00 ; V.SCROLL - no offset
8924 fdb 0xd800 ; V.OFFSET - screen at 0x6c000
8925 fcb 0x00 ; H.OFFSET - no offset
8926 ; Set up video registers for the selected "HSCREEN" mode. Note that the two code paths for the resolution widths
8927 ; are unneeded.
8928 SETGRAPH pshs y,x,a ; save registers
8929 lbrn 0
8930 ldx #IM.GRAPH ; point to graphics initlializer
8931 ldy #RESTABLE ; point to resolution bytes table
8932 lda HRMODE ; get graphics mode
8933 cmpa #2 ; is it a 640 pixel mode?
8934 bls SE063 ; brif not
8935 ldx #SE079 ; point to 640 pixel registers
8936 SE063 suba #1 ; normalize mode numbers to start at 0
8937 lda a,y ; get resolution setting for this mode
8938 sta 2,x ; put it in the graphics mode initializer
8939 jmp SETVIDEO ; go set up video registers
8940 RESTABLE fcb 0x15 ; 320x192, 4 colours
8941 fcb 0x1e ; 320x192, 16 colours
8942 fcb 0x14 ; 640x192, 2 colours
8943 fcb 0x1d ; 640x192, 4 colours
8944 ; 320x192 graphics modes
8945 IM.GRAPH fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes)
8946 fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row
8947 fcb 0x00 ; VIDEORES - placeholder
8948 fcb 0x00 ; V.BORDER - black
8949 fcb 0x00 ; filler for reserved
8950 fcb 0x00 ; V.SCROLL - no offset
8951 fdb 0xc000 ; V.OFFSET - screen at 0x60000
8952 fcb 0x00 ; H.SCROLL - no offset
8953 ; 640x192 graphics modes (observe that these are identical to the 320x192 ones above)
8954 SE079 fcb MMUEN+MC3+MC2 ; INITo (disable VDG modes)
8955 fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row
8956 fcb 0x00 ; VIDEORES - placeholder
8957 fcb 0x00 ; V.BORDER - black
8958 fcb 0x00 ; filler for reserved
8959 fcb 0x00 ; V.SCROLL - no offset
8960 fdb 0xc000 ; V.OFFSET - screen at 0x60000
8961 fcb 0x00 ; H.SCROLL - no offset
8962 ; Program video registers and INIT0 from (X); enter with A,X,Y pre-saved
8963 SETVIDEO lda ,x+ ; set INIT0
8964 sta INIT0
8965 ldy #VIDEOMOD ; point to start of video mode registers
8966 SE08B lda ,x+ ; set a register
8967 sta ,y+
8968 cmpy #MMUREG ; done all of them?
8969 blo SE08B ; brif not
8970 puls a,x,y,pc ; restore registers and return
8971 ; Set MMU registers to their default values. All 16 of them.
8972 SETMMU pshs y,x,b,a ; save registers
8973 leax IM.MMU,pcr ; point to MMU initializer
8974 bsr SE0F1 ; program MMU registers
8975 puls a,b,x,y,pc ; restore registers and return
8976 ; Set logical block 0 to the physical block in B. This is embarassingly inefficient since it sets
8977 ; *all 16* MMU registers to change one of them. All the faffing about with pointers and the call
8978 ; to set the MMU registers is pointless. It could be done with a single STB.
8979 SELBLOK0 pshs y,x,b,a ; save registers
8980 leax IM.MMU,pcr ; point to MMU initializer
8981 pshs x ; save it for later
8982 stb ,x ; set desired block in initializer
8983 bsr SE0F1 ; program *all 16* MMU registers (stupid)
8984 ldb #BLOCK7.0 ; get correct block number for logical block 0
8985 puls x ; get back pointer to the initializer
8986 stb ,x ; restore initializer value
8987 puls a,b,x,y,pc ; restore registers and return
8988 ; Put hi-res text screen in logical address space block 1. This is embarassingly ineffecient since
8989 ; it sets *all 16* MMU registers to change only one. All the faffing about with pointers and the
8990 ; call to set the MMU registers is pointless. It could be done with a singel LD/ST sequence.
8991 SELTEXT pshs y,x,b,a ; save registers
8992 leax IM.MMU,pcr ; point to MMU initializer
8993 pshs x ; save pointer for later
8994 ldb #BLOCK6.6 ; get block number for text screen
8995 stb 1,x ; put in logical block 1 of initializer
8996 bsr SE0F1 ; program *all 16* MMU registers (stupid)
8997 puls x ; get back pointer
8998 ldb #BLOCK7.1 ; get proper block for logical block 1
8999 stb 1,x ; put it back in the initializer
9000 puls a,b,x,y,pc ; restore registers and return
9001 ; Get block 6.4 (HBUFF buffers) to logical block 6 of task 1. This is embarassingly inefficient
9002 ; since it sets *all 16* MMU registers to change only one. All the faffing about with pointers and
9003 ; the call to set the MMU registers ispointless. It could be done with a single LD/ST sequence.
9004 SE0CB pshs y,x,b,a ; save registers
9005 leax IM.MMU,pcr ; point to MMU initializer
9006 pshs x ; save pointer for later
9007 ldb #BLOCK6.4 ; get block for the HBUFF buffers
9008 stb 14,x ; put in logical block 6, task 1
9009 bsr SE0F1 ; program *all 16* MMU registers (stupid)
9010 puls x ; get back pointer
9011 ldb #BLOCK6.5 ; get default block for logical block 6 of task 1
9012 stb 14,x ; put it back in the initializer
9013 puls a,b,x,y,pc ; restore registers and return
9014 ; MMU initializer
9015 IM.MMU fcb BLOCK7.0,BLOCK7.1,BLOCK7.2,BLOCK7.3 ; task 0: map 0x70000-0x7ffff
9016 fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7
9017 fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2 ; task 1: put hires gfx at 0x2000 and a stack block at 0xc000
9018 fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7
9019 ; Set all 16 MMU registers from the initializer pointed to by X.
9020 SE0F1 ldy #MMUREG ; point to MMU registers
9021 ldb #16 ; there are 16 to set
9022 SE0F7 lda ,x+ ; set a register
9023 sta ,y+
9024 decb ; done all?
9025 bne SE0F7 ; brif not
9026 rts
9027 ; Select task register 0 as the active MMU set. Enter with stack in a temporary location which
9028 ; holds the original stack pointer. Note that the return could be done simply as jmp [V42] instead
9029 ; of pushing the return address onto the stack. Interrupts will be enabled on the way out.
9030 SELTASK0 std V40 ; temp save D
9031 ldd ,s ; get return address
9032 std V42 ; save it
9033 ldd 2,s ; get original stack pointer
9034 std V44 ; save it
9035 clrb ; reset INIT1 to task 0 (and slow timer), could just be CLR INIT1
9036 stb INIT1
9037 lds V44 ; restore original stack pointer
9038 ldd V42 ; get back return address
9039 pshs d ; set return address on stack
9040 ldd V40 ; get back original D
9041 andcc #0xaf ; re-enable interrupts
9042 rts
9043 ; Select task register 1 as the active MMU set. Exit with interrupts disabled and the original
9044 ; stack pointer saved at the top of the temporary stack. Note that jmp [V42] could be used to
9045 ; return instead of pushing the return address back on the stack.
9046 SELTASK1 orcc #0x50 ; disable interrupts
9047 std V40 ; temp save D
9048 puls d ; get return address
9049 std V42 ; save it
9050 sts V44 ; save stack pointer
9051 ldb #1 ; set to enable task 1, slow timer input
9052 stb INIT1
9053 lds #TMPSTACK ; point to temporary stack location (top of the C000-Dfff range)
9054 ldd V44 ; get old stack pointer
9055 pshs d ; stash it
9056 ldd V42 ; put original return address back
9057 pshs d
9058 ldd V40 ; restore original D
9059 rts
9060 ; Tokenziation patch
9061 ALINK2 tst V41 ; is it a function token?
9062 bne SE152 ; brif so
9063 lda V42 ; get token value
9064 cmpa #0x62 ; have we reached the first SECB token?
9065 bls SE148 ; brif not
9066 ldu #COMVEC-5 ; point to function table and go again
9067 jmp LB8D7 ; re-enter mainline code
9068 SE148 lda #0x62 ; force tokens to start at the correct number (above Disk Basic)
9069 ldu #EBCOMTAB-10 ; point to SECB command table
9070 SE14D sta V42 ; set token counter to SECB values
9071 jmp LB89D ; re-enter mainstream still in command mode
9072 SE152 lda V42 ; get token number
9073 cmpa #0x29 ; have we run through SECB functions yet?
9074 bls SE15B ; brif not
9075 jmp LB8D7 ; re-enter mainline code (end of processing)
9076 SE15B lda #0x29 ; force token into SECB range (this leaves one unused)
9077 ldu #EBCOMTAB-5 ; point to SECB function table
9078 bra SE14D ; go transfer control back to mainline with new settings
9079 EBCOMTAB fcb 23 ; number of keywords (commands)
9080 fdb COMDIC20 ; keyword table (commands)
9081 fdb ALINK4 ; interpretation handler (commands)
9082 fcb 5 ; number of keywords (functions)
9083 fdb FUNDIC20 ; keyword table (functions)
9084 fdb ALINK5 ; interpretation handler (functions)
9085 fcb 0x00,0x00,0x00,0x00,0x00,0x00 ; marker for no further tables
9086 ; Detokenization patch. This routine has a bug. It freezes if an unknown token is encountered instead
9087 ; of using the placeholder.
9088 ALINK3 leau 10,u ; move to next table
9089 tst ,u ; valid table?
9090 lbne LB7F9 ; brif so - re-enter mainline code
9091 leax -1,x ; get token number
9092 lda ,x+
9093 anda #0x7f ; remove token bias
9094 cmpa #0x62 ; SECB command?
9095 blo SE18B ; brif not
9096 suba #0x62 ; zero-base SECB token number
9097 ldu #EBCOMTAB-10 ; point to command table
9098 bra ALINK3 ; go try again
9099 SE18B suba #0x29 ; zero-base function token
9100 ldu #EBCOMTAB-5 ; point to SECB function table
9101 bra ALINK3 ; go try again
9102 ; Command interpretation patch
9103 ALINK4 cmpa #0xe2 ; is it within the SECB range?
9104 blo SE19A ; brif not (below)
9105 cmpa #0xf8 ; is it above range?
9106 bls SE19E ; brif not - we have a SECB command
9107 SE19A jmp [COMVEC+23] ; transfer control onward to Disk Basic
9108 SE19E suba #0xe2 ; normalize SECB commands to 0
9109 ldx #COMDIS20 ; point to jump table for SECB commands
9110 jmp LADD4 ; go dispatch command
9111 ; Function processing patch
9112 ALINK5 cmpb #0x29*2 ; is it an SECB function?
9113 blo SE1AE ; brif not (below)
9114 cmpb #0x2d*2 ; is it still an SECB function?
9115 bls SE1B2 ; brif so
9116 SE1AE jmp [COMVEC+28] ; transfer control to Disk Basic
9117 SE1B2 subb #0x29*2 ; normalize SECB functions to 0
9118 cmpb #2*2 ; do we need to parse a parameter?
9119 bhs SE1BF ; brif not
9120 pshs b ; save token offset
9121 jsr LB262 ; parse parenthetical expression
9122 puls b ; get back token offset
9123 SE1BF ldx #FUNDIS20 ; point to jump table for SECB functions
9124 jmp LB2CE ; go dispatch function call
9125 ; Keyword table (commands) for SECB
9126 COMDIC20 fcs 'WIDTH' ; 0xe2
9127 fcs 'PALETTE' ; 0xe3
9128 fcs 'HSCREEN' ; 0xe4
9129 fcs 'LPOKE' ; 0xe5
9130 fcs 'HCLS' ; 0xe6
9131 fcs 'HCOLOR' ; 0xe7
9132 fcs 'HPAINT' ; 0xe8
9133 fcs 'HCIRCLE' ; 0xe9
9134 fcs 'HLINE' ; 0xea
9135 fcs 'HGET' ; 0xeb
9136 fcs 'HPUT' ; 0xec
9137 fcs 'HBUFF' ; 0xed
9138 fcs 'HPRINT' ; 0xee
9139 fcs 'ERR' ; 0xef
9140 fcs 'BRK' ; 0xf0
9141 fcs 'LOCATE' ; 0xf1
9142 fcs 'HSTAT' ; 0xf2
9143 fcs 'HSET' ; 0xf3
9144 fcs 'HRESET' ; 0xf4
9145 fcs 'HDRAW' ; 0xf5
9146 fcs 'CMP' ; 0xf6
9147 fcs 'RGB' ; 0xf7
9148 fcs 'ATTR' ; 0xf8
9149 ; Jump table for SECB commands
9150 COMDIS20 fdb WIDTH ; 0xe2 WIDTH
9151 fdb PALETTE ; 0xe3 PALETTE
9152 fdb HSCREEN ; 0xe4 HSCREEN
9153 fdb LPOKE ; 0xe5 LPOKE
9154 fdb HCLS ; 0xe6 HCLS
9155 fdb HCOLOR ; 0xe7 HCOLOR
9156 fdb HPAINT ; 0xe8 HPAINT
9157 fdb HCIRCLE ; 0xe9 HCIRCLE
9158 fdb HLINE ; 0xea HLINE
9159 fdb HGET ; 0xeb HGET
9160 fdb HPUT ; 0xec HPUT
9161 fdb HBUFF ; 0xed HBUFF
9162 fdb HPRINT ; 0xee HPRINT
9163 fdb ERR ; 0xef ERR (should be LB277)
9164 fdb BRK ; 0xf0 BRK (should be LB277)
9165 fdb LOCATE ; 0xf1 LOCATE
9166 fdb HSTAT ; 0xf2 HSTAT
9167 fdb HSET ; 0xf3 HSET
9168 fdb HRESET ; 0xf4 HRESET
9169 fdb HDRAW ; 0xf5 HDRAW
9170 fdb CMP ; 0xf6 CMP
9171 fdb RGB ; 0xf7 RGB
9172 fdb ATTR ; 0xf8 ATTR
9173 ; Keyword table for SECB functions
9174 FUNDIC20 fcs 'LPEEK' ; 0xa9
9175 fcs 'BUTTON' ; 0xaa
9176 fcs 'HPOINT' ; 0xab
9177 fcs 'ERNO' ; 0xac
9178 fcs 'ERLIN' ; 0xad
9179 ; Jump table for SECB functions
9180 FUNDIS20 fdb LPEEK ; 0xa9 LPEEK
9181 fdb BUTTON ; 0xaa BUTTON
9182 fdb HPOINT ; 0xab HPOINT
9183 fdb ERNO ; 0xac ERNO
9184 fdb ERLIN ; 0xad ERLIN
9185 ; Signon message patch
9186 ALINK12 ldx #L80E8-1 ; point to ECB's message
9187 jsr STRINOUT ; display it
9188 ldx #MWAREMS-1 ; point to Microware string
9189 jsr STRINOUT ; display it
9190 jmp L80B8 ; return to mainline code
9191 ; Signon message patch for Disk Basic 1.0
9192 ALINK28 ldx #DISK20MS-1 ; point to modified message
9193 jmp DC0DC-19 ; return to mainline code
9194 ; Signon message patch for Disk Basic 1.1
9195 ALINK29 ldx #DISK21MS-1 ; point to modified message
9196 jmp DC0DC ; return to mainline code
9197 DISK20MS fcc 'DISK EXTENDED COLOR BASIC 2.0'
9198 fcb 0x0d
9199 fcc 'COPR. 1981, 1986 BY TANDY'
9200 fcb 0x0d
9201 fcc 'UNDER LICENSE FROM MICROSOFT'
9202 fcb 0x0d
9203 MWAREMS fcc 'AND MICROWARE SYSTEMS CORP.'
9204 fcb 0x0d,0x0d,0x00
9205 DISK21MS fcc 'DISK EXTENDED COLOR BASIC 2.1'
9206 fcb 0x0d
9207 fcc 'COPR. 1982, 1986 BY TANDY'
9208 fcb 0x0d
9209 fcc 'UNDER LICENSE FROM MICROSOFT'
9210 fcb 0x0d
9211 fcc 'AND MICROWARE SYSTEMS CORP.'
9212 fcb 0x0d,0x0d,0x00
9213 ; Extended Basic extra initialization patch
9214 ALINK14 clra ; set up to clear things
9215 clrb
9216 lbrn 0
9217 stb H.CRSATT ; reset cursor attributes
9218 std HRMODE ; reset to VDG screen and no HSCREEN graphics
9219 std H.ONBRK ; reset ON BRK destination
9220 std H.ONERR ; reset ON ERR destinatin
9221 sta H.BCOLOR ; default HSCREEN background to 0
9222 lda #1 ; default HSCREEN foreground to 1
9223 sta H.FCOLOR
9224 lda #BLOCK6.4 ; map the HGET/HPUT buffers
9225 sta MMUREG
9226 ldd #0xffff ; mark as empty
9227 std 0
9228 lda #BLOCK7.0 ; restore memory map
9229 sta MMUREG
9230 jmp LAD19 ; go finish initializing (NEW)
9231 ; ON command patch
9232 ALINK18 cmpa #0xef ; ERR?
9233 beq ERR ; brif so
9234 cmpa #0xf0 ; BRK?
9235 beq BRK ; brif so
9236 jsr EVALEXPB ; evaluate the ON index argument
9237 jmp LAF45 ; return to mainline code
9238 SE3C2 jsr GETNCH ; eat the ERR/BRK token
9239 cmpa #0x81 ; GO?
9240 bne SE3CF ; brif not
9241 jsr GETNCH ; eat the GO
9242 cmpa #0xa5 ; TO?
9243 bne SE3CF ; brif not
9244 rts
9245 SE3CF leas 2,s ; clean up stack (not needed)
9246 jmp LB277 ; raise syntax error
9247 ; ERR jumps here if used as a command
9248 ; NOTE: you can do ERR <char> GOTO (where <char> is a single character that doesn't prevent GOTO from being tokenized
9249 ERR bsr SE3C2 ; check for GOTO
9250 jsr GETNCH ; eat the "TO"
9251 jsr LAF67 ; evaluate destination line number
9252 ldd BINVAL ; get line number
9253 std H.ONERR ; set error destination
9254 ldd CURLIN ; get current line number
9255 std H.ONERRS ; save line number where ON ERR was executed
9256 rts
9257 ; BRK jump shere if used as a command.
9258 ; Same note as for ERR applies.
9259 BRK bsr SE3C2 ; check for GOTO
9260 jsr GETNCH ; eat the "TO"
9261 jsr LAF67 ; evaluate destination line number
9262 ldd BINVAL ; get line number
9263 std H.ONBRK ; set break destination
9264 ldd CURLIN ; get current line number
9265 std H.ONBRKS ; save line number where ON BRK was executed
9266 rts
9267 ; Patches for &H parsing
9268 ALINK6A lsl 2,x ; multiply accumulator by 2
9269 rol 1,x
9270 rol ,x
9271 lbcs LBA92 ; brif we overflowed
9272 decb ; done enough shifts?
9273 bne ALINK6A ; brif not
9274 suba #'0 ; remove ASCII bias
9275 adda 2,x ; add digit to accumulator (this cannot cause carry)
9276 sta 2,x
9277 rts
9278 ALINK6B lbcs L8800 ; brif numeric
9279 jmp L883F ; return to mainline
9280 ; Line input patch
9281 ALINK16 cmpa #3 ; is it BREAK?
9282 orcc #1 ; set C for BREAK
9283 bne SE426 ; brif not BREAK
9284 pshs a,cc ; save character and break status
9285 lda HRMODE ; is it graphics mode?
9286 beq SE424 ; brif not
9287 clr HRMODE ; disable graphics mode
9288 jsr SETTEXT
9289 SE424 puls cc,a ; get back BREAK status and character
9290 SE426 jmp LA3C6 ; return to mainline
9291 ; Break check patch
9292 ALINK15 cmpa #3 ; BREAK?
9293 beq SE430 ; brif so
9294 jmp LADF4 ; re-enter mainline
9295 SE430 lda #1 ; BREAK flag
9296 sta H.ERRBRK
9297 lda CURLIN ; immediate mode?
9298 inca
9299 beq SE43F ; brif so
9300 ldd H.ONBRK ; is ON BRK active?
9301 bne SE449 ; brif so
9302 SE43F lda HRMODE ; graphics m ode?
9303 beq SE446 ; brif not
9304 jsr SETTEXT ; set text mode
9305 SE446 jmp STOP ; go handle BREAK
9306 SE449 std BINVAL ; set destination line number
9307 tst H.ERRBRK ; error or break?
9308 bne SE458 ; brif break
9309 lds FRETOP ; reset stack pointer
9310 ldd #LADC4 ; return to main loop
9311 pshs d
9312 SE458 jsr LAEEB ; move to end of line
9313 leax 1,x ; move past line terminator
9314 ldd BINVAL ; get desired line number
9315 cmpd CURLIN ; is it here or later?
9316 bhi SE466 ; brif so
9317 ldx TXTTAB ; start search at beginning
9318 SE466 jsr LAD05 ; find program line
9319 lbcs SE51E ; brif not found
9320 jmp LAEBB ; reset input pointer and return to main loop
9321 ; Error handling patch
9322 ALINK20 clr H.ERRBRK ; flag error handling
9323 lda CURLIN ; immediate mode?
9324 inca
9325 beq SE47D ; brif so
9326 ldx H.ONERR ; is ON ERR in effect
9327 bne SE4B3 ; brif so
9328 SE47D pshs a ; save register
9329 lda HRMODE ; set flags on graphics mode
9330 puls a ; get back A
9331 beq SE488 ; brif not graphics mode
9332 jsr SETTEXT ; force text mode
9333 SE488 cmpb #38*2 ; HG error?
9334 bne SE49F ; brif not
9335 jsr LB95C ; do newline
9336 jsr LB9AF ; do ?
9337 leax BAS20ERR,pcr ; point to error string
9338 SE496 jsr LACA0 ; display two character error message
9339 jsr LACA0
9340 jmp LAC65 ; return to mainline code
9341 SE49F cmpb #39*2 ; HP error?
9342 bne SE4B0 ; brif not
9343 jsr LB95C ; do newline
9344 jsr LB9AF ; do ?
9345 leax BAS20ERR+2,pcr ; point to error string
9346 jmp SE496 ; go finish up
9347 SE4B0 jmp LAC49 ; return to mainline error handler
9348 SE4B3 stb H.ERROR ; save error number
9349 pshs b ; save error number
9350 ldd CURLIN ; get current line number
9351 std H.ERLINE ; save line number where error occurred
9352 puls b ; get back error number
9353 cmpb #3*2 ; OD error?
9354 bne SE4C7 ; brif not
9355 ldd BINVAL ; restore input pointer
9356 std CHARAD
9357 SE4C7 tfr x,d ; save error destination line
9358 lbra SE449 ; go transfer control to error handler
9359 BAS20ERR fcc 'HR' ; 38 Hi resolution graphics error
9360 fcc 'HP' ; 39 Hi resolutuion print error
9361 ; NEW handling patch
9362 ALINK19 pshs d ; save D
9363 clra ; set up to clear things
9364 clrb
9365 std OLDPTR ; reset CONT address
9366 std H.ONBRK ; reset ON BRK line
9367 std H.ONERR ; reset ON ERR line
9368 std H.ERLINE ; reset error source line
9369 lda #0xff ; set error number to -1
9370 sta H.ERROR
9371 puls d ; restore d
9372 jmp LAD43 ; return to mainline
9373 ; ERNO function
9374 ERNO clra ; zero extend error number
9375 ldb H.ERROR ; get error number
9376 cmpb #0xff ; real?
9377 bne SE4F4 ; brif so
9378 sex ; return "-1"
9379 bra SE4FA
9380 SE4F4 cmpb #0xf1 ; error number 0xf1?
9381 bne SE4F9 ; brif not
9382 comb ; turn it back into UL error
9383 SE4F9 asrb ; error numbers are pre-multiplied by 2 - undo that
9384 SE4FA jmp GIVABF ; return error number
9385 ; ERLIN function
9386 ERLIN ldd H.ERLINE ; get the line number where the error occurred
9387 bra SE4FA ; return it - BUG: will treat lines above 32767 as negative
9388 ; Immediate mode patch
9389 ALINK21 jsr SETTEXT ; force text mode
9390 jsr LB95C ; do line feed if needed
9391 orcc #0x50 ; disable interrupts
9392 lda #BLOCK6.4 ; map HGET/HPUT buffers
9393 sta MMUREG
9394 ldd #0xffff ; mark buffers empty
9395 std 0
9396 lda #BLOCK7.0 ; restore memory map
9397 sta MMUREG
9398 andcc #0xaf ; re-enable interrupts
9399 jmp LAC76 ; return to mainline
9400 ; Handle undefined line in ON ERR or ON BRK
9401 SE51E tst H.ERRBRK ; break?
9402 beq SE528 ; brif not
9403 ldd H.ONBRKS ; get line number where ON BRK is
9404 bra SE52B
9405 SE528 ldd H.ONERRS ; get line number where ON ERR is
9406 SE52B std CURLIN ; reset the current line number there
9407 ldb #7*2 ; undefined line number
9408 jmp LAC49 ; raise error (bypass ON ERR check)
9409 ; INPUT patch
9410 ALINK17 ldd H.ONBRK ; is ON BRK operating?
9411 lbeq LAE11 ; brif not
9412 pshs d ; save destination line
9413 lda #1 ; set BREAK flag
9414 sta H.ERRBRK
9415 puls d ; get destination line
9416 lbra SE449 ; go handle ON BRK in INPUT
9417 ; LPOKE command
9418 LPOKE jsr LB141 ; evaluate numeric expression (address)
9419 lbrn 0
9420 bsr SE58E ; convert to extended address
9421 cmpb #BLOCK7.7 ; valid block number?
9422 lbhi LB44A ; brif not
9423 pshs x,b ; save block and offset
9424 jsr SYNCOMMA ; require a comma
9425 jsr EVALEXPB ; evaluate value to put in memory
9426 tfr b,a ; save value in A
9427 puls b,x ; get back block and offset
9428 cmpb #BLOCK7.7 ; valid block (we already tested this!!)
9429 lbhi LB44A ; brif not
9430 orcc #0x50 ; clobber interrupts
9431 lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers)
9432 sta ,x ; save byte in memory
9433 lbsr SETMMU ; unmap block (by writing *all 16* MMU registers)
9434 andcc #0xaf ; re-enable interrupts
9435 rts
9436 ; LPEEK function
9437 LPEEK bsr SE58E ; convert to block and offset
9438 lbrn 0
9439 cmpb #BLOCK7.7 ; valid block?
9440 lbhi LB44A ; brif not
9441 orcc #0x50 ; clobber interrupts
9442 lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers)
9443 ldb ,x ; get memory contents
9444 lbsr SETMMU ; restore map (by writing *all 16* MMU registers)
9445 andcc #0xaf ; re-enable interrupts
9446 jmp LB4F3 ; return B as unsigned
9447 SE58E pshs a ; save register
9448 lda FP0EXP ; is it in range for 0x80000?
9449 cmpa #0x93
9450 bls SE59A ; brif so
9451 ldb #BLOCK7.7+1 ; return illegal block number
9452 bra SE5AF
9453 SE59A jsr LBCC8 ; shift binary point to right of mantissa
9454 ldd FPA0+2 ; get low bits
9455 anda #0x1f ; mask off block number bits
9456 tfr d,x ; now X has the block offset
9457 ldd FPA0+1 ; get high bits
9458 asra ;* shift block number to the right of B; note that
9459 rorb ;* asr *should* be lsr but it works here because of
9460 asra ;* the maximum range of the value
9461 rorb
9462 asra
9463 rorb
9464 asra
9465 rorb
9466 asra
9467 rorb
9468 SE5AF puls a,pc ; restore registers and return
9469 ; BUTTON command
9470 BUTTON jsr INTCNV ; get button number
9471 lbrn 0
9472 cmpb #3 ; button number in range?
9473 lbhi LB44A ; raise error if not
9474 tfr b,a ; save button number
9475 clrb ; set B to 0xff (strobe no keyboard columns)
9476 comb
9477 ldx #PIA0 ; point to PIA0
9478 stb 2,x ; strobe nothing
9479 ldb ,x ; get button data
9480 cmpb #0x0f ; buttons are on bottom four rows
9481 beq SE5EA ; brif no buttons down
9482 leax SE5D5,pcr ; point to button mask routines
9483 asla ; four bytes per button routine
9484 asla
9485 jmp a,x ; jump to appropriate routine
9486 SE5D5 andb #1 ; keep button 1, right joystick
9487 bra SE5E3
9488 andb #4 ; keep button #1, left joystick
9489 bra SE5E3
9490 andb #2 ; keep button #2, right joystick
9491 bra SE5E3
9492 andb #8 ; keep button #2, left joystick
9493 SE5E3 bne SE5EA ; brif button was not down
9494 ldd #1 ; return nonzero if button down
9495 bra SE5EC ; return result
9496 SE5EA clra ; return zero if not down
9497 clrb
9498 SE5EC jsr GIVABF ; return result
9499 rts
9500 ; PALETTE command
9501 PALETTE cmpa #0xf7 ; RGB?
9502 lbrn 0
9503 bne SE600 ; brif not
9504 jsr GETNCH ; munch the RGB
9505 SE5FA leax IM.RGB,pcr ; point to RGB palette initializer
9506 bra SE634 ; go set palette registers
9507 SE600 cmpa #0xf6 ; CMP?
9508 bne SE60C ; brif not
9509 jsr GETNCH ; eat the CMP
9510 SE606 leax IM.CMP,pcr ; point to CMP palette initializer
9511 bra SE634 ; go set palette registers
9512 SE60C jsr SE7B2 ; evaluate two expressions
9513 ldx #PALETREG ; point to palette registers
9514 ldy #IM.PALET ; point to palette register images
9515 lda BINVAL+1 ; get palette number
9516 cmpa #16 ; valid entry?
9517 lbhs LB44A ; brif not 0-15
9518 leax a,x ; offset the pointers to the right entries
9519 leay a,y
9520 ldb VERBEG+1 ; get colour number
9521 cmpb #63 ; valid?
9522 bls SE62A ; brif so
9523 ldb #63 ; maximize to 63 (white)
9524 SE62A orcc #0x50 ; disable interrupts
9525 sync ; synchronize to VSYNC
9526 stb ,x ; set palette register
9527 stb ,y ; record it in image
9528 andcc #0xaf ; restore interrupts
9529 rts
9530 SE634 pshs x ; save source pointer
9531 ldy #IM.PALET ; point to palette register live image
9532 bsr SE648 ; copy source to the live image
9533 puls x ; get source back
9534 ldy #PALETREG ; point to palette registers
9535 orcc #0x50 ; disable interrupts
9536 sync ; synchronize to VSYNC
9537 bsr SE648 ; copy the colour values into the palette registers
9538 rts
9539 SE648 ldb #16-1 ; BUG: should be 16 - this doesn't set register #15
9540 SE64A lda ,x+ ; set a register
9541 sta ,y+
9542 decb ; done all?
9543 bne SE64A ; brif not
9544 andcc #0xaf ; re-enable interrupts
9545 rts
9546 IM.CMP fcb 18,36,11,7,63,31,9,38 ; palette values for CMP
9547 fcb 0,18,0,63,0,18,0,38
9548 IM.RGB fcb 18,54,9,36,63,27,45,38 ; palette values for RGB
9549 fcb 0,18,0,63,0,18,0,38
9550 ; CMP and RGB commands just jump to the relevant implementations above
9551 RGB bra SE5FA
9552 CMP bra SE606
9553 IM.PALET fcb 18,36,11,7,63,31,9,38 ; live palette images
9554 fcb 0,18,0,63,0,18,0,38
9555 ; HSCREEN command
9556 HSCREEN cmpa #0 ; end of line? BUG: won't work if colon terminates the command
9557 lbrn 0
9558 bne SE693 ; brif not end of line
9559 clrb ; default to HSCREEN 0 - turn off graphics
9560 bra SE69C
9561 SE693 jsr EVALEXPB ; evaluate HSCREEN argument
9562 cmpb #4 ; only 4 HSCREEN modes
9563 lbhi LB44A ; brif out of range
9564 SE69C stb HRMODE ; set graphics mode
9565 cmpb #0 ; HSCREEN 0?
9566 bne SE6A5 ; brif not
9567 jmp SETTEXT ; set text mode (disable graphics)
9568 SE6A5 stb HRMODE ; set graphics mode (we already did!)
9569 ldx #SE6CB ; point to bytes/row table
9570 subb #1 ; normalize mode to 0
9571 lda b,x ; get bytes per row value
9572 sta HORBYT ; set it
9573 cmpb #1 ; is it 1 or 2?
9574 bgt SE6B9 ; brif not
9575 ldd #160 ; default coordinate for middle of 320 screen
9576 bra SE6BC
9577 SE6B9 ldd #320 ; default coordainte for middle of 640 screen
9578 SE6BC std HORDEF ; set default horizontal coordinate
9579 ldd #96 ; set default vertical coordinate to middle
9580 std VERDEF
9581 ldb H.BCOLOR ; get background colour
9582 bsr CLRHIRES ; clear hi-res graphics screen
9583 jmp SETGRAPH ; set up to display the screen
9584 SE6CB fcb 80,160,80,160 ; bytes per row values for HSCREEN 1 through 4
9585 ; HCLS command
9586 HCLS bne SE6D6 ; brif not end of statement
9587 ldb H.BCOLOR ; get background colour as default
9588 bra CLRHIRES ; go clear screen
9589 SE6D6 bsr SE70E ; evaluate colour number
9590 CLRHIRES tst HRMODE ; graphics mode?
9591 beq SE6EF ; brif not
9592 bsr PIXELFIL ; get all pixels set byte
9593 jsr SELTASK1 ; swap screen in
9594 ldx #HRESSCRN ; point to start of screen
9595 SE6E4 stb ,x+ ; set a byte worth of pixels
9596 cmpx #HRESSCRN+0x8000 ; end of graphics memory?
9597 bne SE6E4 ; brif not
9598 jsr SELTASK0 ; restore memory map
9599 rts
9600 SE6EF ldb #38*2 ; code for HR error
9601 jmp LAC46 ; raise error
9602 ; HCOLOR command
9603 HCOLOR cmpa #', ; was a foreground colour given?
9604 lbrn 0
9605 beq SE705 ; brif not
9606 bsr SE70E ; evaluate colour number
9607 stb H.FCOLOR ; save foreground colour
9608 jsr GETCCH ; is there something after the foreground?
9609 beq SE70D ; brif not
9610 SE705 jsr SYNCOMMA ; insist on a comma
9611 bsr SE70E ; evaluate colour number
9612 stb H.BCOLOR ; set background colour
9613 SE70D rts
9614 ; Evaluate a colour number and make sure it's between 0 and 15 inclusive
9615 SE70E jsr EVALEXPB ; evaluate colour
9616 SE711 cmpb #16 ; is it in range?
9617 lbhs LB44A ; brif not
9618 rts
9619 SE718 jsr SE731 ; set working colour and pixel bytes to default
9620 jsr GETCCH ; is there a colour number?
9621 beq SE72F ; brif not
9622 cmpa #') ; )?
9623 beq SE72F ; brif so - no colour
9624 jsr SYNCOMMA ; insist on a comma
9625 cmpa #', ; another comma?
9626 beq SE72F ; brif so - colour not specified
9627 jsr SE70E ; evaluate colour
9628 bsr SE73B ; set working colour and pixel bytes
9629 SE72F jmp GETCCH ; get current character and return
9630 SE731 ldb H.FCOLOR ; get foreground colour
9631 tst SETFLG ; doing set?
9632 bne SE73B ; brif so
9633 ldb H.BCOLOR ; use background colour if doing reset
9634 SE73B stb WCOLOR ; save working colour
9635 bsr PIXELFIL ; get all pixel byte
9636 stb ALLCOL ; save all pixel byte
9637 rts
9638 ; Return B with all pixels set to colour number in B
9639 PIXELFIL pshs x ; save registers
9640 lda HRMODE ; get graphics mode
9641 suba #1 ; normalize mode numbers to start at 0
9642 ldx #SE759 ; point to colour masks
9643 andb a,x ; now B has only the relevant low bits of colour number
9644 lda HRMODE ; get graphics mode
9645 suba #1 ; normalize mode numbers to start at 0
9646 ldx #SE75D ; point to multiplier table
9647 lda a,x ; get multplier
9648 mul ; now B has all pixels set
9649 puls x,pc ; restore registers and return
9650 SE759 fcb 0x03,0x0f,0x01,0x03 ; colour masks to keep only necessary low bits
9651 SE75D fcb 0x55,0x11,0xff,0x55 ; multipliers to duplicate colour value across all pixels
9652 ; HSET command
9653 HSET lda #1 ; HSET flag
9654 bra SE76A
9655 ; HRESET command
9656 HRESET clra ; HRESET flag
9657 lbrn 0
9658 SE76A tst HRMODE ; are we in a graphics mode?
9659 beq SE6EF ; brif not - raise error
9660 sta SETFLG ; save our set/reset state
9661 jsr LB26A ; insist on (
9662 jsr SE7AA ; evaluate coordindates
9663 tst SETFLG ; resetting?
9664 bne SE77F ; brif so
9665 jsr SE731 ; set working colour and pixel byte
9666 bra SE782
9667 SE77F jsr SE718 ; evaluate colour number if present
9668 SE782 jsr LB267 ; insist on a )
9669 jsr HCALPOS ; fetch screen pointer address and pixel mask
9670 SE788 jsr SELTASK1 ; map the screen
9671 jsr SE792 ; set or reset the pixel
9672 jsr SELTASK0 ; unmap the screen
9673 rts
9674 SE792 ldb ,x ; get byte on screen
9675 pshs b ; save it
9676 tfr a,b ; duplicate mask
9677 coma ; invert the mask for clearing the screen data
9678 anda ,x ; reset the pixel
9679 andb ALLCOL ; set pixel mask to correct colour
9680 pshs b ; merge pixel colour into screen data
9681 ora ,s+
9682 sta ,x ; put modified data on screen
9683 suba ,s+ ; nonzero if the screen changed
9684 ora CHGFLG ; merge with existing change flag
9685 sta CHGFLG
9686 rts
9687 SE7AA jsr SE7B2 ; evaluate coordinates
9688 SE7AD ldu #HORBEG ; point to horizontal coordinates
9689 SE7B0 rts ; dummy "normalization" routine
9690 rts ; pointles RTS
9691 ; Evaluate two expressions (usually coordinates)
9692 SE7B2 jsr LB734 ; evaluate two expressions, first in BINVAL, second in B
9693 ldy #HORBEG ; point to horizontal coordinates
9694 SE7B9 cmpb #192 ; in range vertically?
9695 blo SE7BF ; brif so
9696 ldb #191 ; set to maximum coordinate
9697 SE7BF clra ; zero extend vertical
9698 std 2,y ; set vertical coordinate
9699 lda HRMODE ; get graphics mode
9700 cmpa #2 ; is it 1 or 2?
9701 bgt SE7CD ; brif not
9702 ldd #319 ; maximum coordinate for modes 1 and 2
9703 bra SE7D0
9704 SE7CD ldd #639 ; maximum coordindate for modes 3 and 4
9705 SE7D0 cmpd BINVAL ; is our max less than the specified one?
9706 blo SE7D7 ; brif so - keep max
9707 ldd BINVAL ; use specified coordinate
9708 SE7D7 std ,y ; save horizontal coordinate
9709 rts
9710 ; Calculate pixel mask and memory address for pixel
9711 HCALPOS bsr SE7E6 ; point to correct routine for current mode
9712 jmp ,u ; execute it
9713 CALTABLE fdb G2BITPIX ; HSCREEN 1
9714 fdb G4BITPIX ; HSCREEN 2
9715 fdb G1BITPIX ; HSCREEN 3
9716 fdb G2BITPIX ; HSCREEN 4
9717 SE7E6 ldu #CALTABLE ; point to routine table
9718 lda HRMODE ; get graphicsmode
9719 suba #1 ; zero-base it
9720 asla ; two bytes per address
9721 ldu a,u ; get routine address
9722 rts
9723 PIX1MASK fcb 0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01 ; pixel masks for 1 bpp
9724 PIX2MASK fcb 0xc0,0x30,0x0c,0x03 ; pxiel masks for 2 bpp
9725 PIX4MASK fcb 0xf0,0x0f ; pixel masks for 4 bpp
9726 G1BITPIX pshs u,b ; save registers
9727 ldb HORBYT ; get bytes per row
9728 lda VERBEG+1 ; get vergical coord
9729 mul ; now D is the offset to the start of the row
9730 addd #HRESSCRN ; add in start of screen in memory
9731 tfr d,x ; put it in a pointer
9732 ldd HORBEG ; get horiztonal coordindate
9733 lsra ; 8 pixels per byte do divide by 8
9734 rorb
9735 lsra
9736 rorb
9737 lsra
9738 rorb
9739 leax d,x ; offset to correct byte row
9740 lda HORBEG+1 ; get pixel number
9741 anda #7 ; keep only byte offset
9742 ldu #PIX1MASK ; point to 1 bpp masks
9743 lda a,u ; get pixel mask
9744 puls b,u,pc ; restore registers and return
9745 G2BITPIX pshs u,b ; save registers
9746 ldb HORBYT ; get number of bytes per row
9747 lda VERBEG+1 ; get horizontal coordinate
9748 mul ; now D is the offset to the start of the row
9749 addd #HRESSCRN ; add in memory offset to the screen
9750 tfr d,x ; put that in a pointer
9751 ldd HORBEG ; get horizontal coordinate
9752 lsra ; 4 pixels per byte so divide by 4
9753 rorb
9754 lsra
9755 rorb
9756 leax d,x ; now X points to the correct memory byte
9757 lda HORBEG+1 ; get horizontal coordinate
9758 anda #3 ; keep only the pixel number in the byte
9759 ldu #PIX2MASK ; point to 2 bpp pixel masks
9760 lda a,u ; get mask for this pixel
9761 puls b,u,pc ; restore registers and return
9762 G4BITPIX pshs u,b ; save registers
9763 ldb HORBYT ; get bytes per row
9764 lda VERBEG+1 ; get vertical coordinate
9765 mul ; now D is the offset to the start of the row
9766 addd #HRESSCRN ; add in memory address of start of screen
9767 tfr d,x ; put it in a pointer
9768 ldd HORBEG ; get horizontal coordinate
9769 lsra ; divide by 2 - only 2 pixels per byte
9770 rorb
9771 leax d,x ; now X points to the memory address of the pixel
9772 lda HORBEG+1 ; get horiztonal coordinate
9773 anda #1 ; keep offset into byte
9774 ldu #PIX4MASK ; point to 4 bpp pixel masks
9775 lda a,u ; get pixel mask
9776 puls b,u,pc ; restore registers and return
9777 ; HPOINT function
9778 HPOINT tst HRMODE ; is there a graphics mode?
9779 lbeq SE6EF ; brif not - raise error
9780 jsr LB26A ; insist on (
9781 jsr SE7AA ; evaluate coordinates
9782 jsr LB267 ; insist on )
9783 jsr SELTASK1 ; map the screen
9784 jsr HCALPOS ; get screen pointer
9785 tfr a,b ; save mask
9786 andb ,x ; get pixel data
9787 SE875 lsra ; is the pixel aligned right?
9788 bcs SE87B ; brif so
9789 lsrb ; shift right
9790 bra SE875 ; see if it's aligned yet
9791 SE87B jsr LB4F3 ; return colour number
9792 jsr SELTASK0 ; restore memory map
9793 rts
9794 ; HLINE command
9795 HLINE tst HRMODE ; is there a graphics mode active?
9796 lbeq SE6EF ; brif not - raise error
9797 lbrn 0
9798 cmpa #'( ; is there (?
9799 beq SE899 ; brif so - we have start coords
9800 cmpa #0xac ; -?
9801 beq SE899 ; brif no start given
9802 ldb #'@ ; make sure it's @ if not
9803 jsr LB26F
9804 SE899 jsr SE9E1 ; get start/end coords
9805 ldx HOREND ; put end in the defaults
9806 stx HORDEF
9807 ldx VEREND
9808 stx VERDEF
9809 jsr SYNCOMMA ; make sure comma
9810 cmpa #0xbe ; PRESET?
9811 beq SE8B4 ; brif so
9812 cmpa #0xbd ; PSET?
9813 lbne LB277 ; brif not
9814 ldb #1 ; set flag
9815 skip1lda
9816 SE8B4 clrb ; reset flag
9817 pshs b ; save set/reset flag
9818 jsr GETNCH ; eat the PSET/PRESET token
9819 jsr SEA0D ; normalize start/end
9820 puls b ; get back set/reset flag
9821 stb SETFLG ; save set/reset flag
9822 jsr SE731 ; set active colour byte
9823 jsr GETCCH ; is there more?
9824 lbeq SE94E ; brif not - no box
9825 jsr SYNCOMMA ; insist on a comma
9826 ldb #'B ; insist on a B
9827 jsr LB26F
9828 bne SE8EB ; brif something after B
9829 bsr SE906 ; draw horizontal line (top)
9830 bsr SE931 ; draw vertical line (left)
9831 ldx HORBEG ; save horizontal start
9832 pshs x
9833 ldx HOREND ; set up to draw vertical line (right)
9834 stx HORBEG
9835 bsr SE931 ; draw vertical line (right)
9836 puls x ; restore start coord
9837 stx HORBEG
9838 ldx VEREND ; set up to draw horizontal line (bottom)
9839 stx VERBEG
9840 bra SE906 ; draw horizontal line (bottom) and return
9841 SE8EB ldb #'F ; insist on F
9842 jsr LB26F
9843 bra SE8F6 ; draw a filled box
9844 SE8F2 leax -1,x ; move vertical coordinate up one
9845 SE8F4 stx VERBEG ; save new vertical coordinate
9846 SE8F6 jsr SE906 ; draw horizontal line
9847 ldx VERBEG ; get current coordinate
9848 cmpx VEREND ; above or below end?
9849 beq SE905 ; brif done
9850 bhs SE8F2 ; brif below - move up
9851 leax 1,x ; move down (we're above)
9852 bra SE8F4 ; draw another line
9853 SE905 rts
9854 SE906 ldx HORBEG ; get starting coordinate
9855 pshs x ; save it
9856 jsr SE9DB ; get absolute horizontal difference
9857 bcc SE913 ; brif end > start
9858 ldx HOREND ; get ending coordinate
9859 stx HORBEG ; save as starting position
9860 SE913 tfr d,y ; save difference (pixel count)
9861 leay 1,y ; bump it (coords are inclusive)
9862 jsr HCALPOS ; calculate pixel address
9863 puls u ; get start coordinate
9864 stu HORBEG ; restore it
9865 lbsr SEA16 ; point to routine to move pixel pointer right
9866 SE921 sta VD7 ; save pixel mask
9867 jsr SE788 ; turn on pixel
9868 lda VD7 ; get back pixel mask
9869 jsr ,u ; move one pixel right
9870 leay -1,y ; done all pixels?
9871 bne SE921 ; brif not
9872 rts
9873 SE92F puls d ; clean up stack
9874 SE931 ldd VERBEG ; get vertical start
9875 pshs d ; save it
9876 jsr SE9CD ; calculate absolute vertical difference
9877 bcc SE93E ; brif end > start
9878 ldx VEREND ; swap coordinate
9879 stx VERBEG
9880 SE93E tfr d,y ; save difference (pixel count)
9881 leay 1,y ; coordinates are inclusive
9882 jsr HCALPOS ; get screen pointer
9883 puls u ; get original start coord
9884 stu VERBEG ; restore it
9885 lbsr SEA21 ; get routine to move down one row
9886 bra SE921 ; draw vertical line
9887 SE94E ldy #SE9B8 ; point to vertical increment routine
9888 jsr SE9CD ; calculate absolute vertical difference
9889 beq SE906 ; draw horizontal if difference is 0
9890 bcc SE95D ; brif vertical end > vertical start
9891 ldy #SE9C6 ; point to decrement vertical routine
9892 SE95D pshs b,a ; save vertical difference
9893 ldu #SE9B1 ; point to horitzontal increment routine
9894 jsr SE9DB ; calculate absolute horizontal difference
9895 beq SE92F ; draw vertical line if difference is 0
9896 bcc SE96C ; brif horizontal end > horizontal start
9897 ldu #SE9BF ; point to decrement horizontal routine
9898 SE96C cmpd ,s ; compare horiztonal difference with vertical difference
9899 puls x ; get vertical difference back
9900 bhs SE977 ; brif horizontal difference is greater
9901 exg u,y ; swap major/minor directions
9902 exg d,x
9903 SE977 pshs u,d ; save larger difference and incr/decr routine
9904 pshs d ; save larger difference
9905 lsra ; divide larger difference by 2
9906 rorb
9907 bcs SE988 ; brif odd
9908 cmpu #SE9B8+1 ; inc or dec?
9909 blo SE988 ; brif inc
9910 subd #1 ; move back of dec (round down)
9911 SE988 pshs x,d ; save smaller difference and inc/dec
9912 jsr SE7E6 ; point to screen address routine
9913 SE98D jsr ,u ; convert coordinates to screen address
9914 jsr SE788 ; turn on pxiel
9915 ldx 6,s ; done all?
9916 beq SE9AD ; brif so
9917 leax -1,x ; account for pixel just drawn
9918 stx 6,s
9919 jsr [8,s] ; bump coordinate
9920 ldd ,s ; get minor coordinate increment counter
9921 addd 2,s ; add to minor coordinate
9922 std ,s ; save new minor increment
9923 subd 4,s ; subtract largest difference
9924 bcs SE98D ; brif result not bigger than largest difference
9925 std ,s ; save new minor increment
9926 jsr ,y ; inc/dec minor
9927 bra SE98D ; draw another pixel
9928 SE9AD puls x ; clean up stack
9929 puls d,x,y,u,pc ; clean up stack and return
9930 SE9B1 ldx HORBEG ; bump horizontal coord
9931 leax 1,x
9932 stx HORBEG
9933 rts
9934 SE9B8 ldx VERBEG ; bump vertical coord
9935 leax 1,x
9936 stx VERBEG
9937 rts
9938 SE9BF ldx HORBEG ; reduce horizontal coord
9939 leax -1,x
9940 stx HORBEG
9941 rts
9942 SE9C6 ldx VERBEG ; reduce vertical coord
9943 leax -1,x
9944 stx VERBEG
9945 SE9CC rts
9946 SE9CD ldd VEREND ; get vertical end
9947 subd VERBEG ; get subtract start
9948 SE9D1 bcc SE9CC ; brif end > start
9949 pshs cc ; save flag for which is >
9950 nega ; negate difference
9951 negb
9952 sbca #0
9953 puls cc,pc ; restore status andreturn
9954 SE9DB ldd HOREND ; get horizontal end coord
9955 subd HORBEG ; subtract start coord
9956 bra SE9D1 ; handle going negative
9957 ; Evaluate two sets of coordinates
9958 SE9E1 ldx HORDEF ; set start to default
9959 stx HORBEG
9960 ldx VERDEF
9961 stx VERBEG
9962 cmpa #0xac ; -?
9963 beq SE9F0 ; brif so - use default start
9964 jsr SEA04 ; evaluate coordinate pair
9965 SE9F0 ldb #0xac ; insist on -
9966 jsr LB26F
9967 jsr LB26A ; insist on (
9968 jsr LB734 ; evaluate two expressions (X, B)
9969 ldy #HOREND ; point to end coords
9970 jsr SE7B9 ; validate end coords
9971 bra SEA0A ; handle rest of evaluation
9972 SEA04 jsr LB26A ; insist on (
9973 jsr SE7B2 ; evaluate coordinates with range check
9974 SEA0A jmp LB267 ; insist on )
9975 SEA0D jsr SE7AD ; "normalize" start
9976 ldu #HOREND ; point to end coords
9977 jmp SE7B0 ; "normalize" end
9978 ; Point U to routine to move pixel to right
9979 SEA16 ldu #SEA25 ; point to jump table
9980 ldb HRMODE ; get graphics mode
9981 subb #1 ; zero-base it
9982 aslb ; two bytes per entry
9983 ldu b,u ; get routine address
9984 rts
9985 SEA21 ldu #SEA45 ; point to routine to move down one row
9986 rts
9987 SEA25 fdb SEA34 ; HSCREEN 1 right
9988 fdb SEA3D ; HSCREEN 2 right
9989 fdb SEA2D ; HSCREEN 3 right
9990 fdb SEA34 ; HSCREEN 4 right
9991 SEA2D lsra ; move pixel mask right
9992 bcc SEA33 ; brif not changing bytes
9993 rora ; shift mask back around to left
9994 leax 1,x ; move byte forward
9995 SEA33 rts
9996 SEA34 lsra ; move one pixel right
9997 lsra
9998 bcc SEA33 ; brif same byte
9999 lda #0xc0 ; reset pixel mask
10000 leax 1,x ; move to next byte
10001 rts
10002 SEA3D coma ; flip pixels
10003 cmpa #0xf0 ; did we move to a new byte?
10004 bne SEA44 ; brif not
10005 leax 1,x ; move to next byte
10006 SEA44 rts
10007 SEA45 ldb HORBYT ; get number of bytes per row
10008 abx ; move ahead that many
10009 rts
10010 ; HCIRCLE command
10011 HCIRCLE tst HRMODE ; graphics mode?
10012 lbeq SE6EF ; brif not - raise error
10013 lbrn 0
10014 cmpa #'@ ; is there @ before coords?
10015 bne SEA59 ; brif not
10016 jsr GETNCH ; eat the @
10017 SEA59 jsr SEB60 ; get max coords for video mode
10018 jsr SEA04 ; parse centre coords
10019 jsr SE7AD ; normalize coordinates (ha ha)
10020 ldx ,u ; get horizontal coordinate
10021 stx VCB ; save it
10022 ldx 2,u ; get vertical coordinate
10023 stx VCD ; save it
10024 jsr SYNCOMMA ; insist on a comma
10025 jsr LB73D ; evaluate expression into X (radius)
10026 ldu #VCF ; point to temp storage area
10027 stx ,u ; save radius
10028 jsr SE7B0 ; normalize - pointless
10029 lda #1 ; put into "set" mode
10030 sta SETFLG
10031 jsr SE718 ; evaluate colour
10032 ldx #0x100 ; default H/W ratio (1:1)
10033 jsr GETCCH ; is the an HW ratio?
10034 beq SEA95 ; brif not
10035 jsr SYNCOMMA ; insist on comma
10036 jsr LB141 ; evaluate HW ratio
10037 lda FP0EXP ; multiply by 256
10038 adda #8
10039 sta FP0EXP
10040 jsr LB740 ; fetch HW ratio to X (with a fixed 8 bit fraction part)
10041 SEA95 lda HRMODE ; get graphics mode
10042 cmpa #2 ; is it a 320 mode?
10043 bhi SEA9F ; brif not
10044 tfr x,d ; double HW ratio for 320 modes
10045 leax d,x
10046 SEA9F stx VD1 ; save H/W ratio
10047 ldb #1 ; go into SET mode
10048 stb SETFLG
10049 stb VD8 ; flag for "first arc"
10050 jsr SEB7B ; evaluate start point (octant, subarc)
10051 pshs d ; save start point
10052 jsr SEB7B ; evaluate end point
10053 std VD9 ; save end point
10054 puls d ; get back start point
10055 SEAB3 pshs d ; save current circle position
10056 ldx HOREND ; switch previous end coords in as the start
10057 stx HORBEG
10058 ldx VEREND
10059 stx VERBEG
10060 ldu #CIRCDATA+2 ; point to sines/cosines table
10061 anda #1 ; is it an even octant?
10062 beq SEAC7 ; brif so
10063 negb ; swap arc order for odd octants
10064 addb #8
10065 SEAC7 aslb ; four bytes per table entry
10066 aslb
10067 leau b,u ; now U points to the correct entry
10068 pshs u ; save table entry
10069 jsr SEBBD ; calculate horizontal offset
10070 puls u ; get back table pointer
10071 leau -2,u ; move to other entry
10072 pshs x ; save horizontal offset
10073 jsr SEBBD ; calculaute vertical offset
10074 puls y ; get back horizontal offset
10075 lda ,s ; get octant number
10076 anda #3 ; is it 0 or 4?
10077 beq SEAE7 ; brif so
10078 cmpa #3 ; is it 3 or 7?
10079 beq SEAE7 ; brif so
10080 exg x,y ; swap horizontal and vertical otherwise
10081 SEAE7 stx HOREND ; save horizontal offset
10082 tfr y,d ; divide offset by 2
10083 lsra
10084 rorb
10085 ldx VD1 ; get H/W ratio
10086 jsr SEBCB ; multiply offset by ratio
10087 tfr y,d ; did MSB (bits 23-16) end up nonzero?
10088 tsta ; brif so - outside 16 bit range
10089 lbne LB44A ; brif so - raise error
10090 stb VEREND ; save vertical offset MSB
10091 tfr u,d ; get low bytes of result
10092 sta VEREND+1 ; save LSB (lose fractional part)
10093 lda ,s ; get octant number
10094 cmpa #2 ; 0 or 1?
10095 blo SEB13 ; brif so
10096 cmpa #6 ; 6 or h?
10097 bhs SEB13 ; brif so
10098 ldd VCB ; get horizontal center
10099 subd HOREND ; subtract offset (going left)
10100 bcc SEB20 ; brif we didn't go negative
10101 clra ; minimize to 0
10102 clrb
10103 bra SEB20
10104 SEB13 ldd VCB ; get horizontal centre
10105 addd HOREND ; add offset
10106 bcs SEB1E ; brif we overflowed
10107 cmpd VD3 ; did we overflow screen size?
10108 blo SEB20 ; brif not
10109 SEB1E ldd VD3 ; maximize horizontal coordinate
10110 SEB20 std HOREND ; save new horizontal coordinate
10111 lda ,s ; get octantnumber
10112 cmpa #4 ; is it 0-3 (bottom half)?
10113 blo SEB32 ; brif so
10114 ldd VCD ; get vertical centre
10115 subd VEREND ; subtract offset
10116 bcc SEB3F ; brif we didn't run past 0
10117 clra ; minimize to 0
10118 clrb
10119 bra SEB3F
10120 SEB32 ldd VCD ; get vertical centre
10121 addd VEREND ; add offset
10122 bcs SEB3D ; brif we overflowed
10123 cmpd VD5 ; did we go past end of screen?
10124 blo SEB3F ; brif not
10125 SEB3D ldd VD5 ; maximize to screen size
10126 SEB3F std VEREND ; save new vertical coord
10127 tst VD8 ; was this the first coordinate?
10128 bne SEB48 ; brif so - don't draw a line
10129 lbsr SE94E ; draw the subarc line
10130 SEB48 puls d ; get octant and arc
10131 lsr VD8 ; test if first point, and clear flag
10132 bcs SEB53 ; brif first coord
10133 cmpd VD9 ; at end of circle?
10134 beq SEB5F ; brif so
10135 SEB53 incb ; bump arc counter
10136 cmpb #8 ; done 8 subarcs?
10137 bne SEB5C ; brif not
10138 inca ; bump octant
10139 clrb ; reset arc counter
10140 anda #7 ; wrap octant number if needed
10141 SEB5C jmp SEAB3 ; move on with the next arc
10142 SEB5F rts
10143 SEB60 ldu #VD3 ; point to storage area
10144 ldx #639 ; set max horizontal coord for 640 mode
10145 stx ,u
10146 lda HRMODE ; get graphics mode
10147 cmpa #2 ; is it a 640 mode?
10148 bgt SEB73 ; brif so
10149 ldx #319 ; set max horzontalcoord for 320 mode
10150 stx ,u
10151 SEB73 ldx #191 ; all modes have a 191 vertical max
10152 stx 2,u
10153 jmp SE7B0 ; "normalize" coords
10154 SEB7B clrb ; default circle start/end to 0
10155 jsr GETCCH ; is there a fraction?
10156 beq SEB91 ; brif not
10157 jsr SYNCOMMA ; insist on a comma
10158 jsr LB141 ; evaluate circle fraction
10159 lda FP0EXP ; multiply by 64 (calculate # of 64ths)
10160 adda #6
10161 sta FP0EXP
10162 jsr LB70E ; fetch result as 8 bits unsigned
10163 andb #0x3f ; keep only the fraction part
10164 SEB91 tfr b,a ; copy fraction to A (for octant)
10165 andb #7 ; keep only arc number in B
10166 lsra ; shift octant number to right of A
10167 lsra
10168 lsra
10169 rts
10170 CIRCDATA fdb 0x0000,0x0001 ; subarc 0
10171 fdb 0xfec5,0x1919 ; subarc 1
10172 fdb 0xfb16,0x31f2 ; subarc 2
10173 fdb 0xf4fb,0x4a51 ; subarc 3
10174 fdb 0xec84,0x61f9 ; subarc 4
10175 fdb 0xe1c7,0x78ae ; subarc 5
10176 fdb 0xd4dc,0x8e3b ; subarc 6
10177 fdb 0xc5e5,0xa269 ; subarc 7
10178 fdb 0xb506,0xb506 ; subarc 8
10179 SEBBD ldx VCF ; get radius
10180 ldd ,u ; get sin/cos value
10181 beq SEBCA ; brif 0 - just use radius
10182 subd #1 ; subtract 1
10183 bsr SEBCB ; do the multiplication dance
10184 tfr y,x ; save result to X
10185 SEBCA rts
10186 SEBCB pshs u,y,x,b,a ; save registers and reserve storage
10187 clr 4,s ; clear high bits
10188 lda 3,s ; B*XL
10189 mul
10190 std 6,s ; save in partical result
10191 ldd 1,s ; A*XH
10192 mul
10193 addb 6,s ; add to partial product
10194 adca #0
10195 std 5,s
10196 ldb ,s ; A*XL
10197 lda 3,s
10198 mul
10199 addd 5,s ; add to partial product
10200 std 5,s
10201 bcc SEBEA
10202 inc 4,s
10203 SEBEA lda ,s ; A*XH
10204 ldb 2,s
10205 mul
10206 addd 4,s ; add to partial product
10207 std 4,s ; save final product bits
10208 puls a,b,x,y,u,pc ; save factors, retrieve result, and return
10209 ; HPAINT command
10210 HPAINT tst HRMODE ; do we have a grahpics mode?
10211 lbeq SE6EF ; brif not - raise error
10212 lbrn 0
10213 cmpa #'@ ; is there @ before the coords?
10214 bne SEC05 ; brif not
10215 jsr GETNCH ; eat the @
10216 SEC05 jsr SEA04 ; insist on (
10217 jsr SE7AD ; evaluate the coordinates
10218 lda #1 ; set up for "setting"
10219 sta SETFLG
10220 jsr SE718 ; evaluate colour code
10221 ldd WCOLOR ; get working colour and all pixels byte
10222 pshs d ; save them for later
10223 jsr GETCCH ; do we have a border colour?
10224 beq SEC1D ; brif not - use default
10225 jsr SE718 ; evaluate border colour
10226 SEC1D lda ALLCOL ; get border colour pixel byte
10227 sta VD8 ; save it
10228 puls d ; get paint colour details
10229 std WCOLOR ; restore them
10230 jsr SELTASK1 ; map the graphics screen
10231 clra ;* add a terminator block to the top of the stack
10232 pshs u,x,b,a ;* which is how HPAINT knows it's done
10233 jsr SEB60 ; get maximum coordinate values
10234 jsr SE7E6 ; point U to routine that selects a pixel
10235 stu VD9 ; save pixel selection routine address
10236 jsr SECBE ; paint from current coord to the left
10237 beq SEC47 ; brif no painting done - we started on the border
10238 jsr SED01 ; paint to the right
10239 lda #1 ; set up a record to paint down the screen
10240 sta VD7
10241 jsr SED2E
10242 neg VD7 ; set up a record to paint up the screen
10243 jsr SED2E
10244 SEC47 sts TMPSTK ; save stack pointer
10245 SEC4A tst CHGFLG ; see if a pixel changed
10246 bne SEC51 ; brif so
10247 lds TMPSTK ; get stack pointer back
10248 SEC51 puls a,b,x,u ; get data for the next line to handle
10249 clr CHGFLG ; flag nothing changed yet
10250 sts TMPSTK ; save new stack address
10251 leax 1,x ; add one to the start position
10252 STX HORBEG ; set it as the starting position
10253 stu VD1 ; save length of parent line
10254 sta VD7 ; save up/down flag
10255 beq SECBA ; brif up/down is 0 - end marker
10256 bmi SEC6A ; brif we're going up the screen
10257 incb ; bump vertical coord
10258 cmpb VD6 ; at end of screen?
10259 bls SEC6E ; brif not
10260 clrb ; wrap around - this will cause us to bail below
10261 SEC6A tstb ; is coord 0?
10262 beq SEC4A ; brif so - don't go upward
10263 decb ; move upward on the screen
10264 SEC6E stb VERBEG+1 ; save new vertical coordinate
10265 jsr SECBE ; paint to the left
10266 beq SEC86 ; brif no pixels changed
10267 cmpd #3 ; less than 3 painted?
10268 blo SEC80 ; brif so - no need to check for paintable data
10269 leax -2,x ; move coord left two
10270 jsr SED15 ; save block of paint data in the other direction (vertically)
10271 SEC80 jsr SED01 ; paint to the right
10272 SEC83 jsr SED2E ; save a block of paint data in the same direction
10273 SEC86 coma ; invert number of pixels painted (but "less 1")
10274 comb
10275 SEC88 addd VD1 ; add to length of parent line
10276 std VD1 ; now we have the new parent line length
10277 ble SECA5 ; brif parent line was shorter
10278 jsr SE9B1 ; bump horizontal
10279 jsr SECF1 ; check for border
10280 bne SEC9B ; brif not
10281 ldd #-1 ; count down
10282 bra SEC88 ; keep looking
10283 SEC9B jsr SE9BF ; move left
10284 jsr SED3A ; save horizontal coord
10285 bsr SECC7 ; paint to the right
10286 bra SEC83 ; save paint block and keep going
10287 SECA5 jsr SE9B1 ; bump horizontal coord
10288 leax d,x ; point to right of end of parent line
10289 stx HORBEG ; set as start coord
10290 coma ; negate pixel count (and subtract 2?)
10291 comb
10292 subd #1
10293 ble SECB7 ; brif line doesn't extend past right of parent
10294 tfr d,x ; save portion of line to the right as length
10295 bsr SED15 ; save block of paint data
10296 SECB7 jmp SEC4A ; go process more paint blocks
10297 SECBA jsr SELTASK0 ; unmap screen
10298 rts
10299 SECBE jsr SED3A ; point starting coord in end
10300 ldy #SE9BF ; point to dec horizontal
10301 bra SECCD ; paint line
10302 SECC7 ldy #SE9B1 ; point to incr horizontal coord
10303 jsr ,y ; skip first - already done
10304 SECCD ldu ZERO ; initial pixel counter to 0
10305 ldx HORBEG ; get starting coord
10306 SECD1 bmi SECEA ; brif off the left side
10307 cmpx VD3 ; at max value?
10308 bhi SECEA ; brif off right side
10309 pshs u,y ; save counter and inc/dec p ointer
10310 bsr SECF1 ; check for border
10311 beq SECE8 ; brif so - we're done
10312 jsr SE792 ; set pixel
10313 puls y,u ; restore count and inc/dec routine
10314 leau 1,u ; bump count
10315 jsr ,y ; adjust coord
10316 bra SECD1 ; go do another pixel
10317 SECE8 puls y,u ; get back counter and inc/dec pointer
10318 SECEA tfr u,d ; save paint counter in D and X
10319 tfr d,x
10320 subd ZERO ; set flags on counter
10321 rts
10322 SECF1 jsr [VD9] ; get address of pixel
10323 tfr a,b ; duplicate mask
10324 andb VD8 ; get pixel colour mask for the pixel
10325 pshs b,a ; save masks
10326 anda ,x ; merge in with pixel data on screen
10327 cmpa 1,s ; does it match? (Z set if so)
10328 puls a,b,pc ; restore masks and return
10329 SED01 std VCD ; save pixel count
10330 ldy HOREND ; get last horizontal coord
10331 bsr SED3A ; save current coord
10332 sty HORBEG ; start painting to right from the previous end
10333 bsr SECC7 ; go paint rightward
10334 ldx VCD ; get previous pixel count
10335 leax d,x ; now we have a total count for this line
10336 addd #1 ; bump it by one?
10337 rts
10338 SED15 std VCB ; save painted pixel count
10339 puls y ; get return address
10340 ldd HORBEG ; get start coord
10341 pshs x,d ; save start coord and line length
10342 lda VD7 ; get direction
10343 nega ; invert it
10344 SED20 ldb VERBEG+1 ; get vertical coordinate
10345 pshs b,a ; save direction and vertical coord
10346 pshs y ; put return address back
10347 ldb #6 ; make sure we didn't overflow the stack
10348 jsr SED3F
10349 ldd VCB ; get line length back
10350 rts
10351 SED2E std VCB ; save line length
10352 puls y ; get return address
10353 ldd HOREND ; get horizontal start
10354 pshs x,d ; save line length and horizontal coord
10355 lda VD7 ; get direction flag
10356 bra SED20 ; finish saving frame
10357 SED3A ldx HORBEG ; get start coord
10358 stx HOREND ; save it as end coord
10359 rts
10360 SED3F negb ; subtract B bytes from S
10361 leas b,s
10362 cmps #TMPSTACK-(0x2000+14) ; does it overflow? (14 extra is from the unused vectors at the top of the CB ROM area)
10363 lblo SED4E ; raise OM error if we did
10364 negb ; restore stack pointer
10365 leas b,s
10366 rts
10367 SED4E lds #TMPSTACK-2 ; reset stack (since we overflowed it)
10368 jsr SELTASK0 ; restore default memory map
10369 jmp LAC44 ; raise OM error
10370 ; HBUFF command
10371 HBUFF jsr LB73D ; evaluate buffer number to X
10372 lbrn 0
10373 cmpx #255 ; valid?
10374 lbhi LB44A ; brif not
10375 stx VD1 ; save buffer number
10376 beq SED72 ; don't get size if buffer 0 select
10377 jsr SYNCOMMA ; insist on a comma
10378 jsr LB73D ; evaluate size to X
10379 stx VD3 ; save buffer size
10380 SED72 jsr SE0CB ; map the buffers
10381 jsr SELTASK1
10382 ldd VD1 ; get buffer number
10383 tstb ; is it zero (not needed!)
10384 bne SED85 ; brif not
10385 ldd #0xffff ; clear all buffers
10386 std HRESBUFF
10387 bra SEDBD ; reset memory map and return
10388 SED85 ldy #HRESBUFF ; point to buffers
10389 ldd ,y ; get address of next block
10390 cmpd #0xffff ; empty buffer space?
10391 bne SED95 ; brif not
10392 bsr SEDC4 ; check for room in buffer space
10393 bra SEDB0 ; set up buffer
10394 SED95 ldb VD1+1 ; get buffer number
10395 SED97 cmpb 2,y ; is this buffer the same number?
10396 beq SEDD2 ; brif so - throw error
10397 ldu ,y ; get address of next buffer
10398 beq SEDA3 ; brif last buffer
10399 tfr u,y ; move on to next buffer
10400 bra SED97 ; see if we have a matching number here
10401 SEDA3 tfr y,u ; save start address to U
10402 ldd 3,y ; get size of last buffer
10403 leay 5,y ; move past header
10404 leay d,y ; move past buffer data
10405 bsr SEDC4 ; check for enough room
10406 sty ,u ; save pointer to the new buffer in previous header
10407 SEDB0 ldd #0 ; mark this as the last buffer
10408 std ,y
10409 ldb VD1+1 ; set buffer number
10410 stb 2,y
10411 ldd VD3 ; set buffer size
10412 std 3,y
10413 SEDBD jsr SELTASK0 ; restore memory map
10414 jsr SETMMU
10415 rts
10416 SEDC4 tfr y,x ; point X to the start of the buffer data
10417 leax 5,x
10418 ldd VD3 ; get length requested
10419 leax d,x ; point to end of new buffer
10420 cmpx #HRESBUFF+0x1f00 ; does it fit?
10421 bhi SEDD6 ; brif not
10422 rts
10423 SEDD2 ldb #9*2 ; code for redim array
10424 bra SEDD8
10425 SEDD6 ldb #6*2 ; code for out of memory
10426 SEDD8 lds #TMPSTACK-2 ; reset stack
10427 jsr SELTASK0 ; restore memory map
10428 jsr SETMMU
10429 jmp LAC46 ; raise error
10430 ; HGET command
10431 HGET ldx #SEEC0 ; point to HGET movement routine
10432 stx VD5 ; save it
10433 clrb ; flag for "GET"
10434 bra SEDF4 ; get on with things
10435 ; HPUT command
10436 HPUT ldx #SEEEF ; point to HPUT movement routine
10437 stx VD5 ; save it
10438 ldb #1 ; flag for "PUT"
10439 SEDF4 tst HRMODE ; check for graphics
10440 lbeq SE6EF ; brif not - raise error
10441 lbrn 0
10442 stb VD8 ; save GET/PUT flag
10443 cmpa #'@ ; is there @ before coords?
10444 bne SEE06 ; brif not
10445 jsr GETNCH ; eat the @
10446 SEE06 jsr SE9E1 ; evaluate box bounds
10447 jsr SYNCOMMA ; insist on a comma
10448 jsr EVALEXPB ; evaluate buffer number
10449 stb VD3 ; save buffer number
10450 clr VD4 ; default action to none
10451 jsr GETCCH ; is there an action flag?
10452 beq SEE38 ; brif not
10453 com VD4 ; flag for action flag specified
10454 jsr SYNCOMMA ; insist on a comma
10455 tst VD8 ; is it GET?
10456 bne SEE23 ; brif not
10457 lbra LB277 ; raise error
10458 SEE23 ldb #5 ; 5 possible actions
10459 ldx #SEEE0 ; point to action routine table address
10460 SEE28 ldu ,x++ ; get routine address
10461 cmpa ,x+ ; does the action match?
10462 beq SEE34 ; brif so
10463 decb ; checked all of them?
10464 bne SEE28 ; brif not
10465 jmp LB277 ; raise error
10466 SEE34 stu VD5 ; save action address
10467 jsr GETNCH ; eat the action token
10468 SEE38 jsr SE0CB ; map the buffers and screen
10469 jsr SELTASK1
10470 ldb VD3 ; get buffer number
10471 jsr SEF18 ; find the correct buffer's data
10472 ldd HORBEG ; get horizontal start
10473 cmpd HOREND ; is it less than end?
10474 ble SEE50 ; brif so
10475 ldx HOREND ; swap start/end horizontal coords
10476 stx HORBEG
10477 std HOREND
10478 SEE50 ldd VERBEG ; get vertical start
10479 cmpd VEREND ; less that end?
10480 ble SEE5D ; brif so
10481 ldx VEREND ; swap vertical coords
10482 stx VERBEG
10483 std VEREND
10484 SEE5D lda HRMODE ; get graphics mode
10485 ldb #0xf8 ; round off mask for mode 3 (1 bpp)
10486 cmpa #3 ; is it mode 3 (1 bpp)
10487 beq SEE6D ; brif so
10488 ldb #0xfc ; mask for mode 1 or 4 (2 bpp)
10489 cmpa #2 ; is it mode 2?
10490 bne SEE6D ; brif not - it's mode 1 or 4
10491 ldb #0xfe ; round off mask for mode 2 (4 bpp)
10492 SEE6D tfr b,a ; save round off in A and B - we need it twice
10493 anda HORBEG+1 ; round off horizontal start
10494 sta HORBEG+1
10495 andb HOREND+1 ; round of horizontal end coord
10496 stb HOREND+1
10497 jsr SE9DB ; calculate horizontal difference
10498 std HOREND ; save it
10499 jsr SE9CD ; calculate vertial difference
10500 addd #1 ; make it inclusive
10501 std VEREND ; save it
10502 lda HRMODE ; get graphics mode
10503 cmpa #2 ; HSCREEN 2?
10504 beq SEE96 ; divide pixel count by 2 for byte count
10505 cmpa #3 ; HSCREEN 3?
10506 bne SEE92 ; brif not - divide by 4 (HSCREEN 1, 4)
10507 lsr HOREND ; divide by 8 (falls through to by 4)
10508 ror HOREND+1
10509 SEE92 lsr HOREND ; divide by 4 (falls through to divide by 2)
10510 ror HOREND+1
10511 SEE96 lsr HOREND ; divide by 2
10512 ror HOREND+1
10513 ldd HOREND ; get byte count
10514 addd #1 ; make it inclusive of the end
10515 std HOREND
10516 jsr HCALPOS ; get pointer to screen location
10517 ldy VD5 ; point to action routine address
10518 SEEA7 ldb HOREND+1 ; get LS byte of byte count
10519 pshs x ; save line start pointer
10520 SEEAB jsr ,y ; perform movement action
10521 decb ; done all bytes?
10522 bne SEEAB ; brif not
10523 puls x ; get back line start
10524 jsr SEA45 ; move down one line
10525 dec VEREND+1 ; done all rows?
10526 bne SEEA7 ; brif not
10527 jsr SELTASK0 ; restore memory map
10528 jsr SETMMU
10529 rts
10530 SEEC0 lda ,x+ ; get a byte from screen
10531 bsr SEEC7 ; point to proper buffer location
10532 sta ,u ; save it
10533 rts
10534 SEEC7 ldu VCF ; get buffer pointer
10535 leau 1,u ; move to next byte
10536 stu VCF ; save new pointer
10537 cmpu VD1 ; did we run past the end of the buffer?
10538 bhi SEED3 ; brif so - raise error
10539 rts
10540 SEED3 lds #TMPSTACK-2 ; reset stack
10541 jsr SELTASK0 ; restore memory map
10542 jsr SETMMU
10543 jmp LB44A ; raise FC error
10544 SEEE0 fdb SEEEF ; PSET action routine
10545 fcb 0xbd ; PSET token
10546 fdb SEEF6 ; PRESET action routine
10547 fcb 0xbe ; PRESET token
10548 fdb SEF07 ; OR action routine
10549 fcb 0xb1 ; OR token
10550 fdb SEEFE ; AND action routine
10551 fcb 0xb0 ; AND token
10552 fdb SEF10 ; NOT action routine
10553 fcb 0xa8 ; NOT token
10554 SEEEF bsr SEEC7 ; point to buffer location
10555 lda ,u ; get byte from buffer
10556 sta ,x+ ; put it on screen
10557 rts
10558 SEEF6 bsr SEEC7 ; point to buffer location
10559 lda ,u ; get byte
10560 coma ; invert it
10561 sta ,x+ ; put it on screen
10562 rts
10563 SEEFE bsr SEEC7 ; point to buffer location
10564 lda ,u ; get byte from buffer
10565 anda ,x ; "AND" with screen data
10566 sta ,x+ ; put it on screen
10567 rts
10568 SEF07 bsr SEEC7 ; point to buffer location
10569 lda ,u ; get byte from buffer
10570 ora ,x ; "OR" with screen data
10571 sta ,x+ ; put on screen
10572 rts
10573 SEF10 bsr SEEC7 ; point to buffer address
10574 lda ,x ; get byte from screen (BUG: should be ,u to get from buffer)
10575 coma ; invert data
10576 sta ,x+ ; save on screen
10577 rts
10578 SEF18 ldy #HRESBUFF ; point to start of buffers
10579 lda ,y ; are there any buffers?
10580 cmpa #0xff
10581 bne SEF2C ; brif so
10582 jmp SEED3 ; raise error if no buffers
10583 SEF25 ldy ,y ; point to next buffer
10584 lbeq SEED3 ; brif end of buffers - raise error
10585 SEF2C cmpb 2,y ; is this the desired buffer?
10586 bne SEF25 ; brif not
10587 ldd 3,y ; get size of buffer
10588 leay 4,y ; point to start of data (less one for "pre-inc" on use
10589 sty VCF ; save buffer pointer
10590 leay 1,y ; point to actual data start
10591 leay d,y ; calculate address of end of buffer
10592 sty VD1 ; save end address
10593 rts
10594 ; HPRINT command
10595 HPRINT tst HRMODE ; graphics mode?
10596 lbeq SE6EF ; brif not - raise error
10597 lbrn 0
10598 jsr LB26A ; insist on (
10599 jsr SE7B2 ; evaluate coordinates
10600 jsr LB267 ; insist on )
10601 jsr SYNCOMMA ; insist on comma
10602 jsr LB156 ; evaluate print string
10603 tst VALTYP ; is it string?
10604 bne SEF62 ; brif not numeric (should be BMI)
10605 jsr LBDD9 ; convert number to string
10606 jsr LB516 ; save string in string space and all that jazz
10607 SEF62 jsr LB657 ; fetch string details
10608 stb H.PCOUNT ; save length in print count
10609 ldy #H.PBUF ; point to temporary string buffer
10610 SEF6C decb ; have we processed the whole string?
10611 bmi SEF75 ; brif so (or if the string length was > 128)
10612 lda ,x+ ; copy a character from the string into the buffer
10613 sta ,y+
10614 bra SEF6C ; see if we're done yet
10615 SEF75 lda HRMODE ; get graphics mode
10616 ldb #40 ; 40 characters on a 320 line
10617 cmpa #3 ; is it mode 1 or 2?
10618 blo SEF7F ; brif so
10619 ldb #80 ; 80 characters on a 640 line
10620 SEF7F clra ; zero extend line size
10621 subd HORBEG ; subtract first position from line length
10622 bmi SF001 ; brif we're printing off the side of the screen
10623 cmpb H.PCOUNT ; is the print count larger than characters left?
10624 bhi SEF8E ; brif not
10625 stb H.PCOUNT ; save remaining screen positions as print count
10626 beq SF001 ; brif nothing to print
10627 SEF8E lda #ROWMAX-1 ; get highest row number
10628 cmpa VERBEG+1 ; are we in range?
10629 bge SEF96 ; brif so
10630 sta VERBEG+1 ; force bottom row if not in range
10631 SEF96 jsr SF08C ; calculate actual pixel coordinates
10632 jsr HCALPOS ; get screen pointer
10633 ldy #H.PBUF ; point to string data
10634 ldb H.PCOUNT ; get number of characters to print
10635 SEFA3 lda ,y ; get character to print
10636 anda #0x7f ; lose bit 7 (character set repeats)
10637 suba #0x20 ; lose the "control" characters - no glyphs for those codes
10638 bpl SEFAD ; brif it was not a control character
10639 lda #0 ; use a space if it was
10640 SEFAD sta ,y+ ; put glyph number into the buffer
10641 decb ; processed all of them?
10642 bgt SEFA3 ; brif not
10643 lda HRMODE ; get graphics mode
10644 deca ; zero-base it
10645 asla ; two bytes per display routine
10646 ldy #SF002 ; point to display routine table
10647 ldy a,y ; point to display routine
10648 sty VD1 ; save it
10649 lda #8 ; 8 rows per character
10650 sta VD3 ; temp save row counter
10651 ldy #H.PBUF ; point to print buffer
10652 ldu #SF09D ; point to FONT data
10653 ldb H.FCOLOR ; get foreground colour
10654 jsr PIXELFIL ; get an all pixel byte
10655 stb ALLCOL ; save it
10656 jsr SELTASK1 ; map the screen
10657 lda H.PCOUNT ; get character count to display
10658 SEFD9 pshs y,x,a ; save buffer pointer, character count, and screen address
10659 SEFDB ldb ,y+ ; get character from buffer
10660 clra ; zero extend it
10661 aslb ;* 8 bytes per character entry (don't need rola after first
10662 aslb ;* because characters are only 7 bits
10663 rola
10664 aslb
10665 rola
10666 lda d,u ; get font data for this row
10667 jsr [VD1] ; display it
10668 dec H.PCOUNT ; done all characters on this row?
10669 bgt SEFDB ; brif not
10670 puls a,x,y ; get back character count, buffer pointer, and screen address
10671 dec VD3 ; have we done all the rows?
10672 beq SEFFE ; brif so
10673 sta H.PCOUNT ; restore print count
10674 leau 1,u ; move one row down the font data
10675 jsr SEA45 ; move one row down the screen
10676 bra SEFD9 ; go do another row of pixels
10677 SEFFE jsr SELTASK0 ; restore memory map
10678 SF001 rts
10679 SF002 fdb SF01A ; HSCREEN 1 (2 bpp)
10680 fdb SF045 ; HSCREEN 2 (4 bpp)
10681 fdb SF00A ; HSCREEN 3 (1 bpp)
10682 fdb SF01A ; HSCREEN 4 (2 bpp)
10683 SF00A pshs a ; save font data
10684 coma ; invert it
10685 anda ,x ; merge with screen - turns off pixels in the character
10686 sta ,x ; save it back on the screen
10687 puls a ; get back font data
10688 anda ALLCOL ; merge with colour data
10689 ora ,x ; merge with screen to fill hole created above
10690 sta ,x+ ; save it on screen
10691 rts
10692 SF01A pshs y ; save buffer pointer
10693 ldy #SF035 ; point to 2 bpp pixel masks
10694 tfr a,b ; copy character data (need two bytes per character)
10695 lsra ; use the upper 4 bits in first byte
10696 lsra
10697 lsra
10698 lsra
10699 lda a,y ; get pixel mask for all 16 possibilities for upper 4 bits
10700 jsr SF00A ; shove it on screen
10701 andb #0x0f ; lose upper bits for low half
10702 lda b,y ; get pixel mask for this pixel combination
10703 jsr SF00A ; shove that on screen too
10704 puls y ; restore buffer pointer
10705 rts
10706 SF035 fcb 0x00,0x03,0x0c,0x0f ; combined pixel masks for 16 possibilities for a 2 bpp byte
10707 fcb 0x30,0x33,0x3c,0x3f
10708 fcb 0xc0,0xc3,0xcc,0xcf
10709 fcb 0xf0,0xf3,0xfc,0xff
10710 SF045 pshs y,a ; save buffer pointer and font data
10711 ldy #SF06C ; point to 16 colour masks
10712 lsra ; fetch high 4 bits
10713 lsra
10714 lsra
10715 lsra
10716 asla ; two bytes per mask (this is NOT redundant - this and above clears bit 0)
10717 ldd a,y ; get two byte mask for these four bits
10718 jsr SF00A ; show upper 2 pixels
10719 tfr b,a ; show lower 2 pixels
10720 jsr SF00A
10721 puls a ; get back font data
10722 anda #0x0f ; lost upper bits
10723 asla ; two bytes per mask
10724 ldd a,y ; get mask data
10725 jsr SF00A ; show upper 2 pixels
10726 tfr b,a ; show lower 2 pixels
10727 jsr SF00A
10728 puls y ; restore buffer pointer
10729 rts
10730 SF06C fdb 0x0000,0x000f,0x00f0,0x00ff ; combined pixel masks for 16 possibilities for a 4 bpp double byte
10731 fdb 0x0f00,0x0f0f,0x0ff0,0x0fff
10732 fdb 0xf000,0xf00f,0xf0f0,0xf0ff
10733 fdb 0xff00,0xff0f,0xfff0,0xffff
10734 SF08C ldd HORBEG ; get horizontal character cell coordinate
10735 aslb ; times 8 - 8x8 font data; note first shift can't cause carry with max 79 for column number
10736 aslb
10737 rola
10738 aslb
10739 rola
10740 std HORBEG ; save actual horizontal pixel position of print position
10741 lda VERBEG+1 ; get vertical character cell coordinate
10742 asla ; times 8 - 8x8 font data
10743 asla
10744 asla
10745 sta VERBEG+1 ; save actual vertical pixel position of print position
10746 rts
10747 ; This is the HPRINT font, which is basically equivalent to the hardware font in the GIME for character codes
10748 ; 0x20 through 0x7f. It does not include the extra characters in the 0x00-0x1f range of the hardware character
10749 ; set. However, glyphs for those are actually included in the ROM above the end of the actual code.
10750 SF09D fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; SPACE
10751 fcb 0x10,0x10,0x10,0x10,0x10,0x00,0x10,0x00 ; !
10752 fcb 0x28,0x28,0x28,0x00,0x00,0x00,0x00,0x00 ; "
10753 fcb 0x28,0x28,0x7C,0x28,0x7C,0x28,0x28,0x00 ; #
10754 fcb 0x10,0x3C,0x50,0x38,0x14,0x78,0x10,0x00 ; $
10755 fcb 0x60,0x64,0x08,0x10,0x20,0x4C,0x0C,0x00 ; %
10756 fcb 0x20,0x50,0x50,0x20,0x54,0x48,0x34,0x00 ; &
10757 fcb 0x10,0x10,0x20,0x00,0x00,0x00,0x00,0x00 ; '
10758 fcb 0x08,0x10,0x20,0x20,0x20,0x10,0x08,0x00 ; (
10759 fcb 0x20,0x10,0x08,0x08,0x08,0x10,0x20,0x00 ; )
10760 fcb 0x00,0x10,0x54,0x38,0x38,0x54,0x10,0x00 ; *
10761 fcb 0x00,0x10,0x10,0x7C,0x10,0x10,0x00,0x00 ; +
10762 fcb 0x00,0x00,0x00,0x00,0x00,0x10,0x10,0x20 ; ,
10763 fcb 0x00,0x00,0x00,0x7C,0x00,0x00,0x00,0x00 ; -
10764 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00 ; .
10765 fcb 0x00,0x04,0x08,0x10,0x20,0x40,0x00,0x00 ; /
10766 fcb 0x38,0x44,0x4C,0x54,0x64,0x44,0x38,0x00 ; 0
10767 fcb 0x10,0x30,0x10,0x10,0x10,0x10,0x38,0x00 ; 1
10768 fcb 0x38,0x44,0x04,0x38,0x40,0x40,0x7C,0x00 ; 2
10769 fcb 0x38,0x44,0x04,0x08,0x04,0x44,0x38,0x00 ; 3
10770 fcb 0x08,0x18,0x28,0x48,0x7C,0x08,0x08,0x00 ; 4
10771 fcb 0x7C,0x40,0x78,0x04,0x04,0x44,0x38,0x00 ; 5
10772 fcb 0x38,0x40,0x40,0x78,0x44,0x44,0x38,0x00 ; 6
10773 fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x40,0x00 ; 7
10774 fcb 0x38,0x44,0x44,0x38,0x44,0x44,0x38,0x00 ; 8
10775 fcb 0x38,0x44,0x44,0x38,0x04,0x04,0x38,0x00 ; 9
10776 fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x00,0x00 ; :
10777 fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x10,0x20 ; ;
10778 fcb 0x08,0x10,0x20,0x40,0x20,0x10,0x08,0x00 ; <
10779 fcb 0x00,0x00,0x7C,0x00,0x7C,0x00,0x00,0x00 ; =
10780 fcb 0x20,0x10,0x08,0x04,0x08,0x10,0x20,0x00 ; >
10781 fcb 0x38,0x44,0x04,0x08,0x10,0x00,0x10,0x00 ; ?
10782 fcb 0x38,0x44,0x04,0x34,0x4C,0x4C,0x38,0x00 ; @
10783 fcb 0x10,0x28,0x44,0x44,0x7C,0x44,0x44,0x00 ; A
10784 fcb 0x78,0x24,0x24,0x38,0x24,0x24,0x78,0x00 ; B
10785 fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x00 ; C
10786 fcb 0x78,0x24,0x24,0x24,0x24,0x24,0x78,0x00 ; D
10787 fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x7C,0x00 ; E
10788 fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x40,0x00 ; F
10789 fcb 0x38,0x44,0x40,0x40,0x4C,0x44,0x38,0x00 ; G
10790 fcb 0x44,0x44,0x44,0x7C,0x44,0x44,0x44,0x00 ; H
10791 fcb 0x38,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; I
10792 fcb 0x04,0x04,0x04,0x04,0x04,0x44,0x38,0x00 ; J
10793 fcb 0x44,0x48,0x50,0x60,0x50,0x48,0x44,0x00 ; K
10794 fcb 0x40,0x40,0x40,0x40,0x40,0x40,0x7C,0x00 ; L
10795 fcb 0x44,0x6C,0x54,0x54,0x44,0x44,0x44,0x00 ; M
10796 fcb 0x44,0x44,0x64,0x54,0x4C,0x44,0x44,0x00 ; N
10797 fcb 0x38,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; O
10798 fcb 0x78,0x44,0x44,0x78,0x40,0x40,0x40,0x00 ; P
10799 fcb 0x38,0x44,0x44,0x44,0x54,0x48,0x34,0x00 ; Q
10800 fcb 0x78,0x44,0x44,0x78,0x50,0x48,0x44,0x00 ; R
10801 fcb 0x38,0x44,0x40,0x38,0x04,0x44,0x38,0x00 ; S
10802 fcb 0x7C,0x10,0x10,0x10,0x10,0x10,0x10,0x00 ; T
10803 fcb 0x44,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; U
10804 fcb 0x44,0x44,0x44,0x28,0x28,0x10,0x10,0x00 ; V
10805 fcb 0x44,0x44,0x44,0x44,0x54,0x6C,0x44,0x00 ; W
10806 fcb 0x44,0x44,0x28,0x10,0x28,0x44,0x44,0x00 ; X
10807 fcb 0x44,0x44,0x28,0x10,0x10,0x10,0x10,0x00 ; Y
10808 fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x7C,0x00 ; Z
10809 fcb 0x38,0x20,0x20,0x20,0x20,0x20,0x38,0x00 ; ]
10810 fcb 0x00,0x40,0x20,0x10,0x08,0x04,0x00,0x00 ; \
10811 fcb 0x38,0x08,0x08,0x08,0x08,0x08,0x38,0x00 ; [
10812 fcb 0x10,0x38,0x54,0x10,0x10,0x10,0x10,0x00 ; UP ARROW
10813 fcb 0x00,0x10,0x20,0x7C,0x20,0x10,0x00,0x00 ; LEFT ARROW
10814 fcb 0x10,0x28,0x44,0x00,0x00,0x00,0x00,0x00 ; ^
10815 fcb 0x00,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; a
10816 fcb 0x40,0x40,0x58,0x64,0x44,0x64,0x58,0x00 ; b
10817 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x00 ; c
10818 fcb 0x04,0x04,0x34,0x4C,0x44,0x4C,0x34,0x00 ; d
10819 fcb 0x00,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; e
10820 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x10,0x00 ; f
10821 fcb 0x00,0x00,0x34,0x4C,0x4C,0x34,0x04,0x38 ; g
10822 fcb 0x40,0x40,0x58,0x64,0x44,0x44,0x44,0x00 ; h
10823 fcb 0x00,0x10,0x00,0x30,0x10,0x10,0x38,0x00 ; i
10824 fcb 0x00,0x04,0x00,0x04,0x04,0x04,0x44,0x38 ; j
10825 fcb 0x40,0x40,0x48,0x50,0x60,0x50,0x48,0x00 ; k
10826 fcb 0x30,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; l
10827 fcb 0x00,0x00,0x68,0x54,0x54,0x54,0x54,0x00 ; m
10828 fcb 0x00,0x00,0x58,0x64,0x44,0x44,0x44,0x00 ; n
10829 fcb 0x00,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; o
10830 fcb 0x00,0x00,0x78,0x44,0x44,0x78,0x40,0x40 ; p
10831 fcb 0x00,0x00,0x3C,0x44,0x44,0x3C,0x04,0x04 ; q
10832 fcb 0x00,0x00,0x58,0x64,0x40,0x40,0x40,0x00 ; r
10833 fcb 0x00,0x00,0x3C,0x40,0x38,0x04,0x78,0x00 ; s
10834 fcb 0x20,0x20,0x70,0x20,0x20,0x24,0x18,0x00 ; t
10835 fcb 0x00,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; u
10836 fcb 0x00,0x00,0x44,0x44,0x44,0x28,0x10,0x00 ; v
10837 fcb 0x00,0x00,0x44,0x54,0x54,0x28,0x28,0x00 ; w
10838 fcb 0x00,0x00,0x44,0x28,0x10,0x28,0x44,0x00 ; x
10839 fcb 0x00,0x00,0x44,0x44,0x44,0x3C,0x04,0x38 ; y
10840 fcb 0x00,0x00,0x7C,0x08,0x10,0x20,0x7C,0x00 ; z
10841 fcb 0x08,0x10,0x10,0x20,0x10,0x10,0x08,0x00 ; {
10842 fcb 0x10,0x10,0x10,0x00,0x10,0x10,0x10,0x00 ; |
10843 fcb 0x20,0x10,0x10,0x08,0x10,0x10,0x20,0x00 ; }
10844 fcb 0x20,0x54,0x08,0x00,0x00,0x00,0x00,0x00 ; ~
10845 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x7C,0x00 ; _
10846 ; HDRAW command
10847 HDRAW tst HRMODE ; grahics mode?
10848 lbeq SE6EF ; brif not
10849 lbrn 0
10850 ldx #0 ; set empty string for "end of DRAW"
10851 ldb #1
10852 pshs x,b
10853 stb SETFLG ; set up for "set" mode
10854 stx VD5 ; clear update and draw flags
10855 jsr SE731 ; set up color byte
10856 jsr LB156 ; evaluate command string
10857 SF3B8 jsr LB654 ; fetch command string details
10858 bra SF3C5 ; interpret command string
10859 SF3BD jsr SF591 ; fetch command character
10860 jmp SF5A7 ; evaluate number
10861 SF3C3 puls b,x ; get "caller" command string details
10862 SF3C5 stb VD8 ; save string pointer
10863 beq SF3C3 ; brif end of string - try another
10864 stx VD9 ; set string data pointer
10865 lbeq SF4D0 ; brif we hit the top of the stack
10866 SF3CF tst VD8 ; is there anything left?
10867 beq SF3C3 ; brif not
10868 jsr SF591 ; get command character
10869 cmpa #'; ; separator?
10870 beq SF3CF ; brif so - ignore it
10871 cmpa #'' ; '?
10872 beq SF3CF ; brif so - ignore that too
10873 cmpa #'N ; update toggle?
10874 bne SF3E6 ; brif not
10875 com VD5 ; toggle the "update" flag (if set, return to original position after)
10876 bra SF3CF ; process more
10877 SF3E6 cmpa #'B ; blank modifier?
10878 bne SF3EE ; brif not
10879 com VD6 ; toggle "draw" flag - 0 = draw, nonzero = don't draw
10880 bra SF3CF ; process more
10881 SF3EE cmpa #'X ; substring call?
10882 lbeq SF4A1 ; brif so - process it
10883 cmpa #'M ; M (move)?
10884 lbeq SF54C ; brif so - process "move"
10885 pshs a ; save command character
10886 ldb #1 ; default count if no number follows
10887 clr VD3 ; clear MS byte of count
10888 stb VD4 ; save LS byte of count
10889 tst VD8 ; is there anything left?
10890 beq SF417 ; brif not
10891 jsr SF591 ; get command character
10892 jsr LB3A2 ; set C if not alpha
10893 pshs cc ; save alpha flag
10894 jsr SF5F2 ; back up command pointer
10895 puls cc ; get back alpha flag
10896 bcc SF417 ; brif command is alpha
10897 bsr SF3BD ; evaluate decimal string
10898 SF417 puls a ; get command back
10899 cmpa #'C ; C (colour)?
10900 beq SF445 ; brif so
10901 cmpa #'A ; A (angle)?
10902 beq SF451 ; brif so
10903 cmpa #'S ; S (scale)?
10904 beq SF45C ; brif so
10905 cmpa #'U ; U (up)?
10906 beq SF496 ; brif so
10907 cmpa #'D ; D (down)?
10908 beq SF492 ; brif so
10909 cmpa #'L ; L (left)?
10910 beq SF48C ; brif so
10911 cmpa #'R ; R (right)?
10912 beq SF485 ; brif so
10913 suba #'E ; shift E,F,G,H to be 0-3
10914 beq SF473 ; brif E (UR)
10915 deca ; F (DR)
10916 beq SF46D ; brif so
10917 deca ; G (DL)
10918 beq SF47D ; brif so
10919 deca ; H (UL)
10920 beq SF467 ; brif so
10921 jmp LB44A ; raise error if unrecognized command
10922 SF445 jsr SE711 ; adjust colour code for graphics mode
10923 stb H.FCOLOR ; set new foreground
10924 jsr SE731 ; set up colour byte
10925 lbra SF3CF ; handle another command
10926 SF451 cmpb #4 ; only 4 angles valid
10927 lbhs LB44A ; brif invalid angle
10928 stb ANGLE ; save draw angle
10929 lbra SF3CF ; go handle another command
10930 SF45C cmpb #63 ; only 0-62 are valid scale factors
10931 lbhs LB44A ; brif invalid scale
10932 stb SCALE ; set scale factor
10933 lbra SF3CF ; process another command
10934 SF467 lda VD3 ; get count MSB
10935 bsr NEGACCD ; negate horizontal difference (go left)
10936 bra SF46F ; go the same distance up
10937 SF46D lda VD3 ; get count MSB
10938 SF46F tfr d,x ; go same distance right as down
10939 bra SF4D4 ; go handle movement/drawing
10940 SF473 lda VD3 ; get MSB of count
10941 tfr d,x ; going same distance on both axes
10942 bsr NEGACCD ; negate the vertical distance
10943 exg d,x ; put vertical in X, horizontal in D
10944 bra SF4D4 ; go handle drawing and moving
10945 SF47D lda VD3 ; get MSB of count
10946 tfr d,x ; go same distance on both axes
10947 bsr NEGACCD ; go left horizontally (and down vertically)
10948 bra SF4D4 ; go handle drawing and moving
10949 SF485 lda VD3 ; get MSB of difference (going right)
10950 SF487 ldx #0 ; no vertical movement
10951 bra SF4D4 ; handle drawing/moving
10952 SF48C lda VD3 ; get MSB of count
10953 bsr NEGACCD ; negate because going left
10954 bra SF487 ; set no vertical difference, handle drawing/moving
10955 SF492 lda VD3 ; get MSB of count
10956 bra SF49A ; go make horizontal difference 0, use positive distance for down
10957 SF496 lda VD3 ; get MSB of count
10958 bsr NEGACCD ; use negative distance for up
10959 SF49A ldx #0 ; use 0 horizontal distance
10960 exg x,d ; put horizontal and vertical in the right places
10961 bra SF4D4 ; go move/draw
10962 SF4A1 jsr SF611 ; interpret command as a variable
10963 ldb #2 ; see if we're about to run out of memory
10964 jsr LAC33
10965 ldb VD8 ; get remaining characters in current command string
10966 ldx VD9 ; get current command string pointer
10967 pshs x,b ; save the stack frame
10968 jmp SF3B8 ; go evaluate the string
10969 SF4B2 ldb SCALE ; get scaling factor
10970 beq SF4D1 ; brif none - use full scale
10971 clra ; zero extend scale
10972 exg d,x ; put distance in D, save scale factor
10973 sta ,-s ; save MSB of distance and set flags on sign
10974 bpl SF4BF ; brif positive distance
10975 bsr NEGACCD ; make it positive if negative
10976 SF4BF jsr SEBCB ; multiply D and X
10977 tfr U,D ; save LSW in D
10978 lsra ; divide by 4
10979 rorb
10980 lsra
10981 rorb
10982 tst ,s+ ; was original positive?
10983 bpl SF4D0 ; brif so
10984 NEGACCD nega ; negate D
10985 negb
10986 sbca #0
10987 SF4D0 rts
10988 SF4D1 tfr x,d ; keep unmodified distance
10989 rts
10990 SF4D4 pshs d ; save horizontal distance
10991 bsr SF4B2 ; apply scale factor to vertical distance
10992 puls x ; get back horizontal distance
10993 pshs d ; save scaled vertical distance
10994 bsr SF4B2 ; apply scale to horizontal distance
10995 puls x ; get back the vertical distance
10996 ldy ANGLE ; get draw angle (using Y to avoid clobbering D)
10997 pshs y ; save it
10998 SF4E5 tst ,s ; check angle
10999 beq SF4F1 ; brif no angle
11000 exg x,d ;* swap horizontal and vertical distances then negate new horizontal
11001 bsr NEGACCD ;* distance, which rotates 90° counterclockwise
11002 dec ,s ; count down the angle
11003 bra SF4E5 ; see if we have rotated enough times
11004 SF4F1 puls y ; clean up stack
11005 ldu #0 ; default end position to 0
11006 addd HORDEF ; add distance to current draw position
11007 bmi SF4FC ; brif we went negative - use minimal 0
11008 tfr d,u ; use calculated draw coordinate
11009 SF4FC tfr x,d ; fetch vertical distance for calculation
11010 ldx #0 ; default end position to 0
11011 addd VERDEF ; add distance to draw position
11012 bmi SF507 ; brif we went negative - use minimal 0
11013 tfr d,x ; use calculated coordinate
11014 SF507 cmpu #640 ; is it out of range completely?
11015 blo SF510 ; brif not
11016 ldu #639 ; maximize to right edge of screen
11017 SF510 lda HRMODE ; get graphics mode
11018 cmpa #2 ; is it a 320 mode?
11019 bgt SF51F ; brif not
11020 cmpu #320 ; out of range for 320 mode?
11021 blo SF51F ; brif not
11022 ldu #319 ; maximize to right edge of screen
11023 SF51F cmpx #192 ; out of range vertically?
11024 blo SF527 ; brif not
11025 ldx #191 ; maximize to bottom of screen
11026 SF527 ldd HORDEF ; set start position to current draw position
11027 std HORBEG
11028 ldd VERDEF
11029 std VERBEG
11030 stx VEREND ; set calculated position as end position
11031 stu HOREND
11032 tst VD5 ; are we going to update draw position?
11033 bne SF53B ; brif not
11034 stx VERDEF ; set new draw position
11035 stu HORDEF
11036 SF53B jsr SEA0D ; "normalize" coordinates
11037 tst VD6 ; are we doing to draw a line?
11038 bne SF545 ; brif not
11039 jsr SE94E ; draw a line
11040 SF545 clr VD5 ; reset the "update" flag
11041 clr VD6 ; reset the "draw" flag
11042 jmp SF3CF ; go handle another command
11043 SF54C jsr SF591 ; get input character
11044 pshs a ; save it
11045 jsr SF578 ; evaluate horizontal distance
11046 pshs d ; save it
11047 jsr SF591 ; get a character
11048 cmpa #', ; is it a comma separator?
11049 lbne LB44A ; brif not - raise error
11050 jsr SF575 ; evaluate the vertical distance
11051 tfr d,x ; save vertical distance
11052 puls u ; get horizontal distance
11053 puls a ; get first command character
11054 cmpa #'+ ; +?
11055 beq SF570 ; treat coordinates as relative displacements
11056 cmpa #'- ; -?
11057 bne SF507 ; brif neither + or -; treat as absolute coordinates
11058 SF570 tfr u,d ; put horizontal distance in D
11059 jmp SF4D4 ; treat distances as offsets
11060 SF575 jsr SF591 ; get character
11061 SF578 cmpa #'+ ; +?
11062 beq SF583 ; brif so - do positive
11063 cmpa #'- ; -?
11064 beq SF584 ; brif so - do negative
11065 jsr SF5F2 ; back up input pointer
11066 SF583 clra ; flag positive
11067 SF584 pshs a ; save sign flag
11068 jsr SF3BD ; evaluate decimal number
11069 tst ,s+ ; is it positive?
11070 beq SF590 ; brif so
11071 negb ; negate the value - BUG: should be JSR NEGACCD; this code sequence doesn't work
11072 sbca #0
11073 SF590 rts
11074 SF591 pshs x ; save register
11075 SF593 tst VD8 ; is there anything to fetch?
11076 lbeq LB44A ; brif not - raise error
11077 ldx VD9 ; get command pointer
11078 lda ,x+ ; get command character
11079 stx VD9 ; save updated pointer
11080 dec VD8 ; account for character consumed
11081 cmpa #0x20 ; space?
11082 beq SF593 ; brif so - skip it
11083 puls x,pc ; restore register and return
11084 SF5A7 cmpa #'= ; is it variable equate?
11085 bne SF5B6 ; brif not
11086 pshs u,y ; save registers
11087 bsr SF611 ; interpret variable in command string
11088 jsr LB3E9 ; convert to integer in D
11089 std VD3 ; save as count
11090 puls y,u,pc ; restore registers and return
11091 SF5B6 jsr SF608 ; clear carry if numeric
11092 lbcs LB44A ; bail if not numeric
11093 clr VD3 ; initialize count to 0
11094 clr VD4
11095 SF5C1 suba #'0 ; remove ASCII bias
11096 sta VD7 ; save digit value
11097 ldd VD3 ; get accumulated value
11098 bsr SF5FD ; multiply by 10
11099 addb VD7 ; add digit value
11100 adca #0 ; propagate carry
11101 std VD3 ; save accumulated count value
11102 lda HRMODE ; get graphics mode
11103 cmpa #2 ; is it a 640 mode?
11104 bgt SF5DA ; brif so
11105 ldd #319 ; get max for 320 mode
11106 bra SF5DD
11107 SF5DA ldd #639 ; get max for 640 mode
11108 SF5DD cmpd VD3 ; is the value in range for a horizontal coordinate?
11109 lblt LB44A ; brif not
11110 ldd VD3 ; get accumulated value
11111 tst VD8 ; is there anything more to parse?
11112 beq SF5FA ; brif not
11113 jsr SF591 ; get a character
11114 jsr SF608 ; set C if not digit
11115 bcc SF5C1 ; brif digit - add to accumulated value
11116 SF5F2 inc VD8 ; account for character being unfetched
11117 ldx VD9 ; move command pointer back
11118 leax -1,x
11119 stx VD9
11120 SF5FA ldd VD3 ; get accumulated value
11121 rts
11122 SF5FD aslb ; times 2
11123 rola
11124 pshs d ; save 2D
11125 aslb ; times 4
11126 rola
11127 aslb ; times 8
11128 rola
11129 addd ,s++ ; 8D+2D=10D
11130 rts
11131 SF608 cmpa #'0 ; is it less than ASCII 0?
11132 blo SF610 ; brif so - sets C
11133 suba #'9+1 ; set C if > ASCII 9
11134 suba #-('9+1)
11135 SF610 rts
11136 SF611 ldx VD9 ; get command pointer
11137 pshs x ; save it
11138 jsr SF591 ; get command character
11139 jsr LB3A2 ; set C if not alpha
11140 lbcs LB44A ; brif not variable name
11141 SF61F jsr SF591 ; get command character
11142 cmpa #'; ; is it end of variable string?
11143 bne SF61F ; brif not
11144 puls x ; get back start of variable
11145 ldu CHARAD ; save interpreter input pointer
11146 pshs u
11147 stx CHARAD ; save command string pointer as interpeter input
11148 jsr LB284 ; evaluate variable
11149 puls x ; restore interpreter input pointer
11150 stx CHARAD
11151 rts
11152 ; WIDTH command
11153 WIDTH clr HRMODE ; turn off graphics
11154 lbrn 0
11155 cmpa #0 ; end of line? (BUG: should do a BEQ before the CLR above)
11156 beq SF64F ; brif so - raise error if no argument (won't trigger on :)
11157 jsr EVALEXPB ; evaluate width argument
11158 cmpb #32 ; 32 columns?
11159 beq COL32 ; brif so
11160 cmpb #40 ; 40 columns?
11161 beq COL40 ; brif so
11162 cmpb #80 ; 80 columns?
11163 beq COL80 ; brif so
11164 SF64F jmp LB44A ; raise FC error
11165 COL32 clra ; set text mode to 32 columns
11166 sta HRWIDTH
11167 jsr LA928 ; clear screen
11168 lbsr SETTEXT ; set up display for 32 column screen
11169 rts
11170 COL40 lda #1 ; mode number for 40 columns
11171 sta HRWIDTH ; set text screen mode
11172 lbsr SF772 ; map text screen
11173 lda #40 ; set up scren size in character cells
11174 ldb #ROWMAX
11175 std H.COLUMN
11176 ldd #HRESSCRN+40*ROWMAX*2 ; set end address of screen
11177 SF66D std H.DISPEN ; save end address
11178 bsr SF68C ; clear the screen
11179 lbsr SF778 ; unmap text screen
11180 lbsr SETTEXT ; set up display for the text screen
11181 rts
11182 COL80 lda #2 ; mode number for 80 columns
11183 sta HRWIDTH ; set text screen mode
11184 lbsr SF772 ; map the screen
11185 lda #80 ; set up screen size in character cells
11186 ldb #ROWMAX
11187 std H.COLUMN
11188 ldd #HRESSCRN+80*ROWMAX*2 ; set end address of screen
11189 bra SF66D ; set up rest of parameters
11190 SF68C ldx #HRESSCRN ; set cursor address to top left corner
11191 lbrn 0
11192 stx H.CRSLOC
11193 lda #0x20 ; use space to clear screen
11194 ldb H.CRSATT ; get current attributes
11195 SF69B std ,x++ ; blank a character cell
11196 cmpx H.DISPEN ; end of screen?
11197 blo SF69B ; brif not
11198 ldx #HRESSCRN ; reset to top of screen
11199 clra ; reset cursor coordinates to 0,0
11200 sta H.CURSX
11201 sta H.CURSY
11202 rts
11203 ; CLS patch entered from the other patch in the ECB area
11204 ALINK23 puls cc ; restore zero flag
11205 lbrn 0
11206 beq SF6E0 ; brif no arguments
11207 jsr EVALEXPB ; get colour number
11208 tstb ; 0?
11209 beq SF6E0 ; brif so - treat as no arguments
11210 cmpb #8 ; valid colour?
11211 bhi SF6E7 ; brif not - do the easter egg or the other easter egg
11212 decb ; zero-base the colour
11213 leay IM.PALET,pcr ; point to current palette settings
11214 lda b,y ; get the real colour
11215 sta V.BORDER ; set border colour
11216 lbsr SF766 ; set border colour in GIME initializers
11217 stb H.CRSATT ; set attributes to foreground 0, background as selected, no blink or underline
11218 lda #0x20 ; get space character
11219 lbsr SF772 ; map screen
11220 ldx #HRESSCRN ; get address of start of screen
11221 stx H.CRSLOC ; put cursor there
11222 bsr SF69B ; clear screen
11223 SF6DC lbsr SF778 ; unmap screen
11224 rts
11225 SF6E0 lbsr SF772 ; map screen
11226 bsr SF68C ; clear screen
11227 bra SF6DC ; ummap screen and return
11228 SF6E7 clr H.CRSATT ; reset attributes to colours 0,0, no blink or underline
11229 lda IM.PALET ; get colour in register 0
11230 sta V.BORDER ; set border colour
11231 bsr SF766 ; reset border colour in GIME initializers
11232 cmpb #100 ; is it CLS 100?
11233 SF6F4 beq SF730 ; brif so - do the easter egg
11234 bsr SF772 ; map the screen
11235 bsr SF68C ; clear screen
11236 bsr SF778 ; unmap screen
11237 ldx #MICROMS-1 ; point to Microware commercial
11238 jmp STRINOUT ; display it
11239 MICROMS fcc 'Microware Systems Corp.'
11240 fcb 0x0d,0x00
11241 AUTHORMS fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; the ROM/RAM copy sets this to the actual easter egg text
11242 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00
11243 fcb 0x00,0x00,0x00,0x00,0x00
11244 SF730 bsr SF772 ; map the screen
11245 lbsr SF68C ; clear it
11246 bsr SF778 ; unmap the screen
11247 ldx #AUTHORMS-1 ; point to the easter egg
11248 jsr STRINOUT ; display it
11249 pshs x ; save X for some reason
11250 leax >SF6F4,pcr ; point to start of easter egg code
11251 lda #0x12 ; NOP opcode
11252 sta ,x+ ; blank out the branch that brings us here
11253 sta ,x
11254 leax >AUTHORMS,pcr ; point to author message
11255 SF74D sta ,x+ ; blank out character in string or this code
11256 cmpx #SF74D ; end of string or display code?
11257 blo SF74D ; brif not
11258 puls x ; restore X
11259 rts
11260 ; Line input routine patch for handling CLEAR
11261 ALINK27 tst HRWIDTH ; is it 40/80 column screen?
11262 bne SF761 ; brif so
11263 jsr LA928 ; clear 32 column screen
11264 SF75E jmp LA390 ; go make to mainline
11265 SF761 lbsr SF6E0 ; clear the screen
11266 bra SF75E ; return to mainline
11267 SF766 pshs y ; save register
11268 leay SE03B,pcr ; point to text initializers
11269 sta 3,y ; set border in 40 column initializer
11270 sta 12,y ; set border in 80 column initializer
11271 puls y,pc ; restore registers and return
11272 SF772 orcc #0x50 ; clobber interrupts
11273 lbsr SELTEXT ; map the text screen (by setting *all 16* MMU registers)
11274 rts
11275 SF778 lbsr SETMMU ; unmap text screen (by setting *all 16* MMU registers)
11276 andcc #0xaf ; restart interrupts
11277 rts
11278 ; The driver for putting characters on the 40 and 80 column screen is here, modulo the WIDTH command and clear
11279 ; screen routines above.
11280 ;
11281 ; There are several major problems with this driver:
11282 ;
11283 ; * Cursor handling is overly complicated. Instead of doing what Color Basic does and only show the cursor
11284 ; when waiting for input in the generic input routine, this driver displays it almost all of the time and, thus,
11285 ; has all manner of code for managing the cursor that would not be needed otherwise.
11286 ; * The system goes out of its way to set up the screen height and width values. Then, it doesn't bother using
11287 ; them consistently, especially during the screen scrolling routine. Indeed, the screen scrolling routine could
11288 ; be made completely general purpose by using two pointers, say U for the destination and X for the source. Then
11289 ; the column count could be used to decide the line width (to calculate the offset betwen U and X) and then the
11290 ; row count could be used to set the row number after the scrolling is done. This would remove any hard coded
11291 ; offsets or screen size assumptions.
11292 ; * The routines for mapping and unmapping the text screen are inexcusably slow. Only one MMU register needs to
11293 ; be changed in either routine. However, instead of doing that, the routines use an inefficient routine that
11294 ; sets *all 16* MMU registers (both tasks!). This reduces screen output speed so much that a fast reader can
11295 ; actually keep up with the output going full speed. Simply replacing these two routines with simpler ones that
11296 ; do not do that dumbassery gets performance on par with the 32 column VDG screen.
11297 ;
11298 ; Along with the above, some of the code is far more convoluted than it needs to be, but that is relatively
11299 ; benign compared to everything else.
11300 ;
11301 ; Blink cursor patch
11302 ALINK24 bsr SF787 ; blink the cursor
11303 jsr KEYIN ; get keypress
11304 beq ALINK24 ; brif no key pressed
11305 puls b,x,pc ; return to caller
11306 SF787 dec BLKCNT ; time to blink cursor?
11307 bne SF7A8 ; brif not
11308 ldb #11 ; reset blink counter
11309 stb BLKCNT
11310 bsr SF772 ; map screen
11311 ldx H.CRSLOC ; get cursor pointer
11312 lda 1,x ; get current attributes
11313 bita #0x40 ; is underline on?
11314 beq SF79F ; brif not - enable it
11315 lda H.CRSATT ; use current attributes if it is
11316 bra SF7A4
11317 SF79F lda H.CRSATT ; get current attributes
11318 ora #0x40 ; turn on underline
11319 SF7A4 sta 1,x ; save new attributes
11320 bsr SF778 ; unmap screen
11321 SF7A8 ldx #DEBDEL ; do a delay
11322 jmp LA7D3
11323 ; Put character on screen patch
11324 ALINK22 bsr SF772 ; map the screen
11325 lbrn 0
11326 ldx H.CRSLOC ; get cursor location
11327 cmpa #0x08 ; backspace?
11328 bne SF7C4 ; brif not
11329 cmpx #HRESSCRN ; at start of screen?
11330 beq SF7DE ; brif so - do nothing
11331 bsr SF7E2 ; do a backspace
11332 bra SF7DE ; finish up
11333 SF7C4 cmpa #0x0d ; carriage return?
11334 bne SF7CC ; brif not
11335 bsr SF827 ; do a carriage return
11336 bra SF7D7 ; finish up with scroll check
11337 SF7CC cmpa #0x20 ; is it a control code?
11338 blo SF7DE ; brif so - do nothing
11339 ldb H.CRSATT ; get current attributes
11340 std ,x ; put character on screen
11341 bsr SF807 ; move cursor forward
11342 SF7D7 cmpx H.DISPEN ; end of screen?
11343 blo SF7DE ; brif not
11344 bsr SF854 ; scroll screen
11345 SF7DE bsr SF778 ; unmap the screen
11346 puls a,b,x,pc ; restore registers and return
11347 SF7E2 pshs b,a ; save registers
11348 lda #0x20 ; space character
11349 ldb H.CRSATT ; get attributes
11350 std ,x ; turns off cursor at this position and blanks it
11351 orb #0x40 ; turn on underline (we'll put a cursor in the previous position)
11352 std -2,x ; put blank and cursor back one
11353 leax -2,x ; move pointer back
11354 stx H.CRSLOC ; save new cursor pointer
11355 ldd H.CURSX ; get coordinates
11356 deca ; move horizontal back
11357 bpl SF802 ; brif we didn't wrap
11358 decb ; move vertical back
11359 stb H.CURSY ; save it
11360 lda H.COLUMN ; get screen width
11361 deca ; coordinates are zero-based so now we have the max horizontal coord
11362 SF802 sta H.CURSX ; save new horizontal position
11363 puls a,b,pc ; restore registers and return
11364 SF807 pshs a,b ; save registers
11365 lda #0x20 ; we'll blank a character for the cursor
11366 ldb H.CRSATT ; get attributes
11367 orb #0x40 ; force underline for cursor
11368 leax 2,x ; move pointer forward
11369 std ,x ; put blank and cursor on screen
11370 stx H.CRSLOC ; save new cursor position
11371 ldd H.CURSX ; get coordinates
11372 inca ; move right
11373 cmpa H.COLUMN ; did we hit the edge?
11374 blo SF802 ; brif not - save new horizontal coordinate and return
11375 incb ; bump line
11376 stb H.CURSY ; save new line
11377 clra ; reset to left side of screen
11378 bra SF802 ; save new horizontal coordinate and return
11379 SF827 pshs a,b ; save registers
11380 lda #0x20 ; get space character
11381 ldb H.CRSATT ; get attributes
11382 SF82E std ,x++ ; blank a character
11383 pshs a ; save character
11384 lda H.CURSX ; get horizontal position
11385 inca ; bump it
11386 sta H.CURSX ; save new position
11387 cmpa H.COLUMN ; edge of screen?
11388 puls a ; restore character
11389 blo SF82E ; brif not end of line yet
11390 stx H.CRSLOC ; save cursor location
11391 clr H.CURSX ; reset to left edge
11392 inc H.CURSY ; bump row
11393 lda #0x20 ; space character
11394 ldb H.CRSATT ; get attributes
11395 orb #0x40 ; turn on underline
11396 std ,x ; put a cursor on screen
11397 puls a,b,pc ; restore registers and return
11398 SF854 pshs a,b ; save registers
11399 ldx #HRESSCRN ; point to start of screen
11400 lda H.COLUMN ; get screen width
11401 cmpa #40 ; is it 40 columns?
11402 bne SF86E ; brif not - do 80 column scroll
11403 SF860 ldd 2*40,x ; get character cell from one line down
11404 std ,x++ ; move it here
11405 cmpx #HRESSCRN+(ROWMAX-1)*40*2 ; at start of last row?
11406 blo SF860 ; brif not
11407 SF86A bsr SF87B ; fill last row with spaces
11408 puls a,b,pc ; restore registers and return
11409 SF86E ldd 80*2,x ; get a character cell from next row
11410 std ,x++ ; put it here
11411 cmpx #HRESSCRN+(ROWMAX-1)*80*2 ; at start of last row?
11412 blo SF86E ; brif not
11413 bra SF86A ; blank out last row and finish up
11414 SF87B clr H.CURSX ; reset column to 0
11415 lda #ROWMAX-1 ; reset row number to bottom of screen
11416 sta H.CURSY
11417 lda #0x20 ; get space character
11418 ldb H.CRSATT ; get attributes
11419 pshs x ; save pointer to start of row
11420 SF88A std ,x++ ; blank a character
11421 cmpx H.DISPEN ; at end of screen?
11422 bne SF88A ; brif not
11423 clr H.CURSX ; reset horizontal position to margin
11424 puls x ; get start of line pointer
11425 lda #0x20 ; space haracter
11426 ldb H.CRSATT ; get attributes
11427 orb #0x40 ; turn on underline
11428 std ,x ; put a bleeping cursor at start of line
11429 stx H.CRSLOC ; set cursor position
11430 rts
11431 ; Conditional newline patch. Note that this maps and unmaps the text screen in 40/80 column mode
11432 ; but that is completely unneeded to just test the X coordinate.
11433 ALINK26 tst DEVNUM ; is it screen?
11434 bne SF8AB ; brif not
11435 tst HRWIDTH ; VDG screen?
11436 bne SF8B1 ; brif not
11437 SF8AB jsr LA35F ; set up print parameters
11438 jmp LB95F ; re-enter mainline code
11439 SF8B1 lbsr SF772 ; map screen
11440 tst H.CURSX ; at left margin?
11441 pshs cc ; save Z flag
11442 lbsr SF778 ; unmap screen
11443 puls cc ; get back Z flag
11444 lbne LB958 ; brif not at left margine - do CR
11445 rts
11446 ; PRINT @ patch
11447 ALINK25 tst HRWIDTH ; VDG screen?
11448 bne SF8CD ; brif not - raise error
11449 jsr LA554 ; move cursor to specified position
11450 jmp LB905 ; return to mainline code
11451 SF8CD ldb #39*2 ; code for HP error
11452 jmp LAC46 ; raise error
11453 ; LOCATE command
11454 ; The parameter checking here could simply use the H.COLUMN and H.ROW variables and it would
11455 ; be loads simpler. Also, if the dumbassery with the cursor wasn't a thing, this routine wouldn't
11456 ; need to mess with mapping the screen or screwing around with the cursor.
11457 LOCATE ldb HRWIDTH ; is it 40/80 column screen?
11458 lbrn 0
11459 beq SF8CD ; brif not - raise error
11460 pshs b ; save screen mode
11461 jsr SE7B2 ; evaluate coordinates
11462 lda BINVAL+1 ; get X coordinate
11463 puls b ; get back screen mode
11464 cmpb #1 ; is it 40 column screen?
11465 bne SF8EB ; brif not
11466 cmpa #40 ; in range for 40 columns?
11467 bra SF8ED
11468 SF8EB cmpa #80 ; in range for 80 columns?
11469 SF8ED lbhs LB44A ; brif not - raise error
11470 ldb VERBEG+1 ; get Y coordinate
11471 cmpb #ROWMAX ; is it in range?
11472 bhs SF8ED ; brif not - raise error
11473 pshs d ; save new coordinates
11474 lbsr SF772 ; map screen
11475 std H.CURSX ; set screen coordinates
11476 ldx H.CRSLOC ; get pointer to old position
11477 lda H.CRSATT ; replace attributes with current ones
11478 sta 1,x
11479 lda H.COLUMN ; get number of columns (why not use this above?)
11480 asla ; two bytes per character cell
11481 mul ; now D is offset to start of row
11482 ldx #HRESSCRN ; get start of screen
11483 leax d,x ; now X points to the start of the line
11484 puls a,b ; get back column and row numbers
11485 asla ; two bytes per character cell
11486 tfr a,b ; need this in B since we'll overflow singed 8 bits
11487 abx ; offset to correct cursor position
11488 lda H.CRSATT ; get attributes
11489 ora #0x40 ; enable underline
11490 sta 1,x ; enable cursor
11491 stx H.CRSLOC ; save new cursor pointer
11492 lbsr SF778 ; unmap screen
11493 rts
11494 ; HSTAT command
11495 HSTAT tst HRWIDTH ; is it 40/80 column screen?
11496 lbrn 0
11497 beq SF8CD ; brif not - raise error
11498 lbsr SF772 ; map the screen
11499 ldx H.CRSLOC ; get cursor pointer
11500 ldd ,x ; get character and attributes
11501 std VCB ; save them
11502 ldd H.CURSX ; get screen coordinates
11503 std VCD ; save them
11504 lbsr SF778 ; unmap screen
11505 jsr LB357 ; evaluate variable for character
11506 stx VARDES ; saveit
11507 jsr SYNCOMMA ; insist on a comma
11508 ldb #1 ; make a single character string
11509 jsr LB56D
11510 lda VCB ; get character on screen
11511 jsr LB511 ; get string details
11512 sta ,x ; save character in string
11513 jsr LB54C ; put string on string stack
11514 ldx VARDES ; point to variable descriptor
11515 tst -1,x ; is it a string? (should have checked after evaluating instead)
11516 lbpl LB151 ; do type mismatch if number
11517 ldy FPA0+2 ; point to destination string descriptor
11518 ldb #5 ; copy 5 bytes from newly created string into variable
11519 SF963 lda ,y+ ; copy byte
11520 sta ,x+
11521 decb ; done all?
11522 bne SF963 ; brif not
11523 LDX TEMPPT ; point to new string descriptor
11524 leax -5,x ; BUG: should just call LB675 to remove string from string stack
11525 stx TEMPPT
11526 jsr LB357 ; evaluate a variable (for X coord)
11527 stx VARDES ; save pointer to it
11528 jsr SYNCOMMA ; insist on a comma after it
11529 clra ; zero extend attributes
11530 ldb VCB+1 ; get attribute byte
11531 jsr GIVABF ; convert to float
11532 ldx VARDES ; point to variable
11533 tst -1,x ; test if numeric (should have tested VALTYP above)
11534 lbmi LB151 ; TM error if not number
11535 jsr LBC35 ; pack FPA0 to variable
11536 jsr LB357 ; evaluate another variable
11537 stx VARDES ; save it
11538 jsr SYNCOMMA ; insist on a comma
11539 clra ; zero extend the X coordinate
11540 ldb VCD ; get X coordinate
11541 jsr GIVABF ; turn into a FP number
11542 ldx VARDES ; get variable
11543 tst -1,x ; is it a number (should have tested VALTYP above)
11544 LBMI LB151 ; brif not - TM error
11545 jsr LBC35 ; pack FPA0 to variable
11546 jsr LB357 ; evaluate another variable
11547 stx VARDES ; save it
11548 clra ; zero extend Y coordinate
11549 ldb VCD+1 ; get Y coordinate
11550 jsr GIVABF ; turn into a FP number
11551 ldx VARDES ; get variable descriptor back
11552 tst -1,x ; is it a number (should have tested VALTYP above)
11553 lbmi LB151 ; brif not - TM error
11554 jsr LBC35 ; pack FPA0 to variable
11555 rts
11556 ; ATTR command
11557 ATTR jsr EVALEXPB ; evaluate foreground colour
11558 lbrn 0
11559 cmpb #8 ; there are 8 valid colours (0-7)
11560 lbhs LB44A ; brif out of range - raise error
11561 aslb ; shift over to bits 5,4,3
11562 aslb
11563 aslb
11564 pshs b ; save partial attribute byte
11565 jsr GETCCH ; fetch current character (useless call)
11566 jsr SYNCOMMA ; insist on comma
11567 jsr EVALEXPB ; evaluate background colour
11568 cmpb #8 ; is it valid (0-7)?
11569 lbhs LB44A ; brif not - raise error
11570 orb ,s ; merge with partial attribute byte
11571 leas 1,s ; clean up stack (could use ,s+ above)
11572 andb #0x3f ; make sure we have zeros in bit 7,6 - unneeded
11573 pshs b ; save colour attributes
11574 jsr GETCCH ; is there mode?
11575 SF9E3 beq SFA06 ; brif no more flags
11576 jsr SYNCOMMA ; insist on a comma
11577 cmpa #'B ; B (blink)?
11578 bne SF9F6 ; brif not
11579 puls b ; set blink bit in accumulated attributes
11580 orb #0x80
11581 pshs b
11582 jsr GETNCH ; eat the flag
11583 bra SF9E3 ; look for another flag
11584 SF9F6 cmpa #'U ; U (underline)?
11585 lbne LB44A ; invalid flag - raise error
11586 puls b ; get accumulated attributes and set underline bit
11587 orb #0x40
11588 pshs b
11589 jsr GETNCH ; eat the flag
11590 bra SF9E3 ; look for another flag
11591 SFA06 puls b ; get new attributes
11592 stb H.CRSATT ; set them as default
11593 rts
11594 fcb 0x00,0x00,0x00,0x00 ; unused bytes
11595 ; These are extra glyphs that should be part of the HPRINT font but aren't.
11596 fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 ; Ç
11597 fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; ü
11598 fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; é
11599 fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 ; â
11600 fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ä
11601 fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 ; à
11602 fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ȧ (or å maybe?)
11603 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 ; ç
11604 fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 ; ê
11605 fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; ë
11606 fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; è
11607 fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 ; ï
11608 fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 ; î
11609 fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 ; ẞ
11610 fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ä
11611 fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ȧ (or Å maybe?)
11612 fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 ; ó
11613 fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 ; æ
11614 fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 ; Æ
11615 fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 ; ô
11616 fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; ö
11617 fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 ; ø
11618 fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 ; û
11619 fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 ; ù
11620 fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 ; Ø
11621 fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 ; Ö
11622 fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; Ü
11623 fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 ; §
11624 fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 ; £
11625 fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 ; ±
11626 fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 ; °
11627 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 ; ſ (long s)
11628 ; These are some extra symbol glyphs
11629 fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 ; solid right pointing triangle
11630 fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; solid left pointing triangle
11631 fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00 ; solid down pointing triangle
11632 fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00 ; solid up pointing triangle
11633 fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00 ; three horizontal lines with middle one double thick
11634 fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00 ; solid square on top left of open square
11635 fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00 ; solid box inside larger box
11636 fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00 ; thick equals sign
11637 fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00 ; solid vertical rectangle
11638 fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00 ; solid horizontal rectangle
11639 fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00 ; hour glass
11640 fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00 ; left end three horizontal lines with middle one double thick
11641 fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00 ; right end three horizontal lines with middle one double thick
11642 ; The above 45 glyphs are duplicated below
11643 fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10
11644 fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00
11645 fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00
11646 fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00
11647 fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00
11648 fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00
11649 fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00
11650 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10
11651 fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00
11652 fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00
11653 fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00
11654 fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00
11655 fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00
11656 fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40
11657 fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00
11658 fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00
11659 fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00
11660 fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00
11661 fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00
11662 fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00
11663 fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00
11664 fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00
11665 fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00
11666 fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00
11667 fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00
11668 fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00
11669 fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00
11670 fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00
11671 fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00
11672 fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00
11673 fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00
11674 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40
11675 fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00
11676 fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00
11677 fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00
11678 fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00
11679 fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00
11680 fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00
11681 fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00
11682 fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00
11683 fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00
11684 fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00
11685 fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00
11686 fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00
11687 fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00
11688 ; The glyphs above repeat one more time here but the set is incomplete
11689 fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10
11690 fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00
11691 fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00
11692 fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00
11693 fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00
11694 fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00
11695 fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00
11696 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10
11697 fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00
11698 fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00
11699 fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00
11700 fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00
11701 fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00
11702 fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40
11703 fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00
11704 fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00
11705 fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00
11706 fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00
11707 fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00
11708 fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00
11709 fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00
11710 fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00
11711 fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00
11712 fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00
11713 fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00
11714 fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00
11715 fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00
11716 fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00
11717 fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00
11718 fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00
11719 fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00
11720 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40
11721 fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00
11722 fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; final duplicated glyph: left pointing solid triangle
11723 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; junk unused (or blank space)
11724 fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF ; junk unused (or solid block)
11725 ; This is where the constant page (FExx) would start. It's just garbage in the ROM.
11726 fill 0xff,8
11727 fill 0x00,8
11728 fill 0xff,8
11729 fill 0x00,8
11730 fill 0xff,8
11731 fill 0x00,8
11732 fill 0xff,8
11733 fill 0x00,8
11734 fill 0xff,8
11735 fill 0x00,8
11736 fill 0xff,8
11737 fill 0x00,8
11738 fill 0xff,8
11739 fill 0x00,8
11740 fill 0xff,8
11741 fill 0x00,8
11742 fill 0xff,8
11743 fill 0x00,8
11744 fill 0xff,8
11745 fill 0x00,8
11746 fill 0xff,8
11747 fill 0x00,8
11748 fill 0xff,8
11749 fill 0x00,8
11750 fill 0xff,8
11751 fill 0x00,8
11752 fill 0xff,8
11753 fill 0x00,8
11754 fill 0xff,8
11755 fill 0x00,8
11756 fill 0xff,8
11757 fill 0x00,8
11758 ; This is where the I/O page would start. It's just garbage in the ROM until the interrupt vectors.
11759 fill 0x00,8
11760 fill 0xff,8
11761 fill 0x00,8
11762 fill 0xff,8
11763 fill 0x00,8
11764 fill 0xff,8
11765 fill 0x00,8
11766 fill 0xff,8
11767 fill 0x00,8
11768 fill 0xff,8
11769 fill 0x00,8
11770 fill 0xff,8
11771 fill 0x00,8
11772 fill 0xff,8
11773 fill 0x00,8
11774 fill 0xff,8
11775 fill 0x00,8
11776 fill 0xff,8
11777 fill 0x00,8
11778 fill 0xff,8
11779 fill 0x00,8
11780 fill 0xff,8
11781 fill 0x00,8
11782 fill 0xff,8
11783 fill 0x00,8
11784 fill 0xff,8
11785 fill 0x00,8
11786 fill 0xff,8
11787 fill 0x00,8
11788 fill 0xff,8
11789 ; These are the actual CPU interrupt vectors
11790 fdb 0x0000 ; would be the 6309 illegal instruction trap
11791 fdb INT.SWI3 ; SWI3 bounce vector address
11792 fdb INT.SWI2 ; SWI2 bounce vector address
11793 fdb INT.FIRQ ; FIRQ bounce vector address
11794 fdb INT.IRQ ; IRQ bounce vector address
11795 fdb INT.SWI ; SWI bounce vector address
11796 fdb INT.NMI ; NMI bounce vector address
11797 fdb L8C1B ; this is where execution starts on RESET or power on