view exbas10.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
; These are the entry points in the Color Basic ROM which are used the the Extended Basic ROM.
; They are included here in order to keep the Extended Basic ROM separate from the Color Basic
; ROM.
BAWMST EQU 0xA0E8
CLOAD EQU 0xA498
CSAVE EQU 0xA44C
DATA EQU 0xAEE0
EVALEXPB EQU 0xB70B
GIVABF EQU 0xB4F4
INT EQU 0xBCEE
LA0E2 EQU 0xA0E2
LA171 EQU 0xA171
LA176 EQU 0xA176
LA35F EQU 0xA35F
LA3ED EQU 0xA3ED
LA406 EQU 0xA406
LA429 EQU 0xA429
LA42D EQU 0xA42D
LA444 EQU 0xA444
LA491 EQU 0xA491
LA505 EQU 0xA505
LA578 EQU 0xA578
LA59A EQU 0xA59A
LA5A5 EQU 0xA5A5
LA5AE EQU 0xA5AE
LA5C7 EQU 0xA5C7
LA5E4 EQU 0xA5E4
LA616 EQU 0xA616
LA619 EQU 0xA619
LA635 EQU 0xA635
LA644 EQU 0xA644
LA648 EQU 0xA648
LA65F EQU 0xA65F
LA7E9 EQU 0xA7E9
LA974 EQU 0xA974
LA976 EQU 0xA976
LA9A2 EQU 0xA9A2
LA9BB EQU 0xA9BB
LAC1E EQU 0xAC1E
LAC33 EQU 0xAC33
LAC46 EQU 0xAC46
LAC60 EQU 0xAC60
LAC73 EQU 0xAC73
LAC7C EQU 0xAC7C
LAC9D EQU 0xAC9D
LACA8 EQU 0xACA8
LACEF EQU 0xACEF
LACF1 EQU 0xACF1
LAD01 EQU 0xAD01
LAD19 EQU 0xAD19
LAD21 EQU 0xAD21
LAD26 EQU 0xAD26
LAD33 EQU 0xAD33
LAD9E EQU 0xAD9E
LADC6 EQU 0xADC6
LADD4 EQU 0xADD4
LADEB EQU 0xADEB
LAE15 EQU 0xAE15
LAED2 EQU 0xAED2
LAF67 EQU 0xAF67
LAFA4 EQU 0xAFA4
LB035 EQU 0xB035
LB141 EQU 0xB141
LB143 EQU 0xB143
LB146 EQU 0xB146
LB156 EQU 0xB156
LB158 EQU 0xB158
LB244 EQU 0xB244
LB262 EQU 0xB262
LB267 EQU 0xB267
LB26A EQU 0xB26A
LB26F EQU 0xB26F
LB277 EQU 0xB277
LB284 EQU 0xB284
LB2CE EQU 0xB2CE
LB357 EQU 0xB357
LB35C EQU 0xB35C
LB3A2 EQU 0xB3A2
LB44A EQU 0xB44A
LB4F3 EQU 0xB4F3
LB50F EQU 0xB50F
LB518 EQU 0xB518
LB51A EQU 0xB51A
LB56D EQU 0xB56D
LB643 EQU 0xB643
LB654 EQU 0xB654
LB657 EQU 0xB657
LB659 EQU 0xB659
LB69B EQU 0xB69B
LB6A4 EQU 0xB6A4
LB6AD EQU 0xB6AD
LB70E EQU 0xB70E
LB734 EQU 0xB734
LB738 EQU 0xB738
LB73D EQU 0xB73D
LB740 EQU 0xB740
LB7C2 EQU 0xB7C2
LB958 EQU 0xB958
LB95C EQU 0xB95C
LB99F EQU 0xB99F
LB9AC EQU 0xB9AC
LB9AF EQU 0xB9AF
LB9B4 EQU 0xB9B4
LB9B9 EQU 0xB9B9
LB9C2 EQU 0xB9C2
LBA1C EQU 0xBA1C
LBA3A EQU 0xBA3A
LBA92 EQU 0xBA92
LBAC5 EQU 0xBAC5
LBACA EQU 0xBACA
LBB48 EQU 0xBB48
LBB5C EQU 0xBB5C
LBB6A EQU 0xBB6A
LBB82 EQU 0xBB82
LBB8F EQU 0xBB8F
LBC14 EQU 0xBC14
LBC2F EQU 0xBC2F
LBC35 EQU 0xBC35
LBC4C EQU 0xBC4C
LBC5F EQU 0xBC5F
LBC6D EQU 0xBC6D
LBCA0 EQU 0xBCA0
LBCC8 EQU 0xBCC8
LBD99 EQU 0xBD99
LBDB6 EQU 0xBDB6
LBDBB EQU 0xBDBB
LBDC0 EQU 0xBDC0
LBDC5 EQU 0xBDC5
LBDCC EQU 0xBDCC
LBDD9 EQU 0xBDD9
LBEC0 EQU 0xBEC0
LBEC5 EQU 0xBEC5
LBEE9 EQU 0xBEE9
LBEF0 EQU 0xBEF0
LBEFF EQU 0xBEFF
LBFA6 EQU 0xBFA6
LET EQU 0xAF89
PUTCHR EQU 0xA282
SIN EQU 0xBF78
SNDBLK EQU 0xA7F4
STRINOUT EQU 0xB99C
SYNCOMMA EQU 0xB26D
WRLDR EQU 0xA7D8
                *pragma list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXTENDED COLOR BASIC ROM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                org EXBAS
                fcc 'EX'                        ; magic number that Color Basic uses to identify the presence of Extended Basic
L8002           ldx #L80DE                      ; point to command interpretation table information
                ldu #COMVEC+10                  ; point to command interpretation table location
                ldb #10                         ; 10 bytes to move
                jsr LA59A                       ; copy command interpretation table
                ldx #LB277                      ; initialize Disk Basic's entries to error
                stx 3,u
                stx 8,u
                ldx #XIRQSV                     ; set up IRQ service routine
                stx IRQVEC+1
                ldx ZERO                        ; reset the TIMER value
                stx TIMVAL
                jsr XVEC18                      ; do a bunch of initialization
                ldd #0x2c05                     ; initialize DLOAD baud rate constant and timeout
                std DLBAUD
                ldx #USR0                       ; set up pointer to USR routine addresses
                stx USRADR
                ldu #LB44A                      ; set up USR routine addresses to "FC error"
                ldb #10                         ; there are 10 routines
L8031           stu ,x++                        ; set a routine to FC error
                decb                            ; done all?
                bne L8031                       ; brif not
                lda #0x7e                       ; op code of JMP extended (for RAM hook intialization)
                sta RVEC20                      ; command interpretation loop
                ldx #XVEC20
                stx RVEC20+1
                sta RVEC15                      ; expression evaluation
                ldx #XVEC15
                stx RVEC15+1
                sta RVEC19                      ; number parsing
                ldx #XVEC19
                stx RVEC19+1
                sta RVEC9                       ; PRINT
                ldx #XVEC9
                stx RVEC9+1
                sta RVEC17                      ; error handler
                ldx #XVEC17
                stx RVEC17+1
                sta RVEC4                       ; generic input
                ldx #XVEC4
                stx RVEC4+1
                sta RVEC3                       ; generic output
                ldx #XVEC3
                stx RVEC3+1
                sta RVEC8                       ; close file
                ldx #XVEC8
                stx RVEC8+1
                sta RVEC23                      ; tokenize line
                ldx #XVEC23
                stx RVEC23+1
                sta RVEC18                      ; RUN
                ldx #XVEC18
                stx RVEC18+1
                sta EXPJMP                      ; exponentiation
                ldx #L8489
                stx EXPJMP+1
                jsr L96E6                       ; initialize graphics stuff
                lda PIA0+3                      ; enable 60Hz interrupt
                ora #1
                sta PIA0+3
                ldx #'D*256+'K                  ; magic number for a Disk Basic ROM
                cmpx DOSBAS                     ; do we have a Disk Basic ROM?
                lbeq DOSBAS+2                   ; brif so - launch it
                andcc #0xaf                     ; enable interrupts
                ldx #L80E8-1                    ; show sign on message
                jsr STRINOUT
                ldx #XBWMST                     ; install warm start handler
                stx RSTVEC
                jmp LA0E2                       ; set up warm start flag and launch immediate mode
; Extended Basic warm start code
XBWMST          nop                             ; flag to mark routine as valid
                clr PLYTMR                      ; cancel any PLAY command in progress
                clr PLYTMR+1
                lda PIA0+3                      ; enable 60Hz interrupt
                ora #1
                sta PIA0+3
                jmp BAWMST                      ; let Color Basic's warm start process run
; This routine is dead code that is never used by any Basic ROMs.
L80D0           lda PIA1+2                      ; check memory size jump
                bita #2
                bne L80DA                       ; brif high
                sta SAMREG+29                   ; set SAM for 64K memory size
L80DA           jmp ,x                          ; jump to address in X
                fcb 0,0                         ; dead space
L80DE           fcb 25                          ; 25 Extended Basic commands
                fdb L8183                       ; reserved word table (commands)
                fdb L813C                       ; interpretation handler (commands)
                fcb 14                          ; 14 Extended Basic functions
                fdb L821E                       ; reserved word table (functions)
                fdb L8168                       ; function handler
L80E8           fcc 'EXTENDED COLOR BASIC 1.0'
                fcb 0x0d
                fcc 'COPYRIGHT (C) 1980 BY TANDY'
                fcb 0x0d
                fcc 'UNDER LICENSE FROM MICROSOFT'
                fcb 0x0d,0x0d,0x00
; Extended Basic command interpretation loop
L813C           cmpa #0xcb                      ; is it an Extended Basic command?
                bhi L8148                       ; brif not
                ldx #L81F0                      ; point to dispatch table
                suba #0xb5                      ; normalize the token number so 0 is the first entry
                jmp LADD4                       ; go transfer control to the command
L8148           cmpa #0xff                      ; is it a function token?
                beq L8154                       ; brif so - for MID$()=, TIMER=
                cmpa #0xcd                      ; is it a token for a keyword that isn't a command?
                bls L8165                       ; brif so - error for USING and FN
                jmp [COMVEC+23]                 ; transfer control to Disk Basic if it is present
L8154           jsr GETNCH                      ; get token after the function flag
                cmpa #0x90                      ; MID$?
                lbeq L86D6                      ; brif so (substring replacement)
                cmpa #0x9f                      ; TIMER?
                lbeq L8960                      ; brif so - TIMER setting
                jsr RVEC22                      ; do a RAM hook in case something wants to extend this
L8165           jmp LB277                       ; we have nothing valid here
; Function handler
L8168           cmpb #2*33                      ; is it a valid Extended Basic function?
                bls L8170                       ; brif so
                jmp [COMVEC+28]                 ; transfer control to Disk Basic if it is present
L8170           subb #2*20                      ; normalize Extended Basic functions to 0
                cmpb #2*8                       ; Above HEX$?
                bhi L817D                       ; brif so - we don't pre-evaluate an argument
                pshs b                          ; save token value
                jsr LB262                       ; evaluate the function parameter
                puls b                          ; get back token value
L817D           ldx #L8257                      ; point to dispatch table
                jmp LB2CE                       ; go transfer control to the function
; Reserved words (commands)
L8183           fcs 'DEL'                       ; 0xb5
                fcs 'EDIT'                      ; 0xb6
                fcs 'TRON'                      ; 0xb7
                fcs 'TROFF'                     ; 0xb8
                fcs 'DEF'                       ; 0xb9
                fcs 'LET'                       ; 0xba
                fcs 'LINE'                      ; 0xbb
                fcs 'PCLS'                      ; 0xbc
                fcs 'PSET'                      ; 0xbd
                fcs 'PRESET'                    ; 0xbe
                fcs 'SCREEN'                    ; 0xbf
                fcs 'PCLEAR'                    ; 0xc0
                fcs 'COLOR'                     ; 0xc1
                fcs 'CIRCLE'                    ; 0xc2
                fcs 'PAINT'                     ; 0xc3
                fcs 'GET'                       ; 0xc4
                fcs 'PUT'                       ; 0xc5
                fcs 'DRAW'                      ; 0xc6
                fcs 'PCOPY'                     ; 0xc7
                fcs 'PMODE'                     ; 0xc8
                fcs 'PLAY'                      ; 0xc9
                fcs 'DLOAD'                     ; 0xca
                fcs 'RENUM'                     ; 0xcb
                fcs 'FN'                        ; 0xcc
                fcs 'USING'                     ; 0xcd
; Dispatch table (commands)
L81F0           fdb DEL                         ; 0xb5 DEL
                fdb EDIT                        ; 0xb6 EDIT
                fdb TRON                        ; 0xb7 TRON
                fdb TROFF                       ; 0xb8 TROFF
                fdb DEF                         ; 0xb9 DEF
                fdb LET                         ; 0xba LET (note: implemented by Color Basic!)
                fdb LINE                        ; 0xbb LINE
                fdb PCLS                        ; 0xbc PCLS
                fdb PSET                        ; 0xbd PSET
                fdb PRESET                      ; 0xbe PRESET
                fdb SCREEN                      ; 0xbf SCREEN
                fdb PCLEAR                      ; 0xc0 PCLEAR
                fdb COLOR                       ; 0xc1 COLOR
                fdb CIRCLE                      ; 0xc2 CIRCLE
                fdb PAINT                       ; 0xc3 PAINT
                fdb GET                         ; 0xc4 GET
                fdb PUT                         ; 0xc5 PUT
                fdb DRAW                        ; 0xc6 DRAW
                fdb PCOPY                       ; 0xc7 PCOPY
                fdb PMODETOK                    ; 0xc8 PMODE
                fdb PLAY                        ; 0xc9 PLAY
                fdb DLOAD                       ; 0xca DLOAD
                fdb RENUM                       ; 0xcb RENUM
; Reserved words (functions)
L821E           fcs 'ATN'                       ; 0x94
                fcs 'COS'                       ; 0x95
                fcs 'TAN'                       ; 0x96
                fcs 'EXP'                       ; 0x97
                fcs 'FIX'                       ; 0x98
                fcs 'LOG'                       ; 0x99
                fcs 'POS'                       ; 0x9a
                fcs 'SQR'                       ; 0x9b
                fcs 'HEX$'                      ; 0x9c
                fcs 'VARPTR'                    ; 0x9d
                fcs 'INSTR'                     ; 0x9e
                fcs 'TIMER'                     ; 0x9f
                fcs 'PPOINT'                    ; 0xa0
                fcs 'STRING$'                   ; 0xa1
; Dispatch table (functions)
L8257           fdb ATN                         ; 0x94 ATN
                fdb COS                         ; 0x95 COS
                fdb TAN                         ; 0x96 TAN
                fdb EXP                         ; 0x97 EXP
                fdb FIX                         ; 0x98 FIX
                fdb LOG                         ; 0x99 LOG
                fdb POS                         ; 0x9a POS
                fdb SQR                         ; 0x9b SQR
                fdb HEXDOL                      ; 0x9c HEX$
                fdb VARPTRTOK                   ; 0x9d VARPTR
                fdb INSTR                       ; 0x9e INSTR
                fdb TIMER                       ; 0x9f TIMER
                fdb PPOINT                      ; 0xa0 PPOINT
                fdb STRING                      ; 0xa1 STRING$
; Generic output handler
XVEC3           tst DEVNUM                      ; screen?
                lbeq L95AC                      ; brif so - force text screen active
                pshs b                          ; save register
                ldb DEVNUM                      ; get output device
                cmpb #-3                        ; check for DLOAD
                puls b                          ; restore register
                bne L8285                       ; brif not DLOAD
                leas 2,s                        ; bail out of output handler if DLOAD
L8285           rts
; Close file handler. This corrects a bug in Color Basic 1.0 which didn't handle writing the
; end of file block correctly. That bug is fixed in Color Basic 1.1 so this isn't required
; if a recent enough version of Color Basic is installed.
XVEC8           lda DEVNUM                      ; get device number
                inca                            ; is it tape?
                bne L8285                       ; brif not - we aren't going to mess with it
                lda FILSTA                      ; get tape file status
                cmpa #2                         ; output file?
                bne L8285                       ; brif not
                lda CINCTR                      ; is there anything waiting to be written out?
                bne L8285                       ; brif so - mainline code will handle it properly
                clr DEVNUM                      ; reset output to screen
                leas 2,s                        ; don't return to mainline code
                jmp LA444                       ; write EOF block
; RUN handler - sets up some Extended Basic stuff to defaults at program start
XVEC18          ldd #0xba42                     ; initialize PLAY volume
                std VOLHI
                lda #2                          ; set PLAY tempo to 2, PLAY octave to 3
                sta TEMPO
                sta OCTAVE
                asla                            ; set default note length to 5
                sta NOTELN
                clr DOTVAL                      ; don't do any note length extension
                ldd ZERO                        ; initialize DRAW angle and scale to default 1
                std ANGLE
                ldb #128                        ; initialize horizontal and vertical default coordinates to the middle of the screen
                std HORDEF
                ldb #96
                std VERDEF
                rts
; Command interpretation loop handler; we need to intercept this to implement TRON/TROFF
XVEC20          leas 2,s                        ; don't return to the mainline code
L82BB           andcc #0xaf                     ; make sure interrupts are running
                jsr LADEB                       ; do a BREAK/pause check
                ldx CHARAD                      ; save input pointer
                stx TINPTR
                lda ,x+                         ; get current input character
                beq L82CF                       ; brif end of line
                cmpa #':                        ; statement separator?
                beq L82F1                       ; brif so
                jmp LB277                       ; raise error we got here with extra junk
L82CF           lda ,x++                        ; get first byte of next line address
                sta ENDFLG                      ; use it to set "END" flag to "END"
                bne L82D8                       ; brif not end of program
                jmp LAE15                       ; go do the "END"
L82D8           ldd ,x+                         ; get line number of next line (and leave pointer one before line text)
                std CURLIN                      ; set current line number
                stx CHARAD                      ; save input pointer
                lda TRCFLG                      ; are we tracing?
                beq L82F1                       ; brif not
                lda #'[                         ; show opening marker for TRON line number
                jsr PUTCHR
                lda CURLIN                      ; restore MSB of line number
                jsr LBDCC                       ; show line number
                lda #']                         ; show closing marker for TRON line number
                jsr PUTCHR
L82F1           jsr GETNCH                      ; get the start of the statement
                tfr cc,b                        ; save status flags
                cmpa #0x98                      ; is it CSAVE?
                beq L8316                       ; brif so - go to Extended Basic patch (adds CSAVEM)
                cmpa #0x97                      ; is it CLOAD?
                beq L8311                       ; brif so - go to Extended Basic patch (adds multi-origin binaries)
                tfr b,cc                        ; restore character status
                jsr LADC6                       ; go process command
                bra L82BB                       ; restart interpretation loop
; Tokenizaton handler. This is actually a hack to intercept CLOAD and CSAVE during immediate mode by causing the
; tokenization routine to return to the interpretation loop above instead of the mainline interpretation loop. This
; is necessary because the first command encountered on a line in immediate mode is executed BEFORE the interpretation
; loop RAM hook is called. This patch doesn't actually affect tokenization itself at all.
XVEC23          ldx 2,s                         ; get return address of caller to the tokenizer
                cmpx #LAC9D                     ; is it coming from immediate mode prior to executing the line?
                bne L8310                       ; brif not
                ldx #L82F1                      ; force return to Extended Basic's main loop patch above
                stx 2,s
L8310           rts
; These two patches are set up this way so that control can be transferred back to the original Color Basic
; implementations if the Extended Basic addons are not triggered.
L8311           jsr L8C62                       ; transfer control to Extended Basic's CLOAD handler
                bra L82BB                       ; go do another command
L8316           bsr L831A                       ; go do Extended Basic's CSAVE handler
                bra L82BB                       ; go do another command
; Extended Basic's CSAVE handler which implements CSAVEM (which Color Basic does not have)
L831A           jsr GETNCH                      ; get character after CSAVE
                cmpa #'M                        ; is it CSAVEM?
                lbne CSAVE                      ; brif not - Color Basic can handle this
                jsr GETNCH                      ; eat the "M"
                jsr LA578                       ; parse file name
                bsr L836C                       ; get start address
                stx CASBUF+13                   ; save it in file header
                bsr L836C                       ; get end address
                cmpx 2,s                        ; compare to start address
                lblo LB44A                      ; brif end address is before the start address
                bsr L836C                       ; get execution address
                stx CASBUF+11                   ; put in file header
                jsr GETCCH                      ; are we at the end of the commmand?
                bne L8310                       ; brif not
                lda #2                          ; file type to machine language
                ldx ZERO                        ; set to binary and single block
                jsr LA65F                       ; write header
                clr FILSTA                      ; mark any open tape file closed
                inc BLKTYP                      ; set block type to data
                jsr WRLDR                       ; write a data leader
                ldx 4,s                         ; get starting address
L834D           stx CBUFAD                      ; set start of data address
                lda #255                        ; try a full length block by default
                sta BLKLEN
                ldd 2,s                         ; get ending address
                subd CBUFAD                     ; see how much is left
                bhs L835E                       ; brif we have more to write
                leas 6,s                        ; clean up stack
                jmp LA491                       ; write EOF block
L835E           cmpd #255                       ; do we have a full block left?
                bhs L8367                       ; brif so
                incb                            ; set block size to remainder
                stb BLKLEN
L8367           jsr SNDBLK                      ; write a data block
                bra L834D                       ; go see if we have more to write
L836C           jsr SYNCOMMA                    ; make sure we have a comma
                jsr LB73D                       ; evaluate unsigned expression to X
                ldu ,s                          ; get return address
                stx ,s                          ; save result on stack
                tfr u,pc                        ; return to caller
; COS function
COS             ldx #L83AB                      ; point to PI/2 constant
                jsr LB9C2                       ; add to argument ( cos(x) = sin((pi/2)+x) )
L837E           jmp SIN                         ; now calculate sin((pi/2)+x)
; TAN function. This is determined by the identity TAN(X) = SIN(X)/COS(X)
TAN             jsr LBC2F                       ; save FPA0 in FPA3
                clr RELFLG                      ; reset quadrant flag
                bsr L837E                       ; calculate SIN(x)
                ldx #V4A                        ; save result in FPA5
                jsr LBC35
                ldx #V40                        ; get back original argument
                jsr LBC14
                clr FP0SGN                      ; force result positive
                lda RELFLG                      ; get quadrant flag
                bsr L83A6                       ; calculate COS(x)
                tst FP0EXP                      ; did we get 0 for COS(x)
                lbeq LBA92                      ; brif so - overflow
                ldx #V4A                        ; point to sin(x)
L83A3           jmp LBB8F                       ; divide the sin(x) value by the cos(x) value
L83A6           pshs a                          ; save sign flag
                jmp LBFA6                       ; expand polynomial
