Mercurial > hg > index.cgi
diff secb.s @ 0:605ff82c4618
Initial check in with cleaned up sources
This is the initial check in the source code in a state where it builds byte
accurate copies of all the various ROM versions included.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sat, 08 Dec 2018 19:57:01 -0700 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/secb.s Sat Dec 08 19:57:01 2018 -0700 @@ -0,0 +1,11797 @@ + *pragma nolist + include defs.s +DC0DC equ 0xC0DC ; needed for Disk Basic path jump backs + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; EXTENDED COLOR BASIC ROM area +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + org EXBAS + fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic +L8002 ldx #L80DE ; point to command interpretation table information + ldu #COMVEC+10 ; point to command interpretation table location + ldb #10 ; 10 bytes to move + jsr LA59A ; copy command interpretation table + ldx #LB277 ; initialize Disk Basic's entries to error + stx 3,u + stx 8,u + ldx #XIRQSV ; set up IRQ service routine + stx IRQVEC+1 + ldx ZERO ; reset the TIMER value + stx TIMVAL + jsr XVEC18 ; do a bunch of initialization + ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout + std DLBAUD + ldx #USR0 ; set up pointer to USR routine addresses + stx USRADR + ldu #LB44A ; set up USR routine addresses to "FC error" + ldb #10 ; there are 10 routines +L8031 stu ,x++ ; set a routine to FC error + decb ; done all? + bne L8031 ; brif not + lda #0x7e ; op code of JMP extended (for RAM hook intialization) + sta RVEC20 ; command interpretation loop + ldx #XVEC20 + stx RVEC20+1 + sta RVEC15 ; expression evaluation + ldx #XVEC15 + stx RVEC15+1 + sta RVEC19 ; number parsing + ldx #XVEC19 + stx RVEC19+1 + sta RVEC9 ; PRINT + ldx #XVEC9 + stx RVEC9+1 + sta RVEC17 ; error handler + ldx #XVEC17 + stx RVEC17+1 + sta RVEC4 ; generic input + ldx #XVEC4 + stx RVEC4+1 + sta RVEC3 ; generic output + ldx #XVEC3 + stx RVEC3+1 + sta RVEC8 ; close file + ldx #XVEC8 + stx RVEC8+1 + sta RVEC23 ; tokenize line + ldx #XVEC23 + stx RVEC23+1 + sta RVEC18 ; RUN + ldx #XVEC18 + stx RVEC18+1 + sta EXPJMP ; exponentiation + ldx #L8489 + stx EXPJMP+1 + jsr L96E6 ; initialize graphics stuff + lda PIA0+3 ; enable 60Hz interrupt + ora #1 + sta PIA0+3 + ldx #'D*256+'K ; magic number for a Disk Basic ROM + cmpx DOSBAS ; do we have a Disk Basic ROM? + lbeq DOSBAS+2 ; brif so - launch it + andcc #0xaf ; enable interrupts +L80B2 ldx #L80E8-1 ; show sign on message + jsr STRINOUT +L80B8 ldx #XBWMST ; install warm start handler + stx RSTVEC + jmp LA0E2 ; set up warm start flag and launch immediate mode +; Extended Basic warm start code +XBWMST fcb 0xff ; mark routine as invalid so that ROMs are always copied to RAM on RESET + clr PLYTMR ; cancel any PLAY command in progress + clr PLYTMR+1 + lda PIA0+3 ; enable 60Hz interrupt + ora #1 + sta PIA0+3 + jmp BAWMST ; let Color Basic's warm start process run +; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects +; the input pointer so that it points to the correct place after the program has been relocated by +; PCLEAR instead of continuing with something that, in the best case, is a syntax error. +L80D0 lda CURLIN ; immediate mode? + inca + beq L80DD ; brif so + tfr y,d ; save offset to D + subd TXTTAB ; see how far into the program we are + addd CHARAD ; now adjust the input pointer based on that + std CHARAD ; save corrected input pointer +L80DD rts +L80DE fcb 25 ; 25 Extended Basic commands + fdb L8183 ; reserved word table (commands) + fdb L813C ; interpretation handler (commands) + fcb 14 ; 14 Extended Basic functions + fdb L821E ; reserved word table (functions) + fdb L8168 ; function handler +L80E8 fcc 'EXTENDED COLOR BASIC 2.0' + fcb 0x0d + fcc 'COPR. 1982, 1986 BY TANDY ' + fcb 0x0d + fcc 'UNDER LICENSE FROM MICROSOFT' + fcb 0x0d,0x0d,0x00 +; Extended Basic command interpretation loop +L813C cmpa #0xcb ; is it an Extended Basic command? + bhi L8148 ; brif not + ldx #L81F0 ; point to dispatch table + suba #0xb5 ; normalize the token number so 0 is the first entry + jmp LADD4 ; go transfer control to the command +L8148 cmpa #0xff ; is it a function token? + beq L8154 ; brif so - for MID$()=, TIMER= + cmpa #0xcd ; is it a token for a keyword that isn't a command? + bls L8165 ; brif so - error for USING and FN +L8150 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present +L8154 jsr GETNCH ; get token after the function flag + cmpa #0x90 ; MID$? + lbeq L86D6 ; brif so (substring replacement) + cmpa #0x9f ; TIMER? + lbeq L8960 ; brif so - TIMER setting + jsr RVEC22 ; do a RAM hook in case something wants to extend this +L8165 jmp LB277 ; we have nothing valid here +; Function handler +L8168 cmpb #2*33 ; is it a valid Extended Basic function? + bls L8170 ; brif so +L816C jmp [COMVEC+28] ; transfer control to Disk Basic if it is present +L8170 subb #2*20 ; normalize Extended Basic functions to 0 + cmpb #2*8 ; Above HEX$? + bhi L817D ; brif so - we don't pre-evaluate an argument + pshs b ; save token value + jsr LB262 ; evaluate the function parameter + puls b ; get back token value +L817D ldx #L8257 ; point to dispatch table + jmp LB2CE ; go transfer control to the function +; Reserved words (commands) +L8183 fcs 'DEL' ; 0xb5 + fcs 'EDIT' ; 0xb6 + fcs 'TRON' ; 0xb7 + fcs 'TROFF' ; 0xb8 + fcs 'DEF' ; 0xb9 + fcs 'LET' ; 0xba + fcs 'LINE' ; 0xbb + fcs 'PCLS' ; 0xbc + fcs 'PSET' ; 0xbd + fcs 'PRESET' ; 0xbe + fcs 'SCREEN' ; 0xbf + fcs 'PCLEAR' ; 0xc0 + fcs 'COLOR' ; 0xc1 + fcs 'CIRCLE' ; 0xc2 + fcs 'PAINT' ; 0xc3 + fcs 'GET' ; 0xc4 + fcs 'PUT' ; 0xc5 + fcs 'DRAW' ; 0xc6 + fcs 'PCOPY' ; 0xc7 + fcs 'PMODE' ; 0xc8 + fcs 'PLAY' ; 0xc9 + fcs 'DLOAD' ; 0xca + fcs 'RENUM' ; 0xcb + fcs 'FN' ; 0xcc + fcs 'USING' ; 0xcd +; Dispatch table (commands) +L81F0 fdb DEL ; 0xb5 DEL + fdb EDIT ; 0xb6 EDIT + fdb TRON ; 0xb7 TRON + fdb TROFF ; 0xb8 TROFF + fdb DEF ; 0xb9 DEF + fdb LET ; 0xba LET (note: implemented by Color Basic!) + fdb LINE ; 0xbb LINE + fdb PCLS ; 0xbc PCLS + fdb PSET ; 0xbd PSET + fdb PRESET ; 0xbe PRESET + fdb SCREEN ; 0xbf SCREEN + fdb PCLEAR ; 0xc0 PCLEAR + fdb COLOR ; 0xc1 COLOR + fdb CIRCLE ; 0xc2 CIRCLE + fdb PAINT ; 0xc3 PAINT + fdb GET ; 0xc4 GET + fdb PUT ; 0xc5 PUT + fdb DRAW ; 0xc6 DRAW + fdb PCOPY ; 0xc7 PCOPY + fdb PMODETOK ; 0xc8 PMODE + fdb PLAY ; 0xc9 PLAY + fdb DLOAD ; 0xca DLOAD + fdb RENUM ; 0xcb RENUM +; Reserved words (functions) +L821E fcs 'ATN' ; 0x94 + fcs 'COS' ; 0x95 + fcs 'TAN' ; 0x96 + fcs 'EXP' ; 0x97 + fcs 'FIX' ; 0x98 + fcs 'LOG' ; 0x99 + fcs 'POS' ; 0x9a + fcs 'SQR' ; 0x9b + fcs 'HEX$' ; 0x9c + fcs 'VARPTR' ; 0x9d + fcs 'INSTR' ; 0x9e + fcs 'TIMER' ; 0x9f + fcs 'PPOINT' ; 0xa0 + fcs 'STRING$' ; 0xa1 +; Dispatch table (functions) +L8257 fdb ATN ; 0x94 ATN + fdb COS ; 0x95 COS + fdb TAN ; 0x96 TAN + fdb EXP ; 0x97 EXP + fdb FIX ; 0x98 FIX + fdb LOG ; 0x99 LOG + fdb POS ; 0x9a POS + fdb SQR ; 0x9b SQR + fdb HEXDOL ; 0x9c HEX$ + fdb VARPTRTOK ; 0x9d VARPTR + fdb INSTR ; 0x9e INSTR + fdb TIMER ; 0x9f TIMER + fdb PPOINT ; 0xa0 PPOINT + fdb STRING ; 0xa1 STRING$ +; Generic output handler +XVEC3 tst DEVNUM ; screen? + lbeq L95AC ; brif so - force text screen active + pshs b ; save register + ldb DEVNUM ; get output device + cmpb #-3 ; check for DLOAD + puls b ; restore register + bne L8285 ; brif not DLOAD + leas 2,s ; bail out of output handler if DLOAD +L8285 rts +; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the +; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required +; if a recent enough version of Color Basic is installed. +XVEC8 lda DEVNUM ; get device number + inca ; is it tape? + bne L8285 ; brif not - we aren't going to mess with it + lda FILSTA ; get tape file status + cmpa #2 ; output file? + bne L8285 ; brif not + lda CINCTR ; is there anything waiting to be written out? + bne L8285 ; brif so - mainline code will handle it properly + clr DEVNUM ; reset output to screen + leas 2,s ; don't return to mainline code + jmp LA444 ; write EOF block +; RUN handler - sets up some Extended Basic stuff to defaults at program start +XVEC18 ldd #0xba42 ; initialize PLAY volume + std VOLHI + lda #2 ; set PLAY tempo to 2, PLAY octave to 3 + sta TEMPO + sta OCTAVE + asla ; set default note length to 5 + sta NOTELN + clr DOTVAL ; don't do any note length extension + ldd ZERO ; initialize DRAW angle and scale to default 1 + std ANGLE + ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen + std HORDEF + ldb #96 + std VERDEF + rts +; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF +XVEC20 leas 2,s ; don't return to the mainline code +L82BB andcc #0xaf ; make sure interrupts are running + jsr LADEB ; do a BREAK/pause check + ldx CHARAD ; save input pointer + stx TINPTR + lda ,x+ ; get current input character + beq L82CF ; brif end of line + cmpa #': ; statement separator? + beq L82F1 ; brif so + jmp LB277 ; raise error we got here with extra junk +L82CF lda ,x++ ; get first byte of next line address + sta ENDFLG ; use it to set "END" flag to "END" + bne L82D8 ; brif not end of program + jmp LAE15 ; go do the "END" +L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text) + std CURLIN ; set current line number + stx CHARAD ; save input pointer + lda TRCFLG ; are we tracing? + beq L82F1 ; brif not + lda #'[ ; show opening marker for TRON line number + jsr PUTCHR + lda CURLIN ; restore MSB of line number + jsr LBDCC ; show line number + lda #'] ; show closing marker for TRON line number + jsr PUTCHR +L82F1 jsr GETNCH ; get the start of the statement + tfr cc,b ; save status flags + cmpa #0x98 ; is it CSAVE? + beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM) + cmpa #0x97 ; is it CLOAD? + beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries) + tfr b,cc ; restore character status + jsr LADC6 ; go process command + bra L82BB ; restart interpretation loop +; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the +; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This +; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation +; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all. +XVEC23 ldx 2,s ; get return address of caller to the tokenizer + cmpx #LAC9D ; is it coming from immediate mode prior to executing the line? + bne L8310 ; brif not + ldx #L82F1 ; force return to Extended Basic's main loop patch above + stx 2,s +L8310 rts +; These two patches are set up this way so that control can be transferred back to the original Color Basic +; implementations if the Extended Basic addons are not triggered. +L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler + bra L82BB ; go do another command +L8316 bsr L831A ; go do Extended Basic's CSAVE handler + bra L82BB ; go do another command +; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have) +L831A jsr GETNCH ; get character after CSAVE + cmpa #'M ; is it CSAVEM? + lbne CSAVE ; brif not - Color Basic can handle this + jsr GETNCH ; eat the "M" + jsr LA578 ; parse file name + bsr L836C ; get start address + stx CASBUF+13 ; save it in file header + bsr L836C ; get end address + cmpx 2,s ; compare to start address + lblo LB44A ; brif end address is before the start address + bsr L836C ; get execution address + stx CASBUF+11 ; put in file header + jsr GETCCH ; are we at the end of the commmand? + bne L8310 ; brif not + lda #2 ; file type to machine language + ldx ZERO ; set to binary and single block + jsr LA65F ; write header + clr FILSTA ; mark any open tape file closed + inc BLKTYP ; set block type to data + jsr WRLDR ; write a data leader + ldx 4,s ; get starting address +L834D stx CBUFAD ; set start of data address + lda #255 ; try a full length block by default + sta BLKLEN + ldd 2,s ; get ending address + subd CBUFAD ; see how much is left + bhs L835E ; brif we have more to write + leas 6,s ; clean up stack + jmp LA491 ; write EOF block +L835E cmpd #255 ; do we have a full block left? + bhs L8367 ; brif so + incb ; set block size to remainder + stb BLKLEN +L8367 jsr SNDBLK ; write a data block + bra L834D ; go see if we have more to write +L836C jsr SYNCOMMA ; make sure we have a comma + jsr LB73D ; evaluate unsigned expression to X + ldu ,s ; get return address + stx ,s ; save result on stack + tfr u,pc ; return to caller +; COS function +COS ldx #L83AB ; point to PI/2 constant + jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) ) +L837E jmp SIN ; now calculate sin((pi/2)+x) +; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X) +TAN jsr LBC2F ; save FPA0 in FPA3 + clr RELFLG ; reset quadrant flag + bsr L837E ; calculate SIN(x) + ldx #V4A ; save result in FPA5 + jsr LBC35 + ldx #V40 ; get back original argument + jsr LBC14 + clr FP0SGN ; force result positive + lda RELFLG ; get quadrant flag + bsr L83A6 ; calculate COS(x) + tst FP0EXP ; did we get 0 for COS(x) + lbeq LBA92 ; brif so - overflow + ldx #V4A ; point to sin(x) +L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value +L83A6 pshs a ; save sign flag + jmp LBFA6 ; expand polynomial +L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant +; ATN function (inverse tangent). There are two calculation streams used to improve precision. +; One if the parameter is >= 1.0 and the other if it is < 1.0 +ATN lda FP0SGN ; get sign of argument + pshs a ; save it + bpl L83B8 ; brif positive + bsr L83DC ; flip sign of argument +L83B8 lda FP0EXP ; get exponent + pshs a ; save it + cmpa #0x81 ; exponent for 1.0 + blo L83C5 ; brif less - value is less than 1.0 + ldx #LBAC5 ; point to FP constant 1.0 + bsr L83A3 ; calculate reciprocal +L83C5 ldx #L83E0 ; point to polynomical coefficients + jsr LBEF0 ; expand polynomial + puls a ; get exponent of argument + cmpa #0x81 ; did we do a reciprocal calculation? + blo L83D7 ; brif not + ldx #L83AB ; subtract result from pi/2 if we did + jsr LB9B9 +L83D7 puls a ; get sign of original + tsta ; was it positive? + bpl L83DF ; brif so +L83DC jmp LBEE9 ; flip sign of result +L83DF rts +; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly +; 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 +; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with +; fewer coefficients. +L83E0 fcb 11 ; 12 coefficients + fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912 + fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216 + fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018 + fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381 + fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328 + fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965 + fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954 + fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413 + fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808 + fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121 + fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316 + fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0 +; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x) +L841D fcb 3 ; four coefficients + fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2) + fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2) + fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2) + fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2) +L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2) +L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2) +L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5 +L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2) +; LOG function (natural log, ln) +; FP representation is of the form A*2^B. Thus, the log routine determines the value of +; ln(A*2^B). +; +; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR: +; (log2(A) + B)*ln(2) +; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so: +; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2) +; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2) +; +; Everything except log2(A*sqrt(2)) is either constant or trivial. +; +; What the actual code below feeds into the modified taylor series is actually: +; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1) +; +; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would +; expect from the identities. However, the modified coefficients in the series above +; could be correcting for that or the introduced error was deemed acceptable. +; NOTE: this routine does NOT return 0 for LOG(1) +LOG jsr LBC6D ; get status of FPA0 + lble LB44A ; brif <= 0 - logarithms don't exist in that case + ldx #L8432 ; point to 1/sqrt(2) + lda FP0EXP ; get exponent of argument + suba #0x80 ; remove bias + pshs a ; save it for later + lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description) + sta FP0EXP + jsr LB9C2 ; add 1/sqrt(2) to A + ldx #L8437 ; point to sqrt(2) + jsr LBB8F ; divide that by FPA0 + ldx #LBAC5 ; point to 1.0 + jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2))) + ldx #L841D ; point to coefficients + jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument) + ldx #L843C ; point to -0.5 + jsr LB9C2 ; add result + puls b ; get original exponent back + jsr LBD99 ; add B to FPA0 + ldx #L8441 ; point to ln(2) + jmp LBACA ; multiply by ln(2) which gives us the result in base e +; SQR function (square root) - returns the principle root (positive) +SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation) + ldx #LBEC0 ; point to 0.5 (exponent for square root) + jsr LBC14 ; set up second argument to exponentiation (the exponent) +; Exponentiation operator +; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0 +L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0) + tsta ; check that the base is not 0 + bne L8491 ; brif base is not 0 + jmp LBA3A ; 0^(nonzero) is 0 +L8491 ldx #V4A ; save exponent (to FPA5) + jsr LBC35 + clrb ; result sign will default to positive + lda FP1SGN ; check if base is positive + bpl L84AC ; brif so + jsr INT ; convert exponent to integer + ldx #V4A ; point to original expoent + lda FP1SGN ; get sign of FPA1 + jsr LBCA0 ; compare original exponent with truncated one + bne L84AC ; brif not equal + coma ; flip sign + ldb CHARAC ; get LS byte of integer exponent (result sign flag) +L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign) + pshs b ; save result sign + jsr LOG ; get natural log of the base + ldx #V4A ; multiply the log by the exponent + jsr LBACA + bsr EXP ; now raise e to the resulting power + puls a ; get result sign + rora ; brif it was negative + lbcs LBEE9 ; brif negative - flip sign + rts +L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function) +; Chebyshev modified taylor series coefficients for e^x +L84C9 fcb 7 ; eight coefficients + fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7)) + fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6)) + fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5)) + fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4)) + fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3)) + fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2)) + fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1)) + fcb 0x81,0x00,0x00,0x00,0x00 ; 1 +; EXP function (e^x) +EXP ldx #L84C4 ; point to correction factor + jsr LBACA ; multiply it + jsr LBC2F ; save corrected argument to FPA3 + lda FP0EXP ; get exponent of FPA0 + cmpa #0x88 ; is it too big? + blo L8504 ; brif not +L8501 jmp LBB5C ; to 0 (underflow) or overflow error +L8504 jsr INT ; convert argument to an integer + lda CHARAC ; get ls byte of integer + adda #0x81 ; was argument 127? if so, the OV error; adds bias + beq L8501 + deca ; adjust for the extra +1 above + pshs a ; save integer exponent + ldx #V40 ; get fractional part of argument + jsr LB9B9 + ldx #L84C9 ; point to coefficients + jsr LBEFF ; evaluate polynomial on the fractional part + clr RESSGN ; force result to be positive + puls a ; get back original exponent + jsr LBB48 ; add original exponent to the fractional result + rts +; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0) +FIX jsr LBC6D ; get status of argument + bmi L852C ; brif negative +L8529 jmp INT ; do regular "int" if positive +L852C com FP0SGN ; flip the sign + bsr L8529 ; do "INT" on this + jmp LBEE9 ; flip the sign back +; EDIT command +EDIT jsr L89AE ; get line number + leas 2,s ; we're not going to return to the main loop +L8538 lda #1 ; "LIST" flag + sta VD8 ; set to list the line + jsr LAD01 ; find line number + lbcs LAED2 ; brif line wasn't found + jsr LB7C2 ; go unpack the line into the buffer + tfr y,d ; calculate the actual length of the line + subd #LINBUF+2 + stb VD7 ; save line length (it will only be 8 bits) +L854D ldd BINVAL ; get the line number + jsr LBDCC ; display it + jsr LB9AC ; put a space after it + ldx #LINBUF+1 ; point to iput uffer + ldb VD8 ; are we listing? + bne L8581 ; brif so +L855C clrb ; reset digit accumulator +L855D jsr L8687 ; get a keypress + jsr L90AA ; set carry if not numeric + bcs L8570 ; brif not a number + suba #'0 ; remove ASCII bias + pshs a ; save digit value + lda #10 ; multiply accumulator by 10 + mul + addb ,s+ ; add in new digit + bra L855D ; go check for another digit +L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1 + adcb #1 + cmpa #'A ; abort? + bne L857D ; brif not + jsr LB958 ; to a CR + bra L8538 ; restart EDIT process +L857D cmpa #'L ; list? + bne L858C ; brif not +L8581 bsr L85B4 ; list the line + clr VD8 ; reset to "not listing" + jsr LB958 ; do a CR + bra L854D ; start editing +L858A leas 2,s ; lose return address +L858C cmpa #0x0d ; ENTER? + bne L859D ; brif not + bsr L85B4 ; echo out the line +L8592 jsr LB958 ; do a CR + ldx #LINBUF+1 ; reset input pointer to start of buffer + stx CHARAD + jmp LACA8 ; join immediate mode to replace the line in the program +L859D cmpa #'E ; exit? + beq L8592 ; brif so - end edit with no echo + cmpa #'Q ; quit? + bne L85AB ; brif not + jsr LB958 ; do a CR + jmp LAC73 ; go to immediate mode with no fanfare - no changes saved +L85AB bsr L85AF ; go do commands + bra L855C ; go handle another command +L85AF cmpa #0x20 ; space? + bne L85C3 ; brif not + skip2 +L85B4 ldb #LBUFMX-1 ; display up to a whole line +L85B6 lda ,x ; get buffer chracter + beq L85C2 ; brif end of line + jsr PUTCHR ; output character + leax 1,x ; move to next character + decb ; done? + bne L85B6 ; brif not +L85C2 rts +L85C3 cmpa #'D ; delete? + bne L860F ; brif not +L85C7 tst ,x ; end of line? + beq L85C2 ; brif so - can't delete + bsr L85D1 ; remove a character + decb ; done all requested? + bne L85C7 ; brif not + rts +L85D1 dec VD7 ; account for character being removed + leay -1,x ; set pointer and compensate for increment below +L85D5 leay 1,y ; move to next character + lda 1,y ; get next character + sta ,y ; move it forward + bne L85D5 ; brif we didn't hit the end of the buffer + rts +L85DE cmpa #'I ; insert? + beq L85F5 ; brif so + cmpa #'X ; extend? + beq L85F3 ; brif so + cmpa #'H ; "hack"? + bne L8646 ; brif not + clr ,x ; mark current location as end of line + tfr x,d ; calculate new line length + subd #LINBUF+2 + stb VD7 ; save new length +L85F3 bsr L85B4 ; display the line +L85F5 jsr L8687 ; read a character + cmpa #0x0d ; ENTER? + beq L858A ; brif so - terminate entry + cmpa #0x1b ; ESC? + beq L8625 ; brif so - back to command mode + cmpa #0x08 ; backspace? + bne L8626 ; brif no + cmpx #LINBUF+1 ; are we at the start of the buffer? + beq L85F5 ; brif so - it's a no-op + bsr L8650 ; move pointer back one, do a BS + bsr L85D1 ; remove character from the buffer + bra L85F5 ; go handle more input +L860F cmpa #'C ; change? + bne L85DE ; brif not +L8613 tst ,x ; is there something to change? + beq L8625 ; brif not + jsr L8687 ; get a key stroke + bcs L861E ; brif valid key + bra L8613 ; try again if invalid key +L861E sta ,x+ ; put new character in the buffer + bsr L8659 ; echo it + decb ; changed number requested? + bne L8613 ; brif not +L8625 rts +L8626 ldb VD7 ; get length of line + cmpb #LBUFMX-1 ; at maximum line length? + bne L862E ; brif not + bra L85F5 ; process another input character +L862E pshs x ; save input pointer +L8630 tst ,x+ ; are we at the end of the line? + bne L8630 ; brif not +L8634 ldb ,-x ; get character before current pointer, move back + stb 1,x ; move it forward + cmpx ,s ; at the original buffer pointer? + bne L8634 ; brif not + leas 2,s ; remove saved buffer pointer + sta ,x+ ; save input character in newly made hole + bsr L8659 ; echo it + inc VD7 ; bump line length counter + bra L85F5 ; go handle more stuff +L8646 cmpa #0x08 ; backspace? + bne L865C ; brif not +L864A bsr L8650 ; move pointer back, echo BS + decb ; done enough of them? + bne L864A ; brif not + rts +L8650 cmpx #LINBUF+1 ; at start of buffer? + beq L8625 ; brif so + leax -1,x ; move pointer back + lda #0x08 ; character to echo - BS +L8659 jmp PUTCHR ; echo character to screen +L865C cmpa #'K ; "kill"? + beq L8665 ; brif so + suba #'S ; search? + beq L8665 ; brif so + rts +L8665 pshs a ; save kill/search flag + bsr L8687 ; read target + pshs a ; save search character +L866B lda ,x ; get current character in buffer + beq L8685 ; brif end of line - nothing more to search + tst 1,s ; is it KILL? + bne L8679 ; brif so + bsr L8659 ; echo the character + leax 1,x ; move ahead + bra L867C ; check next character +L8679 jsr L85D1 ; remove character from buffer +L867C lda ,x ; get character in buffer + cmpa ,s ; are we at the target? + bne L866B ; brif not + decb ; have we found enough of them? + bne L866B ; brif not +L8685 puls y,pc ; clean up stack and return to main EDIT routine +L8687 jsr LA171 ; get input from the generic input handler (will show the cursor) + cmpa #0x7f ; graphics (or DEL)? + bhs L8687 ; brif so - ignore it + cmpa #0x5f ; SHIFT-UP? + bne L8694 ; brif not + lda #0x1b ; replace with ESC +L8694 cmpa #0x0d ; carriage return? + beq L86A6 ; brif so (C=0) + cmpa #0x1b ; ESC + beq L86A6 ; brif so (C=0) + cmpa #0x08 ; backspace? + beq L86A6 ; brif so (C=0) + cmpa #32 ; control code? + blo L8687 ; brif control code - try again + orcc #1 ; set C for "valid" (printable) character +L86A6 rts +; TRON and TROFF commands +TRON skip1lda ; load flag with nonzero for trace enabled (and skip next) +TROFF clra ; clear flag for trace disabled + sta TRCFLG ; save trace status + rts +; POS function +POS lda DEVNUM ; get original device number + pshs a ; save it for later + jsr LA5AE ; fetch device number + jsr LA406 ; check for open file + jsr LA35F ; set up print parameters + ldb DEVPOS ; get current line position for the device + jmp LA5E4 ; return position in B as unsigned +; VARPTR function +VARPTRTOK jsr LB26A ; make sure we have ( + ldd ARYEND ; get address of end of arrays + pshs d ; save it + jsr LB357 ; parse variable descriptor + jsr LB267 ; make sure there is a ) + puls d ; get original end of arrays + exg x,d ; swap original end of arrays and the discovered variable pointer + cmpx ARYEND ; did array end move (variable created?) + bne L8724 ; brif so (FC error) + jmp GIVABF ; return the pointer (NOTE: as signed) +; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter +; than the specified size, only the number of characters actually in the replacement will be used. +L86D6 jsr GETNCH ; eat the MID$ token + jsr LB26A ; force ( + jsr LB357 ; evaluate the variable + pshs x ; save variable descriptor + ldd 2,x ; point to start of original string + cmpd FRETOP ; is it in string space? + bls L86EB ; brif not + subd MEMSIZ ; is it still in string space (top end)? + bls L86FD ; brif so +L86EB ldb ,x ; get length of original string + jsr LB56D ; allocate space in string space + pshs x ; save pointer to string space + ldx 2,s ; get to original string descriptor + jsr LB643 ; move the string into string space + puls x,u ; get new string address and string descriptor + stx 2,u ; save new data address for the string + pshs u ; save descriptor address again +L86FD jsr LB738 ; evaluate ",start" + pshs b ; save start offset + tstb ; is start 0? + beq L8724 ; brif so - strings offsets are 1-based + ldb #255 ; default use the entire string + cmpa #') ; end of parameters? + beq L870E ; brif so + jsr LB738 ; evaluate ",length" +L870E pshs b ; save length + jsr LB267 ; make sure we have a ) + ldb #0xb3 ; make sure we have = + jsr LB26F + bsr L8748 ; evaluate replacement string + tfr x,u ; save replacement string address + ldx 2,s ; get original string descriptor + lda ,x ; get length of original string + suba 1,s ; subtract start position + bhs L8727 ; brif within the string - insert replacement +L8724 jmp LB44A ; raise illegal function call +L8727 inca ; A is now number of characters to the right of the position parameter + cmpa ,s ; compare to length desired + bhs L872E ; brif new length fits + sta ,s ; only use as much of the length as will fit +L872E lda 1,s ; get position offset + exg a,b ; swap replacement length and position + ldx 2,x ; point to original string address + decb ; we work with 0-based offsets + abx ; now X points to start of replacement + tsta ; replacing 0? + beq L8746 ; brif so - done + cmpa ,s ; is replacement shorter than the hole? + bls L873F ; brif so + lda ,s ; use copy the maximum number specified +L873F tfr a,b ; save number to move in B + exg u,x ; swap pointers so they are right for the routine + jsr LA59A ; copy string data +L8746 puls a,b,x,pc ; clean up stack and return +L8748 jsr LB156 ; evaluate expression + jmp LB654 ; make sure it's a string and return string details +; STRING$ function +STRING jsr LB26A ; make sure we have ( + jsr EVALEXPB ; evaluate repeat count (error if > 255) + pshs b ; save repeat count + jsr SYNCOMMA ; make sure there's a comma + jsr LB156 ; evaluate the thing to repeat + jsr LB267 ; make sure we have a ) + lda VALTYP ; is it string? + bne L8768 ; brif so + jsr LB70E ; get 8 bit character code + bra L876B ; use that +L8768 jsr LB6A4 ; get first character of string +L876B pshs b ; save repeat character + ldb 1,s ; get repeat count + jsr LB50F ; reserve space for the string + puls a,b ; get character and repeat count + beq L877B ; brif NULL string +L8776 sta ,x+ ; put character into string + decb ; put enough? + bne L8776 ; brif not +L877B jmp LB69B ; return the newly created string +; INSTR function +INSTR jsr LB26A ; evaluate ( + jsr LB156 ; evaluate first argument + ldb #1 ; default start position is 1 (start of string) + pshs b ; save start position + lda VALTYP ; get type of first argument + bne L879C ; brif string - use default starting position + jsr LB70E ; convert first argument into string offset + stb ,s ; save offset + beq L8724 ; brif starting at 0 - not allowed + jsr SYNCOMMA ; make sure there's a comma + jsr LB156 ; evaluate the search string + jsr LB146 ; make sure it *is* a string +L879C ldx FPA0+2 ; get search string descriptor + pshs x ; save it + jsr SYNCOMMA ; make sure we have a comma + jsr L8748 ; evalute the target string + pshs x,b ; save address and length of target string + jsr LB267 ; make sure we have a ) + ldx 3,s ; get search string address + jsr LB659 ; get string details + pshs b ; save search string length + cmpb 6,s ; compare length of search string to the start + blo L87D9 ; brif start position is beyond the search string - return 0 + lda 1,s ; get length of target string + beq L87D6 ; brif targetstring is NULL - match will be immediate + ldb 6,s ; get start position + decb ; zero-base it + abx ; now X points to the start position for the search +L87BE leay ,x ; point to start of search + ldu 2,s ; get target string pointer + ldb 1,s ; get targetlength + lda ,s ; get length of serach + suba 6,s ; see how much is left in searh + inca ; add one for "inclusivity" + cmpa 1,s ; do we have less than the target string? + blo L87D9 ; brif so - we obviously won't match +L87CD lda ,x+ ; compare a byte + cmpa ,u+ + bne L87DF ; brif no match + decb ; compared all of target? + bne L87CD ; brif not +L87D6 ldb 6,s ; get position where we matched + skip1 +L87D9 clrb ; flag no match + leas 7,s ; clean up stack + jmp LB4F3 ; return unsigned B +L87DF inc 6,s ; bump start position + leax 1,y ; move starting pointer + bra L87BE ; see if we match now +; Number parsing handler +XVEC19 cmpa #'& ; do we have & (hex or octal)? +L87E7 bne L8845 ; brif not + leas 2,s ; we won't return to the original invoker +L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value + clr FPA0+3 + ldx #FPA0+2 ; point to accumulator + jsr GETNCH ; eat the & + cmpa #'O ; octal? + beq L880A ; brif so + cmpa #'H ; hex? + beq L881F ; brif so + jsr GETCCH ; reset flags on input + bra L880C ; go process octal (default) +L8800 cmpa #'8 ; is it a valid octal character? + lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7) + ldb #3 ; base 8 multiplier + bsr L8834 ; add digit to accumulator +L880A jsr GETNCH ; get input character +L880C bcs L8800 ; brif numeric +L880E clr FPA0 ; clear upper bytes of FPA0 + clr FPA0+1 + clr VALTYP ; result is numeric + clr FPSBYT ; clear out any extra precision + clr FP0SGN ; make it positive + ldb #0xa0 ; exponent for integer aligned to right of FPA0 + stb FP0EXP + jmp LBA1C ; go normalize the result and return +L881F jsr GETNCH ; get input character + bcs L882E ; brif digit + jsr LB3A2 ; set carry if not alpha +L8826 bcs L880E ; brif not alpha + cmpa #'G ; is it valid HEX digit? + bhs L880E ; brif not + suba #7 ; normalize A-F to be just above 0-9 +L882E ldb #4 ; four bits per digit + bsr L8834 ; add digit to accumlator + bra L881F ; process another digit +L8834 asl 1,x ; shift accumulator one bit left + rol ,x + lbcs LBA92 ; brif too big - overflow + decb ; done enough bit shifts? + bne L8834 ; brif not +L883F suba #'0 ; remove ASCII bias + adda 1,x ; merge digit into accumlator (this cannot cause carry) + sta 1,x +L8845 rts +; Expression evaluation handler +XVEC15 puls u ; get back return address + clr VALTYP ; set result to numeric + ldx CHARAD ; save input pointer + jsr GETNCH ; get the input character + cmpa #'& ; HEX or OCTAL? + beq L87EB ; brif so + cmpa #0xcc ; FN? + beq L88B4 ; brif so - do "FNx()" + cmpa #0xff ; function token? + bne L8862 ; brif not + jsr GETNCH ; get function token value + cmpa #0x83 ; USR? + lbeq L892C ; brif so - short circuit Color Basic's USR handler +L8862 stx CHARAD ; restore input pointer + jmp ,u ; return to mainline code +L8866 ldx CURLIN ; are we in immediate mode? + leax 1,x +L886A bne L8845 ; brif not - we're good + ldb #2*11 ; code for illegal direct statement +L886E jmp LAC46 ; raise error +; DEF command (DEF FN, DEF USR) +DEF ldx [CHARAD] ; get two input characters + cmpx #0xff83 ; USR? + lbeq L890F ; brif so - do DEF USR + bsr L88A1 ; get descriptor address for FN variable + bsr L8866 ; disallow DEF FN in immediate mode + jsr LB26A ; make sure we have ( + ldb #0x80 ; disallow arrays as arguments + stb ARYDIS + jsr LB357 ; evaluate variable + bsr L88B1 ; make sure it's numeric + jsr LB267 ; make sure we have ) + ldb #0xb3 ; make sure we have = + jsr LB26F + ldx V4B ; get variable descriptor address + ldd CHARAD ; get input pointer + std ,x ; save address of the actual function code in variable descriptor + ldd VARPTR ; get descriptor address of argument + std 2,x ; save argument descriptor address + jmp DATA ; move to the end of this statement +L88A1 ldb #0xcc ; make sure we have FN + jsr LB26F + ldb #0x80 ; disable array lookup + stb ARYDIS + ora #0x80 ; set bit 7 of first character (to indicate FN variable) + jsr LB35C ; find the variable + stx V4B ; save descriptor pointer +L88B1 jmp LB143 ; make sure we have a numeric variable +; Evaluate an FN call +L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor + pshs x ; save descriptor + jsr LB262 ; evaluate parameter + bsr L88B1 ; make sure it's a number + puls u ; get FN descriptor + ldb #2*25 ; code for undefined function + ldx 2,u ; point to argument variable descriptor + beq L886E ; brif nothing doing there (if it was just created, this will be NULL) + ldy CHARAD ; save current input pointer + ldu ,u ; point to start of FN definition + stu CHARAD ; put input pointer there + lda 4,x ; save original value of argument and save it with current input, and variable pointers + pshs a + ldd ,x + ldu 2,x + pshs u,y,x,d + jsr LBC35 ; set argument variable to the argument +L88D9 jsr LB141 ; go evaluate the FN expression + puls d,x,y,u ; get back variable pointers, input pointer, and original variable value + std ,x + stu 2,x + puls a + sta 4,x + jsr GETCCH ; test end of FN formula + lbne LB277 ; brif not end of statement - problem with the function + sty CHARAD ; restore input pointer +L88EF rts +; Error handler +XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code? + blo L88EF ; brif not - return to mainline + jsr LA7E9 ; turn off tape + jsr LA974 ; turn off sound + jsr LAD33 ; clean up stack and other bits + clr DEVNUM ; reset output to screen + jsr LB95C ; do a newline if needed + jsr LB9AF ; do a ? + ldx #L890B-25*2 ; point to error message table + jmp LAC60 ; go display error message +; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the +; Disk Basic documentation. It is here for the use of DLOAD. +L890B fcc 'UF' ; 25 undefined function call + fcc 'NE' ; 26 File not found +; DEF USR +L890F jsr GETNCH ; eat the USR token + bsr L891C ; get pointer to USR call + pshs x ; save FN exec address location + bsr L8944 ; calculate execution address + puls u ; get FN address pointer + stx ,u ; save new address + rts +L891C clrb ; default routine number is 0 + jsr GETNCH ; fetch the call number + bcc L8927 ; brif not a number + suba #'0 ; remove ASCII bias + tfr a,b ; save it in the right place + jsr GETNCH ; eat the call number +L8927 ldx USRADR ; get start address of USR jump table + aslb ; two bytes per address + abx ; now X points to the right entry + rts +; Evaluate a USR call +L892C bsr L891C ; find the correct routine address location + ldx ,x ; get routine address + pshs x ; save it + jsr LB262 ; evaluate argument + ldx #FP0EXP ; point to FPA0 (argument value) + lda VALTYP ; is it string? + beq L8943 ; brif not + jsr LB657 ; fetch string details (removes it from the string stack) + ldx FPA0+2 ; get string descriptor pointer + lda VALTYP ; set flags for the value type +L8943 rts ; call the routine and return to mainline code +L8944 ldb #0xb3 ; check for "=" + jsr LB26F + jmp LB73D ; evaluate integer expression to X and return +; Extended Basic IRQ handler +XIRQSV lda PIA0+3 ; is it VSYNC interrupt? + bmi L8952 ; brif so + rti ; really should clear the HSYNC interrupt here +L8952 lda PIA0+2 ; clear VSYNC interrupt + ldx TIMVAL ; increment the TIMER value + leax 1,x + stx TIMVAL + jmp L9C3E ; check for other stuff +; TIMER= +L8960 jsr GETNCH ; eat the TIMER token + bsr L8944 ; evaluate =nnnn to X + stx TIMVAL ; set the timer + rts +; TIMER function +TIMER ldx TIMVAL ; get timer value + stx FPA0+2 ; set it in FPA0 + jmp L880E ; return as positive 16 bit value +; DEL command +DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0) + jsr LAF67 ; parse line number + jsr LAD01 ; find line + stx VD3 ; save address of line + jsr GETCCH ; is there something more? + beq L8990 ; brif not + cmpa #0xac ; dash? + bne L89BF ; brif not - error out + jsr GETNCH ; each the - + beq L898C ; brif no ending line - use default line number + bsr L89AE ; parse second line number and save in BINVAL + bra L8990 ; do the deletion +L898C lda #0xff ; set to maximum line number + sta BINVAL +L8990 ldu VD3 ; point end to start + skip2 +L8993 ldu ,u ; point to start of next line + ldd ,u ; check for end of program + beq L899F ; brif end of program + ldd 2,u ; get line number + subd BINVAL ; is it in range? + bls L8993 ; brif so +L899F ldx VD3 ; get starting line address + bsr L89B8 ; close up gap + jsr LAD21 ; reset input pointer and erase variables + ldx VD3 ; get start of program after the deletion + jsr LACF1 ; recompute netl ine pointers + jmp LAC73 ; return to immediate mode +L89AE jsr LAF67 ; parse a line number + jmp LA5C7 ; make sure there's nothing more +L89B4 lda ,u+ ; copy a byte + sta ,x+ +L89B8 cmpu VARTAB ; end of program? + bne L89B4 ; brif not + stx VARTAB ; save new start of variables/end of program +L89BF rts +; LINE INPUT +L89C0 jsr L8866 ; raise error if in immediate mode + jsr GETNCH ; eat the "INPUT" token + cmpa #'# ; device number? + bne L89D2 ; brif not + jsr LA5A5 ; parse device number + jsr LA3ED ; make sure it's valid for input + jsr SYNCOMMA ; make sure there's a comma after the device number +L89D2 cmpa #'" ; is there a prompt? + bne L89E1 ; brif not + jsr LB244 ; parse the string + ldb #'; ; make sure there's a semicolon after the prompt + jsr LB26F + jsr LB99F ; go actually display the prompt +L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right) + jsr LB035 ; read an input line from current device + leas 2,s ; clean up stack + clr DEVNUM ; reset to screen/keyboard + jsr LB357 ; parse a variable + stx VARDES ; save pointer to it + jsr LB146 ; make sure it's a string + ldx #LINBUF ; point to input buffer + clra ; make sure we terminate on NUL only + jsr LB51A ; parse string and store it in string space + jmp LAFA4 ; go assign the string to its final resting place +; RENUM command +L89FC jsr LAF67 ; read a line number + ldx BINVAL ; get value + rts +L8A02 ldx VD1 ; get current old number being renumbered +L8A04 stx BINVAL ; save number being searched for + jmp LAD01 ; go find line number +RENUM jsr LAD26 ; erase variables + ldd #10 ; default line number interval and start + std VD5 ; set starting line number + std VCF ; set number interval + clrb ; now D is 0 + std VD1 ; save default start for renumbering + jsr GETCCH ; are there any arguments + bcc L8A20 ; brif not numeric + bsr L89FC ; fetch line number + stx VD5 ; save line beginning number + jsr GETCCH ; get input character +L8A20 beq L8A3D ; brif end of line + jsr SYNCOMMA ; make sure we have a comma + bcc L8A2D ; brif next isn't numeric + bsr L89FC ; fetch starting line number + stx VD1 ; save the number where we start working + jsr GETCCH ; fetch input character +L8A2D beq L8A3D ; brif end of line + jsr SYNCOMMA ; make sure we have a comma + bcc L8A3A ; brif we don't have a number + bsr L89FC ; parse the number + stx VCF ; save interval + beq L8A83 ; brif we ave a zero interval +L8A3A jsr LA5C7 ; raise error if more stuff +L8A3D bsr L8A02 ; get address of old number to process + stx VD3 ; save address + ldx VD5 ; get the next renumbered line to use + bsr L8A04 ; find that line + cmpx VD3 ; is it before the previous one? + blo L8A83 ; brif so - raise error + bsr L8A67 ; make sure renumbered line numbers will be in range + jsr L8ADD ; convert line numbers to "expanded" binary + jsr LACEF ; recalculate next line pointers + bsr L8A02 ; get address of first line to renumber + stx VD3 ; save it + bsr L8A91 ; make sure line numbers exist + bsr L8A68 ; renumber the actual lines + bsr L8A91 ; update line numbers in program text + jsr L8B7B ; convert packed binary line numbers to text + jsr LAD26 ; erase variables, reset stack, etc. + jsr LACEF ; recalculate next line pointers + jmp LAC73 ; bounce back to immediate mode +L8A67 skip1lda ; set line number flag to nonzero (skip next instruction) +L8A68 clra ; set line number flag to zero (insert new numbers) + sta VD8 ; save line number flag + ldx VD3 ; get address of line being renumbered + ldd VD5 ; get the current renumbering number + bsr L8A86 ; return if end of program +L8A71 tst VD8 ; test line number flag + bne L8A77 ; brif not adding new numbers + std 2,x ; set new number +L8A77 ldx ,x ; point to next line + bsr L8A86 ; return if end of program + addd VCF ; add interval to current number + bcs L8A83 ; brif we overflowed - bad line number + cmpa #MAXLIN ; maximum legal number? + blo L8A71 ; brif so - do another +L8A83 jmp LB44A ; raise FC error +L8A86 pshs d ; save D (we're going to clobber it) + ldd ,x ; get next line pointer + puls d ; unclobber D + bne L8A90 ; brif not end of program + leas 2,s ; return to caller's caller +L8A90 rts +L8A91 ldx TXTTAB ; get start of program + leax -1,x ; move pointer back one (compensate for leax 1,x below) +L8A95 leax 1,x ; move to next line + bsr L8A86 ; return if end of program +L8A99 leax 3,x ; move past next line address and line number, go one before line +L8A9B leax 1,x ; move to next character + lda ,x ; check input character + beq L8A95 ; brif end of line + stx TEMPTR ; save current pointer + deca ; is it start of packed numeric line number? + beq L8AB2 ; brif so + deca ; does line exist? + beq L8AD3 ; brif line number exists + deca ; not part of something to process? + bne L8A9B ; brif so +L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing + sta ,x+ + bra L8A99 ; go process another +L8AB2 ldd 1,x ; get MSB of line number + dec 2,x ; is MS byte zero? + beq L8AB9 ; brif not + clra ; set MS byte to 0 +L8AB9 ldb 3,x ; get LSB of line number + dec 4,x ; is it zero? + beq L8AC0 ; brif not + clrb ; clear byte +L8AC0 std 1,x ; save binary number + std BINVAL ; save trial number + jsr LAD01 ; find the line number +L8AC7 ldx TEMPTR ; get start of packed line + bcs L8AAC ; brif line number not found + ldd V47 ; get address of line number + inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting + std ,x ; save address of correct number + bra L8A99 ; go process more +L8AD3 clr ,x ; clear carry and first byte + ldx 1,x ; point to address of correct line + ldx 2,x ; get correct line number + stx V47 ; save it + bra L8AC7 ; insert into line +L8ADD ldx TXTTAB ; get beginning of program + bra L8AE5 +L8AE1 ldx CHARAD ; get input pointer + leax 1,x ; move it forward +L8AE5 bsr L8A86 ; return if end of program + leax 2,x ; move past line address +L8AE9 leax 1,x ; move forward +L8AEB stx CHARAD ; save input pointer +L8AED jsr GETNCH ; get an input character +L8AEF tsta ; is it actual 0? + beq L8AE1 ; brif end of line + bpl L8AED ; brif not a token + ldx CHARAD ; get input pointer + cmpa #0xff ; function? + beq L8AE9 ; brif so - ignore it (and following byte) + jsr RVEC22 ; do the RAM hook thing + cmpa #0xa7 ; THEN? + beq L8B13 ; brif so + cmpa #0x84 ; ELSE? + beq L8B13 ; brif so + cmpa #0x81 ; GO(TO|SUB)? + bne L8AED ; brif not - we don't have a line number + jsr GETNCH ; get TO/SUB + cmpa #0xa5 ; GOTO? + beq L8B13 ; brif so + cmpa #0xa6 ; GOSUB? + bne L8AEB ; brif not +L8B13 jsr GETNCH ; fetch character after token + bcs L8B1B ; brif numeric (line number) +L8B17 jsr GETCCH ; set flags on input character + bra L8AEF ; keep checking for line numbers +L8B1B ldx CHARAD ; get input pointer + pshs x ; save it + jsr LAF67 ; parse line number + ldx CHARAD ; get input pointer after line +L8B24 lda ,-x ; get character before pointer + jsr L90AA ; set C if numeric + bcs L8B24 ; brif not numeric + leax 1,x ; move pointer up + tfr x,d ; calculate size of line number + subb 1,s + subb #5 ; make sure at least 5 bytes + beq L8B55 ; brif exactly 5 bytes - no change + blo L8B41 ; brif less than 5 bytes + leau ,x ; move remainder of program backward + negb ; negate extra number of bytes (to subtract from X) + leax b,x ; now X is the correct position to move program to + jsr L89B8 ; shift program backward + bra L8B55 +L8B41 stx V47 ; save end of line number space (end of copy) + ldx VARTAB ; get end of program + stx V43 ; set source pointer + negb ; get positive difference + leax b,x ; now X is the top of the destination block + stx V41 ; set copy destination + stx VARTAB ; save new end of program + jsr LAC1E ; make sure enough room and make a hole in the program + ldx V45 ; get end address of destination block + stx CHARAD ; set input there +L8B55 puls x ; get starting address of the line number + lda #1 ; set "new number" flag + sta ,x + sta 2,x + sta 4,x + ldb BINVAL ; get MS byte of line number + bne L8B67 ; brif it is not zero + ldb #1 ; set to 1 if MSB is 0 + inc 2,x ; flag MSB as 0 +L8B67 stb 1,x ; set MSB of line number + ldb BINVAL+1 ; get LSB of number + bne L8B71 ; brif nonzero + ldb #1 ; set to 1 if LSB is 0 + inc 4,x ; flag LSB as 0 +L8B71 stb 3,x ; save LSB of line number + jsr GETCCH ; get input character + cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB) + beq L8B13 ; brif so - process another + bra L8B17 ; go look for more line numbers +L8B7B ldx TXTTAB ; point to start of program + leax -1,x ; move back (compensate for inc below) +L8B7F leax 1,x ; move forward + ldd 2,x ; get this line number + std CURLIN ; save it (for error message) + jsr L8A86 ; return if end of program + leax 3,x ; skip address and line number, stay one before line text +L8B8A leax 1,x ; move to next character +L8B8C lda ,x ; get input character + beq L8B7F ; brif end of line + deca ; valid line new line number? + beq L8BAE ; brif so + suba #2 ; undefined line? + bne L8B8A ; brif not + pshs x ; save line number pointer + ldx #L8BD9-1 ; show UL message + jsr STRINOUT + ldx ,s ; get input pointer + ldd 1,x ; get undefined line number + jsr LBDCC ; display line number + jsr LBDC5 ; print out "IN XXXX" + jsr LB958 ; do a newline + puls x ; get input pointer back +L8BAE pshs x ; save input pointer + ldd 1,x ; get binary value of line number + std FPA0+2 ; save it in FPA0 + jsr L880E ; adjust FPA0 as integer + jsr LBDD9 ; convert to text string + puls u ; get previous input pointer address + ldb #5 ; each expanded line uses 5 bytes +L8BBE leax 1,x ; move pointer forward (in string number) past sign + lda ,x ; do we have a digit? + beq L8BC9 ; brif not - end of number + decb ; mark a byte consumed + sta ,u+ ; put digit in program + bra L8BBE ; copy another digit +L8BC9 leax ,u ; point to address at end of text number + tstb ; did number fill whole space? + beq L8B8C ; brif so - move on + leay ,u ; save end of number pointer + leau b,u ; point to the end of the original expanded number + jsr L89B8 ; close up gap in program + leax ,y ; get end of line number pointer back + bra L8B8C ; go process more +L8BD9 fcn 'UL ' +; HEX$ function +HEXDOL jsr LB740 ; convert argument to positive integer + ldx #STRBUF+2 ; point to string buffer + ldb #4 ; convert 4 nibbles +L8BE5 pshs b ; save nibble counter + clrb ; clear digit accumulator + lda #4 ; do 4 shifts +L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B + rol FPA0+2 + rolb + deca ; done all shifts? + bne L8BEA ; brif not + tstb ; do we have a nonzero digit? + bne L8BFF ; brif so + lda ,s ; is it last digit? + deca + beq L8BFF ; brif so - keep the 0 + cmpx #STRBUF+2 ; is it a middle zero? + beq L8C0B ; brif not +L8BFF addb #'0 ; add ASCII bias + cmpb #'9 ; above 9? + bls L8C07 ; brif not + addb #7 ; adjust into alpha range +L8C07 stb ,x+ ; save digit in output + clr ,x ; make sure we have a NUL term +L8C0B puls b ; get back nibble counter + decb ; done all? + bne L8BE5 ; brif not + leas 2,s ; don't return mainline (we're returning a string) + ldx #STRBUF+1 ; point to start of converted number + jmp LB518 ; save string in string space, etc., and return it +; DLOAD command; this is eliminated on the Coco3. It was basically useless anyway so it was +; a good candidate to overwrite for some extra code space in the lower 16K of the internal +; ROM. Now, DLOAD functions as another entry into the RESET sequence. +DLOAD jsr LA429 ; close tape file +L8C1B orcc #0x50 ; make sure interrupts are disabled + lda #MC3+MC1 ; disable MMU, 32K internal ROM, not "coco" compatible + sta INIT0 + clr TYCLR ; go to ROM mapping mode + jmp SC000 ; transfer control to the "hidden" init code +L8C28 clr INT.FLAG ; set the interrupt flag to not valid + clr PIA1+3 ; disable cartridge interrupt +L8C2E lda #COCO+MMUEN+MC3+MC2 ; enable SCS, 16K split, MMU, COCO mode + sta INIT0 + clr TYCLR ; go to ROM mode +L8C36 rts +L8C37 pshs a,b,x ; save registers + ldx CURPOS ; get cursor position + ldb HRWIDTH ; hi-res mode? + lbne ALINK22 ; brif so + ldb 1,s ; restore B + jmp LA30E ; go back to mainline code +L8C46 pshs cc ; save Z + tst HRWIDTH ; hi-res? + beq L8C4F ; brif not + jmp ALINK23 ; go to hi-res handler +L8C4F puls cc ; get back Z + jmp LA913 ; go back to mainline code + nop + fcb 0xc7 ; junk byte (too few NOPs above) +; This returns to the remainder of the original ECB 1.1 DLOAD code + tstb ; ASCII? + beq L8C5F ; brif not - do error + jsr LAD19 ; clear out program + jmp LAC7C ; go read program +L8C5F jmp LA616 ; raise bad file mode +; CLOADM patch for Extended Basic +L8C62 jsr GETNCH ; get character after CLOAD + cmpa #'M ; CLOADM? + lbne CLOAD ; brif not - Color Basic's CLOAD can handle it + clr FILSTA ; close tape file + jsr GETNCH ; eat the "M" + jsr LA578 ; parse file name + jsr LA648 ; find the file + tst CASBUF+10 ; is it a chunked file? + lbeq LA505 ; brif not - Color Basic's CLOADM can handle it + ldu CASBUF+8 ; get file type and ASCII flag + dec DEVNUM ; set source device to tape + jsr LA635 ; go read the first block + tfr u,d ; put type and ASCII flag somewhere more useful +; NOTE: DLOADM comes here to do the final processing +L8C85 subd #0x200 ; is it binary and "machine language"? + bne L8C5F ; brif not - raise an error + ldx ZERO ; default load offset + jsr GETCCH ; is there any offset? + beq L8C96 ; brif not + jsr SYNCOMMA ; make sure there's a comma + jsr LB73D ; evaluate offset in X +L8C96 stx VD3 ; save offset + jsr LA5C7 ; raise error if more stuff follows +L8C9B bsr L8CC6 ; get type of "amble" + pshs a ; save it + bsr L8CBF ; read in block length + tfr d,y ; save it + bsr L8CBF ; read in load address + addd VD3 ; add in offset + std EXECJP ; save it as the execution address + tfr d,x ; put load address in a pointer + lda ,s+ ; get "amble" type + lbne LA42D ; brif postamble - close file +L8CB1 bsr L8CC6 ; read a data byte + sta ,x ; save in memory + cmpa ,x+ ; did it actually save? + bne L8CCD ; brif not RAM - raise error + leay -1,y ; done yet? + bne L8CB1 ; brif not + bra L8C9B ; look for another "amble" +L8CBF bsr L8CC1 ; read a character to B +L8CC1 bsr L8CC6 ; read character to A + exg a,b ; swap character with previously read one +L8CC5 rts +L8CC6 jsr LA176 ; read a character from input + tst CINBFL ; EOF? + beq L8CC5 ; brif not +L8CCD jmp LA619 ; raise I/O error if EOF +L8CD0 bsr L8D14 ; transmit file name + pshs b,a ; save file status + inca ; was file found? + beq L8CDD ; brif not + ldu ZERO ; zero U - first block + bsr L8CE4 ; read block + puls a,b,pc ; restore status and return +L8CDD ldb #2*26 ; code for NE error + jmp LAC46 ; raise error +L8CE2 ldu CBUFAD ; get block number +L8CE4 leax 1,u ; bump block number + stx CBUFAD ; save new block number + ldx #CASBUF ; use cassette buffer + jsr L8D7C ; read a block + jmp LA644 ; reset input buffer pointers +; Generic input handler for Extended Basic +XVEC4 lda DEVNUM ; get device number + cmpa #-3 ; DLOAD? + bne L8D01 ; brif not + leas 2,s ; don't return to mainline code + clr CINBFL ; reset EOF flag to not EOF + tst CINCTR ; anything available? + bne L8D02 ; brif so - fetch one + com CINBFL ; flag EOF +L8D01 rts +L8D02 pshs u,y,x,b ; save registers + ldx CINPTR ; get buffer pointer + lda ,x+ ; get character from buffer + pshs a ; save it for return + stx CINPTR ; save new input pointer + dec CINCTR ; account for byte removed from buffer + bne L8D12 ; brif buffer not empty + bsr L8CE2 ; go read a block +L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return +L8D14 clra ; clear attempt counter + pshs x,b,a ; make a hole for variables + leay ,s ; set up frame pointer + bra L8D1D ; go read block +L8D1B bsr L8D48 ; bump attempt counter +L8D1D lda #0x8a ; send file request control code + bsr L8D58 + bne L8D1B ; brif no echo or error + ldx #CFNBUF+1 ; point to file name +L8D26 lda ,x+ ; get file name characater + jsr L8E04 ; send it + cmpx #CFNBUF+9 ; end of file name? + bne L8D26 ; brif not + bsr L8D62 ; output check byte and look for response + bne L8D1B ; transmit name again if not ack + bsr L8D72 ; get file type (0xff is not found) + bne L8D1B ; brif error + sta 2,y ; save file type + bsr L8D72 ; read ASCII flag + bne L8D1B ; brif error + sta 3,y ; save ASCII flag + bsr L8D6B ; read check byte + bne L8D1B ; brif error + leas 2,s ; lose attempt counter and check byte + puls a,b,pc ; return file type and ascii flag +L8D48 inc ,y ; bump attempt counter + lda ,y ; get new count + cmpa #5 ; done 5 times? + blo L8D6A ; brif not + lda #0xbc ; send abort code + jsr L8E0C + jmp LA619 ; raise an I/O error +L8D58 pshs a ; save compare character + bsr L8DB8 ; send character + bne L8D60 ; brif read error + cmpa ,s ; does it match? (set Z if good) +L8D60 puls a,pc ; restore character and return +L8D62 lda 1,y ; get XOR check byte + bsr L8DB8 ; send it and read + bne L8D6A ; brif read error + cmpa #0xc8 ; is it ack? (set Z if so) +L8D6A rts +L8D6B bsr L8D72 ; read character from rs232 + bne L8D6A ; brif error + lda 1,y ; get check byte + rts +L8D72 bsr L8DBC ; read a character from rs232 + pshs a,cc ; save result (and flags) + eora 1,y ; accumulate xor checksum + sta 1,y + puls cc,a,pc ; restore byte, flags, and return +L8D7C clra ; reset attempt counter + pshs u,y,x,b,a ; make a stack frame + asl 7,s ; split block number into two 7 bit chuncks + rol 6,s + lsr 7,s + leay ,s ; set up frame pointer + bra L8D8B +L8D89 bsr L8D48 ; bump attempt counter +L8D8B lda #0x97 ; send block request code + bsr L8D58 + bne L8D89 ; brif error + lda 6,y ; send out block number (high bits first) + bsr L8E04 + lda 7,y + bsr L8E04 + bsr L8D62 ; send check byte and get ack + bne L8D89 ; brif error + bsr L8D72 ; read block size + bne L8D89 ; brif read error + sta 4,y ; save character count + ldx 2,y ; get buffer pointer + ldb #128 ; length of data block +L8DA7 bsr L8D72 ; read a data byte + bne L8D89 ; brif error + sta ,x+ ; save byte in buffer + decb ; done a whole block? + bne L8DA7 ; brif not + bsr L8D6B ; read check byte + bne L8D89 ; brif error + leas 4,s ; lose attempt counter, check byte, and buffer pointer + puls a,b,x,pc ; return with character count in A, clean rest of stack +L8DB8 clr 1,y ; clear check byte + bsr L8E0C ; output character +L8DBC clra ; clear attempt counter + pshs x,b,cc ; save registers and interrupt status + orcc #0x50 ; disable interrupts + lda TIMOUT ; get timout delay (variable) + ldx ZERO ; get constant timeout value +L8DC5 bsr L8DE6 ; get RS232 status + bcc L8DC5 ; brif "space" - waiting for "mark" +L8DC9 bsr L8DE6 ; get RS232 status + bcs L8DC9 ; brif "mark" - waiting for "space" (start bit) + bsr L8DF9 ; delay for half of bit time + ldb #1 ; set bit probe + pshs b ; save it + clra ; reset data byte +L8DD4 bsr L8DF7 ; wait one bit time + ldb PIA1+2 ; get input bit to carry + rorb + bcc L8DDE ; brif "space" (0) + ora ,s ; merge bit probe in +L8DDE asl ,s ; shift bit probe over + bcc L8DD4 ; brif we haven't done 8 bits + leas 1,s ; remove bit probe + puls cc,b,x,pc ; restore interrupts, registers, and return +L8DE6 ldb PIA1+2 ; get RS232 value + rorb ; put in C + leax 1,x ; bump timeout + bne L8DF6 ; brif nonzero + deca ; did the number of waits expire? + bne L8DF6 ; brif not + leas 2,s ; don't return - we timed out + puls cc,b,x ; restore interrupts and registers + inca ; clear Z (A was zero above) +L8DF6 rts +L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second +L8DF9 pshs a ; save register + lda DLBAUD ; get baud rate constant +L8DFD brn L8DFD ; do nothing - delay + deca ; time expired? + bne L8DFD ; brif not + puls a,pc ; restore register and return +L8E04 pshs a ; save character to send + eora 1,y ; accumulate chechsum + sta 1,y + puls a ; get character back +L8E0C pshs b,a,cc ; save registers and interrupt status + orcc #0x50 ; disable interrupts + bsr L8DF7 ; do a bit delay + bsr L8DF7 ; do another bit delay + clr PIA1 ; set output to space (start bit) + bsr L8DF7 ; do a bit delay + ldb #1 ; bit probe start at LSB + pshs b ; save bitprobe +L8E1D lda 2,s ; get output byte + anda ,s ; see what our current bit is + beq L8E25 ; brif output is 0 + lda #2 ; set output to "marking" +L8E25 sta PIA1 ; send bit + bsr L8DF7 ; do a bit delay + asl ,s ; shift bit probe + bcc L8E1D ; brif not last bit + lda #2 ; set output to marking ("stop" bit) + sta PIA1 + leas 1,s ; lose bit probe + puls cc,a,b,pc ; restore registers, interrupts, and return +; PRINT USING +; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to +; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total +; Extended Color Basic ROM. +; +; This uses several variables: +; VD5: pointer to format string descriptor +; VD7: next print item flag +; VD8: right digit counter +; VD9: left digit counter (or length of string argument) +; VDA: status byte (bits as follows): +; 6: force comma +; 5: force leading * +; 4: floating $ +; 3: pre-sign +; 2: post-sign +; 0: scientific notation +L8E37 lda #1 ; set length to use to 1 + sta VD9 +L8E3B decb ; consume character from format string + jsr L8FD8 ; show error flag if flags set + jsr GETCCH ; get input character + lbeq L8ED8 ; brif end of line - bail + stb VD3 ; save remaining string length + jsr LB156 ; evaluate the argument + jsr LB146 ; error if numeric + ldx FPA0+2 ; get descriptor for argument + stx V4D ; save it for later + ldb VD9 ; get length counter to use + jsr LB6AD ; get B bytes of string space (do a LEFT$) + jsr LB99F ; print the formatted string + ldx FPA0+2 ; get formatted string descriptor + ldb VD9 ; get requested length + subb ,x ; see if we have any left over +L8E5F decb ; have we got the right width? + lbmi L8FB3 ; brif so - go process more + jsr LB9AC ; output a space + bra L8E5F ; go see if we're done yet +L8E69 stb VD3 ; save current format string counter and pointer + stx TEMPTR + lda #2 ; initial spaces count = 2 (for the two %s) + sta VD9 ; save length counter +L8E71 lda ,x ; get character in string + cmpa #'% ; is it the end of the sequence? + beq L8E3B ; brif so - display requested part of the strign + cmpa #0x20 ; space? + bne L8E82 ; brif not + inc VD9 ; bump spaces count + leax 1,x ; move format pointer forward + decb ; consume character + bne L8E71 ; brif not end of format string +L8E82 ldx TEMPTR ; restore format string pointer + ldb VD3 ; get back format string length + lda #'% ; show % as debugging aid +L8E88 jsr L8FD8 ; send error indicator if flags set + jsr PUTCHR ; output character + bra L8EB9 ; go process more format string +; PRINT extension for USING +XVEC9 cmpa #0xcd ; USING? + beq L8E95 ; brif so + rts ; return to mainline code +; This is the main entry point for PRINT USING +L8E95 leas 2,s ; don't return to the mainline code + jsr LB158 ; evaluate the format string + jsr LB146 ; error if numeric + ldb #'; ; make sure there's a ; after the string + jsr LB26F + ldx FPA0+2 ; get format string descriptor + stx VD5 ; save it for later + bra L8EAE ; process format string +L8EA8 lda VD7 ; is there a print item? + beq L8EB4 ; brif not + ldx VD5 ; get back format string descriptor +L8EAE clr VD7 ; reset next print item flag + ldb ,x ; get length of format string + bne L8EB7 ; brif string is non-null +L8EB4 jmp LB44A ; raise FC error +L8EB7 ldx 2,x ; point to start of string +L8EB9 clr VDA ; clear status (new item) +L8EBB clr VD9 ; clear left digit counter + lda ,x+ ; get character from format string + cmpa #'! ; ! (use first character of string)? + lbeq L8E37 ; brif so + cmpa #'# ; digit? + beq L8F24 ; brif so - handle numeric + decb ; consume format character + bne L8EE2 ; brif not done + jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string + jsr PUTCHR ; output format string character +L8ED2 jsr GETCCH ; get current input character + bne L8EA8 ; brif not end of statement + lda VD7 ; get next item flag +L8ED8 bne L8EDD ; brif more print items + jsr LB958 ; do newline +L8EDD ldx VD5 ; point to format string descriptor + jmp LB659 ; remove from string stack, etc., if appropriate (and return) +L8EE2 cmpa #'+ ; is it + (pre-sign)? + bne L8EEF ; brif not + jsr L8FD8 ; send a "+" if flags set + lda #8 ; flag for pre-sign + sta VDA ; set flags + bra L8EBB ; go interpret some more stuff +L8EEF cmpa #'. ; decimal? + beq L8F41 ; brif so - numeric + cmpa #'% ; % (show string)? + lbeq L8E69 ; brif so + cmpa ,x ; do we have two identical characters? +L8EFB bne L8E88 ; brif not - invalid format character + cmpa #'$ ; double $? + beq L8F1A ; brif so - floating $ + cmpa #'* ; double *? + bne L8EFB ; brif not + lda VDA ; get status byte + ora #0x20 ; enable * padding + sta VDA + cmpb #2 ; is $$ the last two? + blo L8F20 ; brif so + lda 1,x ; is it $ after? + cmpa #'$ + bne L8F20 ; brif not + decb ; consume the "$" + leax 1,x + inc VD9 ; add to digit counter * pad + $ counter +L8F1A lda VDA ; indicate floating $ + ora #0x10 + sta VDA +L8F20 leax 1,x ; consume the second format character + inc VD9 ; add one more left place +L8F24 clr VD8 ; clear right digit counter +L8F26 inc VD9 ; bump left digit counter + decb ; consume character + beq L8F74 ; brif end of string + lda ,x+ ; get next format character + cmpa #'. ; decimal? + beq L8F4F ; brif so + cmpa #'# ; digit? + beq L8F26 ; brif so + cmpa #', ; comma flag? + bne L8F5A ; brif not + lda VDA ; set commas flag + ora #0x40 + sta VDA + bra L8F26 ; handle more characters to left of decimal +L8F41 lda ,x ; get character after . + cmpa #'# ; digit? + lbne L8E88 ; brif not - invalid + lda #1 ; set right digit counter to 1 (for the .) + sta VD8 + leax 1,x ; consume the . +L8F4F inc VD8 ; add one to right digit counter + decb ; consume character + beq L8F74 ; brif end of format string + lda ,x+ ; get another format character + cmpa #'# ; digit? + beq L8F4F ; brif so +L8F5A cmpa #0x5e ; up arrow? + bne L8F74 ; brif not + cmpa ,x ; two of them? + bne L8F74 ; brif not + cmpa 1,x ; three of them? + bne L8F74 ; brif not + cmpa 2,x ; four of them? + bne L8F74 ; brif not + cmpb #4 ; string actually has the characters? + blo L8F74 ; brif not + subb #4 ; consome them + leax 4,x + inc VDA ; set scientific notation bit +L8F74 leax -1,x ; back up input pointer + inc VD9 ; add one digit for pre-sign force + lda VDA ; is it pre-sign? + bita #8 + bne L8F96 ; brif so + dec VD9 ; undo pre-sign adjustment + tstb ; end of string? + beq L8F96 ; brif so + lda ,x ; get next character + suba #'- ; post sign force? + beq L8F8F ; brif so + cmpa #'+-'- ; plus? + bne L8F96 ; brif not + lda #8 ; trailing + is a pre-sign force +L8F8F ora #4 ; add in post sign flag + ora VDA ; merge with flags + sta VDA + decb ; consume character +L8F96 jsr GETCCH ; do we have an argument + lbeq L8ED8 ; brif not + stb VD3 ; save format string length + jsr LB141 ; evluate numeric expression + lda VD9 ; get left digit counter + adda VD8 ; add in right digit counter + cmpa #17 ; is it more than 16 digits + decimal? + lbhi LB44A ; brif so - this is a problem + jsr L8FE5 ; format value according to settings + leax -1,x ; move buffer pointer back + jsr STRINOUT ; display formatted number string +L8FB3 clr VD7 ; reset next print item flag + jsr GETCCH ; get current input character + beq L8FC6 ; brif end of statement + sta VD7 ; set next print flag to nonzero + cmpa #'; ; list separator ;? + beq L8FC4 ; brif so + jsr SYNCOMMA ; require a comma between if not ; + bra L8FC6 ; process next item +L8FC4 jsr GETNCH ; munch the semicolon +L8FC6 ldx VD5 ; get format string descriptor + ldb ,x ; get length of string + subb VD3 ; subtract amount left after last item + ldx 2,x ; point to string address + abx ; move pointer to correct spot + ldb VD3 ; get remaining string length + lbne L8EB9 ; if we have more, interpret from there + jmp L8ED2 ; re-interpret from start if we hit the end +L8FD8 pshs a ; save character + lda #'+ ; "error" flag character + tst VDA ; did we have some flags set? + beq L8FE3 ; brif not + jsr PUTCHR ; output error flag +L8FE3 puls a,pc ; restore character and return +L8FE5 ldu #STRBUF+4 ; point to string buffer + ldb #0x20 ; blank space + lda VDA ; get flags + bita #8 ; pre-sign? + beq L8FF2 ; brif not + ldb #'+ ; plus sign +L8FF2 tst FP0SGN ; get sign of value + bpl L8FFA ; brif positive + clr FP0SGN ; make number positive (for later) + ldb #'- ; negative sign +L8FFA stb ,u+ ; put sign in buffer + ldb #'0 ; put a zero there + stb ,u+ + anda #1 ; check scientific notation force + lbne L910D ; brif so + ldx #LBDC0 ; point to FP 1E+9 + jsr LBCA0 ; is it less? + bmi L9023 ; brif so + jsr LBDD9 ; convert FP number to string (we're doing scientific notation) +L9011 lda ,x+ ; advance pointer to end of string + bne L9011 +L9015 lda ,-x ; make a hole at the start + sta 1,x + cmpx #STRBUF+3 ; done yet? + bne L9015 ; brif not + lda #'% ; put "overflow" flag at start + sta ,x + rts +L9023 lda FP0EXP ; get exponent of value + sta V47 ; save it + beq L902C ; brif value is 0 + jsr L91CD ; convert to number with 9 significant figures to left of decimal +L902C lda V47 ; get base 10 exponent offset + lbmi L90B3 ; brif < 100,000,000 + nega ; get negative difference + adda VD9 ; add to number of left digits + suba #9 ; account for the 9 we actually have + jsr L90EA ; put leading zeroes in buffer + jsr L9263 ; initialize the decimal point and comma counters + jsr L9202 ; convert FPA0 to decimal ASCII in buffer + lda V47 ; get base 10 exponent + jsr L9281 ; put that many zeroes in buffer, stop at decimal point + lda V47 ; get base 10 exponent + jsr L9249 ; check for decimal + lda VD8 ; get right digit counter + bne L9050 ; brif we want stuff after decimal + leau -1,u ; delete decimal if not needed +L9050 deca ; subtract one place (for decimal) + jsr L90EA ; put zeroes in buffer (trailing) +L9054 jsr L9185 ; insert * padding, floating $, and post-sign + tsta ; was there a post sign? + beq L9060 ; brif not + cmpb #'* ; was first character a *? + beq L9060 ; brif so + stb ,u+ ; store the post sign +L9060 clr ,u ; make srue it's NUL terminated + ldx #STRBUF+3 ; point to start of buffer +L9065 leax 1,x ; move to next character + stx TEMPTR ; save it for later + lda VARPTR+1 ; get address of decimal point + suba TEMPTR+1 ; subtract out actual digits left of decimal + suba VD9 ; subtract out required left digits + beq L90A9 ; brif no padding needed + lda ,x ; get current character + cmpa #0x20 ; space? + beq L9065 ; brif so - advance pointer + cmpa #'* ; *? + beq L9065 ; brif so - advance pointer + clra ; zero on stack is end of data ponter +L907C pshs a ; save character on stack + lda ,x+ ; get next character + cmpa #'- ; minus? + beq L907C ; brif so + cmpa #'+ ; plus? + beq L907C ; brif so + cmpa #'$ ; $? + beq L907C ; brif so + cmpa #'0 ; zero? + bne L909E ; brif not + lda 1,x ; get character after 0 + bsr L90AA ; clear carry if number + bcs L909E ; brif not number +L9096 puls a ; get character off stack + sta ,-x ; put it back in string buffer + bne L9096 ; brif not - restore another + bra L9065 ; keep cleaning up buffer +L909E puls a ; get the character on the stack + tsta ; is it NUL? + bne L909E ; brif not + ldx TEMPTR ; get string buffer start pointer + lda #'% ; put error flag in front + sta ,-x +L90A9 rts +L90AA cmpa #'0 ; zero? + blo L90B2 ; brif not + suba #'9+1 ; set C if > "9" + suba #-('9+1) +L90B2 rts +L90B3 lda VD8 ; get right digit counter + beq L90B8 ; brif not right digits + deca ; account for decimal point +L90B8 adda V47 ; add base 10 exponent offset + bmi L90BD ; if >= 0, no shifts are required + clra ; force shift counter to 0 +L90BD pshs a ; save shift counter +L90BF bpl L90CB ; brif positive count + pshs a ; save shift counter + jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right) + puls a ; get shift counter back + inca ; account for the shift + bra L90BF ; see if we're done yet +L90CB lda V47 ; get base 10 exponent offset + suba ,s+ ; account for adjustment + sta V47 ; save new exponent offset + adda #9 ; account for significant places + bmi L90EE ; brif we don't need zeroes to left + lda VD9 ; get left decimal counter + suba #9 ; account for significant figures + suba V47 ; subtract exponent offset + bsr L90EA ; output leading zeroes + jsr L9263 ; initialize decimal and comma counters + bra L90FF ; process remainder of digits +L90E2 pshs a ; save zero counter + lda #'0 ; insert a 0 + sta ,u+ + puls a ; get back counter +L90EA deca ; do we need more zeroes? + bpl L90E2 ; brif so + rts +L90EE lda VD9 ; get left digit counter + bsr L90EA ; put that many zeroes in + jsr L924D ; put decimal in buffer + lda #-9 ; figure out filler zeroes + suba V47 + bsr L90EA ; output required leader zeroes + clr V45 ; clear decimal pointer counter + clr VD7 ; clear comma counter +L90FF jsr L9202 ; decode FPA0 to decimal string + lda VD8 ; get right digit counter + bne L9108 ; brif there are right digits + ldu VARPTR ; point to decimal location of decimal +L9108 adda V47 ; add base 10 exponent + lbra L9050 ; add in leading astrisks, etc. +L910D lda FP0EXP ; get exponent of FPA0 + pshs a ; save it + beq L9116 ; brif 0 + jsr L91CD ; convert to number with 9 figures +L9116 lda VD8 ; get right digit counter + beq L911B ; brif no right digits + deca ; account for decimal point +L911B adda VD9 ; get left digit counter + clr STRBUF+3 ; use buffer byte as temporary storage + ldb VDA ; get status flags + andb #4 ; post-sign? + bne L9129 ; brif so + com STRBUF+3 ; flip byte if no post sign +L9129 adda STRBUF+3 ; subtract 1 if no post sign + suba #9 ; account for significant figures + pshs a ; save shift counter +L9130 bpl L913C ; brif no more shifts needed + pshs a ; save counter + jsr LBB82 ; divide by 10 (shift right one) + puls a ; get back counter + inca ; account for the shift + bra L9130 ; see if we need more +L913C lda ,s ; get original shift count + bmi L9141 ; brif shifting happened + clra ; flag for no shifting +L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed) + adda VD9 ; add left digit counter + inca ; and post sign + adda STRBUF+3 + sta V45 ; save decimal counter + clr VD7 ; clear comma counter + jsr L9202 ; convert to decimal string + puls a ; get shift counter + jsr L9281 ; put the needed zeroes in + lda VD8 ; get right digit counter + bne L915A ; brif we want some + leau -1,u ; remove te decimal point +L915A ldb ,s+ ; get original exponent + beq L9167 ; brif it was 0 + ldb V47 ; get base 10 exponent + addb #9 ; account for significant figures + subb VD9 ; remove left digit count + subb STRBUF+3 ; add one if post sign +L9167 lda #'+ ; positive sign + tstb ; is base 10 exponent positive? + bpl L916F ; brif so + lda #'- ; negative sign + negb ; flip exponent +L916F sta 1,u ; put exponent sign + lda #'E ; put "E" and advance output pointer + sta ,u++ + lda #'0-1 ; initialize digit accumulator +L9177 inca ; bump digit + subb #10 ; are we at the right digit? + bcc L9177 ; brif not + addb #'0+10 ; add ASCII bias and undo extra subtraction + std ,u++ ; save exponent in buffer + clr ,u ; clear final byte in buffer + jmp L9054 ; insert *, $, etc. +L9185 ldx #STRBUF+4 ; point to start of result + ldb ,x ; get sign + pshs b ; save it + lda #0x20 ; default pad with spaces + ldb VDA ; get flags + bitb #0x20 ; padding with *? + puls b + beq L919E ; brif no padding + lda #'* ; pad with * + cmpb #0x20 ; do we have a blank? (positive) + bne L919E ; brif not + tfr a,b ; use pad character +L919E pshs b ; save first character +L91A0 sta ,x+ ; store padding + ldb ,x ; get next character + beq L91B6 ; brif end of string + cmpb #'E ; exponent? + beq L91B6 ; brif so - treat as 0 + cmpb #'0 ; zero? + beq L91A0 ; brif so - pad it + cmpb #', ; leading comma? + beq L91A0 ; brif so - pad it + cmpb #'. ; decimal? + bne L91BA ; brif so - don't put a 0 before it +L91B6 lda #'0 ; put a zero before + sta ,-x +L91BA lda VDA ; get status byte + bita #0x10 ; floating $? + beq L91C4 ; brif not + ldb #'$ ; stuff a $ in + stb ,-x +L91C4 anda #4 ; pre-sgn? + puls b ; get back first character + bne L91CC ; brif not + stb ,-x ; save leading character (sign) +L91CC rts +L91CD pshs u ; save buffer pointer + clra ; initial exponent offset is 0 +L91D0 sta V47 ; save exponent offset + ldb FP0EXP ; get actual exponent + cmpb #0x80 ; is value >= 1.0? + bhi L91E9 ; brif so + ldx #LBDC0 ; point to FP number 1E9 + jsr LBACA ; multiply by 1000000000 + lda V47 ; account for 9 shifts + suba #9 + bra L91D0 ; brif not there yet +L91E4 jsr LBB82 ; divide by 10 + inc V47 ; account for shift +L91E9 ldx #LBDBB ; point to 999999999 + jsr LBCA0 ; compare it + bgt L91E4 ; brif not in range yet +L91F1 ldx #LBDB6 ; point to 99999999.9 + jsr LBCA0 ; compare + bgt L9200 ; brif in range + jsr LBB6A ; multiply by 10 + dec V47 ; account for shift + bra L91F1 ; see if we're in range yet +L9200 puls u,pc ; restore buffer pointer and return +L9202 pshs u ; save buffer pointer + jsr LB9B4 ; add .5 (round off) + jsr LBCC8 ; convert to integer format + puls u ; restore buffer pointer + ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs) + ldb #0x80 ; intitial digit counter is 0 with 0x80 bias +L9211 bsr L9249 ; check for comma +L9213 lda FPA0+3 ; add a power of 10 + adda 3,x + sta FPA0+3 + lda FPA0+2 + adca 2,x + sta FPA0+2 + lda FPA0+1 + adca 1,x + sta FPA0+1 + lda FPA0 + adca ,x + sta FPA0 + incb ; add one to digit counter + rorb ; set V if carry and sign differ + rolb + bvc L9213 ; brif we haven't "wrapped" + bcc L9235 ; brif subtracting + subb #10+1 ; take 9's complement if adding + negb +L9235 addb #'0-1 ; add in ASCII bias + leax 4,x ; move to next power + tfr b,a ; save digit + anda #0x7f ; mask off subtract flag + sta ,u+ ; save digit + comb ; toggle add/subtract + andb #0x80 + cmpx #LBEE9 ; done all places? + bne L9211 ; brif not + clr ,u ; but NUL at end +L9249 dec V45 ; at decimal? + bne L9256 ; brif not +L924D stu VARPTR ; save decimal point pointer + lda #'. ; insert decimal + sta ,u+ + clr VD7 ; clear comma counter + rts +L9256 dec VD7 ; do we need a comma? + bne L9262 ; brif not + lda #3 ; reset comma counter + sta VD7 + lda #', ; insert comma + sta ,u+ +L9262 rts +L9263 lda V47 ; get base 10 exponent offset + adda #10 ; account for significant figures + sta V45 ; save decimal counter + inca ; add one for decimal point +L926A suba #3 ; divide by 3, leave remainder in A + bcc L926A + adda #5 ; renormalize to range 1-3 + sta VD7 ; save comma counter + lda VDA ; get status + anda #0x40 ; commas wanted? + bne L927A ; brif not + sta VD7 ; clear comma counter +L927A rts +L927B pshs a ; save zeroes counter + bsr L9249 ; check for decimal + puls a ; get back counter +L9281 deca ; need a zero? + bmi L928E ; brif not + pshs a ; save counter + lda #'0 ; put a zero + sta ,u+ + lda ,s+ ; get back counter and set flags + bne L927B ; brif not done enough +L928E rts +; From here to the end of the Extended Basic ROM is the PMODE graphics system and related +; infrastructure with the exception of the PLAY command which shares some of its machinery +; with the DRAW command. +; +; Fetch screen address calculation routine address for the selected graphics mode +L928F ldu #L929C ; point to normalization routine jump table + lda PMODE ; get graphics mode + asla ; two bytes per address + ldu a,u ; get routine address + rts +; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A. +L9298 bsr L928F ; fetch normalization routine pointer + jmp ,u ; transfer control to it +L929C fdb L92A6 ; PMODE 0 + fdb L92C2 ; PMODE 1 + fdb L92A6 ; PMODE 2 + fdb L92C2 ; PMODE 3 + fdb L92A6 ; PMODE 4 +; Two colour mode address calculatoin +L92A6 pshs u,b ; savce registers + ldb HORBYT ; get number of bytes in each graphics row + lda VERBEG+1 ; get vertical coordinate + mul + addd BEGGRP ; now D is the absolute address of the start of the row + tfr d,x ; get address to the return location + ldb HORBEG+1 ; get horizontal coordinate + lsrb ; divide by 8 (8 pixels per byte in 2 colour mode) + lsrb + lsrb + abx ; now X is the address of the actual pixel byte + lda HORBEG+1 ; get horizontal coordinate + anda #7 ; keep only the low 3 bits which contain the pixel number + ldu #L92DD ; point to pixel mask lookup + lda a,u ; get pixel mask + puls b,u,pc ; restore registers and return result +; four colour address calculation +L92C2 pshs u,b ; save registers + ldb HORBYT ; get bytes per graphics row + lda VERBEG+1 ; get vertical coordinate + mul + addd BEGGRP ; now D is the address of the start of the row + tfr d,x ; put it in returnlocatin + ldb HORBEG+1 ; get horizontal coordinate + lsrb ; divide by 4 (four colour modes have four pixels per byte) + lsrb + abx ; now X points to the screen byte + lda HORBEG+1 ; get horizontal coordinate + anda #3 ; keep low two bits for pixel number + ldu #L92E5 ; point to four colour pixel masks + lda a,u ; get pixel mask + puls b,u,pc ; restore registers and return result +L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks + fcb 0x08,0x04,0x02,0x01 +L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks +; Move X down one graphics row +L92E9 ldb HORBYT ; get bytes per row + abx ; add to screen address + rts +; Move one pixel right in 2 colour mode +L92ED lsra ; move pixel mask right + bcc L92F3 ; brif same byte + rora ; move pixel mask to left of byte + leax 1,x ; move to next byte +L92F3 rts +; Move one pixel right in 4 colour mode +L92F4 lsra ; shift mask half a pixel right + bcc L92ED ; brif not past end of byte - shift one more + lda #0xc0 ; set mask on left of byte + leax 1,x ; move to next byte + rts +; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG. +L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B + ldy #HORBEG ; point to storage location +L9303 cmpb #192 ; is vertical outside range? + blo L9309 ; brif not + ldb #191 ; max it at bottom of screen +L9309 clra ; zero extend vertical coordinate + std 2,y ; save vertical coordinate + ldd BINVAL ; get horizontal coordinate + cmpd #256 ; in range? + blo L9317 ; brif so + ldd #255 ; max it out to right side of screen +L9317 std ,y ; save horizontal coordinate + rts +; Normalize coordinates for proper PMODE +L931A jsr L92FC ; parse coordinates +L931D ldu #HORBEG ; point to start coordinates +L9320 lda PMODE ; get graphics mode + cmpa #2 ; is it pmode 0 or 1? + bhs L932C ; brif not + ldd 2,u ; get vertical coordinate + lsra ; divide it by two + rorb + std 2,u ; save it back +L932C lda PMODE ; get graphics mode + cmpa #4 ; pmode 4? + bhs L9338 ; brif so + ldd ,u ; cut horizontal coordinate in half + lsra + rorb + std ,u ; save new coordinate +L9338 rts +; PPOINT function +PPOINT jsr L93B2 ; evaluate two expressions (coordinates) + jsr L931D ; normalize coordinates + jsr L9298 ; get screen address + anda ,x ; get colour value of desired screen coordinate + ldb PMODE ; get graphics mode + rorb ; is it a two colour m ode? + bcc L935B ; brif so +L9349 cmpa #4 ; is it on rightmost bits? + blo L9351 ; brif not + rora ; shift right + rora + bra L9349 ; see if we're there yet +L9351 inca ; colour numbers start at 1 + asla ; add in colour set (0 or 8) + adda CSSVAL + lsra ; get colour in range of 0 to 8 +L9356 tfr a,b ; put result to B + jmp LB4F3 ; return B as FP number +L935B tsta ; is pixel on? + beq L9356 ; brif not, return 0 (off) + clra ; set colour number to "1" + bra L9351 ; make it 1 or 5 and return +; PSET command +PSET lda #1 ; PSET flag + bra L9366 ; go turn on the pixel +; PRESET command +PRESET clra ; PRESET flag +L9366 sta SETFLG ; store whether we're setting or resetting + jsr LB26A ; enforce ( + jsr L931A ; evaluate coordinates + jsr L9581 ; evaluate colour + jsr LB267 ; enforce ) + jsr L9298 ; get address of pixel +L9377 ldb ,x ; get screen data + pshs b ; save it + tfr a,b ; duplicate pixel mask + coma ; invert mask + anda ,x ; turn off screen pixel + andb ALLCOL ; adjust pixel mask to be the current colour + pshs b ; merge pixel data into the screen data + ora ,s+ + sta ,x ; put it on screen + suba ,s+ ; nonzero if screen data changed + ora CHGFLG ; propagate change flag + sta CHGFLG + rts +; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and +; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF. +L938F ldx HORDEF ; set default start coords + stx HORBEG + ldx VERDEF + stx VERBEG + cmpa #0xac ; do we start with a -? + beq L939E ; brif no starting coordinates + jsr L93B2 ; parse coordinates +L939E ldb #0xac ; make sure we have a - + jsr LB26F + jsr LB26A ; require a ( + jsr LB734 ; evaluate two expressions + ldy #HOREND ; point to storage location + jsr L9303 ; process coordinates + bra L93B8 ; finish up with a ) +L93B2 jsr LB26A ; make sure there's a ( + jsr L92FC ; evaluate coordinates +L93B8 jmp LB267 ; force a ) +; LINE command +LINE cmpa #0x89 ; is it LINE INPUT? + lbeq L89C0 ; brif so - go handle it + cmpa #'( ; starting coord? + beq L93CE ; brif so + cmpa #0xac ; leading -? + beq L93CE ; brif so + ldb #'@ ; if it isn't the above, make sure it's @ + jsr LB26F +L93CE jsr L938F ; parse coordinates + ldx HOREND ; set ending coordinates as the defaults + stx HORDEF + ldx VEREND + stx VERDEF + jsr SYNCOMMA ; make sure we have a comma + cmpa #0xbe ; PRESET? + beq L93E9 ; brif so + cmpa #0xbd ; PSET? + lbne LB277 ; brif not + ldb #01 ; PSET flag + skip1lda ; skip byte and set A nonzero +L93E9 clrb ; PRESET flag + pshs b ; save PSET/PRESET flag + jsr GETNCH ; eat the PSET/PRESET + jsr L9420 ; normalize coordinates + puls b ; get back PSET/PRESET flag + stb SETFLG ; flag which we're doing + jsr L959A ; set colour byte + jsr GETCCH ; get next bit + lbeq L94A1 ; brif no box option + jsr SYNCOMMA ; make sure it's comma + ldb #'B ; make sure "B" for "box" + jsr LB26F + bne L9429 ; brif something follows the B + bsr L9444 ; draw horizontal line + bsr L946E ; draw vertical line + ldx HORBEG ; save horizontal coordinate + pshs x ; save it + ldx HOREND ; switch in horizontal end + stx HORBEG + bsr L946E ; draw vertical line + puls x ; get back original start + stx HORBEG ; put it back + ldx VEREND ; do the same dance with the vertical end + stx VERBEG + bra L9444 ; draw horizontal line +L9420 jsr L931D ; normalize the start coordinates + ldu #HOREND ; point to end coords + jmp L9320 ; normalize those coordinates +L9429 ldb #'F ; make sure we have "BF" for "filled box" + jsr LB26F + bra L9434 ; fill the box +L9430 leax -1,x ; move vertical coordinate up one +L9432 stx VERBEG ; save new vertical coordinate +L9434 jsr L9444 ; draw a horizontal line + ldx VERBEG ; are we at the end of the box? + cmpx VEREND + beq L9443 ; brif so + bcc L9430 ; brif we're moving up the screen + leax 1,x ; move down the screen + bra L9432 ; go draw another line +L9443 rts +; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL +L9444 ldx HORBEG ; get starting horizontal coordinate + pshs x ; save it + jsr L971D ; get absolute value of HOREND-HORBEG + bcc L9451 ; brif end is > start + ldx HOREND ; copy end coordinate to start it is smaller + stx HORBEG +L9451 tfr d,y ; save difference - it's a pixel count + leay 1,y ; coordinates are inclusive + jsr L9298 ; get screen position of start coord + puls u ; restore original start coordinate + stu HORBEG + bsr L9494 ; point to routine to move pizel pointers to right +L945E sta VD7 ; save pixel mask + jsr L9377 ; turn on pixel + lda VD7 ; get pixel mask back + jsr ,u ; move one pixel right + leay -1,y ; turned on enough pixels yet? + bne L945E ; brif not +L946B rts +L946C puls b,a ; clean up stack +L946E ldd VERBEG ; save original vertical start coordinate + pshs b,a + jsr L9710 ; get vertical difference + bcc L947B ; brif end coordinate > start + ldx VEREND ; swap in end coordinate if not + stx VERBEG +L947B tfr d,y ; save number of pixels to set + leay 1,y ; the coordinates are inclusive + jsr L9298 ; get screen pointer + puls u ; restore start coordinate + stu VERBEG + bsr L949D ; point to routine to move down one row + bra L945E ; draw vertical line +; Point to routine which will move one pixel right +L948A fdb L92ED ; PMODE 0 + fdb L92F4 ; PMODE 1 + fdb L92ED ; PMODE 2 + fdb L92F4 ; PMODE 3 + fdb L92ED ; PMODE 4 +L9494 ldu #L948A ; point to jump table + ldb PMODE ; get graphics mode + aslb ; two bytes per address + ldu b,u ; get jump address + rts +; Point to routine to move down one row +L949D ldu #L92E9 ; point to "move down one row" routien + rts +; Draw a line from HORBEG,VERBEG to HOREND,VEREND +L94A1 ldy #L950D ; point to increase vertical coord + jsr L9710 ; calculate difference + lbeq L9444 ; brif none - draw a horizontal line + bcc L94B2 ; brif vertical end is > vertical start + ldy #L951B ; point to decrease vertical coord +L94B2 pshs d ; save vertical difference + ldu #L9506 ; point to increase horizontal coord + jsr L971D ; get difference + beq L946C ; brif none - draw a vertical line + bcc L94C1 ; brif horizontal end > horizontal start + ldu #L9514 ; point to decrease hoizontal coord +L94C1 cmpd ,s ; compare vert and horiz differences + puls x ; get X difference + bcc L94CC ; brif horiz diff > vert diff + exg u,y ; swap change routine pointers + exg d,x ; swap differences +L94CC pshs u,d ; save larger difference and routine + pshs d ; save larger difference + lsra ; divide by two + rorb + bcs L94DD ; brif odd number + cmpu #L950D+1 ; increase or decrease? + blo L94DD ; brif increase + subd #1 ; back up one +L94DD pshs x,b,a ; save smallest difference and initial middle offset + jsr L928F ; point to proper coordinate to screen conversion routine +L94E2 jsr ,u ; convert coordinates to screen address + jsr L9377 ; turn on a pixel + ldx 6,s ; get distnace counter + beq L9502 ; brif line is completely drawn + leax -1,x ; account for one pixel drawn + stx 6,s ; save new counter + jsr [8,s] ; increment/decrement larger delta + ldd ,s ; get the minor coordinate increment counter + addd 2,s ; add the smallest difference + std ,s ; save new minor coordinate incrementcounter + subd 4,s ; subtractout the largest difference + bcs L94E2 ; brif not greater - draw another pixel + std ,s ; save new minor coordinate increment + jsr ,y ; adjust minor coordinate + bra L94E2 ; go draw another pixel +L9502 puls x ; clean up stack and return + puls a,b,x,y,u,pc +L9506 ldx HORBEG ; bump horizontal coordinate + leax 1,x + stx HORBEG + rts +L950D ldx VERBEG ; bump vertical coordinate + leax 1,x + stx VERBEG + rts +L9514 ldx HORBEG ; decrement horizontal coordinate + leax -1,x + stx HORBEG + rts +L951B ldx VERBEG ; decrement vertical coordinate + leax -1,x + stx VERBEG + rts +; Get normalized maximum coordinate values in VD3 and VD5 +L9522 ldu #VD3 ; point to temp storage + ldx #255 ; set maximum horizontal + stx ,u + ldx #191 ; set maximum vertical + stx 2,u + jmp L9320 ; normalize them +; PCLS command +PCLS beq L9542 ; clear to background colour if no argument + bsr L955A ; evaluate colour +L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles + mul ; now colour is in all four sub-pixels + ldx BEGGRP ; get start of graphics screen +L953B stb ,x+ ; set byte to proper colour + cmpx ENDGRP ; at end of graphics page? + bne L953B ; brif not + rts +L9542 ldb BAKCOL ; get background colour + bra L9536 ; do the clearing dance +; COLOR command +COLOR cmpa #', ; check for comma + beq L9552 ; brif no foreground colour + bsr L955A ; evaluate first colour + stb FORCOL ; set foreground colour + jsr GETCCH ; is there a background colour? + beq L9559 ; brif not +L9552 jsr SYNCOMMA ; make sure we have a comma + bsr L955A ; evaluate background colour argument + stb BAKCOL ; set background colour +L9559 rts +; Evaluate a colour agument and convert to proper code based on graphics mode +L955A jsr EVALEXPB ; evaluate colour code +L955D cmpb #9 ; is it in range of 0-8? + lbhs LB44A ; brif not - raise error + clra ; CSS value for first colour set + cmpb #5 ; is it first or second colour set? + blo L956C ; brif first colour set + lda #8 ; flag second colour set + subb #4 ; adjust into basic range +L956C pshs a ; save CSS value + lda PMODE ; get graphics mode + rora ; 4 colour or 2? + bcc L957B ; brif 2 colour + tstb ; was it 0? + bne L9578 ; brif not +L9576 ldb #4 ; if so, make it 4 +L9578 decb ; convert to zero based +L9579 puls a,pc ; get back CSS value and return +L957B rorb ; is colour number odd? + bcs L9576 ; brif so - force all bits set colour + clrb ; force colour 0 if not + bra L9579 +; Set all pixel byte and active colour +L9581 jsr L959A ; set colour byte + jsr GETCCH ; is there something to evaluate? + beq L9598 ; brif not + cmpa #') ; )? + beq L9598 ; brif so + jsr SYNCOMMA ; force comma + cmpa #', ; another comma? + beq L9598 ; brif so + jsr L955A ; evaluate expression and return colour + bsr L95A2 ; save colour and pixel byte +L9598 jmp GETCCH ; re-fetch input character and return +L959A ldb FORCOL ; use foreground colour by default + tst SETFLG ; doing PRESET? + bne L95A2 ; brif not + ldb BAKCOL ; default to background colour +L95A2 stb WCOLOR ; save working colour + lda #0x55 ; consider a byte as 4 pixels + mul ; now all pixels are set to the same bit pattern + stb ALLCOL ; set all pixels byte + rts +L95AA bne L95CF ; brif graphics mode +L95AC pshs x,b,a ; save registers + ldx #SAMREG+8 ; point to middle of control register + sta 10,x ; reset display page to 0x400 + sta 8,x + sta 6,x + sta 4,x + sta 2,x + sta 1,x + sta -2,x + sta -4,x ; reset to alpha mode + sta -6,x + sta -8,x + lda PIA1+2 ; set VDG to alpha mode, colour set 0 + anda #7 + sta PIA1+2 + puls a,b,x,pc ;restore registers and return +L95CF pshs x,b,a ; save registers + lda PMODE ; get graphics mode + adda #3 ; offset to 3-7 (we don't use the bottom 3 modes) + ldb #0x10 ; shift to high 4 bits + mul + orb #0x80 ; set to graphics mode + orb CSSVAL ; set the desired colour set + lda PIA1+2 ; get get original PIA values + anda #7 ; mask off VDG control + pshs a ; merge with new VDG control + orb ,s+ + stb PIA1+2 ; set new VDG mode + lda BEGGRP ; get start of graphics page + lsra ; divide by two - pages are on 512 byte boundaries + jsr L960F ; set SAM control register + lda PMODE ; get graphics mode + adda #3 ; shift to VDG values + cmpa #7 ; PMODE 4? + bne L95F7 ; brif not + deca ; treat PMODE 4 the same as PMODE 3 +L95F7 bsr L95FB ; program SAM's VDG bits + puls a,b,x,pc ; restore registers and return +L95FB ldb #3 ; set 3 bits in register + ldx #SAMREG ; point to VDG control bits +L9600 rora ; get bit to set + bcc L9607 ; brif we need to clear the bit + sta 1,x ; set the bit + bra L9609 +L9607 sta ,x ; clear the bit +L9609 leax 2,x ; move to next bit + decb ; done all bits? + bne L9600 ; brif not + rts +L960F ldb #7 ; 7 screen address bits + ldx #SAMREG+6 ; point to screen address bits in SAM + bra L9600 ; go program SAM bits +L9616 lda PIA1+2 ; get VDG bits + anda #0xf7 ; keep everything but CSS bit + ora CSSVAL ; set correct CSS bit + sta PIA1+2 ; set desired CSS + rts +; PMODE command +PMODETOK cmpa #', ; is first argument missing? + beq L9650 ; brif so + jsr EVALEXPB ; evaluate PMODE number + cmpb #5 ; valid (0-4)? + bhs L966D ; brif not + lda GRPRAM ; get start of graphics memory +L962E sta BEGGRP ; set start of graphics page + aslb ; multiply mode by two (table has two bytes per entry) + ldu #L9706+1 ; point to lookup table + adda b,u ; add in number of 256 byte pages used for graphics screen + cmpa TXTTAB ; does it fit? + bhi L966D ; brif not + sta ENDGRP ; save end of graphics + leau -1,u ; point to bytes per horizontal row + lda b,u ; get bytes per row + sta HORBYT ; set it + lsrb ; restore PMODE value + stb PMODE ; set graphics mode + clra ; set background colour to 0 + sta BAKCOL + lda #3 ; set foreground colour to maximum (3) + sta FORCOL + jsr GETCCH ; is there a starting page number? + beq L966C ; brif not +L9650 jsr LB738 ; evaluate an expression following a comma + tstb ; page 0? + beq L966D ; brif so - not valid + decb ; zero-base it + lda #6 ; each graphics page is 6*256 + mul + addb GRPRAM ; add to start of graphics memory + pshs b ; save start of screen memory + addb ENDGRP ; add current and address + subb BEGGRP ; subtract current start (adds size of screen) + cmpb TXTTAB ; does it fit? + bhi L966D ; brif not + stb ENDGRP ; save new end of graphics + puls b ; get back start of graphics + stb BEGGRP ; set start of graphics +L966C rts +L966D jmp LB44A ; raise FC error +; SCREEN command +SCREEN cmpa #', ; is there a mode? + beq L967F ; brif no mode + jsr EVALEXPB ; get mode argument + tstb ; set Z if alpha + jsr L95AA ; set SAM/VDG for graphics mode + jsr GETCCH ; is there a second argument? + beq L966C ; brif not +L967F jsr LB738 ; evaluate ,<expr> + tstb ; colour set 0? + beq L9687 ; brif so + ldb #8 ; flag for colour set 1 +L9687 stb CSSVAL ; set colour set + bra L9616 ; set up VDG +; PCLEAR command +PCLEAR jsr EVALEXPB ; evaulate number of pages requested + tstb ; 0? + beq L966D ; brif zero - not allowed + cmpb #9 ; more than 8? + bhs L966D ; brif so - not allowed + lda #6 ; there are 6 "pages" per graphics page + mul ; now B is the number of pages to reserve + addb GRPRAM ; add to start of graphics memory + tfr b,a ; now A is the MSB of the start of free memory + ldb #1 ; program memory always starts one above + tfr d,y ; save pointer to program memory + cmpd ENDGRP ; are we trying to deallocate the current graphics page? + blo L966D ; brif so (note that this prevents PCLEAR 0 anyway) + subd TXTTAB ; subtract out current start of basic program + addd VARTAB ; add in end of program - now D is new top of program + tfr d,x ; save new end of program + inca ; make some extra space (for stack) + subd FRETOP ; see if new top of program fits + bhs L966D ; brif there isn't enough space + jsr L80D0 ; adjust input pointer + nop ; space filler for 1.1 patch (the JSR above) + ldu VARTAB ; get end of program + stx VARTAB ; save new end of program + cmpu VARTAB ; is old end higher? + bhs L96D4 ; brif so +L96BD lda ,-u ; copy a byte upward + sta ,-x + cmpu TXTTAB ; at beginning? + bne L96BD ; brif not + sty TXTTAB ; save new start of program + clr -1,y ; there must always be a NUL before the program +L96CB jsr LACEF ; re-assign basic program addresses + jsr LAD26 ; reset variables and stack + jmp LAD9E ; return to interpretation loop +L96D4 ldu TXTTAB ; get start of program + sty TXTTAB ; save new start of program + clr -1,y ; there must be a NUL at the start of the program +L96DB lda ,u+ ; move a byte downward + sta ,y+ + cmpy VARTAB ; at the top of the program? + bne L96DB ; brif not + bra L96CB ; finish up +; Graphics initialization routine - this really should be up at the start of the ROM with the +; rest of the initialization code. +L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4") + stb TXTTAB + lda #6 ; graphics memory starts immediately after the screen +L96EC sta GRPRAM ; set graphics memory start + sta BEGGRP ; set start of current graphics page + clra ; set PMODE to 0 + sta PMODE + lda #16 ; 16 bytes per graphics row + sta HORBYT + lda #3 ; set foreground colour to 3 + sta FORCOL + lda #0x0c ; set ending graphics page (for PMODE 0) + sta ENDGRP + ldx TXTTAB ; get start of program + clr -1,x ; make sure there's a NUL before it +L9703 jmp LAD19 ; do a "NEW" +; PMODE data table (bytes per row and number of 256 byte pages required for a screen) +L9706 fcb 16,6 ; PMODE 0 + fcb 32,12 ; PMODE 1 + fcb 16,12 ; PMODE 2 + fcb 32,24 ; PMODE 3 + fcb 32,24 ; PMODE 4 +; Calculate absolute value of vertical coordinate difference +L9710 ldd VEREND ; get ending address + subd VERBEG ; get difference +L9714 bcc L9751 ; brif we didn't carry + pshs cc ; save status (C set if start > end) + jsr L9DC3 ; negate the difference to be positive + puls cc,pc ; restore C and return +; Calculate absolute value of horizontal coordinate difference +L971D ldd HOREND ; get end coordinate + subd HORBEG ; calculate difference + bra L9714 ; turn into absolute value +; PCOPY command +PCOPY bsr L973F ; fetch address of the source page + pshs d ; save address + ldb #0xa5 ; make sure we have TO + jsr LB26F + bsr L973F ; fetch address of the second page + puls x ; get back source + tfr d,u ; put destination into a pointer + ldy #0x300 ; 0x300 words to copy +L9736 ldd ,x++ ; copy a word + std ,u++ + leay -1,y ; done? + bne L9736 ; brif not + rts +L973F jsr EVALEXPB ; evaluate page number + tstb ; zero? + beq L9752 ; brif invalid page number +; BUG: this should be deferred until after the address is calculated at which point it should +; be bhs instead of bhi. There should also be a check to make sure the page number is less than +; or equal to 8 above so we don't have to test for overflows below. + cmpb TXTTAB ; is page number higher than start of program (BUG!) + bhi L9752 ; brif so - error + decb ; zero-base the page number + lda #6 ; 6 "pages" per graphics page + mul ; now we have proper number of "pages" for the offset + addb GRPRAM ; add start of graphics memory + exg a,b ; put MSB into A, 0 into B. +L9751 rts +L9752 jmp LB44A ; raise illegal function call +; GET command +GET clrb ; GET flag + bra L975A ; go on to the main body +PUT ldb #1 ; PUT flag +L975A stb VD8 ; save GET/PUT flag + jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing) +L975F cmpa #'@ ; @ before coordinates? + bne L9765 ; brif not + jsr GETNCH ; eat the @ +L9765 jsr L938F ; evaluate start/end coordinates + jsr SYNCOMMA ; make sure we have a comma + jsr L98CC ; get pointer to array + tfr X,D ; save descriptor pointer + ldu ,x ; get offset to next descriptor + leau -2,u ; move back to array name + leau d,u ; point to end of array + stu VD1 ; save end of data + leax 2,x ; point to number of dimensions + ldb ,x ; get dimension count + aslb ; two bytes per dimension size + abx ; now X points to start of data + stx VCF ; save start of array data + lda VALTYP ; is it numeric + bne L9752 ; brif not + clr VD4 ; set default graphic action to PSET + jsr GETCCH ; get input character + beq L97B7 ; brif no action flag + com VD4 ; flag action enabled + jsr SYNCOMMA ; make sure there's a comma + tst VD8 ; PUT? + bne L979A ; brif so + ldb #'G ; check for full graphics option + jsr LB26F + bra L97CA ; handle the rest of the process +L979A ldb #5 ; 5 legal actions for PUT + ldx #L9839 ; point to action table +L979F ldu ,x++ ; get "clear bit" action routine + ldy ,x++ ; get "set bit" action routine + cmpa ,x+ ; does token match? + beq L97AE ; brif so + decb ; checked all? + bne L979F ; brif not + jmp LB277 ; raise error +L97AE sty VD5 ; save set bit action address + stu VD9 ; save clear bit action address + jsr GETNCH ; munch the acton token + bra L97CA ; handle rest of process +L97B7 ldb #0xf8 ; mask for bottom three bits + lda PMODE ; get graphics mode + rora ; odd number mode? + bcc L97C0 ; brif even + ldb #0xfc ; bottom 2 bits mask +L97C0 tfr b,a ; save mask + andb HORBEG+1 ; round down the start address + stb HORBEG+1 + anda HOREND+1 ; round down end address + sta HOREND+1 +L97CA jsr L971D ; get horizontal size + bcc L97D3 ; brif end > start + ldx HOREND ; switch end in for start + stx HORBEG +L97D3 std HOREND ; save size + jsr L9710 ; calculate vertical size + bcc L97DE ; brif end > start + ldx VEREND ; swap in vertical end for the start + stx VERBEG +L97DE std VEREND ; save vertical size + lda PMODE ; get graphics mode + rora ; even? + ldd HOREND ; get difference + bcc L97EB ; brif even (2 colour) + addd HOREND ; add in size (double it) + std HOREND ; save adjusted end size +L97EB jsr L9420 ; normalize differences + ldd HOREND ; get end coord + ldx VEREND ; get end size + leax 1,x ; make vertical size inclusive + stx VEREND ; save it back + tst VD4 ; got "G" or GET action + bne L9852 ; brif given + lsra ; we're going for whole bytes here + rorb + lsra + rorb + lsra + rorb + addd #1 ; make it inclusive + std HOREND ; save new coordinate + jsr L9298 ; convert to screen address +L9808 ldb HOREND+1 ; get horizontal size + pshs x ; save screen position +L980C tst VD8 ; get/put flag + beq L9831 ; brif get + bsr L9823 ; bump array data pointer + lda ,u ; copy data from array to screen + sta ,x+ +L9816 decb ; are we done the row? + bne L980C ; brif not + puls x ; get screen address + jsr L92E9 ; move to next row + dec VEREND+1 ; done? + bne L9808 ; brif not +L9822 rts +L9823 ldu VCF ; get array data location + leau 1,u ; bump it + stu VCF ; save new array data location + cmpu VD1 ; did we hit the end of the array? + bne L9822 ; brif not +L982E jmp LB44A ; raise function call error +L9831 lda ,x+ ; get data from screen + bsr L9823 ; bump array data pointer + sta ,u ; put data in array + bra L9816 ; do the loopy thing +; PUT actions +L9839 fdb L9894,L989B ; PSET + fcb 0xbd + fdb L989B,L9894 ; PRESET + fcb 0xbe + fdb L98B1,L989B ; OR + fcb 0xb1 + fdb L9894,L98B1 ; AND + fcb 0xb0 + fdb L98A1,L98A1 ; NOT + fcb 0xa8 +L9852 addd #1 ; add to horiz difference + std HOREND ; save it + lda VD8 ; PUT? + bne L9864 ; brif so + ldu VD1 ; get end of array +L985D sta ,-u ; zero out a byte + cmpu VCF ; done? + bhi L985D ; brif not +L9864 jsr L9298 ; get screen address + ldb PMODE ; get graphics mode + rorb ; even? + bcc L986E ; brif so + anda #0xaa ; use as pixel mask for 4 colour mode +L986E ldb #1 ; set bit probe + ldy VCF ; point to start of array data +L9873 pshs x,a ; save screen address + ldu HOREND ; get horizontal size +L9877 pshs u,a ; save horizontal size and pixel mask + lsrb ; move bit probe right + bcc L9884 ; brif we didn't fall off a byte + rorb ; shift carry back in on the left + leay 1,y ; move ahead a byte in the array + cmpy VD1 ; end of array data? + beq L982E ; raise error if so +L9884 tst VD8 ; PUT? + beq L98A7 ; brif not + bitb ,y ; test bit in array + beq L9890 ; brif not set + jmp [VD5] ; do action routine for bit set +L9890 jmp [VD9] ; do action routine for bit clear +L9894 coma ; invert mask + anda ,x ; read screen data and reset the desired bit + sta ,x ; save on screen + bra L98B1 +L989B ora ,x ; merge pixel mask with screen data (turn on bit) + sta ,x ; save on screen + bra L98B1 +L98A1 eora ,x ; invert the pixel in the screen data + sta ,x ; save on screen + bra L98B1 +L98A7 bita ,x ; is the bit set? + beq L98B1 ; brif not - do nothing + tfr b,a ; get bit probe + ora ,y ; turn on proper bit in data + sta ,y +L98B1 puls a,u ; get back array address + jsr L92ED ; move screen address to the right + leau -1,u ; account for consumed pixel + cmpu ZERO ; done yet? + bne L9877 ; brif not + ldx 1,s ; get start of row back + lda HORBYT ; get number of bytes per row + leax a,x ; move ahead one line + puls a ; get back screen pixel mask + leas 2,s ; lose the screen pointer + dec VEREND+1 ; done all rows? + bne L9873 ; brif not + rts +L98CC jsr LB357 ; evaluate a variable + ldb ,-x ; get variable name + lda ,-x + tfr d,u ; save it + ldx ARYTAB ; get start of arrays +L98D7 cmpx ARYEND ; end of arrays? + lbeq LB44A ; brif not found + cmpu ,x ; correct variable? + beq L98E8 ; brif so + ldd 2,x ; get array size + leax d,x ; move to next array + bra L98D7 ; check this array +L98E8 leax 2,x ; move pointer to the array header + rts ; obviously this rts is not needed +L98EB rts +; PAINT command +PAINT cmpa #'@ ; do we have @ before coords? + bne L98F2 ; brif not + jsr GETNCH ; eat the @ +L98F2 jsr L93B2 ; evaluate coordinates + jsr L931D ; normalize coordinates + lda #1 ; PSET flag (use working colour) + sta SETFLG + jsr L9581 ; parse colour and set working colour, etc. + ldd WCOLOR ; get working colour and all pixels byte + pshs d ; save them + jsr GETCCH ; is there anything else? + beq L990A ; brif not + jsr L9581 ; evaluate border colour +L990A lda ALLCOL ; get border colour all pixel byte + sta VD8 ; save border colour pixel byte + puls d ; get back working colour details + std WCOLOR + clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding + pshs u,x,b,a + jsr L9522 ; set up starting coordinates + jsr L928F ; point to pixel mask routine + stu VD9 ; save pixel mask routine + jsr L99DF ; paint from current horizontal coordinate to zero (left) + beq L9931 ; brif hit border immediately + jsr L99CB ; paint from current horizontal coordinate upward (right) + lda #1 ; set direction to "down" + sta VD7 + jsr L99BA ; save "down" frame + neg VD7 ; set direction to "up" + jsr L99BA ; save "up" frame +L9931 sts TMPSTK ; save stack pointer +L9934 tst CHGFLG ; did the paint change anything? + bne L993B ; brif so + lds TMPSTK ; get back stack pointer +L993B puls a,b,x,u ; get frame from stack + clr CHGFLG ; mark nothing changed + sts TMPSTK ; save stack pointer + leax 1,x ; move start coordinate right + stx HORBEG ; save new coordinate + stu VD1 ; save length of line + sta VD7 ; save up/down flag + beq L98EB ; did we hit the "stop" frame? + bmi L9954 ; brif negative going (up)? + incb ; bump vertical coordinate + cmpb VD6 ; at end? + bls L9958 ; brif not + clrb ; set vertical to 0 (wrap around) +L9954 tstb ; did we wrap? + beq L9934 ; do another block if so + decb ; move up a row +L9958 stb VERBEG+1 ; save vertical coordinate + jsr L99DF ; paint from horizontal to 0 + beq L996E ; brif we hit the border immediately + cmpd #3 ; less than 3 pixels? + blo L9969 ; brif so + leax -2,x ; move two pixels left + bsr L99A1 ; save paint block on the stack +L9969 jsr L99CB ; continue painting to the right +L996C bsr L99BA ; save paint data frame +L996E coma ; complement length of line just painted and add to length of line + comb +L9970 addd VD1 ; save difference between this line and parent line + std VD1 + ble L998C ; brif parent line is shorter + jsr L9506 ; bump horizontal coordinate + jsr L9A12 ; see if we bounced into the border + bne L9983 ; brif not border + ldd #-1 ; move left + bra L9970 ; keep looking +L9983 jsr L9514 ; move horizontally left + bsr L99C6 ; save horizontal coordinate + bsr L99E8 ; paint right + bra L996C ; save paint block and do more +L998C jsr L9506 ; bump horizontal coordinate + leax d,x ; point to right end of parent line + stx HORBEG ; set as curent coordinate + coma ; get amount we extend past parent line + comb + subd #1 + ble L999E ; brif doesn't extend + tfr d,x ; save length of line + bsr L99A1 ; save paint frame +L999E jmp L9934 +L99A1 std VCB ; save number of pixels painted + puls y ; get return address + ldd HORBEG ; get horizontal coordinate + pshs x,b,a ; save horizontal coordinate and pointer + lda VD7 ; get up/down flag + nega ; reverse it +L99AC ldb VERBEG+1 ; get vertical coordainte + pshs b,a ; save vertical coord and up/down flag + pshs y ; put return address back + ldb #2 ; make sure we haven't overflowed memory + jsr LAC33 + ldd VCB ; get line length back + rts +L99BA std VCB ; save length of painted line + puls y ; get return address + ldd HOREND ; get start coord + pshs x,b,a ; save horizontal start and length + lda VD7 ; get up/down flag + bra L99AC ; finish up with the stack +L99C6 ldx HORBEG ; save current horizontal coord and save it + stx HOREND + rts +L99CB std VCD ; save number of pixels painted + ldy HOREND ; get last horizontal start + bsr L99C6 ; save current coordinate + sty HORBEG ; save coordinate + bsr L99E8 ; paint a line + ldx VCD ; get number painted + leax d,x ; add to the number painted going the other way + addd #1 ; now D is length of line + rts +L99DF jsr L99C6 ; put starting coordinate in end + ldy #L9514 ; decrement horizontal coordinate address + bra L99EE ; go paint line +L99E8 ldy #L9506 ; increment horizontal coordinate address + jsr ,y ; bump coordinate +L99EE ldu ZERO ; initialize pixel count + ldx HORBEG ; get starting coordinate +L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate + cmpx VD3 ; at end? + bhi L9A0B ; brif right of max + pshs u,y ; save counter and inc/dec routine pointer + bsr L9A12 ; at border? + beq L9A09 ; brif so + jsr L9377 ; set pixel to paint colour + puls y,u ; restore counter and inc/dec/pointer + leau 1,u ; bump number of painted pixels + jsr ,y ; inc/dec screen address + bra L99F2 ; go do another pixel +L9A09 puls y,u ; get back counter and inc/dec routine +L9A0B tfr u,d ; save count in D + tfr d,x ; and in X + subd ZERO ; set flags on D (smaller/faster than cmpd ZERO) + rts +L9A12 jsr [VD9] ; get the screen address + tfr a,b ; save pixel mask + andb VD8 ; set pixel to border colour + pshs b,a ; save mask and border + anda ,x ; mask current pixel into A + cmpa 1,s ; does it match border? Z=1 if so + puls a,b,pc ; restore mask, border pixel, and return +; PLAY command +; This is here mixed in with the graphics package because it shares some machinery with DRAW. +PLAY ldx ZERO ; default values for note length, etc. + ldb #1 + pshs x,b ; save default values + jsr LB156 ; evaluate argument + clrb ; enable DA and sound output + jsr LA9A2 + jsr LA976 +L9A32 jsr LB654 ; fetch PLAY string details + bra L9A39 ; go evaluate the string +L9A37 puls b,x ; get back play string details +L9A39 stb VD8 ; save length of string + beq L9A37 ; brif end of string + stx VD9 ; save start of string + lbeq LA974 ; brif NULL string - disable sound and return +L9A43 tst VD8 ; have anything left? + beq L9A37 ; brif not + jsr L9B98 ; get command character + cmpa #'; ; command separator? + beq L9A43 ; brif so - ignore it + cmpa #'' ; '? + beq L9A43 ; brif so - ignore it + cmpa #'X ; execuate sub string? + lbeq L9C0A ; brif so - handle it + bsr L9A5C ; handle other commands + bra L9A43 ; look for more stuff +L9A5C cmpa #'O ; octave? + bne L9A6D ; brif not + ldb OCTAVE ; get current octave + incb ; 1-base it + bsr L9AC0 ; get value if present + decb ; zero-base it + cmpb #4 ; valid octave? + bhi L9ACD ; raise error if not + stb OCTAVE ; save new octave + rts +L9A6D cmpa #'V ; volume? + bne L9A8B ; brif not + ldb VOLHI ; get current high volume limit + lsrb ; shift 2 bits right (DA is 6 bits in high bits) + lsrb + subb #31 ; subtract out mid value offset + bsr L9AC0 ; read argument + cmpb #31 ; maximum range is 31 + bhi L9ACD ; brif out of range + aslb ; adjust back in range + aslb + pshs b ; save new volume + ldd #0x7e7e ; midrange value for both high and low + adda ,s ; add new volume to high limit + subb ,s+ ; subtract volume from low limit + std VOLHI ; save new volume limits (sets high and low amplitudes) + rts +L9A8B cmpa #'L ; note length? + bne L9AB2 ; brif not + ldb NOTELN ; get current length + bsr L9AC0 ; read parameter + tstb ; resulting length 0? + beq L9ACD ; brif so - problem + stb NOTELN ; save new length + clr DOTVAL ; reset note timer scale factor +L9A9A bsr L9A9F ; check for dot + bcc L9A9A ; brif there was one + rts +L9A9F tst VD8 ; check length + beq L9AAD ; brif zero + jsr L9B98 ; get command character + cmpa #'. ; dot? + beq L9AAF ; brif so + jsr L9BE2 ; move input back and bump length +L9AAD coma ; set C to indicate nothing found + rts +L9AAF inc DOTVAL ; bump number of dots + rts +L9AB2 cmpa #'T ; tempo? + bne L9AC3 ; brif not + ldb TEMPO ; get current tempo + bsr L9AC0 ; parse tempo argument + tstb ; 0? + beq L9ACD ; brif so - invalid + stb TEMPO ; save new tempo + rts +L9AC0 jmp L9BAC ; evaluate various operators +L9AC3 cmpa #'P ; pause? + bne L9AEB ; brif not + jsr L9CCB ; evaluate parameter + tstb ; is the pause number 0? + bne L9AD0 ; brif not +L9ACD jmp LB44A ; raise FC error +L9AD0 lda DOTVAL ; save current volume and note scale + ldx VOLHI + pshs x,a + lda #0x7e ; drop DA to mid range + sta VOLHI + sta VOLLOW + clr DOTVAL + bsr L9AE7 ; go play a "silence" + puls a,x ; restore volume and note scale + sta DOTVAL + stx VOLHI + rts +L9AE7 clr ,-s ; set not number 0 + bra L9B2B ; go play it +L9AEB cmpa #'N ; N for "note"? + bne L9AF2 ; brif not - it's optional + jsr L9B98 ; skip the "N" +L9AF2 cmpa #'A ; is it a valid note? + blo L9AFA ; brif not + cmpa #'G ; is it above the note range? + bls L9AFF ; brif not - valid note +L9AFA jsr L9BBE ; evaluate a number + bra L9B22 ; process note value +L9AFF suba #'A ; normalize note number to 0 + ldx #L9C5B ; point to note number lookup table + ldb a,x ; get not number + tst VD8 ; any command characters left? + beq L9B22 ; brif not + jsr L9B98 ; get character + cmpa #'# ; sharp? + beq L9B15 ; brif so + cmpa #'+ ; also sharp? + bne L9B18 ; brif not +L9B15 incb ; add one half tone + bra L9B22 +L9B18 cmpa #'- ; flat? + bne L9B1F ; brif not + decb ; subtract one half tone + bra L9B22 +L9B1F jsr L9BE2 ; back up command pointer +L9B22 decb ; adjust note number (zero base it) + cmpb #11 ; is it valid? + bhi L9ACD ; raise error if not + pshs b ; save note value + ldb NOTELN ; get note length +L9B2B lda TEMPO ; get tempo value + mul ; calculate note duration + std VD5 ; save duration + leau 1,s ; point to where the stack goes after we're done + lda OCTAVE ; get current octave + cmpa #1 ; 0 or 1? + bhi L9B64 ; brif not + ldx #L9C62 ; point to delay table + ldb #2*12 ; 24 bytes per octave + mul ; now we have the base address + abx ; now X points to the octave base + puls b ; get back note value + aslb ; two bytes per delay + abx ; now we're pointing to the delay + leay ,x ; save pointer to note value + bsr L9B8C ; calculate note timer value + std PLYTMR ; set timer for note playing (IRQ will count this down) +L9B49 bsr L9B57 ; set to mid range and delay + lda VOLHI ; get high value + bsr L9B5A ; set to high value and delay + bsr L9B57 ; set to mid range and delay + lda VOLLOW ; get low value + bsr L9B5A ; set to low value and delay + bra L9B49 ; do it again (IRQ will break the loop) +L9B57 lda #0x7e ; mid value for DA with RS232 marking + nop ; a delay to fine tune frequencies +L9B5A sta PIA1 ; set DA + ldx ,y ; get delay value +L9B5F leax -1,x ; count down + bne L9B5F ; brif not done yet + rts +L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+ + ldb #12 ; 12 bytes per octave + mul ; now we have the offset to the desired octave + abx ; now we point to the start of the octave + puls b ; get back note value + abx ; now we point to the delay value + bsr L9B8C ; calculate timer value + std PLYTMR ; set play timer (IRQ counts this down) +L9B72 bsr L9B80 ; send mid value and delay + lda VOLHI ; get high value + bsr L9B83 ; send high value and delay + bsr L9B80 ; send low value and delay + lda VOLLOW ; get low value + bsr L9B83 ; send low value and delay + bra L9B72 ; do it again (IRQ will break the loop) +L9B80 lda #0x7e ; mid range value with RS232 marking + nop ; fine tuning delay +L9B83 sta PIA1 ; set DA + lda ,x ; get delay value +L9B88 deca ; count down + bne L9B88 ; brif not done + rts +L9B8C ldb #0xff ; base timer value + lda DOTVAL ; get number of dots + beq L9B97 ; use default value if 0 + adda #2 ; add in constant timer factor + mul ; multiply scale by base + lsra ; divide by two - each increment will increase note timer by 128 + rorb +L9B97 rts +L9B98 pshs x ; save register +L9B9A tst VD8 ; do we have anything left? + beq L9BEB ; brif not - raise error + ldx VD9 ; get parsing address + lda ,x+ ; get character + stx VD9 ; save pointer + dec VD8 ; account for character consumed + cmpa #0x20 ; space? + beq L9B9A ; brif so - skip it + puls x,pc ; restore register and return +L9BAC bsr L9B98 ; get character + cmpa #'+ ; add one? + beq L9BEE ; brif so + cmpa #'- ; subtract one? + beq L9BF2 ; brif so + cmpa #'> ; double? + beq L9BFC ; brif so + cmpa #'< ; halve? + beq L9BF7 ; brif so +L9BBE cmpa #'= ; variable equate? + beq L9C01 ; brif so + jsr L90AA ; clear carry if numeric + bcs L9BEB ; brif not numeric + clrb ; initialize value to 0 +L9BC8 suba #'0 ; remove ASCII bias + sta VD7 ; save digit + lda #10 ; make room for digit + mul + tsta ; did we overflow 8 bits? + bne L9BEB ; brif so + addb VD7 ; add in digit + bcs L9BEB ; brif that overflowed + tst VD8 ; more digits? + beq L9BF1 ; brif not + jsr L9B98 ; get character + jsr L90AA ; clear carry if numeric + bcc L9BC8 ; brif another digit +L9BE2 inc VD8 ; unaccount for character just read + ldx VD9 ; move pointer back + leax -1,x + stx VD9 + rts +L9BEB jmp LB44A ; raise FC error +L9BEE incb ; bump param + beq L9BEB ; brif overflow +L9BF1 rts +L9BF2 tstb ; already zero? + beq L9BEB ; brif so - underflow + decb ; decrease parameter + rts +L9BF7 tstb ; already at 0? + beq L9BEB ; brif so - raise error + lsrb ; halve it + rts +L9BFC tstb ; will it overflow? + bmi L9BEB ; brif so + aslb ; double it + rts +L9C01 pshs u,y ; save registers + bsr L9C1B ; interpret command string as a variable + jsr LB70E ; convert it to an 8 bit number + puls y,u,pc ; restore registers and return +L9C0A jsr L9C1B ; evaluate expression in command string + ldb #2 ; room for 4 bytes? + jsr LAC33 + ldb VD8 ; get the command length and pointer + ldx VD9 + pshs x,b ; save them + jmp L9A32 ; go process the sub string +L9C1B ldx VD9 ; get command pointer + pshs x ; save it + jsr L9B98 ; get input character + jsr LB3A2 ; set carry if not alpha + bcs L9BEB ; brif not a variable reference +L9C27 jsr L9B98 ; get command character + cmpa #'; ; semicolon? + bne L9C27 ; keep scanning if not + puls x ; get back start of variable string + ldu CHARAD ; get current interpreter input pointer + pshs u ; save it + stx CHARAD ; point interpreter at command string + jsr LB284 ; evaluate expression as string + puls x ; restore interpeter input pointer + stx CHARAD + rts +; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after +; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts. +L9C3E clra ; make sure DP is set to 0 + tfr a,dp + ldd PLYTMR ; is PLAY running? + lbeq LA9BB ; brif not - transfer control on the Color Basic's routine + subd VD5 ; subtract out the interval + std PLYTMR ; save new timer value + bhi L9C5A ; brif it isn't <= 0 + clr PLYTMR ; disable the timer + clr PLYTMR+1 + puls a ; get saved CC + lds 7,s ; set stack to saved U value + anda #0x7f ; clear E flag (to return minimal state) + pshs a ; set fake "FIRQ" stack frame +L9C5A rti +L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G +L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1 + fdb 0x0150,0x013d,0x012b,0x011a + fdb 0x010a,0x00fb,0x00ed,0x00df + fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2 + fdb 0x00a6,0x009d,0x0094,0x008b + fdb 0x0083,0x007c,0x0075,0x006e +L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3 + fcb 0x83,0x7b,0x74,0x6d + fcb 0x67,0x61,0x5b,0x56 + fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4 + fcb 0x3f,0x3b,0x37,0x34 + fcb 0x31,0x2e,0x2b,0x28 + fcb 0x26,0x23,0x21,0x1f ; delays for octave 5 + fcb 0x1d,0x1b,0x19,0x18 + fcb 0x16,0x14,0x13,0x12 +; DRAW command +DRAW ldx ZERO ; create an empty "DRAW" frame + ldb #1 + pshs x,b + stb SETFLG ; set to "PSET" mode + stx VD5 ; clear update and draw flag + jsr L959A ; set active colour byte + jsr LB156 ; evaluate command string +L9CC6 jsr LB654 ; fetch command string details + bra L9CD3 ; interpret the command string +L9CCB jsr L9B98 ; fetch command character + jmp L9BBE ; evaluate a number +L9CD1 puls b,x ; get previously saved command string +L9CD3 stb VD8 ; save length counter + beq L9CD1 ; brif end of string + stx VD9 ; save pointer + lbeq L9DC7 ; brif overall end of command +L9CDD tst VD8 ; are we at the end of the string? + beq L9CD1 ; brif so - return to previous string + jsr L9B98 ; get command character + cmpa #'; ; semicolon? + beq L9CDD ; brif so - ignore it + cmpa #'' ; '? + beq L9CDD ; brif so - ignore that too + cmpa #'N ; update position toggle? + bne L9CF4 ; brif not + com VD5 ; toggle update position flag + bra L9CDD ; get on for another command +L9CF4 cmpa #'B ; blank flag? + bne L9CFC ; brif not + com VD6 ; toggle blank flag + bra L9CDD ; get on for another command +L9CFC cmpa #'X ; substring? + lbeq L9D98 ; brif so - execute command + cmpa #'M ; move draw position? + lbeq L9E32 ; brif so + pshs a ; save command character + ldb #1 ; default value if no number follows + tst VD8 ; is there something there? + beq L9D21 ; brif not + jsr L9B98 ; get character + jsr LB3A2 ; set C if not alpha + pshs cc ; save alpha state + jsr L9BE2 ; move back pointer + puls cc ; get back alpha flag + bcc L9D21 ; brif it's alpha + bsr L9CCB ; evaluate a number +L9D21 puls a ; get command back + cmpa #'C ; color change? + beq L9D4F ; brif so + cmpa #'A ; angle? + beq L9D59 ; brif so + cmpa #'S ; scale? + beq L9D61 ; brif so + cmpa #'U ; up? + beq L9D8F ; brif so + cmpa #'D ; down? + beq L9D8C ; brif so + cmpa #'L ; left? + beq L9D87 ; brif so + cmpa #'R ; right? + beq L9D82 ; brif so + suba #'E ; normalize the half cardinals to 0 + beq L9D72 ; brif E (45°) + deca ; F (135°?) + beq L9D6D ; brif so + deca ; G (225°?) + beq L9D7B ; brif so + deca ; H (315°?) + beq L9D69 ; brif so +L9D4C jmp LB44A ; raise FC error +L9D4F jsr L955D ; adjust colour for PMODE + stb FORCOL ; save new foreground colour + jsr L959A ; set up working colour and all pixels byte +L9D57 bra L9CDD ; go process another command +L9D59 cmpb #4 ; only 3 angles are valid + bhs L9D4C ; brif not valid + stb ANGLE ; save new angle + bra L9D57 ; go process another command +L9D61 cmpb #63 ; only 64 scale values are possible + bhs L9D4C ; brif out of range + stb SCALE ; save new scale factor + bra L9D57 ; go process another command +L9D69 clra ; make horizontal negative + bsr L9DC4 + skip1 +L9D6D clra ; keep horizontal distance positive + tfr d,x ; make horizontal distance and vertical distance the same + bra L9DCB ; go do the draw thing +L9D72 clra ; zero extend horizontal distance + tfr d,x ; set it as vertical + bsr L9DC4 ; negate horizontal distance + exg d,x ; swap directions (vertical is now negative) + bra L9DCB ; go do the draw thing +L9D7B clra ; zero extend horizontal distance + tfr d,x ; copy horizontal to vertical + bsr L9DC4 ; negate horizontal + bra L9DCB ; go do the drawing thing +L9D82 clra ; zero extend horizontal distance +L9DB3 ldx ZERO ; no vertical distance + bra L9DCB ; go do the drawing things +L9D87 clra ; zero extend horizontal + bsr L9DC4 ; negate horizontal + bra L9DB3 ; zero out vertical and do the drawing thing +L9D8C clra ; zero extend distance + bra L9D92 ; make the distance vertical and zero out horizontal +L9D8F clra ; zero extend distance + bsr L9DC4 ; negate distance +L9D92 ldx ZERO ; zero out vertical distance + exg x,d ; swap vertical and horizontal + bra L9DCB ; go do the drawing thing +L9D98 jsr L9C1B ; evaluate substring expression + ldb #2 ; is there enough room for the state? + jsr LAC33 + ldb VD8 ; save current command string state + ldx VD9 + pshs x,b + jmp L9CC6 ; go evaluate the sub string +L9DA9 ldb SCALE ; get scale factor + beq L9DC8 ; brif zero - default to full size + clra ; zero extend + exg d,x ; put distance somewhere useful + sta ,-s ; save MS of distance + bpl L9DB6 ; brif positive distance + bsr L9DC3 ; negate the distance +L9DB6 jsr L9FB5 ; multiply D and X + tfr u,d ; save ms bytes in D + lsra ; divide by 2 + rorb +L9DBD lsra ; ...divide by 4 + rorb + tst ,s+ ; negative distance? + bpl L9DC7 ; brif it was positive +L9DC3 nega ; negate D +L9DC4 negb + sbca #0 +L9DC7 rts +L9DC8 tfr x,d ; copy unchanged sitance to D + rts +L9DCB pshs b,a ; save horizontal distance + bsr L9DA9 ; apply scale factor to vertical + puls x ; get horizontal distance + pshs b,a ; save scaled vertical + bsr L9DA9 ; apply scale to horizontal + puls x ; get back vertical distance + ldy ANGLE ; get draw angle and scale + pshs y ; save them +L9DDC tst ,s ; is there an angle? + beq L9DE8 ; brif no angle + exg x,d ; swap distances + bsr L9DC3 ; negate D + dec ,s ; account for one tick around the rotation + bra L9DDC ; see if we're there yet +L9DE8 puls y ; get angle and scale back + ldu ZERO ; default end position (horizontal) is 0 + addd HORDEF ; add default horizontal to horizontal distance + bmi L9DF2 ; brif we went negative + tfr d,u ; save calculated end coordindate +L9DF2 tfr x,d ; get vertical distance somewhere useful + ldx ZERO ; default vertical end is 0 + addd VERDEF ; add distance to default vertical start + bmi L9DFC ; brif negative - use 0 + tfr d,x ; save calculated end coordinate +L9DFC cmpu #256 ; is horizontal in range? + blo L9E05 ; brif su + ldu #255 ; maximize it +L9E05 cmpx #192 ; is vertical in range? + blo L9E0D ; brif so + ldx #191 ; maximize it +L9E0D ldd HORDEF ; set starting coordinates for the line + std HORBEG + ldd VERDEF + std VERBEG + stx VEREND ; set end coordinates + stu HOREND + tst VD5 ; are we updating position? + bne L9E21 ; brif not + stx VERDEF ; update default coordinates + stu HORDEF +L9E21 jsr L9420 ; normalize coordindates + tst VD6 ; are we drawing something? + bne L9E2B ; brif not + jsr L94A1 ; draw the line +L9E2B clr VD5 ; reset draw and update flags + clr VD6 + jmp L9CDD ; do another command +L9E32 jsr L9B98 ; get a command character + pshs a ; save it + jsr L9E5E ; evaluate horizontal distance + pshs b,a ; save it + jsr L9B98 ; get character + cmpa #', ; comma between coordinates? + lbne L9D4C ; brif not - raise error + jsr L9E5B ; evaluate vertical distance + tfr d,x ; save vertical distance + puls u ; get horizontal distance + puls a ; get back first command character + cmpa #'+ ; was it + at start? + beq L9E56 ; brif +; treat values as positive + cmpa #'- ; was it -? + bne L9DFC ; brif not - treat it as absolute +L9E56 tfr u,d ; put horizontal distance somewhere useful + jmp L9DCB ; move draw position (relative) +L9E5B jsr L9B98 ; get input character +L9E5E cmpa #'+ ; leading +? + beq L9E69 ; brif so + cmpa #'- ; leading -? + beq L9E6A ; brif so - negative + jsr L9BE2 ; move pointer back one +L9E69 clra ; 0 for +, nonzero for - +L9E6A pshs a ; save sign flag + jsr L9CCB ; evaluate number + puls a ; get sign flag + tsta ; negative? + beq L9E78 ; brif not + clra ; zero extend and negate + negb + sbca #0 +L9E78 rts +; Table of sines and cosines for CIRCLE +L9E79 fdb 0x0000,0x0001 ; subarc 0 + fdb 0xfec5,0x1919 ; subarc 1 + fdb 0xfb16,0x31f2 ; subarc 2 + fdb 0xf4fb,0x4a51 ; subarc 3 + fdb 0xec84,0x61f9 ; subarc 4 + fdb 0xe1c7,0x78ae ; subarc 5 + fdb 0xd4dc,0x8e3b ; subarc 6 + fdb 0xc5e5,0xa269 ; subarc 7 + fdb 0xb506,0xb506 ; subarc 8 +; CIRCLE command +; The circle is drawn as a 64 sided polygon (64 LINE commands essentially) +CIRCLE cmpa #'@ ; is there an @ before coordinates? + bne L9EA3 ; brif not + jsr GETNCH ; eat the @ +L9EA3 jsr L9522 ; get max coordinates for screen + jsr L93B2 ; parse coordinates for circle centre + jsr L931D ; normalize the start coordinates + ldx ,u ; get horizontal coordinate + stx VCB ; save it + ldx 2,u ; get vertical coordinate + stx VCD ; saveit + jsr SYNCOMMA ; make sure we have a comma + jsr LB73D ; evaluate radius expression + ldu #VCF ; point to temp storage + stx ,u ; save radius + jsr L9320 ; normalize radius + lda #1 ; default to PSET + sta SETFLG + jsr L9581 ; evaluate the colour expression + ldx #0x100 ; height/width default value + jsr GETCCH ; is there a ratio? + beq L9EDF ; brif not + jsr SYNCOMMA ; make sure we have a comma + jsr LB141 ; evaluate the ratio + lda FP0EXP ; multiply ratio by 256 + adda #8 + sta FP0EXP + jsr LB740 ; evaluate ratio to X (fraction part in LSB) +L9EDF lda PMODE ; get graphics mode + bita #2 ; is it even? + beq L9EE9 ; brif so + tfr x,d ; double the ratio + leax d,x +L9EE9 stx VD1 ; save height/width ratio + ldb #1 ; set the SET flag to PSET + stb SETFLG + stb VD8 ; set first time flag (set to 0 after arc drawn) + jsr L9FE2 ; evaluate circle starting point (octant, subarc) + pshs b,a ; save startpoint + jsr L9FE2 ; evaluate circle end point (octant, subarc) + std VD9 ; save endp oint + puls a,b +L9EFD pshs b,a ; save current circle position + ldx HOREND ; move end coordinates to start coordinates + stx HORBEG + ldx VEREND + stx VERBEG + ldu #L9E79+2 ; point to sine/cosine table + anda #1 ; even octant? + beq L9F11 ; brif so + negb ; convert 0-7 to 8-1 for odd octants + addb #8 +L9F11 aslb ; four bytes per table entry + aslb + leau b,u ; point to correct table entry + pshs u ; save sine/cosine table entry pointer + jsr L9FA7 ; calculate horizontal offset + puls u ; get back table entry pointer + leau -2,u ; move to cosine entry + pshs x ; save horizontal offset + jsr L9FA7 ; calculate vertical offset + puls y ; put horizontal in Y + lda ,s ; get octant number + anda #3 ; is it 0 or 4? + beq L9F31 ; brif so + cmpa #3 ; is it 3 or 7? + beq L9F31 ; brif so + exg x,y ; swap horizontal and vertical +L9F31 stx HOREND ; save horizontal offset + tfr y,x ; put vertical offset in X + ldd VD1 ; get height/width ratio + jsr L9FB5 ; multiply vertical by h/w ratio + tfr y,d ; save the product to D + tsta ; did it overflow? + lbne LB44A ; brif so + stb VEREND ; save vertical coordinate MSB + tfr u,d ; get LSW of product + sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio) + lda ,s ; get octant + cmpa #2 ; is it 0 or 1? + blo L9F5B ; brif so + cmpa #6 ; is it 6 or 7? + bhs L9F5B ; brif so + ldd VCB ; get horizontal centre + subd HOREND ; subtract horizontal displacement + bcc L9F68 ; brif we didn't overflow the screen + clra ; zero out coordinate if we overflowed the screen + clrb + bra L9F68 +L9F5B ldd VCB ; get horizontal coordinate of the centre + addd HOREND ; add displacement + bcs L9F66 ; brif overlod + cmpd VD3 ; larger than max horizontal coord? + blo L9F68 ; brif not +L9F66 ldd VD3 ; maximize the coordinate +L9F68 std HOREND ; save horizontal ending coordainte + lda ,s ; get octant + cmpa #4 ; is it 0-3? + blo L9F7A ; brif so + ldd VCD ; get vertical coordinate of centre + subd VEREND ; subtract displacement + bcc L9F87 ; brif we didn't overflow the screen + clra ; minimize to top of screen + clrb + bra L9F87 +L9F7A ldd VCD ; get vertical centre coordinate + addd VEREND ; add displacement + bcs L9F85 ; brif we overflowed the screen + cmpd VD5 ; did we go past max coordinate? + blo L9F87 ; brif not +L9F85 ldd VD5 ; maximize the coordinate +L9F87 std VEREND ; save end coordinate + tst VD8 ; check first time flag + bne L9F8F ; do not draw if first time through (it was setting start coord) + bsr L9FDF ; draw the line +L9F8F puls a,b ; get arc number and sub arc + lsr VD8 ; get first time flag value (and clear it!) + bcs L9F9A ; do not check for end point after drawing for first coordinate + cmpd VD9 ; at end point? + beq L9FA6 ; brif drawing finished +L9F9A incb ; bump arc counter + cmpb #8 ; done 8 arcs? + bne L9FA3 ; brif not + inca ; bump octant + clrb ; reset subarc number + anda #7 ; make sure octant number stays in 0-7 range +L9FA3 jmp L9EFD ; go do another arc +L9FA6 rts +L9FA7 ldx VCF ; get radius + ldd ,u ; get sine/cosine table entry + beq L9FB4 ; brif 0 - offset = radius + subd #1 ; adjust values to correct range + bsr L9FB5 ; multiply radius by sine/cosine + tfr y,x ; resturn result in X +L9FB4 rts +L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space + clr 4,s ; reset overflow byte (YH) + lda 3,s ; calcuate B*XL + mul + std 6,s ; put in "U" + ldd 1,s ; calculate B*XH + mul + addb 6,s ; accumluate with previous product + adca #0 + std 5,s ; save in YL,UH + ldb ,s ; calculate A*XL + lda 3,s + mul + addd 5,s ; accumulate with previous partical product + std 5,s ; save in YL,UH + bcc L9FD4 ; brif no carry + inc 4,s ; bump YH for carry +L9FD4 lda ,s ; calculate A*XH + ldb 2,s + mul + addd 4,s ; accumulate with previous partial product + std 4,s ; save in Y (we can't have a carry here) + puls a,b,x,y,u,pc ; restore multiplicands and return results +L9FDF jmp L94A1 ; go draw a line +L9FE2 clrb ; default arc number (0) + jsr GETCCH ; is there something there for a value? + beq L9FF8 ; brif not + jsr SYNCOMMA ; evaluate , + expression + jsr LB141 + lda FP0EXP ; multiply by 64 + adda #6 + sta FP0EXP + jsr LB70E ; get integer value of circle fraction + andb #0x3f ; max value of 63 +L9FF8 tfr b,a ; save arc value in A to calculate octant + andb #7 ; calculate subarc + lsra ; calculate octant + lsra + lsra + rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; COLOR BASIC ROM area +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed +; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of +; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points. +POLCAT fdb KEYIN ; indirect jump, get a keystroke +CHROUT fdb PUTCHR ; indirect jump, output character +CSRDON fdb CASON ; indirect jump, turn cassette on and start reading +BLKIN fdb GETBLK ; indirect jump, read a block from tape +BLKOUT fdb SNDBLK ; indirect jump, write a block to tape +JOYIN fdb GETJOY ; indirect jump, read joystick axes +WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader +; Initialization code. +LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now + lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges) + sta PIA1+3 + lda RSTFLG ; get warm start flag + cmpa #0x55 ; is it valid? + bne BACDST ; brif not - cold start + ldx RSTVEC ; get warm start routine pointer + lda ,x ; get first byte of the routine + cmpa #0x12 ; is it NOP? + bne BACDST ; brif not - the routine is invalid so do a cold start + jmp ,x ; transfer control to the warm start routine +; RESET/power on comes here +RESVEC leay LA00E,pcr ; point to warm start check code +LA02A lda #0x3a ; restore MMU block in 0x4000-0x5fff block + sta MMUREG+2 + ldx #PIA1 ; point to PIA1 + ldd #0xff34 ; set up for initializing PIAs + clr 1,x ; set PIA1 DA to direction mode + clr 3,x ; set PIA1 DB to direction mode + deca + sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input + lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input + sta 2,x + stb 1,x ; set PIA1 DA to data mode + stb 3,x ; set PIA1 DB to data mode + clr 2,x ; set VDG to alpha-numeric + lda #2 ; set RS232 to marking + sta ,x + lda #0xff + ldx #PIA0 ; point to PIA0 + clr 1,x ; set PIA0 DA to direction mode + clr 3,x ; set PIA0 DB to direction mode + clr ,x ; set PIA0 DA to input + sta 2,x ; set PIA0 DB to output + stb 1,x ; set PIA0 DA to direction mode + stb 3,x ; set PIA0 DB to direction mode + jmp LA072 ; continue initializing +LA05E jsr L8C2E ; map ROM pack + jmp 0xc000 ; transfer control to ROM pack +; Left over initialization code from Color Basic 1.2 follows + bitb 2,x ; check RAMSZ input + beq LA072 ; brif set for 4K RAMs + clr -2,x ; set strobe low + bitb 2,x ; check input + beq LA070 ; brif set for 64K rams + leau -2,u ; adjust pointer to set SAM for 16K RAMs +LA070 sta -3,u ; program SAM for either 16K or 64K RAMs +LA072 jmp ,y ; transfer control to startup routine +; Cold start jumps here +BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below) +LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM) + leax 1,x ; move forward one byte (will set Z if we're done) + bne LA077 ; brif not donw yet + jsr LA928 ; clear the screen + clr ,x+ ; put the constant zero that lives before the program + stx TXTTAB ; set beginning of program storage +LA084 ldx #0x7fff ; set to of available RAM to just below the "ROM" area + bra LA093 + nop + nop + nop + nop + nop + nop + nop + nop + nop + nop +LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work) + stx MEMSIZ ; save top of string space + stx STRTAB ; set bottom of allocated string space + leax -200,x ; allocate 200 bytes of string space + stx FRETOP ; set top of actually free memory + tfr x,s ; put the stack there + ldx #LA10D ; point to variable initializer + ldu #CMPMID ; point to variables to initialize (first batch) + ldb #28 ; 28 bytes in first batch + jsr LA59A ; copy bytes to variables + ldu #IRQVEC ; point to variables to initialize (second batch) + ldb #30 ; 30 bytes this time + jsr LA59A ; copy bytes to variables + ldx -12,x ; get SN error address + stx 3,u ; set ECB's command handlers to error + stx 8,u + ldx #RVEC0 ; point to RAM vectors + ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors) +LA0C0 sta ,x+ ; put an RTS + decb ; done? + bne LA0C0 ; brif not + sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer + jsr LAD19 ; do a "NEW" + jmp L8002 ; transfer control to ECB's initialization routine +LA0CE pshs b,x ; save registers + tst HRWIDTH ; is it VDG mode? + lbne ALINK24 ; brif not +LA0D6 jsr LA199 ; do a "cursor" + jsr KEYIN ; read a key + beq LA0D6 ; brif no key +LA0DE jmp LA1B9 ; return to mainline + fcb 0x72 ; left-over from code replacement above +LA0E2 lda #0x55 ; warm start valid flag + sta RSTFLG ; mark warm start valid + bra LA0F3 ; go to direct mode +; Warm start entry point +BAWMST nop ; valid routine marker + clr DEVNUM ; reset output/input to screen + jsr LAD33 ; do a partial NEW + andcc #0xaf ; start interrupts + jsr CLS ; clear the screen +LA0F3 jmp LAC73 ; go to direct mode +; FIRQ service routine - this handles starting autostart cartridges +BFRQSV tst PIA1+3 ; is it the cartridge interrupt? + bmi LA0FC ; brif so + rti +LA0FC jsr L8C28 ; map cartridge + jsr LA7D1 ; delay for another while + leay <LA108,pcr ; point to cartridge starter + jmp LA02A ; go initialize everything clean for the cartridge +LA108 clr RSTFLG ; force a cold start a cartridge reset + jmp ROMPAK ; transfer control to the cartridge +; Variable initializers (first batch) +LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period + fcb 24 ; upper limit of 1200 Hz period + fcb 10 ; upper limit of 2400 Hz period + fdb 128 ; number of 0x55s for cassette leader + fcb 11 ; cursor blink delay + fdb 88 ; 600 baud delay constant + fdb 1 ; printer carriage return delay constant + fcb 16 ; printer tab field width + fcb 112 ; last printer tab zone + fcb 132 ; printer carriage width + fcb 0 ; printer carriage position + fdb LB44A ; default execution address for EXEC + inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two + bne LA123 ;* two stage increment of CHARAD then load the value into A + inc CHARAD ;* before transferring control to the bottom half routine in ROM +LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required + jmp BROMHK +; Variable initializers (second batch) + jmp BIRQSV ; IRQ handler + jmp BFRQSV ; FIRQ handler + jmp LB44A ; default USR() address + fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed + fcb 0xff ; capslock flag - default to upper case + fdb DEBDEL ; keyboard debounce delay (why is it a variable?) + jmp LB277 ; exponentiation handler vector + fcb 53 ; (command interpretation table) 53 commands + fdb LAA66 ; (command interpretation table) reserved words list (commands) + fdb LAB67 ; (command interpretation table) jump table (commands) + fcb 20 ; (command interpretation table) 20 functions + fdb LAB1A ; (command interpretation table) reserved words list (functions) + fdb LAA29 ; (command interpretation table) jump table (functions) +; This is the signon message. +LA147 fcc 'COLOR BASIC 1.2' + fcb 0x0d + fcc '(C) 1982 TANDY' + fcb 0 +; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes +LA166 fcc 'MICROSOFT' + fcb 0x0d,0 +; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII) +LA171 bsr LA176 ; get character + anda #0x7f ; mask off high bit + rts +; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available, +; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine +; has undefined results when called on an output only device. All registers except CC and A are preserved. +LA176 jsr RVEC4 ; do RAM hook + clr CINBFL ; flag data available + tst DEVNUM ; is it keyboard? + beq LA1B1 ; brif so - blink cursor and wait for key press + tst CINCTR ; is there anything in cassette input buffer? + bne LA186 ; brif so + com CINBFL ; flag EOF + rts +; Read character from cassette file +LA186 pshs u,y,x,b ; preserve registers + ldx CINPTR ; get input buffer pointer + lda ,x+ ; get character from buffer + pshs a ; save it for return + stx CINPTR ; save new input buffer pointer + dec CINCTR ; count character just consumed + bne LA197 ; brif buffer is not empty yet + jsr LA635 ; go read another block, if any, to refill the buffer +LA197 puls a,b,x,y,u,pc ; restore registers and return the character +; Blink the cursor. This might be better timed via an interrupt or something. +LA199 dec BLKCNT ; is it time to blink the cursor? + bne LA1AB ; brif not + ldb #11 ; reset blink timer + stb BLKCNT + ldx CURPOS ; get cursor position + lda ,x ; get character at the cursor + adda #0x10 ; move to next color + ora #0x8f ; make sure it's a grahpics block with all elements lit + sta ,x ; put new cursor block on screen +LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms) +LA1AE jmp LA7D3 ; go count X down +; Blink cursor while waiting for a key press +LA1B1 pshs x,b ; save registers +LA1B3 bsr LA199 ; go do a cursor iteration + bsr KEYIN ; go read a key + beq LA1B3 ; brif no key pressed +LA1B9 ldb #0x60 ; VDG screen space character + stb [CURPOS] ; blank cursor out + puls b,x,pc ; restore registers and return +; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1 +; ROMs, this routine is quite a lot more compact and robust. +LA1C1 jmp KEYIN ; transfer control to actual keyboard scan + rts ;* this actually removes a check to see if any keys are actually down + rts ;* which is unfortunate because it makes programs run slower. + rts + rts + rts + rts + rts +KEYIN pshs u,x,b ; save registers + ldu #PIA0 ; point to keyboard PIA + ldx #KEYBUF ; point to state table + clra ; clear carry, set column to 0xff (no strobe) + deca ; (note: deca does not affect C) + pshs x,a ; save column counter and make a couple of holes for temporaries + sta 2,u ; set strobe to no columns +LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after) + bcc LA220 ; brif we shifted out a 0 - we've done 8 columns + inc 0,s ; bump column counter (first bump goes to 0) + bsr LA23A ; read row data + sta 1,s ; save key data (for debounce check and later saving) + eora ,x ; now bits set if key state changed + anda ,x ; now bits are only set if a key has been pressed + ldb 1,s ; get new key data + stb ,x+ ; save in state table + tsta ; was a key down? + beq LA1D9 ; brif not - do another (nothing above cleared C) + ldb 2,u ; get strobe data + stb 2,s ; save it for debounce check + ldb #0xf8 ; set up so B is 0 after first add +LA1F4 addb #8 ; add 8 for each row + lsra ; did we hit the right row? + bcc LA1F4 ; brif not + addb 0,s ; add in column number + beq LA245 ; brif @ + cmpb #26 ; letter? + bhi LA247 ; brif not + orb #0x40 ; bias into letter range + bsr LA22E ; check for SHIFT + ora CASFLG ; merge in capslock state + bne LA20C ; brif either capslock or SHIFT - keep upper case + orb #0x20 ; move to lower case +LA20C stb 0,s ; save ASCII value + ldx DEBVAL ; get debounce delay + bsr LA1AE ; do the 10ms debounce delay + ldb #0xff ; set strobe to none - only joystick buttons register now + bsr LA238 ; read keyboard + inca ; A now 0 if no buttons down + bne LA220 ; brif button down - return nothing since we have interference +LA21A ldb 2,s ; get column strobe data + bsr LA238 ; read row data + cmpa 1,s ; does it match original read? +LA220 puls a,x ; clean up stack and get return value + bne LA22B ; brif failed debounce or a joystick button down + cmpa #0x12 ; is it SHIFT-0? + bne LA22C ; brif not + com CASFLG ; swap capslock state +LA22B clra ; set no key down +LA22C puls b,x,u,pc ; restore registers and return +LA22E lda #0x7f ; column strobe for SHIFT + sta 2,u ; set column + lda ,u ; get row data + coma ; set if key down + anda #0x40 ; only keep SHIFT state + rts +LA238 stb 2,u ; save strobe data +LA23A lda ,u ; get row data + ora #0x80 ; mask off comparator so it doesn't interfere + tst 2,u ; are we on column 7? + bmi LA244 ; brif not + ora #0xc0 ; also mask off SHIFT +LA244 rts +LA245 ldb #51 ; scan code for @ +LA247 ldx #CONTAB-0x36 ; point to code table + cmpb #33 ; arrows, space, zero? + blo LA264 ; brif so + ldx #CONTAB-0x54 ; adjust to other half of table + cmpb #48 ; ENTER, CLEAR, BREAK, @? + bhs LA264 ; brif so + bsr LA22E ; read shift state + cmpb #43 ; is it a number, colon, semicolon? + bls LA25D ; brif so + eora #0x40 ; invert shift state for others +LA25D tsta ; shift down? + bne LA20C ; brif not - return result + addb #0x10 ; add in offset to shifted character + bra LA20C ; go return result +LA264 lslb ; two entries per key + bsr LA22E ; check SHIFT state + beq LA26A ; brif not shift + incb ; point to shifted entry +LA26A ldb b,x ; get actual key code + bra LA20C ; go return result +CONTAB fcb 0x5e,0x5f ; <UP> (^, _) + fcb 0x0a,0x5b ; <DOWN> (LF, [) + fcb 0x08,0x15 ; <LEFT> (BS, ^U) + fcb 0x09,0x5d ; <RIGHT> (TAB, ]) + fcb 0x20,0x20 ; <SPACE> + fcb 0x30,0x12 ; <0> (0, ^R) + fcb 0x0d,0x0d ; <ENTER> (CR, CR) + fcb 0x0c,0x5c ; <CLEAR> (FF, \) + fcb 0x03,0x03 ; <BREAK> (^C, ^C) + fcb 0x40,0x13 ; <@> (@, ^S) +; Generic output routine. +; Output character in A to the device specified by DEVNUM. All registers are preserved except CC. +; Sending output to a device that does not support output is undefined. +PUTCHR jsr RVEC3 ; call RAM hook + pshs b ; save B + ldb DEVNUM ; get desired device number + incb ; set flags (Z for -1, etc.) + puls b ; restore B + bmi LA2BF ; brif < -1 (line printer) + bne LA30A ; brif > -1 (screen) +; Write character to tape file + pshs x,b,a ; save registers + ldb FILSTA ; get file status + decb ; input file? + beq LA2A6 ; brif so + ldb CINCTR ; get character count + incb ; account for this character + bne LA29E ; brif buffer not full + bsr LA2A8 ; write previously full block to tape +LA29E ldx CINPTR ; get output buffer pointer + sta ,x+ ; put character in output + stx CINPTR ; save new buffer pointer + inc CINCTR ; account for this character +LA2A6 puls a,b,x,pc ; restore registers and return +; Write a block of data to tape. +LA2A8 ldb #1 ; data block type +LA2AA stb BLKTYP ; set block type + ldx #CASBUF ; point to output buffer + stx CBUFAD ; set buffer pointer + ldb CINCTR ; get number of bytes in the block + stb BLKLEN ; set length to write + pshs u,y,a ; save registers + jsr LA7E5 ; write a block to tape + puls a,y,u ; restore registers + jmp LA650 ; reset buffer pointers +; Send byte to line printer +LA2BF pshs x,b,a,cc ; save registers and interrupt status + orcc #0x50 ; disable interrupts +LA2C3 ldb PIA1+2 ; get RS232 status + lsrb ; get status to C + bcs LA2C3 ; brif busy - loop until not busy + bsr LA2FB ; set output to marking + clrb ; transmit one start bit + bsr LA2FD + ldb #8 ; counter for 8 bits +LA2D0 pshs b ; save bit count + clrb ; zero output bits + lsra ; bet output bit to C + rolb ; get output bit to correct bit for output byte + lslb + bsr LA2FD ; transmit bit + puls b ; get back bit counter + decb ; are we done yet? + bne LA2D0 ; brif not + bsr LA2FB ; send stop bit (marking) + puls cc,a ; restore interrupt status and output character + cmpa #0x0d ; carriage return? + beq LA2ED ; brif so + inc LPTPOS ; bump output position + ldb LPTPOS ; get new position + cmpb LPTWID ; end of line? + blo LA2F3 ; brif not +LA2ED clr LPTPOS ; reset position to start of line + bsr LA305 ; do carriage return delay + bsr LA305 +LA2F3 ldb PIA1+2 ; get RS232 status + lsrb ; get status to C + bcs LA2F3 ; brif still busy, keep waiting + puls b,x,pc ; restore registers and return +LA2FB ldb #2 ; set output to high (marking) +LA2FD stb PIA1 ; set RS232 output + bsr LA302 ; do baud delay (first iteration) then fall through for second +LA302 ldx LPTBTD ; get buard rate delay constant + skip2 +LA305 ldx LPTLND ; get carriage return delay constant + jmp LA7D3 ; count X down +; Output character to screen +LA30A pshs x,b,a ; save registers + ldx CURPOS ; get cursor pointer +LA30E cmpa #0x08 ; backspace? + bne LA31D ; brif not + cmpx #VIDRAM ; at top of screen? + beq LA35D ; brif so - it's a no-op + lda #0x60 ; VDG space character + sta ,-x ; put a space at previous location and move pointer back + bra LA344 ; save new cursor position and return +LA31D cmpa #0x0d ; carriage return? + bne LA32F ; brif not + ldx CURPOS ; get cursor pointer (why? we already have it) +LA323 lda #0x60 ; VDG space character + sta ,x+ ; put output space + tfr x,d ; see if we at a multiple of 32 now + bitb #0x1f + bne LA323 ; brif not + bra LA344 ; go check for scrolling +LA32F cmpa #0x20 ; control character? + blo LA35D ; brif so + tsta ; is it graphics block? + bmi LA342 ; brif so + cmpa #0x40 ; number or special? + blo LA340 ; brif so (flip "case" bit) + cmpa #0x60 ; upper case alpha? + blo LA342 ; brif so - keep it unmodified + anda #0xdf ; clear bit 5 (inverse video) +LA340 eora #0x40 ; flip inverse video bit +LA342 sta ,x+ ; output character +LA344 stx CURPOS ; save new cursor position + cmpx #VIDRAM+511 ; end of screen? + bls LA35D ; brif not + ldx #VIDRAM ; point to start of screen +LA34E ldd 32,x ; get two characters from next row + std ,x++ ; put them on this row + cmpx #VIDRAM+0x1e0 ; at start of last row on screen? + blo LA34E ; brif not + ldb #0x60 ; VDG space + jsr LA92D ; blank out last line (borrow CLS's loop) +LA35D puls a,b,x,pc ; restore registers and return +; Set up device parameters for output +LA35F jsr RVEC2 ; do the RAM hook dance + pshs x,b,a ; save registers + clr PRTDEV ; flag device as a screen + lda DEVNUM ; get devicenumber + beq LA373 ; brif screen + inca ; is it tape? + beq LA384 ; brif so + ldx LPTCFW ; get tab width and last tab stop for printer + ldd LPTWID ; get line width and current position for printer + bra LA37C ; set parameters +LA373 ldb CURPOS+1 ; get LSB of cursor position + andb #0x1f ; now we have the offset into the line + ldx #0x1010 ; 16 character tab, position 16 is last tab stop + lda #32 ; screen is 32 characters wide +LA37C stx DEVCFW ; save tab width and last tab stop for active device + stb DEVPOS ; save line position for current device + sta DEVWID ; save line width for current device + puls a,b,x,pc ; restore registers and return +LA384 com PRTDEV ; flag device as non-display + ldx #0x0100 ; tab width is 1, last tab field is 0 + clra ; line width is 0 + clrb ; character position on line is 0 + bra LA37C ; go set parameters +; This is the line input routine used for reading lines for Basic, both in immediate mode and for +; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER. +; The actualy entry point is LA390. Note that this routine echoes to *all* devices. +LA38D jsr LA928 ; clear screen (CLEAR key handling) +LA390 jsr RVEC12 ; do the RAM hook dance + clr IKEYIM ; reset cached input character from BREAK check + ldx #LINBUF+1 ; point to line input buffer (input pointer) + ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier) +LA39A jsr LA171 ; get an input character, only keep low 7 bits + tst CINBFL ; is it EOF? + bne LA3CC ; brif EOF + tst DEVNUM ; is it keyboard input? + bne LA3C8 ; brif not - don't do line editing + cmpa #0x0c ; form feed (CLEAR)? + beq LA38D ; brif so - clear screen and reset + cmpa #0x08 ; backspace? + bne LA3B4 ; brif not + decb ; move back one character + beq LA390 ; brif we were at the start of the line - reset and start again + leax -1,x ; move input pointer back + bra LA3E8 ; echo the backspace and continue +LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)? + bne LA3C2 ; brif not +LA3B8 decb ; at start of line? + beq LA390 ; brif so - reset and restart + lda #0x08 ; echo a backspace + jsr PUTCHR + bra LA3B8 ; see if we've erased everything yet +LA3C2 cmpa #0x03 ; BREAK? + orcc #1 ; set C if it is (only need Z for the next test +LA3C6 beq LA3CD ; brif BREAK - exit +LA3C8 cmpa #0x0d ; ENTER (CR) + bne LA3D9 ; brif not +LA3CC clra ; clear carry (it might not be clear on EOF) +LA3CD pshs cc ; save ENTER/BREAK flag + jsr LB958 ; echo a carriage return + clr ,x ; make sure we have a NUL at the end of the buffer + ldx #LINBUF ; point to input buffer + puls cc,pc ; restore ENTER/BREAK flag and return +LA3D9 cmpa #0x20 ; control character? + blo LA39A ; brif so - skip it + cmpa #'z+1 ; above z? + bhs LA39A ; brif so - ignore it + cmpb #LBUFMX ; is the buffer full? + bhs LA39A ; brif so - ignore extra characters + sta ,x+ ; put character in the buffer + incb ; bump character count +LA3E8 jsr PUTCHR ; echo character + bra LA39A ; go handle next input character +; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open. +LA3ED jsr RVEC5 ; do the RAM hook dance + lda DEVNUM ; get device number + beq LA415 ; brif keyboard - always valid + inca ; is it tape? + bne LA403 ; brif not + lda FILSTA ; get tape file status + bne LA400 ; brif file is open +LA3FB ldb #22*2 ; raise NO error + jmp LAC46 +LA400 deca ; is it in input mode? + beq LA415 ; brif so +LA403 jmp LA616 ; raise FM error +; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open. +LA406 jsr RVEC6 ; do the RAM hook dance + lda DEVNUM ; get device number + inca ; is it tape? + bne LA415 ; brif not + lda FILSTA ; get file status + beq LA3FB ; brif not open + deca ; is it open for reading? + beq LA403 ; brif so - bad mode +LA415 rts +; CLOSE command +CLOSE beq LA426 ; brif no file specified - close all files + jsr LA5A5 ; parse device number +LA41B bsr LA42D ; close specified file + jsr GETCCH ; is there more? + beq LA44B ; brif not + jsr LA5A2 ; check for comma and parse another device number + bra LA41B ; go close this one +; Close all files handler. +LA426 jsr RVEC7 ; Yup. The RAM hook dance. +LA429 lda #-1 ; start with tape file + sta DEVNUM +; Close file specified in DEVNUM. Note that this never fails. +LA42D jsr RVEC8 ; You know it. RAM hook. + lda DEVNUM ; get device we're closing + clr DEVNUM ; reset to screen/keyboard + inca ; is it tape? + bne LA44B ; brif not + lda FILSTA ; get file status + cmpa #2 ; is it output? + bne LA449 ; brif not + lda CINCTR ; is there anything waiting to be written? + beq LA444 ; brif not + jsr LA2A8 ; write final block of data +LA444 ldb #0xff ; write EOF block + jsr LA2AA +LA449 clr FILSTA ; mark tape file closed +LA44B rts +; CSAVE command +CSAVE jsr LA578 ; parse filename + jsr GETCCH ; see what we have after the file name + beq LA469 ; brif none + jsr SYNCOMMA ; make sure there's a comma + ldb #'A ; make sure there's an A after + jsr LB26F + bne LA44B ; brif not end of line + clra ; file type 0 (basic program) + jsr LA65C ; write out header block + lda #-1 ; set output to tape + sta DEVNUM + clra ; set Z so we list the whole program + jmp LIST ; go list the program to tape +LA469 clra ; file type 0 (basic program) + ldx ZERO ; set to binary file mode + jsr LA65F ; write header block + clr FILSTA ; close files + inc BLKTYP ; set block type to data + jsr WRLDR ; write out a leader + ldx TXTTAB ; point to start of program +LA478 stx CBUFAD ; set buffer location + lda #255 ; block size to 255 bytes (max size) + sta BLKLEN + ldd VARTAB ; get end of program + subd CBUFAD ; how much is left? + beq LA491 ; brif we have nothing left + cmpd #255 ; do we have a full block worth? + bhs LA48C ; brif so + stb BLKLEN ; save actual remainder as block length +LA48C jsr SNDBLK ; write a block out + bra LA478 ; go do another block +LA491 neg BLKTYP ; set block type to 0xff (EOF) + clr BLKLEN ; no data in EOF block + jmp LA7E7 ; write EOF, stop tape, and return +; CLOAD and CLOADM commands +CLOAD clr FILSTA ; close tape file + cmpa #'M ; is it ClOADM? + beq LA4FE ; brif so + leas 2,s ; clean up stack + jsr LA5C5 ; parse file name + jsr LA648 ; go find the file + tst CASBUF+10 ; is it binary? + beq LA4C8 ; brif so + lda CASBUF+9 ; is it ASCII? + beq LA4CD ; brif not + jsr LAD19 ; clear out existing program + lda #-1 ; set up for reading from tape + sta DEVNUM + inc FILSTA ; set tape file to input + jsr LA635 ; go read first block + jmp LAC7C ; go to immediate mode to read in the program +; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is +; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in +; 8K. +LA4BF jsr RVEC13 ; do the RAM hook dance + jsr LA42D ; close file + jmp LAC73 ; go back to immediate mode +LA4C8 lda CASBUF+8 ; get file type + beq LA4D0 ; brif basic program +LA4CD jmp LA616 ; raise FM error +LA4D0 jsr LAD19 ; erase existing program + jsr CASON ; start reading tape + ldx TXTTAB ; get start of program storage +LA4D8 stx CBUFAD ; set load address for block + ldd CBUFAD ; get start of block + inca ; bump by 256 + jsr LAC37 ; check if there's room for a maximum sized block of 255 + jsr GETBLK ; go read a block + bne LA4F8 ; brif there was an error during reading + lda BLKTYP ; get type of block read + beq LA4F8 ; brif header block - IO error + bpl LA4D8 ; brif data block - read another + stx VARTAB ; save new end of program + bsr LA53B ; stop tape + ldx #LABED-1 ; point to "OK" prompt + jsr STRINOUT ; show prompt + jmp LACE9 ; reset various things and return +LA4F8 jsr LAD19 ; clear out partial program load +LA4FB jmp LA619 ; raise IO error +; This is the CLOADM command +LA4FE jsr GETNCH ; eat the "M" + bsr LA578 ; parse file name + jsr LA648 ; go find the file +LA505 ldx ZERO ; default offset is 0 + jsr GETCCH ; see if there's something after the file name + beq LA511 ; brif no offset + jsr SYNCOMMA ; make sure there's a comma + jsr LB73D ; evaluate offset to X +LA511 lda CASBUF+8 ; get file mode + cmpa #2 ; M/L program? + bne LA4CD ; brif not - FM error + ldd CASBUF+11 ; get load address + leau D,x ; add in offset + stu EXECJP ; set EXEC default address + tst CASBUF+10 ; is it binary? + bne LA4CD ; brif not + ldd CASBUF+13 ; get load address + leax d,x ; add in offset + stx CBUFAD ; set buffer address for loading + jsr CASON ; start up tape +LA52E jsr GETBLK ; read a block + bne LA4FB ; brif error reading + stx CBUFAD ; save new load address + tst BLKTYP ; set flags on block type + beq LA4FB ; brif another header - IO error + bpl LA52E ; brif it was data - read more +LA53B jmp LA7E9 ; turn off tape and return +; The EXEC command +EXEC beq LA545 ; brif no argument - use default address + jsr LB73D ; evaluate EXEC address to X + stx EXECJP ; set new default EXEC address +LA545 jmp [EXECJP] ; transfer control to execution address +; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break +; check logic or packaged up with LIST? +LA549 jsr RVEC11 ; do the RAM hook dance + lda DEVNUM ; get device number + inca ; is it tape? + beq LA5A1 ; brif so - don't do break check + jmp LADEB ; do the actual break check +; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position. +; This really should be located with the PRINT command. +LA554 jsr LB3E4 ; evaluate a positive expression to D + subd #511 ; is it within bounds? + lbhi LB44A ; brif not - error out + addd #VIDRAM+511 ; adjust to be within the screen (and undo the SUBD above) + std CURPOS ; set cursor position + rts +; INKEY$ function +INKEY lda IKEYIM ; was a key down during break check? + bne LA56B ; brif so + jsr KEYIN ; poll the keyboard +LA56B clr IKEYIM ; reset the break check cache + sta FPA0+3 ; store result for later return + lbne LB68F ; brif a key was down - return it as a string + sta STRDES ; set string length to 0 (no key down) + jmp LB69B ; return the NULL string +; Parse a filename +LA578 ldx #CFNBUF ; point to file name buffer + clr ,x+ ; zero out file name length + lda #0x20 ; space character to initialize file name +LA57F sta ,x+ ; put a space in the buffer + cmpx #CASBUF ; at end of file name? + bne LA57F ; brif not + jsr GETCCH ; get input character + beq LA5A1 ; brif no name present + jsr LB156 ; evaluate the file name expression + jsr LB654 ; point to start of the file name + ldu #CFNBUF ; point to file name buffer + stb ,u+ ; save string length + beq LA5A1 ; brif empty - we're done + skip2 +LA598 ldb #8 ; copy 8 bytes +; Move B bytes from (X) to (U) +LA59A lda ,x+ ; copy a byte + sta ,u+ + decb ; done yet? + bne LA59A ; brif not +LA5A1 rts +; Parse a device number and check validity +LA5A2 jsr SYNCOMMA ; check for comma and SN error if not +LA5A5 cmpa #'# ; do we have a #? + bne LA5AB ; brif not (it's optional) + jsr GETNCH ; munch the # +LA5AB jsr LB141 ; evaluate the expression +LA5AE jsr INTCNV ; convert it to an integer in D + rolb ; move sign of B into C + adca #0 ; add sign of B to A + bne LA61F ; brif A doesn't match the sign of B + rorb ; restore B (ADCA will have set C if B was negative) + stb DEVNUM ; set device number + jsr RVEC1 ; do the RAM hook dance + beq LA5C4 ; brif device number set to screen/keyboard (valid) + bpl LA61F ; brif not negative (not valid) + cmpb #-2 ; is it printer or tape? + blt LA61F ; brif not (not valid) +LA5C4 rts +; Read file name from the line and do an error if anything follows it +LA5C5 bsr LA578 ; parse file name +LA5C7 jsr GETCCH ; set flags on current character +LA5C9 beq LA5C4 ; brif nothing there - it's good + jmp LB277 ; raise SN error +; EOF function +EOF jsr RVEC14 ; do the RAM hook dance + lda DEVNUM ; get device number + pshs a ; save it (so we can restore it later) + bsr LA5AE ; check the device number (which is in FPA0) + jsr LA3ED ; check validity for reading +LA5DA clrb ; not EOF = 0 (FALSE) + lda DEVNUM ; get device number + beq LA5E4 ; brif keyboard - never EOF + tst CINCTR ; is there anything in the input buffer? + bne LA5E4 ; brif so - not EOF + comb ; set EOF flag to -1 (true) +LA5E4 puls a ; get back original device + sta DEVNUM ; restore it +LA5E8 sex ; sign extend result to 16 bits + jmp GIVABF ; go return the result +; SKIPF command +SKIPF bsr LA5C5 ; parse file name + bsr LA648 ; look for the file + jsr LA6D1 ; read the file + bne LA619 ; brif error reading file + rts +; OPEN command +OPEN jsr RVEC0 ; do the RAM hook dance + jsr LB156 ; get file status (input/output) + jsr LB6A4 ; get first character of status string + pshs b ; save status + bsr LA5A2 ; parse a comma then the device number + jsr SYNCOMMA ; make sure there's a comma + bsr LA5C5 ; parse the file name + lda DEVNUM ; get device number of the file + clr DEVNUM ; reset actual device to the screen + puls b ; get back status + cmpb #'I ; INPUT? + beq LA624 ; brif so - open a file for INPUT + cmpb #'O ; OUTPUT? + beq LA658 ; brif so - open a file for OUTPUT +LA616 ldb #21*2 ; raise FM error + skip2 +LA619 ldb #20*2 ; raise I/O error + skip2 +LA61C ldb #18*2 ; raise AO error + skip2 +LA61F ldb #19*2 ; raise DN error + jmp LAC46 +LA624 inca ; are we opening the tape? + bmi LA616 ; brif printer - FM error; printer can't be opened for READ + bne LA657 ; brif screen - screen is always open + bsr LA648 ; read header block + lda CASBUF+9 ; clear A if binary or machine language file + anda CASBUF+10 + beq LA616 ; bad file mode if not data file + inc FILSTA ; open file for input +LA635 jsr LA701 ; start tape, read block + bne LA619 ; brif error during read + tst BLKTYP ; check block type + beq LA619 ; brif header block - something's wrong + bmi LA657 ; brif EOF + lda BLKLEN ; get length of block + beq LA635 ; brif empty block - read another +LA644 sta CINCTR ; set buffer count + bra LA652 ; reset buffer pointer +LA648 tst FILSTA ; is the file open? + bne LA61C ; brif so - AO error + bsr LA681 ; search for file + bne LA619 ; brif error on read +LA650 clr CINCTR ; mark buffer empty +LA652 ldx #CASBUF ; set buffer pointer to start of buffer + stx CINPTR +LA657 rts +LA658 inca ; check for tape device + bne LA657 ; brif not tape (nothing doing - it's always open) + inca ; make file type 1 +LA65C ldx #0xffff ; ASCII and data mode +LA65F tst FILSTA ; is file open? + bne LA61C ; brif so - raise error + ldu #CASBUF ; point to tape buffer + stu CBUFAD ; set address of block to write + sta 8,u ; set file type + stx 9,u ; set ASCII flag and mode + ldx #CFNBUF+1 ; point to file name + jsr LA598 ; move file name to the tape buffer + clr BLKTYP ; set for header block + lda #15 ; 15 bytes in a header block + sta BLKLEN ; set block length + jsr LA7E5 ; write the block + lda #2 ; set file type to output + sta FILSTA + bra LA650 ; reset file pointers +; Search for correct cassette file name +LA681 ldx #CASBUF ; point to cassette buffer + stx CBUFAD ; set location to read blocks to +LA686 lda CURLIN ; are we in immediate mode? + inca + bne LA696 ; brif not + jsr LA928 ; clear screen + ldx CURPOS ; get start of screen (set after clear) + ldb #'S ; for "searching" + stb ,x++ ; put it on the screen + stx CURPOS ; save cursor position to be one past the search indicator +LA696 bsr LA701 ; read a block + orb BLKTYP ; merge error flag with block type + bne LA6D0 ; brif error or not header + ldx #CASBUF ; point to block just read + ldu #CFNBUF+1 ; point to the desired name + ldb #8 ; compare 8 characters + clr ,-s ; set flag to "match" +LA6A6 lda ,x+ ; get character from just read block + ldy CURLIN ; immediate mode? + leay 1,y + bne LA6B4 ; brif not + clr DEVNUM ; set output to screen + jsr PUTCHR ; display character +LA6B4 suba ,u+ ; subtract from desired file name (nonzero if no match) + ora ,s ; merge with match flag + sta ,s ; save new match flag (will be nonzero if any character differs) + decb ; done all characters? + bne LA6A6 ; brif not - do another + lda ,s+ ; get match flag (and set flags) + beq LA6CB ; brif we have a match + tst -9,u ; did we actually have a file name or will any file do? + beq LA6CB ; brif any file will do + bsr LA6D1 ; go read past the file + bne LA6D0 ; return on error + bra LA686 ; keep looking +LA6CB lda #'F ; for "found" + bsr LA6F8 ; put "F" on screen + clra ; set Z to indicat eno errors +LA6D0 rts +LA6D1 tst CASBUF+10 ; check type of file + bne LA6DF ; brif "blocked" file + jsr CASON ; turn on tape +LA6D9 bsr GETBLK ; read a block + bsr LA6E5 ; error or EOF? + bra LA6D9 ; read another block +LA6DF bsr LA701 ; read a single block + bsr LA6E5 ; error or EOF? + bra LA6DF ; read another block +LA6E5 bne LA6ED ; got error reading block + lda BLKTYP ; check block type + nega ; A is 0 now if EOF + bmi LA700 ; brif not end of file + deca ; clear error indicator +LA6ED sta CSRERR ; set error flag + leas 2,s ; don't return to original caller + bra LA705 ; turn off motor and return +LA6F3 lda VIDRAM ; get first char on screen + eora #0x40 ; flip case +LA6F8 ldb CURLIN ; immediate mode? + incb + bne LA700 ; brif not + sta VIDRAM ; save flipped case character +LA700 rts +; Read a single block from tape (for a "blocked" file) +LA701 bsr CASON ; start tape going + bsr GETBLK ; read block +LA705 jsr LA7E9 ; stop tape + ldb CSRERR ; get error status + rts +; Read a block from tape - this does the heavy lifting +GETBLK orcc #0x50 ; disable interrupts (timing is important) + bsr LA6F3 ; reverse video of upper left character in direct mode + ldx CBUFAD ; point to destination buffer + clra ; reset read byte +LA712 bsr LA755 ; read a bit + rora ; move bit into accumulator + cmpa #0x3c ; have we synched on the start of the block data yet? + bne LA712 ; brif not + bsr LA749 ; read block type + sta BLKTYP + bsr LA749 ; get block size + sta BLKLEN + adda BLKTYP ; accumulate checksum + sta CCKSUM ; save current checksum + lda BLKLEN ; get back count + sta CSRERR ; initialize counter; we use this since it will be ovewritten later anyway + beq LA73B ; brif empty block +LA72B bsr LA749 ; read a byte + sta ,x ; save in buffer + cmpa ,x+ ; make sure it wrote + bne LA744 ; brif error if it didn't match + adda CCKSUM ; accumulate checksum + sta CCKSUM + dec CSRERR ; read all bytes? + bne LA72B ; brif not +LA73B bsr LA749 ; read checksum from tape + suba CCKSUM ; does it match? + beq LA746 ; brif so + lda #1 ; checksum error flag + skip2 +LA744 lda #2 ; non-RAM error flag +LA746 sta CSRERR ; save error status + rts +LA749 lda #8 ; read 8 bits + sta CPULWD ; initialize counter +LA74D bsr LA755 ; read a bit + rora ; put it into accumulator + dec CPULWD ; got all 8 bits? + bne LA74D ; brif not + rts +LA755 bsr LA75D ; get time between transitions + ldb CPERTM ; get timer + decb + cmpb CMPMID ; set C if timer is below the transition point - high or 1; clear otherwise + rts +LA75D clr CPERTM ; reset timer + tst CBTPHA ; check which phase we synched on + bne LA773 ; brif HI-LO synch +LA763 bsr LA76C ; read input + bcs LA763 ; brif still high +LA767 bsr LA76C ; read input + bcc LA767 ; brif still low + rts +LA76C inc CPERTM ; bump timer + ldb PIA1 ; get input bit to C + rorb + rts +LA773 bsr LA76C ; read input + bcc LA773 ; brif still low +LA777 bsr LA76C ; read output + bcs LA777 ; brif still high + rts +; Start tape and look for sync bytes +CASON orcc #0x50 ; disable interrupts + bsr LA7CA ; turn on tape + clr CPULWD ; reset timer +LA782 bsr LA763 ; wait for low-high transition +LA784 bsr LA7AD ; wait for it to go low again + bhi LA797 ; brif in range for 1200 Hz +LA788 bsr LA7A7 ; wait for it to go high again + blo LA79B ; brif in range for 2400 Hz + dec CPULWD ; decrement counter (synched on low-high) + lda CPULWD ; get counter + cmpa #-96 ; have we seen 96 1-0-1-0 patterns (48 0x55s)? +LA792 bne LA782 ; brif not - wait some more + sta CBTPHA ; save phase we synched on + rts +LA797 bsr LA7A7 ; wait for it to go high again + bhi LA784 ; brif another 1200 Hz, 2 in a row, try again +LA79B bsr LA7AD ; wait for it to go low again + blo LA788 ; brif another 2400 Hz; go try again for high + inc CPULWD ; bump counter + lda CPULWD ; get counter + suba #96 ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa) + bra LA792 ; set phase and return or keep waiting +LA7A7 clr CPERTM ; reset period timer + bsr LA767 ; wait for high + bra LA7B1 ; set flags on result +LA7AD clr CPERTM ; reset period timer + bsr LA777 ; wait for low +LA7B1 ldb CPERTM ; get period count + cmpb CMP0 ; is it too long for 1200Hz? + bhi LA7BA ; brif so - reset counts + cmpb CMP1 ; set C if 2400Hz, clear C if 1200 Hz + rts +LA7BA clr CPULWD ; reset sync counter (too slow or drop out) + rts +; MOTOR command +MOTOR tfr a,b ; save ON/OFF + jsr GETNCH ; eat the ON/OFF token + cmpb #0xaa ; OFF? + beq LA7E9 ; brif so - turn off tape + cmpb #0x88 ; ON? + jsr LA5C9 ; SN error if no match +; Turn on tape +LA7CA lda PIA1+1 ; get motor control value + ora #8 ; turn on bit 3 (starts motor) + bsr LA7F0 ; put it back (dumb but it saves a byte) +LA7D1 ldx ZERO ; maximum delay timer +LA7D3 leax -1,x ; count down + bne LA7D3 ; brif not at 0 yet + rts +; Write a synch leader to tape +WRLDR orcc #0x50 ; disable interrupts + bsr LA7CA ; turn on tape + ldx SYNCLN ; get count of 0x55s to write +LA7DE bsr LA828 ; write a 0x55 + leax -1,x ; done? + bne LA7DE ; brif not + rts +; Write sync bytes and a block, then stop tape +LA7E5 bsr WRLDR ; write sync +LA7E7 bsr SNDBLK ; write block +; Turn off tape +LA7E9 andcc #0xaf ; enable interrupts + lda PIA1+1 ; get control register + anda #0xf7 ; disable motor bit +LA7F0 sta PIA1+1 ; set motor enable bit + rts +; Write a block to tape. +SNDBLK orcc #0x50 ; disable interrupts + ldb BLKLEN ; get block size + stb CSRERR ; initialize character counter + lda BLKLEN ; initialize checksum + beq LA805 ; brif empty block + ldx CBUFAD ; point to tape buffer +LA800 adda ,x+ ; accumulate checksum + decb ; end of block data? + bne LA800 ; brif not +LA805 adda BLKTYP ; accumulate block type into checksum + sta CCKSUM ; save calculated checksum + ldx CBUFAD ; point to buffer + bsr LA828 ; send a 0x55 + lda #0x3c ; and then a 0x3c + bsr LA82A + lda BLKTYP ; send block type + bsr LA82A + lda BLKLEN ; send block size + bsr LA82A + tsta ; empty block? + beq LA824 ; brif so +LA81C lda ,x+ ; send character from block data + bsr LA82A + dec CSRERR ; are we done yet? + bne LA81C ; brif not +LA824 lda CCKSUM ; send checksum + bsr LA82A +LA828 lda #0x55 ; send a 0x55 +LA82A pshs a ; save output byte + ldb #1 ; initialize bit probe +LA82E lda CLSTSN ; get ending value of last cycle + sta PIA1 ; set DA + ldy #LA85C ; point to sine wave table + bitb ,s ; is bit set? + bne LA848 ; brif so - do high frequency +LA83B lda ,y+ ; get next sample (use all for low frequency) + cmpy #LA85C+36 ; end of table? + beq LA855 ; brif so + sta PIA1 ; set output sample + bra LA83B ; do another sample +LA848 lda ,y++ ; get next sample (use every other for high frequency) + cmpy #LA85C+36 ; end of table? + beq LA855 ; brif so + sta PIA1 ; send output sample + bra LA848 ; do another sample +LA855 sta CLSTSN ; save last sample that *would* have been sent + lslb ; shift mask to next bit + bcc LA82E ; brif not done all 8 bits + puls a,pc ; get back original character and return +; This is the sample table for the tape sine wave +LA85C fcb 0x82,0x92,0xaa,0xba,0xca,0xda + fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2 + fcb 0xea,0xda,0xca,0xba,0xaa,0x92 + fcb 0x7a,0x6a,0x52,0x42,0x32,0x22 + fcb 0x12,0x0a,0x02,0x02,0x02,0x0a + fcb 0x12,0x22,0x32,0x42,0x52,0x6a +; SET command +SET bsr LA8C1 ; get absolute screen position of graphics block + pshs x ; save character location + jsr LB738 ; evaluate comma then expression in B + puls x ; get back character pointer + cmpb #8 ; valid colour? + bhi LA8D5 ; brif not + decb ; normalize colours + bmi LA895 ; brif colour 0 (use current colour) + lda #0x10 ; 16 patterns per colour + mul + bra LA89D ; go save the colour +LA895 ldb ,x ; get current value + bpl LA89C ; brif not grahpic + andb #0x70 ; keep only the colour + skip1 +LA89C clrb ; reset block to all black +LA89D pshs b ; save colour + bsr LA90D ; force a ) + lda ,x ; get current screen value + bmi LA8A6 ; brif graphic block already + clra ; force all pixels off +LA8A6 anda #0x0f ; keep only pixel data + ora GRBLOK ; set the desired pixel + ora ,s+ ; merge with desired colour +LA8AC ora #0x80 ; force it to be a graphic block + sta ,x ; put new block on screen + rts +; RESET command +RESET bsr LA8C1 ; get address of desired block + bsr LA90D ; force a ) + clra ; zero block (no pixels) + ldb ,x ; is it graphics? + bpl LA8AC ; brif not - just blank the block + com GRBLOK ; invert pixel data + andb GRBLOK ; turn off the desired pixel + stb ,x ; put new pixel data on screen + rts +; Parse SET/RESET/POINT coordinates except for closing ) +LA8C1 jsr LB26A ; make sure it starts with ( +LA8C4 jsr RVEC21 ; do the RAM hook dance + jsr EVALEXPB ; get first coordinate + cmpb #63 ; valid horizontal coordinate + bhi LA8D5 ; brif out of range + pshs b ; save horizontal coordinate + jsr LB738 ; look for , followed by vertical coordinate + cmpb #31 ; in range for vertical? +LA8D5 bhi LA948 ; brif not + pshs b ; save vertical coordinate + lsrb ; divide by two (two blocks per row) + lda #32 ; 32 bytes per row + mul ; now we have the offset into video RAM + ldx #VIDRAM ; point to start of screen + leax d,x ; now X points to the correct character row + ldb 1,s ; get horizontal coordinate + lsrb ; divide by two (two per character cell) + abx ; now we're pointing to the correct character cell + puls a,b ; get back coordinates (vertical in A) + anda #1 ; keep only row offset of vertical + rorb ; get column offset of horizontal to C + rola ; now we have "row * 2 + col" in A + ldb #0x10 ; make a bit mask (one bit left of first pixel) +LA8EE lsrb ; move mask right + deca ; at the right pixel? + bpl LA8EE ; brif not + stb GRBLOK ; save graphics block mask + rts +; POINT function +POINT bsr LA8C4 ; evaluate coordinates + ldb #0xff ; default colour value is -1 (not graphics) + lda ,x ; get character + bpl LA90A ; brif not graphics + anda GRBLOK ; is desired pixel set? + beq LA909 ; brif not - return 0 for "black" + ldb ,x ; get graphics data + lsrb ; shift right 4 to get colour in low bits + lsrb + lsrb + lsrb + andb #7 ; lose the graphics block bias +LA909 incb ; shift colours into 1 to 8 range +LA90A jsr LA5E8 ; convert B to floating point +LA90D jmp LB267 ; make sure we have a ) and return +; CLS command +CLS jsr RVEC22 ; do the RAM hook dance +LA913 beq LA928 ; brif no colour - just do a basic screen clear + jsr EVALEXPB ; evaluate colour number + cmpb #8 ; valid colour? + bhi LA937 ; brif not - do the easter egg + tstb ; color 0? + beq LA925 ; brif so + decb ; normalize to 0 based colour numbers + lda #0x10 ; 16 blocks per colour + mul ; now we have the base code for that colour + orb #0x0f ; set all pixels +LA925 orb #0x80 ; make it a graphics block + skip2 +LA928 ldb #0x60 ; VDG screen space character + ldx #VIDRAM ; point to start of screen +LA92D stx CURPOS ; set cursor position +LA92F stb ,x+ ; blank a character + cmpx #VIDRAM+511 ; end of screen? + bls LA92F ; brif not + rts +LA937 bsr LA928 ; clear te screen + ldx #LA166-1 ; point to the easter egg + jmp STRINOUT ; go display it +; Evaluate an expression to B, prefixed by a comma, and do FC error if 0 +LA93F jsr SYNCOMMA ; force a comma +LA942 jsr EVALEXPB ; evaluate expression to B + tstb ; is it 0? + bne LA984 ; brif not - return +LA948 jmp LB44A ; raise FC error +; SOUND command +SOUND bsr LA942 ; evaluate frequency + stb SNDTON ; save it + bsr LA93F ; evaluate duration (after a comma) +LA951 lda #4 ; constant factor for duration (each increment is 1/15 of a second) + mul + std SNDDUR ; save length of sound (IRQ will count it down) + lda PIA0+3 ; enable 60 Hz interrupt + ora #1 + sta PIA0+3 + clr ARYDIS ; clear array disable flag for some reason + bsr LA9A2 ; connect DAC to MUX output + bsr LA976 ; turn on sound +LA964 bsr LA985 ; store mid range output value and delay + lda #0xfe ; store high value and delay + bsr LA987 + bsr LA985 ; store mid range value and delay + lda #2 ; store low value and delay + bsr LA987 + ldx SNDDUR ; has timer expired? + bne LA964 ; brif not, do another wave +; Disable sound output +LA974 clra ; bit 3 to 0 will disable output + skip2 +; Enable sound output +LA976 lda #8 ; bit 3 set to enable output + sta ,-s ; save desired value + lda PIA1+3 ; get control register value + anda #0xf7 ; reset value + ora ,s+ ; set to desired value + sta PIA1+3 ; set new sound output status +LA984 rts +LA985 lda #0x7e ; mid range value for DAC +LA987 sta PIA1 ; set DAC output value + lda SNDTON ; get frequency +LA98C inca ; increment it (gives shorter count with higher values, so higher frequencies work) + bne LA98C ; brif not done yet + rts +; AUDIO command +AUDIO tfr a,b ; save ON/OFF token + jsr GETNCH ; munch the ON/OFF token + cmpb #0xaa ; OFF? + beq LA974 ; brif so + subb #0x88 ; ON? + jsr LA5C9 ; do SN error if not + incb ; now B is 1 - cassette sound source + bsr LA9A2 ; set MUX input to tape + bra LA976 ; enable sound +; Set MUX source to value in B +LA9A2 ldu #PIA0+1 ; point to PIA0 control register A + bsr LA9A7 ; program bit 0 then fall through for bit 1 +LA9A7 lda ,u ; get control register value + anda #0xf7 ; reset mux control bit + asrb ; shift desired value to C + bcc LA9B0 ; brif this bit is clear + ora #8 ; set the bit +LA9B0 sta ,u++ ; set register value and move to next register + rts +; IRQ service routine +BIRQSV lda PIA0+3 ; check for VSYNC interrupt + bpl LA9C5 ; brif not - return. BUG: should clear HSYNC interrupt status first + lda PIA0+2 ; clear VSYNC interrupt status +LA9BB ldx >SNDDUR ; are we counting down for SOUND? (force extended in case DP is modified) + beq LA9C5 ; brif not + leax -1,x ; count down one tick + stx >SNDDUR ; save new count (forced extended in case DP is modified) +LA9C5 rti +; JOYSTK function +JOYSTK jsr LB70E ; evaluate which joystick axis is desired + cmpb #3 ; valid axis? + lbhi LB44A ; brif not + tstb ; want axis 0? + bne LA9D4 ; brif not + bsr GETJOY ; read axis data if axis 0 +LA9D4 ldx #POTVAL ; point to axis values + ldb FPA0+3 ; get desired axis + ldb b,x ; get axis value + jmp LB4F3 ; return value +; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches +; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed, +; this routine will do the read *ten times* before just returning the last value. This is assininely +; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note +; also that this routine should be using PSHS and PULS but it doesn't. +GETJOY bsr LA974 ; turn off sound + ldx #POTVAL+4 ; point to the end of the axis data (we'll work backwards) + ldb #3 ; start with axis 3 +LA9E5 lda #10 ; 10 tries to see if we match *the last call* to this routine + std ,--s ; save retry counter and axis number + bsr LA9A2 ; set MUX for the correct axis +LA9EB ldd #0x4080 ; set initial trial value to mid range and the next difference to add/subtract to half +LA9EE sta ,-s ; store the add/subtract value + orb #2 ; keep rs232 output marking + stb PIA1 ; set DAC output to the trial value + eorb #2 ; remove RS232 output value + lda PIA0 ; read the comparator + bmi LA9FF ; brif comparator output is high (DAC is lower than the axis value) + subb ,s ; subtract next bit value (split the difference toward 0) + skip2 +LA9FF addb ,s ; add next bit value (split the different toward infinity) + lda ,s+ ; get bit value back + lsra ; cut in half + cmpa #1 ; have we done that last value for the DAC? + bne LA9EE ; brif not + lsrb ; normalize the axis value + lsrb + cmpb -1,x ; does it match the read from the last call to this routine? + beq LAA12 ; brif so + dec ,s ; are we out of retries? + bne LA9EB ; brif not - try again +LAA12 stb ,-x ; save new value and move pointer back + ldd ,s++ ; get axis counter and clean up retry counter + decb ; move to next axis + bpl LA9E5 ; brif still more axes to do + rts +; This is the "bottom half" of the character fetching routines. +BROMHK cmpa #'9+1 ; is it >= colon? + bhs LAA28 ; brif so Z set if colon, C clear. + cmpa #0x20 ; space? + bne LAA24 ; brif not + jmp GETNCH ; move on to another character if space +LAA24 suba #'0 ; normalize ascii digit to 0-9; we already handled above digit 9 + suba #-'0 ; this will cause a carry for any value that was already positive +LAA28 rts +; Jump table for functions +LAA29 fdb SGN ; SGN 0x80 + fdb INT ; INT 0x81 + fdb ABS ; ABS 0x82 + fdb USRJMP ; USR 0x83 + fdb RND ; RND 0x84 + fdb SIN ; SIN 0x85 + fdb PEEK ; PEEK 0x86 + fdb LEN ; LEN 0x87 + fdb STR ; STR$ 0x88 + fdb VAL ; VAL 0x89 + fdb ASC ; ASC 0x8a + fdb CHR ; CHR$ 0x8b + fdb EOF ; EOF 0x8c + fdb JOYSTK ; JOYSTK 0x8d + fdb LEFT ; LEFT$ 0x8e + fdb RIGHT ; RIGHT$ 0x8f + fdb MID ; MID$ 0x90 + fdb POINT ; POINT 0x91 + fdb INKEY ; INKEY$ 0x92 + fdb MEM ; MEM 0x93 +; Operator precedence and jump table (binary ops except relational) +LAA51 fcb 0x79 ; + + fdb LB9C5 + fcb 0x79 ; - + fdb LB9BC + fcb 0x7b ; * + fdb LBACC + fcb 0x7b ; / + fdb LBB91 + fcb 0x7f ; ^ (exponentiation) + fdb EXPJMP + fcb 0x50 ; AND + fdb LB2D5 + fcb 0x46 ; OR + fdb LB2D4 +; Reserved words table for commands +LAA66 fcs 'FOR' ; 0x80 + fcs 'GO' ; 0x81 + fcs 'REM' ; 0x82 + fcs "'" ; 0x83 + fcs 'ELSE' ; 0x84 + fcs 'IF' ; 0x85 + fcs 'DATA' ; 0x86 + fcs 'PRINT' ; 0x87 + fcs 'ON' ; 0x88 + fcs 'INPUT' ; 0x89 + fcs 'END' ; 0x8a + fcs 'NEXT' ; 0x8b + fcs 'DIM' ; 0x8c + fcs 'READ' ; 0x8d + fcs 'RUN' ; 0x8e + fcs 'RESTORE' ; 0x8f + fcs 'RETURN' ; 0x90 + fcs 'STOP' ; 0x91 + fcs 'POKE' ; 0x92 + fcs 'CONT' ; 0x93 + fcs 'LIST' ; 0x94 + fcs 'CLEAR' ; 0x95 + fcs 'NEW' ; 0x96 + fcs 'CLOAD' ; 0x97 + fcs 'CSAVE' ; 0x98 + fcs 'OPEN' ; 0x99 + fcs 'CLOSE' ; 0x9a + fcs 'LLIST' ; 0x9b + fcs 'SET' ; 0x9c + fcs 'RESET' ; 0x9d + fcs 'CLS' ; 0x9e + fcs 'MOTOR' ; 0x9f + fcs 'SOUND' ; 0xa0 + fcs 'AUDIO' ; 0xa1 + fcs 'EXEC' ; 0xa2 + fcs 'SKIPF' ; 0xa3 + fcs 'TAB(' ; 0xa4 + fcs 'TO' ; 0xa5 + fcs 'SUB' ; 0xa6 + fcs 'THEN' ; 0xa7 + fcs 'NOT' ; 0xa8 + fcs 'STEP' ; 0xa9 + fcs 'OFF' ; 0xaa + fcs '+' ; 0xab + fcs '-' ; 0xac + fcs '*' ; 0xad + fcs '/' ; 0xae + fcs '^' ; 0xaf + fcs 'AND' ; 0xb0 + fcs 'OR' ; 0xb1 + fcs '>' ; 0xb2 + fcs '=' ; 0xb3 + fcs '<' ; 0xb4 +; Reserved word list for functions +LAB1A fcs 'SGN' ; 0x80 + fcs 'INT' ; 0x81 + fcs 'ABS' ; 0x82 + fcs 'USR' ; 0x83 + fcs 'RND' ; 0x84 + fcs 'SIN' ; 0x85 + fcs 'PEEK' ; 0x86 + fcs 'LEN' ; 0x87 + fcs 'STR$' ; 0x88 + fcs 'VAL' ; 0x89 + fcs 'ASC' ; 0x8a + fcs 'CHR$' ; 0x8b + fcs 'EOF' ; 0x8c + fcs 'JOYSTK' ; 0x8d + fcs 'LEFT$' ; 0x8e + fcs 'RIGHT$' ; 0x8f + fcs 'MID$' ; 0x90 + fcs 'POINT' ; 0x91 + fcs 'INKEY$' ; 0x92 + fcs 'MEM' ; 0x93 +; Jump table for commands +LAB67 fdb FOR ; 0x80 FOR + fdb GO ; 0x81 GO + fdb REM ; 0x82 REM + fdb REM ; 0x83 ' + fdb REM ; 0x84 ELSE + fdb IFTOK ; 0x85 IF + fdb DATA ; 0x86 DATA + fdb PRINT ; 0x87 PRINT + fdb ON ; 0x88 ON + fdb INPUT ; 0x89 INPUT + fdb ENDTOK ; 0x8a END + fdb NEXT ; 0x8b NEXT + fdb DIM ; 0x8c DIM + fdb READ ; 0x8d READ + fdb RUN ; 0x8e RUN + fdb RESTOR ; 0x8f RESTORE + fdb RETURN ; 0x90 RETURN + fdb STOP ; 0x91 STOP + fdb POKE ; 0x92 POKE + fdb CONT ; 0x93 CONT + fdb LIST ; 0x94 LIST + fdb CLEAR ; 0x95 CLEAR + fdb NEW ; 0x96 NEW + fdb CLOAD ; 0x97 CLOAD + fdb CSAVE ; 0x98 CSAVE + fdb OPEN ; 0x99 OPEN + fdb CLOSE ; 0x9a CLOSE + fdb LLIST ; 0x9b LLIST + fdb SET ; 0x9c SET + fdb RESET ; 0x9d RESET + fdb CLS ; 0x9e CLS + fdb MOTOR ; 0x9f MOTOR + fdb SOUND ; 0xa0 SOUND + fdb AUDIO ; 0xa1 AUDIO + fdb EXEC ; 0xa2 EXEC + fdb SKIPF ; 0xa3 SKIPF +; Error message table +LABAF fcc 'NF' ; 0 NEXT without FOR + fcc 'SN' ; 1 Syntax error + fcc 'RG' ; 2 RETURN without GOSUB + fcc 'OD' ; 3 Out of data + fcc 'FC' ; 4 Illegal function call + fcc 'OV' ; 5 Overflow + fcc 'OM' ; 6 Out of memory + fcc 'UL' ; 7 Undefined line number + fcc 'BS' ; 8 Bad subscript + fcc 'DD' ; 9 Redimensioned array + fcc '/0' ; 10 Division by 0 + fcc 'ID' ; 11 Illegal direct statement + fcc 'TM' ; 12 Type mismatch + fcc 'OS' ; 13 Out of string space + fcc 'LS' ; 14 String too long + fcc 'ST' ; 15 String formula too complex + fcc 'CN' ; 16 Can't continue + fcc 'FD' ; 17 Bad file data + fcc 'AO' ; 18 File already open + fcc 'DN' ; 19 Device number error + fcc 'IO' ; 20 Input/output error + fcc 'FM' ; 21 Bad file mode + fcc 'NO' ; 22 File not open + fcc 'IE' ; 23 Input past end of file + fcc 'DS' ; 24 Direct statement in file +LABE1 fcn ' ERROR' +LABE8 fcn ' IN ' +LABED fcb 0x0d +LABEE fcc 'OK' + fcb 0x0d,0x00 +LABF2 fcb 0x0d + fcn 'BREAK' +; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT +; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL +; for the first match. +; +; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the +; 6809's registers. This requires some minor tweaks where the routine is called. Further, the +; use of B is completely pointless and, even if B is going to be used, why is it reloaded on +; every loop? +LABF9 leax 4,s ; skip past our caller and the main command loop return address +LABFB ldb #18 ; each FOR/NEXT frame is 18 bytes + stx TEMPTR ; save current search pointer + lda ,x ; get first byte of this frame + suba #0x80 ; set to 0 if FOR/NEXT + bne LAC1A ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame) + ldx 1,x ; get index variable descriptor + stx TMPTR1 ; save it + ldx VARDES ; get desired index descriptor + beq LAC16 ; brif NULL - we found something + cmpx TMPTR1 ; does this one match? + beq LAC1A ; brif so + ldx TEMPTR ; get back frame pointer + abx ; move to next entry + bra LABFB ; check next block of data +LAC16 ldx TMPTR1 ; get index variable of this frame + stx VARDES ; set it as the one found +LAC1A ldx TEMPTR ; get matching frame pointer + tsta ; set Z if FOR/NEXT + rts +; This is a block copy routine which copies from top to bottom. It's not clear that the use of +; this routine actually saves any ROM space compared to just implementing the copies directly +; once all the marshalling to set up the parameter variables is taken into account. +LAC1E bsr LAC37 ; check to see if stack collides with D +LAC20 ldu V41 ; point to destination + leau 1,u ; offset for pre-dec + ldx V43 ; point to source + leax 1,x ; offset for pre-dec +LAC28 lda ,-x ; get source byte + pshu a ; store at destination (sta ,-u would be less weird) + cmpx V47 ; at the bottom of the copy? + bne LAC28 ; brif not + stu V45 ; save final destination address +LAC32 rts +; Check for 2*B (0 <= B <= 127) bytes for free memory +LAC33 clra ; zero extend + aslb ; times 2 (loses bit 7 of B) + addd ARYEND ; add to top of used memory +LAC37 addd #STKBUF ; add a fudge factor for interpreter operation + bcs LAC44 ; brif >65535! + sts BOTSTK ; get current stack pointer + cmpd BOTSTK ; is our new address above that? + blo LAC32 ; brif not - no error +LAC44 ldb #6*2 ; raise OM error +; The error servicing routine +LAC46 jsr RVEC16 ; do the RAM hook dance (ON ERROR reserved hook) +LAC49 jsr RVEC17 ; do the RAM hook dance again + jsr LA7E9 ; turn off tape + jsr LA974 ; disable sound + jsr LAD33 ; reset stack, etc. + clr DEVNUM ; reset output to screen + jsr LB95C ; do a newline + jsr LB9AF ; send a ? + ldx #LABAF ; point to error table +LAC60 abx ; offset to correct message + bsr LACA0 ; send a char from X + bsr LACA0 ; send another char from X +LAC65 ldx #LABE1-1 ; point to "ERROR" message +LAC68 jsr STRINOUT ; print ERROR message (or BREAK) + lda CURLIN ; are we in immediate mode? + inca + beq LAC73 ; brif not - go to immediate mode + jsr LBDC5 ; print "IN ****" +; This is the immediate mode loop +LAC73 jsr LB95C ; do a newline if needed +LAC76 ldx #LABEE-1 ; point to prompt (without leading CR) + jsr STRINOUT ; show prompt +LAC7C jsr LA390 ; read an input line + ldu #0xffff ; flag immediate mode + stu CURLIN + bcs LAC7C ; brif we ended on BREAK - just go for another line + tst CINBFL ; EOF? + lbne LA4BF ; brif so + stx CHARAD ; save start of input line as input pointer + jsr GETNCH ; get character from input line + beq LAC7C ; brif no input + bcs LACA5 ; brif numeric - adding or removing a line number + ldb #2*24 ; code for "direct statement in file" + tst DEVNUM ; keyboard input? + bne LAC46 ; brif not - complain about direct statement + jsr LB821 ; go tokenize the input line +LAC9D jmp LADC0 ; go execute the newly tokenized line +LACA0 lda ,x+ ; get character and advance pointer + jmp LB9B1 ; output it +LACA5 jsr LAF67 ; convert line number to binary +LACA8 ldx BINVAL ; get converted number + stx LINHDR ; put it before the line we just read + jsr LB821 ; tokenize the input line + stb TMPLOC ; save line length + bsr LAD01 ; find where the line should be in the program + bcs LACC8 ; brif the line number isn't already present + ldd V47 ; get address where the line is in the program + subd ,x ; get the difference between here and the end of the line (negative) + addd VARTAB ; subtract line length from the end of the program + std VARTAB ; save new end of program address + ldu ,x ; get start of next line +LACC0 pulu a ; get source byte (lda ,u+ would be less weird) + sta ,x+ ; move it down + cmpx VARTAB ; have we moved everything yet? + bne LACC0 ; brif not +LACC8 lda LINBUF ; see if there is actually a line to input + beq LACE9 ; brif not - we just needed to remove the line + ldd VARTAB ; get current end of program + std V43 ; set as source pointer + addb TMPLOC ; add in the length of the new line + adca #0 + std V41 ; save destination pointer + jsr LAC1E ; make sure there's enough room and then make a hole for the new line + ldu #LINHDR-2 ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer) +LACDD pulu a ; get byte from new line (lda ,u+ would be less weird) + sta ,x+ ; stow it + cmpx V45 ; at the end of the hole we just made? + bne LACDD ; brif not + ldx V41 ; get save new top of program address + stx VARTAB +LACE9 bsr LAD21 ; reset variables, etc. + bsr LACEF ; adjust next line pointers + bra LAC7C ; go read another input line +; Recompute next line pointers +LACEF ldx TXTTAB ; point to start of program +LACF1 ldd ,x ; get address of next line + beq LAD16 ; brif end of program + leau 4,x ; move past pointer and line number +LACF7 lda ,u+ ; are we at the end of the line? + bne LACF7 ; brif not + stu ,x ; save new next line pointer + ldx ,x ; point to next line + bra LACF1 ; process the next line +; Find a line in the program +LAD01 ldd BINVAL ; get desired line number + ldx TXTTAB ; point to start of program +LAD05 ldu ,x ; get address of next line + beq LAD12 ; brif end of program + cmpd 2,x ; do we have a match? + bls LAD14 ; brif our search number is <= the number here + ldx ,x ; move to next line + bra LAD05 ; check another line +LAD12 orcc #1 ; set C for not found +LAD14 stx V47 ; save address of matching line *or* line just after where it would have been +LAD16 rts +; NEW command +; This routine has multiple entry points used for various "levels" of NEW +NEW bne LAD14 ; brif there was input given; should be LAD16! +LAD19 ldx TXTTAB ; point to start of program + clr ,x+ ; blank out program (with NULL next line pointer) + clr ,x+ + stx VARTAB ; save end of program +LAD21 ldx TXTTAB ; get start of program + jsr LAEBB ; put input pointer there +LAD26 ldx MEMSIZ ; reset string space + stx STRTAB + jsr RESTOR ; reset DATA pointer + ldx VARTAB ; clear out scalars and arrays + stx ARYTAB + stx ARYEND +LAD33 ldx #STRSTK ; reset the string stack + stx TEMPPT + ldx ,s ; get return address (we're going to reset the stack) + lds FRETOP ; reset the stack to top of memory + clr ,-s ; put stopper so FOR/NEXT search will actually stop here +LAD3F clr OLDPTR ; reset "CONT" state + clr OLDPTR+1 +LAD43 clr ARYDIS ; un-disable arrays + jmp ,x ; return to original caller +; FOR command +FOR lda #0x80 ; disable array parsing + sta ARYDIS + jsr LET ; assign start value to index + jsr LABF9 ; search stack for matching FOR/NEXT frame + leas 2,s ; lose return address + bne LAD59 ; brif variable not already being used + ldx TEMPTR ; get address of matched data + leas b,x ; move stack pointer to the end of it (B is set to 18 in the stack search) +LAD59 ldb #9 ; is there room for 18 bytes in memory? + jsr LAC33 + jsr LAEE8 ; get address of the end of this statement in X + ldd CURLIN ; get line number + pshs x,b,a ; save next line address and current line number + ldb #0xa5 ; make sure we have TO + jsr LB26F + jsr LB143 ; make sure we have a numeric index + jsr LB141 ; evaluate terminal condition value + ldb FP0SGN ; pack FPA0 in place + orb #0x7f + andb FPA0 + stb FPA0 + ldy #LAD7F ; where to come back to + jmp LB1EA ; stash terminal condition on the stack +LAD7F ldx #LBAC5 ; point to FP 1.0 (default step) + jsr LBC14 ; unpack it to FPA0 + jsr GETCCH ; get character after the terminal + cmpa #0xa9 ; is it STEP? + bne LAD90 ; brif not + jsr GETNCH ; eat STEP + jsr LB141 ; evaluate step condition +LAD90 jsr LBC6D ; get "status" of FPA0 + jsr LB1E6 ; stash FPA0 on the stack (for step value) + ldd VARDES ; get variable descriptor pointer + pshs d ; put that on the stack too + lda #0x80 ; flag the frame as a FOR/NEXT frame + pshs a +; Main command interpretation loop +LAD9E jsr RVEC20 ; do the RAM hook dance + andcc #0xaf ; make sure interrupts are running + bsr LADEB ; check for BREAK/pause + ldx CHARAD ; get input pointer + stx TINPTR ; save input pointer for start of line + lda ,x+ ; get current input character + beq LADB4 ; brif end of line - move to another line + cmpa #': ; end of statement? + beq LADC0 ; brif so - keep processing +LADB1 jmp LB277 ; raise a syntax error +LADB4 lda ,x++ ; get MSB of next line pointer and skip past pointer + sta ENDFLG + beq LAE15 ; brif MSB of next line address is 0 (do END) + ldd ,x+ ; get line number but only advance one + std CURLIN ; set current line number + stx CHARAD ; set input pointer to one before line text +LADC0 jsr GETNCH ; move past statement separator or to first character in line + bsr LADC6 ; process a command +LADC4 bra LAD9E ; handle next statement or line +LADC6 beq LAE40 ; return if end of statement + tsta ; is it a token? + lbpl LET ; brif not - do a LET + cmpa #0xa3 ; above SKIPF? + bhi LADDC ; brif so + ldx COMVEC+3 ; point to jump table +LADD4 lsla ; two bytes per entry (loses the token bias) + tfr a,b ; put it in B for unsigned ABX + abx + jsr GETNCH ; move past token + jmp [,x] ; transfer control to the handler (which will return to the main loop) +LADDC cmpa #0xb4 ; is it a non-executable token? + bls LADB1 ; brif so + jmp [COMVEC+13] ; transfer control to ECB command handler +; RESTORE command +RESTOR ldx TXTTAB ; point to beginning of the program + leax -1,x ; move back one (to compensate for "GETNCH") +LADE8 stx DATPTR ; save as new data pointer + rts +; BREAK check +LADEB jsr LA1C1 ; read keyboard + beq LADFA ; brif no key down +LADF0 cmpa #3 ; BREAK? + beq STOP ; brif so - do a STOP +LADF4 cmpa #0x13 ; pause (SHIFT-@)? + beq LADFB ; brif so + sta IKEYIM ; cache key for later INKEY$ so break check doesn't break INKEY$ +LADFA rts +LADFB jsr KEYIN ; read keyboard + beq LADFB ; brif no key down + bra LADF0 ; process pressed key in case BREAK or SHIFT-@ again +; END command +ENDTOK jsr LA426 ; close files + jsr GETCCH ; re-get input character + bra LAE0B +; STOP command +STOP orcc #1 ; flag "STOP" +LAE0B bne LAE40 ; brif not end of statement + ldx CHARAD ; save current input pointer + stx TINPTR +LAE11 ror ENDFLG ; save END/STOP flag (C) + leas 2,s ; lose return address +LAE15 ldx CURLIN ; get current input line (end of program comes here) + cmpx #0xffff ; immediate mode? + beq LAE22 ; brif so + stx OLDTXT ; save line where we stopped executing + ldx TINPTR ; get input pointer + stx OLDPTR ; save location where we stopped executing +LAE22 clr DEVNUM ; reset to screen/keyboard + ldx #LABF2-1 ; point to BREAK message + tst ENDFLG ; are we doing "BREAK"? + lbpl LAC73 ; brif not + jmp LAC68 ; go do the BREAK message and return to main loop +; CONT command +CONT bne LAE40 ; brif not end of statement + ldb #2*16 ; code for can't continue + ldx OLDPTR ; get saved execution pointer + lbeq LAC46 ; brif no saved pointer - raise CN error + stx CHARAD ; reset input pointer + ldx OLDTXT ; reset current line number + stx CURLIN +LAE40 rts +; CLEAR command +CLEAR beq LAE6F ; brif no argument + jsr LB3E6 ; evaluate string space size + pshs d ; save it + ldx MEMSIZ ; get memory size (top of memory) + jsr GETCCH ; is there anything after the string space size? + beq LAE5A ; brif not + jsr SYNCOMMA ; force a comma + jsr LB73D ; get top of memory value in X + leax -1,x ; move back one (top of cleared space) + cmpx TOPRAM ; is it within the memory available? + bhi LAE72 ; brif higher than top of memory - OM error +LAE5A tfr x,d ; so we can do math for checking memory usage + subd ,s++ ; subtract out string space value + bcs LAE72 ; brif less than 0 + tfr d,u ; U is bottom of cleared space + subd #STKBUF ; also account for slop space + bcs LAE72 ; brif less than 0 + subd VARTAB ; is there still room for the program? + blo LAE72 ; brif not + stu FRETOP ; set top of free memory + stx MEMSIZ ; set size of usable memory +LAE6F jmp LAD26 ; erase variables, etc. +LAE72 jmp LAC44 ; raise OM error +; RUN command +RUN jsr RVEC18 ; do the RAM hook dance + jsr LA426 ; close any open files + jsr GETCCH ; is there a line number + lbeq LAD21 ; brif no line number - start from beginning + jsr LAD26 ; clear variables, etc. + bra LAE9F ; "GOTO" the line number +; GO command (GOTO and GOSUB) +GO tfr a,b ; save TO/SUB +LAE88 jsr GETNCH ; eat the TO/SUB token + cmpb #0xa5 ; TO? + beq LAEA4 ; brif GOTO + cmpb #0xa6 ; SUB? + bne LAED7 ; brif not + ldb #3 ; room for 6 bytes? + jsr LAC33 + ldu CHARAD ; get input pointer + ldx CURLIN ; get line number + lda #0xa6 ; flag for GOSUB frame + pshs u,x,a ; set stack frame +LAE9F bsr LAEA4 ; do "GOTO" + jmp LAD9E ; go back to main loop +; Actual GOTO is here +LAEA4 jsr GETCCH ; get current input + jsr LAF67 ; convert number to binary + bsr LAEEB ; move input pointer to end of statement + leax 1,x ; point to start of next line + ldd BINVAL ; get desired line number + cmpd CURLIN ; is it beyond here? + bhi LAEB6 ; brif so + ldx TXTTAB ; start search at beginning of program +LAEB6 jsr LAD05 ; find line number + bcs LAED2 ; brif not found +LAEBB leax -1,x ; move to just before start of line + stx CHARAD ; reset input pointer +LAEBF rts +; RETURN command +RETURN bne LAEBF ; exit if argument given + lda #0xff ; set VARDES to an illegal value so we ignore FOR frames + sta VARDES + jsr LABF9 ; look for a GOSUB frame + tfr x,s ; reset stack + cmpa #0xa6-0x80 ; is it a GOSUB frame? + beq LAEDA ; brif so + ldb #2*2 ; code for RETURN without GOSUB + skip2 +LAED2 ldb #7*2 ; code for undefined line number + jmp LAC46 ; raise error +LAED7 jmp LB277 ; raise syntax error +LAEDA puls a,x,u ; get back saved line number and input pointer + stx CURLIN ; reset line number + stu CHARAD ; reset input pointer +; DATA command +DATA bsr LAEE8 ; move input pointer to end of statement + skip2 +; REM command (also ELSE) +REM bsr LAEEB ; move input pointer to end of line + stx CHARAD ; save new input pointer +LAEE7 rts +; Return end of statement (LAEE8) or line (AEEB) in X +LAEE8 ldb #': ; colon is statement terminator + skip1lda +LAEEB clrb ; make main terminator NUL + stb CHARAC ; save terminator + clrb ; end of line - always terminates + ldx CHARAD ; get input pointer +LAEF1 tfr b,a ; save secondary terminator + ldb CHARAC ; get main terminator + sta CHARAC ; save secondary +LAEF7 lda ,x ; get input character + beq LAEE7 ; brif end of line + pshs b ; save terminator + cmpa ,s+ ; does it match? + beq LAEE7 ; brif so - bail + leax 1,x ; move pointer ahead + cmpa #'" ; start of string? + beq LAEF1 ; brif so + inca ; functon token? + bne LAF0C ; brif not + leax 1,x ; skip second part of function token +LAF0C cmpa #0x85+1 ; IF? + bne LAEF7 ; brif not + inc IFCTR ; bump "IF" count + bra LAEF7 ; get check another input character +; IF command +IFTOK jsr LB141 ; evaluate condition + jsr GETCCH ; find out what's after the conditin + cmpa #0x81 ; GO? + beq LAF22 ; treat same as THEN + ldb #0xa7 ; make sure we have a THEN + jsr LB26F +LAF22 lda FP0EXP ; get true/false (false is 0) + bne LAF39 ; brif condition true + clr IFCTR ; reset IF counter +LAF28 bsr DATA ; skip over statement + tsta ; end of line? + beq LAEE7 ; brif so + jsr GETNCH ; get start of this statement + cmpa #0x84 ; ELSE? + bne LAF28 ; brif not + dec IFCTR ; is it a matching ELSE? + bpl LAF28 ; brif not - keep looking + jsr GETNCH ; eat the ELSE +LAF39 jsr GETCCH ; get current input + lbcs LAEA4 ; brif numeric - to a GOTO + jmp LADC6 ; let main loop interpret the next command +; ON command +ON jsr EVALEXPB ; evaluate index expression +LAF45 ldb #0x81 ; make sure we have "GO" + jsr LB26F + pshs a ; save TO/SUB + cmpa #0xa6 ; SUB? + beq LAF54 ; brif so + cmpa #0xa5 ; TO? +LAF52 bne LAED7 ; brif not +LAF54 dec FPA0+3 ; are we at the right index? + bne LAF5D ; brif not + puls b ; get TO/SUB token + jmp LAE88 ; go do GOTO or GOSUB +LAF5D jsr GETNCH ; munch a character + bsr LAF67 ; parse line number + cmpa #', ; is there another line following? + beq LAF54 ; brif so - see if we're there yet + puls b,pc ; clean up TO/SUB token and return - we fell through +; Parse a line number +LAF67 ldx ZERO ; initialize line number accumulator to 0 + stx BINVAL +LAF6B bcc LAFCE ; brif not numeric + suba #'0 ; adjust to actual value of digit + sta CHARAC ; save digit + ldd BINVAL ; get accumulated number + cmpa #24 ; will this overflow? + bhi LAF52 ; brif so - raise syntax error + aslb ; times 2 + rola + aslb ; times 4 + rola + addd BINVAL ; times 5 + aslb ; times 10 + rola + addb CHARAC ; add in digit + adca #0 + std BINVAL ; save new accumulated number + jsr GETNCH ; fetch next character + bra LAF6B ; process next digit +; LET command (the LET keyword requires Extended Basic) +LET jsr LB357 ; evaluate destination variable + stx VARDES ; save descriptor pointer + ldb #0xb3 ; make sure we have = + jsr LB26F + lda VALTYP ; get destination variable type + pshs a ; save it for later + jsr LB156 ; evaluate the expression to assign + puls a ; get back original variable type + rora ; put type in C + jsr LB148 ; make sure the current result matches the type + lbeq LBC33 ; bri fnumeric - copy FPA0 to variable +LAFA4 ldx FPA0+2 ; point to descriptor of replacement string + ldd FRETOP ; get bottom of string space + cmpd 2,x ; is the string already in string space? + bhs LAFBE ; brif so + cmpx VARTAB ; is the descriptor in variable space? + blo LAFBE ; brif not +LAFB1 ldb ,x ; get length of string + jsr LB50D ; allocate space for this string + ldx V4D ; get descriptor pointer back + jsr LB643 ; copy string into string space + ldx #STRDES ; point to temporary string descriptor +LAFBE stx V4D ; save descriptor pointer + jsr LB675 ; remove string from string stack if appropriate + ldu V4D ; get back replacement descriptor + ldx VARDES ; get target descriptor + pulu a,b,y ; get string length (A) and data pointer (Y) + sta ,x ; save new length + sty 2,x ; save new pointer +LAFCE rts +; READ and INPUT commands. +LAFCF fcc '?REDO' ; The ?REDO message + fcb 0x0d,0x00 +LAFD6 ldb #2*17 ; bad file data code + tst DEVNUM ; are we reading from the keyboard? + beq LAFDF ; brif so +LAFDC jmp LAC46 ; raise the error +LAFDF lda INPFLG ; are we doing INPUT? + beq LAFEA ; brif so + ldx DATTXT ; get line number where the DATA statement happened + stx CURLIN ; set current line number to that so can report the correct location + jmp LB277 ; raise a syntax error on bad data +LAFEA ldx #LAFCF-1 ; show the ?REDO if we're doing INPUT + jsr STRINOUT + ldx TINPTR ;* reset input pointer to start of statement (this will cause the + stx CHARAD ;* INPUT statement to be re-executed + rts +INPUT ldb #11*2 ; code for illegal direct statement + ldx CURLIN ; are we in immediate mode? + leax 1,x + beq LAFDC ; brif so - raise ID error + bsr LB002 ; go do the INPUT thing + clr DEVNUM ; reset device to screen/keyboard + rts +LB002 cmpa #'# ; is there a device number? + bne LB00F ; brif not + jsr LA5A5 ; parse device number + jsr LA3ED ; make sure it's valid for input + jsr SYNCOMMA ; make sure we have a comma after the device number +LB00F cmpa #'" ; is there a prompt string? + bne LB01E ; brif not + jsr LB244 ; parse the prompt string + ldb #'; ; make sure we have a semicolon after the prompt + jsr LB26F + jsr LB99F ; print the prompt +LB01E ldx #LINBUF ; point to line input buffer + clr ,x ; NUL first byte to indicate no data + tst DEVNUM ; is it keyboard input? + bne LB049 ; brif not + bsr LB02F ; read a line from the keyboard + ldb #', ; put a comma at the start of the buffer + stb ,x + bra LB049 ; go process some input +LB02F jsr LB9AF ; send a ? + jsr LB9AC ; send a space +LB035 jsr LA390 ; read input from the keyboard + bcc LB03F ; brif not BREAK + leas 4,s ; clean up stack +LB03C jmp LAE11 ; go process BREAK +LB03F ldb #2*23 ; input past end of file error code + tst CINBFL ; was it EOF? + bne LAFDC ; brif so - raise the error + rts +READ ldx DATPTR ; fetch current DATA pointer + skip1lda ; set A to nonzero (for READ) +LB049 clra ; set A to zero (for INPUT) + sta INPFLG ; record whether we're doing READ or INPUT + stx DATTMP ; save current input location +LB04E jsr LB357 ; evaluate a variable (destination of data) + stx VARDES ; save descriptor + ldx CHARAD ; save interpreter input pointer + stx BINVAL + ldx DATTMP ; get data pointer + lda ,x ; is there anything to read? + bne LB069 ; brif so + lda INPFLG ; is it INPUT? + bne LB0B9 ; brif not + jsr RVEC10 ; do the RAM hook dance + jsr LB9AF ; send a ? (so subsequent lines get ??) + bsr LB02F ; go read an input line +LB069 stx CHARAD ; save data pointer + jsr GETNCH ; fetch next data character + ldb VALTYP ; do we want a number? + beq LB098 ; brif so + ldx CHARAD ; get input pointer + sta CHARAC ; save initial character as the delimiter + cmpa #'" ; do we have a string delimiter? + beq LB08B ; brif so - use " as both delimiters + leax -1,x ; back up input if we don't have a delimiter + clra ; set delimiter to NUL (end of line) + sta CHARAC + jsr LA35F ; set up print parameters + tst PRTDEV ; is it a file type device? + bne LB08B ; brif so - use two NULs + lda #': ; use colon as one delimiter + sta CHARAC + lda #', ; and use comma as the other +LB08B sta ENDCHR ; save second terminator + jsr LB51E ; parse out the string + jsr LB249 ; move input pointer past the string + jsr LAFA4 ; assign the string to the variable + bra LB09E ; go see if there's more to read +LB098 jsr LBD12 ; parse a numeric string + jsr LBC33 ; assign the numbe to the variable +LB09E jsr GETCCH ; get current input character + beq LB0A8 ; brif end of line + cmpa #', ; check for comma + lbne LAFD6 ; brif not - we have bad data +LB0A8 ldx CHARAD ; get current data pointer + stx DATTMP ; save the data pointer + ldx BINVAL ; restore the interpreter input pointer + stx CHARAD + jsr GETCCH ; get current input from program + beq LB0D5 ; brif end of statement + jsr SYNCOMMA ; make sure there's a comma between variables + bra LB04E ; go read another item +LB0B9 stx CHARAD ; reset input pointer + jsr LAEE8 ; search for end of statement + leax 1,x ; move past end of statement + tsta ; was it end of line? + bne LB0CD ; brif not + ldb #2*3 ; code for out of data + ldu ,x++ ; get pointer to next line + beq LB10A ; brif end of program - raise OD error + ldd ,x++ ; get line number + std DATTXT ; record it for raising errors in DATA statements +LB0CD lda ,x ; do we have a DATA statement? + cmpa #0x86 + bne LB0B9 ; brif not - keep scanning + bra LB069 ; go process the input +LB0D5 ldx DATTMP ; get data pointer + ldb INPFLG ; were we doing READ? + lbne LADE8 ; brif so - save DATA pointer + lda ,x ; is there something after the input in the input buffer? + beq LB0E7 ; brif not - we consumed everything + ldx #LB0E8-1 ; print the ?EXTRA IGNORED message + jmp STRINOUT +LB0E7 rts +LB0E8 fcc '?EXTRA IGNORED' + fcb 0x0d,0x00 +; NEXT command +NEXT bne LB0FE ; brif argument given + ldx ZERO ; set to NULL descriptor pointer + bra LB101 ; go process "any index will do" +LB0FE jsr LB357 ; evaluate the variable +LB101 stx VARDES ; save the index we're looking for + jsr LABF9 ; search the stack for the matching frame + beq LB10C ; brif we found a matching frame + ldb #0 ; code for NEXT without FOR +LB10A bra LB153 ; raise the error +LB10C tfr x,s ; reset the stack to the start of the stack frame + leax 3,x ; point to the STEP value + jsr LBC14 ; copy the value to FPA0 + lda 8,s ; get step direction + sta FP0SGN ; save as sign of FPA0 + ldx VARDES ; point to index variable + jsr LB9C2 ; add (X) to FPA0 (steps the index) + jsr LBC33 ; save new value to the index + leax 9,s ; point to terminal condition + jsr LBC96 ; compare the new index value with the terminal + subb 8,s ; set B=0 if we hit the terminal (or passed it with nonzero step) + beq LB134 ; brif loop complete + ldx 14,s ; restore line number and input pointer to start of loop + stx CURLIN + ldx 16,s + stx CHARAD +LB131 jmp LAD9E ; return to interpretation loop +LB134 leas 18,s ; remove the frame from the stack + jsr GETCCH ; get character after the index + cmpa #', ; do we have more indexes? + bne LB131 ; brif not + jsr GETNCH ; munch the comma + bsr LB0FE ; go process another value +; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall +; through this point, nor will the stack grow without bound. The BSR is required to make sure +; the stack is aligned properly for the stack search for the subsequent index variable. +; +; The following is the expression evaluation system. It has various entry points including for type +; checking. This really consists of two co-routines, one for evaluating operators and one for individual +; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow +; just how some of this works. +; +; Evaluate numeric expression +LB141 bsr LB156 ; evaluate an expression +; TM error if string +LB143 andcc #0xfe ; clear C to indicate we want a number + skip2keepc +; TM error if numeric +LB146 orcc #1 ; set C to indicate we want a string +; TM error if: C = 1 and number, OR C = 0 and string +LB148 tst VALTYP ; set flags on the current value to (doesn't change C) + bcs LB14F ; brif we want a string + bpl LB0E7 ; brif we have a number (we want a number) + skip2 +LB14F bmi LB0E7 ; brif we have a string (we want a string) +LB151 ldb #12*2 ; code for TM error +LB153 jmp LAC46 ; raise the error +; The general expression evaluation entry point +LB156 bsr LB1C6 ; back up input pointer to compensate for GETNCH below +LB158 clra ; set operator precedence to 0 (no previous operator) + skip2 +LB15A pshs b ; save relational operator flags + pshs a ; save previous operator precedence + ldb #1 ; make sure we aren't overflowing the stack + jsr LAC33 + jsr LB223 ; go evaluate the first term +LB166 clr TRELFL ; flag no relational operators seen +LB168 jsr GETCCH ; get input character +LB16A suba #0xb2 ; token for > (lowest relational operator) + blo LB181 ; brif below relational operators + cmpa #3 ; there are three relational operators, is it one? + bhs LB181 ; brif not + cmpa #1 ; set C if > + rola ; shift C into bit 0 (4: <, 2: =, 1: >) + eora TRELFL ; flip the bit for this operator + cmpa TRELFL ; did the result get lower? + blo LB1DF ; brif so - we have a duplicate so raise an error + sta TRELFL ; save new operator flags + jsr GETNCH ; munch the operator + bra LB16A ; go see if we have another one +LB181 ldb TRELFL ; do we have a relational comparison? + bne LB1B8 ; brif so + lbcc LB1F4 ; brif the token is above the relational operators + adda #7 ; put operators starting at 0 + bhs LB1F4 ; brif we're above 0 - it's an operator, Jim + adca VALTYP ; add carry, numeric flag, and modified token number + lbeq LB60F ; brif we have string and A is + - do concatenation + adca #-1 ; restore operator number + pshs a ; save operator number + asla ; times 2 + adda ,s+ ; and times 3 (3 bytes per entry) + ldx #LAA51 ; point to operator pecedence and jump table + leax a,x ; point to correct entry +LB19F puls a ; get precedence of previous operation + cmpa ,x ; is hit higher (or same) than the current one? + bhs LB1FA ; brif so - we need to process that operator + bsr LB143 ; TM error if we have a string +LB1A7 pshs a ; save previous operation precedence + bsr LB1D4 ; push operator handler address and FPA0 onto the stack + ldx RELPTR ; get pointer to arithmetic/logical table entry for last operation + puls a ; get back precedence + bne LB1CE ; brif we had a relational operation + tsta ; check precedence of previous operation + lbeq LB220 ; brif end of expression + bra LB203 ; go handle operation +LB1B8 asl VALTYP ; get type of value to C + rolb ; mix it in to bit 0 of relational flags + bsr LB1C6 ; back up input pointer + ldx #LB1CB ; point to relational operator precedence and handler + stb TRELFL ; save relational comparison flags + clr VALTYP ; result will be numeric + bra LB19F ; to process the operation +LB1C6 ldx CHARAD ; get input pointer + jmp LAEBB ; back it up one and put it back +LB1CB fcb 0x64 ; precedence of relational comparison + fdb LB2F4 ; handler address for relational comparison +LB1CE cmpa ,x ; is last done operation higher (or same) precedence? + bhs LB203 ; brif so - go process it + bra LB1A7 ; go push things on the stack and process this operation otherwise +LB1D4 ldd 1,x ; get address of operatorroutine + pshs d ; save it + bsr LB1E2 ; push FPA0 onto the stack + ldb TRELFL ; get back relational operator flags + lbra LB15A ; go evaluate another operation +LB1DF jmp LB277 ; raise a syntax error +LB1E2 ldb FP0SGN ; get sign of FPA0 + lda ,x ; get precedence of this operation +LB1E6 puls y ; get back original caller + pshs b ; save sign +LB1EA ldb FP0EXP ; get exponent + ldx FPA0 ; get mantissa + ldu FPA0+2 + pshs u,x,b ; stow FPA0 sign and mantissa + jmp ,y ; return to caller +LB1F4 ldx ZERO ; point to dummy value + lda ,s+ ; get precedence of previous operation (and set flags) + beq LB220 ; brif end of expression +LB1FA cmpa #0x64 ; relational operation? + beq LB201 ; brif so + jsr LB143 ; type mismatch if string +LB201 stx RELPTR ; save pointer to operator routine +LB203 puls b ; get relational flags + cmpa #0x5a ; NOT operation? + beq LB222 ; brif so (it was unary) + cmpa #0x7d ; unary negation? + beq LB222 ; brif so + lsrb ; shift value type flag out of relational flags + stb RELFLG ; save relational operator flag + puls a,x,u ; get FP value back + sta FP1EXP ; set exponent and mantissa in FPA1 + stx FPA1 + stu FPA1+2 + puls b ; and the sign + stb FP1SGN + eorb FP0SGN ; set RESSGN if the two operand signs differ + stb RESSGN +LB220 ldb FP0EXP ; get exponent of FPA0 +LB222 rts ; return or transfer control to operator handler routine +LB223 jsr RVEC15 ; do the RAM hook dance + clr VALTYP ; set type to numeric + jsr GETNCH ; get first character in the term + bcc LB22F ; brif not numeric +LB22C jmp LBD12 ; parse a number (and return) +LB22F jsr LB3A2 ; set carry if not alpha + bcc LB284 ; brif alpha character (variable) + cmpa #'. ; decimal point? + beq LB22C ; brif so - evaluate number + cmpa #0xac ; minus? + beq LB27C ; brif so - process unary negation + cmpa #0xab ; plus? + beq LB223 ; brif so - ignore unary "posation" + cmpa #'" ; string delimiter? + bne LB24E ; brif not +LB244 ldx CHARAD ; get input pointer + jsr LB518 ; go parse the string +LB249 ldx COEFPT ; get address of end of string + stx CHARAD ; move input pointer past string + rts +LB24E cmpa #0xa8 ; NOT? + bne LB25F ; brif not + lda #0x5a ; precedence of unary NOT + jsr LB15A ; process the operand of NOT + jsr INTCNV ; convert to integer in D + coma ; do a bitwise complement + comb + jmp GIVABF ; resturn the result +LB25F inca ; is it a function token? + beq LB290 ; brif so +LB262 bsr LB26A ; only other legal thing must be a (expr) + jsr LB156 ; evaluate parentheticized expression +LB267 ldb #') ; force a ) + skip2 +LB26A ldb #'( ; force a ( + skip2 +SYNCOMMA ldb #', ; force a , +LB26F cmpb [CHARAD] ; does character match? + bne LB277 ; brif not + jmp GETNCH ; each the character and return the next +LB277 ldb #2*1 ; raise syntax error + jmp LAC46 +LB27C lda #0x7d ; unary negation precedence + jsr LB15A ; evaluate argument + jmp LBEE9 ; flip sign of FPA0 and return +LB284 jsr LB357 ; evaluate variable +LB287 stx FPA0+2 ; save descriptor address in FPA0 + lda VALTYP ; test variable type + bne LB222 ; brif string - we're done + jmp LBC14 ; copy FP number from (X) into FPA0 +LB290 jsr GETNCH ; get the actual token number + tfr a,b ; save it (for offsetting X) + lslb ; two bytes per jump table entry (and lose high bit) + jsr GETNCH ; eat the token byte + cmpb #2*19 ; is it a valid token for Color Basic? + bls LB29F ; brif so + jmp [COMVEC+18] ; transfer control to Extended Basic if not +LB29F pshs b ; save jump table offset + cmpb #2*14 ; does it expect a numeric argument? + blo LB2C7 ; brif so + cmpb #2*18 ; does it need no arguments? + bhs LB2C9 ; brif so + bsr LB26A ; force a ( + lda ,s ; get token value + cmpa #2*17 ; is it POINT? + bhs LB2C9 ; brif so + jsr LB156 ; evaluate first argument string + bsr SYNCOMMA ; force a comma + jsr LB146 ; TM error if string + puls a ; get token value + ldu FPA0+2 ; get string descriptor + pshs u,a ; now we save the first string argument and the token value + jsr EVALEXPB ; evaluate first numeric argument + puls a ; get back token value + pshs b,a ; save second argument and token value + fcb 0x8e ; opcode of LDX immediate (skips two bytes) +LB2C7 bsr LB262 ; force a ( +LB2C9 puls b ; get offset + ldx COMVEC+8 ; get jump table pointer +LB2CE abx ; add offset into table + jsr [,x] ; go process function + jmp LB143 ; make sure result is numeric +; operator OR +LB2D4 skip1lda ; set flag to nonzero to signal OR +; operator AND +LB2D5 clra ; set flag to zero to signal AND + sta TMPLOC ; save AND/OR flag + jsr INTCNV ; convert second argument to intenger + std CHARAC ; save it + jsr LBC4A ; move first argument to FPA0 + jsr INTCNV ; convert first argument to integer + tst TMPLOC ; is it AND or OR? + bne LB2ED ; brif OR + anda CHARAC ; do the bitwise AND + andb ENDCHR + bra LB2F1 ; finish up +LB2ED ora CHARAC ; do the bitwise OR + orb ENDCHR +LB2F1 jmp GIVABF ; return integer result +; relational comparision operators +LB2F4 jsr LB148 ; TM error if type mismatch + BNE LB309 ; brif we have a string comparison + lda FP1SGN ; pack FPA1 + ora #0x7f + anda FPA1 + sta FPA1 + ldx #FP1EXP ; point to packed FPA1 + jsr LBC96 ; compare FPA0 to FPA1 + bra LB33F ; handle truth comparison +LB309 clr VALTYP ; the result of a comparison is always a number + dec TRELFL ; remove the string flag from the comparison data + jsr LB657 ; get string details for second argument + stb STRDES ; save them in the temporary string descriptor + stx STRDES+2 + ldx FPA1+2 ; get pointer to first argument descriptor + jsr LB659 ; get string details for second argument + lda STRDES ; get length of second argument + pshs b ; save length of first argument + suba ,s+ ; now A is the difference in string lengths + beq LB328 ; brif string lengths are equal + lda #1 ; flag for second argument is longer than first + bcc LB328 ; brif second string is longer than first + ldb STRDES ; get length of second string (shorter) + nega ; invert default comparison result +LB328 sta FP0SGN ; save default truth flag + ldu STRDES+2 ; get pointer to start of second string + incb ; compensate for DECB +LB32D decb ; have we compared everything? + bne LB334 ; brif not + ldb FP0SGN ; get default truth value + bra LB33F ; decide comparison truth +LB334 lda ,x+ ; get byte from first argument + cmpa ,u+ ; compare with second argument + beq LB32D ; brif equal - keep comparing + ldb #0xff ; negative if first string is > second + bcc LB33F ; brif string A > string B + negb ; invert result +LB33F addb #1 ; convert to 0,1,2 + rolb ; shift left - now it's 4,2,1 for <, =, > + andb RELFLG ; keep only the truth we care about + beq LB348 ; brif no matching bits - it's false + ldb #0xff ; set true +LB348 jmp LBC7C ; convert result to FP and return it +; DIM command +LB34B jsr SYNCOMMA ; make sure there's a comma between variables +DIM ldb #1 ; flag that we're dimensioning + bsr LB35A ; go allocate the variable + jsr GETCCH ; are we done? + bne LB34B ; brif not + rts +; This routine parses a variable. For scalars, it will return a NULL string or 0 value number +; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will +; allocate a default sized array if dimensioning is not underway and then attempt to look up +; the requested coordinates in that array. Otherwise, it will allocate an array based on the +; specified dimension values. +LB357 clrb ; flag that we're not setting up an array + jsr GETCCH +LB35A stb DIMFLG ; save dimensioning flag +LB35C sta VARNAM ; save first character of variable name + jsr GETCCH ; get input character (why? we already have it) + bsr LB3A2 ; set carry if not alpha + lbcs LB277 ; brif our variable doesn't start with a letter + clrb ; default second variable character to NUL + stb VALTYP ; set value type to numeric + jsr GETNCH ; get second character + bcs LB371 ; brif numeric - numbers are allowed + bsr LB3A2 ; set carry if not alpha + bcs LB37B ; brif not alpha +LB371 tfr a,b ; save set second character of variable name +LB373 jsr GETNCH ; get an input character + bcs LB373 ; brif numeric - still in variable name + bsr LB3A2 ; set carry if not alpha + bcc LB373 ; brif alpha - still in variable name +LB37B cmpa #'$ ; do we have the string sigil? + bne LB385 ; brif not + com VALTYP ; set value type to string + addb #0x80 ; set bit 7 of second variable character to indicate string + jsr GETNCH ; eat the sigil +LB385 stb VARNAM+1 ; save second variable name character + ora ARYDIS ; merge array disable flag (will set bit 7 of input character if no arrays) + suba #'( ; do we have a subscript? + lbeq LB404 ; brif so + clr ARYDIS ; disable the array disable flag - it's single use + ldx VARTAB ; point to the start of the variable table + ldd VARNAM ; get variable name +LB395 cmpx ARYTAB ; are we at the top of the variable table? + beq LB3AB ; brif so + cmpd ,x++ ; does the variable name match (and move pointer to variable data) + beq LB3DC ; brif so + leax 5,x ; move to next table entry + bra LB395 ; see if we have a match +; Set carry if not upper case alpha +LB3A2 cmpa #'A ; set C if less than A + bcs LB3AA ; brif less than A + suba #'Z+1 ; set C if greater than Z + suba #-('Z+1) +LB3AA rts +LB3AB ldx #ZERO ; point to empty location (NULL/0 value) + ldu ,s ; get caller address + cmpu #LB287 ; coming from "evaluate term"? + beq LB3DE ; brif so - don't allocate + ldd ARYEND ; get end of arrays + std V43 ; save as top of source block + addd #7 ; 7 bytes per scalar entry + std V41 ; save as top of destination block + ldx ARYTAB ; get bottom of arrays + stx V47 ; save as bottom of source block + jsr LAC1E ; move the arrays up to make a hole + ldx V41 ; get new top of arrays + stx ARYEND ; set new end of arrays + ldx V45 ; get bottom of destination block + stx ARYTAB ; set as new start of arrays + ldx V47 ; get old end of variables + ldd VARNAM ; get name of variable + std ,x++ ; set variable name and advance X to the value + clra ; zero out the variable value + clrb + std ,x + std 2,x + sta 4,x +LB3DC stx VARPTR ; save descriptor address of return value +LB3DE rts +; Various integer conversion routines +LB3DF fcb 0x90,0x80,0x00,0x00,0x00 ; FP constant -32768 +LB3E4 jsr GETNCH ; fetch input character +LB3E6 jsr LB141 ; evaluate numeric expression +LB3E9 lda FP0SGN ; get sign of value + bmi LB44A ; brif negative (raise FC error) +INTCNV jsr LB143 ; TM error if string + lda FP0EXP ; get exponent + cmpa #0x90 ; is it within the range for a 16 bit integer? + blo LB3FE ; brif smaller than 32768 + ldx #LB3DF ; point to -32678 constant + jsr LBC96 ; is FPA0 equal to -32768? + bne LB44A ; brif not - magnitude is too far negative +LB3FE jsr LBCC8 ; move binary point to the right of FPA0 and correct sign + ldd FPA0+2 ; get the resulting integer + rts +LB404 ldd DIMFLG ; get dimensioning flag and variable type + pshs b,a ; save them (to avoid issues while evaluating dimension values) + nop ; dead space caused by 1.2 revision + clrb ; reset dimension counter +LB40A ldx VARNAM ; get variable name + pshs x,b ; save dimension counter and variable name + bsr LB3E4 ; evaluate a dimension value (and skip either ( or ,) + puls b,x,y ; get variable name, dimension counter, and dimensioning/type flag + stx VARNAM ; restore variable name + ldu FPA0+2 ; get dimension size/index + pshs u,y ; save dimension size and dimensioning/type flag + incb ; bump dimension counter + jsr GETCCH ; get what's after the dimension count + cmpa #', ; do we have another dimension? + beq LB40A ; brif so - parse it + stb TMPLOC ; save dimension counter + jsr LB267 ; make sure we have a ) + puls a,b ; get back variable type and dimensioning flag + std DIMFLG ; restore variable type and dimensioning flag + ldx ARYTAB ; get start of arrays +LB42A cmpx ARYEND ; are we at the end of the array table + beq LB44F ; brif so + ldd VARNAM ; get variable name + cmpd ,x ; does it match? + beq LB43B ; brif so + ldd 2,x ; get length of this array + leax d,x ; move to next array + bra LB42A ; go check another entry +LB43B ldb #2*9 ; code for redimensioned array error + lda DIMFLG ; are we dimensioning? + bne LB44C ; brif so - raise error + ldb TMPLOC ; get number of dimensions given + cmpb 4,x ; does it match? + beq LB4A0 ; brif so +LB447 ldb #8*2 ; raise "bad subscript" + skip2 +LB44A ldb #4*2 ; raise "illegal function call" +LB44C jmp LAC46 ; raise error +LB44F ldd #5 ; 5 bytes per array entry + std COEFPT ; initialize array size to entry size + ldd VARNAM ; get variable name + std ,x ; set array name + ldb TMPLOC ; get dimension count + stb 4,x ; set dimension count + jsr LAC33 ; make sure we haven't overflowed memory + stx V41 ; save array descriptor address +LB461 ldb #11 ; default dimension value (zero-based, gives max index of 10) + clra ; zero extend (??? why not LDD above?) + tst DIMFLG ; are we dimensioning? + beq LB46D ; brif not + puls a,b ; get dimension size + addd #1 ; account for zero based indexing +LB46D std 5,x ; save dimension size + bsr LB4CE ; multiply by accumulated array size + std COEFPT ; save new array size + leax 2,x ; move to next dimension + dec TMPLOC ; have we done all dimensions? + bne LB461 ; brif not + stx TEMPTR ; save end of array descriptor (minus 5) + addd TEMPTR ; add total size of array to address of descriptor + lbcs LAC44 ; brif it overflows memory + tfr d,x ; save end of array for later + jsr LAC37 ; does array fit in memory? + subd #STKBUF-5 ; subtract out the "stack fudge factor" but add 5 to the result + std ARYEND ; save new end of arrays + clra ; set up for clearing +LB48C leax -1,x ; move back one + sta 5,x ; blank out a byte in the array data + cmpx TEMPTR ; have we reached the array header? + bne LB48C ; brif not + ldx V41 ; get address of start of descriptor + lda ARYEND ; get MSB of end of array back (B still has LSB) + subd V41 ; subtract start of descriptor + std 2,x ; save length of array in array header + lda DIMFLG ; are we dimensioning? + bne LB4CD ; brif so - we're done +LB4A0 ldb 4,x ; get number of dimensions + stb TMPLOC ; initialize counter + clra ; initialize accumulated offset + clrb +LB4A6 std COEFPT ; save accumulated offset + puls a,b ; get desired index + std FPA0+2 ; save it + cmpd 5,x ; is it in range for this dimension? + bhs LB4EB ; brif not + ldu COEFPT ; get accumulated offset + beq LB4B9 ; brif first dimension + bsr LB4CE ; multiply accumulated offset by dimension length + addd FPA0+2 ; add in offset into this dimension +LB4B9 leax 2,x ; move to next dimension in header + dec TMPLOC ; done all dimensions? + bne LB4A6 ; brif not + std ,--s ; save D for multiply by 5 (should be pshs d) + aslb ; times 2 + rola + aslb ; times 4 + rola + addd ,s++ ; times 5 + leax d,x ; add in offset from start of array data + leax 5,x ; offset to end of header + stx VARPTR ; save pointer to element data +LB4CD rts +; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry +LB4CE lda #16 ; 16 shifts to do a multiply + sta V45 ; save shift counter + ldd 5,x ; get multiplier + std BOTSTK ; save it + clra ; zero out product + clrb +LB4D8 aslb ; shift product left + rola + bcs LB4EB ; brif we have a carry + asl COEFPT+1 ; shift other factor left + rol COEFPT + bcc LB4E6 ; brif no carry - this bit position is 0 + addd BOTSTK ; add in multiplier at this bit position + bcs LB4EB ; brif carry - do an error +LB4E6 dec V45 ; have we done all 16 bits? + bne LB4D8 ; brif not + rts +LB4EB jmp LB447 ; raise a BS error +; MEM function +; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks +MEM tfr s,d ; get stack pointer where we can do math + subd ARYEND ; calculate number of bytes between the stack and the top of arrays + skip1 ; return result +; Convert unsigned value in B to FP +LB4F3 clra ; zero extend +; Convert signed value in D to FP +GIVABF clr VALTYP ; set value type to numeric + std FPA0 ; save value in FPA0 + ldb #0x90 ; exponent for top two bytes to be an integer + jmp LBC82 ; finish conversion to integer +; STR$ function +STR jsr LB143 ; make sure we have a number + ldu #STRBUF+2 ; convert FP number to string in temporary string buffer + jsr LBDDC + leas 2,s ; don't return to the function evaluator (which will do a numeric type check) + ldx #STRBUF+1 ; point to number string + bra LB518 ; to stash the string in string space and return to the "evaluate term" caller +; Reserve B bytes of string space. Return start in X and FRESPC +LB50D stx V4D ; save X somewhere in case the caller needs it +LB50F bsr LB56D ; allocate string space +LB511 stx STRDES+2 ; save pointer to allocated space in the temporary descriptor + stb STRDES ; save length in the temporary descriptor + rts +LB516 leax -1,x ; move pointer back one (to compensate for the increment below) +; Scan from X until either NUL or one of the string terminators is found +LB518 lda #'" ; set terminator to be string delimiter +LB51A sta CHARAC ; set both delimiters + sta ENDCHR +LB51E leax 1,x ; move to next character + stx RESSGN ; save start of string + stx STRDES+2 ; save start of string in the temporary string descriptor + ldb #-1 ; initialize length counter to -1 (compensate for initial INCB) +LB526 incb ; bump string length + lda ,x+ ; get character from string + beq LB537 ; brif end of line + cmpa CHARAC ; is it delimiter #1? + beq LB533 ; brif so + cmpa ENDCHR ; is it delimiter #2? + bne LB526 ; brif not - keep scanning +LB533 cmpa #'" ; string delimiter? + beq LB539 ; brif so - don't move pointer back +LB537 leax -1,x ; move pointer back (so we don't consume the delimiter) +LB539 stx COEFPT ; save end of string address + stb STRDES ; save string length + ldu RESSGN ; get start of string + cmpu #STRBUF+2 ; is it at the start of the string buffer? + bhi LB54C ; brif so - don't copy it to string space + bsr LB50D ; allocate string space + ldx RESSGN ; point to beginning of the string + jsr LB645 ; copy string data (B bytes) from (X) to (FRESPC) +; Put temporary string descriptor on the string stack +LB54C ldx TEMPPT ; get top of string stack + cmpx #CFNBUF ; is the string stack full? + bne LB558 ; brif not + ldb #15*2 ; code for "string formula too complex" +LB555 jmp LAC46 ; raise error +LB558 lda STRDES ; get string length + sta 0,x ; save it in the string stack descriptor + ldd STRDES+2 ; get string data pointer + std 2,x ; save in string stack descriptor + lda #0xff ; set value type to string + sta VALTYP + stx LASTPT ; set pointer to last used entry on the string stack + stx FPA0+2 ; set pointer to descriptor in the current evaluation value + leax 5,x ; advance string stack pointer + stx TEMPPT + rts +; Reserve B bytes in string space. If there isn't enough space, try compacting string space and +; then try the allocation again. If it still fails, raise OS error. +LB56D clr GARBFL ; flag that compaction not yet done +LB56F clra ; zero extend the length + pshs d ; save requested string length + ldd STRTAB ; get current bottom of strings + subd ,s+ ; calculate new bottom of strings and remove zero extension + cmpd FRETOP ; does the string fit? + blo LB585 ; brif not - try compaction + std STRTAB ; save new bottom of strings + ldx STRTAB ; get bottom of strings + leax 1,x ; now X points to the real start of the allocated space + stx FRESPC ; save the string pointer + puls b,pc ; restore length and return +LB585 ldb #2*13 ; code for out of string space + com GARBFL ; have we compacted string space yet? + beq LB555 ; brif so - raise error + bsr LB591 ; compact string space + puls b ; get back string length + bra LB56F ; go try allocation again +; Compact string space +; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer +; that hasn't already been moved into the freshly compacted string space. If then moves that string data +; up to the highest address it can go to. It repeats this process over and over until it finds no string +; that isn't already in the compacted space. While doing this, it has to search all strings on the string +; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string +; variables, and *every* entry in every string array. +LB591 ldx MEMSIZ ; get to of string space +LB593 stx STRTAB ; save top of uncompacted stringspace + clra ; zero out D and reset pointer to discovered variable to NULL + clrb + std V4B + ldx FRETOP ; point to bottom of string space + stx V47 ; save as lowest match address (match will be higher) + ldx #STRSTK ; point to start of string stack +LB5A0 cmpx TEMPPT ; are we at the top of the string stack? + beq LB5A8 ; brif so - done with the string stack + bsr LB5D8 ; check for string in uncompacted space (and advance pointer) + bra LB5A0 ; check another on the string stack +LB5A8 ldx VARTAB ; point to start of scalar variables +LB5AA cmpx ARYTAB ; end of scalars? + beq LB5B2 ; brif so + bsr LB5D2 ; check for string in uncompacted space and advance pointer + bra LB5AA ; check another variable +LB5B2 stx V41 ; save address of end of variables (address of first array) +LB5B4 ldx V41 ; get start of the next array +LB5B6 cmpx ARYEND ; end of arrays? + beq LB5EF ; brif so + ldd 2,x ; get length of array + addd V41 ; add to start of array + std V41 ; save address of next array + lda 1,x ; get second character of variable name + bpl LB5B4 ; brif numeric + ldb 4,x ; get number of dimensions + aslb ; two bytes per dimension size + addb #5 ; add in fixed overhead for array descriptor + abx ; now X points to first array element +LB5CA cmpx V41 ; at the start of the next array? + beq LB5B6 ; brif so - go handle another array + bsr LB5D8 ; check for string in uncompacted space (and advance pointer) + bra LB5CA ; process next array element +LB5D2 lda 1,x ; get second character of variable name + leax 2,x ; move to variable data + bpl LB5EC ; brif numeric +LB5D8 ldb ,x ; get length of string + beq LB5EC ; brif NULL - don't need to check data pointer + ldd 2,x ; get data pointer + cmpd STRTAB ; is it in compacted string space? + bhi LB5EC ; brif so + cmpd V47 ; is it better match than previous best? + bls LB5EC ; brif not + stx V4B ; save descriptor address of best match + std V47 ; save new best data pointer match +LB5EC leax 5,x ; move to next descriptor +LB5EE rts +LB5EF ldx V4B ; get descriptor address of the matched string + beq LB5EE ; brif we didn't find one - we're done + clra ; zero extend length + ldb ,x ; get string length + decb ; subtract one (we won't have a NULL string here) + addd V47 ; now D points to the address of the end of the string data + std V43 ; save as top address of move + ldx STRTAB ; set top of uncompacted space as destination + stx V41 + jsr LAC20 ; move string to top of uncompactedspace + ldx V4B ; point to string descriptor + ldd V45 ; get new data pointer address + std 2,x ; update descriptor + ldx V45 ; get bottom of copy destination + leax -1,x ; move back below it + jmp LB593 ; go search for another string to move (and set new bottom of string space) +; Concatenate two strings. We come here directly from the operator handler rather than via a JSR. +LB60F ldd FPA0+2 ; get string descriptor for the first string + pshs d ; save it + jsr LB223 ; evaluate a second string (concatenation is left associative) + jsr LB146 ; make sure we have a string + puls x ; get back first string descriptor + stx RESSGN ; save it + ldb ,x ; get length of first string + ldx FPA0+2 ; get pointer to second string + addb ,x ; add length of second string + bcc LB62A ; brif combined length is OK + ldb #2*14 ; raise string too long error + jmp LAC46 +LB62A jsr LB50D ; reserve room for new string + ldx RESSGN ; get descriptor address of the first string + ldb ,x ; get length of first string + bsr LB643 ; copy it to string space + ldx V4D ; get descriptor address of second string + bsr LB659 ; get string details for second string + bsr LB645 ; copy second string into new string space + ldx RESSGN ; get pointer to first string + bsr LB659 ; remove it from the string stack if possible + jsr LB54C ; put new string on the string stack + jmp LB168 ; return to expression evaluator +; Copy B bytes to space pointed to by FRESPC +LB643 ldx 2,x ; get source address from string descriptor +LB645 ldu FRESPC ; get destination address + incb ; compensate for decb + bra LB64E ; do the copy +LB64A lda ,x+ ; copy a byte + sta ,u+ +LB64E decb ; done yet? + bne LB64A ; brif not + stu FRESPC ; save destination pointer + rts +; Fetch details of string in FPA0+2 and remove from the string stack if possible +LB654 jsr LB146 ; make sure we have a string +LB657 ldx FPA0+2 ; get descriptor pointer +LB659 ldb ,x ; get length of string + bsr LB675 ; see if it's at the top of the string stack and remove it if so + bne LB672 ; brif not removed + ldx 5+2,x ; get start address of string just removed + leax -1,x ; move pointer down 1 + cmpx STRTAB ; is it at the bottom of string space? + bne LB66F ; brif not + pshs b ; save length + addd STRTAB ; add length to start of strings (A was cleared previously) + std STRTAB ; save new string space start (deallocated space for this string) + puls b ; get back string length +LB66F leax 1,x ; restore pointer to pointing at the actual string data + rts +LB672 ldx 2,x ; get data pointer for the string + rts +; Remove string pointed to by X from the string stack if it is at the top of the stack; return with +; A clear and Z set if string removed +LB675 cmpx LASTPT ; is it at the top of the string stack? + bne LB680 ; brif not - do nothing + stx TEMPPT ; save new top of stack + leax -5,x ; move the "last" pointer back as well + stx LASTPT + clra ; flag string removed +LB680 rts +; LEN function +LEN bsr LB686 ; get string details +LB683 jmp LB4F3 ; return unsigned length in B +LB686 bsr LB654 ; get string details and remove from string stack + clr VALTYP ; set value type to numeric + tstb ; set flags according to length + rts +; CHR$ function +CHR jsr LB70E ; get 8 bit unsigned integer to B +LB68F ldb #1 ; allocate a one byte string + jsr LB56D + lda FPA0+3 ; get character code + jsr LB511 ; save reserved string details in temp descriptor + sta ,x ; put character in string +LB69B leas 2,s ; don't go back to function handler - avoid numeric type check +LB69D jmp LB54C ; return temporary string on string stack +; ASC function +ASC bsr LB6A4 ; get first character of argument + bra LB683 ; return unsigned code in B +LB6A4 bsr LB686 ; fetch string details + beq LB706 ; brif NULL string + ldb ,x ; get character at start of string + rts +; LEFT$ function +LEFT bsr LB6F5 ; get arguments from the stack +LB6AD clra ; clear pointer offset (set to start of string) +LB6AE cmpb ,x ; are we asking for more characters than there are in the string? + bls LB6B5 ; brif not + ldb ,x ; only return the number that are in the string + clra ; force starting offset to be the start of the string +LB6B5 pshs b,a ; save offset and length + jsr LB50F ; reserve space in string space + ldx V4D ; point to original string descriptor + bsr LB659 ; get string details + puls b ; get string offset + abx ; now X points to the start of the data to copy + puls b ; get length of copy + jsr LB645 ; copy the data to the allocated space + bra LB69D ; return temp string on string stack +; RIGHT$ function +RIGHT bsr LB6F5 ; get arguments from stack + suba ,x ; subtract length of original string from desired length + nega ; now A is offset into old string where we start copying + bra LB6AE ; go handle everything else +; MID$ function +MID ldb #255 ; default length is the whole string + stb FPA0+3 ; save it + jsr GETCCH ; see what we have after offset + cmpa #') ; end of function? + beq LB6DE ; brif so - no length + jsr SYNCOMMA ; force a comma + bsr EVALEXPB ; get length parameter +LB6DE bsr LB6F5 ; get string and offset parameters from the stack + beq LB706 ; brif we have a 0 offset requested (string offsets are 1-based) + clrb ; clear length counter + deca ; subtract one from position parameter (we work on 0-based, param is 1-based) + cmpa ,x ; is start greater than length of string? + bhs LB6B5 ; brif so - return NULL string + tfr a,b ; save absolute position parameter + subb ,x ; now B is postition less length + negb ; now B is amount of string to copy + cmpb FPA0+3 ; is it less than the length requested? + bls LB6B5 ; brif so + ldb FPA0+3 ; set length to the requested length + bra LB6B5 ; go finish up copying the substring +; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter +; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing +; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.) +LB6F5 jsr LB267 ; make sure we have ) + ldu ,s ; get return address - we're going to mess with the stack + ldx 5,s ; get address of string descriptor + stx V4D ; save descriptor adddress + lda 4,s ; get first numeric parameter in both A and B + ldb 4,s + leas 7,s ; clean up stack + tfr u,pc ; return to original caller +LB706 jmp LB44A ; raise FC error +; Evaluate an unsigned 8 bit expression to B +LB709 jsr GETNCH ; move to next character +EVALEXPB jsr LB141 ; evaluate a numeric expression +LB70E jsr LB3E9 ; convert to integer in D + tsta ; are we negative or > 255? + bne LB706 ; brif so - FC error + jmp GETCCH ; fetch current input character and return +; VAL function +VAL jsr LB686 ; get string details + lbeq LBA39 ; brif NULL string - return 0 + ldu CHARAD ; get input pointer so we can replace it later + stx CHARAD ; point interpreter at string data + abx ; calculate end address of the string + lda ,x ; get byte after the end of the string + pshs u,x,a ; save end of string address, input pointer, and character after end of string + clr ,x ; put a NUL after the string (stops the number interpreter) + jsr GETCCH ; get input character at start of string + jsr LBD12 ; evaluate numeric expression in string + puls a,x,u ; get back saved character and pointers + sta ,x ; restore byte after string + stu CHARAD ; restore interpeter's input pointer + rts +; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B +LB734 bsr LB73D ; evaluate expression + stx BINVAL ; save result +LB738 jsr SYNCOMMA ; make sure there's a comma + bra EVALEXPB ; evaluate unsigned expression to B +; Evaluate unsigned expression in X +LB73D jsr LB141 ; evaluate numeric expression +LB740 lda FP0SGN ; is it negative? + bmi LB706 ; brif so + lda FP0EXP ; get exponent + cmpa #0x90 ; largest possible exponent for 16 bits + bhi LB706 ; brif too large + jsr LBCC8 ; move binary point to right of FPA0 + ldx FPA0+2 ; get resulting unsigned value + rts +; PEEK function +PEEK bsr LB740 ; get address to X + ldb ,x ; get the value at that address + jmp LB4F3 ; return B as unsigned value +; POKE function +POKE bsr LB734 ; evaluate address and byte value + ldx BINVAL ; get address + stb ,x ; put value there + rts +; LLIST command +LLIST ldb #-2 ; set output device to printer + stb DEVNUM + jsr GETCCH ; reset flags for input character and fall through to LIST +; LIST command +LIST pshs cc ; save zero flag (end of statement) + jsr LAF67 ; parse line number + jsr LAD01 ; find address of that line + stx LSTTXT ; save that address as the start of the list + puls cc ; get back ent of statement flag + beq LB784 ; brif end of line - list whole program + jsr GETCCH ; are we at the end of the line (one number)? + beq LB789 ; brif end of line + cmpa #0xac ; is it "-"? + bne LB783 ; brif not + jsr GETNCH ; eat the "-" + beq LB784 ; brif no second number - list to end of program + jsr LAF67 ; evaluate the second number + beq LB789 ; brif illegal number +LB783 rts +LB784 ldu #0xffff ; this will cause listing to do the entire program + stu BINVAL +LB789 leas 2,s ; don't return to the caller - we'll jump back to the main loop + ldx LSTTXT ; get address of line to list +LB78D jsr LB95C ; do a newline if needed + jsr LA549 ; do a break check + ldd ,x ; get address of next line + bne LB79F ; brif not end of program +LB797 jsr LA42D ; close output file + clr DEVNUM ; reset device to screen + jmp LAC73 ; go back to immediate mode +LB79F stx LSTTXT ; save new line address + ldd 2,x ; get line number of this line + cmpd BINVAL ; is it above the end line? + bhi LB797 ; brif so - return + jsr LBDCC ; display line number + jsr LB9AC ; put a space after it + ldx LSTTXT ; get line address + bsr LB7C2 ; detokenize the line + ldx [LSTTXT] ; get pointer to next line + ldu #LINBUF+1 ; point to start of detokenized line +LB7B9 lda ,u+ ; get byte from detokenized line + beq LB78D ; brif end of line + jsr LB9B1 ; output character + bra LB7B9 ; handle next character +; Detokenize a line from (X) to the line input buffer +LB7C2 jsr RVEC24 ; do the RAM hook dance + leax 4,x ; move past next line pointer and line number + ldy #LINBUF+1 ; point to line input buffer (destination) +LB7CB lda ,x+ ; get character from tokenized line + beq LB820 ; brif end of input + bmi LB7E6 ; brif it's a token + cmpa #': ; colon? + bne LB7E2 ; brif not + ldb ,x ; get what's after the colon + cmpb #0x84 ; ELSE? + beq LB7CB ; brif so - suppress the colon + cmpb #0x83 ; '? + beq LB7CB ; brif so - suppress the colon + skip2 +LB7E0 lda #'! ; placeholder for unknown token +LB7E2 bsr LB814 ; stow output character + bra LB7CB ; go process another input character +LB7E6 ldu #COMVEC-10 ; point to command interptation table + cmpa #0xff ; is it a function? + bne LB7F1 ; brif not + lda ,x+ ; get function token + leau 5,u ; shift to the function half of the interpretation tables +LB7F1 anda #0x7f ; remove token bias +LB7F3 leau 10,u ; move to next command/function table + tst ,u ; is this table active? + beq LB7E0 ; brif not - use place holder +LB7F9 suba ,u ; subtract number of tokens handled by this table entry + bpl LB7F3 ; brif this token isn't handled here + adda ,u ; undo extra subtraction + ldu 1,u ; get reserved word list for this table +LB801 deca ; are we at the right entry? + bmi LB80A ; brif so +LB804 tst ,u+ ; end of entry? + bpl LB804 ; brif not + bra LB801 ; see if we're there yet +LB80A lda ,u ; get character from wordlist + bsr LB814 ; put character in the buffer + tst ,u+ ; end of word? + bpl LB80A ; brif not + bra LB7CB ; go handle another input character +LB814 cmpy #LINBUF+LBUFMX ; is there room? + bhs LB820 ; brif not + anda #0x7f ; lose bit 7 + sta ,y+ ; save character in output + clr ,y ; make sure there's always a NUL terminator +LB820 rts +; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return +; length in D +LB821 jsr RVEC23 ; do the RAM hook dance + ldx CHARAD ; get input pointer + ldu #LINBUF ; set destination pointer +LB829 clr V43 ; clear alpha string flag + clr V44 ; clear DATA flag +LB82D lda ,x+ ; get input character + beq LB852 ; brif end of input + tst V43 ; are we handling an alphanumeric string? + beq LB844 ; brif not + jsr LB3A2 ; set carry if not alpha + bcc LB852 ; brif alpha + cmpa #'0 ; is it below the digits? + blo LB842 ; brif so + cmpa #'9 ; is it within the digits? + bls LB852 ; brif so +LB842 clr V43 ; flag that we're past the alphanumeric string +LB844 cmpa #0x20 ; space? + beq LB852 ; brif so - keep it + sta V42 ; save scan delimiter + cmpa #'" ; string delimiter? + beq LB886 ; brif so - copy until another " + tst V44 ; doing "DATA"? + beq LB86B ; brif not +LB852 sta ,u+ ; put character in output + beq LB85C ; brif end of input + cmpa #': ; colon? + beq LB829 ; brif so - reset DATA and alpha string flags +LB85A bra LB82D ; go process another input character +LB85C clr ,u+ ; put a double NUL at the end + clr ,u+ + tfr u,d ; calculate length of result (includes double NUL and an extra two bytes) + subd #LINHDR + ldx #LINBUF-1 ; point to one before the output + stx CHARAD ; set input pointer there + rts +LB86B cmpa #'? ; print abbreviation? + bne LB873 ; brif not + lda #0x87 ; token for PRINT + bra LB852 ; go stash it +LB873 cmpa #'' ; REM abbreviation? + bne LB88A ; brif not + ldd #0x3a83 ; colon plus ' token + std ,u++ ; put it in the output +LB87C clr V42 ; set delimiter to NUL +LB87E lda ,x+ ; get input + beq LB852 ; brif end of line + cmpa V42 ; at the delimiter? + beq LB852 ; brif so +LB886 sta ,u+ ; save in output + bra LB87E ; keep scanning for delimiter +LB88A cmpa #'0 ; is it below digits? + blo LB892 ; brif so + cmpa #';+1 ; is it digit, colon, or semicolon? + blo LB852 ; brif so +LB892 leax -1,x ; move input pointer back one (to point at this input character) + pshs u,x ; save input and output pointers + clr V41 ; set token type to 0 (command) + ldu #COMVEC-10 ; point to command interpretation table +LB89B clr V42 ; set token counter to 0 (0x80) +LB89D leau 10,u ; + lda ,u ; get number of reserved words + beq LB8D4 ; brif this table isn't active + ldy 1,u ; point to reserved words list +LB8A6 ldx ,s ; get input pointer +LB8A8 ldb ,y+ ; get character from reserved word table + subb ,x+ ; compare with input character + beq LB8A8 ; brif exact match + cmpb #0x80 ; brif it was the last character in word and exact match + bne LB8EA ; brif not + leas 2,s ; remove original input pointer from stack + puls u ; get back output pointer + orb V42 ; create token value (B has 0x80 from above) + lda V41 ; get token type + bne LB8C2 ; brif function + cmpb #0x84 ; is it ELSE? + bne LB8C6 ; brif not + lda #': ; silently add a colon before ELSE +LB8C2 std ,u++ ; put two byte token into output + bra LB85A ; go handle more input +LB8C6 stb ,u+ ; save single byte token + cmpb #0x86 ; DATA? + bne LB8CE ; brif not + inc V44 ; set DATA flag +LB8CE cmpb #0x82 ; REM? + beq LB87C ; brif so - skip over rest of line +LB8D2 bra LB85A ; go handle more input +LB8D4 ldu #COMVEC-5 ; point to interpretation table, function style +LB8D7 com V41 ; invert token flag + bne LB89B ; brif we haven't already done functions + puls x,u ; restore input and output pointers + lda ,x+ ; copy first character + sta ,u+ + jsr LB3A2 ; set C if not alpha + bcs LB8D2 ; brif not alpha - it isn't a variable + com V43 ; set alphanumeric string flag + bra LB8D2 ; process more input +LB8EA inc V42 ; bump token number + deca ; checked all in this table? + beq LB89D ; brif so + leay -1,y ; unconsume last compared character +LB8F1 ldb ,y+ ; end of entry? + bpl LB8F1 ; brif not + bra LB8A6 ; check next reserved word +; PRINT command +PRINT beq LB958 ; brif no argument - do a newline + bsr LB8FE ; process print options + clr DEVNUM ; reset output to screen + rts +LB8FE cmpa #'@ ; is it PRINT @? + bne LB907 ; brif not +LB902 jsr LA554 ; move cursor to correct location +LB905 bra LB911 ; handle some more +LB907 cmpa #'# ; device number specified? + bne LB918 ; brif not + jsr LA5A5 ; parse device number + jsr LA406 ; check for valid output file +LB911 jsr GETCCH ; get input character + beq LB958 ; brif nothing - do newline + jsr SYNCOMMA ; need comma after @ or # +LB918 jsr RVEC9 ; do the RAM hook boogaloo +LB91B beq LB965 ; brif end of input +LB91D cmpa #0xa4 ; TAB(? + beq LB97E ; brif so + cmpa #', ; comma (next tab field)? + beq LB966 ; brif so + cmpa #'; ; semicolon (do not advance print position) + beq LB997 ; brif so + jsr LB156 ; evaluate expression + lda VALTYP ; get type of value + pshs a ; save it + bne LB938 ; brif string + jsr LBDD9 ; convert FP number to string + jsr LB516 ; parse a string and put on string stack +LB938 bsr LB99F ; print string + puls b ; get back variable type + jsr LA35F ; set up print parameters + tst PRTDEV ; is it a display device? + beq LB949 ; brif so + bsr LB958 ; do a newline + jsr GETCCH ; get input + bra LB91B ; process more print stuff +LB949 tstb ; set flags on print position + bne LB954 ; brif not at start of line + jsr GETCCH ; get current input + cmpa #', ; comma? + beq LB966 ; skip to next tab field if so + bsr LB9AC ; send a space +LB954 jsr GETCCH ; get input character + bne LB91D ; brif not end of statement +LB958 lda #0x0d ; carriage return + bra LB9B1 ; send it to output +LB95C jsr LA35F ; set up print parameters +LB95F beq LB958 ; brif width is 0 + lda DEVPOS ; get line position + bne LB958 ; brif not at start of line +LB965 rts +LB966 jsr LA35F ; set up print parameters + beq LB975 ; brif line width is 0 + ldb DEVPOS ; get line position + cmpb DEVLCF ; at or past last comma field? + blo LB977 ; brif so + bsr LB958 ; move to next line + bra LB997 ; handle more stuff +LB975 ldb DEVPOS ; get line position +LB977 subb DEVCFW ; subtract a comma field width + bhs LB977 ; brif we don't have a remainder yet + negb ; now B is number of of spaces needed + bra LB98E ; go advance +LB97E jsr LB709 ; evaluate TAB distance + cmpa #') ; closing )? + lbne LB277 ; brif not + jsr LA35F ; set up print parameters + subb DEVPOS ; subtract print position from desired position + bls LB997 ; brif we're already past it +LB98E tst PRTDEV ; is it a display device? + bne LB997 ; brif not +LB992 bsr LB9AC ; output a space + decb ; done enough? + bne LB992 ; brif not +LB997 jsr GETNCH ; get input character + jmp LB91B ; process more items +; cpoy string from (X-1) to output +STRINOUT jsr LB518 ; parse the string +LB99F jsr LB657 ; get string details +LB9A2 incb ; compensate for decb +LB9A3 decb ; done all of the string? + beq LB965 ; brif so + lda ,x+ ; get character from string + bsr LB9B1 ; send to output + bra LB9A3 ; go do another character +LB9AC lda #0x20 ; space character + skip2 +LB9AF lda #'? ; question mark character +LB9B1 jmp PUTCHR ; output character +; The floating point math package and related functions and operations follow from here +; to the end of the Color Basic ROM area +LB9B4 ldx #LBEC0 ; point to FP constant 0.5 + bra LB9C2 ; add 0.5 to FPA0 +LB9B9 jsr LBB2F ; unpack FP data from (X) to FPA1 +; subtraction operator +LB9BC com FP0SGN ; invert sign of FPA0 (subtracting is adding the negative) + com RESSGN ; that also inverts the sign differential + bra LB9C5 ; go add the negative of FPA0 to FPA1 +LB9C2 jsr LBB2F ; unpack FP data from (X) to FPA1 +; addition operator +LB9C5 tstb ; check exponent of FPA0 + lbeq LBC4A ; copy FPA1 to FPA0 if FPA0 is 0 + ldx #FP1EXP ; point X to FPA1 (first operand) as the operand to denormalize +LB9CD tfr a,b ; put exponent of FPA1 into B + tstb ; is FPA1 0? + beq LBA3E ; brif exponent is 0 - no-op; adding 0 to FPA0 + subb FP0EXP ; get difference in exponents - number of bits to shift the smaller mantissa + beq LBA3F ; brif exponents are equal - no need to denormalize + blo LB9E2 ; brif FPA0 > FPA1 + sta FP0EXP ; replace result exponent with FPA1's (FPA1 is bigger) + lda FP1SGN ; also copy sign over + sta FP0SGN + ldx #FP0EXP ; point to FPA0 (we need to denormalize the smaller number) + negb ; invert the difference - this is the number of bits to shift the mantissa +LB9E2 cmpb #-8 ; do we have to shift by a whole byte? + ble LBA3F ; brif so start by shifting whole bytes to the right + clra ; clear overflow byte + lsr 1,x ; shift high bit of mantissa right (LSR will force a zero into the high bit) + jsr LBABA ; shift remainder of mantissa right -B times +LB9EC ldb RESSGN ; get the sign flag + bpl LB9FB ; brif signs are the same (we add the mantissas then) + com 1,x ; complement the mantissa and extra precision bytes + com 2,x + com 3,x + com 4,x + coma + adca #0 ; add one to A (COM sets C); this may cause a carry to enter the ADD below +LB9FB sta FPSBYT ; save extra precision byte + lda FPA0+3 ; add the main mantissa bytes (and propage carry from above) + adca FPA1+3 + sta FPA0+3 + lda FPA0+2 + adca FPA1+2 + sta FPA0+2 + lda FPA0+1 + adca FPA1+1 + sta FPA0+1 + lda FPA0 + adca FPA1 + sta FPA0 + tstb ; were signs the same? + bpl LBA5C ; brif so - number may have gotten bigger so normalize if needed +LBA18 bcs LBA1C ; brif we had a carry - result is positive?) + bsr LBA79 ; do a proper negation of FPA0 mantissa +LBA1C clrb ; clear temporary exponent accumulator +LBA1D lda FPA0 ; test high byte of mantissa + bne LBA4F ; brif not 0 - we need to do bit shifting + lda FPA0+1 ; shift left 8 bits + sta FPA0 + lda FPA0+2 + sta FPA0+1 + lda FPA0+3 + sta FPA0+2 + lda FPSBYT + sta FPA0+3 + clr FPSBYT + addb #8 ; account for 8 bits shifted + cmpb #5*8 ; shifted 5 bytes worth? + blt LBA1D ; brif not +LBA39 clra ; zero out exponent and sign - result is 0 +LBA3A sta FP0EXP ; set exponent and sign + sta FP0SGN +LBA3E rts +LBA3F bsr LBAAE ; shift FPA0 mantissa to the right + clrb ; clear carry + bra LB9EC ; get on with adding +LBA44 incb ; account for one bit shift + asl FPSBYT ; shift mantissa and extra precision left + rol FPA0+3 + rol FPA0+2 + rol FPA0+1 + rol FPA0 +LBA4F bpl LBA44 ; brif we haven't got a 1 in bit 7 + lda FP0EXP ; get exponent of result + pshs b ; subtract shift count from exponent + suba ,s+ + sta FP0EXP ; save adjusted exponent + bls LBA39 ; brif we underflowed - set result to 0 + skip2 +LBA5C bcs LBA66 ; brif mantissa overflowed + asl FPSBYT ; get bit 7 of expra precision to C (used for round off) + lda #0 ; set to 0 without affecting C + sta FPSBYT ; clear out extra precision bits + bra LBA72 ; go round off result +LBA66 inc FP0EXP ; bump exponent (for a right shift to bring carry in) + beq LBA92 ; brif we overflowed + ror FPA0 ; shift carry into mantissa, shift right + ror FPA0+1 + ror FPA0+2 + ror FPA0+3 +LBA72 bcc LBA78 ; brif no round-off needed + bsr LBA83 ; add one to mantissa + beq LBA66 ; brif carry - need to shift right again +LBA78 rts +LBA79 com FP0SGN ; invert sign of value +LBA7B com FPA0 ; first do a one's copmlement + com FPA0+1 + com FPA0+2 + com FPA0+3 +LBA83 ldx FPA0+2 ; add one to mantissa (after one's complement gives two's complement) + leax 1,x ; bump low word + stx FPA0+2 + bne LBA91 ; brif no carry from low word + ldx FPA0 ; bump high word + leax 1,x + stx FPA0 +LBA91 rts +LBA92 ldb #2*5 ; code for overflow + jmp LAC46 ; raise error +LBA97 ldx #FPA2-1 ; point to FPA2 +LBA9A lda 4,x ; shift mantissa right by 8 bits + sta FPSBYT + lda 3,x + sta 4,x + lda 2,x + sta 3,x + lda 1,x + sta 2,x + lda FPCARY ; and handle extra precision on the left + sta 1,x +LBAAE addb #8 ; account for 8 bits shifted + ble LBA9A ; brif more shifts needed + lda FPSBYT ; get sub byte (extra precision) + subb #8 ; undo the 8 added above + beq LBAC4 ; brif difference is 0 +LBAB8 asr 1,x ; shift mantissa and sub byte one bit (keep mantissa high bit set) +LBABA ror 2,x + ror 3,x + ror 4,x + rora + incb ; account for one shift + bne LBAB8 ; brif not enought shifts yet +LBAC4 rts +LBAC5 fcb 0x81,0x00,0x00,0x00,0x00 ; packed FP 1.0 +LBACA bsr LBB2F ; unpack FP value from (X) to FPA1 +; multiplication operator +LBACC beq LBB2E ; brif exponent of FPA0 is 0 (result is 0) + bsr LBB48 ; calculate exponent of product +LBAD0 lda #0 ; zero out mantissa of FPA2 + sta FPA2 + sta FPA2+1 + sta FPA2+2 + sta FPA2+3 + ldb FPA0+3 ; multiply FPA1 by LSB of FPA0 + bsr LBB00 + ldb FPSBYT ; save extra precision byte + stb VAE + ldb FPA0+2 + bsr LBB00 ; again for next byte of FPA0 + ldb FPSBYT + stb VAD + ldb FPA0+1 ; again for next byte of FPA0 + bsr LBB00 + ldb FPSBYT + stb VAC + ldb FPA0 ; and finally for the high byte + bsr LBB02 + ldb FPSBYT + stb VAB + jsr LBC0B ; copy mantissa from FPA2 to FPA0 (result) + jmp LBA1C ; normalize +LBB00 beq LBA97 ; brif multiplier is 0 - just shift, don't multiply +LBB02 coma ; set carry +LBB03 lda FPA2 ; get FPA2 MS byte + rorb ; data bit to carry; will be 0 when all shifts done + beq LBB2E ; brif 8 shifts done + bcc LBB20 ; brif data bit is 0 - no addition + lda FPA2+3 ; add mantissa of FPA1 and FPA2 + adda FPA1+3 + sta FPA2+3 + lda FPA2+2 + adca FPA1+2 + sta FPA2+2 + lda FPA2+1 + adca FPA1+1 + sta FPA2+1 + lda FPA2 + adca FPA1 +LBB20 rora ; shift carry into FPA2 + sta FPA2 + ror FPA2+1 + ror FPA2+2 + ror FPA2+3 + ror FPSBYT + clra ; clear carry + bra LBB03 +LBB2E rts +; Unpack FP value from (X) to FPA1 +LBB2F ldd 1,x ; copy mantissa (and sign) + sta FP1SGN ; save sign bit + ora #0x80 ; make sure mantissa has bit 7 set + std FPA1 + ldb FP1SGN ; get sign + eorb FP0SGN ; set if FPA0 sign differs + stb RESSGN + ldd 3,x ; copy remainder of mantissa + std FPA1+2 + lda ,x ; and exponent + sta FP1EXP + ldb FP0EXP ; fetch FPA0 exponent and set flags + rts +; Calculate eponent for product of FPA0 and FPA1 +LBB48 tsta ; is FPA1 zero? + beq LBB61 ; brif so + adda FP0EXP ; add to exponent of FPA0 (this is how scientific notation works) + rora ; set V if we *don't* have an overflow + rola + bvc LBB61 ; brif exponent too larger or small + adda #0x80 ; restore the bias + sta FP0EXP ; set result exponent + beq LBB63 ; brif 0 - clear FPA0 + lda RESSGN ; the result sign (negative if signs differ) is the result sign + sta FP0SGN ; so set it as such + rts +LBB5C lda FP0SGN ; get sign of FPA0 + coma ; invert sign + bra LBB63 ; zero sign and exponent +LBB61 leas 2,s ; don't go back to caller (mul/div) - return to previous caller +LBB63 lbpl LBA39 ; brif we underflowed - go zero things out +LBB67 jmp LBA92 ; raise overflow error +; fast multiply by 10 - leave result in FPA0 +LBB6A jsr LBC5F ; copy FPA0 to FPA1 (for addition later) + beq LBB7C ; brif exponent is 0 - it's a no-op then + adda #2 ; this gives "times 4" + bcs LBB67 ; raise overflow if required + clr RESSGN ; set result sign to "signs the same" + jsr LB9CD ; add FPA1 to FPA0 "times 5" + inc FP0EXP ; times 10 + beq LBB67 ; brif overflow +LBB7C rts +LBB7D fcb 0x84,0x20,0x00,0x00,0x00 ; packed FP constant 10.0 +; Divide by 10 +LBB82 jsr LBC5F ; move FPA0 to FPA1 + ldx #LBB7D ; point to constant 10 + clrb ; zero sign +LBB89 stb RESSGN ; result will be positive or zero + jsr LBC14 ; unpack constant 10 to FPA0 + skip2 ; fall through to division (divide FPA1 by 10) +LBB8F bsr LBB2F ; unpack FP number from (X) to FPA1 +; division operator +LBB91 beq LBC06 ; brif FPA0 is 0 - division by zero + neg FP0EXP ; get exponent of reciprocal of the divisor + bsr LBB48 ; calculate exponent of quotient + inc FP0EXP ; bump exponent (due to division algorithm below) + beq LBB67 ; brif overflow + ldx #FPA2 ; point to temporary storage location + ldb #4 ; do 5 bytes + stb TMPLOC ; save counter + ldb #1 ; shift counter and quotient byte +LBBA4 lda FPA0 ; compare mantissa of FPA0 to FPA1, set C if FPA1 less + cmpa FPA1 + bne LBBBD + lda FPA0+1 + cmpa FPA1+1 + bne LBBBD + lda FPA0+2 + cmpa FPA1+2 + bne LBBBD + lda FPA0+3 + cmpa FPA1+3 + bne LBBBD + coma ; set C if FPA0 = FPA1 (it "goes") +LBBBD tfr cc,a ; save "it goes" status + rolb ; rotate carry into quotient + bcc LBBCC ; brif carry clear - haven't done 8 shifts yet + stb ,x+ ; save quotient byte + dec TMPLOC ; done enough bytes? + bmi LBBFC ; brif done all 5 + beq LBBF8 ; brif last byte + ldb #1 ; reset shift counter and quotient byte +LBBCC tfr a,cc ; get back carry status + bcs LBBDE ; brif it "went" +LBBD0 asl FPA1+3 ; shift mantissa (dividend) left + rol FPA1+2 + rol FPA1+1 + rol FPA1 + bcs LBBBD ; brif carry - it "goes" so we have to bump quotient + bmi LBBA4 ; brif high order bit is set - compare mantissas + bra LBBBD ; otherwise, count a 0 bit and try next bit +LBBDE lda FPA1+3 ; subtract mantissa of FPA0 from mantissa of FPA1 + suba FPA0+3 + sta FPA1+3 + lda FPA1+2 + sbca FPA0+2 + sta FPA1+2 + lda FPA1+1 + sbca FPA0+1 + sta FPA1+1 + lda FPA1 + sbca FPA0 + sta FPA1 + bra LBBD0 ; go check for another go +LBBF8 ldb #0x40 ; only two bits in last byte (for rounding) + bra LBBCC ; go do the last byte +LBBFC rorb ; get low bits to bits 7,6 and C to bit 5 + rorb + rorb + stb FPSBYT ; save result extra precision + bsr LBC0B ; move FPA2 mantissa to FPA0 (result) + jmp LBA1C ; go normalize the result +LBC06 ldb #2*10 ; division by zero + jmp LAC46 ; raise error +; Copy mantissa of FPA2 to FPA0 +LBC0B ldx FPA2 ; copy high word + stx FPA0 + ldx FPA2+2 ; copy low word + stx FPA0+2 + rts +; unpack FP number at (X) to FPA0 +LBC14 pshs a ; save register + ldd 1,x ; get mantissa high word and sign + sta FP0SGN ; set sign + ora #0x80 ; make sure mantissa always has bit 7 set + std FPA0 + clr FPSBYT ; clear extra precision + ldb ,x ; get exponent + ldx 3,x ; copy mantissa low word + stx FPA0+2 + stb FP0EXP ; save exponent (and set flags) + puls a,pc ; restore register and return +LBC2A ldx #V45 ; point to FPA4 + bra LBC35 ; pack FPA0 there +LBC2F ldx #V40 ; point to FPA3 + skip2 ; fall through to pack FPA0 there +LBC33 ldx VARDES ; get variable descriptor pointer +; Pack FPA0 to (X) +LBC35 lda FP0EXP ; get exponent + sta ,x ; save it + lda FP0SGN ; get sign + ora #0x7f ; force set low bits - only keep sign in high bit + anda FPA0 ; merge in bits 6-0 of high byte of mantissa + sta 1,x ; save it + lda FPA0+1 ; copy next highest byte + sta 2,x + ldu FPA0+2 ; and the low word of the mantissa + stu 3,x + rts +; Copy FPA1 to FPA0; return with sign in A +LBC4A lda FP1SGN ; copy sign +LBC4C sta FP0SGN + ldx FP1EXP ; copy exponent, mantissa high byte + stx FP0EXP + clr FPSBYT ; clear extra precision + lda FPA1+1 ; copy mantissa second highest byte + sta FPA0+1 + lda FP0SGN ; set sign for return + ldx FPA1+2 ; copy low word of mantissa + stx FPA0+2 + rts +; Copy FPA0 to FPA1 +LBC5F ldd FP0EXP ; copy exponent and high byte of mantissa + std FP1EXP + ldx FPA0+1 ; copy middle bytes of mantissa + stx FPA1+1 + ldx FPA0+3 ; copy low byte of mantissa and sign + stx FPA1+3 + tsta ; set flags on exponent + rts +; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive +LBC6D ldb FP0EXP ; get exponent + beq LBC79 ; brif 0 +LBC71 ldb FP0SGN ; get sign +LBC73 rolb ; get sign to C + ldb #0xff ; set for negative result + bcs LBC79 ; brif negative + negb ; set to 1 for positive +LBC79 rts +; SGN function +SGN bsr LBC6D ; get sign of FPA0 +LBC7C stb FPA0 ; save result + clr FPA0+1 ; clear next lower 8 bits + ldb #0x88 ; exponent if mantissa is 8 bit integer +LBC82 lda FPA0 ; get high bits of mantissa + suba #0x80 ; set C if mantissa was positive (will cause a negation if it was negative) +LBC86 stb FP0EXP ; set exponent + ldd ZERO ; clear out low word + std FPA0+2 + sta FPSBYT ; clear extra precision + sta FP0SGN ; set sign to positive + jmp LBA18 ; normalize the result +; ABS function +ABS clr FP0SGN ; force FPA0 to be positive (yes, it's that simple) + rts +; Compare packed FP number at (X) to FPA0 +; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that +LBC96 ldb ,x ; get exponent of (X) + beq LBC6D ; brif (X) is 0 + ldb 1,x ; get MS byte of mantissa of (X) + eorb FP0SGN ; set bit 7 if signs of (X) and FPA0 differ + bmi LBC71 ; brif signs differ - no need to compare the magnitude +LBCA0 ldb FP0EXP ; compare exponents and brif different + cmpb ,x + bne LBCC3 + ldb 1,x ; compare mantissa (but we have to pack the FPA0 bits first + orb #0x7f ; keep only sign bit (note: signs are the same) + andb FPA0 ; merge in the mantissa bits from FPA0 + cmpb 1,x ; do the packed versions match? + bne LBCC3 ; brif not + ldb FPA0+1 ; compare second byte of mantissas + cmpb 2,x + bne LBCC3 + ldb FPA0+2 ; compare third byte of mantissas + cmpb 3,x + bne LBCC3 + ldb FPA0+3 ; compare low byte of mantissas, but use subtraction so B = 0 on match + subb 4,x + bne LBCC3 + rts ; return B = 0 if (X) = FPA0 +LBCC3 rorb ; shift carry to bit 7 (C set if FPA0 < (X)) + eorb FP0SGN ; invert the comparision sense if the signs are negative + bra LBC73 ; interpret comparison result +; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the +; result as a two's complement value. +LBCC8 ldb FP0EXP ; get exponent of FPA0 + beq LBD09 ; brif FPA0 is zero - we don't have to do anything, just blank it + subb #0xa0 ; calculate number of shifts to get to the correct exponent (binary point to the right) + lda FP0SGN ; do we have a positive number? + bpl LBCD7 ; brif so + com FPCARY ; negate the mantissa and set extra inbound precision to the correct sign + jsr LBA7B +LBCD7 ldx #FP0EXP ; point to FPA0 + cmpb #-8 ; moving by whole bytes? + bgt LBCE4 ; brif not + jsr LBAAE ; do bit shifting + clr FPCARY ; clear carry in byte + rts +LBCE4 clr FPCARY ; clear the extra carry in precision + lda FP0SGN ; get sign of value + rola ; get sign to carry (so rotate repeats the sign) + ror FPA0 ; shift the first bit + jmp LBABA ; do the shifting dance +; INT function +INT ldb FP0EXP ; get exponent + cmpb #0xa0 ; is the number big enough that there can be no fractional part? + bhs LBD11 ; brif so - we don't have to do anything + bsr LBCC8 ; go shift binary point to the right of the mantissa + stb FPSBYT ; save extra precision bits + lda FP0SGN ; get original sign + stb FP0SGN ; force result to be positive + suba #0x80 ; set C if we had a positive result + lda #0xa0 ; set exponent to match denormalized result + sta FP0EXP + lda FPA0+3 ; save low byte + sta CHARAC + jmp LBA18 ; go normalize (this will correct for the two's complement representation of negatives) +LBD09 stb FPA0 ; replace mantissa of FPA0 with contents of B + stb FPA0+1 + stb FPA0+2 + stb FPA0+3 +LBD11 rts +; Convert ASCII string to FP +; BUG: no overflow is checked on the decimal exponent in exponential notation. +LBD12 ldx ZERO ; zero out FPA0 and temporaries + stx FP0SGN + stx FP0EXP + stx FPA0+1 + stx FPA0+2 + stx V47 + stx V45 + bcs LBD86 ; brif input character is numeric + jsr RVEC19 ; do the RAM hook dance + cmpa #'- ; regular negative sign + bne LBD2D ; brif not + com COEFCT ; invert sign + bra LBD31 ; process stuff after the sign +LBD2D cmpa #'+ ; regular plus? + bne LBD35 ; brif not +LBD31 jsr GETNCH ; get character after sign + bcs LBD86 ; brif numeric +LBD35 cmpa #'. ; decimal point? + beq LBD61 ; brif so + cmpa #'E ; scientific notation + bne LBD65 ; brif not + jsr GETNCH ; eat the "E" + bcs LBDA5 ; brif numeric + cmpa #0xac ; negative sign (token)? + beq LBD53 ; brif so + cmpa #'- ; regular negative? + beq LBD53 ; brif so + cmpa #0xab ; plus sign (token)? + beq LBD55 ; brif so + cmpa #'+ ; regular plus? + beq LBD55 + bra LBD59 ; brif no sign found +LBD53 com V48 ; set exponent sign to negative +LBD55 jsr GETNCH ; eat the sign + bcs LBDA5 ; brif numeric +LBD59 tst V48 ; is the exponent sign negatvie? + beq LBD65 ; brif not + neg V47 ; negate base 10 exponent + bra LBD65 +LBD61 com V46 ; toggle decimal point flag + bne LBD31 ; brif we haven't seen two decimal points +LBD65 lda V47 ; get base 10 exponent + suba V45 ; subtract number of places to the right + sta V47 ; we now have a complete decimal exponent + beq LBD7F ; brif we have no base 10 shifting required + bpl LBD78 ; brif positive exponent +LBD6F jsr LBB82 ; divide FPA0 by 10 (shift decimal point left) + inc V47 ; bump exponent + bne LBD6F ; brif we haven't reached 0 yet + bra LBD7F ; return result +LBD78 jsr LBB6A ; multiply by 10 + dec V47 ; downshift the exponent + bne LBD78 ; brif not at 0 yet +LBD7F lda COEFCT ; get desired sign + bpl LBD11 ; brif it will be positive - no need to do anything + jmp LBEE9 ; flip the sign of FPA0 +LBD86 ldb V45 ; get the decimal count + subb V46 ; (if decimal seen, will add one; otherwise it does nothing) + stb V45 + pshs a ; save new digit + jsr LBB6A ; multiply partial result by 10 + puls b ; get back digit + subb #'0 ; remove ASCII bias + bsr LBD99 ; add B to FPA0 + bra LBD31 ; go process another digit +LBD99 jsr LBC2F ; save FPA0 to FPA3 + jsr LBC7C ; convert B to FP number + ldx #V40 ; point to FPA3 + jmp LB9C2 ; add FPA3 and FPA0 +LBDA5 ldb V47 ; get exponent value + aslb ; times 2 + aslb ; times 4 + addb V47 ; times 5 + aslb ; times 10 + suba #'0 ; remove ASCII bias + pshs b ; save acculated result + adda ,s+ ; add new digit to accumulated result + sta V47 ; save new accumulated decimal exponent + bra LBD55 ; interpret another exponent character +LBDB6 fcb 0x9b,0x3e,0xbc,0x1f,0xfd ; packed FP: 99999999.9 +LBDBB fcb 0x9e,0x6e,0x6b,0x27,0xfd ; packed FP: 999999999 +LBDC0 fcb 0x9e,0x6e,0x6b,0x28,0x00 ; pakced FP: 1E9 +LBDC5 ldx #LABE8-1 ; point to "IN" message + bsr LBDD6 ; output the string + ldd CURLIN ; get basic line number +LBDCC std FPA0 ; save 16 bit unsigned integer + ldb #0x90 ; exponent for upper 16 bits of FPA0 to be an integer + coma ; set C (force normalization to treat as positive) + jsr LBC86 ; zero bottom half, save exponent, and normalize + bsr LBDD9 ; convert FP number to ASCII string +LBDD6 jmp STRINOUT ; output string +; Convert FP number to ASCII string +LBDD9 ldu #STRBUF+3 ; point to buffer address that will not cause string to go to string space +LBDDC lda #0x20 ; default sign is a space character + ldb FP0SGN ; get sign of value + bpl LBDE4 ; brif positive + lda #'- ; use negative sign +LBDE4 sta ,u+ ; save sign + stu COEFPT ; save output buffer pointer + sta FP0SGN ; save sign character + lda #'0 ; result is 0 if exponent is 0 + ldb FP0EXP ; get exponent + lbeq LBEB8 ; brif FPA0 is 0 + clra ; base 10 exponent is 0 for > 1 + cmpb #0x80 ; is number > 1? + bhi LBDFF ; brif so + ldx #LBDC0 ; point to 1E+09 + jsr LBACA ; shift decimal to the right by 9 spaces + lda #-9 ; account for shift +LBDFF sta V45 ; save base 10 exponent +LBE01 ldx #LBDBB ; point to 999999999 + jsr LBCA0 ; are we above that? + bgt LBE18 ; brif so +LBE09 ldx #LBDB6 ; point to 99999999.9 + jsr LBCA0 ; are we above that? + bgt LBE1F ; brif in range + jsr LBB6A ; multiply by 10 (we were small) + dec V45 ; account for shift + bra LBE09 ; see if we've come into range +LBE18 jsr LBB82 ; divide by 10 + inc V45 ; account for shift + bra LBE01 ; see if we've come into range +LBE1F jsr LB9B4 ; add 0.5 to FPA0 (rounding) + jsr LBCC8 ; do the integer dance + ldb #1 ; default decimal flag (force immediate decimal) + lda V45 ; get base 10 exponent + adda #10 ; account for "unormalized" number + bmi LBE36 ; brif number < 1.0 + cmpa #11 ; do we have more than 9 places? + bhs LBE36 ; brif so - do scientific notation + deca + tfr a,b + lda #2 ; force no scientific notation +LBE36 deca ; subtract wo without affecting carry + deca + sta V47 ; save exponent - 0 is do not display in scientific notation + stb V45 ; save number of places to left of decimal + bgt LBE4B ; brif >= 1 + ldu COEFPT ; point to string buffer + lda #'. ; put decimal + sta ,u+ + tstb ; is there anything to left of decimal? + beq LBE4B ; brif not + lda #'0 ; store a zero + sta ,u+ +LBE4B ldx #LBEC5 ; point to powers of 10 + ldb #0x80 ; set digit counter to 0x80 +LBE50 lda FPA0+3 ; add mantissa to power of 10 + adda 3,x + sta FPA0+3 + lda FPA0+2 + adca 2,x + sta FPA0+2 + lda FPA0+1 + adca 1,x + sta FPA0+1 + lda FPA0 + adca ,x + sta FPA0 + incb ; add one to digit counter + rorb ; put carry into bit 7 + rolb ; set V if carry and sign differ + bvc LBE50 ; brif positive mantissa or carry is 0 and negative mantissa + bcc LBE72 ; brif negative mantissa + subb #10+1 ; take 9's complement if adding mantissa + negb +LBE72 addb #'0-1 ; add ASCII bias + leax 4,x ; move to next power of 10 + tfr b,a ; save digit + anda #0x7f ; remove add/subtract flag + sta ,u+ ; put in output + dec V45 ; do we need a decimal yet? + bne LBE84 ; brif not + lda #'. ; put decimal + sta ,u+ +LBE84 comb ; toggle bit 7 (add/sub flag) + andb #0x80 ; only keep bit 7 + cmpx #LBEC5+9*4 ; done all places? + bne LBE50 ; brif not +LBE8C lda ,-u ; get last character + cmpa #'0 ; was it 0? + beq LBE8C ; brif so + cmpa #'. ; decimal? + bne LBE98 ; brif not + leau -1,u ; move past decimal if it isn't needed +LBE98 lda #'+ ; plus sign + ldb V47 ; get scientific notation exponent + beq LBEBA ; brif not scientific notation + bpl LBEA3 ; brif positive exponent + lda #'- ; negative sign for base 10 exponent + negb ; switch to positive exponent +LBEA3 sta 2,u ; put sign + lda #'E ; put "E" + sta 1,u + lda #'0-1 ; init to ASCII 0 (compensate for INC) +LBEAB inca ; bump digit + subb #10 ; have we hit the correct one yet? + bcc LBEAB ; brif not + addb #'9+1 ; convert units digit to ASCII + std 3,u ; put exponent in output + clr 5,u ; put trailing NUL + bra LBEBC ; go reset pointer +LBEB8 sta ,u ; store last character +LBEBA clr 1,u ; put NUL at the end +LBEBC ldx #STRBUF+3 ; point to start of string + rts +LBEC0 fcb 0x80,0x00,0x00,0x00,0x00 ; packed FP 0.5 +LBEC5 fqb -100000000 + fqb 10000000 + fqb -1000000 + fqb 100000 + fqb -10000 + fqb 1000 + fqb -100 + fqb 10 + fqb -1 +LBEE9 lda FP0EXP ; get exponent of FPA0 + beq LBEEF ; brif 0 - don't flip sign + com FP0SGN ; flip sign +LBEEF rts +; Expand a polynomial of the form +; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table +LBEF0 stx COEFPT ; save coefficient table pointer + jsr LBC2F ; copy FPA0 to FPA3 + bsr LBEFC ; multiply FPA3 by FPA0 + bsr LBF01 ; expand polynomial + ldx #V40 ; point to FPA3 +LBEFC jmp LBACA ; multiply FPA0 by FPA3 +LBEFF stx COEFPT ; save coefficient table counter +LBF01 jsr LBC2A ; move FPA0 to FPA4 + ldx COEFPT ; get the current coefficient + ldb ,x+ ; get the number of entries + stb COEFCT ; save as counter + stx COEFPT ; save new pointer +LBF0C bsr LBEFC ; multiply (X) and FPA0 + ldx COEFPT ; get this coefficient + leax 5,x ; move to next one + stx COEFPT ; save new pointer + jsr LB9C2 ; add (X) to FPA0 + ldx #V45 ; point X to FPA4 + dec COEFCT ; done all coefficients? + bne LBF0C ; brif more left + rts +; RND function +RND jsr LBC6D ; set flags on FPA0 + bmi LBF45 ; brif negative - set seed + beq LBF3B ; brif 0 - do random between 0 and 1 + bsr LBF38 ; convert to integer + jsr LBC2F ; save range value + bsr LBF3B ; get random number + ldx #V40 ; point to FPA3 + bsr LBEFC ; multply (X) by FPA0 + ldx #LBAC5 ; point to FP 1.0 + jsr LB9C2 ; add 1 to FPA0 +LBF38 jmp INT ; return integer value +LBF3B ldx RVSEED+1 ; move variable random number seed to FPA0 + stx FPA0 + ldx RVSEED+3 + stx FPA0+2 +LBF45 ldx RSEED ; move fixed seed to FPA1 + stx FPA1 + ldx RSEED+2 + stx FPA1+2 + jsr LBAD0 ; multiply them + ldd VAD ; get lowest order product bytes + addd #0x658b ; add a constant + std RVSEED+3 ; save it as new seed + std FPA0+2 ; save in result + ldd VAB ; get high order extra product bytes + adcb #0xb0 ; add upper bytes of constant + adca #5 + std RVSEED+1 ; save as new seed + std FPA0 ; save as result + clr FP0SGN ; set result to positive + lda #0x80 ; set exponent to 0 < FPA0 < 1 + sta FP0EXP + lda FPA2+2 ; get a byte from FPA2 + sta FPSBYT ; save as extra precision + jmp LBA1C ; go normalize FPA0 +RSEED fqb 0x40e64dab ; constant random number generator seed +; SIN function +SIN jsr LBC5F ; copy FPA0 to FPA1 + ldx #LBFBD ; point to 2*pi + ldb FP1SGN ; get sign of FPA1 + jsr LBB89 ; divide FPA0 by 2*pi + jsr LBC5F ; copy FPA0 to FPA1 + bsr LBF38 ; convert FPA0 to an integer + clr RESSGN ; set result to positive + lda FP1EXP ; get exponent of FPA1 + ldb FP0EXP ; get exponent of FPA0 + jsr LB9BC ; subtract FPA0 from FPA1 + ldx #LBFC2 ; point to FP 0.25 + jsr LB9B9 ; subtract FPA0 from 0.25 (pi/2) + lda FP0SGN ; get result sign + pshs a ; save it + bpl LBFA6 ; brif positive + jsr LB9B4 ; add 0.5 (pi) to FPA0 + lda FP0SGN ; get sign of result + bmi LBFA9 ; brif negative + com RELFLG ; if 3pi/2 >= arg >= pi/2 +LBFA6 jsr LBEE9 ; flip sign of FPA0 +LBFA9 ldx #LBFC2 ; point to 0.25 + jsr LB9C2 ; add 0.25 (pi/2) to FPA0 + puls a ; get original sign + tsta ; was it positive + bpl LBFB7 ; brif so + jsr LBEE9 ; flip result sign +LBFB7 ldx #LBFC7 ; point to series coefficients + jmp LBEF0 ; go calculate value +LBFBD fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi +LBFC2 fcb 0x7f,0x00,0x00,0x00,0x00 ; 0.25 +; modified taylor series SIN coefficients +LBFC7 fcb 6-1 ; six coefficients + fcb 0x84,0xe6,0x1a,0x2d,0x1b ; -((2pi)^11)/11! + fcb 0x86,0x28,0x07,0xfb,0xf8 ; ((2pi)^9)/9! + fcb 0x87,0x99,0x68,0x89,0x01 ; -((2pi)^7)/7! + fcb 0x87,0x23,0x35,0xdf,0xe1 ; ((2pi)^5)/5! + fcb 0x86,0xa5,0x5d,0xe7,0x28 ; -(2pi)^3)/3! + fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi +; these 12 bytes are unused + fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43 + fcb 0x89,0xcd,0xa6,0x81 +; these are a copy of the interrupt vectors that live at the top of the ROM. It's not clear +; why these vectors have been modified since they are not actually used. + fdb INT.SWI3 ; SWI3 + fdb INT.SWI2 ; SWI2 + fdb INT.FIRQ ; FIRQ + fdb INT.IRQ ; IRQ + fdb INT.SWI ; SWI + fdb INT.NMI ; NMI + fdb L8C1B ; RESET +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Coco3 internal ROM, upper 32K +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This is the initialization code specific to the Coco3. This handles copying the ROMs to RAM and adding various patches in. +; This sequence of code demonstrates clearly that the creators of the Coco3 additions were rushed and didn't have a clear +; understanding of the Coco3 hardware or how Color Basic works. There is evidence of last minute adjustments along with code +; that serves no purpose but which is still present. +; +; There is also a major bug. The F1 for burst phase invert enable is clearly supposed to be enabled for the HSCREEN graphics +; modes. However, the code that enables it actually patches the wrong byte in the graphics mode initializers. Instead of enabling +; the burst phase invert bit in FF98, it actually enables the FIRQ enable bit in FF90. +SC000 orcc #0x50 ; make sure interrupts are disabled + lds #0x5eff ; put the stack somewhere + lda #0x12 ; nuclear green colour + ldb #16 ; 16 palette registers + ldx #PALETREG ; point to palette registers +SC00D sta ,x+ ; set a palette register to green + decb ; done? + bne SC00D ; brif not + ldx #MMUREG ; point to MMU registers + leay MMUIMAGE,pcr ; point to MMU initializer + ldb #16 ; there are 16 MMU registers +SC01B lda ,y+ ; copy an MMU initializer + sta ,x+ + decb ; done all? + bne SC01B ; brif not + lda #COCO+MMUEN+MC3+MC2+MC1 ; enable coco compatible, mmu, SCS, FExx, and 32K internal + sta INIT0 + leax BEGMOVE,pcr ; point to start of relocated initialization code + ldy #0x4000 ; point to RAM address where it goes +SC02F ldd ,x++ ; copy four bytes + ldu ,x++ + std ,y++ + stu ,y++ + cmpx #ENDMOVE ; copied everything? + blo SC02F ; brif not + jmp 0x4000 ; transfer control to code in RAM +; The rest runs from RAM. This allows it to mess with the ROM mapping (for the ROM/RAM copy). Unfortunately, +; this clobbers an 8K memory block *before* it determines that it isn't going to copy ROM to RAM which is +; somewhat problematic for things that intercept a warm start. +BEGMOVE leas -1,s ; make a hole on the stack + nop ; space fillers; probably something removed at the eleventh hour + nop + nop + nop + nop + lda #0xff ; set GIME timer to maximum value and start it counting + sta V.TIMER + sta V.TIMER+1 + leax VIDIMAGE,pcr ; point to video mode initializer + ldy #VIDEOMOD ; point to video mode registers +SC056 lda ,x+ ; copy a byte + sta ,y+ + cmpy #MMUREG ; done? + bne SC056 ; brif not + ldx #PIA1 ; point to PIA1 + ldd #0xff34 ; set up for initializing PIAs + clr 1,x ; set PIA1 DA to direction mode + clr 3,x ; set PIA1 DB to direction mode + deca + sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input + lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input + sta 2,x + stb 1,x ; set PIA1 DA to data mode + stb 3,x ; set PIA1 DB to data mode + clr 2,x ; set VDG to alpha-numeric + lda #2 ; set RS232 to marking + sta ,x + lda #0xff + ldx #PIA0 ; point to PIA0 + clr 1,x ; set PIA0 DA to direction mode + clr 3,x ; set PIA0 DB to direction mode + clr ,x ; set PIA0 DA to input + sta 2,x ; set PIA0 DB to output + stb 1,x ; set PIA0 DA to direction mode + stb 3,x ; set PIA0 DB to direction mode + ldb #12 ; there are 12 SAM bits to reset + ldu #SAMREG ; point to SAM register +SC091 sta ,u++ ; clear a bit + decb ; done all? + bne SC091 ; brif not + sta SAMREG+9 ; put VDG display at 0x400 + tfr b,dp ; set direct page to 0 + clr 2,x ; strobe all keyboard columns (pointless) + sta -3,u ; select RAM page 1 (also pointless) + ldx #PIA0 ; point to PIA0 (unneeded - already points there) + ldb #0xdf ; column strobe for F1 + stb 2,x ; strobe for F1 + lda ,x ; get row data + coma ; set nonzero if F1 down + anda #0x40 + sta ,s ; save F1 state for later + ldy #2 ; check for two keys +SC0B1 asrb ; shift strobe (why not just shift directly in the PIA?) + stb 2,x ; strobe new column + lda ,x ; get row data + coma ; set nonzero if CTRL or ALT is down + anda #0x40 + beq SC0C2 ; brif not - we don't have C-A-RESET + leay -1,y ; done both? + bne SC0B1 ; brif not + lbra SC1F0 ; go do easter egg picture if C-A-RESET +SC0C2 lda #COCO+MMUEN+MC3+MC1 ; turn off standard SCS (why?) + sta INIT0 +; This checks if we have a valid warm start routine. If there is one, we don't do a ROM/RAM copy. This and +; everything above could just as easily have been done from ROM. + lda INT.FLAG ; are the bounce vectors valid? + cmpa #0x55 + bne SC0F6 ; brif not - copy ROM to RAM + lda RSTFLG ; is the DP reset vector marked valid? + cmpa #0x55 + bne NOWARM ; brif not + ldx RSTVEC ; does the vector point to NOP? + lda ,x + cmpa #0x12 + lbeq SC18C ; brif so - don't do ROM/RAM copy +NOWARM clr MMUREG ; put bottom memory block in logical block 0 (replaces DP) + lda RSTFLG ; does this give us a valid reset vector? + cmpa #0x55 + bne SC0F1 ; brif not + ldx RSTVEC ; does this routine point to a NOP? + lda ,x + cmpa #0x12 + lbeq SC18C ; brif so - don't do ROM/RAM copy and keep modified memory map +SC0F1 lda #BLOCK7.0 ; restore memory map + sta MMUREG +SC0F6 ldx #DOSBAS ; point to the end of Color Basic + ldy #EXBAS ; point to start of Extended Basic + lbsr SC1AA ; copy them to RAM + leay PATCHTAB,pcr ; point to patch table + lda ,y+ ; get number of patches to be made +SC106 pshs a ; save patch counter + ldx ,y++ ; get address to patch + ldb ,y+ ; get number of bytes in the patch +SC10C lda ,y+ ; copy a byte + sta ,x+ + decb ; done all in this patch? + bne SC10C + puls a ; get back patch counter + deca ; done all patches? + bne SC106 ; brif not + clr TYCLR ; got back to ROM mode + lda #COCO+MMUEN+MC3 ; set up for 16K split mode + sta INIT0 + ldd DOSBAS ; is there a Disk Basic ROM signature? + cmpa #'D ; (note that this should just be CMPD) + bne SC137 + cmpb #'K + bne SC137 + ldx #SUPERVAR ; point to end of Disk Basic ROM + ldy #DOSBAS ; point to start of Disk Basic ROM + bsr SC1AA ; copy it to RAM + lbsr SC322 ; add patches to Disk Basic +SC137 clr TYCLR ; go back to ROM mode + lda #COCO+MMUEN+MC3+MC1 ; set 32K internal mocde + sta INIT0 + ldx #H.CRSLOC ; point to end of the Coco3 additions + ldy #SUPERVAR ; point to start of the Coco3 additions + bsr SC1AA ; copy it to RAM + lbsr SC1DE ; set up an easter egg + leay INTIMAGE,pcr ; point to bounce vector initializer + ldx #INT.FLAG ; point to bounce vectors + ldb #19 ; 19 bytes in bounce vectors + lbsr MOVE.XY ; initialize the bounce vectors + clr TYSET ; enable RAM mode (the ROM/RAM copy already did this) + tst ,s ; was F1 pressed? + beq SC180 ; brif not + ldx #IM.TEXT ; point to text mode initializers + ldb #3 ; there are three sets of them + leax 1,x ; move past the FF90 initializer +SC165 lda ,x ; get video mode initializer + ora #0x20 ; enable burst phase invert + sta ,x ; update initializer + leax 9,x ; move to next mode + decb ; done all of them? + bne SC165 ; brif not + ldb #2 ; two graphics mode initalizers + ldx #IM.GRAPH ; point to graphics mode initializers (should be +1; we're actually enabling GIME FIRQ) +SC175 lda ,x ; get initializer + ora #0x20 ; enable burst phase invert (or it would if X pointed to the right place) + sta ,x ; save modified initializer + leax 9,x ; move to next set + decb ; done all of them? + bne SC175 ; brif not +SC180 ldx #VIDRAM ; point to start of VDG text screen + lda #0x60 ; VDG space character +SC185 sta ,x+ ; blank a character + cmpx #VIDRAM+512 ; end of screen? + blo SC185 ; brif not +SC18C lda #COCO+MMUEN+MC3+MC2+MC1 ; turn the SCS back on + sta INIT0 + tst ,s ; F1? + beq SC19A ; brif not + lda #0x20 ; enable burst phase invert + sta VIDEOMOD +SC19A ldx #PALETREG ; point to palette registers + leay PALIMAGE,PCR ; point to palette initializer + ldb #16 ; do 16 palette registers + bsr MOVE.XY ; initialize palette + leas 1,s ; clean up stack (not much point since it will be reset anyway) + jmp RESVEC ; transfer control to the original Color Basic initialization routine +SC1AA stx 0x5f02 ; save end copy address + sts 0x5f00 ; save stack +SC1B1 clr TYCLR ; go to ROM mode + ldd ,y ; grab 8 bytes + ldx 2,y + ldu 4,y + lds 6,y + clr TYSET ; go to RAM mode + std ,y ; save the 8 bytes + stx 2,y + stu 4,y + sts 6,y + leay 8,y ; move pointer forward + cmpy 0x5f02 ; done yet? + blo SC1B1 ; brif not + lds 0x5f00 ; restore stack pointer + rts +MOVE.XY lda ,y+ ; copy a byte + sta ,x+ + decb ; done all? + bne MOVE.XY ; brif not + rts +SC1DE ldx #AUTHORMS ; point to author name easter egg + leay SC30D,pcr ; point to encoded names + ldb #21 ; 21 bytes in names +SC1E7 lda ,y+ ; get encoded byte + coma ; decode (wow. one's complement encoding.) + sta ,x+ ; put in copied ROM + decb ; done all? + bne SC1E7 ; brif not + rts +SC1F0 clra ; set up to mark things as invalid + sta INT.FLAG ; mark bounce vectors invalid + sta RSTFLG ; mark reset vector invalid + sta TYCLR ; go to ROM mode + ldb #9 ; foreground colour for image + stb PALETREG+10 + ldb #63 ; white background + stb PALETREG+11 + ldx #AUTHPIC ; point to author picture data + ldy #0xe00 ; put picture at 0xe00 in memory +SC20A ldd ,x++ ; copy four bytes + ldu ,x++ + std ,y++ + stu ,y++ + cmpx #AUTHPICe ; at end of picture data? + blo SC20A ; brif not + lda #0xf9 ; 256x192, CSS0 VDG mode + sta PIA1+2 + clra ; this instruction is useless + ldx #SAMREG ; point to SAM register + sta ,x ; set SAM address to 0xe00 and video mode to 256x192 + sta 3,x + sta 5,x + sta 7,x + sta 9,x + sta 11,x +WAITLOOP bra WAITLOOP ; freeze the system +VIDIMAGE fcb 0x00,0x00,0x00,0x00,0x0f,0xe0,0x00,0x00 +PALIMAGE fcb 18,36,11,7,63,31,9,38,0,18,0,63,0,18,0,38 +MMUIMAGE fcb BLOCK7.0,BLOCK7.1,BLOCK6.4,BLOCK7.3 + fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7 + fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2 + fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7 +PATCHTAB fcb 27 ; 27 patches to install +; Patch #1: enable warm start routine after ROM/RAM copy +patch1 fdb XBWMST + fcb patch2-*-1 + nop +; Patch #2: intercept tokenization routine +patch2 fdb LB8D4 + fcb patch3-*-1 + jmp ALINK2 +; Patch #3: intercept detokenization routine +patch3 fdb LB7F3 + fcb patch4-*-1 + jmp ALINK3 +; Patch #4: intercept Extended Basic's command interpretation handler +patch4 fdb L8150 + fcb patch5-*-1 + jmp ALINK4 + nop +; Patch #5: intercept Extended Basic's function handler +patch5 fdb L816C + fcb patch6-*-1 + jmp ALINK5 + nop +; Patch #6 through patch #10 - extend &H and &O to allow 24 bit values +patch6 fdb L8834 + fcb patch7-*-1 + jmp ALINK6A + clr FPA0+1 + clr FPA0+2 + clr FPA0+3 + bra *-78 + clr FPA0 + bra *-47 + jmp ALINK6B +patch7 fdb L87EB + fcb patch8-*-1 + bra *+76 + nop + rts + ldx #FPA0+1 +patch8 fdb L880C + fcb patch9-*-1 + bra *+55 +patch9 fdb L8826 + fcb patch10-*-1 + bcs *+25 +patch10 fdb L87E7 + fcb patch11-*-1 + bne *+7 +; Patch #11 is needed because the above removed an RTS used by this routine +patch11 fdb L886A + fcb patch12-*-1 + bne *-124 +; Patch #12 - intercept signon message display +patch12 fdb L80B2 + fcb patch13-*-1 + jmp ALINK12 +; Patch #13 - remove one carriage return from signon message +patch13 fdb L80E8+82 + fcb patch14-*-1 + fcb 0 +; Patch #14 - extend Extended Basic's graphics initialization routine +patch14 fdb L9703 + fcb patch15-*-1 + jmp ALINK14 +; Patch #15 - intercept break check +patch15 fdb LADF0 + fcb patch16-*-1 + jmp ALINK15 + nop +; Patch #16 - intercept break check when handling "line input" +patch16 fdb LA3C2 + fcb patch17-*-1 + jmp ALINK16 + nop +; Patch #17 - cause INPUT to respond to ON BRK +patch17 fdb LB03C+1 + fcb patch18-*-1 + fdb ALINK17 +; Patch #18 - intercept ON command +patch18 fdb ON + fcb patch19-*-1 + jmp ALINK18 +; Patch #19 - add on extra stuff to end of NEW +patch19 fdb LAD3F + fcb patch20-*-1 + jmp ALINK19 + nop +; Patch #20 - intercept error handler +patch20 fdb LAC46 + fcb patch21-*-1 + jmp ALINK20 +; Patch #21 - intercept immediate mode loop +patch21 fdb LAC73 + fcb patch22-*-1 + jmp ALINK21 +; Patch #22 - intercept character to screen routine +patch22 fdb LA30A + fcb patch23-*-1 + jmp L8C37 +; Patch #23 - intercept CLS +patch23 fdb CLS + fcb patch24-*-1 + jmp L8C46 +; Patch #24 - intercept waiting for keypress with cursor routine +patch24 fdb LA1B1 + fcb patch25-*-1 + jmp LA0CE + nop + nop + nop + nop + nop +; Patch #25 - intercept PRINT @ +patch25 fdb LB902 + fcb patch26-*-1 + jmp ALINK25 +; Patch #26 - intercept conditional newline routine +patch26 fdb LB95C + fcb patch27-*-1 + jmp ALINK26 +; Patch #27 - intercept CLEAR handling in line input routine +patch27 fdb LA38D + fcb patch27e-*-1 + jmp ALINK27 +patch27e equ * +; Names of the authors in one's complemented ASCII +SC30D fcb 0xab,0xd1,0xb7,0x9e,0x8d,0x8d,0x96,0x8c + fcb 0xdf,0xd9,0xdf,0xab,0xd1,0xba,0x9e,0x8d + fcb 0x93,0x9a,0x8c,0xf2,0xff +SC322 lda DOSBAS+4 ; get MSB of DSKCON vector + cmpa #0xd6 ; is it 0xd6? + bne SC334 ; brif not - we have Disk Basic 1.1 + ldx #0xc0c6 ; point to patch address in Disk Basic 1.0 + leay SC355,pcr ; point to patch for Disk Basic 1.0 + ldb ,y+ ; get number of bytes to patch + bra SC349 ; go patch it +SC334 ldx #0xC8B4 ; point to Disk Basic 1.1 keyboard check (in the interpretation loop handler) + lda #0x12 ; NOP opcode + ldb #11 ; clobber 11 bytes (which check for a key down before calling the break check) +SC33B sta ,x+ ; put a NOP + decb ; done? + bne SC33B ; brif not + ldx #0xc0d9 ; point to the Disk Basic 1.1 patch address + leay SC351,pcr ; point to patch for Disk Basic 1.1 + ldb ,y+ ; get number of bytes in patch +SC349 lda ,y+ ; put a byte from the patch + sta ,x+ + decb ; done yet? + bne SC349 ; brif not + rts +; Copyright message patch for Disk Basic 1.1 +SC351 fcb SC355-*-1 + jmp ALINK29 +; Copyright message patch for Disk Basic 1.0 +SC355 fcb SC355e-*-1 + jmp ALINK28 +SC355e equ * +; This is the initializer for the bounce vector table. It sets up to transfer control to Color Basic's +; interrupt vectors at 0x100. These really should be JMP instead of LBRA, if only because JMP is faster. +INTIMAGE fcb 0x55 ; valid vector table flag + lbra (INTIMAGE+1)-(INT.JUMP)+SW3VEC ; SWI3 + lbra (INTIMAGE+1)-(INT.JUMP)+SW2VEC ; SWI2 + lbra (INTIMAGE+1)-(INT.JUMP)+FRQVEC ; FIRQ + lbra (INTIMAGE+1)-(INT.JUMP)+IRQVEC ; IRQ + lbra (INTIMAGE+1)-(INT.JUMP)+SWIVEC ; SWI + lbra (INTIMAGE+1)-(INT.JUMP)+NMIVEC ; NMI +ENDMOVE equ * +; Unused bytes + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x55,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x18,0x00,0x0E,0x00 +; This is the "pmode 4" author picture easter egg +AUTHPIC fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFB,0xEE,0xEF,0xFB,0xFF,0xBB,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB + fcb 0xBB,0xBB,0xBF,0xBB,0xBB,0xFF,0xBF,0xFF,0xFE,0xEF,0xFF,0xFF,0xFF,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xBB,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEE,0xFE,0xEE + fcb 0xEE,0xEE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEE,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xFF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xAA,0xAE,0xAA,0xAE,0xAA,0xEA,0xBB,0xBB,0xFB,0xFF,0xBB,0xFF,0xBF,0xBF + fcb 0xFF,0xFB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBB,0xBA,0xEA,0xAA,0xEE,0xAE,0xEE,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF + fcb 0xFF,0xFE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBB,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xAA,0xEE,0xAA,0xAA,0xAA,0xEA,0xAB,0xBB,0xBB,0xFF,0xBB,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xFF,0xBB,0xBB,0xEA,0xAE,0xAA,0xAA,0xAF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEF,0xEE,0xEE,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEE,0xFF,0xEF,0xEE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xEA,0xAA,0xBB,0xBB,0xBB,0xBB,0xBB,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFB,0xFB,0xBB,0xBB,0xBA,0xAA,0xAA,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEE,0xEF,0xFE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBB,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x0F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEA,0xAB,0xAA,0xAB,0xBB,0xBB,0xBF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x7F + fcb 0xFF,0xFF,0xC0,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xBF,0xAA,0xAA,0xAA,0xEF,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEE,0xFF,0xFF,0xFF,0xEE,0xFF,0xFF,0x80,0x00,0x3F + fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xAB,0xAE,0xEB,0xBB,0xBF,0xFB,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x1F + fcb 0xFF,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xBB,0xAA,0xAA,0xBE,0xAB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xFB,0xBB,0xBB,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF,0x80,0x00,0x0F + fcb 0xFF,0xFE,0x00,0x00,0x3F,0xFF,0xFF,0xEF,0xEF,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEA,0xAB,0xBA,0xAB,0xBB,0xFB,0xFF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x07 + fcb 0xFF,0xFC,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFB,0xAA,0xFF,0xFE,0xEA,0xAB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x03 + fcb 0xFF,0xF8,0x00,0x00,0x3F,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0xFE,0xEE,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xAA,0xFB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x01 + fcb 0xFF,0xF0,0x00,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xAE,0xBB,0xBE,0xAF,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFE,0xFF,0xFF,0xFF,0xFF,0x80,0x08,0x00 + fcb 0xFF,0xE0,0x02,0x00,0x3F,0xFF,0xFF,0xFE,0xEF,0xEE,0xFF,0xEE,0xEF,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xAA,0xBB,0xBB,0xFB,0xBB,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 + fcb 0x7F,0xC0,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBF,0xEB,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0E,0x00 + fcb 0x3F,0x80,0x0E,0x00,0x3F,0xFF,0xFF,0xFE,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF3,0xEA,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x00 + fcb 0x1F,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x80 + fcb 0x0E,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xEE,0xFF,0xFF,0xFF,0xFE,0xEF,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF + fcb 0xFF,0xF6,0xEA,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0 + fcb 0x00,0x00,0x7E,0x00,0x3F,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBA,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xE0 + fcb 0x00,0x00,0xFE,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xFE,0xEF,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF6,0xEB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0 + fcb 0x00,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEB,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00 + fcb 0x00,0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBA,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 + fcb 0x00,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEB,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFC,0x00,0x0F,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xAA,0x7F,0xFF + fcb 0xFF,0xF6,0xAB,0xBB,0xFF,0xFF,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 + fcb 0x00,0x00,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x79,0x9F,0xFB,0xAB,0x7F,0xFF + fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xF8,0x00,0x00,0x01,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00 + fcb 0x00,0x38,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x03,0xFE,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x4F,0xFF,0xFF,0xFF,0x80,0x00,0x00 + fcb 0x01,0x7C,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x00,0xFA,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x01,0xFF,0xFF,0xF0,0x00,0x00,0x00 + fcb 0x03,0xFE,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x7E,0xEE,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0x80,0x00,0x00 + fcb 0x0F,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x3B,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xFF,0xFF,0x00,0x00 + fcb 0x2F,0xFF,0x00,0x7F,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00,0x0E,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xFF,0x80,0x00,0x01 + fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x07,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF0,0x00,0x00,0x03 + fcb 0xFF,0xFF,0x40,0x00,0x03,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x03,0xEE,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xFF,0xF0,0x00,0x00,0x00,0x01,0x00,0x1F,0xFF,0xFF,0x80,0x01,0x07 + fcb 0xFF,0xFF,0xA0,0x00,0x3F,0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x01,0xBB,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x01,0x80,0x1F,0xFF,0xFF,0xFE,0x0E,0x2F + fcb 0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x65,0xE0,0x0F,0xFF,0xFF,0x80,0x0C,0x1F + fcb 0xFF,0xFF,0xE0,0x00,0x3F,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x3B,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xC0,0x00,0x00,0x0B,0xFF,0xF0,0x0F,0xFF,0xFC,0x00,0x18,0x0F + fcb 0xF8,0x00,0x60,0x00,0x07,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xFF,0xC0,0x00,0x01,0xFF,0xFF,0xF8,0x0F,0xFF,0xFF,0x80,0x00,0x01 + fcb 0xF8,0x00,0x20,0x00,0x3F,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x1B,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x80,0x00,0x03,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xFC,0x03,0x03 + fcb 0xFF,0x7F,0xF0,0x03,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF + fcb 0xFF,0xF7,0xFE,0xFF,0x80,0x01,0x5D,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xC0,0x07,0xF1 + fcb 0xFC,0x07,0xFC,0x00,0x3F,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x03,0x7F,0xFF + fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x02,0xEF,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0x00,0x0E,0x00 + fcb 0x7C,0x00,0xF4,0x00,0x0C,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF + fcb 0xFF,0xF2,0xAB,0xFF,0x00,0x05,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1C,0x00 + fcb 0xFC,0x01,0xF8,0x01,0xFB,0xBF,0xFF,0xF8,0x00,0x00,0x0F,0xE1,0x80,0x0B,0x7F,0xFF + fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x03,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1F,0xC0 + fcb 0xFE,0x3F,0xFC,0x01,0xF6,0xDF,0xFF,0xF8,0x00,0x3F,0xFF,0xFF,0x80,0x0E,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x07,0xFF,0xFF,0xFF,0xFE,0x0F,0xFE,0xFF,0xFC,0x1F,0xF1 + fcb 0xFF,0x9F,0xF8,0x37,0xF5,0xDF,0xFF,0xF8,0x00,0xFF,0xFF,0xFF,0x80,0x0B,0x7F,0xFF + fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xF8,0x0F,0xEF + fcb 0x7F,0xFF,0xFC,0x03,0xF6,0xDF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0x80,0x06,0x7F,0xFF + fcb 0xFF,0xF6,0xFF,0xBF,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x07,0xFB,0xBB,0xFD,0xDF,0xFF + fcb 0xEF,0xFF,0xF9,0x7F,0xFB,0xBF,0xFF,0xFC,0x7F,0xFF,0xFF,0xFF,0xC0,0x0B,0x7F,0xFF + fcb 0xFF,0xF7,0xBF,0xFE,0x00,0x03,0xFF,0xFF,0xFF,0xF8,0x07,0xFF,0xFF,0xFF,0x9F,0xFF + fcb 0xFF,0xFF,0xFF,0xBF,0xFC,0x7F,0xFF,0xFC,0x75,0x0F,0xFF,0xCF,0xC0,0x0E,0x7F,0xFF + fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x07,0xF5,0x47,0xFF,0xE0,0x07,0xFF,0xEF,0xFF,0xCF,0xFD + fcb 0xFF,0xFF,0xFF,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0xE0,0x07,0xC0,0x0F,0x7F,0xFF + fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x0F,0xF8,0x07,0xFF,0xDC,0x07,0xFF,0xFF,0xFF,0xCF,0xFB + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x03,0xE0,0x0D,0x7F,0xFF + fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x1F,0xD1,0x1F,0xFF,0xEF,0x07,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xF1,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x7B,0xF0,0x0B,0x7F,0xFF + fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xFF,0xEF,0xFE,0x81,0x07,0xFF,0xFF,0xFF,0x7F,0xF8 + fcb 0x40,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x60,0x01,0xFC,0x1D,0xF0,0x0D,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0x01,0xFE,0x01,0x87,0xFE,0xEE,0xFF,0xFF,0xF0 + fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xE0,0x03,0xF0,0x67,0xF0,0x17,0x7F,0xFF + fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xF8,0x01,0xFC,0x03,0x87,0xFF,0xFF,0xFF,0xFF,0xC0 + fcb 0x00,0x0F,0xFC,0x3F,0xFF,0xFF,0xFF,0xFF,0xC0,0x03,0xF0,0x33,0xF0,0x5F,0x7F,0xFF + fcb 0xFF,0xF6,0xAF,0xFE,0x00,0x1F,0xFF,0xF0,0xFE,0x0F,0x87,0xFF,0xBF,0xFF,0xFF,0x80 + fcb 0xFF,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x03,0xFA,0xFF,0xF1,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x1F,0xFF,0xFE,0xFE,0x9B,0x87,0xFF,0xFF,0xFF,0xFF,0xBD + fcb 0x80,0xF3,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x17,0xFF,0xFF,0xF4,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0xFF,0xFF,0x03,0x87,0xEF,0xEE,0xEF,0xFF,0x00 + fcb 0x00,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x77,0xFF,0xFF,0xFE,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x0F,0xFF,0xEF,0xF8,0x83,0x87,0xFF,0xFF,0xFF,0xFF,0xBE + fcb 0xBF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0xFF,0xFD,0xB3,0xFF,0xFF,0xFD,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFF,0xF8,0x7F,0xF7,0x8F,0xFF,0xFB,0xBF,0xFF,0xFF + fcb 0xFF,0xF7,0xFC,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x0F,0xFF,0xF3,0x7F,0x0F,0x8F,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xBF,0xE3,0xFC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFE,0xF7,0xFF,0xCF,0x8E,0xFF,0xFF,0xEF,0xFF,0xFF + fcb 0x17,0xF7,0xFD,0xEF,0xEF,0xFE,0xFF,0xFF,0xFF,0x9F,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x07,0xFF,0xFE,0xFF,0xC1,0x9F,0xFF,0xFF,0xFF,0xFF,0xFE + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xF7,0xFF,0xFE,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x03,0xFF,0xC4,0x1C,0x03,0x9B,0xFB,0xAF,0xBF,0xFF,0xFF + fcb 0xFF,0xFF,0xFE,0xFB,0xFB,0xBB,0xFF,0xBF,0xFE,0x02,0xAB,0xFF,0xF8,0xFB,0x7F,0xFF + fcb 0xFF,0xF3,0xBF,0xBA,0x04,0x03,0xFA,0x00,0x00,0x01,0x9F,0xFF,0xBB,0xFF,0xFB,0xFF + fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xFE,0xEF,0xFC,0x00,0x05,0xFF,0xF9,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEC,0x06,0x01,0xFC,0xA2,0x00,0x03,0x9F,0xEE,0xEE,0xEF,0xFE,0xFF + fcb 0xFF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEF,0xBF,0xFE,0x00,0x00,0x3F,0xFB,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xB0,0x00,0x01,0xFA,0x10,0x00,0x03,0x9F,0xFB,0xBB,0xFF,0xFB,0xFF + fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xBE,0xEF,0xFC,0x0F,0x80,0x1F,0xF6,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x68,0x5F,0xFE,0x03,0x1B,0xAE,0xAE,0xFB,0xEE,0xFD + fcb 0xFF,0xFF,0xFE,0xAB,0xBB,0xEA,0xFF,0xBF,0xF8,0x0B,0xFC,0x1F,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0xBA,0x00,0x00,0x7B,0x0F,0xFE,0x00,0x1F,0xBB,0xBB,0xFF,0xFB,0xFF + fcb 0xFF,0xFF,0xFB,0xBB,0xFF,0xBB,0xBE,0xEF,0xFC,0x07,0xFC,0x5F,0xF6,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x14,0x40,0x3C,0x00,0x0E,0xEE,0xEE,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFE,0xEE,0xEE,0xEE,0xEF,0xBF,0xFE,0x00,0x61,0xFF,0xFF,0xBB,0x7F,0xFF + fcb 0xFF,0xF3,0xBB,0x80,0x00,0x00,0x00,0x7E,0x00,0x00,0x3F,0xBB,0xFF,0xFF,0xBF,0xFF + fcb 0xFF,0xFF,0xFF,0xBB,0xFF,0xBB,0xBE,0xEF,0xFF,0xE0,0x07,0xFF,0xFF,0xEE,0x7F,0xFF + fcb 0xFF,0xF6,0xEE,0x00,0x00,0x00,0x00,0x3F,0xEE,0x80,0x2E,0xAB,0xBF,0xBE,0xFC,0xFF + fcb 0xFF,0xFF,0xFE,0xEB,0xBB,0xAA,0xBB,0xBF,0xEF,0xFA,0xFF,0xFF,0xF8,0x0B,0x7F,0xFF + fcb 0xFF,0xF3,0xBA,0x00,0x00,0xC0,0x00,0x0F,0xFE,0x00,0x3B,0xBF,0xFF,0xFB,0xB1,0xFF + fcb 0xFF,0xFF,0xF3,0xBB,0xFF,0xBB,0xAE,0xEF,0xBF,0xD9,0x7F,0xFF,0xF8,0x02,0x7F,0xFF + fcb 0xFF,0xF6,0xEC,0x00,0x00,0xE0,0x00,0x00,0x00,0x00,0xEE,0xEE,0xEF,0xEE,0xE1,0xFF + fcb 0xFF,0xFF,0xF0,0xEE,0xEE,0xEE,0xEB,0xBF,0xEF,0x8E,0x3F,0xFF,0xF8,0x00,0x7F,0xFF + fcb 0xFF,0xF3,0xBA,0x00,0x00,0xF0,0x00,0x00,0x00,0x00,0xBB,0xBB,0xBF,0xBB,0xB1,0xFF + fcb 0xFF,0xFF,0xE0,0x3B,0xFF,0xBB,0xEE,0xFF,0xBB,0x00,0x5F,0xFF,0xF8,0x00,0x7F,0xFF + fcb 0xFF,0xF6,0xE0,0x04,0x00,0x78,0x00,0x00,0x00,0x01,0xEE,0xAA,0xAE,0xEA,0xC0,0x7F + fcb 0xFF,0xFF,0x80,0x0B,0xFF,0xEF,0xAB,0xFF,0xEF,0xC2,0x3F,0xFF,0xFF,0xE0,0x7F,0xFF + fcb 0xFF,0xF3,0x80,0x00,0x00,0x7C,0x00,0x00,0x00,0x00,0x3B,0xBB,0xBB,0xBB,0x00,0x3F + fcb 0xFF,0xFF,0x00,0x03,0xFF,0xFE,0xEE,0xEF,0xBB,0xC0,0x7F,0xFF,0xFE,0xF8,0x7F,0xFF + fcb 0xFF,0xF6,0x60,0xC0,0x00,0x7F,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEE,0xEC,0x00,0x01 + fcb 0x3F,0xFC,0x00,0x00,0x6E,0xEF,0xFF,0xFB,0xEE,0xE2,0x3F,0xFF,0xFE,0x78,0x7F,0xFF + fcb 0xFF,0xF0,0x98,0x60,0x00,0x3F,0x80,0x00,0x00,0x00,0x03,0xBB,0xBB,0xB8,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x01,0xBB,0xBB,0xBA,0xBB,0x5F,0x9F,0xFF,0xFC,0xF8,0x7F,0xFF + fcb 0xFF,0xF6,0x00,0x30,0x00,0x0F,0xC0,0x00,0x00,0x00,0x00,0x6A,0xEE,0xA0,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFA,0xEE,0x83,0xFF,0xFF,0xFC,0xF8,0x7F,0xFF + fcb 0xFF,0xF4,0x00,0x00,0x00,0x07,0xE0,0x00,0x00,0x00,0x05,0x13,0xBB,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEA,0x9B,0xA3,0xFF,0xFF,0xFD,0xF0,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x01,0xF0,0x00,0x00,0x00,0x00,0x0E,0xEE,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x2F,0xFE,0xAA,0x0E,0xED,0xFF,0xFF,0xF9,0xF0,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x03,0xBB,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x0A,0xBA,0xA8,0x0B,0xFB,0x7F,0xFF,0xF3,0xF0,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x3C,0x00,0x00,0x00,0x00,0x02,0x8A,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xFE,0xA0,0x06,0xFE,0xFF,0xFF,0x07,0xF0,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x1E,0x00,0x00,0x00,0x00,0x07,0x03,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xAA,0x80,0x07,0xF9,0xFF,0xFC,0x07,0xF4,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x0F,0x14,0x0E,0x00,0x00,0x02,0x80,0x80,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xAA,0x80,0xBF,0xFF,0xBF,0xF0,0x0F,0xF6,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x03,0xFF,0xFC,0x00,0x00,0x03,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xEA,0x0F,0xFE,0x7C,0x77,0x80,0x1F,0xF6,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0xF8,0x00,0x00,0x03,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x28,0x7F,0xFC,0xFE,0x80,0x00,0x1F,0xF7,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0xF0,0x00,0x00,0x03,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x37,0x3C,0xFE,0xC0,0x00,0xBF,0xF7,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x07,0x7F,0xE0,0x00,0x00,0xF3,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0x3E,0xFF,0x80,0x01,0xFF,0xF7,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0xA3,0xFF,0xC0,0x00,0x00,0x63,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0xFD,0xEE,0x80,0x07,0xFF,0xF7,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x63,0xFF,0xC0,0x00,0x00,0x73,0x00,0x00,0x00,0x00 + fcb 0xFF,0x00,0x00,0x00,0x00,0x00,0x08,0x1F,0x78,0xF7,0xE8,0x9F,0xFF,0xFC,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x77,0xBF,0x80,0x00,0x00,0x33,0x00,0x00,0x00,0x3F + fcb 0xBB,0xE0,0x00,0x00,0x00,0x00,0x00,0x1F,0xF8,0x3B,0x55,0x7F,0x80,0x70,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0x00,0x00,0x00,0x3B,0x00,0x00,0x00,0xFF + fcb 0x3B,0xFC,0x00,0x00,0x00,0x00,0x00,0x1F,0xFF,0x1D,0x8E,0xE7,0x82,0xF8,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0x00,0x00,0x00,0x30,0x00,0x00,0x01,0xFE + fcb 0xF9,0x9F,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF,0xC1,0x17,0xFF,0xFF,0xC0,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x18,0x00,0x00,0x00,0xF8 + fcb 0xFF,0x3F,0xE0,0x00,0x04,0x00,0x00,0x0F,0xBF,0xC2,0xEF,0xFF,0xFF,0x80,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x1C,0x00,0x00,0x08,0xFB + fcb 0xFF,0x37,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xC1,0x1F,0xFF,0xFF,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x1D,0x07 + fcb 0xFF,0xE3,0x68,0x00,0x00,0x00,0x00,0x07,0x7F,0xC7,0x3F,0xFF,0xFE,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F + fcb 0xFF,0xFB,0xF6,0x00,0x00,0x00,0x00,0x07,0x7F,0xE1,0x7F,0xFF,0xFC,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x01,0xC6,0x7F + fcb 0xFF,0xFF,0xE8,0x00,0x00,0x00,0x00,0x07,0x0F,0xF3,0x8F,0x97,0xFC,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xB1,0xEF + fcb 0xFF,0xEF,0xB7,0x00,0x00,0x00,0x00,0x07,0x83,0xE1,0xC6,0x00,0x78,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21,0xDF + fcb 0xFF,0xD1,0xA2,0x00,0x00,0x40,0x00,0x03,0x00,0xF1,0xFF,0x14,0x20,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3E,0xFF + fcb 0xFF,0xFF,0xDF,0x00,0x00,0x00,0x00,0x03,0x06,0x70,0x7C,0x00,0xC0,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF + fcb 0xFF,0xFF,0xE7,0xE0,0x00,0x00,0x00,0x03,0x87,0xF1,0xF8,0x03,0x80,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xAF + fcb 0xFF,0xFF,0xF7,0x00,0x00,0x00,0x00,0x03,0x8F,0xFB,0xF8,0x20,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1F,0xBF + fcb 0xFF,0xFF,0xBF,0xE0,0x00,0x00,0x00,0xF3,0x8D,0xFF,0xF8,0x5F,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xFF + fcb 0xFF,0xFF,0x4F,0xF0,0x00,0x00,0x01,0xE3,0x87,0xFF,0xFC,0x6E,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0D,0xF7 + fcb 0xBF,0xFF,0xEF,0xE8,0x00,0x00,0x00,0x01,0x1F,0xFF,0xFF,0xFE,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0B,0xFF + fcb 0x9F,0xFF,0xFD,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFF,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0xFF,0x8F,0xE8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFC,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xF8,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0x9F,0xFF,0xF8,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xF0,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFE,0x00,0x00,0x07,0xFF + fcb 0x1F,0xFF,0xF5,0xFC,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xE0,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFC + fcb 0x3F,0xFF,0xBF,0xF8,0x00,0x00,0x00,0x01,0x3F,0x85,0xFF,0xC0,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF + fcb 0xF7,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x00,0x1D,0x2A,0x07,0x80,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0x06,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x1F,0xFF + fcb 0xFF,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x01,0x17,0x3D,0x95,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF,0x80,0x00,0x07,0xFF + fcb 0xFF,0xFF,0xEF,0xF8,0x00,0x00,0x00,0x00,0x0E,0xEF,0xDA,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF + fcb 0xFF,0xFF,0xF7,0xF0,0x00,0x00,0x00,0x00,0x15,0xF7,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF + fcb 0xFF,0xFF,0xED,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xEC,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0xFF,0xDC,0xE0,0x00,0x00,0x00,0x00,0x17,0x7F,0xD8,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF + fcb 0xFF,0xFF,0xBC,0xC0,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF + fcb 0xFF,0xFF,0xDE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF + fcb 0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF + fcb 0xFF,0xFB,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xDF + fcb 0xFE,0xC1,0xF2,0x00,0x00,0x00,0x00,0x18,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x83 + fcb 0x00,0x1F,0xCC,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0x00 + fcb 0x80,0x3F,0x98,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE2 + fcb 0x46,0x3E,0x60,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xE0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x80 + fcb 0x33,0x3C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xC0,0x60,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xA0 + fcb 0x73,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x15,0x3A,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0 + fcb 0x08,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xF6,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x17,0xB6,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xED,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x05,0x2C,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xB0,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x70,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0xC0,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x3F,0xFF,0xCF,0x9F,0xFF,0xFF,0xFF,0x03,0xFF + fcb 0xCC,0xFF,0xFF,0xF3,0xFF,0xFF,0xF8,0x1F,0xFE,0x0F,0xFF,0x8F,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x18,0xFF,0xF3,0x3F,0xFF,0xCF,0xFF,0xFF,0xFF,0xFF,0xCF,0xFF + fcb 0xCC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x7F,0xFE,0x7F,0xFF,0xCF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x00,0xFF,0xF3,0x31,0x9E,0x49,0x10,0xE1,0xFF,0xFF,0xCF,0xFF + fcb 0xCC,0xC6,0x08,0x23,0x0F,0xFF,0xFE,0x7F,0xFE,0x7C,0x60,0xCC,0x70,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x24,0xFF,0xF0,0x3C,0xC0,0xC3,0x92,0x4F,0xFF,0xFF,0xCF,0xFF + fcb 0xC0,0xF2,0x38,0xF2,0x7F,0xFF,0xFE,0x7F,0xFE,0x1F,0x23,0xC9,0x27,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x30,0xC0,0xC7,0x92,0x63,0xFF,0xFF,0xCF,0xFF + fcb 0xCC,0xC2,0x79,0xF3,0x1F,0xFF,0xFE,0x7F,0xFE,0x7C,0x27,0xC8,0x31,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x24,0xE1,0xC3,0x92,0x79,0xFF,0xFF,0xCF,0xFF + fcb 0xCC,0x92,0x79,0xF3,0xCF,0xFF,0xFE,0x7F,0xFE,0x79,0x27,0xC9,0xFC,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0x9F,0xF3,0x30,0xE1,0xC9,0x92,0x43,0xFF,0xFF,0xCE,0x7F + fcb 0xCC,0xC2,0x79,0xF2,0x1F,0xFF,0xFE,0x73,0xFE,0x0C,0x27,0xCC,0x61,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF + fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF +AUTHPICe equ * +; Unused + fcb 0xFF,0x00,0x00,0xA0,0x27,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xEF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF + fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x40,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The actual Super Extended Basic (SECB) extensions start here. +; +; Note that many routines in this area feature a "lbrn 0" instruction. This appears to be intended as a placeholder to allow +; patching into the routines similar to the RAM hooks in Color Basic except using direct overwiting of the instruction. It's +; completely pointless and probably illustrates that the writers of this code didn't really think through what they were doing. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +SUPERVAR fdb HRMODE ; address of direct page variables unique to SECB +PRGTEXT fdb SETTEXT ; set video registers for text mode (indirect) +PRGGRAPH fdb SETGRAPH ; set video registers for graphics mode (indirect) +PRGMMU fdb SETMMU ; set MMU registers to their "default" (indirect) +GETTEXT fdb SELTEXT ; put hi-res text screen in logical block 1 (indirect) +GETBLOK0 fdb SELBLOK0 ; put block in B in logical block 0 (indirect) +GETTASK0 fdb SELTASK0 ; re-select MMU task 0 (indirect) +GETTAKS1 fdb SELTASK1 ; select MMU task 1(indirect) + jmp LA05E ; execute non-self starting ROM +SPARE0 fdb 0 ; undefined +SPARE1 fdb 0 ; undefined +SPARE2 fdb 0 ; undefined +; Set up video registers for the selected text screen. Given that the sets of video mode initializers are contiguous in +; memory, this would probably be better done with a simple sequence of MUL and ABX. +SETTEXT pshs y,x,a ; save registers + lbrn 0 + ldx #IM.TEXT ; point to 32 column video mode registers + lda HRWIDTH ; get text mode + beq SETVIDEO ; brif 32 column + ldx #SE03B ; point to 40 column mode data + cmpa #1 ; is it 40 column? + beq SETVIDEO ; brif so + ldx #SE044 ; assume 80 column + bra SETVIDEO ; program video registers +; 32 column (VDG) initializer +IM.TEXT fcb COCO+MMUEN+MC3+MC2 ; INIT0 (COCO bit enables VDG modes) + fcb 0x00 ; VIDEOMOD (unused for VDG modes) + fcb 0x00 ; VIDEORES (unused for VDG modes) + fcb 0x00 ; V.BORDER (black) + fcb 0x00 ; filler for reserved + fcb 0x0f ; V.SCROLL - this value is needed to show a proper 12 lines per text row + fdb 0xe000 ; V.OFFSET - SAM offsets operate in 0x7xxx + fcb 0x00 ; H.OFFSET - no horizontal offset +; 40 column screen +SE03B fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) + fcb 0x03 ; VIDEOMOD - 8 lines per row + fcb 0x05 ; VIDEORES - 40 columns, attributes enabled, 192 lines per field + fcb 0x12 ; V.BORDER - nuclear green + fcb 0x00 ; filler for reserved + fcb 0x00 ; V.SCROLL - no offset + fdb 0xd800 ; V.OFFSET - screen at 0x6c000 + fcb 0x00 ; H.OFFSET - no offset +; 80 column screen +SE044 fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) + fcb 0x03 ; VIDEOMOD - 8 lines per row + fcb 0x15 ; VIDEORES - 80 columns, attributes enabled, 192 lines per field + fcb 0x12 ; V.BORDER - nuclear green + fcb 0x00 ; filler for reserved + fcb 0x00 ; V.SCROLL - no offset + fdb 0xd800 ; V.OFFSET - screen at 0x6c000 + fcb 0x00 ; H.OFFSET - no offset +; Set up video registers for the selected "HSCREEN" mode. Note that the two code paths for the resolution widths +; are unneeded. +SETGRAPH pshs y,x,a ; save registers + lbrn 0 + ldx #IM.GRAPH ; point to graphics initlializer + ldy #RESTABLE ; point to resolution bytes table + lda HRMODE ; get graphics mode + cmpa #2 ; is it a 640 pixel mode? + bls SE063 ; brif not + ldx #SE079 ; point to 640 pixel registers +SE063 suba #1 ; normalize mode numbers to start at 0 + lda a,y ; get resolution setting for this mode + sta 2,x ; put it in the graphics mode initializer + jmp SETVIDEO ; go set up video registers +RESTABLE fcb 0x15 ; 320x192, 4 colours + fcb 0x1e ; 320x192, 16 colours + fcb 0x14 ; 640x192, 2 colours + fcb 0x1d ; 640x192, 4 colours +; 320x192 graphics modes +IM.GRAPH fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) + fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row + fcb 0x00 ; VIDEORES - placeholder + fcb 0x00 ; V.BORDER - black + fcb 0x00 ; filler for reserved + fcb 0x00 ; V.SCROLL - no offset + fdb 0xc000 ; V.OFFSET - screen at 0x60000 + fcb 0x00 ; H.SCROLL - no offset +; 640x192 graphics modes (observe that these are identical to the 320x192 ones above) +SE079 fcb MMUEN+MC3+MC2 ; INITo (disable VDG modes) + fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row + fcb 0x00 ; VIDEORES - placeholder + fcb 0x00 ; V.BORDER - black + fcb 0x00 ; filler for reserved + fcb 0x00 ; V.SCROLL - no offset + fdb 0xc000 ; V.OFFSET - screen at 0x60000 + fcb 0x00 ; H.SCROLL - no offset +; Program video registers and INIT0 from (X); enter with A,X,Y pre-saved +SETVIDEO lda ,x+ ; set INIT0 + sta INIT0 + ldy #VIDEOMOD ; point to start of video mode registers +SE08B lda ,x+ ; set a register + sta ,y+ + cmpy #MMUREG ; done all of them? + blo SE08B ; brif not + puls a,x,y,pc ; restore registers and return +; Set MMU registers to their default values. All 16 of them. +SETMMU pshs y,x,b,a ; save registers + leax IM.MMU,pcr ; point to MMU initializer + bsr SE0F1 ; program MMU registers + puls a,b,x,y,pc ; restore registers and return +; Set logical block 0 to the physical block in B. This is embarassingly inefficient since it sets +; *all 16* MMU registers to change one of them. All the faffing about with pointers and the call +; to set the MMU registers is pointless. It could be done with a single STB. +SELBLOK0 pshs y,x,b,a ; save registers + leax IM.MMU,pcr ; point to MMU initializer + pshs x ; save it for later + stb ,x ; set desired block in initializer + bsr SE0F1 ; program *all 16* MMU registers (stupid) + ldb #BLOCK7.0 ; get correct block number for logical block 0 + puls x ; get back pointer to the initializer + stb ,x ; restore initializer value + puls a,b,x,y,pc ; restore registers and return +; Put hi-res text screen in logical address space block 1. This is embarassingly ineffecient since +; it sets *all 16* MMU registers to change only one. All the faffing about with pointers and the +; call to set the MMU registers is pointless. It could be done with a singel LD/ST sequence. +SELTEXT pshs y,x,b,a ; save registers + leax IM.MMU,pcr ; point to MMU initializer + pshs x ; save pointer for later + ldb #BLOCK6.6 ; get block number for text screen + stb 1,x ; put in logical block 1 of initializer + bsr SE0F1 ; program *all 16* MMU registers (stupid) + puls x ; get back pointer + ldb #BLOCK7.1 ; get proper block for logical block 1 + stb 1,x ; put it back in the initializer + puls a,b,x,y,pc ; restore registers and return +; Get block 6.4 (HBUFF buffers) to logical block 6 of task 1. This is embarassingly inefficient +; since it sets *all 16* MMU registers to change only one. All the faffing about with pointers and +; the call to set the MMU registers ispointless. It could be done with a single LD/ST sequence. +SE0CB pshs y,x,b,a ; save registers + leax IM.MMU,pcr ; point to MMU initializer + pshs x ; save pointer for later + ldb #BLOCK6.4 ; get block for the HBUFF buffers + stb 14,x ; put in logical block 6, task 1 + bsr SE0F1 ; program *all 16* MMU registers (stupid) + puls x ; get back pointer + ldb #BLOCK6.5 ; get default block for logical block 6 of task 1 + stb 14,x ; put it back in the initializer + puls a,b,x,y,pc ; restore registers and return +; MMU initializer +IM.MMU fcb BLOCK7.0,BLOCK7.1,BLOCK7.2,BLOCK7.3 ; task 0: map 0x70000-0x7ffff + fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7 + fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2 ; task 1: put hires gfx at 0x2000 and a stack block at 0xc000 + fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7 +; Set all 16 MMU registers from the initializer pointed to by X. +SE0F1 ldy #MMUREG ; point to MMU registers + ldb #16 ; there are 16 to set +SE0F7 lda ,x+ ; set a register + sta ,y+ + decb ; done all? + bne SE0F7 ; brif not + rts +; Select task register 0 as the active MMU set. Enter with stack in a temporary location which +; holds the original stack pointer. Note that the return could be done simply as jmp [V42] instead +; of pushing the return address onto the stack. Interrupts will be enabled on the way out. +SELTASK0 std V40 ; temp save D + ldd ,s ; get return address + std V42 ; save it + ldd 2,s ; get original stack pointer + std V44 ; save it + clrb ; reset INIT1 to task 0 (and slow timer), could just be CLR INIT1 + stb INIT1 + lds V44 ; restore original stack pointer + ldd V42 ; get back return address + pshs d ; set return address on stack + ldd V40 ; get back original D + andcc #0xaf ; re-enable interrupts + rts +; Select task register 1 as the active MMU set. Exit with interrupts disabled and the original +; stack pointer saved at the top of the temporary stack. Note that jmp [V42] could be used to +; return instead of pushing the return address back on the stack. +SELTASK1 orcc #0x50 ; disable interrupts + std V40 ; temp save D + puls d ; get return address + std V42 ; save it + sts V44 ; save stack pointer + ldb #1 ; set to enable task 1, slow timer input + stb INIT1 + lds #TMPSTACK ; point to temporary stack location (top of the C000-Dfff range) + ldd V44 ; get old stack pointer + pshs d ; stash it + ldd V42 ; put original return address back + pshs d + ldd V40 ; restore original D + rts +; Tokenziation patch +ALINK2 tst V41 ; is it a function token? + bne SE152 ; brif so + lda V42 ; get token value + cmpa #0x62 ; have we reached the first SECB token? + bls SE148 ; brif not + ldu #COMVEC-5 ; point to function table and go again + jmp LB8D7 ; re-enter mainline code +SE148 lda #0x62 ; force tokens to start at the correct number (above Disk Basic) + ldu #EBCOMTAB-10 ; point to SECB command table +SE14D sta V42 ; set token counter to SECB values + jmp LB89D ; re-enter mainstream still in command mode +SE152 lda V42 ; get token number + cmpa #0x29 ; have we run through SECB functions yet? + bls SE15B ; brif not + jmp LB8D7 ; re-enter mainline code (end of processing) +SE15B lda #0x29 ; force token into SECB range (this leaves one unused) + ldu #EBCOMTAB-5 ; point to SECB function table + bra SE14D ; go transfer control back to mainline with new settings +EBCOMTAB fcb 23 ; number of keywords (commands) + fdb COMDIC20 ; keyword table (commands) + fdb ALINK4 ; interpretation handler (commands) + fcb 5 ; number of keywords (functions) + fdb FUNDIC20 ; keyword table (functions) + fdb ALINK5 ; interpretation handler (functions) + fcb 0x00,0x00,0x00,0x00,0x00,0x00 ; marker for no further tables +; Detokenization patch. This routine has a bug. It freezes if an unknown token is encountered instead +; of using the placeholder. +ALINK3 leau 10,u ; move to next table + tst ,u ; valid table? + lbne LB7F9 ; brif so - re-enter mainline code + leax -1,x ; get token number + lda ,x+ + anda #0x7f ; remove token bias + cmpa #0x62 ; SECB command? + blo SE18B ; brif not + suba #0x62 ; zero-base SECB token number + ldu #EBCOMTAB-10 ; point to command table + bra ALINK3 ; go try again +SE18B suba #0x29 ; zero-base function token + ldu #EBCOMTAB-5 ; point to SECB function table + bra ALINK3 ; go try again +; Command interpretation patch +ALINK4 cmpa #0xe2 ; is it within the SECB range? + blo SE19A ; brif not (below) + cmpa #0xf8 ; is it above range? + bls SE19E ; brif not - we have a SECB command +SE19A jmp [COMVEC+23] ; transfer control onward to Disk Basic +SE19E suba #0xe2 ; normalize SECB commands to 0 + ldx #COMDIS20 ; point to jump table for SECB commands + jmp LADD4 ; go dispatch command +; Function processing patch +ALINK5 cmpb #0x29*2 ; is it an SECB function? + blo SE1AE ; brif not (below) + cmpb #0x2d*2 ; is it still an SECB function? + bls SE1B2 ; brif so +SE1AE jmp [COMVEC+28] ; transfer control to Disk Basic +SE1B2 subb #0x29*2 ; normalize SECB functions to 0 + cmpb #2*2 ; do we need to parse a parameter? + bhs SE1BF ; brif not + pshs b ; save token offset + jsr LB262 ; parse parenthetical expression + puls b ; get back token offset +SE1BF ldx #FUNDIS20 ; point to jump table for SECB functions + jmp LB2CE ; go dispatch function call +; Keyword table (commands) for SECB +COMDIC20 fcs 'WIDTH' ; 0xe2 + fcs 'PALETTE' ; 0xe3 + fcs 'HSCREEN' ; 0xe4 + fcs 'LPOKE' ; 0xe5 + fcs 'HCLS' ; 0xe6 + fcs 'HCOLOR' ; 0xe7 + fcs 'HPAINT' ; 0xe8 + fcs 'HCIRCLE' ; 0xe9 + fcs 'HLINE' ; 0xea + fcs 'HGET' ; 0xeb + fcs 'HPUT' ; 0xec + fcs 'HBUFF' ; 0xed + fcs 'HPRINT' ; 0xee + fcs 'ERR' ; 0xef + fcs 'BRK' ; 0xf0 + fcs 'LOCATE' ; 0xf1 + fcs 'HSTAT' ; 0xf2 + fcs 'HSET' ; 0xf3 + fcs 'HRESET' ; 0xf4 + fcs 'HDRAW' ; 0xf5 + fcs 'CMP' ; 0xf6 + fcs 'RGB' ; 0xf7 + fcs 'ATTR' ; 0xf8 +; Jump table for SECB commands +COMDIS20 fdb WIDTH ; 0xe2 WIDTH + fdb PALETTE ; 0xe3 PALETTE + fdb HSCREEN ; 0xe4 HSCREEN + fdb LPOKE ; 0xe5 LPOKE + fdb HCLS ; 0xe6 HCLS + fdb HCOLOR ; 0xe7 HCOLOR + fdb HPAINT ; 0xe8 HPAINT + fdb HCIRCLE ; 0xe9 HCIRCLE + fdb HLINE ; 0xea HLINE + fdb HGET ; 0xeb HGET + fdb HPUT ; 0xec HPUT + fdb HBUFF ; 0xed HBUFF + fdb HPRINT ; 0xee HPRINT + fdb ERR ; 0xef ERR (should be LB277) + fdb BRK ; 0xf0 BRK (should be LB277) + fdb LOCATE ; 0xf1 LOCATE + fdb HSTAT ; 0xf2 HSTAT + fdb HSET ; 0xf3 HSET + fdb HRESET ; 0xf4 HRESET + fdb HDRAW ; 0xf5 HDRAW + fdb CMP ; 0xf6 CMP + fdb RGB ; 0xf7 RGB + fdb ATTR ; 0xf8 ATTR +; Keyword table for SECB functions +FUNDIC20 fcs 'LPEEK' ; 0xa9 + fcs 'BUTTON' ; 0xaa + fcs 'HPOINT' ; 0xab + fcs 'ERNO' ; 0xac + fcs 'ERLIN' ; 0xad +; Jump table for SECB functions +FUNDIS20 fdb LPEEK ; 0xa9 LPEEK + fdb BUTTON ; 0xaa BUTTON + fdb HPOINT ; 0xab HPOINT + fdb ERNO ; 0xac ERNO + fdb ERLIN ; 0xad ERLIN +; Signon message patch +ALINK12 ldx #L80E8-1 ; point to ECB's message + jsr STRINOUT ; display it + ldx #MWAREMS-1 ; point to Microware string + jsr STRINOUT ; display it + jmp L80B8 ; return to mainline code +; Signon message patch for Disk Basic 1.0 +ALINK28 ldx #DISK20MS-1 ; point to modified message + jmp DC0DC-19 ; return to mainline code +; Signon message patch for Disk Basic 1.1 +ALINK29 ldx #DISK21MS-1 ; point to modified message + jmp DC0DC ; return to mainline code +DISK20MS fcc 'DISK EXTENDED COLOR BASIC 2.0' + fcb 0x0d + fcc 'COPR. 1981, 1986 BY TANDY' + fcb 0x0d + fcc 'UNDER LICENSE FROM MICROSOFT' + fcb 0x0d +MWAREMS fcc 'AND MICROWARE SYSTEMS CORP.' + fcb 0x0d,0x0d,0x00 +DISK21MS fcc 'DISK EXTENDED COLOR BASIC 2.1' + fcb 0x0d + fcc 'COPR. 1982, 1986 BY TANDY' + fcb 0x0d + fcc 'UNDER LICENSE FROM MICROSOFT' + fcb 0x0d + fcc 'AND MICROWARE SYSTEMS CORP.' + fcb 0x0d,0x0d,0x00 +; Extended Basic extra initialization patch +ALINK14 clra ; set up to clear things + clrb + lbrn 0 + stb H.CRSATT ; reset cursor attributes + std HRMODE ; reset to VDG screen and no HSCREEN graphics + std H.ONBRK ; reset ON BRK destination + std H.ONERR ; reset ON ERR destinatin + sta H.BCOLOR ; default HSCREEN background to 0 + lda #1 ; default HSCREEN foreground to 1 + sta H.FCOLOR + lda #BLOCK6.4 ; map the HGET/HPUT buffers + sta MMUREG + ldd #0xffff ; mark as empty + std 0 + lda #BLOCK7.0 ; restore memory map + sta MMUREG + jmp LAD19 ; go finish initializing (NEW) +; ON command patch +ALINK18 cmpa #0xef ; ERR? + beq ERR ; brif so + cmpa #0xf0 ; BRK? + beq BRK ; brif so + jsr EVALEXPB ; evaluate the ON index argument + jmp LAF45 ; return to mainline code +SE3C2 jsr GETNCH ; eat the ERR/BRK token + cmpa #0x81 ; GO? + bne SE3CF ; brif not + jsr GETNCH ; eat the GO + cmpa #0xa5 ; TO? + bne SE3CF ; brif not + rts +SE3CF leas 2,s ; clean up stack (not needed) + jmp LB277 ; raise syntax error +; ERR jumps here if used as a command +; NOTE: you can do ERR <char> GOTO (where <char> is a single character that doesn't prevent GOTO from being tokenized +ERR bsr SE3C2 ; check for GOTO + jsr GETNCH ; eat the "TO" + jsr LAF67 ; evaluate destination line number + ldd BINVAL ; get line number + std H.ONERR ; set error destination + ldd CURLIN ; get current line number + std H.ONERRS ; save line number where ON ERR was executed + rts +; BRK jump shere if used as a command. +; Same note as for ERR applies. +BRK bsr SE3C2 ; check for GOTO + jsr GETNCH ; eat the "TO" + jsr LAF67 ; evaluate destination line number + ldd BINVAL ; get line number + std H.ONBRK ; set break destination + ldd CURLIN ; get current line number + std H.ONBRKS ; save line number where ON BRK was executed + rts +; Patches for &H parsing +ALINK6A lsl 2,x ; multiply accumulator by 2 + rol 1,x + rol ,x + lbcs LBA92 ; brif we overflowed + decb ; done enough shifts? + bne ALINK6A ; brif not + suba #'0 ; remove ASCII bias + adda 2,x ; add digit to accumulator (this cannot cause carry) + sta 2,x + rts +ALINK6B lbcs L8800 ; brif numeric + jmp L883F ; return to mainline +; Line input patch +ALINK16 cmpa #3 ; is it BREAK? + orcc #1 ; set C for BREAK + bne SE426 ; brif not BREAK + pshs a,cc ; save character and break status + lda HRMODE ; is it graphics mode? + beq SE424 ; brif not + clr HRMODE ; disable graphics mode + jsr SETTEXT +SE424 puls cc,a ; get back BREAK status and character +SE426 jmp LA3C6 ; return to mainline +; Break check patch +ALINK15 cmpa #3 ; BREAK? + beq SE430 ; brif so + jmp LADF4 ; re-enter mainline +SE430 lda #1 ; BREAK flag + sta H.ERRBRK + lda CURLIN ; immediate mode? + inca + beq SE43F ; brif so + ldd H.ONBRK ; is ON BRK active? + bne SE449 ; brif so +SE43F lda HRMODE ; graphics m ode? + beq SE446 ; brif not + jsr SETTEXT ; set text mode +SE446 jmp STOP ; go handle BREAK +SE449 std BINVAL ; set destination line number + tst H.ERRBRK ; error or break? + bne SE458 ; brif break + lds FRETOP ; reset stack pointer + ldd #LADC4 ; return to main loop + pshs d +SE458 jsr LAEEB ; move to end of line + leax 1,x ; move past line terminator + ldd BINVAL ; get desired line number + cmpd CURLIN ; is it here or later? + bhi SE466 ; brif so + ldx TXTTAB ; start search at beginning +SE466 jsr LAD05 ; find program line + lbcs SE51E ; brif not found + jmp LAEBB ; reset input pointer and return to main loop +; Error handling patch +ALINK20 clr H.ERRBRK ; flag error handling + lda CURLIN ; immediate mode? + inca + beq SE47D ; brif so + ldx H.ONERR ; is ON ERR in effect + bne SE4B3 ; brif so +SE47D pshs a ; save register + lda HRMODE ; set flags on graphics mode + puls a ; get back A + beq SE488 ; brif not graphics mode + jsr SETTEXT ; force text mode +SE488 cmpb #38*2 ; HG error? + bne SE49F ; brif not + jsr LB95C ; do newline + jsr LB9AF ; do ? + leax BAS20ERR,pcr ; point to error string +SE496 jsr LACA0 ; display two character error message + jsr LACA0 + jmp LAC65 ; return to mainline code +SE49F cmpb #39*2 ; HP error? + bne SE4B0 ; brif not + jsr LB95C ; do newline + jsr LB9AF ; do ? + leax BAS20ERR+2,pcr ; point to error string + jmp SE496 ; go finish up +SE4B0 jmp LAC49 ; return to mainline error handler +SE4B3 stb H.ERROR ; save error number + pshs b ; save error number + ldd CURLIN ; get current line number + std H.ERLINE ; save line number where error occurred + puls b ; get back error number + cmpb #3*2 ; OD error? + bne SE4C7 ; brif not + ldd BINVAL ; restore input pointer + std CHARAD +SE4C7 tfr x,d ; save error destination line + lbra SE449 ; go transfer control to error handler +BAS20ERR fcc 'HR' ; 38 Hi resolution graphics error + fcc 'HP' ; 39 Hi resolutuion print error +; NEW handling patch +ALINK19 pshs d ; save D + clra ; set up to clear things + clrb + std OLDPTR ; reset CONT address + std H.ONBRK ; reset ON BRK line + std H.ONERR ; reset ON ERR line + std H.ERLINE ; reset error source line + lda #0xff ; set error number to -1 + sta H.ERROR + puls d ; restore d + jmp LAD43 ; return to mainline +; ERNO function +ERNO clra ; zero extend error number + ldb H.ERROR ; get error number + cmpb #0xff ; real? + bne SE4F4 ; brif so + sex ; return "-1" + bra SE4FA +SE4F4 cmpb #0xf1 ; error number 0xf1? + bne SE4F9 ; brif not + comb ; turn it back into UL error +SE4F9 asrb ; error numbers are pre-multiplied by 2 - undo that +SE4FA jmp GIVABF ; return error number +; ERLIN function +ERLIN ldd H.ERLINE ; get the line number where the error occurred + bra SE4FA ; return it - BUG: will treat lines above 32767 as negative +; Immediate mode patch +ALINK21 jsr SETTEXT ; force text mode + jsr LB95C ; do line feed if needed + orcc #0x50 ; disable interrupts + lda #BLOCK6.4 ; map HGET/HPUT buffers + sta MMUREG + ldd #0xffff ; mark buffers empty + std 0 + lda #BLOCK7.0 ; restore memory map + sta MMUREG + andcc #0xaf ; re-enable interrupts + jmp LAC76 ; return to mainline +; Handle undefined line in ON ERR or ON BRK +SE51E tst H.ERRBRK ; break? + beq SE528 ; brif not + ldd H.ONBRKS ; get line number where ON BRK is + bra SE52B +SE528 ldd H.ONERRS ; get line number where ON ERR is +SE52B std CURLIN ; reset the current line number there + ldb #7*2 ; undefined line number + jmp LAC49 ; raise error (bypass ON ERR check) +; INPUT patch +ALINK17 ldd H.ONBRK ; is ON BRK operating? + lbeq LAE11 ; brif not + pshs d ; save destination line + lda #1 ; set BREAK flag + sta H.ERRBRK + puls d ; get destination line + lbra SE449 ; go handle ON BRK in INPUT +; LPOKE command +LPOKE jsr LB141 ; evaluate numeric expression (address) + lbrn 0 + bsr SE58E ; convert to extended address + cmpb #BLOCK7.7 ; valid block number? + lbhi LB44A ; brif not + pshs x,b ; save block and offset + jsr SYNCOMMA ; require a comma + jsr EVALEXPB ; evaluate value to put in memory + tfr b,a ; save value in A + puls b,x ; get back block and offset + cmpb #BLOCK7.7 ; valid block (we already tested this!!) + lbhi LB44A ; brif not + orcc #0x50 ; clobber interrupts + lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers) + sta ,x ; save byte in memory + lbsr SETMMU ; unmap block (by writing *all 16* MMU registers) + andcc #0xaf ; re-enable interrupts + rts +; LPEEK function +LPEEK bsr SE58E ; convert to block and offset + lbrn 0 + cmpb #BLOCK7.7 ; valid block? + lbhi LB44A ; brif not + orcc #0x50 ; clobber interrupts + lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers) + ldb ,x ; get memory contents + lbsr SETMMU ; restore map (by writing *all 16* MMU registers) + andcc #0xaf ; re-enable interrupts + jmp LB4F3 ; return B as unsigned +SE58E pshs a ; save register + lda FP0EXP ; is it in range for 0x80000? + cmpa #0x93 + bls SE59A ; brif so + ldb #BLOCK7.7+1 ; return illegal block number + bra SE5AF +SE59A jsr LBCC8 ; shift binary point to right of mantissa + ldd FPA0+2 ; get low bits + anda #0x1f ; mask off block number bits + tfr d,x ; now X has the block offset + ldd FPA0+1 ; get high bits + asra ;* shift block number to the right of B; note that + rorb ;* asr *should* be lsr but it works here because of + asra ;* the maximum range of the value + rorb + asra + rorb + asra + rorb + asra + rorb +SE5AF puls a,pc ; restore registers and return +; BUTTON command +BUTTON jsr INTCNV ; get button number + lbrn 0 + cmpb #3 ; button number in range? + lbhi LB44A ; raise error if not + tfr b,a ; save button number + clrb ; set B to 0xff (strobe no keyboard columns) + comb + ldx #PIA0 ; point to PIA0 + stb 2,x ; strobe nothing + ldb ,x ; get button data + cmpb #0x0f ; buttons are on bottom four rows + beq SE5EA ; brif no buttons down + leax SE5D5,pcr ; point to button mask routines + asla ; four bytes per button routine + asla + jmp a,x ; jump to appropriate routine +SE5D5 andb #1 ; keep button 1, right joystick + bra SE5E3 + andb #4 ; keep button #1, left joystick + bra SE5E3 + andb #2 ; keep button #2, right joystick + bra SE5E3 + andb #8 ; keep button #2, left joystick +SE5E3 bne SE5EA ; brif button was not down + ldd #1 ; return nonzero if button down + bra SE5EC ; return result +SE5EA clra ; return zero if not down + clrb +SE5EC jsr GIVABF ; return result + rts +; PALETTE command +PALETTE cmpa #0xf7 ; RGB? + lbrn 0 + bne SE600 ; brif not + jsr GETNCH ; munch the RGB +SE5FA leax IM.RGB,pcr ; point to RGB palette initializer + bra SE634 ; go set palette registers +SE600 cmpa #0xf6 ; CMP? + bne SE60C ; brif not + jsr GETNCH ; eat the CMP +SE606 leax IM.CMP,pcr ; point to CMP palette initializer + bra SE634 ; go set palette registers +SE60C jsr SE7B2 ; evaluate two expressions + ldx #PALETREG ; point to palette registers + ldy #IM.PALET ; point to palette register images + lda BINVAL+1 ; get palette number + cmpa #16 ; valid entry? + lbhs LB44A ; brif not 0-15 + leax a,x ; offset the pointers to the right entries + leay a,y + ldb VERBEG+1 ; get colour number + cmpb #63 ; valid? + bls SE62A ; brif so + ldb #63 ; maximize to 63 (white) +SE62A orcc #0x50 ; disable interrupts + sync ; synchronize to VSYNC + stb ,x ; set palette register + stb ,y ; record it in image + andcc #0xaf ; restore interrupts + rts +SE634 pshs x ; save source pointer + ldy #IM.PALET ; point to palette register live image + bsr SE648 ; copy source to the live image + puls x ; get source back + ldy #PALETREG ; point to palette registers + orcc #0x50 ; disable interrupts + sync ; synchronize to VSYNC + bsr SE648 ; copy the colour values into the palette registers + rts +SE648 ldb #16-1 ; BUG: should be 16 - this doesn't set register #15 +SE64A lda ,x+ ; set a register + sta ,y+ + decb ; done all? + bne SE64A ; brif not + andcc #0xaf ; re-enable interrupts + rts +IM.CMP fcb 18,36,11,7,63,31,9,38 ; palette values for CMP + fcb 0,18,0,63,0,18,0,38 +IM.RGB fcb 18,54,9,36,63,27,45,38 ; palette values for RGB + fcb 0,18,0,63,0,18,0,38 +; CMP and RGB commands just jump to the relevant implementations above +RGB bra SE5FA +CMP bra SE606 +IM.PALET fcb 18,36,11,7,63,31,9,38 ; live palette images + fcb 0,18,0,63,0,18,0,38 +; HSCREEN command +HSCREEN cmpa #0 ; end of line? BUG: won't work if colon terminates the command + lbrn 0 + bne SE693 ; brif not end of line + clrb ; default to HSCREEN 0 - turn off graphics + bra SE69C +SE693 jsr EVALEXPB ; evaluate HSCREEN argument + cmpb #4 ; only 4 HSCREEN modes + lbhi LB44A ; brif out of range +SE69C stb HRMODE ; set graphics mode + cmpb #0 ; HSCREEN 0? + bne SE6A5 ; brif not + jmp SETTEXT ; set text mode (disable graphics) +SE6A5 stb HRMODE ; set graphics mode (we already did!) + ldx #SE6CB ; point to bytes/row table + subb #1 ; normalize mode to 0 + lda b,x ; get bytes per row value + sta HORBYT ; set it + cmpb #1 ; is it 1 or 2? + bgt SE6B9 ; brif not + ldd #160 ; default coordinate for middle of 320 screen + bra SE6BC +SE6B9 ldd #320 ; default coordainte for middle of 640 screen +SE6BC std HORDEF ; set default horizontal coordinate + ldd #96 ; set default vertical coordinate to middle + std VERDEF + ldb H.BCOLOR ; get background colour + bsr CLRHIRES ; clear hi-res graphics screen + jmp SETGRAPH ; set up to display the screen +SE6CB fcb 80,160,80,160 ; bytes per row values for HSCREEN 1 through 4 +; HCLS command +HCLS bne SE6D6 ; brif not end of statement + ldb H.BCOLOR ; get background colour as default + bra CLRHIRES ; go clear screen +SE6D6 bsr SE70E ; evaluate colour number +CLRHIRES tst HRMODE ; graphics mode? + beq SE6EF ; brif not + bsr PIXELFIL ; get all pixels set byte + jsr SELTASK1 ; swap screen in + ldx #HRESSCRN ; point to start of screen +SE6E4 stb ,x+ ; set a byte worth of pixels + cmpx #HRESSCRN+0x8000 ; end of graphics memory? + bne SE6E4 ; brif not + jsr SELTASK0 ; restore memory map + rts +SE6EF ldb #38*2 ; code for HR error + jmp LAC46 ; raise error +; HCOLOR command +HCOLOR cmpa #', ; was a foreground colour given? + lbrn 0 + beq SE705 ; brif not + bsr SE70E ; evaluate colour number + stb H.FCOLOR ; save foreground colour + jsr GETCCH ; is there something after the foreground? + beq SE70D ; brif not +SE705 jsr SYNCOMMA ; insist on a comma + bsr SE70E ; evaluate colour number + stb H.BCOLOR ; set background colour +SE70D rts +; Evaluate a colour number and make sure it's between 0 and 15 inclusive +SE70E jsr EVALEXPB ; evaluate colour +SE711 cmpb #16 ; is it in range? + lbhs LB44A ; brif not + rts +SE718 jsr SE731 ; set working colour and pixel bytes to default + jsr GETCCH ; is there a colour number? + beq SE72F ; brif not + cmpa #') ; )? + beq SE72F ; brif so - no colour + jsr SYNCOMMA ; insist on a comma + cmpa #', ; another comma? + beq SE72F ; brif so - colour not specified + jsr SE70E ; evaluate colour + bsr SE73B ; set working colour and pixel bytes +SE72F jmp GETCCH ; get current character and return +SE731 ldb H.FCOLOR ; get foreground colour + tst SETFLG ; doing set? + bne SE73B ; brif so + ldb H.BCOLOR ; use background colour if doing reset +SE73B stb WCOLOR ; save working colour + bsr PIXELFIL ; get all pixel byte + stb ALLCOL ; save all pixel byte + rts +; Return B with all pixels set to colour number in B +PIXELFIL pshs x ; save registers + lda HRMODE ; get graphics mode + suba #1 ; normalize mode numbers to start at 0 + ldx #SE759 ; point to colour masks + andb a,x ; now B has only the relevant low bits of colour number + lda HRMODE ; get graphics mode + suba #1 ; normalize mode numbers to start at 0 + ldx #SE75D ; point to multiplier table + lda a,x ; get multplier + mul ; now B has all pixels set + puls x,pc ; restore registers and return +SE759 fcb 0x03,0x0f,0x01,0x03 ; colour masks to keep only necessary low bits +SE75D fcb 0x55,0x11,0xff,0x55 ; multipliers to duplicate colour value across all pixels +; HSET command +HSET lda #1 ; HSET flag + bra SE76A +; HRESET command +HRESET clra ; HRESET flag + lbrn 0 +SE76A tst HRMODE ; are we in a graphics mode? + beq SE6EF ; brif not - raise error + sta SETFLG ; save our set/reset state + jsr LB26A ; insist on ( + jsr SE7AA ; evaluate coordindates + tst SETFLG ; resetting? + bne SE77F ; brif so + jsr SE731 ; set working colour and pixel byte + bra SE782 +SE77F jsr SE718 ; evaluate colour number if present +SE782 jsr LB267 ; insist on a ) + jsr HCALPOS ; fetch screen pointer address and pixel mask +SE788 jsr SELTASK1 ; map the screen + jsr SE792 ; set or reset the pixel + jsr SELTASK0 ; unmap the screen + rts +SE792 ldb ,x ; get byte on screen + pshs b ; save it + tfr a,b ; duplicate mask + coma ; invert the mask for clearing the screen data + anda ,x ; reset the pixel + andb ALLCOL ; set pixel mask to correct colour + pshs b ; merge pixel colour into screen data + ora ,s+ + sta ,x ; put modified data on screen + suba ,s+ ; nonzero if the screen changed + ora CHGFLG ; merge with existing change flag + sta CHGFLG + rts +SE7AA jsr SE7B2 ; evaluate coordinates +SE7AD ldu #HORBEG ; point to horizontal coordinates +SE7B0 rts ; dummy "normalization" routine + rts ; pointles RTS +; Evaluate two expressions (usually coordinates) +SE7B2 jsr LB734 ; evaluate two expressions, first in BINVAL, second in B + ldy #HORBEG ; point to horizontal coordinates +SE7B9 cmpb #192 ; in range vertically? + blo SE7BF ; brif so + ldb #191 ; set to maximum coordinate +SE7BF clra ; zero extend vertical + std 2,y ; set vertical coordinate + lda HRMODE ; get graphics mode + cmpa #2 ; is it 1 or 2? + bgt SE7CD ; brif not + ldd #319 ; maximum coordinate for modes 1 and 2 + bra SE7D0 +SE7CD ldd #639 ; maximum coordindate for modes 3 and 4 +SE7D0 cmpd BINVAL ; is our max less than the specified one? + blo SE7D7 ; brif so - keep max + ldd BINVAL ; use specified coordinate +SE7D7 std ,y ; save horizontal coordinate + rts +; Calculate pixel mask and memory address for pixel +HCALPOS bsr SE7E6 ; point to correct routine for current mode + jmp ,u ; execute it +CALTABLE fdb G2BITPIX ; HSCREEN 1 + fdb G4BITPIX ; HSCREEN 2 + fdb G1BITPIX ; HSCREEN 3 + fdb G2BITPIX ; HSCREEN 4 +SE7E6 ldu #CALTABLE ; point to routine table + lda HRMODE ; get graphicsmode + suba #1 ; zero-base it + asla ; two bytes per address + ldu a,u ; get routine address + rts +PIX1MASK fcb 0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01 ; pixel masks for 1 bpp +PIX2MASK fcb 0xc0,0x30,0x0c,0x03 ; pxiel masks for 2 bpp +PIX4MASK fcb 0xf0,0x0f ; pixel masks for 4 bpp +G1BITPIX pshs u,b ; save registers + ldb HORBYT ; get bytes per row + lda VERBEG+1 ; get vergical coord + mul ; now D is the offset to the start of the row + addd #HRESSCRN ; add in start of screen in memory + tfr d,x ; put it in a pointer + ldd HORBEG ; get horiztonal coordindate + lsra ; 8 pixels per byte do divide by 8 + rorb + lsra + rorb + lsra + rorb + leax d,x ; offset to correct byte row + lda HORBEG+1 ; get pixel number + anda #7 ; keep only byte offset + ldu #PIX1MASK ; point to 1 bpp masks + lda a,u ; get pixel mask + puls b,u,pc ; restore registers and return +G2BITPIX pshs u,b ; save registers + ldb HORBYT ; get number of bytes per row + lda VERBEG+1 ; get horizontal coordinate + mul ; now D is the offset to the start of the row + addd #HRESSCRN ; add in memory offset to the screen + tfr d,x ; put that in a pointer + ldd HORBEG ; get horizontal coordinate + lsra ; 4 pixels per byte so divide by 4 + rorb + lsra + rorb + leax d,x ; now X points to the correct memory byte + lda HORBEG+1 ; get horizontal coordinate + anda #3 ; keep only the pixel number in the byte + ldu #PIX2MASK ; point to 2 bpp pixel masks + lda a,u ; get mask for this pixel + puls b,u,pc ; restore registers and return +G4BITPIX pshs u,b ; save registers + ldb HORBYT ; get bytes per row + lda VERBEG+1 ; get vertical coordinate + mul ; now D is the offset to the start of the row + addd #HRESSCRN ; add in memory address of start of screen + tfr d,x ; put it in a pointer + ldd HORBEG ; get horizontal coordinate + lsra ; divide by 2 - only 2 pixels per byte + rorb + leax d,x ; now X points to the memory address of the pixel + lda HORBEG+1 ; get horiztonal coordinate + anda #1 ; keep offset into byte + ldu #PIX4MASK ; point to 4 bpp pixel masks + lda a,u ; get pixel mask + puls b,u,pc ; restore registers and return +; HPOINT function +HPOINT tst HRMODE ; is there a graphics mode? + lbeq SE6EF ; brif not - raise error + jsr LB26A ; insist on ( + jsr SE7AA ; evaluate coordinates + jsr LB267 ; insist on ) + jsr SELTASK1 ; map the screen + jsr HCALPOS ; get screen pointer + tfr a,b ; save mask + andb ,x ; get pixel data +SE875 lsra ; is the pixel aligned right? + bcs SE87B ; brif so + lsrb ; shift right + bra SE875 ; see if it's aligned yet +SE87B jsr LB4F3 ; return colour number + jsr SELTASK0 ; restore memory map + rts +; HLINE command +HLINE tst HRMODE ; is there a graphics mode active? + lbeq SE6EF ; brif not - raise error + lbrn 0 + cmpa #'( ; is there (? + beq SE899 ; brif so - we have start coords + cmpa #0xac ; -? + beq SE899 ; brif no start given + ldb #'@ ; make sure it's @ if not + jsr LB26F +SE899 jsr SE9E1 ; get start/end coords + ldx HOREND ; put end in the defaults + stx HORDEF + ldx VEREND + stx VERDEF + jsr SYNCOMMA ; make sure comma + cmpa #0xbe ; PRESET? + beq SE8B4 ; brif so + cmpa #0xbd ; PSET? + lbne LB277 ; brif not + ldb #1 ; set flag + skip1lda +SE8B4 clrb ; reset flag + pshs b ; save set/reset flag + jsr GETNCH ; eat the PSET/PRESET token + jsr SEA0D ; normalize start/end + puls b ; get back set/reset flag + stb SETFLG ; save set/reset flag + jsr SE731 ; set active colour byte + jsr GETCCH ; is there more? + lbeq SE94E ; brif not - no box + jsr SYNCOMMA ; insist on a comma + ldb #'B ; insist on a B + jsr LB26F + bne SE8EB ; brif something after B + bsr SE906 ; draw horizontal line (top) + bsr SE931 ; draw vertical line (left) + ldx HORBEG ; save horizontal start + pshs x + ldx HOREND ; set up to draw vertical line (right) + stx HORBEG + bsr SE931 ; draw vertical line (right) + puls x ; restore start coord + stx HORBEG + ldx VEREND ; set up to draw horizontal line (bottom) + stx VERBEG + bra SE906 ; draw horizontal line (bottom) and return +SE8EB ldb #'F ; insist on F + jsr LB26F + bra SE8F6 ; draw a filled box +SE8F2 leax -1,x ; move vertical coordinate up one +SE8F4 stx VERBEG ; save new vertical coordinate +SE8F6 jsr SE906 ; draw horizontal line + ldx VERBEG ; get current coordinate + cmpx VEREND ; above or below end? + beq SE905 ; brif done + bhs SE8F2 ; brif below - move up + leax 1,x ; move down (we're above) + bra SE8F4 ; draw another line +SE905 rts +SE906 ldx HORBEG ; get starting coordinate + pshs x ; save it + jsr SE9DB ; get absolute horizontal difference + bcc SE913 ; brif end > start + ldx HOREND ; get ending coordinate + stx HORBEG ; save as starting position +SE913 tfr d,y ; save difference (pixel count) + leay 1,y ; bump it (coords are inclusive) + jsr HCALPOS ; calculate pixel address + puls u ; get start coordinate + stu HORBEG ; restore it + lbsr SEA16 ; point to routine to move pixel pointer right +SE921 sta VD7 ; save pixel mask + jsr SE788 ; turn on pixel + lda VD7 ; get back pixel mask + jsr ,u ; move one pixel right + leay -1,y ; done all pixels? + bne SE921 ; brif not + rts +SE92F puls d ; clean up stack +SE931 ldd VERBEG ; get vertical start + pshs d ; save it + jsr SE9CD ; calculate absolute vertical difference + bcc SE93E ; brif end > start + ldx VEREND ; swap coordinate + stx VERBEG +SE93E tfr d,y ; save difference (pixel count) + leay 1,y ; coordinates are inclusive + jsr HCALPOS ; get screen pointer + puls u ; get original start coord + stu VERBEG ; restore it + lbsr SEA21 ; get routine to move down one row + bra SE921 ; draw vertical line +SE94E ldy #SE9B8 ; point to vertical increment routine + jsr SE9CD ; calculate absolute vertical difference + beq SE906 ; draw horizontal if difference is 0 + bcc SE95D ; brif vertical end > vertical start + ldy #SE9C6 ; point to decrement vertical routine +SE95D pshs b,a ; save vertical difference + ldu #SE9B1 ; point to horitzontal increment routine + jsr SE9DB ; calculate absolute horizontal difference + beq SE92F ; draw vertical line if difference is 0 + bcc SE96C ; brif horizontal end > horizontal start + ldu #SE9BF ; point to decrement horizontal routine +SE96C cmpd ,s ; compare horiztonal difference with vertical difference + puls x ; get vertical difference back + bhs SE977 ; brif horizontal difference is greater + exg u,y ; swap major/minor directions + exg d,x +SE977 pshs u,d ; save larger difference and incr/decr routine + pshs d ; save larger difference + lsra ; divide larger difference by 2 + rorb + bcs SE988 ; brif odd + cmpu #SE9B8+1 ; inc or dec? + blo SE988 ; brif inc + subd #1 ; move back of dec (round down) +SE988 pshs x,d ; save smaller difference and inc/dec + jsr SE7E6 ; point to screen address routine +SE98D jsr ,u ; convert coordinates to screen address + jsr SE788 ; turn on pxiel + ldx 6,s ; done all? + beq SE9AD ; brif so + leax -1,x ; account for pixel just drawn + stx 6,s + jsr [8,s] ; bump coordinate + ldd ,s ; get minor coordinate increment counter + addd 2,s ; add to minor coordinate + std ,s ; save new minor increment + subd 4,s ; subtract largest difference + bcs SE98D ; brif result not bigger than largest difference + std ,s ; save new minor increment + jsr ,y ; inc/dec minor + bra SE98D ; draw another pixel +SE9AD puls x ; clean up stack + puls d,x,y,u,pc ; clean up stack and return +SE9B1 ldx HORBEG ; bump horizontal coord + leax 1,x + stx HORBEG + rts +SE9B8 ldx VERBEG ; bump vertical coord + leax 1,x + stx VERBEG + rts +SE9BF ldx HORBEG ; reduce horizontal coord + leax -1,x + stx HORBEG + rts +SE9C6 ldx VERBEG ; reduce vertical coord + leax -1,x + stx VERBEG +SE9CC rts +SE9CD ldd VEREND ; get vertical end + subd VERBEG ; get subtract start +SE9D1 bcc SE9CC ; brif end > start + pshs cc ; save flag for which is > + nega ; negate difference + negb + sbca #0 + puls cc,pc ; restore status andreturn +SE9DB ldd HOREND ; get horizontal end coord + subd HORBEG ; subtract start coord + bra SE9D1 ; handle going negative +; Evaluate two sets of coordinates +SE9E1 ldx HORDEF ; set start to default + stx HORBEG + ldx VERDEF + stx VERBEG + cmpa #0xac ; -? + beq SE9F0 ; brif so - use default start + jsr SEA04 ; evaluate coordinate pair +SE9F0 ldb #0xac ; insist on - + jsr LB26F + jsr LB26A ; insist on ( + jsr LB734 ; evaluate two expressions (X, B) + ldy #HOREND ; point to end coords + jsr SE7B9 ; validate end coords + bra SEA0A ; handle rest of evaluation +SEA04 jsr LB26A ; insist on ( + jsr SE7B2 ; evaluate coordinates with range check +SEA0A jmp LB267 ; insist on ) +SEA0D jsr SE7AD ; "normalize" start + ldu #HOREND ; point to end coords + jmp SE7B0 ; "normalize" end +; Point U to routine to move pixel to right +SEA16 ldu #SEA25 ; point to jump table + ldb HRMODE ; get graphics mode + subb #1 ; zero-base it + aslb ; two bytes per entry + ldu b,u ; get routine address + rts +SEA21 ldu #SEA45 ; point to routine to move down one row + rts +SEA25 fdb SEA34 ; HSCREEN 1 right + fdb SEA3D ; HSCREEN 2 right + fdb SEA2D ; HSCREEN 3 right + fdb SEA34 ; HSCREEN 4 right +SEA2D lsra ; move pixel mask right + bcc SEA33 ; brif not changing bytes + rora ; shift mask back around to left + leax 1,x ; move byte forward +SEA33 rts +SEA34 lsra ; move one pixel right + lsra + bcc SEA33 ; brif same byte + lda #0xc0 ; reset pixel mask + leax 1,x ; move to next byte + rts +SEA3D coma ; flip pixels + cmpa #0xf0 ; did we move to a new byte? + bne SEA44 ; brif not + leax 1,x ; move to next byte +SEA44 rts +SEA45 ldb HORBYT ; get number of bytes per row + abx ; move ahead that many + rts +; HCIRCLE command +HCIRCLE tst HRMODE ; graphics mode? + lbeq SE6EF ; brif not - raise error + lbrn 0 + cmpa #'@ ; is there @ before coords? + bne SEA59 ; brif not + jsr GETNCH ; eat the @ +SEA59 jsr SEB60 ; get max coords for video mode + jsr SEA04 ; parse centre coords + jsr SE7AD ; normalize coordinates (ha ha) + ldx ,u ; get horizontal coordinate + stx VCB ; save it + ldx 2,u ; get vertical coordinate + stx VCD ; save it + jsr SYNCOMMA ; insist on a comma + jsr LB73D ; evaluate expression into X (radius) + ldu #VCF ; point to temp storage area + stx ,u ; save radius + jsr SE7B0 ; normalize - pointless + lda #1 ; put into "set" mode + sta SETFLG + jsr SE718 ; evaluate colour + ldx #0x100 ; default H/W ratio (1:1) + jsr GETCCH ; is the an HW ratio? + beq SEA95 ; brif not + jsr SYNCOMMA ; insist on comma + jsr LB141 ; evaluate HW ratio + lda FP0EXP ; multiply by 256 + adda #8 + sta FP0EXP + jsr LB740 ; fetch HW ratio to X (with a fixed 8 bit fraction part) +SEA95 lda HRMODE ; get graphics mode + cmpa #2 ; is it a 320 mode? + bhi SEA9F ; brif not + tfr x,d ; double HW ratio for 320 modes + leax d,x +SEA9F stx VD1 ; save H/W ratio + ldb #1 ; go into SET mode + stb SETFLG + stb VD8 ; flag for "first arc" + jsr SEB7B ; evaluate start point (octant, subarc) + pshs d ; save start point + jsr SEB7B ; evaluate end point + std VD9 ; save end point + puls d ; get back start point +SEAB3 pshs d ; save current circle position + ldx HOREND ; switch previous end coords in as the start + stx HORBEG + ldx VEREND + stx VERBEG + ldu #CIRCDATA+2 ; point to sines/cosines table + anda #1 ; is it an even octant? + beq SEAC7 ; brif so + negb ; swap arc order for odd octants + addb #8 +SEAC7 aslb ; four bytes per table entry + aslb + leau b,u ; now U points to the correct entry + pshs u ; save table entry + jsr SEBBD ; calculate horizontal offset + puls u ; get back table pointer + leau -2,u ; move to other entry + pshs x ; save horizontal offset + jsr SEBBD ; calculaute vertical offset + puls y ; get back horizontal offset + lda ,s ; get octant number + anda #3 ; is it 0 or 4? + beq SEAE7 ; brif so + cmpa #3 ; is it 3 or 7? + beq SEAE7 ; brif so + exg x,y ; swap horizontal and vertical otherwise +SEAE7 stx HOREND ; save horizontal offset + tfr y,d ; divide offset by 2 + lsra + rorb + ldx VD1 ; get H/W ratio + jsr SEBCB ; multiply offset by ratio + tfr y,d ; did MSB (bits 23-16) end up nonzero? + tsta ; brif so - outside 16 bit range + lbne LB44A ; brif so - raise error + stb VEREND ; save vertical offset MSB + tfr u,d ; get low bytes of result + sta VEREND+1 ; save LSB (lose fractional part) + lda ,s ; get octant number + cmpa #2 ; 0 or 1? + blo SEB13 ; brif so + cmpa #6 ; 6 or h? + bhs SEB13 ; brif so + ldd VCB ; get horizontal center + subd HOREND ; subtract offset (going left) + bcc SEB20 ; brif we didn't go negative + clra ; minimize to 0 + clrb + bra SEB20 +SEB13 ldd VCB ; get horizontal centre + addd HOREND ; add offset + bcs SEB1E ; brif we overflowed + cmpd VD3 ; did we overflow screen size? + blo SEB20 ; brif not +SEB1E ldd VD3 ; maximize horizontal coordinate +SEB20 std HOREND ; save new horizontal coordinate + lda ,s ; get octantnumber + cmpa #4 ; is it 0-3 (bottom half)? + blo SEB32 ; brif so + ldd VCD ; get vertical centre + subd VEREND ; subtract offset + bcc SEB3F ; brif we didn't run past 0 + clra ; minimize to 0 + clrb + bra SEB3F +SEB32 ldd VCD ; get vertical centre + addd VEREND ; add offset + bcs SEB3D ; brif we overflowed + cmpd VD5 ; did we go past end of screen? + blo SEB3F ; brif not +SEB3D ldd VD5 ; maximize to screen size +SEB3F std VEREND ; save new vertical coord + tst VD8 ; was this the first coordinate? + bne SEB48 ; brif so - don't draw a line + lbsr SE94E ; draw the subarc line +SEB48 puls d ; get octant and arc + lsr VD8 ; test if first point, and clear flag + bcs SEB53 ; brif first coord + cmpd VD9 ; at end of circle? + beq SEB5F ; brif so +SEB53 incb ; bump arc counter + cmpb #8 ; done 8 subarcs? + bne SEB5C ; brif not + inca ; bump octant + clrb ; reset arc counter + anda #7 ; wrap octant number if needed +SEB5C jmp SEAB3 ; move on with the next arc +SEB5F rts +SEB60 ldu #VD3 ; point to storage area + ldx #639 ; set max horizontal coord for 640 mode + stx ,u + lda HRMODE ; get graphics mode + cmpa #2 ; is it a 640 mode? + bgt SEB73 ; brif so + ldx #319 ; set max horzontalcoord for 320 mode + stx ,u +SEB73 ldx #191 ; all modes have a 191 vertical max + stx 2,u + jmp SE7B0 ; "normalize" coords +SEB7B clrb ; default circle start/end to 0 + jsr GETCCH ; is there a fraction? + beq SEB91 ; brif not + jsr SYNCOMMA ; insist on a comma + jsr LB141 ; evaluate circle fraction + lda FP0EXP ; multiply by 64 (calculate # of 64ths) + adda #6 + sta FP0EXP + jsr LB70E ; fetch result as 8 bits unsigned + andb #0x3f ; keep only the fraction part +SEB91 tfr b,a ; copy fraction to A (for octant) + andb #7 ; keep only arc number in B + lsra ; shift octant number to right of A + lsra + lsra + rts +CIRCDATA fdb 0x0000,0x0001 ; subarc 0 + fdb 0xfec5,0x1919 ; subarc 1 + fdb 0xfb16,0x31f2 ; subarc 2 + fdb 0xf4fb,0x4a51 ; subarc 3 + fdb 0xec84,0x61f9 ; subarc 4 + fdb 0xe1c7,0x78ae ; subarc 5 + fdb 0xd4dc,0x8e3b ; subarc 6 + fdb 0xc5e5,0xa269 ; subarc 7 + fdb 0xb506,0xb506 ; subarc 8 +SEBBD ldx VCF ; get radius + ldd ,u ; get sin/cos value + beq SEBCA ; brif 0 - just use radius + subd #1 ; subtract 1 + bsr SEBCB ; do the multiplication dance + tfr y,x ; save result to X +SEBCA rts +SEBCB pshs u,y,x,b,a ; save registers and reserve storage + clr 4,s ; clear high bits + lda 3,s ; B*XL + mul + std 6,s ; save in partical result + ldd 1,s ; A*XH + mul + addb 6,s ; add to partial product + adca #0 + std 5,s + ldb ,s ; A*XL + lda 3,s + mul + addd 5,s ; add to partial product + std 5,s + bcc SEBEA + inc 4,s +SEBEA lda ,s ; A*XH + ldb 2,s + mul + addd 4,s ; add to partial product + std 4,s ; save final product bits + puls a,b,x,y,u,pc ; save factors, retrieve result, and return +; HPAINT command +HPAINT tst HRMODE ; do we have a grahpics mode? + lbeq SE6EF ; brif not - raise error + lbrn 0 + cmpa #'@ ; is there @ before the coords? + bne SEC05 ; brif not + jsr GETNCH ; eat the @ +SEC05 jsr SEA04 ; insist on ( + jsr SE7AD ; evaluate the coordinates + lda #1 ; set up for "setting" + sta SETFLG + jsr SE718 ; evaluate colour code + ldd WCOLOR ; get working colour and all pixels byte + pshs d ; save them for later + jsr GETCCH ; do we have a border colour? + beq SEC1D ; brif not - use default + jsr SE718 ; evaluate border colour +SEC1D lda ALLCOL ; get border colour pixel byte + sta VD8 ; save it + puls d ; get paint colour details + std WCOLOR ; restore them + jsr SELTASK1 ; map the graphics screen + clra ;* add a terminator block to the top of the stack + pshs u,x,b,a ;* which is how HPAINT knows it's done + jsr SEB60 ; get maximum coordinate values + jsr SE7E6 ; point U to routine that selects a pixel + stu VD9 ; save pixel selection routine address + jsr SECBE ; paint from current coord to the left + beq SEC47 ; brif no painting done - we started on the border + jsr SED01 ; paint to the right + lda #1 ; set up a record to paint down the screen + sta VD7 + jsr SED2E + neg VD7 ; set up a record to paint up the screen + jsr SED2E +SEC47 sts TMPSTK ; save stack pointer +SEC4A tst CHGFLG ; see if a pixel changed + bne SEC51 ; brif so + lds TMPSTK ; get stack pointer back +SEC51 puls a,b,x,u ; get data for the next line to handle + clr CHGFLG ; flag nothing changed yet + sts TMPSTK ; save new stack address + leax 1,x ; add one to the start position + STX HORBEG ; set it as the starting position + stu VD1 ; save length of parent line + sta VD7 ; save up/down flag + beq SECBA ; brif up/down is 0 - end marker + bmi SEC6A ; brif we're going up the screen + incb ; bump vertical coord + cmpb VD6 ; at end of screen? + bls SEC6E ; brif not + clrb ; wrap around - this will cause us to bail below +SEC6A tstb ; is coord 0? + beq SEC4A ; brif so - don't go upward + decb ; move upward on the screen +SEC6E stb VERBEG+1 ; save new vertical coordinate + jsr SECBE ; paint to the left + beq SEC86 ; brif no pixels changed + cmpd #3 ; less than 3 painted? + blo SEC80 ; brif so - no need to check for paintable data + leax -2,x ; move coord left two + jsr SED15 ; save block of paint data in the other direction (vertically) +SEC80 jsr SED01 ; paint to the right +SEC83 jsr SED2E ; save a block of paint data in the same direction +SEC86 coma ; invert number of pixels painted (but "less 1") + comb +SEC88 addd VD1 ; add to length of parent line + std VD1 ; now we have the new parent line length + ble SECA5 ; brif parent line was shorter + jsr SE9B1 ; bump horizontal + jsr SECF1 ; check for border + bne SEC9B ; brif not + ldd #-1 ; count down + bra SEC88 ; keep looking +SEC9B jsr SE9BF ; move left + jsr SED3A ; save horizontal coord + bsr SECC7 ; paint to the right + bra SEC83 ; save paint block and keep going +SECA5 jsr SE9B1 ; bump horizontal coord + leax d,x ; point to right of end of parent line + stx HORBEG ; set as start coord + coma ; negate pixel count (and subtract 2?) + comb + subd #1 + ble SECB7 ; brif line doesn't extend past right of parent + tfr d,x ; save portion of line to the right as length + bsr SED15 ; save block of paint data +SECB7 jmp SEC4A ; go process more paint blocks +SECBA jsr SELTASK0 ; unmap screen + rts +SECBE jsr SED3A ; point starting coord in end + ldy #SE9BF ; point to dec horizontal + bra SECCD ; paint line +SECC7 ldy #SE9B1 ; point to incr horizontal coord + jsr ,y ; skip first - already done +SECCD ldu ZERO ; initial pixel counter to 0 + ldx HORBEG ; get starting coord +SECD1 bmi SECEA ; brif off the left side + cmpx VD3 ; at max value? + bhi SECEA ; brif off right side + pshs u,y ; save counter and inc/dec p ointer + bsr SECF1 ; check for border + beq SECE8 ; brif so - we're done + jsr SE792 ; set pixel + puls y,u ; restore count and inc/dec routine + leau 1,u ; bump count + jsr ,y ; adjust coord + bra SECD1 ; go do another pixel +SECE8 puls y,u ; get back counter and inc/dec pointer +SECEA tfr u,d ; save paint counter in D and X + tfr d,x + subd ZERO ; set flags on counter + rts +SECF1 jsr [VD9] ; get address of pixel + tfr a,b ; duplicate mask + andb VD8 ; get pixel colour mask for the pixel + pshs b,a ; save masks + anda ,x ; merge in with pixel data on screen + cmpa 1,s ; does it match? (Z set if so) + puls a,b,pc ; restore masks and return +SED01 std VCD ; save pixel count + ldy HOREND ; get last horizontal coord + bsr SED3A ; save current coord + sty HORBEG ; start painting to right from the previous end + bsr SECC7 ; go paint rightward + ldx VCD ; get previous pixel count + leax d,x ; now we have a total count for this line + addd #1 ; bump it by one? + rts +SED15 std VCB ; save painted pixel count + puls y ; get return address + ldd HORBEG ; get start coord + pshs x,d ; save start coord and line length + lda VD7 ; get direction + nega ; invert it +SED20 ldb VERBEG+1 ; get vertical coordinate + pshs b,a ; save direction and vertical coord + pshs y ; put return address back + ldb #6 ; make sure we didn't overflow the stack + jsr SED3F + ldd VCB ; get line length back + rts +SED2E std VCB ; save line length + puls y ; get return address + ldd HOREND ; get horizontal start + pshs x,d ; save line length and horizontal coord + lda VD7 ; get direction flag + bra SED20 ; finish saving frame +SED3A ldx HORBEG ; get start coord + stx HOREND ; save it as end coord + rts +SED3F negb ; subtract B bytes from S + leas b,s + cmps #TMPSTACK-(0x2000+14) ; does it overflow? (14 extra is from the unused vectors at the top of the CB ROM area) + lblo SED4E ; raise OM error if we did + negb ; restore stack pointer + leas b,s + rts +SED4E lds #TMPSTACK-2 ; reset stack (since we overflowed it) + jsr SELTASK0 ; restore default memory map + jmp LAC44 ; raise OM error +; HBUFF command +HBUFF jsr LB73D ; evaluate buffer number to X + lbrn 0 + cmpx #255 ; valid? + lbhi LB44A ; brif not + stx VD1 ; save buffer number + beq SED72 ; don't get size if buffer 0 select + jsr SYNCOMMA ; insist on a comma + jsr LB73D ; evaluate size to X + stx VD3 ; save buffer size +SED72 jsr SE0CB ; map the buffers + jsr SELTASK1 + ldd VD1 ; get buffer number + tstb ; is it zero (not needed!) + bne SED85 ; brif not + ldd #0xffff ; clear all buffers + std HRESBUFF + bra SEDBD ; reset memory map and return +SED85 ldy #HRESBUFF ; point to buffers + ldd ,y ; get address of next block + cmpd #0xffff ; empty buffer space? + bne SED95 ; brif not + bsr SEDC4 ; check for room in buffer space + bra SEDB0 ; set up buffer +SED95 ldb VD1+1 ; get buffer number +SED97 cmpb 2,y ; is this buffer the same number? + beq SEDD2 ; brif so - throw error + ldu ,y ; get address of next buffer + beq SEDA3 ; brif last buffer + tfr u,y ; move on to next buffer + bra SED97 ; see if we have a matching number here +SEDA3 tfr y,u ; save start address to U + ldd 3,y ; get size of last buffer + leay 5,y ; move past header + leay d,y ; move past buffer data + bsr SEDC4 ; check for enough room + sty ,u ; save pointer to the new buffer in previous header +SEDB0 ldd #0 ; mark this as the last buffer + std ,y + ldb VD1+1 ; set buffer number + stb 2,y + ldd VD3 ; set buffer size + std 3,y +SEDBD jsr SELTASK0 ; restore memory map + jsr SETMMU + rts +SEDC4 tfr y,x ; point X to the start of the buffer data + leax 5,x + ldd VD3 ; get length requested + leax d,x ; point to end of new buffer + cmpx #HRESBUFF+0x1f00 ; does it fit? + bhi SEDD6 ; brif not + rts +SEDD2 ldb #9*2 ; code for redim array + bra SEDD8 +SEDD6 ldb #6*2 ; code for out of memory +SEDD8 lds #TMPSTACK-2 ; reset stack + jsr SELTASK0 ; restore memory map + jsr SETMMU + jmp LAC46 ; raise error +; HGET command +HGET ldx #SEEC0 ; point to HGET movement routine + stx VD5 ; save it + clrb ; flag for "GET" + bra SEDF4 ; get on with things +; HPUT command +HPUT ldx #SEEEF ; point to HPUT movement routine + stx VD5 ; save it + ldb #1 ; flag for "PUT" +SEDF4 tst HRMODE ; check for graphics + lbeq SE6EF ; brif not - raise error + lbrn 0 + stb VD8 ; save GET/PUT flag + cmpa #'@ ; is there @ before coords? + bne SEE06 ; brif not + jsr GETNCH ; eat the @ +SEE06 jsr SE9E1 ; evaluate box bounds + jsr SYNCOMMA ; insist on a comma + jsr EVALEXPB ; evaluate buffer number + stb VD3 ; save buffer number + clr VD4 ; default action to none + jsr GETCCH ; is there an action flag? + beq SEE38 ; brif not + com VD4 ; flag for action flag specified + jsr SYNCOMMA ; insist on a comma + tst VD8 ; is it GET? + bne SEE23 ; brif not + lbra LB277 ; raise error +SEE23 ldb #5 ; 5 possible actions + ldx #SEEE0 ; point to action routine table address +SEE28 ldu ,x++ ; get routine address + cmpa ,x+ ; does the action match? + beq SEE34 ; brif so + decb ; checked all of them? + bne SEE28 ; brif not + jmp LB277 ; raise error +SEE34 stu VD5 ; save action address + jsr GETNCH ; eat the action token +SEE38 jsr SE0CB ; map the buffers and screen + jsr SELTASK1 + ldb VD3 ; get buffer number + jsr SEF18 ; find the correct buffer's data + ldd HORBEG ; get horizontal start + cmpd HOREND ; is it less than end? + ble SEE50 ; brif so + ldx HOREND ; swap start/end horizontal coords + stx HORBEG + std HOREND +SEE50 ldd VERBEG ; get vertical start + cmpd VEREND ; less that end? + ble SEE5D ; brif so + ldx VEREND ; swap vertical coords + stx VERBEG + std VEREND +SEE5D lda HRMODE ; get graphics mode + ldb #0xf8 ; round off mask for mode 3 (1 bpp) + cmpa #3 ; is it mode 3 (1 bpp) + beq SEE6D ; brif so + ldb #0xfc ; mask for mode 1 or 4 (2 bpp) + cmpa #2 ; is it mode 2? + bne SEE6D ; brif not - it's mode 1 or 4 + ldb #0xfe ; round off mask for mode 2 (4 bpp) +SEE6D tfr b,a ; save round off in A and B - we need it twice + anda HORBEG+1 ; round off horizontal start + sta HORBEG+1 + andb HOREND+1 ; round of horizontal end coord + stb HOREND+1 + jsr SE9DB ; calculate horizontal difference + std HOREND ; save it + jsr SE9CD ; calculate vertial difference + addd #1 ; make it inclusive + std VEREND ; save it + lda HRMODE ; get graphics mode + cmpa #2 ; HSCREEN 2? + beq SEE96 ; divide pixel count by 2 for byte count + cmpa #3 ; HSCREEN 3? + bne SEE92 ; brif not - divide by 4 (HSCREEN 1, 4) + lsr HOREND ; divide by 8 (falls through to by 4) + ror HOREND+1 +SEE92 lsr HOREND ; divide by 4 (falls through to divide by 2) + ror HOREND+1 +SEE96 lsr HOREND ; divide by 2 + ror HOREND+1 + ldd HOREND ; get byte count + addd #1 ; make it inclusive of the end + std HOREND + jsr HCALPOS ; get pointer to screen location + ldy VD5 ; point to action routine address +SEEA7 ldb HOREND+1 ; get LS byte of byte count + pshs x ; save line start pointer +SEEAB jsr ,y ; perform movement action + decb ; done all bytes? + bne SEEAB ; brif not + puls x ; get back line start + jsr SEA45 ; move down one line + dec VEREND+1 ; done all rows? + bne SEEA7 ; brif not + jsr SELTASK0 ; restore memory map + jsr SETMMU + rts +SEEC0 lda ,x+ ; get a byte from screen + bsr SEEC7 ; point to proper buffer location + sta ,u ; save it + rts +SEEC7 ldu VCF ; get buffer pointer + leau 1,u ; move to next byte + stu VCF ; save new pointer + cmpu VD1 ; did we run past the end of the buffer? + bhi SEED3 ; brif so - raise error + rts +SEED3 lds #TMPSTACK-2 ; reset stack + jsr SELTASK0 ; restore memory map + jsr SETMMU + jmp LB44A ; raise FC error +SEEE0 fdb SEEEF ; PSET action routine + fcb 0xbd ; PSET token + fdb SEEF6 ; PRESET action routine + fcb 0xbe ; PRESET token + fdb SEF07 ; OR action routine + fcb 0xb1 ; OR token + fdb SEEFE ; AND action routine + fcb 0xb0 ; AND token + fdb SEF10 ; NOT action routine + fcb 0xa8 ; NOT token +SEEEF bsr SEEC7 ; point to buffer location + lda ,u ; get byte from buffer + sta ,x+ ; put it on screen + rts +SEEF6 bsr SEEC7 ; point to buffer location + lda ,u ; get byte + coma ; invert it + sta ,x+ ; put it on screen + rts +SEEFE bsr SEEC7 ; point to buffer location + lda ,u ; get byte from buffer + anda ,x ; "AND" with screen data + sta ,x+ ; put it on screen + rts +SEF07 bsr SEEC7 ; point to buffer location + lda ,u ; get byte from buffer + ora ,x ; "OR" with screen data + sta ,x+ ; put on screen + rts +SEF10 bsr SEEC7 ; point to buffer address + lda ,x ; get byte from screen (BUG: should be ,u to get from buffer) + coma ; invert data + sta ,x+ ; save on screen + rts +SEF18 ldy #HRESBUFF ; point to start of buffers + lda ,y ; are there any buffers? + cmpa #0xff + bne SEF2C ; brif so + jmp SEED3 ; raise error if no buffers +SEF25 ldy ,y ; point to next buffer + lbeq SEED3 ; brif end of buffers - raise error +SEF2C cmpb 2,y ; is this the desired buffer? + bne SEF25 ; brif not + ldd 3,y ; get size of buffer + leay 4,y ; point to start of data (less one for "pre-inc" on use + sty VCF ; save buffer pointer + leay 1,y ; point to actual data start + leay d,y ; calculate address of end of buffer + sty VD1 ; save end address + rts +; HPRINT command +HPRINT tst HRMODE ; graphics mode? + lbeq SE6EF ; brif not - raise error + lbrn 0 + jsr LB26A ; insist on ( + jsr SE7B2 ; evaluate coordinates + jsr LB267 ; insist on ) + jsr SYNCOMMA ; insist on comma + jsr LB156 ; evaluate print string + tst VALTYP ; is it string? + bne SEF62 ; brif not numeric (should be BMI) + jsr LBDD9 ; convert number to string + jsr LB516 ; save string in string space and all that jazz +SEF62 jsr LB657 ; fetch string details + stb H.PCOUNT ; save length in print count + ldy #H.PBUF ; point to temporary string buffer +SEF6C decb ; have we processed the whole string? + bmi SEF75 ; brif so (or if the string length was > 128) + lda ,x+ ; copy a character from the string into the buffer + sta ,y+ + bra SEF6C ; see if we're done yet +SEF75 lda HRMODE ; get graphics mode + ldb #40 ; 40 characters on a 320 line + cmpa #3 ; is it mode 1 or 2? + blo SEF7F ; brif so + ldb #80 ; 80 characters on a 640 line +SEF7F clra ; zero extend line size + subd HORBEG ; subtract first position from line length + bmi SF001 ; brif we're printing off the side of the screen + cmpb H.PCOUNT ; is the print count larger than characters left? + bhi SEF8E ; brif not + stb H.PCOUNT ; save remaining screen positions as print count + beq SF001 ; brif nothing to print +SEF8E lda #ROWMAX-1 ; get highest row number + cmpa VERBEG+1 ; are we in range? + bge SEF96 ; brif so + sta VERBEG+1 ; force bottom row if not in range +SEF96 jsr SF08C ; calculate actual pixel coordinates + jsr HCALPOS ; get screen pointer + ldy #H.PBUF ; point to string data + ldb H.PCOUNT ; get number of characters to print +SEFA3 lda ,y ; get character to print + anda #0x7f ; lose bit 7 (character set repeats) + suba #0x20 ; lose the "control" characters - no glyphs for those codes + bpl SEFAD ; brif it was not a control character + lda #0 ; use a space if it was +SEFAD sta ,y+ ; put glyph number into the buffer + decb ; processed all of them? + bgt SEFA3 ; brif not + lda HRMODE ; get graphics mode + deca ; zero-base it + asla ; two bytes per display routine + ldy #SF002 ; point to display routine table + ldy a,y ; point to display routine + sty VD1 ; save it + lda #8 ; 8 rows per character + sta VD3 ; temp save row counter + ldy #H.PBUF ; point to print buffer + ldu #SF09D ; point to FONT data + ldb H.FCOLOR ; get foreground colour + jsr PIXELFIL ; get an all pixel byte + stb ALLCOL ; save it + jsr SELTASK1 ; map the screen + lda H.PCOUNT ; get character count to display +SEFD9 pshs y,x,a ; save buffer pointer, character count, and screen address +SEFDB ldb ,y+ ; get character from buffer + clra ; zero extend it + aslb ;* 8 bytes per character entry (don't need rola after first + aslb ;* because characters are only 7 bits + rola + aslb + rola + lda d,u ; get font data for this row + jsr [VD1] ; display it + dec H.PCOUNT ; done all characters on this row? + bgt SEFDB ; brif not + puls a,x,y ; get back character count, buffer pointer, and screen address + dec VD3 ; have we done all the rows? + beq SEFFE ; brif so + sta H.PCOUNT ; restore print count + leau 1,u ; move one row down the font data + jsr SEA45 ; move one row down the screen + bra SEFD9 ; go do another row of pixels +SEFFE jsr SELTASK0 ; restore memory map +SF001 rts +SF002 fdb SF01A ; HSCREEN 1 (2 bpp) + fdb SF045 ; HSCREEN 2 (4 bpp) + fdb SF00A ; HSCREEN 3 (1 bpp) + fdb SF01A ; HSCREEN 4 (2 bpp) +SF00A pshs a ; save font data + coma ; invert it + anda ,x ; merge with screen - turns off pixels in the character + sta ,x ; save it back on the screen + puls a ; get back font data + anda ALLCOL ; merge with colour data + ora ,x ; merge with screen to fill hole created above + sta ,x+ ; save it on screen + rts +SF01A pshs y ; save buffer pointer + ldy #SF035 ; point to 2 bpp pixel masks + tfr a,b ; copy character data (need two bytes per character) + lsra ; use the upper 4 bits in first byte + lsra + lsra + lsra + lda a,y ; get pixel mask for all 16 possibilities for upper 4 bits + jsr SF00A ; shove it on screen + andb #0x0f ; lose upper bits for low half + lda b,y ; get pixel mask for this pixel combination + jsr SF00A ; shove that on screen too + puls y ; restore buffer pointer + rts +SF035 fcb 0x00,0x03,0x0c,0x0f ; combined pixel masks for 16 possibilities for a 2 bpp byte + fcb 0x30,0x33,0x3c,0x3f + fcb 0xc0,0xc3,0xcc,0xcf + fcb 0xf0,0xf3,0xfc,0xff +SF045 pshs y,a ; save buffer pointer and font data + ldy #SF06C ; point to 16 colour masks + lsra ; fetch high 4 bits + lsra + lsra + lsra + asla ; two bytes per mask (this is NOT redundant - this and above clears bit 0) + ldd a,y ; get two byte mask for these four bits + jsr SF00A ; show upper 2 pixels + tfr b,a ; show lower 2 pixels + jsr SF00A + puls a ; get back font data + anda #0x0f ; lost upper bits + asla ; two bytes per mask + ldd a,y ; get mask data + jsr SF00A ; show upper 2 pixels + tfr b,a ; show lower 2 pixels + jsr SF00A + puls y ; restore buffer pointer + rts +SF06C fdb 0x0000,0x000f,0x00f0,0x00ff ; combined pixel masks for 16 possibilities for a 4 bpp double byte + fdb 0x0f00,0x0f0f,0x0ff0,0x0fff + fdb 0xf000,0xf00f,0xf0f0,0xf0ff + fdb 0xff00,0xff0f,0xfff0,0xffff +SF08C ldd HORBEG ; get horizontal character cell coordinate + aslb ; times 8 - 8x8 font data; note first shift can't cause carry with max 79 for column number + aslb + rola + aslb + rola + std HORBEG ; save actual horizontal pixel position of print position + lda VERBEG+1 ; get vertical character cell coordinate + asla ; times 8 - 8x8 font data + asla + asla + sta VERBEG+1 ; save actual vertical pixel position of print position + rts +; This is the HPRINT font, which is basically equivalent to the hardware font in the GIME for character codes +; 0x20 through 0x7f. It does not include the extra characters in the 0x00-0x1f range of the hardware character +; set. However, glyphs for those are actually included in the ROM above the end of the actual code. +SF09D fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; SPACE + fcb 0x10,0x10,0x10,0x10,0x10,0x00,0x10,0x00 ; ! + fcb 0x28,0x28,0x28,0x00,0x00,0x00,0x00,0x00 ; " + fcb 0x28,0x28,0x7C,0x28,0x7C,0x28,0x28,0x00 ; # + fcb 0x10,0x3C,0x50,0x38,0x14,0x78,0x10,0x00 ; $ + fcb 0x60,0x64,0x08,0x10,0x20,0x4C,0x0C,0x00 ; % + fcb 0x20,0x50,0x50,0x20,0x54,0x48,0x34,0x00 ; & + fcb 0x10,0x10,0x20,0x00,0x00,0x00,0x00,0x00 ; ' + fcb 0x08,0x10,0x20,0x20,0x20,0x10,0x08,0x00 ; ( + fcb 0x20,0x10,0x08,0x08,0x08,0x10,0x20,0x00 ; ) + fcb 0x00,0x10,0x54,0x38,0x38,0x54,0x10,0x00 ; * + fcb 0x00,0x10,0x10,0x7C,0x10,0x10,0x00,0x00 ; + + fcb 0x00,0x00,0x00,0x00,0x00,0x10,0x10,0x20 ; , + fcb 0x00,0x00,0x00,0x7C,0x00,0x00,0x00,0x00 ; - + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00 ; . + fcb 0x00,0x04,0x08,0x10,0x20,0x40,0x00,0x00 ; / + fcb 0x38,0x44,0x4C,0x54,0x64,0x44,0x38,0x00 ; 0 + fcb 0x10,0x30,0x10,0x10,0x10,0x10,0x38,0x00 ; 1 + fcb 0x38,0x44,0x04,0x38,0x40,0x40,0x7C,0x00 ; 2 + fcb 0x38,0x44,0x04,0x08,0x04,0x44,0x38,0x00 ; 3 + fcb 0x08,0x18,0x28,0x48,0x7C,0x08,0x08,0x00 ; 4 + fcb 0x7C,0x40,0x78,0x04,0x04,0x44,0x38,0x00 ; 5 + fcb 0x38,0x40,0x40,0x78,0x44,0x44,0x38,0x00 ; 6 + fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x40,0x00 ; 7 + fcb 0x38,0x44,0x44,0x38,0x44,0x44,0x38,0x00 ; 8 + fcb 0x38,0x44,0x44,0x38,0x04,0x04,0x38,0x00 ; 9 + fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x00,0x00 ; : + fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x10,0x20 ; ; + fcb 0x08,0x10,0x20,0x40,0x20,0x10,0x08,0x00 ; < + fcb 0x00,0x00,0x7C,0x00,0x7C,0x00,0x00,0x00 ; = + fcb 0x20,0x10,0x08,0x04,0x08,0x10,0x20,0x00 ; > + fcb 0x38,0x44,0x04,0x08,0x10,0x00,0x10,0x00 ; ? + fcb 0x38,0x44,0x04,0x34,0x4C,0x4C,0x38,0x00 ; @ + fcb 0x10,0x28,0x44,0x44,0x7C,0x44,0x44,0x00 ; A + fcb 0x78,0x24,0x24,0x38,0x24,0x24,0x78,0x00 ; B + fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x00 ; C + fcb 0x78,0x24,0x24,0x24,0x24,0x24,0x78,0x00 ; D + fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x7C,0x00 ; E + fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x40,0x00 ; F + fcb 0x38,0x44,0x40,0x40,0x4C,0x44,0x38,0x00 ; G + fcb 0x44,0x44,0x44,0x7C,0x44,0x44,0x44,0x00 ; H + fcb 0x38,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; I + fcb 0x04,0x04,0x04,0x04,0x04,0x44,0x38,0x00 ; J + fcb 0x44,0x48,0x50,0x60,0x50,0x48,0x44,0x00 ; K + fcb 0x40,0x40,0x40,0x40,0x40,0x40,0x7C,0x00 ; L + fcb 0x44,0x6C,0x54,0x54,0x44,0x44,0x44,0x00 ; M + fcb 0x44,0x44,0x64,0x54,0x4C,0x44,0x44,0x00 ; N + fcb 0x38,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; O + fcb 0x78,0x44,0x44,0x78,0x40,0x40,0x40,0x00 ; P + fcb 0x38,0x44,0x44,0x44,0x54,0x48,0x34,0x00 ; Q + fcb 0x78,0x44,0x44,0x78,0x50,0x48,0x44,0x00 ; R + fcb 0x38,0x44,0x40,0x38,0x04,0x44,0x38,0x00 ; S + fcb 0x7C,0x10,0x10,0x10,0x10,0x10,0x10,0x00 ; T + fcb 0x44,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; U + fcb 0x44,0x44,0x44,0x28,0x28,0x10,0x10,0x00 ; V + fcb 0x44,0x44,0x44,0x44,0x54,0x6C,0x44,0x00 ; W + fcb 0x44,0x44,0x28,0x10,0x28,0x44,0x44,0x00 ; X + fcb 0x44,0x44,0x28,0x10,0x10,0x10,0x10,0x00 ; Y + fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x7C,0x00 ; Z + fcb 0x38,0x20,0x20,0x20,0x20,0x20,0x38,0x00 ; ] + fcb 0x00,0x40,0x20,0x10,0x08,0x04,0x00,0x00 ; \ + fcb 0x38,0x08,0x08,0x08,0x08,0x08,0x38,0x00 ; [ + fcb 0x10,0x38,0x54,0x10,0x10,0x10,0x10,0x00 ; UP ARROW + fcb 0x00,0x10,0x20,0x7C,0x20,0x10,0x00,0x00 ; LEFT ARROW + fcb 0x10,0x28,0x44,0x00,0x00,0x00,0x00,0x00 ; ^ + fcb 0x00,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; a + fcb 0x40,0x40,0x58,0x64,0x44,0x64,0x58,0x00 ; b + fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x00 ; c + fcb 0x04,0x04,0x34,0x4C,0x44,0x4C,0x34,0x00 ; d + fcb 0x00,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; e + fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x10,0x00 ; f + fcb 0x00,0x00,0x34,0x4C,0x4C,0x34,0x04,0x38 ; g + fcb 0x40,0x40,0x58,0x64,0x44,0x44,0x44,0x00 ; h + fcb 0x00,0x10,0x00,0x30,0x10,0x10,0x38,0x00 ; i + fcb 0x00,0x04,0x00,0x04,0x04,0x04,0x44,0x38 ; j + fcb 0x40,0x40,0x48,0x50,0x60,0x50,0x48,0x00 ; k + fcb 0x30,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; l + fcb 0x00,0x00,0x68,0x54,0x54,0x54,0x54,0x00 ; m + fcb 0x00,0x00,0x58,0x64,0x44,0x44,0x44,0x00 ; n + fcb 0x00,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; o + fcb 0x00,0x00,0x78,0x44,0x44,0x78,0x40,0x40 ; p + fcb 0x00,0x00,0x3C,0x44,0x44,0x3C,0x04,0x04 ; q + fcb 0x00,0x00,0x58,0x64,0x40,0x40,0x40,0x00 ; r + fcb 0x00,0x00,0x3C,0x40,0x38,0x04,0x78,0x00 ; s + fcb 0x20,0x20,0x70,0x20,0x20,0x24,0x18,0x00 ; t + fcb 0x00,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; u + fcb 0x00,0x00,0x44,0x44,0x44,0x28,0x10,0x00 ; v + fcb 0x00,0x00,0x44,0x54,0x54,0x28,0x28,0x00 ; w + fcb 0x00,0x00,0x44,0x28,0x10,0x28,0x44,0x00 ; x + fcb 0x00,0x00,0x44,0x44,0x44,0x3C,0x04,0x38 ; y + fcb 0x00,0x00,0x7C,0x08,0x10,0x20,0x7C,0x00 ; z + fcb 0x08,0x10,0x10,0x20,0x10,0x10,0x08,0x00 ; { + fcb 0x10,0x10,0x10,0x00,0x10,0x10,0x10,0x00 ; | + fcb 0x20,0x10,0x10,0x08,0x10,0x10,0x20,0x00 ; } + fcb 0x20,0x54,0x08,0x00,0x00,0x00,0x00,0x00 ; ~ + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x7C,0x00 ; _ +; HDRAW command +HDRAW tst HRMODE ; grahics mode? + lbeq SE6EF ; brif not + lbrn 0 + ldx #0 ; set empty string for "end of DRAW" + ldb #1 + pshs x,b + stb SETFLG ; set up for "set" mode + stx VD5 ; clear update and draw flags + jsr SE731 ; set up color byte + jsr LB156 ; evaluate command string +SF3B8 jsr LB654 ; fetch command string details + bra SF3C5 ; interpret command string +SF3BD jsr SF591 ; fetch command character + jmp SF5A7 ; evaluate number +SF3C3 puls b,x ; get "caller" command string details +SF3C5 stb VD8 ; save string pointer + beq SF3C3 ; brif end of string - try another + stx VD9 ; set string data pointer + lbeq SF4D0 ; brif we hit the top of the stack +SF3CF tst VD8 ; is there anything left? + beq SF3C3 ; brif not + jsr SF591 ; get command character + cmpa #'; ; separator? + beq SF3CF ; brif so - ignore it + cmpa #'' ; '? + beq SF3CF ; brif so - ignore that too + cmpa #'N ; update toggle? + bne SF3E6 ; brif not + com VD5 ; toggle the "update" flag (if set, return to original position after) + bra SF3CF ; process more +SF3E6 cmpa #'B ; blank modifier? + bne SF3EE ; brif not + com VD6 ; toggle "draw" flag - 0 = draw, nonzero = don't draw + bra SF3CF ; process more +SF3EE cmpa #'X ; substring call? + lbeq SF4A1 ; brif so - process it + cmpa #'M ; M (move)? + lbeq SF54C ; brif so - process "move" + pshs a ; save command character + ldb #1 ; default count if no number follows + clr VD3 ; clear MS byte of count + stb VD4 ; save LS byte of count + tst VD8 ; is there anything left? + beq SF417 ; brif not + jsr SF591 ; get command character + jsr LB3A2 ; set C if not alpha + pshs cc ; save alpha flag + jsr SF5F2 ; back up command pointer + puls cc ; get back alpha flag + bcc SF417 ; brif command is alpha + bsr SF3BD ; evaluate decimal string +SF417 puls a ; get command back + cmpa #'C ; C (colour)? + beq SF445 ; brif so + cmpa #'A ; A (angle)? + beq SF451 ; brif so + cmpa #'S ; S (scale)? + beq SF45C ; brif so + cmpa #'U ; U (up)? + beq SF496 ; brif so + cmpa #'D ; D (down)? + beq SF492 ; brif so + cmpa #'L ; L (left)? + beq SF48C ; brif so + cmpa #'R ; R (right)? + beq SF485 ; brif so + suba #'E ; shift E,F,G,H to be 0-3 + beq SF473 ; brif E (UR) + deca ; F (DR) + beq SF46D ; brif so + deca ; G (DL) + beq SF47D ; brif so + deca ; H (UL) + beq SF467 ; brif so + jmp LB44A ; raise error if unrecognized command +SF445 jsr SE711 ; adjust colour code for graphics mode + stb H.FCOLOR ; set new foreground + jsr SE731 ; set up colour byte + lbra SF3CF ; handle another command +SF451 cmpb #4 ; only 4 angles valid + lbhs LB44A ; brif invalid angle + stb ANGLE ; save draw angle + lbra SF3CF ; go handle another command +SF45C cmpb #63 ; only 0-62 are valid scale factors + lbhs LB44A ; brif invalid scale + stb SCALE ; set scale factor + lbra SF3CF ; process another command +SF467 lda VD3 ; get count MSB + bsr NEGACCD ; negate horizontal difference (go left) + bra SF46F ; go the same distance up +SF46D lda VD3 ; get count MSB +SF46F tfr d,x ; go same distance right as down + bra SF4D4 ; go handle movement/drawing +SF473 lda VD3 ; get MSB of count + tfr d,x ; going same distance on both axes + bsr NEGACCD ; negate the vertical distance + exg d,x ; put vertical in X, horizontal in D + bra SF4D4 ; go handle drawing and moving +SF47D lda VD3 ; get MSB of count + tfr d,x ; go same distance on both axes + bsr NEGACCD ; go left horizontally (and down vertically) + bra SF4D4 ; go handle drawing and moving +SF485 lda VD3 ; get MSB of difference (going right) +SF487 ldx #0 ; no vertical movement + bra SF4D4 ; handle drawing/moving +SF48C lda VD3 ; get MSB of count + bsr NEGACCD ; negate because going left + bra SF487 ; set no vertical difference, handle drawing/moving +SF492 lda VD3 ; get MSB of count + bra SF49A ; go make horizontal difference 0, use positive distance for down +SF496 lda VD3 ; get MSB of count + bsr NEGACCD ; use negative distance for up +SF49A ldx #0 ; use 0 horizontal distance + exg x,d ; put horizontal and vertical in the right places + bra SF4D4 ; go move/draw +SF4A1 jsr SF611 ; interpret command as a variable + ldb #2 ; see if we're about to run out of memory + jsr LAC33 + ldb VD8 ; get remaining characters in current command string + ldx VD9 ; get current command string pointer + pshs x,b ; save the stack frame + jmp SF3B8 ; go evaluate the string +SF4B2 ldb SCALE ; get scaling factor + beq SF4D1 ; brif none - use full scale + clra ; zero extend scale + exg d,x ; put distance in D, save scale factor + sta ,-s ; save MSB of distance and set flags on sign + bpl SF4BF ; brif positive distance + bsr NEGACCD ; make it positive if negative +SF4BF jsr SEBCB ; multiply D and X + tfr U,D ; save LSW in D + lsra ; divide by 4 + rorb + lsra + rorb + tst ,s+ ; was original positive? + bpl SF4D0 ; brif so +NEGACCD nega ; negate D + negb + sbca #0 +SF4D0 rts +SF4D1 tfr x,d ; keep unmodified distance + rts +SF4D4 pshs d ; save horizontal distance + bsr SF4B2 ; apply scale factor to vertical distance + puls x ; get back horizontal distance + pshs d ; save scaled vertical distance + bsr SF4B2 ; apply scale to horizontal distance + puls x ; get back the vertical distance + ldy ANGLE ; get draw angle (using Y to avoid clobbering D) + pshs y ; save it +SF4E5 tst ,s ; check angle + beq SF4F1 ; brif no angle + exg x,d ;* swap horizontal and vertical distances then negate new horizontal + bsr NEGACCD ;* distance, which rotates 90° counterclockwise + dec ,s ; count down the angle + bra SF4E5 ; see if we have rotated enough times +SF4F1 puls y ; clean up stack + ldu #0 ; default end position to 0 + addd HORDEF ; add distance to current draw position + bmi SF4FC ; brif we went negative - use minimal 0 + tfr d,u ; use calculated draw coordinate +SF4FC tfr x,d ; fetch vertical distance for calculation + ldx #0 ; default end position to 0 + addd VERDEF ; add distance to draw position + bmi SF507 ; brif we went negative - use minimal 0 + tfr d,x ; use calculated coordinate +SF507 cmpu #640 ; is it out of range completely? + blo SF510 ; brif not + ldu #639 ; maximize to right edge of screen +SF510 lda HRMODE ; get graphics mode + cmpa #2 ; is it a 320 mode? + bgt SF51F ; brif not + cmpu #320 ; out of range for 320 mode? + blo SF51F ; brif not + ldu #319 ; maximize to right edge of screen +SF51F cmpx #192 ; out of range vertically? + blo SF527 ; brif not + ldx #191 ; maximize to bottom of screen +SF527 ldd HORDEF ; set start position to current draw position + std HORBEG + ldd VERDEF + std VERBEG + stx VEREND ; set calculated position as end position + stu HOREND + tst VD5 ; are we going to update draw position? + bne SF53B ; brif not + stx VERDEF ; set new draw position + stu HORDEF +SF53B jsr SEA0D ; "normalize" coordinates + tst VD6 ; are we doing to draw a line? + bne SF545 ; brif not + jsr SE94E ; draw a line +SF545 clr VD5 ; reset the "update" flag + clr VD6 ; reset the "draw" flag + jmp SF3CF ; go handle another command +SF54C jsr SF591 ; get input character + pshs a ; save it + jsr SF578 ; evaluate horizontal distance + pshs d ; save it + jsr SF591 ; get a character + cmpa #', ; is it a comma separator? + lbne LB44A ; brif not - raise error + jsr SF575 ; evaluate the vertical distance + tfr d,x ; save vertical distance + puls u ; get horizontal distance + puls a ; get first command character + cmpa #'+ ; +? + beq SF570 ; treat coordinates as relative displacements + cmpa #'- ; -? + bne SF507 ; brif neither + or -; treat as absolute coordinates +SF570 tfr u,d ; put horizontal distance in D + jmp SF4D4 ; treat distances as offsets +SF575 jsr SF591 ; get character +SF578 cmpa #'+ ; +? + beq SF583 ; brif so - do positive + cmpa #'- ; -? + beq SF584 ; brif so - do negative + jsr SF5F2 ; back up input pointer +SF583 clra ; flag positive +SF584 pshs a ; save sign flag + jsr SF3BD ; evaluate decimal number + tst ,s+ ; is it positive? + beq SF590 ; brif so + negb ; negate the value - BUG: should be JSR NEGACCD; this code sequence doesn't work + sbca #0 +SF590 rts +SF591 pshs x ; save register +SF593 tst VD8 ; is there anything to fetch? + lbeq LB44A ; brif not - raise error + ldx VD9 ; get command pointer + lda ,x+ ; get command character + stx VD9 ; save updated pointer + dec VD8 ; account for character consumed + cmpa #0x20 ; space? + beq SF593 ; brif so - skip it + puls x,pc ; restore register and return +SF5A7 cmpa #'= ; is it variable equate? + bne SF5B6 ; brif not + pshs u,y ; save registers + bsr SF611 ; interpret variable in command string + jsr LB3E9 ; convert to integer in D + std VD3 ; save as count + puls y,u,pc ; restore registers and return +SF5B6 jsr SF608 ; clear carry if numeric + lbcs LB44A ; bail if not numeric + clr VD3 ; initialize count to 0 + clr VD4 +SF5C1 suba #'0 ; remove ASCII bias + sta VD7 ; save digit value + ldd VD3 ; get accumulated value + bsr SF5FD ; multiply by 10 + addb VD7 ; add digit value + adca #0 ; propagate carry + std VD3 ; save accumulated count value + lda HRMODE ; get graphics mode + cmpa #2 ; is it a 640 mode? + bgt SF5DA ; brif so + ldd #319 ; get max for 320 mode + bra SF5DD +SF5DA ldd #639 ; get max for 640 mode +SF5DD cmpd VD3 ; is the value in range for a horizontal coordinate? + lblt LB44A ; brif not + ldd VD3 ; get accumulated value + tst VD8 ; is there anything more to parse? + beq SF5FA ; brif not + jsr SF591 ; get a character + jsr SF608 ; set C if not digit + bcc SF5C1 ; brif digit - add to accumulated value +SF5F2 inc VD8 ; account for character being unfetched + ldx VD9 ; move command pointer back + leax -1,x + stx VD9 +SF5FA ldd VD3 ; get accumulated value + rts +SF5FD aslb ; times 2 + rola + pshs d ; save 2D + aslb ; times 4 + rola + aslb ; times 8 + rola + addd ,s++ ; 8D+2D=10D + rts +SF608 cmpa #'0 ; is it less than ASCII 0? + blo SF610 ; brif so - sets C + suba #'9+1 ; set C if > ASCII 9 + suba #-('9+1) +SF610 rts +SF611 ldx VD9 ; get command pointer + pshs x ; save it + jsr SF591 ; get command character + jsr LB3A2 ; set C if not alpha + lbcs LB44A ; brif not variable name +SF61F jsr SF591 ; get command character + cmpa #'; ; is it end of variable string? + bne SF61F ; brif not + puls x ; get back start of variable + ldu CHARAD ; save interpreter input pointer + pshs u + stx CHARAD ; save command string pointer as interpeter input + jsr LB284 ; evaluate variable + puls x ; restore interpreter input pointer + stx CHARAD + rts +; WIDTH command +WIDTH clr HRMODE ; turn off graphics + lbrn 0 + cmpa #0 ; end of line? (BUG: should do a BEQ before the CLR above) + beq SF64F ; brif so - raise error if no argument (won't trigger on :) + jsr EVALEXPB ; evaluate width argument + cmpb #32 ; 32 columns? + beq COL32 ; brif so + cmpb #40 ; 40 columns? + beq COL40 ; brif so + cmpb #80 ; 80 columns? + beq COL80 ; brif so +SF64F jmp LB44A ; raise FC error +COL32 clra ; set text mode to 32 columns + sta HRWIDTH + jsr LA928 ; clear screen + lbsr SETTEXT ; set up display for 32 column screen + rts +COL40 lda #1 ; mode number for 40 columns + sta HRWIDTH ; set text screen mode + lbsr SF772 ; map text screen + lda #40 ; set up scren size in character cells + ldb #ROWMAX + std H.COLUMN + ldd #HRESSCRN+40*ROWMAX*2 ; set end address of screen +SF66D std H.DISPEN ; save end address + bsr SF68C ; clear the screen + lbsr SF778 ; unmap text screen + lbsr SETTEXT ; set up display for the text screen + rts +COL80 lda #2 ; mode number for 80 columns + sta HRWIDTH ; set text screen mode + lbsr SF772 ; map the screen + lda #80 ; set up screen size in character cells + ldb #ROWMAX + std H.COLUMN + ldd #HRESSCRN+80*ROWMAX*2 ; set end address of screen + bra SF66D ; set up rest of parameters +SF68C ldx #HRESSCRN ; set cursor address to top left corner + lbrn 0 + stx H.CRSLOC + lda #0x20 ; use space to clear screen + ldb H.CRSATT ; get current attributes +SF69B std ,x++ ; blank a character cell + cmpx H.DISPEN ; end of screen? + blo SF69B ; brif not + ldx #HRESSCRN ; reset to top of screen + clra ; reset cursor coordinates to 0,0 + sta H.CURSX + sta H.CURSY + rts +; CLS patch entered from the other patch in the ECB area +ALINK23 puls cc ; restore zero flag + lbrn 0 + beq SF6E0 ; brif no arguments + jsr EVALEXPB ; get colour number + tstb ; 0? + beq SF6E0 ; brif so - treat as no arguments + cmpb #8 ; valid colour? + bhi SF6E7 ; brif not - do the easter egg or the other easter egg + decb ; zero-base the colour + leay IM.PALET,pcr ; point to current palette settings + lda b,y ; get the real colour + sta V.BORDER ; set border colour + lbsr SF766 ; set border colour in GIME initializers + stb H.CRSATT ; set attributes to foreground 0, background as selected, no blink or underline + lda #0x20 ; get space character + lbsr SF772 ; map screen + ldx #HRESSCRN ; get address of start of screen + stx H.CRSLOC ; put cursor there + bsr SF69B ; clear screen +SF6DC lbsr SF778 ; unmap screen + rts +SF6E0 lbsr SF772 ; map screen + bsr SF68C ; clear screen + bra SF6DC ; ummap screen and return +SF6E7 clr H.CRSATT ; reset attributes to colours 0,0, no blink or underline + lda IM.PALET ; get colour in register 0 + sta V.BORDER ; set border colour + bsr SF766 ; reset border colour in GIME initializers + cmpb #100 ; is it CLS 100? +SF6F4 beq SF730 ; brif so - do the easter egg + bsr SF772 ; map the screen + bsr SF68C ; clear screen + bsr SF778 ; unmap screen + ldx #MICROMS-1 ; point to Microware commercial + jmp STRINOUT ; display it +MICROMS fcc 'Microware Systems Corp.' + fcb 0x0d,0x00 +AUTHORMS fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; the ROM/RAM copy sets this to the actual easter egg text + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 + fcb 0x00,0x00,0x00,0x00,0x00 +SF730 bsr SF772 ; map the screen + lbsr SF68C ; clear it + bsr SF778 ; unmap the screen + ldx #AUTHORMS-1 ; point to the easter egg + jsr STRINOUT ; display it + pshs x ; save X for some reason + leax >SF6F4,pcr ; point to start of easter egg code + lda #0x12 ; NOP opcode + sta ,x+ ; blank out the branch that brings us here + sta ,x + leax >AUTHORMS,pcr ; point to author message +SF74D sta ,x+ ; blank out character in string or this code + cmpx #SF74D ; end of string or display code? + blo SF74D ; brif not + puls x ; restore X + rts +; Line input routine patch for handling CLEAR +ALINK27 tst HRWIDTH ; is it 40/80 column screen? + bne SF761 ; brif so + jsr LA928 ; clear 32 column screen +SF75E jmp LA390 ; go make to mainline +SF761 lbsr SF6E0 ; clear the screen + bra SF75E ; return to mainline +SF766 pshs y ; save register + leay SE03B,pcr ; point to text initializers + sta 3,y ; set border in 40 column initializer + sta 12,y ; set border in 80 column initializer + puls y,pc ; restore registers and return +SF772 orcc #0x50 ; clobber interrupts + lbsr SELTEXT ; map the text screen (by setting *all 16* MMU registers) + rts +SF778 lbsr SETMMU ; unmap text screen (by setting *all 16* MMU registers) + andcc #0xaf ; restart interrupts + rts +; The driver for putting characters on the 40 and 80 column screen is here, modulo the WIDTH command and clear +; screen routines above. +; +; There are several major problems with this driver: +; +; * Cursor handling is overly complicated. Instead of doing what Color Basic does and only show the cursor +; when waiting for input in the generic input routine, this driver displays it almost all of the time and, thus, +; has all manner of code for managing the cursor that would not be needed otherwise. +; * The system goes out of its way to set up the screen height and width values. Then, it doesn't bother using +; them consistently, especially during the screen scrolling routine. Indeed, the screen scrolling routine could +; be made completely general purpose by using two pointers, say U for the destination and X for the source. Then +; the column count could be used to decide the line width (to calculate the offset betwen U and X) and then the +; row count could be used to set the row number after the scrolling is done. This would remove any hard coded +; offsets or screen size assumptions. +; * The routines for mapping and unmapping the text screen are inexcusably slow. Only one MMU register needs to +; be changed in either routine. However, instead of doing that, the routines use an inefficient routine that +; sets *all 16* MMU registers (both tasks!). This reduces screen output speed so much that a fast reader can +; actually keep up with the output going full speed. Simply replacing these two routines with simpler ones that +; do not do that dumbassery gets performance on par with the 32 column VDG screen. +; +; Along with the above, some of the code is far more convoluted than it needs to be, but that is relatively +; benign compared to everything else. +; +; Blink cursor patch +ALINK24 bsr SF787 ; blink the cursor + jsr KEYIN ; get keypress + beq ALINK24 ; brif no key pressed + puls b,x,pc ; return to caller +SF787 dec BLKCNT ; time to blink cursor? + bne SF7A8 ; brif not + ldb #11 ; reset blink counter + stb BLKCNT + bsr SF772 ; map screen + ldx H.CRSLOC ; get cursor pointer + lda 1,x ; get current attributes + bita #0x40 ; is underline on? + beq SF79F ; brif not - enable it + lda H.CRSATT ; use current attributes if it is + bra SF7A4 +SF79F lda H.CRSATT ; get current attributes + ora #0x40 ; turn on underline +SF7A4 sta 1,x ; save new attributes + bsr SF778 ; unmap screen +SF7A8 ldx #DEBDEL ; do a delay + jmp LA7D3 +; Put character on screen patch +ALINK22 bsr SF772 ; map the screen + lbrn 0 + ldx H.CRSLOC ; get cursor location + cmpa #0x08 ; backspace? + bne SF7C4 ; brif not + cmpx #HRESSCRN ; at start of screen? + beq SF7DE ; brif so - do nothing + bsr SF7E2 ; do a backspace + bra SF7DE ; finish up +SF7C4 cmpa #0x0d ; carriage return? + bne SF7CC ; brif not + bsr SF827 ; do a carriage return + bra SF7D7 ; finish up with scroll check +SF7CC cmpa #0x20 ; is it a control code? + blo SF7DE ; brif so - do nothing + ldb H.CRSATT ; get current attributes + std ,x ; put character on screen + bsr SF807 ; move cursor forward +SF7D7 cmpx H.DISPEN ; end of screen? + blo SF7DE ; brif not + bsr SF854 ; scroll screen +SF7DE bsr SF778 ; unmap the screen + puls a,b,x,pc ; restore registers and return +SF7E2 pshs b,a ; save registers + lda #0x20 ; space character + ldb H.CRSATT ; get attributes + std ,x ; turns off cursor at this position and blanks it + orb #0x40 ; turn on underline (we'll put a cursor in the previous position) + std -2,x ; put blank and cursor back one + leax -2,x ; move pointer back + stx H.CRSLOC ; save new cursor pointer + ldd H.CURSX ; get coordinates + deca ; move horizontal back + bpl SF802 ; brif we didn't wrap + decb ; move vertical back + stb H.CURSY ; save it + lda H.COLUMN ; get screen width + deca ; coordinates are zero-based so now we have the max horizontal coord +SF802 sta H.CURSX ; save new horizontal position + puls a,b,pc ; restore registers and return +SF807 pshs a,b ; save registers + lda #0x20 ; we'll blank a character for the cursor + ldb H.CRSATT ; get attributes + orb #0x40 ; force underline for cursor + leax 2,x ; move pointer forward + std ,x ; put blank and cursor on screen + stx H.CRSLOC ; save new cursor position + ldd H.CURSX ; get coordinates + inca ; move right + cmpa H.COLUMN ; did we hit the edge? + blo SF802 ; brif not - save new horizontal coordinate and return + incb ; bump line + stb H.CURSY ; save new line + clra ; reset to left side of screen + bra SF802 ; save new horizontal coordinate and return +SF827 pshs a,b ; save registers + lda #0x20 ; get space character + ldb H.CRSATT ; get attributes +SF82E std ,x++ ; blank a character + pshs a ; save character + lda H.CURSX ; get horizontal position + inca ; bump it + sta H.CURSX ; save new position + cmpa H.COLUMN ; edge of screen? + puls a ; restore character + blo SF82E ; brif not end of line yet + stx H.CRSLOC ; save cursor location + clr H.CURSX ; reset to left edge + inc H.CURSY ; bump row + lda #0x20 ; space character + ldb H.CRSATT ; get attributes + orb #0x40 ; turn on underline + std ,x ; put a cursor on screen + puls a,b,pc ; restore registers and return +SF854 pshs a,b ; save registers + ldx #HRESSCRN ; point to start of screen + lda H.COLUMN ; get screen width + cmpa #40 ; is it 40 columns? + bne SF86E ; brif not - do 80 column scroll +SF860 ldd 2*40,x ; get character cell from one line down + std ,x++ ; move it here + cmpx #HRESSCRN+(ROWMAX-1)*40*2 ; at start of last row? + blo SF860 ; brif not +SF86A bsr SF87B ; fill last row with spaces + puls a,b,pc ; restore registers and return +SF86E ldd 80*2,x ; get a character cell from next row + std ,x++ ; put it here + cmpx #HRESSCRN+(ROWMAX-1)*80*2 ; at start of last row? + blo SF86E ; brif not + bra SF86A ; blank out last row and finish up +SF87B clr H.CURSX ; reset column to 0 + lda #ROWMAX-1 ; reset row number to bottom of screen + sta H.CURSY + lda #0x20 ; get space character + ldb H.CRSATT ; get attributes + pshs x ; save pointer to start of row +SF88A std ,x++ ; blank a character + cmpx H.DISPEN ; at end of screen? + bne SF88A ; brif not + clr H.CURSX ; reset horizontal position to margin + puls x ; get start of line pointer + lda #0x20 ; space haracter + ldb H.CRSATT ; get attributes + orb #0x40 ; turn on underline + std ,x ; put a bleeping cursor at start of line + stx H.CRSLOC ; set cursor position + rts +; Conditional newline patch. Note that this maps and unmaps the text screen in 40/80 column mode +; but that is completely unneeded to just test the X coordinate. +ALINK26 tst DEVNUM ; is it screen? + bne SF8AB ; brif not + tst HRWIDTH ; VDG screen? + bne SF8B1 ; brif not +SF8AB jsr LA35F ; set up print parameters + jmp LB95F ; re-enter mainline code +SF8B1 lbsr SF772 ; map screen + tst H.CURSX ; at left margin? + pshs cc ; save Z flag + lbsr SF778 ; unmap screen + puls cc ; get back Z flag + lbne LB958 ; brif not at left margine - do CR + rts +; PRINT @ patch +ALINK25 tst HRWIDTH ; VDG screen? + bne SF8CD ; brif not - raise error + jsr LA554 ; move cursor to specified position + jmp LB905 ; return to mainline code +SF8CD ldb #39*2 ; code for HP error + jmp LAC46 ; raise error +; LOCATE command +; The parameter checking here could simply use the H.COLUMN and H.ROW variables and it would +; be loads simpler. Also, if the dumbassery with the cursor wasn't a thing, this routine wouldn't +; need to mess with mapping the screen or screwing around with the cursor. +LOCATE ldb HRWIDTH ; is it 40/80 column screen? + lbrn 0 + beq SF8CD ; brif not - raise error + pshs b ; save screen mode + jsr SE7B2 ; evaluate coordinates + lda BINVAL+1 ; get X coordinate + puls b ; get back screen mode + cmpb #1 ; is it 40 column screen? + bne SF8EB ; brif not + cmpa #40 ; in range for 40 columns? + bra SF8ED +SF8EB cmpa #80 ; in range for 80 columns? +SF8ED lbhs LB44A ; brif not - raise error + ldb VERBEG+1 ; get Y coordinate + cmpb #ROWMAX ; is it in range? + bhs SF8ED ; brif not - raise error + pshs d ; save new coordinates + lbsr SF772 ; map screen + std H.CURSX ; set screen coordinates + ldx H.CRSLOC ; get pointer to old position + lda H.CRSATT ; replace attributes with current ones + sta 1,x + lda H.COLUMN ; get number of columns (why not use this above?) + asla ; two bytes per character cell + mul ; now D is offset to start of row + ldx #HRESSCRN ; get start of screen + leax d,x ; now X points to the start of the line + puls a,b ; get back column and row numbers + asla ; two bytes per character cell + tfr a,b ; need this in B since we'll overflow singed 8 bits + abx ; offset to correct cursor position + lda H.CRSATT ; get attributes + ora #0x40 ; enable underline + sta 1,x ; enable cursor + stx H.CRSLOC ; save new cursor pointer + lbsr SF778 ; unmap screen + rts +; HSTAT command +HSTAT tst HRWIDTH ; is it 40/80 column screen? + lbrn 0 + beq SF8CD ; brif not - raise error + lbsr SF772 ; map the screen + ldx H.CRSLOC ; get cursor pointer + ldd ,x ; get character and attributes + std VCB ; save them + ldd H.CURSX ; get screen coordinates + std VCD ; save them + lbsr SF778 ; unmap screen + jsr LB357 ; evaluate variable for character + stx VARDES ; saveit + jsr SYNCOMMA ; insist on a comma + ldb #1 ; make a single character string + jsr LB56D + lda VCB ; get character on screen + jsr LB511 ; get string details + sta ,x ; save character in string + jsr LB54C ; put string on string stack + ldx VARDES ; point to variable descriptor + tst -1,x ; is it a string? (should have checked after evaluating instead) + lbpl LB151 ; do type mismatch if number + ldy FPA0+2 ; point to destination string descriptor + ldb #5 ; copy 5 bytes from newly created string into variable +SF963 lda ,y+ ; copy byte + sta ,x+ + decb ; done all? + bne SF963 ; brif not + LDX TEMPPT ; point to new string descriptor + leax -5,x ; BUG: should just call LB675 to remove string from string stack + stx TEMPPT + jsr LB357 ; evaluate a variable (for X coord) + stx VARDES ; save pointer to it + jsr SYNCOMMA ; insist on a comma after it + clra ; zero extend attributes + ldb VCB+1 ; get attribute byte + jsr GIVABF ; convert to float + ldx VARDES ; point to variable + tst -1,x ; test if numeric (should have tested VALTYP above) + lbmi LB151 ; TM error if not number + jsr LBC35 ; pack FPA0 to variable + jsr LB357 ; evaluate another variable + stx VARDES ; save it + jsr SYNCOMMA ; insist on a comma + clra ; zero extend the X coordinate + ldb VCD ; get X coordinate + jsr GIVABF ; turn into a FP number + ldx VARDES ; get variable + tst -1,x ; is it a number (should have tested VALTYP above) + LBMI LB151 ; brif not - TM error + jsr LBC35 ; pack FPA0 to variable + jsr LB357 ; evaluate another variable + stx VARDES ; save it + clra ; zero extend Y coordinate + ldb VCD+1 ; get Y coordinate + jsr GIVABF ; turn into a FP number + ldx VARDES ; get variable descriptor back + tst -1,x ; is it a number (should have tested VALTYP above) + lbmi LB151 ; brif not - TM error + jsr LBC35 ; pack FPA0 to variable + rts +; ATTR command +ATTR jsr EVALEXPB ; evaluate foreground colour + lbrn 0 + cmpb #8 ; there are 8 valid colours (0-7) + lbhs LB44A ; brif out of range - raise error + aslb ; shift over to bits 5,4,3 + aslb + aslb + pshs b ; save partial attribute byte + jsr GETCCH ; fetch current character (useless call) + jsr SYNCOMMA ; insist on comma + jsr EVALEXPB ; evaluate background colour + cmpb #8 ; is it valid (0-7)? + lbhs LB44A ; brif not - raise error + orb ,s ; merge with partial attribute byte + leas 1,s ; clean up stack (could use ,s+ above) + andb #0x3f ; make sure we have zeros in bit 7,6 - unneeded + pshs b ; save colour attributes + jsr GETCCH ; is there mode? +SF9E3 beq SFA06 ; brif no more flags + jsr SYNCOMMA ; insist on a comma + cmpa #'B ; B (blink)? + bne SF9F6 ; brif not + puls b ; set blink bit in accumulated attributes + orb #0x80 + pshs b + jsr GETNCH ; eat the flag + bra SF9E3 ; look for another flag +SF9F6 cmpa #'U ; U (underline)? + lbne LB44A ; invalid flag - raise error + puls b ; get accumulated attributes and set underline bit + orb #0x40 + pshs b + jsr GETNCH ; eat the flag + bra SF9E3 ; look for another flag +SFA06 puls b ; get new attributes + stb H.CRSATT ; set them as default + rts + fcb 0x00,0x00,0x00,0x00 ; unused bytes +; These are extra glyphs that should be part of the HPRINT font but aren't. + fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 ; Ç + fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; ü + fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; é + fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 ; â + fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ä + fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 ; à + fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ȧ (or å maybe?) + fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 ; ç + fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 ; ê + fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; ë + fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; è + fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 ; ï + fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 ; î + fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 ; ẞ + fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ä + fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ȧ (or Å maybe?) + fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 ; ó + fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 ; æ + fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 ; Æ + fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 ; ô + fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; ö + fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 ; ø + fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 ; û + fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 ; ù + fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 ; Ø + fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 ; Ö + fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; Ü + fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 ; § + fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 ; £ + fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 ; ± + fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 ; ° + fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 ; ſ (long s) +; These are some extra symbol glyphs + fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 ; solid right pointing triangle + fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; solid left pointing triangle + fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00 ; solid down pointing triangle + fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00 ; solid up pointing triangle + fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00 ; three horizontal lines with middle one double thick + fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00 ; solid square on top left of open square + fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00 ; solid box inside larger box + fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00 ; thick equals sign + fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00 ; solid vertical rectangle + fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00 ; solid horizontal rectangle + fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00 ; hour glass + fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00 ; left end three horizontal lines with middle one double thick + fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00 ; right end three horizontal lines with middle one double thick +; The above 45 glyphs are duplicated below + fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 + fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 + fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 + fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 + fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 + fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 + fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 + fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 + fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 + fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 + fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 + fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 + fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 + fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 + fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 + fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 + fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 + fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 + fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 + fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 + fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 + fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 + fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 + fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00 + fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00 + fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00 + fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00 + fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00 + fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00 + fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00 + fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00 + fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00 + fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00 + fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00 +; The glyphs above repeat one more time here but the set is incomplete + fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 + fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 + fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 + fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 + fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 + fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 + fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 + fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 + fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 + fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 + fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 + fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 + fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 + fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 + fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 + fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 + fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 + fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 + fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 + fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 + fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 + fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 + fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 + fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 + fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 + fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; final duplicated glyph: left pointing solid triangle + fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; junk unused (or blank space) + fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF ; junk unused (or solid block) +; This is where the constant page (FExx) would start. It's just garbage in the ROM. + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 +; This is where the I/O page would start. It's just garbage in the ROM until the interrupt vectors. + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 + fill 0x00,8 + fill 0xff,8 +; These are the actual CPU interrupt vectors + fdb 0x0000 ; would be the 6309 illegal instruction trap + fdb INT.SWI3 ; SWI3 bounce vector address + fdb INT.SWI2 ; SWI2 bounce vector address + fdb INT.FIRQ ; FIRQ bounce vector address + fdb INT.IRQ ; IRQ bounce vector address + fdb INT.SWI ; SWI bounce vector address + fdb INT.NMI ; NMI bounce vector address + fdb L8C1B ; this is where execution starts on RESET or power on