Mercurial > hg > index.cgi
view secb.s @ 1:704b2c9dc19e default tip
Remove extraneous unused and incorrect definition
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Wed, 02 Jan 2019 10:11:19 -0700 |
| parents | 605ff82c4618 |
| children |
line wrap: on
line source
*pragma nolist include defs.s DC0DC equ 0xC0DC ; needed for Disk Basic path jump backs *pragma list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; EXTENDED COLOR BASIC ROM area ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; org EXBAS fcc 'EX' ; magic number that Color Basic uses to identify the presence of Extended Basic L8002 ldx #L80DE ; point to command interpretation table information ldu #COMVEC+10 ; point to command interpretation table location ldb #10 ; 10 bytes to move jsr LA59A ; copy command interpretation table ldx #LB277 ; initialize Disk Basic's entries to error stx 3,u stx 8,u ldx #XIRQSV ; set up IRQ service routine stx IRQVEC+1 ldx ZERO ; reset the TIMER value stx TIMVAL jsr XVEC18 ; do a bunch of initialization ldd #0x2c05 ; initialize DLOAD baud rate constant and timeout std DLBAUD ldx #USR0 ; set up pointer to USR routine addresses stx USRADR ldu #LB44A ; set up USR routine addresses to "FC error" ldb #10 ; there are 10 routines L8031 stu ,x++ ; set a routine to FC error decb ; done all? bne L8031 ; brif not lda #0x7e ; op code of JMP extended (for RAM hook intialization) sta RVEC20 ; command interpretation loop ldx #XVEC20 stx RVEC20+1 sta RVEC15 ; expression evaluation ldx #XVEC15 stx RVEC15+1 sta RVEC19 ; number parsing ldx #XVEC19 stx RVEC19+1 sta RVEC9 ; PRINT ldx #XVEC9 stx RVEC9+1 sta RVEC17 ; error handler ldx #XVEC17 stx RVEC17+1 sta RVEC4 ; generic input ldx #XVEC4 stx RVEC4+1 sta RVEC3 ; generic output ldx #XVEC3 stx RVEC3+1 sta RVEC8 ; close file ldx #XVEC8 stx RVEC8+1 sta RVEC23 ; tokenize line ldx #XVEC23 stx RVEC23+1 sta RVEC18 ; RUN ldx #XVEC18 stx RVEC18+1 sta EXPJMP ; exponentiation ldx #L8489 stx EXPJMP+1 jsr L96E6 ; initialize graphics stuff lda PIA0+3 ; enable 60Hz interrupt ora #1 sta PIA0+3 ldx #'D*256+'K ; magic number for a Disk Basic ROM cmpx DOSBAS ; do we have a Disk Basic ROM? lbeq DOSBAS+2 ; brif so - launch it andcc #0xaf ; enable interrupts L80B2 ldx #L80E8-1 ; show sign on message jsr STRINOUT L80B8 ldx #XBWMST ; install warm start handler stx RSTVEC jmp LA0E2 ; set up warm start flag and launch immediate mode ; Extended Basic warm start code XBWMST fcb 0xff ; mark routine as invalid so that ROMs are always copied to RAM on RESET clr PLYTMR ; cancel any PLAY command in progress clr PLYTMR+1 lda PIA0+3 ; enable 60Hz interrupt ora #1 sta PIA0+3 jmp BAWMST ; let Color Basic's warm start process run ; This code is to fix the famous PCLEAR bug. It replaces dead code in the 1.0 ROM. This patch corrects ; the input pointer so that it points to the correct place after the program has been relocated by ; PCLEAR instead of continuing with something that, in the best case, is a syntax error. L80D0 lda CURLIN ; immediate mode? inca beq L80DD ; brif so tfr y,d ; save offset to D subd TXTTAB ; see how far into the program we are addd CHARAD ; now adjust the input pointer based on that std CHARAD ; save corrected input pointer L80DD rts L80DE fcb 25 ; 25 Extended Basic commands fdb L8183 ; reserved word table (commands) fdb L813C ; interpretation handler (commands) fcb 14 ; 14 Extended Basic functions fdb L821E ; reserved word table (functions) fdb L8168 ; function handler L80E8 fcc 'EXTENDED COLOR BASIC 2.0' fcb 0x0d fcc 'COPR. 1982, 1986 BY TANDY ' fcb 0x0d fcc 'UNDER LICENSE FROM MICROSOFT' fcb 0x0d,0x0d,0x00 ; Extended Basic command interpretation loop L813C cmpa #0xcb ; is it an Extended Basic command? bhi L8148 ; brif not ldx #L81F0 ; point to dispatch table suba #0xb5 ; normalize the token number so 0 is the first entry jmp LADD4 ; go transfer control to the command L8148 cmpa #0xff ; is it a function token? beq L8154 ; brif so - for MID$()=, TIMER= cmpa #0xcd ; is it a token for a keyword that isn't a command? bls L8165 ; brif so - error for USING and FN L8150 jmp [COMVEC+23] ; transfer control to Disk Basic if it is present L8154 jsr GETNCH ; get token after the function flag cmpa #0x90 ; MID$? lbeq L86D6 ; brif so (substring replacement) cmpa #0x9f ; TIMER? lbeq L8960 ; brif so - TIMER setting jsr RVEC22 ; do a RAM hook in case something wants to extend this L8165 jmp LB277 ; we have nothing valid here ; Function handler L8168 cmpb #2*33 ; is it a valid Extended Basic function? bls L8170 ; brif so L816C jmp [COMVEC+28] ; transfer control to Disk Basic if it is present L8170 subb #2*20 ; normalize Extended Basic functions to 0 cmpb #2*8 ; Above HEX$? bhi L817D ; brif so - we don't pre-evaluate an argument pshs b ; save token value jsr LB262 ; evaluate the function parameter puls b ; get back token value L817D ldx #L8257 ; point to dispatch table jmp LB2CE ; go transfer control to the function ; Reserved words (commands) L8183 fcs 'DEL' ; 0xb5 fcs 'EDIT' ; 0xb6 fcs 'TRON' ; 0xb7 fcs 'TROFF' ; 0xb8 fcs 'DEF' ; 0xb9 fcs 'LET' ; 0xba fcs 'LINE' ; 0xbb fcs 'PCLS' ; 0xbc fcs 'PSET' ; 0xbd fcs 'PRESET' ; 0xbe fcs 'SCREEN' ; 0xbf fcs 'PCLEAR' ; 0xc0 fcs 'COLOR' ; 0xc1 fcs 'CIRCLE' ; 0xc2 fcs 'PAINT' ; 0xc3 fcs 'GET' ; 0xc4 fcs 'PUT' ; 0xc5 fcs 'DRAW' ; 0xc6 fcs 'PCOPY' ; 0xc7 fcs 'PMODE' ; 0xc8 fcs 'PLAY' ; 0xc9 fcs 'DLOAD' ; 0xca fcs 'RENUM' ; 0xcb fcs 'FN' ; 0xcc fcs 'USING' ; 0xcd ; Dispatch table (commands) L81F0 fdb DEL ; 0xb5 DEL fdb EDIT ; 0xb6 EDIT fdb TRON ; 0xb7 TRON fdb TROFF ; 0xb8 TROFF fdb DEF ; 0xb9 DEF fdb LET ; 0xba LET (note: implemented by Color Basic!) fdb LINE ; 0xbb LINE fdb PCLS ; 0xbc PCLS fdb PSET ; 0xbd PSET fdb PRESET ; 0xbe PRESET fdb SCREEN ; 0xbf SCREEN fdb PCLEAR ; 0xc0 PCLEAR fdb COLOR ; 0xc1 COLOR fdb CIRCLE ; 0xc2 CIRCLE fdb PAINT ; 0xc3 PAINT fdb GET ; 0xc4 GET fdb PUT ; 0xc5 PUT fdb DRAW ; 0xc6 DRAW fdb PCOPY ; 0xc7 PCOPY fdb PMODETOK ; 0xc8 PMODE fdb PLAY ; 0xc9 PLAY fdb DLOAD ; 0xca DLOAD fdb RENUM ; 0xcb RENUM ; Reserved words (functions) L821E fcs 'ATN' ; 0x94 fcs 'COS' ; 0x95 fcs 'TAN' ; 0x96 fcs 'EXP' ; 0x97 fcs 'FIX' ; 0x98 fcs 'LOG' ; 0x99 fcs 'POS' ; 0x9a fcs 'SQR' ; 0x9b fcs 'HEX$' ; 0x9c fcs 'VARPTR' ; 0x9d fcs 'INSTR' ; 0x9e fcs 'TIMER' ; 0x9f fcs 'PPOINT' ; 0xa0 fcs 'STRING$' ; 0xa1 ; Dispatch table (functions) L8257 fdb ATN ; 0x94 ATN fdb COS ; 0x95 COS fdb TAN ; 0x96 TAN fdb EXP ; 0x97 EXP fdb FIX ; 0x98 FIX fdb LOG ; 0x99 LOG fdb POS ; 0x9a POS fdb SQR ; 0x9b SQR fdb HEXDOL ; 0x9c HEX$ fdb VARPTRTOK ; 0x9d VARPTR fdb INSTR ; 0x9e INSTR fdb TIMER ; 0x9f TIMER fdb PPOINT ; 0xa0 PPOINT fdb STRING ; 0xa1 STRING$ ; Generic output handler XVEC3 tst DEVNUM ; screen? lbeq L95AC ; brif so - force text screen active pshs b ; save register ldb DEVNUM ; get output device cmpb #-3 ; check for DLOAD puls b ; restore register bne L8285 ; brif not DLOAD leas 2,s ; bail out of output handler if DLOAD L8285 rts ; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the ; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required ; if a recent enough version of Color Basic is installed. XVEC8 lda DEVNUM ; get device number inca ; is it tape? bne L8285 ; brif not - we aren't going to mess with it lda FILSTA ; get tape file status cmpa #2 ; output file? bne L8285 ; brif not lda CINCTR ; is there anything waiting to be written out? bne L8285 ; brif so - mainline code will handle it properly clr DEVNUM ; reset output to screen leas 2,s ; don't return to mainline code jmp LA444 ; write EOF block ; RUN handler - sets up some Extended Basic stuff to defaults at program start XVEC18 ldd #0xba42 ; initialize PLAY volume std VOLHI lda #2 ; set PLAY tempo to 2, PLAY octave to 3 sta TEMPO sta OCTAVE asla ; set default note length to 5 sta NOTELN clr DOTVAL ; don't do any note length extension ldd ZERO ; initialize DRAW angle and scale to default 1 std ANGLE ldb #128 ; initialize horizontal and vertical default coordinates to the middle of the screen std HORDEF ldb #96 std VERDEF rts ; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF XVEC20 leas 2,s ; don't return to the mainline code L82BB andcc #0xaf ; make sure interrupts are running jsr LADEB ; do a BREAK/pause check ldx CHARAD ; save input pointer stx TINPTR lda ,x+ ; get current input character beq L82CF ; brif end of line cmpa #': ; statement separator? beq L82F1 ; brif so jmp LB277 ; raise error we got here with extra junk L82CF lda ,x++ ; get first byte of next line address sta ENDFLG ; use it to set "END" flag to "END" bne L82D8 ; brif not end of program jmp LAE15 ; go do the "END" L82D8 ldd ,x+ ; get line number of next line (and leave pointer one before line text) std CURLIN ; set current line number stx CHARAD ; save input pointer lda TRCFLG ; are we tracing? beq L82F1 ; brif not lda #'[ ; show opening marker for TRON line number jsr PUTCHR lda CURLIN ; restore MSB of line number jsr LBDCC ; show line number lda #'] ; show closing marker for TRON line number jsr PUTCHR L82F1 jsr GETNCH ; get the start of the statement tfr cc,b ; save status flags cmpa #0x98 ; is it CSAVE? beq L8316 ; brif so - go to Extended Basic patch (adds CSAVEM) cmpa #0x97 ; is it CLOAD? beq L8311 ; brif so - go to Extended Basic patch (adds multi-origin binaries) tfr b,cc ; restore character status jsr LADC6 ; go process command bra L82BB ; restart interpretation loop ; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the ; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This ; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation ; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all. XVEC23 ldx 2,s ; get return address of caller to the tokenizer cmpx #LAC9D ; is it coming from immediate mode prior to executing the line? bne L8310 ; brif not ldx #L82F1 ; force return to Extended Basic's main loop patch above stx 2,s L8310 rts ; These two patches are set up this way so that control can be transferred back to the original Color Basic ; implementations if the Extended Basic addons are not triggered. L8311 jsr L8C62 ; transfer control to Extended Basic's CLOAD handler bra L82BB ; go do another command L8316 bsr L831A ; go do Extended Basic's CSAVE handler bra L82BB ; go do another command ; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have) L831A jsr GETNCH ; get character after CSAVE cmpa #'M ; is it CSAVEM? lbne CSAVE ; brif not - Color Basic can handle this jsr GETNCH ; eat the "M" jsr LA578 ; parse file name bsr L836C ; get start address stx CASBUF+13 ; save it in file header bsr L836C ; get end address cmpx 2,s ; compare to start address lblo LB44A ; brif end address is before the start address bsr L836C ; get execution address stx CASBUF+11 ; put in file header jsr GETCCH ; are we at the end of the commmand? bne L8310 ; brif not lda #2 ; file type to machine language ldx ZERO ; set to binary and single block jsr LA65F ; write header clr FILSTA ; mark any open tape file closed inc BLKTYP ; set block type to data jsr WRLDR ; write a data leader ldx 4,s ; get starting address L834D stx CBUFAD ; set start of data address lda #255 ; try a full length block by default sta BLKLEN ldd 2,s ; get ending address subd CBUFAD ; see how much is left bhs L835E ; brif we have more to write leas 6,s ; clean up stack jmp LA491 ; write EOF block L835E cmpd #255 ; do we have a full block left? bhs L8367 ; brif so incb ; set block size to remainder stb BLKLEN L8367 jsr SNDBLK ; write a data block bra L834D ; go see if we have more to write L836C jsr SYNCOMMA ; make sure we have a comma jsr LB73D ; evaluate unsigned expression to X ldu ,s ; get return address stx ,s ; save result on stack tfr u,pc ; return to caller ; COS function COS ldx #L83AB ; point to PI/2 constant jsr LB9C2 ; add to argument ( cos(x) = sin((pi/2)+x) ) L837E jmp SIN ; now calculate sin((pi/2)+x) ; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X) TAN jsr LBC2F ; save FPA0 in FPA3 clr RELFLG ; reset quadrant flag bsr L837E ; calculate SIN(x) ldx #V4A ; save result in FPA5 jsr LBC35 ldx #V40 ; get back original argument jsr LBC14 clr FP0SGN ; force result positive lda RELFLG ; get quadrant flag bsr L83A6 ; calculate COS(x) tst FP0EXP ; did we get 0 for COS(x) lbeq LBA92 ; brif so - overflow ldx #V4A ; point to sin(x) L83A3 jmp LBB8F ; divide the sin(x) value by the cos(x) value L83A6 pshs a ; save sign flag jmp LBFA6 ; expand polynomial L83AB fcb 0x81,0x49,0x0f,0xda,0xa2 ; pi/2 constant ; ATN function (inverse tangent). There are two calculation streams used to improve precision. ; One if the parameter is >= 1.0 and the other if it is < 1.0 ATN lda FP0SGN ; get sign of argument pshs a ; save it bpl L83B8 ; brif positive bsr L83DC ; flip sign of argument L83B8 lda FP0EXP ; get exponent pshs a ; save it cmpa #0x81 ; exponent for 1.0 blo L83C5 ; brif less - value is less than 1.0 ldx #LBAC5 ; point to FP constant 1.0 bsr L83A3 ; calculate reciprocal L83C5 ldx #L83E0 ; point to polynomical coefficients jsr LBEF0 ; expand polynomial puls a ; get exponent of argument cmpa #0x81 ; did we do a reciprocal calculation? blo L83D7 ; brif not ldx #L83AB ; subtract result from pi/2 if we did jsr LB9B9 L83D7 puls a ; get sign of original tsta ; was it positive? bpl L83DF ; brif so L83DC jmp LBEE9 ; flip sign of result L83DF rts ; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly ; from the standard taylor series after 1/9. The standard coefficients are 1/1,-1/3, 1/5, -1/7, 1/9, -1/11, and ; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with ; fewer coefficients. L83E0 fcb 11 ; 12 coefficients fcb 0x76,0xb3,0x83,0xbd,0xd3 ; -0.000684793912 fcb 0x79,0x1e,0xf4,0xa6,0xf5 ; 0.00485094216 fcb 0x7b,0x83,0xfc,0xb0,0x10 ; -0.0161117018 fcb 0x7c,0x0c,0x1f,0x67,0xca ; 0.0342096381 fcb 0x7c,0xde,0x53,0xcb,0xc1 ; -0.0542791328 fcb 0x7d,0x14,0x64,0x70,0x4c ; 0.0724571965 fcb 0x7d,0xb7,0xea,0x51,0x7a ; -0.0898023954 fcb 0x7d,0x63,0x30,0x88,0x7e ; 0.110932413 fcb 0x7e,0x92,0x44,0x99,0x3a ; -0.142839808 fcb 0x7e,0x4c,0xcc,0x91,0xc7 ; 0.199999121 fcb 0x7f,0xaa,0xaa,0xaa,0x13 ; -0.333333316 fcb 0x81,0x00,0x00,0x00,0x00 ; 1.0 ; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x) L841D fcb 3 ; four coefficients fcb 0x7f,0x5e,0x56,0xcb,0x79 ; 0.434255942 from (2/7)/ln(2) fcb 0x80,0x13,0x9b,0x0b,0x64 ; 0.576584541 from (2/5)/ln(2) fcb 0x80,0x76,0x38,0x93,0x16 ; 0.961800759 from (2/3)/ln(2) fcb 0x82,0x38,0xaa,0x3b,0x20 ; 2.88539007 from 2/ln(2) L8432 fcb 0x80,0x35,0x04,0xf3,0x34 ; 1/sqrt(2) L8437 fcb 0x81,0x35,0x04,0xf3,0x34 ; sqrt(2) L843C fcb 0x80,0x80,0x00,0x00,0x00 ; -0.5 L8441 fcb 0x80,0x31,0x72,0x17,0xf8 ; ln(2) ; LOG function (natural log, ln) ; FP representation is of the form A*2^B. Thus, the log routine determines the value of ; ln(A*2^B). ; ; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR: ; (log2(A) + B)*ln(2) ; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so: ; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2) ; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2) ; ; Everything except log2(A*sqrt(2)) is either constant or trivial. ; ; What the actual code below feeds into the modified taylor series is actually: ; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1) ; ; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would ; expect from the identities. However, the modified coefficients in the series above ; could be correcting for that or the introduced error was deemed acceptable. ; NOTE: this routine does NOT return 0 for LOG(1) LOG jsr LBC6D ; get status of FPA0 lble LB44A ; brif <= 0 - logarithms don't exist in that case ldx #L8432 ; point to 1/sqrt(2) lda FP0EXP ; get exponent of argument suba #0x80 ; remove bias pshs a ; save it for later lda #0x80 ; force exponent to 0 (this turns FPA0 into A in the above description) sta FP0EXP jsr LB9C2 ; add 1/sqrt(2) to A ldx #L8437 ; point to sqrt(2) jsr LBB8F ; divide that by FPA0 ldx #LBAC5 ; point to 1.0 jsr LB9B9 ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2))) ldx #L841D ; point to coefficients jsr LBEF0 ; expand polynomial (calculate base 2 log of modified argument) ldx #L843C ; point to -0.5 jsr LB9C2 ; add result puls b ; get original exponent back jsr LBD99 ; add B to FPA0 ldx #L8441 ; point to ln(2) jmp LBACA ; multiply by ln(2) which gives us the result in base e ; SQR function (square root) - returns the principle root (positive) SQR jsr LBC5F ; move argument to FPA1 (first argument for exponentiation) ldx #LBEC0 ; point to 0.5 (exponent for square root) jsr LBC14 ; set up second argument to exponentiation (the exponent) ; Exponentiation operator ; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0 L8489 beq EXP ; do "EXP" if exponent is 0 (this will catch 0^0) tsta ; check that the base is not 0 bne L8491 ; brif base is not 0 jmp LBA3A ; 0^(nonzero) is 0 L8491 ldx #V4A ; save exponent (to FPA5) jsr LBC35 clrb ; result sign will default to positive lda FP1SGN ; check if base is positive bpl L84AC ; brif so jsr INT ; convert exponent to integer ldx #V4A ; point to original expoent lda FP1SGN ; get sign of FPA1 jsr LBCA0 ; compare original exponent with truncated one bne L84AC ; brif not equal coma ; flip sign ldb CHARAC ; get LS byte of integer exponent (result sign flag) L84AC jsr LBC4C ; copy FPA1 (base) to FPA0 (A = sign) pshs b ; save result sign jsr LOG ; get natural log of the base ldx #V4A ; multiply the log by the exponent jsr LBACA bsr EXP ; now raise e to the resulting power puls a ; get result sign rora ; brif it was negative lbcs LBEE9 ; brif negative - flip sign rts L84C4 fcb 0x81,0x38,0xaa,0x3b,0x29 ; 1.44269504 (correction factor for exponential function) ; Chebyshev modified taylor series coefficients for e^x L84C9 fcb 7 ; eight coefficients fcb 0x71,0x34,0x58,0x3e,0x56 ; 1/(7!*(CF^7)) fcb 0x74,0x16,0x7e,0xb3,0x1b ; 1/(6!*(CF^6)) fcb 0x77,0x2f,0xee,0xe3,0x85 ; 1/(5!*(CF^5)) fcb 0x7a,0x1d,0x84,0x1c,0x2a ; 1/(4!*(CF^4)) fcb 0x7c,0x63,0x59,0x58,0x0a ; 1/(3!*(CF^3)) fcb 0x7e,0x75,0xfd,0xe7,0xc6 ; 1/(2!*(CF^2)) fcb 0x80,0x31,0x72,0x18,0x10 ; 1/(1!*(CF^1)) fcb 0x81,0x00,0x00,0x00,0x00 ; 1 ; EXP function (e^x) EXP ldx #L84C4 ; point to correction factor jsr LBACA ; multiply it jsr LBC2F ; save corrected argument to FPA3 lda FP0EXP ; get exponent of FPA0 cmpa #0x88 ; is it too big? blo L8504 ; brif not L8501 jmp LBB5C ; to 0 (underflow) or overflow error L8504 jsr INT ; convert argument to an integer lda CHARAC ; get ls byte of integer adda #0x81 ; was argument 127? if so, the OV error; adds bias beq L8501 deca ; adjust for the extra +1 above pshs a ; save integer exponent ldx #V40 ; get fractional part of argument jsr LB9B9 ldx #L84C9 ; point to coefficients jsr LBEFF ; evaluate polynomial on the fractional part clr RESSGN ; force result to be positive puls a ; get back original exponent jsr LBB48 ; add original exponent to the fractional result rts ; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0) FIX jsr LBC6D ; get status of argument bmi L852C ; brif negative L8529 jmp INT ; do regular "int" if positive L852C com FP0SGN ; flip the sign bsr L8529 ; do "INT" on this jmp LBEE9 ; flip the sign back ; EDIT command EDIT jsr L89AE ; get line number leas 2,s ; we're not going to return to the main loop L8538 lda #1 ; "LIST" flag sta VD8 ; set to list the line jsr LAD01 ; find line number lbcs LAED2 ; brif line wasn't found jsr LB7C2 ; go unpack the line into the buffer tfr y,d ; calculate the actual length of the line subd #LINBUF+2 stb VD7 ; save line length (it will only be 8 bits) L854D ldd BINVAL ; get the line number jsr LBDCC ; display it jsr LB9AC ; put a space after it ldx #LINBUF+1 ; point to iput uffer ldb VD8 ; are we listing? bne L8581 ; brif so L855C clrb ; reset digit accumulator L855D jsr L8687 ; get a keypress jsr L90AA ; set carry if not numeric bcs L8570 ; brif not a number suba #'0 ; remove ASCII bias pshs a ; save digit value lda #10 ; multiply accumulator by 10 mul addb ,s+ ; add in new digit bra L855D ; go check for another digit L8570 subb #1 ; this converts 0 to 1, but *only* 0 to 1 adcb #1 cmpa #'A ; abort? bne L857D ; brif not jsr LB958 ; to a CR bra L8538 ; restart EDIT process L857D cmpa #'L ; list? bne L858C ; brif not L8581 bsr L85B4 ; list the line clr VD8 ; reset to "not listing" jsr LB958 ; do a CR bra L854D ; start editing L858A leas 2,s ; lose return address L858C cmpa #0x0d ; ENTER? bne L859D ; brif not bsr L85B4 ; echo out the line L8592 jsr LB958 ; do a CR ldx #LINBUF+1 ; reset input pointer to start of buffer stx CHARAD jmp LACA8 ; join immediate mode to replace the line in the program L859D cmpa #'E ; exit? beq L8592 ; brif so - end edit with no echo cmpa #'Q ; quit? bne L85AB ; brif not jsr LB958 ; do a CR jmp LAC73 ; go to immediate mode with no fanfare - no changes saved L85AB bsr L85AF ; go do commands bra L855C ; go handle another command L85AF cmpa #0x20 ; space? bne L85C3 ; brif not skip2 L85B4 ldb #LBUFMX-1 ; display up to a whole line L85B6 lda ,x ; get buffer chracter beq L85C2 ; brif end of line jsr PUTCHR ; output character leax 1,x ; move to next character decb ; done? bne L85B6 ; brif not L85C2 rts L85C3 cmpa #'D ; delete? bne L860F ; brif not L85C7 tst ,x ; end of line? beq L85C2 ; brif so - can't delete bsr L85D1 ; remove a character decb ; done all requested? bne L85C7 ; brif not rts L85D1 dec VD7 ; account for character being removed leay -1,x ; set pointer and compensate for increment below L85D5 leay 1,y ; move to next character lda 1,y ; get next character sta ,y ; move it forward bne L85D5 ; brif we didn't hit the end of the buffer rts L85DE cmpa #'I ; insert? beq L85F5 ; brif so cmpa #'X ; extend? beq L85F3 ; brif so cmpa #'H ; "hack"? bne L8646 ; brif not clr ,x ; mark current location as end of line tfr x,d ; calculate new line length subd #LINBUF+2 stb VD7 ; save new length L85F3 bsr L85B4 ; display the line L85F5 jsr L8687 ; read a character cmpa #0x0d ; ENTER? beq L858A ; brif so - terminate entry cmpa #0x1b ; ESC? beq L8625 ; brif so - back to command mode cmpa #0x08 ; backspace? bne L8626 ; brif no cmpx #LINBUF+1 ; are we at the start of the buffer? beq L85F5 ; brif so - it's a no-op bsr L8650 ; move pointer back one, do a BS bsr L85D1 ; remove character from the buffer bra L85F5 ; go handle more input L860F cmpa #'C ; change? bne L85DE ; brif not L8613 tst ,x ; is there something to change? beq L8625 ; brif not jsr L8687 ; get a key stroke bcs L861E ; brif valid key bra L8613 ; try again if invalid key L861E sta ,x+ ; put new character in the buffer bsr L8659 ; echo it decb ; changed number requested? bne L8613 ; brif not L8625 rts L8626 ldb VD7 ; get length of line cmpb #LBUFMX-1 ; at maximum line length? bne L862E ; brif not bra L85F5 ; process another input character L862E pshs x ; save input pointer L8630 tst ,x+ ; are we at the end of the line? bne L8630 ; brif not L8634 ldb ,-x ; get character before current pointer, move back stb 1,x ; move it forward cmpx ,s ; at the original buffer pointer? bne L8634 ; brif not leas 2,s ; remove saved buffer pointer sta ,x+ ; save input character in newly made hole bsr L8659 ; echo it inc VD7 ; bump line length counter bra L85F5 ; go handle more stuff L8646 cmpa #0x08 ; backspace? bne L865C ; brif not L864A bsr L8650 ; move pointer back, echo BS decb ; done enough of them? bne L864A ; brif not rts L8650 cmpx #LINBUF+1 ; at start of buffer? beq L8625 ; brif so leax -1,x ; move pointer back lda #0x08 ; character to echo - BS L8659 jmp PUTCHR ; echo character to screen L865C cmpa #'K ; "kill"? beq L8665 ; brif so suba #'S ; search? beq L8665 ; brif so rts L8665 pshs a ; save kill/search flag bsr L8687 ; read target pshs a ; save search character L866B lda ,x ; get current character in buffer beq L8685 ; brif end of line - nothing more to search tst 1,s ; is it KILL? bne L8679 ; brif so bsr L8659 ; echo the character leax 1,x ; move ahead bra L867C ; check next character L8679 jsr L85D1 ; remove character from buffer L867C lda ,x ; get character in buffer cmpa ,s ; are we at the target? bne L866B ; brif not decb ; have we found enough of them? bne L866B ; brif not L8685 puls y,pc ; clean up stack and return to main EDIT routine L8687 jsr LA171 ; get input from the generic input handler (will show the cursor) cmpa #0x7f ; graphics (or DEL)? bhs L8687 ; brif so - ignore it cmpa #0x5f ; SHIFT-UP? bne L8694 ; brif not lda #0x1b ; replace with ESC L8694 cmpa #0x0d ; carriage return? beq L86A6 ; brif so (C=0) cmpa #0x1b ; ESC beq L86A6 ; brif so (C=0) cmpa #0x08 ; backspace? beq L86A6 ; brif so (C=0) cmpa #32 ; control code? blo L8687 ; brif control code - try again orcc #1 ; set C for "valid" (printable) character L86A6 rts ; TRON and TROFF commands TRON skip1lda ; load flag with nonzero for trace enabled (and skip next) TROFF clra ; clear flag for trace disabled sta TRCFLG ; save trace status rts ; POS function POS lda DEVNUM ; get original device number pshs a ; save it for later jsr LA5AE ; fetch device number jsr LA406 ; check for open file jsr LA35F ; set up print parameters ldb DEVPOS ; get current line position for the device jmp LA5E4 ; return position in B as unsigned ; VARPTR function VARPTRTOK jsr LB26A ; make sure we have ( ldd ARYEND ; get address of end of arrays pshs d ; save it jsr LB357 ; parse variable descriptor jsr LB267 ; make sure there is a ) puls d ; get original end of arrays exg x,d ; swap original end of arrays and the discovered variable pointer cmpx ARYEND ; did array end move (variable created?) bne L8724 ; brif so (FC error) jmp GIVABF ; return the pointer (NOTE: as signed) ; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter ; than the specified size, only the number of characters actually in the replacement will be used. L86D6 jsr GETNCH ; eat the MID$ token jsr LB26A ; force ( jsr LB357 ; evaluate the variable pshs x ; save variable descriptor ldd 2,x ; point to start of original string cmpd FRETOP ; is it in string space? bls L86EB ; brif not subd MEMSIZ ; is it still in string space (top end)? bls L86FD ; brif so L86EB ldb ,x ; get length of original string jsr LB56D ; allocate space in string space pshs x ; save pointer to string space ldx 2,s ; get to original string descriptor jsr LB643 ; move the string into string space puls x,u ; get new string address and string descriptor stx 2,u ; save new data address for the string pshs u ; save descriptor address again L86FD jsr LB738 ; evaluate ",start" pshs b ; save start offset tstb ; is start 0? beq L8724 ; brif so - strings offsets are 1-based ldb #255 ; default use the entire string cmpa #') ; end of parameters? beq L870E ; brif so jsr LB738 ; evaluate ",length" L870E pshs b ; save length jsr LB267 ; make sure we have a ) ldb #0xb3 ; make sure we have = jsr LB26F bsr L8748 ; evaluate replacement string tfr x,u ; save replacement string address ldx 2,s ; get original string descriptor lda ,x ; get length of original string suba 1,s ; subtract start position bhs L8727 ; brif within the string - insert replacement L8724 jmp LB44A ; raise illegal function call L8727 inca ; A is now number of characters to the right of the position parameter cmpa ,s ; compare to length desired bhs L872E ; brif new length fits sta ,s ; only use as much of the length as will fit L872E lda 1,s ; get position offset exg a,b ; swap replacement length and position ldx 2,x ; point to original string address decb ; we work with 0-based offsets abx ; now X points to start of replacement tsta ; replacing 0? beq L8746 ; brif so - done cmpa ,s ; is replacement shorter than the hole? bls L873F ; brif so lda ,s ; use copy the maximum number specified L873F tfr a,b ; save number to move in B exg u,x ; swap pointers so they are right for the routine jsr LA59A ; copy string data L8746 puls a,b,x,pc ; clean up stack and return L8748 jsr LB156 ; evaluate expression jmp LB654 ; make sure it's a string and return string details ; STRING$ function STRING jsr LB26A ; make sure we have ( jsr EVALEXPB ; evaluate repeat count (error if > 255) pshs b ; save repeat count jsr SYNCOMMA ; make sure there's a comma jsr LB156 ; evaluate the thing to repeat jsr LB267 ; make sure we have a ) lda VALTYP ; is it string? bne L8768 ; brif so jsr LB70E ; get 8 bit character code bra L876B ; use that L8768 jsr LB6A4 ; get first character of string L876B pshs b ; save repeat character ldb 1,s ; get repeat count jsr LB50F ; reserve space for the string puls a,b ; get character and repeat count beq L877B ; brif NULL string L8776 sta ,x+ ; put character into string decb ; put enough? bne L8776 ; brif not L877B jmp LB69B ; return the newly created string ; INSTR function INSTR jsr LB26A ; evaluate ( jsr LB156 ; evaluate first argument ldb #1 ; default start position is 1 (start of string) pshs b ; save start position lda VALTYP ; get type of first argument bne L879C ; brif string - use default starting position jsr LB70E ; convert first argument into string offset stb ,s ; save offset beq L8724 ; brif starting at 0 - not allowed jsr SYNCOMMA ; make sure there's a comma jsr LB156 ; evaluate the search string jsr LB146 ; make sure it *is* a string L879C ldx FPA0+2 ; get search string descriptor pshs x ; save it jsr SYNCOMMA ; make sure we have a comma jsr L8748 ; evalute the target string pshs x,b ; save address and length of target string jsr LB267 ; make sure we have a ) ldx 3,s ; get search string address jsr LB659 ; get string details pshs b ; save search string length cmpb 6,s ; compare length of search string to the start blo L87D9 ; brif start position is beyond the search string - return 0 lda 1,s ; get length of target string beq L87D6 ; brif targetstring is NULL - match will be immediate ldb 6,s ; get start position decb ; zero-base it abx ; now X points to the start position for the search L87BE leay ,x ; point to start of search ldu 2,s ; get target string pointer ldb 1,s ; get targetlength lda ,s ; get length of serach suba 6,s ; see how much is left in searh inca ; add one for "inclusivity" cmpa 1,s ; do we have less than the target string? blo L87D9 ; brif so - we obviously won't match L87CD lda ,x+ ; compare a byte cmpa ,u+ bne L87DF ; brif no match decb ; compared all of target? bne L87CD ; brif not L87D6 ldb 6,s ; get position where we matched skip1 L87D9 clrb ; flag no match leas 7,s ; clean up stack jmp LB4F3 ; return unsigned B L87DF inc 6,s ; bump start position leax 1,y ; move starting pointer bra L87BE ; see if we match now ; Number parsing handler XVEC19 cmpa #'& ; do we have & (hex or octal)? L87E7 bne L8845 ; brif not leas 2,s ; we won't return to the original invoker L87EB clr FPA0+2 ; clear bottom of FPA0 for 16 bit value clr FPA0+3 ldx #FPA0+2 ; point to accumulator jsr GETNCH ; eat the & cmpa #'O ; octal? beq L880A ; brif so cmpa #'H ; hex? beq L881F ; brif so jsr GETCCH ; reset flags on input bra L880C ; go process octal (default) L8800 cmpa #'8 ; is it a valid octal character? lbhi LB277 ; brif not (BUG: should be LBHS or above be #'7) ldb #3 ; base 8 multiplier bsr L8834 ; add digit to accumulator L880A jsr GETNCH ; get input character L880C bcs L8800 ; brif numeric L880E clr FPA0 ; clear upper bytes of FPA0 clr FPA0+1 clr VALTYP ; result is numeric clr FPSBYT ; clear out any extra precision clr FP0SGN ; make it positive ldb #0xa0 ; exponent for integer aligned to right of FPA0 stb FP0EXP jmp LBA1C ; go normalize the result and return L881F jsr GETNCH ; get input character bcs L882E ; brif digit jsr LB3A2 ; set carry if not alpha L8826 bcs L880E ; brif not alpha cmpa #'G ; is it valid HEX digit? bhs L880E ; brif not suba #7 ; normalize A-F to be just above 0-9 L882E ldb #4 ; four bits per digit bsr L8834 ; add digit to accumlator bra L881F ; process another digit L8834 asl 1,x ; shift accumulator one bit left rol ,x lbcs LBA92 ; brif too big - overflow decb ; done enough bit shifts? bne L8834 ; brif not L883F suba #'0 ; remove ASCII bias adda 1,x ; merge digit into accumlator (this cannot cause carry) sta 1,x L8845 rts ; Expression evaluation handler XVEC15 puls u ; get back return address clr VALTYP ; set result to numeric ldx CHARAD ; save input pointer jsr GETNCH ; get the input character cmpa #'& ; HEX or OCTAL? beq L87EB ; brif so cmpa #0xcc ; FN? beq L88B4 ; brif so - do "FNx()" cmpa #0xff ; function token? bne L8862 ; brif not jsr GETNCH ; get function token value cmpa #0x83 ; USR? lbeq L892C ; brif so - short circuit Color Basic's USR handler L8862 stx CHARAD ; restore input pointer jmp ,u ; return to mainline code L8866 ldx CURLIN ; are we in immediate mode? leax 1,x L886A bne L8845 ; brif not - we're good ldb #2*11 ; code for illegal direct statement L886E jmp LAC46 ; raise error ; DEF command (DEF FN, DEF USR) DEF ldx [CHARAD] ; get two input characters cmpx #0xff83 ; USR? lbeq L890F ; brif so - do DEF USR bsr L88A1 ; get descriptor address for FN variable bsr L8866 ; disallow DEF FN in immediate mode jsr LB26A ; make sure we have ( ldb #0x80 ; disallow arrays as arguments stb ARYDIS jsr LB357 ; evaluate variable bsr L88B1 ; make sure it's numeric jsr LB267 ; make sure we have ) ldb #0xb3 ; make sure we have = jsr LB26F ldx V4B ; get variable descriptor address ldd CHARAD ; get input pointer std ,x ; save address of the actual function code in variable descriptor ldd VARPTR ; get descriptor address of argument std 2,x ; save argument descriptor address jmp DATA ; move to the end of this statement L88A1 ldb #0xcc ; make sure we have FN jsr LB26F ldb #0x80 ; disable array lookup stb ARYDIS ora #0x80 ; set bit 7 of first character (to indicate FN variable) jsr LB35C ; find the variable stx V4B ; save descriptor pointer L88B1 jmp LB143 ; make sure we have a numeric variable ; Evaluate an FN call L88B4 bsr L88A1 ; parse the FNx bit and get the descriptor pshs x ; save descriptor jsr LB262 ; evaluate parameter bsr L88B1 ; make sure it's a number puls u ; get FN descriptor ldb #2*25 ; code for undefined function ldx 2,u ; point to argument variable descriptor beq L886E ; brif nothing doing there (if it was just created, this will be NULL) ldy CHARAD ; save current input pointer ldu ,u ; point to start of FN definition stu CHARAD ; put input pointer there lda 4,x ; save original value of argument and save it with current input, and variable pointers pshs a ldd ,x ldu 2,x pshs u,y,x,d jsr LBC35 ; set argument variable to the argument L88D9 jsr LB141 ; go evaluate the FN expression puls d,x,y,u ; get back variable pointers, input pointer, and original variable value std ,x stu 2,x puls a sta 4,x jsr GETCCH ; test end of FN formula lbne LB277 ; brif not end of statement - problem with the function sty CHARAD ; restore input pointer L88EF rts ; Error handler XVEC17 cmpb #2*25 ; is it a valid Extended Basic error code? blo L88EF ; brif not - return to mainline jsr LA7E9 ; turn off tape jsr LA974 ; turn off sound jsr LAD33 ; clean up stack and other bits clr DEVNUM ; reset output to screen jsr LB95C ; do a newline if needed jsr LB9AF ; do a ? ldx #L890B-25*2 ; point to error message table jmp LAC60 ; go display error message ; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the ; Disk Basic documentation. It is here for the use of DLOAD. L890B fcc 'UF' ; 25 undefined function call fcc 'NE' ; 26 File not found ; DEF USR L890F jsr GETNCH ; eat the USR token bsr L891C ; get pointer to USR call pshs x ; save FN exec address location bsr L8944 ; calculate execution address puls u ; get FN address pointer stx ,u ; save new address rts L891C clrb ; default routine number is 0 jsr GETNCH ; fetch the call number bcc L8927 ; brif not a number suba #'0 ; remove ASCII bias tfr a,b ; save it in the right place jsr GETNCH ; eat the call number L8927 ldx USRADR ; get start address of USR jump table aslb ; two bytes per address abx ; now X points to the right entry rts ; Evaluate a USR call L892C bsr L891C ; find the correct routine address location ldx ,x ; get routine address pshs x ; save it jsr LB262 ; evaluate argument ldx #FP0EXP ; point to FPA0 (argument value) lda VALTYP ; is it string? beq L8943 ; brif not jsr LB657 ; fetch string details (removes it from the string stack) ldx FPA0+2 ; get string descriptor pointer lda VALTYP ; set flags for the value type L8943 rts ; call the routine and return to mainline code L8944 ldb #0xb3 ; check for "=" jsr LB26F jmp LB73D ; evaluate integer expression to X and return ; Extended Basic IRQ handler XIRQSV lda PIA0+3 ; is it VSYNC interrupt? bmi L8952 ; brif so rti ; really should clear the HSYNC interrupt here L8952 lda PIA0+2 ; clear VSYNC interrupt ldx TIMVAL ; increment the TIMER value leax 1,x stx TIMVAL jmp L9C3E ; check for other stuff ; TIMER= L8960 jsr GETNCH ; eat the TIMER token bsr L8944 ; evaluate =nnnn to X stx TIMVAL ; set the timer rts ; TIMER function TIMER ldx TIMVAL ; get timer value stx FPA0+2 ; set it in FPA0 jmp L880E ; return as positive 16 bit value ; DEL command DEL lbeq LB44A ; raise error if no argument (probably to avoid accidentally deleting line 0) jsr LAF67 ; parse line number jsr LAD01 ; find line stx VD3 ; save address of line jsr GETCCH ; is there something more? beq L8990 ; brif not cmpa #0xac ; dash? bne L89BF ; brif not - error out jsr GETNCH ; each the - beq L898C ; brif no ending line - use default line number bsr L89AE ; parse second line number and save in BINVAL bra L8990 ; do the deletion L898C lda #0xff ; set to maximum line number sta BINVAL L8990 ldu VD3 ; point end to start skip2 L8993 ldu ,u ; point to start of next line ldd ,u ; check for end of program beq L899F ; brif end of program ldd 2,u ; get line number subd BINVAL ; is it in range? bls L8993 ; brif so L899F ldx VD3 ; get starting line address bsr L89B8 ; close up gap jsr LAD21 ; reset input pointer and erase variables ldx VD3 ; get start of program after the deletion jsr LACF1 ; recompute netl ine pointers jmp LAC73 ; return to immediate mode L89AE jsr LAF67 ; parse a line number jmp LA5C7 ; make sure there's nothing more L89B4 lda ,u+ ; copy a byte sta ,x+ L89B8 cmpu VARTAB ; end of program? bne L89B4 ; brif not stx VARTAB ; save new start of variables/end of program L89BF rts ; LINE INPUT L89C0 jsr L8866 ; raise error if in immediate mode jsr GETNCH ; eat the "INPUT" token cmpa #'# ; device number? bne L89D2 ; brif not jsr LA5A5 ; parse device number jsr LA3ED ; make sure it's valid for input jsr SYNCOMMA ; make sure there's a comma after the device number L89D2 cmpa #'" ; is there a prompt? bne L89E1 ; brif not jsr LB244 ; parse the string ldb #'; ; make sure there's a semicolon after the prompt jsr LB26F jsr LB99F ; go actually display the prompt L89E1 leas -2,s ; make a hole on the stack (so number of return adddresses is right) jsr LB035 ; read an input line from current device leas 2,s ; clean up stack clr DEVNUM ; reset to screen/keyboard jsr LB357 ; parse a variable stx VARDES ; save pointer to it jsr LB146 ; make sure it's a string ldx #LINBUF ; point to input buffer clra ; make sure we terminate on NUL only jsr LB51A ; parse string and store it in string space jmp LAFA4 ; go assign the string to its final resting place ; RENUM command L89FC jsr LAF67 ; read a line number ldx BINVAL ; get value rts L8A02 ldx VD1 ; get current old number being renumbered L8A04 stx BINVAL ; save number being searched for jmp LAD01 ; go find line number RENUM jsr LAD26 ; erase variables ldd #10 ; default line number interval and start std VD5 ; set starting line number std VCF ; set number interval clrb ; now D is 0 std VD1 ; save default start for renumbering jsr GETCCH ; are there any arguments bcc L8A20 ; brif not numeric bsr L89FC ; fetch line number stx VD5 ; save line beginning number jsr GETCCH ; get input character L8A20 beq L8A3D ; brif end of line jsr SYNCOMMA ; make sure we have a comma bcc L8A2D ; brif next isn't numeric bsr L89FC ; fetch starting line number stx VD1 ; save the number where we start working jsr GETCCH ; fetch input character L8A2D beq L8A3D ; brif end of line jsr SYNCOMMA ; make sure we have a comma bcc L8A3A ; brif we don't have a number bsr L89FC ; parse the number stx VCF ; save interval beq L8A83 ; brif we ave a zero interval L8A3A jsr LA5C7 ; raise error if more stuff L8A3D bsr L8A02 ; get address of old number to process stx VD3 ; save address ldx VD5 ; get the next renumbered line to use bsr L8A04 ; find that line cmpx VD3 ; is it before the previous one? blo L8A83 ; brif so - raise error bsr L8A67 ; make sure renumbered line numbers will be in range jsr L8ADD ; convert line numbers to "expanded" binary jsr LACEF ; recalculate next line pointers bsr L8A02 ; get address of first line to renumber stx VD3 ; save it bsr L8A91 ; make sure line numbers exist bsr L8A68 ; renumber the actual lines bsr L8A91 ; update line numbers in program text jsr L8B7B ; convert packed binary line numbers to text jsr LAD26 ; erase variables, reset stack, etc. jsr LACEF ; recalculate next line pointers jmp LAC73 ; bounce back to immediate mode L8A67 skip1lda ; set line number flag to nonzero (skip next instruction) L8A68 clra ; set line number flag to zero (insert new numbers) sta VD8 ; save line number flag ldx VD3 ; get address of line being renumbered ldd VD5 ; get the current renumbering number bsr L8A86 ; return if end of program L8A71 tst VD8 ; test line number flag bne L8A77 ; brif not adding new numbers std 2,x ; set new number L8A77 ldx ,x ; point to next line bsr L8A86 ; return if end of program addd VCF ; add interval to current number bcs L8A83 ; brif we overflowed - bad line number cmpa #MAXLIN ; maximum legal number? blo L8A71 ; brif so - do another L8A83 jmp LB44A ; raise FC error L8A86 pshs d ; save D (we're going to clobber it) ldd ,x ; get next line pointer puls d ; unclobber D bne L8A90 ; brif not end of program leas 2,s ; return to caller's caller L8A90 rts L8A91 ldx TXTTAB ; get start of program leax -1,x ; move pointer back one (compensate for leax 1,x below) L8A95 leax 1,x ; move to next line bsr L8A86 ; return if end of program L8A99 leax 3,x ; move past next line address and line number, go one before line L8A9B leax 1,x ; move to next character lda ,x ; check input character beq L8A95 ; brif end of line stx TEMPTR ; save current pointer deca ; is it start of packed numeric line number? beq L8AB2 ; brif so deca ; does line exist? beq L8AD3 ; brif line number exists deca ; not part of something to process? bne L8A9B ; brif so L8AAC lda #3 ; set 1st byte to 3 to indicate line number not existing sta ,x+ bra L8A99 ; go process another L8AB2 ldd 1,x ; get MSB of line number dec 2,x ; is MS byte zero? beq L8AB9 ; brif not clra ; set MS byte to 0 L8AB9 ldb 3,x ; get LSB of line number dec 4,x ; is it zero? beq L8AC0 ; brif not clrb ; clear byte L8AC0 std 1,x ; save binary number std BINVAL ; save trial number jsr LAD01 ; find the line number L8AC7 ldx TEMPTR ; get start of packed line bcs L8AAC ; brif line number not found ldd V47 ; get address of line number inc ,x+ ; bump first byte to 2 (exists if checking) or 1 if inserting std ,x ; save address of correct number bra L8A99 ; go process more L8AD3 clr ,x ; clear carry and first byte ldx 1,x ; point to address of correct line ldx 2,x ; get correct line number stx V47 ; save it bra L8AC7 ; insert into line L8ADD ldx TXTTAB ; get beginning of program bra L8AE5 L8AE1 ldx CHARAD ; get input pointer leax 1,x ; move it forward L8AE5 bsr L8A86 ; return if end of program leax 2,x ; move past line address L8AE9 leax 1,x ; move forward L8AEB stx CHARAD ; save input pointer L8AED jsr GETNCH ; get an input character L8AEF tsta ; is it actual 0? beq L8AE1 ; brif end of line bpl L8AED ; brif not a token ldx CHARAD ; get input pointer cmpa #0xff ; function? beq L8AE9 ; brif so - ignore it (and following byte) jsr RVEC22 ; do the RAM hook thing cmpa #0xa7 ; THEN? beq L8B13 ; brif so cmpa #0x84 ; ELSE? beq L8B13 ; brif so cmpa #0x81 ; GO(TO|SUB)? bne L8AED ; brif not - we don't have a line number jsr GETNCH ; get TO/SUB cmpa #0xa5 ; GOTO? beq L8B13 ; brif so cmpa #0xa6 ; GOSUB? bne L8AEB ; brif not L8B13 jsr GETNCH ; fetch character after token bcs L8B1B ; brif numeric (line number) L8B17 jsr GETCCH ; set flags on input character bra L8AEF ; keep checking for line numbers L8B1B ldx CHARAD ; get input pointer pshs x ; save it jsr LAF67 ; parse line number ldx CHARAD ; get input pointer after line L8B24 lda ,-x ; get character before pointer jsr L90AA ; set C if numeric bcs L8B24 ; brif not numeric leax 1,x ; move pointer up tfr x,d ; calculate size of line number subb 1,s subb #5 ; make sure at least 5 bytes beq L8B55 ; brif exactly 5 bytes - no change blo L8B41 ; brif less than 5 bytes leau ,x ; move remainder of program backward negb ; negate extra number of bytes (to subtract from X) leax b,x ; now X is the correct position to move program to jsr L89B8 ; shift program backward bra L8B55 L8B41 stx V47 ; save end of line number space (end of copy) ldx VARTAB ; get end of program stx V43 ; set source pointer negb ; get positive difference leax b,x ; now X is the top of the destination block stx V41 ; set copy destination stx VARTAB ; save new end of program jsr LAC1E ; make sure enough room and make a hole in the program ldx V45 ; get end address of destination block stx CHARAD ; set input there L8B55 puls x ; get starting address of the line number lda #1 ; set "new number" flag sta ,x sta 2,x sta 4,x ldb BINVAL ; get MS byte of line number bne L8B67 ; brif it is not zero ldb #1 ; set to 1 if MSB is 0 inc 2,x ; flag MSB as 0 L8B67 stb 1,x ; set MSB of line number ldb BINVAL+1 ; get LSB of number bne L8B71 ; brif nonzero ldb #1 ; set to 1 if LSB is 0 inc 4,x ; flag LSB as 0 L8B71 stb 3,x ; save LSB of line number jsr GETCCH ; get input character cmpa #', ; multiple line numbers? (ON GOTO, ON GOSUB) beq L8B13 ; brif so - process another bra L8B17 ; go look for more line numbers L8B7B ldx TXTTAB ; point to start of program leax -1,x ; move back (compensate for inc below) L8B7F leax 1,x ; move forward ldd 2,x ; get this line number std CURLIN ; save it (for error message) jsr L8A86 ; return if end of program leax 3,x ; skip address and line number, stay one before line text L8B8A leax 1,x ; move to next character L8B8C lda ,x ; get input character beq L8B7F ; brif end of line deca ; valid line new line number? beq L8BAE ; brif so suba #2 ; undefined line? bne L8B8A ; brif not pshs x ; save line number pointer ldx #L8BD9-1 ; show UL message jsr STRINOUT ldx ,s ; get input pointer ldd 1,x ; get undefined line number jsr LBDCC ; display line number jsr LBDC5 ; print out "IN XXXX" jsr LB958 ; do a newline puls x ; get input pointer back L8BAE pshs x ; save input pointer ldd 1,x ; get binary value of line number std FPA0+2 ; save it in FPA0 jsr L880E ; adjust FPA0 as integer jsr LBDD9 ; convert to text string puls u ; get previous input pointer address ldb #5 ; each expanded line uses 5 bytes L8BBE leax 1,x ; move pointer forward (in string number) past sign lda ,x ; do we have a digit? beq L8BC9 ; brif not - end of number decb ; mark a byte consumed sta ,u+ ; put digit in program bra L8BBE ; copy another digit L8BC9 leax ,u ; point to address at end of text number tstb ; did number fill whole space? beq L8B8C ; brif so - move on leay ,u ; save end of number pointer leau b,u ; point to the end of the original expanded number jsr L89B8 ; close up gap in program leax ,y ; get end of line number pointer back bra L8B8C ; go process more L8BD9 fcn 'UL ' ; HEX$ function HEXDOL jsr LB740 ; convert argument to positive integer ldx #STRBUF+2 ; point to string buffer ldb #4 ; convert 4 nibbles L8BE5 pshs b ; save nibble counter clrb ; clear digit accumulator lda #4 ; do 4 shifts L8BEA asl FPA0+3 ; shift a bit off the left of the value into low bits of B rol FPA0+2 rolb deca ; done all shifts? bne L8BEA ; brif not tstb ; do we have a nonzero digit? bne L8BFF ; brif so lda ,s ; is it last digit? deca beq L8BFF ; brif so - keep the 0 cmpx #STRBUF+2 ; is it a middle zero? beq L8C0B ; brif not L8BFF addb #'0 ; add ASCII bias cmpb #'9 ; above 9? bls L8C07 ; brif not addb #7 ; adjust into alpha range L8C07 stb ,x+ ; save digit in output clr ,x ; make sure we have a NUL term L8C0B puls b ; get back nibble counter decb ; done all? bne L8BE5 ; brif not leas 2,s ; don't return mainline (we're returning a string) ldx #STRBUF+1 ; point to start of converted number jmp LB518 ; save string in string space, etc., and return it ; DLOAD command; this is eliminated on the Coco3. It was basically useless anyway so it was ; a good candidate to overwrite for some extra code space in the lower 16K of the internal ; ROM. Now, DLOAD functions as another entry into the RESET sequence. DLOAD jsr LA429 ; close tape file L8C1B orcc #0x50 ; make sure interrupts are disabled lda #MC3+MC1 ; disable MMU, 32K internal ROM, not "coco" compatible sta INIT0 clr TYCLR ; go to ROM mapping mode jmp SC000 ; transfer control to the "hidden" init code L8C28 clr INT.FLAG ; set the interrupt flag to not valid clr PIA1+3 ; disable cartridge interrupt L8C2E lda #COCO+MMUEN+MC3+MC2 ; enable SCS, 16K split, MMU, COCO mode sta INIT0 clr TYCLR ; go to ROM mode L8C36 rts L8C37 pshs a,b,x ; save registers ldx CURPOS ; get cursor position ldb HRWIDTH ; hi-res mode? lbne ALINK22 ; brif so ldb 1,s ; restore B jmp LA30E ; go back to mainline code L8C46 pshs cc ; save Z tst HRWIDTH ; hi-res? beq L8C4F ; brif not jmp ALINK23 ; go to hi-res handler L8C4F puls cc ; get back Z jmp LA913 ; go back to mainline code nop fcb 0xc7 ; junk byte (too few NOPs above) ; This returns to the remainder of the original ECB 1.1 DLOAD code tstb ; ASCII? beq L8C5F ; brif not - do error jsr LAD19 ; clear out program jmp LAC7C ; go read program L8C5F jmp LA616 ; raise bad file mode ; CLOADM patch for Extended Basic L8C62 jsr GETNCH ; get character after CLOAD cmpa #'M ; CLOADM? lbne CLOAD ; brif not - Color Basic's CLOAD can handle it clr FILSTA ; close tape file jsr GETNCH ; eat the "M" jsr LA578 ; parse file name jsr LA648 ; find the file tst CASBUF+10 ; is it a chunked file? lbeq LA505 ; brif not - Color Basic's CLOADM can handle it ldu CASBUF+8 ; get file type and ASCII flag dec DEVNUM ; set source device to tape jsr LA635 ; go read the first block tfr u,d ; put type and ASCII flag somewhere more useful ; NOTE: DLOADM comes here to do the final processing L8C85 subd #0x200 ; is it binary and "machine language"? bne L8C5F ; brif not - raise an error ldx ZERO ; default load offset jsr GETCCH ; is there any offset? beq L8C96 ; brif not jsr SYNCOMMA ; make sure there's a comma jsr LB73D ; evaluate offset in X L8C96 stx VD3 ; save offset jsr LA5C7 ; raise error if more stuff follows L8C9B bsr L8CC6 ; get type of "amble" pshs a ; save it bsr L8CBF ; read in block length tfr d,y ; save it bsr L8CBF ; read in load address addd VD3 ; add in offset std EXECJP ; save it as the execution address tfr d,x ; put load address in a pointer lda ,s+ ; get "amble" type lbne LA42D ; brif postamble - close file L8CB1 bsr L8CC6 ; read a data byte sta ,x ; save in memory cmpa ,x+ ; did it actually save? bne L8CCD ; brif not RAM - raise error leay -1,y ; done yet? bne L8CB1 ; brif not bra L8C9B ; look for another "amble" L8CBF bsr L8CC1 ; read a character to B L8CC1 bsr L8CC6 ; read character to A exg a,b ; swap character with previously read one L8CC5 rts L8CC6 jsr LA176 ; read a character from input tst CINBFL ; EOF? beq L8CC5 ; brif not L8CCD jmp LA619 ; raise I/O error if EOF L8CD0 bsr L8D14 ; transmit file name pshs b,a ; save file status inca ; was file found? beq L8CDD ; brif not ldu ZERO ; zero U - first block bsr L8CE4 ; read block puls a,b,pc ; restore status and return L8CDD ldb #2*26 ; code for NE error jmp LAC46 ; raise error L8CE2 ldu CBUFAD ; get block number L8CE4 leax 1,u ; bump block number stx CBUFAD ; save new block number ldx #CASBUF ; use cassette buffer jsr L8D7C ; read a block jmp LA644 ; reset input buffer pointers ; Generic input handler for Extended Basic XVEC4 lda DEVNUM ; get device number cmpa #-3 ; DLOAD? bne L8D01 ; brif not leas 2,s ; don't return to mainline code clr CINBFL ; reset EOF flag to not EOF tst CINCTR ; anything available? bne L8D02 ; brif so - fetch one com CINBFL ; flag EOF L8D01 rts L8D02 pshs u,y,x,b ; save registers ldx CINPTR ; get buffer pointer lda ,x+ ; get character from buffer pshs a ; save it for return stx CINPTR ; save new input pointer dec CINCTR ; account for byte removed from buffer bne L8D12 ; brif buffer not empty bsr L8CE2 ; go read a block L8D12 puls a,b,x,y,u,pc ; restore registers, return value, and return L8D14 clra ; clear attempt counter pshs x,b,a ; make a hole for variables leay ,s ; set up frame pointer bra L8D1D ; go read block L8D1B bsr L8D48 ; bump attempt counter L8D1D lda #0x8a ; send file request control code bsr L8D58 bne L8D1B ; brif no echo or error ldx #CFNBUF+1 ; point to file name L8D26 lda ,x+ ; get file name characater jsr L8E04 ; send it cmpx #CFNBUF+9 ; end of file name? bne L8D26 ; brif not bsr L8D62 ; output check byte and look for response bne L8D1B ; transmit name again if not ack bsr L8D72 ; get file type (0xff is not found) bne L8D1B ; brif error sta 2,y ; save file type bsr L8D72 ; read ASCII flag bne L8D1B ; brif error sta 3,y ; save ASCII flag bsr L8D6B ; read check byte bne L8D1B ; brif error leas 2,s ; lose attempt counter and check byte puls a,b,pc ; return file type and ascii flag L8D48 inc ,y ; bump attempt counter lda ,y ; get new count cmpa #5 ; done 5 times? blo L8D6A ; brif not lda #0xbc ; send abort code jsr L8E0C jmp LA619 ; raise an I/O error L8D58 pshs a ; save compare character bsr L8DB8 ; send character bne L8D60 ; brif read error cmpa ,s ; does it match? (set Z if good) L8D60 puls a,pc ; restore character and return L8D62 lda 1,y ; get XOR check byte bsr L8DB8 ; send it and read bne L8D6A ; brif read error cmpa #0xc8 ; is it ack? (set Z if so) L8D6A rts L8D6B bsr L8D72 ; read character from rs232 bne L8D6A ; brif error lda 1,y ; get check byte rts L8D72 bsr L8DBC ; read a character from rs232 pshs a,cc ; save result (and flags) eora 1,y ; accumulate xor checksum sta 1,y puls cc,a,pc ; restore byte, flags, and return L8D7C clra ; reset attempt counter pshs u,y,x,b,a ; make a stack frame asl 7,s ; split block number into two 7 bit chuncks rol 6,s lsr 7,s leay ,s ; set up frame pointer bra L8D8B L8D89 bsr L8D48 ; bump attempt counter L8D8B lda #0x97 ; send block request code bsr L8D58 bne L8D89 ; brif error lda 6,y ; send out block number (high bits first) bsr L8E04 lda 7,y bsr L8E04 bsr L8D62 ; send check byte and get ack bne L8D89 ; brif error bsr L8D72 ; read block size bne L8D89 ; brif read error sta 4,y ; save character count ldx 2,y ; get buffer pointer ldb #128 ; length of data block L8DA7 bsr L8D72 ; read a data byte bne L8D89 ; brif error sta ,x+ ; save byte in buffer decb ; done a whole block? bne L8DA7 ; brif not bsr L8D6B ; read check byte bne L8D89 ; brif error leas 4,s ; lose attempt counter, check byte, and buffer pointer puls a,b,x,pc ; return with character count in A, clean rest of stack L8DB8 clr 1,y ; clear check byte bsr L8E0C ; output character L8DBC clra ; clear attempt counter pshs x,b,cc ; save registers and interrupt status orcc #0x50 ; disable interrupts lda TIMOUT ; get timout delay (variable) ldx ZERO ; get constant timeout value L8DC5 bsr L8DE6 ; get RS232 status bcc L8DC5 ; brif "space" - waiting for "mark" L8DC9 bsr L8DE6 ; get RS232 status bcs L8DC9 ; brif "mark" - waiting for "space" (start bit) bsr L8DF9 ; delay for half of bit time ldb #1 ; set bit probe pshs b ; save it clra ; reset data byte L8DD4 bsr L8DF7 ; wait one bit time ldb PIA1+2 ; get input bit to carry rorb bcc L8DDE ; brif "space" (0) ora ,s ; merge bit probe in L8DDE asl ,s ; shift bit probe over bcc L8DD4 ; brif we haven't done 8 bits leas 1,s ; remove bit probe puls cc,b,x,pc ; restore interrupts, registers, and return L8DE6 ldb PIA1+2 ; get RS232 value rorb ; put in C leax 1,x ; bump timeout bne L8DF6 ; brif nonzero deca ; did the number of waits expire? bne L8DF6 ; brif not leas 2,s ; don't return - we timed out puls cc,b,x ; restore interrupts and registers inca ; clear Z (A was zero above) L8DF6 rts L8DF7 bsr L8DF9 ; do first half of bit delay then fall through for second L8DF9 pshs a ; save register lda DLBAUD ; get baud rate constant L8DFD brn L8DFD ; do nothing - delay deca ; time expired? bne L8DFD ; brif not puls a,pc ; restore register and return L8E04 pshs a ; save character to send eora 1,y ; accumulate chechsum sta 1,y puls a ; get character back L8E0C pshs b,a,cc ; save registers and interrupt status orcc #0x50 ; disable interrupts bsr L8DF7 ; do a bit delay bsr L8DF7 ; do another bit delay clr PIA1 ; set output to space (start bit) bsr L8DF7 ; do a bit delay ldb #1 ; bit probe start at LSB pshs b ; save bitprobe L8E1D lda 2,s ; get output byte anda ,s ; see what our current bit is beq L8E25 ; brif output is 0 lda #2 ; set output to "marking" L8E25 sta PIA1 ; send bit bsr L8DF7 ; do a bit delay asl ,s ; shift bit probe bcc L8E1D ; brif not last bit lda #2 ; set output to marking ("stop" bit) sta PIA1 leas 1,s ; lose bit probe puls cc,a,b,pc ; restore registers, interrupts, and return ; PRINT USING ; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to ; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total ; Extended Color Basic ROM. ; ; This uses several variables: ; VD5: pointer to format string descriptor ; VD7: next print item flag ; VD8: right digit counter ; VD9: left digit counter (or length of string argument) ; VDA: status byte (bits as follows): ; 6: force comma ; 5: force leading * ; 4: floating $ ; 3: pre-sign ; 2: post-sign ; 0: scientific notation L8E37 lda #1 ; set length to use to 1 sta VD9 L8E3B decb ; consume character from format string jsr L8FD8 ; show error flag if flags set jsr GETCCH ; get input character lbeq L8ED8 ; brif end of line - bail stb VD3 ; save remaining string length jsr LB156 ; evaluate the argument jsr LB146 ; error if numeric ldx FPA0+2 ; get descriptor for argument stx V4D ; save it for later ldb VD9 ; get length counter to use jsr LB6AD ; get B bytes of string space (do a LEFT$) jsr LB99F ; print the formatted string ldx FPA0+2 ; get formatted string descriptor ldb VD9 ; get requested length subb ,x ; see if we have any left over L8E5F decb ; have we got the right width? lbmi L8FB3 ; brif so - go process more jsr LB9AC ; output a space bra L8E5F ; go see if we're done yet L8E69 stb VD3 ; save current format string counter and pointer stx TEMPTR lda #2 ; initial spaces count = 2 (for the two %s) sta VD9 ; save length counter L8E71 lda ,x ; get character in string cmpa #'% ; is it the end of the sequence? beq L8E3B ; brif so - display requested part of the strign cmpa #0x20 ; space? bne L8E82 ; brif not inc VD9 ; bump spaces count leax 1,x ; move format pointer forward decb ; consume character bne L8E71 ; brif not end of format string L8E82 ldx TEMPTR ; restore format string pointer ldb VD3 ; get back format string length lda #'% ; show % as debugging aid L8E88 jsr L8FD8 ; send error indicator if flags set jsr PUTCHR ; output character bra L8EB9 ; go process more format string ; PRINT extension for USING XVEC9 cmpa #0xcd ; USING? beq L8E95 ; brif so rts ; return to mainline code ; This is the main entry point for PRINT USING L8E95 leas 2,s ; don't return to the mainline code jsr LB158 ; evaluate the format string jsr LB146 ; error if numeric ldb #'; ; make sure there's a ; after the string jsr LB26F ldx FPA0+2 ; get format string descriptor stx VD5 ; save it for later bra L8EAE ; process format string L8EA8 lda VD7 ; is there a print item? beq L8EB4 ; brif not ldx VD5 ; get back format string descriptor L8EAE clr VD7 ; reset next print item flag ldb ,x ; get length of format string bne L8EB7 ; brif string is non-null L8EB4 jmp LB44A ; raise FC error L8EB7 ldx 2,x ; point to start of string L8EB9 clr VDA ; clear status (new item) L8EBB clr VD9 ; clear left digit counter lda ,x+ ; get character from format string cmpa #'! ; ! (use first character of string)? lbeq L8E37 ; brif so cmpa #'# ; digit? beq L8F24 ; brif so - handle numeric decb ; consume format character bne L8EE2 ; brif not done jsr L8FD8 ; show a "+" if any flags set - indicates error at end of string jsr PUTCHR ; output format string character L8ED2 jsr GETCCH ; get current input character bne L8EA8 ; brif not end of statement lda VD7 ; get next item flag L8ED8 bne L8EDD ; brif more print items jsr LB958 ; do newline L8EDD ldx VD5 ; point to format string descriptor jmp LB659 ; remove from string stack, etc., if appropriate (and return) L8EE2 cmpa #'+ ; is it + (pre-sign)? bne L8EEF ; brif not jsr L8FD8 ; send a "+" if flags set lda #8 ; flag for pre-sign sta VDA ; set flags bra L8EBB ; go interpret some more stuff L8EEF cmpa #'. ; decimal? beq L8F41 ; brif so - numeric cmpa #'% ; % (show string)? lbeq L8E69 ; brif so cmpa ,x ; do we have two identical characters? L8EFB bne L8E88 ; brif not - invalid format character cmpa #'$ ; double $? beq L8F1A ; brif so - floating $ cmpa #'* ; double *? bne L8EFB ; brif not lda VDA ; get status byte ora #0x20 ; enable * padding sta VDA cmpb #2 ; is $$ the last two? blo L8F20 ; brif so lda 1,x ; is it $ after? cmpa #'$ bne L8F20 ; brif not decb ; consume the "$" leax 1,x inc VD9 ; add to digit counter * pad + $ counter L8F1A lda VDA ; indicate floating $ ora #0x10 sta VDA L8F20 leax 1,x ; consume the second format character inc VD9 ; add one more left place L8F24 clr VD8 ; clear right digit counter L8F26 inc VD9 ; bump left digit counter decb ; consume character beq L8F74 ; brif end of string lda ,x+ ; get next format character cmpa #'. ; decimal? beq L8F4F ; brif so cmpa #'# ; digit? beq L8F26 ; brif so cmpa #', ; comma flag? bne L8F5A ; brif not lda VDA ; set commas flag ora #0x40 sta VDA bra L8F26 ; handle more characters to left of decimal L8F41 lda ,x ; get character after . cmpa #'# ; digit? lbne L8E88 ; brif not - invalid lda #1 ; set right digit counter to 1 (for the .) sta VD8 leax 1,x ; consume the . L8F4F inc VD8 ; add one to right digit counter decb ; consume character beq L8F74 ; brif end of format string lda ,x+ ; get another format character cmpa #'# ; digit? beq L8F4F ; brif so L8F5A cmpa #0x5e ; up arrow? bne L8F74 ; brif not cmpa ,x ; two of them? bne L8F74 ; brif not cmpa 1,x ; three of them? bne L8F74 ; brif not cmpa 2,x ; four of them? bne L8F74 ; brif not cmpb #4 ; string actually has the characters? blo L8F74 ; brif not subb #4 ; consome them leax 4,x inc VDA ; set scientific notation bit L8F74 leax -1,x ; back up input pointer inc VD9 ; add one digit for pre-sign force lda VDA ; is it pre-sign? bita #8 bne L8F96 ; brif so dec VD9 ; undo pre-sign adjustment tstb ; end of string? beq L8F96 ; brif so lda ,x ; get next character suba #'- ; post sign force? beq L8F8F ; brif so cmpa #'+-'- ; plus? bne L8F96 ; brif not lda #8 ; trailing + is a pre-sign force L8F8F ora #4 ; add in post sign flag ora VDA ; merge with flags sta VDA decb ; consume character L8F96 jsr GETCCH ; do we have an argument lbeq L8ED8 ; brif not stb VD3 ; save format string length jsr LB141 ; evluate numeric expression lda VD9 ; get left digit counter adda VD8 ; add in right digit counter cmpa #17 ; is it more than 16 digits + decimal? lbhi LB44A ; brif so - this is a problem jsr L8FE5 ; format value according to settings leax -1,x ; move buffer pointer back jsr STRINOUT ; display formatted number string L8FB3 clr VD7 ; reset next print item flag jsr GETCCH ; get current input character beq L8FC6 ; brif end of statement sta VD7 ; set next print flag to nonzero cmpa #'; ; list separator ;? beq L8FC4 ; brif so jsr SYNCOMMA ; require a comma between if not ; bra L8FC6 ; process next item L8FC4 jsr GETNCH ; munch the semicolon L8FC6 ldx VD5 ; get format string descriptor ldb ,x ; get length of string subb VD3 ; subtract amount left after last item ldx 2,x ; point to string address abx ; move pointer to correct spot ldb VD3 ; get remaining string length lbne L8EB9 ; if we have more, interpret from there jmp L8ED2 ; re-interpret from start if we hit the end L8FD8 pshs a ; save character lda #'+ ; "error" flag character tst VDA ; did we have some flags set? beq L8FE3 ; brif not jsr PUTCHR ; output error flag L8FE3 puls a,pc ; restore character and return L8FE5 ldu #STRBUF+4 ; point to string buffer ldb #0x20 ; blank space lda VDA ; get flags bita #8 ; pre-sign? beq L8FF2 ; brif not ldb #'+ ; plus sign L8FF2 tst FP0SGN ; get sign of value bpl L8FFA ; brif positive clr FP0SGN ; make number positive (for later) ldb #'- ; negative sign L8FFA stb ,u+ ; put sign in buffer ldb #'0 ; put a zero there stb ,u+ anda #1 ; check scientific notation force lbne L910D ; brif so ldx #LBDC0 ; point to FP 1E+9 jsr LBCA0 ; is it less? bmi L9023 ; brif so jsr LBDD9 ; convert FP number to string (we're doing scientific notation) L9011 lda ,x+ ; advance pointer to end of string bne L9011 L9015 lda ,-x ; make a hole at the start sta 1,x cmpx #STRBUF+3 ; done yet? bne L9015 ; brif not lda #'% ; put "overflow" flag at start sta ,x rts L9023 lda FP0EXP ; get exponent of value sta V47 ; save it beq L902C ; brif value is 0 jsr L91CD ; convert to number with 9 significant figures to left of decimal L902C lda V47 ; get base 10 exponent offset lbmi L90B3 ; brif < 100,000,000 nega ; get negative difference adda VD9 ; add to number of left digits suba #9 ; account for the 9 we actually have jsr L90EA ; put leading zeroes in buffer jsr L9263 ; initialize the decimal point and comma counters jsr L9202 ; convert FPA0 to decimal ASCII in buffer lda V47 ; get base 10 exponent jsr L9281 ; put that many zeroes in buffer, stop at decimal point lda V47 ; get base 10 exponent jsr L9249 ; check for decimal lda VD8 ; get right digit counter bne L9050 ; brif we want stuff after decimal leau -1,u ; delete decimal if not needed L9050 deca ; subtract one place (for decimal) jsr L90EA ; put zeroes in buffer (trailing) L9054 jsr L9185 ; insert * padding, floating $, and post-sign tsta ; was there a post sign? beq L9060 ; brif not cmpb #'* ; was first character a *? beq L9060 ; brif so stb ,u+ ; store the post sign L9060 clr ,u ; make srue it's NUL terminated ldx #STRBUF+3 ; point to start of buffer L9065 leax 1,x ; move to next character stx TEMPTR ; save it for later lda VARPTR+1 ; get address of decimal point suba TEMPTR+1 ; subtract out actual digits left of decimal suba VD9 ; subtract out required left digits beq L90A9 ; brif no padding needed lda ,x ; get current character cmpa #0x20 ; space? beq L9065 ; brif so - advance pointer cmpa #'* ; *? beq L9065 ; brif so - advance pointer clra ; zero on stack is end of data ponter L907C pshs a ; save character on stack lda ,x+ ; get next character cmpa #'- ; minus? beq L907C ; brif so cmpa #'+ ; plus? beq L907C ; brif so cmpa #'$ ; $? beq L907C ; brif so cmpa #'0 ; zero? bne L909E ; brif not lda 1,x ; get character after 0 bsr L90AA ; clear carry if number bcs L909E ; brif not number L9096 puls a ; get character off stack sta ,-x ; put it back in string buffer bne L9096 ; brif not - restore another bra L9065 ; keep cleaning up buffer L909E puls a ; get the character on the stack tsta ; is it NUL? bne L909E ; brif not ldx TEMPTR ; get string buffer start pointer lda #'% ; put error flag in front sta ,-x L90A9 rts L90AA cmpa #'0 ; zero? blo L90B2 ; brif not suba #'9+1 ; set C if > "9" suba #-('9+1) L90B2 rts L90B3 lda VD8 ; get right digit counter beq L90B8 ; brif not right digits deca ; account for decimal point L90B8 adda V47 ; add base 10 exponent offset bmi L90BD ; if >= 0, no shifts are required clra ; force shift counter to 0 L90BD pshs a ; save shift counter L90BF bpl L90CB ; brif positive count pshs a ; save shift counter jsr LBB82 ; divide FPA0 by 10 (shift 1 digit to the right) puls a ; get shift counter back inca ; account for the shift bra L90BF ; see if we're done yet L90CB lda V47 ; get base 10 exponent offset suba ,s+ ; account for adjustment sta V47 ; save new exponent offset adda #9 ; account for significant places bmi L90EE ; brif we don't need zeroes to left lda VD9 ; get left decimal counter suba #9 ; account for significant figures suba V47 ; subtract exponent offset bsr L90EA ; output leading zeroes jsr L9263 ; initialize decimal and comma counters bra L90FF ; process remainder of digits L90E2 pshs a ; save zero counter lda #'0 ; insert a 0 sta ,u+ puls a ; get back counter L90EA deca ; do we need more zeroes? bpl L90E2 ; brif so rts L90EE lda VD9 ; get left digit counter bsr L90EA ; put that many zeroes in jsr L924D ; put decimal in buffer lda #-9 ; figure out filler zeroes suba V47 bsr L90EA ; output required leader zeroes clr V45 ; clear decimal pointer counter clr VD7 ; clear comma counter L90FF jsr L9202 ; decode FPA0 to decimal string lda VD8 ; get right digit counter bne L9108 ; brif there are right digits ldu VARPTR ; point to decimal location of decimal L9108 adda V47 ; add base 10 exponent lbra L9050 ; add in leading astrisks, etc. L910D lda FP0EXP ; get exponent of FPA0 pshs a ; save it beq L9116 ; brif 0 jsr L91CD ; convert to number with 9 figures L9116 lda VD8 ; get right digit counter beq L911B ; brif no right digits deca ; account for decimal point L911B adda VD9 ; get left digit counter clr STRBUF+3 ; use buffer byte as temporary storage ldb VDA ; get status flags andb #4 ; post-sign? bne L9129 ; brif so com STRBUF+3 ; flip byte if no post sign L9129 adda STRBUF+3 ; subtract 1 if no post sign suba #9 ; account for significant figures pshs a ; save shift counter L9130 bpl L913C ; brif no more shifts needed pshs a ; save counter jsr LBB82 ; divide by 10 (shift right one) puls a ; get back counter inca ; account for the shift bra L9130 ; see if we need more L913C lda ,s ; get original shift count bmi L9141 ; brif shifting happened clra ; flag for no shifting L9141 nega ; calculate position of decimal (negate shift count, add left digit and post sign if needed) adda VD9 ; add left digit counter inca ; and post sign adda STRBUF+3 sta V45 ; save decimal counter clr VD7 ; clear comma counter jsr L9202 ; convert to decimal string puls a ; get shift counter jsr L9281 ; put the needed zeroes in lda VD8 ; get right digit counter bne L915A ; brif we want some leau -1,u ; remove te decimal point L915A ldb ,s+ ; get original exponent beq L9167 ; brif it was 0 ldb V47 ; get base 10 exponent addb #9 ; account for significant figures subb VD9 ; remove left digit count subb STRBUF+3 ; add one if post sign L9167 lda #'+ ; positive sign tstb ; is base 10 exponent positive? bpl L916F ; brif so lda #'- ; negative sign negb ; flip exponent L916F sta 1,u ; put exponent sign lda #'E ; put "E" and advance output pointer sta ,u++ lda #'0-1 ; initialize digit accumulator L9177 inca ; bump digit subb #10 ; are we at the right digit? bcc L9177 ; brif not addb #'0+10 ; add ASCII bias and undo extra subtraction std ,u++ ; save exponent in buffer clr ,u ; clear final byte in buffer jmp L9054 ; insert *, $, etc. L9185 ldx #STRBUF+4 ; point to start of result ldb ,x ; get sign pshs b ; save it lda #0x20 ; default pad with spaces ldb VDA ; get flags bitb #0x20 ; padding with *? puls b beq L919E ; brif no padding lda #'* ; pad with * cmpb #0x20 ; do we have a blank? (positive) bne L919E ; brif not tfr a,b ; use pad character L919E pshs b ; save first character L91A0 sta ,x+ ; store padding ldb ,x ; get next character beq L91B6 ; brif end of string cmpb #'E ; exponent? beq L91B6 ; brif so - treat as 0 cmpb #'0 ; zero? beq L91A0 ; brif so - pad it cmpb #', ; leading comma? beq L91A0 ; brif so - pad it cmpb #'. ; decimal? bne L91BA ; brif so - don't put a 0 before it L91B6 lda #'0 ; put a zero before sta ,-x L91BA lda VDA ; get status byte bita #0x10 ; floating $? beq L91C4 ; brif not ldb #'$ ; stuff a $ in stb ,-x L91C4 anda #4 ; pre-sgn? puls b ; get back first character bne L91CC ; brif not stb ,-x ; save leading character (sign) L91CC rts L91CD pshs u ; save buffer pointer clra ; initial exponent offset is 0 L91D0 sta V47 ; save exponent offset ldb FP0EXP ; get actual exponent cmpb #0x80 ; is value >= 1.0? bhi L91E9 ; brif so ldx #LBDC0 ; point to FP number 1E9 jsr LBACA ; multiply by 1000000000 lda V47 ; account for 9 shifts suba #9 bra L91D0 ; brif not there yet L91E4 jsr LBB82 ; divide by 10 inc V47 ; account for shift L91E9 ldx #LBDBB ; point to 999999999 jsr LBCA0 ; compare it bgt L91E4 ; brif not in range yet L91F1 ldx #LBDB6 ; point to 99999999.9 jsr LBCA0 ; compare bgt L9200 ; brif in range jsr LBB6A ; multiply by 10 dec V47 ; account for shift bra L91F1 ; see if we're in range yet L9200 puls u,pc ; restore buffer pointer and return L9202 pshs u ; save buffer pointer jsr LB9B4 ; add .5 (round off) jsr LBCC8 ; convert to integer format puls u ; restore buffer pointer ldx #LBEC5 ; point to 32 bit powers of 10 (alternating signs) ldb #0x80 ; intitial digit counter is 0 with 0x80 bias L9211 bsr L9249 ; check for comma L9213 lda FPA0+3 ; add a power of 10 adda 3,x sta FPA0+3 lda FPA0+2 adca 2,x sta FPA0+2 lda FPA0+1 adca 1,x sta FPA0+1 lda FPA0 adca ,x sta FPA0 incb ; add one to digit counter rorb ; set V if carry and sign differ rolb bvc L9213 ; brif we haven't "wrapped" bcc L9235 ; brif subtracting subb #10+1 ; take 9's complement if adding negb L9235 addb #'0-1 ; add in ASCII bias leax 4,x ; move to next power tfr b,a ; save digit anda #0x7f ; mask off subtract flag sta ,u+ ; save digit comb ; toggle add/subtract andb #0x80 cmpx #LBEE9 ; done all places? bne L9211 ; brif not clr ,u ; but NUL at end L9249 dec V45 ; at decimal? bne L9256 ; brif not L924D stu VARPTR ; save decimal point pointer lda #'. ; insert decimal sta ,u+ clr VD7 ; clear comma counter rts L9256 dec VD7 ; do we need a comma? bne L9262 ; brif not lda #3 ; reset comma counter sta VD7 lda #', ; insert comma sta ,u+ L9262 rts L9263 lda V47 ; get base 10 exponent offset adda #10 ; account for significant figures sta V45 ; save decimal counter inca ; add one for decimal point L926A suba #3 ; divide by 3, leave remainder in A bcc L926A adda #5 ; renormalize to range 1-3 sta VD7 ; save comma counter lda VDA ; get status anda #0x40 ; commas wanted? bne L927A ; brif not sta VD7 ; clear comma counter L927A rts L927B pshs a ; save zeroes counter bsr L9249 ; check for decimal puls a ; get back counter L9281 deca ; need a zero? bmi L928E ; brif not pshs a ; save counter lda #'0 ; put a zero sta ,u+ lda ,s+ ; get back counter and set flags bne L927B ; brif not done enough L928E rts ; From here to the end of the Extended Basic ROM is the PMODE graphics system and related ; infrastructure with the exception of the PLAY command which shares some of its machinery ; with the DRAW command. ; ; Fetch screen address calculation routine address for the selected graphics mode L928F ldu #L929C ; point to normalization routine jump table lda PMODE ; get graphics mode asla ; two bytes per address ldu a,u ; get routine address rts ; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A. L9298 bsr L928F ; fetch normalization routine pointer jmp ,u ; transfer control to it L929C fdb L92A6 ; PMODE 0 fdb L92C2 ; PMODE 1 fdb L92A6 ; PMODE 2 fdb L92C2 ; PMODE 3 fdb L92A6 ; PMODE 4 ; Two colour mode address calculatoin L92A6 pshs u,b ; savce registers ldb HORBYT ; get number of bytes in each graphics row lda VERBEG+1 ; get vertical coordinate mul addd BEGGRP ; now D is the absolute address of the start of the row tfr d,x ; get address to the return location ldb HORBEG+1 ; get horizontal coordinate lsrb ; divide by 8 (8 pixels per byte in 2 colour mode) lsrb lsrb abx ; now X is the address of the actual pixel byte lda HORBEG+1 ; get horizontal coordinate anda #7 ; keep only the low 3 bits which contain the pixel number ldu #L92DD ; point to pixel mask lookup lda a,u ; get pixel mask puls b,u,pc ; restore registers and return result ; four colour address calculation L92C2 pshs u,b ; save registers ldb HORBYT ; get bytes per graphics row lda VERBEG+1 ; get vertical coordinate mul addd BEGGRP ; now D is the address of the start of the row tfr d,x ; put it in returnlocatin ldb HORBEG+1 ; get horizontal coordinate lsrb ; divide by 4 (four colour modes have four pixels per byte) lsrb abx ; now X points to the screen byte lda HORBEG+1 ; get horizontal coordinate anda #3 ; keep low two bits for pixel number ldu #L92E5 ; point to four colour pixel masks lda a,u ; get pixel mask puls b,u,pc ; restore registers and return result L92DD fcb 0x80,0x40,0x20,0x10 ; two colour pixel masks fcb 0x08,0x04,0x02,0x01 L92E5 fcb 0xc0,0x30,0x0c,0x03 ; four colour pixel masks ; Move X down one graphics row L92E9 ldb HORBYT ; get bytes per row abx ; add to screen address rts ; Move one pixel right in 2 colour mode L92ED lsra ; move pixel mask right bcc L92F3 ; brif same byte rora ; move pixel mask to left of byte leax 1,x ; move to next byte L92F3 rts ; Move one pixel right in 4 colour mode L92F4 lsra ; shift mask half a pixel right bcc L92ED ; brif not past end of byte - shift one more lda #0xc0 ; set mask on left of byte leax 1,x ; move to next byte rts ; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG. L92FC jsr LB734 ; evaluate two expressions - first in BINVAL, second in B ldy #HORBEG ; point to storage location L9303 cmpb #192 ; is vertical outside range? blo L9309 ; brif not ldb #191 ; max it at bottom of screen L9309 clra ; zero extend vertical coordinate std 2,y ; save vertical coordinate ldd BINVAL ; get horizontal coordinate cmpd #256 ; in range? blo L9317 ; brif so ldd #255 ; max it out to right side of screen L9317 std ,y ; save horizontal coordinate rts ; Normalize coordinates for proper PMODE L931A jsr L92FC ; parse coordinates L931D ldu #HORBEG ; point to start coordinates L9320 lda PMODE ; get graphics mode cmpa #2 ; is it pmode 0 or 1? bhs L932C ; brif not ldd 2,u ; get vertical coordinate lsra ; divide it by two rorb std 2,u ; save it back L932C lda PMODE ; get graphics mode cmpa #4 ; pmode 4? bhs L9338 ; brif so ldd ,u ; cut horizontal coordinate in half lsra rorb std ,u ; save new coordinate L9338 rts ; PPOINT function PPOINT jsr L93B2 ; evaluate two expressions (coordinates) jsr L931D ; normalize coordinates jsr L9298 ; get screen address anda ,x ; get colour value of desired screen coordinate ldb PMODE ; get graphics mode rorb ; is it a two colour m ode? bcc L935B ; brif so L9349 cmpa #4 ; is it on rightmost bits? blo L9351 ; brif not rora ; shift right rora bra L9349 ; see if we're there yet L9351 inca ; colour numbers start at 1 asla ; add in colour set (0 or 8) adda CSSVAL lsra ; get colour in range of 0 to 8 L9356 tfr a,b ; put result to B jmp LB4F3 ; return B as FP number L935B tsta ; is pixel on? beq L9356 ; brif not, return 0 (off) clra ; set colour number to "1" bra L9351 ; make it 1 or 5 and return ; PSET command PSET lda #1 ; PSET flag bra L9366 ; go turn on the pixel ; PRESET command PRESET clra ; PRESET flag L9366 sta SETFLG ; store whether we're setting or resetting jsr LB26A ; enforce ( jsr L931A ; evaluate coordinates jsr L9581 ; evaluate colour jsr LB267 ; enforce ) jsr L9298 ; get address of pixel L9377 ldb ,x ; get screen data pshs b ; save it tfr a,b ; duplicate pixel mask coma ; invert mask anda ,x ; turn off screen pixel andb ALLCOL ; adjust pixel mask to be the current colour pshs b ; merge pixel data into the screen data ora ,s+ sta ,x ; put it on screen suba ,s+ ; nonzero if screen data changed ora CHGFLG ; propagate change flag sta CHGFLG rts ; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and ; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF. L938F ldx HORDEF ; set default start coords stx HORBEG ldx VERDEF stx VERBEG cmpa #0xac ; do we start with a -? beq L939E ; brif no starting coordinates jsr L93B2 ; parse coordinates L939E ldb #0xac ; make sure we have a - jsr LB26F jsr LB26A ; require a ( jsr LB734 ; evaluate two expressions ldy #HOREND ; point to storage location jsr L9303 ; process coordinates bra L93B8 ; finish up with a ) L93B2 jsr LB26A ; make sure there's a ( jsr L92FC ; evaluate coordinates L93B8 jmp LB267 ; force a ) ; LINE command LINE cmpa #0x89 ; is it LINE INPUT? lbeq L89C0 ; brif so - go handle it cmpa #'( ; starting coord? beq L93CE ; brif so cmpa #0xac ; leading -? beq L93CE ; brif so ldb #'@ ; if it isn't the above, make sure it's @ jsr LB26F L93CE jsr L938F ; parse coordinates ldx HOREND ; set ending coordinates as the defaults stx HORDEF ldx VEREND stx VERDEF jsr SYNCOMMA ; make sure we have a comma cmpa #0xbe ; PRESET? beq L93E9 ; brif so cmpa #0xbd ; PSET? lbne LB277 ; brif not ldb #01 ; PSET flag skip1lda ; skip byte and set A nonzero L93E9 clrb ; PRESET flag pshs b ; save PSET/PRESET flag jsr GETNCH ; eat the PSET/PRESET jsr L9420 ; normalize coordinates puls b ; get back PSET/PRESET flag stb SETFLG ; flag which we're doing jsr L959A ; set colour byte jsr GETCCH ; get next bit lbeq L94A1 ; brif no box option jsr SYNCOMMA ; make sure it's comma ldb #'B ; make sure "B" for "box" jsr LB26F bne L9429 ; brif something follows the B bsr L9444 ; draw horizontal line bsr L946E ; draw vertical line ldx HORBEG ; save horizontal coordinate pshs x ; save it ldx HOREND ; switch in horizontal end stx HORBEG bsr L946E ; draw vertical line puls x ; get back original start stx HORBEG ; put it back ldx VEREND ; do the same dance with the vertical end stx VERBEG bra L9444 ; draw horizontal line L9420 jsr L931D ; normalize the start coordinates ldu #HOREND ; point to end coords jmp L9320 ; normalize those coordinates L9429 ldb #'F ; make sure we have "BF" for "filled box" jsr LB26F bra L9434 ; fill the box L9430 leax -1,x ; move vertical coordinate up one L9432 stx VERBEG ; save new vertical coordinate L9434 jsr L9444 ; draw a horizontal line ldx VERBEG ; are we at the end of the box? cmpx VEREND beq L9443 ; brif so bcc L9430 ; brif we're moving up the screen leax 1,x ; move down the screen bra L9432 ; go draw another line L9443 rts ; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL L9444 ldx HORBEG ; get starting horizontal coordinate pshs x ; save it jsr L971D ; get absolute value of HOREND-HORBEG bcc L9451 ; brif end is > start ldx HOREND ; copy end coordinate to start it is smaller stx HORBEG L9451 tfr d,y ; save difference - it's a pixel count leay 1,y ; coordinates are inclusive jsr L9298 ; get screen position of start coord puls u ; restore original start coordinate stu HORBEG bsr L9494 ; point to routine to move pizel pointers to right L945E sta VD7 ; save pixel mask jsr L9377 ; turn on pixel lda VD7 ; get pixel mask back jsr ,u ; move one pixel right leay -1,y ; turned on enough pixels yet? bne L945E ; brif not L946B rts L946C puls b,a ; clean up stack L946E ldd VERBEG ; save original vertical start coordinate pshs b,a jsr L9710 ; get vertical difference bcc L947B ; brif end coordinate > start ldx VEREND ; swap in end coordinate if not stx VERBEG L947B tfr d,y ; save number of pixels to set leay 1,y ; the coordinates are inclusive jsr L9298 ; get screen pointer puls u ; restore start coordinate stu VERBEG bsr L949D ; point to routine to move down one row bra L945E ; draw vertical line ; Point to routine which will move one pixel right L948A fdb L92ED ; PMODE 0 fdb L92F4 ; PMODE 1 fdb L92ED ; PMODE 2 fdb L92F4 ; PMODE 3 fdb L92ED ; PMODE 4 L9494 ldu #L948A ; point to jump table ldb PMODE ; get graphics mode aslb ; two bytes per address ldu b,u ; get jump address rts ; Point to routine to move down one row L949D ldu #L92E9 ; point to "move down one row" routien rts ; Draw a line from HORBEG,VERBEG to HOREND,VEREND L94A1 ldy #L950D ; point to increase vertical coord jsr L9710 ; calculate difference lbeq L9444 ; brif none - draw a horizontal line bcc L94B2 ; brif vertical end is > vertical start ldy #L951B ; point to decrease vertical coord L94B2 pshs d ; save vertical difference ldu #L9506 ; point to increase horizontal coord jsr L971D ; get difference beq L946C ; brif none - draw a vertical line bcc L94C1 ; brif horizontal end > horizontal start ldu #L9514 ; point to decrease hoizontal coord L94C1 cmpd ,s ; compare vert and horiz differences puls x ; get X difference bcc L94CC ; brif horiz diff > vert diff exg u,y ; swap change routine pointers exg d,x ; swap differences L94CC pshs u,d ; save larger difference and routine pshs d ; save larger difference lsra ; divide by two rorb bcs L94DD ; brif odd number cmpu #L950D+1 ; increase or decrease? blo L94DD ; brif increase subd #1 ; back up one L94DD pshs x,b,a ; save smallest difference and initial middle offset jsr L928F ; point to proper coordinate to screen conversion routine L94E2 jsr ,u ; convert coordinates to screen address jsr L9377 ; turn on a pixel ldx 6,s ; get distnace counter beq L9502 ; brif line is completely drawn leax -1,x ; account for one pixel drawn stx 6,s ; save new counter jsr [8,s] ; increment/decrement larger delta ldd ,s ; get the minor coordinate increment counter addd 2,s ; add the smallest difference std ,s ; save new minor coordinate incrementcounter subd 4,s ; subtractout the largest difference bcs L94E2 ; brif not greater - draw another pixel std ,s ; save new minor coordinate increment jsr ,y ; adjust minor coordinate bra L94E2 ; go draw another pixel L9502 puls x ; clean up stack and return puls a,b,x,y,u,pc L9506 ldx HORBEG ; bump horizontal coordinate leax 1,x stx HORBEG rts L950D ldx VERBEG ; bump vertical coordinate leax 1,x stx VERBEG rts L9514 ldx HORBEG ; decrement horizontal coordinate leax -1,x stx HORBEG rts L951B ldx VERBEG ; decrement vertical coordinate leax -1,x stx VERBEG rts ; Get normalized maximum coordinate values in VD3 and VD5 L9522 ldu #VD3 ; point to temp storage ldx #255 ; set maximum horizontal stx ,u ldx #191 ; set maximum vertical stx 2,u jmp L9320 ; normalize them ; PCLS command PCLS beq L9542 ; clear to background colour if no argument bsr L955A ; evaluate colour L9536 lda #0x55 ; consider each byte as 4 groups of 2 bit sub-nibbles mul ; now colour is in all four sub-pixels ldx BEGGRP ; get start of graphics screen L953B stb ,x+ ; set byte to proper colour cmpx ENDGRP ; at end of graphics page? bne L953B ; brif not rts L9542 ldb BAKCOL ; get background colour bra L9536 ; do the clearing dance ; COLOR command COLOR cmpa #', ; check for comma beq L9552 ; brif no foreground colour bsr L955A ; evaluate first colour stb FORCOL ; set foreground colour jsr GETCCH ; is there a background colour? beq L9559 ; brif not L9552 jsr SYNCOMMA ; make sure we have a comma bsr L955A ; evaluate background colour argument stb BAKCOL ; set background colour L9559 rts ; Evaluate a colour agument and convert to proper code based on graphics mode L955A jsr EVALEXPB ; evaluate colour code L955D cmpb #9 ; is it in range of 0-8? lbhs LB44A ; brif not - raise error clra ; CSS value for first colour set cmpb #5 ; is it first or second colour set? blo L956C ; brif first colour set lda #8 ; flag second colour set subb #4 ; adjust into basic range L956C pshs a ; save CSS value lda PMODE ; get graphics mode rora ; 4 colour or 2? bcc L957B ; brif 2 colour tstb ; was it 0? bne L9578 ; brif not L9576 ldb #4 ; if so, make it 4 L9578 decb ; convert to zero based L9579 puls a,pc ; get back CSS value and return L957B rorb ; is colour number odd? bcs L9576 ; brif so - force all bits set colour clrb ; force colour 0 if not bra L9579 ; Set all pixel byte and active colour L9581 jsr L959A ; set colour byte jsr GETCCH ; is there something to evaluate? beq L9598 ; brif not cmpa #') ; )? beq L9598 ; brif so jsr SYNCOMMA ; force comma cmpa #', ; another comma? beq L9598 ; brif so jsr L955A ; evaluate expression and return colour bsr L95A2 ; save colour and pixel byte L9598 jmp GETCCH ; re-fetch input character and return L959A ldb FORCOL ; use foreground colour by default tst SETFLG ; doing PRESET? bne L95A2 ; brif not ldb BAKCOL ; default to background colour L95A2 stb WCOLOR ; save working colour lda #0x55 ; consider a byte as 4 pixels mul ; now all pixels are set to the same bit pattern stb ALLCOL ; set all pixels byte rts L95AA bne L95CF ; brif graphics mode L95AC pshs x,b,a ; save registers ldx #SAMREG+8 ; point to middle of control register sta 10,x ; reset display page to 0x400 sta 8,x sta 6,x sta 4,x sta 2,x sta 1,x sta -2,x sta -4,x ; reset to alpha mode sta -6,x sta -8,x lda PIA1+2 ; set VDG to alpha mode, colour set 0 anda #7 sta PIA1+2 puls a,b,x,pc ;restore registers and return L95CF pshs x,b,a ; save registers lda PMODE ; get graphics mode adda #3 ; offset to 3-7 (we don't use the bottom 3 modes) ldb #0x10 ; shift to high 4 bits mul orb #0x80 ; set to graphics mode orb CSSVAL ; set the desired colour set lda PIA1+2 ; get get original PIA values anda #7 ; mask off VDG control pshs a ; merge with new VDG control orb ,s+ stb PIA1+2 ; set new VDG mode lda BEGGRP ; get start of graphics page lsra ; divide by two - pages are on 512 byte boundaries jsr L960F ; set SAM control register lda PMODE ; get graphics mode adda #3 ; shift to VDG values cmpa #7 ; PMODE 4? bne L95F7 ; brif not deca ; treat PMODE 4 the same as PMODE 3 L95F7 bsr L95FB ; program SAM's VDG bits puls a,b,x,pc ; restore registers and return L95FB ldb #3 ; set 3 bits in register ldx #SAMREG ; point to VDG control bits L9600 rora ; get bit to set bcc L9607 ; brif we need to clear the bit sta 1,x ; set the bit bra L9609 L9607 sta ,x ; clear the bit L9609 leax 2,x ; move to next bit decb ; done all bits? bne L9600 ; brif not rts L960F ldb #7 ; 7 screen address bits ldx #SAMREG+6 ; point to screen address bits in SAM bra L9600 ; go program SAM bits L9616 lda PIA1+2 ; get VDG bits anda #0xf7 ; keep everything but CSS bit ora CSSVAL ; set correct CSS bit sta PIA1+2 ; set desired CSS rts ; PMODE command PMODETOK cmpa #', ; is first argument missing? beq L9650 ; brif so jsr EVALEXPB ; evaluate PMODE number cmpb #5 ; valid (0-4)? bhs L966D ; brif not lda GRPRAM ; get start of graphics memory L962E sta BEGGRP ; set start of graphics page aslb ; multiply mode by two (table has two bytes per entry) ldu #L9706+1 ; point to lookup table adda b,u ; add in number of 256 byte pages used for graphics screen cmpa TXTTAB ; does it fit? bhi L966D ; brif not sta ENDGRP ; save end of graphics leau -1,u ; point to bytes per horizontal row lda b,u ; get bytes per row sta HORBYT ; set it lsrb ; restore PMODE value stb PMODE ; set graphics mode clra ; set background colour to 0 sta BAKCOL lda #3 ; set foreground colour to maximum (3) sta FORCOL jsr GETCCH ; is there a starting page number? beq L966C ; brif not L9650 jsr LB738 ; evaluate an expression following a comma tstb ; page 0? beq L966D ; brif so - not valid decb ; zero-base it lda #6 ; each graphics page is 6*256 mul addb GRPRAM ; add to start of graphics memory pshs b ; save start of screen memory addb ENDGRP ; add current and address subb BEGGRP ; subtract current start (adds size of screen) cmpb TXTTAB ; does it fit? bhi L966D ; brif not stb ENDGRP ; save new end of graphics puls b ; get back start of graphics stb BEGGRP ; set start of graphics L966C rts L966D jmp LB44A ; raise FC error ; SCREEN command SCREEN cmpa #', ; is there a mode? beq L967F ; brif no mode jsr EVALEXPB ; get mode argument tstb ; set Z if alpha jsr L95AA ; set SAM/VDG for graphics mode jsr GETCCH ; is there a second argument? beq L966C ; brif not L967F jsr LB738 ; evaluate ,<expr> tstb ; colour set 0? beq L9687 ; brif so ldb #8 ; flag for colour set 1 L9687 stb CSSVAL ; set colour set bra L9616 ; set up VDG ; PCLEAR command PCLEAR jsr EVALEXPB ; evaulate number of pages requested tstb ; 0? beq L966D ; brif zero - not allowed cmpb #9 ; more than 8? bhs L966D ; brif so - not allowed lda #6 ; there are 6 "pages" per graphics page mul ; now B is the number of pages to reserve addb GRPRAM ; add to start of graphics memory tfr b,a ; now A is the MSB of the start of free memory ldb #1 ; program memory always starts one above tfr d,y ; save pointer to program memory cmpd ENDGRP ; are we trying to deallocate the current graphics page? blo L966D ; brif so (note that this prevents PCLEAR 0 anyway) subd TXTTAB ; subtract out current start of basic program addd VARTAB ; add in end of program - now D is new top of program tfr d,x ; save new end of program inca ; make some extra space (for stack) subd FRETOP ; see if new top of program fits bhs L966D ; brif there isn't enough space jsr L80D0 ; adjust input pointer nop ; space filler for 1.1 patch (the JSR above) ldu VARTAB ; get end of program stx VARTAB ; save new end of program cmpu VARTAB ; is old end higher? bhs L96D4 ; brif so L96BD lda ,-u ; copy a byte upward sta ,-x cmpu TXTTAB ; at beginning? bne L96BD ; brif not sty TXTTAB ; save new start of program clr -1,y ; there must always be a NUL before the program L96CB jsr LACEF ; re-assign basic program addresses jsr LAD26 ; reset variables and stack jmp LAD9E ; return to interpretation loop L96D4 ldu TXTTAB ; get start of program sty TXTTAB ; save new start of program clr -1,y ; there must be a NUL at the start of the program L96DB lda ,u+ ; move a byte downward sta ,y+ cmpy VARTAB ; at the top of the program? bne L96DB ; brif not bra L96CB ; finish up ; Graphics initialization routine - this really should be up at the start of the ROM with the ; rest of the initialization code. L96E6 ldb #0x1e ; set start of program to 0x1e00 ("PCLEAR 4") stb TXTTAB lda #6 ; graphics memory starts immediately after the screen L96EC sta GRPRAM ; set graphics memory start sta BEGGRP ; set start of current graphics page clra ; set PMODE to 0 sta PMODE lda #16 ; 16 bytes per graphics row sta HORBYT lda #3 ; set foreground colour to 3 sta FORCOL lda #0x0c ; set ending graphics page (for PMODE 0) sta ENDGRP ldx TXTTAB ; get start of program clr -1,x ; make sure there's a NUL before it L9703 jmp LAD19 ; do a "NEW" ; PMODE data table (bytes per row and number of 256 byte pages required for a screen) L9706 fcb 16,6 ; PMODE 0 fcb 32,12 ; PMODE 1 fcb 16,12 ; PMODE 2 fcb 32,24 ; PMODE 3 fcb 32,24 ; PMODE 4 ; Calculate absolute value of vertical coordinate difference L9710 ldd VEREND ; get ending address subd VERBEG ; get difference L9714 bcc L9751 ; brif we didn't carry pshs cc ; save status (C set if start > end) jsr L9DC3 ; negate the difference to be positive puls cc,pc ; restore C and return ; Calculate absolute value of horizontal coordinate difference L971D ldd HOREND ; get end coordinate subd HORBEG ; calculate difference bra L9714 ; turn into absolute value ; PCOPY command PCOPY bsr L973F ; fetch address of the source page pshs d ; save address ldb #0xa5 ; make sure we have TO jsr LB26F bsr L973F ; fetch address of the second page puls x ; get back source tfr d,u ; put destination into a pointer ldy #0x300 ; 0x300 words to copy L9736 ldd ,x++ ; copy a word std ,u++ leay -1,y ; done? bne L9736 ; brif not rts L973F jsr EVALEXPB ; evaluate page number tstb ; zero? beq L9752 ; brif invalid page number ; BUG: this should be deferred until after the address is calculated at which point it should ; be bhs instead of bhi. There should also be a check to make sure the page number is less than ; or equal to 8 above so we don't have to test for overflows below. cmpb TXTTAB ; is page number higher than start of program (BUG!) bhi L9752 ; brif so - error decb ; zero-base the page number lda #6 ; 6 "pages" per graphics page mul ; now we have proper number of "pages" for the offset addb GRPRAM ; add start of graphics memory exg a,b ; put MSB into A, 0 into B. L9751 rts L9752 jmp LB44A ; raise illegal function call ; GET command GET clrb ; GET flag bra L975A ; go on to the main body PUT ldb #1 ; PUT flag L975A stb VD8 ; save GET/PUT flag jsr RVEC22 ; do the RAM hook dance (so Disk Basic can do its thing) L975F cmpa #'@ ; @ before coordinates? bne L9765 ; brif not jsr GETNCH ; eat the @ L9765 jsr L938F ; evaluate start/end coordinates jsr SYNCOMMA ; make sure we have a comma jsr L98CC ; get pointer to array tfr X,D ; save descriptor pointer ldu ,x ; get offset to next descriptor leau -2,u ; move back to array name leau d,u ; point to end of array stu VD1 ; save end of data leax 2,x ; point to number of dimensions ldb ,x ; get dimension count aslb ; two bytes per dimension size abx ; now X points to start of data stx VCF ; save start of array data lda VALTYP ; is it numeric bne L9752 ; brif not clr VD4 ; set default graphic action to PSET jsr GETCCH ; get input character beq L97B7 ; brif no action flag com VD4 ; flag action enabled jsr SYNCOMMA ; make sure there's a comma tst VD8 ; PUT? bne L979A ; brif so ldb #'G ; check for full graphics option jsr LB26F bra L97CA ; handle the rest of the process L979A ldb #5 ; 5 legal actions for PUT ldx #L9839 ; point to action table L979F ldu ,x++ ; get "clear bit" action routine ldy ,x++ ; get "set bit" action routine cmpa ,x+ ; does token match? beq L97AE ; brif so decb ; checked all? bne L979F ; brif not jmp LB277 ; raise error L97AE sty VD5 ; save set bit action address stu VD9 ; save clear bit action address jsr GETNCH ; munch the acton token bra L97CA ; handle rest of process L97B7 ldb #0xf8 ; mask for bottom three bits lda PMODE ; get graphics mode rora ; odd number mode? bcc L97C0 ; brif even ldb #0xfc ; bottom 2 bits mask L97C0 tfr b,a ; save mask andb HORBEG+1 ; round down the start address stb HORBEG+1 anda HOREND+1 ; round down end address sta HOREND+1 L97CA jsr L971D ; get horizontal size bcc L97D3 ; brif end > start ldx HOREND ; switch end in for start stx HORBEG L97D3 std HOREND ; save size jsr L9710 ; calculate vertical size bcc L97DE ; brif end > start ldx VEREND ; swap in vertical end for the start stx VERBEG L97DE std VEREND ; save vertical size lda PMODE ; get graphics mode rora ; even? ldd HOREND ; get difference bcc L97EB ; brif even (2 colour) addd HOREND ; add in size (double it) std HOREND ; save adjusted end size L97EB jsr L9420 ; normalize differences ldd HOREND ; get end coord ldx VEREND ; get end size leax 1,x ; make vertical size inclusive stx VEREND ; save it back tst VD4 ; got "G" or GET action bne L9852 ; brif given lsra ; we're going for whole bytes here rorb lsra rorb lsra rorb addd #1 ; make it inclusive std HOREND ; save new coordinate jsr L9298 ; convert to screen address L9808 ldb HOREND+1 ; get horizontal size pshs x ; save screen position L980C tst VD8 ; get/put flag beq L9831 ; brif get bsr L9823 ; bump array data pointer lda ,u ; copy data from array to screen sta ,x+ L9816 decb ; are we done the row? bne L980C ; brif not puls x ; get screen address jsr L92E9 ; move to next row dec VEREND+1 ; done? bne L9808 ; brif not L9822 rts L9823 ldu VCF ; get array data location leau 1,u ; bump it stu VCF ; save new array data location cmpu VD1 ; did we hit the end of the array? bne L9822 ; brif not L982E jmp LB44A ; raise function call error L9831 lda ,x+ ; get data from screen bsr L9823 ; bump array data pointer sta ,u ; put data in array bra L9816 ; do the loopy thing ; PUT actions L9839 fdb L9894,L989B ; PSET fcb 0xbd fdb L989B,L9894 ; PRESET fcb 0xbe fdb L98B1,L989B ; OR fcb 0xb1 fdb L9894,L98B1 ; AND fcb 0xb0 fdb L98A1,L98A1 ; NOT fcb 0xa8 L9852 addd #1 ; add to horiz difference std HOREND ; save it lda VD8 ; PUT? bne L9864 ; brif so ldu VD1 ; get end of array L985D sta ,-u ; zero out a byte cmpu VCF ; done? bhi L985D ; brif not L9864 jsr L9298 ; get screen address ldb PMODE ; get graphics mode rorb ; even? bcc L986E ; brif so anda #0xaa ; use as pixel mask for 4 colour mode L986E ldb #1 ; set bit probe ldy VCF ; point to start of array data L9873 pshs x,a ; save screen address ldu HOREND ; get horizontal size L9877 pshs u,a ; save horizontal size and pixel mask lsrb ; move bit probe right bcc L9884 ; brif we didn't fall off a byte rorb ; shift carry back in on the left leay 1,y ; move ahead a byte in the array cmpy VD1 ; end of array data? beq L982E ; raise error if so L9884 tst VD8 ; PUT? beq L98A7 ; brif not bitb ,y ; test bit in array beq L9890 ; brif not set jmp [VD5] ; do action routine for bit set L9890 jmp [VD9] ; do action routine for bit clear L9894 coma ; invert mask anda ,x ; read screen data and reset the desired bit sta ,x ; save on screen bra L98B1 L989B ora ,x ; merge pixel mask with screen data (turn on bit) sta ,x ; save on screen bra L98B1 L98A1 eora ,x ; invert the pixel in the screen data sta ,x ; save on screen bra L98B1 L98A7 bita ,x ; is the bit set? beq L98B1 ; brif not - do nothing tfr b,a ; get bit probe ora ,y ; turn on proper bit in data sta ,y L98B1 puls a,u ; get back array address jsr L92ED ; move screen address to the right leau -1,u ; account for consumed pixel cmpu ZERO ; done yet? bne L9877 ; brif not ldx 1,s ; get start of row back lda HORBYT ; get number of bytes per row leax a,x ; move ahead one line puls a ; get back screen pixel mask leas 2,s ; lose the screen pointer dec VEREND+1 ; done all rows? bne L9873 ; brif not rts L98CC jsr LB357 ; evaluate a variable ldb ,-x ; get variable name lda ,-x tfr d,u ; save it ldx ARYTAB ; get start of arrays L98D7 cmpx ARYEND ; end of arrays? lbeq LB44A ; brif not found cmpu ,x ; correct variable? beq L98E8 ; brif so ldd 2,x ; get array size leax d,x ; move to next array bra L98D7 ; check this array L98E8 leax 2,x ; move pointer to the array header rts ; obviously this rts is not needed L98EB rts ; PAINT command PAINT cmpa #'@ ; do we have @ before coords? bne L98F2 ; brif not jsr GETNCH ; eat the @ L98F2 jsr L93B2 ; evaluate coordinates jsr L931D ; normalize coordinates lda #1 ; PSET flag (use working colour) sta SETFLG jsr L9581 ; parse colour and set working colour, etc. ldd WCOLOR ; get working colour and all pixels byte pshs d ; save them jsr GETCCH ; is there anything else? beq L990A ; brif not jsr L9581 ; evaluate border colour L990A lda ALLCOL ; get border colour all pixel byte sta VD8 ; save border colour pixel byte puls d ; get back working colour details std WCOLOR clra ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding pshs u,x,b,a jsr L9522 ; set up starting coordinates jsr L928F ; point to pixel mask routine stu VD9 ; save pixel mask routine jsr L99DF ; paint from current horizontal coordinate to zero (left) beq L9931 ; brif hit border immediately jsr L99CB ; paint from current horizontal coordinate upward (right) lda #1 ; set direction to "down" sta VD7 jsr L99BA ; save "down" frame neg VD7 ; set direction to "up" jsr L99BA ; save "up" frame L9931 sts TMPSTK ; save stack pointer L9934 tst CHGFLG ; did the paint change anything? bne L993B ; brif so lds TMPSTK ; get back stack pointer L993B puls a,b,x,u ; get frame from stack clr CHGFLG ; mark nothing changed sts TMPSTK ; save stack pointer leax 1,x ; move start coordinate right stx HORBEG ; save new coordinate stu VD1 ; save length of line sta VD7 ; save up/down flag beq L98EB ; did we hit the "stop" frame? bmi L9954 ; brif negative going (up)? incb ; bump vertical coordinate cmpb VD6 ; at end? bls L9958 ; brif not clrb ; set vertical to 0 (wrap around) L9954 tstb ; did we wrap? beq L9934 ; do another block if so decb ; move up a row L9958 stb VERBEG+1 ; save vertical coordinate jsr L99DF ; paint from horizontal to 0 beq L996E ; brif we hit the border immediately cmpd #3 ; less than 3 pixels? blo L9969 ; brif so leax -2,x ; move two pixels left bsr L99A1 ; save paint block on the stack L9969 jsr L99CB ; continue painting to the right L996C bsr L99BA ; save paint data frame L996E coma ; complement length of line just painted and add to length of line comb L9970 addd VD1 ; save difference between this line and parent line std VD1 ble L998C ; brif parent line is shorter jsr L9506 ; bump horizontal coordinate jsr L9A12 ; see if we bounced into the border bne L9983 ; brif not border ldd #-1 ; move left bra L9970 ; keep looking L9983 jsr L9514 ; move horizontally left bsr L99C6 ; save horizontal coordinate bsr L99E8 ; paint right bra L996C ; save paint block and do more L998C jsr L9506 ; bump horizontal coordinate leax d,x ; point to right end of parent line stx HORBEG ; set as curent coordinate coma ; get amount we extend past parent line comb subd #1 ble L999E ; brif doesn't extend tfr d,x ; save length of line bsr L99A1 ; save paint frame L999E jmp L9934 L99A1 std VCB ; save number of pixels painted puls y ; get return address ldd HORBEG ; get horizontal coordinate pshs x,b,a ; save horizontal coordinate and pointer lda VD7 ; get up/down flag nega ; reverse it L99AC ldb VERBEG+1 ; get vertical coordainte pshs b,a ; save vertical coord and up/down flag pshs y ; put return address back ldb #2 ; make sure we haven't overflowed memory jsr LAC33 ldd VCB ; get line length back rts L99BA std VCB ; save length of painted line puls y ; get return address ldd HOREND ; get start coord pshs x,b,a ; save horizontal start and length lda VD7 ; get up/down flag bra L99AC ; finish up with the stack L99C6 ldx HORBEG ; save current horizontal coord and save it stx HOREND rts L99CB std VCD ; save number of pixels painted ldy HOREND ; get last horizontal start bsr L99C6 ; save current coordinate sty HORBEG ; save coordinate bsr L99E8 ; paint a line ldx VCD ; get number painted leax d,x ; add to the number painted going the other way addd #1 ; now D is length of line rts L99DF jsr L99C6 ; put starting coordinate in end ldy #L9514 ; decrement horizontal coordinate address bra L99EE ; go paint line L99E8 ldy #L9506 ; increment horizontal coordinate address jsr ,y ; bump coordinate L99EE ldu ZERO ; initialize pixel count ldx HORBEG ; get starting coordinate L99F2 bmi L9A0B ; brif out of range for hoizontal coordinate cmpx VD3 ; at end? bhi L9A0B ; brif right of max pshs u,y ; save counter and inc/dec routine pointer bsr L9A12 ; at border? beq L9A09 ; brif so jsr L9377 ; set pixel to paint colour puls y,u ; restore counter and inc/dec/pointer leau 1,u ; bump number of painted pixels jsr ,y ; inc/dec screen address bra L99F2 ; go do another pixel L9A09 puls y,u ; get back counter and inc/dec routine L9A0B tfr u,d ; save count in D tfr d,x ; and in X subd ZERO ; set flags on D (smaller/faster than cmpd ZERO) rts L9A12 jsr [VD9] ; get the screen address tfr a,b ; save pixel mask andb VD8 ; set pixel to border colour pshs b,a ; save mask and border anda ,x ; mask current pixel into A cmpa 1,s ; does it match border? Z=1 if so puls a,b,pc ; restore mask, border pixel, and return ; PLAY command ; This is here mixed in with the graphics package because it shares some machinery with DRAW. PLAY ldx ZERO ; default values for note length, etc. ldb #1 pshs x,b ; save default values jsr LB156 ; evaluate argument clrb ; enable DA and sound output jsr LA9A2 jsr LA976 L9A32 jsr LB654 ; fetch PLAY string details bra L9A39 ; go evaluate the string L9A37 puls b,x ; get back play string details L9A39 stb VD8 ; save length of string beq L9A37 ; brif end of string stx VD9 ; save start of string lbeq LA974 ; brif NULL string - disable sound and return L9A43 tst VD8 ; have anything left? beq L9A37 ; brif not jsr L9B98 ; get command character cmpa #'; ; command separator? beq L9A43 ; brif so - ignore it cmpa #'' ; '? beq L9A43 ; brif so - ignore it cmpa #'X ; execuate sub string? lbeq L9C0A ; brif so - handle it bsr L9A5C ; handle other commands bra L9A43 ; look for more stuff L9A5C cmpa #'O ; octave? bne L9A6D ; brif not ldb OCTAVE ; get current octave incb ; 1-base it bsr L9AC0 ; get value if present decb ; zero-base it cmpb #4 ; valid octave? bhi L9ACD ; raise error if not stb OCTAVE ; save new octave rts L9A6D cmpa #'V ; volume? bne L9A8B ; brif not ldb VOLHI ; get current high volume limit lsrb ; shift 2 bits right (DA is 6 bits in high bits) lsrb subb #31 ; subtract out mid value offset bsr L9AC0 ; read argument cmpb #31 ; maximum range is 31 bhi L9ACD ; brif out of range aslb ; adjust back in range aslb pshs b ; save new volume ldd #0x7e7e ; midrange value for both high and low adda ,s ; add new volume to high limit subb ,s+ ; subtract volume from low limit std VOLHI ; save new volume limits (sets high and low amplitudes) rts L9A8B cmpa #'L ; note length? bne L9AB2 ; brif not ldb NOTELN ; get current length bsr L9AC0 ; read parameter tstb ; resulting length 0? beq L9ACD ; brif so - problem stb NOTELN ; save new length clr DOTVAL ; reset note timer scale factor L9A9A bsr L9A9F ; check for dot bcc L9A9A ; brif there was one rts L9A9F tst VD8 ; check length beq L9AAD ; brif zero jsr L9B98 ; get command character cmpa #'. ; dot? beq L9AAF ; brif so jsr L9BE2 ; move input back and bump length L9AAD coma ; set C to indicate nothing found rts L9AAF inc DOTVAL ; bump number of dots rts L9AB2 cmpa #'T ; tempo? bne L9AC3 ; brif not ldb TEMPO ; get current tempo bsr L9AC0 ; parse tempo argument tstb ; 0? beq L9ACD ; brif so - invalid stb TEMPO ; save new tempo rts L9AC0 jmp L9BAC ; evaluate various operators L9AC3 cmpa #'P ; pause? bne L9AEB ; brif not jsr L9CCB ; evaluate parameter tstb ; is the pause number 0? bne L9AD0 ; brif not L9ACD jmp LB44A ; raise FC error L9AD0 lda DOTVAL ; save current volume and note scale ldx VOLHI pshs x,a lda #0x7e ; drop DA to mid range sta VOLHI sta VOLLOW clr DOTVAL bsr L9AE7 ; go play a "silence" puls a,x ; restore volume and note scale sta DOTVAL stx VOLHI rts L9AE7 clr ,-s ; set not number 0 bra L9B2B ; go play it L9AEB cmpa #'N ; N for "note"? bne L9AF2 ; brif not - it's optional jsr L9B98 ; skip the "N" L9AF2 cmpa #'A ; is it a valid note? blo L9AFA ; brif not cmpa #'G ; is it above the note range? bls L9AFF ; brif not - valid note L9AFA jsr L9BBE ; evaluate a number bra L9B22 ; process note value L9AFF suba #'A ; normalize note number to 0 ldx #L9C5B ; point to note number lookup table ldb a,x ; get not number tst VD8 ; any command characters left? beq L9B22 ; brif not jsr L9B98 ; get character cmpa #'# ; sharp? beq L9B15 ; brif so cmpa #'+ ; also sharp? bne L9B18 ; brif not L9B15 incb ; add one half tone bra L9B22 L9B18 cmpa #'- ; flat? bne L9B1F ; brif not decb ; subtract one half tone bra L9B22 L9B1F jsr L9BE2 ; back up command pointer L9B22 decb ; adjust note number (zero base it) cmpb #11 ; is it valid? bhi L9ACD ; raise error if not pshs b ; save note value ldb NOTELN ; get note length L9B2B lda TEMPO ; get tempo value mul ; calculate note duration std VD5 ; save duration leau 1,s ; point to where the stack goes after we're done lda OCTAVE ; get current octave cmpa #1 ; 0 or 1? bhi L9B64 ; brif not ldx #L9C62 ; point to delay table ldb #2*12 ; 24 bytes per octave mul ; now we have the base address abx ; now X points to the octave base puls b ; get back note value aslb ; two bytes per delay abx ; now we're pointing to the delay leay ,x ; save pointer to note value bsr L9B8C ; calculate note timer value std PLYTMR ; set timer for note playing (IRQ will count this down) L9B49 bsr L9B57 ; set to mid range and delay lda VOLHI ; get high value bsr L9B5A ; set to high value and delay bsr L9B57 ; set to mid range and delay lda VOLLOW ; get low value bsr L9B5A ; set to low value and delay bra L9B49 ; do it again (IRQ will break the loop) L9B57 lda #0x7e ; mid value for DA with RS232 marking nop ; a delay to fine tune frequencies L9B5A sta PIA1 ; set DA ldx ,y ; get delay value L9B5F leax -1,x ; count down bne L9B5F ; brif not done yet rts L9B64 ldx #L9C92-2*12 ; point to delay table for octaves 2+ ldb #12 ; 12 bytes per octave mul ; now we have the offset to the desired octave abx ; now we point to the start of the octave puls b ; get back note value abx ; now we point to the delay value bsr L9B8C ; calculate timer value std PLYTMR ; set play timer (IRQ counts this down) L9B72 bsr L9B80 ; send mid value and delay lda VOLHI ; get high value bsr L9B83 ; send high value and delay bsr L9B80 ; send low value and delay lda VOLLOW ; get low value bsr L9B83 ; send low value and delay bra L9B72 ; do it again (IRQ will break the loop) L9B80 lda #0x7e ; mid range value with RS232 marking nop ; fine tuning delay L9B83 sta PIA1 ; set DA lda ,x ; get delay value L9B88 deca ; count down bne L9B88 ; brif not done rts L9B8C ldb #0xff ; base timer value lda DOTVAL ; get number of dots beq L9B97 ; use default value if 0 adda #2 ; add in constant timer factor mul ; multiply scale by base lsra ; divide by two - each increment will increase note timer by 128 rorb L9B97 rts L9B98 pshs x ; save register L9B9A tst VD8 ; do we have anything left? beq L9BEB ; brif not - raise error ldx VD9 ; get parsing address lda ,x+ ; get character stx VD9 ; save pointer dec VD8 ; account for character consumed cmpa #0x20 ; space? beq L9B9A ; brif so - skip it puls x,pc ; restore register and return L9BAC bsr L9B98 ; get character cmpa #'+ ; add one? beq L9BEE ; brif so cmpa #'- ; subtract one? beq L9BF2 ; brif so cmpa #'> ; double? beq L9BFC ; brif so cmpa #'< ; halve? beq L9BF7 ; brif so L9BBE cmpa #'= ; variable equate? beq L9C01 ; brif so jsr L90AA ; clear carry if numeric bcs L9BEB ; brif not numeric clrb ; initialize value to 0 L9BC8 suba #'0 ; remove ASCII bias sta VD7 ; save digit lda #10 ; make room for digit mul tsta ; did we overflow 8 bits? bne L9BEB ; brif so addb VD7 ; add in digit bcs L9BEB ; brif that overflowed tst VD8 ; more digits? beq L9BF1 ; brif not jsr L9B98 ; get character jsr L90AA ; clear carry if numeric bcc L9BC8 ; brif another digit L9BE2 inc VD8 ; unaccount for character just read ldx VD9 ; move pointer back leax -1,x stx VD9 rts L9BEB jmp LB44A ; raise FC error L9BEE incb ; bump param beq L9BEB ; brif overflow L9BF1 rts L9BF2 tstb ; already zero? beq L9BEB ; brif so - underflow decb ; decrease parameter rts L9BF7 tstb ; already at 0? beq L9BEB ; brif so - raise error lsrb ; halve it rts L9BFC tstb ; will it overflow? bmi L9BEB ; brif so aslb ; double it rts L9C01 pshs u,y ; save registers bsr L9C1B ; interpret command string as a variable jsr LB70E ; convert it to an 8 bit number puls y,u,pc ; restore registers and return L9C0A jsr L9C1B ; evaluate expression in command string ldb #2 ; room for 4 bytes? jsr LAC33 ldb VD8 ; get the command length and pointer ldx VD9 pshs x,b ; save them jmp L9A32 ; go process the sub string L9C1B ldx VD9 ; get command pointer pshs x ; save it jsr L9B98 ; get input character jsr LB3A2 ; set carry if not alpha bcs L9BEB ; brif not a variable reference L9C27 jsr L9B98 ; get command character cmpa #'; ; semicolon? bne L9C27 ; keep scanning if not puls x ; get back start of variable string ldu CHARAD ; get current interpreter input pointer pshs u ; save it stx CHARAD ; point interpreter at command string jsr LB284 ; evaluate expression as string puls x ; restore interpeter input pointer stx CHARAD rts ; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after ; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts. L9C3E clra ; make sure DP is set to 0 tfr a,dp ldd PLYTMR ; is PLAY running? lbeq LA9BB ; brif not - transfer control on the Color Basic's routine subd VD5 ; subtract out the interval std PLYTMR ; save new timer value bhi L9C5A ; brif it isn't <= 0 clr PLYTMR ; disable the timer clr PLYTMR+1 puls a ; get saved CC lds 7,s ; set stack to saved U value anda #0x7f ; clear E flag (to return minimal state) pshs a ; set fake "FIRQ" stack frame L9C5A rti L9C5B fcb 10,12,1,3,5,6,8 ; table of half tone numbers for notes A-G L9C62 fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1 fdb 0x0150,0x013d,0x012b,0x011a fdb 0x010a,0x00fb,0x00ed,0x00df fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2 fdb 0x00a6,0x009d,0x0094,0x008b fdb 0x0083,0x007c,0x0075,0x006e L9C92 fcb 0xa6,0x9c,0x93,0x8b ; delays for octave 3 fcb 0x83,0x7b,0x74,0x6d fcb 0x67,0x61,0x5b,0x56 fcb 0x51,0x4c,0x47,0x43 ; delays for octave 4 fcb 0x3f,0x3b,0x37,0x34 fcb 0x31,0x2e,0x2b,0x28 fcb 0x26,0x23,0x21,0x1f ; delays for octave 5 fcb 0x1d,0x1b,0x19,0x18 fcb 0x16,0x14,0x13,0x12 ; DRAW command DRAW ldx ZERO ; create an empty "DRAW" frame ldb #1 pshs x,b stb SETFLG ; set to "PSET" mode stx VD5 ; clear update and draw flag jsr L959A ; set active colour byte jsr LB156 ; evaluate command string L9CC6 jsr LB654 ; fetch command string details bra L9CD3 ; interpret the command string L9CCB jsr L9B98 ; fetch command character jmp L9BBE ; evaluate a number L9CD1 puls b,x ; get previously saved command string L9CD3 stb VD8 ; save length counter beq L9CD1 ; brif end of string stx VD9 ; save pointer lbeq L9DC7 ; brif overall end of command L9CDD tst VD8 ; are we at the end of the string? beq L9CD1 ; brif so - return to previous string jsr L9B98 ; get command character cmpa #'; ; semicolon? beq L9CDD ; brif so - ignore it cmpa #'' ; '? beq L9CDD ; brif so - ignore that too cmpa #'N ; update position toggle? bne L9CF4 ; brif not com VD5 ; toggle update position flag bra L9CDD ; get on for another command L9CF4 cmpa #'B ; blank flag? bne L9CFC ; brif not com VD6 ; toggle blank flag bra L9CDD ; get on for another command L9CFC cmpa #'X ; substring? lbeq L9D98 ; brif so - execute command cmpa #'M ; move draw position? lbeq L9E32 ; brif so pshs a ; save command character ldb #1 ; default value if no number follows tst VD8 ; is there something there? beq L9D21 ; brif not jsr L9B98 ; get character jsr LB3A2 ; set C if not alpha pshs cc ; save alpha state jsr L9BE2 ; move back pointer puls cc ; get back alpha flag bcc L9D21 ; brif it's alpha bsr L9CCB ; evaluate a number L9D21 puls a ; get command back cmpa #'C ; color change? beq L9D4F ; brif so cmpa #'A ; angle? beq L9D59 ; brif so cmpa #'S ; scale? beq L9D61 ; brif so cmpa #'U ; up? beq L9D8F ; brif so cmpa #'D ; down? beq L9D8C ; brif so cmpa #'L ; left? beq L9D87 ; brif so cmpa #'R ; right? beq L9D82 ; brif so suba #'E ; normalize the half cardinals to 0 beq L9D72 ; brif E (45°) deca ; F (135°?) beq L9D6D ; brif so deca ; G (225°?) beq L9D7B ; brif so deca ; H (315°?) beq L9D69 ; brif so L9D4C jmp LB44A ; raise FC error L9D4F jsr L955D ; adjust colour for PMODE stb FORCOL ; save new foreground colour jsr L959A ; set up working colour and all pixels byte L9D57 bra L9CDD ; go process another command L9D59 cmpb #4 ; only 3 angles are valid bhs L9D4C ; brif not valid stb ANGLE ; save new angle bra L9D57 ; go process another command L9D61 cmpb #63 ; only 64 scale values are possible bhs L9D4C ; brif out of range stb SCALE ; save new scale factor bra L9D57 ; go process another command L9D69 clra ; make horizontal negative bsr L9DC4 skip1 L9D6D clra ; keep horizontal distance positive tfr d,x ; make horizontal distance and vertical distance the same bra L9DCB ; go do the draw thing L9D72 clra ; zero extend horizontal distance tfr d,x ; set it as vertical bsr L9DC4 ; negate horizontal distance exg d,x ; swap directions (vertical is now negative) bra L9DCB ; go do the draw thing L9D7B clra ; zero extend horizontal distance tfr d,x ; copy horizontal to vertical bsr L9DC4 ; negate horizontal bra L9DCB ; go do the drawing thing L9D82 clra ; zero extend horizontal distance L9DB3 ldx ZERO ; no vertical distance bra L9DCB ; go do the drawing things L9D87 clra ; zero extend horizontal bsr L9DC4 ; negate horizontal bra L9DB3 ; zero out vertical and do the drawing thing L9D8C clra ; zero extend distance bra L9D92 ; make the distance vertical and zero out horizontal L9D8F clra ; zero extend distance bsr L9DC4 ; negate distance L9D92 ldx ZERO ; zero out vertical distance exg x,d ; swap vertical and horizontal bra L9DCB ; go do the drawing thing L9D98 jsr L9C1B ; evaluate substring expression ldb #2 ; is there enough room for the state? jsr LAC33 ldb VD8 ; save current command string state ldx VD9 pshs x,b jmp L9CC6 ; go evaluate the sub string L9DA9 ldb SCALE ; get scale factor beq L9DC8 ; brif zero - default to full size clra ; zero extend exg d,x ; put distance somewhere useful sta ,-s ; save MS of distance bpl L9DB6 ; brif positive distance bsr L9DC3 ; negate the distance L9DB6 jsr L9FB5 ; multiply D and X tfr u,d ; save ms bytes in D lsra ; divide by 2 rorb L9DBD lsra ; ...divide by 4 rorb tst ,s+ ; negative distance? bpl L9DC7 ; brif it was positive L9DC3 nega ; negate D L9DC4 negb sbca #0 L9DC7 rts L9DC8 tfr x,d ; copy unchanged sitance to D rts L9DCB pshs b,a ; save horizontal distance bsr L9DA9 ; apply scale factor to vertical puls x ; get horizontal distance pshs b,a ; save scaled vertical bsr L9DA9 ; apply scale to horizontal puls x ; get back vertical distance ldy ANGLE ; get draw angle and scale pshs y ; save them L9DDC tst ,s ; is there an angle? beq L9DE8 ; brif no angle exg x,d ; swap distances bsr L9DC3 ; negate D dec ,s ; account for one tick around the rotation bra L9DDC ; see if we're there yet L9DE8 puls y ; get angle and scale back ldu ZERO ; default end position (horizontal) is 0 addd HORDEF ; add default horizontal to horizontal distance bmi L9DF2 ; brif we went negative tfr d,u ; save calculated end coordindate L9DF2 tfr x,d ; get vertical distance somewhere useful ldx ZERO ; default vertical end is 0 addd VERDEF ; add distance to default vertical start bmi L9DFC ; brif negative - use 0 tfr d,x ; save calculated end coordinate L9DFC cmpu #256 ; is horizontal in range? blo L9E05 ; brif su ldu #255 ; maximize it L9E05 cmpx #192 ; is vertical in range? blo L9E0D ; brif so ldx #191 ; maximize it L9E0D ldd HORDEF ; set starting coordinates for the line std HORBEG ldd VERDEF std VERBEG stx VEREND ; set end coordinates stu HOREND tst VD5 ; are we updating position? bne L9E21 ; brif not stx VERDEF ; update default coordinates stu HORDEF L9E21 jsr L9420 ; normalize coordindates tst VD6 ; are we drawing something? bne L9E2B ; brif not jsr L94A1 ; draw the line L9E2B clr VD5 ; reset draw and update flags clr VD6 jmp L9CDD ; do another command L9E32 jsr L9B98 ; get a command character pshs a ; save it jsr L9E5E ; evaluate horizontal distance pshs b,a ; save it jsr L9B98 ; get character cmpa #', ; comma between coordinates? lbne L9D4C ; brif not - raise error jsr L9E5B ; evaluate vertical distance tfr d,x ; save vertical distance puls u ; get horizontal distance puls a ; get back first command character cmpa #'+ ; was it + at start? beq L9E56 ; brif +; treat values as positive cmpa #'- ; was it -? bne L9DFC ; brif not - treat it as absolute L9E56 tfr u,d ; put horizontal distance somewhere useful jmp L9DCB ; move draw position (relative) L9E5B jsr L9B98 ; get input character L9E5E cmpa #'+ ; leading +? beq L9E69 ; brif so cmpa #'- ; leading -? beq L9E6A ; brif so - negative jsr L9BE2 ; move pointer back one L9E69 clra ; 0 for +, nonzero for - L9E6A pshs a ; save sign flag jsr L9CCB ; evaluate number puls a ; get sign flag tsta ; negative? beq L9E78 ; brif not clra ; zero extend and negate negb sbca #0 L9E78 rts ; Table of sines and cosines for CIRCLE L9E79 fdb 0x0000,0x0001 ; subarc 0 fdb 0xfec5,0x1919 ; subarc 1 fdb 0xfb16,0x31f2 ; subarc 2 fdb 0xf4fb,0x4a51 ; subarc 3 fdb 0xec84,0x61f9 ; subarc 4 fdb 0xe1c7,0x78ae ; subarc 5 fdb 0xd4dc,0x8e3b ; subarc 6 fdb 0xc5e5,0xa269 ; subarc 7 fdb 0xb506,0xb506 ; subarc 8 ; CIRCLE command ; The circle is drawn as a 64 sided polygon (64 LINE commands essentially) CIRCLE cmpa #'@ ; is there an @ before coordinates? bne L9EA3 ; brif not jsr GETNCH ; eat the @ L9EA3 jsr L9522 ; get max coordinates for screen jsr L93B2 ; parse coordinates for circle centre jsr L931D ; normalize the start coordinates ldx ,u ; get horizontal coordinate stx VCB ; save it ldx 2,u ; get vertical coordinate stx VCD ; saveit jsr SYNCOMMA ; make sure we have a comma jsr LB73D ; evaluate radius expression ldu #VCF ; point to temp storage stx ,u ; save radius jsr L9320 ; normalize radius lda #1 ; default to PSET sta SETFLG jsr L9581 ; evaluate the colour expression ldx #0x100 ; height/width default value jsr GETCCH ; is there a ratio? beq L9EDF ; brif not jsr SYNCOMMA ; make sure we have a comma jsr LB141 ; evaluate the ratio lda FP0EXP ; multiply ratio by 256 adda #8 sta FP0EXP jsr LB740 ; evaluate ratio to X (fraction part in LSB) L9EDF lda PMODE ; get graphics mode bita #2 ; is it even? beq L9EE9 ; brif so tfr x,d ; double the ratio leax d,x L9EE9 stx VD1 ; save height/width ratio ldb #1 ; set the SET flag to PSET stb SETFLG stb VD8 ; set first time flag (set to 0 after arc drawn) jsr L9FE2 ; evaluate circle starting point (octant, subarc) pshs b,a ; save startpoint jsr L9FE2 ; evaluate circle end point (octant, subarc) std VD9 ; save endp oint puls a,b L9EFD pshs b,a ; save current circle position ldx HOREND ; move end coordinates to start coordinates stx HORBEG ldx VEREND stx VERBEG ldu #L9E79+2 ; point to sine/cosine table anda #1 ; even octant? beq L9F11 ; brif so negb ; convert 0-7 to 8-1 for odd octants addb #8 L9F11 aslb ; four bytes per table entry aslb leau b,u ; point to correct table entry pshs u ; save sine/cosine table entry pointer jsr L9FA7 ; calculate horizontal offset puls u ; get back table entry pointer leau -2,u ; move to cosine entry pshs x ; save horizontal offset jsr L9FA7 ; calculate vertical offset puls y ; put horizontal in Y lda ,s ; get octant number anda #3 ; is it 0 or 4? beq L9F31 ; brif so cmpa #3 ; is it 3 or 7? beq L9F31 ; brif so exg x,y ; swap horizontal and vertical L9F31 stx HOREND ; save horizontal offset tfr y,x ; put vertical offset in X ldd VD1 ; get height/width ratio jsr L9FB5 ; multiply vertical by h/w ratio tfr y,d ; save the product to D tsta ; did it overflow? lbne LB44A ; brif so stb VEREND ; save vertical coordinate MSB tfr u,d ; get LSW of product sta VEREND+1 ; save LSB of integer part (we have 8 bits of fraction in the ratio) lda ,s ; get octant cmpa #2 ; is it 0 or 1? blo L9F5B ; brif so cmpa #6 ; is it 6 or 7? bhs L9F5B ; brif so ldd VCB ; get horizontal centre subd HOREND ; subtract horizontal displacement bcc L9F68 ; brif we didn't overflow the screen clra ; zero out coordinate if we overflowed the screen clrb bra L9F68 L9F5B ldd VCB ; get horizontal coordinate of the centre addd HOREND ; add displacement bcs L9F66 ; brif overlod cmpd VD3 ; larger than max horizontal coord? blo L9F68 ; brif not L9F66 ldd VD3 ; maximize the coordinate L9F68 std HOREND ; save horizontal ending coordainte lda ,s ; get octant cmpa #4 ; is it 0-3? blo L9F7A ; brif so ldd VCD ; get vertical coordinate of centre subd VEREND ; subtract displacement bcc L9F87 ; brif we didn't overflow the screen clra ; minimize to top of screen clrb bra L9F87 L9F7A ldd VCD ; get vertical centre coordinate addd VEREND ; add displacement bcs L9F85 ; brif we overflowed the screen cmpd VD5 ; did we go past max coordinate? blo L9F87 ; brif not L9F85 ldd VD5 ; maximize the coordinate L9F87 std VEREND ; save end coordinate tst VD8 ; check first time flag bne L9F8F ; do not draw if first time through (it was setting start coord) bsr L9FDF ; draw the line L9F8F puls a,b ; get arc number and sub arc lsr VD8 ; get first time flag value (and clear it!) bcs L9F9A ; do not check for end point after drawing for first coordinate cmpd VD9 ; at end point? beq L9FA6 ; brif drawing finished L9F9A incb ; bump arc counter cmpb #8 ; done 8 arcs? bne L9FA3 ; brif not inca ; bump octant clrb ; reset subarc number anda #7 ; make sure octant number stays in 0-7 range L9FA3 jmp L9EFD ; go do another arc L9FA6 rts L9FA7 ldx VCF ; get radius ldd ,u ; get sine/cosine table entry beq L9FB4 ; brif 0 - offset = radius subd #1 ; adjust values to correct range bsr L9FB5 ; multiply radius by sine/cosine tfr y,x ; resturn result in X L9FB4 rts L9FB5 pshs u,y,x,b,a ; save registers and reserve temp space clr 4,s ; reset overflow byte (YH) lda 3,s ; calcuate B*XL mul std 6,s ; put in "U" ldd 1,s ; calculate B*XH mul addb 6,s ; accumluate with previous product adca #0 std 5,s ; save in YL,UH ldb ,s ; calculate A*XL lda 3,s mul addd 5,s ; accumulate with previous partical product std 5,s ; save in YL,UH bcc L9FD4 ; brif no carry inc 4,s ; bump YH for carry L9FD4 lda ,s ; calculate A*XH ldb 2,s mul addd 4,s ; accumulate with previous partial product std 4,s ; save in Y (we can't have a carry here) puls a,b,x,y,u,pc ; restore multiplicands and return results L9FDF jmp L94A1 ; go draw a line L9FE2 clrb ; default arc number (0) jsr GETCCH ; is there something there for a value? beq L9FF8 ; brif not jsr SYNCOMMA ; evaluate , + expression jsr LB141 lda FP0EXP ; multiply by 64 adda #6 sta FP0EXP jsr LB70E ; get integer value of circle fraction andb #0x3f ; max value of 63 L9FF8 tfr b,a ; save arc value in A to calculate octant andb #7 ; calculate subarc lsra ; calculate octant lsra lsra rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; COLOR BASIC ROM area ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed ; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of ; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points. POLCAT fdb KEYIN ; indirect jump, get a keystroke CHROUT fdb PUTCHR ; indirect jump, output character CSRDON fdb CASON ; indirect jump, turn cassette on and start reading BLKIN fdb GETBLK ; indirect jump, read a block from tape BLKOUT fdb SNDBLK ; indirect jump, write a block to tape JOYIN fdb GETJOY ; indirect jump, read joystick axes WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader ; Initialization code. LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges) sta PIA1+3 lda RSTFLG ; get warm start flag cmpa #0x55 ; is it valid? bne BACDST ; brif not - cold start ldx RSTVEC ; get warm start routine pointer lda ,x ; get first byte of the routine cmpa #0x12 ; is it NOP? bne BACDST ; brif not - the routine is invalid so do a cold start jmp ,x ; transfer control to the warm start routine ; RESET/power on comes here RESVEC leay LA00E,pcr ; point to warm start check code LA02A lda #0x3a ; restore MMU block in 0x4000-0x5fff block sta MMUREG+2 ldx #PIA1 ; point to PIA1 ldd #0xff34 ; set up for initializing PIAs clr 1,x ; set PIA1 DA to direction mode clr 3,x ; set PIA1 DB to direction mode deca sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input sta 2,x stb 1,x ; set PIA1 DA to data mode stb 3,x ; set PIA1 DB to data mode clr 2,x ; set VDG to alpha-numeric lda #2 ; set RS232 to marking sta ,x lda #0xff ldx #PIA0 ; point to PIA0 clr 1,x ; set PIA0 DA to direction mode clr 3,x ; set PIA0 DB to direction mode clr ,x ; set PIA0 DA to input sta 2,x ; set PIA0 DB to output stb 1,x ; set PIA0 DA to direction mode stb 3,x ; set PIA0 DB to direction mode jmp LA072 ; continue initializing LA05E jsr L8C2E ; map ROM pack jmp 0xc000 ; transfer control to ROM pack ; Left over initialization code from Color Basic 1.2 follows bitb 2,x ; check RAMSZ input beq LA072 ; brif set for 4K RAMs clr -2,x ; set strobe low bitb 2,x ; check input beq LA070 ; brif set for 64K rams leau -2,u ; adjust pointer to set SAM for 16K RAMs LA070 sta -3,u ; program SAM for either 16K or 64K RAMs LA072 jmp ,y ; transfer control to startup routine ; Cold start jumps here BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below) LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM) leax 1,x ; move forward one byte (will set Z if we're done) bne LA077 ; brif not donw yet jsr LA928 ; clear the screen clr ,x+ ; put the constant zero that lives before the program stx TXTTAB ; set beginning of program storage LA084 ldx #0x7fff ; set to of available RAM to just below the "ROM" area bra LA093 nop nop nop nop nop nop nop nop nop nop LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work) stx MEMSIZ ; save top of string space stx STRTAB ; set bottom of allocated string space leax -200,x ; allocate 200 bytes of string space stx FRETOP ; set top of actually free memory tfr x,s ; put the stack there ldx #LA10D ; point to variable initializer ldu #CMPMID ; point to variables to initialize (first batch) ldb #28 ; 28 bytes in first batch jsr LA59A ; copy bytes to variables ldu #IRQVEC ; point to variables to initialize (second batch) ldb #30 ; 30 bytes this time jsr LA59A ; copy bytes to variables ldx -12,x ; get SN error address stx 3,u ; set ECB's command handlers to error stx 8,u ldx #RVEC0 ; point to RAM vectors ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors) LA0C0 sta ,x+ ; put an RTS decb ; done? bne LA0C0 ; brif not sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer jsr LAD19 ; do a "NEW" jmp L8002 ; transfer control to ECB's initialization routine LA0CE pshs b,x ; save registers tst HRWIDTH ; is it VDG mode? lbne ALINK24 ; brif not LA0D6 jsr LA199 ; do a "cursor" jsr KEYIN ; read a key beq LA0D6 ; brif no key LA0DE jmp LA1B9 ; return to mainline fcb 0x72 ; left-over from code replacement above LA0E2 lda #0x55 ; warm start valid flag sta RSTFLG ; mark warm start valid bra LA0F3 ; go to direct mode ; Warm start entry point BAWMST nop ; valid routine marker clr DEVNUM ; reset output/input to screen jsr LAD33 ; do a partial NEW andcc #0xaf ; start interrupts jsr CLS ; clear the screen LA0F3 jmp LAC73 ; go to direct mode ; FIRQ service routine - this handles starting autostart cartridges BFRQSV tst PIA1+3 ; is it the cartridge interrupt? bmi LA0FC ; brif so rti LA0FC jsr L8C28 ; map cartridge jsr LA7D1 ; delay for another while leay <LA108,pcr ; point to cartridge starter jmp LA02A ; go initialize everything clean for the cartridge LA108 clr RSTFLG ; force a cold start a cartridge reset jmp ROMPAK ; transfer control to the cartridge ; Variable initializers (first batch) LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period fcb 24 ; upper limit of 1200 Hz period fcb 10 ; upper limit of 2400 Hz period fdb 128 ; number of 0x55s for cassette leader fcb 11 ; cursor blink delay fdb 88 ; 600 baud delay constant fdb 1 ; printer carriage return delay constant fcb 16 ; printer tab field width fcb 112 ; last printer tab zone fcb 132 ; printer carriage width fcb 0 ; printer carriage position fdb LB44A ; default execution address for EXEC inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two bne LA123 ;* two stage increment of CHARAD then load the value into A inc CHARAD ;* before transferring control to the bottom half routine in ROM LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required jmp BROMHK ; Variable initializers (second batch) jmp BIRQSV ; IRQ handler jmp BFRQSV ; FIRQ handler jmp LB44A ; default USR() address fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed fcb 0xff ; capslock flag - default to upper case fdb DEBDEL ; keyboard debounce delay (why is it a variable?) jmp LB277 ; exponentiation handler vector fcb 53 ; (command interpretation table) 53 commands fdb LAA66 ; (command interpretation table) reserved words list (commands) fdb LAB67 ; (command interpretation table) jump table (commands) fcb 20 ; (command interpretation table) 20 functions fdb LAB1A ; (command interpretation table) reserved words list (functions) fdb LAA29 ; (command interpretation table) jump table (functions) ; This is the signon message. LA147 fcc 'COLOR BASIC 1.2' fcb 0x0d fcc '(C) 1982 TANDY' fcb 0 ; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes LA166 fcc 'MICROSOFT' fcb 0x0d,0 ; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII) LA171 bsr LA176 ; get character anda #0x7f ; mask off high bit rts ; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available, ; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine ; has undefined results when called on an output only device. All registers except CC and A are preserved. LA176 jsr RVEC4 ; do RAM hook clr CINBFL ; flag data available tst DEVNUM ; is it keyboard? beq LA1B1 ; brif so - blink cursor and wait for key press tst CINCTR ; is there anything in cassette input buffer? bne LA186 ; brif so com CINBFL ; flag EOF rts ; Read character from cassette file LA186 pshs u,y,x,b ; preserve registers ldx CINPTR ; get input buffer pointer lda ,x+ ; get character from buffer pshs a ; save it for return stx CINPTR ; save new input buffer pointer dec CINCTR ; count character just consumed bne LA197 ; brif buffer is not empty yet jsr LA635 ; go read another block, if any, to refill the buffer LA197 puls a,b,x,y,u,pc ; restore registers and return the character ; Blink the cursor. This might be better timed via an interrupt or something. LA199 dec BLKCNT ; is it time to blink the cursor? bne LA1AB ; brif not ldb #11 ; reset blink timer stb BLKCNT ldx CURPOS ; get cursor position lda ,x ; get character at the cursor adda #0x10 ; move to next color ora #0x8f ; make sure it's a grahpics block with all elements lit sta ,x ; put new cursor block on screen LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms) LA1AE jmp LA7D3 ; go count X down ; Blink cursor while waiting for a key press LA1B1 pshs x,b ; save registers LA1B3 bsr LA199 ; go do a cursor iteration bsr KEYIN ; go read a key beq LA1B3 ; brif no key pressed LA1B9 ldb #0x60 ; VDG screen space character stb [CURPOS] ; blank cursor out puls b,x,pc ; restore registers and return ; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1 ; ROMs, this routine is quite a lot more compact and robust. LA1C1 jmp KEYIN ; transfer control to actual keyboard scan rts ;* this actually removes a check to see if any keys are actually down rts ;* which is unfortunate because it makes programs run slower. rts rts rts rts rts KEYIN pshs u,x,b ; save registers ldu #PIA0 ; point to keyboard PIA ldx #KEYBUF ; point to state table clra ; clear carry, set column to 0xff (no strobe) deca ; (note: deca does not affect C) pshs x,a ; save column counter and make a couple of holes for temporaries sta 2,u ; set strobe to no columns LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after) bcc LA220 ; brif we shifted out a 0 - we've done 8 columns inc 0,s ; bump column counter (first bump goes to 0) bsr LA23A ; read row data sta 1,s ; save key data (for debounce check and later saving) eora ,x ; now bits set if key state changed anda ,x ; now bits are only set if a key has been pressed ldb 1,s ; get new key data stb ,x+ ; save in state table tsta ; was a key down? beq LA1D9 ; brif not - do another (nothing above cleared C) ldb 2,u ; get strobe data stb 2,s ; save it for debounce check ldb #0xf8 ; set up so B is 0 after first add LA1F4 addb #8 ; add 8 for each row lsra ; did we hit the right row? bcc LA1F4 ; brif not addb 0,s ; add in column number beq LA245 ; brif @ cmpb #26 ; letter? bhi LA247 ; brif not orb #0x40 ; bias into letter range bsr LA22E ; check for SHIFT ora CASFLG ; merge in capslock state bne LA20C ; brif either capslock or SHIFT - keep upper case orb #0x20 ; move to lower case LA20C stb 0,s ; save ASCII value ldx DEBVAL ; get debounce delay bsr LA1AE ; do the 10ms debounce delay ldb #0xff ; set strobe to none - only joystick buttons register now bsr LA238 ; read keyboard inca ; A now 0 if no buttons down bne LA220 ; brif button down - return nothing since we have interference LA21A ldb 2,s ; get column strobe data bsr LA238 ; read row data cmpa 1,s ; does it match original read? LA220 puls a,x ; clean up stack and get return value bne LA22B ; brif failed debounce or a joystick button down cmpa #0x12 ; is it SHIFT-0? bne LA22C ; brif not com CASFLG ; swap capslock state LA22B clra ; set no key down LA22C puls b,x,u,pc ; restore registers and return LA22E lda #0x7f ; column strobe for SHIFT sta 2,u ; set column lda ,u ; get row data coma ; set if key down anda #0x40 ; only keep SHIFT state rts LA238 stb 2,u ; save strobe data LA23A lda ,u ; get row data ora #0x80 ; mask off comparator so it doesn't interfere tst 2,u ; are we on column 7? bmi LA244 ; brif not ora #0xc0 ; also mask off SHIFT LA244 rts LA245 ldb #51 ; scan code for @ LA247 ldx #CONTAB-0x36 ; point to code table cmpb #33 ; arrows, space, zero? blo LA264 ; brif so ldx #CONTAB-0x54 ; adjust to other half of table cmpb #48 ; ENTER, CLEAR, BREAK, @? bhs LA264 ; brif so bsr LA22E ; read shift state cmpb #43 ; is it a number, colon, semicolon? bls LA25D ; brif so eora #0x40 ; invert shift state for others LA25D tsta ; shift down? bne LA20C ; brif not - return result addb #0x10 ; add in offset to shifted character bra LA20C ; go return result LA264 lslb ; two entries per key bsr LA22E ; check SHIFT state beq LA26A ; brif not shift incb ; point to shifted entry LA26A ldb b,x ; get actual key code bra LA20C ; go return result CONTAB fcb 0x5e,0x5f ; <UP> (^, _) fcb 0x0a,0x5b ; <DOWN> (LF, [) fcb 0x08,0x15 ; <LEFT> (BS, ^U) fcb 0x09,0x5d ; <RIGHT> (TAB, ]) fcb 0x20,0x20 ; <SPACE> fcb 0x30,0x12 ; <0> (0, ^R) fcb 0x0d,0x0d ; <ENTER> (CR, CR) fcb 0x0c,0x5c ; <CLEAR> (FF, \) fcb 0x03,0x03 ; <BREAK> (^C, ^C) fcb 0x40,0x13 ; <@> (@, ^S) ; Generic output routine. ; Output character in A to the device specified by DEVNUM. All registers are preserved except CC. ; Sending output to a device that does not support output is undefined. PUTCHR jsr RVEC3 ; call RAM hook pshs b ; save B ldb DEVNUM ; get desired device number incb ; set flags (Z for -1, etc.) puls b ; restore B bmi LA2BF ; brif < -1 (line printer) bne LA30A ; brif > -1 (screen) ; Write character to tape file pshs x,b,a ; save registers ldb FILSTA ; get file status decb ; input file? beq LA2A6 ; brif so ldb CINCTR ; get character count incb ; account for this character bne LA29E ; brif buffer not full bsr LA2A8 ; write previously full block to tape LA29E ldx CINPTR ; get output buffer pointer sta ,x+ ; put character in output stx CINPTR ; save new buffer pointer inc CINCTR ; account for this character LA2A6 puls a,b,x,pc ; restore registers and return ; Write a block of data to tape. LA2A8 ldb #1 ; data block type LA2AA stb BLKTYP ; set block type ldx #CASBUF ; point to output buffer stx CBUFAD ; set buffer pointer ldb CINCTR ; get number of bytes in the block stb BLKLEN ; set length to write pshs u,y,a ; save registers jsr LA7E5 ; write a block to tape puls a,y,u ; restore registers jmp LA650 ; reset buffer pointers ; Send byte to line printer LA2BF pshs x,b,a,cc ; save registers and interrupt status orcc #0x50 ; disable interrupts LA2C3 ldb PIA1+2 ; get RS232 status lsrb ; get status to C bcs LA2C3 ; brif busy - loop until not busy bsr LA2FB ; set output to marking clrb ; transmit one start bit bsr LA2FD ldb #8 ; counter for 8 bits LA2D0 pshs b ; save bit count clrb ; zero output bits lsra ; bet output bit to C rolb ; get output bit to correct bit for output byte lslb bsr LA2FD ; transmit bit puls b ; get back bit counter decb ; are we done yet? bne LA2D0 ; brif not bsr LA2FB ; send stop bit (marking) puls cc,a ; restore interrupt status and output character cmpa #0x0d ; carriage return? beq LA2ED ; brif so inc LPTPOS ; bump output position ldb LPTPOS ; get new position cmpb LPTWID ; end of line? blo LA2F3 ; brif not LA2ED clr LPTPOS ; reset position to start of line bsr LA305 ; do carriage return delay bsr LA305 LA2F3 ldb PIA1+2 ; get RS232 status lsrb ; get status to C bcs LA2F3 ; brif still busy, keep waiting puls b,x,pc ; restore registers and return LA2FB ldb #2 ; set output to high (marking) LA2FD stb PIA1 ; set RS232 output bsr LA302 ; do baud delay (first iteration) then fall through for second LA302 ldx LPTBTD ; get buard rate delay constant skip2 LA305 ldx LPTLND ; get carriage return delay constant jmp LA7D3 ; count X down ; Output character to screen LA30A pshs x,b,a ; save registers ldx CURPOS ; get cursor pointer LA30E cmpa #0x08 ; backspace? bne LA31D ; brif not cmpx #VIDRAM ; at top of screen? beq LA35D ; brif so - it's a no-op lda #0x60 ; VDG space character sta ,-x ; put a space at previous location and move pointer back bra LA344 ; save new cursor position and return LA31D cmpa #0x0d ; carriage return? bne LA32F ; brif not ldx CURPOS ; get cursor pointer (why? we already have it) LA323 lda #0x60 ; VDG space character sta ,x+ ; put output space tfr x,d ; see if we at a multiple of 32 now bitb #0x1f bne LA323 ; brif not bra LA344 ; go check for scrolling LA32F cmpa #0x20 ; control character? blo LA35D ; brif so tsta ; is it graphics block? bmi LA342 ; brif so cmpa #0x40 ; number or special? blo LA340 ; brif so (flip "case" bit) cmpa #0x60 ; upper case alpha? blo LA342 ; brif so - keep it unmodified anda #0xdf ; clear bit 5 (inverse video) LA340 eora #0x40 ; flip inverse video bit LA342 sta ,x+ ; output character LA344 stx CURPOS ; save new cursor position cmpx #VIDRAM+511 ; end of screen? bls LA35D ; brif not ldx #VIDRAM ; point to start of screen LA34E ldd 32,x ; get two characters from next row std ,x++ ; put them on this row cmpx #VIDRAM+0x1e0 ; at start of last row on screen? blo LA34E ; brif not ldb #0x60 ; VDG space jsr LA92D ; blank out last line (borrow CLS's loop) LA35D puls a,b,x,pc ; restore registers and return ; Set up device parameters for output LA35F jsr RVEC2 ; do the RAM hook dance pshs x,b,a ; save registers clr PRTDEV ; flag device as a screen lda DEVNUM ; get devicenumber beq LA373 ; brif screen inca ; is it tape? beq LA384 ; brif so ldx LPTCFW ; get tab width and last tab stop for printer ldd LPTWID ; get line width and current position for printer bra LA37C ; set parameters LA373 ldb CURPOS+1 ; get LSB of cursor position andb #0x1f ; now we have the offset into the line ldx #0x1010 ; 16 character tab, position 16 is last tab stop lda #32 ; screen is 32 characters wide LA37C stx DEVCFW ; save tab width and last tab stop for active device stb DEVPOS ; save line position for current device sta DEVWID ; save line width for current device puls a,b,x,pc ; restore registers and return LA384 com PRTDEV ; flag device as non-display ldx #0x0100 ; tab width is 1, last tab field is 0 clra ; line width is 0 clrb ; character position on line is 0 bra LA37C ; go set parameters ; This is the line input routine used for reading lines for Basic, both in immediate mode and for ; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER. ; The actualy entry point is LA390. Note that this routine echoes to *all* devices. LA38D jsr LA928 ; clear screen (CLEAR key handling) LA390 jsr RVEC12 ; do the RAM hook dance clr IKEYIM ; reset cached input character from BREAK check ldx #LINBUF+1 ; point to line input buffer (input pointer) ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier) LA39A jsr LA171 ; get an input character, only keep low 7 bits tst CINBFL ; is it EOF? bne LA3CC ; brif EOF tst DEVNUM ; is it keyboard input? bne LA3C8 ; brif not - don't do line editing cmpa #0x0c ; form feed (CLEAR)? beq LA38D ; brif so - clear screen and reset cmpa #0x08 ; backspace? bne LA3B4 ; brif not decb ; move back one character beq LA390 ; brif we were at the start of the line - reset and start again leax -1,x ; move input pointer back bra LA3E8 ; echo the backspace and continue LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)? bne LA3C2 ; brif not LA3B8 decb ; at start of line? beq LA390 ; brif so - reset and restart lda #0x08 ; echo a backspace jsr PUTCHR bra LA3B8 ; see if we've erased everything yet LA3C2 cmpa #0x03 ; BREAK? orcc #1 ; set C if it is (only need Z for the next test LA3C6 beq LA3CD ; brif BREAK - exit LA3C8 cmpa #0x0d ; ENTER (CR) bne LA3D9 ; brif not LA3CC clra ; clear carry (it might not be clear on EOF) LA3CD pshs cc ; save ENTER/BREAK flag jsr LB958 ; echo a carriage return clr ,x ; make sure we have a NUL at the end of the buffer ldx #LINBUF ; point to input buffer puls cc,pc ; restore ENTER/BREAK flag and return LA3D9 cmpa #0x20 ; control character? blo LA39A ; brif so - skip it cmpa #'z+1 ; above z? bhs LA39A ; brif so - ignore it cmpb #LBUFMX ; is the buffer full? bhs LA39A ; brif so - ignore extra characters sta ,x+ ; put character in the buffer incb ; bump character count LA3E8 jsr PUTCHR ; echo character bra LA39A ; go handle next input character ; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open. LA3ED jsr RVEC5 ; do the RAM hook dance lda DEVNUM ; get device number beq LA415 ; brif keyboard - always valid inca ; is it tape? bne LA403 ; brif not lda FILSTA ; get tape file status bne LA400 ; brif file is open LA3FB ldb #22*2 ; raise NO error jmp LAC46 LA400 deca ; is it in input mode? beq LA415 ; brif so LA403 jmp LA616 ; raise FM error ; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open. LA406 jsr RVEC6 ; do the RAM hook dance lda DEVNUM ; get device number inca ; is it tape? bne LA415 ; brif not lda FILSTA ; get file status beq LA3FB ; brif not open deca ; is it open for reading? beq LA403 ; brif so - bad mode LA415 rts ; CLOSE command CLOSE beq LA426 ; brif no file specified - close all files jsr LA5A5 ; parse device number LA41B bsr LA42D ; close specified file jsr GETCCH ; is there more? beq LA44B ; brif not jsr LA5A2 ; check for comma and parse another device number bra LA41B ; go close this one ; Close all files handler. LA426 jsr RVEC7 ; Yup. The RAM hook dance. LA429 lda #-1 ; start with tape file sta DEVNUM ; Close file specified in DEVNUM. Note that this never fails. LA42D jsr RVEC8 ; You know it. RAM hook. lda DEVNUM ; get device we're closing clr DEVNUM ; reset to screen/keyboard inca ; is it tape? bne LA44B ; brif not lda FILSTA ; get file status cmpa #2 ; is it output? bne LA449 ; brif not lda CINCTR ; is there anything waiting to be written? beq LA444 ; brif not jsr LA2A8 ; write final block of data LA444 ldb #0xff ; write EOF block jsr LA2AA LA449 clr FILSTA ; mark tape file closed LA44B rts ; CSAVE command CSAVE jsr LA578 ; parse filename jsr GETCCH ; see what we have after the file name beq LA469 ; brif none jsr SYNCOMMA ; make sure there's a comma ldb #'A ; make sure there's an A after jsr LB26F bne LA44B ; brif not end of line clra ; file type 0 (basic program) jsr LA65C ; write out header block lda #-1 ; set output to tape sta DEVNUM clra ; set Z so we list the whole program jmp LIST ; go list the program to tape LA469 clra ; file type 0 (basic program) ldx ZERO ; set to binary file mode jsr LA65F ; write header block clr FILSTA ; close files inc BLKTYP ; set block type to data jsr WRLDR ; write out a leader ldx TXTTAB ; point to start of program LA478 stx CBUFAD ; set buffer location lda #255 ; block size to 255 bytes (max size) sta BLKLEN ldd VARTAB ; get end of program subd CBUFAD ; how much is left? beq LA491 ; brif we have nothing left cmpd #255 ; do we have a full block worth? bhs LA48C ; brif so stb BLKLEN ; save actual remainder as block length LA48C jsr SNDBLK ; write a block out bra LA478 ; go do another block LA491 neg BLKTYP ; set block type to 0xff (EOF) clr BLKLEN ; no data in EOF block jmp LA7E7 ; write EOF, stop tape, and return ; CLOAD and CLOADM commands CLOAD clr FILSTA ; close tape file cmpa #'M ; is it ClOADM? beq LA4FE ; brif so leas 2,s ; clean up stack jsr LA5C5 ; parse file name jsr LA648 ; go find the file tst CASBUF+10 ; is it binary? beq LA4C8 ; brif so lda CASBUF+9 ; is it ASCII? beq LA4CD ; brif not jsr LAD19 ; clear out existing program lda #-1 ; set up for reading from tape sta DEVNUM inc FILSTA ; set tape file to input jsr LA635 ; go read first block jmp LAC7C ; go to immediate mode to read in the program ; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is ; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in ; 8K. LA4BF jsr RVEC13 ; do the RAM hook dance jsr LA42D ; close file jmp LAC73 ; go back to immediate mode LA4C8 lda CASBUF+8 ; get file type beq LA4D0 ; brif basic program LA4CD jmp LA616 ; raise FM error LA4D0 jsr LAD19 ; erase existing program jsr CASON ; start reading tape ldx TXTTAB ; get start of program storage LA4D8 stx CBUFAD ; set load address for block ldd CBUFAD ; get start of block inca ; bump by 256 jsr LAC37 ; check if there's room for a maximum sized block of 255 jsr GETBLK ; go read a block bne LA4F8 ; brif there was an error during reading lda BLKTYP ; get type of block read beq LA4F8 ; brif header block - IO error bpl LA4D8 ; brif data block - read another stx VARTAB ; save new end of program bsr LA53B ; stop tape ldx #LABED-1 ; point to "OK" prompt jsr STRINOUT ; show prompt jmp LACE9 ; reset various things and return LA4F8 jsr LAD19 ; clear out partial program load LA4FB jmp LA619 ; raise IO error ; This is the CLOADM command LA4FE jsr GETNCH ; eat the "M" bsr LA578 ; parse file name jsr LA648 ; go find the file LA505 ldx ZERO ; default offset is 0 jsr GETCCH ; see if there's something after the file name beq LA511 ; brif no offset jsr SYNCOMMA ; make sure there's a comma jsr LB73D ; evaluate offset to X LA511 lda CASBUF+8 ; get file mode cmpa #2 ; M/L program? bne LA4CD ; brif not - FM error ldd CASBUF+11 ; get load address leau D,x ; add in offset stu EXECJP ; set EXEC default address tst CASBUF+10 ; is it binary? bne LA4CD ; brif not ldd CASBUF+13 ; get load address leax d,x ; add in offset stx CBUFAD ; set buffer address for loading jsr CASON ; start up tape LA52E jsr GETBLK ; read a block bne LA4FB ; brif error reading stx CBUFAD ; save new load address tst BLKTYP ; set flags on block type beq LA4FB ; brif another header - IO error bpl LA52E ; brif it was data - read more LA53B jmp LA7E9 ; turn off tape and return ; The EXEC command EXEC beq LA545 ; brif no argument - use default address jsr LB73D ; evaluate EXEC address to X stx EXECJP ; set new default EXEC address LA545 jmp [EXECJP] ; transfer control to execution address ; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break ; check logic or packaged up with LIST? LA549 jsr RVEC11 ; do the RAM hook dance lda DEVNUM ; get device number inca ; is it tape? beq LA5A1 ; brif so - don't do break check jmp LADEB ; do the actual break check ; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position. ; This really should be located with the PRINT command. LA554 jsr LB3E4 ; evaluate a positive expression to D subd #511 ; is it within bounds? lbhi LB44A ; brif not - error out addd #VIDRAM+511 ; adjust to be within the screen (and undo the SUBD above) std CURPOS ; set cursor position rts ; INKEY$ function INKEY lda IKEYIM ; was a key down during break check? bne LA56B ; brif so jsr KEYIN ; poll the keyboard LA56B clr IKEYIM ; reset the break check cache sta FPA0+3 ; store result for later return lbne LB68F ; brif a key was down - return it as a string sta STRDES ; set string length to 0 (no key down) jmp LB69B ; return the NULL string ; Parse a filename LA578 ldx #CFNBUF ; point to file name buffer clr ,x+ ; zero out file name length lda #0x20 ; space character to initialize file name LA57F sta ,x+ ; put a space in the buffer cmpx #CASBUF ; at end of file name? bne LA57F ; brif not jsr GETCCH ; get input character beq LA5A1 ; brif no name present jsr LB156 ; evaluate the file name expression jsr LB654 ; point to start of the file name ldu #CFNBUF ; point to file name buffer stb ,u+ ; save string length beq LA5A1 ; brif empty - we're done skip2 LA598 ldb #8 ; copy 8 bytes ; Move B bytes from (X) to (U) LA59A lda ,x+ ; copy a byte sta ,u+ decb ; done yet? bne LA59A ; brif not LA5A1 rts ; Parse a device number and check validity LA5A2 jsr SYNCOMMA ; check for comma and SN error if not LA5A5 cmpa #'# ; do we have a #? bne LA5AB ; brif not (it's optional) jsr GETNCH ; munch the # LA5AB jsr LB141 ; evaluate the expression LA5AE jsr INTCNV ; convert it to an integer in D rolb ; move sign of B into C adca #0 ; add sign of B to A bne LA61F ; brif A doesn't match the sign of B rorb ; restore B (ADCA will have set C if B was negative) stb DEVNUM ; set device number jsr RVEC1 ; do the RAM hook dance beq LA5C4 ; brif device number set to screen/keyboard (valid) bpl LA61F ; brif not negative (not valid) cmpb #-2 ; is it printer or tape? blt LA61F ; brif not (not valid) LA5C4 rts ; Read file name from the line and do an error if anything follows it LA5C5 bsr LA578 ; parse file name LA5C7 jsr GETCCH ; set flags on current character LA5C9 beq LA5C4 ; brif nothing there - it's good jmp LB277 ; raise SN error ; EOF function EOF jsr RVEC14 ; do the RAM hook dance lda DEVNUM ; get device number pshs a ; save it (so we can restore it later) bsr LA5AE ; check the device number (which is in FPA0) jsr LA3ED ; check validity for reading LA5DA clrb ; not EOF = 0 (FALSE) lda DEVNUM ; get device number beq LA5E4 ; brif keyboard - never EOF tst CINCTR ; is there anything in the input buffer? bne LA5E4 ; brif so - not EOF comb ; set EOF flag to -1 (true) LA5E4 puls a ; get back original device sta DEVNUM ; restore it LA5E8 sex ; sign extend result to 16 bits jmp GIVABF ; go return the result ; SKIPF command SKIPF bsr LA5C5 ; parse file name bsr LA648 ; look for the file jsr LA6D1 ; read the file bne LA619 ; brif error reading file rts ; OPEN command OPEN jsr RVEC0 ; do the RAM hook dance jsr LB156 ; get file status (input/output) jsr LB6A4 ; get first character of status string pshs b ; save status bsr LA5A2 ; parse a comma then the device number jsr SYNCOMMA ; make sure there's a comma bsr LA5C5 ; parse the file name lda DEVNUM ; get device number of the file clr DEVNUM ; reset actual device to the screen puls b ; get back status cmpb #'I ; INPUT? beq LA624 ; brif so - open a file for INPUT cmpb #'O ; OUTPUT? beq LA658 ; brif so - open a file for OUTPUT LA616 ldb #21*2 ; raise FM error skip2 LA619 ldb #20*2 ; raise I/O error skip2 LA61C ldb #18*2 ; raise AO error skip2 LA61F ldb #19*2 ; raise DN error jmp LAC46 LA624 inca ; are we opening the tape? bmi LA616 ; brif printer - FM error; printer can't be opened for READ bne LA657 ; brif screen - screen is always open bsr LA648 ; read header block lda CASBUF+9 ; clear A if binary or machine language file anda CASBUF+10 beq LA616 ; bad file mode if not data file inc FILSTA ; open file for input LA635 jsr LA701 ; start tape, read block bne LA619 ; brif error during read tst BLKTYP ; check block type beq LA619 ; brif header block - something's wrong bmi LA657 ; brif EOF lda BLKLEN ; get length of block beq LA635 ; brif empty block - read another LA644 sta CINCTR ; set buffer count bra LA652 ; reset buffer pointer LA648 tst FILSTA ; is the file open? bne LA61C ; brif so - AO error bsr LA681 ; search for file bne LA619 ; brif error on read LA650 clr CINCTR ; mark buffer empty LA652 ldx #CASBUF ; set buffer pointer to start of buffer stx CINPTR LA657 rts LA658 inca ; check for tape device bne LA657 ; brif not tape (nothing doing - it's always open) inca ; make file type 1 LA65C ldx #0xffff ; ASCII and data mode LA65F tst FILSTA ; is file open? bne LA61C ; brif so - raise error ldu #CASBUF ; point to tape buffer stu CBUFAD ; set address of block to write sta 8,u ; set file type stx 9,u ; set ASCII flag and mode ldx #CFNBUF+1 ; point to file name jsr LA598 ; move file name to the tape buffer clr BLKTYP ; set for header block lda #15 ; 15 bytes in a header block sta BLKLEN ; set block length jsr LA7E5 ; write the block lda #2 ; set file type to output sta FILSTA bra LA650 ; reset file pointers ; Search for correct cassette file name LA681 ldx #CASBUF ; point to cassette buffer stx CBUFAD ; set location to read blocks to LA686 lda CURLIN ; are we in immediate mode? inca bne LA696 ; brif not jsr LA928 ; clear screen ldx CURPOS ; get start of screen (set after clear) ldb #'S ; for "searching" stb ,x++ ; put it on the screen stx CURPOS ; save cursor position to be one past the search indicator LA696 bsr LA701 ; read a block orb BLKTYP ; merge error flag with block type bne LA6D0 ; brif error or not header ldx #CASBUF ; point to block just read ldu #CFNBUF+1 ; point to the desired name ldb #8 ; compare 8 characters clr ,-s ; set flag to "match" LA6A6 lda ,x+ ; get character from just read block ldy CURLIN ; immediate mode? leay 1,y bne LA6B4 ; brif not clr DEVNUM ; set output to screen jsr PUTCHR ; display character LA6B4 suba ,u+ ; subtract from desired file name (nonzero if no match) ora ,s ; merge with match flag sta ,s ; save new match flag (will be nonzero if any character differs) decb ; done all characters? bne LA6A6 ; brif not - do another lda ,s+ ; get match flag (and set flags) beq LA6CB ; brif we have a match tst -9,u ; did we actually have a file name or will any file do? beq LA6CB ; brif any file will do bsr LA6D1 ; go read past the file bne LA6D0 ; return on error bra LA686 ; keep looking LA6CB lda #'F ; for "found" bsr LA6F8 ; put "F" on screen clra ; set Z to indicat eno errors LA6D0 rts LA6D1 tst CASBUF+10 ; check type of file bne LA6DF ; brif "blocked" file jsr CASON ; turn on tape LA6D9 bsr GETBLK ; read a block bsr LA6E5 ; error or EOF? bra LA6D9 ; read another block LA6DF bsr LA701 ; read a single block bsr LA6E5 ; error or EOF? bra LA6DF ; read another block LA6E5 bne LA6ED ; got error reading block lda BLKTYP ; check block type nega ; A is 0 now if EOF bmi LA700 ; brif not end of file deca ; clear error indicator LA6ED sta CSRERR ; set error flag leas 2,s ; don't return to original caller bra LA705 ; turn off motor and return LA6F3 lda VIDRAM ; get first char on screen eora #0x40 ; flip case LA6F8 ldb CURLIN ; immediate mode? incb bne LA700 ; brif not sta VIDRAM ; save flipped case character LA700 rts ; Read a single block from tape (for a "blocked" file) LA701 bsr CASON ; start tape going bsr GETBLK ; read block LA705 jsr LA7E9 ; stop tape ldb CSRERR ; get error status rts ; Read a block from tape - this does the heavy lifting GETBLK orcc #0x50 ; disable interrupts (timing is important) bsr LA6F3 ; reverse video of upper left character in direct mode ldx CBUFAD ; point to destination buffer clra ; reset read byte LA712 bsr LA755 ; read a bit rora ; move bit into accumulator cmpa #0x3c ; have we synched on the start of the block data yet? bne LA712 ; brif not bsr LA749 ; read block type sta BLKTYP bsr LA749 ; get block size sta BLKLEN adda BLKTYP ; accumulate checksum sta CCKSUM ; save current checksum lda BLKLEN ; get back count sta CSRERR ; initialize counter; we use this since it will be ovewritten later anyway beq LA73B ; brif empty block LA72B bsr LA749 ; read a byte sta ,x ; save in buffer cmpa ,x+ ; make sure it wrote bne LA744 ; brif error if it didn't match adda CCKSUM ; accumulate checksum sta CCKSUM dec CSRERR ; read all bytes? bne LA72B ; brif not LA73B bsr LA749 ; read checksum from tape suba CCKSUM ; does it match? beq LA746 ; brif so lda #1 ; checksum error flag skip2 LA744 lda #2 ; non-RAM error flag LA746 sta CSRERR ; save error status rts LA749 lda #8 ; read 8 bits sta CPULWD ; initialize counter LA74D bsr LA755 ; read a bit rora ; put it into accumulator dec CPULWD ; got all 8 bits? bne LA74D ; brif not rts LA755 bsr LA75D ; get time between transitions ldb CPERTM ; get timer decb cmpb CMPMID ; set C if timer is below the transition point - high or 1; clear otherwise rts LA75D clr CPERTM ; reset timer tst CBTPHA ; check which phase we synched on bne LA773 ; brif HI-LO synch LA763 bsr LA76C ; read input bcs LA763 ; brif still high LA767 bsr LA76C ; read input bcc LA767 ; brif still low rts LA76C inc CPERTM ; bump timer ldb PIA1 ; get input bit to C rorb rts LA773 bsr LA76C ; read input bcc LA773 ; brif still low LA777 bsr LA76C ; read output bcs LA777 ; brif still high rts ; Start tape and look for sync bytes CASON orcc #0x50 ; disable interrupts bsr LA7CA ; turn on tape clr CPULWD ; reset timer LA782 bsr LA763 ; wait for low-high transition LA784 bsr LA7AD ; wait for it to go low again bhi LA797 ; brif in range for 1200 Hz LA788 bsr LA7A7 ; wait for it to go high again blo LA79B ; brif in range for 2400 Hz dec CPULWD ; decrement counter (synched on low-high) lda CPULWD ; get counter cmpa #-96 ; have we seen 96 1-0-1-0 patterns (48 0x55s)? LA792 bne LA782 ; brif not - wait some more sta CBTPHA ; save phase we synched on rts LA797 bsr LA7A7 ; wait for it to go high again bhi LA784 ; brif another 1200 Hz, 2 in a row, try again LA79B bsr LA7AD ; wait for it to go low again blo LA788 ; brif another 2400 Hz; go try again for high inc CPULWD ; bump counter lda CPULWD ; get counter suba #96 ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa) bra LA792 ; set phase and return or keep waiting LA7A7 clr CPERTM ; reset period timer bsr LA767 ; wait for high bra LA7B1 ; set flags on result LA7AD clr CPERTM ; reset period timer bsr LA777 ; wait for low LA7B1 ldb CPERTM ; get period count cmpb CMP0 ; is it too long for 1200Hz? bhi LA7BA ; brif so - reset counts cmpb CMP1 ; set C if 2400Hz, clear C if 1200 Hz rts LA7BA clr CPULWD ; reset sync counter (too slow or drop out) rts ; MOTOR command MOTOR tfr a,b ; save ON/OFF jsr GETNCH ; eat the ON/OFF token cmpb #0xaa ; OFF? beq LA7E9 ; brif so - turn off tape cmpb #0x88 ; ON? jsr LA5C9 ; SN error if no match ; Turn on tape LA7CA lda PIA1+1 ; get motor control value ora #8 ; turn on bit 3 (starts motor) bsr LA7F0 ; put it back (dumb but it saves a byte) LA7D1 ldx ZERO ; maximum delay timer LA7D3 leax -1,x ; count down bne LA7D3 ; brif not at 0 yet rts ; Write a synch leader to tape WRLDR orcc #0x50 ; disable interrupts bsr LA7CA ; turn on tape ldx SYNCLN ; get count of 0x55s to write LA7DE bsr LA828 ; write a 0x55 leax -1,x ; done? bne LA7DE ; brif not rts ; Write sync bytes and a block, then stop tape LA7E5 bsr WRLDR ; write sync LA7E7 bsr SNDBLK ; write block ; Turn off tape LA7E9 andcc #0xaf ; enable interrupts lda PIA1+1 ; get control register anda #0xf7 ; disable motor bit LA7F0 sta PIA1+1 ; set motor enable bit rts ; Write a block to tape. SNDBLK orcc #0x50 ; disable interrupts ldb BLKLEN ; get block size stb CSRERR ; initialize character counter lda BLKLEN ; initialize checksum beq LA805 ; brif empty block ldx CBUFAD ; point to tape buffer LA800 adda ,x+ ; accumulate checksum decb ; end of block data? bne LA800 ; brif not LA805 adda BLKTYP ; accumulate block type into checksum sta CCKSUM ; save calculated checksum ldx CBUFAD ; point to buffer bsr LA828 ; send a 0x55 lda #0x3c ; and then a 0x3c bsr LA82A lda BLKTYP ; send block type bsr LA82A lda BLKLEN ; send block size bsr LA82A tsta ; empty block? beq LA824 ; brif so LA81C lda ,x+ ; send character from block data bsr LA82A dec CSRERR ; are we done yet? bne LA81C ; brif not LA824 lda CCKSUM ; send checksum bsr LA82A LA828 lda #0x55 ; send a 0x55 LA82A pshs a ; save output byte ldb #1 ; initialize bit probe LA82E lda CLSTSN ; get ending value of last cycle sta PIA1 ; set DA ldy #LA85C ; point to sine wave table bitb ,s ; is bit set? bne LA848 ; brif so - do high frequency LA83B lda ,y+ ; get next sample (use all for low frequency) cmpy #LA85C+36 ; end of table? beq LA855 ; brif so sta PIA1 ; set output sample bra LA83B ; do another sample LA848 lda ,y++ ; get next sample (use every other for high frequency) cmpy #LA85C+36 ; end of table? beq LA855 ; brif so sta PIA1 ; send output sample bra LA848 ; do another sample LA855 sta CLSTSN ; save last sample that *would* have been sent lslb ; shift mask to next bit bcc LA82E ; brif not done all 8 bits puls a,pc ; get back original character and return ; This is the sample table for the tape sine wave LA85C fcb 0x82,0x92,0xaa,0xba,0xca,0xda fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2 fcb 0xea,0xda,0xca,0xba,0xaa,0x92 fcb 0x7a,0x6a,0x52,0x42,0x32,0x22 fcb 0x12,0x0a,0x02,0x02,0x02,0x0a fcb 0x12,0x22,0x32,0x42,0x52,0x6a ; SET command SET bsr LA8C1 ; get absolute screen position of graphics block pshs x ; save character location jsr LB738 ; evaluate comma then expression in B puls x ; get back character pointer cmpb #8 ; valid colour? bhi LA8D5 ; brif not decb ; normalize colours bmi LA895 ; brif colour 0 (use current colour) lda #0x10 ; 16 patterns per colour mul bra LA89D ; go save the colour LA895 ldb ,x ; get current value bpl LA89C ; brif not grahpic andb #0x70 ; keep only the colour skip1 LA89C clrb ; reset block to all black LA89D pshs b ; save colour bsr LA90D ; force a ) lda ,x ; get current screen value bmi LA8A6 ; brif graphic block already clra ; force all pixels off LA8A6 anda #0x0f ; keep only pixel data ora GRBLOK ; set the desired pixel ora ,s+ ; merge with desired colour LA8AC ora #0x80 ; force it to be a graphic block sta ,x ; put new block on screen rts ; RESET command RESET bsr LA8C1 ; get address of desired block bsr LA90D ; force a ) clra ; zero block (no pixels) ldb ,x ; is it graphics? bpl LA8AC ; brif not - just blank the block com GRBLOK ; invert pixel data andb GRBLOK ; turn off the desired pixel stb ,x ; put new pixel data on screen rts ; Parse SET/RESET/POINT coordinates except for closing ) LA8C1 jsr LB26A ; make sure it starts with ( LA8C4 jsr RVEC21 ; do the RAM hook dance jsr EVALEXPB ; get first coordinate cmpb #63 ; valid horizontal coordinate bhi LA8D5 ; brif out of range pshs b ; save horizontal coordinate jsr LB738 ; look for , followed by vertical coordinate cmpb #31 ; in range for vertical? LA8D5 bhi LA948 ; brif not pshs b ; save vertical coordinate lsrb ; divide by two (two blocks per row) lda #32 ; 32 bytes per row mul ; now we have the offset into video RAM ldx #VIDRAM ; point to start of screen leax d,x ; now X points to the correct character row ldb 1,s ; get horizontal coordinate lsrb ; divide by two (two per character cell) abx ; now we're pointing to the correct character cell puls a,b ; get back coordinates (vertical in A) anda #1 ; keep only row offset of vertical rorb ; get column offset of horizontal to C rola ; now we have "row * 2 + col" in A ldb #0x10 ; make a bit mask (one bit left of first pixel) LA8EE lsrb ; move mask right deca ; at the right pixel? bpl LA8EE ; brif not stb GRBLOK ; save graphics block mask rts ; POINT function POINT bsr LA8C4 ; evaluate coordinates ldb #0xff ; default colour value is -1 (not graphics) lda ,x ; get character bpl LA90A ; brif not graphics anda GRBLOK ; is desired pixel set? beq LA909 ; brif not - return 0 for "black" ldb ,x ; get graphics data lsrb ; shift right 4 to get colour in low bits lsrb lsrb lsrb andb #7 ; lose the graphics block bias LA909 incb ; shift colours into 1 to 8 range LA90A jsr LA5E8 ; convert B to floating point LA90D jmp LB267 ; make sure we have a ) and return ; CLS command CLS jsr RVEC22 ; do the RAM hook dance LA913 beq LA928 ; brif no colour - just do a basic screen clear jsr EVALEXPB ; evaluate colour number cmpb #8 ; valid colour? bhi LA937 ; brif not - do the easter egg tstb ; color 0? beq LA925 ; brif so decb ; normalize to 0 based colour numbers lda #0x10 ; 16 blocks per colour mul ; now we have the base code for that colour orb #0x0f ; set all pixels LA925 orb #0x80 ; make it a graphics block skip2 LA928 ldb #0x60 ; VDG screen space character ldx #VIDRAM ; point to start of screen LA92D stx CURPOS ; set cursor position LA92F stb ,x+ ; blank a character cmpx #VIDRAM+511 ; end of screen? bls LA92F ; brif not rts LA937 bsr LA928 ; clear te screen ldx #LA166-1 ; point to the easter egg jmp STRINOUT ; go display it ; Evaluate an expression to B, prefixed by a comma, and do FC error if 0 LA93F jsr SYNCOMMA ; force a comma LA942 jsr EVALEXPB ; evaluate expression to B tstb ; is it 0? bne LA984 ; brif not - return LA948 jmp LB44A ; raise FC error ; SOUND command SOUND bsr LA942 ; evaluate frequency stb SNDTON ; save it bsr LA93F ; evaluate duration (after a comma) LA951 lda #4 ; constant factor for duration (each increment is 1/15 of a second) mul std SNDDUR ; save length of sound (IRQ will count it down) lda PIA0+3 ; enable 60 Hz interrupt ora #1 sta PIA0+3 clr ARYDIS ; clear array disable flag for some reason bsr LA9A2 ; connect DAC to MUX output bsr LA976 ; turn on sound LA964 bsr LA985 ; store mid range output value and delay lda #0xfe ; store high value and delay bsr LA987 bsr LA985 ; store mid range value and delay lda #2 ; store low value and delay bsr LA987 ldx SNDDUR ; has timer expired? bne LA964 ; brif not, do another wave ; Disable sound output LA974 clra ; bit 3 to 0 will disable output skip2 ; Enable sound output LA976 lda #8 ; bit 3 set to enable output sta ,-s ; save desired value lda PIA1+3 ; get control register value anda #0xf7 ; reset value ora ,s+ ; set to desired value sta PIA1+3 ; set new sound output status LA984 rts LA985 lda #0x7e ; mid range value for DAC LA987 sta PIA1 ; set DAC output value lda SNDTON ; get frequency LA98C inca ; increment it (gives shorter count with higher values, so higher frequencies work) bne LA98C ; brif not done yet rts ; AUDIO command AUDIO tfr a,b ; save ON/OFF token jsr GETNCH ; munch the ON/OFF token cmpb #0xaa ; OFF? beq LA974 ; brif so subb #0x88 ; ON? jsr LA5C9 ; do SN error if not incb ; now B is 1 - cassette sound source bsr LA9A2 ; set MUX input to tape bra LA976 ; enable sound ; Set MUX source to value in B LA9A2 ldu #PIA0+1 ; point to PIA0 control register A bsr LA9A7 ; program bit 0 then fall through for bit 1 LA9A7 lda ,u ; get control register value anda #0xf7 ; reset mux control bit asrb ; shift desired value to C bcc LA9B0 ; brif this bit is clear ora #8 ; set the bit LA9B0 sta ,u++ ; set register value and move to next register rts ; IRQ service routine BIRQSV lda PIA0+3 ; check for VSYNC interrupt bpl LA9C5 ; brif not - return. BUG: should clear HSYNC interrupt status first lda PIA0+2 ; clear VSYNC interrupt status LA9BB ldx >SNDDUR ; are we counting down for SOUND? (force extended in case DP is modified) beq LA9C5 ; brif not leax -1,x ; count down one tick stx >SNDDUR ; save new count (forced extended in case DP is modified) LA9C5 rti ; JOYSTK function JOYSTK jsr LB70E ; evaluate which joystick axis is desired cmpb #3 ; valid axis? lbhi LB44A ; brif not tstb ; want axis 0? bne LA9D4 ; brif not bsr GETJOY ; read axis data if axis 0 LA9D4 ldx #POTVAL ; point to axis values ldb FPA0+3 ; get desired axis ldb b,x ; get axis value jmp LB4F3 ; return value ; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches ; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed, ; this routine will do the read *ten times* before just returning the last value. This is assininely ; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note ; also that this routine should be using PSHS and PULS but it doesn't. GETJOY bsr LA974 ; turn off sound ldx #POTVAL+4 ; point to the end of the axis data (we'll work backwards) ldb #3 ; start with axis 3 LA9E5 lda #10 ; 10 tries to see if we match *the last call* to this routine std ,--s ; save retry counter and axis number bsr LA9A2 ; set MUX for the correct axis LA9EB ldd #0x4080 ; set initial trial value to mid range and the next difference to add/subtract to half LA9EE sta ,-s ; store the add/subtract value orb #2 ; keep rs232 output marking stb PIA1 ; set DAC output to the trial value eorb #2 ; remove RS232 output value lda PIA0 ; read the comparator bmi LA9FF ; brif comparator output is high (DAC is lower than the axis value) subb ,s ; subtract next bit value (split the difference toward 0) skip2 LA9FF addb ,s ; add next bit value (split the different toward infinity) lda ,s+ ; get bit value back lsra ; cut in half cmpa #1 ; have we done that last value for the DAC? bne LA9EE ; brif not lsrb ; normalize the axis value lsrb cmpb -1,x ; does it match the read from the last call to this routine? beq LAA12 ; brif so dec ,s ; are we out of retries? bne LA9EB ; brif not - try again LAA12 stb ,-x ; save new value and move pointer back ldd ,s++ ; get axis counter and clean up retry counter decb ; move to next axis bpl LA9E5 ; brif still more axes to do rts ; This is the "bottom half" of the character fetching routines. BROMHK cmpa #'9+1 ; is it >= colon? bhs LAA28 ; brif so Z set if colon, C clear. cmpa #0x20 ; space? bne LAA24 ; brif not jmp GETNCH ; move on to another character if space LAA24 suba #'0 ; normalize ascii digit to 0-9; we already handled above digit 9 suba #-'0 ; this will cause a carry for any value that was already positive LAA28 rts ; Jump table for functions LAA29 fdb SGN ; SGN 0x80 fdb INT ; INT 0x81 fdb ABS ; ABS 0x82 fdb USRJMP ; USR 0x83 fdb RND ; RND 0x84 fdb SIN ; SIN 0x85 fdb PEEK ; PEEK 0x86 fdb LEN ; LEN 0x87 fdb STR ; STR$ 0x88 fdb VAL ; VAL 0x89 fdb ASC ; ASC 0x8a fdb CHR ; CHR$ 0x8b fdb EOF ; EOF 0x8c fdb JOYSTK ; JOYSTK 0x8d fdb LEFT ; LEFT$ 0x8e fdb RIGHT ; RIGHT$ 0x8f fdb MID ; MID$ 0x90 fdb POINT ; POINT 0x91 fdb INKEY ; INKEY$ 0x92 fdb MEM ; MEM 0x93 ; Operator precedence and jump table (binary ops except relational) LAA51 fcb 0x79 ; + fdb LB9C5 fcb 0x79 ; - fdb LB9BC fcb 0x7b ; * fdb LBACC fcb 0x7b ; / fdb LBB91 fcb 0x7f ; ^ (exponentiation) fdb EXPJMP fcb 0x50 ; AND fdb LB2D5 fcb 0x46 ; OR fdb LB2D4 ; Reserved words table for commands LAA66 fcs 'FOR' ; 0x80 fcs 'GO' ; 0x81 fcs 'REM' ; 0x82 fcs "'" ; 0x83 fcs 'ELSE' ; 0x84 fcs 'IF' ; 0x85 fcs 'DATA' ; 0x86 fcs 'PRINT' ; 0x87 fcs 'ON' ; 0x88 fcs 'INPUT' ; 0x89 fcs 'END' ; 0x8a fcs 'NEXT' ; 0x8b fcs 'DIM' ; 0x8c fcs 'READ' ; 0x8d fcs 'RUN' ; 0x8e fcs 'RESTORE' ; 0x8f fcs 'RETURN' ; 0x90 fcs 'STOP' ; 0x91 fcs 'POKE' ; 0x92 fcs 'CONT' ; 0x93 fcs 'LIST' ; 0x94 fcs 'CLEAR' ; 0x95 fcs 'NEW' ; 0x96 fcs 'CLOAD' ; 0x97 fcs 'CSAVE' ; 0x98 fcs 'OPEN' ; 0x99 fcs 'CLOSE' ; 0x9a fcs 'LLIST' ; 0x9b fcs 'SET' ; 0x9c fcs 'RESET' ; 0x9d fcs 'CLS' ; 0x9e fcs 'MOTOR' ; 0x9f fcs 'SOUND' ; 0xa0 fcs 'AUDIO' ; 0xa1 fcs 'EXEC' ; 0xa2 fcs 'SKIPF' ; 0xa3 fcs 'TAB(' ; 0xa4 fcs 'TO' ; 0xa5 fcs 'SUB' ; 0xa6 fcs 'THEN' ; 0xa7 fcs 'NOT' ; 0xa8 fcs 'STEP' ; 0xa9 fcs 'OFF' ; 0xaa fcs '+' ; 0xab fcs '-' ; 0xac fcs '*' ; 0xad fcs '/' ; 0xae fcs '^' ; 0xaf fcs 'AND' ; 0xb0 fcs 'OR' ; 0xb1 fcs '>' ; 0xb2 fcs '=' ; 0xb3 fcs '<' ; 0xb4 ; Reserved word list for functions LAB1A fcs 'SGN' ; 0x80 fcs 'INT' ; 0x81 fcs 'ABS' ; 0x82 fcs 'USR' ; 0x83 fcs 'RND' ; 0x84 fcs 'SIN' ; 0x85 fcs 'PEEK' ; 0x86 fcs 'LEN' ; 0x87 fcs 'STR$' ; 0x88 fcs 'VAL' ; 0x89 fcs 'ASC' ; 0x8a fcs 'CHR$' ; 0x8b fcs 'EOF' ; 0x8c fcs 'JOYSTK' ; 0x8d fcs 'LEFT$' ; 0x8e fcs 'RIGHT$' ; 0x8f fcs 'MID$' ; 0x90 fcs 'POINT' ; 0x91 fcs 'INKEY$' ; 0x92 fcs 'MEM' ; 0x93 ; Jump table for commands LAB67 fdb FOR ; 0x80 FOR fdb GO ; 0x81 GO fdb REM ; 0x82 REM fdb REM ; 0x83 ' fdb REM ; 0x84 ELSE fdb IFTOK ; 0x85 IF fdb DATA ; 0x86 DATA fdb PRINT ; 0x87 PRINT fdb ON ; 0x88 ON fdb INPUT ; 0x89 INPUT fdb ENDTOK ; 0x8a END fdb NEXT ; 0x8b NEXT fdb DIM ; 0x8c DIM fdb READ ; 0x8d READ fdb RUN ; 0x8e RUN fdb RESTOR ; 0x8f RESTORE fdb RETURN ; 0x90 RETURN fdb STOP ; 0x91 STOP fdb POKE ; 0x92 POKE fdb CONT ; 0x93 CONT fdb LIST ; 0x94 LIST fdb CLEAR ; 0x95 CLEAR fdb NEW ; 0x96 NEW fdb CLOAD ; 0x97 CLOAD fdb CSAVE ; 0x98 CSAVE fdb OPEN ; 0x99 OPEN fdb CLOSE ; 0x9a CLOSE fdb LLIST ; 0x9b LLIST fdb SET ; 0x9c SET fdb RESET ; 0x9d RESET fdb CLS ; 0x9e CLS fdb MOTOR ; 0x9f MOTOR fdb SOUND ; 0xa0 SOUND fdb AUDIO ; 0xa1 AUDIO fdb EXEC ; 0xa2 EXEC fdb SKIPF ; 0xa3 SKIPF ; Error message table LABAF fcc 'NF' ; 0 NEXT without FOR fcc 'SN' ; 1 Syntax error fcc 'RG' ; 2 RETURN without GOSUB fcc 'OD' ; 3 Out of data fcc 'FC' ; 4 Illegal function call fcc 'OV' ; 5 Overflow fcc 'OM' ; 6 Out of memory fcc 'UL' ; 7 Undefined line number fcc 'BS' ; 8 Bad subscript fcc 'DD' ; 9 Redimensioned array fcc '/0' ; 10 Division by 0 fcc 'ID' ; 11 Illegal direct statement fcc 'TM' ; 12 Type mismatch fcc 'OS' ; 13 Out of string space fcc 'LS' ; 14 String too long fcc 'ST' ; 15 String formula too complex fcc 'CN' ; 16 Can't continue fcc 'FD' ; 17 Bad file data fcc 'AO' ; 18 File already open fcc 'DN' ; 19 Device number error fcc 'IO' ; 20 Input/output error fcc 'FM' ; 21 Bad file mode fcc 'NO' ; 22 File not open fcc 'IE' ; 23 Input past end of file fcc 'DS' ; 24 Direct statement in file LABE1 fcn ' ERROR' LABE8 fcn ' IN ' LABED fcb 0x0d LABEE fcc 'OK' fcb 0x0d,0x00 LABF2 fcb 0x0d fcn 'BREAK' ; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT ; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL ; for the first match. ; ; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the ; 6809's registers. This requires some minor tweaks where the routine is called. Further, the ; use of B is completely pointless and, even if B is going to be used, why is it reloaded on ; every loop? LABF9 leax 4,s ; skip past our caller and the main command loop return address LABFB ldb #18 ; each FOR/NEXT frame is 18 bytes stx TEMPTR ; save current search pointer lda ,x ; get first byte of this frame suba #0x80 ; set to 0 if FOR/NEXT bne LAC1A ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame) ldx 1,x ; get index variable descriptor stx TMPTR1 ; save it ldx VARDES ; get desired index descriptor beq LAC16 ; brif NULL - we found something cmpx TMPTR1 ; does this one match? beq LAC1A ; brif so ldx TEMPTR ; get back frame pointer abx ; move to next entry bra LABFB ; check next block of data LAC16 ldx TMPTR1 ; get index variable of this frame stx VARDES ; set it as the one found LAC1A ldx TEMPTR ; get matching frame pointer tsta ; set Z if FOR/NEXT rts ; This is a block copy routine which copies from top to bottom. It's not clear that the use of ; this routine actually saves any ROM space compared to just implementing the copies directly ; once all the marshalling to set up the parameter variables is taken into account. LAC1E bsr LAC37 ; check to see if stack collides with D LAC20 ldu V41 ; point to destination leau 1,u ; offset for pre-dec ldx V43 ; point to source leax 1,x ; offset for pre-dec LAC28 lda ,-x ; get source byte pshu a ; store at destination (sta ,-u would be less weird) cmpx V47 ; at the bottom of the copy? bne LAC28 ; brif not stu V45 ; save final destination address LAC32 rts ; Check for 2*B (0 <= B <= 127) bytes for free memory LAC33 clra ; zero extend aslb ; times 2 (loses bit 7 of B) addd ARYEND ; add to top of used memory LAC37 addd #STKBUF ; add a fudge factor for interpreter operation bcs LAC44 ; brif >65535! sts BOTSTK ; get current stack pointer cmpd BOTSTK ; is our new address above that? blo LAC32 ; brif not - no error LAC44 ldb #6*2 ; raise OM error ; The error servicing routine LAC46 jsr RVEC16 ; do the RAM hook dance (ON ERROR reserved hook) LAC49 jsr RVEC17 ; do the RAM hook dance again jsr LA7E9 ; turn off tape jsr LA974 ; disable sound jsr LAD33 ; reset stack, etc. clr DEVNUM ; reset output to screen jsr LB95C ; do a newline jsr LB9AF ; send a ? ldx #LABAF ; point to error table LAC60 abx ; offset to correct message bsr LACA0 ; send a char from X bsr LACA0 ; send another char from X LAC65 ldx #LABE1-1 ; point to "ERROR" message LAC68 jsr STRINOUT ; print ERROR message (or BREAK) lda CURLIN ; are we in immediate mode? inca beq LAC73 ; brif not - go to immediate mode jsr LBDC5 ; print "IN ****" ; This is the immediate mode loop LAC73 jsr LB95C ; do a newline if needed LAC76 ldx #LABEE-1 ; point to prompt (without leading CR) jsr STRINOUT ; show prompt LAC7C jsr LA390 ; read an input line ldu #0xffff ; flag immediate mode stu CURLIN bcs LAC7C ; brif we ended on BREAK - just go for another line tst CINBFL ; EOF? lbne LA4BF ; brif so stx CHARAD ; save start of input line as input pointer jsr GETNCH ; get character from input line beq LAC7C ; brif no input bcs LACA5 ; brif numeric - adding or removing a line number ldb #2*24 ; code for "direct statement in file" tst DEVNUM ; keyboard input? bne LAC46 ; brif not - complain about direct statement jsr LB821 ; go tokenize the input line LAC9D jmp LADC0 ; go execute the newly tokenized line LACA0 lda ,x+ ; get character and advance pointer jmp LB9B1 ; output it LACA5 jsr LAF67 ; convert line number to binary LACA8 ldx BINVAL ; get converted number stx LINHDR ; put it before the line we just read jsr LB821 ; tokenize the input line stb TMPLOC ; save line length bsr LAD01 ; find where the line should be in the program bcs LACC8 ; brif the line number isn't already present ldd V47 ; get address where the line is in the program subd ,x ; get the difference between here and the end of the line (negative) addd VARTAB ; subtract line length from the end of the program std VARTAB ; save new end of program address ldu ,x ; get start of next line LACC0 pulu a ; get source byte (lda ,u+ would be less weird) sta ,x+ ; move it down cmpx VARTAB ; have we moved everything yet? bne LACC0 ; brif not LACC8 lda LINBUF ; see if there is actually a line to input beq LACE9 ; brif not - we just needed to remove the line ldd VARTAB ; get current end of program std V43 ; set as source pointer addb TMPLOC ; add in the length of the new line adca #0 std V41 ; save destination pointer jsr LAC1E ; make sure there's enough room and then make a hole for the new line ldu #LINHDR-2 ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer) LACDD pulu a ; get byte from new line (lda ,u+ would be less weird) sta ,x+ ; stow it cmpx V45 ; at the end of the hole we just made? bne LACDD ; brif not ldx V41 ; get save new top of program address stx VARTAB LACE9 bsr LAD21 ; reset variables, etc. bsr LACEF ; adjust next line pointers bra LAC7C ; go read another input line ; Recompute next line pointers LACEF ldx TXTTAB ; point to start of program LACF1 ldd ,x ; get address of next line beq LAD16 ; brif end of program leau 4,x ; move past pointer and line number LACF7 lda ,u+ ; are we at the end of the line? bne LACF7 ; brif not stu ,x ; save new next line pointer ldx ,x ; point to next line bra LACF1 ; process the next line ; Find a line in the program LAD01 ldd BINVAL ; get desired line number ldx TXTTAB ; point to start of program LAD05 ldu ,x ; get address of next line beq LAD12 ; brif end of program cmpd 2,x ; do we have a match? bls LAD14 ; brif our search number is <= the number here ldx ,x ; move to next line bra LAD05 ; check another line LAD12 orcc #1 ; set C for not found LAD14 stx V47 ; save address of matching line *or* line just after where it would have been LAD16 rts ; NEW command ; This routine has multiple entry points used for various "levels" of NEW NEW bne LAD14 ; brif there was input given; should be LAD16! LAD19 ldx TXTTAB ; point to start of program clr ,x+ ; blank out program (with NULL next line pointer) clr ,x+ stx VARTAB ; save end of program LAD21 ldx TXTTAB ; get start of program jsr LAEBB ; put input pointer there LAD26 ldx MEMSIZ ; reset string space stx STRTAB jsr RESTOR ; reset DATA pointer ldx VARTAB ; clear out scalars and arrays stx ARYTAB stx ARYEND LAD33 ldx #STRSTK ; reset the string stack stx TEMPPT ldx ,s ; get return address (we're going to reset the stack) lds FRETOP ; reset the stack to top of memory clr ,-s ; put stopper so FOR/NEXT search will actually stop here LAD3F clr OLDPTR ; reset "CONT" state clr OLDPTR+1 LAD43 clr ARYDIS ; un-disable arrays jmp ,x ; return to original caller ; FOR command FOR lda #0x80 ; disable array parsing sta ARYDIS jsr LET ; assign start value to index jsr LABF9 ; search stack for matching FOR/NEXT frame leas 2,s ; lose return address bne LAD59 ; brif variable not already being used ldx TEMPTR ; get address of matched data leas b,x ; move stack pointer to the end of it (B is set to 18 in the stack search) LAD59 ldb #9 ; is there room for 18 bytes in memory? jsr LAC33 jsr LAEE8 ; get address of the end of this statement in X ldd CURLIN ; get line number pshs x,b,a ; save next line address and current line number ldb #0xa5 ; make sure we have TO jsr LB26F jsr LB143 ; make sure we have a numeric index jsr LB141 ; evaluate terminal condition value ldb FP0SGN ; pack FPA0 in place orb #0x7f andb FPA0 stb FPA0 ldy #LAD7F ; where to come back to jmp LB1EA ; stash terminal condition on the stack LAD7F ldx #LBAC5 ; point to FP 1.0 (default step) jsr LBC14 ; unpack it to FPA0 jsr GETCCH ; get character after the terminal cmpa #0xa9 ; is it STEP? bne LAD90 ; brif not jsr GETNCH ; eat STEP jsr LB141 ; evaluate step condition LAD90 jsr LBC6D ; get "status" of FPA0 jsr LB1E6 ; stash FPA0 on the stack (for step value) ldd VARDES ; get variable descriptor pointer pshs d ; put that on the stack too lda #0x80 ; flag the frame as a FOR/NEXT frame pshs a ; Main command interpretation loop LAD9E jsr RVEC20 ; do the RAM hook dance andcc #0xaf ; make sure interrupts are running bsr LADEB ; check for BREAK/pause ldx CHARAD ; get input pointer stx TINPTR ; save input pointer for start of line lda ,x+ ; get current input character beq LADB4 ; brif end of line - move to another line cmpa #': ; end of statement? beq LADC0 ; brif so - keep processing LADB1 jmp LB277 ; raise a syntax error LADB4 lda ,x++ ; get MSB of next line pointer and skip past pointer sta ENDFLG beq LAE15 ; brif MSB of next line address is 0 (do END) ldd ,x+ ; get line number but only advance one std CURLIN ; set current line number stx CHARAD ; set input pointer to one before line text LADC0 jsr GETNCH ; move past statement separator or to first character in line bsr LADC6 ; process a command LADC4 bra LAD9E ; handle next statement or line LADC6 beq LAE40 ; return if end of statement tsta ; is it a token? lbpl LET ; brif not - do a LET cmpa #0xa3 ; above SKIPF? bhi LADDC ; brif so ldx COMVEC+3 ; point to jump table LADD4 lsla ; two bytes per entry (loses the token bias) tfr a,b ; put it in B for unsigned ABX abx jsr GETNCH ; move past token jmp [,x] ; transfer control to the handler (which will return to the main loop) LADDC cmpa #0xb4 ; is it a non-executable token? bls LADB1 ; brif so jmp [COMVEC+13] ; transfer control to ECB command handler ; RESTORE command RESTOR ldx TXTTAB ; point to beginning of the program leax -1,x ; move back one (to compensate for "GETNCH") LADE8 stx DATPTR ; save as new data pointer rts ; BREAK check LADEB jsr LA1C1 ; read keyboard beq LADFA ; brif no key down LADF0 cmpa #3 ; BREAK? beq STOP ; brif so - do a STOP LADF4 cmpa #0x13 ; pause (SHIFT-@)? beq LADFB ; brif so sta IKEYIM ; cache key for later INKEY$ so break check doesn't break INKEY$ LADFA rts LADFB jsr KEYIN ; read keyboard beq LADFB ; brif no key down bra LADF0 ; process pressed key in case BREAK or SHIFT-@ again ; END command ENDTOK jsr LA426 ; close files jsr GETCCH ; re-get input character bra LAE0B ; STOP command STOP orcc #1 ; flag "STOP" LAE0B bne LAE40 ; brif not end of statement ldx CHARAD ; save current input pointer stx TINPTR LAE11 ror ENDFLG ; save END/STOP flag (C) leas 2,s ; lose return address LAE15 ldx CURLIN ; get current input line (end of program comes here) cmpx #0xffff ; immediate mode? beq LAE22 ; brif so stx OLDTXT ; save line where we stopped executing ldx TINPTR ; get input pointer stx OLDPTR ; save location where we stopped executing LAE22 clr DEVNUM ; reset to screen/keyboard ldx #LABF2-1 ; point to BREAK message tst ENDFLG ; are we doing "BREAK"? lbpl LAC73 ; brif not jmp LAC68 ; go do the BREAK message and return to main loop ; CONT command CONT bne LAE40 ; brif not end of statement ldb #2*16 ; code for can't continue ldx OLDPTR ; get saved execution pointer lbeq LAC46 ; brif no saved pointer - raise CN error stx CHARAD ; reset input pointer ldx OLDTXT ; reset current line number stx CURLIN LAE40 rts ; CLEAR command CLEAR beq LAE6F ; brif no argument jsr LB3E6 ; evaluate string space size pshs d ; save it ldx MEMSIZ ; get memory size (top of memory) jsr GETCCH ; is there anything after the string space size? beq LAE5A ; brif not jsr SYNCOMMA ; force a comma jsr LB73D ; get top of memory value in X leax -1,x ; move back one (top of cleared space) cmpx TOPRAM ; is it within the memory available? bhi LAE72 ; brif higher than top of memory - OM error LAE5A tfr x,d ; so we can do math for checking memory usage subd ,s++ ; subtract out string space value bcs LAE72 ; brif less than 0 tfr d,u ; U is bottom of cleared space subd #STKBUF ; also account for slop space bcs LAE72 ; brif less than 0 subd VARTAB ; is there still room for the program? blo LAE72 ; brif not stu FRETOP ; set top of free memory stx MEMSIZ ; set size of usable memory LAE6F jmp LAD26 ; erase variables, etc. LAE72 jmp LAC44 ; raise OM error ; RUN command RUN jsr RVEC18 ; do the RAM hook dance jsr LA426 ; close any open files jsr GETCCH ; is there a line number lbeq LAD21 ; brif no line number - start from beginning jsr LAD26 ; clear variables, etc. bra LAE9F ; "GOTO" the line number ; GO command (GOTO and GOSUB) GO tfr a,b ; save TO/SUB LAE88 jsr GETNCH ; eat the TO/SUB token cmpb #0xa5 ; TO? beq LAEA4 ; brif GOTO cmpb #0xa6 ; SUB? bne LAED7 ; brif not ldb #3 ; room for 6 bytes? jsr LAC33 ldu CHARAD ; get input pointer ldx CURLIN ; get line number lda #0xa6 ; flag for GOSUB frame pshs u,x,a ; set stack frame LAE9F bsr LAEA4 ; do "GOTO" jmp LAD9E ; go back to main loop ; Actual GOTO is here LAEA4 jsr GETCCH ; get current input jsr LAF67 ; convert number to binary bsr LAEEB ; move input pointer to end of statement leax 1,x ; point to start of next line ldd BINVAL ; get desired line number cmpd CURLIN ; is it beyond here? bhi LAEB6 ; brif so ldx TXTTAB ; start search at beginning of program LAEB6 jsr LAD05 ; find line number bcs LAED2 ; brif not found LAEBB leax -1,x ; move to just before start of line stx CHARAD ; reset input pointer LAEBF rts ; RETURN command RETURN bne LAEBF ; exit if argument given lda #0xff ; set VARDES to an illegal value so we ignore FOR frames sta VARDES jsr LABF9 ; look for a GOSUB frame tfr x,s ; reset stack cmpa #0xa6-0x80 ; is it a GOSUB frame? beq LAEDA ; brif so ldb #2*2 ; code for RETURN without GOSUB skip2 LAED2 ldb #7*2 ; code for undefined line number jmp LAC46 ; raise error LAED7 jmp LB277 ; raise syntax error LAEDA puls a,x,u ; get back saved line number and input pointer stx CURLIN ; reset line number stu CHARAD ; reset input pointer ; DATA command DATA bsr LAEE8 ; move input pointer to end of statement skip2 ; REM command (also ELSE) REM bsr LAEEB ; move input pointer to end of line stx CHARAD ; save new input pointer LAEE7 rts ; Return end of statement (LAEE8) or line (AEEB) in X LAEE8 ldb #': ; colon is statement terminator skip1lda LAEEB clrb ; make main terminator NUL stb CHARAC ; save terminator clrb ; end of line - always terminates ldx CHARAD ; get input pointer LAEF1 tfr b,a ; save secondary terminator ldb CHARAC ; get main terminator sta CHARAC ; save secondary LAEF7 lda ,x ; get input character beq LAEE7 ; brif end of line pshs b ; save terminator cmpa ,s+ ; does it match? beq LAEE7 ; brif so - bail leax 1,x ; move pointer ahead cmpa #'" ; start of string? beq LAEF1 ; brif so inca ; functon token? bne LAF0C ; brif not leax 1,x ; skip second part of function token LAF0C cmpa #0x85+1 ; IF? bne LAEF7 ; brif not inc IFCTR ; bump "IF" count bra LAEF7 ; get check another input character ; IF command IFTOK jsr LB141 ; evaluate condition jsr GETCCH ; find out what's after the conditin cmpa #0x81 ; GO? beq LAF22 ; treat same as THEN ldb #0xa7 ; make sure we have a THEN jsr LB26F LAF22 lda FP0EXP ; get true/false (false is 0) bne LAF39 ; brif condition true clr IFCTR ; reset IF counter LAF28 bsr DATA ; skip over statement tsta ; end of line? beq LAEE7 ; brif so jsr GETNCH ; get start of this statement cmpa #0x84 ; ELSE? bne LAF28 ; brif not dec IFCTR ; is it a matching ELSE? bpl LAF28 ; brif not - keep looking jsr GETNCH ; eat the ELSE LAF39 jsr GETCCH ; get current input lbcs LAEA4 ; brif numeric - to a GOTO jmp LADC6 ; let main loop interpret the next command ; ON command ON jsr EVALEXPB ; evaluate index expression LAF45 ldb #0x81 ; make sure we have "GO" jsr LB26F pshs a ; save TO/SUB cmpa #0xa6 ; SUB? beq LAF54 ; brif so cmpa #0xa5 ; TO? LAF52 bne LAED7 ; brif not LAF54 dec FPA0+3 ; are we at the right index? bne LAF5D ; brif not puls b ; get TO/SUB token jmp LAE88 ; go do GOTO or GOSUB LAF5D jsr GETNCH ; munch a character bsr LAF67 ; parse line number cmpa #', ; is there another line following? beq LAF54 ; brif so - see if we're there yet puls b,pc ; clean up TO/SUB token and return - we fell through ; Parse a line number LAF67 ldx ZERO ; initialize line number accumulator to 0 stx BINVAL LAF6B bcc LAFCE ; brif not numeric suba #'0 ; adjust to actual value of digit sta CHARAC ; save digit ldd BINVAL ; get accumulated number cmpa #24 ; will this overflow? bhi LAF52 ; brif so - raise syntax error aslb ; times 2 rola aslb ; times 4 rola addd BINVAL ; times 5 aslb ; times 10 rola addb CHARAC ; add in digit adca #0 std BINVAL ; save new accumulated number jsr GETNCH ; fetch next character bra LAF6B ; process next digit ; LET command (the LET keyword requires Extended Basic) LET jsr LB357 ; evaluate destination variable stx VARDES ; save descriptor pointer ldb #0xb3 ; make sure we have = jsr LB26F lda VALTYP ; get destination variable type pshs a ; save it for later jsr LB156 ; evaluate the expression to assign puls a ; get back original variable type rora ; put type in C jsr LB148 ; make sure the current result matches the type lbeq LBC33 ; bri fnumeric - copy FPA0 to variable LAFA4 ldx FPA0+2 ; point to descriptor of replacement string ldd FRETOP ; get bottom of string space cmpd 2,x ; is the string already in string space? bhs LAFBE ; brif so cmpx VARTAB ; is the descriptor in variable space? blo LAFBE ; brif not LAFB1 ldb ,x ; get length of string jsr LB50D ; allocate space for this string ldx V4D ; get descriptor pointer back jsr LB643 ; copy string into string space ldx #STRDES ; point to temporary string descriptor LAFBE stx V4D ; save descriptor pointer jsr LB675 ; remove string from string stack if appropriate ldu V4D ; get back replacement descriptor ldx VARDES ; get target descriptor pulu a,b,y ; get string length (A) and data pointer (Y) sta ,x ; save new length sty 2,x ; save new pointer LAFCE rts ; READ and INPUT commands. LAFCF fcc '?REDO' ; The ?REDO message fcb 0x0d,0x00 LAFD6 ldb #2*17 ; bad file data code tst DEVNUM ; are we reading from the keyboard? beq LAFDF ; brif so LAFDC jmp LAC46 ; raise the error LAFDF lda INPFLG ; are we doing INPUT? beq LAFEA ; brif so ldx DATTXT ; get line number where the DATA statement happened stx CURLIN ; set current line number to that so can report the correct location jmp LB277 ; raise a syntax error on bad data LAFEA ldx #LAFCF-1 ; show the ?REDO if we're doing INPUT jsr STRINOUT ldx TINPTR ;* reset input pointer to start of statement (this will cause the stx CHARAD ;* INPUT statement to be re-executed rts INPUT ldb #11*2 ; code for illegal direct statement ldx CURLIN ; are we in immediate mode? leax 1,x beq LAFDC ; brif so - raise ID error bsr LB002 ; go do the INPUT thing clr DEVNUM ; reset device to screen/keyboard rts LB002 cmpa #'# ; is there a device number? bne LB00F ; brif not jsr LA5A5 ; parse device number jsr LA3ED ; make sure it's valid for input jsr SYNCOMMA ; make sure we have a comma after the device number LB00F cmpa #'" ; is there a prompt string? bne LB01E ; brif not jsr LB244 ; parse the prompt string ldb #'; ; make sure we have a semicolon after the prompt jsr LB26F jsr LB99F ; print the prompt LB01E ldx #LINBUF ; point to line input buffer clr ,x ; NUL first byte to indicate no data tst DEVNUM ; is it keyboard input? bne LB049 ; brif not bsr LB02F ; read a line from the keyboard ldb #', ; put a comma at the start of the buffer stb ,x bra LB049 ; go process some input LB02F jsr LB9AF ; send a ? jsr LB9AC ; send a space LB035 jsr LA390 ; read input from the keyboard bcc LB03F ; brif not BREAK leas 4,s ; clean up stack LB03C jmp LAE11 ; go process BREAK LB03F ldb #2*23 ; input past end of file error code tst CINBFL ; was it EOF? bne LAFDC ; brif so - raise the error rts READ ldx DATPTR ; fetch current DATA pointer skip1lda ; set A to nonzero (for READ) LB049 clra ; set A to zero (for INPUT) sta INPFLG ; record whether we're doing READ or INPUT stx DATTMP ; save current input location LB04E jsr LB357 ; evaluate a variable (destination of data) stx VARDES ; save descriptor ldx CHARAD ; save interpreter input pointer stx BINVAL ldx DATTMP ; get data pointer lda ,x ; is there anything to read? bne LB069 ; brif so lda INPFLG ; is it INPUT? bne LB0B9 ; brif not jsr RVEC10 ; do the RAM hook dance jsr LB9AF ; send a ? (so subsequent lines get ??) bsr LB02F ; go read an input line LB069 stx CHARAD ; save data pointer jsr GETNCH ; fetch next data character ldb VALTYP ; do we want a number? beq LB098 ; brif so ldx CHARAD ; get input pointer sta CHARAC ; save initial character as the delimiter cmpa #'" ; do we have a string delimiter? beq LB08B ; brif so - use " as both delimiters leax -1,x ; back up input if we don't have a delimiter clra ; set delimiter to NUL (end of line) sta CHARAC jsr LA35F ; set up print parameters tst PRTDEV ; is it a file type device? bne LB08B ; brif so - use two NULs lda #': ; use colon as one delimiter sta CHARAC lda #', ; and use comma as the other LB08B sta ENDCHR ; save second terminator jsr LB51E ; parse out the string jsr LB249 ; move input pointer past the string jsr LAFA4 ; assign the string to the variable bra LB09E ; go see if there's more to read LB098 jsr LBD12 ; parse a numeric string jsr LBC33 ; assign the numbe to the variable LB09E jsr GETCCH ; get current input character beq LB0A8 ; brif end of line cmpa #', ; check for comma lbne LAFD6 ; brif not - we have bad data LB0A8 ldx CHARAD ; get current data pointer stx DATTMP ; save the data pointer ldx BINVAL ; restore the interpreter input pointer stx CHARAD jsr GETCCH ; get current input from program beq LB0D5 ; brif end of statement jsr SYNCOMMA ; make sure there's a comma between variables bra LB04E ; go read another item LB0B9 stx CHARAD ; reset input pointer jsr LAEE8 ; search for end of statement leax 1,x ; move past end of statement tsta ; was it end of line? bne LB0CD ; brif not ldb #2*3 ; code for out of data ldu ,x++ ; get pointer to next line beq LB10A ; brif end of program - raise OD error ldd ,x++ ; get line number std DATTXT ; record it for raising errors in DATA statements LB0CD lda ,x ; do we have a DATA statement? cmpa #0x86 bne LB0B9 ; brif not - keep scanning bra LB069 ; go process the input LB0D5 ldx DATTMP ; get data pointer ldb INPFLG ; were we doing READ? lbne LADE8 ; brif so - save DATA pointer lda ,x ; is there something after the input in the input buffer? beq LB0E7 ; brif not - we consumed everything ldx #LB0E8-1 ; print the ?EXTRA IGNORED message jmp STRINOUT LB0E7 rts LB0E8 fcc '?EXTRA IGNORED' fcb 0x0d,0x00 ; NEXT command NEXT bne LB0FE ; brif argument given ldx ZERO ; set to NULL descriptor pointer bra LB101 ; go process "any index will do" LB0FE jsr LB357 ; evaluate the variable LB101 stx VARDES ; save the index we're looking for jsr LABF9 ; search the stack for the matching frame beq LB10C ; brif we found a matching frame ldb #0 ; code for NEXT without FOR LB10A bra LB153 ; raise the error LB10C tfr x,s ; reset the stack to the start of the stack frame leax 3,x ; point to the STEP value jsr LBC14 ; copy the value to FPA0 lda 8,s ; get step direction sta FP0SGN ; save as sign of FPA0 ldx VARDES ; point to index variable jsr LB9C2 ; add (X) to FPA0 (steps the index) jsr LBC33 ; save new value to the index leax 9,s ; point to terminal condition jsr LBC96 ; compare the new index value with the terminal subb 8,s ; set B=0 if we hit the terminal (or passed it with nonzero step) beq LB134 ; brif loop complete ldx 14,s ; restore line number and input pointer to start of loop stx CURLIN ldx 16,s stx CHARAD LB131 jmp LAD9E ; return to interpretation loop LB134 leas 18,s ; remove the frame from the stack jsr GETCCH ; get character after the index cmpa #', ; do we have more indexes? bne LB131 ; brif not jsr GETNCH ; munch the comma bsr LB0FE ; go process another value ; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall ; through this point, nor will the stack grow without bound. The BSR is required to make sure ; the stack is aligned properly for the stack search for the subsequent index variable. ; ; The following is the expression evaluation system. It has various entry points including for type ; checking. This really consists of two co-routines, one for evaluating operators and one for individual ; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow ; just how some of this works. ; ; Evaluate numeric expression LB141 bsr LB156 ; evaluate an expression ; TM error if string LB143 andcc #0xfe ; clear C to indicate we want a number skip2keepc ; TM error if numeric LB146 orcc #1 ; set C to indicate we want a string ; TM error if: C = 1 and number, OR C = 0 and string LB148 tst VALTYP ; set flags on the current value to (doesn't change C) bcs LB14F ; brif we want a string bpl LB0E7 ; brif we have a number (we want a number) skip2 LB14F bmi LB0E7 ; brif we have a string (we want a string) LB151 ldb #12*2 ; code for TM error LB153 jmp LAC46 ; raise the error ; The general expression evaluation entry point LB156 bsr LB1C6 ; back up input pointer to compensate for GETNCH below LB158 clra ; set operator precedence to 0 (no previous operator) skip2 LB15A pshs b ; save relational operator flags pshs a ; save previous operator precedence ldb #1 ; make sure we aren't overflowing the stack jsr LAC33 jsr LB223 ; go evaluate the first term LB166 clr TRELFL ; flag no relational operators seen LB168 jsr GETCCH ; get input character LB16A suba #0xb2 ; token for > (lowest relational operator) blo LB181 ; brif below relational operators cmpa #3 ; there are three relational operators, is it one? bhs LB181 ; brif not cmpa #1 ; set C if > rola ; shift C into bit 0 (4: <, 2: =, 1: >) eora TRELFL ; flip the bit for this operator cmpa TRELFL ; did the result get lower? blo LB1DF ; brif so - we have a duplicate so raise an error sta TRELFL ; save new operator flags jsr GETNCH ; munch the operator bra LB16A ; go see if we have another one LB181 ldb TRELFL ; do we have a relational comparison? bne LB1B8 ; brif so lbcc LB1F4 ; brif the token is above the relational operators adda #7 ; put operators starting at 0 bhs LB1F4 ; brif we're above 0 - it's an operator, Jim adca VALTYP ; add carry, numeric flag, and modified token number lbeq LB60F ; brif we have string and A is + - do concatenation adca #-1 ; restore operator number pshs a ; save operator number asla ; times 2 adda ,s+ ; and times 3 (3 bytes per entry) ldx #LAA51 ; point to operator pecedence and jump table leax a,x ; point to correct entry LB19F puls a ; get precedence of previous operation cmpa ,x ; is hit higher (or same) than the current one? bhs LB1FA ; brif so - we need to process that operator bsr LB143 ; TM error if we have a string LB1A7 pshs a ; save previous operation precedence bsr LB1D4 ; push operator handler address and FPA0 onto the stack ldx RELPTR ; get pointer to arithmetic/logical table entry for last operation puls a ; get back precedence bne LB1CE ; brif we had a relational operation tsta ; check precedence of previous operation lbeq LB220 ; brif end of expression bra LB203 ; go handle operation LB1B8 asl VALTYP ; get type of value to C rolb ; mix it in to bit 0 of relational flags bsr LB1C6 ; back up input pointer ldx #LB1CB ; point to relational operator precedence and handler stb TRELFL ; save relational comparison flags clr VALTYP ; result will be numeric bra LB19F ; to process the operation LB1C6 ldx CHARAD ; get input pointer jmp LAEBB ; back it up one and put it back LB1CB fcb 0x64 ; precedence of relational comparison fdb LB2F4 ; handler address for relational comparison LB1CE cmpa ,x ; is last done operation higher (or same) precedence? bhs LB203 ; brif so - go process it bra LB1A7 ; go push things on the stack and process this operation otherwise LB1D4 ldd 1,x ; get address of operatorroutine pshs d ; save it bsr LB1E2 ; push FPA0 onto the stack ldb TRELFL ; get back relational operator flags lbra LB15A ; go evaluate another operation LB1DF jmp LB277 ; raise a syntax error LB1E2 ldb FP0SGN ; get sign of FPA0 lda ,x ; get precedence of this operation LB1E6 puls y ; get back original caller pshs b ; save sign LB1EA ldb FP0EXP ; get exponent ldx FPA0 ; get mantissa ldu FPA0+2 pshs u,x,b ; stow FPA0 sign and mantissa jmp ,y ; return to caller LB1F4 ldx ZERO ; point to dummy value lda ,s+ ; get precedence of previous operation (and set flags) beq LB220 ; brif end of expression LB1FA cmpa #0x64 ; relational operation? beq LB201 ; brif so jsr LB143 ; type mismatch if string LB201 stx RELPTR ; save pointer to operator routine LB203 puls b ; get relational flags cmpa #0x5a ; NOT operation? beq LB222 ; brif so (it was unary) cmpa #0x7d ; unary negation? beq LB222 ; brif so lsrb ; shift value type flag out of relational flags stb RELFLG ; save relational operator flag puls a,x,u ; get FP value back sta FP1EXP ; set exponent and mantissa in FPA1 stx FPA1 stu FPA1+2 puls b ; and the sign stb FP1SGN eorb FP0SGN ; set RESSGN if the two operand signs differ stb RESSGN LB220 ldb FP0EXP ; get exponent of FPA0 LB222 rts ; return or transfer control to operator handler routine LB223 jsr RVEC15 ; do the RAM hook dance clr VALTYP ; set type to numeric jsr GETNCH ; get first character in the term bcc LB22F ; brif not numeric LB22C jmp LBD12 ; parse a number (and return) LB22F jsr LB3A2 ; set carry if not alpha bcc LB284 ; brif alpha character (variable) cmpa #'. ; decimal point? beq LB22C ; brif so - evaluate number cmpa #0xac ; minus? beq LB27C ; brif so - process unary negation cmpa #0xab ; plus? beq LB223 ; brif so - ignore unary "posation" cmpa #'" ; string delimiter? bne LB24E ; brif not LB244 ldx CHARAD ; get input pointer jsr LB518 ; go parse the string LB249 ldx COEFPT ; get address of end of string stx CHARAD ; move input pointer past string rts LB24E cmpa #0xa8 ; NOT? bne LB25F ; brif not lda #0x5a ; precedence of unary NOT jsr LB15A ; process the operand of NOT jsr INTCNV ; convert to integer in D coma ; do a bitwise complement comb jmp GIVABF ; resturn the result LB25F inca ; is it a function token? beq LB290 ; brif so LB262 bsr LB26A ; only other legal thing must be a (expr) jsr LB156 ; evaluate parentheticized expression LB267 ldb #') ; force a ) skip2 LB26A ldb #'( ; force a ( skip2 SYNCOMMA ldb #', ; force a , LB26F cmpb [CHARAD] ; does character match? bne LB277 ; brif not jmp GETNCH ; each the character and return the next LB277 ldb #2*1 ; raise syntax error jmp LAC46 LB27C lda #0x7d ; unary negation precedence jsr LB15A ; evaluate argument jmp LBEE9 ; flip sign of FPA0 and return LB284 jsr LB357 ; evaluate variable LB287 stx FPA0+2 ; save descriptor address in FPA0 lda VALTYP ; test variable type bne LB222 ; brif string - we're done jmp LBC14 ; copy FP number from (X) into FPA0 LB290 jsr GETNCH ; get the actual token number tfr a,b ; save it (for offsetting X) lslb ; two bytes per jump table entry (and lose high bit) jsr GETNCH ; eat the token byte cmpb #2*19 ; is it a valid token for Color Basic? bls LB29F ; brif so jmp [COMVEC+18] ; transfer control to Extended Basic if not LB29F pshs b ; save jump table offset cmpb #2*14 ; does it expect a numeric argument? blo LB2C7 ; brif so cmpb #2*18 ; does it need no arguments? bhs LB2C9 ; brif so bsr LB26A ; force a ( lda ,s ; get token value cmpa #2*17 ; is it POINT? bhs LB2C9 ; brif so jsr LB156 ; evaluate first argument string bsr SYNCOMMA ; force a comma jsr LB146 ; TM error if string puls a ; get token value ldu FPA0+2 ; get string descriptor pshs u,a ; now we save the first string argument and the token value jsr EVALEXPB ; evaluate first numeric argument puls a ; get back token value pshs b,a ; save second argument and token value fcb 0x8e ; opcode of LDX immediate (skips two bytes) LB2C7 bsr LB262 ; force a ( LB2C9 puls b ; get offset ldx COMVEC+8 ; get jump table pointer LB2CE abx ; add offset into table jsr [,x] ; go process function jmp LB143 ; make sure result is numeric ; operator OR LB2D4 skip1lda ; set flag to nonzero to signal OR ; operator AND LB2D5 clra ; set flag to zero to signal AND sta TMPLOC ; save AND/OR flag jsr INTCNV ; convert second argument to intenger std CHARAC ; save it jsr LBC4A ; move first argument to FPA0 jsr INTCNV ; convert first argument to integer tst TMPLOC ; is it AND or OR? bne LB2ED ; brif OR anda CHARAC ; do the bitwise AND andb ENDCHR bra LB2F1 ; finish up LB2ED ora CHARAC ; do the bitwise OR orb ENDCHR LB2F1 jmp GIVABF ; return integer result ; relational comparision operators LB2F4 jsr LB148 ; TM error if type mismatch BNE LB309 ; brif we have a string comparison lda FP1SGN ; pack FPA1 ora #0x7f anda FPA1 sta FPA1 ldx #FP1EXP ; point to packed FPA1 jsr LBC96 ; compare FPA0 to FPA1 bra LB33F ; handle truth comparison LB309 clr VALTYP ; the result of a comparison is always a number dec TRELFL ; remove the string flag from the comparison data jsr LB657 ; get string details for second argument stb STRDES ; save them in the temporary string descriptor stx STRDES+2 ldx FPA1+2 ; get pointer to first argument descriptor jsr LB659 ; get string details for second argument lda STRDES ; get length of second argument pshs b ; save length of first argument suba ,s+ ; now A is the difference in string lengths beq LB328 ; brif string lengths are equal lda #1 ; flag for second argument is longer than first bcc LB328 ; brif second string is longer than first ldb STRDES ; get length of second string (shorter) nega ; invert default comparison result LB328 sta FP0SGN ; save default truth flag ldu STRDES+2 ; get pointer to start of second string incb ; compensate for DECB LB32D decb ; have we compared everything? bne LB334 ; brif not ldb FP0SGN ; get default truth value bra LB33F ; decide comparison truth LB334 lda ,x+ ; get byte from first argument cmpa ,u+ ; compare with second argument beq LB32D ; brif equal - keep comparing ldb #0xff ; negative if first string is > second bcc LB33F ; brif string A > string B negb ; invert result LB33F addb #1 ; convert to 0,1,2 rolb ; shift left - now it's 4,2,1 for <, =, > andb RELFLG ; keep only the truth we care about beq LB348 ; brif no matching bits - it's false ldb #0xff ; set true LB348 jmp LBC7C ; convert result to FP and return it ; DIM command LB34B jsr SYNCOMMA ; make sure there's a comma between variables DIM ldb #1 ; flag that we're dimensioning bsr LB35A ; go allocate the variable jsr GETCCH ; are we done? bne LB34B ; brif not rts ; This routine parses a variable. For scalars, it will return a NULL string or 0 value number ; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will ; allocate a default sized array if dimensioning is not underway and then attempt to look up ; the requested coordinates in that array. Otherwise, it will allocate an array based on the ; specified dimension values. LB357 clrb ; flag that we're not setting up an array jsr GETCCH LB35A stb DIMFLG ; save dimensioning flag LB35C sta VARNAM ; save first character of variable name jsr GETCCH ; get input character (why? we already have it) bsr LB3A2 ; set carry if not alpha lbcs LB277 ; brif our variable doesn't start with a letter clrb ; default second variable character to NUL stb VALTYP ; set value type to numeric jsr GETNCH ; get second character bcs LB371 ; brif numeric - numbers are allowed bsr LB3A2 ; set carry if not alpha bcs LB37B ; brif not alpha LB371 tfr a,b ; save set second character of variable name LB373 jsr GETNCH ; get an input character bcs LB373 ; brif numeric - still in variable name bsr LB3A2 ; set carry if not alpha bcc LB373 ; brif alpha - still in variable name LB37B cmpa #'$ ; do we have the string sigil? bne LB385 ; brif not com VALTYP ; set value type to string addb #0x80 ; set bit 7 of second variable character to indicate string jsr GETNCH ; eat the sigil LB385 stb VARNAM+1 ; save second variable name character ora ARYDIS ; merge array disable flag (will set bit 7 of input character if no arrays) suba #'( ; do we have a subscript? lbeq LB404 ; brif so clr ARYDIS ; disable the array disable flag - it's single use ldx VARTAB ; point to the start of the variable table ldd VARNAM ; get variable name LB395 cmpx ARYTAB ; are we at the top of the variable table? beq LB3AB ; brif so cmpd ,x++ ; does the variable name match (and move pointer to variable data) beq LB3DC ; brif so leax 5,x ; move to next table entry bra LB395 ; see if we have a match ; Set carry if not upper case alpha LB3A2 cmpa #'A ; set C if less than A bcs LB3AA ; brif less than A suba #'Z+1 ; set C if greater than Z suba #-('Z+1) LB3AA rts LB3AB ldx #ZERO ; point to empty location (NULL/0 value) ldu ,s ; get caller address cmpu #LB287 ; coming from "evaluate term"? beq LB3DE ; brif so - don't allocate ldd ARYEND ; get end of arrays std V43 ; save as top of source block addd #7 ; 7 bytes per scalar entry std V41 ; save as top of destination block ldx ARYTAB ; get bottom of arrays stx V47 ; save as bottom of source block jsr LAC1E ; move the arrays up to make a hole ldx V41 ; get new top of arrays stx ARYEND ; set new end of arrays ldx V45 ; get bottom of destination block stx ARYTAB ; set as new start of arrays ldx V47 ; get old end of variables ldd VARNAM ; get name of variable std ,x++ ; set variable name and advance X to the value clra ; zero out the variable value clrb std ,x std 2,x sta 4,x LB3DC stx VARPTR ; save descriptor address of return value LB3DE rts ; Various integer conversion routines LB3DF fcb 0x90,0x80,0x00,0x00,0x00 ; FP constant -32768 LB3E4 jsr GETNCH ; fetch input character LB3E6 jsr LB141 ; evaluate numeric expression LB3E9 lda FP0SGN ; get sign of value bmi LB44A ; brif negative (raise FC error) INTCNV jsr LB143 ; TM error if string lda FP0EXP ; get exponent cmpa #0x90 ; is it within the range for a 16 bit integer? blo LB3FE ; brif smaller than 32768 ldx #LB3DF ; point to -32678 constant jsr LBC96 ; is FPA0 equal to -32768? bne LB44A ; brif not - magnitude is too far negative LB3FE jsr LBCC8 ; move binary point to the right of FPA0 and correct sign ldd FPA0+2 ; get the resulting integer rts LB404 ldd DIMFLG ; get dimensioning flag and variable type pshs b,a ; save them (to avoid issues while evaluating dimension values) nop ; dead space caused by 1.2 revision clrb ; reset dimension counter LB40A ldx VARNAM ; get variable name pshs x,b ; save dimension counter and variable name bsr LB3E4 ; evaluate a dimension value (and skip either ( or ,) puls b,x,y ; get variable name, dimension counter, and dimensioning/type flag stx VARNAM ; restore variable name ldu FPA0+2 ; get dimension size/index pshs u,y ; save dimension size and dimensioning/type flag incb ; bump dimension counter jsr GETCCH ; get what's after the dimension count cmpa #', ; do we have another dimension? beq LB40A ; brif so - parse it stb TMPLOC ; save dimension counter jsr LB267 ; make sure we have a ) puls a,b ; get back variable type and dimensioning flag std DIMFLG ; restore variable type and dimensioning flag ldx ARYTAB ; get start of arrays LB42A cmpx ARYEND ; are we at the end of the array table beq LB44F ; brif so ldd VARNAM ; get variable name cmpd ,x ; does it match? beq LB43B ; brif so ldd 2,x ; get length of this array leax d,x ; move to next array bra LB42A ; go check another entry LB43B ldb #2*9 ; code for redimensioned array error lda DIMFLG ; are we dimensioning? bne LB44C ; brif so - raise error ldb TMPLOC ; get number of dimensions given cmpb 4,x ; does it match? beq LB4A0 ; brif so LB447 ldb #8*2 ; raise "bad subscript" skip2 LB44A ldb #4*2 ; raise "illegal function call" LB44C jmp LAC46 ; raise error LB44F ldd #5 ; 5 bytes per array entry std COEFPT ; initialize array size to entry size ldd VARNAM ; get variable name std ,x ; set array name ldb TMPLOC ; get dimension count stb 4,x ; set dimension count jsr LAC33 ; make sure we haven't overflowed memory stx V41 ; save array descriptor address LB461 ldb #11 ; default dimension value (zero-based, gives max index of 10) clra ; zero extend (??? why not LDD above?) tst DIMFLG ; are we dimensioning? beq LB46D ; brif not puls a,b ; get dimension size addd #1 ; account for zero based indexing LB46D std 5,x ; save dimension size bsr LB4CE ; multiply by accumulated array size std COEFPT ; save new array size leax 2,x ; move to next dimension dec TMPLOC ; have we done all dimensions? bne LB461 ; brif not stx TEMPTR ; save end of array descriptor (minus 5) addd TEMPTR ; add total size of array to address of descriptor lbcs LAC44 ; brif it overflows memory tfr d,x ; save end of array for later jsr LAC37 ; does array fit in memory? subd #STKBUF-5 ; subtract out the "stack fudge factor" but add 5 to the result std ARYEND ; save new end of arrays clra ; set up for clearing LB48C leax -1,x ; move back one sta 5,x ; blank out a byte in the array data cmpx TEMPTR ; have we reached the array header? bne LB48C ; brif not ldx V41 ; get address of start of descriptor lda ARYEND ; get MSB of end of array back (B still has LSB) subd V41 ; subtract start of descriptor std 2,x ; save length of array in array header lda DIMFLG ; are we dimensioning? bne LB4CD ; brif so - we're done LB4A0 ldb 4,x ; get number of dimensions stb TMPLOC ; initialize counter clra ; initialize accumulated offset clrb LB4A6 std COEFPT ; save accumulated offset puls a,b ; get desired index std FPA0+2 ; save it cmpd 5,x ; is it in range for this dimension? bhs LB4EB ; brif not ldu COEFPT ; get accumulated offset beq LB4B9 ; brif first dimension bsr LB4CE ; multiply accumulated offset by dimension length addd FPA0+2 ; add in offset into this dimension LB4B9 leax 2,x ; move to next dimension in header dec TMPLOC ; done all dimensions? bne LB4A6 ; brif not std ,--s ; save D for multiply by 5 (should be pshs d) aslb ; times 2 rola aslb ; times 4 rola addd ,s++ ; times 5 leax d,x ; add in offset from start of array data leax 5,x ; offset to end of header stx VARPTR ; save pointer to element data LB4CD rts ; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry LB4CE lda #16 ; 16 shifts to do a multiply sta V45 ; save shift counter ldd 5,x ; get multiplier std BOTSTK ; save it clra ; zero out product clrb LB4D8 aslb ; shift product left rola bcs LB4EB ; brif we have a carry asl COEFPT+1 ; shift other factor left rol COEFPT bcc LB4E6 ; brif no carry - this bit position is 0 addd BOTSTK ; add in multiplier at this bit position bcs LB4EB ; brif carry - do an error LB4E6 dec V45 ; have we done all 16 bits? bne LB4D8 ; brif not rts LB4EB jmp LB447 ; raise a BS error ; MEM function ; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks MEM tfr s,d ; get stack pointer where we can do math subd ARYEND ; calculate number of bytes between the stack and the top of arrays skip1 ; return result ; Convert unsigned value in B to FP LB4F3 clra ; zero extend ; Convert signed value in D to FP GIVABF clr VALTYP ; set value type to numeric std FPA0 ; save value in FPA0 ldb #0x90 ; exponent for top two bytes to be an integer jmp LBC82 ; finish conversion to integer ; STR$ function STR jsr LB143 ; make sure we have a number ldu #STRBUF+2 ; convert FP number to string in temporary string buffer jsr LBDDC leas 2,s ; don't return to the function evaluator (which will do a numeric type check) ldx #STRBUF+1 ; point to number string bra LB518 ; to stash the string in string space and return to the "evaluate term" caller ; Reserve B bytes of string space. Return start in X and FRESPC LB50D stx V4D ; save X somewhere in case the caller needs it LB50F bsr LB56D ; allocate string space LB511 stx STRDES+2 ; save pointer to allocated space in the temporary descriptor stb STRDES ; save length in the temporary descriptor rts LB516 leax -1,x ; move pointer back one (to compensate for the increment below) ; Scan from X until either NUL or one of the string terminators is found LB518 lda #'" ; set terminator to be string delimiter LB51A sta CHARAC ; set both delimiters sta ENDCHR LB51E leax 1,x ; move to next character stx RESSGN ; save start of string stx STRDES+2 ; save start of string in the temporary string descriptor ldb #-1 ; initialize length counter to -1 (compensate for initial INCB) LB526 incb ; bump string length lda ,x+ ; get character from string beq LB537 ; brif end of line cmpa CHARAC ; is it delimiter #1? beq LB533 ; brif so cmpa ENDCHR ; is it delimiter #2? bne LB526 ; brif not - keep scanning LB533 cmpa #'" ; string delimiter? beq LB539 ; brif so - don't move pointer back LB537 leax -1,x ; move pointer back (so we don't consume the delimiter) LB539 stx COEFPT ; save end of string address stb STRDES ; save string length ldu RESSGN ; get start of string cmpu #STRBUF+2 ; is it at the start of the string buffer? bhi LB54C ; brif so - don't copy it to string space bsr LB50D ; allocate string space ldx RESSGN ; point to beginning of the string jsr LB645 ; copy string data (B bytes) from (X) to (FRESPC) ; Put temporary string descriptor on the string stack LB54C ldx TEMPPT ; get top of string stack cmpx #CFNBUF ; is the string stack full? bne LB558 ; brif not ldb #15*2 ; code for "string formula too complex" LB555 jmp LAC46 ; raise error LB558 lda STRDES ; get string length sta 0,x ; save it in the string stack descriptor ldd STRDES+2 ; get string data pointer std 2,x ; save in string stack descriptor lda #0xff ; set value type to string sta VALTYP stx LASTPT ; set pointer to last used entry on the string stack stx FPA0+2 ; set pointer to descriptor in the current evaluation value leax 5,x ; advance string stack pointer stx TEMPPT rts ; Reserve B bytes in string space. If there isn't enough space, try compacting string space and ; then try the allocation again. If it still fails, raise OS error. LB56D clr GARBFL ; flag that compaction not yet done LB56F clra ; zero extend the length pshs d ; save requested string length ldd STRTAB ; get current bottom of strings subd ,s+ ; calculate new bottom of strings and remove zero extension cmpd FRETOP ; does the string fit? blo LB585 ; brif not - try compaction std STRTAB ; save new bottom of strings ldx STRTAB ; get bottom of strings leax 1,x ; now X points to the real start of the allocated space stx FRESPC ; save the string pointer puls b,pc ; restore length and return LB585 ldb #2*13 ; code for out of string space com GARBFL ; have we compacted string space yet? beq LB555 ; brif so - raise error bsr LB591 ; compact string space puls b ; get back string length bra LB56F ; go try allocation again ; Compact string space ; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer ; that hasn't already been moved into the freshly compacted string space. If then moves that string data ; up to the highest address it can go to. It repeats this process over and over until it finds no string ; that isn't already in the compacted space. While doing this, it has to search all strings on the string ; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string ; variables, and *every* entry in every string array. LB591 ldx MEMSIZ ; get to of string space LB593 stx STRTAB ; save top of uncompacted stringspace clra ; zero out D and reset pointer to discovered variable to NULL clrb std V4B ldx FRETOP ; point to bottom of string space stx V47 ; save as lowest match address (match will be higher) ldx #STRSTK ; point to start of string stack LB5A0 cmpx TEMPPT ; are we at the top of the string stack? beq LB5A8 ; brif so - done with the string stack bsr LB5D8 ; check for string in uncompacted space (and advance pointer) bra LB5A0 ; check another on the string stack LB5A8 ldx VARTAB ; point to start of scalar variables LB5AA cmpx ARYTAB ; end of scalars? beq LB5B2 ; brif so bsr LB5D2 ; check for string in uncompacted space and advance pointer bra LB5AA ; check another variable LB5B2 stx V41 ; save address of end of variables (address of first array) LB5B4 ldx V41 ; get start of the next array LB5B6 cmpx ARYEND ; end of arrays? beq LB5EF ; brif so ldd 2,x ; get length of array addd V41 ; add to start of array std V41 ; save address of next array lda 1,x ; get second character of variable name bpl LB5B4 ; brif numeric ldb 4,x ; get number of dimensions aslb ; two bytes per dimension size addb #5 ; add in fixed overhead for array descriptor abx ; now X points to first array element LB5CA cmpx V41 ; at the start of the next array? beq LB5B6 ; brif so - go handle another array bsr LB5D8 ; check for string in uncompacted space (and advance pointer) bra LB5CA ; process next array element LB5D2 lda 1,x ; get second character of variable name leax 2,x ; move to variable data bpl LB5EC ; brif numeric LB5D8 ldb ,x ; get length of string beq LB5EC ; brif NULL - don't need to check data pointer ldd 2,x ; get data pointer cmpd STRTAB ; is it in compacted string space? bhi LB5EC ; brif so cmpd V47 ; is it better match than previous best? bls LB5EC ; brif not stx V4B ; save descriptor address of best match std V47 ; save new best data pointer match LB5EC leax 5,x ; move to next descriptor LB5EE rts LB5EF ldx V4B ; get descriptor address of the matched string beq LB5EE ; brif we didn't find one - we're done clra ; zero extend length ldb ,x ; get string length decb ; subtract one (we won't have a NULL string here) addd V47 ; now D points to the address of the end of the string data std V43 ; save as top address of move ldx STRTAB ; set top of uncompacted space as destination stx V41 jsr LAC20 ; move string to top of uncompactedspace ldx V4B ; point to string descriptor ldd V45 ; get new data pointer address std 2,x ; update descriptor ldx V45 ; get bottom of copy destination leax -1,x ; move back below it jmp LB593 ; go search for another string to move (and set new bottom of string space) ; Concatenate two strings. We come here directly from the operator handler rather than via a JSR. LB60F ldd FPA0+2 ; get string descriptor for the first string pshs d ; save it jsr LB223 ; evaluate a second string (concatenation is left associative) jsr LB146 ; make sure we have a string puls x ; get back first string descriptor stx RESSGN ; save it ldb ,x ; get length of first string ldx FPA0+2 ; get pointer to second string addb ,x ; add length of second string bcc LB62A ; brif combined length is OK ldb #2*14 ; raise string too long error jmp LAC46 LB62A jsr LB50D ; reserve room for new string ldx RESSGN ; get descriptor address of the first string ldb ,x ; get length of first string bsr LB643 ; copy it to string space ldx V4D ; get descriptor address of second string bsr LB659 ; get string details for second string bsr LB645 ; copy second string into new string space ldx RESSGN ; get pointer to first string bsr LB659 ; remove it from the string stack if possible jsr LB54C ; put new string on the string stack jmp LB168 ; return to expression evaluator ; Copy B bytes to space pointed to by FRESPC LB643 ldx 2,x ; get source address from string descriptor LB645 ldu FRESPC ; get destination address incb ; compensate for decb bra LB64E ; do the copy LB64A lda ,x+ ; copy a byte sta ,u+ LB64E decb ; done yet? bne LB64A ; brif not stu FRESPC ; save destination pointer rts ; Fetch details of string in FPA0+2 and remove from the string stack if possible LB654 jsr LB146 ; make sure we have a string LB657 ldx FPA0+2 ; get descriptor pointer LB659 ldb ,x ; get length of string bsr LB675 ; see if it's at the top of the string stack and remove it if so bne LB672 ; brif not removed ldx 5+2,x ; get start address of string just removed leax -1,x ; move pointer down 1 cmpx STRTAB ; is it at the bottom of string space? bne LB66F ; brif not pshs b ; save length addd STRTAB ; add length to start of strings (A was cleared previously) std STRTAB ; save new string space start (deallocated space for this string) puls b ; get back string length LB66F leax 1,x ; restore pointer to pointing at the actual string data rts LB672 ldx 2,x ; get data pointer for the string rts ; Remove string pointed to by X from the string stack if it is at the top of the stack; return with ; A clear and Z set if string removed LB675 cmpx LASTPT ; is it at the top of the string stack? bne LB680 ; brif not - do nothing stx TEMPPT ; save new top of stack leax -5,x ; move the "last" pointer back as well stx LASTPT clra ; flag string removed LB680 rts ; LEN function LEN bsr LB686 ; get string details LB683 jmp LB4F3 ; return unsigned length in B LB686 bsr LB654 ; get string details and remove from string stack clr VALTYP ; set value type to numeric tstb ; set flags according to length rts ; CHR$ function CHR jsr LB70E ; get 8 bit unsigned integer to B LB68F ldb #1 ; allocate a one byte string jsr LB56D lda FPA0+3 ; get character code jsr LB511 ; save reserved string details in temp descriptor sta ,x ; put character in string LB69B leas 2,s ; don't go back to function handler - avoid numeric type check LB69D jmp LB54C ; return temporary string on string stack ; ASC function ASC bsr LB6A4 ; get first character of argument bra LB683 ; return unsigned code in B LB6A4 bsr LB686 ; fetch string details beq LB706 ; brif NULL string ldb ,x ; get character at start of string rts ; LEFT$ function LEFT bsr LB6F5 ; get arguments from the stack LB6AD clra ; clear pointer offset (set to start of string) LB6AE cmpb ,x ; are we asking for more characters than there are in the string? bls LB6B5 ; brif not ldb ,x ; only return the number that are in the string clra ; force starting offset to be the start of the string LB6B5 pshs b,a ; save offset and length jsr LB50F ; reserve space in string space ldx V4D ; point to original string descriptor bsr LB659 ; get string details puls b ; get string offset abx ; now X points to the start of the data to copy puls b ; get length of copy jsr LB645 ; copy the data to the allocated space bra LB69D ; return temp string on string stack ; RIGHT$ function RIGHT bsr LB6F5 ; get arguments from stack suba ,x ; subtract length of original string from desired length nega ; now A is offset into old string where we start copying bra LB6AE ; go handle everything else ; MID$ function MID ldb #255 ; default length is the whole string stb FPA0+3 ; save it jsr GETCCH ; see what we have after offset cmpa #') ; end of function? beq LB6DE ; brif so - no length jsr SYNCOMMA ; force a comma bsr EVALEXPB ; get length parameter LB6DE bsr LB6F5 ; get string and offset parameters from the stack beq LB706 ; brif we have a 0 offset requested (string offsets are 1-based) clrb ; clear length counter deca ; subtract one from position parameter (we work on 0-based, param is 1-based) cmpa ,x ; is start greater than length of string? bhs LB6B5 ; brif so - return NULL string tfr a,b ; save absolute position parameter subb ,x ; now B is postition less length negb ; now B is amount of string to copy cmpb FPA0+3 ; is it less than the length requested? bls LB6B5 ; brif so ldb FPA0+3 ; set length to the requested length bra LB6B5 ; go finish up copying the substring ; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter ; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing ; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.) LB6F5 jsr LB267 ; make sure we have ) ldu ,s ; get return address - we're going to mess with the stack ldx 5,s ; get address of string descriptor stx V4D ; save descriptor adddress lda 4,s ; get first numeric parameter in both A and B ldb 4,s leas 7,s ; clean up stack tfr u,pc ; return to original caller LB706 jmp LB44A ; raise FC error ; Evaluate an unsigned 8 bit expression to B LB709 jsr GETNCH ; move to next character EVALEXPB jsr LB141 ; evaluate a numeric expression LB70E jsr LB3E9 ; convert to integer in D tsta ; are we negative or > 255? bne LB706 ; brif so - FC error jmp GETCCH ; fetch current input character and return ; VAL function VAL jsr LB686 ; get string details lbeq LBA39 ; brif NULL string - return 0 ldu CHARAD ; get input pointer so we can replace it later stx CHARAD ; point interpreter at string data abx ; calculate end address of the string lda ,x ; get byte after the end of the string pshs u,x,a ; save end of string address, input pointer, and character after end of string clr ,x ; put a NUL after the string (stops the number interpreter) jsr GETCCH ; get input character at start of string jsr LBD12 ; evaluate numeric expression in string puls a,x,u ; get back saved character and pointers sta ,x ; restore byte after string stu CHARAD ; restore interpeter's input pointer rts ; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B LB734 bsr LB73D ; evaluate expression stx BINVAL ; save result LB738 jsr SYNCOMMA ; make sure there's a comma bra EVALEXPB ; evaluate unsigned expression to B ; Evaluate unsigned expression in X LB73D jsr LB141 ; evaluate numeric expression LB740 lda FP0SGN ; is it negative? bmi LB706 ; brif so lda FP0EXP ; get exponent cmpa #0x90 ; largest possible exponent for 16 bits bhi LB706 ; brif too large jsr LBCC8 ; move binary point to right of FPA0 ldx FPA0+2 ; get resulting unsigned value rts ; PEEK function PEEK bsr LB740 ; get address to X ldb ,x ; get the value at that address jmp LB4F3 ; return B as unsigned value ; POKE function POKE bsr LB734 ; evaluate address and byte value ldx BINVAL ; get address stb ,x ; put value there rts ; LLIST command LLIST ldb #-2 ; set output device to printer stb DEVNUM jsr GETCCH ; reset flags for input character and fall through to LIST ; LIST command LIST pshs cc ; save zero flag (end of statement) jsr LAF67 ; parse line number jsr LAD01 ; find address of that line stx LSTTXT ; save that address as the start of the list puls cc ; get back ent of statement flag beq LB784 ; brif end of line - list whole program jsr GETCCH ; are we at the end of the line (one number)? beq LB789 ; brif end of line cmpa #0xac ; is it "-"? bne LB783 ; brif not jsr GETNCH ; eat the "-" beq LB784 ; brif no second number - list to end of program jsr LAF67 ; evaluate the second number beq LB789 ; brif illegal number LB783 rts LB784 ldu #0xffff ; this will cause listing to do the entire program stu BINVAL LB789 leas 2,s ; don't return to the caller - we'll jump back to the main loop ldx LSTTXT ; get address of line to list LB78D jsr LB95C ; do a newline if needed jsr LA549 ; do a break check ldd ,x ; get address of next line bne LB79F ; brif not end of program LB797 jsr LA42D ; close output file clr DEVNUM ; reset device to screen jmp LAC73 ; go back to immediate mode LB79F stx LSTTXT ; save new line address ldd 2,x ; get line number of this line cmpd BINVAL ; is it above the end line? bhi LB797 ; brif so - return jsr LBDCC ; display line number jsr LB9AC ; put a space after it ldx LSTTXT ; get line address bsr LB7C2 ; detokenize the line ldx [LSTTXT] ; get pointer to next line ldu #LINBUF+1 ; point to start of detokenized line LB7B9 lda ,u+ ; get byte from detokenized line beq LB78D ; brif end of line jsr LB9B1 ; output character bra LB7B9 ; handle next character ; Detokenize a line from (X) to the line input buffer LB7C2 jsr RVEC24 ; do the RAM hook dance leax 4,x ; move past next line pointer and line number ldy #LINBUF+1 ; point to line input buffer (destination) LB7CB lda ,x+ ; get character from tokenized line beq LB820 ; brif end of input bmi LB7E6 ; brif it's a token cmpa #': ; colon? bne LB7E2 ; brif not ldb ,x ; get what's after the colon cmpb #0x84 ; ELSE? beq LB7CB ; brif so - suppress the colon cmpb #0x83 ; '? beq LB7CB ; brif so - suppress the colon skip2 LB7E0 lda #'! ; placeholder for unknown token LB7E2 bsr LB814 ; stow output character bra LB7CB ; go process another input character LB7E6 ldu #COMVEC-10 ; point to command interptation table cmpa #0xff ; is it a function? bne LB7F1 ; brif not lda ,x+ ; get function token leau 5,u ; shift to the function half of the interpretation tables LB7F1 anda #0x7f ; remove token bias LB7F3 leau 10,u ; move to next command/function table tst ,u ; is this table active? beq LB7E0 ; brif not - use place holder LB7F9 suba ,u ; subtract number of tokens handled by this table entry bpl LB7F3 ; brif this token isn't handled here adda ,u ; undo extra subtraction ldu 1,u ; get reserved word list for this table LB801 deca ; are we at the right entry? bmi LB80A ; brif so LB804 tst ,u+ ; end of entry? bpl LB804 ; brif not bra LB801 ; see if we're there yet LB80A lda ,u ; get character from wordlist bsr LB814 ; put character in the buffer tst ,u+ ; end of word? bpl LB80A ; brif not bra LB7CB ; go handle another input character LB814 cmpy #LINBUF+LBUFMX ; is there room? bhs LB820 ; brif not anda #0x7f ; lose bit 7 sta ,y+ ; save character in output clr ,y ; make sure there's always a NUL terminator LB820 rts ; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return ; length in D LB821 jsr RVEC23 ; do the RAM hook dance ldx CHARAD ; get input pointer ldu #LINBUF ; set destination pointer LB829 clr V43 ; clear alpha string flag clr V44 ; clear DATA flag LB82D lda ,x+ ; get input character beq LB852 ; brif end of input tst V43 ; are we handling an alphanumeric string? beq LB844 ; brif not jsr LB3A2 ; set carry if not alpha bcc LB852 ; brif alpha cmpa #'0 ; is it below the digits? blo LB842 ; brif so cmpa #'9 ; is it within the digits? bls LB852 ; brif so LB842 clr V43 ; flag that we're past the alphanumeric string LB844 cmpa #0x20 ; space? beq LB852 ; brif so - keep it sta V42 ; save scan delimiter cmpa #'" ; string delimiter? beq LB886 ; brif so - copy until another " tst V44 ; doing "DATA"? beq LB86B ; brif not LB852 sta ,u+ ; put character in output beq LB85C ; brif end of input cmpa #': ; colon? beq LB829 ; brif so - reset DATA and alpha string flags LB85A bra LB82D ; go process another input character LB85C clr ,u+ ; put a double NUL at the end clr ,u+ tfr u,d ; calculate length of result (includes double NUL and an extra two bytes) subd #LINHDR ldx #LINBUF-1 ; point to one before the output stx CHARAD ; set input pointer there rts LB86B cmpa #'? ; print abbreviation? bne LB873 ; brif not lda #0x87 ; token for PRINT bra LB852 ; go stash it LB873 cmpa #'' ; REM abbreviation? bne LB88A ; brif not ldd #0x3a83 ; colon plus ' token std ,u++ ; put it in the output LB87C clr V42 ; set delimiter to NUL LB87E lda ,x+ ; get input beq LB852 ; brif end of line cmpa V42 ; at the delimiter? beq LB852 ; brif so LB886 sta ,u+ ; save in output bra LB87E ; keep scanning for delimiter LB88A cmpa #'0 ; is it below digits? blo LB892 ; brif so cmpa #';+1 ; is it digit, colon, or semicolon? blo LB852 ; brif so LB892 leax -1,x ; move input pointer back one (to point at this input character) pshs u,x ; save input and output pointers clr V41 ; set token type to 0 (command) ldu #COMVEC-10 ; point to command interpretation table LB89B clr V42 ; set token counter to 0 (0x80) LB89D leau 10,u ; lda ,u ; get number of reserved words beq LB8D4 ; brif this table isn't active ldy 1,u ; point to reserved words list LB8A6 ldx ,s ; get input pointer LB8A8 ldb ,y+ ; get character from reserved word table subb ,x+ ; compare with input character beq LB8A8 ; brif exact match cmpb #0x80 ; brif it was the last character in word and exact match bne LB8EA ; brif not leas 2,s ; remove original input pointer from stack puls u ; get back output pointer orb V42 ; create token value (B has 0x80 from above) lda V41 ; get token type bne LB8C2 ; brif function cmpb #0x84 ; is it ELSE? bne LB8C6 ; brif not lda #': ; silently add a colon before ELSE LB8C2 std ,u++ ; put two byte token into output bra LB85A ; go handle more input LB8C6 stb ,u+ ; save single byte token cmpb #0x86 ; DATA? bne LB8CE ; brif not inc V44 ; set DATA flag LB8CE cmpb #0x82 ; REM? beq LB87C ; brif so - skip over rest of line LB8D2 bra LB85A ; go handle more input LB8D4 ldu #COMVEC-5 ; point to interpretation table, function style LB8D7 com V41 ; invert token flag bne LB89B ; brif we haven't already done functions puls x,u ; restore input and output pointers lda ,x+ ; copy first character sta ,u+ jsr LB3A2 ; set C if not alpha bcs LB8D2 ; brif not alpha - it isn't a variable com V43 ; set alphanumeric string flag bra LB8D2 ; process more input LB8EA inc V42 ; bump token number deca ; checked all in this table? beq LB89D ; brif so leay -1,y ; unconsume last compared character LB8F1 ldb ,y+ ; end of entry? bpl LB8F1 ; brif not bra LB8A6 ; check next reserved word ; PRINT command PRINT beq LB958 ; brif no argument - do a newline bsr LB8FE ; process print options clr DEVNUM ; reset output to screen rts LB8FE cmpa #'@ ; is it PRINT @? bne LB907 ; brif not LB902 jsr LA554 ; move cursor to correct location LB905 bra LB911 ; handle some more LB907 cmpa #'# ; device number specified? bne LB918 ; brif not jsr LA5A5 ; parse device number jsr LA406 ; check for valid output file LB911 jsr GETCCH ; get input character beq LB958 ; brif nothing - do newline jsr SYNCOMMA ; need comma after @ or # LB918 jsr RVEC9 ; do the RAM hook boogaloo LB91B beq LB965 ; brif end of input LB91D cmpa #0xa4 ; TAB(? beq LB97E ; brif so cmpa #', ; comma (next tab field)? beq LB966 ; brif so cmpa #'; ; semicolon (do not advance print position) beq LB997 ; brif so jsr LB156 ; evaluate expression lda VALTYP ; get type of value pshs a ; save it bne LB938 ; brif string jsr LBDD9 ; convert FP number to string jsr LB516 ; parse a string and put on string stack LB938 bsr LB99F ; print string puls b ; get back variable type jsr LA35F ; set up print parameters tst PRTDEV ; is it a display device? beq LB949 ; brif so bsr LB958 ; do a newline jsr GETCCH ; get input bra LB91B ; process more print stuff LB949 tstb ; set flags on print position bne LB954 ; brif not at start of line jsr GETCCH ; get current input cmpa #', ; comma? beq LB966 ; skip to next tab field if so bsr LB9AC ; send a space LB954 jsr GETCCH ; get input character bne LB91D ; brif not end of statement LB958 lda #0x0d ; carriage return bra LB9B1 ; send it to output LB95C jsr LA35F ; set up print parameters LB95F beq LB958 ; brif width is 0 lda DEVPOS ; get line position bne LB958 ; brif not at start of line LB965 rts LB966 jsr LA35F ; set up print parameters beq LB975 ; brif line width is 0 ldb DEVPOS ; get line position cmpb DEVLCF ; at or past last comma field? blo LB977 ; brif so bsr LB958 ; move to next line bra LB997 ; handle more stuff LB975 ldb DEVPOS ; get line position LB977 subb DEVCFW ; subtract a comma field width bhs LB977 ; brif we don't have a remainder yet negb ; now B is number of of spaces needed bra LB98E ; go advance LB97E jsr LB709 ; evaluate TAB distance cmpa #') ; closing )? lbne LB277 ; brif not jsr LA35F ; set up print parameters subb DEVPOS ; subtract print position from desired position bls LB997 ; brif we're already past it LB98E tst PRTDEV ; is it a display device? bne LB997 ; brif not LB992 bsr LB9AC ; output a space decb ; done enough? bne LB992 ; brif not LB997 jsr GETNCH ; get input character jmp LB91B ; process more items ; cpoy string from (X-1) to output STRINOUT jsr LB518 ; parse the string LB99F jsr LB657 ; get string details LB9A2 incb ; compensate for decb LB9A3 decb ; done all of the string? beq LB965 ; brif so lda ,x+ ; get character from string bsr LB9B1 ; send to output bra LB9A3 ; go do another character LB9AC lda #0x20 ; space character skip2 LB9AF lda #'? ; question mark character LB9B1 jmp PUTCHR ; output character ; The floating point math package and related functions and operations follow from here ; to the end of the Color Basic ROM area LB9B4 ldx #LBEC0 ; point to FP constant 0.5 bra LB9C2 ; add 0.5 to FPA0 LB9B9 jsr LBB2F ; unpack FP data from (X) to FPA1 ; subtraction operator LB9BC com FP0SGN ; invert sign of FPA0 (subtracting is adding the negative) com RESSGN ; that also inverts the sign differential bra LB9C5 ; go add the negative of FPA0 to FPA1 LB9C2 jsr LBB2F ; unpack FP data from (X) to FPA1 ; addition operator LB9C5 tstb ; check exponent of FPA0 lbeq LBC4A ; copy FPA1 to FPA0 if FPA0 is 0 ldx #FP1EXP ; point X to FPA1 (first operand) as the operand to denormalize LB9CD tfr a,b ; put exponent of FPA1 into B tstb ; is FPA1 0? beq LBA3E ; brif exponent is 0 - no-op; adding 0 to FPA0 subb FP0EXP ; get difference in exponents - number of bits to shift the smaller mantissa beq LBA3F ; brif exponents are equal - no need to denormalize blo LB9E2 ; brif FPA0 > FPA1 sta FP0EXP ; replace result exponent with FPA1's (FPA1 is bigger) lda FP1SGN ; also copy sign over sta FP0SGN ldx #FP0EXP ; point to FPA0 (we need to denormalize the smaller number) negb ; invert the difference - this is the number of bits to shift the mantissa LB9E2 cmpb #-8 ; do we have to shift by a whole byte? ble LBA3F ; brif so start by shifting whole bytes to the right clra ; clear overflow byte lsr 1,x ; shift high bit of mantissa right (LSR will force a zero into the high bit) jsr LBABA ; shift remainder of mantissa right -B times LB9EC ldb RESSGN ; get the sign flag bpl LB9FB ; brif signs are the same (we add the mantissas then) com 1,x ; complement the mantissa and extra precision bytes com 2,x com 3,x com 4,x coma adca #0 ; add one to A (COM sets C); this may cause a carry to enter the ADD below LB9FB sta FPSBYT ; save extra precision byte lda FPA0+3 ; add the main mantissa bytes (and propage carry from above) adca FPA1+3 sta FPA0+3 lda FPA0+2 adca FPA1+2 sta FPA0+2 lda FPA0+1 adca FPA1+1 sta FPA0+1 lda FPA0 adca FPA1 sta FPA0 tstb ; were signs the same? bpl LBA5C ; brif so - number may have gotten bigger so normalize if needed LBA18 bcs LBA1C ; brif we had a carry - result is positive?) bsr LBA79 ; do a proper negation of FPA0 mantissa LBA1C clrb ; clear temporary exponent accumulator LBA1D lda FPA0 ; test high byte of mantissa bne LBA4F ; brif not 0 - we need to do bit shifting lda FPA0+1 ; shift left 8 bits sta FPA0 lda FPA0+2 sta FPA0+1 lda FPA0+3 sta FPA0+2 lda FPSBYT sta FPA0+3 clr FPSBYT addb #8 ; account for 8 bits shifted cmpb #5*8 ; shifted 5 bytes worth? blt LBA1D ; brif not LBA39 clra ; zero out exponent and sign - result is 0 LBA3A sta FP0EXP ; set exponent and sign sta FP0SGN LBA3E rts LBA3F bsr LBAAE ; shift FPA0 mantissa to the right clrb ; clear carry bra LB9EC ; get on with adding LBA44 incb ; account for one bit shift asl FPSBYT ; shift mantissa and extra precision left rol FPA0+3 rol FPA0+2 rol FPA0+1 rol FPA0 LBA4F bpl LBA44 ; brif we haven't got a 1 in bit 7 lda FP0EXP ; get exponent of result pshs b ; subtract shift count from exponent suba ,s+ sta FP0EXP ; save adjusted exponent bls LBA39 ; brif we underflowed - set result to 0 skip2 LBA5C bcs LBA66 ; brif mantissa overflowed asl FPSBYT ; get bit 7 of expra precision to C (used for round off) lda #0 ; set to 0 without affecting C sta FPSBYT ; clear out extra precision bits bra LBA72 ; go round off result LBA66 inc FP0EXP ; bump exponent (for a right shift to bring carry in) beq LBA92 ; brif we overflowed ror FPA0 ; shift carry into mantissa, shift right ror FPA0+1 ror FPA0+2 ror FPA0+3 LBA72 bcc LBA78 ; brif no round-off needed bsr LBA83 ; add one to mantissa beq LBA66 ; brif carry - need to shift right again LBA78 rts LBA79 com FP0SGN ; invert sign of value LBA7B com FPA0 ; first do a one's copmlement com FPA0+1 com FPA0+2 com FPA0+3 LBA83 ldx FPA0+2 ; add one to mantissa (after one's complement gives two's complement) leax 1,x ; bump low word stx FPA0+2 bne LBA91 ; brif no carry from low word ldx FPA0 ; bump high word leax 1,x stx FPA0 LBA91 rts LBA92 ldb #2*5 ; code for overflow jmp LAC46 ; raise error LBA97 ldx #FPA2-1 ; point to FPA2 LBA9A lda 4,x ; shift mantissa right by 8 bits sta FPSBYT lda 3,x sta 4,x lda 2,x sta 3,x lda 1,x sta 2,x lda FPCARY ; and handle extra precision on the left sta 1,x LBAAE addb #8 ; account for 8 bits shifted ble LBA9A ; brif more shifts needed lda FPSBYT ; get sub byte (extra precision) subb #8 ; undo the 8 added above beq LBAC4 ; brif difference is 0 LBAB8 asr 1,x ; shift mantissa and sub byte one bit (keep mantissa high bit set) LBABA ror 2,x ror 3,x ror 4,x rora incb ; account for one shift bne LBAB8 ; brif not enought shifts yet LBAC4 rts LBAC5 fcb 0x81,0x00,0x00,0x00,0x00 ; packed FP 1.0 LBACA bsr LBB2F ; unpack FP value from (X) to FPA1 ; multiplication operator LBACC beq LBB2E ; brif exponent of FPA0 is 0 (result is 0) bsr LBB48 ; calculate exponent of product LBAD0 lda #0 ; zero out mantissa of FPA2 sta FPA2 sta FPA2+1 sta FPA2+2 sta FPA2+3 ldb FPA0+3 ; multiply FPA1 by LSB of FPA0 bsr LBB00 ldb FPSBYT ; save extra precision byte stb VAE ldb FPA0+2 bsr LBB00 ; again for next byte of FPA0 ldb FPSBYT stb VAD ldb FPA0+1 ; again for next byte of FPA0 bsr LBB00 ldb FPSBYT stb VAC ldb FPA0 ; and finally for the high byte bsr LBB02 ldb FPSBYT stb VAB jsr LBC0B ; copy mantissa from FPA2 to FPA0 (result) jmp LBA1C ; normalize LBB00 beq LBA97 ; brif multiplier is 0 - just shift, don't multiply LBB02 coma ; set carry LBB03 lda FPA2 ; get FPA2 MS byte rorb ; data bit to carry; will be 0 when all shifts done beq LBB2E ; brif 8 shifts done bcc LBB20 ; brif data bit is 0 - no addition lda FPA2+3 ; add mantissa of FPA1 and FPA2 adda FPA1+3 sta FPA2+3 lda FPA2+2 adca FPA1+2 sta FPA2+2 lda FPA2+1 adca FPA1+1 sta FPA2+1 lda FPA2 adca FPA1 LBB20 rora ; shift carry into FPA2 sta FPA2 ror FPA2+1 ror FPA2+2 ror FPA2+3 ror FPSBYT clra ; clear carry bra LBB03 LBB2E rts ; Unpack FP value from (X) to FPA1 LBB2F ldd 1,x ; copy mantissa (and sign) sta FP1SGN ; save sign bit ora #0x80 ; make sure mantissa has bit 7 set std FPA1 ldb FP1SGN ; get sign eorb FP0SGN ; set if FPA0 sign differs stb RESSGN ldd 3,x ; copy remainder of mantissa std FPA1+2 lda ,x ; and exponent sta FP1EXP ldb FP0EXP ; fetch FPA0 exponent and set flags rts ; Calculate eponent for product of FPA0 and FPA1 LBB48 tsta ; is FPA1 zero? beq LBB61 ; brif so adda FP0EXP ; add to exponent of FPA0 (this is how scientific notation works) rora ; set V if we *don't* have an overflow rola bvc LBB61 ; brif exponent too larger or small adda #0x80 ; restore the bias sta FP0EXP ; set result exponent beq LBB63 ; brif 0 - clear FPA0 lda RESSGN ; the result sign (negative if signs differ) is the result sign sta FP0SGN ; so set it as such rts LBB5C lda FP0SGN ; get sign of FPA0 coma ; invert sign bra LBB63 ; zero sign and exponent LBB61 leas 2,s ; don't go back to caller (mul/div) - return to previous caller LBB63 lbpl LBA39 ; brif we underflowed - go zero things out LBB67 jmp LBA92 ; raise overflow error ; fast multiply by 10 - leave result in FPA0 LBB6A jsr LBC5F ; copy FPA0 to FPA1 (for addition later) beq LBB7C ; brif exponent is 0 - it's a no-op then adda #2 ; this gives "times 4" bcs LBB67 ; raise overflow if required clr RESSGN ; set result sign to "signs the same" jsr LB9CD ; add FPA1 to FPA0 "times 5" inc FP0EXP ; times 10 beq LBB67 ; brif overflow LBB7C rts LBB7D fcb 0x84,0x20,0x00,0x00,0x00 ; packed FP constant 10.0 ; Divide by 10 LBB82 jsr LBC5F ; move FPA0 to FPA1 ldx #LBB7D ; point to constant 10 clrb ; zero sign LBB89 stb RESSGN ; result will be positive or zero jsr LBC14 ; unpack constant 10 to FPA0 skip2 ; fall through to division (divide FPA1 by 10) LBB8F bsr LBB2F ; unpack FP number from (X) to FPA1 ; division operator LBB91 beq LBC06 ; brif FPA0 is 0 - division by zero neg FP0EXP ; get exponent of reciprocal of the divisor bsr LBB48 ; calculate exponent of quotient inc FP0EXP ; bump exponent (due to division algorithm below) beq LBB67 ; brif overflow ldx #FPA2 ; point to temporary storage location ldb #4 ; do 5 bytes stb TMPLOC ; save counter ldb #1 ; shift counter and quotient byte LBBA4 lda FPA0 ; compare mantissa of FPA0 to FPA1, set C if FPA1 less cmpa FPA1 bne LBBBD lda FPA0+1 cmpa FPA1+1 bne LBBBD lda FPA0+2 cmpa FPA1+2 bne LBBBD lda FPA0+3 cmpa FPA1+3 bne LBBBD coma ; set C if FPA0 = FPA1 (it "goes") LBBBD tfr cc,a ; save "it goes" status rolb ; rotate carry into quotient bcc LBBCC ; brif carry clear - haven't done 8 shifts yet stb ,x+ ; save quotient byte dec TMPLOC ; done enough bytes? bmi LBBFC ; brif done all 5 beq LBBF8 ; brif last byte ldb #1 ; reset shift counter and quotient byte LBBCC tfr a,cc ; get back carry status bcs LBBDE ; brif it "went" LBBD0 asl FPA1+3 ; shift mantissa (dividend) left rol FPA1+2 rol FPA1+1 rol FPA1 bcs LBBBD ; brif carry - it "goes" so we have to bump quotient bmi LBBA4 ; brif high order bit is set - compare mantissas bra LBBBD ; otherwise, count a 0 bit and try next bit LBBDE lda FPA1+3 ; subtract mantissa of FPA0 from mantissa of FPA1 suba FPA0+3 sta FPA1+3 lda FPA1+2 sbca FPA0+2 sta FPA1+2 lda FPA1+1 sbca FPA0+1 sta FPA1+1 lda FPA1 sbca FPA0 sta FPA1 bra LBBD0 ; go check for another go LBBF8 ldb #0x40 ; only two bits in last byte (for rounding) bra LBBCC ; go do the last byte LBBFC rorb ; get low bits to bits 7,6 and C to bit 5 rorb rorb stb FPSBYT ; save result extra precision bsr LBC0B ; move FPA2 mantissa to FPA0 (result) jmp LBA1C ; go normalize the result LBC06 ldb #2*10 ; division by zero jmp LAC46 ; raise error ; Copy mantissa of FPA2 to FPA0 LBC0B ldx FPA2 ; copy high word stx FPA0 ldx FPA2+2 ; copy low word stx FPA0+2 rts ; unpack FP number at (X) to FPA0 LBC14 pshs a ; save register ldd 1,x ; get mantissa high word and sign sta FP0SGN ; set sign ora #0x80 ; make sure mantissa always has bit 7 set std FPA0 clr FPSBYT ; clear extra precision ldb ,x ; get exponent ldx 3,x ; copy mantissa low word stx FPA0+2 stb FP0EXP ; save exponent (and set flags) puls a,pc ; restore register and return LBC2A ldx #V45 ; point to FPA4 bra LBC35 ; pack FPA0 there LBC2F ldx #V40 ; point to FPA3 skip2 ; fall through to pack FPA0 there LBC33 ldx VARDES ; get variable descriptor pointer ; Pack FPA0 to (X) LBC35 lda FP0EXP ; get exponent sta ,x ; save it lda FP0SGN ; get sign ora #0x7f ; force set low bits - only keep sign in high bit anda FPA0 ; merge in bits 6-0 of high byte of mantissa sta 1,x ; save it lda FPA0+1 ; copy next highest byte sta 2,x ldu FPA0+2 ; and the low word of the mantissa stu 3,x rts ; Copy FPA1 to FPA0; return with sign in A LBC4A lda FP1SGN ; copy sign LBC4C sta FP0SGN ldx FP1EXP ; copy exponent, mantissa high byte stx FP0EXP clr FPSBYT ; clear extra precision lda FPA1+1 ; copy mantissa second highest byte sta FPA0+1 lda FP0SGN ; set sign for return ldx FPA1+2 ; copy low word of mantissa stx FPA0+2 rts ; Copy FPA0 to FPA1 LBC5F ldd FP0EXP ; copy exponent and high byte of mantissa std FP1EXP ldx FPA0+1 ; copy middle bytes of mantissa stx FPA1+1 ldx FPA0+3 ; copy low byte of mantissa and sign stx FPA1+3 tsta ; set flags on exponent rts ; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive LBC6D ldb FP0EXP ; get exponent beq LBC79 ; brif 0 LBC71 ldb FP0SGN ; get sign LBC73 rolb ; get sign to C ldb #0xff ; set for negative result bcs LBC79 ; brif negative negb ; set to 1 for positive LBC79 rts ; SGN function SGN bsr LBC6D ; get sign of FPA0 LBC7C stb FPA0 ; save result clr FPA0+1 ; clear next lower 8 bits ldb #0x88 ; exponent if mantissa is 8 bit integer LBC82 lda FPA0 ; get high bits of mantissa suba #0x80 ; set C if mantissa was positive (will cause a negation if it was negative) LBC86 stb FP0EXP ; set exponent ldd ZERO ; clear out low word std FPA0+2 sta FPSBYT ; clear extra precision sta FP0SGN ; set sign to positive jmp LBA18 ; normalize the result ; ABS function ABS clr FP0SGN ; force FPA0 to be positive (yes, it's that simple) rts ; Compare packed FP number at (X) to FPA0 ; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that LBC96 ldb ,x ; get exponent of (X) beq LBC6D ; brif (X) is 0 ldb 1,x ; get MS byte of mantissa of (X) eorb FP0SGN ; set bit 7 if signs of (X) and FPA0 differ bmi LBC71 ; brif signs differ - no need to compare the magnitude LBCA0 ldb FP0EXP ; compare exponents and brif different cmpb ,x bne LBCC3 ldb 1,x ; compare mantissa (but we have to pack the FPA0 bits first orb #0x7f ; keep only sign bit (note: signs are the same) andb FPA0 ; merge in the mantissa bits from FPA0 cmpb 1,x ; do the packed versions match? bne LBCC3 ; brif not ldb FPA0+1 ; compare second byte of mantissas cmpb 2,x bne LBCC3 ldb FPA0+2 ; compare third byte of mantissas cmpb 3,x bne LBCC3 ldb FPA0+3 ; compare low byte of mantissas, but use subtraction so B = 0 on match subb 4,x bne LBCC3 rts ; return B = 0 if (X) = FPA0 LBCC3 rorb ; shift carry to bit 7 (C set if FPA0 < (X)) eorb FP0SGN ; invert the comparision sense if the signs are negative bra LBC73 ; interpret comparison result ; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the ; result as a two's complement value. LBCC8 ldb FP0EXP ; get exponent of FPA0 beq LBD09 ; brif FPA0 is zero - we don't have to do anything, just blank it subb #0xa0 ; calculate number of shifts to get to the correct exponent (binary point to the right) lda FP0SGN ; do we have a positive number? bpl LBCD7 ; brif so com FPCARY ; negate the mantissa and set extra inbound precision to the correct sign jsr LBA7B LBCD7 ldx #FP0EXP ; point to FPA0 cmpb #-8 ; moving by whole bytes? bgt LBCE4 ; brif not jsr LBAAE ; do bit shifting clr FPCARY ; clear carry in byte rts LBCE4 clr FPCARY ; clear the extra carry in precision lda FP0SGN ; get sign of value rola ; get sign to carry (so rotate repeats the sign) ror FPA0 ; shift the first bit jmp LBABA ; do the shifting dance ; INT function INT ldb FP0EXP ; get exponent cmpb #0xa0 ; is the number big enough that there can be no fractional part? bhs LBD11 ; brif so - we don't have to do anything bsr LBCC8 ; go shift binary point to the right of the mantissa stb FPSBYT ; save extra precision bits lda FP0SGN ; get original sign stb FP0SGN ; force result to be positive suba #0x80 ; set C if we had a positive result lda #0xa0 ; set exponent to match denormalized result sta FP0EXP lda FPA0+3 ; save low byte sta CHARAC jmp LBA18 ; go normalize (this will correct for the two's complement representation of negatives) LBD09 stb FPA0 ; replace mantissa of FPA0 with contents of B stb FPA0+1 stb FPA0+2 stb FPA0+3 LBD11 rts ; Convert ASCII string to FP ; BUG: no overflow is checked on the decimal exponent in exponential notation. LBD12 ldx ZERO ; zero out FPA0 and temporaries stx FP0SGN stx FP0EXP stx FPA0+1 stx FPA0+2 stx V47 stx V45 bcs LBD86 ; brif input character is numeric jsr RVEC19 ; do the RAM hook dance cmpa #'- ; regular negative sign bne LBD2D ; brif not com COEFCT ; invert sign bra LBD31 ; process stuff after the sign LBD2D cmpa #'+ ; regular plus? bne LBD35 ; brif not LBD31 jsr GETNCH ; get character after sign bcs LBD86 ; brif numeric LBD35 cmpa #'. ; decimal point? beq LBD61 ; brif so cmpa #'E ; scientific notation bne LBD65 ; brif not jsr GETNCH ; eat the "E" bcs LBDA5 ; brif numeric cmpa #0xac ; negative sign (token)? beq LBD53 ; brif so cmpa #'- ; regular negative? beq LBD53 ; brif so cmpa #0xab ; plus sign (token)? beq LBD55 ; brif so cmpa #'+ ; regular plus? beq LBD55 bra LBD59 ; brif no sign found LBD53 com V48 ; set exponent sign to negative LBD55 jsr GETNCH ; eat the sign bcs LBDA5 ; brif numeric LBD59 tst V48 ; is the exponent sign negatvie? beq LBD65 ; brif not neg V47 ; negate base 10 exponent bra LBD65 LBD61 com V46 ; toggle decimal point flag bne LBD31 ; brif we haven't seen two decimal points LBD65 lda V47 ; get base 10 exponent suba V45 ; subtract number of places to the right sta V47 ; we now have a complete decimal exponent beq LBD7F ; brif we have no base 10 shifting required bpl LBD78 ; brif positive exponent LBD6F jsr LBB82 ; divide FPA0 by 10 (shift decimal point left) inc V47 ; bump exponent bne LBD6F ; brif we haven't reached 0 yet bra LBD7F ; return result LBD78 jsr LBB6A ; multiply by 10 dec V47 ; downshift the exponent bne LBD78 ; brif not at 0 yet LBD7F lda COEFCT ; get desired sign bpl LBD11 ; brif it will be positive - no need to do anything jmp LBEE9 ; flip the sign of FPA0 LBD86 ldb V45 ; get the decimal count subb V46 ; (if decimal seen, will add one; otherwise it does nothing) stb V45 pshs a ; save new digit jsr LBB6A ; multiply partial result by 10 puls b ; get back digit subb #'0 ; remove ASCII bias bsr LBD99 ; add B to FPA0 bra LBD31 ; go process another digit LBD99 jsr LBC2F ; save FPA0 to FPA3 jsr LBC7C ; convert B to FP number ldx #V40 ; point to FPA3 jmp LB9C2 ; add FPA3 and FPA0 LBDA5 ldb V47 ; get exponent value aslb ; times 2 aslb ; times 4 addb V47 ; times 5 aslb ; times 10 suba #'0 ; remove ASCII bias pshs b ; save acculated result adda ,s+ ; add new digit to accumulated result sta V47 ; save new accumulated decimal exponent bra LBD55 ; interpret another exponent character LBDB6 fcb 0x9b,0x3e,0xbc,0x1f,0xfd ; packed FP: 99999999.9 LBDBB fcb 0x9e,0x6e,0x6b,0x27,0xfd ; packed FP: 999999999 LBDC0 fcb 0x9e,0x6e,0x6b,0x28,0x00 ; pakced FP: 1E9 LBDC5 ldx #LABE8-1 ; point to "IN" message bsr LBDD6 ; output the string ldd CURLIN ; get basic line number LBDCC std FPA0 ; save 16 bit unsigned integer ldb #0x90 ; exponent for upper 16 bits of FPA0 to be an integer coma ; set C (force normalization to treat as positive) jsr LBC86 ; zero bottom half, save exponent, and normalize bsr LBDD9 ; convert FP number to ASCII string LBDD6 jmp STRINOUT ; output string ; Convert FP number to ASCII string LBDD9 ldu #STRBUF+3 ; point to buffer address that will not cause string to go to string space LBDDC lda #0x20 ; default sign is a space character ldb FP0SGN ; get sign of value bpl LBDE4 ; brif positive lda #'- ; use negative sign LBDE4 sta ,u+ ; save sign stu COEFPT ; save output buffer pointer sta FP0SGN ; save sign character lda #'0 ; result is 0 if exponent is 0 ldb FP0EXP ; get exponent lbeq LBEB8 ; brif FPA0 is 0 clra ; base 10 exponent is 0 for > 1 cmpb #0x80 ; is number > 1? bhi LBDFF ; brif so ldx #LBDC0 ; point to 1E+09 jsr LBACA ; shift decimal to the right by 9 spaces lda #-9 ; account for shift LBDFF sta V45 ; save base 10 exponent LBE01 ldx #LBDBB ; point to 999999999 jsr LBCA0 ; are we above that? bgt LBE18 ; brif so LBE09 ldx #LBDB6 ; point to 99999999.9 jsr LBCA0 ; are we above that? bgt LBE1F ; brif in range jsr LBB6A ; multiply by 10 (we were small) dec V45 ; account for shift bra LBE09 ; see if we've come into range LBE18 jsr LBB82 ; divide by 10 inc V45 ; account for shift bra LBE01 ; see if we've come into range LBE1F jsr LB9B4 ; add 0.5 to FPA0 (rounding) jsr LBCC8 ; do the integer dance ldb #1 ; default decimal flag (force immediate decimal) lda V45 ; get base 10 exponent adda #10 ; account for "unormalized" number bmi LBE36 ; brif number < 1.0 cmpa #11 ; do we have more than 9 places? bhs LBE36 ; brif so - do scientific notation deca tfr a,b lda #2 ; force no scientific notation LBE36 deca ; subtract wo without affecting carry deca sta V47 ; save exponent - 0 is do not display in scientific notation stb V45 ; save number of places to left of decimal bgt LBE4B ; brif >= 1 ldu COEFPT ; point to string buffer lda #'. ; put decimal sta ,u+ tstb ; is there anything to left of decimal? beq LBE4B ; brif not lda #'0 ; store a zero sta ,u+ LBE4B ldx #LBEC5 ; point to powers of 10 ldb #0x80 ; set digit counter to 0x80 LBE50 lda FPA0+3 ; add mantissa to power of 10 adda 3,x sta FPA0+3 lda FPA0+2 adca 2,x sta FPA0+2 lda FPA0+1 adca 1,x sta FPA0+1 lda FPA0 adca ,x sta FPA0 incb ; add one to digit counter rorb ; put carry into bit 7 rolb ; set V if carry and sign differ bvc LBE50 ; brif positive mantissa or carry is 0 and negative mantissa bcc LBE72 ; brif negative mantissa subb #10+1 ; take 9's complement if adding mantissa negb LBE72 addb #'0-1 ; add ASCII bias leax 4,x ; move to next power of 10 tfr b,a ; save digit anda #0x7f ; remove add/subtract flag sta ,u+ ; put in output dec V45 ; do we need a decimal yet? bne LBE84 ; brif not lda #'. ; put decimal sta ,u+ LBE84 comb ; toggle bit 7 (add/sub flag) andb #0x80 ; only keep bit 7 cmpx #LBEC5+9*4 ; done all places? bne LBE50 ; brif not LBE8C lda ,-u ; get last character cmpa #'0 ; was it 0? beq LBE8C ; brif so cmpa #'. ; decimal? bne LBE98 ; brif not leau -1,u ; move past decimal if it isn't needed LBE98 lda #'+ ; plus sign ldb V47 ; get scientific notation exponent beq LBEBA ; brif not scientific notation bpl LBEA3 ; brif positive exponent lda #'- ; negative sign for base 10 exponent negb ; switch to positive exponent LBEA3 sta 2,u ; put sign lda #'E ; put "E" sta 1,u lda #'0-1 ; init to ASCII 0 (compensate for INC) LBEAB inca ; bump digit subb #10 ; have we hit the correct one yet? bcc LBEAB ; brif not addb #'9+1 ; convert units digit to ASCII std 3,u ; put exponent in output clr 5,u ; put trailing NUL bra LBEBC ; go reset pointer LBEB8 sta ,u ; store last character LBEBA clr 1,u ; put NUL at the end LBEBC ldx #STRBUF+3 ; point to start of string rts LBEC0 fcb 0x80,0x00,0x00,0x00,0x00 ; packed FP 0.5 LBEC5 fqb -100000000 fqb 10000000 fqb -1000000 fqb 100000 fqb -10000 fqb 1000 fqb -100 fqb 10 fqb -1 LBEE9 lda FP0EXP ; get exponent of FPA0 beq LBEEF ; brif 0 - don't flip sign com FP0SGN ; flip sign LBEEF rts ; Expand a polynomial of the form ; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table LBEF0 stx COEFPT ; save coefficient table pointer jsr LBC2F ; copy FPA0 to FPA3 bsr LBEFC ; multiply FPA3 by FPA0 bsr LBF01 ; expand polynomial ldx #V40 ; point to FPA3 LBEFC jmp LBACA ; multiply FPA0 by FPA3 LBEFF stx COEFPT ; save coefficient table counter LBF01 jsr LBC2A ; move FPA0 to FPA4 ldx COEFPT ; get the current coefficient ldb ,x+ ; get the number of entries stb COEFCT ; save as counter stx COEFPT ; save new pointer LBF0C bsr LBEFC ; multiply (X) and FPA0 ldx COEFPT ; get this coefficient leax 5,x ; move to next one stx COEFPT ; save new pointer jsr LB9C2 ; add (X) to FPA0 ldx #V45 ; point X to FPA4 dec COEFCT ; done all coefficients? bne LBF0C ; brif more left rts ; RND function RND jsr LBC6D ; set flags on FPA0 bmi LBF45 ; brif negative - set seed beq LBF3B ; brif 0 - do random between 0 and 1 bsr LBF38 ; convert to integer jsr LBC2F ; save range value bsr LBF3B ; get random number ldx #V40 ; point to FPA3 bsr LBEFC ; multply (X) by FPA0 ldx #LBAC5 ; point to FP 1.0 jsr LB9C2 ; add 1 to FPA0 LBF38 jmp INT ; return integer value LBF3B ldx RVSEED+1 ; move variable random number seed to FPA0 stx FPA0 ldx RVSEED+3 stx FPA0+2 LBF45 ldx RSEED ; move fixed seed to FPA1 stx FPA1 ldx RSEED+2 stx FPA1+2 jsr LBAD0 ; multiply them ldd VAD ; get lowest order product bytes addd #0x658b ; add a constant std RVSEED+3 ; save it as new seed std FPA0+2 ; save in result ldd VAB ; get high order extra product bytes adcb #0xb0 ; add upper bytes of constant adca #5 std RVSEED+1 ; save as new seed std FPA0 ; save as result clr FP0SGN ; set result to positive lda #0x80 ; set exponent to 0 < FPA0 < 1 sta FP0EXP lda FPA2+2 ; get a byte from FPA2 sta FPSBYT ; save as extra precision jmp LBA1C ; go normalize FPA0 RSEED fqb 0x40e64dab ; constant random number generator seed ; SIN function SIN jsr LBC5F ; copy FPA0 to FPA1 ldx #LBFBD ; point to 2*pi ldb FP1SGN ; get sign of FPA1 jsr LBB89 ; divide FPA0 by 2*pi jsr LBC5F ; copy FPA0 to FPA1 bsr LBF38 ; convert FPA0 to an integer clr RESSGN ; set result to positive lda FP1EXP ; get exponent of FPA1 ldb FP0EXP ; get exponent of FPA0 jsr LB9BC ; subtract FPA0 from FPA1 ldx #LBFC2 ; point to FP 0.25 jsr LB9B9 ; subtract FPA0 from 0.25 (pi/2) lda FP0SGN ; get result sign pshs a ; save it bpl LBFA6 ; brif positive jsr LB9B4 ; add 0.5 (pi) to FPA0 lda FP0SGN ; get sign of result bmi LBFA9 ; brif negative com RELFLG ; if 3pi/2 >= arg >= pi/2 LBFA6 jsr LBEE9 ; flip sign of FPA0 LBFA9 ldx #LBFC2 ; point to 0.25 jsr LB9C2 ; add 0.25 (pi/2) to FPA0 puls a ; get original sign tsta ; was it positive bpl LBFB7 ; brif so jsr LBEE9 ; flip result sign LBFB7 ldx #LBFC7 ; point to series coefficients jmp LBEF0 ; go calculate value LBFBD fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi LBFC2 fcb 0x7f,0x00,0x00,0x00,0x00 ; 0.25 ; modified taylor series SIN coefficients LBFC7 fcb 6-1 ; six coefficients fcb 0x84,0xe6,0x1a,0x2d,0x1b ; -((2pi)^11)/11! fcb 0x86,0x28,0x07,0xfb,0xf8 ; ((2pi)^9)/9! fcb 0x87,0x99,0x68,0x89,0x01 ; -((2pi)^7)/7! fcb 0x87,0x23,0x35,0xdf,0xe1 ; ((2pi)^5)/5! fcb 0x86,0xa5,0x5d,0xe7,0x28 ; -(2pi)^3)/3! fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi ; these 12 bytes are unused fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43 fcb 0x89,0xcd,0xa6,0x81 ; these are a copy of the interrupt vectors that live at the top of the ROM. It's not clear ; why these vectors have been modified since they are not actually used. fdb INT.SWI3 ; SWI3 fdb INT.SWI2 ; SWI2 fdb INT.FIRQ ; FIRQ fdb INT.IRQ ; IRQ fdb INT.SWI ; SWI fdb INT.NMI ; NMI fdb L8C1B ; RESET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Coco3 internal ROM, upper 32K ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This is the initialization code specific to the Coco3. This handles copying the ROMs to RAM and adding various patches in. ; This sequence of code demonstrates clearly that the creators of the Coco3 additions were rushed and didn't have a clear ; understanding of the Coco3 hardware or how Color Basic works. There is evidence of last minute adjustments along with code ; that serves no purpose but which is still present. ; ; There is also a major bug. The F1 for burst phase invert enable is clearly supposed to be enabled for the HSCREEN graphics ; modes. However, the code that enables it actually patches the wrong byte in the graphics mode initializers. Instead of enabling ; the burst phase invert bit in FF98, it actually enables the FIRQ enable bit in FF90. SC000 orcc #0x50 ; make sure interrupts are disabled lds #0x5eff ; put the stack somewhere lda #0x12 ; nuclear green colour ldb #16 ; 16 palette registers ldx #PALETREG ; point to palette registers SC00D sta ,x+ ; set a palette register to green decb ; done? bne SC00D ; brif not ldx #MMUREG ; point to MMU registers leay MMUIMAGE,pcr ; point to MMU initializer ldb #16 ; there are 16 MMU registers SC01B lda ,y+ ; copy an MMU initializer sta ,x+ decb ; done all? bne SC01B ; brif not lda #COCO+MMUEN+MC3+MC2+MC1 ; enable coco compatible, mmu, SCS, FExx, and 32K internal sta INIT0 leax BEGMOVE,pcr ; point to start of relocated initialization code ldy #0x4000 ; point to RAM address where it goes SC02F ldd ,x++ ; copy four bytes ldu ,x++ std ,y++ stu ,y++ cmpx #ENDMOVE ; copied everything? blo SC02F ; brif not jmp 0x4000 ; transfer control to code in RAM ; The rest runs from RAM. This allows it to mess with the ROM mapping (for the ROM/RAM copy). Unfortunately, ; this clobbers an 8K memory block *before* it determines that it isn't going to copy ROM to RAM which is ; somewhat problematic for things that intercept a warm start. BEGMOVE leas -1,s ; make a hole on the stack nop ; space fillers; probably something removed at the eleventh hour nop nop nop nop lda #0xff ; set GIME timer to maximum value and start it counting sta V.TIMER sta V.TIMER+1 leax VIDIMAGE,pcr ; point to video mode initializer ldy #VIDEOMOD ; point to video mode registers SC056 lda ,x+ ; copy a byte sta ,y+ cmpy #MMUREG ; done? bne SC056 ; brif not ldx #PIA1 ; point to PIA1 ldd #0xff34 ; set up for initializing PIAs clr 1,x ; set PIA1 DA to direction mode clr 3,x ; set PIA1 DB to direction mode deca sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input sta 2,x stb 1,x ; set PIA1 DA to data mode stb 3,x ; set PIA1 DB to data mode clr 2,x ; set VDG to alpha-numeric lda #2 ; set RS232 to marking sta ,x lda #0xff ldx #PIA0 ; point to PIA0 clr 1,x ; set PIA0 DA to direction mode clr 3,x ; set PIA0 DB to direction mode clr ,x ; set PIA0 DA to input sta 2,x ; set PIA0 DB to output stb 1,x ; set PIA0 DA to direction mode stb 3,x ; set PIA0 DB to direction mode ldb #12 ; there are 12 SAM bits to reset ldu #SAMREG ; point to SAM register SC091 sta ,u++ ; clear a bit decb ; done all? bne SC091 ; brif not sta SAMREG+9 ; put VDG display at 0x400 tfr b,dp ; set direct page to 0 clr 2,x ; strobe all keyboard columns (pointless) sta -3,u ; select RAM page 1 (also pointless) ldx #PIA0 ; point to PIA0 (unneeded - already points there) ldb #0xdf ; column strobe for F1 stb 2,x ; strobe for F1 lda ,x ; get row data coma ; set nonzero if F1 down anda #0x40 sta ,s ; save F1 state for later ldy #2 ; check for two keys SC0B1 asrb ; shift strobe (why not just shift directly in the PIA?) stb 2,x ; strobe new column lda ,x ; get row data coma ; set nonzero if CTRL or ALT is down anda #0x40 beq SC0C2 ; brif not - we don't have C-A-RESET leay -1,y ; done both? bne SC0B1 ; brif not lbra SC1F0 ; go do easter egg picture if C-A-RESET SC0C2 lda #COCO+MMUEN+MC3+MC1 ; turn off standard SCS (why?) sta INIT0 ; This checks if we have a valid warm start routine. If there is one, we don't do a ROM/RAM copy. This and ; everything above could just as easily have been done from ROM. lda INT.FLAG ; are the bounce vectors valid? cmpa #0x55 bne SC0F6 ; brif not - copy ROM to RAM lda RSTFLG ; is the DP reset vector marked valid? cmpa #0x55 bne NOWARM ; brif not ldx RSTVEC ; does the vector point to NOP? lda ,x cmpa #0x12 lbeq SC18C ; brif so - don't do ROM/RAM copy NOWARM clr MMUREG ; put bottom memory block in logical block 0 (replaces DP) lda RSTFLG ; does this give us a valid reset vector? cmpa #0x55 bne SC0F1 ; brif not ldx RSTVEC ; does this routine point to a NOP? lda ,x cmpa #0x12 lbeq SC18C ; brif so - don't do ROM/RAM copy and keep modified memory map SC0F1 lda #BLOCK7.0 ; restore memory map sta MMUREG SC0F6 ldx #DOSBAS ; point to the end of Color Basic ldy #EXBAS ; point to start of Extended Basic lbsr SC1AA ; copy them to RAM leay PATCHTAB,pcr ; point to patch table lda ,y+ ; get number of patches to be made SC106 pshs a ; save patch counter ldx ,y++ ; get address to patch ldb ,y+ ; get number of bytes in the patch SC10C lda ,y+ ; copy a byte sta ,x+ decb ; done all in this patch? bne SC10C puls a ; get back patch counter deca ; done all patches? bne SC106 ; brif not clr TYCLR ; got back to ROM mode lda #COCO+MMUEN+MC3 ; set up for 16K split mode sta INIT0 ldd DOSBAS ; is there a Disk Basic ROM signature? cmpa #'D ; (note that this should just be CMPD) bne SC137 cmpb #'K bne SC137 ldx #SUPERVAR ; point to end of Disk Basic ROM ldy #DOSBAS ; point to start of Disk Basic ROM bsr SC1AA ; copy it to RAM lbsr SC322 ; add patches to Disk Basic SC137 clr TYCLR ; go back to ROM mode lda #COCO+MMUEN+MC3+MC1 ; set 32K internal mocde sta INIT0 ldx #H.CRSLOC ; point to end of the Coco3 additions ldy #SUPERVAR ; point to start of the Coco3 additions bsr SC1AA ; copy it to RAM lbsr SC1DE ; set up an easter egg leay INTIMAGE,pcr ; point to bounce vector initializer ldx #INT.FLAG ; point to bounce vectors ldb #19 ; 19 bytes in bounce vectors lbsr MOVE.XY ; initialize the bounce vectors clr TYSET ; enable RAM mode (the ROM/RAM copy already did this) tst ,s ; was F1 pressed? beq SC180 ; brif not ldx #IM.TEXT ; point to text mode initializers ldb #3 ; there are three sets of them leax 1,x ; move past the FF90 initializer SC165 lda ,x ; get video mode initializer ora #0x20 ; enable burst phase invert sta ,x ; update initializer leax 9,x ; move to next mode decb ; done all of them? bne SC165 ; brif not ldb #2 ; two graphics mode initalizers ldx #IM.GRAPH ; point to graphics mode initializers (should be +1; we're actually enabling GIME FIRQ) SC175 lda ,x ; get initializer ora #0x20 ; enable burst phase invert (or it would if X pointed to the right place) sta ,x ; save modified initializer leax 9,x ; move to next set decb ; done all of them? bne SC175 ; brif not SC180 ldx #VIDRAM ; point to start of VDG text screen lda #0x60 ; VDG space character SC185 sta ,x+ ; blank a character cmpx #VIDRAM+512 ; end of screen? blo SC185 ; brif not SC18C lda #COCO+MMUEN+MC3+MC2+MC1 ; turn the SCS back on sta INIT0 tst ,s ; F1? beq SC19A ; brif not lda #0x20 ; enable burst phase invert sta VIDEOMOD SC19A ldx #PALETREG ; point to palette registers leay PALIMAGE,PCR ; point to palette initializer ldb #16 ; do 16 palette registers bsr MOVE.XY ; initialize palette leas 1,s ; clean up stack (not much point since it will be reset anyway) jmp RESVEC ; transfer control to the original Color Basic initialization routine SC1AA stx 0x5f02 ; save end copy address sts 0x5f00 ; save stack SC1B1 clr TYCLR ; go to ROM mode ldd ,y ; grab 8 bytes ldx 2,y ldu 4,y lds 6,y clr TYSET ; go to RAM mode std ,y ; save the 8 bytes stx 2,y stu 4,y sts 6,y leay 8,y ; move pointer forward cmpy 0x5f02 ; done yet? blo SC1B1 ; brif not lds 0x5f00 ; restore stack pointer rts MOVE.XY lda ,y+ ; copy a byte sta ,x+ decb ; done all? bne MOVE.XY ; brif not rts SC1DE ldx #AUTHORMS ; point to author name easter egg leay SC30D,pcr ; point to encoded names ldb #21 ; 21 bytes in names SC1E7 lda ,y+ ; get encoded byte coma ; decode (wow. one's complement encoding.) sta ,x+ ; put in copied ROM decb ; done all? bne SC1E7 ; brif not rts SC1F0 clra ; set up to mark things as invalid sta INT.FLAG ; mark bounce vectors invalid sta RSTFLG ; mark reset vector invalid sta TYCLR ; go to ROM mode ldb #9 ; foreground colour for image stb PALETREG+10 ldb #63 ; white background stb PALETREG+11 ldx #AUTHPIC ; point to author picture data ldy #0xe00 ; put picture at 0xe00 in memory SC20A ldd ,x++ ; copy four bytes ldu ,x++ std ,y++ stu ,y++ cmpx #AUTHPICe ; at end of picture data? blo SC20A ; brif not lda #0xf9 ; 256x192, CSS0 VDG mode sta PIA1+2 clra ; this instruction is useless ldx #SAMREG ; point to SAM register sta ,x ; set SAM address to 0xe00 and video mode to 256x192 sta 3,x sta 5,x sta 7,x sta 9,x sta 11,x WAITLOOP bra WAITLOOP ; freeze the system VIDIMAGE fcb 0x00,0x00,0x00,0x00,0x0f,0xe0,0x00,0x00 PALIMAGE fcb 18,36,11,7,63,31,9,38,0,18,0,63,0,18,0,38 MMUIMAGE fcb BLOCK7.0,BLOCK7.1,BLOCK6.4,BLOCK7.3 fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7 fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2 fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7 PATCHTAB fcb 27 ; 27 patches to install ; Patch #1: enable warm start routine after ROM/RAM copy patch1 fdb XBWMST fcb patch2-*-1 nop ; Patch #2: intercept tokenization routine patch2 fdb LB8D4 fcb patch3-*-1 jmp ALINK2 ; Patch #3: intercept detokenization routine patch3 fdb LB7F3 fcb patch4-*-1 jmp ALINK3 ; Patch #4: intercept Extended Basic's command interpretation handler patch4 fdb L8150 fcb patch5-*-1 jmp ALINK4 nop ; Patch #5: intercept Extended Basic's function handler patch5 fdb L816C fcb patch6-*-1 jmp ALINK5 nop ; Patch #6 through patch #10 - extend &H and &O to allow 24 bit values patch6 fdb L8834 fcb patch7-*-1 jmp ALINK6A clr FPA0+1 clr FPA0+2 clr FPA0+3 bra *-78 clr FPA0 bra *-47 jmp ALINK6B patch7 fdb L87EB fcb patch8-*-1 bra *+76 nop rts ldx #FPA0+1 patch8 fdb L880C fcb patch9-*-1 bra *+55 patch9 fdb L8826 fcb patch10-*-1 bcs *+25 patch10 fdb L87E7 fcb patch11-*-1 bne *+7 ; Patch #11 is needed because the above removed an RTS used by this routine patch11 fdb L886A fcb patch12-*-1 bne *-124 ; Patch #12 - intercept signon message display patch12 fdb L80B2 fcb patch13-*-1 jmp ALINK12 ; Patch #13 - remove one carriage return from signon message patch13 fdb L80E8+82 fcb patch14-*-1 fcb 0 ; Patch #14 - extend Extended Basic's graphics initialization routine patch14 fdb L9703 fcb patch15-*-1 jmp ALINK14 ; Patch #15 - intercept break check patch15 fdb LADF0 fcb patch16-*-1 jmp ALINK15 nop ; Patch #16 - intercept break check when handling "line input" patch16 fdb LA3C2 fcb patch17-*-1 jmp ALINK16 nop ; Patch #17 - cause INPUT to respond to ON BRK patch17 fdb LB03C+1 fcb patch18-*-1 fdb ALINK17 ; Patch #18 - intercept ON command patch18 fdb ON fcb patch19-*-1 jmp ALINK18 ; Patch #19 - add on extra stuff to end of NEW patch19 fdb LAD3F fcb patch20-*-1 jmp ALINK19 nop ; Patch #20 - intercept error handler patch20 fdb LAC46 fcb patch21-*-1 jmp ALINK20 ; Patch #21 - intercept immediate mode loop patch21 fdb LAC73 fcb patch22-*-1 jmp ALINK21 ; Patch #22 - intercept character to screen routine patch22 fdb LA30A fcb patch23-*-1 jmp L8C37 ; Patch #23 - intercept CLS patch23 fdb CLS fcb patch24-*-1 jmp L8C46 ; Patch #24 - intercept waiting for keypress with cursor routine patch24 fdb LA1B1 fcb patch25-*-1 jmp LA0CE nop nop nop nop nop ; Patch #25 - intercept PRINT @ patch25 fdb LB902 fcb patch26-*-1 jmp ALINK25 ; Patch #26 - intercept conditional newline routine patch26 fdb LB95C fcb patch27-*-1 jmp ALINK26 ; Patch #27 - intercept CLEAR handling in line input routine patch27 fdb LA38D fcb patch27e-*-1 jmp ALINK27 patch27e equ * ; Names of the authors in one's complemented ASCII SC30D fcb 0xab,0xd1,0xb7,0x9e,0x8d,0x8d,0x96,0x8c fcb 0xdf,0xd9,0xdf,0xab,0xd1,0xba,0x9e,0x8d fcb 0x93,0x9a,0x8c,0xf2,0xff SC322 lda DOSBAS+4 ; get MSB of DSKCON vector cmpa #0xd6 ; is it 0xd6? bne SC334 ; brif not - we have Disk Basic 1.1 ldx #0xc0c6 ; point to patch address in Disk Basic 1.0 leay SC355,pcr ; point to patch for Disk Basic 1.0 ldb ,y+ ; get number of bytes to patch bra SC349 ; go patch it SC334 ldx #0xC8B4 ; point to Disk Basic 1.1 keyboard check (in the interpretation loop handler) lda #0x12 ; NOP opcode ldb #11 ; clobber 11 bytes (which check for a key down before calling the break check) SC33B sta ,x+ ; put a NOP decb ; done? bne SC33B ; brif not ldx #0xc0d9 ; point to the Disk Basic 1.1 patch address leay SC351,pcr ; point to patch for Disk Basic 1.1 ldb ,y+ ; get number of bytes in patch SC349 lda ,y+ ; put a byte from the patch sta ,x+ decb ; done yet? bne SC349 ; brif not rts ; Copyright message patch for Disk Basic 1.1 SC351 fcb SC355-*-1 jmp ALINK29 ; Copyright message patch for Disk Basic 1.0 SC355 fcb SC355e-*-1 jmp ALINK28 SC355e equ * ; This is the initializer for the bounce vector table. It sets up to transfer control to Color Basic's ; interrupt vectors at 0x100. These really should be JMP instead of LBRA, if only because JMP is faster. INTIMAGE fcb 0x55 ; valid vector table flag lbra (INTIMAGE+1)-(INT.JUMP)+SW3VEC ; SWI3 lbra (INTIMAGE+1)-(INT.JUMP)+SW2VEC ; SWI2 lbra (INTIMAGE+1)-(INT.JUMP)+FRQVEC ; FIRQ lbra (INTIMAGE+1)-(INT.JUMP)+IRQVEC ; IRQ lbra (INTIMAGE+1)-(INT.JUMP)+SWIVEC ; SWI lbra (INTIMAGE+1)-(INT.JUMP)+NMIVEC ; NMI ENDMOVE equ * ; Unused bytes fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x55,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0x00,0x18,0x00,0x0E,0x00 ; This is the "pmode 4" author picture easter egg AUTHPIC fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFB,0xEE,0xEF,0xFB,0xFF,0xBB,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB fcb 0xBB,0xBB,0xBF,0xBB,0xBB,0xFF,0xBF,0xFF,0xFE,0xEF,0xFF,0xFF,0xFF,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xBB,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEE,0xFE,0xEE fcb 0xEE,0xEE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEE,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xFF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xAA,0xAE,0xAA,0xAE,0xAA,0xEA,0xBB,0xBB,0xFB,0xFF,0xBB,0xFF,0xBF,0xBF fcb 0xFF,0xFB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBB,0xBA,0xEA,0xAA,0xEE,0xAE,0xEE,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF fcb 0xFF,0xFE,0xEF,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBB,0xBB,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xAA,0xEE,0xAA,0xAA,0xAA,0xEA,0xAB,0xBB,0xBB,0xFF,0xBB,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xFF,0xBB,0xBB,0xEA,0xAE,0xAA,0xAA,0xAF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEF,0xEE,0xEE,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEE,0xFF,0xEF,0xEE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xEA,0xAA,0xBB,0xBB,0xBB,0xBB,0xBB,0xFB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFB,0xFB,0xBB,0xBB,0xBA,0xAA,0xAA,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEE,0xEF,0xFE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBB,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x0F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xBB,0xBB,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEA,0xAB,0xAA,0xAB,0xBB,0xBB,0xBF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x7F fcb 0xFF,0xFF,0xC0,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xBF,0xAA,0xAA,0xAA,0xEF,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEF,0xEE,0xFF,0xFF,0xFF,0xEE,0xFF,0xFF,0x80,0x00,0x3F fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xEE,0xFE,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBB,0xBB,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xAB,0xAE,0xEB,0xBB,0xBF,0xFB,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x1F fcb 0xFF,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xBB,0xAA,0xAA,0xBE,0xAB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBF,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFB,0xFB,0xBB,0xBB,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xEE,0xEE,0xEE,0xEF,0xFE,0xEF,0xFF,0xFF,0xFF,0x80,0x00,0x0F fcb 0xFF,0xFE,0x00,0x00,0x3F,0xFF,0xFF,0xEF,0xEF,0xEE,0xEE,0xEE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEA,0xAB,0xBA,0xAB,0xBB,0xFB,0xFF,0xBF,0xFF,0xFF,0xFF,0x80,0x00,0x07 fcb 0xFF,0xFC,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFB,0xAA,0xFF,0xFE,0xEA,0xAB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBF,0xFB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFE,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x03 fcb 0xFF,0xF8,0x00,0x00,0x3F,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0xFE,0xEE,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xBB,0xBF,0xFF,0xBB,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xAA,0xFB,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x01 fcb 0xFF,0xF0,0x00,0x00,0x3F,0xFF,0xFF,0xBB,0xBB,0xAE,0xBB,0xBE,0xAF,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFE,0xFF,0xFF,0xFF,0xFF,0x80,0x08,0x00 fcb 0xFF,0xE0,0x02,0x00,0x3F,0xFF,0xFF,0xFE,0xEF,0xEE,0xFF,0xEE,0xEF,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFB,0xFF,0xFF,0xBB,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xAA,0xBB,0xBB,0xFB,0xBB,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 fcb 0x7F,0xC0,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xBB,0xFF,0xFF,0xBF,0xEB,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xEF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0E,0x00 fcb 0x3F,0x80,0x0E,0x00,0x3F,0xFF,0xFF,0xFE,0xFF,0xFF,0xFE,0xEE,0xEE,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF3,0xEA,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x00 fcb 0x1F,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0x80 fcb 0x0E,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xEE,0xFF,0xFF,0xFF,0xFE,0xEF,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBF,0x7F,0xFF fcb 0xFF,0xF6,0xEA,0xBB,0xBB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0 fcb 0x00,0x00,0x7E,0x00,0x3F,0xFF,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0xBA,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xE0 fcb 0x00,0x00,0xFE,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xFE,0xEF,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF6,0xEB,0xBF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x80,0x0F,0xC0 fcb 0x00,0x00,0x3E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xEB,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00 fcb 0x00,0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xBA,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEF,0xFF,0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 fcb 0x00,0x00,0x1E,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xEE,0xEB,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xFF,0xFC,0x00,0x0F,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xAA,0x7F,0xFF fcb 0xFF,0xF6,0xAB,0xBB,0xFF,0xFF,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x80,0x0C,0x00 fcb 0x00,0x00,0x06,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x79,0x9F,0xFB,0xAB,0x7F,0xFF fcb 0xFF,0xF7,0xBB,0xFF,0xFF,0xF8,0x00,0x00,0x01,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00 fcb 0x00,0x38,0x03,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x03,0xFE,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x4F,0xFF,0xFF,0xFF,0x80,0x00,0x00 fcb 0x01,0x7C,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFF,0x80,0x00,0x00,0xFA,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x01,0xFF,0xFF,0xF0,0x00,0x00,0x00 fcb 0x03,0xFE,0x00,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x7E,0xEE,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0x80,0x00,0x00 fcb 0x0F,0xFF,0x00,0x00,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x3B,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xFF,0xFF,0x00,0x00 fcb 0x2F,0xFF,0x00,0x7F,0xFF,0xFF,0xFF,0xFF,0xF0,0x00,0x00,0x00,0x0E,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xFF,0x80,0x00,0x01 fcb 0xFF,0xFF,0x80,0x00,0x3F,0xFF,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x07,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF0,0x00,0x00,0x03 fcb 0xFF,0xFF,0x40,0x00,0x03,0xFF,0xFF,0xFF,0xC0,0x00,0x00,0x00,0x03,0xEE,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xFF,0xF0,0x00,0x00,0x00,0x01,0x00,0x1F,0xFF,0xFF,0x80,0x01,0x07 fcb 0xFF,0xFF,0xA0,0x00,0x3F,0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x01,0xBB,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x01,0x80,0x1F,0xFF,0xFF,0xFE,0x0E,0x2F fcb 0xFF,0xFF,0xC0,0x1F,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xFF,0xFF,0xE0,0x00,0x00,0x00,0x65,0xE0,0x0F,0xFF,0xFF,0x80,0x0C,0x1F fcb 0xFF,0xFF,0xE0,0x00,0x3F,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x3B,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xC0,0x00,0x00,0x0B,0xFF,0xF0,0x0F,0xFF,0xFC,0x00,0x18,0x0F fcb 0xF8,0x00,0x60,0x00,0x07,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xFF,0xC0,0x00,0x01,0xFF,0xFF,0xF8,0x0F,0xFF,0xFF,0x80,0x00,0x01 fcb 0xF8,0x00,0x20,0x00,0x3F,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x00,0x00,0x1B,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x80,0x00,0x03,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xFC,0x03,0x03 fcb 0xFF,0x7F,0xF0,0x03,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF fcb 0xFF,0xF7,0xFE,0xFF,0x80,0x01,0x5D,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0xC0,0x07,0xF1 fcb 0xFC,0x07,0xFC,0x00,0x3F,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x00,0x00,0x03,0x7F,0xFF fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x02,0xEF,0xFF,0xFF,0xFC,0x0F,0xFF,0xFF,0x00,0x0E,0x00 fcb 0x7C,0x00,0xF4,0x00,0x0C,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x00,0x00,0x0E,0x7F,0xFF fcb 0xFF,0xF2,0xAB,0xFF,0x00,0x05,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1C,0x00 fcb 0xFC,0x01,0xF8,0x01,0xFB,0xBF,0xFF,0xF8,0x00,0x00,0x0F,0xE1,0x80,0x0B,0x7F,0xFF fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x03,0xFF,0xFF,0xFF,0xFE,0x0F,0xFF,0xFF,0xF8,0x1F,0xC0 fcb 0xFE,0x3F,0xFC,0x01,0xF6,0xDF,0xFF,0xF8,0x00,0x3F,0xFF,0xFF,0x80,0x0E,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x07,0xFF,0xFF,0xFF,0xFE,0x0F,0xFE,0xFF,0xFC,0x1F,0xF1 fcb 0xFF,0x9F,0xF8,0x37,0xF5,0xDF,0xFF,0xF8,0x00,0xFF,0xFF,0xFF,0x80,0x0B,0x7F,0xFF fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x07,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xF8,0x0F,0xEF fcb 0x7F,0xFF,0xFC,0x03,0xF6,0xDF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0x80,0x06,0x7F,0xFF fcb 0xFF,0xF6,0xFF,0xBF,0x00,0x03,0xFF,0xFF,0xFF,0xFF,0x07,0xFB,0xBB,0xFD,0xDF,0xFF fcb 0xEF,0xFF,0xF9,0x7F,0xFB,0xBF,0xFF,0xFC,0x7F,0xFF,0xFF,0xFF,0xC0,0x0B,0x7F,0xFF fcb 0xFF,0xF7,0xBF,0xFE,0x00,0x03,0xFF,0xFF,0xFF,0xF8,0x07,0xFF,0xFF,0xFF,0x9F,0xFF fcb 0xFF,0xFF,0xFF,0xBF,0xFC,0x7F,0xFF,0xFC,0x75,0x0F,0xFF,0xCF,0xC0,0x0E,0x7F,0xFF fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x07,0xF5,0x47,0xFF,0xE0,0x07,0xFF,0xEF,0xFF,0xCF,0xFD fcb 0xFF,0xFF,0xFF,0x3F,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0xE0,0x07,0xC0,0x0F,0x7F,0xFF fcb 0xFF,0xF7,0xBF,0xFF,0x00,0x0F,0xF8,0x07,0xFF,0xDC,0x07,0xFF,0xFF,0xFF,0xCF,0xFB fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFC,0x00,0x00,0x00,0x03,0xE0,0x0D,0x7F,0xFF fcb 0xFF,0xF6,0xFF,0xFE,0x00,0x1F,0xD1,0x1F,0xFF,0xEF,0x07,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xF1,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x00,0x00,0x00,0x7B,0xF0,0x0B,0x7F,0xFF fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xFF,0xEF,0xFE,0x81,0x07,0xFF,0xFF,0xFF,0x7F,0xF8 fcb 0x40,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x60,0x01,0xFC,0x1D,0xF0,0x0D,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0x01,0xFE,0x01,0x87,0xFE,0xEE,0xFF,0xFF,0xF0 fcb 0x00,0x1F,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0xE0,0x03,0xF0,0x67,0xF0,0x17,0x7F,0xFF fcb 0xFF,0xF3,0xBF,0xFE,0x00,0x1F,0xF8,0x01,0xFC,0x03,0x87,0xFF,0xFF,0xFF,0xFF,0xC0 fcb 0x00,0x0F,0xFC,0x3F,0xFF,0xFF,0xFF,0xFF,0xC0,0x03,0xF0,0x33,0xF0,0x5F,0x7F,0xFF fcb 0xFF,0xF6,0xAF,0xFE,0x00,0x1F,0xFF,0xF0,0xFE,0x0F,0x87,0xFF,0xBF,0xFF,0xFF,0x80 fcb 0xFF,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x03,0xFA,0xFF,0xF1,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x1F,0xFF,0xFE,0xFE,0x9B,0x87,0xFF,0xFF,0xFF,0xFF,0xBD fcb 0x80,0xF3,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x17,0xFF,0xFF,0xF4,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xFF,0x00,0x1F,0xFF,0xFF,0xFF,0x03,0x87,0xEF,0xEE,0xEF,0xFF,0x00 fcb 0x00,0x07,0xF8,0x3F,0xFF,0xFF,0xFF,0xFF,0xFF,0x77,0xFF,0xFF,0xFE,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBF,0xBF,0x00,0x0F,0xFF,0xEF,0xF8,0x83,0x87,0xFF,0xFF,0xFF,0xFF,0xBE fcb 0xBF,0xFF,0xF8,0x7F,0xFF,0xFF,0xFF,0xFF,0xFD,0xB3,0xFF,0xFF,0xFD,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFF,0xF8,0x7F,0xF7,0x8F,0xFF,0xFB,0xBF,0xFF,0xFF fcb 0xFF,0xF7,0xFC,0xFF,0xBF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x0F,0xFF,0xF3,0x7F,0x0F,0x8F,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xBF,0xE3,0xFC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xFF,0xFF,0xFF,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEF,0x00,0x0F,0xFE,0xF7,0xFF,0xCF,0x8E,0xFF,0xFF,0xEF,0xFF,0xFF fcb 0x17,0xF7,0xFD,0xEF,0xEF,0xFE,0xFF,0xFF,0xFF,0x9F,0xFF,0xFF,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBB,0x00,0x07,0xFF,0xFE,0xFF,0xC1,0x9F,0xFF,0xFF,0xFF,0xFF,0xFE fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x07,0xF7,0xFF,0xFE,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x03,0xFF,0xC4,0x1C,0x03,0x9B,0xFB,0xAF,0xBF,0xFF,0xFF fcb 0xFF,0xFF,0xFE,0xFB,0xFB,0xBB,0xFF,0xBF,0xFE,0x02,0xAB,0xFF,0xF8,0xFB,0x7F,0xFF fcb 0xFF,0xF3,0xBF,0xBA,0x04,0x03,0xFA,0x00,0x00,0x01,0x9F,0xFF,0xBB,0xFF,0xFB,0xFF fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xFE,0xEF,0xFC,0x00,0x05,0xFF,0xF9,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEC,0x06,0x01,0xFC,0xA2,0x00,0x03,0x9F,0xEE,0xEE,0xEF,0xFE,0xFF fcb 0xFF,0xFF,0xFE,0xFF,0xFE,0xEE,0xEF,0xBF,0xFE,0x00,0x00,0x3F,0xFB,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xB0,0x00,0x01,0xFA,0x10,0x00,0x03,0x9F,0xFB,0xBB,0xFF,0xFB,0xFF fcb 0xFF,0xFF,0xFB,0xBF,0xFF,0xFB,0xBE,0xEF,0xFC,0x0F,0x80,0x1F,0xF6,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x68,0x5F,0xFE,0x03,0x1B,0xAE,0xAE,0xFB,0xEE,0xFD fcb 0xFF,0xFF,0xFE,0xAB,0xBB,0xEA,0xFF,0xBF,0xF8,0x0B,0xFC,0x1F,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0xBA,0x00,0x00,0x7B,0x0F,0xFE,0x00,0x1F,0xBB,0xBB,0xFF,0xFB,0xFF fcb 0xFF,0xFF,0xFB,0xBB,0xFF,0xBB,0xBE,0xEF,0xFC,0x07,0xFC,0x5F,0xF6,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0xEE,0x00,0x00,0x14,0x40,0x3C,0x00,0x0E,0xEE,0xEE,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFE,0xEE,0xEE,0xEE,0xEF,0xBF,0xFE,0x00,0x61,0xFF,0xFF,0xBB,0x7F,0xFF fcb 0xFF,0xF3,0xBB,0x80,0x00,0x00,0x00,0x7E,0x00,0x00,0x3F,0xBB,0xFF,0xFF,0xBF,0xFF fcb 0xFF,0xFF,0xFF,0xBB,0xFF,0xBB,0xBE,0xEF,0xFF,0xE0,0x07,0xFF,0xFF,0xEE,0x7F,0xFF fcb 0xFF,0xF6,0xEE,0x00,0x00,0x00,0x00,0x3F,0xEE,0x80,0x2E,0xAB,0xBF,0xBE,0xFC,0xFF fcb 0xFF,0xFF,0xFE,0xEB,0xBB,0xAA,0xBB,0xBF,0xEF,0xFA,0xFF,0xFF,0xF8,0x0B,0x7F,0xFF fcb 0xFF,0xF3,0xBA,0x00,0x00,0xC0,0x00,0x0F,0xFE,0x00,0x3B,0xBF,0xFF,0xFB,0xB1,0xFF fcb 0xFF,0xFF,0xF3,0xBB,0xFF,0xBB,0xAE,0xEF,0xBF,0xD9,0x7F,0xFF,0xF8,0x02,0x7F,0xFF fcb 0xFF,0xF6,0xEC,0x00,0x00,0xE0,0x00,0x00,0x00,0x00,0xEE,0xEE,0xEF,0xEE,0xE1,0xFF fcb 0xFF,0xFF,0xF0,0xEE,0xEE,0xEE,0xEB,0xBF,0xEF,0x8E,0x3F,0xFF,0xF8,0x00,0x7F,0xFF fcb 0xFF,0xF3,0xBA,0x00,0x00,0xF0,0x00,0x00,0x00,0x00,0xBB,0xBB,0xBF,0xBB,0xB1,0xFF fcb 0xFF,0xFF,0xE0,0x3B,0xFF,0xBB,0xEE,0xFF,0xBB,0x00,0x5F,0xFF,0xF8,0x00,0x7F,0xFF fcb 0xFF,0xF6,0xE0,0x04,0x00,0x78,0x00,0x00,0x00,0x01,0xEE,0xAA,0xAE,0xEA,0xC0,0x7F fcb 0xFF,0xFF,0x80,0x0B,0xFF,0xEF,0xAB,0xFF,0xEF,0xC2,0x3F,0xFF,0xFF,0xE0,0x7F,0xFF fcb 0xFF,0xF3,0x80,0x00,0x00,0x7C,0x00,0x00,0x00,0x00,0x3B,0xBB,0xBB,0xBB,0x00,0x3F fcb 0xFF,0xFF,0x00,0x03,0xFF,0xFE,0xEE,0xEF,0xBB,0xC0,0x7F,0xFF,0xFE,0xF8,0x7F,0xFF fcb 0xFF,0xF6,0x60,0xC0,0x00,0x7F,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEE,0xEC,0x00,0x01 fcb 0x3F,0xFC,0x00,0x00,0x6E,0xEF,0xFF,0xFB,0xEE,0xE2,0x3F,0xFF,0xFE,0x78,0x7F,0xFF fcb 0xFF,0xF0,0x98,0x60,0x00,0x3F,0x80,0x00,0x00,0x00,0x03,0xBB,0xBB,0xB8,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x01,0xBB,0xBB,0xBA,0xBB,0x5F,0x9F,0xFF,0xFC,0xF8,0x7F,0xFF fcb 0xFF,0xF6,0x00,0x30,0x00,0x0F,0xC0,0x00,0x00,0x00,0x00,0x6A,0xEE,0xA0,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFA,0xEE,0x83,0xFF,0xFF,0xFC,0xF8,0x7F,0xFF fcb 0xFF,0xF4,0x00,0x00,0x00,0x07,0xE0,0x00,0x00,0x00,0x05,0x13,0xBB,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x2E,0xEE,0xEA,0x9B,0xA3,0xFF,0xFF,0xFD,0xF0,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x01,0xF0,0x00,0x00,0x00,0x00,0x0E,0xEE,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x2F,0xFE,0xAA,0x0E,0xED,0xFF,0xFF,0xF9,0xF0,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x03,0xBB,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x0A,0xBA,0xA8,0x0B,0xFB,0x7F,0xFF,0xF3,0xF0,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x3C,0x00,0x00,0x00,0x00,0x02,0x8A,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xFE,0xA0,0x06,0xFE,0xFF,0xFF,0x07,0xF0,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x1E,0x00,0x00,0x00,0x00,0x07,0x03,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x02,0xAA,0x80,0x07,0xF9,0xFF,0xFC,0x07,0xF4,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x0F,0x14,0x0E,0x00,0x00,0x02,0x80,0x80,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xAA,0x80,0xBF,0xFF,0xBF,0xF0,0x0F,0xF6,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x03,0xFF,0xFC,0x00,0x00,0x03,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0xEA,0x0F,0xFE,0x7C,0x77,0x80,0x1F,0xF6,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0xF8,0x00,0x00,0x03,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x28,0x7F,0xFC,0xFE,0x80,0x00,0x1F,0xF7,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0xF0,0x00,0x00,0x03,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x37,0x3C,0xFE,0xC0,0x00,0xBF,0xF7,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x07,0x7F,0xE0,0x00,0x00,0xF3,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0x3E,0xFF,0x80,0x01,0xFF,0xF7,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0xA3,0xFF,0xC0,0x00,0x00,0x63,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F,0xFD,0xEE,0x80,0x07,0xFF,0xF7,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x63,0xFF,0xC0,0x00,0x00,0x73,0x00,0x00,0x00,0x00 fcb 0xFF,0x00,0x00,0x00,0x00,0x00,0x08,0x1F,0x78,0xF7,0xE8,0x9F,0xFF,0xFC,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x77,0xBF,0x80,0x00,0x00,0x33,0x00,0x00,0x00,0x3F fcb 0xBB,0xE0,0x00,0x00,0x00,0x00,0x00,0x1F,0xF8,0x3B,0x55,0x7F,0x80,0x70,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x01,0xFF,0x00,0x00,0x00,0x3B,0x00,0x00,0x00,0xFF fcb 0x3B,0xFC,0x00,0x00,0x00,0x00,0x00,0x1F,0xFF,0x1D,0x8E,0xE7,0x82,0xF8,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0xFF,0x00,0x00,0x00,0x30,0x00,0x00,0x01,0xFE fcb 0xF9,0x9F,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF,0xC1,0x17,0xFF,0xFF,0xC0,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x18,0x00,0x00,0x00,0xF8 fcb 0xFF,0x3F,0xE0,0x00,0x04,0x00,0x00,0x0F,0xBF,0xC2,0xEF,0xFF,0xFF,0x80,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x1C,0x00,0x00,0x08,0xFB fcb 0xFF,0x37,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xC1,0x1F,0xFF,0xFF,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x1D,0x07 fcb 0xFF,0xE3,0x68,0x00,0x00,0x00,0x00,0x07,0x7F,0xC7,0x3F,0xFF,0xFE,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3F fcb 0xFF,0xFB,0xF6,0x00,0x00,0x00,0x00,0x07,0x7F,0xE1,0x7F,0xFF,0xFC,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x01,0xC6,0x7F fcb 0xFF,0xFF,0xE8,0x00,0x00,0x00,0x00,0x07,0x0F,0xF3,0x8F,0x97,0xFC,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xB1,0xEF fcb 0xFF,0xEF,0xB7,0x00,0x00,0x00,0x00,0x07,0x83,0xE1,0xC6,0x00,0x78,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21,0xDF fcb 0xFF,0xD1,0xA2,0x00,0x00,0x40,0x00,0x03,0x00,0xF1,0xFF,0x14,0x20,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3E,0xFF fcb 0xFF,0xFF,0xDF,0x00,0x00,0x00,0x00,0x03,0x06,0x70,0x7C,0x00,0xC0,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0F,0xFF fcb 0xFF,0xFF,0xE7,0xE0,0x00,0x00,0x00,0x03,0x87,0xF1,0xF8,0x03,0x80,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xAF fcb 0xFF,0xFF,0xF7,0x00,0x00,0x00,0x00,0x03,0x8F,0xFB,0xF8,0x20,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1F,0xBF fcb 0xFF,0xFF,0xBF,0xE0,0x00,0x00,0x00,0xF3,0x8D,0xFF,0xF8,0x5F,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1E,0xFF fcb 0xFF,0xFF,0x4F,0xF0,0x00,0x00,0x01,0xE3,0x87,0xFF,0xFC,0x6E,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0D,0xF7 fcb 0xBF,0xFF,0xEF,0xE8,0x00,0x00,0x00,0x01,0x1F,0xFF,0xFF,0xFE,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0B,0xFF fcb 0x9F,0xFF,0xFD,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFF,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0xFF,0x8F,0xE8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xFC,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0xBF,0xFF,0xFF,0xF8,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0x9F,0xFF,0xF8,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xF0,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFE,0x00,0x00,0x07,0xFF fcb 0x1F,0xFF,0xF5,0xFC,0x00,0x00,0x00,0x01,0x3F,0xFF,0xFF,0xE0,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFC fcb 0x3F,0xFF,0xBF,0xF8,0x00,0x00,0x00,0x01,0x3F,0x85,0xFF,0xC0,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF fcb 0xF7,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x00,0x1D,0x2A,0x07,0x80,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x0E,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0xFF,0xFF,0xF8,0x00,0x00,0x00,0x01,0x06,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x1C,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x1F,0xFF fcb 0xFF,0xFF,0xDF,0xF8,0x00,0x00,0x00,0x01,0x17,0x3D,0x95,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF,0x80,0x00,0x07,0xFF fcb 0xFF,0xFF,0xEF,0xF8,0x00,0x00,0x00,0x00,0x0E,0xEF,0xDA,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF fcb 0xFF,0xFF,0xF7,0xF0,0x00,0x00,0x00,0x00,0x15,0xF7,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF fcb 0xFF,0xFF,0xED,0xE0,0x00,0x00,0x00,0x00,0x0F,0xBF,0xEC,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0xFF,0xDC,0xE0,0x00,0x00,0x00,0x00,0x17,0x7F,0xD8,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x07,0xFF fcb 0xFF,0xFF,0xBC,0xC0,0x00,0x00,0x00,0x00,0x3F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xFF fcb 0xFF,0xFF,0xDE,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0xFF fcb 0xFF,0xFF,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF8,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF fcb 0xFF,0xFB,0xFF,0x80,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0xDF fcb 0xFE,0xC1,0xF2,0x00,0x00,0x00,0x00,0x18,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x83 fcb 0x00,0x1F,0xCC,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0x00 fcb 0x80,0x3F,0x98,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xF0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE2 fcb 0x46,0x3E,0x60,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0xE0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x80 fcb 0x33,0x3C,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xC0,0x60,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xA0 fcb 0x73,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x15,0x3A,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0 fcb 0x08,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xF6,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xE0 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x17,0xB6,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xED,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x05,0x2C,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0xB0,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x70,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x78,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x7F,0xFF,0xC0,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF,0x80,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x3F,0xFF,0xCF,0x9F,0xFF,0xFF,0xFF,0x03,0xFF fcb 0xCC,0xFF,0xFF,0xF3,0xFF,0xFF,0xF8,0x1F,0xFE,0x0F,0xFF,0x8F,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x18,0xFF,0xF3,0x3F,0xFF,0xCF,0xFF,0xFF,0xFF,0xFF,0xCF,0xFF fcb 0xCC,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,0x7F,0xFE,0x7F,0xFF,0xCF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x00,0xFF,0xF3,0x31,0x9E,0x49,0x10,0xE1,0xFF,0xFF,0xCF,0xFF fcb 0xCC,0xC6,0x08,0x23,0x0F,0xFF,0xFE,0x7F,0xFE,0x7C,0x60,0xCC,0x70,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x24,0xFF,0xF0,0x3C,0xC0,0xC3,0x92,0x4F,0xFF,0xFF,0xCF,0xFF fcb 0xC0,0xF2,0x38,0xF2,0x7F,0xFF,0xFE,0x7F,0xFE,0x1F,0x23,0xC9,0x27,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x30,0xC0,0xC7,0x92,0x63,0xFF,0xFF,0xCF,0xFF fcb 0xCC,0xC2,0x79,0xF3,0x1F,0xFF,0xFE,0x7F,0xFE,0x7C,0x27,0xC8,0x31,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0xFF,0xF3,0x24,0xE1,0xC3,0x92,0x79,0xFF,0xFF,0xCF,0xFF fcb 0xCC,0x92,0x79,0xF3,0xCF,0xFF,0xFE,0x7F,0xFE,0x79,0x27,0xC9,0xFC,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0x3C,0x9F,0xF3,0x30,0xE1,0xC9,0x92,0x43,0xFF,0xFF,0xCE,0x7F fcb 0xCC,0xC2,0x79,0xF2,0x1F,0xFF,0xFE,0x73,0xFE,0x0C,0x27,0xCC,0x61,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF7,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x7F,0xFF fcb 0xFF,0xF0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7F,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF AUTHPICe equ * ; Unused fcb 0xFF,0x00,0x00,0xA0,0x27,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xEF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF fcb 0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x40,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The actual Super Extended Basic (SECB) extensions start here. ; ; Note that many routines in this area feature a "lbrn 0" instruction. This appears to be intended as a placeholder to allow ; patching into the routines similar to the RAM hooks in Color Basic except using direct overwiting of the instruction. It's ; completely pointless and probably illustrates that the writers of this code didn't really think through what they were doing. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUPERVAR fdb HRMODE ; address of direct page variables unique to SECB PRGTEXT fdb SETTEXT ; set video registers for text mode (indirect) PRGGRAPH fdb SETGRAPH ; set video registers for graphics mode (indirect) PRGMMU fdb SETMMU ; set MMU registers to their "default" (indirect) GETTEXT fdb SELTEXT ; put hi-res text screen in logical block 1 (indirect) GETBLOK0 fdb SELBLOK0 ; put block in B in logical block 0 (indirect) GETTASK0 fdb SELTASK0 ; re-select MMU task 0 (indirect) GETTAKS1 fdb SELTASK1 ; select MMU task 1(indirect) jmp LA05E ; execute non-self starting ROM SPARE0 fdb 0 ; undefined SPARE1 fdb 0 ; undefined SPARE2 fdb 0 ; undefined ; Set up video registers for the selected text screen. Given that the sets of video mode initializers are contiguous in ; memory, this would probably be better done with a simple sequence of MUL and ABX. SETTEXT pshs y,x,a ; save registers lbrn 0 ldx #IM.TEXT ; point to 32 column video mode registers lda HRWIDTH ; get text mode beq SETVIDEO ; brif 32 column ldx #SE03B ; point to 40 column mode data cmpa #1 ; is it 40 column? beq SETVIDEO ; brif so ldx #SE044 ; assume 80 column bra SETVIDEO ; program video registers ; 32 column (VDG) initializer IM.TEXT fcb COCO+MMUEN+MC3+MC2 ; INIT0 (COCO bit enables VDG modes) fcb 0x00 ; VIDEOMOD (unused for VDG modes) fcb 0x00 ; VIDEORES (unused for VDG modes) fcb 0x00 ; V.BORDER (black) fcb 0x00 ; filler for reserved fcb 0x0f ; V.SCROLL - this value is needed to show a proper 12 lines per text row fdb 0xe000 ; V.OFFSET - SAM offsets operate in 0x7xxx fcb 0x00 ; H.OFFSET - no horizontal offset ; 40 column screen SE03B fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) fcb 0x03 ; VIDEOMOD - 8 lines per row fcb 0x05 ; VIDEORES - 40 columns, attributes enabled, 192 lines per field fcb 0x12 ; V.BORDER - nuclear green fcb 0x00 ; filler for reserved fcb 0x00 ; V.SCROLL - no offset fdb 0xd800 ; V.OFFSET - screen at 0x6c000 fcb 0x00 ; H.OFFSET - no offset ; 80 column screen SE044 fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) fcb 0x03 ; VIDEOMOD - 8 lines per row fcb 0x15 ; VIDEORES - 80 columns, attributes enabled, 192 lines per field fcb 0x12 ; V.BORDER - nuclear green fcb 0x00 ; filler for reserved fcb 0x00 ; V.SCROLL - no offset fdb 0xd800 ; V.OFFSET - screen at 0x6c000 fcb 0x00 ; H.OFFSET - no offset ; Set up video registers for the selected "HSCREEN" mode. Note that the two code paths for the resolution widths ; are unneeded. SETGRAPH pshs y,x,a ; save registers lbrn 0 ldx #IM.GRAPH ; point to graphics initlializer ldy #RESTABLE ; point to resolution bytes table lda HRMODE ; get graphics mode cmpa #2 ; is it a 640 pixel mode? bls SE063 ; brif not ldx #SE079 ; point to 640 pixel registers SE063 suba #1 ; normalize mode numbers to start at 0 lda a,y ; get resolution setting for this mode sta 2,x ; put it in the graphics mode initializer jmp SETVIDEO ; go set up video registers RESTABLE fcb 0x15 ; 320x192, 4 colours fcb 0x1e ; 320x192, 16 colours fcb 0x14 ; 640x192, 2 colours fcb 0x1d ; 640x192, 4 colours ; 320x192 graphics modes IM.GRAPH fcb MMUEN+MC3+MC2 ; INIT0 (disable VDG modes) fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row fcb 0x00 ; VIDEORES - placeholder fcb 0x00 ; V.BORDER - black fcb 0x00 ; filler for reserved fcb 0x00 ; V.SCROLL - no offset fdb 0xc000 ; V.OFFSET - screen at 0x60000 fcb 0x00 ; H.SCROLL - no offset ; 640x192 graphics modes (observe that these are identical to the 320x192 ones above) SE079 fcb MMUEN+MC3+MC2 ; INITo (disable VDG modes) fcb 0x80 ; VIDEOMOD - enable bit plane, one line per row fcb 0x00 ; VIDEORES - placeholder fcb 0x00 ; V.BORDER - black fcb 0x00 ; filler for reserved fcb 0x00 ; V.SCROLL - no offset fdb 0xc000 ; V.OFFSET - screen at 0x60000 fcb 0x00 ; H.SCROLL - no offset ; Program video registers and INIT0 from (X); enter with A,X,Y pre-saved SETVIDEO lda ,x+ ; set INIT0 sta INIT0 ldy #VIDEOMOD ; point to start of video mode registers SE08B lda ,x+ ; set a register sta ,y+ cmpy #MMUREG ; done all of them? blo SE08B ; brif not puls a,x,y,pc ; restore registers and return ; Set MMU registers to their default values. All 16 of them. SETMMU pshs y,x,b,a ; save registers leax IM.MMU,pcr ; point to MMU initializer bsr SE0F1 ; program MMU registers puls a,b,x,y,pc ; restore registers and return ; Set logical block 0 to the physical block in B. This is embarassingly inefficient since it sets ; *all 16* MMU registers to change one of them. All the faffing about with pointers and the call ; to set the MMU registers is pointless. It could be done with a single STB. SELBLOK0 pshs y,x,b,a ; save registers leax IM.MMU,pcr ; point to MMU initializer pshs x ; save it for later stb ,x ; set desired block in initializer bsr SE0F1 ; program *all 16* MMU registers (stupid) ldb #BLOCK7.0 ; get correct block number for logical block 0 puls x ; get back pointer to the initializer stb ,x ; restore initializer value puls a,b,x,y,pc ; restore registers and return ; Put hi-res text screen in logical address space block 1. This is embarassingly ineffecient since ; it sets *all 16* MMU registers to change only one. All the faffing about with pointers and the ; call to set the MMU registers is pointless. It could be done with a singel LD/ST sequence. SELTEXT pshs y,x,b,a ; save registers leax IM.MMU,pcr ; point to MMU initializer pshs x ; save pointer for later ldb #BLOCK6.6 ; get block number for text screen stb 1,x ; put in logical block 1 of initializer bsr SE0F1 ; program *all 16* MMU registers (stupid) puls x ; get back pointer ldb #BLOCK7.1 ; get proper block for logical block 1 stb 1,x ; put it back in the initializer puls a,b,x,y,pc ; restore registers and return ; Get block 6.4 (HBUFF buffers) to logical block 6 of task 1. This is embarassingly inefficient ; since it sets *all 16* MMU registers to change only one. All the faffing about with pointers and ; the call to set the MMU registers ispointless. It could be done with a single LD/ST sequence. SE0CB pshs y,x,b,a ; save registers leax IM.MMU,pcr ; point to MMU initializer pshs x ; save pointer for later ldb #BLOCK6.4 ; get block for the HBUFF buffers stb 14,x ; put in logical block 6, task 1 bsr SE0F1 ; program *all 16* MMU registers (stupid) puls x ; get back pointer ldb #BLOCK6.5 ; get default block for logical block 6 of task 1 stb 14,x ; put it back in the initializer puls a,b,x,y,pc ; restore registers and return ; MMU initializer IM.MMU fcb BLOCK7.0,BLOCK7.1,BLOCK7.2,BLOCK7.3 ; task 0: map 0x70000-0x7ffff fcb BLOCK7.4,BLOCK7.5,BLOCK7.6,BLOCK7.7 fcb BLOCK7.0,BLOCK6.0,BLOCK6.1,BLOCK6.2 ; task 1: put hires gfx at 0x2000 and a stack block at 0xc000 fcb BLOCK6.3,BLOCK7.5,BLOCK6.5,BLOCK7.7 ; Set all 16 MMU registers from the initializer pointed to by X. SE0F1 ldy #MMUREG ; point to MMU registers ldb #16 ; there are 16 to set SE0F7 lda ,x+ ; set a register sta ,y+ decb ; done all? bne SE0F7 ; brif not rts ; Select task register 0 as the active MMU set. Enter with stack in a temporary location which ; holds the original stack pointer. Note that the return could be done simply as jmp [V42] instead ; of pushing the return address onto the stack. Interrupts will be enabled on the way out. SELTASK0 std V40 ; temp save D ldd ,s ; get return address std V42 ; save it ldd 2,s ; get original stack pointer std V44 ; save it clrb ; reset INIT1 to task 0 (and slow timer), could just be CLR INIT1 stb INIT1 lds V44 ; restore original stack pointer ldd V42 ; get back return address pshs d ; set return address on stack ldd V40 ; get back original D andcc #0xaf ; re-enable interrupts rts ; Select task register 1 as the active MMU set. Exit with interrupts disabled and the original ; stack pointer saved at the top of the temporary stack. Note that jmp [V42] could be used to ; return instead of pushing the return address back on the stack. SELTASK1 orcc #0x50 ; disable interrupts std V40 ; temp save D puls d ; get return address std V42 ; save it sts V44 ; save stack pointer ldb #1 ; set to enable task 1, slow timer input stb INIT1 lds #TMPSTACK ; point to temporary stack location (top of the C000-Dfff range) ldd V44 ; get old stack pointer pshs d ; stash it ldd V42 ; put original return address back pshs d ldd V40 ; restore original D rts ; Tokenziation patch ALINK2 tst V41 ; is it a function token? bne SE152 ; brif so lda V42 ; get token value cmpa #0x62 ; have we reached the first SECB token? bls SE148 ; brif not ldu #COMVEC-5 ; point to function table and go again jmp LB8D7 ; re-enter mainline code SE148 lda #0x62 ; force tokens to start at the correct number (above Disk Basic) ldu #EBCOMTAB-10 ; point to SECB command table SE14D sta V42 ; set token counter to SECB values jmp LB89D ; re-enter mainstream still in command mode SE152 lda V42 ; get token number cmpa #0x29 ; have we run through SECB functions yet? bls SE15B ; brif not jmp LB8D7 ; re-enter mainline code (end of processing) SE15B lda #0x29 ; force token into SECB range (this leaves one unused) ldu #EBCOMTAB-5 ; point to SECB function table bra SE14D ; go transfer control back to mainline with new settings EBCOMTAB fcb 23 ; number of keywords (commands) fdb COMDIC20 ; keyword table (commands) fdb ALINK4 ; interpretation handler (commands) fcb 5 ; number of keywords (functions) fdb FUNDIC20 ; keyword table (functions) fdb ALINK5 ; interpretation handler (functions) fcb 0x00,0x00,0x00,0x00,0x00,0x00 ; marker for no further tables ; Detokenization patch. This routine has a bug. It freezes if an unknown token is encountered instead ; of using the placeholder. ALINK3 leau 10,u ; move to next table tst ,u ; valid table? lbne LB7F9 ; brif so - re-enter mainline code leax -1,x ; get token number lda ,x+ anda #0x7f ; remove token bias cmpa #0x62 ; SECB command? blo SE18B ; brif not suba #0x62 ; zero-base SECB token number ldu #EBCOMTAB-10 ; point to command table bra ALINK3 ; go try again SE18B suba #0x29 ; zero-base function token ldu #EBCOMTAB-5 ; point to SECB function table bra ALINK3 ; go try again ; Command interpretation patch ALINK4 cmpa #0xe2 ; is it within the SECB range? blo SE19A ; brif not (below) cmpa #0xf8 ; is it above range? bls SE19E ; brif not - we have a SECB command SE19A jmp [COMVEC+23] ; transfer control onward to Disk Basic SE19E suba #0xe2 ; normalize SECB commands to 0 ldx #COMDIS20 ; point to jump table for SECB commands jmp LADD4 ; go dispatch command ; Function processing patch ALINK5 cmpb #0x29*2 ; is it an SECB function? blo SE1AE ; brif not (below) cmpb #0x2d*2 ; is it still an SECB function? bls SE1B2 ; brif so SE1AE jmp [COMVEC+28] ; transfer control to Disk Basic SE1B2 subb #0x29*2 ; normalize SECB functions to 0 cmpb #2*2 ; do we need to parse a parameter? bhs SE1BF ; brif not pshs b ; save token offset jsr LB262 ; parse parenthetical expression puls b ; get back token offset SE1BF ldx #FUNDIS20 ; point to jump table for SECB functions jmp LB2CE ; go dispatch function call ; Keyword table (commands) for SECB COMDIC20 fcs 'WIDTH' ; 0xe2 fcs 'PALETTE' ; 0xe3 fcs 'HSCREEN' ; 0xe4 fcs 'LPOKE' ; 0xe5 fcs 'HCLS' ; 0xe6 fcs 'HCOLOR' ; 0xe7 fcs 'HPAINT' ; 0xe8 fcs 'HCIRCLE' ; 0xe9 fcs 'HLINE' ; 0xea fcs 'HGET' ; 0xeb fcs 'HPUT' ; 0xec fcs 'HBUFF' ; 0xed fcs 'HPRINT' ; 0xee fcs 'ERR' ; 0xef fcs 'BRK' ; 0xf0 fcs 'LOCATE' ; 0xf1 fcs 'HSTAT' ; 0xf2 fcs 'HSET' ; 0xf3 fcs 'HRESET' ; 0xf4 fcs 'HDRAW' ; 0xf5 fcs 'CMP' ; 0xf6 fcs 'RGB' ; 0xf7 fcs 'ATTR' ; 0xf8 ; Jump table for SECB commands COMDIS20 fdb WIDTH ; 0xe2 WIDTH fdb PALETTE ; 0xe3 PALETTE fdb HSCREEN ; 0xe4 HSCREEN fdb LPOKE ; 0xe5 LPOKE fdb HCLS ; 0xe6 HCLS fdb HCOLOR ; 0xe7 HCOLOR fdb HPAINT ; 0xe8 HPAINT fdb HCIRCLE ; 0xe9 HCIRCLE fdb HLINE ; 0xea HLINE fdb HGET ; 0xeb HGET fdb HPUT ; 0xec HPUT fdb HBUFF ; 0xed HBUFF fdb HPRINT ; 0xee HPRINT fdb ERR ; 0xef ERR (should be LB277) fdb BRK ; 0xf0 BRK (should be LB277) fdb LOCATE ; 0xf1 LOCATE fdb HSTAT ; 0xf2 HSTAT fdb HSET ; 0xf3 HSET fdb HRESET ; 0xf4 HRESET fdb HDRAW ; 0xf5 HDRAW fdb CMP ; 0xf6 CMP fdb RGB ; 0xf7 RGB fdb ATTR ; 0xf8 ATTR ; Keyword table for SECB functions FUNDIC20 fcs 'LPEEK' ; 0xa9 fcs 'BUTTON' ; 0xaa fcs 'HPOINT' ; 0xab fcs 'ERNO' ; 0xac fcs 'ERLIN' ; 0xad ; Jump table for SECB functions FUNDIS20 fdb LPEEK ; 0xa9 LPEEK fdb BUTTON ; 0xaa BUTTON fdb HPOINT ; 0xab HPOINT fdb ERNO ; 0xac ERNO fdb ERLIN ; 0xad ERLIN ; Signon message patch ALINK12 ldx #L80E8-1 ; point to ECB's message jsr STRINOUT ; display it ldx #MWAREMS-1 ; point to Microware string jsr STRINOUT ; display it jmp L80B8 ; return to mainline code ; Signon message patch for Disk Basic 1.0 ALINK28 ldx #DISK20MS-1 ; point to modified message jmp DC0DC-19 ; return to mainline code ; Signon message patch for Disk Basic 1.1 ALINK29 ldx #DISK21MS-1 ; point to modified message jmp DC0DC ; return to mainline code DISK20MS fcc 'DISK EXTENDED COLOR BASIC 2.0' fcb 0x0d fcc 'COPR. 1981, 1986 BY TANDY' fcb 0x0d fcc 'UNDER LICENSE FROM MICROSOFT' fcb 0x0d MWAREMS fcc 'AND MICROWARE SYSTEMS CORP.' fcb 0x0d,0x0d,0x00 DISK21MS fcc 'DISK EXTENDED COLOR BASIC 2.1' fcb 0x0d fcc 'COPR. 1982, 1986 BY TANDY' fcb 0x0d fcc 'UNDER LICENSE FROM MICROSOFT' fcb 0x0d fcc 'AND MICROWARE SYSTEMS CORP.' fcb 0x0d,0x0d,0x00 ; Extended Basic extra initialization patch ALINK14 clra ; set up to clear things clrb lbrn 0 stb H.CRSATT ; reset cursor attributes std HRMODE ; reset to VDG screen and no HSCREEN graphics std H.ONBRK ; reset ON BRK destination std H.ONERR ; reset ON ERR destinatin sta H.BCOLOR ; default HSCREEN background to 0 lda #1 ; default HSCREEN foreground to 1 sta H.FCOLOR lda #BLOCK6.4 ; map the HGET/HPUT buffers sta MMUREG ldd #0xffff ; mark as empty std 0 lda #BLOCK7.0 ; restore memory map sta MMUREG jmp LAD19 ; go finish initializing (NEW) ; ON command patch ALINK18 cmpa #0xef ; ERR? beq ERR ; brif so cmpa #0xf0 ; BRK? beq BRK ; brif so jsr EVALEXPB ; evaluate the ON index argument jmp LAF45 ; return to mainline code SE3C2 jsr GETNCH ; eat the ERR/BRK token cmpa #0x81 ; GO? bne SE3CF ; brif not jsr GETNCH ; eat the GO cmpa #0xa5 ; TO? bne SE3CF ; brif not rts SE3CF leas 2,s ; clean up stack (not needed) jmp LB277 ; raise syntax error ; ERR jumps here if used as a command ; NOTE: you can do ERR <char> GOTO (where <char> is a single character that doesn't prevent GOTO from being tokenized ERR bsr SE3C2 ; check for GOTO jsr GETNCH ; eat the "TO" jsr LAF67 ; evaluate destination line number ldd BINVAL ; get line number std H.ONERR ; set error destination ldd CURLIN ; get current line number std H.ONERRS ; save line number where ON ERR was executed rts ; BRK jump shere if used as a command. ; Same note as for ERR applies. BRK bsr SE3C2 ; check for GOTO jsr GETNCH ; eat the "TO" jsr LAF67 ; evaluate destination line number ldd BINVAL ; get line number std H.ONBRK ; set break destination ldd CURLIN ; get current line number std H.ONBRKS ; save line number where ON BRK was executed rts ; Patches for &H parsing ALINK6A lsl 2,x ; multiply accumulator by 2 rol 1,x rol ,x lbcs LBA92 ; brif we overflowed decb ; done enough shifts? bne ALINK6A ; brif not suba #'0 ; remove ASCII bias adda 2,x ; add digit to accumulator (this cannot cause carry) sta 2,x rts ALINK6B lbcs L8800 ; brif numeric jmp L883F ; return to mainline ; Line input patch ALINK16 cmpa #3 ; is it BREAK? orcc #1 ; set C for BREAK bne SE426 ; brif not BREAK pshs a,cc ; save character and break status lda HRMODE ; is it graphics mode? beq SE424 ; brif not clr HRMODE ; disable graphics mode jsr SETTEXT SE424 puls cc,a ; get back BREAK status and character SE426 jmp LA3C6 ; return to mainline ; Break check patch ALINK15 cmpa #3 ; BREAK? beq SE430 ; brif so jmp LADF4 ; re-enter mainline SE430 lda #1 ; BREAK flag sta H.ERRBRK lda CURLIN ; immediate mode? inca beq SE43F ; brif so ldd H.ONBRK ; is ON BRK active? bne SE449 ; brif so SE43F lda HRMODE ; graphics m ode? beq SE446 ; brif not jsr SETTEXT ; set text mode SE446 jmp STOP ; go handle BREAK SE449 std BINVAL ; set destination line number tst H.ERRBRK ; error or break? bne SE458 ; brif break lds FRETOP ; reset stack pointer ldd #LADC4 ; return to main loop pshs d SE458 jsr LAEEB ; move to end of line leax 1,x ; move past line terminator ldd BINVAL ; get desired line number cmpd CURLIN ; is it here or later? bhi SE466 ; brif so ldx TXTTAB ; start search at beginning SE466 jsr LAD05 ; find program line lbcs SE51E ; brif not found jmp LAEBB ; reset input pointer and return to main loop ; Error handling patch ALINK20 clr H.ERRBRK ; flag error handling lda CURLIN ; immediate mode? inca beq SE47D ; brif so ldx H.ONERR ; is ON ERR in effect bne SE4B3 ; brif so SE47D pshs a ; save register lda HRMODE ; set flags on graphics mode puls a ; get back A beq SE488 ; brif not graphics mode jsr SETTEXT ; force text mode SE488 cmpb #38*2 ; HG error? bne SE49F ; brif not jsr LB95C ; do newline jsr LB9AF ; do ? leax BAS20ERR,pcr ; point to error string SE496 jsr LACA0 ; display two character error message jsr LACA0 jmp LAC65 ; return to mainline code SE49F cmpb #39*2 ; HP error? bne SE4B0 ; brif not jsr LB95C ; do newline jsr LB9AF ; do ? leax BAS20ERR+2,pcr ; point to error string jmp SE496 ; go finish up SE4B0 jmp LAC49 ; return to mainline error handler SE4B3 stb H.ERROR ; save error number pshs b ; save error number ldd CURLIN ; get current line number std H.ERLINE ; save line number where error occurred puls b ; get back error number cmpb #3*2 ; OD error? bne SE4C7 ; brif not ldd BINVAL ; restore input pointer std CHARAD SE4C7 tfr x,d ; save error destination line lbra SE449 ; go transfer control to error handler BAS20ERR fcc 'HR' ; 38 Hi resolution graphics error fcc 'HP' ; 39 Hi resolutuion print error ; NEW handling patch ALINK19 pshs d ; save D clra ; set up to clear things clrb std OLDPTR ; reset CONT address std H.ONBRK ; reset ON BRK line std H.ONERR ; reset ON ERR line std H.ERLINE ; reset error source line lda #0xff ; set error number to -1 sta H.ERROR puls d ; restore d jmp LAD43 ; return to mainline ; ERNO function ERNO clra ; zero extend error number ldb H.ERROR ; get error number cmpb #0xff ; real? bne SE4F4 ; brif so sex ; return "-1" bra SE4FA SE4F4 cmpb #0xf1 ; error number 0xf1? bne SE4F9 ; brif not comb ; turn it back into UL error SE4F9 asrb ; error numbers are pre-multiplied by 2 - undo that SE4FA jmp GIVABF ; return error number ; ERLIN function ERLIN ldd H.ERLINE ; get the line number where the error occurred bra SE4FA ; return it - BUG: will treat lines above 32767 as negative ; Immediate mode patch ALINK21 jsr SETTEXT ; force text mode jsr LB95C ; do line feed if needed orcc #0x50 ; disable interrupts lda #BLOCK6.4 ; map HGET/HPUT buffers sta MMUREG ldd #0xffff ; mark buffers empty std 0 lda #BLOCK7.0 ; restore memory map sta MMUREG andcc #0xaf ; re-enable interrupts jmp LAC76 ; return to mainline ; Handle undefined line in ON ERR or ON BRK SE51E tst H.ERRBRK ; break? beq SE528 ; brif not ldd H.ONBRKS ; get line number where ON BRK is bra SE52B SE528 ldd H.ONERRS ; get line number where ON ERR is SE52B std CURLIN ; reset the current line number there ldb #7*2 ; undefined line number jmp LAC49 ; raise error (bypass ON ERR check) ; INPUT patch ALINK17 ldd H.ONBRK ; is ON BRK operating? lbeq LAE11 ; brif not pshs d ; save destination line lda #1 ; set BREAK flag sta H.ERRBRK puls d ; get destination line lbra SE449 ; go handle ON BRK in INPUT ; LPOKE command LPOKE jsr LB141 ; evaluate numeric expression (address) lbrn 0 bsr SE58E ; convert to extended address cmpb #BLOCK7.7 ; valid block number? lbhi LB44A ; brif not pshs x,b ; save block and offset jsr SYNCOMMA ; require a comma jsr EVALEXPB ; evaluate value to put in memory tfr b,a ; save value in A puls b,x ; get back block and offset cmpb #BLOCK7.7 ; valid block (we already tested this!!) lbhi LB44A ; brif not orcc #0x50 ; clobber interrupts lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers) sta ,x ; save byte in memory lbsr SETMMU ; unmap block (by writing *all 16* MMU registers) andcc #0xaf ; re-enable interrupts rts ; LPEEK function LPEEK bsr SE58E ; convert to block and offset lbrn 0 cmpb #BLOCK7.7 ; valid block? lbhi LB44A ; brif not orcc #0x50 ; clobber interrupts lbsr SELBLOK0 ; map the block (by writing *all 16* MMU registers) ldb ,x ; get memory contents lbsr SETMMU ; restore map (by writing *all 16* MMU registers) andcc #0xaf ; re-enable interrupts jmp LB4F3 ; return B as unsigned SE58E pshs a ; save register lda FP0EXP ; is it in range for 0x80000? cmpa #0x93 bls SE59A ; brif so ldb #BLOCK7.7+1 ; return illegal block number bra SE5AF SE59A jsr LBCC8 ; shift binary point to right of mantissa ldd FPA0+2 ; get low bits anda #0x1f ; mask off block number bits tfr d,x ; now X has the block offset ldd FPA0+1 ; get high bits asra ;* shift block number to the right of B; note that rorb ;* asr *should* be lsr but it works here because of asra ;* the maximum range of the value rorb asra rorb asra rorb asra rorb SE5AF puls a,pc ; restore registers and return ; BUTTON command BUTTON jsr INTCNV ; get button number lbrn 0 cmpb #3 ; button number in range? lbhi LB44A ; raise error if not tfr b,a ; save button number clrb ; set B to 0xff (strobe no keyboard columns) comb ldx #PIA0 ; point to PIA0 stb 2,x ; strobe nothing ldb ,x ; get button data cmpb #0x0f ; buttons are on bottom four rows beq SE5EA ; brif no buttons down leax SE5D5,pcr ; point to button mask routines asla ; four bytes per button routine asla jmp a,x ; jump to appropriate routine SE5D5 andb #1 ; keep button 1, right joystick bra SE5E3 andb #4 ; keep button #1, left joystick bra SE5E3 andb #2 ; keep button #2, right joystick bra SE5E3 andb #8 ; keep button #2, left joystick SE5E3 bne SE5EA ; brif button was not down ldd #1 ; return nonzero if button down bra SE5EC ; return result SE5EA clra ; return zero if not down clrb SE5EC jsr GIVABF ; return result rts ; PALETTE command PALETTE cmpa #0xf7 ; RGB? lbrn 0 bne SE600 ; brif not jsr GETNCH ; munch the RGB SE5FA leax IM.RGB,pcr ; point to RGB palette initializer bra SE634 ; go set palette registers SE600 cmpa #0xf6 ; CMP? bne SE60C ; brif not jsr GETNCH ; eat the CMP SE606 leax IM.CMP,pcr ; point to CMP palette initializer bra SE634 ; go set palette registers SE60C jsr SE7B2 ; evaluate two expressions ldx #PALETREG ; point to palette registers ldy #IM.PALET ; point to palette register images lda BINVAL+1 ; get palette number cmpa #16 ; valid entry? lbhs LB44A ; brif not 0-15 leax a,x ; offset the pointers to the right entries leay a,y ldb VERBEG+1 ; get colour number cmpb #63 ; valid? bls SE62A ; brif so ldb #63 ; maximize to 63 (white) SE62A orcc #0x50 ; disable interrupts sync ; synchronize to VSYNC stb ,x ; set palette register stb ,y ; record it in image andcc #0xaf ; restore interrupts rts SE634 pshs x ; save source pointer ldy #IM.PALET ; point to palette register live image bsr SE648 ; copy source to the live image puls x ; get source back ldy #PALETREG ; point to palette registers orcc #0x50 ; disable interrupts sync ; synchronize to VSYNC bsr SE648 ; copy the colour values into the palette registers rts SE648 ldb #16-1 ; BUG: should be 16 - this doesn't set register #15 SE64A lda ,x+ ; set a register sta ,y+ decb ; done all? bne SE64A ; brif not andcc #0xaf ; re-enable interrupts rts IM.CMP fcb 18,36,11,7,63,31,9,38 ; palette values for CMP fcb 0,18,0,63,0,18,0,38 IM.RGB fcb 18,54,9,36,63,27,45,38 ; palette values for RGB fcb 0,18,0,63,0,18,0,38 ; CMP and RGB commands just jump to the relevant implementations above RGB bra SE5FA CMP bra SE606 IM.PALET fcb 18,36,11,7,63,31,9,38 ; live palette images fcb 0,18,0,63,0,18,0,38 ; HSCREEN command HSCREEN cmpa #0 ; end of line? BUG: won't work if colon terminates the command lbrn 0 bne SE693 ; brif not end of line clrb ; default to HSCREEN 0 - turn off graphics bra SE69C SE693 jsr EVALEXPB ; evaluate HSCREEN argument cmpb #4 ; only 4 HSCREEN modes lbhi LB44A ; brif out of range SE69C stb HRMODE ; set graphics mode cmpb #0 ; HSCREEN 0? bne SE6A5 ; brif not jmp SETTEXT ; set text mode (disable graphics) SE6A5 stb HRMODE ; set graphics mode (we already did!) ldx #SE6CB ; point to bytes/row table subb #1 ; normalize mode to 0 lda b,x ; get bytes per row value sta HORBYT ; set it cmpb #1 ; is it 1 or 2? bgt SE6B9 ; brif not ldd #160 ; default coordinate for middle of 320 screen bra SE6BC SE6B9 ldd #320 ; default coordainte for middle of 640 screen SE6BC std HORDEF ; set default horizontal coordinate ldd #96 ; set default vertical coordinate to middle std VERDEF ldb H.BCOLOR ; get background colour bsr CLRHIRES ; clear hi-res graphics screen jmp SETGRAPH ; set up to display the screen SE6CB fcb 80,160,80,160 ; bytes per row values for HSCREEN 1 through 4 ; HCLS command HCLS bne SE6D6 ; brif not end of statement ldb H.BCOLOR ; get background colour as default bra CLRHIRES ; go clear screen SE6D6 bsr SE70E ; evaluate colour number CLRHIRES tst HRMODE ; graphics mode? beq SE6EF ; brif not bsr PIXELFIL ; get all pixels set byte jsr SELTASK1 ; swap screen in ldx #HRESSCRN ; point to start of screen SE6E4 stb ,x+ ; set a byte worth of pixels cmpx #HRESSCRN+0x8000 ; end of graphics memory? bne SE6E4 ; brif not jsr SELTASK0 ; restore memory map rts SE6EF ldb #38*2 ; code for HR error jmp LAC46 ; raise error ; HCOLOR command HCOLOR cmpa #', ; was a foreground colour given? lbrn 0 beq SE705 ; brif not bsr SE70E ; evaluate colour number stb H.FCOLOR ; save foreground colour jsr GETCCH ; is there something after the foreground? beq SE70D ; brif not SE705 jsr SYNCOMMA ; insist on a comma bsr SE70E ; evaluate colour number stb H.BCOLOR ; set background colour SE70D rts ; Evaluate a colour number and make sure it's between 0 and 15 inclusive SE70E jsr EVALEXPB ; evaluate colour SE711 cmpb #16 ; is it in range? lbhs LB44A ; brif not rts SE718 jsr SE731 ; set working colour and pixel bytes to default jsr GETCCH ; is there a colour number? beq SE72F ; brif not cmpa #') ; )? beq SE72F ; brif so - no colour jsr SYNCOMMA ; insist on a comma cmpa #', ; another comma? beq SE72F ; brif so - colour not specified jsr SE70E ; evaluate colour bsr SE73B ; set working colour and pixel bytes SE72F jmp GETCCH ; get current character and return SE731 ldb H.FCOLOR ; get foreground colour tst SETFLG ; doing set? bne SE73B ; brif so ldb H.BCOLOR ; use background colour if doing reset SE73B stb WCOLOR ; save working colour bsr PIXELFIL ; get all pixel byte stb ALLCOL ; save all pixel byte rts ; Return B with all pixels set to colour number in B PIXELFIL pshs x ; save registers lda HRMODE ; get graphics mode suba #1 ; normalize mode numbers to start at 0 ldx #SE759 ; point to colour masks andb a,x ; now B has only the relevant low bits of colour number lda HRMODE ; get graphics mode suba #1 ; normalize mode numbers to start at 0 ldx #SE75D ; point to multiplier table lda a,x ; get multplier mul ; now B has all pixels set puls x,pc ; restore registers and return SE759 fcb 0x03,0x0f,0x01,0x03 ; colour masks to keep only necessary low bits SE75D fcb 0x55,0x11,0xff,0x55 ; multipliers to duplicate colour value across all pixels ; HSET command HSET lda #1 ; HSET flag bra SE76A ; HRESET command HRESET clra ; HRESET flag lbrn 0 SE76A tst HRMODE ; are we in a graphics mode? beq SE6EF ; brif not - raise error sta SETFLG ; save our set/reset state jsr LB26A ; insist on ( jsr SE7AA ; evaluate coordindates tst SETFLG ; resetting? bne SE77F ; brif so jsr SE731 ; set working colour and pixel byte bra SE782 SE77F jsr SE718 ; evaluate colour number if present SE782 jsr LB267 ; insist on a ) jsr HCALPOS ; fetch screen pointer address and pixel mask SE788 jsr SELTASK1 ; map the screen jsr SE792 ; set or reset the pixel jsr SELTASK0 ; unmap the screen rts SE792 ldb ,x ; get byte on screen pshs b ; save it tfr a,b ; duplicate mask coma ; invert the mask for clearing the screen data anda ,x ; reset the pixel andb ALLCOL ; set pixel mask to correct colour pshs b ; merge pixel colour into screen data ora ,s+ sta ,x ; put modified data on screen suba ,s+ ; nonzero if the screen changed ora CHGFLG ; merge with existing change flag sta CHGFLG rts SE7AA jsr SE7B2 ; evaluate coordinates SE7AD ldu #HORBEG ; point to horizontal coordinates SE7B0 rts ; dummy "normalization" routine rts ; pointles RTS ; Evaluate two expressions (usually coordinates) SE7B2 jsr LB734 ; evaluate two expressions, first in BINVAL, second in B ldy #HORBEG ; point to horizontal coordinates SE7B9 cmpb #192 ; in range vertically? blo SE7BF ; brif so ldb #191 ; set to maximum coordinate SE7BF clra ; zero extend vertical std 2,y ; set vertical coordinate lda HRMODE ; get graphics mode cmpa #2 ; is it 1 or 2? bgt SE7CD ; brif not ldd #319 ; maximum coordinate for modes 1 and 2 bra SE7D0 SE7CD ldd #639 ; maximum coordindate for modes 3 and 4 SE7D0 cmpd BINVAL ; is our max less than the specified one? blo SE7D7 ; brif so - keep max ldd BINVAL ; use specified coordinate SE7D7 std ,y ; save horizontal coordinate rts ; Calculate pixel mask and memory address for pixel HCALPOS bsr SE7E6 ; point to correct routine for current mode jmp ,u ; execute it CALTABLE fdb G2BITPIX ; HSCREEN 1 fdb G4BITPIX ; HSCREEN 2 fdb G1BITPIX ; HSCREEN 3 fdb G2BITPIX ; HSCREEN 4 SE7E6 ldu #CALTABLE ; point to routine table lda HRMODE ; get graphicsmode suba #1 ; zero-base it asla ; two bytes per address ldu a,u ; get routine address rts PIX1MASK fcb 0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01 ; pixel masks for 1 bpp PIX2MASK fcb 0xc0,0x30,0x0c,0x03 ; pxiel masks for 2 bpp PIX4MASK fcb 0xf0,0x0f ; pixel masks for 4 bpp G1BITPIX pshs u,b ; save registers ldb HORBYT ; get bytes per row lda VERBEG+1 ; get vergical coord mul ; now D is the offset to the start of the row addd #HRESSCRN ; add in start of screen in memory tfr d,x ; put it in a pointer ldd HORBEG ; get horiztonal coordindate lsra ; 8 pixels per byte do divide by 8 rorb lsra rorb lsra rorb leax d,x ; offset to correct byte row lda HORBEG+1 ; get pixel number anda #7 ; keep only byte offset ldu #PIX1MASK ; point to 1 bpp masks lda a,u ; get pixel mask puls b,u,pc ; restore registers and return G2BITPIX pshs u,b ; save registers ldb HORBYT ; get number of bytes per row lda VERBEG+1 ; get horizontal coordinate mul ; now D is the offset to the start of the row addd #HRESSCRN ; add in memory offset to the screen tfr d,x ; put that in a pointer ldd HORBEG ; get horizontal coordinate lsra ; 4 pixels per byte so divide by 4 rorb lsra rorb leax d,x ; now X points to the correct memory byte lda HORBEG+1 ; get horizontal coordinate anda #3 ; keep only the pixel number in the byte ldu #PIX2MASK ; point to 2 bpp pixel masks lda a,u ; get mask for this pixel puls b,u,pc ; restore registers and return G4BITPIX pshs u,b ; save registers ldb HORBYT ; get bytes per row lda VERBEG+1 ; get vertical coordinate mul ; now D is the offset to the start of the row addd #HRESSCRN ; add in memory address of start of screen tfr d,x ; put it in a pointer ldd HORBEG ; get horizontal coordinate lsra ; divide by 2 - only 2 pixels per byte rorb leax d,x ; now X points to the memory address of the pixel lda HORBEG+1 ; get horiztonal coordinate anda #1 ; keep offset into byte ldu #PIX4MASK ; point to 4 bpp pixel masks lda a,u ; get pixel mask puls b,u,pc ; restore registers and return ; HPOINT function HPOINT tst HRMODE ; is there a graphics mode? lbeq SE6EF ; brif not - raise error jsr LB26A ; insist on ( jsr SE7AA ; evaluate coordinates jsr LB267 ; insist on ) jsr SELTASK1 ; map the screen jsr HCALPOS ; get screen pointer tfr a,b ; save mask andb ,x ; get pixel data SE875 lsra ; is the pixel aligned right? bcs SE87B ; brif so lsrb ; shift right bra SE875 ; see if it's aligned yet SE87B jsr LB4F3 ; return colour number jsr SELTASK0 ; restore memory map rts ; HLINE command HLINE tst HRMODE ; is there a graphics mode active? lbeq SE6EF ; brif not - raise error lbrn 0 cmpa #'( ; is there (? beq SE899 ; brif so - we have start coords cmpa #0xac ; -? beq SE899 ; brif no start given ldb #'@ ; make sure it's @ if not jsr LB26F SE899 jsr SE9E1 ; get start/end coords ldx HOREND ; put end in the defaults stx HORDEF ldx VEREND stx VERDEF jsr SYNCOMMA ; make sure comma cmpa #0xbe ; PRESET? beq SE8B4 ; brif so cmpa #0xbd ; PSET? lbne LB277 ; brif not ldb #1 ; set flag skip1lda SE8B4 clrb ; reset flag pshs b ; save set/reset flag jsr GETNCH ; eat the PSET/PRESET token jsr SEA0D ; normalize start/end puls b ; get back set/reset flag stb SETFLG ; save set/reset flag jsr SE731 ; set active colour byte jsr GETCCH ; is there more? lbeq SE94E ; brif not - no box jsr SYNCOMMA ; insist on a comma ldb #'B ; insist on a B jsr LB26F bne SE8EB ; brif something after B bsr SE906 ; draw horizontal line (top) bsr SE931 ; draw vertical line (left) ldx HORBEG ; save horizontal start pshs x ldx HOREND ; set up to draw vertical line (right) stx HORBEG bsr SE931 ; draw vertical line (right) puls x ; restore start coord stx HORBEG ldx VEREND ; set up to draw horizontal line (bottom) stx VERBEG bra SE906 ; draw horizontal line (bottom) and return SE8EB ldb #'F ; insist on F jsr LB26F bra SE8F6 ; draw a filled box SE8F2 leax -1,x ; move vertical coordinate up one SE8F4 stx VERBEG ; save new vertical coordinate SE8F6 jsr SE906 ; draw horizontal line ldx VERBEG ; get current coordinate cmpx VEREND ; above or below end? beq SE905 ; brif done bhs SE8F2 ; brif below - move up leax 1,x ; move down (we're above) bra SE8F4 ; draw another line SE905 rts SE906 ldx HORBEG ; get starting coordinate pshs x ; save it jsr SE9DB ; get absolute horizontal difference bcc SE913 ; brif end > start ldx HOREND ; get ending coordinate stx HORBEG ; save as starting position SE913 tfr d,y ; save difference (pixel count) leay 1,y ; bump it (coords are inclusive) jsr HCALPOS ; calculate pixel address puls u ; get start coordinate stu HORBEG ; restore it lbsr SEA16 ; point to routine to move pixel pointer right SE921 sta VD7 ; save pixel mask jsr SE788 ; turn on pixel lda VD7 ; get back pixel mask jsr ,u ; move one pixel right leay -1,y ; done all pixels? bne SE921 ; brif not rts SE92F puls d ; clean up stack SE931 ldd VERBEG ; get vertical start pshs d ; save it jsr SE9CD ; calculate absolute vertical difference bcc SE93E ; brif end > start ldx VEREND ; swap coordinate stx VERBEG SE93E tfr d,y ; save difference (pixel count) leay 1,y ; coordinates are inclusive jsr HCALPOS ; get screen pointer puls u ; get original start coord stu VERBEG ; restore it lbsr SEA21 ; get routine to move down one row bra SE921 ; draw vertical line SE94E ldy #SE9B8 ; point to vertical increment routine jsr SE9CD ; calculate absolute vertical difference beq SE906 ; draw horizontal if difference is 0 bcc SE95D ; brif vertical end > vertical start ldy #SE9C6 ; point to decrement vertical routine SE95D pshs b,a ; save vertical difference ldu #SE9B1 ; point to horitzontal increment routine jsr SE9DB ; calculate absolute horizontal difference beq SE92F ; draw vertical line if difference is 0 bcc SE96C ; brif horizontal end > horizontal start ldu #SE9BF ; point to decrement horizontal routine SE96C cmpd ,s ; compare horiztonal difference with vertical difference puls x ; get vertical difference back bhs SE977 ; brif horizontal difference is greater exg u,y ; swap major/minor directions exg d,x SE977 pshs u,d ; save larger difference and incr/decr routine pshs d ; save larger difference lsra ; divide larger difference by 2 rorb bcs SE988 ; brif odd cmpu #SE9B8+1 ; inc or dec? blo SE988 ; brif inc subd #1 ; move back of dec (round down) SE988 pshs x,d ; save smaller difference and inc/dec jsr SE7E6 ; point to screen address routine SE98D jsr ,u ; convert coordinates to screen address jsr SE788 ; turn on pxiel ldx 6,s ; done all? beq SE9AD ; brif so leax -1,x ; account for pixel just drawn stx 6,s jsr [8,s] ; bump coordinate ldd ,s ; get minor coordinate increment counter addd 2,s ; add to minor coordinate std ,s ; save new minor increment subd 4,s ; subtract largest difference bcs SE98D ; brif result not bigger than largest difference std ,s ; save new minor increment jsr ,y ; inc/dec minor bra SE98D ; draw another pixel SE9AD puls x ; clean up stack puls d,x,y,u,pc ; clean up stack and return SE9B1 ldx HORBEG ; bump horizontal coord leax 1,x stx HORBEG rts SE9B8 ldx VERBEG ; bump vertical coord leax 1,x stx VERBEG rts SE9BF ldx HORBEG ; reduce horizontal coord leax -1,x stx HORBEG rts SE9C6 ldx VERBEG ; reduce vertical coord leax -1,x stx VERBEG SE9CC rts SE9CD ldd VEREND ; get vertical end subd VERBEG ; get subtract start SE9D1 bcc SE9CC ; brif end > start pshs cc ; save flag for which is > nega ; negate difference negb sbca #0 puls cc,pc ; restore status andreturn SE9DB ldd HOREND ; get horizontal end coord subd HORBEG ; subtract start coord bra SE9D1 ; handle going negative ; Evaluate two sets of coordinates SE9E1 ldx HORDEF ; set start to default stx HORBEG ldx VERDEF stx VERBEG cmpa #0xac ; -? beq SE9F0 ; brif so - use default start jsr SEA04 ; evaluate coordinate pair SE9F0 ldb #0xac ; insist on - jsr LB26F jsr LB26A ; insist on ( jsr LB734 ; evaluate two expressions (X, B) ldy #HOREND ; point to end coords jsr SE7B9 ; validate end coords bra SEA0A ; handle rest of evaluation SEA04 jsr LB26A ; insist on ( jsr SE7B2 ; evaluate coordinates with range check SEA0A jmp LB267 ; insist on ) SEA0D jsr SE7AD ; "normalize" start ldu #HOREND ; point to end coords jmp SE7B0 ; "normalize" end ; Point U to routine to move pixel to right SEA16 ldu #SEA25 ; point to jump table ldb HRMODE ; get graphics mode subb #1 ; zero-base it aslb ; two bytes per entry ldu b,u ; get routine address rts SEA21 ldu #SEA45 ; point to routine to move down one row rts SEA25 fdb SEA34 ; HSCREEN 1 right fdb SEA3D ; HSCREEN 2 right fdb SEA2D ; HSCREEN 3 right fdb SEA34 ; HSCREEN 4 right SEA2D lsra ; move pixel mask right bcc SEA33 ; brif not changing bytes rora ; shift mask back around to left leax 1,x ; move byte forward SEA33 rts SEA34 lsra ; move one pixel right lsra bcc SEA33 ; brif same byte lda #0xc0 ; reset pixel mask leax 1,x ; move to next byte rts SEA3D coma ; flip pixels cmpa #0xf0 ; did we move to a new byte? bne SEA44 ; brif not leax 1,x ; move to next byte SEA44 rts SEA45 ldb HORBYT ; get number of bytes per row abx ; move ahead that many rts ; HCIRCLE command HCIRCLE tst HRMODE ; graphics mode? lbeq SE6EF ; brif not - raise error lbrn 0 cmpa #'@ ; is there @ before coords? bne SEA59 ; brif not jsr GETNCH ; eat the @ SEA59 jsr SEB60 ; get max coords for video mode jsr SEA04 ; parse centre coords jsr SE7AD ; normalize coordinates (ha ha) ldx ,u ; get horizontal coordinate stx VCB ; save it ldx 2,u ; get vertical coordinate stx VCD ; save it jsr SYNCOMMA ; insist on a comma jsr LB73D ; evaluate expression into X (radius) ldu #VCF ; point to temp storage area stx ,u ; save radius jsr SE7B0 ; normalize - pointless lda #1 ; put into "set" mode sta SETFLG jsr SE718 ; evaluate colour ldx #0x100 ; default H/W ratio (1:1) jsr GETCCH ; is the an HW ratio? beq SEA95 ; brif not jsr SYNCOMMA ; insist on comma jsr LB141 ; evaluate HW ratio lda FP0EXP ; multiply by 256 adda #8 sta FP0EXP jsr LB740 ; fetch HW ratio to X (with a fixed 8 bit fraction part) SEA95 lda HRMODE ; get graphics mode cmpa #2 ; is it a 320 mode? bhi SEA9F ; brif not tfr x,d ; double HW ratio for 320 modes leax d,x SEA9F stx VD1 ; save H/W ratio ldb #1 ; go into SET mode stb SETFLG stb VD8 ; flag for "first arc" jsr SEB7B ; evaluate start point (octant, subarc) pshs d ; save start point jsr SEB7B ; evaluate end point std VD9 ; save end point puls d ; get back start point SEAB3 pshs d ; save current circle position ldx HOREND ; switch previous end coords in as the start stx HORBEG ldx VEREND stx VERBEG ldu #CIRCDATA+2 ; point to sines/cosines table anda #1 ; is it an even octant? beq SEAC7 ; brif so negb ; swap arc order for odd octants addb #8 SEAC7 aslb ; four bytes per table entry aslb leau b,u ; now U points to the correct entry pshs u ; save table entry jsr SEBBD ; calculate horizontal offset puls u ; get back table pointer leau -2,u ; move to other entry pshs x ; save horizontal offset jsr SEBBD ; calculaute vertical offset puls y ; get back horizontal offset lda ,s ; get octant number anda #3 ; is it 0 or 4? beq SEAE7 ; brif so cmpa #3 ; is it 3 or 7? beq SEAE7 ; brif so exg x,y ; swap horizontal and vertical otherwise SEAE7 stx HOREND ; save horizontal offset tfr y,d ; divide offset by 2 lsra rorb ldx VD1 ; get H/W ratio jsr SEBCB ; multiply offset by ratio tfr y,d ; did MSB (bits 23-16) end up nonzero? tsta ; brif so - outside 16 bit range lbne LB44A ; brif so - raise error stb VEREND ; save vertical offset MSB tfr u,d ; get low bytes of result sta VEREND+1 ; save LSB (lose fractional part) lda ,s ; get octant number cmpa #2 ; 0 or 1? blo SEB13 ; brif so cmpa #6 ; 6 or h? bhs SEB13 ; brif so ldd VCB ; get horizontal center subd HOREND ; subtract offset (going left) bcc SEB20 ; brif we didn't go negative clra ; minimize to 0 clrb bra SEB20 SEB13 ldd VCB ; get horizontal centre addd HOREND ; add offset bcs SEB1E ; brif we overflowed cmpd VD3 ; did we overflow screen size? blo SEB20 ; brif not SEB1E ldd VD3 ; maximize horizontal coordinate SEB20 std HOREND ; save new horizontal coordinate lda ,s ; get octantnumber cmpa #4 ; is it 0-3 (bottom half)? blo SEB32 ; brif so ldd VCD ; get vertical centre subd VEREND ; subtract offset bcc SEB3F ; brif we didn't run past 0 clra ; minimize to 0 clrb bra SEB3F SEB32 ldd VCD ; get vertical centre addd VEREND ; add offset bcs SEB3D ; brif we overflowed cmpd VD5 ; did we go past end of screen? blo SEB3F ; brif not SEB3D ldd VD5 ; maximize to screen size SEB3F std VEREND ; save new vertical coord tst VD8 ; was this the first coordinate? bne SEB48 ; brif so - don't draw a line lbsr SE94E ; draw the subarc line SEB48 puls d ; get octant and arc lsr VD8 ; test if first point, and clear flag bcs SEB53 ; brif first coord cmpd VD9 ; at end of circle? beq SEB5F ; brif so SEB53 incb ; bump arc counter cmpb #8 ; done 8 subarcs? bne SEB5C ; brif not inca ; bump octant clrb ; reset arc counter anda #7 ; wrap octant number if needed SEB5C jmp SEAB3 ; move on with the next arc SEB5F rts SEB60 ldu #VD3 ; point to storage area ldx #639 ; set max horizontal coord for 640 mode stx ,u lda HRMODE ; get graphics mode cmpa #2 ; is it a 640 mode? bgt SEB73 ; brif so ldx #319 ; set max horzontalcoord for 320 mode stx ,u SEB73 ldx #191 ; all modes have a 191 vertical max stx 2,u jmp SE7B0 ; "normalize" coords SEB7B clrb ; default circle start/end to 0 jsr GETCCH ; is there a fraction? beq SEB91 ; brif not jsr SYNCOMMA ; insist on a comma jsr LB141 ; evaluate circle fraction lda FP0EXP ; multiply by 64 (calculate # of 64ths) adda #6 sta FP0EXP jsr LB70E ; fetch result as 8 bits unsigned andb #0x3f ; keep only the fraction part SEB91 tfr b,a ; copy fraction to A (for octant) andb #7 ; keep only arc number in B lsra ; shift octant number to right of A lsra lsra rts CIRCDATA fdb 0x0000,0x0001 ; subarc 0 fdb 0xfec5,0x1919 ; subarc 1 fdb 0xfb16,0x31f2 ; subarc 2 fdb 0xf4fb,0x4a51 ; subarc 3 fdb 0xec84,0x61f9 ; subarc 4 fdb 0xe1c7,0x78ae ; subarc 5 fdb 0xd4dc,0x8e3b ; subarc 6 fdb 0xc5e5,0xa269 ; subarc 7 fdb 0xb506,0xb506 ; subarc 8 SEBBD ldx VCF ; get radius ldd ,u ; get sin/cos value beq SEBCA ; brif 0 - just use radius subd #1 ; subtract 1 bsr SEBCB ; do the multiplication dance tfr y,x ; save result to X SEBCA rts SEBCB pshs u,y,x,b,a ; save registers and reserve storage clr 4,s ; clear high bits lda 3,s ; B*XL mul std 6,s ; save in partical result ldd 1,s ; A*XH mul addb 6,s ; add to partial product adca #0 std 5,s ldb ,s ; A*XL lda 3,s mul addd 5,s ; add to partial product std 5,s bcc SEBEA inc 4,s SEBEA lda ,s ; A*XH ldb 2,s mul addd 4,s ; add to partial product std 4,s ; save final product bits puls a,b,x,y,u,pc ; save factors, retrieve result, and return ; HPAINT command HPAINT tst HRMODE ; do we have a grahpics mode? lbeq SE6EF ; brif not - raise error lbrn 0 cmpa #'@ ; is there @ before the coords? bne SEC05 ; brif not jsr GETNCH ; eat the @ SEC05 jsr SEA04 ; insist on ( jsr SE7AD ; evaluate the coordinates lda #1 ; set up for "setting" sta SETFLG jsr SE718 ; evaluate colour code ldd WCOLOR ; get working colour and all pixels byte pshs d ; save them for later jsr GETCCH ; do we have a border colour? beq SEC1D ; brif not - use default jsr SE718 ; evaluate border colour SEC1D lda ALLCOL ; get border colour pixel byte sta VD8 ; save it puls d ; get paint colour details std WCOLOR ; restore them jsr SELTASK1 ; map the graphics screen clra ;* add a terminator block to the top of the stack pshs u,x,b,a ;* which is how HPAINT knows it's done jsr SEB60 ; get maximum coordinate values jsr SE7E6 ; point U to routine that selects a pixel stu VD9 ; save pixel selection routine address jsr SECBE ; paint from current coord to the left beq SEC47 ; brif no painting done - we started on the border jsr SED01 ; paint to the right lda #1 ; set up a record to paint down the screen sta VD7 jsr SED2E neg VD7 ; set up a record to paint up the screen jsr SED2E SEC47 sts TMPSTK ; save stack pointer SEC4A tst CHGFLG ; see if a pixel changed bne SEC51 ; brif so lds TMPSTK ; get stack pointer back SEC51 puls a,b,x,u ; get data for the next line to handle clr CHGFLG ; flag nothing changed yet sts TMPSTK ; save new stack address leax 1,x ; add one to the start position STX HORBEG ; set it as the starting position stu VD1 ; save length of parent line sta VD7 ; save up/down flag beq SECBA ; brif up/down is 0 - end marker bmi SEC6A ; brif we're going up the screen incb ; bump vertical coord cmpb VD6 ; at end of screen? bls SEC6E ; brif not clrb ; wrap around - this will cause us to bail below SEC6A tstb ; is coord 0? beq SEC4A ; brif so - don't go upward decb ; move upward on the screen SEC6E stb VERBEG+1 ; save new vertical coordinate jsr SECBE ; paint to the left beq SEC86 ; brif no pixels changed cmpd #3 ; less than 3 painted? blo SEC80 ; brif so - no need to check for paintable data leax -2,x ; move coord left two jsr SED15 ; save block of paint data in the other direction (vertically) SEC80 jsr SED01 ; paint to the right SEC83 jsr SED2E ; save a block of paint data in the same direction SEC86 coma ; invert number of pixels painted (but "less 1") comb SEC88 addd VD1 ; add to length of parent line std VD1 ; now we have the new parent line length ble SECA5 ; brif parent line was shorter jsr SE9B1 ; bump horizontal jsr SECF1 ; check for border bne SEC9B ; brif not ldd #-1 ; count down bra SEC88 ; keep looking SEC9B jsr SE9BF ; move left jsr SED3A ; save horizontal coord bsr SECC7 ; paint to the right bra SEC83 ; save paint block and keep going SECA5 jsr SE9B1 ; bump horizontal coord leax d,x ; point to right of end of parent line stx HORBEG ; set as start coord coma ; negate pixel count (and subtract 2?) comb subd #1 ble SECB7 ; brif line doesn't extend past right of parent tfr d,x ; save portion of line to the right as length bsr SED15 ; save block of paint data SECB7 jmp SEC4A ; go process more paint blocks SECBA jsr SELTASK0 ; unmap screen rts SECBE jsr SED3A ; point starting coord in end ldy #SE9BF ; point to dec horizontal bra SECCD ; paint line SECC7 ldy #SE9B1 ; point to incr horizontal coord jsr ,y ; skip first - already done SECCD ldu ZERO ; initial pixel counter to 0 ldx HORBEG ; get starting coord SECD1 bmi SECEA ; brif off the left side cmpx VD3 ; at max value? bhi SECEA ; brif off right side pshs u,y ; save counter and inc/dec p ointer bsr SECF1 ; check for border beq SECE8 ; brif so - we're done jsr SE792 ; set pixel puls y,u ; restore count and inc/dec routine leau 1,u ; bump count jsr ,y ; adjust coord bra SECD1 ; go do another pixel SECE8 puls y,u ; get back counter and inc/dec pointer SECEA tfr u,d ; save paint counter in D and X tfr d,x subd ZERO ; set flags on counter rts SECF1 jsr [VD9] ; get address of pixel tfr a,b ; duplicate mask andb VD8 ; get pixel colour mask for the pixel pshs b,a ; save masks anda ,x ; merge in with pixel data on screen cmpa 1,s ; does it match? (Z set if so) puls a,b,pc ; restore masks and return SED01 std VCD ; save pixel count ldy HOREND ; get last horizontal coord bsr SED3A ; save current coord sty HORBEG ; start painting to right from the previous end bsr SECC7 ; go paint rightward ldx VCD ; get previous pixel count leax d,x ; now we have a total count for this line addd #1 ; bump it by one? rts SED15 std VCB ; save painted pixel count puls y ; get return address ldd HORBEG ; get start coord pshs x,d ; save start coord and line length lda VD7 ; get direction nega ; invert it SED20 ldb VERBEG+1 ; get vertical coordinate pshs b,a ; save direction and vertical coord pshs y ; put return address back ldb #6 ; make sure we didn't overflow the stack jsr SED3F ldd VCB ; get line length back rts SED2E std VCB ; save line length puls y ; get return address ldd HOREND ; get horizontal start pshs x,d ; save line length and horizontal coord lda VD7 ; get direction flag bra SED20 ; finish saving frame SED3A ldx HORBEG ; get start coord stx HOREND ; save it as end coord rts SED3F negb ; subtract B bytes from S leas b,s cmps #TMPSTACK-(0x2000+14) ; does it overflow? (14 extra is from the unused vectors at the top of the CB ROM area) lblo SED4E ; raise OM error if we did negb ; restore stack pointer leas b,s rts SED4E lds #TMPSTACK-2 ; reset stack (since we overflowed it) jsr SELTASK0 ; restore default memory map jmp LAC44 ; raise OM error ; HBUFF command HBUFF jsr LB73D ; evaluate buffer number to X lbrn 0 cmpx #255 ; valid? lbhi LB44A ; brif not stx VD1 ; save buffer number beq SED72 ; don't get size if buffer 0 select jsr SYNCOMMA ; insist on a comma jsr LB73D ; evaluate size to X stx VD3 ; save buffer size SED72 jsr SE0CB ; map the buffers jsr SELTASK1 ldd VD1 ; get buffer number tstb ; is it zero (not needed!) bne SED85 ; brif not ldd #0xffff ; clear all buffers std HRESBUFF bra SEDBD ; reset memory map and return SED85 ldy #HRESBUFF ; point to buffers ldd ,y ; get address of next block cmpd #0xffff ; empty buffer space? bne SED95 ; brif not bsr SEDC4 ; check for room in buffer space bra SEDB0 ; set up buffer SED95 ldb VD1+1 ; get buffer number SED97 cmpb 2,y ; is this buffer the same number? beq SEDD2 ; brif so - throw error ldu ,y ; get address of next buffer beq SEDA3 ; brif last buffer tfr u,y ; move on to next buffer bra SED97 ; see if we have a matching number here SEDA3 tfr y,u ; save start address to U ldd 3,y ; get size of last buffer leay 5,y ; move past header leay d,y ; move past buffer data bsr SEDC4 ; check for enough room sty ,u ; save pointer to the new buffer in previous header SEDB0 ldd #0 ; mark this as the last buffer std ,y ldb VD1+1 ; set buffer number stb 2,y ldd VD3 ; set buffer size std 3,y SEDBD jsr SELTASK0 ; restore memory map jsr SETMMU rts SEDC4 tfr y,x ; point X to the start of the buffer data leax 5,x ldd VD3 ; get length requested leax d,x ; point to end of new buffer cmpx #HRESBUFF+0x1f00 ; does it fit? bhi SEDD6 ; brif not rts SEDD2 ldb #9*2 ; code for redim array bra SEDD8 SEDD6 ldb #6*2 ; code for out of memory SEDD8 lds #TMPSTACK-2 ; reset stack jsr SELTASK0 ; restore memory map jsr SETMMU jmp LAC46 ; raise error ; HGET command HGET ldx #SEEC0 ; point to HGET movement routine stx VD5 ; save it clrb ; flag for "GET" bra SEDF4 ; get on with things ; HPUT command HPUT ldx #SEEEF ; point to HPUT movement routine stx VD5 ; save it ldb #1 ; flag for "PUT" SEDF4 tst HRMODE ; check for graphics lbeq SE6EF ; brif not - raise error lbrn 0 stb VD8 ; save GET/PUT flag cmpa #'@ ; is there @ before coords? bne SEE06 ; brif not jsr GETNCH ; eat the @ SEE06 jsr SE9E1 ; evaluate box bounds jsr SYNCOMMA ; insist on a comma jsr EVALEXPB ; evaluate buffer number stb VD3 ; save buffer number clr VD4 ; default action to none jsr GETCCH ; is there an action flag? beq SEE38 ; brif not com VD4 ; flag for action flag specified jsr SYNCOMMA ; insist on a comma tst VD8 ; is it GET? bne SEE23 ; brif not lbra LB277 ; raise error SEE23 ldb #5 ; 5 possible actions ldx #SEEE0 ; point to action routine table address SEE28 ldu ,x++ ; get routine address cmpa ,x+ ; does the action match? beq SEE34 ; brif so decb ; checked all of them? bne SEE28 ; brif not jmp LB277 ; raise error SEE34 stu VD5 ; save action address jsr GETNCH ; eat the action token SEE38 jsr SE0CB ; map the buffers and screen jsr SELTASK1 ldb VD3 ; get buffer number jsr SEF18 ; find the correct buffer's data ldd HORBEG ; get horizontal start cmpd HOREND ; is it less than end? ble SEE50 ; brif so ldx HOREND ; swap start/end horizontal coords stx HORBEG std HOREND SEE50 ldd VERBEG ; get vertical start cmpd VEREND ; less that end? ble SEE5D ; brif so ldx VEREND ; swap vertical coords stx VERBEG std VEREND SEE5D lda HRMODE ; get graphics mode ldb #0xf8 ; round off mask for mode 3 (1 bpp) cmpa #3 ; is it mode 3 (1 bpp) beq SEE6D ; brif so ldb #0xfc ; mask for mode 1 or 4 (2 bpp) cmpa #2 ; is it mode 2? bne SEE6D ; brif not - it's mode 1 or 4 ldb #0xfe ; round off mask for mode 2 (4 bpp) SEE6D tfr b,a ; save round off in A and B - we need it twice anda HORBEG+1 ; round off horizontal start sta HORBEG+1 andb HOREND+1 ; round of horizontal end coord stb HOREND+1 jsr SE9DB ; calculate horizontal difference std HOREND ; save it jsr SE9CD ; calculate vertial difference addd #1 ; make it inclusive std VEREND ; save it lda HRMODE ; get graphics mode cmpa #2 ; HSCREEN 2? beq SEE96 ; divide pixel count by 2 for byte count cmpa #3 ; HSCREEN 3? bne SEE92 ; brif not - divide by 4 (HSCREEN 1, 4) lsr HOREND ; divide by 8 (falls through to by 4) ror HOREND+1 SEE92 lsr HOREND ; divide by 4 (falls through to divide by 2) ror HOREND+1 SEE96 lsr HOREND ; divide by 2 ror HOREND+1 ldd HOREND ; get byte count addd #1 ; make it inclusive of the end std HOREND jsr HCALPOS ; get pointer to screen location ldy VD5 ; point to action routine address SEEA7 ldb HOREND+1 ; get LS byte of byte count pshs x ; save line start pointer SEEAB jsr ,y ; perform movement action decb ; done all bytes? bne SEEAB ; brif not puls x ; get back line start jsr SEA45 ; move down one line dec VEREND+1 ; done all rows? bne SEEA7 ; brif not jsr SELTASK0 ; restore memory map jsr SETMMU rts SEEC0 lda ,x+ ; get a byte from screen bsr SEEC7 ; point to proper buffer location sta ,u ; save it rts SEEC7 ldu VCF ; get buffer pointer leau 1,u ; move to next byte stu VCF ; save new pointer cmpu VD1 ; did we run past the end of the buffer? bhi SEED3 ; brif so - raise error rts SEED3 lds #TMPSTACK-2 ; reset stack jsr SELTASK0 ; restore memory map jsr SETMMU jmp LB44A ; raise FC error SEEE0 fdb SEEEF ; PSET action routine fcb 0xbd ; PSET token fdb SEEF6 ; PRESET action routine fcb 0xbe ; PRESET token fdb SEF07 ; OR action routine fcb 0xb1 ; OR token fdb SEEFE ; AND action routine fcb 0xb0 ; AND token fdb SEF10 ; NOT action routine fcb 0xa8 ; NOT token SEEEF bsr SEEC7 ; point to buffer location lda ,u ; get byte from buffer sta ,x+ ; put it on screen rts SEEF6 bsr SEEC7 ; point to buffer location lda ,u ; get byte coma ; invert it sta ,x+ ; put it on screen rts SEEFE bsr SEEC7 ; point to buffer location lda ,u ; get byte from buffer anda ,x ; "AND" with screen data sta ,x+ ; put it on screen rts SEF07 bsr SEEC7 ; point to buffer location lda ,u ; get byte from buffer ora ,x ; "OR" with screen data sta ,x+ ; put on screen rts SEF10 bsr SEEC7 ; point to buffer address lda ,x ; get byte from screen (BUG: should be ,u to get from buffer) coma ; invert data sta ,x+ ; save on screen rts SEF18 ldy #HRESBUFF ; point to start of buffers lda ,y ; are there any buffers? cmpa #0xff bne SEF2C ; brif so jmp SEED3 ; raise error if no buffers SEF25 ldy ,y ; point to next buffer lbeq SEED3 ; brif end of buffers - raise error SEF2C cmpb 2,y ; is this the desired buffer? bne SEF25 ; brif not ldd 3,y ; get size of buffer leay 4,y ; point to start of data (less one for "pre-inc" on use sty VCF ; save buffer pointer leay 1,y ; point to actual data start leay d,y ; calculate address of end of buffer sty VD1 ; save end address rts ; HPRINT command HPRINT tst HRMODE ; graphics mode? lbeq SE6EF ; brif not - raise error lbrn 0 jsr LB26A ; insist on ( jsr SE7B2 ; evaluate coordinates jsr LB267 ; insist on ) jsr SYNCOMMA ; insist on comma jsr LB156 ; evaluate print string tst VALTYP ; is it string? bne SEF62 ; brif not numeric (should be BMI) jsr LBDD9 ; convert number to string jsr LB516 ; save string in string space and all that jazz SEF62 jsr LB657 ; fetch string details stb H.PCOUNT ; save length in print count ldy #H.PBUF ; point to temporary string buffer SEF6C decb ; have we processed the whole string? bmi SEF75 ; brif so (or if the string length was > 128) lda ,x+ ; copy a character from the string into the buffer sta ,y+ bra SEF6C ; see if we're done yet SEF75 lda HRMODE ; get graphics mode ldb #40 ; 40 characters on a 320 line cmpa #3 ; is it mode 1 or 2? blo SEF7F ; brif so ldb #80 ; 80 characters on a 640 line SEF7F clra ; zero extend line size subd HORBEG ; subtract first position from line length bmi SF001 ; brif we're printing off the side of the screen cmpb H.PCOUNT ; is the print count larger than characters left? bhi SEF8E ; brif not stb H.PCOUNT ; save remaining screen positions as print count beq SF001 ; brif nothing to print SEF8E lda #ROWMAX-1 ; get highest row number cmpa VERBEG+1 ; are we in range? bge SEF96 ; brif so sta VERBEG+1 ; force bottom row if not in range SEF96 jsr SF08C ; calculate actual pixel coordinates jsr HCALPOS ; get screen pointer ldy #H.PBUF ; point to string data ldb H.PCOUNT ; get number of characters to print SEFA3 lda ,y ; get character to print anda #0x7f ; lose bit 7 (character set repeats) suba #0x20 ; lose the "control" characters - no glyphs for those codes bpl SEFAD ; brif it was not a control character lda #0 ; use a space if it was SEFAD sta ,y+ ; put glyph number into the buffer decb ; processed all of them? bgt SEFA3 ; brif not lda HRMODE ; get graphics mode deca ; zero-base it asla ; two bytes per display routine ldy #SF002 ; point to display routine table ldy a,y ; point to display routine sty VD1 ; save it lda #8 ; 8 rows per character sta VD3 ; temp save row counter ldy #H.PBUF ; point to print buffer ldu #SF09D ; point to FONT data ldb H.FCOLOR ; get foreground colour jsr PIXELFIL ; get an all pixel byte stb ALLCOL ; save it jsr SELTASK1 ; map the screen lda H.PCOUNT ; get character count to display SEFD9 pshs y,x,a ; save buffer pointer, character count, and screen address SEFDB ldb ,y+ ; get character from buffer clra ; zero extend it aslb ;* 8 bytes per character entry (don't need rola after first aslb ;* because characters are only 7 bits rola aslb rola lda d,u ; get font data for this row jsr [VD1] ; display it dec H.PCOUNT ; done all characters on this row? bgt SEFDB ; brif not puls a,x,y ; get back character count, buffer pointer, and screen address dec VD3 ; have we done all the rows? beq SEFFE ; brif so sta H.PCOUNT ; restore print count leau 1,u ; move one row down the font data jsr SEA45 ; move one row down the screen bra SEFD9 ; go do another row of pixels SEFFE jsr SELTASK0 ; restore memory map SF001 rts SF002 fdb SF01A ; HSCREEN 1 (2 bpp) fdb SF045 ; HSCREEN 2 (4 bpp) fdb SF00A ; HSCREEN 3 (1 bpp) fdb SF01A ; HSCREEN 4 (2 bpp) SF00A pshs a ; save font data coma ; invert it anda ,x ; merge with screen - turns off pixels in the character sta ,x ; save it back on the screen puls a ; get back font data anda ALLCOL ; merge with colour data ora ,x ; merge with screen to fill hole created above sta ,x+ ; save it on screen rts SF01A pshs y ; save buffer pointer ldy #SF035 ; point to 2 bpp pixel masks tfr a,b ; copy character data (need two bytes per character) lsra ; use the upper 4 bits in first byte lsra lsra lsra lda a,y ; get pixel mask for all 16 possibilities for upper 4 bits jsr SF00A ; shove it on screen andb #0x0f ; lose upper bits for low half lda b,y ; get pixel mask for this pixel combination jsr SF00A ; shove that on screen too puls y ; restore buffer pointer rts SF035 fcb 0x00,0x03,0x0c,0x0f ; combined pixel masks for 16 possibilities for a 2 bpp byte fcb 0x30,0x33,0x3c,0x3f fcb 0xc0,0xc3,0xcc,0xcf fcb 0xf0,0xf3,0xfc,0xff SF045 pshs y,a ; save buffer pointer and font data ldy #SF06C ; point to 16 colour masks lsra ; fetch high 4 bits lsra lsra lsra asla ; two bytes per mask (this is NOT redundant - this and above clears bit 0) ldd a,y ; get two byte mask for these four bits jsr SF00A ; show upper 2 pixels tfr b,a ; show lower 2 pixels jsr SF00A puls a ; get back font data anda #0x0f ; lost upper bits asla ; two bytes per mask ldd a,y ; get mask data jsr SF00A ; show upper 2 pixels tfr b,a ; show lower 2 pixels jsr SF00A puls y ; restore buffer pointer rts SF06C fdb 0x0000,0x000f,0x00f0,0x00ff ; combined pixel masks for 16 possibilities for a 4 bpp double byte fdb 0x0f00,0x0f0f,0x0ff0,0x0fff fdb 0xf000,0xf00f,0xf0f0,0xf0ff fdb 0xff00,0xff0f,0xfff0,0xffff SF08C ldd HORBEG ; get horizontal character cell coordinate aslb ; times 8 - 8x8 font data; note first shift can't cause carry with max 79 for column number aslb rola aslb rola std HORBEG ; save actual horizontal pixel position of print position lda VERBEG+1 ; get vertical character cell coordinate asla ; times 8 - 8x8 font data asla asla sta VERBEG+1 ; save actual vertical pixel position of print position rts ; This is the HPRINT font, which is basically equivalent to the hardware font in the GIME for character codes ; 0x20 through 0x7f. It does not include the extra characters in the 0x00-0x1f range of the hardware character ; set. However, glyphs for those are actually included in the ROM above the end of the actual code. SF09D fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; SPACE fcb 0x10,0x10,0x10,0x10,0x10,0x00,0x10,0x00 ; ! fcb 0x28,0x28,0x28,0x00,0x00,0x00,0x00,0x00 ; " fcb 0x28,0x28,0x7C,0x28,0x7C,0x28,0x28,0x00 ; # fcb 0x10,0x3C,0x50,0x38,0x14,0x78,0x10,0x00 ; $ fcb 0x60,0x64,0x08,0x10,0x20,0x4C,0x0C,0x00 ; % fcb 0x20,0x50,0x50,0x20,0x54,0x48,0x34,0x00 ; & fcb 0x10,0x10,0x20,0x00,0x00,0x00,0x00,0x00 ; ' fcb 0x08,0x10,0x20,0x20,0x20,0x10,0x08,0x00 ; ( fcb 0x20,0x10,0x08,0x08,0x08,0x10,0x20,0x00 ; ) fcb 0x00,0x10,0x54,0x38,0x38,0x54,0x10,0x00 ; * fcb 0x00,0x10,0x10,0x7C,0x10,0x10,0x00,0x00 ; + fcb 0x00,0x00,0x00,0x00,0x00,0x10,0x10,0x20 ; , fcb 0x00,0x00,0x00,0x7C,0x00,0x00,0x00,0x00 ; - fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00 ; . fcb 0x00,0x04,0x08,0x10,0x20,0x40,0x00,0x00 ; / fcb 0x38,0x44,0x4C,0x54,0x64,0x44,0x38,0x00 ; 0 fcb 0x10,0x30,0x10,0x10,0x10,0x10,0x38,0x00 ; 1 fcb 0x38,0x44,0x04,0x38,0x40,0x40,0x7C,0x00 ; 2 fcb 0x38,0x44,0x04,0x08,0x04,0x44,0x38,0x00 ; 3 fcb 0x08,0x18,0x28,0x48,0x7C,0x08,0x08,0x00 ; 4 fcb 0x7C,0x40,0x78,0x04,0x04,0x44,0x38,0x00 ; 5 fcb 0x38,0x40,0x40,0x78,0x44,0x44,0x38,0x00 ; 6 fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x40,0x00 ; 7 fcb 0x38,0x44,0x44,0x38,0x44,0x44,0x38,0x00 ; 8 fcb 0x38,0x44,0x44,0x38,0x04,0x04,0x38,0x00 ; 9 fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x00,0x00 ; : fcb 0x00,0x00,0x10,0x00,0x00,0x10,0x10,0x20 ; ; fcb 0x08,0x10,0x20,0x40,0x20,0x10,0x08,0x00 ; < fcb 0x00,0x00,0x7C,0x00,0x7C,0x00,0x00,0x00 ; = fcb 0x20,0x10,0x08,0x04,0x08,0x10,0x20,0x00 ; > fcb 0x38,0x44,0x04,0x08,0x10,0x00,0x10,0x00 ; ? fcb 0x38,0x44,0x04,0x34,0x4C,0x4C,0x38,0x00 ; @ fcb 0x10,0x28,0x44,0x44,0x7C,0x44,0x44,0x00 ; A fcb 0x78,0x24,0x24,0x38,0x24,0x24,0x78,0x00 ; B fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x00 ; C fcb 0x78,0x24,0x24,0x24,0x24,0x24,0x78,0x00 ; D fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x7C,0x00 ; E fcb 0x7C,0x40,0x40,0x70,0x40,0x40,0x40,0x00 ; F fcb 0x38,0x44,0x40,0x40,0x4C,0x44,0x38,0x00 ; G fcb 0x44,0x44,0x44,0x7C,0x44,0x44,0x44,0x00 ; H fcb 0x38,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; I fcb 0x04,0x04,0x04,0x04,0x04,0x44,0x38,0x00 ; J fcb 0x44,0x48,0x50,0x60,0x50,0x48,0x44,0x00 ; K fcb 0x40,0x40,0x40,0x40,0x40,0x40,0x7C,0x00 ; L fcb 0x44,0x6C,0x54,0x54,0x44,0x44,0x44,0x00 ; M fcb 0x44,0x44,0x64,0x54,0x4C,0x44,0x44,0x00 ; N fcb 0x38,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; O fcb 0x78,0x44,0x44,0x78,0x40,0x40,0x40,0x00 ; P fcb 0x38,0x44,0x44,0x44,0x54,0x48,0x34,0x00 ; Q fcb 0x78,0x44,0x44,0x78,0x50,0x48,0x44,0x00 ; R fcb 0x38,0x44,0x40,0x38,0x04,0x44,0x38,0x00 ; S fcb 0x7C,0x10,0x10,0x10,0x10,0x10,0x10,0x00 ; T fcb 0x44,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; U fcb 0x44,0x44,0x44,0x28,0x28,0x10,0x10,0x00 ; V fcb 0x44,0x44,0x44,0x44,0x54,0x6C,0x44,0x00 ; W fcb 0x44,0x44,0x28,0x10,0x28,0x44,0x44,0x00 ; X fcb 0x44,0x44,0x28,0x10,0x10,0x10,0x10,0x00 ; Y fcb 0x7C,0x04,0x08,0x10,0x20,0x40,0x7C,0x00 ; Z fcb 0x38,0x20,0x20,0x20,0x20,0x20,0x38,0x00 ; ] fcb 0x00,0x40,0x20,0x10,0x08,0x04,0x00,0x00 ; \ fcb 0x38,0x08,0x08,0x08,0x08,0x08,0x38,0x00 ; [ fcb 0x10,0x38,0x54,0x10,0x10,0x10,0x10,0x00 ; UP ARROW fcb 0x00,0x10,0x20,0x7C,0x20,0x10,0x00,0x00 ; LEFT ARROW fcb 0x10,0x28,0x44,0x00,0x00,0x00,0x00,0x00 ; ^ fcb 0x00,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; a fcb 0x40,0x40,0x58,0x64,0x44,0x64,0x58,0x00 ; b fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x00 ; c fcb 0x04,0x04,0x34,0x4C,0x44,0x4C,0x34,0x00 ; d fcb 0x00,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; e fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x10,0x00 ; f fcb 0x00,0x00,0x34,0x4C,0x4C,0x34,0x04,0x38 ; g fcb 0x40,0x40,0x58,0x64,0x44,0x44,0x44,0x00 ; h fcb 0x00,0x10,0x00,0x30,0x10,0x10,0x38,0x00 ; i fcb 0x00,0x04,0x00,0x04,0x04,0x04,0x44,0x38 ; j fcb 0x40,0x40,0x48,0x50,0x60,0x50,0x48,0x00 ; k fcb 0x30,0x10,0x10,0x10,0x10,0x10,0x38,0x00 ; l fcb 0x00,0x00,0x68,0x54,0x54,0x54,0x54,0x00 ; m fcb 0x00,0x00,0x58,0x64,0x44,0x44,0x44,0x00 ; n fcb 0x00,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; o fcb 0x00,0x00,0x78,0x44,0x44,0x78,0x40,0x40 ; p fcb 0x00,0x00,0x3C,0x44,0x44,0x3C,0x04,0x04 ; q fcb 0x00,0x00,0x58,0x64,0x40,0x40,0x40,0x00 ; r fcb 0x00,0x00,0x3C,0x40,0x38,0x04,0x78,0x00 ; s fcb 0x20,0x20,0x70,0x20,0x20,0x24,0x18,0x00 ; t fcb 0x00,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; u fcb 0x00,0x00,0x44,0x44,0x44,0x28,0x10,0x00 ; v fcb 0x00,0x00,0x44,0x54,0x54,0x28,0x28,0x00 ; w fcb 0x00,0x00,0x44,0x28,0x10,0x28,0x44,0x00 ; x fcb 0x00,0x00,0x44,0x44,0x44,0x3C,0x04,0x38 ; y fcb 0x00,0x00,0x7C,0x08,0x10,0x20,0x7C,0x00 ; z fcb 0x08,0x10,0x10,0x20,0x10,0x10,0x08,0x00 ; { fcb 0x10,0x10,0x10,0x00,0x10,0x10,0x10,0x00 ; | fcb 0x20,0x10,0x10,0x08,0x10,0x10,0x20,0x00 ; } fcb 0x20,0x54,0x08,0x00,0x00,0x00,0x00,0x00 ; ~ fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x7C,0x00 ; _ ; HDRAW command HDRAW tst HRMODE ; grahics mode? lbeq SE6EF ; brif not lbrn 0 ldx #0 ; set empty string for "end of DRAW" ldb #1 pshs x,b stb SETFLG ; set up for "set" mode stx VD5 ; clear update and draw flags jsr SE731 ; set up color byte jsr LB156 ; evaluate command string SF3B8 jsr LB654 ; fetch command string details bra SF3C5 ; interpret command string SF3BD jsr SF591 ; fetch command character jmp SF5A7 ; evaluate number SF3C3 puls b,x ; get "caller" command string details SF3C5 stb VD8 ; save string pointer beq SF3C3 ; brif end of string - try another stx VD9 ; set string data pointer lbeq SF4D0 ; brif we hit the top of the stack SF3CF tst VD8 ; is there anything left? beq SF3C3 ; brif not jsr SF591 ; get command character cmpa #'; ; separator? beq SF3CF ; brif so - ignore it cmpa #'' ; '? beq SF3CF ; brif so - ignore that too cmpa #'N ; update toggle? bne SF3E6 ; brif not com VD5 ; toggle the "update" flag (if set, return to original position after) bra SF3CF ; process more SF3E6 cmpa #'B ; blank modifier? bne SF3EE ; brif not com VD6 ; toggle "draw" flag - 0 = draw, nonzero = don't draw bra SF3CF ; process more SF3EE cmpa #'X ; substring call? lbeq SF4A1 ; brif so - process it cmpa #'M ; M (move)? lbeq SF54C ; brif so - process "move" pshs a ; save command character ldb #1 ; default count if no number follows clr VD3 ; clear MS byte of count stb VD4 ; save LS byte of count tst VD8 ; is there anything left? beq SF417 ; brif not jsr SF591 ; get command character jsr LB3A2 ; set C if not alpha pshs cc ; save alpha flag jsr SF5F2 ; back up command pointer puls cc ; get back alpha flag bcc SF417 ; brif command is alpha bsr SF3BD ; evaluate decimal string SF417 puls a ; get command back cmpa #'C ; C (colour)? beq SF445 ; brif so cmpa #'A ; A (angle)? beq SF451 ; brif so cmpa #'S ; S (scale)? beq SF45C ; brif so cmpa #'U ; U (up)? beq SF496 ; brif so cmpa #'D ; D (down)? beq SF492 ; brif so cmpa #'L ; L (left)? beq SF48C ; brif so cmpa #'R ; R (right)? beq SF485 ; brif so suba #'E ; shift E,F,G,H to be 0-3 beq SF473 ; brif E (UR) deca ; F (DR) beq SF46D ; brif so deca ; G (DL) beq SF47D ; brif so deca ; H (UL) beq SF467 ; brif so jmp LB44A ; raise error if unrecognized command SF445 jsr SE711 ; adjust colour code for graphics mode stb H.FCOLOR ; set new foreground jsr SE731 ; set up colour byte lbra SF3CF ; handle another command SF451 cmpb #4 ; only 4 angles valid lbhs LB44A ; brif invalid angle stb ANGLE ; save draw angle lbra SF3CF ; go handle another command SF45C cmpb #63 ; only 0-62 are valid scale factors lbhs LB44A ; brif invalid scale stb SCALE ; set scale factor lbra SF3CF ; process another command SF467 lda VD3 ; get count MSB bsr NEGACCD ; negate horizontal difference (go left) bra SF46F ; go the same distance up SF46D lda VD3 ; get count MSB SF46F tfr d,x ; go same distance right as down bra SF4D4 ; go handle movement/drawing SF473 lda VD3 ; get MSB of count tfr d,x ; going same distance on both axes bsr NEGACCD ; negate the vertical distance exg d,x ; put vertical in X, horizontal in D bra SF4D4 ; go handle drawing and moving SF47D lda VD3 ; get MSB of count tfr d,x ; go same distance on both axes bsr NEGACCD ; go left horizontally (and down vertically) bra SF4D4 ; go handle drawing and moving SF485 lda VD3 ; get MSB of difference (going right) SF487 ldx #0 ; no vertical movement bra SF4D4 ; handle drawing/moving SF48C lda VD3 ; get MSB of count bsr NEGACCD ; negate because going left bra SF487 ; set no vertical difference, handle drawing/moving SF492 lda VD3 ; get MSB of count bra SF49A ; go make horizontal difference 0, use positive distance for down SF496 lda VD3 ; get MSB of count bsr NEGACCD ; use negative distance for up SF49A ldx #0 ; use 0 horizontal distance exg x,d ; put horizontal and vertical in the right places bra SF4D4 ; go move/draw SF4A1 jsr SF611 ; interpret command as a variable ldb #2 ; see if we're about to run out of memory jsr LAC33 ldb VD8 ; get remaining characters in current command string ldx VD9 ; get current command string pointer pshs x,b ; save the stack frame jmp SF3B8 ; go evaluate the string SF4B2 ldb SCALE ; get scaling factor beq SF4D1 ; brif none - use full scale clra ; zero extend scale exg d,x ; put distance in D, save scale factor sta ,-s ; save MSB of distance and set flags on sign bpl SF4BF ; brif positive distance bsr NEGACCD ; make it positive if negative SF4BF jsr SEBCB ; multiply D and X tfr U,D ; save LSW in D lsra ; divide by 4 rorb lsra rorb tst ,s+ ; was original positive? bpl SF4D0 ; brif so NEGACCD nega ; negate D negb sbca #0 SF4D0 rts SF4D1 tfr x,d ; keep unmodified distance rts SF4D4 pshs d ; save horizontal distance bsr SF4B2 ; apply scale factor to vertical distance puls x ; get back horizontal distance pshs d ; save scaled vertical distance bsr SF4B2 ; apply scale to horizontal distance puls x ; get back the vertical distance ldy ANGLE ; get draw angle (using Y to avoid clobbering D) pshs y ; save it SF4E5 tst ,s ; check angle beq SF4F1 ; brif no angle exg x,d ;* swap horizontal and vertical distances then negate new horizontal bsr NEGACCD ;* distance, which rotates 90° counterclockwise dec ,s ; count down the angle bra SF4E5 ; see if we have rotated enough times SF4F1 puls y ; clean up stack ldu #0 ; default end position to 0 addd HORDEF ; add distance to current draw position bmi SF4FC ; brif we went negative - use minimal 0 tfr d,u ; use calculated draw coordinate SF4FC tfr x,d ; fetch vertical distance for calculation ldx #0 ; default end position to 0 addd VERDEF ; add distance to draw position bmi SF507 ; brif we went negative - use minimal 0 tfr d,x ; use calculated coordinate SF507 cmpu #640 ; is it out of range completely? blo SF510 ; brif not ldu #639 ; maximize to right edge of screen SF510 lda HRMODE ; get graphics mode cmpa #2 ; is it a 320 mode? bgt SF51F ; brif not cmpu #320 ; out of range for 320 mode? blo SF51F ; brif not ldu #319 ; maximize to right edge of screen SF51F cmpx #192 ; out of range vertically? blo SF527 ; brif not ldx #191 ; maximize to bottom of screen SF527 ldd HORDEF ; set start position to current draw position std HORBEG ldd VERDEF std VERBEG stx VEREND ; set calculated position as end position stu HOREND tst VD5 ; are we going to update draw position? bne SF53B ; brif not stx VERDEF ; set new draw position stu HORDEF SF53B jsr SEA0D ; "normalize" coordinates tst VD6 ; are we doing to draw a line? bne SF545 ; brif not jsr SE94E ; draw a line SF545 clr VD5 ; reset the "update" flag clr VD6 ; reset the "draw" flag jmp SF3CF ; go handle another command SF54C jsr SF591 ; get input character pshs a ; save it jsr SF578 ; evaluate horizontal distance pshs d ; save it jsr SF591 ; get a character cmpa #', ; is it a comma separator? lbne LB44A ; brif not - raise error jsr SF575 ; evaluate the vertical distance tfr d,x ; save vertical distance puls u ; get horizontal distance puls a ; get first command character cmpa #'+ ; +? beq SF570 ; treat coordinates as relative displacements cmpa #'- ; -? bne SF507 ; brif neither + or -; treat as absolute coordinates SF570 tfr u,d ; put horizontal distance in D jmp SF4D4 ; treat distances as offsets SF575 jsr SF591 ; get character SF578 cmpa #'+ ; +? beq SF583 ; brif so - do positive cmpa #'- ; -? beq SF584 ; brif so - do negative jsr SF5F2 ; back up input pointer SF583 clra ; flag positive SF584 pshs a ; save sign flag jsr SF3BD ; evaluate decimal number tst ,s+ ; is it positive? beq SF590 ; brif so negb ; negate the value - BUG: should be JSR NEGACCD; this code sequence doesn't work sbca #0 SF590 rts SF591 pshs x ; save register SF593 tst VD8 ; is there anything to fetch? lbeq LB44A ; brif not - raise error ldx VD9 ; get command pointer lda ,x+ ; get command character stx VD9 ; save updated pointer dec VD8 ; account for character consumed cmpa #0x20 ; space? beq SF593 ; brif so - skip it puls x,pc ; restore register and return SF5A7 cmpa #'= ; is it variable equate? bne SF5B6 ; brif not pshs u,y ; save registers bsr SF611 ; interpret variable in command string jsr LB3E9 ; convert to integer in D std VD3 ; save as count puls y,u,pc ; restore registers and return SF5B6 jsr SF608 ; clear carry if numeric lbcs LB44A ; bail if not numeric clr VD3 ; initialize count to 0 clr VD4 SF5C1 suba #'0 ; remove ASCII bias sta VD7 ; save digit value ldd VD3 ; get accumulated value bsr SF5FD ; multiply by 10 addb VD7 ; add digit value adca #0 ; propagate carry std VD3 ; save accumulated count value lda HRMODE ; get graphics mode cmpa #2 ; is it a 640 mode? bgt SF5DA ; brif so ldd #319 ; get max for 320 mode bra SF5DD SF5DA ldd #639 ; get max for 640 mode SF5DD cmpd VD3 ; is the value in range for a horizontal coordinate? lblt LB44A ; brif not ldd VD3 ; get accumulated value tst VD8 ; is there anything more to parse? beq SF5FA ; brif not jsr SF591 ; get a character jsr SF608 ; set C if not digit bcc SF5C1 ; brif digit - add to accumulated value SF5F2 inc VD8 ; account for character being unfetched ldx VD9 ; move command pointer back leax -1,x stx VD9 SF5FA ldd VD3 ; get accumulated value rts SF5FD aslb ; times 2 rola pshs d ; save 2D aslb ; times 4 rola aslb ; times 8 rola addd ,s++ ; 8D+2D=10D rts SF608 cmpa #'0 ; is it less than ASCII 0? blo SF610 ; brif so - sets C suba #'9+1 ; set C if > ASCII 9 suba #-('9+1) SF610 rts SF611 ldx VD9 ; get command pointer pshs x ; save it jsr SF591 ; get command character jsr LB3A2 ; set C if not alpha lbcs LB44A ; brif not variable name SF61F jsr SF591 ; get command character cmpa #'; ; is it end of variable string? bne SF61F ; brif not puls x ; get back start of variable ldu CHARAD ; save interpreter input pointer pshs u stx CHARAD ; save command string pointer as interpeter input jsr LB284 ; evaluate variable puls x ; restore interpreter input pointer stx CHARAD rts ; WIDTH command WIDTH clr HRMODE ; turn off graphics lbrn 0 cmpa #0 ; end of line? (BUG: should do a BEQ before the CLR above) beq SF64F ; brif so - raise error if no argument (won't trigger on :) jsr EVALEXPB ; evaluate width argument cmpb #32 ; 32 columns? beq COL32 ; brif so cmpb #40 ; 40 columns? beq COL40 ; brif so cmpb #80 ; 80 columns? beq COL80 ; brif so SF64F jmp LB44A ; raise FC error COL32 clra ; set text mode to 32 columns sta HRWIDTH jsr LA928 ; clear screen lbsr SETTEXT ; set up display for 32 column screen rts COL40 lda #1 ; mode number for 40 columns sta HRWIDTH ; set text screen mode lbsr SF772 ; map text screen lda #40 ; set up scren size in character cells ldb #ROWMAX std H.COLUMN ldd #HRESSCRN+40*ROWMAX*2 ; set end address of screen SF66D std H.DISPEN ; save end address bsr SF68C ; clear the screen lbsr SF778 ; unmap text screen lbsr SETTEXT ; set up display for the text screen rts COL80 lda #2 ; mode number for 80 columns sta HRWIDTH ; set text screen mode lbsr SF772 ; map the screen lda #80 ; set up screen size in character cells ldb #ROWMAX std H.COLUMN ldd #HRESSCRN+80*ROWMAX*2 ; set end address of screen bra SF66D ; set up rest of parameters SF68C ldx #HRESSCRN ; set cursor address to top left corner lbrn 0 stx H.CRSLOC lda #0x20 ; use space to clear screen ldb H.CRSATT ; get current attributes SF69B std ,x++ ; blank a character cell cmpx H.DISPEN ; end of screen? blo SF69B ; brif not ldx #HRESSCRN ; reset to top of screen clra ; reset cursor coordinates to 0,0 sta H.CURSX sta H.CURSY rts ; CLS patch entered from the other patch in the ECB area ALINK23 puls cc ; restore zero flag lbrn 0 beq SF6E0 ; brif no arguments jsr EVALEXPB ; get colour number tstb ; 0? beq SF6E0 ; brif so - treat as no arguments cmpb #8 ; valid colour? bhi SF6E7 ; brif not - do the easter egg or the other easter egg decb ; zero-base the colour leay IM.PALET,pcr ; point to current palette settings lda b,y ; get the real colour sta V.BORDER ; set border colour lbsr SF766 ; set border colour in GIME initializers stb H.CRSATT ; set attributes to foreground 0, background as selected, no blink or underline lda #0x20 ; get space character lbsr SF772 ; map screen ldx #HRESSCRN ; get address of start of screen stx H.CRSLOC ; put cursor there bsr SF69B ; clear screen SF6DC lbsr SF778 ; unmap screen rts SF6E0 lbsr SF772 ; map screen bsr SF68C ; clear screen bra SF6DC ; ummap screen and return SF6E7 clr H.CRSATT ; reset attributes to colours 0,0, no blink or underline lda IM.PALET ; get colour in register 0 sta V.BORDER ; set border colour bsr SF766 ; reset border colour in GIME initializers cmpb #100 ; is it CLS 100? SF6F4 beq SF730 ; brif so - do the easter egg bsr SF772 ; map the screen bsr SF68C ; clear screen bsr SF778 ; unmap screen ldx #MICROMS-1 ; point to Microware commercial jmp STRINOUT ; display it MICROMS fcc 'Microware Systems Corp.' fcb 0x0d,0x00 AUTHORMS fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; the ROM/RAM copy sets this to the actual easter egg text fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 fcb 0x00,0x00,0x00,0x00,0x00 SF730 bsr SF772 ; map the screen lbsr SF68C ; clear it bsr SF778 ; unmap the screen ldx #AUTHORMS-1 ; point to the easter egg jsr STRINOUT ; display it pshs x ; save X for some reason leax >SF6F4,pcr ; point to start of easter egg code lda #0x12 ; NOP opcode sta ,x+ ; blank out the branch that brings us here sta ,x leax >AUTHORMS,pcr ; point to author message SF74D sta ,x+ ; blank out character in string or this code cmpx #SF74D ; end of string or display code? blo SF74D ; brif not puls x ; restore X rts ; Line input routine patch for handling CLEAR ALINK27 tst HRWIDTH ; is it 40/80 column screen? bne SF761 ; brif so jsr LA928 ; clear 32 column screen SF75E jmp LA390 ; go make to mainline SF761 lbsr SF6E0 ; clear the screen bra SF75E ; return to mainline SF766 pshs y ; save register leay SE03B,pcr ; point to text initializers sta 3,y ; set border in 40 column initializer sta 12,y ; set border in 80 column initializer puls y,pc ; restore registers and return SF772 orcc #0x50 ; clobber interrupts lbsr SELTEXT ; map the text screen (by setting *all 16* MMU registers) rts SF778 lbsr SETMMU ; unmap text screen (by setting *all 16* MMU registers) andcc #0xaf ; restart interrupts rts ; The driver for putting characters on the 40 and 80 column screen is here, modulo the WIDTH command and clear ; screen routines above. ; ; There are several major problems with this driver: ; ; * Cursor handling is overly complicated. Instead of doing what Color Basic does and only show the cursor ; when waiting for input in the generic input routine, this driver displays it almost all of the time and, thus, ; has all manner of code for managing the cursor that would not be needed otherwise. ; * The system goes out of its way to set up the screen height and width values. Then, it doesn't bother using ; them consistently, especially during the screen scrolling routine. Indeed, the screen scrolling routine could ; be made completely general purpose by using two pointers, say U for the destination and X for the source. Then ; the column count could be used to decide the line width (to calculate the offset betwen U and X) and then the ; row count could be used to set the row number after the scrolling is done. This would remove any hard coded ; offsets or screen size assumptions. ; * The routines for mapping and unmapping the text screen are inexcusably slow. Only one MMU register needs to ; be changed in either routine. However, instead of doing that, the routines use an inefficient routine that ; sets *all 16* MMU registers (both tasks!). This reduces screen output speed so much that a fast reader can ; actually keep up with the output going full speed. Simply replacing these two routines with simpler ones that ; do not do that dumbassery gets performance on par with the 32 column VDG screen. ; ; Along with the above, some of the code is far more convoluted than it needs to be, but that is relatively ; benign compared to everything else. ; ; Blink cursor patch ALINK24 bsr SF787 ; blink the cursor jsr KEYIN ; get keypress beq ALINK24 ; brif no key pressed puls b,x,pc ; return to caller SF787 dec BLKCNT ; time to blink cursor? bne SF7A8 ; brif not ldb #11 ; reset blink counter stb BLKCNT bsr SF772 ; map screen ldx H.CRSLOC ; get cursor pointer lda 1,x ; get current attributes bita #0x40 ; is underline on? beq SF79F ; brif not - enable it lda H.CRSATT ; use current attributes if it is bra SF7A4 SF79F lda H.CRSATT ; get current attributes ora #0x40 ; turn on underline SF7A4 sta 1,x ; save new attributes bsr SF778 ; unmap screen SF7A8 ldx #DEBDEL ; do a delay jmp LA7D3 ; Put character on screen patch ALINK22 bsr SF772 ; map the screen lbrn 0 ldx H.CRSLOC ; get cursor location cmpa #0x08 ; backspace? bne SF7C4 ; brif not cmpx #HRESSCRN ; at start of screen? beq SF7DE ; brif so - do nothing bsr SF7E2 ; do a backspace bra SF7DE ; finish up SF7C4 cmpa #0x0d ; carriage return? bne SF7CC ; brif not bsr SF827 ; do a carriage return bra SF7D7 ; finish up with scroll check SF7CC cmpa #0x20 ; is it a control code? blo SF7DE ; brif so - do nothing ldb H.CRSATT ; get current attributes std ,x ; put character on screen bsr SF807 ; move cursor forward SF7D7 cmpx H.DISPEN ; end of screen? blo SF7DE ; brif not bsr SF854 ; scroll screen SF7DE bsr SF778 ; unmap the screen puls a,b,x,pc ; restore registers and return SF7E2 pshs b,a ; save registers lda #0x20 ; space character ldb H.CRSATT ; get attributes std ,x ; turns off cursor at this position and blanks it orb #0x40 ; turn on underline (we'll put a cursor in the previous position) std -2,x ; put blank and cursor back one leax -2,x ; move pointer back stx H.CRSLOC ; save new cursor pointer ldd H.CURSX ; get coordinates deca ; move horizontal back bpl SF802 ; brif we didn't wrap decb ; move vertical back stb H.CURSY ; save it lda H.COLUMN ; get screen width deca ; coordinates are zero-based so now we have the max horizontal coord SF802 sta H.CURSX ; save new horizontal position puls a,b,pc ; restore registers and return SF807 pshs a,b ; save registers lda #0x20 ; we'll blank a character for the cursor ldb H.CRSATT ; get attributes orb #0x40 ; force underline for cursor leax 2,x ; move pointer forward std ,x ; put blank and cursor on screen stx H.CRSLOC ; save new cursor position ldd H.CURSX ; get coordinates inca ; move right cmpa H.COLUMN ; did we hit the edge? blo SF802 ; brif not - save new horizontal coordinate and return incb ; bump line stb H.CURSY ; save new line clra ; reset to left side of screen bra SF802 ; save new horizontal coordinate and return SF827 pshs a,b ; save registers lda #0x20 ; get space character ldb H.CRSATT ; get attributes SF82E std ,x++ ; blank a character pshs a ; save character lda H.CURSX ; get horizontal position inca ; bump it sta H.CURSX ; save new position cmpa H.COLUMN ; edge of screen? puls a ; restore character blo SF82E ; brif not end of line yet stx H.CRSLOC ; save cursor location clr H.CURSX ; reset to left edge inc H.CURSY ; bump row lda #0x20 ; space character ldb H.CRSATT ; get attributes orb #0x40 ; turn on underline std ,x ; put a cursor on screen puls a,b,pc ; restore registers and return SF854 pshs a,b ; save registers ldx #HRESSCRN ; point to start of screen lda H.COLUMN ; get screen width cmpa #40 ; is it 40 columns? bne SF86E ; brif not - do 80 column scroll SF860 ldd 2*40,x ; get character cell from one line down std ,x++ ; move it here cmpx #HRESSCRN+(ROWMAX-1)*40*2 ; at start of last row? blo SF860 ; brif not SF86A bsr SF87B ; fill last row with spaces puls a,b,pc ; restore registers and return SF86E ldd 80*2,x ; get a character cell from next row std ,x++ ; put it here cmpx #HRESSCRN+(ROWMAX-1)*80*2 ; at start of last row? blo SF86E ; brif not bra SF86A ; blank out last row and finish up SF87B clr H.CURSX ; reset column to 0 lda #ROWMAX-1 ; reset row number to bottom of screen sta H.CURSY lda #0x20 ; get space character ldb H.CRSATT ; get attributes pshs x ; save pointer to start of row SF88A std ,x++ ; blank a character cmpx H.DISPEN ; at end of screen? bne SF88A ; brif not clr H.CURSX ; reset horizontal position to margin puls x ; get start of line pointer lda #0x20 ; space haracter ldb H.CRSATT ; get attributes orb #0x40 ; turn on underline std ,x ; put a bleeping cursor at start of line stx H.CRSLOC ; set cursor position rts ; Conditional newline patch. Note that this maps and unmaps the text screen in 40/80 column mode ; but that is completely unneeded to just test the X coordinate. ALINK26 tst DEVNUM ; is it screen? bne SF8AB ; brif not tst HRWIDTH ; VDG screen? bne SF8B1 ; brif not SF8AB jsr LA35F ; set up print parameters jmp LB95F ; re-enter mainline code SF8B1 lbsr SF772 ; map screen tst H.CURSX ; at left margin? pshs cc ; save Z flag lbsr SF778 ; unmap screen puls cc ; get back Z flag lbne LB958 ; brif not at left margine - do CR rts ; PRINT @ patch ALINK25 tst HRWIDTH ; VDG screen? bne SF8CD ; brif not - raise error jsr LA554 ; move cursor to specified position jmp LB905 ; return to mainline code SF8CD ldb #39*2 ; code for HP error jmp LAC46 ; raise error ; LOCATE command ; The parameter checking here could simply use the H.COLUMN and H.ROW variables and it would ; be loads simpler. Also, if the dumbassery with the cursor wasn't a thing, this routine wouldn't ; need to mess with mapping the screen or screwing around with the cursor. LOCATE ldb HRWIDTH ; is it 40/80 column screen? lbrn 0 beq SF8CD ; brif not - raise error pshs b ; save screen mode jsr SE7B2 ; evaluate coordinates lda BINVAL+1 ; get X coordinate puls b ; get back screen mode cmpb #1 ; is it 40 column screen? bne SF8EB ; brif not cmpa #40 ; in range for 40 columns? bra SF8ED SF8EB cmpa #80 ; in range for 80 columns? SF8ED lbhs LB44A ; brif not - raise error ldb VERBEG+1 ; get Y coordinate cmpb #ROWMAX ; is it in range? bhs SF8ED ; brif not - raise error pshs d ; save new coordinates lbsr SF772 ; map screen std H.CURSX ; set screen coordinates ldx H.CRSLOC ; get pointer to old position lda H.CRSATT ; replace attributes with current ones sta 1,x lda H.COLUMN ; get number of columns (why not use this above?) asla ; two bytes per character cell mul ; now D is offset to start of row ldx #HRESSCRN ; get start of screen leax d,x ; now X points to the start of the line puls a,b ; get back column and row numbers asla ; two bytes per character cell tfr a,b ; need this in B since we'll overflow singed 8 bits abx ; offset to correct cursor position lda H.CRSATT ; get attributes ora #0x40 ; enable underline sta 1,x ; enable cursor stx H.CRSLOC ; save new cursor pointer lbsr SF778 ; unmap screen rts ; HSTAT command HSTAT tst HRWIDTH ; is it 40/80 column screen? lbrn 0 beq SF8CD ; brif not - raise error lbsr SF772 ; map the screen ldx H.CRSLOC ; get cursor pointer ldd ,x ; get character and attributes std VCB ; save them ldd H.CURSX ; get screen coordinates std VCD ; save them lbsr SF778 ; unmap screen jsr LB357 ; evaluate variable for character stx VARDES ; saveit jsr SYNCOMMA ; insist on a comma ldb #1 ; make a single character string jsr LB56D lda VCB ; get character on screen jsr LB511 ; get string details sta ,x ; save character in string jsr LB54C ; put string on string stack ldx VARDES ; point to variable descriptor tst -1,x ; is it a string? (should have checked after evaluating instead) lbpl LB151 ; do type mismatch if number ldy FPA0+2 ; point to destination string descriptor ldb #5 ; copy 5 bytes from newly created string into variable SF963 lda ,y+ ; copy byte sta ,x+ decb ; done all? bne SF963 ; brif not LDX TEMPPT ; point to new string descriptor leax -5,x ; BUG: should just call LB675 to remove string from string stack stx TEMPPT jsr LB357 ; evaluate a variable (for X coord) stx VARDES ; save pointer to it jsr SYNCOMMA ; insist on a comma after it clra ; zero extend attributes ldb VCB+1 ; get attribute byte jsr GIVABF ; convert to float ldx VARDES ; point to variable tst -1,x ; test if numeric (should have tested VALTYP above) lbmi LB151 ; TM error if not number jsr LBC35 ; pack FPA0 to variable jsr LB357 ; evaluate another variable stx VARDES ; save it jsr SYNCOMMA ; insist on a comma clra ; zero extend the X coordinate ldb VCD ; get X coordinate jsr GIVABF ; turn into a FP number ldx VARDES ; get variable tst -1,x ; is it a number (should have tested VALTYP above) LBMI LB151 ; brif not - TM error jsr LBC35 ; pack FPA0 to variable jsr LB357 ; evaluate another variable stx VARDES ; save it clra ; zero extend Y coordinate ldb VCD+1 ; get Y coordinate jsr GIVABF ; turn into a FP number ldx VARDES ; get variable descriptor back tst -1,x ; is it a number (should have tested VALTYP above) lbmi LB151 ; brif not - TM error jsr LBC35 ; pack FPA0 to variable rts ; ATTR command ATTR jsr EVALEXPB ; evaluate foreground colour lbrn 0 cmpb #8 ; there are 8 valid colours (0-7) lbhs LB44A ; brif out of range - raise error aslb ; shift over to bits 5,4,3 aslb aslb pshs b ; save partial attribute byte jsr GETCCH ; fetch current character (useless call) jsr SYNCOMMA ; insist on comma jsr EVALEXPB ; evaluate background colour cmpb #8 ; is it valid (0-7)? lbhs LB44A ; brif not - raise error orb ,s ; merge with partial attribute byte leas 1,s ; clean up stack (could use ,s+ above) andb #0x3f ; make sure we have zeros in bit 7,6 - unneeded pshs b ; save colour attributes jsr GETCCH ; is there mode? SF9E3 beq SFA06 ; brif no more flags jsr SYNCOMMA ; insist on a comma cmpa #'B ; B (blink)? bne SF9F6 ; brif not puls b ; set blink bit in accumulated attributes orb #0x80 pshs b jsr GETNCH ; eat the flag bra SF9E3 ; look for another flag SF9F6 cmpa #'U ; U (underline)? lbne LB44A ; invalid flag - raise error puls b ; get accumulated attributes and set underline bit orb #0x40 pshs b jsr GETNCH ; eat the flag bra SF9E3 ; look for another flag SFA06 puls b ; get new attributes stb H.CRSATT ; set them as default rts fcb 0x00,0x00,0x00,0x00 ; unused bytes ; These are extra glyphs that should be part of the HPRINT font but aren't. fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 ; Ç fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 ; ü fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; é fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 ; â fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ä fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 ; à fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 ; ȧ (or å maybe?) fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 ; ç fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 ; ê fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 ; ë fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 ; è fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 ; ï fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 ; î fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 ; ẞ fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ä fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 ; Ȧ (or Å maybe?) fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 ; ó fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 ; æ fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 ; Æ fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 ; ô fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 ; ö fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 ; ø fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 ; û fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 ; ù fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 ; Ø fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 ; Ö fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 ; Ü fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 ; § fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 ; £ fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 ; ± fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 ; ° fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 ; ſ (long s) ; These are some extra symbol glyphs fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 ; solid right pointing triangle fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; solid left pointing triangle fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00 ; solid down pointing triangle fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00 ; solid up pointing triangle fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00 ; three horizontal lines with middle one double thick fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00 ; solid square on top left of open square fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00 ; solid box inside larger box fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00 ; thick equals sign fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00 ; solid vertical rectangle fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00 ; solid horizontal rectangle fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00 ; hour glass fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00 ; left end three horizontal lines with middle one double thick fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00 ; right end three horizontal lines with middle one double thick ; The above 45 glyphs are duplicated below fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 fcb 0x00,0x00,0x00,0x7E,0x3C,0x18,0x00,0x00 fcb 0x00,0x00,0x18,0x3C,0x7E,0x00,0x00,0x00 fcb 0x00,0xFF,0x00,0xFF,0xFF,0x00,0xFF,0x00 fcb 0x00,0x00,0x30,0x3C,0x14,0x1C,0x00,0x00 fcb 0x00,0x7E,0x42,0x5A,0x5A,0x42,0x7E,0x00 fcb 0x00,0x7E,0x7E,0x00,0x00,0x7E,0x7E,0x00 fcb 0x00,0x3C,0x3C,0x3C,0x3C,0x3C,0x3C,0x00 fcb 0x00,0x00,0x7E,0x7E,0x7E,0x7E,0x00,0x00 fcb 0x00,0x7E,0x24,0x18,0x18,0x24,0x7E,0x00 fcb 0x00,0x7F,0x00,0x7F,0x7F,0x00,0x7F,0x00 fcb 0x00,0xFE,0x00,0xFE,0xFE,0x00,0xFE,0x00 ; The glyphs above repeat one more time here but the set is incomplete fcb 0x38,0x44,0x40,0x40,0x40,0x44,0x38,0x10 fcb 0x44,0x00,0x44,0x44,0x44,0x4C,0x34,0x00 fcb 0x08,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x10,0x28,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x28,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x20,0x10,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x10,0x00,0x38,0x04,0x3C,0x44,0x3C,0x00 fcb 0x00,0x00,0x38,0x44,0x40,0x44,0x38,0x10 fcb 0x10,0x28,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x28,0x00,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x20,0x10,0x38,0x44,0x7C,0x40,0x38,0x00 fcb 0x28,0x00,0x30,0x10,0x10,0x10,0x38,0x00 fcb 0x10,0x28,0x00,0x30,0x10,0x10,0x38,0x00 fcb 0x00,0x18,0x24,0x38,0x24,0x24,0x38,0x40 fcb 0x44,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 fcb 0x10,0x10,0x28,0x44,0x7C,0x44,0x44,0x00 fcb 0x08,0x10,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x00,0x00,0x68,0x14,0x3C,0x50,0x3C,0x00 fcb 0x3C,0x50,0x50,0x78,0x50,0x50,0x5C,0x00 fcb 0x10,0x28,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x28,0x00,0x38,0x44,0x44,0x44,0x38,0x00 fcb 0x00,0x00,0x38,0x4C,0x54,0x64,0x38,0x00 fcb 0x10,0x28,0x00,0x44,0x44,0x4C,0x34,0x00 fcb 0x20,0x10,0x44,0x44,0x44,0x4C,0x34,0x00 fcb 0x38,0x4C,0x54,0x54,0x54,0x64,0x38,0x00 fcb 0x44,0x38,0x44,0x44,0x44,0x44,0x38,0x00 fcb 0x28,0x44,0x44,0x44,0x44,0x44,0x38,0x00 fcb 0x38,0x40,0x38,0x44,0x38,0x04,0x38,0x00 fcb 0x08,0x14,0x10,0x38,0x10,0x50,0x3C,0x00 fcb 0x10,0x10,0x7C,0x10,0x10,0x00,0x7C,0x00 fcb 0x10,0x28,0x10,0x00,0x00,0x00,0x00,0x00 fcb 0x08,0x14,0x10,0x38,0x10,0x10,0x20,0x40 fcb 0x00,0x10,0x18,0x1C,0x1C,0x18,0x10,0x00 fcb 0x00,0x08,0x18,0x38,0x38,0x18,0x08,0x00 ; final duplicated glyph: left pointing solid triangle fcb 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 ; junk unused (or blank space) fcb 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF ; junk unused (or solid block) ; This is where the constant page (FExx) would start. It's just garbage in the ROM. fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 ; This is where the I/O page would start. It's just garbage in the ROM until the interrupt vectors. fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 fill 0x00,8 fill 0xff,8 ; These are the actual CPU interrupt vectors fdb 0x0000 ; would be the 6309 illegal instruction trap fdb INT.SWI3 ; SWI3 bounce vector address fdb INT.SWI2 ; SWI2 bounce vector address fdb INT.FIRQ ; FIRQ bounce vector address fdb INT.IRQ ; IRQ bounce vector address fdb INT.SWI ; SWI bounce vector address fdb INT.NMI ; NMI bounce vector address fdb L8C1B ; this is where execution starts on RESET or power on