L83AB           fcb 0x81,0x49,0x0f,0xda,0xa2    ; pi/2 constant
; ATN function (inverse tangent). There are two calculation streams used to improve precision.
; One if the parameter is >= 1.0 and the other if it is < 1.0
ATN             lda FP0SGN                      ; get sign of argument
                pshs a                          ; save it
                bpl L83B8                       ; brif positive
                bsr L83DC                       ; flip sign of argument
L83B8           lda FP0EXP                      ; get exponent
                pshs a                          ; save it
                cmpa #0x81                      ; exponent for 1.0
                blo L83C5                       ; brif less - value is less than 1.0
                ldx #LBAC5                      ; point to FP constant 1.0
                bsr L83A3                       ; calculate reciprocal
L83C5           ldx #L83E0                      ; point to polynomical coefficients
                jsr LBEF0                       ; expand polynomial
                puls a                          ; get exponent of argument
                cmpa #0x81                      ; did we do a reciprocal calculation?
                blo L83D7                       ; brif not
                ldx #L83AB                      ; subtract result from pi/2 if we did
                jsr LB9B9
L83D7           puls a                          ; get sign of original
                tsta                            ; was it positive?
                bpl L83DF                       ; brif so
L83DC           jmp LBEE9                       ; flip sign of result
L83DF           rts
; Chebyshev modified taylor series coefficients for inverse tangent. Note that these diverge quite significantly
; from the standard taylor series after 1/9. The standard coefficients are 1/1,-1/3, 1/5, -1/7, 1/9, -1/11, and
; so on. These modified coefficients yield reasonable accuracy for the precision available, presumably with
; fewer coefficients.
L83E0           fcb 11                          ; 12 coefficients
                fcb 0x76,0xb3,0x83,0xbd,0xd3    ; -0.000684793912
                fcb 0x79,0x1e,0xf4,0xa6,0xf5    ; 0.00485094216
                fcb 0x7b,0x83,0xfc,0xb0,0x10    ; -0.0161117018
                fcb 0x7c,0x0c,0x1f,0x67,0xca    ; 0.0342096381
                fcb 0x7c,0xde,0x53,0xcb,0xc1    ; -0.0542791328
                fcb 0x7d,0x14,0x64,0x70,0x4c    ; 0.0724571965 
                fcb 0x7d,0xb7,0xea,0x51,0x7a    ; -0.0898023954
                fcb 0x7d,0x63,0x30,0x88,0x7e    ; 0.110932413
                fcb 0x7e,0x92,0x44,0x99,0x3a    ; -0.142839808
                fcb 0x7e,0x4c,0xcc,0x91,0xc7    ; 0.199999121
                fcb 0x7f,0xaa,0xaa,0xaa,0x13    ; -0.333333316
                fcb 0x81,0x00,0x00,0x00,0x00    ; 1.0
; Chebyshev modified taylor series coefficients for the ln(x)/ln(2) (base 2 log of x)
L841D           fcb 3                           ; four coefficients
                fcb 0x7f,0x5e,0x56,0xcb,0x79    ; 0.434255942 from (2/7)/ln(2)
                fcb 0x80,0x13,0x9b,0x0b,0x64    ; 0.576584541 from (2/5)/ln(2)
                fcb 0x80,0x76,0x38,0x93,0x16    ; 0.961800759 from (2/3)/ln(2) 
                fcb 0x82,0x38,0xaa,0x3b,0x20    ; 2.88539007 from 2/ln(2)
