Mercurial > hg > index.cgi
diff exbas10.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/exbas10.s Sat Dec 08 19:57:01 2018 -0700 @@ -0,0 +1,4033 @@ + *pragma nolist + include defs.s +; These are the entry points in the Color Basic ROM which are used the the Extended Basic ROM. +; They are included here in order to keep the Extended Basic ROM separate from the Color Basic +; ROM. +BAWMST EQU 0xA0E8 +CLOAD EQU 0xA498 +CSAVE EQU 0xA44C +DATA EQU 0xAEE0 +EVALEXPB EQU 0xB70B +GIVABF EQU 0xB4F4 +INT EQU 0xBCEE +LA0E2 EQU 0xA0E2 +LA171 EQU 0xA171 +LA176 EQU 0xA176 +LA35F EQU 0xA35F +LA3ED EQU 0xA3ED +LA406 EQU 0xA406 +LA429 EQU 0xA429 +LA42D EQU 0xA42D +LA444 EQU 0xA444 +LA491 EQU 0xA491 +LA505 EQU 0xA505 +LA578 EQU 0xA578 +LA59A EQU 0xA59A +LA5A5 EQU 0xA5A5 +LA5AE EQU 0xA5AE +LA5C7 EQU 0xA5C7 +LA5E4 EQU 0xA5E4 +LA616 EQU 0xA616 +LA619 EQU 0xA619 +LA635 EQU 0xA635 +LA644 EQU 0xA644 +LA648 EQU 0xA648 +LA65F EQU 0xA65F +LA7E9 EQU 0xA7E9 +LA974 EQU 0xA974 +LA976 EQU 0xA976 +LA9A2 EQU 0xA9A2 +LA9BB EQU 0xA9BB +LAC1E EQU 0xAC1E +LAC33 EQU 0xAC33 +LAC46 EQU 0xAC46 +LAC60 EQU 0xAC60 +LAC73 EQU 0xAC73 +LAC7C EQU 0xAC7C +LAC9D EQU 0xAC9D +LACA8 EQU 0xACA8 +LACEF EQU 0xACEF +LACF1 EQU 0xACF1 +LAD01 EQU 0xAD01 +LAD19 EQU 0xAD19 +LAD21 EQU 0xAD21 +LAD26 EQU 0xAD26 +LAD33 EQU 0xAD33 +LAD9E EQU 0xAD9E +LADC6 EQU 0xADC6 +LADD4 EQU 0xADD4 +LADEB EQU 0xADEB +LAE15 EQU 0xAE15 +LAED2 EQU 0xAED2 +LAF67 EQU 0xAF67 +LAFA4 EQU 0xAFA4 +LB035 EQU 0xB035 +LB141 EQU 0xB141 +LB143 EQU 0xB143 +LB146 EQU 0xB146 +LB156 EQU 0xB156 +LB158 EQU 0xB158 +LB244 EQU 0xB244 +LB262 EQU 0xB262 +LB267 EQU 0xB267 +LB26A EQU 0xB26A +LB26F EQU 0xB26F +LB277 EQU 0xB277 +LB284 EQU 0xB284 +LB2CE EQU 0xB2CE +LB357 EQU 0xB357 +LB35C EQU 0xB35C +LB3A2 EQU 0xB3A2 +LB44A EQU 0xB44A +LB4F3 EQU 0xB4F3 +LB50F EQU 0xB50F +LB518 EQU 0xB518 +LB51A EQU 0xB51A +LB56D EQU 0xB56D +LB643 EQU 0xB643 +LB654 EQU 0xB654 +LB657 EQU 0xB657 +LB659 EQU 0xB659 +LB69B EQU 0xB69B +LB6A4 EQU 0xB6A4 +LB6AD EQU 0xB6AD +LB70E EQU 0xB70E +LB734 EQU 0xB734 +LB738 EQU 0xB738 +LB73D EQU 0xB73D +LB740 EQU 0xB740 +LB7C2 EQU 0xB7C2 +LB958 EQU 0xB958 +LB95C EQU 0xB95C +LB99F EQU 0xB99F +LB9AC EQU 0xB9AC +LB9AF EQU 0xB9AF +LB9B4 EQU 0xB9B4 +LB9B9 EQU 0xB9B9 +LB9C2 EQU 0xB9C2 +LBA1C EQU 0xBA1C +LBA3A EQU 0xBA3A +LBA92 EQU 0xBA92 +LBAC5 EQU 0xBAC5 +LBACA EQU 0xBACA +LBB48 EQU 0xBB48 +LBB5C EQU 0xBB5C +LBB6A EQU 0xBB6A +LBB82 EQU 0xBB82 +LBB8F EQU 0xBB8F +LBC14 EQU 0xBC14 +LBC2F EQU 0xBC2F +LBC35 EQU 0xBC35 +LBC4C EQU 0xBC4C +LBC5F EQU 0xBC5F +LBC6D EQU 0xBC6D +LBCA0 EQU 0xBCA0 +LBCC8 EQU 0xBCC8 +LBD99 EQU 0xBD99 +LBDB6 EQU 0xBDB6 +LBDBB EQU 0xBDBB +LBDC0 EQU 0xBDC0 +LBDC5 EQU 0xBDC5 +LBDCC EQU 0xBDCC +LBDD9 EQU 0xBDD9 +LBEC0 EQU 0xBEC0 +LBEC5 EQU 0xBEC5 +LBEE9 EQU 0xBEE9 +LBEF0 EQU 0xBEF0 +LBEFF EQU 0xBEFF +LBFA6 EQU 0xBFA6 +LET EQU 0xAF89 +PUTCHR EQU 0xA282 +SIN EQU 0xBF78 +SNDBLK EQU 0xA7F4 +STRINOUT EQU 0xB99C +SYNCOMMA EQU 0xB26D +WRLDR EQU 0xA7D8 + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; EXTENDED COLOR BASIC ROM +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 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 + ldx #L80E8-1 ; show sign on message + jsr STRINOUT + 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 nop ; flag to mark routine as valid + 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 routine is dead code that is never used by any Basic ROMs. +L80D0 lda PIA1+2 ; check memory size jump + bita #2 + bne L80DA ; brif high + sta SAMREG+29 ; set SAM for 64K memory size +L80DA jmp ,x ; jump to address in X + fcb 0,0 ; dead space +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 1.0' + fcb 0x0d + fcc 'COPYRIGHT (C) 1980 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 + 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 + 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)? + 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 + 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 +DLOAD jsr LA429 ; close files +L8C1B clr ,-s ; save default token (not DLOADM) + cmpa #'M ; is it DLOADM? + bne L8C25 ; brif not + sta ,s ; save the "M" + jsr GETNCH ; eat the "M" +L8C25 jsr LA578 ; parse the file name + jsr GETCCH ; get character after file name + beq L8C44 ; brif end of line + jsr SYNCOMMA ; make sure we have a comma + cmpa #', ; do we have 2 commas? + beq L8C44 ; brif so - use default baud rate + jsr EVALEXPB ; evaluate baud rate +L8C36 lda #44*4 ; delay for 300 baud + tstb ; was argument 0? + beq L8C42 ; brif so - 300 baud + lda #44 ; constant for 1200 baud + decb ; was it 1? + lbne LB44A ; raise error if not +L8C42 sta DLBAUD ; save baud rate constant +L8C44 jsr L8CD0 ; transmit file name and read in file status + pshs a ; save register + lda #-3 ; set input to DLOAD + sta DEVNUM + puls a ; restore register + tst ,s+ ; is it DLOADM? + bne L8C85 ; brif so + jsr LA5C7 ; check for end of line - error if not + 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 #12 ; are we at the right digit? + bcc L9177 ; brif not + addb #'0+12 ; 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 #6 ; 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? + lblo LB44A ; brif so + 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 + addd #200 ; make some extra space (for stack) + subd FRETOP ; see if new top of program fits + bhs L966D ; brif there isn't enough space + 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