L8432           fcb 0x80,0x35,0x04,0xf3,0x34    ; 1/sqrt(2)
L8437           fcb 0x81,0x35,0x04,0xf3,0x34    ; sqrt(2)
L843C           fcb 0x80,0x80,0x00,0x00,0x00    ; -0.5
L8441           fcb 0x80,0x31,0x72,0x17,0xf8    ; ln(2)
; LOG function (natural log, ln)
; FP representation is of the form A*2^B. Thus, the log routine determines the value of
; ln(A*2^B).
;
; ln(A*2^B) = ln(A) + ln(2^B) = ln(A) + B*ln(2) = (ln(A)/ln(2) + B)*ln(2), OR:
; (log2(A) + B)*ln(2)
; Now if we write A as A*(sqrt(2)/sqrt(2)), we haven't changed anything so:
; (log2(A*sqrt(2)/sqrt(2)) + B)*ln(2) = (log2(A*sqrt(2)) - log2(sqrt(2)) + B) * ln(2)
; which gives: (-1/2 + log2(A*sqrt(2)) + B) * ln(2)
;
; Everything except log2(A*sqrt(2)) is either constant or trivial.
;
; What the actual code below feeds into the modified taylor series is actually:
; 1 - (sqrt(2)/(A + sqrt(2)) which algebra reveals to be (A*sqrt(2)-1)/(A*sqrt(2)+1)
;
; Thus, the code is using (A*sqrt(2)-1)/(A*sqrt(2)+1) instead of A*sqrt(2) as one would
; expect from the identities. However, the modified coefficients in the series above
; could be correcting for that or the introduced error was deemed acceptable.
; NOTE: this routine does NOT return 0 for LOG(1)
LOG             jsr LBC6D                       ; get status of FPA0
                lble LB44A                      ; brif <= 0 - logarithms don't exist in that case
                ldx #L8432                      ; point to 1/sqrt(2)
                lda FP0EXP                      ; get exponent of argument
                suba #0x80                      ; remove bias
                pshs a                          ; save it for later
                lda #0x80                       ; force exponent to 0 (this turns FPA0 into A in the above description)
                sta FP0EXP
                jsr LB9C2                       ; add 1/sqrt(2) to A
                ldx #L8437                      ; point to sqrt(2)
                jsr LBB8F                       ; divide that by FPA0
                ldx #LBAC5                      ; point to 1.0
                jsr LB9B9                       ; subtract result from 1.0: Now FPA0 is 1-(sqrt(2)/(A+1/sqrt(2)))
                ldx #L841D                      ; point to coefficients
                jsr LBEF0                       ; expand polynomial (calculate base 2 log of modified argument)
                ldx #L843C                      ; point to -0.5
                jsr LB9C2                       ; add result
                puls b                          ; get original exponent back
                jsr LBD99                       ; add B to FPA0
                ldx #L8441                      ; point to ln(2)
                jmp LBACA                       ; multiply by ln(2) which gives us the result in base e
; SQR function (square root) - returns the principle root (positive)
SQR             jsr LBC5F                       ; move argument to FPA1 (first argument for exponentiation)
                ldx #LBEC0                      ; point to 0.5 (exponent for square root)
                jsr LBC14                       ; set up second argument to exponentiation (the exponent)
; Exponentiation operator
; This is calculated as A^x = e^(x*ln(A)) where A is in FPA1 and x is in FPA0
L8489           beq EXP                         ; do "EXP" if exponent is 0 (this will catch 0^0)
                tsta                            ; check that the base is not 0
                bne L8491                       ; brif base is not 0
                jmp LBA3A                       ; 0^(nonzero) is 0
L8491           ldx #V4A                        ; save exponent (to FPA5)
                jsr LBC35
                clrb                            ; result sign will default to positive
                lda FP1SGN                      ; check if base is positive
                bpl L84AC                       ; brif so
                jsr INT                         ; convert exponent to integer
                ldx #V4A                        ; point to original expoent
                lda FP1SGN                      ; get sign of FPA1
                jsr LBCA0                       ; compare original exponent with truncated one
                bne L84AC                       ; brif not equal
                coma                            ; flip sign
                ldb CHARAC                      ; get LS byte of integer exponent (result sign flag)
L84AC           jsr LBC4C                       ; copy FPA1 (base) to FPA0 (A = sign)
                pshs b                          ; save result sign
                jsr LOG                         ; get natural log of the base
                ldx #V4A                        ; multiply the log by the exponent
                jsr LBACA
                bsr EXP                         ; now raise e to the resulting power
                puls a                          ; get result sign
                rora                            ; brif it was negative
                lbcs LBEE9                      ; brif negative - flip sign
                rts
L84C4           fcb 0x81,0x38,0xaa,0x3b,0x29    ; 1.44269504 (correction factor for exponential function)
; Chebyshev modified taylor series coefficients for e^x
L84C9           fcb 7                           ; eight coefficients
                fcb 0x71,0x34,0x58,0x3e,0x56    ; 1/(7!*(CF^7))
                fcb 0x74,0x16,0x7e,0xb3,0x1b    ; 1/(6!*(CF^6))
                fcb 0x77,0x2f,0xee,0xe3,0x85    ; 1/(5!*(CF^5))
                fcb 0x7a,0x1d,0x84,0x1c,0x2a    ; 1/(4!*(CF^4))
                fcb 0x7c,0x63,0x59,0x58,0x0a    ; 1/(3!*(CF^3))
                fcb 0x7e,0x75,0xfd,0xe7,0xc6    ; 1/(2!*(CF^2))
                fcb 0x80,0x31,0x72,0x18,0x10    ; 1/(1!*(CF^1))
                fcb 0x81,0x00,0x00,0x00,0x00    ; 1
; EXP function (e^x)
EXP             ldx #L84C4                      ; point to correction factor
                jsr LBACA                       ; multiply it
                jsr LBC2F                       ; save corrected argument to FPA3
                lda FP0EXP                      ; get exponent of FPA0
                cmpa #0x88                      ; is it too big?
                blo L8504                       ; brif not
L8501           jmp LBB5C                       ; to 0 (underflow) or overflow error
L8504           jsr INT                         ; convert argument to an integer
                lda CHARAC                      ; get ls byte of integer
                adda #0x81                      ; was argument 127? if so, the OV error; adds bias
                beq L8501
                deca                            ; adjust for the extra +1 above
                pshs a                          ; save integer exponent
                ldx #V40                        ; get fractional part of argument
                jsr LB9B9
                ldx #L84C9                      ; point to coefficients
                jsr LBEFF                       ; evaluate polynomial on the fractional part
                clr RESSGN                      ; force result to be positive
                puls a                          ; get back original exponent
                jsr LBB48                       ; add original exponent to the fractional result
                rts
; FIX function (truncate/round toward 0) (NOTE: INT() always rounds down so INT(-0.5) gives -1 but FIX(-0.5) gives 0)
FIX             jsr LBC6D                       ; get status of argument
                bmi L852C                       ; brif negative
L8529           jmp INT                         ; do regular "int" if positive
L852C           com FP0SGN                      ; flip the sign
                bsr L8529                       ; do "INT" on this
                jmp LBEE9                       ; flip the sign back
; EDIT command
EDIT            jsr L89AE                       ; get line number
                leas 2,s                        ; we're not going to return to the main loop
L8538           lda #1                          ; "LIST" flag
                sta VD8                         ; set to list the line
                jsr LAD01                       ; find line number
                lbcs LAED2                      ; brif line wasn't found
                jsr LB7C2                       ; go unpack the line into the buffer
                tfr y,d                         ; calculate the actual length of the line
                subd #LINBUF+2
                stb VD7                         ; save line length (it will only be 8 bits)
L854D           ldd BINVAL                      ; get the line number
                jsr LBDCC                       ; display it
                jsr LB9AC                       ; put a space after it
                ldx #LINBUF+1                   ; point to iput uffer
                ldb VD8                         ; are we listing?
                bne L8581                       ; brif so
L855C           clrb                            ; reset digit accumulator
L855D           jsr L8687                       ; get a keypress
                jsr L90AA                       ; set carry if not numeric
                bcs L8570                       ; brif not a number
                suba #'0                        ; remove ASCII bias
                pshs a                          ; save digit value
                lda #10                         ; multiply accumulator by 10
                mul
                addb ,s+                        ; add in new digit
                bra L855D                       ; go check for another digit
L8570           subb #1                         ; this converts 0 to 1, but *only* 0 to 1
                adcb #1
                cmpa #'A                        ; abort?
                bne L857D                       ; brif not
                jsr LB958                       ; to a CR
                bra L8538                       ; restart EDIT process
L857D           cmpa #'L                        ; list?
                bne L858C                       ; brif not
L8581           bsr L85B4                       ; list the line
                clr VD8                         ; reset to "not listing"
                jsr LB958                       ; do a CR
                bra L854D                       ; start editing
L858A           leas 2,s                        ; lose return address
L858C           cmpa #0x0d                      ; ENTER?
                bne L859D                       ; brif not
                bsr L85B4                       ; echo out the line
L8592           jsr LB958                       ; do a CR
                ldx #LINBUF+1                   ; reset input pointer to start of buffer
                stx CHARAD
                jmp LACA8                       ; join immediate mode to replace the line in the program
L859D           cmpa #'E                        ; exit?
                beq L8592                       ; brif so - end edit with no echo
                cmpa #'Q                        ; quit?
                bne L85AB                       ; brif not
                jsr LB958                       ; do a CR
                jmp LAC73                       ; go to immediate mode with no fanfare - no changes saved
L85AB           bsr L85AF                       ; go do commands
                bra L855C                       ; go handle another command
L85AF           cmpa #0x20                      ; space?
                bne L85C3                       ; brif not
                skip2
L85B4           ldb #LBUFMX-1                   ; display up to a whole line
L85B6           lda ,x                          ; get buffer chracter
                beq L85C2                       ; brif end of line
                jsr PUTCHR                      ; output character
                leax 1,x                        ; move to next character
                decb                            ; done?
                bne L85B6                       ; brif not
L85C2           rts
L85C3           cmpa #'D                        ; delete?
                bne L860F                       ; brif not
L85C7           tst ,x                          ; end of line?
                beq L85C2                       ; brif so - can't delete
                bsr L85D1                       ; remove a character
                decb                            ; done all requested?
                bne L85C7                       ; brif not
                rts
L85D1           dec VD7                         ; account for character being removed
                leay -1,x                       ; set pointer and compensate for increment below
L85D5           leay 1,y                        ; move to next character
                lda 1,y                         ; get next character
                sta ,y                          ; move it forward
                bne L85D5                       ; brif we didn't hit the end of the buffer
                rts
L85DE           cmpa #'I                        ; insert?
                beq L85F5                       ; brif so
                cmpa #'X                        ; extend?
                beq L85F3                       ; brif so
                cmpa #'H                        ; "hack"?
                bne L8646                       ; brif not
                clr ,x                          ; mark current location as end of line
                tfr x,d                         ; calculate new line length
                subd #LINBUF+2
                stb VD7                         ; save new length
L85F3           bsr L85B4                       ; display the line
L85F5           jsr L8687                       ; read a character
                cmpa #0x0d                      ; ENTER?
                beq L858A                       ; brif so - terminate entry
                cmpa #0x1b                      ; ESC?
                beq L8625                       ; brif so - back to command mode
                cmpa #0x08                      ; backspace?
                bne L8626                       ; brif no
                cmpx #LINBUF+1                  ; are we at the start of the buffer?
                beq L85F5                       ; brif so - it's a no-op
                bsr L8650                       ; move pointer back one, do a BS
                bsr L85D1                       ; remove character from the buffer
                bra L85F5                       ; go handle more input
L860F           cmpa #'C                        ; change?
                bne L85DE                       ; brif not
L8613           tst ,x                          ; is there something to change?
                beq L8625                       ; brif not
                jsr L8687                       ; get a key stroke
                bcs L861E                       ; brif valid key
                bra L8613                       ; try again if invalid key
L861E           sta ,x+                         ; put new character in the buffer
                bsr L8659                       ; echo it
                decb                            ; changed number requested?
                bne L8613                       ; brif not
L8625           rts
L8626           ldb VD7                         ; get length of line
                cmpb #LBUFMX-1                  ; at maximum line length?
                bne L862E                       ; brif not
                bra L85F5                       ; process another input character
L862E           pshs x                          ; save input pointer
L8630           tst ,x+                         ; are we at the end of the line?
                bne L8630                       ; brif not
L8634           ldb ,-x                         ; get character before current pointer, move back
                stb 1,x                         ; move it forward
                cmpx ,s                         ; at the original buffer pointer?
                bne L8634                       ; brif not
                leas 2,s                        ; remove saved buffer pointer
                sta ,x+                         ; save input character in newly made hole
                bsr L8659                       ; echo it
                inc VD7                         ; bump line length counter
                bra L85F5                       ; go handle more stuff
L8646           cmpa #0x08                      ; backspace?
                bne L865C                       ; brif not
L864A           bsr L8650                       ; move pointer back, echo BS
                decb                            ; done enough of them?
                bne L864A                       ; brif not
                rts
L8650           cmpx #LINBUF+1                  ; at start of buffer?
                beq L8625                       ; brif so
                leax -1,x                       ; move pointer back
                lda #0x08                       ; character to echo - BS
L8659           jmp PUTCHR                      ; echo character to screen
L865C           cmpa #'K                        ; "kill"?
                beq L8665                       ; brif so
                suba #'S                        ; search?
                beq L8665                       ; brif so
                rts
L8665           pshs a                          ; save kill/search flag
                bsr L8687                       ; read target
                pshs a                          ; save search character
L866B           lda ,x                          ; get current character in buffer
                beq L8685                       ; brif end of line - nothing more to search
                tst 1,s                         ; is it KILL?
                bne L8679                       ; brif so
                bsr L8659                       ; echo the character
                leax 1,x                        ; move ahead
                bra L867C                       ; check next character
L8679           jsr L85D1                       ; remove character from buffer
L867C           lda ,x                          ; get character in buffer
                cmpa ,s                         ; are we at the target?
                bne L866B                       ; brif not
                decb                            ; have we found enough of them?
                bne L866B                       ; brif not
L8685           puls y,pc                       ; clean up stack and return to main EDIT routine
L8687           jsr LA171                       ; get input from the generic input handler (will show the cursor)
                cmpa #0x7f                      ; graphics (or DEL)?
                bhs L8687                       ; brif so - ignore it
                cmpa #0x5f                      ; SHIFT-UP?
                bne L8694                       ; brif not
                lda #0x1b                       ; replace with ESC
L8694           cmpa #0x0d                      ; carriage return?
                beq L86A6                       ; brif so (C=0)
                cmpa #0x1b                      ; ESC
                beq L86A6                       ; brif so (C=0)
                cmpa #0x08                      ; backspace?
                beq L86A6                       ; brif so (C=0)
                cmpa #32                        ; control code?
                blo L8687                       ; brif control code - try again
                orcc #1                         ; set C for "valid" (printable) character
L86A6           rts
; TRON and TROFF commands
TRON            skip1lda                        ; load flag with nonzero for trace enabled (and skip next)
TROFF           clra                            ; clear flag for trace disabled
                sta TRCFLG                      ; save trace status
                rts
; POS function
POS             lda DEVNUM                      ; get original device number
                pshs a                          ; save it for later
                jsr LA5AE                       ; fetch device number
                jsr LA406                       ; check for open file
                jsr LA35F                       ; set up print parameters
                ldb DEVPOS                      ; get current line position for the device
                jmp LA5E4                       ; return position in B as unsigned
; VARPTR function
VARPTRTOK       jsr LB26A                       ; make sure we have (
                ldd ARYEND                      ; get address of end of arrays
                pshs d                          ; save it
                jsr LB357                       ; parse variable descriptor
                jsr LB267                       ; make sure there is a )
                puls d                          ; get original end of arrays
                exg x,d                         ; swap original end of arrays and the discovered variable pointer
                cmpx ARYEND                     ; did array end move (variable created?)
                bne L8724                       ; brif so (FC error)
                jmp GIVABF                      ; return the pointer (NOTE: as signed)
; MID$() assignment; note that this cannot make the string longer or shorter and if the replacement is shorter
; than the specified size, only the number of characters actually in the replacement will be used.
L86D6           jsr GETNCH                      ; eat the MID$ token
                jsr LB26A                       ; force (
                jsr LB357                       ; evaluate the variable
                pshs x                          ; save variable descriptor
                ldd 2,x                         ; point to start of original string
                cmpd FRETOP                     ; is it in string space?
                bls L86EB                       ; brif not
                subd MEMSIZ                     ; is it still in string space (top end)?
                bls L86FD                       ; brif so
L86EB           ldb ,x                          ; get length of original string
                jsr LB56D                       ; allocate space in string space
                pshs x                          ; save pointer to string space
                ldx 2,s                         ; get to original string descriptor
                jsr LB643                       ; move the string into string space
                puls x,u                        ; get new string address and string descriptor
                stx 2,u                         ; save new data address for the string
                pshs u                          ; save descriptor address again
L86FD           jsr LB738                       ; evaluate ",start"
                pshs b                          ; save start offset
                tstb                            ; is start 0?
                beq L8724                       ; brif so - strings offsets are 1-based
                ldb #255                        ; default use the entire string
                cmpa #')                        ; end of parameters?
                beq L870E                       ; brif so
                jsr LB738                       ; evaluate ",length"
L870E           pshs b                          ; save length
                jsr LB267                       ; make sure we have a )
                ldb #0xb3                       ; make sure we have =
                jsr LB26F
                bsr L8748                       ; evaluate replacement string
                tfr x,u                         ; save replacement string address
                ldx 2,s                         ; get original string descriptor
                lda ,x                          ; get length of original string
                suba 1,s                        ; subtract start position
                bhs L8727                       ; brif within the string - insert replacement
L8724           jmp LB44A                       ; raise illegal function call
L8727           inca                            ; A is now number of characters to the right of the position parameter
                cmpa ,s                         ; compare to length desired
                bhs L872E                       ; brif new length fits
                sta ,s                          ; only use as much of the length as will fit
L872E           lda 1,s                         ; get position offset
                exg a,b                         ; swap replacement length and position
                ldx 2,x                         ; point to original string address
                decb                            ; we work with 0-based offsets
                abx                             ; now X points to start of replacement
                tsta                            ; replacing 0?
                beq L8746                       ; brif so - done
                cmpa ,s                         ; is replacement shorter than the hole?
                bls L873F                       ; brif so
                lda ,s                          ; use copy the maximum number specified
L873F           tfr a,b                         ; save number to move in B
                exg u,x                         ; swap pointers so they are right for the routine
                jsr LA59A                       ; copy string data
L8746           puls a,b,x,pc                   ; clean up stack and return
L8748           jsr LB156                       ; evaluate expression
                jmp LB654                       ; make sure it's a string and return string details
; STRING$ function
STRING          jsr LB26A                       ; make sure we have (
                jsr EVALEXPB                    ; evaluate repeat count (error if > 255)
                pshs b                          ; save repeat count
                jsr SYNCOMMA                    ; make sure there's a comma
                jsr LB156                       ; evaluate the thing to repeat
                jsr LB267                       ; make sure we have a )
                lda VALTYP                      ; is it string?
                bne L8768                       ; brif so
                jsr LB70E                       ; get 8 bit character code
                bra L876B                       ; use that
L8768           jsr LB6A4                       ; get first character of string
L876B           pshs b                          ; save repeat character
                ldb 1,s                         ; get repeat count
                jsr LB50F                       ; reserve space for the string
                puls a,b                        ; get character and repeat count
                beq L877B                       ; brif NULL string
L8776           sta ,x+                         ; put character into string
                decb                            ; put enough?
                bne L8776                       ; brif not
L877B           jmp LB69B                       ; return the newly created string
; INSTR function
INSTR           jsr LB26A                       ; evaluate (
                jsr LB156                       ; evaluate first argument
                ldb #1                          ; default start position is 1 (start of string)
                pshs b                          ; save start position
                lda VALTYP                      ; get type of first argument
                bne L879C                       ; brif string - use default starting position
                jsr LB70E                       ; convert first argument into string offset
                stb ,s                          ; save offset
                beq L8724                       ; brif starting at 0 - not allowed
                jsr SYNCOMMA                    ; make sure there's a comma
                jsr LB156                       ; evaluate the search string
                jsr LB146                       ; make sure it *is* a string
L879C           ldx FPA0+2                      ; get search string descriptor
                pshs x                          ; save it
                jsr SYNCOMMA                    ; make sure we have a comma
                jsr L8748                       ; evalute the target string
                pshs x,b                        ; save address and length of target string
                jsr LB267                       ; make sure we have a )
                ldx 3,s                         ; get search string address
                jsr LB659                       ; get string details
                pshs b                          ; save search string length
                cmpb 6,s                        ; compare length of search string to the start
                blo L87D9                       ; brif start position is beyond the search string - return 0
                lda 1,s                         ; get length of target string
                beq L87D6                       ; brif targetstring is NULL - match will be immediate
                ldb 6,s                         ; get start position
                decb                            ; zero-base it
                abx                             ; now X points to the start position for the search
L87BE           leay ,x                         ; point to start of search
                ldu 2,s                         ; get target string pointer
                ldb 1,s                         ; get targetlength
                lda ,s                          ; get length of serach
                suba 6,s                        ; see how much is left in searh
                inca                            ; add one for "inclusivity"
                cmpa 1,s                        ; do we have less than the target string?
                blo L87D9                       ; brif so - we obviously won't match
L87CD           lda ,x+                         ; compare a byte
                cmpa ,u+
                bne L87DF                       ; brif no match
                decb                            ; compared all of target?
                bne L87CD                       ; brif not
L87D6           ldb 6,s                         ; get position where we matched
                skip1
L87D9           clrb                            ; flag no match
                leas 7,s                        ; clean up stack
                jmp LB4F3                       ; return unsigned B
L87DF           inc 6,s                         ; bump start position
                leax 1,y                        ; move starting pointer
                bra L87BE                       ; see if we match now
; Number parsing handler
XVEC19          cmpa #'&                        ; do we have & (hex or octal)?
                bne L8845                       ; brif not
                leas 2,s                        ; we won't return to the original invoker
L87EB           clr FPA0+2                      ; clear bottom of FPA0 for 16 bit value
                clr FPA0+3
                ldx #FPA0+2                     ; point to accumulator
                jsr GETNCH                      ; eat the &
                cmpa #'O                        ; octal?
                beq L880A                       ; brif so
                cmpa #'H                        ; hex?
                beq L881F                       ; brif so
                jsr GETCCH                      ; reset flags on input
                bra L880C                       ; go process octal (default)
L8800           cmpa #'8                        ; is it a valid octal character?
                lbhi LB277                      ; brif not (BUG: should be LBHS or above be #'7)
                ldb #3                          ; base 8 multiplier
                bsr L8834                       ; add digit to accumulator
L880A           jsr GETNCH                      ; get input character
L880C           bcs L8800                       ; brif numeric
L880E           clr FPA0                        ; clear upper bytes of FPA0
                clr FPA0+1
                clr VALTYP                      ; result is numeric
                clr FPSBYT                      ; clear out any extra precision
                clr FP0SGN                      ; make it positive
                ldb #0xa0                       ; exponent for integer aligned to right of FPA0
                stb FP0EXP
                jmp LBA1C                       ; go normalize the result and return
L881F           jsr GETNCH                      ; get input character
                bcs L882E                       ; brif digit
                jsr LB3A2                       ; set carry if not alpha
L8826           bcs L880E                       ; brif not alpha
                cmpa #'G                        ; is it valid HEX digit?
                bhs L880E                       ; brif not
                suba #7                         ; normalize A-F to be just above 0-9
L882E           ldb #4                          ; four bits per digit
                bsr L8834                       ; add digit to accumlator
                bra L881F                       ; process another digit
L8834           asl 1,x                         ; shift accumulator one bit left
                rol ,x
                lbcs LBA92                      ; brif too big - overflow
                decb                            ; done enough bit shifts?
                bne L8834                       ; brif not
L883F           suba #'0                        ; remove ASCII bias
                adda 1,x                        ; merge digit into accumlator (this cannot cause carry)
                sta 1,x
L8845           rts
; Expression evaluation handler
XVEC15          puls u                          ; get back return address
                clr VALTYP                      ; set result to numeric
                ldx CHARAD                      ; save input pointer
                jsr GETNCH                      ; get the input character
                cmpa #'&                        ; HEX or OCTAL?
                beq L87EB                       ; brif so
                cmpa #0xcc                      ; FN?
                beq L88B4                       ; brif so - do "FNx()"
                cmpa #0xff                      ; function token?
                bne L8862                       ; brif not
                jsr GETNCH                      ; get function token value
                cmpa #0x83                      ; USR?
                lbeq L892C                      ; brif so - short circuit Color Basic's USR handler
L8862           stx CHARAD                      ; restore input pointer
                jmp ,u                          ; return to mainline code
L8866           ldx CURLIN                      ; are we in immediate mode?
                leax 1,x
                bne L8845                       ; brif not - we're good
                ldb #2*11                       ; code for illegal direct statement
L886E           jmp LAC46                       ; raise error
; DEF command (DEF FN, DEF USR)
DEF             ldx [CHARAD]                    ; get two input characters
                cmpx #0xff83                    ; USR?
                lbeq L890F                      ; brif so - do DEF USR
                bsr L88A1                       ; get descriptor address for FN variable
                bsr L8866                       ; disallow DEF FN in immediate mode
                jsr LB26A                       ; make sure we have (
                ldb #0x80                       ; disallow arrays as arguments
                stb ARYDIS
                jsr LB357                       ; evaluate variable
                bsr L88B1                       ; make sure it's numeric
                jsr LB267                       ; make sure we have )
                ldb #0xb3                       ; make sure we have =
                jsr LB26F
                ldx V4B                         ; get variable descriptor address
                ldd CHARAD                      ; get input pointer
                std ,x                          ; save address of the actual function code in variable descriptor
                ldd VARPTR                      ; get descriptor address of argument
                std 2,x                         ; save argument descriptor address
                jmp DATA                        ; move to the end of this statement
L88A1           ldb #0xcc                       ; make sure we have FN
                jsr LB26F
                ldb #0x80                       ; disable array lookup
                stb ARYDIS
                ora #0x80                       ; set bit 7 of first character (to indicate FN variable)
                jsr LB35C                       ; find the variable
                stx V4B                         ; save descriptor pointer
L88B1           jmp LB143                       ; make sure we have a numeric variable
; Evaluate an FN call
L88B4           bsr L88A1                       ; parse the FNx bit and get the descriptor
                pshs x                          ; save descriptor
                jsr LB262                       ; evaluate parameter
                bsr L88B1                       ; make sure it's a number
                puls u                          ; get FN descriptor
                ldb #2*25                       ; code for undefined function
                ldx 2,u                         ; point to argument variable descriptor
                beq L886E                       ; brif nothing doing there (if it was just created, this will be NULL)
                ldy CHARAD                      ; save current input pointer
                ldu ,u                          ; point to start of FN definition
                stu CHARAD                      ; put input pointer there
                lda 4,x                         ; save original value of argument and save it with current input, and variable pointers
                pshs a
                ldd ,x
                ldu 2,x
                pshs u,y,x,d
                jsr LBC35                       ; set argument variable to the argument
L88D9           jsr LB141                       ; go evaluate the FN expression
                puls d,x,y,u                    ; get back variable pointers, input pointer, and original variable value
                std ,x
                stu 2,x
                puls a
                sta 4,x
                jsr GETCCH                      ; test end of FN formula
                lbne LB277                      ; brif not end of statement - problem with the function
                sty CHARAD                      ; restore input pointer
L88EF           rts
; Error handler
XVEC17          cmpb #2*25                      ; is it a valid Extended Basic error code?
                blo L88EF                       ; brif not - return to mainline
                jsr LA7E9                       ; turn off tape
                jsr LA974                       ; turn off sound
                jsr LAD33                       ; clean up stack and other bits
                clr DEVNUM                      ; reset output to screen
                jsr LB95C                       ; do a newline if needed
                jsr LB9AF                       ; do a ?
                ldx #L890B-25*2                 ; point to error message table
                jmp LAC60                       ; go display error message
; Extended Basic error codes. Yes, NE is defined here even though it is only actually documented in the
; Disk Basic documentation. It is here for the use of DLOAD.
L890B           fcc 'UF'                        ; 25 undefined function call
                fcc 'NE'                        ; 26 File not found
; DEF USR
L890F           jsr GETNCH                      ; eat the USR token
                bsr L891C                       ; get pointer to USR call
                pshs x                          ; save FN exec address location
                bsr L8944                       ; calculate execution address
                puls u                          ; get FN address pointer
                stx ,u                          ; save new address
                rts
L891C           clrb                            ; default routine number is 0
                jsr GETNCH                      ; fetch the call number
                bcc L8927                       ; brif not a number
                suba #'0                        ; remove ASCII bias
                tfr a,b                         ; save it in the right place
                jsr GETNCH                      ; eat the call number
L8927           ldx USRADR                      ; get start address of USR jump table
                aslb                            ; two bytes per address
                abx                             ; now X points to the right entry
                rts
; Evaluate a USR call
L892C           bsr L891C                       ; find the correct routine address location
                ldx ,x                          ; get routine address
                pshs x                          ; save it
                jsr LB262                       ; evaluate argument
                ldx #FP0EXP                     ; point to FPA0 (argument value)
                lda VALTYP                      ; is it string?
                beq L8943                       ; brif not
                jsr LB657                       ; fetch string details (removes it from the string stack)
                ldx FPA0+2                      ; get string descriptor pointer
                lda VALTYP                      ; set flags for the value type
L8943           rts                             ; call the routine and return to mainline code
L8944           ldb #0xb3                       ; check for "="
                jsr LB26F
                jmp LB73D                       ; evaluate integer expression to X and return
; Extended Basic IRQ handler
XIRQSV          lda PIA0+3                      ; is it VSYNC interrupt?
                bmi L8952                       ; brif so
                rti                             ; really should clear the HSYNC interrupt here
L8952           lda PIA0+2                      ; clear VSYNC interrupt
                ldx TIMVAL                      ; increment the TIMER value
                leax 1,x
                stx TIMVAL
                jmp L9C3E                       ; check for other stuff
; TIMER=
L8960           jsr GETNCH                      ; eat the TIMER token
                bsr L8944                       ; evaluate =nnnn to X
                stx TIMVAL                      ; set the timer
                rts
; TIMER function
TIMER           ldx TIMVAL                      ; get timer value
                stx FPA0+2                      ; set it in FPA0
                jmp L880E                       ; return as positive 16 bit value
; DEL command
DEL             lbeq LB44A                      ; raise error if no argument (probably to avoid accidentally deleting line 0)
                jsr LAF67                       ; parse line number
                jsr LAD01                       ; find line
                stx VD3                         ; save address of line
                jsr GETCCH                      ; is there something more?
                beq L8990                       ; brif not
                cmpa #0xac                      ; dash?
                bne L89BF                       ; brif not - error out
                jsr GETNCH                      ; each the -
                beq L898C                       ; brif no ending line - use default line number
                bsr L89AE                       ; parse second line number and save in BINVAL
                bra L8990                       ; do the deletion
L898C           lda #0xff                       ; set to maximum line number
                sta BINVAL
L8990           ldu VD3                         ; point end to start
                skip2
L8993           ldu ,u                          ; point to start of next line
                ldd ,u                          ; check for end of program
                beq L899F                       ; brif end of program
                ldd 2,u                         ; get line number
                subd BINVAL                     ; is it in range?
                bls L8993                       ; brif so
L899F           ldx VD3                         ; get starting line address
                bsr L89B8                       ; close up gap
                jsr LAD21                       ; reset input pointer and erase variables
                ldx VD3                         ; get start of program after the deletion
                jsr LACF1                       ; recompute netl ine pointers
                jmp LAC73                       ; return to immediate mode
L89AE           jsr LAF67                       ; parse a line number
                jmp LA5C7                       ; make sure there's nothing more
L89B4           lda ,u+                         ; copy a byte
                sta ,x+
L89B8           cmpu VARTAB                     ; end of program?
                bne L89B4                       ; brif not
                stx VARTAB                      ; save new start of variables/end of program
L89BF           rts
; LINE INPUT
L89C0           jsr L8866                       ; raise error if in immediate mode
                jsr GETNCH                      ; eat the "INPUT" token
                cmpa #'#                        ; device number?
                bne L89D2                       ; brif not
                jsr LA5A5                       ; parse device number
                jsr LA3ED                       ; make sure it's valid for input
                jsr SYNCOMMA                    ; make sure there's a comma after the device number
L89D2           cmpa #'"                        ; is there a prompt?
                bne L89E1                       ; brif not
                jsr LB244                       ; parse the string
                ldb #';                         ; make sure there's a semicolon after the prompt
                jsr LB26F
                jsr LB99F                       ; go actually display the prompt
L89E1           leas -2,s                       ; make a hole on the stack (so number of return adddresses is right)
                jsr LB035                       ; read an input line from current device
                leas 2,s                        ; clean up stack
                clr DEVNUM                      ; reset to screen/keyboard
                jsr LB357                       ; parse a variable
                stx VARDES                      ; save pointer to it
                jsr LB146                       ; make sure it's a string
                ldx #LINBUF                     ; point to input buffer
                clra                            ; make sure we terminate on NUL only
                jsr LB51A                       ; parse string and store it in string space
                jmp LAFA4                       ; go assign the string to its final resting place
; RENUM command
L89FC           jsr LAF67                       ; read a line number
                ldx BINVAL                      ; get value
                rts
L8A02           ldx VD1                         ; get current old number being renumbered
L8A04           stx BINVAL                      ; save number being searched for
                jmp LAD01                       ; go find line number
RENUM           jsr LAD26                       ; erase variables
                ldd #10                         ; default line number interval and start
                std VD5                         ; set starting line number
                std VCF                         ; set number interval
                clrb                            ; now D is 0
                std VD1                         ; save default start for renumbering
                jsr GETCCH                      ; are there any arguments
                bcc L8A20                       ; brif not numeric
                bsr L89FC                       ; fetch line number
                stx VD5                         ; save line beginning number
                jsr GETCCH                      ; get input character
L8A20           beq L8A3D                       ; brif end of line
                jsr SYNCOMMA                    ; make sure we have a comma
                bcc L8A2D                       ; brif next isn't numeric
                bsr L89FC                       ; fetch starting line number
                stx VD1                         ; save the number where we start working
                jsr GETCCH                      ; fetch input character
L8A2D           beq L8A3D                       ; brif end of line
                jsr SYNCOMMA                    ; make sure we have a comma
                bcc L8A3A                       ; brif we don't have a number
                bsr L89FC                       ; parse the number
                stx VCF                         ; save interval
                beq L8A83                       ; brif we ave a zero interval
L8A3A           jsr LA5C7                       ; raise error if more stuff
L8A3D           bsr L8A02                       ; get address of old number to process
                stx VD3                         ; save address
                ldx VD5                         ; get the next renumbered line to use
                bsr L8A04                       ; find that line
                cmpx VD3                        ; is it before the previous one?
                blo L8A83                       ; brif so - raise error
                bsr L8A67                       ; make sure renumbered line numbers will be in range
                jsr L8ADD                       ; convert line numbers to "expanded" binary
                jsr LACEF                       ; recalculate next line pointers
                bsr L8A02                       ; get address of first line to renumber
                stx VD3                         ; save it
                bsr L8A91                       ; make sure line numbers exist
                bsr L8A68                       ; renumber the actual lines
                bsr L8A91                       ; update line numbers in program text
                jsr L8B7B                       ; convert packed binary line numbers to text
                jsr LAD26                       ; erase variables, reset stack, etc.
                jsr LACEF                       ; recalculate next line pointers
                jmp LAC73                       ; bounce back to immediate mode
L8A67           skip1lda                        ; set line number flag to nonzero (skip next instruction)
L8A68           clra                            ; set line number flag to zero (insert new numbers)
                sta VD8                         ; save line number flag
                ldx VD3                         ; get address of line being renumbered
                ldd VD5                         ; get the current renumbering number
                bsr L8A86                       ; return if end of program
L8A71           tst VD8                         ; test line number flag
                bne L8A77                       ; brif not adding new numbers
                std 2,x                         ; set new number
L8A77           ldx ,x                          ; point to next line
                bsr L8A86                       ; return if end of program
                addd VCF                        ; add interval to current number
                bcs L8A83                       ; brif we overflowed - bad line number
                cmpa #MAXLIN                    ; maximum legal number?
                blo L8A71                       ; brif so - do another
L8A83           jmp LB44A                       ; raise FC error
L8A86           pshs d                          ; save D (we're going to clobber it)
                ldd ,x                          ; get next line pointer
                puls d                          ; unclobber D
                bne L8A90                       ; brif not end of program
                leas 2,s                        ; return to caller's caller
L8A90           rts
L8A91           ldx TXTTAB                      ; get start of program
                leax -1,x                       ; move pointer back one (compensate for leax 1,x below)
L8A95           leax 1,x                        ; move to next line
                bsr L8A86                       ; return if end of program
L8A99           leax 3,x                        ; move past next line address and line number, go one before line
L8A9B           leax 1,x                        ; move to next character
                lda ,x                          ; check input character
                beq L8A95                       ; brif end of line
                stx TEMPTR                      ; save current pointer
                deca                            ; is it start of packed numeric line number?
                beq L8AB2                       ; brif so
                deca                            ; does line exist?
                beq L8AD3                       ; brif line number exists
                deca                            ; not part of something to process?
                bne L8A9B                       ; brif so
L8AAC           lda #3                          ; set 1st byte to 3 to indicate line number not existing
                sta ,x+
                bra L8A99                       ; go process another
L8AB2           ldd 1,x                         ; get MSB of line number
                dec 2,x                         ; is MS byte zero?
                beq L8AB9                       ; brif not
                clra                            ; set MS byte to 0
L8AB9           ldb 3,x                         ; get LSB of line number
                dec 4,x                         ; is it zero?
                beq L8AC0                       ; brif not
                clrb                            ; clear byte
L8AC0           std 1,x                         ; save binary number
                std BINVAL                      ; save trial number
                jsr LAD01                       ; find the line number
L8AC7           ldx TEMPTR                      ; get start of packed line
                bcs L8AAC                       ; brif line number not found
                ldd V47                         ; get address of line number
                inc ,x+                         ; bump first byte to 2 (exists if checking) or 1 if inserting
                std ,x                          ; save address of correct number
                bra L8A99                       ; go process more
L8AD3           clr ,x                          ; clear carry and first byte
                ldx 1,x                         ; point to address of correct line
                ldx 2,x                         ; get correct line number
                stx V47                         ; save it
                bra L8AC7                       ; insert into line
L8ADD           ldx TXTTAB                      ; get beginning of program
                bra L8AE5
L8AE1           ldx CHARAD                      ; get input pointer
                leax 1,x                        ; move it forward
L8AE5           bsr L8A86                       ; return if end of program
                leax 2,x                        ; move past line address
L8AE9           leax 1,x                        ; move forward
L8AEB           stx CHARAD                      ; save input pointer
L8AED           jsr GETNCH                      ; get an input character
L8AEF           tsta                            ; is it actual 0?
                beq L8AE1                       ; brif end of line
                bpl L8AED                       ; brif not a token
                ldx CHARAD                      ; get input pointer
                cmpa #0xff                      ; function?
                beq L8AE9                       ; brif so - ignore it (and following byte)
                jsr RVEC22                      ; do the RAM hook thing
                cmpa #0xa7                      ; THEN?
                beq L8B13                       ; brif so
                cmpa #0x84                      ; ELSE?
                beq L8B13                       ; brif so
                cmpa #0x81                      ; GO(TO|SUB)?
                bne L8AED                       ; brif not - we don't have a line number
                jsr GETNCH                      ; get TO/SUB
                cmpa #0xa5                      ; GOTO?
                beq L8B13                       ; brif so
                cmpa #0xa6                      ; GOSUB?
                bne L8AEB                       ; brif not
L8B13           jsr GETNCH                      ; fetch character after token
                bcs L8B1B                       ; brif numeric (line number)
L8B17           jsr GETCCH                      ; set flags on input character
                bra L8AEF                       ; keep checking for line numbers
L8B1B           ldx CHARAD                      ; get input pointer
                pshs x                          ; save it
                jsr LAF67                       ; parse line number
                ldx CHARAD                      ; get input pointer after line
L8B24           lda ,-x                         ; get character before pointer
                jsr L90AA                       ; set C if numeric
                bcs L8B24                       ; brif not numeric
                leax 1,x                        ; move pointer up
                tfr x,d                         ; calculate size of line number
                subb 1,s
                subb #5                         ; make sure at least 5 bytes
                beq L8B55                       ; brif exactly 5 bytes - no change
                blo L8B41                       ; brif less than 5 bytes
                leau ,x                         ; move remainder of program backward
                negb                            ; negate extra number of bytes (to subtract from X)
                leax b,x                        ; now X is the correct position to move program to
                jsr L89B8                       ; shift program backward
                bra L8B55
L8B41           stx V47                         ; save end of line number space (end of copy)
                ldx VARTAB                      ; get end of program
                stx V43                         ; set source pointer
                negb                            ; get positive difference
                leax b,x                        ; now X is the top of the destination block
                stx V41                         ; set copy destination
                stx VARTAB                      ; save new end of program
                jsr LAC1E                       ; make sure enough room and make a hole in the program
                ldx V45                         ; get end address of destination block
                stx CHARAD                      ; set input there
L8B55           puls x                          ; get starting address of the line number
                lda #1                          ; set "new number" flag
                sta ,x
                sta 2,x
                sta 4,x
                ldb BINVAL                      ; get MS byte of line number
                bne L8B67                       ; brif it is not zero
                ldb #1                          ; set to 1 if MSB is 0
                inc 2,x                         ; flag MSB as 0
L8B67           stb 1,x                         ; set MSB of line number
                ldb BINVAL+1                    ; get LSB of number
                bne L8B71                       ; brif nonzero
                ldb #1                          ; set to 1 if LSB is 0
                inc 4,x                         ; flag LSB as 0
L8B71           stb 3,x                         ; save LSB of line number
                jsr GETCCH                      ; get input character
                cmpa #',                        ; multiple line numbers? (ON GOTO, ON GOSUB)
                beq L8B13                       ; brif so - process another
                bra L8B17                       ; go look for more line numbers
L8B7B           ldx TXTTAB                      ; point to start of program
                leax -1,x                       ; move back (compensate for inc below)
L8B7F           leax 1,x                        ; move forward
                ldd 2,x                         ; get this line number
                std CURLIN                      ; save it (for error message)
                jsr L8A86                       ; return if end of program
                leax 3,x                        ; skip address and line number, stay one before line text
L8B8A           leax 1,x                        ; move to next character
L8B8C           lda ,x                          ; get input character
                beq L8B7F                       ; brif end of line
                deca                            ; valid line new line number?
                beq L8BAE                       ; brif so
                suba #2                         ; undefined line?
                bne L8B8A                       ; brif not
                pshs x                          ; save line number pointer
                ldx #L8BD9-1                    ; show UL message
                jsr STRINOUT
                ldx ,s                          ; get input pointer
                ldd 1,x                         ; get undefined line number
                jsr LBDCC                       ; display line number
                jsr LBDC5                       ; print out "IN XXXX"
                jsr LB958                       ; do a newline
                puls x                          ; get input pointer back
L8BAE           pshs x                          ; save input pointer
                ldd 1,x                         ; get binary value of line number
                std FPA0+2                      ; save it in FPA0
                jsr L880E                       ; adjust FPA0 as integer
                jsr LBDD9                       ; convert to text string
                puls u                          ; get previous input pointer address
                ldb #5                          ; each expanded line uses 5 bytes
L8BBE           leax 1,x                        ; move pointer forward (in string number) past sign
                lda ,x                          ; do we have a digit?
                beq L8BC9                       ; brif not - end of number
                decb                            ; mark a byte consumed
                sta ,u+                         ; put digit in program
                bra L8BBE                       ; copy another digit
L8BC9           leax ,u                         ; point to address at end of text number
                tstb                            ; did number fill whole space?
                beq L8B8C                       ; brif so - move on
                leay ,u                         ; save end of number pointer
                leau b,u                        ; point to the end of the original expanded number
                jsr L89B8                       ; close up gap in program
                leax ,y                         ; get end of line number pointer back
                bra L8B8C                       ; go process more
L8BD9           fcn 'UL '
; HEX$ function
HEXDOL          jsr LB740                       ; convert argument to positive integer
                ldx #STRBUF+2                   ; point to string buffer
                ldb #4                          ; convert 4 nibbles
L8BE5           pshs b                          ; save nibble counter
                clrb                            ; clear digit accumulator
                lda #4                          ; do 4 shifts
L8BEA           asl FPA0+3                      ; shift a bit off the left of the value into low bits of B
                rol FPA0+2
                rolb
                deca                            ; done all shifts?
                bne L8BEA                       ; brif not
                tstb                            ; do we have a nonzero digit?
                bne L8BFF                       ; brif so
                lda ,s                          ; is it last digit?
                deca
                beq L8BFF                       ; brif so - keep the 0
                cmpx #STRBUF+2                  ; is it a middle zero?
                beq L8C0B                       ; brif not
L8BFF           addb #'0                        ; add ASCII bias
                cmpb #'9                        ; above 9?
                bls L8C07                       ; brif not
                addb #7                         ; adjust into alpha range
L8C07           stb ,x+                         ; save digit in output
                clr ,x                          ; make sure we have a NUL term
L8C0B           puls b                          ; get back nibble counter
                decb                            ; done all?
                bne L8BE5                       ; brif not
                leas 2,s                        ; don't return mainline (we're returning a string)
                ldx #STRBUF+1                   ; point to start of converted number
                jmp LB518                       ; save string in string space, etc., and return it
; DLOAD command
DLOAD           jsr LA429                       ; close files
L8C1B           clr ,-s                         ; save default token (not DLOADM)
                cmpa #'M                        ; is it DLOADM?
                bne L8C25                       ; brif not
                sta ,s                          ; save the "M"
                jsr GETNCH                      ; eat the "M"
L8C25           jsr LA578                       ; parse the file name
                jsr GETCCH                      ; get character after file name
                beq L8C44                       ; brif end of line
                jsr SYNCOMMA                    ; make sure we have a comma
                cmpa #',                        ; do we have 2 commas?
                beq L8C44                       ; brif so - use default baud rate
                jsr EVALEXPB                    ; evaluate baud rate
L8C36           lda #44*4                       ; delay for 300 baud
                tstb                            ; was argument 0?
                beq L8C42                       ; brif so - 300 baud
                lda #44                         ; constant for 1200 baud
                decb                            ; was it 1?
                lbne LB44A                      ; raise error if not
L8C42           sta DLBAUD                      ; save baud rate constant
L8C44           jsr L8CD0                       ; transmit file name and read in file status
                pshs a                          ; save register
                lda #-3                         ; set input to DLOAD
                sta DEVNUM
                puls a                          ; restore register
                tst ,s+                         ; is it DLOADM?
                bne L8C85                       ; brif so
                jsr LA5C7                       ; check for end of line - error if not
                tstb                            ; ASCII?
                beq L8C5F                       ; brif not - do error
                jsr LAD19                       ; clear out program
                jmp LAC7C                       ; go read program
L8C5F           jmp LA616                       ; raise bad file mode
; CLOADM patch for Extended Basic
L8C62           jsr GETNCH                      ; get character after CLOAD
                cmpa #'M                        ; CLOADM?
                lbne CLOAD                      ; brif not - Color Basic's CLOAD can handle it
                clr FILSTA                      ; close tape file
                jsr GETNCH                      ; eat the "M"
                jsr LA578                       ; parse file name
                jsr LA648                       ; find the file
                tst CASBUF+10                   ; is it a chunked file?
                lbeq LA505                      ; brif not - Color Basic's CLOADM can handle it
                ldu CASBUF+8                    ; get file type and ASCII flag
                dec DEVNUM                      ; set source device to tape
                jsr LA635                       ; go read the first block
                tfr u,d                         ; put type and ASCII flag somewhere more useful
; NOTE: DLOADM comes here to do the final processing
L8C85           subd #0x200                     ; is it binary and "machine language"?
                bne L8C5F                       ; brif not - raise an error
                ldx ZERO                        ; default load offset
                jsr GETCCH                      ; is there any offset?
                beq L8C96                       ; brif not
                jsr SYNCOMMA                    ; make sure there's a comma
                jsr LB73D                       ; evaluate offset in X
L8C96           stx VD3                         ; save offset
                jsr LA5C7                       ; raise error if more stuff follows
L8C9B           bsr L8CC6                       ; get type of "amble"
                pshs a                          ; save it
                bsr L8CBF                       ; read in block length
                tfr d,y                         ; save it
                bsr L8CBF                       ; read in load address
                addd VD3                        ; add in offset
                std EXECJP                      ; save it as the execution address
                tfr d,x                         ; put load address in a pointer
                lda ,s+                         ; get "amble" type
                lbne LA42D                      ; brif postamble - close file
L8CB1           bsr L8CC6                       ; read a data byte
                sta ,x                          ; save in memory
                cmpa ,x+                        ; did it actually save?
                bne L8CCD                       ; brif not RAM - raise error
                leay -1,y                       ; done yet?
                bne L8CB1                       ; brif not
                bra L8C9B                       ; look for another "amble"
L8CBF           bsr L8CC1                       ; read a character to B
L8CC1           bsr L8CC6                       ; read character to A
                exg a,b                         ; swap character with previously read one
L8CC5           rts
L8CC6           jsr LA176                       ; read a character from input
                tst CINBFL                      ; EOF?
                beq L8CC5                       ; brif not
L8CCD           jmp LA619                       ; raise I/O error if EOF
L8CD0           bsr L8D14                       ; transmit file name
                pshs b,a                        ; save file status
                inca                            ; was file found?
                beq L8CDD                       ; brif not
                ldu ZERO                        ; zero U - first block
                bsr L8CE4                       ; read block
                puls a,b,pc                     ; restore status and return
L8CDD           ldb #2*26                       ; code for NE error
                jmp LAC46                       ; raise error
L8CE2           ldu CBUFAD                      ; get block number
L8CE4           leax 1,u                        ; bump block number
                stx CBUFAD                      ; save new block number
                ldx #CASBUF                     ; use cassette buffer
                jsr L8D7C                       ; read a block
                jmp LA644                       ; reset input buffer pointers
; Generic input handler for Extended Basic
XVEC4           lda DEVNUM                      ; get device number
                cmpa #-3                        ; DLOAD?
                bne L8D01                       ; brif not
                leas 2,s                        ; don't return to mainline code
                clr CINBFL                      ; reset EOF flag to not EOF
                tst CINCTR                      ; anything available?
                bne L8D02                       ; brif so - fetch one
                com CINBFL                      ; flag EOF
L8D01           rts
L8D02           pshs u,y,x,b                    ; save registers
                ldx CINPTR                      ; get buffer pointer
                lda ,x+                         ; get character from buffer
                pshs a                          ; save it for return
                stx CINPTR                      ; save new input pointer
                dec CINCTR                      ; account for byte removed from buffer
                bne L8D12                       ; brif buffer not empty
                bsr L8CE2                       ; go read a block
L8D12           puls a,b,x,y,u,pc               ; restore registers, return value, and return
L8D14           clra                            ; clear attempt counter
                pshs x,b,a                      ; make a hole for variables
                leay ,s                         ; set up frame pointer
                bra L8D1D                       ; go read block
L8D1B           bsr L8D48                       ; bump attempt counter
L8D1D           lda #0x8a                       ; send file request control code
                bsr L8D58
                bne L8D1B                       ; brif no echo or error
                ldx #CFNBUF+1                   ; point to file name
L8D26           lda ,x+                         ; get file name characater
                jsr L8E04                       ; send it
                cmpx #CFNBUF+9                  ; end of file name?
                bne L8D26                       ; brif not
                bsr L8D62                       ; output check byte and look for response
                bne L8D1B                       ; transmit name again if not ack
                bsr L8D72                       ; get file type (0xff is not found)
                bne L8D1B                       ; brif error
                sta 2,y                         ; save file type
                bsr L8D72                       ; read ASCII flag
                bne L8D1B                       ; brif error
                sta 3,y                         ; save ASCII flag
                bsr L8D6B                       ; read check byte
                bne L8D1B                       ; brif error
                leas 2,s                        ; lose attempt counter and check byte
                puls a,b,pc                     ; return file type and ascii flag
L8D48           inc ,y                          ; bump attempt counter
                lda ,y                          ; get new count
                cmpa #5                         ; done 5 times?
                blo L8D6A                       ; brif not
                lda #0xbc                       ; send abort code
                jsr L8E0C
                jmp LA619                       ; raise an I/O error
L8D58           pshs a                          ; save compare character
                bsr L8DB8                       ; send character
                bne L8D60                       ; brif read error
                cmpa ,s                         ; does it match? (set Z if good)
L8D60           puls a,pc                       ; restore character and return
L8D62           lda 1,y                         ; get XOR check byte
                bsr L8DB8                       ; send it and read
                bne L8D6A                       ; brif read error
                cmpa #0xc8                      ; is it ack? (set Z if so)
L8D6A           rts
L8D6B           bsr L8D72                       ; read character from rs232
                bne L8D6A                       ; brif error
                lda 1,y                         ; get check byte
                rts
L8D72           bsr L8DBC                       ; read a character from rs232
                pshs a,cc                       ; save result (and flags)
                eora 1,y                        ; accumulate xor checksum
                sta 1,y
                puls cc,a,pc                    ; restore byte, flags, and return
L8D7C           clra                            ; reset attempt counter
                pshs u,y,x,b,a                  ; make a stack frame
                asl 7,s                         ; split block number into two 7 bit chuncks
                rol 6,s
                lsr 7,s
                leay ,s                         ; set up frame pointer
                bra L8D8B
L8D89           bsr L8D48                       ; bump attempt counter
L8D8B           lda #0x97                       ; send block request code
                bsr L8D58
                bne L8D89                       ; brif error
                lda 6,y                         ; send out block number (high bits first)
                bsr L8E04
                lda 7,y
                bsr L8E04
                bsr L8D62                       ; send check byte and get ack
                bne L8D89                       ; brif error
                bsr L8D72                       ; read block size
                bne L8D89                       ; brif read error
                sta 4,y                         ; save character count
                ldx 2,y                         ; get buffer pointer
                ldb #128                        ; length of data block
L8DA7           bsr L8D72                       ; read a data byte
                bne L8D89                       ; brif error
                sta ,x+                         ; save byte in buffer
                decb                            ; done a whole block?
                bne L8DA7                       ; brif not
                bsr L8D6B                       ; read check byte
                bne L8D89                       ; brif error
                leas 4,s                        ; lose attempt counter, check byte, and buffer pointer
                puls a,b,x,pc                   ; return with character count in A, clean rest of stack
L8DB8           clr 1,y                         ; clear check byte
                bsr L8E0C                       ; output character
L8DBC           clra                            ; clear attempt counter
                pshs x,b,cc                     ; save registers and interrupt status
                orcc #0x50                      ; disable interrupts
                lda TIMOUT                      ; get timout delay (variable)
                ldx ZERO                        ; get constant timeout value
L8DC5           bsr L8DE6                       ; get RS232 status
                bcc L8DC5                       ; brif "space" - waiting for "mark"
L8DC9           bsr L8DE6                       ; get RS232 status
                bcs L8DC9                       ; brif "mark" - waiting for "space" (start bit)
                bsr L8DF9                       ; delay for half of bit time
                ldb #1                          ; set bit probe
                pshs b                          ; save it
                clra                            ; reset data byte
L8DD4           bsr L8DF7                       ; wait one bit time
                ldb PIA1+2                      ; get input bit to carry
                rorb
                bcc L8DDE                       ; brif "space" (0)
                ora ,s                          ; merge bit probe in
L8DDE           asl ,s                          ; shift bit probe over
                bcc L8DD4                       ; brif we haven't done 8 bits
                leas 1,s                        ; remove bit probe
                puls cc,b,x,pc                  ; restore interrupts, registers, and return
L8DE6           ldb PIA1+2                      ; get RS232 value
                rorb                            ; put in C
                leax 1,x                        ; bump timeout 
                bne L8DF6                       ; brif nonzero
                deca                            ; did the number of waits expire?
                bne L8DF6                       ; brif not
                leas 2,s                        ; don't return - we timed out
                puls cc,b,x                     ; restore interrupts and registers
                inca                            ; clear Z (A was zero above)
L8DF6           rts
L8DF7           bsr L8DF9                       ; do first half of bit delay then fall through for second
L8DF9           pshs a                          ; save register
                lda DLBAUD                      ; get baud rate constant
L8DFD           brn L8DFD                       ; do nothing - delay
                deca                            ; time expired?
                bne L8DFD                       ; brif not
                puls a,pc                       ; restore register and return
L8E04           pshs a                          ; save character to send
                eora 1,y                        ; accumulate chechsum
                sta 1,y
                puls a                          ; get character back
L8E0C           pshs b,a,cc                     ; save registers and interrupt status
                orcc #0x50                      ; disable interrupts
                bsr L8DF7                       ; do a bit delay
                bsr L8DF7                       ; do another bit delay
                clr PIA1                        ; set output to space (start bit)
                bsr L8DF7                       ; do a bit delay
                ldb #1                          ; bit probe start at LSB
                pshs b                          ; save bitprobe
L8E1D           lda 2,s                         ; get output byte
                anda ,s                         ; see what our current bit is
                beq L8E25                       ; brif output is 0
                lda #2                          ; set output to "marking"
L8E25           sta PIA1                        ; send bit
                bsr L8DF7                       ; do a bit delay
                asl ,s                          ; shift bit probe
                bcc L8E1D                       ; brif not last bit
                lda #2                          ; set output to marking ("stop" bit)
                sta PIA1
                leas 1,s                        ; lose bit probe
                puls cc,a,b,pc                  ; restore registers, interrupts, and return
; PRINT USING
; This is a massive block of code for something that has limited utility. It is *almost* flexible enough to
; be truly useful outside of a narrow range of use cases. Indeed, this comes in at about 1/8 of the total
; Extended Color Basic ROM.
;
; This uses several variables:
; VD5: pointer to format string descriptor
; VD7: next print item flag
; VD8: right digit counter
; VD9: left digit counter (or length of string argument)
; VDA: status byte (bits as follows):
;     6: force comma
;     5: force leading *
;     4: floating $
;     3: pre-sign
;     2: post-sign
;     0: scientific notation
L8E37           lda #1                          ; set length to use to 1
                sta VD9
L8E3B           decb                            ; consume character from format string
                jsr L8FD8                       ; show error flag if flags set
                jsr GETCCH                      ; get input character
                lbeq L8ED8                      ; brif end of line - bail
                stb VD3                         ; save remaining string length
                jsr LB156                       ; evaluate the argument
                jsr LB146                       ; error if numeric
                ldx FPA0+2                      ; get descriptor for argument
                stx V4D                         ; save it for later
                ldb VD9                         ; get length counter to use
                jsr LB6AD                       ; get B bytes of string space (do a LEFT$)
                jsr LB99F                       ; print the formatted string
                ldx FPA0+2                      ; get formatted string descriptor
                ldb VD9                         ; get requested length
                subb ,x                         ; see if we have any left over
L8E5F           decb                            ; have we got the right width?
                lbmi L8FB3                      ; brif so - go process more
                jsr LB9AC                       ; output a space
                bra L8E5F                       ; go see if we're done yet
L8E69           stb VD3                         ; save current format string counter and pointer
                stx TEMPTR
                lda #2                          ; initial spaces count = 2 (for the two %s)
                sta VD9                         ; save length counter
L8E71           lda ,x                          ; get character in string
                cmpa #'%                        ; is it the end of the sequence?
                beq L8E3B                       ; brif so - display requested part of the strign
                cmpa #0x20                      ; space?
                bne L8E82                       ; brif not
                inc VD9                         ; bump spaces count
                leax 1,x                        ; move format pointer forward
                decb                            ; consume character
                bne L8E71                       ; brif not end of format string
L8E82           ldx TEMPTR                      ; restore format string pointer
                ldb VD3                         ; get back format string length
                lda #'%                         ; show % as debugging aid
L8E88           jsr L8FD8                       ; send error indicator if flags set
                jsr PUTCHR                      ; output character
                bra L8EB9                       ; go process more format string
; PRINT extension for USING
XVEC9           cmpa #0xcd                      ; USING?
                beq L8E95                       ; brif so
                rts                             ; return to mainline code
; This is the main entry point for PRINT USING
L8E95           leas 2,s                        ; don't return to the mainline code
                jsr LB158                       ; evaluate the format string
                jsr LB146                       ; error if numeric
                ldb #';                         ; make sure there's a ; after the string
                jsr LB26F
                ldx FPA0+2                      ; get format string descriptor
                stx VD5                         ; save it for later
                bra L8EAE                       ; process format string
L8EA8           lda VD7                         ; is there a print item?
                beq L8EB4                       ; brif not
                ldx VD5                         ; get back format string descriptor
L8EAE           clr VD7                         ; reset next print item flag
                ldb ,x                          ; get length of format string
                bne L8EB7                       ; brif string is non-null
L8EB4           jmp LB44A                       ; raise FC error
L8EB7           ldx 2,x                         ; point to start of string
L8EB9           clr VDA                         ; clear status (new item)
L8EBB           clr VD9                         ; clear left digit counter
                lda ,x+                         ; get character from format string
                cmpa #'!                        ; ! (use first character of string)?
                lbeq L8E37                      ; brif so
                cmpa #'#                        ; digit?
                beq L8F24                       ; brif so - handle numeric
                decb                            ; consume format character
                bne L8EE2                       ; brif not done
                jsr L8FD8                       ; show a "+" if any flags set - indicates error at end of string
                jsr PUTCHR                      ; output format string character
L8ED2           jsr GETCCH                      ; get current input character
                bne L8EA8                       ; brif not end of statement
                lda VD7                         ; get next item flag
L8ED8           bne L8EDD                       ; brif more print items
                jsr LB958                       ; do newline
L8EDD           ldx VD5                         ; point to format string descriptor
                jmp LB659                       ; remove from string stack, etc., if appropriate (and return)
L8EE2           cmpa #'+                        ; is it + (pre-sign)?
                bne L8EEF                       ; brif not
                jsr L8FD8                       ; send a "+" if flags set
                lda #8                          ; flag for pre-sign
                sta VDA                         ; set flags
                bra L8EBB                       ; go interpret some more stuff
L8EEF           cmpa #'.                        ; decimal?
                beq L8F41                       ; brif so - numeric
                cmpa #'%                        ; % (show string)?
                lbeq L8E69                      ; brif so
                cmpa ,x                         ; do we have two identical characters?
L8EFB           bne L8E88                       ; brif not - invalid format character
                cmpa #'$                        ; double $?
                beq L8F1A                       ; brif so - floating $
                cmpa #'*                        ; double *?
                bne L8EFB                       ; brif not
                lda VDA                         ; get status byte
                ora #0x20                       ; enable * padding
                sta VDA
                cmpb #2                         ; is $$ the last two?
                blo L8F20                       ; brif so
                lda 1,x                         ; is it $ after?
                cmpa #'$
                bne L8F20                       ; brif not
                decb                            ; consume the "$"
                leax 1,x
                inc VD9                         ; add to digit counter * pad + $ counter
L8F1A           lda VDA                         ; indicate floating $
                ora #0x10
                sta VDA
L8F20           leax 1,x                        ; consume the second format character
                inc VD9                         ; add one more left place
L8F24           clr VD8                         ; clear right digit counter
L8F26           inc VD9                         ; bump left digit counter
                decb                            ; consume character
                beq L8F74                       ; brif end of string
                lda ,x+                         ; get next format character
                cmpa #'.                        ; decimal?
                beq L8F4F                       ; brif so
                cmpa #'#                        ; digit?
                beq L8F26                       ; brif so
                cmpa #',                        ; comma flag?
                bne L8F5A                       ; brif not
                lda VDA                         ; set commas flag
                ora #0x40
                sta VDA
                bra L8F26                       ; handle more characters to left of decimal
L8F41           lda ,x                          ; get character after .
                cmpa #'#                        ; digit?
                lbne L8E88                      ; brif not - invalid
                lda #1                          ; set right digit counter to 1 (for the .)
                sta VD8
                leax 1,x                        ; consume the .
L8F4F           inc VD8                         ; add one to right digit counter
                decb                            ; consume character
                beq L8F74                       ; brif end of format string
                lda ,x+                         ; get another format character
                cmpa #'#                        ; digit?
                beq L8F4F                       ; brif so
L8F5A           cmpa #0x5e                      ; up arrow?
                bne L8F74                       ; brif not
                cmpa ,x                         ; two of them?
                bne L8F74                       ; brif not
                cmpa 1,x                        ; three of them?
                bne L8F74                       ; brif not
                cmpa 2,x                        ; four of them?
                bne L8F74                       ; brif not
                cmpb #4                         ; string actually has the characters?
                blo L8F74                       ; brif not
                subb #4                         ; consome them
                leax 4,x
                inc VDA                         ; set scientific notation bit
L8F74           leax -1,x                       ; back up input pointer
                inc VD9                         ; add one digit for pre-sign force
                lda VDA                         ; is it pre-sign?
                bita #8
                bne L8F96                       ; brif so
                dec VD9                         ; undo pre-sign adjustment
                tstb                            ; end of string?
                beq L8F96                       ; brif so
                lda ,x                          ; get next character
                suba #'-                        ; post sign force?
                beq L8F8F                       ; brif so
                cmpa #'+-'-                     ; plus?
                bne L8F96                       ; brif not
                lda #8                          ; trailing + is a pre-sign force
L8F8F           ora #4                          ; add in post sign flag
                ora VDA                         ; merge with flags
                sta VDA
                decb                            ; consume character
L8F96           jsr GETCCH                      ; do we have an argument
                lbeq L8ED8                      ; brif not
                stb VD3                         ; save format string length
                jsr LB141                       ; evluate numeric expression
                lda VD9                         ; get left digit counter
                adda VD8                        ; add in right digit counter
                cmpa #17                        ; is it more than 16 digits + decimal?
                lbhi LB44A                      ; brif so - this is a problem
                jsr L8FE5                       ; format value according to settings
                leax -1,x                       ; move buffer pointer back
                jsr STRINOUT                    ; display formatted number string
L8FB3           clr VD7                         ; reset next print item flag
                jsr GETCCH                      ; get current input character
                beq L8FC6                       ; brif end of statement
                sta VD7                         ; set next print flag to nonzero
                cmpa #';                        ; list separator ;?
                beq L8FC4                       ; brif so
                jsr SYNCOMMA                    ; require a comma between if not ;
                bra L8FC6                       ; process next item
L8FC4           jsr GETNCH                      ; munch the semicolon
L8FC6           ldx VD5                         ; get format string descriptor
                ldb ,x                          ; get length of string
                subb VD3                        ; subtract amount left after last item
                ldx 2,x                         ; point to string address
                abx                             ; move pointer to correct spot
                ldb VD3                         ; get remaining string length
                lbne L8EB9                      ; if we have more, interpret from there
                jmp L8ED2                       ; re-interpret from start if we hit the end
L8FD8           pshs a                          ; save character
                lda #'+                         ; "error" flag character
                tst VDA                         ; did we have some flags set?
                beq L8FE3                       ; brif not
                jsr PUTCHR                      ; output error flag
L8FE3           puls a,pc                       ; restore character and return
L8FE5           ldu #STRBUF+4                   ; point to string buffer
                ldb #0x20                       ; blank space
                lda VDA                         ; get flags
                bita #8                         ; pre-sign?
                beq L8FF2                       ; brif not
                ldb #'+                         ; plus sign
L8FF2           tst FP0SGN                      ; get sign of value
                bpl L8FFA                       ; brif positive
                clr FP0SGN                      ; make number positive (for later)
                ldb #'-                         ; negative sign
L8FFA           stb ,u+                         ; put sign in buffer
                ldb #'0                         ; put a zero there
                stb ,u+
                anda #1                         ; check scientific notation force
                lbne L910D                      ; brif so
                ldx #LBDC0                      ; point to FP 1E+9
                jsr LBCA0                       ; is it less?
                bmi L9023                       ; brif so
                jsr LBDD9                       ; convert FP number to string (we're doing scientific notation)
L9011           lda ,x+                         ; advance pointer to end of string
                bne L9011
L9015           lda ,-x                         ; make a hole at the start
                sta 1,x
                cmpx #STRBUF+3                  ; done yet?
                bne L9015                       ; brif not
                lda #'%                         ; put "overflow" flag at start
                sta ,x
                rts
L9023           lda FP0EXP                      ; get exponent of value
                sta V47                         ; save it
                beq L902C                       ; brif value is 0
                jsr L91CD                       ; convert to number with 9 significant figures to left of decimal
L902C           lda V47                         ; get base 10 exponent offset
                lbmi L90B3                      ; brif < 100,000,000
                nega                            ; get negative difference
                adda VD9                        ; add to number of left digits
                suba #9                         ; account for the 9 we actually have
                jsr L90EA                       ; put leading zeroes in buffer
                jsr L9263                       ; initialize the decimal point and comma counters
                jsr L9202                       ; convert FPA0 to decimal ASCII in buffer
                lda V47                         ; get base 10 exponent
                jsr L9281                       ; put that many zeroes in buffer, stop at decimal point
                lda V47                         ; get base 10 exponent
                jsr L9249                       ; check for decimal
                lda VD8                         ; get right digit counter
                bne L9050                       ; brif we want stuff after decimal
                leau -1,u                       ; delete decimal if not needed
L9050           deca                            ; subtract one place (for decimal)
                jsr L90EA                       ; put zeroes in buffer (trailing)
L9054           jsr L9185                       ; insert * padding, floating $, and post-sign
                tsta                            ; was there a post sign?
                beq L9060                       ; brif not
                cmpb #'*                        ; was first character a *?
                beq L9060                       ; brif so
                stb ,u+                         ; store the post sign
L9060           clr ,u                          ; make srue it's NUL terminated
                ldx #STRBUF+3                   ; point to start of buffer
L9065           leax 1,x                        ; move to next character
                stx TEMPTR                      ; save it for later
                lda VARPTR+1                    ; get address of decimal point
                suba TEMPTR+1                   ; subtract out actual digits left of decimal
                suba VD9                        ; subtract out required left digits
                beq L90A9                       ; brif no padding needed
                lda ,x                          ; get current character
                cmpa #0x20                      ; space?
                beq L9065                       ; brif so - advance pointer
                cmpa #'*                        ; *?
                beq L9065                       ; brif so - advance pointer
                clra                            ; zero on stack is end of data ponter
L907C           pshs a                          ; save character on stack
                lda ,x+                         ; get next character
                cmpa #'-                        ; minus?
                beq L907C                       ; brif so
                cmpa #'+                        ; plus?
                beq L907C                       ; brif so
                cmpa #'$                        ; $?
                beq L907C                       ; brif so
                cmpa #'0                        ; zero?
                bne L909E                       ; brif not
                lda 1,x                         ; get character after 0
                bsr L90AA                       ; clear carry if number
                bcs L909E                       ; brif not number
L9096           puls a                          ; get character off stack
                sta ,-x                         ; put it back in string buffer
                bne L9096                       ; brif not - restore another
                bra L9065                       ; keep cleaning up buffer
L909E           puls a                          ; get the character on the stack
                tsta                            ; is it NUL?
                bne L909E                       ; brif not
                ldx TEMPTR                      ; get string buffer start pointer
                lda #'%                         ; put error flag in front
                sta ,-x
L90A9           rts
L90AA           cmpa #'0                        ; zero?
                blo L90B2                       ; brif not
                suba #'9+1                      ; set C if > "9"
                suba #-('9+1)
L90B2           rts
L90B3           lda VD8                         ; get right digit counter
                beq L90B8                       ; brif not right digits
                deca                            ; account for decimal point
L90B8           adda V47                        ; add base 10 exponent offset
                bmi L90BD                       ; if >= 0, no shifts are required
                clra                            ; force shift counter to 0
L90BD           pshs a                          ; save shift counter
L90BF           bpl L90CB                       ; brif positive count
                pshs a                          ; save shift counter
                jsr LBB82                       ; divide FPA0 by 10 (shift 1 digit to the right)
                puls a                          ; get shift counter back
                inca                            ; account for the shift
                bra L90BF                       ; see if we're done yet
L90CB           lda V47                         ; get base 10 exponent offset
                suba ,s+                        ; account for adjustment
                sta V47                         ; save new exponent offset
                adda #9                         ; account for significant places
                bmi L90EE                       ; brif we don't need zeroes to left
                lda VD9                         ; get left decimal counter
                suba #9                         ; account for significant figures
                suba V47                        ; subtract exponent offset
                bsr L90EA                       ; output leading zeroes
                jsr L9263                       ; initialize decimal and comma counters
                bra L90FF                       ; process remainder of digits
L90E2           pshs a                          ; save zero counter
                lda #'0                         ; insert a 0
                sta ,u+
                puls a                          ; get back counter
L90EA           deca                            ; do we need more zeroes?
                bpl L90E2                       ; brif so
                rts
L90EE           lda VD9                         ; get left digit counter
                bsr L90EA                       ; put that many zeroes in
                jsr L924D                       ; put decimal in buffer
                lda #-9                         ; figure out filler zeroes
                suba V47
                bsr L90EA                       ; output required leader zeroes
                clr V45                         ; clear decimal pointer counter
                clr VD7                         ; clear comma counter
L90FF           jsr L9202                       ; decode FPA0 to decimal string
                lda VD8                         ; get right digit counter
                bne L9108                       ; brif there are right digits
                ldu VARPTR                      ; point to decimal location of decimal
L9108           adda V47                        ; add base 10 exponent
                lbra L9050                      ; add in leading astrisks, etc.
L910D           lda FP0EXP                      ; get exponent of FPA0
                pshs a                          ; save it
                beq L9116                       ; brif 0
                jsr L91CD                       ; convert to number with 9 figures
L9116           lda VD8                         ; get right digit counter
                beq L911B                       ; brif no right digits
                deca                            ; account for decimal point
L911B           adda VD9                        ; get left digit counter
                clr STRBUF+3                    ; use buffer byte as temporary storage
                ldb VDA                         ; get status flags
                andb #4                         ; post-sign?
                bne L9129                       ; brif so
                com STRBUF+3                    ; flip byte if no post sign
L9129           adda STRBUF+3                   ; subtract 1 if no post sign
                suba #9                         ; account for significant figures
                pshs a                          ; save shift counter
L9130           bpl L913C                       ; brif no more shifts needed
                pshs a                          ; save counter
                jsr LBB82                       ; divide by 10 (shift right one)
                puls a                          ; get back counter
                inca                            ; account for the shift
                bra L9130                       ; see if we need more
L913C           lda ,s                          ; get original shift count
                bmi L9141                       ; brif shifting happened
                clra                            ; flag for no shifting
L9141           nega                            ; calculate position of decimal (negate shift count, add left digit and post sign if needed)
                adda VD9                        ; add left digit counter
                inca                            ; and post sign
                adda STRBUF+3
                sta V45                         ; save decimal counter
                clr VD7                         ; clear comma counter
                jsr L9202                       ; convert to decimal string
                puls a                          ; get shift counter
                jsr L9281                       ; put the needed zeroes in
                lda VD8                         ; get right digit counter
                bne L915A                       ; brif we want some
                leau -1,u                       ; remove te decimal point
L915A           ldb ,s+                         ; get original exponent
                beq L9167                       ; brif it was 0
                ldb V47                         ; get base 10 exponent
                addb #9                         ; account for significant figures
                subb VD9                        ; remove left digit count
                subb STRBUF+3                   ; add one if post sign
L9167           lda #'+                         ; positive sign
                tstb                            ; is base 10 exponent positive?
                bpl L916F                       ; brif so
                lda #'-                         ; negative sign
                negb                            ; flip exponent
L916F           sta 1,u                         ; put exponent sign
                lda #'E                         ; put "E" and advance output pointer
                sta ,u++
                lda #'0-1                       ; initialize digit accumulator
L9177           inca                            ; bump digit
                subb #12                        ; are we at the right digit?
                bcc L9177                       ; brif not
                addb #'0+12                     ; add ASCII bias and undo extra subtraction
                std ,u++                        ; save exponent in buffer
                clr ,u                          ; clear final byte in buffer
                jmp L9054                       ; insert *, $, etc.
L9185           ldx #STRBUF+4                   ; point to start of result
                ldb ,x                          ; get sign
                pshs b                          ; save it
                lda #0x20                       ; default pad with spaces
                ldb VDA                         ; get flags
                bitb #0x20                      ; padding with *?
                puls b
                beq L919E                       ; brif no padding
                lda #'*                         ; pad with *
                cmpb #0x20                      ; do we have a blank? (positive)
                bne L919E                       ; brif not
                tfr a,b                         ; use pad character
L919E           pshs b                          ; save first character
L91A0           sta ,x+                         ; store padding
                ldb ,x                          ; get next character
                beq L91B6                       ; brif end of string
                cmpb #'E                        ; exponent?
                beq L91B6                       ; brif so - treat as 0
                cmpb #'0                        ; zero?
                beq L91A0                       ; brif so - pad it
                cmpb #',                        ; leading comma?
                beq L91A0                       ; brif so - pad it
                cmpb #'.                        ; decimal?
                bne L91BA                       ; brif so - don't put a 0 before it
L91B6           lda #'0                         ; put a zero before
                sta ,-x
L91BA           lda VDA                         ; get status byte
                bita #0x10                      ; floating $?
                beq L91C4                       ; brif not
                ldb #'$                         ; stuff a $ in
                stb ,-x
L91C4           anda #4                         ; pre-sgn?
                puls b                          ; get back first character
                bne L91CC                       ; brif not
                stb ,-x                         ; save leading character (sign)
L91CC           rts
L91CD           pshs u                          ; save buffer pointer
                clra                            ; initial exponent offset is 0
L91D0           sta V47                         ; save exponent offset
                ldb FP0EXP                      ; get actual exponent
                cmpb #0x80                      ; is value >= 1.0?
                bhi L91E9                       ; brif so
                ldx #LBDC0                      ; point to FP number 1E9
                jsr LBACA                       ; multiply by 1000000000
                lda V47                         ; account for 9 shifts
                suba #9
                bra L91D0                       ; brif not there yet
L91E4           jsr LBB82                       ; divide by 10
                inc V47                         ; account for shift
L91E9           ldx #LBDBB                      ; point to 999999999
                jsr LBCA0                       ; compare it
                bgt L91E4                       ; brif not in range yet
L91F1           ldx #LBDB6                      ; point to 99999999.9
                jsr LBCA0                       ; compare
                bgt L9200                       ; brif in range
                jsr LBB6A                       ; multiply by 10
                dec V47                         ; account for shift
                bra L91F1                       ; see if we're in range yet
L9200           puls u,pc                       ; restore buffer pointer and return
L9202           pshs u                          ; save buffer pointer           
                jsr LB9B4                       ; add .5 (round off)
                jsr LBCC8                       ; convert to integer format
                puls u                          ; restore buffer pointer
                ldx #LBEC5                      ; point to 32 bit powers of 10 (alternating signs)
                ldb #0x80                       ; intitial digit counter is 0 with 0x80 bias
L9211           bsr L9249                       ; check for comma
L9213           lda FPA0+3                      ; add a power of 10
                adda 3,x
                sta FPA0+3
                lda FPA0+2
                adca 2,x
                sta FPA0+2
                lda FPA0+1
                adca 1,x
                sta FPA0+1
                lda FPA0
                adca ,x
                sta FPA0
                incb                            ; add one to digit counter
                rorb                            ; set V if carry and sign differ
                rolb
                bvc L9213                       ; brif we haven't "wrapped"
                bcc L9235                       ; brif subtracting
                subb #10+1                      ; take 9's complement if adding
                negb
L9235           addb #'0-1                      ; add in ASCII bias
                leax 4,x                        ; move to next power
                tfr b,a                         ; save digit
                anda #0x7f                      ; mask off subtract flag
                sta ,u+                         ; save digit
                comb                            ; toggle add/subtract
                andb #0x80
                cmpx #LBEE9                     ; done all places?
                bne L9211                       ; brif not
                clr ,u                          ; but NUL at end
L9249           dec V45                         ; at decimal?
                bne L9256                       ; brif not
L924D           stu VARPTR                      ; save decimal point pointer
                lda #'.                         ; insert decimal
                sta ,u+
                clr VD7                         ; clear comma counter
                rts
L9256           dec VD7                         ; do we need a comma?
                bne L9262                       ; brif not
                lda #3                          ; reset comma counter
                sta VD7
                lda #',                         ; insert comma
                sta ,u+
L9262           rts
L9263           lda V47                         ; get base 10 exponent offset
                adda #10                        ; account for significant figures
                sta V45                         ; save decimal counter
                inca                            ; add one for decimal point
L926A           suba #3                         ; divide by 3, leave remainder in A
                bcc L926A
                adda #5                         ; renormalize to range 1-3
                sta VD7                         ; save comma counter
                lda VDA                         ; get status
                anda #0x40                      ; commas wanted?
                bne L927A                       ; brif not
                sta VD7                         ; clear comma counter
L927A           rts
L927B           pshs a                          ; save zeroes counter
                bsr L9249                       ; check for decimal
                puls a                          ; get back counter
L9281           deca                            ; need a zero?
                bmi L928E                       ; brif not
                pshs a                          ; save counter
                lda #'0                         ; put a zero
                sta ,u+
                lda ,s+                         ; get back counter and set flags
                bne L927B                       ; brif not done enough
L928E           rts
; From here to the end of the Extended Basic ROM is the PMODE graphics system and related
; infrastructure with the exception of the PLAY command which shares some of its machinery
; with the DRAW command.
;
; Fetch screen address calculation routine address for the selected graphics mode
L928F           ldu #L929C                      ; point to normalization routine jump table
                lda PMODE                       ; get graphics mode
                asla                            ; two bytes per address
                ldu a,u                         ; get routine address
                rts
; Normalize VERBEG/HORBEG coordinates and return screen address in X and pixel mask in A.
L9298           bsr L928F                       ; fetch normalization routine pointer
                jmp ,u                          ; transfer control to it
L929C           fdb L92A6                       ; PMODE 0
                fdb L92C2                       ; PMODE 1
                fdb L92A6                       ; PMODE 2
                fdb L92C2                       ; PMODE 3
                fdb L92A6                       ; PMODE 4
; Two colour mode address calculatoin
L92A6           pshs u,b                        ; savce registers
                ldb HORBYT                      ; get number of bytes in each graphics row
                lda VERBEG+1                    ; get vertical coordinate
                mul
                addd BEGGRP                     ; now D is the absolute address of the start of the row
                tfr d,x                         ; get address to the return location
                ldb HORBEG+1                    ; get horizontal coordinate
                lsrb                            ; divide by 8 (8 pixels per byte in 2 colour mode)
                lsrb
                lsrb
                abx                             ; now X is the address of the actual pixel byte
                lda HORBEG+1                    ; get horizontal coordinate
                anda #7                         ; keep only the low 3 bits which contain the pixel number
                ldu #L92DD                      ; point to pixel mask lookup
                lda a,u                         ; get pixel mask
                puls b,u,pc                     ; restore registers and return result
; four colour address calculation
L92C2           pshs u,b                        ; save registers
                ldb HORBYT                      ; get bytes per graphics row
                lda VERBEG+1                    ; get vertical coordinate
                mul
                addd BEGGRP                     ; now D is the address of the start of the row
                tfr d,x                         ; put it in returnlocatin
                ldb HORBEG+1                    ; get horizontal coordinate
                lsrb                            ; divide by 4 (four colour modes have four pixels per byte)
                lsrb
                abx                             ; now X points to the screen byte
                lda HORBEG+1                    ; get horizontal coordinate
                anda #3                         ; keep low two bits for pixel number
                ldu #L92E5                      ; point to four colour pixel masks
                lda a,u                         ; get pixel mask
                puls b,u,pc                     ; restore registers and return result
L92DD           fcb 0x80,0x40,0x20,0x10         ; two colour pixel masks
                fcb 0x08,0x04,0x02,0x01
L92E5           fcb 0xc0,0x30,0x0c,0x03         ; four colour pixel masks
;  Move X down one graphics row
L92E9           ldb HORBYT                      ; get bytes per row
                abx                             ; add to screen address
                rts
; Move one pixel right in 2 colour mode
L92ED           lsra                            ; move pixel mask right
                bcc L92F3                       ; brif same byte
                rora                            ; move pixel mask to left of byte
                leax 1,x                        ; move to next byte
L92F3           rts
; Move one pixel right in 4 colour mode
L92F4           lsra                            ; shift mask half a pixel right
                bcc L92ED                       ; brif not past end of byte - shift one more
                lda #0xc0                       ; set mask on left of byte
                leax 1,x                        ; move to next byte
                rts
; Evaluate two expressions (coordinates). Put first in HORBEG and second in VERBEG.
L92FC           jsr LB734                       ; evaluate two expressions - first in BINVAL, second in B
                ldy #HORBEG                     ; point to storage location
L9303           cmpb #192                       ; is vertical outside range?
                blo L9309                       ; brif not
                ldb #191                        ; max it at bottom of screen
L9309           clra                            ; zero extend vertical coordinate
                std 2,y                         ; save vertical coordinate
                ldd BINVAL                      ; get horizontal coordinate
                cmpd #256                       ; in range?
                blo L9317                       ; brif so
                ldd #255                        ; max it out to right side of screen
L9317           std ,y                          ; save horizontal coordinate
                rts
; Normalize coordinates for proper PMODE
L931A           jsr L92FC                       ; parse coordinates
L931D           ldu #HORBEG                     ; point to start coordinates
L9320           lda PMODE                       ; get graphics mode
                cmpa #2                         ; is it pmode 0 or 1?
                bhs L932C                       ; brif not
                ldd 2,u                         ; get vertical coordinate
                lsra                            ; divide it by two
                rorb
                std 2,u                         ; save it back
L932C           lda PMODE                       ; get graphics mode
                cmpa #4                         ; pmode 4?
                bhs L9338                       ; brif so
                ldd ,u                          ; cut horizontal coordinate in half
                lsra
                rorb
                std ,u                          ; save new coordinate
L9338           rts
; PPOINT function
PPOINT          jsr L93B2                       ; evaluate two expressions (coordinates)
                jsr L931D                       ; normalize coordinates
                jsr L9298                       ; get screen address
                anda ,x                         ; get colour value of desired screen coordinate
                ldb PMODE                       ; get graphics mode
                rorb                            ; is it a two colour m ode?
                bcc L935B                       ; brif so
L9349           cmpa #4                         ; is it on rightmost bits?
                blo L9351                       ; brif not
                rora                            ; shift right
                rora
                bra L9349                       ; see if we're there yet
L9351           inca                            ; colour numbers start at 1
                asla                            ; add in colour set (0 or 8)
                adda CSSVAL
                lsra                            ; get colour in range of 0 to 8
L9356           tfr a,b                         ; put result to B
                jmp LB4F3                       ; return B as FP number
L935B           tsta                            ; is pixel on?
                beq L9356                       ; brif not, return 0 (off)
                clra                            ; set colour number to "1"
                bra L9351                       ; make it 1 or 5 and return
; PSET command
PSET            lda #1                          ; PSET flag
                bra L9366                       ; go turn on the pixel
; PRESET command
PRESET          clra                            ; PRESET flag
L9366           sta SETFLG                      ; store whether we're setting or resetting
                jsr LB26A                       ; enforce (
                jsr L931A                       ; evaluate coordinates
                jsr L9581                       ; evaluate colour
                jsr LB267                       ; enforce )
                jsr L9298                       ; get address of pixel
L9377           ldb ,x                          ; get screen data
                pshs b                          ; save it
                tfr a,b                         ; duplicate pixel mask
                coma                            ; invert mask
                anda ,x                         ; turn off screen pixel
                andb ALLCOL                     ; adjust pixel mask to be the current colour
                pshs b                          ; merge pixel data into the screen data
                ora ,s+
                sta ,x                          ; put it on screen
                suba ,s+                        ; nonzero if screen data changed
                ora CHGFLG                      ; propagate change flag
                sta CHGFLG
                rts
; Evaluate two sets of coordinates separated by a minus sign. First at HORBEG,VERBEG and
; second at HOREND,VEREND. If no first set, use HORDEF,VERDEF.
L938F           ldx HORDEF                      ; set default start coords
                stx HORBEG
                ldx VERDEF
                stx VERBEG
                cmpa #0xac                      ; do we start with a -?
                beq L939E                       ; brif no starting coordinates
                jsr L93B2                       ; parse coordinates
L939E           ldb #0xac                       ; make sure we have a -
                jsr LB26F
                jsr LB26A                       ; require a (
                jsr LB734                       ; evaluate two expressions
                ldy #HOREND                     ; point to storage location
                jsr L9303                       ; process coordinates
                bra L93B8                       ; finish up with a )
L93B2           jsr LB26A                       ; make sure there's a (
                jsr L92FC                       ; evaluate coordinates
L93B8           jmp LB267                       ; force a )
; LINE command
LINE            cmpa #0x89                      ; is it LINE INPUT?
                lbeq L89C0                      ; brif so - go handle it
                cmpa #'(                        ; starting coord?
                beq L93CE                       ; brif so
                cmpa #0xac                      ; leading -?
                beq L93CE                       ; brif so
                ldb #'@                         ; if it isn't the above, make sure it's @
                jsr LB26F
L93CE           jsr L938F                       ; parse coordinates
                ldx HOREND                      ; set ending coordinates as the defaults
                stx HORDEF
                ldx VEREND
                stx VERDEF
                jsr SYNCOMMA                    ; make sure we have a comma
                cmpa #0xbe                      ; PRESET?
                beq L93E9                       ; brif so
                cmpa #0xbd                      ; PSET?
                lbne LB277                      ; brif not
                ldb #01                         ; PSET flag
                skip1lda                        ; skip byte and set A nonzero
L93E9           clrb                            ; PRESET flag
                pshs b                          ; save PSET/PRESET flag
                jsr GETNCH                      ; eat the PSET/PRESET
                jsr L9420                       ; normalize coordinates
                puls b                          ; get back PSET/PRESET flag
                stb SETFLG                      ; flag which we're doing
                jsr L959A                       ; set colour byte
                jsr GETCCH                      ; get next bit
                lbeq L94A1                      ; brif no box option
                jsr SYNCOMMA                    ; make sure it's comma
                ldb #'B                         ; make sure "B" for "box"
                jsr LB26F
                bne L9429                       ; brif something follows the B
                bsr L9444                       ; draw horizontal line
                bsr L946E                       ; draw vertical line
                ldx HORBEG                      ; save horizontal coordinate
                pshs x                          ; save it
                ldx HOREND                      ; switch in horizontal end
                stx HORBEG
                bsr L946E                       ; draw vertical line
                puls x                          ; get back original start
                stx HORBEG                      ; put it back
                ldx VEREND                      ; do the same dance with the vertical end
                stx VERBEG
                bra L9444                       ; draw horizontal line
L9420           jsr L931D                       ; normalize the start coordinates
                ldu #HOREND                     ; point to end coords
                jmp L9320                       ; normalize those coordinates
L9429           ldb #'F                         ; make sure we have "BF" for "filled box"
                jsr LB26F
                bra L9434                       ; fill the box
L9430           leax -1,x                       ; move vertical coordinate up one
L9432           stx VERBEG                      ; save new vertical coordinate
L9434           jsr L9444                       ; draw a horizontal line
                ldx VERBEG                      ; are we at the end of the box?
                cmpx VEREND
                beq L9443                       ; brif so
                bcc L9430                       ; brif we're moving up the screen
                leax 1,x                        ; move down the screen
                bra L9432                       ; go draw another line
L9443           rts
; Draw a horizontal line from HORBEG to HOREND at VERBEG using color mask in ALLCOL
L9444           ldx HORBEG                      ; get starting horizontal coordinate
                pshs x                          ; save it
                jsr L971D                       ; get absolute value of HOREND-HORBEG
                bcc L9451                       ; brif end is > start
                ldx HOREND                      ; copy end coordinate to start it is smaller
                stx HORBEG
L9451           tfr d,y                         ; save difference - it's a pixel count
                leay 1,y                        ; coordinates are inclusive
                jsr L9298                       ; get screen position of start coord
                puls u                          ; restore original start coordinate
                stu HORBEG
                bsr L9494                       ; point to routine to move pizel pointers to right
L945E           sta VD7                         ; save pixel mask
                jsr L9377                       ; turn on pixel
                lda VD7                         ; get pixel mask back
                jsr ,u                          ; move one pixel right
                leay -1,y                       ; turned on enough pixels yet?
                bne L945E                       ; brif not
L946B           rts
L946C           puls b,a                        ; clean up stack
L946E           ldd VERBEG                      ; save original vertical start coordinate
                pshs b,a
                jsr L9710                       ; get vertical difference
                bcc L947B                       ; brif end coordinate > start
                ldx VEREND                      ; swap in end coordinate if not
                stx VERBEG
L947B           tfr d,y                         ; save number of pixels to set
                leay 1,y                        ; the coordinates are inclusive
                jsr L9298                       ; get screen pointer
                puls u                          ; restore start coordinate
                stu VERBEG
                bsr L949D                       ; point to routine to move down one row
                bra L945E                       ; draw vertical line
; Point to routine which will move one pixel right
L948A           fdb L92ED                       ; PMODE 0
                fdb L92F4                       ; PMODE 1
                fdb L92ED                       ; PMODE 2
                fdb L92F4                       ; PMODE 3
                fdb L92ED                       ; PMODE 4
L9494           ldu #L948A                      ; point to jump table
                ldb PMODE                       ; get graphics mode
                aslb                            ; two bytes per address
                ldu b,u                         ; get jump address
                rts
; Point to routine to move down one row
L949D           ldu #L92E9                      ; point to "move down one row" routien
                rts
; Draw a line from HORBEG,VERBEG to HOREND,VEREND
L94A1           ldy #L950D                      ; point to increase vertical coord
                jsr L9710                       ; calculate difference
                lbeq L9444                      ; brif none - draw a horizontal line
                bcc L94B2                       ; brif vertical end is > vertical start
                ldy #L951B                      ; point to decrease vertical coord
L94B2           pshs d                          ; save vertical difference
                ldu #L9506                      ; point to increase horizontal coord
                jsr L971D                       ; get difference
                beq L946C                       ; brif none - draw a vertical line
                bcc L94C1                       ; brif horizontal end > horizontal start
                ldu #L9514                      ; point to decrease hoizontal coord
L94C1           cmpd ,s                         ; compare vert and horiz differences
                puls x                          ; get X difference
                bcc L94CC                       ; brif horiz diff > vert diff
                exg u,y                         ; swap change routine pointers
                exg d,x                         ; swap differences
L94CC           pshs u,d                        ; save larger difference and routine
                pshs d                          ; save larger difference
                lsra                            ; divide by two
                rorb
                bcs L94DD                       ; brif odd number
                cmpu #L950D+1                   ; increase or decrease?
                blo L94DD                       ; brif increase
                subd #1                         ; back up one
L94DD           pshs x,b,a                      ; save smallest difference and initial middle offset
                jsr L928F                       ; point to proper coordinate to screen conversion routine
L94E2           jsr ,u                          ; convert coordinates to screen address
                jsr L9377                       ; turn on a pixel
                ldx 6,s                         ; get distnace counter
                beq L9502                       ; brif line is completely drawn
                leax -1,x                       ; account for one pixel drawn
                stx 6,s                         ; save new counter
                jsr [8,s]                       ; increment/decrement larger delta
                ldd ,s                          ; get the minor coordinate increment counter
                addd 2,s                        ; add the smallest difference
                std ,s                          ; save new minor coordinate incrementcounter
                subd 4,s                        ; subtractout the largest difference
                bcs L94E2                       ; brif not greater - draw another pixel
                std ,s                          ; save new minor coordinate increment
                jsr ,y                          ; adjust minor coordinate
                bra L94E2                       ; go draw another pixel
L9502           puls x                          ; clean up stack and return
                puls a,b,x,y,u,pc
L9506           ldx HORBEG                      ; bump horizontal coordinate
                leax 1,x
                stx HORBEG
                rts
L950D           ldx VERBEG                      ; bump vertical coordinate
                leax 1,x
                stx VERBEG
                rts
L9514           ldx HORBEG                      ; decrement horizontal coordinate
                leax -1,x
                stx HORBEG
                rts
L951B           ldx VERBEG                      ; decrement vertical coordinate
                leax -1,x
                stx VERBEG
                rts
; Get normalized maximum coordinate values in VD3 and VD5
L9522           ldu #VD3                        ; point to temp storage
                ldx #255                        ; set maximum horizontal
                stx ,u
                ldx #191                        ; set maximum vertical
                stx 2,u
                jmp L9320                       ; normalize them
; PCLS command
PCLS            beq L9542                       ; clear to background colour if no argument
                bsr L955A                       ; evaluate colour
L9536           lda #0x55                       ; consider each byte as 4 groups of 2 bit sub-nibbles
                mul                             ; now colour is in all four sub-pixels
                ldx BEGGRP                      ; get start of graphics screen
L953B           stb ,x+                         ; set byte to proper colour
                cmpx ENDGRP                     ; at end of graphics page?
                bne L953B                       ; brif not
                rts
L9542           ldb BAKCOL                      ; get background colour
                bra L9536                       ; do the clearing dance
; COLOR command
COLOR           cmpa #',                        ; check for comma
                beq L9552                       ; brif no foreground colour
                bsr L955A                       ; evaluate first colour
                stb FORCOL                      ; set foreground colour
                jsr GETCCH                      ; is there a background colour?
                beq L9559                       ; brif not
L9552           jsr SYNCOMMA                    ; make sure we have a comma
                bsr L955A                       ; evaluate background colour argument
                stb BAKCOL                      ; set background colour
L9559           rts
; Evaluate a colour agument and convert to proper code based on graphics mode
L955A           jsr EVALEXPB                    ; evaluate colour code
L955D           cmpb #9                         ; is it in range of 0-8?
                lbhs LB44A                      ; brif not - raise error
                clra                            ; CSS value for first colour set
                cmpb #5                         ; is it first or second colour set?
                blo L956C                       ; brif first colour set
                lda #8                          ; flag second colour set
                subb #4                         ; adjust into basic range
L956C           pshs a                          ; save CSS value
                lda PMODE                       ; get graphics mode
                rora                            ; 4 colour or 2?
                bcc L957B                       ; brif 2 colour
                tstb                            ; was it 0?
                bne L9578                       ; brif not
L9576           ldb #4                          ; if so, make it 4
L9578           decb                            ; convert to zero based
L9579           puls a,pc                       ; get back CSS value and return
L957B           rorb                            ; is colour number odd?
                bcs L9576                       ; brif so - force all bits set colour
                clrb                            ; force colour 0 if not
                bra L9579
; Set all pixel byte and active colour
L9581           jsr L959A                       ; set colour byte
                jsr GETCCH                      ; is there something to evaluate?
                beq L9598                       ; brif not
                cmpa #')                        ; )?
                beq L9598                       ; brif so
                jsr SYNCOMMA                    ; force comma
                cmpa #',                        ; another comma?
                beq L9598                       ; brif so
                jsr L955A                       ; evaluate expression and return colour
                bsr L95A2                       ; save colour and pixel byte
L9598           jmp GETCCH                      ; re-fetch input character and return
L959A           ldb FORCOL                      ; use foreground colour by default
                tst SETFLG                      ; doing PRESET?
                bne L95A2                       ; brif not
                ldb BAKCOL                      ; default to background colour
L95A2           stb WCOLOR                      ; save working colour
                lda #0x55                       ; consider a byte as 4 pixels
                mul                             ; now all pixels are set to the same bit pattern
                stb ALLCOL                      ; set all pixels byte
                rts
L95AA           bne L95CF                       ; brif graphics mode
L95AC           pshs x,b,a                      ; save registers
                ldx #SAMREG+8                   ; point to middle of control register
                sta 10,x                        ; reset display page to 0x400
                sta 8,x
                sta 6,x
                sta 4,x
                sta 2,x
                sta 1,x
                sta -2,x
                sta -4,x                        ; reset to alpha mode
                sta -6,x
                sta -8,x
                lda PIA1+2                      ; set VDG to alpha mode, colour set 0
                anda #7
                sta PIA1+2
                puls a,b,x,pc                   ;restore registers and return
L95CF           pshs x,b,a                      ; save registers
                lda PMODE                       ; get graphics mode
                adda #3                         ; offset to 3-7 (we don't use the bottom 3 modes)
                ldb #0x10                       ; shift to high 4 bits
                mul
                orb #0x80                       ; set to graphics mode
                orb CSSVAL                      ; set the desired colour set
                lda PIA1+2                      ; get get original PIA values
                anda #7                         ; mask off VDG control
                pshs a                          ; merge with new VDG control
                orb ,s+
                stb PIA1+2                      ; set new VDG mode
                lda BEGGRP                      ; get start of graphics page
                lsra                            ; divide by two - pages are on 512 byte boundaries
                jsr L960F                       ; set SAM control register
                lda PMODE                       ; get graphics mode
                adda #3                         ; shift to VDG values
                cmpa #7                         ; PMODE 4?
                bne L95F7                       ; brif not
                deca                            ; treat PMODE 4 the same as PMODE 3
L95F7           bsr L95FB                       ; program SAM's VDG bits
                puls a,b,x,pc                   ; restore registers and return
L95FB           ldb #3                          ; set 3 bits in register
                ldx #SAMREG                     ; point to VDG control bits
L9600           rora                            ; get bit to set
                bcc L9607                       ; brif we need to clear the bit
                sta 1,x                         ; set the bit
                bra L9609
L9607           sta ,x                          ; clear the bit
L9609           leax 2,x                        ; move to next bit
                decb                            ; done all bits?
                bne L9600                       ; brif not
                rts
L960F           ldb #7                          ; 7 screen address bits
                ldx #SAMREG+6                   ; point to screen address bits in SAM
                bra L9600                       ; go program SAM bits
L9616           lda PIA1+2                      ; get VDG bits
                anda #0xf7                      ; keep everything but CSS bit
                ora CSSVAL                      ; set correct CSS bit
                sta PIA1+2                      ; set desired CSS
                rts
; PMODE command
PMODETOK        cmpa #',                        ; is first argument missing?
                beq L9650                       ; brif so
                jsr EVALEXPB                    ; evaluate PMODE number
                cmpb #5                         ; valid (0-4)?
                bhs L966D                       ; brif not
                lda #6                          ; get start of graphics memory
L962E           sta BEGGRP                      ; set start of graphics page
                aslb                            ; multiply mode by two (table has two bytes per entry)
                ldu #L9706+1                    ; point to lookup table
                adda b,u                        ; add in number of 256 byte pages used for graphics screen
                cmpa TXTTAB                     ; does it fit?
                bhi L966D                       ; brif not
                sta ENDGRP                      ; save end of graphics
                leau -1,u                       ; point to bytes per horizontal row
                lda b,u                         ; get bytes per row
                sta HORBYT                      ; set it
                lsrb                            ; restore PMODE value
                stb PMODE                       ; set graphics mode
                clra                            ; set background colour to 0
                sta BAKCOL
                lda #3                          ; set foreground colour to maximum (3)
                sta FORCOL
                jsr GETCCH                      ; is there a starting page number?
                beq L966C                       ; brif not
L9650           jsr LB738                       ; evaluate an expression following a comma
                tstb                            ; page 0?
                beq L966D                       ; brif so - not valid
                decb                            ; zero-base it
                lda #6                          ; each graphics page is 6*256
                mul
                addb GRPRAM                     ; add to start of graphics memory
                pshs b                          ; save start of screen memory
                addb ENDGRP                     ; add current and address
                subb BEGGRP                     ; subtract current start (adds size of screen)
                cmpb TXTTAB                     ; does it fit?
                bhi L966D                       ; brif not
                stb ENDGRP                      ; save new end of graphics
                puls b                          ; get back start of graphics
                stb BEGGRP                      ; set start of graphics
L966C           rts
L966D           jmp LB44A                       ; raise FC error
; SCREEN command
SCREEN          cmpa #',                        ; is there a mode?
                beq L967F                       ; brif no mode
                jsr EVALEXPB                    ; get mode argument
                tstb                            ; set Z if alpha
                jsr L95AA                       ; set SAM/VDG for graphics mode
                jsr GETCCH                      ; is there a second argument?
                beq L966C                       ; brif not
L967F           jsr LB738                       ; evaluate ,<expr>
                tstb                            ; colour set 0?
                beq L9687                       ; brif so
                ldb #8                          ; flag for colour set 1
L9687           stb CSSVAL                      ; set colour set
                bra L9616                       ; set up VDG
; PCLEAR command
PCLEAR          jsr EVALEXPB                    ; evaulate number of pages requested
                tstb                            ; 0?
                beq L966D                       ; brif zero - not allowed
                cmpb #9                         ; more than 8?
                bhs L966D                       ; brif so - not allowed
                lda #6                          ; there are 6 "pages" per graphics page
                mul                             ; now B is the number of pages to reserve
                addb GRPRAM                     ; add to start of graphics memory
                tfr b,a                         ; now A is the MSB of the start of free memory
                ldb #1                          ; program memory always starts one above
                tfr d,y                         ; save pointer to program memory
                cmpd ENDGRP                     ; are we trying to deallocate the current graphics page?
                lblo LB44A                      ; brif so
                subd TXTTAB                     ; subtract out current start of basic program
                addd VARTAB                     ; add in end of program - now D is new top of program
                tfr d,x                         ; save new end of program
                addd #200                       ; make some extra space (for stack)
                subd FRETOP                     ; see if new top of program fits
                bhs L966D                       ; brif there isn't enough space
                ldu VARTAB                      ; get end of program
                stx VARTAB                      ; save new end of program
                cmpu VARTAB                     ; is old end higher?
                bhs L96D4                       ; brif so
L96BD           lda ,-u                         ; copy a byte upward
                sta ,-x
                cmpu TXTTAB                     ; at beginning?
                bne L96BD                       ; brif not
                sty TXTTAB                      ; save new start of program
                clr -1,y                        ; there must always be a NUL before the program
L96CB           jsr LACEF                       ; re-assign basic program addresses
                jsr LAD26                       ; reset variables and stack
                jmp LAD9E                       ; return to interpretation loop
L96D4           ldu TXTTAB                      ; get start of program
                sty TXTTAB                      ; save new start of program
                clr -1,y                        ; there must be a NUL at the start of the program
L96DB           lda ,u+                         ; move a byte downward
                sta ,y+
                cmpy VARTAB                     ; at the top of the program?
                bne L96DB                       ; brif not
                bra L96CB                       ; finish up
; Graphics initialization routine - this really should be up at the start of the ROM with the
; rest of the initialization code.
L96E6           ldb #0x1e                       ; set start of program to 0x1e00 ("PCLEAR 4")
                stb TXTTAB
                lda #6                          ; graphics memory starts immediately after the screen
L96EC           sta GRPRAM                      ; set graphics memory start
                sta BEGGRP                      ; set start of current graphics page
                clra                            ; set PMODE to 0
                sta PMODE
                lda #16                         ; 16 bytes per graphics row
                sta HORBYT
                lda #3                          ; set foreground colour to 3
                sta FORCOL
                lda #0x0c                       ; set ending graphics page (for PMODE 0)
                sta ENDGRP
                ldx TXTTAB                      ; get start of program
                clr -1,x                        ; make sure there's a NUL before it
L9703           jmp LAD19                       ; do a "NEW"
; PMODE data table (bytes per row and number of 256 byte pages required for a screen)
L9706           fcb 16,6                        ; PMODE 0
                fcb 32,12                       ; PMODE 1
                fcb 16,12                       ; PMODE 2
                fcb 32,24                       ; PMODE 3
                fcb 32,24                       ; PMODE 4
; Calculate absolute value of vertical coordinate difference
L9710           ldd VEREND                      ; get ending address
                subd VERBEG                     ; get difference
L9714           bcc L9751                       ; brif we didn't carry
                pshs cc                         ; save status (C set if start > end)
                jsr L9DC3                       ; negate the difference to be positive
                puls cc,pc                      ; restore C and return
; Calculate absolute value of horizontal coordinate difference
L971D           ldd HOREND                      ; get end coordinate
                subd HORBEG                     ; calculate difference
                bra L9714                       ; turn into absolute value
; PCOPY command
PCOPY           bsr L973F                       ; fetch address of the source page
                pshs d                          ; save address
                ldb #0xa5                       ; make sure we have TO
                jsr LB26F
                bsr L973F                       ; fetch address of the second page
                puls x                          ; get back source
                tfr d,u                         ; put destination into a pointer
                ldy #0x300                      ; 0x300 words to copy
L9736           ldd ,x++                        ; copy a word
                std ,u++
                leay -1,y                       ; done?
                bne L9736                       ; brif not
                rts
L973F           jsr EVALEXPB                    ; evaluate page number
                tstb                            ; zero?
                beq L9752                       ; brif invalid page number
; BUG: this should be deferred until after the address is calculated at which point it should
; be bhs instead of bhi. There should also be a check to make sure the page number is less than
; or equal to 8 above so we don't have to test for overflows below.
                cmpb TXTTAB                     ; is page number higher than start of program (BUG!)
                bhi L9752                       ; brif so - error
                decb                            ; zero-base the page number
                lda #6                          ; 6 "pages" per graphics page
                mul                             ; now we have proper number of "pages" for the offset
                addb GRPRAM                     ; add start of graphics memory
                exg a,b                         ; put MSB into A, 0 into B.
L9751           rts
L9752           jmp LB44A                       ; raise illegal function call
; GET command
GET             clrb                            ; GET flag
                bra L975A                       ; go on to the main body
PUT             ldb #1                          ; PUT flag
L975A           stb VD8                         ; save GET/PUT flag
                jsr RVEC22                      ; do the RAM hook dance (so Disk Basic can do its thing)
L975F           cmpa #'@                        ; @ before coordinates?
                bne L9765                       ; brif not
                jsr GETNCH                      ; eat the @
L9765           jsr L938F                       ; evaluate start/end coordinates
                jsr SYNCOMMA                    ; make sure we have a comma
                jsr L98CC                       ; get pointer to array
                tfr X,D                         ; save descriptor pointer
                ldu ,x                          ; get offset to next descriptor
                leau -2,u                       ; move back to array name
                leau d,u                        ; point to end of array
                stu VD1                         ; save end of data
                leax 2,x                        ; point to number of dimensions
                ldb ,x                          ; get dimension count
                aslb                            ; two bytes per dimension size
                abx                             ; now X points to start of data
                stx VCF                         ; save start of array data
                lda VALTYP                      ; is it numeric
                bne L9752                       ; brif not
                clr VD4                         ; set default graphic action to PSET
                jsr GETCCH                      ; get input character
                beq L97B7                       ; brif no action flag
                com VD4                         ; flag action enabled
                jsr SYNCOMMA                    ; make sure there's a comma
                tst VD8                         ; PUT?
                bne L979A                       ; brif so
                ldb #'G                         ; check for full graphics option
                jsr LB26F
                bra L97CA                       ; handle the rest of the process
L979A           ldb #5                          ; 5 legal actions for PUT
                ldx #L9839                      ; point to action table
L979F           ldu ,x++                        ; get "clear bit" action routine
                ldy ,x++                        ; get "set bit" action routine
                cmpa ,x+                        ; does token match?
                beq L97AE                       ; brif so
                decb                            ; checked all?
                bne L979F                       ; brif not
                jmp LB277                       ; raise error
L97AE           sty VD5                         ; save set bit action address
                stu VD9                         ; save clear bit action address
                jsr GETNCH                      ; munch the acton token
                bra L97CA                       ; handle rest of process
L97B7           ldb #0xf8                       ; mask for bottom three bits
                lda PMODE                       ; get graphics mode
                rora                            ; odd number mode?
                bcc L97C0                       ; brif even
                ldb #0xfc                       ; bottom 2 bits mask
L97C0           tfr b,a                         ; save mask
                andb HORBEG+1                   ; round down the start address
                stb HORBEG+1
                anda HOREND+1                   ; round down end address
                sta HOREND+1
L97CA           jsr L971D                       ; get horizontal size
                bcc L97D3                       ; brif end > start
                ldx HOREND                      ; switch end in for start
                stx HORBEG
L97D3           std HOREND                      ; save size
                jsr L9710                       ; calculate vertical size
                bcc L97DE                       ; brif end > start
                ldx VEREND                      ; swap in vertical end for the start
                stx VERBEG
L97DE           std VEREND                      ; save vertical size
                lda PMODE                       ; get graphics mode
                rora                            ; even?
                ldd HOREND                      ; get difference
                bcc L97EB                       ; brif even (2 colour)
                addd HOREND                     ; add in size (double it)
                std HOREND                      ; save adjusted end size
L97EB           jsr L9420                       ; normalize differences
                ldd HOREND                      ; get end coord
                ldx VEREND                      ; get end size
                leax 1,x                        ; make vertical size inclusive
                stx VEREND                      ; save it back
                tst VD4                         ; got "G" or GET action
                bne L9852                       ; brif given
                lsra                            ; we're going for whole bytes here
                rorb
                lsra
                rorb
                lsra
                rorb
                addd #1                         ; make it inclusive
                std HOREND                      ; save new coordinate
                jsr L9298                       ; convert to screen address
L9808           ldb HOREND+1                    ; get horizontal size
                pshs x                          ; save screen position
L980C           tst VD8                         ; get/put flag
                beq L9831                       ; brif get
                bsr L9823                       ; bump array data pointer
                lda ,u                          ; copy data from array to screen
                sta ,x+
L9816           decb                            ; are we done the row?
                bne L980C                       ; brif not
                puls x                          ; get screen address
                jsr L92E9                       ; move to next row
                dec VEREND+1                    ; done?
                bne L9808                       ; brif not
L9822           rts
L9823           ldu VCF                         ; get array data location
                leau 1,u                        ; bump it
                stu VCF                         ; save new array data location
                cmpu VD1                        ; did we hit the end of the array?
                bne L9822                       ; brif not
L982E           jmp LB44A                       ; raise function call error
L9831           lda ,x+                         ; get data from screen
                bsr L9823                       ; bump array data pointer
                sta ,u                          ; put data in array
                bra L9816                       ; do the loopy thing
; PUT actions
L9839           fdb L9894,L989B                 ; PSET
                fcb 0xbd
                fdb L989B,L9894                 ; PRESET
                fcb 0xbe
                fdb L98B1,L989B                 ; OR
                fcb 0xb1
                fdb L9894,L98B1                 ; AND
                fcb 0xb0
                fdb L98A1,L98A1                 ; NOT
                fcb 0xa8
L9852           addd #1                         ; add to horiz difference
                std HOREND                      ; save it
                lda VD8                         ; PUT?
                bne L9864                       ; brif so
                ldu VD1                         ; get end of array
L985D           sta ,-u                         ; zero out a byte
                cmpu VCF                        ; done?
                bhi L985D                       ; brif not
L9864           jsr L9298                       ; get screen address
                ldb PMODE                       ; get graphics mode
                rorb                            ; even?
                bcc L986E                       ; brif so
                anda #0xaa                      ; use as pixel mask for 4 colour mode
L986E           ldb #1                          ; set bit probe
                ldy VCF                         ; point to start of array data
L9873           pshs x,a                        ; save screen address
                ldu HOREND                      ; get horizontal size
L9877           pshs u,a                        ; save horizontal size and pixel mask
                lsrb                            ; move bit probe right
                bcc L9884                       ; brif we didn't fall off a byte
                rorb                            ; shift carry back in on the left
                leay 1,y                        ; move ahead a byte in the array
                cmpy VD1                        ; end of array data?
                beq L982E                       ; raise error if so
L9884           tst VD8                         ; PUT?
                beq L98A7                       ; brif not
                bitb ,y                         ; test bit in array
                beq L9890                       ; brif not set
                jmp [VD5]                       ; do action routine for bit set
L9890           jmp [VD9]                       ; do action routine for bit clear
L9894           coma                            ; invert mask
                anda ,x                         ; read screen data and reset the desired bit
                sta ,x                          ; save on screen
                bra L98B1
L989B           ora ,x                          ; merge pixel mask with screen data (turn on bit)
                sta ,x                          ; save on screen
                bra L98B1
L98A1           eora ,x                         ; invert the pixel in the screen data
                sta ,x                          ; save on screen
                bra L98B1
L98A7           bita ,x                         ; is the bit set?
                beq L98B1                       ; brif not - do nothing
                tfr b,a                         ; get bit probe
                ora ,y                          ; turn on proper bit in data
                sta ,y
L98B1           puls a,u                        ; get back array address
                jsr L92ED                       ; move screen address to the right
                leau -1,u                       ; account for consumed pixel
                cmpu ZERO                       ; done yet?
                bne L9877                       ; brif not
                ldx 1,s                         ; get start of row back
                lda HORBYT                      ; get number of bytes per row
                leax a,x                        ; move ahead one line
                puls a                          ; get back screen pixel mask
                leas 2,s                        ; lose the screen pointer
                dec VEREND+1                    ; done all rows?
                bne L9873                       ; brif not
                rts
L98CC           jsr LB357                       ; evaluate a variable
                ldb ,-x                         ; get variable name
                lda ,-x
                tfr d,u                         ; save it
                ldx ARYTAB                      ; get start of arrays
L98D7           cmpx ARYEND                     ; end of arrays?
                lbeq LB44A                      ; brif not found
                cmpu ,x                         ; correct variable?
                beq L98E8                       ; brif so
                ldd 2,x                         ; get array size
                leax d,x                        ; move to next array
                bra L98D7                       ; check this array
L98E8           leax 2,x                        ; move pointer to the array header
                rts                             ; obviously this rts is not needed
L98EB           rts
; PAINT command
PAINT           cmpa #'@                        ; do we have @ before coords?
                bne L98F2                       ; brif not
                jsr GETNCH                      ; eat the @
L98F2           jsr L93B2                       ; evaluate coordinates
                jsr L931D                       ; normalize coordinates
                lda #1                          ; PSET flag (use working colour)
                sta SETFLG
                jsr L9581                       ; parse colour and set working colour, etc.
                ldd WCOLOR                      ; get working colour and all pixels byte
                pshs d                          ; save them
                jsr GETCCH                      ; is there anything else?
                beq L990A                       ; brif not
                jsr L9581                       ; evaluate border colour
L990A           lda ALLCOL                      ; get border colour all pixel byte
                sta VD8                         ; save border colour pixel byte
                puls d                          ; get back working colour details
                std WCOLOR
                clra                            ; store a "stop" frame on the stack so PAINT knows when it's finished unwinding
                pshs u,x,b,a
                jsr L9522                       ; set up starting coordinates
                jsr L928F                       ; point to pixel mask routine
                stu VD9                         ; save pixel mask routine
                jsr L99DF                       ; paint from current horizontal coordinate to zero (left)
                beq L9931                       ; brif hit border immediately
                jsr L99CB                       ; paint from current horizontal coordinate upward (right)
                lda #1                          ; set direction to "down"
                sta VD7
                jsr L99BA                       ; save "down" frame
                neg VD7                         ; set direction to "up"
                jsr L99BA                       ; save "up" frame
L9931           sts TMPSTK                      ; save stack pointer
L9934           tst CHGFLG                      ; did the paint change anything?
                bne L993B                       ; brif so
                lds TMPSTK                      ; get back stack pointer
L993B           puls a,b,x,u                    ; get frame from stack
                clr CHGFLG                      ; mark nothing changed
                sts TMPSTK                      ; save stack pointer
                leax 1,x                        ; move start coordinate right
                stx HORBEG                      ; save new coordinate
                stu VD1                         ; save length of line
                sta VD7                         ; save up/down flag
                beq L98EB                       ; did we hit the "stop" frame?
                bmi L9954                       ; brif negative going (up)?
                incb                            ; bump vertical coordinate
                cmpb VD6                        ; at end?
                bls L9958                       ; brif not
                clrb                            ; set vertical to 0 (wrap around)
L9954           tstb                            ; did we wrap?
                beq L9934                       ; do another block if so
                decb                            ; move up a row
L9958           stb VERBEG+1                    ; save vertical coordinate
                jsr L99DF                       ; paint from horizontal to 0
                beq L996E                       ; brif we hit the border immediately
                cmpd #3                         ; less than 3 pixels?
                blo L9969                       ; brif so
                leax -2,x                       ; move two pixels left
                bsr L99A1                       ; save paint block on the stack
L9969           jsr L99CB                       ; continue painting to the right
L996C           bsr L99BA                       ; save paint data frame
L996E           coma                            ; complement length of line just painted and add to length of line
                comb
L9970           addd VD1                        ; save difference between this line and parent line
                std VD1
                ble L998C                       ; brif parent line is shorter
                jsr L9506                       ; bump horizontal coordinate
                jsr L9A12                       ; see if we bounced into the border
                bne L9983                       ; brif not border
                ldd #-1                         ; move left
                bra L9970                       ; keep looking
L9983           jsr L9514                       ; move horizontally left
                bsr L99C6                       ; save horizontal coordinate
                bsr L99E8                       ; paint right
                bra L996C                       ; save paint block and do more
L998C           jsr L9506                       ; bump horizontal coordinate
                leax d,x                        ; point to right end of parent line
                stx HORBEG                      ; set as curent coordinate
                coma                            ; get amount we extend past parent line
                comb
                subd #1
                ble L999E                       ; brif doesn't extend
                tfr d,x                         ; save length of line
                bsr L99A1                       ; save paint frame
L999E           jmp L9934
L99A1           std VCB                         ; save number of pixels painted
                puls y                          ; get return address
                ldd HORBEG                      ; get horizontal coordinate
                pshs x,b,a                      ; save horizontal coordinate and pointer
                lda VD7                         ; get up/down flag
                nega                            ; reverse it
L99AC           ldb VERBEG+1                    ; get vertical coordainte
                pshs b,a                        ; save vertical coord and up/down flag
                pshs y                          ; put return address back
                ldb #2                          ; make sure we haven't overflowed memory
                jsr LAC33
                ldd VCB                         ; get line length back
                rts
L99BA           std VCB                         ; save length of painted line
                puls y                          ; get return address
                ldd HOREND                      ; get start coord
                pshs x,b,a                      ; save horizontal start and length
                lda VD7                         ; get up/down flag
                bra L99AC                       ; finish up with the stack
L99C6           ldx HORBEG                      ; save current horizontal coord and save it
                stx HOREND
                rts
L99CB           std VCD                         ; save number of pixels painted
                ldy HOREND                      ; get last horizontal start
                bsr L99C6                       ; save current coordinate
                sty HORBEG                      ; save coordinate
                bsr L99E8                       ; paint a line
                ldx VCD                         ; get number painted
                leax d,x                        ; add to the number painted going the other way
                addd #1                         ; now D is length of line
                rts
L99DF           jsr L99C6                       ; put starting coordinate in end
                ldy #L9514                      ; decrement horizontal coordinate address
                bra L99EE                       ; go paint line
L99E8           ldy #L9506                      ; increment horizontal coordinate address
                jsr ,y                          ; bump coordinate
L99EE           ldu ZERO                        ; initialize pixel count
                ldx HORBEG                      ; get starting coordinate
L99F2           bmi L9A0B                       ; brif out of range for hoizontal coordinate
                cmpx VD3                        ; at end?
                bhi L9A0B                       ; brif right of max
                pshs u,y                        ; save counter and inc/dec routine pointer
                bsr L9A12                       ; at border?
                beq L9A09                       ; brif so
                jsr L9377                       ; set pixel to paint colour
                puls y,u                        ; restore counter and inc/dec/pointer
                leau 1,u                        ; bump number of painted pixels
                jsr ,y                          ; inc/dec screen address
                bra L99F2                       ; go do another pixel
L9A09           puls y,u                        ; get back counter and inc/dec routine
L9A0B           tfr u,d                         ; save count in D
                tfr d,x                         ; and in X
                subd ZERO                       ; set flags on D (smaller/faster than cmpd ZERO)
                rts
L9A12           jsr [VD9]                       ; get the screen address
                tfr a,b                         ; save pixel mask
                andb VD8                        ; set pixel to border colour
                pshs b,a                        ; save mask and border
                anda ,x                         ; mask current pixel into A
                cmpa 1,s                        ; does it match border? Z=1 if so
                puls a,b,pc                     ; restore mask, border pixel, and return
; PLAY command
; This is here mixed in with the graphics package because it shares some machinery with DRAW.
PLAY            ldx ZERO                        ; default values for note length, etc.
                ldb #1
                pshs x,b                        ; save default values
                jsr LB156                       ; evaluate argument
                clrb                            ; enable DA and sound output
                jsr LA9A2
                jsr LA976
L9A32           jsr LB654                       ; fetch PLAY string details
                bra L9A39                       ; go evaluate the string
L9A37           puls b,x                        ; get back play string details
L9A39           stb VD8                         ; save length of string
                beq L9A37                       ; brif end of string
                stx VD9                         ; save start of string
                lbeq LA974                      ; brif NULL string - disable sound and return
L9A43           tst VD8                         ; have anything left?
                beq L9A37                       ; brif not
                jsr L9B98                       ; get command character
                cmpa #';                        ; command separator?
                beq L9A43                       ; brif so - ignore it
                cmpa #''                        ; '?
                beq L9A43                       ; brif so - ignore it
                cmpa #'X                        ; execuate sub string?
                lbeq L9C0A                      ; brif so - handle it
                bsr L9A5C                       ; handle other commands
                bra L9A43                       ; look for more stuff
L9A5C           cmpa #'O                        ; octave?
                bne L9A6D                       ; brif not
                ldb OCTAVE                      ; get current octave
                incb                            ; 1-base it
                bsr L9AC0                       ; get value if present
                decb                            ; zero-base it
                cmpb #4                         ; valid octave?
                bhi L9ACD                       ; raise error if not
                stb OCTAVE                      ; save new octave
                rts
L9A6D           cmpa #'V                        ; volume?
                bne L9A8B                       ; brif not
                ldb VOLHI                       ; get current high volume limit
                lsrb                            ; shift 2 bits right (DA is 6 bits in high bits)
                lsrb
                subb #31                        ; subtract out mid value offset
                bsr L9AC0                       ; read argument
                cmpb #31                        ; maximum range is 31
                bhi L9ACD                       ; brif out of range
                aslb                            ; adjust back in range
                aslb
                pshs b                          ; save new volume
                ldd #0x7e7e                     ; midrange value for both high and low
                adda ,s                         ; add new volume to high limit
                subb ,s+                        ; subtract volume from low limit
                std VOLHI                       ; save new volume limits (sets high and low amplitudes)
                rts
L9A8B           cmpa #'L                        ; note length?
                bne L9AB2                       ; brif not
                ldb NOTELN                      ; get current length
                bsr L9AC0                       ; read parameter
                tstb                            ; resulting length 0?
                beq L9ACD                       ; brif so - problem
                stb NOTELN                      ; save new length
                clr DOTVAL                      ; reset note timer scale factor
L9A9A           bsr L9A9F                       ; check for dot
                bcc L9A9A                       ; brif there was one
                rts
L9A9F           tst VD8                         ; check length
                beq L9AAD                       ; brif zero
                jsr L9B98                       ; get command character
                cmpa #'.                        ; dot?
                beq L9AAF                       ; brif so
                jsr L9BE2                       ; move input back and bump length
L9AAD           coma                            ; set C to indicate nothing found
                rts
L9AAF           inc DOTVAL                      ; bump number of dots
                rts
L9AB2           cmpa #'T                        ; tempo?
                bne L9AC3                       ; brif not
                ldb TEMPO                       ; get current tempo
                bsr L9AC0                       ; parse tempo argument
                tstb                            ; 0?
                beq L9ACD                       ; brif so - invalid
                stb TEMPO                       ; save new tempo
                rts
L9AC0           jmp L9BAC                       ; evaluate various operators
L9AC3           cmpa #'P                        ; pause?
                bne L9AEB                       ; brif not
                jsr L9CCB                       ; evaluate parameter
                tstb                            ; is the pause number 0?
                bne L9AD0                       ; brif not
L9ACD           jmp LB44A                       ; raise FC error
L9AD0           lda DOTVAL                      ; save current volume and note scale
                ldx VOLHI
                pshs x,a
                lda #0x7e                       ; drop DA to mid range
                sta VOLHI
                sta VOLLOW
                clr DOTVAL
                bsr L9AE7                       ; go play a "silence"
                puls a,x                        ; restore volume and note scale
                sta DOTVAL
                stx VOLHI
                rts
L9AE7           clr ,-s                         ; set not number 0
                bra L9B2B                       ; go play it
L9AEB           cmpa #'N                        ; N for "note"?
                bne L9AF2                       ; brif not - it's optional
                jsr L9B98                       ; skip the "N"
L9AF2           cmpa #'A                        ; is it a valid note?
                blo L9AFA                       ; brif not
                cmpa #'G                        ; is it above the note range?
                bls L9AFF                       ; brif not - valid note
L9AFA           jsr L9BBE                       ; evaluate a number
                bra L9B22                       ; process note value
L9AFF           suba #'A                        ; normalize note number to 0
                ldx #L9C5B                      ; point to note number lookup table
                ldb a,x                         ; get not number
                tst VD8                         ; any command characters left?
                beq L9B22                       ; brif not
                jsr L9B98                       ; get character
                cmpa #'#                        ; sharp?
                beq L9B15                       ; brif so
                cmpa #'+                        ; also sharp?
                bne L9B18                       ; brif not
L9B15           incb                            ; add one half tone
                bra L9B22
L9B18           cmpa #'-                        ; flat?
                bne L9B1F                       ; brif not
                decb                            ; subtract one half tone
                bra L9B22
L9B1F           jsr L9BE2                       ; back up command pointer
L9B22           decb                            ; adjust note number (zero base it)
                cmpb #11                        ; is it valid?
                bhi L9ACD                       ; raise error if not
                pshs b                          ; save note value
                ldb NOTELN                      ; get note length
L9B2B           lda TEMPO                       ; get tempo value
                mul                             ; calculate note duration
                std VD5                         ; save duration
                leau 1,s                        ; point to where the stack goes after we're done
                lda OCTAVE                      ; get current octave
                cmpa #1                         ; 0 or 1?
                bhi L9B64                       ; brif not
                ldx #L9C62                      ; point to delay table
                ldb #2*12                       ; 24 bytes per octave
                mul                             ; now we have the base address
                abx                             ; now X points to the octave base
                puls b                          ; get back note value
                aslb                            ; two bytes per delay
                abx                             ; now we're pointing to the delay
                leay ,x                         ; save pointer to note value
                bsr L9B8C                       ; calculate note timer value
                std PLYTMR                      ; set timer for note playing (IRQ will count this down)
L9B49           bsr L9B57                       ; set to mid range and delay
                lda VOLHI                       ; get high value
                bsr L9B5A                       ; set to high value and delay
                bsr L9B57                       ; set to mid range and delay
                lda VOLLOW                      ; get low value
                bsr L9B5A                       ; set to low value and delay
                bra L9B49                       ; do it again (IRQ will break the loop)
L9B57           lda #0x7e                       ; mid value for DA with RS232 marking
                nop                             ; a delay to fine tune frequencies
L9B5A           sta PIA1                        ; set DA
                ldx ,y                          ; get delay value
L9B5F           leax -1,x                       ; count down
                bne L9B5F                       ; brif not done yet
                rts
L9B64           ldx #L9C92-2*12                 ; point to delay table for octaves 2+
                ldb #12                         ; 12 bytes per octave
                mul                             ; now we have the offset to the desired octave
                abx                             ; now we point to the start of the octave
                puls b                          ; get back note value
                abx                             ; now we point to the delay value
                bsr L9B8C                       ; calculate timer value
                std PLYTMR                      ; set play timer (IRQ counts this down)
L9B72           bsr L9B80                       ; send mid value and delay
                lda VOLHI                       ; get high value
                bsr L9B83                       ; send high value and delay
                bsr L9B80                       ; send low value and delay
                lda VOLLOW                      ; get low value
                bsr L9B83                       ; send low value and delay
                bra L9B72                       ; do it again (IRQ will break the loop)
L9B80           lda #0x7e                       ; mid range value with RS232 marking
                nop                             ; fine tuning delay
L9B83           sta PIA1                        ; set DA
                lda ,x                          ; get delay value
L9B88           deca                            ; count down
                bne L9B88                       ; brif not done
                rts
L9B8C           ldb #0xff                       ; base timer value
                lda DOTVAL                      ; get number of dots
                beq L9B97                       ; use default value if 0
                adda #2                         ; add in constant timer factor
                mul                             ; multiply scale by base
                lsra                            ; divide by two - each increment will increase note timer by 128
                rorb
L9B97           rts
L9B98           pshs x                          ; save register
L9B9A           tst VD8                         ; do we have anything left?
                beq L9BEB                       ; brif not - raise error
                ldx VD9                         ; get parsing address
                lda ,x+                         ; get character
                stx VD9                         ; save pointer
                dec VD8                         ; account for character consumed
                cmpa #0x20                      ; space?
                beq L9B9A                       ; brif so - skip it
                puls x,pc                       ; restore register and return
L9BAC           bsr L9B98                       ; get character
                cmpa #'+                        ; add one?
                beq L9BEE                       ; brif so
                cmpa #'-                        ; subtract one?
                beq L9BF2                       ; brif so
                cmpa #'>                        ; double?
                beq L9BFC                       ; brif so
                cmpa #'<                        ; halve?
                beq L9BF7                       ; brif so
L9BBE           cmpa #'=                        ; variable equate?
                beq L9C01                       ; brif so
                jsr L90AA                       ; clear carry if numeric
                bcs L9BEB                       ; brif not numeric
                clrb                            ; initialize value to 0
L9BC8           suba #'0                        ; remove ASCII bias
                sta VD7                         ; save digit
                lda #10                         ; make room for digit
                mul
                tsta                            ; did we overflow 8 bits?
                bne L9BEB                       ; brif so
                addb VD7                        ; add in digit
                bcs L9BEB                       ; brif that overflowed
                tst VD8                         ; more digits?
                beq L9BF1                       ; brif not
                jsr L9B98                       ; get character
                jsr L90AA                       ; clear carry if numeric
                bcc L9BC8                       ; brif another digit
L9BE2           inc VD8                         ; unaccount for character just read
                ldx VD9                         ; move pointer back
                leax -1,x
                stx VD9
                rts
L9BEB           jmp LB44A                       ; raise FC error
L9BEE           incb                            ; bump param
                beq L9BEB                       ; brif overflow
L9BF1           rts
L9BF2           tstb                            ; already zero?
                beq L9BEB                       ; brif so - underflow
                decb                            ; decrease parameter
                rts
L9BF7           tstb                            ; already at 0?
                beq L9BEB                       ; brif so - raise error
                lsrb                            ; halve it
                rts
L9BFC           tstb                            ; will it overflow?
                bmi L9BEB                       ; brif so
                aslb                            ; double it
                rts
L9C01           pshs u,y                        ; save registers
                bsr L9C1B                       ; interpret command string as a variable
                jsr LB70E                       ; convert it to an 8 bit number
                puls y,u,pc                     ; restore registers and return
L9C0A           jsr L9C1B                       ; evaluate expression in command string
                ldb #2                          ; room for 4 bytes?
                jsr LAC33
                ldb VD8                         ; get the command length and pointer
                ldx VD9
                pshs x,b                        ; save them
                jmp L9A32                       ; go process the sub string
L9C1B           ldx VD9                         ; get command pointer
                pshs x                          ; save it
                jsr L9B98                       ; get input character
                jsr LB3A2                       ; set carry if not alpha
                bcs L9BEB                       ; brif not a variable reference
L9C27           jsr L9B98                       ; get command character
                cmpa #';                        ; semicolon?
                bne L9C27                       ; keep scanning if not
                puls x                          ; get back start of variable string
                ldu CHARAD                      ; get current interpreter input pointer
                pshs u                          ; save it
                stx CHARAD                      ; point interpreter at command string
                jsr LB284                       ; evaluate expression as string
                puls x                          ; restore interpeter input pointer
                stx CHARAD
                rts
; The bit of Extended Basic's IRQ routine that handles PLAY. Note that everything after
; clr PLYTMR+1 could be replaced with a simple lds 8,s followed by rts.
L9C3E           clra                            ; make sure DP is set to 0
                tfr a,dp
                ldd PLYTMR                      ; is PLAY running?
                lbeq LA9BB                      ; brif not - transfer control on the Color Basic's routine
                subd VD5                        ; subtract out the interval
                std PLYTMR                      ; save new timer value
                bhi L9C5A                       ; brif it isn't <= 0
                clr PLYTMR                      ; disable the timer
                clr PLYTMR+1
                puls a                          ; get saved CC
                lds 7,s                         ; set stack to saved U value
                anda #0x7f                      ; clear E flag (to return minimal state)
                pshs a                          ; set fake "FIRQ" stack frame
L9C5A           rti
L9C5B           fcb 10,12,1,3,5,6,8             ; table of half tone numbers for notes A-G
L9C62           fdb 0x01a8,0x0190,0x017a,0x0164 ; delays for octave 1
                fdb 0x0150,0x013d,0x012b,0x011a
                fdb 0x010a,0x00fb,0x00ed,0x00df
                fdb 0x00d3,0x00c7,0x00bb,0x00b1 ; delays for octave 2
                fdb 0x00a6,0x009d,0x0094,0x008b
                fdb 0x0083,0x007c,0x0075,0x006e
L9C92           fcb 0xa6,0x9c,0x93,0x8b         ; delays for octave 3
                fcb 0x83,0x7b,0x74,0x6d
                fcb 0x67,0x61,0x5b,0x56
                fcb 0x51,0x4c,0x47,0x43         ; delays for octave 4
                fcb 0x3f,0x3b,0x37,0x34
                fcb 0x31,0x2e,0x2b,0x28
                fcb 0x26,0x23,0x21,0x1f         ; delays for octave 5
                fcb 0x1d,0x1b,0x19,0x18
                fcb 0x16,0x14,0x13,0x12
; DRAW command
DRAW            ldx ZERO                        ; create an empty "DRAW" frame
                ldb #1
                pshs x,b
                stb SETFLG                      ; set to "PSET" mode
                stx VD5                         ; clear update and draw flag
                jsr L959A                       ; set active colour byte
                jsr LB156                       ; evaluate command string
L9CC6           jsr LB654                       ; fetch command string details
                bra L9CD3                       ; interpret the command string
L9CCB           jsr L9B98                       ; fetch command character
                jmp L9BBE                       ; evaluate a number
L9CD1           puls b,x                        ; get previously saved command string
L9CD3           stb VD8                         ; save length counter
                beq L9CD1                       ; brif end of string
                stx VD9                         ; save pointer
                lbeq L9DC7                      ; brif overall end of command
L9CDD           tst VD8                         ; are we at the end of the string?
                beq L9CD1                       ; brif so - return to previous string
                jsr L9B98                       ; get command character
                cmpa #';                        ; semicolon?
                beq L9CDD                       ; brif so - ignore it
                cmpa #''                        ; '?
                beq L9CDD                       ; brif so - ignore that too
                cmpa #'N                        ; update position toggle?
                bne L9CF4                       ; brif not
                com VD5                         ; toggle update position flag
                bra L9CDD                       ; get on for another command
L9CF4           cmpa #'B                        ; blank flag?
                bne L9CFC                       ; brif not
                com VD6                         ; toggle blank flag
                bra L9CDD                       ; get on for another command
L9CFC           cmpa #'X                        ; substring?
                lbeq L9D98                      ; brif so - execute command
                cmpa #'M                        ; move draw position?
                lbeq L9E32                      ; brif so
                pshs a                          ; save command character
                ldb #1                          ; default value if no number follows
                tst VD8                         ; is there something there?
                beq L9D21                       ; brif not
                jsr L9B98                       ; get character
                jsr LB3A2                       ; set C if not alpha
                pshs cc                         ; save alpha state
                jsr L9BE2                       ; move back pointer
                puls cc                         ; get back alpha flag
                bcc L9D21                       ; brif it's alpha
                bsr L9CCB                       ; evaluate a number
L9D21           puls a                          ; get command back
                cmpa #'C                        ; color change?
                beq L9D4F                       ; brif so
                cmpa #'A                        ; angle?
                beq L9D59                       ; brif so
                cmpa #'S                        ; scale?
                beq L9D61                       ; brif so
                cmpa #'U                        ; up?
                beq L9D8F                       ; brif so
                cmpa #'D                        ; down?
                beq L9D8C                       ; brif so
                cmpa #'L                        ; left?
                beq L9D87                       ; brif so
                cmpa #'R                        ; right?
                beq L9D82                       ; brif so
                suba #'E                        ; normalize the half cardinals to 0
                beq L9D72                       ; brif E (45°)
                deca                            ; F (135°?)
                beq L9D6D                       ; brif so
                deca                            ; G (225°?)
                beq L9D7B                       ; brif so
                deca                            ; H (315°?)
                beq L9D69                       ; brif so
L9D4C           jmp LB44A                       ; raise FC error
L9D4F           jsr L955D                       ; adjust colour for PMODE
                stb FORCOL                      ; save new foreground colour
                jsr L959A                       ; set up working colour and all pixels byte
L9D57           bra L9CDD                       ; go process another command
L9D59           cmpb #4                         ; only 3 angles are valid
                bhs L9D4C                       ; brif not valid
                stb ANGLE                       ; save new angle
                bra L9D57                       ; go process another command
L9D61           cmpb #63                        ; only 64 scale values are possible
                bhs L9D4C                       ; brif out of range
                stb SCALE                       ; save new scale factor
                bra L9D57                       ; go process another command
L9D69           clra                            ; make horizontal negative
                bsr L9DC4
                skip1
L9D6D           clra                            ; keep horizontal distance positive
                tfr d,x                         ; make horizontal distance and vertical distance the same
                bra L9DCB                       ; go do the draw thing
L9D72           clra                            ; zero extend horizontal distance
                tfr d,x                         ; set it as vertical
                bsr L9DC4                       ; negate horizontal distance
                exg d,x                         ; swap directions (vertical is now negative)
                bra L9DCB                       ; go do the draw thing
L9D7B           clra                            ; zero extend horizontal distance
                tfr d,x                         ; copy horizontal to vertical
                bsr L9DC4                       ; negate horizontal
                bra L9DCB                       ; go do the drawing thing
L9D82           clra                            ; zero extend horizontal distance
L9DB3           ldx ZERO                        ; no vertical distance
                bra L9DCB                       ; go do the drawing things
L9D87           clra                            ; zero extend horizontal
                bsr L9DC4                       ; negate horizontal
                bra L9DB3                       ; zero out vertical and do the drawing thing
L9D8C           clra                            ; zero extend distance
                bra L9D92                       ; make the distance vertical and zero out horizontal
L9D8F           clra                            ; zero extend distance
                bsr L9DC4                       ; negate distance
L9D92           ldx ZERO                        ; zero out vertical distance
                exg x,d                         ; swap vertical and horizontal
                bra L9DCB                       ; go do the drawing thing
L9D98           jsr L9C1B                       ; evaluate substring expression
                ldb #2                          ; is there enough room for the state?
                jsr LAC33
                ldb VD8                         ; save current command string state
                ldx VD9
                pshs x,b
                jmp L9CC6                       ; go evaluate the sub string
L9DA9           ldb SCALE                       ; get scale factor
                beq L9DC8                       ; brif zero - default to full size
                clra                            ; zero extend
                exg d,x                         ; put distance somewhere useful
                sta ,-s                         ; save MS of distance
                bpl L9DB6                       ; brif positive distance
                bsr L9DC3                       ; negate the distance
L9DB6           jsr L9FB5                       ; multiply D and X
                tfr u,d                         ; save ms bytes in D
                lsra                            ; divide by 2
                rorb
L9DBD           lsra                            ; ...divide by 4
                rorb
                tst ,s+                         ; negative distance?
                bpl L9DC7                       ; brif it was positive
L9DC3           nega                            ; negate D
L9DC4           negb
                sbca #0
L9DC7           rts
L9DC8           tfr x,d                         ; copy unchanged sitance to D
                rts
L9DCB           pshs b,a                        ; save horizontal distance
                bsr L9DA9                       ; apply scale factor to vertical
                puls x                          ; get horizontal distance
                pshs b,a                        ; save scaled vertical
                bsr L9DA9                       ; apply scale to horizontal
                puls x                          ; get back vertical distance
                ldy ANGLE                       ; get draw angle and scale
                pshs y                          ; save them
L9DDC           tst ,s                          ; is there an angle?
                beq L9DE8                       ; brif no angle
                exg x,d                         ; swap distances
                bsr L9DC3                       ; negate D
                dec ,s                          ; account for one tick around the rotation
                bra L9DDC                       ; see if we're there yet
L9DE8           puls y                          ; get angle and scale back
                ldu ZERO                        ; default end position (horizontal) is 0
                addd HORDEF                     ; add default horizontal to horizontal distance
                bmi L9DF2                       ; brif we went negative
                tfr d,u                         ; save calculated end coordindate
L9DF2           tfr x,d                         ; get vertical distance somewhere useful
                ldx ZERO                        ; default vertical end is 0
                addd VERDEF                     ; add distance to default vertical start
                bmi L9DFC                       ; brif negative - use 0
                tfr d,x                         ; save calculated end coordinate
L9DFC           cmpu #256                       ; is horizontal in range?
                blo L9E05                       ; brif su
                ldu #255                        ; maximize it
L9E05           cmpx #192                       ; is vertical in range?
                blo L9E0D                       ; brif so
                ldx #191                        ; maximize it
L9E0D           ldd HORDEF                      ; set starting coordinates for the line
                std HORBEG
                ldd VERDEF
                std VERBEG
                stx VEREND                      ; set end coordinates
                stu HOREND
                tst VD5                         ; are we updating position?
                bne L9E21                       ; brif not
                stx VERDEF                      ; update default coordinates
                stu HORDEF
L9E21           jsr L9420                       ; normalize coordindates
                tst VD6                         ; are we drawing something?
                bne L9E2B                       ; brif not
                jsr L94A1                       ; draw the line
L9E2B           clr VD5                         ; reset draw and update flags
                clr VD6
                jmp L9CDD                       ; do another command
L9E32           jsr L9B98                       ; get a command character
                pshs a                          ; save it
                jsr L9E5E                       ; evaluate horizontal distance
                pshs b,a                        ; save it
                jsr L9B98                       ; get character
                cmpa #',                        ; comma between coordinates?
                lbne L9D4C                      ; brif not - raise error
                jsr L9E5B                       ; evaluate vertical distance
                tfr d,x                         ; save vertical distance
                puls u                          ; get horizontal distance
                puls a                          ; get back first command character
                cmpa #'+                        ; was it + at start?
                beq L9E56                       ; brif +; treat values as positive
                cmpa #'-                        ; was it -?
                bne L9DFC                       ; brif not - treat it as absolute
L9E56           tfr u,d                         ; put horizontal distance somewhere useful
                jmp L9DCB                       ; move draw position (relative)
L9E5B           jsr L9B98                       ; get input character
L9E5E           cmpa #'+                        ; leading +?
                beq L9E69                       ; brif so
                cmpa #'-                        ; leading -?
                beq L9E6A                       ; brif so - negative
                jsr L9BE2                       ; move pointer back one
L9E69           clra                            ; 0  for +, nonzero for -
L9E6A           pshs a                          ; save sign flag
                jsr L9CCB                       ; evaluate number
                puls a                          ; get sign flag
                tsta                            ; negative?
                beq L9E78                       ; brif not
                clra                            ; zero extend and negate
                negb
                sbca #0
L9E78           rts
; Table of sines and cosines for CIRCLE
L9E79           fdb 0x0000,0x0001               ; subarc 0
                fdb 0xfec5,0x1919               ; subarc 1
                fdb 0xfb16,0x31f2               ; subarc 2
                fdb 0xf4fb,0x4a51               ; subarc 3
                fdb 0xec84,0x61f9               ; subarc 4
                fdb 0xe1c7,0x78ae               ; subarc 5
                fdb 0xd4dc,0x8e3b               ; subarc 6
                fdb 0xc5e5,0xa269               ; subarc 7
                fdb 0xb506,0xb506               ; subarc 8
; CIRCLE command
; The circle is drawn as a 64 sided polygon (64 LINE commands essentially)
CIRCLE          cmpa #'@                        ; is there an @ before coordinates?
                bne L9EA3                       ; brif not
                jsr GETNCH                      ; eat the @
L9EA3           jsr L9522                       ; get max coordinates for screen
                jsr L93B2                       ; parse coordinates for circle centre
                jsr L931D                       ; normalize the start coordinates
                ldx ,u                          ; get horizontal coordinate
                stx VCB                         ; save it
                ldx 2,u                         ; get vertical coordinate
                stx VCD                         ; saveit
                jsr SYNCOMMA                    ; make sure we have a comma
                jsr LB73D                       ; evaluate radius expression
                ldu #VCF                        ; point to temp storage
                stx ,u                          ; save radius
                jsr L9320                       ; normalize radius
                lda #1                          ; default to PSET
                sta SETFLG
                jsr L9581                       ; evaluate the colour expression
                ldx #0x100                      ; height/width default value
                jsr GETCCH                      ; is there a ratio?
                beq L9EDF                       ; brif not
                jsr SYNCOMMA                    ; make sure we have a comma
                jsr LB141                       ; evaluate the ratio
                lda FP0EXP                      ; multiply ratio by 256
                adda #8
                sta FP0EXP
                jsr LB740                       ; evaluate ratio to X (fraction part in LSB)
L9EDF           lda PMODE                       ; get graphics mode
                bita #2                         ; is it even?
                beq L9EE9                       ; brif so
                tfr x,d                         ; double the ratio
                leax d,x
L9EE9           stx VD1                         ; save height/width ratio
                ldb #1                          ; set the SET flag to PSET
                stb SETFLG
                stb VD8                         ; set first time flag (set to 0 after arc drawn)
                jsr L9FE2                       ; evaluate circle starting point (octant, subarc)
                pshs b,a                        ; save startpoint
                jsr L9FE2                       ; evaluate circle end point (octant, subarc)
                std VD9                         ; save endp oint
                puls a,b
L9EFD           pshs b,a                        ; save current circle position
                ldx HOREND                      ; move end coordinates to start coordinates
                stx HORBEG
                ldx VEREND
                stx VERBEG
                ldu #L9E79+2                    ; point to sine/cosine table
                anda #1                         ; even octant?
                beq L9F11                       ; brif so
                negb                            ; convert 0-7 to 8-1 for odd octants
                addb #8
L9F11           aslb                            ; four bytes per table entry
                aslb
                leau b,u                        ; point to correct table entry
                pshs u                          ; save sine/cosine table entry pointer
                jsr L9FA7                       ; calculate horizontal offset
                puls u                          ; get back table entry pointer
                leau -2,u                       ; move to cosine entry
                pshs x                          ; save horizontal offset
                jsr L9FA7                       ; calculate vertical offset
                puls y                          ; put horizontal in Y
                lda ,s                          ; get octant number
                anda #3                         ; is it 0 or 4?
                beq L9F31                       ; brif so
                cmpa #3                         ; is it 3 or 7?
                beq L9F31                       ; brif so
                exg x,y                         ; swap horizontal and vertical
L9F31           stx HOREND                      ; save horizontal offset
                tfr y,x                         ; put vertical offset in X
                ldd VD1                         ; get height/width ratio
                jsr L9FB5                       ; multiply vertical by h/w ratio
                tfr y,d                         ; save the product to D
                tsta                            ; did it overflow?
                lbne LB44A                      ; brif so
                stb VEREND                      ; save vertical coordinate MSB
                tfr u,d                         ; get LSW of product
                sta VEREND+1                    ; save LSB of integer part (we have 8 bits of fraction in the ratio)
                lda ,s                          ; get octant
                cmpa #2                         ; is it 0 or 1?
                blo L9F5B                       ; brif so
                cmpa #6                         ; is it 6 or 7?
                bhs L9F5B                       ; brif so
                ldd VCB                         ; get horizontal centre
                subd HOREND                     ; subtract horizontal displacement
                bcc L9F68                       ; brif we didn't overflow the screen
                clra                            ; zero out coordinate if we overflowed the screen
                clrb
                bra L9F68
L9F5B           ldd VCB                         ; get horizontal coordinate of the centre
                addd HOREND                     ; add displacement
                bcs L9F66                       ; brif overlod
                cmpd VD3                        ; larger than max horizontal coord?
                blo L9F68                       ; brif not
L9F66           ldd VD3                         ; maximize the coordinate
L9F68           std HOREND                      ; save horizontal ending coordainte
                lda ,s                          ; get octant
                cmpa #4                         ; is it 0-3?
                blo L9F7A                       ; brif so
                ldd VCD                         ; get vertical coordinate of centre
                subd VEREND                     ; subtract displacement
                bcc L9F87                       ; brif we didn't overflow the screen
                clra                            ; minimize to top of screen
                clrb
                bra L9F87
L9F7A           ldd VCD                         ; get vertical centre coordinate
                addd VEREND                     ; add displacement
                bcs L9F85                       ; brif we overflowed the screen
                cmpd VD5                        ; did we go past max coordinate?
                blo L9F87                       ; brif not
L9F85           ldd VD5                         ; maximize the coordinate
L9F87           std VEREND                      ; save end coordinate
                tst VD8                         ; check first time flag
                bne L9F8F                       ; do not draw if first time through (it was setting start coord)
                bsr L9FDF                       ; draw the line
L9F8F           puls a,b                        ; get arc number and sub arc
                lsr VD8                         ; get first time flag value (and clear it!)
                bcs L9F9A                       ; do not check for end point after drawing for first coordinate
                cmpd VD9                        ; at end point?
                beq L9FA6                       ; brif drawing finished
L9F9A           incb                            ; bump arc counter
                cmpb #8                         ; done 8 arcs?
                bne L9FA3                       ; brif not
                inca                            ; bump octant
                clrb                            ; reset subarc number
                anda #7                         ; make sure octant number stays in 0-7 range
L9FA3           jmp L9EFD                       ; go do another arc
L9FA6           rts
L9FA7           ldx VCF                         ; get radius
                ldd ,u                          ; get sine/cosine table entry
                beq L9FB4                       ; brif 0 - offset = radius
                subd #1                         ; adjust values to correct range
                bsr L9FB5                       ; multiply radius by sine/cosine
                tfr y,x                         ; resturn result in X
L9FB4           rts
L9FB5           pshs u,y,x,b,a                  ; save registers and reserve temp space
                clr 4,s                         ; reset overflow byte (YH)
                lda 3,s                         ; calcuate B*XL
                mul
                std 6,s                         ; put in "U"
                ldd 1,s                         ; calculate B*XH
                mul
                addb 6,s                        ; accumluate with previous product
                adca #0
                std 5,s                         ; save in YL,UH
                ldb ,s                          ; calculate A*XL
                lda 3,s
                mul
                addd 5,s                        ; accumulate with previous partical product
                std 5,s                         ; save in YL,UH
                bcc L9FD4                       ; brif no carry
                inc 4,s                         ; bump YH for carry
L9FD4           lda ,s                          ; calculate A*XH
                ldb 2,s
                mul
                addd 4,s                        ; accumulate with previous partial product
                std 4,s                         ; save in Y (we can't have a carry here)
                puls a,b,x,y,u,pc               ; restore multiplicands and return results
L9FDF           jmp L94A1                       ; go draw a line
L9FE2           clrb                            ; default arc number (0)
                jsr GETCCH                      ; is there something there for a value?
                beq L9FF8                       ; brif not
                jsr SYNCOMMA                    ; evaluate , + expression
                jsr LB141
                lda FP0EXP                      ; multiply by 64
                adda #6
                sta FP0EXP
                jsr LB70E                       ; get integer value of circle fraction
                andb #0x3f                      ; max value of 63
L9FF8           tfr b,a                         ; save arc value in A to calculate octant
                andb #7                         ; calculate subarc
                lsra                            ; calculate octant
                lsra
                lsra
                rts