view bas12.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
                *pragma list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; COLOR BASIC ROM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                org BASIC
; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed
; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of
; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points.
POLCAT          fdb KEYIN                       ; indirect jump, get a keystroke
CHROUT          fdb PUTCHR                      ; indirect jump, output character
CSRDON          fdb CASON                       ; indirect jump, turn cassette on and start reading
BLKIN           fdb GETBLK                      ; indirect jump, read a block from tape
BLKOUT          fdb SNDBLK                      ; indirect jump, write a block to tape
JOYIN           fdb GETJOY                      ; indirect jump, read joystick axes
WRTLDR          fdb WRLDR                       ; indirect jump, turn cassette on and write a leader
; Initialization code.
LA00E           lds #LINBUF+LBUFMX+1            ; put the stack in the line input buffer which is a safe place for now
                lda #0x37                       ; enable the cartidge interrupt (to detect autostarting cartridges)
                sta PIA1+3
                lda RSTFLG                      ; get warm start flag
                cmpa #0x55                      ; is it valid?
                bne BACDST                      ; brif not - cold start
                ldx RSTVEC                      ; get warm start routine pointer
                lda ,x                          ; get first byte of the routine
                cmpa #0x12                      ; is it NOP?
                bne BACDST                      ; brif not - the routine is invalid so do a cold start
                jmp ,x                          ; transfer control to the warm start routine
; RESET/power on comes here
RESVEC          leay LA00E,pcr                  ; point to warm start check code
LA02A           ldx #PIA1                       ; point to PIA1 - we're going to rely on the mirroring to reach PIA0
                clr -3,x                        ; set PIA0 DA to direction mode
                clr -1,x                        ; set PIA0 DB to direction mode
                clr -4,x                        ; set PIA0 DA to inputs
                ldd #0xff34
                sta -2,x                        ; set PIA0 DB to outputs
                stb -3,x                        ; set PIA0 DA to data mode
                stb -1,x                        ; set PIA0 DB to data mode
                clr 1,x                         ; set PIA1 DA to direction mode
                clr 3,x                         ; set PIA1 DB to direction mode
                deca
                sta ,x                          ; set PIA1 DA bits 7-1 as output, 0 as input
                lda #0xf8                       ; set PIA1 DB bits 7-3 as output, 2-0 as input
                sta 2,x
                stb 1,x                         ; set PIA1 DA to data mode
                stb 3,x                         ; set PIA1 DB to data mode
                clr 2,x                         ; set VDG to alpha-numeric
                ldb #2                          ; make RS232 marking ("stop" bit)
                stb ,x
                ldu #SAMREG                     ; point to SAM register
                ldb #16                         ; 16 bits to clear
LA056           sta ,u++                        ; clear a bit
                decb                            ; done all?
                bne LA056                       ; brif not
                sta SAMREG+9                    ; put display at 0x400
                tfr b,dp                        ; set direct page to 0
                ldb #4                          ; use as a mask to check RAMSZ input
	sta -2,x                        ; set RAMSZ strobe high
	bitb 2,x                        ; check RAMSZ input
	beq LA072                       ; brif set for 4K RAMs
	clr -2,x                        ; set strobe low
	bitb 2,x                        ; check input
	beq LA070                       ; brif set for 64K rams
	leau -2,u                       ; adjust pointer to set SAM for 16K RAMs
LA070           sta -3,u                        ; program SAM for either 16K or 64K RAMs
LA072           jmp ,y                          ; transfer control to startup routine
; Cold start jumps here
BACDST          ldx #VIDRAM+1                   ; point past the top of the first 1K of memory (for double predec below)
LA077           clr ,--x                        ; clear a byte (last will actually try clearing LSB of RESET vector in ROM)
                leax 1,x                        ; move forward one byte (will set Z if we're done)
                bne LA077                       ; brif not donw yet
                jsr LA928                       ; clear the screen
                clr ,x+                         ; put the constant zero that lives before the program
                stx TXTTAB                      ; set beginning of program storage
LA084           lda 2,x                         ; get value from memory
                coma                            ; make it different
                sta 2,x                         ; try putting different into memory
                cmpa 2,x                        ; did it matcH?
                bne LA093                       ; brif not - we found the end of memory
                leax 1,x                        ; move pointer forward
                com 1,x                         ; restore the original memory contents
                bra LA084                       ; try another byte
LA093           stx TOPRAM                      ; save top of memory (one below actual top because we need a byte for VAL() to work)
                stx MEMSIZ                      ; save top of string space
                stx STRTAB                      ; set bottom of allocated string space
                leax -200,x                     ; allocate 200 bytes of string space
                stx FRETOP                      ; set top of actually free memory
                tfr x,s                         ; put the stack there
                ldx #LA10D                      ; point to variable initializer
                ldu #CMPMID                     ; point to variables to initialize (first batch)
                ldb #28                         ; 28 bytes in first batch
                jsr LA59A                       ; copy bytes to variables
                ldu #IRQVEC                     ; point to variables to initialize (second batch)
                ldb #30                         ; 30 bytes this time
                jsr LA59A                       ; copy bytes to variables
                ldx -12,x                       ; get SN error address
                stx 3,u                         ; set ECB's command handlers to error
                stx 8,u
                ldx #RVEC0                      ; point to RAM vectors
                ldd #0x394b                     ; write 75 RTS opcodes (25 RAM vectors)
LA0C0           sta ,x+                         ; put an RTS
                decb                            ; done?
                bne LA0C0                       ; brif not
                sta LINHDR-1                    ; make temporary line header data for line encoding have a nonzero next line pointer
                jsr LAD19                       ; do a "NEW"
                ldx #'E*256+'X                  ; magic number to detect ECB ROM
                cmpx EXBAS                      ; is there an ECB ROM?
                lbeq EXBAS+2                    ; brif so - launch it
                andcc #0xaf                     ; start interrupts
                ldx #LA147-1                    ; point to sign on message
                jsr LB99C                       ; print it out
                ldx #BAWMST                     ; warm start routine address
                stx RSTVEC                      ; set vector there
                lda #0x55                       ; warm start valid flag
                sta RSTFLG                      ; mark warm start valid
                bra LA0F3                       ; go to direct mode
; Warm start entry point
BAWMST          nop                             ; valid routine marker
                clr DEVNUM                      ; reset output/input to screen
                jsr LAD33                       ; do a partial NEW
                andcc #0xaf                     ; start interrupts
                jsr LA928                       ; clear the screen
LA0F3           jmp LAC73                       ; go to direct mode
; FIRQ service routine - this handles starting autostart cartridges
BFRQSV          tst PIA1+3                      ; is it the cartridge interrupt?
                bmi LA0FC                       ; brif so
                rti
LA0FC           jsr LA7D1                       ; delay for a while
                jsr LA7D1                       ; delay for another while
                leay <LA108,pcr                 ; point to cartridge starter
                jmp LA02A                       ; go initialize everything clean for the cartridge
LA108           clr RSTFLG                      ; force a cold start a cartridge reset
                jmp ROMPAK                      ; transfer control to the cartridge
; Variable initializers (first batch)
LA10D           fcb 18                          ; mid band partition of the 1200/2400 Hz period
                fcb 24                          ; upper limit of 1200 Hz period
                fcb 10                          ; upper limit of 2400 Hz period
                fdb 128                         ; number of 0x55s for cassette leader
                fcb 11                          ; cursor blink delay
                fdb 88                          ; 600 baud delay constant
                fdb 1                           ; printer carriage return delay constant
                fcb 16                          ; printer tab field width
                fcb 112                         ; last printer tab zone
                fcb 132                         ; printer carriage width
                fcb 0                           ; printer carriage position
                fdb LB44A                       ; default execution address for EXEC
                inc CHARAD+1                    ;* character fetching routines (DP portion) - we first do a two
                bne LA123                       ;* two stage increment of CHARAD then load the value into A
                inc CHARAD                      ;* before transferring control to the bottom half routine in ROM
LA123           lda >0                          ; NOTE: the 0 is a placeholder, extended addressing is required
                jmp BROMHK
; Variable initializers (second batch)
                jmp BIRQSV                      ; IRQ handler
                jmp BFRQSV                      ; FIRQ handler
                jmp LB44A                       ; default USR() address
                fcb 0x80,0x4f,0xc7,0x52,0x59    ; random seed
                fcb 0xff                        ; capslock flag - default to upper case
                fdb DEBDEL                      ; keyboard debounce delay (why is it a variable?)
                jmp LB277                       ; exponentiation handler vector
                fcb 53                          ; (command interpretation table) 53 commands
                fdb LAA66                       ; (command interpretation table) reserved words list (commands)
                fdb LAB67                       ; (command interpretation table) jump table (commands)
                fcb 20                          ; (command interpretation table) 20 functions
                fdb LAB1A                       ; (command interpretation table) reserved words list (functions)
                fdb LAA29                       ; (command interpretation table) jump table (functions)
; This is the signon message.
LA147           fcc 'COLOR BASIC 1.2'
                fcb 0x0d
                fcc '(C) 1982 TANDY'
                fcb 0
; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes
LA166           fcc 'MICROSOFT'
                fcb 0x0d,0
; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII)
LA171           bsr LA176                       ; get character
                anda #0x7f                      ; mask off high bit
                rts
; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available,
; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine
; has undefined results when called on an output only device. All registers except CC and A are preserved.
LA176           jsr RVEC4                       ; do RAM hook
                clr CINBFL                      ; flag data available
                tst DEVNUM                      ; is it keyboard?
                beq LA1B1                       ; brif so - blink cursor and wait for key press
                tst CINCTR                      ; is there anything in cassette input buffer?
                bne LA186                       ; brif so
                com CINBFL                      ; flag EOF
                rts
; Read character from cassette file
LA186           pshs u,y,x,b                    ; preserve registers
                ldx CINPTR                      ; get input buffer pointer
                lda ,x+                         ; get character from buffer
                pshs a                          ; save it for return
                stx CINPTR                      ; save new input buffer pointer
                dec CINCTR                      ; count character just consumed
                bne LA197                       ; brif buffer is not empty yet
                jsr LA635                       ; go read another block, if any, to refill the buffer
LA197           puls a,b,x,y,u,pc               ; restore registers and return the character
; Blink the cursor. This might be better timed via an interrupt or something.
LA199           dec BLKCNT                      ; is it time to blink the cursor?
                bne LA1AB                       ; brif not
                ldb #11                         ; reset blink timer
                stb BLKCNT
                ldx CURPOS                      ; get cursor position
                lda ,x                          ; get character at the cursor
                adda #0x10                      ; move to next color
                ora #0x8f                       ; make sure it's a grahpics block with all elements lit
                sta ,x                          ; put new cursor block on screen
LA1AB           ldx #DEBDEL                     ; we'll use the debounce delay for the cursor blink timer (10ms)
LA1AE           jmp LA7D3                       ; go count X down
; Blink cursor while waiting for a key press
LA1B1           pshs x,b                        ; save registers
LA1B3           bsr LA199                       ; go do a cursor iteration
                bsr KEYIN                       ; go read a key
                beq LA1B3                       ; brif no key pressed
                ldb #0x60                       ; VDG screen space character
                stb [CURPOS]                    ; blank cursor out
                puls b,x,pc                     ; restore registers and return
; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1
; ROMs, this routine is quite a lot more compact and robust.
LA1C1           clr PIA0+2                      ; strobe all columns
                lda PIA0                        ; get rows
                coma                            ; bits set if keys down
                lsla                            ; remove the comparator input
                beq LA244                       ; brif no keys down - don't actually poll the keyboard
KEYIN           pshs u,x,b                      ; save registers
                ldu #PIA0                       ; point to keyboard PIA
                ldx #KEYBUF                     ; point to state table
                clra                            ; clear carry, set column to 0xff (no strobe)
                deca                            ; (note: deca does not affect C)
                pshs x,a                        ; save column counter and make a couple of holes for temporaries
                sta 2,u                         ; set strobe to no columns
LA1D9           rol 2,u                         ; move to next column (C is 0 initially, 1 after)
                bcc LA220                       ; brif we shifted out a 0 - we've done 8 columns
                inc 0,s                         ; bump column counter (first bump goes to 0)
                bsr LA23A                       ; read row data
                sta 1,s                         ; save key data (for debounce check and later saving)
                eora ,x                         ; now bits set if key state changed
                anda ,x                         ; now bits are only set if a key has been pressed
                ldb 1,s                         ; get new key data
                stb ,x+                         ; save in state table
                tsta                            ; was a key down?
                beq LA1D9                       ; brif not - do another (nothing above cleared C)
                ldb 2,u                         ; get strobe data
                stb 2,s                         ; save it for debounce check
                ldb #0xf8                       ; set up so B is 0 after first add
LA1F4           addb #8                         ; add 8 for each row
                lsra                            ; did we hit the right row?
                bcc LA1F4                       ; brif not
                addb 0,s                        ; add in column number
                beq LA245                       ; brif @
                cmpb #26                        ; letter?
                bhi LA247                       ; brif not
                orb #0x40                       ; bias into letter range
                bsr LA22E                       ; check for SHIFT
                ora CASFLG                      ; merge in capslock state
                bne LA20C                       ; brif either capslock or SHIFT - keep upper case
                orb #0x20                       ; move to lower case
LA20C           stb 0,s                         ; save ASCII value
                ldx DEBVAL                      ; get debounce delay
                bsr LA1AE                       ; do the 10ms debounce delay
                ldb #0xff                       ; set strobe to none - only joystick buttons register now
                bsr LA238                       ; read keyboard
                inca                            ; A now 0 if no buttons down
                bne LA220                       ; brif button down - return nothing since we have interference
LA21A           ldb 2,s                         ; get column strobe data
                bsr LA238                       ; read row data
                cmpa 1,s                        ; does it match original read?
LA220           puls a,x                        ; clean up stack and get return value
                bne LA22B                       ; brif failed debounce or a joystick button down
                cmpa #0x12                      ; is it SHIFT-0?
                bne LA22C                       ; brif not
                com CASFLG                      ; swap capslock state
LA22B           clra                            ; set no key down
LA22C           puls b,x,u,pc                   ; restore registers and return
LA22E           lda #0x7f                       ; column strobe for SHIFT
                sta 2,u                         ; set column
                lda ,u                          ; get row data
                coma                            ; set if key down
                anda #0x40                      ; only keep SHIFT state
                rts
LA238           stb 2,u                         ; save strobe data
LA23A           lda ,u                          ; get row data
                ora #0x80                       ; mask off comparator so it doesn't interfere
                tst 2,u                         ; are we on column 7?
                bmi LA244                       ; brif not
                ora #0xc0                       ; also mask off SHIFT
LA244           rts
LA245           ldb #51                         ; scan code for @
LA247           ldx #CONTAB-0x36                ; point to code table
                cmpb #33                        ; arrows, space, zero?
                blo LA264                       ; brif so
                ldx #CONTAB-0x54                ; adjust to other half of table
                cmpb #48                        ; ENTER, CLEAR, BREAK, @?
                bhs LA264                       ; brif so
                bsr LA22E                       ; read shift state
                cmpb #43                        ; is it a number, colon, semicolon?
                bls LA25D                       ; brif so
                eora #0x40                      ; invert shift state for others
LA25D           tsta                            ; shift down?
                bne LA20C                       ; brif not - return result
                addb #0x10                      ; add in offset to shifted character
                bra LA20C                       ; go return result
LA264           lslb                            ; two entries per key
                bsr LA22E                       ; check SHIFT state
                beq LA26A                       ; brif not shift
                incb                            ; point to shifted entry
LA26A           ldb b,x                         ; get actual key code
                bra LA20C                       ; go return result
CONTAB          fcb 0x5e,0x5f                   ; <UP> (^, _)
                fcb 0x0a,0x5b                   ; <DOWN> (LF, [)
                fcb 0x08,0x15                   ; <LEFT> (BS, ^U)
                fcb 0x09,0x5d                   ; <RIGHT> (TAB, ])
                fcb 0x20,0x20                   ; <SPACE>
                fcb 0x30,0x12                   ; <0> (0, ^R)
                fcb 0x0d,0x0d                   ; <ENTER> (CR, CR)
                fcb 0x0c,0x5c                   ; <CLEAR> (FF, \)
                fcb 0x03,0x03                   ; <BREAK> (^C, ^C)
                fcb 0x40,0x13                   ; <@> (@, ^S)
; Generic output routine.
; Output character in A to the device specified by DEVNUM. All registers are preserved except CC.
; Sending output to a device that does not support output is undefined.
PUTCHR          jsr RVEC3                       ; call RAM hook
                pshs b                          ; save B
                ldb DEVNUM                      ; get desired device number
                incb                            ; set flags (Z for -1, etc.)
                puls b                          ; restore B
                bmi LA2BF                       ; brif < -1 (line printer)
                bne LA30A                       ; brif > -1 (screen)
; Write character to tape file
                pshs x,b,a                      ; save registers
                ldb FILSTA                      ; get file status
                decb                            ; input file?
                beq LA2A6                       ; brif so
                ldb CINCTR                      ; get character count
                incb                            ; account for this character
                bne LA29E                       ; brif buffer not full
                bsr LA2A8                       ; write previously full block to tape
LA29E           ldx CINPTR                      ; get output buffer pointer
                sta ,x+                         ; put character in output
                stx CINPTR                      ; save new buffer pointer
                inc CINCTR                      ; account for this character
LA2A6           puls a,b,x,pc                   ; restore registers and return
; Write a block of data to tape.
LA2A8           ldb #1                          ; data block type
LA2AA           stb BLKTYP                      ; set block type
                ldx #CASBUF                     ; point to output buffer
                stx CBUFAD                      ; set buffer pointer
                ldb CINCTR                      ; get number of bytes in the block
                stb BLKLEN                      ; set length to write
                pshs u,y,a                      ; save registers
                jsr LA7E5                       ; write a block to tape
                puls a,y,u                      ; restore registers
                jmp LA650                       ; reset buffer pointers
; Send byte to line printer
LA2BF           pshs x,b,a,cc                   ; save registers and interrupt status
                orcc #0x50                      ; disable interrupts
LA2C3           ldb PIA1+2                      ; get RS232 status
                lsrb                            ; get status to C
                bcs LA2C3                       ; brif busy - loop until not busy
                bsr LA2FB                       ; set output to marking
                clrb                            ; transmit one start bit
                bsr LA2FD
                ldb #8                          ; counter for 8 bits
LA2D0           pshs b                          ; save bit count
                clrb                            ; zero output bits
                lsra                            ; bet output bit to C
                rolb                            ; get output bit to correct bit for output byte
                lslb
                bsr LA2FD                       ; transmit bit
                puls b                          ; get back bit counter
                decb                            ; are we done yet?
                bne LA2D0                       ; brif not
                bsr LA2FB                       ; send stop bit (marking)
                puls cc,a                       ; restore interrupt status and output character
                cmpa #0x0d                      ; carriage return?
                beq LA2ED                       ; brif so
                inc LPTPOS                      ; bump output position
                ldb LPTPOS                      ; get new position
                cmpb LPTWID                     ; end of line?
                blo LA2F3                       ; brif not
LA2ED           clr LPTPOS                      ; reset position to start of line
                bsr LA305                       ; do carriage return delay
                bsr LA305
LA2F3           ldb PIA1+2                      ; get RS232 status
                lsrb                            ; get status to C
                bcs LA2F3                       ; brif still busy, keep waiting
                puls b,x,pc                     ; restore registers and return
LA2FB           ldb #2                          ; set output to high (marking)
LA2FD           stb PIA1                        ; set RS232 output
                bsr LA302                       ; do baud delay (first iteration) then fall through for second
LA302           ldx LPTBTD                      ; get buard rate delay constant
                skip2
LA305           ldx LPTLND                      ; get carriage return delay constant
                jmp LA7D3                       ; count X down
; Output character to screen
LA30A           pshs x,b,a                      ; save registers
                ldx CURPOS                      ; get cursor pointer
                cmpa #0x08                      ; backspace?
                bne LA31D                       ; brif not
                cmpx #VIDRAM                    ; at top of screen?
                beq LA35D                       ; brif so - it's a no-op
                lda #0x60                       ; VDG space character
                sta ,-x                         ; put a space at previous location and move pointer back
                bra LA344                       ; save new cursor position and return
LA31D           cmpa #0x0d                      ; carriage return?
                bne LA32F                       ; brif not
                ldx CURPOS                      ; get cursor pointer (why? we already have it)
LA323           lda #0x60                       ; VDG space character
                sta ,x+                         ; put output space
                tfr x,d                         ; see if we at a multiple of 32 now
                bitb #0x1f
                bne LA323                       ; brif not
                bra LA344                       ; go check for scrolling
LA32F           cmpa #0x20                      ; control character?
                blo LA35D                       ; brif so
                tsta                            ; is it graphics block?
                bmi LA342                       ; brif so
                cmpa #0x40                      ; number or special?
                blo LA340                       ; brif so (flip "case" bit)
                cmpa #0x60                      ; upper case alpha?
                blo LA342                       ; brif so - keep it unmodified
                anda #0xdf                      ; clear bit 5 (inverse video)
LA340           eora #0x40                      ; flip inverse video bit
LA342           sta ,x+                         ; output character
LA344           stx CURPOS                      ; save new cursor position
                cmpx #VIDRAM+511                ; end of screen?
                bls LA35D                       ; brif not
                ldx #VIDRAM                     ; point to start of screen
LA34E           ldd 32,x                        ; get two characters from next row
                std ,x++                        ; put them on this row
                cmpx #VIDRAM+0x1e0              ; at start of last row on screen?
                blo LA34E                       ; brif not
                ldb #0x60                       ; VDG space
                jsr LA92D                       ; blank out last line (borrow CLS's loop)
LA35D           puls a,b,x,pc                   ; restore registers and return
; Set up device parameters for output
LA35F           jsr RVEC2                       ; do the RAM hook dance
                pshs x,b,a                      ; save registers
                clr PRTDEV                      ; flag device as a screen
                lda DEVNUM                      ; get devicenumber
                beq LA373                       ; brif screen
                inca                            ; is it tape?
                beq LA384                       ; brif so
                ldx LPTCFW                      ; get tab width and last tab stop for printer
                ldd LPTWID                      ; get line width and current position for printer
                bra LA37C                       ; set parameters
LA373           ldb CURPOS+1                    ; get LSB of cursor position
                andb #0x1f                      ; now we have the offset into the line
                ldx #0x1010                     ; 16 character tab, position 16 is last tab stop
                lda #32                         ; screen is 32 characters wide
LA37C           stx DEVCFW                      ; save tab width and last tab stop for active device
                stb DEVPOS                      ; save line position for current device
                sta DEVWID                      ; save line width for current device
                puls a,b,x,pc                   ; restore registers and return
LA384           com PRTDEV                      ; flag device as non-display
                ldx #0x0100                     ; tab width is 1, last tab field is 0
                clra                            ; line width is 0
                clrb                            ; character position on line is 0
                bra LA37C                       ; go set parameters
; This is the line input routine used for reading lines for Basic, both in immediate mode and for
; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER.
; The actualy entry point is LA390. Note that this routine echoes to *all* devices.
LA38D           jsr LA928                       ; clear screen (CLEAR key handling)
LA390           jsr RVEC12                      ; do the RAM hook dance
                clr IKEYIM                      ; reset cached input character from BREAK check
                ldx #LINBUF+1                   ; point to line input buffer (input pointer)
                ldb #1                          ; Number of characters in line (we start at 1 so BS handling is easier)
LA39A           jsr LA171                       ; get an input character, only keep low 7 bits
                tst CINBFL                      ; is it EOF?
                bne LA3CC                       ; brif EOF
                tst DEVNUM                      ; is it keyboard input?
                bne LA3C8                       ; brif not - don't do line editing
                cmpa #0x0c                      ; form feed (CLEAR)?
                beq LA38D                       ; brif so - clear screen and reset
                cmpa #0x08                      ; backspace?
                bne LA3B4                       ; brif not
                decb                            ; move back one character
                beq LA390                       ; brif we were at the start of the line - reset and start again
                leax -1,x                       ; move input pointer back
                bra LA3E8                       ; echo the backspace and continue
LA3B4           cmpa #0x15                      ; SHIFT-LEFT (kill line)?
                bne LA3C2                       ; brif not
LA3B8           decb                            ; at start of line?
                beq LA390                       ; brif so - reset and restart
                lda #0x08                       ; echo a backspace
                jsr PUTCHR
                bra LA3B8                       ; see if we've erased everything yet
LA3C2           cmpa #0x03                      ; BREAK?
                orcc #1                         ; set C if it is (only need Z for the next test
                beq LA3CD                       ; brif BREAK - exit
LA3C8           cmpa #0x0d                      ; ENTER (CR)
                bne LA3D9                       ; brif not
LA3CC           clra                            ; clear carry (it might not be clear on EOF)
LA3CD           pshs cc                         ; save ENTER/BREAK flag
                jsr LB958                       ; echo a carriage return
                clr ,x                          ; make sure we have a NUL at the end of the buffer
                ldx #LINBUF                     ; point to input buffer
                puls cc,pc                      ; restore ENTER/BREAK flag and return
LA3D9           cmpa #0x20                      ; control character?
                blo LA39A                       ; brif so - skip it
                cmpa #'z+1                      ; above z?
                bhs LA39A                       ; brif so - ignore it
                cmpb #LBUFMX                    ; is the buffer full?
                bhs LA39A                       ; brif so - ignore extra characters
                sta ,x+                         ; put character in the buffer
                incb                            ; bump character count
LA3E8           jsr PUTCHR                      ; echo character
                bra LA39A                       ; go handle next input character
; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open.
LA3ED           jsr RVEC5                       ; do the RAM hook dance
                lda DEVNUM                      ; get device number
                beq LA415                       ; brif keyboard - always valid
                inca                            ; is it tape?
                bne LA403                       ; brif not
                lda FILSTA                      ; get tape file status
                bne LA400                       ; brif file is open
LA3FB           ldb #22*2                       ; raise NO error
                jmp LAC46
LA400           deca                            ; is it in input mode?
                beq LA415                       ; brif so
LA403           jmp LA616                       ; raise FM error
; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open.
LA406           jsr RVEC6                       ; do the RAM hook dance
                lda DEVNUM                      ; get device number
                inca                            ; is it tape?
                bne LA415                       ; brif not
                lda FILSTA                      ; get file status
                beq LA3FB                       ; brif not open
                deca                            ; is it open for reading?
                beq LA403                       ; brif so - bad mode
LA415           rts
; CLOSE command
CLOSE           beq LA426                       ; brif no file specified - close all files
                jsr LA5A5                       ; parse device number
LA41B           bsr LA42D                       ; close specified file
                jsr GETCCH                      ; is there more?
                beq LA44B                       ; brif not
                jsr LA5A2                       ; check for comma and parse another device number
                bra LA41B                       ; go close this one
; Close all files handler.
LA426           jsr RVEC7                       ; Yup. The RAM hook dance.
                lda #-1                         ; start with tape file
                sta DEVNUM
; Close file specified in DEVNUM. Note that this never fails.
LA42D           jsr RVEC8                       ; You know it. RAM hook.
                lda DEVNUM                      ; get device we're closing
                clr DEVNUM                      ; reset to screen/keyboard
                inca                            ; is it tape?
                bne LA44B                       ; brif not
                lda FILSTA                      ; get file status
                cmpa #2                         ; is it output?
                bne LA449                       ; brif not
                lda CINCTR                      ; is there anything waiting to be written?
                beq LA444                       ; brif not
                jsr LA2A8                       ; write final block of data
LA444           ldb #0xff                       ; write EOF block
                jsr LA2AA
LA449           clr FILSTA                      ; mark tape file closed
LA44B           rts
; CSAVE command
CSAVE           jsr LA578                       ; parse filename
                jsr GETCCH                      ; see what we have after the file name
                beq LA469                       ; brif none
                jsr LB26D                       ; make sure there's a comma
                ldb #'A                         ; make sure there's an A after
                jsr LB26F
                bne LA44B                       ; brif not end of line
                clra                            ; file type 0 (basic program)
                jsr LA65C                       ; write out header block
                lda #-1                         ; set output to tape
                sta DEVNUM
                clra                            ; set Z so we list the whole program
                jmp LIST                        ; go list the program to tape
LA469           clra                            ; file type 0 (basic program)
                ldx ZERO                        ; set to binary file mode
                jsr LA65F                       ; write header block
                clr FILSTA                      ; close files
                inc BLKTYP                      ; set block type to data
                jsr WRLDR                       ; write out a leader
                ldx TXTTAB                      ; point to start of program
LA478           stx CBUFAD                      ; set buffer location
                lda #255                        ; block size to 255 bytes (max size)
                sta BLKLEN
                ldd VARTAB                      ; get end of program
                subd CBUFAD                     ; how much is left?
                beq LA491                       ; brif we have nothing left
                cmpd #255                       ; do we have a full block worth?
                bhs LA48C                       ; brif so
                stb BLKLEN                      ; save actual remainder as block length
LA48C           jsr SNDBLK                      ; write a block out
                bra LA478                       ; go do another block
LA491           neg BLKTYP                      ; set block type to 0xff (EOF)
                clr BLKLEN                      ; no data in EOF block
                jmp LA7E7                       ; write EOF, stop tape, and return
; CLOAD and CLOADM commands
CLOAD           clr FILSTA                      ; close tape file
                cmpa #'M                        ; is it ClOADM?
                beq LA4FE                       ; brif so
                leas 2,s                        ; clean up stack
                jsr LA5C5                       ; parse file name
                jsr LA648                       ; go find the file
                tst CASBUF+10                   ; is it binary?
                beq LA4C8                       ; brif so
                lda CASBUF+9                    ; is it ASCII?
                beq LA4CD                       ; brif not
                jsr LAD19                       ; clear out existing program
                lda #-1                         ; set up for reading from tape
                sta DEVNUM
                inc FILSTA                      ; set tape file to input
                jsr LA635                       ; go read first block
                jmp LAC7C                       ; go to immediate mode to read in the program
; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is
; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in
; 8K.
LA4BF           jsr RVEC13                      ; do the RAM hook dance
                jsr LA42D                       ; close file
                jmp LAC73                       ; go back to immediate mode
LA4C8           lda CASBUF+8                    ; get file type
                beq LA4D0                       ; brif basic program
LA4CD           jmp LA616                       ; raise FM error
LA4D0           jsr LAD19                       ; erase existing program
                jsr CASON                       ; start reading tape
                ldx TXTTAB                      ; get start of program storage
LA4D8           stx CBUFAD                      ; set load address for block
                ldd CBUFAD                      ; get start of block
                inca                            ; bump by 256
                jsr LAC37                       ; check if there's room for a maximum sized block of 255
                jsr GETBLK                      ; go read a block
                bne LA4F8                       ; brif there was an error during reading
                lda BLKTYP                      ; get type of block read
                beq LA4F8                       ; brif header block - IO error
                bpl LA4D8                       ; brif data block - read another
                stx VARTAB                      ; save new end of program
                bsr LA53B                       ; stop tape
                ldx #LABED-1                    ; point to "OK" prompt
                jsr LB99C                       ; show prompt
                jmp LACE9                       ; reset various things and return
LA4F8           jsr LAD19                       ; clear out partial program load
LA4FB           jmp LA619                       ; raise IO error
; This is the CLOADM command
LA4FE           jsr GETNCH                      ; eat the "M"
                bsr LA578                       ; parse file name
                jsr LA648                       ; go find the file
LA505           ldx ZERO                        ; default offset is 0
                jsr GETCCH                      ; see if there's something after the file name
                beq LA511                       ; brif no offset
                jsr LB26D                       ; make sure there's a comma
                jsr LB73D                       ; evaluate offset to X
LA511           lda CASBUF+8                    ; get file mode
                cmpa #2                         ; M/L program?
                bne LA4CD                       ; brif not - FM error
                ldd CASBUF+11                   ; get load address
                leau D,x                        ; add in offset
                stu EXECJP                      ; set EXEC default address
                tst CASBUF+10                   ; is it binary?
                bne LA4CD                       ; brif not
                ldd CASBUF+13                   ; get load address
                leax d,x                        ; add in offset
                stx CBUFAD                      ; set buffer address for loading
                jsr CASON                       ; start up tape
LA52E           jsr GETBLK                      ; read a block
                bne LA4FB                       ; brif error reading
                stx CBUFAD                      ; save new load address
                tst BLKTYP                      ; set flags on block type
                beq LA4FB                       ; brif another header - IO error
                bpl LA52E                       ; brif it was data - read more
LA53B           jmp LA7E9                       ; turn off tape and return
; The EXEC command
EXEC            beq LA545                       ; brif no argument - use default address
                jsr LB73D                       ; evaluate EXEC address to X
                stx EXECJP                      ; set new default EXEC address
LA545           jmp [EXECJP]                    ; transfer control to execution address
; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break
; check logic or packaged up with LIST?
LA549           jsr RVEC11                      ; do the RAM hook dance
                lda DEVNUM                      ; get device number
                inca                            ; is it tape?
                beq LA5A1                       ; brif so - don't do break check
                jmp LADEB                       ; do the actual break check
; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position.
; This really should be located with the PRINT command.
LA554           jsr LB3E4                       ; evaluate a positive expression to D
                subd #511                       ; is it within bounds?
                lbhi LB44A                      ; brif not - error out
                addd #VIDRAM+511                ; adjust to be within the screen (and undo the SUBD above)
                std CURPOS                      ; set cursor position
                rts
; INKEY$ function
INKEY           lda IKEYIM                      ; was a key down during break check?
                bne LA56B                       ; brif so
                jsr KEYIN                       ; poll the keyboard
LA56B           clr IKEYIM                      ; reset the break check cache
                sta FPA0+3                      ; store result for later return
                lbne LB68F                      ; brif a key was down - return it as a string
                sta STRDES                      ; set string length to 0 (no key down)
                jmp LB69B                       ; return the NULL string
; Parse a filename
LA578           ldx #CFNBUF                     ; point to file name buffer
                clr ,x+                         ; zero out file name length
                lda #0x20                       ; space character to initialize file name
LA57F           sta ,x+                         ; put a space in the buffer
                cmpx #CASBUF                    ; at end of file name?
                bne LA57F                       ; brif not
                jsr GETCCH                      ; get input character
                beq LA5A1                       ; brif no name present
                jsr LB156                       ; evaluate the file name expression
                jsr LB654                       ; point to start of the file name
                ldu #CFNBUF                     ; point to file name buffer
                stb ,u+                         ; save string length
                beq LA5A1                       ; brif empty - we're done
                skip2
LA598           ldb #8                          ; copy 8 bytes
; Move B bytes from (X) to (U)
LA59A           lda ,x+                         ; copy a byte
                sta ,u+
                decb                            ; done yet?
                bne LA59A                       ; brif not
LA5A1           rts
; Parse a device number and check validity
LA5A2           jsr LB26D                       ; check for comma and SN error if not
LA5A5           cmpa #'#                        ; do we have a #?
                bne LA5AB                       ; brif not (it's optional)
                jsr GETNCH                      ; munch the #
LA5AB           jsr LB141                       ; evaluate the expression
LA5AE           jsr INTCNV                      ; convert it to an integer in D
                rolb                            ; move sign of B into C
                adca #0                         ; add sign of B to A
                bne LA61F                       ; brif A doesn't match the sign of B
                rorb                            ; restore B (ADCA will have set C if B was negative)
                stb DEVNUM                      ; set device number
                jsr RVEC1                       ; do the RAM hook dance
                beq LA5C4                       ; brif device number set to screen/keyboard (valid)
                bpl LA61F                       ; brif not negative (not valid)
                cmpb #-2                        ; is it printer or tape?
                blt LA61F                       ; brif not (not valid)
LA5C4           rts
; Read file name from the line and do an error if anything follows it
LA5C5           bsr LA578                       ; parse file name
                jsr GETCCH                      ; set flags on current character
LA5C9           beq LA5C4                       ; brif nothing there - it's good
                jmp LB277                       ; raise SN error
; EOF functoin
EOF             jsr RVEC14                      ; do the RAM hook dance
                lda DEVNUM                      ; get device number
                pshs a                          ; save it (so we can restore it later)
                bsr LA5AE                       ; check the device number (which is in FPA0)
                jsr LA3ED                       ; check validity for reading
LA5DA           clrb                            ; not EOF = 0 (FALSE)
                lda DEVNUM                      ; get device number
                beq LA5E4                       ; brif keyboard - never EOF
                tst CINCTR                      ; is there anything in the input buffer?
                bne LA5E4                       ; brif so - not EOF
                comb                            ; set EOF flag to -1 (true)
LA5E4           puls a                          ; get back original device
                sta DEVNUM                      ; restore it
LA5E8           sex                             ; sign extend result to 16 bits
                jmp GIVABF                      ; go return the result
; SKIPF command
SKIPF           bsr LA5C5                       ; parse file name
                bsr LA648                       ; look for the file
                jsr LA6D1                       ; read the file
                bne LA619                       ; brif error reading file
                rts
; OPEN command
OPEN            jsr RVEC0                       ; do the RAM hook dance
                jsr LB156                       ; get file status (input/output)
                jsr LB6A4                       ; get first character of status string
                pshs b                          ; save status
                bsr LA5A2                       ; parse a comma then the device number
                jsr LB26D                       ; make sure there's a comma
                bsr LA5C5                       ; parse the file name
                lda DEVNUM                      ; get device number of the file
                clr DEVNUM                      ; reset actual device to the screen
                puls b                          ; get back status
                cmpb #'I                        ; INPUT?
                beq LA624                       ; brif so - open a file for INPUT
                cmpb #'O                        ; OUTPUT?
                beq LA658                       ; brif so - open a file for OUTPUT
LA616           ldb #21*2                       ; raise FM error
                skip2
LA619           ldb #20*2                       ; raise I/O error
                skip2
LA61C           ldb #18*2                       ; raise AO error
                skip2
LA61F           ldb #19*2                       ; raise DN error
                jmp LAC46
LA624           inca                            ; are we opening the tape?
                bmi LA616                       ; brif printer - FM error; printer can't be opened for READ
                bne LA657                       ; brif screen - screen is always open
                bsr LA648                       ; read header block
                lda CASBUF+9                    ; clear A if binary or machine language file
                anda CASBUF+10
                beq LA616                       ; bad file mode if not data file
                inc FILSTA                      ; open file for input
LA635           jsr LA701                       ; start tape, read block           
                bne LA619                       ; brif error during read
                tst BLKTYP                      ; check block type
                beq LA619                       ; brif header block - something's wrong
                bmi LA657                       ; brif EOF
                lda BLKLEN                      ; get length of block
                beq LA635                       ; brif empty block - read another
LA644           sta CINCTR                      ; set buffer count
                bra LA652                       ; reset buffer pointer
LA648           tst FILSTA                      ; is the file open?
                bne LA61C                       ; brif so - AO error
                bsr LA681                       ; search for file
                bne LA619                       ; brif error on read
LA650           clr CINCTR                      ; mark buffer empty
LA652           ldx #CASBUF                     ; set buffer pointer to start of buffer
                stx CINPTR
LA657           rts
LA658           inca                            ; check for tape device
                bne LA657                       ; brif not tape (nothing doing - it's always open)
                inca                            ; make file type 1
LA65C           ldx #0xffff                     ; ASCII and data mode
LA65F           tst FILSTA                      ; is file open?
                bne LA61C                       ; brif so - raise error
                ldu #CASBUF                     ; point to tape buffer
                stu CBUFAD                      ; set address of block to write
                sta 8,u                         ; set file type
                stx 9,u                         ; set ASCII flag and mode
                ldx #CFNBUF+1                   ; point to file name
                jsr LA598                       ; move file name to the tape buffer
                clr BLKTYP                      ; set for header block
                lda #15                         ; 15 bytes in a header block
                sta BLKLEN                      ; set block length
                jsr LA7E5                       ; write the block
                lda #2                          ; set file type to output
                sta FILSTA
                bra LA650                       ; reset file pointers
; Search for correct cassette file name
LA681           ldx #CASBUF                     ; point to cassette buffer
                stx CBUFAD                      ; set location to read blocks to
LA686           lda CURLIN                      ; are we in immediate mode?
                inca
                bne LA696                       ; brif not
                jsr LA928                       ; clear screen
                ldx CURPOS                      ; get start of screen (set after clear)
                ldb #'S                         ; for "searching"
                stb ,x++                        ; put it on the screen
                stx CURPOS                      ; save cursor position to be one past the search indicator
LA696           bsr LA701                       ; read a block
                orb BLKTYP                      ; merge error flag with block type
                bne LA6D0                       ; brif error or not header
                ldx #CASBUF                     ; point to block just read
                ldu #CFNBUF+1                   ; point to the desired name
                ldb #8                          ; compare 8 characters
                clr ,-s                         ; set flag to "match"
LA6A6           lda ,x+                         ; get character from just read block
                ldy CURLIN                      ; immediate mode?
                leay 1,y
                bne LA6B4                       ; brif not
                clr DEVNUM                      ; set output to screen
                jsr PUTCHR                      ; display character
LA6B4           suba ,u+                        ; subtract from desired file name (nonzero if no match)
                ora ,s                          ; merge with match flag
                sta ,s                          ; save new match flag (will be nonzero if any character differs)
                decb                            ; done all characters?
                bne LA6A6                       ; brif not - do another
                lda ,s+                         ; get match flag (and set flags)
                beq LA6CB                       ; brif we have a match
                tst -9,u                        ; did we actually have a file name or will any file do?
                beq LA6CB                       ; brif any file will do
                bsr LA6D1                       ; go read past the file
                bne LA6D0                       ; return on error
                bra LA686                       ; keep looking
LA6CB           lda #'F                         ; for "found"
                bsr LA6F8                       ; put "F" on screen
                clra                            ; set Z to indicat eno errors
LA6D0           rts
LA6D1           tst CASBUF+10                   ; check type of file
                bne LA6DF                       ; brif "blocked" file
                jsr CASON                       ; turn on tape
LA6D9           bsr GETBLK                      ; read a block
                bsr LA6E5                       ; error or EOF?
                bra LA6D9                       ; read another block
LA6DF           bsr LA701                       ; read a single block
                bsr LA6E5                       ; error or EOF?
                bra LA6DF                       ; read another block
LA6E5           bne LA6ED                       ; got error reading block
                lda BLKTYP                      ; check block type
                nega                            ; A is 0 now if EOF
                bmi LA700                       ; brif not end of file
                deca                            ; clear error indicator
LA6ED           sta CSRERR                      ; set error flag
                leas 2,s                        ; don't return to original caller
                bra LA705                       ; turn off motor and return
LA6F3           lda VIDRAM                      ; get first char on screen
                eora #0x40                      ; flip case
LA6F8           ldb CURLIN                      ; immediate mode?
                incb
                bne LA700                       ; brif not
                sta VIDRAM                      ; save flipped case character
LA700           rts
; Read a single block from tape (for a "blocked" file)
LA701           bsr CASON                       ; start tape going
                bsr GETBLK                      ; read block
LA705           jsr LA7E9                       ; stop tape
                ldb CSRERR                      ; get error status
                rts
; Read a block from tape - this does the heavy lifting
GETBLK          orcc #0x50                      ; disable interrupts (timing is important)
                bsr LA6F3                       ; reverse video of upper left character in direct mode
                ldx CBUFAD                      ; point to destination buffer
                clra                            ; reset read byte
LA712           bsr LA755                       ; read a bit
                rora                            ; move bit into accumulator
                cmpa #0x3c                      ; have we synched on the start of the block data yet?
                bne LA712                       ; brif not
                bsr LA749                       ; read block type
                sta BLKTYP
                bsr LA749                       ; get block size
                sta BLKLEN
                adda BLKTYP                     ; accumulate checksum
                sta CCKSUM                      ; save current checksum
                lda BLKLEN                      ; get back count
                sta CSRERR                      ; initialize counter; we use this since it will be ovewritten later anyway
                beq LA73B                       ; brif empty block
LA72B           bsr LA749                       ; read a byte
                sta ,x                          ; save in buffer
                cmpa ,x+                        ; make sure it wrote
                bne LA744                       ; brif error if it didn't match
                adda CCKSUM                     ; accumulate checksum
                sta CCKSUM
                dec CSRERR                      ; read all bytes?
                bne LA72B                       ; brif not
LA73B           bsr LA749                       ; read checksum from tape
                suba CCKSUM                     ; does it match?
                beq LA746                       ; brif so
                lda #1                          ; checksum error flag
                skip2
LA744           lda #2                          ; non-RAM error flag
LA746           sta CSRERR                      ; save error status
                rts
LA749           lda #8                          ; read 8 bits
                sta CPULWD                      ; initialize counter
LA74D           bsr LA755                       ; read a bit
                rora                            ; put it into accumulator
                dec CPULWD                      ; got all 8 bits?
                bne LA74D                       ; brif not
                rts
LA755           bsr LA75D                       ; get time between transitions
                ldb CPERTM                      ; get timer
                decb
                cmpb CMPMID                     ; set C if timer is below the transition point - high or 1; clear otherwise
                rts
LA75D           clr CPERTM                      ; reset timer
                tst CBTPHA                      ; check which phase we synched on
                bne LA773                       ; brif HI-LO synch
LA763           bsr LA76C                       ; read input
                bcs LA763                       ; brif still high
LA767           bsr LA76C                       ; read input
                bcc LA767                       ; brif still low
                rts
LA76C           inc CPERTM                      ; bump timer
                ldb PIA1                        ; get input bit to C
                rorb
                rts
LA773           bsr LA76C                       ; read input
                bcc LA773                       ; brif still low
LA777           bsr LA76C                       ; read output
                bcs LA777                       ; brif still high
                rts
; Start tape and look for sync bytes
CASON           orcc #0x50                      ; disable interrupts
                bsr LA7CA                       ; turn on tape
                clr CPULWD                      ; reset timer
LA782           bsr LA763                       ; wait for low-high transition
LA784           bsr LA7AD                       ; wait for it to go low again
                bhi LA797                       ; brif in range for 1200 Hz
LA788           bsr LA7A7                       ; wait for it to go high again
                blo LA79B                       ; brif in range for 2400 Hz
                dec CPULWD                      ; decrement counter (synched on low-high)
                lda CPULWD                      ; get counter
                cmpa #-96                       ; have we seen 96 1-0-1-0 patterns (48 0x55s)?
LA792           bne LA782                       ; brif not - wait some more
                sta CBTPHA                      ; save phase we synched on
                rts
LA797           bsr LA7A7                       ; wait for it to go high again
                bhi LA784                       ; brif another 1200 Hz, 2 in a row, try again
LA79B           bsr LA7AD                       ; wait for it to go low again
                blo LA788                       ; brif another 2400 Hz; go try again for high
                inc CPULWD                      ; bump counter
                lda CPULWD                      ; get counter
                suba #96                        ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa)
                bra LA792                       ; set phase and return or keep waiting
LA7A7           clr CPERTM                      ; reset period timer
                bsr LA767                       ; wait for high
                bra LA7B1                       ; set flags on result
LA7AD           clr CPERTM                      ; reset period timer
                bsr LA777                       ; wait for low
LA7B1           ldb CPERTM                      ; get period count
                cmpb CMP0                       ; is it too long for 1200Hz?
                bhi LA7BA                       ; brif so - reset counts
                cmpb CMP1                       ; set C if 2400Hz, clear C if 1200 Hz
                rts
LA7BA           clr CPULWD                      ; reset sync counter (too slow or drop out)
                rts
; MOTOR command
MOTOR           tfr a,b                         ; save ON/OFF
                jsr GETNCH                      ; eat the ON/OFF token
                cmpb #0xaa                      ; OFF?
                beq LA7E9                       ; brif so - turn off tape
                cmpb #0x88                      ; ON?
                jsr LA5C9                       ; SN error if no match
; Turn on tape
LA7CA           lda PIA1+1                      ; get motor control value
                ora #8                          ; turn on bit 3 (starts motor)
                bsr LA7F0                       ; put it back (dumb but it saves a byte)
LA7D1           ldx ZERO                        ; maximum delay timer
LA7D3           leax -1,x                       ; count down
                bne LA7D3                       ; brif not at 0 yet
                rts
; Write a synch leader to tape
WRLDR           orcc #0x50                      ; disable interrupts
                bsr LA7CA                       ; turn on tape
                ldx SYNCLN                      ; get count of 0x55s to write
LA7DE           bsr LA828                       ; write a 0x55
                leax -1,x                       ; done?
                bne LA7DE                       ; brif not
                rts
; Write sync bytes and a block, then stop tape
LA7E5           bsr WRLDR                       ; write sync
LA7E7           bsr SNDBLK                      ; write block
; Turn off tape
LA7E9           andcc #0xaf                     ; enable interrupts
                lda PIA1+1                      ; get control register
                anda #0xf7                      ; disable motor bit
LA7F0           sta PIA1+1                      ; set motor enable bit
                rts
; Write a block to tape.
SNDBLK          orcc #0x50                      ; disable interrupts
                ldb BLKLEN                      ; get block size
                stb CSRERR                      ; initialize character counter
                lda BLKLEN                      ; initialize checksum
                beq LA805                       ; brif empty block
                ldx CBUFAD                      ; point to tape buffer
LA800           adda ,x+                        ; accumulate checksum
                decb                            ; end of block data?
                bne LA800                       ; brif not
LA805           adda BLKTYP                     ; accumulate block type into checksum
                sta CCKSUM                      ; save calculated checksum
                ldx CBUFAD                      ; point to buffer
                bsr LA828                       ; send a 0x55
                lda #0x3c                       ; and then a 0x3c
                bsr LA82A
                lda BLKTYP                      ; send block type
                bsr LA82A
                lda BLKLEN                      ; send block size
                bsr LA82A
                tsta                            ; empty block?
                beq LA824                       ; brif so
LA81C           lda ,x+                         ; send character from block data
                bsr LA82A
                dec CSRERR                      ; are we done yet?
                bne LA81C                       ; brif not
LA824           lda CCKSUM                      ; send checksum
                bsr LA82A
LA828           lda #0x55                       ; send a 0x55
LA82A           pshs a                          ; save output byte
                ldb #1                          ; initialize bit probe
LA82E           lda CLSTSN                      ; get ending value of last cycle
                sta PIA1                        ; set DA
                ldy #LA85C                      ; point to sine wave table
                bitb ,s                         ; is bit set?
                bne LA848                       ; brif so - do high frequency
LA83B           lda ,y+                         ; get next sample (use all for low frequency)
                cmpy #LA85C+36                  ; end of table?
                beq LA855                       ; brif so
                sta PIA1                        ; set output sample
                bra LA83B                       ; do another sample
LA848           lda ,y++                        ; get next sample (use every other for high frequency)
                cmpy #LA85C+36                  ; end of table?
                beq LA855                       ; brif so
                sta PIA1                        ; send output sample
                bra LA848                       ; do another sample
LA855           sta CLSTSN                      ; save last sample that *would* have been sent
                lslb                            ; shift mask to next bit
                bcc LA82E                       ; brif not done all 8 bits
                puls a,pc                       ; get back original character and return
; This is the sample table for the tape sine wave
LA85C           fcb 0x82,0x92,0xaa,0xba,0xca,0xda
                fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2
                fcb 0xea,0xda,0xca,0xba,0xaa,0x92
                fcb 0x7a,0x6a,0x52,0x42,0x32,0x22
                fcb 0x12,0x0a,0x02,0x02,0x02,0x0a
                fcb 0x12,0x22,0x32,0x42,0x52,0x6a
; SET command
SET             bsr LA8C1                       ; get absolute screen position of graphics block
                pshs x                          ; save character location
                jsr LB738                       ; evaluate comma then expression in B
                puls x                          ; get back character pointer
                cmpb #8                         ; valid colour?
                bhi LA8D5                       ; brif not
                decb                            ; normalize colours
                bmi LA895                       ; brif colour 0 (use current colour)
                lda #0x10                       ; 16 patterns per colour
                mul
                bra LA89D                       ; go save the colour
LA895           ldb ,x                          ; get current value
                bpl LA89C                       ; brif not grahpic
                andb #0x70                      ; keep only the colour
                skip1
LA89C           clrb                            ; reset block to all black
LA89D           pshs b                          ; save colour
                bsr LA90D                       ; force a )
                lda ,x                          ; get current screen value
                bmi LA8A6                       ; brif graphic block already
                clra                            ; force all pixels off
LA8A6           anda #0x0f                      ; keep only pixel data
                ora GRBLOK                      ; set the desired pixel
                ora ,s+                         ; merge with desired colour
LA8AC           ora #0x80                       ; force it to be a graphic block
                sta ,x                          ; put new block on screen
                rts
; RESET command
RESET           bsr LA8C1                       ; get address of desired block
                bsr LA90D                       ; force a )
                clra                            ; zero block (no pixels)
                ldb ,x                          ; is it graphics?
                bpl LA8AC                       ; brif not - just blank the block
                com GRBLOK                      ; invert pixel data
                andb GRBLOK                     ; turn off the desired pixel
                stb ,x                          ; put new pixel data on screen
                rts
; Parse SET/RESET/POINT coordinates except for closing )
LA8C1           jsr LB26A                       ; make sure it starts with (
LA8C4           jsr RVEC21                      ; do the RAM hook dance
                jsr LB70B                       ; get first coordinate
                cmpb #63                        ; valid horizontal coordinate
                bhi LA8D5                       ; brif out of range
                pshs b                          ; save horizontal coordinate
                jsr LB738                       ; look for , followed by vertical coordinate
                cmpb #31                        ; in range for vertical?
LA8D5           bhi LA948                       ; brif not
                pshs b                          ; save vertical coordinate
                lsrb                            ; divide by two (two blocks per row)
                lda #32                         ; 32 bytes per row
                mul                             ; now we have the offset into video RAM
                ldx #VIDRAM                     ; point to start of screen
                leax d,x                        ; now X points to the correct character row
                ldb 1,s                         ; get horizontal coordinate
                lsrb                            ; divide by two (two per character cell)
                abx                             ; now we're pointing to the correct character cell
                puls a,b                        ; get back coordinates (vertical in A)
                anda #1                         ; keep only row offset of vertical
                rorb                            ; get column offset of horizontal to C
                rola                            ; now we have "row * 2 + col" in A
                ldb #0x10                       ; make a bit mask (one bit left of first pixel)
LA8EE           lsrb                            ; move mask right
                deca                            ; at the right pixel?
                bpl LA8EE                       ; brif not
                stb GRBLOK                      ; save graphics block mask
                rts
; POINT function
POINT           bsr LA8C4                       ; evaluate coordinates
                ldb #0xff                       ; default colour value is -1 (not graphics)
                lda ,x                          ; get character
                bpl LA90A                       ; brif not graphics
                anda GRBLOK                     ; is desired pixel set?
                beq LA909                       ; brif not - return 0 for "black"
                ldb ,x                          ; get graphics data
                lsrb                            ; shift right 4 to get colour in low bits
                lsrb
                lsrb
                lsrb
                andb #7                         ; lose the graphics block bias
LA909           incb                            ; shift colours into 1 to 8 range
LA90A           jsr LA5E8                       ; convert B to floating point
LA90D           jmp LB267                       ; make sure we have a ) and return
; CLS command
CLS             jsr RVEC22                      ; do the RAM hook dance
LA913           beq LA928                       ; brif no colour - just do a basic screen clear
                jsr LB70B                       ; evaluate colour number
                cmpb #8                         ; valid colour?
                bhi LA937                       ; brif not - do the easter egg
                tstb                            ; color 0?
                beq LA925                       ; brif so
                decb                            ; normalize to 0 based colour numbers
                lda #0x10                       ; 16 blocks per colour
                mul                             ; now we have the base code for that colour
                orb #0x0f                       ; set all pixels
LA925           orb #0x80                       ; make it a graphics block
                skip2
LA928           ldb #0x60                       ; VDG screen space character
                ldx #VIDRAM                     ; point to start of screen
LA92D           stx CURPOS                      ; set cursor position
LA92F           stb ,x+                         ; blank a character
                cmpx #VIDRAM+511                ; end of screen?
                bls LA92F                       ; brif not
                rts
LA937           bsr LA928                       ; clear te screen
                ldx #LA166-1                    ; point to the easter egg
                jmp LB99C                       ; go display it
; Evaluate an expression to B, prefixed by a comma, and do FC error if 0
LA93F           jsr LB26D                       ; force a comma
LA942           jsr LB70B                       ; evaluate expression to B
                tstb                            ; is it 0?
                bne LA984                       ; brif not - return
LA948           jmp LB44A                       ; raise FC error
; SOUND command
SOUND           bsr LA942                       ; evaluate frequency
                stb SNDTON                      ; save it
                bsr LA93F                       ; evaluate duration (after a comma)
LA951           lda #4                          ; constant factor for duration (each increment is 1/15 of a second)
                mul
                std SNDDUR                      ; save length of sound (IRQ will count it down)
                lda PIA0+3                      ; enable 60 Hz interrupt
                ora #1
                sta PIA0+3
                clr ARYDIS                      ; clear array disable flag for some reason
                bsr LA9A2                       ; connect DAC to MUX output
                bsr LA976                       ; turn on sound
LA964           bsr LA985                       ; store mid range output value and delay
                lda #0xfe                       ; store high value and delay
                bsr LA987
                bsr LA985                       ; store mid range value and delay
                lda #2                          ; store low value and delay
                bsr LA987
                ldx SNDDUR                      ; has timer expired?
                bne LA964                       ; brif not, do another wave
; Disable sound output
LA974           clra                            ; bit 3 to 0 will disable output
                skip2
; Enable sound output
LA976           lda #8                          ; bit 3 set to enable output
                sta ,-s                         ; save desired value
                lda PIA1+3                      ; get control register value
                anda #0xf7                      ; reset value
                ora ,s+                         ; set to desired value
                sta PIA1+3                      ; set new sound output status
LA984           rts
LA985           lda #0x7e                       ; mid range value for DAC
LA987           sta PIA1                        ; set DAC output value
                lda SNDTON                      ; get frequency
LA98C           inca                            ; increment it (gives shorter count with higher values, so higher frequencies work)
                bne LA98C                       ; brif not done yet
                rts
; AUDIO command
AUDIO           tfr a,b                         ; save ON/OFF token
                jsr GETNCH                      ; munch the ON/OFF token
                cmpb #0xaa                      ; OFF?
                beq LA974                       ; brif so
                subb #0x88                      ; ON?
                jsr LA5C9                       ; do SN error if not
                incb                            ; now B is 1 - cassette sound source
                bsr LA9A2                       ; set MUX input to tape
                bra LA976                       ; enable sound
; Set MUX source to value in B
LA9A2           ldu #PIA0+1                     ; point to PIA0 control register A
                bsr LA9A7                       ; program bit 0 then fall through for bit 1
LA9A7           lda ,u                          ; get control register value
                anda #0xf7                      ; reset mux control bit
                asrb                            ; shift desired value to C
                bcc LA9B0                       ; brif this bit is clear
                ora #8                          ; set the bit
LA9B0           sta ,u++                        ; set register value and move to next register
                rts
; IRQ service routine
BIRQSV          lda PIA0+3                      ; check for VSYNC interrupt
                bpl LA9C5                       ; brif not - return. BUG: should clear HSYNC interrupt status first
                lda PIA0+2                      ; clear VSYNC interrupt status
                ldx >SNDDUR                     ; are we counting down for SOUND? (force extended in case DP is modified)
                beq LA9C5                       ; brif not
                leax -1,x                       ; count down one tick
                stx >SNDDUR                     ; save new count (forced extended in case DP is modified)
LA9C5           rti
; JOYSTK function
JOYSTK          jsr LB70E                       ; evaluate which joystick axis is desired
                cmpb #3                         ; valid axis?
                lbhi LB44A                      ; brif not
                tstb                            ; want axis 0?
                bne LA9D4                       ; brif not
                bsr GETJOY                      ; read axis data if axis 0
LA9D4           ldx #POTVAL                     ; point to axis values
                ldb FPA0+3                      ; get desired axis
                ldb b,x                         ; get axis value
                jmp LB4F3                       ; return value
; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches
; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed,
; this routine will do the read *ten times* before just returning the last value. This is assininely
; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note
; also that this routine should be using PSHS and PULS but it doesn't.
GETJOY          bsr LA974                       ; turn off sound
                ldx #POTVAL+4                   ; point to the end of the axis data (we'll work backwards)
                ldb #3                          ; start with axis 3
LA9E5           lda #10                         ; 10 tries to see if we match *the last call* to this routine
                std ,--s                        ; save retry counter and axis number
                bsr LA9A2                       ; set MUX for the correct axis
LA9EB           ldd #0x4080                     ; set initial trial value to mid range and the next difference to add/subtract to half
LA9EE           sta ,-s                         ; store the add/subtract value
                orb #2                          ; keep rs232 output marking
                stb PIA1                        ; set DAC output to the trial value
                eorb #2                         ; remove RS232 output value
                lda PIA0                        ; read the comparator
                bmi LA9FF                       ; brif comparator output is high (DAC is lower than the axis value)
                subb ,s                         ; subtract next bit value (split the difference toward 0)
                skip2
LA9FF           addb ,s                         ; add next bit value (split the different toward infinity)
                lda ,s+                         ; get bit value back
                lsra                            ; cut in half
                cmpa #1                         ; have we done that last value for the DAC?
                bne LA9EE                       ; brif not
                lsrb                            ; normalize the axis value
                lsrb
                cmpb -1,x                       ; does it match the read from the last call to this routine?
                beq LAA12                       ; brif so
                dec ,s                          ; are we out of retries?
                bne LA9EB                       ; brif not - try again
LAA12           stb ,-x                         ; save new value and move pointer back
                ldd ,s++                        ; get axis counter and clean up retry counter
                decb                            ; move to next axis
                bpl LA9E5                       ; brif still more axes to do
                rts
; This is the "bottom half" of the character fetching routines.
BROMHK          cmpa #'9+1                      ; is it >= colon?
                bhs LAA28                       ; brif so Z set if colon, C clear.
                cmpa #0x20                      ; space?
                bne LAA24                       ; brif not
                jmp GETNCH                      ; move on to another character if space
LAA24           suba #'0                        ; normalize ascii digit to 0-9; we already handled above digit 9
                suba #-'0                       ; this will cause a carry for any value that was already positive
LAA28           rts
; Jump table for functions
LAA29           fdb SGN                         ; SGN 0x80
                fdb INT                         ; INT 0x81
                fdb ABS                         ; ABS 0x82
                fdb USRJMP                      ; USR 0x83
                fdb RND                         ; RND 0x84
                fdb SIN                         ; SIN 0x85
                fdb PEEK                        ; PEEK 0x86
                fdb LEN                         ; LEN 0x87
                fdb STR                         ; STR$ 0x88
                fdb VAL                         ; VAL 0x89
                fdb ASC                         ; ASC 0x8a
                fdb CHR                         ; CHR$ 0x8b
                fdb EOF                         ; EOF 0x8c
                fdb JOYSTK                      ; JOYSTK 0x8d
                fdb LEFT                        ; LEFT$ 0x8e
                fdb RIGHT                       ; RIGHT$ 0x8f
                fdb MID                         ; MID$ 0x90
                fdb POINT                       ; POINT 0x91
                fdb INKEY                       ; INKEY$ 0x92
                fdb MEM                         ; MEM 0x93
; Operator precedence and jump table (binary ops except relational)
LAA51           fcb 0x79                        ; +
                fdb LB9C5
                fcb 0x79                        ; -
                fdb LB9BC
                fcb 0x7b                        ; *
                fdb LBACC
                fcb 0x7b                        ; /
                fdb LBB91
                fcb 0x7f                        ; ^ (exponentiation)
                fdb EXPJMP
                fcb 0x50                        ; AND
                fdb LB2D5
                fcb 0x46                        ; OR
                fdb LB2D4
; Reserved words table for commands
LAA66           fcs 'FOR'                       ; 0x80
                fcs 'GO'                        ; 0x81
                fcs 'REM'                       ; 0x82
                fcs "'"                         ; 0x83
                fcs 'ELSE'                      ; 0x84
                fcs 'IF'                        ; 0x85
                fcs 'DATA'                      ; 0x86
                fcs 'PRINT'                     ; 0x87
                fcs 'ON'                        ; 0x88
                fcs 'INPUT'                     ; 0x89
                fcs 'END'                       ; 0x8a
                fcs 'NEXT'                      ; 0x8b
                fcs 'DIM'                       ; 0x8c
                fcs 'READ'                      ; 0x8d
                fcs 'RUN'                       ; 0x8e
                fcs 'RESTORE'                   ; 0x8f
                fcs 'RETURN'                    ; 0x90
                fcs 'STOP'                      ; 0x91
                fcs 'POKE'                      ; 0x92
                fcs 'CONT'                      ; 0x93
                fcs 'LIST'                      ; 0x94
                fcs 'CLEAR'                     ; 0x95
                fcs 'NEW'                       ; 0x96
                fcs 'CLOAD'                     ; 0x97
                fcs 'CSAVE'                     ; 0x98
                fcs 'OPEN'                      ; 0x99
                fcs 'CLOSE'                     ; 0x9a
                fcs 'LLIST'                     ; 0x9b
                fcs 'SET'                       ; 0x9c
                fcs 'RESET'                     ; 0x9d
                fcs 'CLS'                       ; 0x9e
                fcs 'MOTOR'                     ; 0x9f
                fcs 'SOUND'                     ; 0xa0
                fcs 'AUDIO'                     ; 0xa1
                fcs 'EXEC'                      ; 0xa2
                fcs 'SKIPF'                     ; 0xa3
                fcs 'TAB('                      ; 0xa4
                fcs 'TO'                        ; 0xa5
                fcs 'SUB'                       ; 0xa6
                fcs 'THEN'                      ; 0xa7
                fcs 'NOT'                       ; 0xa8
                fcs 'STEP'                      ; 0xa9
                fcs 'OFF'                       ; 0xaa
                fcs '+'                         ; 0xab
                fcs '-'                         ; 0xac
                fcs '*'                         ; 0xad
                fcs '/'                         ; 0xae
                fcs '^'                         ; 0xaf
                fcs 'AND'                       ; 0xb0
                fcs 'OR'                        ; 0xb1
                fcs '>'                         ; 0xb2
                fcs '='                         ; 0xb3
                fcs '<'                         ; 0xb4
; Reserved word list for functions
LAB1A           fcs 'SGN'                       ; 0x80
                fcs 'INT'                       ; 0x81
                fcs 'ABS'                       ; 0x82
                fcs 'USR'                       ; 0x83
                fcs 'RND'                       ; 0x84
                fcs 'SIN'                       ; 0x85
                fcs 'PEEK'                      ; 0x86
                fcs 'LEN'                       ; 0x87
                fcs 'STR$'                      ; 0x88
                fcs 'VAL'                       ; 0x89
                fcs 'ASC'                       ; 0x8a
                fcs 'CHR$'                      ; 0x8b
                fcs 'EOF'                       ; 0x8c
                fcs 'JOYSTK'                    ; 0x8d
                fcs 'LEFT$'                     ; 0x8e
                fcs 'RIGHT$'                    ; 0x8f
                fcs 'MID$'                      ; 0x90
                fcs 'POINT'                     ; 0x91
                fcs 'INKEY$'                    ; 0x92
                fcs 'MEM'                       ; 0x93
; Jump table for commands
LAB67           fdb FOR                         ; 0x80 FOR
                fdb GO                          ; 0x81 GO
                fdb REM                         ; 0x82 REM
                fdb REM                         ; 0x83 '
                fdb REM                         ; 0x84 ELSE
                fdb IFTOK                       ; 0x85 IF
                fdb DATA                        ; 0x86 DATA
                fdb PRINT                       ; 0x87 PRINT
                fdb ON                          ; 0x88 ON
                fdb INPUT                       ; 0x89 INPUT
                fdb ENDTOK                      ; 0x8a END
                fdb NEXT                        ; 0x8b NEXT
                fdb DIM                         ; 0x8c DIM
                fdb READ                        ; 0x8d READ
                fdb RUN                         ; 0x8e RUN
                fdb RESTOR                      ; 0x8f RESTORE
                fdb RETURN                      ; 0x90 RETURN
                fdb STOP                        ; 0x91 STOP
                fdb POKE                        ; 0x92 POKE
                fdb CONT                        ; 0x93 CONT
                fdb LIST                        ; 0x94 LIST
                fdb CLEAR                       ; 0x95 CLEAR
                fdb NEW                         ; 0x96 NEW
                fdb CLOAD                       ; 0x97 CLOAD
                fdb CSAVE                       ; 0x98 CSAVE
                fdb OPEN                        ; 0x99 OPEN
                fdb CLOSE                       ; 0x9a CLOSE
                fdb LLIST                       ; 0x9b LLIST
                fdb SET                         ; 0x9c SET
                fdb RESET                       ; 0x9d RESET
                fdb CLS                         ; 0x9e CLS
                fdb MOTOR                       ; 0x9f MOTOR
                fdb SOUND                       ; 0xa0 SOUND
                fdb AUDIO                       ; 0xa1 AUDIO
                fdb EXEC                        ; 0xa2 EXEC
                fdb SKIPF                       ; 0xa3 SKIPF
; Error message table
LABAF           fcc 'NF'                        ; 0 NEXT without FOR
                fcc 'SN'                        ; 1 Syntax error
                fcc 'RG'                        ; 2 RETURN without GOSUB
                fcc 'OD'                        ; 3 Out of data
                fcc 'FC'                        ; 4 Illegal function call
                fcc 'OV'                        ; 5 Overflow
                fcc 'OM'                        ; 6 Out of memory
                fcc 'UL'                        ; 7 Undefined line number
                fcc 'BS'                        ; 8 Bad subscript
                fcc 'DD'                        ; 9 Redimensioned array
                fcc '/0'                        ; 10 Division by 0
                fcc 'ID'                        ; 11 Illegal direct statement
                fcc 'TM'                        ; 12 Type mismatch
                fcc 'OS'                        ; 13 Out of string space
                fcc 'LS'                        ; 14 String too long
                fcc 'ST'                        ; 15 String formula too complex
                fcc 'CN'                        ; 16 Can't continue
                fcc 'FD'                        ; 17 Bad file data
                fcc 'AO'                        ; 18 File already open
                fcc 'DN'                        ; 19 Device number error
                fcc 'IO'                        ; 20 Input/output error
                fcc 'FM'                        ; 21 Bad file mode
                fcc 'NO'                        ; 22 File not open
                fcc 'IE'                        ; 23 Input past end of file
                fcc 'DS'                        ; 24 Direct statement in file
LABE1           fcn ' ERROR'
LABE8           fcn ' IN '
LABED           fcb 0x0d
LABEE           fcc 'OK'
                fcb 0x0d,0x00
LABF2           fcb 0x0d
                fcn 'BREAK'
; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT
; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL
; for the first match.
;
; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the
; 6809's registers. This requires some minor tweaks where the routine is called. Further, the
; use of B is completely pointless and, even if B is going to be used, why is it reloaded on
; every loop?
LABF9           leax 4,s                        ; skip past our caller and the main command loop return address
LABFB           ldb #18                         ; each FOR/NEXT frame is 18 bytes
                stx TEMPTR                      ; save current search pointer
                lda ,x                          ; get first byte of this frame
                suba #0x80                      ; set to 0 if FOR/NEXT
                bne LAC1A                       ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame)
                ldx 1,x                         ; get index variable descriptor
                stx TMPTR1                      ; save it
                ldx VARDES                      ; get desired index descriptor
                beq LAC16                       ; brif NULL - we found something
                cmpx TMPTR1                     ; does this one match?
                beq LAC1A                       ; brif so
                ldx TEMPTR                      ; get back frame pointer
                abx                             ; move to next entry
                bra LABFB                       ; check next block of data
LAC16           ldx TMPTR1                      ; get index variable of this frame
                stx VARDES                      ; set it as the one found
LAC1A           ldx TEMPTR                      ; get matching frame pointer
                tsta                            ; set Z if FOR/NEXT
                rts
; This is a block copy routine which copies from top to bottom. It's not clear that the use of
; this routine actually saves any ROM space compared to just implementing the copies directly
; once all the marshalling to set up the parameter variables is taken into account.
LAC1E           bsr LAC37                       ; check to see if stack collides with D
LAC20           ldu V41                         ; point to destination
                leau 1,u                        ; offset for pre-dec
                ldx V43                         ; point to source
                leax 1,x                        ; offset for pre-dec
LAC28           lda ,-x                         ; get source byte
                pshu a                          ; store at destination (sta ,-u would be less weird)
                cmpx V47                        ; at the bottom of the copy?
                bne LAC28                       ; brif not
                stu V45                         ; save final destination address
LAC32           rts
; Check for 2*B (0 <= B <= 127) bytes for free memory
LAC33           clra                            ; zero extend
                aslb                            ; times 2 (loses bit 7 of B)
                addd ARYEND                     ; add to top of used memory
LAC37           addd #STKBUF                    ; add a fudge factor for interpreter operation
                bcs LAC44                       ; brif >65535!
                sts BOTSTK                      ; get current stack pointer
                cmpd BOTSTK                     ; is our new address above that?
                blo LAC32                       ; brif not - no error
LAC44           ldb #6*2                        ; raise OM error
; The error servicing routine
LAC46           jsr RVEC16                      ; do the RAM hook dance (ON ERROR reserved hook)
LAC49           jsr RVEC17                      ; do the RAM hook dance again
                jsr LA7E9                       ; turn off tape
                jsr LA974                       ; disable sound
                jsr LAD33                       ; reset stack, etc.
                clr DEVNUM                      ; reset output to screen
                jsr LB95C                       ; do a newline
                jsr LB9AF                       ; send a ?
                ldx #LABAF                      ; point to error table
                abx                             ; offset to correct message
                bsr LACA0                       ; send a char from X
                bsr LACA0                       ; send another char from X
                ldx #LABE1-1                    ; point to "ERROR" message
LAC68           jsr LB99C                       ; print ERROR message (or BREAK)
                lda CURLIN                      ; are we in immediate mode?
                inca
                beq LAC73                       ; brif not - go to immediate mode
                jsr LBDC5                       ; print "IN ****"
; This is the immediate mode loop
LAC73           jsr LB95C                       ; do a newline if needed
LAC76           ldx #LABEE-1                    ; point to prompt (without leading CR)
                jsr LB99C                       ; show prompt
LAC7C           jsr LA390                       ; read an input line
                ldu #0xffff                     ; flag immediate mode
                stu CURLIN
                bcs LAC7C                       ; brif we ended on BREAK - just go for another line
                tst CINBFL                      ; EOF?
                lbne LA4BF                      ; brif so
                stx CHARAD                      ; save start of input line as input pointer
                jsr GETNCH                      ; get character from input line
                beq LAC7C                       ; brif no input
                bcs LACA5                       ; brif numeric - adding or removing a line number
                ldb #2*24                       ; code for "direct statement in file"
                tst DEVNUM                      ; keyboard input?
                bne LAC46                       ; brif not - complain about direct statement
                jsr LB821                       ; go tokenize the input line
                jmp LADC0                       ; go execute the newly tokenized line
LACA0           lda ,x+                         ; get character and advance pointer
                jmp LB9B1                       ; output it
LACA5           jsr LAF67                       ; convert line number to binary
                ldx BINVAL                      ; get converted number
                stx LINHDR                      ; put it before the line we just read
                jsr LB821                       ; tokenize the input line
                stb TMPLOC                      ; save line length
                bsr LAD01                       ; find where the line should be in the program
                bcs LACC8                       ; brif the line number isn't already present
                ldd V47                         ; get address where the line is in the program
                subd ,x                         ; get the difference between here and the end of the line (negative)
                addd VARTAB                     ; subtract line length from the end of the program
                std VARTAB                      ; save new end of program address
                ldu ,x                          ; get start of next line
LACC0           pulu a                          ; get source byte (lda ,u+ would be less weird)
                sta ,x+                         ; move it down
                cmpx VARTAB                     ; have we moved everything yet?
                bne LACC0                       ; brif not
LACC8           lda LINBUF                      ; see if there is actually a line to input
                beq LACE9                       ; brif not - we just needed to remove the line
                ldd VARTAB                      ; get current end of program
                std V43                         ; set as source pointer
                addb TMPLOC                     ; add in the length of the new line
                adca #0
                std V41                         ; save destination pointer
                jsr LAC1E                       ; make sure there's enough room and then make a hole for the new line
                ldu #LINHDR-2                   ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer)
LACDD           pulu a                          ; get byte from new line (lda ,u+ would be less weird)
                sta ,x+                         ; stow it
                cmpx V45                        ; at the end of the hole we just made?
                bne LACDD                       ; brif not
                ldx V41                         ; get save new top of program address
                stx VARTAB
LACE9           bsr LAD21                       ; reset variables, etc.
                bsr LACEF                       ; adjust next line pointers
                bra LAC7C                       ; go read another input line
; Recompute next line pointers
LACEF           ldx  TXTTAB                     ; point to start of program
LACF1           ldd ,x                          ; get address of next line
                beq LAD16                       ; brif end of program
                leau 4,x                        ; move past pointer and line number
LACF7           lda ,u+                         ; are we at the end of the line?
                bne LACF7                       ; brif not
                stu ,x                          ; save new next line pointer
                ldx ,x                          ; point to next line
                bra LACF1                       ; process the next line
; Find a line in the program
LAD01           ldd BINVAL                      ; get desired line number
                ldx TXTTAB                      ; point to start of program
LAD05           ldu ,x                          ; get address of next line
                beq LAD12                       ; brif end of program
                cmpd 2,x                        ; do we have a match?
                bls LAD14                       ; brif our search number is <= the number here
                ldx ,x                          ; move to next line
                bra LAD05                       ; check another line
LAD12           orcc #1                         ; set C for not found
LAD14           stx V47                         ; save address of matching line *or* line just after where it would have been
LAD16           rts
; NEW command
; This routine has multiple entry points used for various "levels" of NEW
NEW             bne LAD14                       ; brif there was input given; should be LAD16!
LAD19           ldx TXTTAB                      ; point to start of program
                clr ,x+                         ; blank out program (with NULL next line pointer)
                clr ,x+
                stx VARTAB                      ; save end of program
LAD21           ldx TXTTAB                      ; get start of program
                jsr LAEBB                       ; put input pointer there
LAD26           ldx MEMSIZ                      ; reset string space
                stx STRTAB
                jsr RESTOR                      ; reset DATA pointer
                ldx VARTAB                      ; clear out scalars and arrays
                stx ARYTAB
                stx ARYEND
LAD33           ldx #STRSTK                     ; reset the string stack
                stx TEMPPT
                ldx ,s                          ; get return address (we're going to reset the stack)
                lds FRETOP                      ; reset the stack to top of memory
                clr ,-s                         ; put stopper so FOR/NEXT search will actually stop here
                clr OLDPTR                      ; reset "CONT" state
                clr OLDPTR+1
                clr ARYDIS                      ; un-disable arrays
                jmp ,x                          ; return to original caller
; FOR command
FOR             lda #0x80                       ; disable array parsing
                sta ARYDIS
                jsr LET                         ; assign start value to index
                jsr LABF9                       ; search stack for matching FOR/NEXT frame
                leas 2,s                        ; lose return address
                bne LAD59                       ; brif variable not already being used
                ldx TEMPTR                      ; get address of matched data
                leas b,x                        ; move stack pointer to the end of it (B is set to 18 in the stack search)
LAD59           ldb #9                          ; is there room for 18 bytes in memory?
                jsr LAC33
                jsr LAEE8                       ; get address of the end of this statement in X
                ldd CURLIN                      ; get line number
                pshs x,b,a                      ; save next line address and current line number
                ldb #0xa5                       ; make sure we have TO
                jsr LB26F
                jsr LB143                       ; make sure we have a numeric index
                jsr LB141                       ; evaluate terminal condition value
                ldb FP0SGN                      ; pack FPA0 in place
                orb #0x7f
                andb FPA0
                stb FPA0
                ldy #LAD7F                      ; where to come back to
                jmp LB1EA                       ; stash terminal condition on the stack
LAD7F           ldx #LBAC5                      ; point to FP 1.0 (default step)
                jsr LBC14                       ; unpack it to FPA0
                jsr GETCCH                      ; get character after the terminal
                cmpa #0xa9                      ; is it STEP?
                bne LAD90                       ; brif not
                jsr GETNCH                      ; eat STEP
                jsr LB141                       ; evaluate step condition
LAD90           jsr LBC6D                       ; get "status" of FPA0
                jsr LB1E6                       ; stash FPA0 on the stack (for step value)
                ldd VARDES                      ; get variable descriptor pointer
                pshs d                          ; put that on the stack too
                lda #0x80                       ; flag the frame as a FOR/NEXT frame
                pshs a
; Main command interpretation loop
LAD9E           jsr RVEC20                      ; do the RAM hook dance
                andcc #0xaf                     ; make sure interrupts are running
                bsr LADEB                       ; check for BREAK/pause
                ldx CHARAD                      ; get input pointer
                stx TINPTR                      ; save input pointer for start of line
                lda ,x+                         ; get current input character
                beq LADB4                       ; brif end of line - move to another line
                cmpa #':                        ; end of statement?
                beq LADC0                       ; brif so - keep processing
LADB1           jmp LB277                       ; raise a syntax error
LADB4           lda ,x++                        ; get MSB of next line pointer and skip past pointer
                sta ENDFLG
                beq LAE15                       ; brif MSB of next line address is 0 (do END)
                ldd ,x+                         ; get line number but only advance one
                std CURLIN                      ; set current line number
                stx CHARAD                      ; set input pointer to one before line text
LADC0           jsr GETNCH                      ; move past statement separator or to first character in line
                bsr LADC6                       ; process a command
                bra LAD9E                       ; handle next statement or line
LADC6           beq LAE40                       ; return if end of statement
                tsta                            ; is it a token?
                lbpl LET                        ; brif not - do a LET
                cmpa #0xa3                      ; above SKIPF?
                bhi LADDC                       ; brif so
                ldx COMVEC+3                    ; point to jump table
                lsla                            ; two bytes per entry (loses the token bias)
                tfr a,b                         ; put it in B for unsigned ABX
                abx
                jsr GETNCH                      ; move past token
                jmp [,x]                        ; transfer control to the handler (which will return to the main loop)
LADDC           cmpa #0xb4                      ; is it a non-executable token?
                bls LADB1                       ; brif so
                jmp [COMVEC+13]                 ; transfer control to ECB command handler
; RESTORE command
RESTOR          ldx TXTTAB                      ; point to beginning of the program
                leax -1,x                       ; move back one (to compensate for "GETNCH")
LADE8           stx DATPTR                      ; save as new data pointer
                rts
; BREAK check
LADEB           jsr LA1C1                       ; read keyboard
                beq LADFA                       ; brif no key down
LADF0           cmpa #3                         ; BREAK?
                beq STOP                        ; brif so - do a STOP
                cmpa #0x13                      ; pause (SHIFT-@)?
                beq LADFB                       ; brif so
                sta IKEYIM                      ; cache key for later INKEY$ so break check doesn't break INKEY$
LADFA           rts
LADFB           jsr KEYIN                       ; read keyboard
                beq LADFB                       ; brif no key down
                bra LADF0                       ; process pressed key in case BREAK or SHIFT-@ again
; END command
ENDTOK          jsr LA426                       ; close files
                jsr GETCCH                      ; re-get input character
                bra LAE0B
; STOP command
STOP            orcc #1                         ; flag "STOP"
LAE0B           bne LAE40                       ; brif not end of statement
                ldx CHARAD                      ; save current input pointer
                stx TINPTR
LAE11           ror ENDFLG                      ; save END/STOP flag (C)
                leas 2,s                        ; lose return address
LAE15           ldx CURLIN                      ; get current input line (end of program comes here)
                cmpx #0xffff                    ; immediate mode?
                beq LAE22                       ; brif so
                stx OLDTXT                      ; save line where we stopped executing
                ldx TINPTR                      ; get input pointer
                stx OLDPTR                      ; save location where we stopped executing
LAE22           clr DEVNUM                      ; reset to screen/keyboard
                ldx #LABF2-1                    ; point to BREAK message
                tst ENDFLG                      ; are we doing "BREAK"?
                lbpl LAC73                      ; brif not
                jmp LAC68                       ; go do the BREAK message and return to main loop
; CONT command
CONT            bne LAE40                       ; brif not end of statement
                ldb #2*16                       ; code for can't continue
                ldx OLDPTR                      ; get saved execution pointer
                lbeq LAC46                      ; brif no saved pointer - raise CN error
                stx CHARAD                      ; reset input pointer
                ldx OLDTXT                      ; reset current line number
                stx CURLIN
LAE40           rts
; CLEAR command
CLEAR           beq LAE6F                       ; brif no argument
                jsr LB3E6                       ; evaluate string space size
                pshs d                          ; save it
                ldx MEMSIZ                      ; get memory size (top of memory)
                jsr GETCCH                      ; is there anything after the string space size?
                beq LAE5A                       ; brif not
                jsr LB26D                       ; force a comma
                jsr LB73D                       ; get top of memory value in X
                leax -1,x                       ; move back one (top of cleared space)
                cmpx TOPRAM                     ; is it within the memory available?
                bhi LAE72                       ; brif higher than top of memory - OM error
LAE5A           tfr x,d                         ; so we can do math for checking memory usage
                subd ,s++                       ; subtract out string space value
                bcs LAE72                       ; brif less than 0
                tfr d,u                         ; U is bottom of cleared space
                subd #STKBUF                    ; also account for slop space
                bcs LAE72                       ; brif less than 0
                subd VARTAB                     ; is there still room for the program?
                blo LAE72                       ; brif not
                stu FRETOP                      ; set top of free memory
                stx MEMSIZ                      ; set size of usable memory
LAE6F           jmp LAD26                       ; erase variables, etc.
LAE72           jmp LAC44                       ; raise OM error
; RUN command
RUN             jsr RVEC18                      ; do the RAM hook dance
                jsr LA426                       ; close any open files
                jsr GETCCH                      ; is there a line number
                lbeq LAD21                      ; brif no line number - start from beginning
                jsr LAD26                       ; clear variables, etc.
                bra LAE9F                       ; "GOTO" the line number
; GO command (GOTO and GOSUB)
GO              tfr a,b                         ; save TO/SUB
LAE88           jsr GETNCH                      ; eat the TO/SUB token
                cmpb #0xa5                      ; TO?
                beq LAEA4                       ; brif GOTO
                cmpb #0xa6                      ; SUB?
                bne LAED7                       ; brif not
                ldb #3                          ; room for 6 bytes?
                jsr LAC33
                ldu CHARAD                      ; get input pointer
                ldx CURLIN                      ; get line number
                lda #0xa6                       ; flag for GOSUB frame
                pshs u,x,a                      ; set stack frame
LAE9F           bsr LAEA4                       ; do "GOTO"
                jmp LAD9E                       ; go back to main loop
; Actual GOTO is here
LAEA4           jsr GETCCH                      ; get current input
                jsr LAF67                       ; convert number to binary
                bsr LAEEB                       ; move input pointer to end of statement
                leax 1,x                        ; point to start of next line
                ldd BINVAL                      ; get desired line number
                cmpd CURLIN                     ; is it beyond here?
                bhi LAEB6                       ; brif so
                ldx TXTTAB                      ; start search at beginning of program
LAEB6           jsr LAD05                       ; find line number
                bcs LAED2                       ; brif not found
LAEBB           leax -1,x                       ; move to just before start of line
                stx CHARAD                      ; reset input pointer
LAEBF           rts
; RETURN command
RETURN          bne LAEBF                       ; exit if argument given
                lda #0xff                       ; set VARDES to an illegal value so we ignore FOR frames
                sta VARDES
                jsr LABF9                       ; look for a GOSUB frame
                tfr x,s                         ; reset stack
                cmpa #0xa6-0x80                 ; is it a GOSUB frame?
                beq LAEDA                       ; brif so
                ldb #2*2                        ; code for RETURN without GOSUB
                skip2
LAED2           ldb #7*2                        ; code for undefined line number
                jmp LAC46                       ; raise error
LAED7           jmp LB277                       ; raise syntax error
LAEDA           puls a,x,u                      ; get back saved line number and input pointer
                stx CURLIN                      ; reset line number
                stu CHARAD                      ; reset input pointer
; DATA command
DATA            bsr LAEE8                       ; move input pointer to end of statement
                skip2
; REM command (also ELSE)
REM             bsr LAEEB                       ; move input pointer to end of line
                stx CHARAD                      ; save new input pointer
LAEE7           rts
; Return end of statement (LAEE8) or line (AEEB) in X
LAEE8           ldb #':                         ; colon is statement terminator
                skip1lda
LAEEB           clrb                            ; make main terminator NUL
                stb CHARAC                      ; save terminator
                clrb                            ; end of line - always terminates
                ldx CHARAD                      ; get input pointer
LAEF1           tfr b,a                         ; save secondary terminator
                ldb CHARAC                      ; get main terminator
                sta CHARAC                      ; save secondary
LAEF7           lda ,x                          ; get input character
                beq LAEE7                       ; brif end of line
                pshs b                          ; save terminator
                cmpa ,s+                        ; does it match?
                beq LAEE7                       ; brif so - bail
                leax 1,x                        ; move pointer ahead
                cmpa #'"                        ; start of string?
                beq LAEF1                       ; brif so
                inca                            ; functon token?
                bne LAF0C                       ; brif not
                leax 1,x                        ; skip second part of function token
LAF0C           cmpa #0x85+1                    ; IF?
                bne LAEF7                       ; brif not
                inc IFCTR                       ; bump "IF" count
                bra LAEF7                       ; get check another input character
; IF command
IFTOK           jsr LB141                       ; evaluate condition
                jsr GETCCH                      ; find out what's after the conditin
                cmpa #0x81                      ; GO?
                beq LAF22                       ; treat same as THEN
                ldb #0xa7                       ; make sure we have a THEN
                jsr LB26F
LAF22           lda FP0EXP                      ; get true/false (false is 0)
                bne LAF39                       ; brif condition true
                clr IFCTR                       ; reset IF counter
LAF28           bsr DATA                        ; skip over statement
                tsta                            ; end of line?
                beq LAEE7                       ; brif so
                jsr GETNCH                      ; get start of this statement
                cmpa #0x84                      ; ELSE?
                bne LAF28                       ; brif not
                dec IFCTR                       ; is it a matching ELSE?
                bpl LAF28                       ; brif not - keep looking
                jsr GETNCH                      ; eat the ELSE
LAF39           jsr GETCCH                      ; get current input
                lbcs LAEA4                      ; brif numeric - to a GOTO
                jmp LADC6                       ; let main loop interpret the next command
; ON command
ON              jsr LB70B                       ; evaluate index expression
LAF45           ldb #0x81                       ; make sure we have "GO"
                jsr LB26F
                pshs a                          ; save TO/SUB
                cmpa #0xa6                      ; SUB?
                beq LAF54                       ; brif so
                cmpa #0xa5                      ; TO?
LAF52           bne LAED7                       ; brif not
LAF54           dec FPA0+3                      ; are we at the right index?
                bne LAF5D                       ; brif not
                puls b                          ; get TO/SUB token
                jmp LAE88                       ; go do GOTO or GOSUB
LAF5D           jsr GETNCH                      ; munch a character
                bsr LAF67                       ; parse line number
                cmpa #',                        ; is there another line following?
                beq LAF54                       ; brif so - see if we're there yet
                puls b,pc                       ; clean up TO/SUB token and return - we fell through
; Parse a line number
LAF67           ldx ZERO                        ; initialize line number accumulator to 0
                stx BINVAL
LAF6B           bcc LAFCE                       ; brif not numeric
                suba #'0                        ; adjust to actual value of digit
                sta CHARAC                      ; save digit
                ldd BINVAL                      ; get accumulated number
                cmpa #24                        ; will this overflow?
                bhi LAF52                       ; brif so - raise syntax error
                aslb                            ; times 2
                rola
                aslb                            ; times 4
                rola
                addd BINVAL                     ; times 5
                aslb                            ; times 10
                rola
                addb CHARAC                     ; add in digit
                adca #0
                std BINVAL                      ; save new accumulated number
                jsr GETNCH                      ; fetch next character
                bra LAF6B                       ; process next digit
; LET command (the LET keyword requires Extended Basic)
LET             jsr LB357                       ; evaluate destination variable
                stx VARDES                      ; save descriptor pointer
                ldb #0xb3                       ; make sure we have =
                jsr LB26F
                lda VALTYP                      ; get destination variable type
                pshs a                          ; save it for later
                jsr LB156                       ; evaluate the expression to assign
                puls a                          ; get back original variable type
                rora                            ; put type in C
                jsr LB148                       ; make sure the current result matches the type
                lbeq LBC33                      ; bri fnumeric - copy FPA0 to variable
LAFA4           ldx FPA0+2                      ; point to descriptor of replacement string
                ldd FRETOP                      ; get bottom of string space
                cmpd 2,x                        ; is the string already in string space?
                bhs LAFBE                       ; brif so
                cmpx VARTAB                     ; is the descriptor in variable space?
                blo LAFBE                       ; brif not
LAFB1           ldb ,x                          ; get length of string
                jsr LB50D                       ; allocate space for this string
                ldx V4D                         ; get descriptor pointer back
                jsr LB643                       ; copy string into string space
                ldx #STRDES                     ; point to temporary string descriptor
LAFBE           stx V4D                         ; save descriptor pointer
                jsr LB675                       ; remove string from string stack if appropriate
                ldu V4D                         ; get back replacement descriptor
                ldx VARDES                      ; get target descriptor
                pulu a,b,y                      ; get string length (A) and data pointer (Y)
                sta ,x                          ; save new length
                sty 2,x                         ; save new pointer
LAFCE           rts
; READ and INPUT commands.
LAFCF           fcc '?REDO'                     ; The ?REDO message
                fcb 0x0d,0x00
LAFD6           ldb #2*17                       ; bad file data code
                tst DEVNUM                      ; are we reading from the keyboard?
                beq LAFDF                       ; brif so
LAFDC           jmp LAC46                       ; raise the error
LAFDF           lda INPFLG                      ; are we doing INPUT?
                beq LAFEA                       ; brif so
                ldx DATTXT                      ; get line number where the DATA statement happened
                stx CURLIN                      ; set current line number to that so can report the correct location
                jmp LB277                       ; raise a syntax error on bad data
LAFEA           ldx #LAFCF-1                    ; show the ?REDO if we're doing INPUT
                jsr LB99C
                ldx TINPTR                      ;* reset input pointer to start of statement (this will cause the
                stx CHARAD                      ;* INPUT statement to be re-executed
                rts
INPUT           ldb #11*2                       ; code for illegal direct statement
                ldx CURLIN                      ; are we in immediate mode?
                leax 1,x
                beq LAFDC                       ; brif so - raise ID error
                bsr LB002                       ; go do the INPUT thing
                clr DEVNUM                      ; reset device to screen/keyboard
                rts
LB002           cmpa #'#                        ; is there a device number?
                bne LB00F                       ; brif not
                jsr LA5A5                       ; parse device number
                jsr LA3ED                       ; make sure it's valid for input
                jsr LB26D                       ; make sure we have a comma after the device number
LB00F           cmpa #'"                        ; is there a prompt string?
                bne LB01E                       ; brif not
                jsr LB244                       ; parse the prompt string
                ldb #';                         ; make sure we have a semicolon after the prompt
                jsr LB26F
                jsr LB99F                       ; print the prompt
LB01E           ldx #LINBUF                     ; point to line input buffer
                clr ,x                          ; NUL first byte to indicate no data
                tst DEVNUM                      ; is it keyboard input?
                bne LB049                       ; brif not
                bsr LB02F                       ; read a line from the keyboard
                ldb #',                         ; put a comma at the start of the buffer
                stb ,x
                bra LB049                       ; go process some input
LB02F           jsr LB9AF                       ; send a ?
                jsr LB9AC                       ; send a space
LB035           jsr LA390                       ; read input from the keyboard
                bcc LB03F                       ; brif not BREAK
                leas 4,s                        ; clean up stack
LB03C           jmp LAE11                       ; go process BREAK
LB03F           ldb #2*23                       ; input past end of file error code
                tst CINBFL                      ; was it EOF?
                bne LAFDC                       ; brif so - raise the error
                rts
READ            ldx DATPTR                      ; fetch current DATA pointer
                skip1lda                        ; set A to nonzero (for READ)
LB049           clra                            ; set A to zero (for INPUT)
                sta INPFLG                      ; record whether we're doing READ or INPUT
                stx DATTMP                      ; save current input location
LB04E           jsr LB357                       ; evaluate a variable (destination of data)
                stx VARDES                      ; save descriptor
                ldx CHARAD                      ; save interpreter input pointer
                stx BINVAL
                ldx DATTMP                      ; get data pointer
                lda ,x                          ; is there anything to read?
                bne LB069                       ; brif so
                lda INPFLG                      ; is it INPUT?
                bne LB0B9                       ; brif not
                jsr RVEC10                      ; do the RAM hook dance
                jsr LB9AF                       ; send a ? (so subsequent lines get ??)
                bsr LB02F                       ; go read an input line
LB069           stx CHARAD                      ; save data pointer
                jsr GETNCH                      ; fetch next data character
                ldb VALTYP                      ; do we want a number?
                beq LB098                       ; brif so
                ldx CHARAD                      ; get input pointer
                sta CHARAC                      ; save initial character as the delimiter
                cmpa #'"                        ; do we have a string delimiter?
                beq LB08B                       ; brif so - use " as both delimiters
                leax -1,x                       ; back up input if we don't have a delimiter
                clra                            ; set delimiter to NUL (end of line)
                sta CHARAC
                jsr LA35F                       ; set up print parameters
                tst PRTDEV                      ; is it a file type device?
                bne LB08B                       ; brif so - use two NULs
                lda #':                         ; use colon as one delimiter
                sta CHARAC
                lda #',                         ; and use comma as the other
LB08B           sta ENDCHR                      ; save second terminator
                jsr LB51E                       ; parse out the string
                jsr LB249                       ; move input pointer past the string
                jsr LAFA4                       ; assign the string to the variable
                bra LB09E                       ; go see if there's more to read
LB098           jsr LBD12                       ; parse a numeric string
                jsr LBC33                       ; assign the numbe to the variable
LB09E           jsr GETCCH                      ; get current input character
                beq LB0A8                       ; brif end of line
                cmpa #',                        ; check for comma
                lbne LAFD6                      ; brif not - we have bad data
LB0A8           ldx CHARAD                      ; get current data pointer
                stx DATTMP                      ; save the data pointer
                ldx BINVAL                      ; restore the interpreter input pointer
                stx CHARAD
                jsr GETCCH                      ; get current input from program
                beq LB0D5                       ; brif end of statement
                jsr LB26D                       ; make sure there's a comma between variables
                bra LB04E                       ; go read another item
LB0B9           stx CHARAD                      ; reset input pointer
                jsr LAEE8                       ; search for end of statement
                leax 1,x                        ; move past end of statement
                tsta                            ; was it end of line?
                bne LB0CD                       ; brif not
                ldb #2*3                        ; code for out of data
                ldu ,x++                        ; get pointer to next line
                beq LB10A                       ; brif end of program - raise OD error
                ldd ,x++                        ; get line number
                std DATTXT                      ; record it for raising errors in DATA statements
LB0CD           lda ,x                          ; do we have a DATA statement?
                cmpa #0x86
                bne LB0B9                       ; brif not - keep scanning
                bra LB069                       ; go process the input
LB0D5           ldx DATTMP                      ; get data pointer
                ldb INPFLG                      ; were we doing READ?
                lbne LADE8                      ; brif so - save DATA pointer
                lda ,x                          ; is there something after the input in the input buffer?
                beq LB0E7                       ; brif not - we consumed everything
                ldx #LB0E8-1                    ; print the ?EXTRA IGNORED message
                jmp LB99C
LB0E7           rts
LB0E8           fcc '?EXTRA IGNORED'
                fcb 0x0d,0x00
; NEXT command
NEXT            bne LB0FE                       ; brif argument given
                ldx ZERO                        ; set to NULL descriptor pointer
                bra LB101                       ; go process "any index will do"
LB0FE           jsr LB357                       ; evaluate the variable
LB101           stx VARDES                      ; save the index we're looking for
                jsr LABF9                       ; search the stack for the matching frame
                beq LB10C                       ; brif we found a matching frame
                ldb #0                          ; code for NEXT without FOR
LB10A           bra LB153                       ; raise the error
LB10C           tfr x,s                         ; reset the stack to the start of the stack frame
                leax 3,x                        ; point to the STEP value
                jsr LBC14                       ; copy the value to FPA0
                lda 8,s                         ; get step direction
                sta FP0SGN                      ; save as sign of FPA0
                ldx VARDES                      ; point to index variable
                jsr LB9C2                       ; add (X) to FPA0 (steps the index)
                jsr LBC33                       ; save new value to the index
                leax 9,s                        ; point to terminal condition
                jsr LBC96                       ; compare the new index value with the terminal
                subb 8,s                        ; set B=0 if we hit the terminal (or passed it with nonzero step)
                beq LB134                       ; brif loop complete
                ldx 14,s                        ; restore line number and input pointer to start of loop
                stx CURLIN
                ldx 16,s
                stx CHARAD
LB131           jmp LAD9E                       ; return to interpretation loop
LB134           leas 18,s                       ; remove the frame from the stack
                jsr GETCCH                      ; get character after the index
                cmpa #',                        ; do we have more indexes?
                bne LB131                       ; brif not
                jsr GETNCH                      ; munch the comma
                bsr LB0FE                       ; go process another value
; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall
; through this point, nor will the stack grow without bound. The BSR is required to make sure
; the stack is aligned properly for the stack search for the subsequent index variable.
;
; The following is the expression evaluation system. It has various entry points including for type
; checking. This really consists of two co-routines, one for evaluating operators and one for individual
; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow
; just how some of this works.
;
; Evaluate numeric expression
LB141           bsr LB156                       ; evaluate an expression
; TM error if string
LB143           andcc #0xfe                     ; clear C to indicate we want a number
                skip2keepc
; TM error if numeric
LB146           orcc #1                         ; set C to indicate we want a string
; TM error if: C = 1 and number, OR C = 0 and string
LB148           tst VALTYP                      ; set flags on the current value to (doesn't change C)
                bcs LB14F                       ; brif we want a string
                bpl LB0E7                       ; brif we have a number (we want a number)
                skip2
LB14F           bmi LB0E7                       ; brif we have a string (we want a string)
LB151           ldb #12*2                       ; code for TM error
LB153           jmp LAC46                       ; raise the error
; The general expression evaluation entry point
LB156           bsr LB1C6                       ; back up input pointer to compensate for GETNCH below
LB158           clra                            ; set operator precedence to 0 (no previous operator)
                skip2
LB15A           pshs b                          ; save relational operator flags
                pshs a                          ; save previous operator precedence
                ldb #1                          ; make sure we aren't overflowing the stack
                jsr LAC33
                jsr LB223                       ; go evaluate the first term
LB166           clr TRELFL                      ; flag no relational operators seen
LB168           jsr GETCCH                      ; get input character
LB16A           suba #0xb2                      ; token for > (lowest relational operator)
                blo LB181                       ; brif below relational operators
                cmpa #3                         ; there are three relational operators, is it one?
                bhs LB181                       ; brif not
                cmpa #1                         ; set C if >
                rola                            ; shift C into bit 0 (4: <, 2: =, 1: >)
                eora TRELFL                     ; flip the bit for this operator
                cmpa TRELFL                     ; did the result get lower?
                blo LB1DF                       ; brif so - we have a duplicate so raise an error
                sta TRELFL                      ; save new operator flags
                jsr GETNCH                      ; munch the operator
                bra LB16A                       ; go see if we have another one
LB181           ldb TRELFL                      ; do we have a relational comparison?
                bne LB1B8                       ; brif so
                lbcc LB1F4                      ; brif the token is above the relational operators
                adda #7                         ; put operators starting at 0
                bhs LB1F4                       ; brif we're above 0 - it's an operator, Jim
                adca VALTYP                     ; add carry, numeric flag, and modified token number
                lbeq LB60F                      ; brif we have string and A is + - do concatenation
                adca #-1                        ; restore operator number
                pshs a                          ; save operator number
                asla                            ; times 2
                adda ,s+                        ; and times 3 (3 bytes per entry)
                ldx #LAA51                      ; point to operator pecedence and jump table
                leax a,x                        ; point to correct entry
LB19F           puls a                          ; get precedence of previous operation
                cmpa ,x                         ; is hit higher (or same) than the current one?
                bhs LB1FA                       ; brif so - we need to process that operator
                bsr LB143                       ; TM error if we have a string
LB1A7           pshs a                          ; save previous operation precedence
                bsr LB1D4                       ; push operator handler address and FPA0 onto the stack
                ldx RELPTR                      ; get pointer to arithmetic/logical table entry for last operation
                puls a                          ; get back precedence
                bne LB1CE                       ; brif we had a relational operation
                tsta                            ; check precedence of previous operation
                lbeq LB220                      ; brif end of expression
                bra LB203                       ; go handle operation
LB1B8           asl VALTYP                      ; get type of value to C
                rolb                            ; mix it in to bit 0 of relational flags
                bsr LB1C6                       ; back up input pointer
                ldx #LB1CB                      ; point to relational operator precedence and handler
                stb TRELFL                      ; save relational comparison flags
                clr VALTYP                      ; result will be numeric
                bra LB19F                       ; to process the operation
LB1C6           ldx CHARAD                      ; get input pointer
                jmp LAEBB                       ; back it up one and put it back
LB1CB           fcb 0x64                        ; precedence of relational comparison
                fdb LB2F4                       ; handler address for relational comparison
LB1CE           cmpa ,x                         ; is last done operation higher (or same) precedence?
                bhs LB203                       ; brif so - go process it
                bra LB1A7                       ; go push things on the stack and process this operation otherwise
LB1D4           ldd 1,x                         ; get address of operatorroutine
                pshs d                          ; save it
                bsr LB1E2                       ; push FPA0 onto the stack
                ldb TRELFL                      ; get back relational operator flags
                lbra LB15A                      ; go evaluate another operation
LB1DF           jmp LB277                       ; raise a syntax error
LB1E2           ldb FP0SGN                      ; get sign of FPA0
                lda ,x                          ; get precedence of this operation
LB1E6           puls y                          ; get back original caller
                pshs b                          ; save sign
LB1EA           ldb FP0EXP                      ; get exponent
                ldx FPA0                        ; get mantissa
                ldu FPA0+2
                pshs u,x,b                      ; stow FPA0 sign and mantissa
                jmp ,y                          ; return to caller
LB1F4           ldx ZERO                        ; point to dummy value
                lda ,s+                         ; get precedence of previous operation (and set flags)
                beq LB220                       ; brif end of expression
LB1FA           cmpa #0x64                      ; relational operation?
                beq LB201                       ; brif so
                jsr LB143                       ; type mismatch if string
LB201           stx RELPTR                      ; save pointer to operator routine
LB203           puls b                          ; get relational flags
                cmpa #0x5a                      ; NOT operation?
                beq LB222                       ; brif so (it was unary)
                cmpa #0x7d                      ; unary negation?
                beq LB222                       ; brif so
                lsrb                            ; shift value type flag out of relational flags
                stb RELFLG                      ; save relational operator flag
                puls a,x,u                      ; get FP value back
                sta FP1EXP                      ; set exponent and mantissa in FPA1
                stx FPA1
                stu FPA1+2
                puls b                          ; and the sign
                stb FP1SGN
                eorb FP0SGN                     ; set RESSGN if the two operand signs differ
                stb RESSGN
LB220           ldb FP0EXP                      ; get exponent of FPA0
LB222           rts                             ; return or transfer control to operator handler routine
LB223           jsr RVEC15                      ; do the RAM hook dance
                clr VALTYP                      ; set type to numeric
                jsr GETNCH                      ; get first character in the term
                bcc LB22F                       ; brif not numeric
LB22C           jmp LBD12                       ; parse a number (and return)
LB22F           jsr LB3A2                       ; set carry if not alpha
                bcc LB284                       ; brif alpha character (variable)
                cmpa #'.                        ; decimal point?
                beq LB22C                       ; brif so - evaluate number
                cmpa #0xac                      ; minus?
                beq LB27C                       ; brif so - process unary negation
                cmpa #0xab                      ; plus?
                beq LB223                       ; brif so - ignore unary "posation"
                cmpa #'"                        ; string delimiter?
                bne LB24E                       ; brif not
LB244           ldx CHARAD                      ; get input pointer
                jsr LB518                       ; go parse the string
LB249           ldx COEFPT                      ; get address of end of string
                stx CHARAD                      ; move input pointer past string
                rts
LB24E           cmpa #0xa8                      ; NOT?
                bne LB25F                       ; brif not
                lda #0x5a                       ; precedence of unary NOT
                jsr LB15A                       ; process the operand of NOT
                jsr INTCNV                      ; convert to integer in D
                coma                            ; do a bitwise complement
                comb
                jmp GIVABF                      ; resturn the result
LB25F           inca                            ; is it a function token?
                beq LB290                       ; brif so
LB262           bsr LB26A                       ; only other legal thing must be a (expr)
                jsr LB156                       ; evaluate parentheticized expression
LB267           ldb #')                         ; force a )
                skip2
LB26A           ldb #'(                         ; force a (
                skip2
LB26D           ldb #',                         ; force a ,
LB26F           cmpb [CHARAD]                   ; does character match?
                bne LB277                       ; brif not
                jmp GETNCH                      ; each the character and return the next
LB277           ldb #2*1                        ; raise syntax error
                jmp LAC46
LB27C           lda #0x7d                       ; unary negation precedence
                jsr LB15A                       ; evaluate argument
                jmp LBEE9                       ; flip sign of FPA0 and return
LB284           jsr LB357                       ; evaluate variable
LB287           stx FPA0+2                      ; save descriptor address in FPA0
                lda VALTYP                      ; test variable type
                bne LB222                       ; brif string - we're done
                jmp LBC14                       ; copy FP number from (X) into FPA0
LB290           jsr GETNCH                      ; get the actual token number
                tfr a,b                         ; save it (for offsetting X)
                lslb                            ; two bytes per jump table entry (and lose high bit)
                jsr GETNCH                      ; eat the token byte
                cmpb #2*19                      ; is it a valid token for Color Basic?
                bls LB29F                       ; brif so
                jmp [COMVEC+18]                 ; transfer control to Extended Basic if not
LB29F           pshs b                          ; save jump table offset
                cmpb #2*14                      ; does it expect a numeric argument?
                blo LB2C7                       ; brif so
                cmpb #2*18                      ; does it need no arguments?
                bhs LB2C9                       ; brif so
                bsr LB26A                       ; force a (
                lda ,s                          ; get token value
                cmpa #2*17                      ; is it POINT?
                bhs LB2C9                       ; brif so
                jsr LB156                       ; evaluate first argument string
                bsr LB26D                       ; force a comma
                jsr LB146                       ; TM error if string
                puls a                          ; get token value
                ldu FPA0+2                      ; get string descriptor
                pshs u,a                        ; now we save the first string argument and the token value
                jsr LB70B                       ; evaluate first numeric argument
                puls a                          ; get back token value
                pshs b,a                        ; save second argument and token value
                fcb 0x8e                        ; opcode of LDX immediate (skips two bytes)
LB2C7           bsr LB262                       ; force a (
LB2C9           puls b                          ; get offset
                ldx COMVEC+8                    ; get jump table pointer
                abx                             ; add offset into table
                jsr [,x]                        ; go process function
                jmp LB143                       ; make sure result is numeric
; operator OR
LB2D4           skip1lda                        ; set flag to nonzero to signal OR
; operator AND
LB2D5           clra                            ; set flag to zero to signal AND
                sta TMPLOC                      ; save AND/OR flag
                jsr INTCNV                      ; convert second argument to intenger
                std CHARAC                      ; save it
                jsr LBC4A                       ; move first argument to FPA0
                jsr INTCNV                      ; convert first argument to integer
                tst TMPLOC                      ; is it AND or OR?
                bne LB2ED                       ; brif OR
                anda CHARAC                     ; do the bitwise AND
                andb ENDCHR
                bra LB2F1                       ; finish up
LB2ED           ora CHARAC                      ; do the bitwise OR
                orb ENDCHR
LB2F1           jmp GIVABF                      ; return integer result
; relational comparision operators
LB2F4           jsr LB148                       ; TM error if type mismatch
                BNE LB309                       ; brif we have a string comparison
                lda FP1SGN                      ; pack FPA1
                ora #0x7f
                anda FPA1
                sta FPA1
                ldx #FP1EXP                     ; point to packed FPA1
                jsr LBC96                       ; compare FPA0 to FPA1
                bra LB33F                       ; handle truth comparison
LB309           clr VALTYP                      ; the result of a comparison is always a number
                dec TRELFL                      ; remove the string flag from the comparison data
                jsr LB657                       ; get string details for second argument
                stb STRDES                      ; save them in the temporary string descriptor
                stx STRDES+2
                ldx FPA1+2                      ; get pointer to first argument descriptor
                jsr LB659                       ; get string details for second argument
                lda STRDES                      ; get length of second argument
                pshs b                          ; save length of first argument
                suba ,s+                        ; now A is the difference in string lengths
                beq LB328                       ; brif string lengths are equal
                lda #1                          ; flag for second argument is longer than first
                bcc LB328                       ; brif second string is longer than first
                ldb STRDES                      ; get length of second string (shorter)
                nega                            ; invert default comparison result
LB328           sta FP0SGN                      ; save default truth flag
                ldu STRDES+2                    ; get pointer to start of second string
                incb                            ; compensate for DECB
LB32D           decb                            ; have we compared everything?
                bne LB334                       ; brif not
                ldb FP0SGN                      ; get default truth value
                bra LB33F                       ; decide comparison truth
LB334           lda ,x+                         ; get byte from first argument
                cmpa ,u+                        ; compare with second argument
                beq LB32D                       ; brif equal - keep comparing
                ldb #0xff                       ; negative if first string is > second
                bcc LB33F                       ; brif string A > string B
                negb                            ; invert result
LB33F           addb #1                         ; convert to 0,1,2
                rolb                            ; shift left - now it's 4,2,1 for <, =, >
                andb RELFLG                     ; keep only the truth we care about
                beq LB348                       ; brif no matching bits - it's false
                ldb #0xff                       ; set true
LB348           jmp LBC7C                       ; convert result to FP and return it
; DIM command
LB34B           jsr LB26D                       ; make sure there's a comma between variables
DIM             ldb #1                          ; flag that we're dimensioning
                bsr LB35A                       ; go allocate the variable
                jsr GETCCH                      ; are we done?
                bne LB34B                       ; brif not
                rts
; This routine parses a variable. For scalars, it will return a NULL string or 0 value number
; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will
; allocate a default sized array if dimensioning is not underway and then attempt to look up
; the requested coordinates in that array. Otherwise, it will allocate an array based on the
; specified dimension values.
LB357           clrb                            ; flag that we're not setting up an array
                jsr GETCCH
LB35A           stb DIMFLG                      ; save dimensioning flag
                sta VARNAM                      ; save first character of variable name
                jsr GETCCH                      ; get input character (why? we already have it)
                bsr LB3A2                       ; set carry if not alpha
                lbcs LB277                      ; brif our variable doesn't start with a letter
                clrb                            ; default second variable character to NUL
                stb VALTYP                      ; set value type to numeric
                jsr GETNCH                      ; get second character
                bcs LB371                       ; brif numeric - numbers are allowed
                bsr LB3A2                       ; set carry if not alpha
                bcs LB37B                       ; brif not alpha
LB371           tfr a,b                         ; save set second character of variable name
LB373           jsr GETNCH                      ; get an input character
                bcs LB373                       ; brif numeric - still in variable name
                bsr LB3A2                       ; set carry if not alpha
                bcc LB373                       ; brif alpha - still in variable name
LB37B           cmpa #'$                        ; do we have the string sigil?
                bne LB385                       ; brif not
                com VALTYP                      ; set value type to string
                addb #0x80                      ; set bit 7 of second variable character to indicate string
                jsr GETNCH                      ; eat the sigil
LB385           stb VARNAM+1                    ; save second variable name character
                ora ARYDIS                      ; merge array disable flag (will set bit 7 of input character if no arrays)
                suba #'(                        ; do we have a subscript?
                lbeq LB404                      ; brif so
                clr ARYDIS                      ; disable the array disable flag - it's single use
                ldx VARTAB                      ; point to the start of the variable table
                ldd VARNAM                      ; get variable name
LB395           cmpx ARYTAB                     ; are we at the top of the variable table?
                beq LB3AB                       ; brif so
                cmpd ,x++                       ; does the variable name match (and move pointer to variable data)
                beq LB3DC                       ; brif so
                leax 5,x                        ; move to next table entry
                bra LB395                       ; see if we have a match
; Set carry if not upper case alpha
LB3A2           cmpa #'A                        ; set C if less than A
                bcs LB3AA                       ; brif less than A
                suba #'Z+1                      ; set C if greater than Z
                suba #-('Z+1)
LB3AA           rts
LB3AB           ldx #ZERO                       ; point to empty location (NULL/0 value)
                ldu ,s                          ; get caller address
                cmpu #LB287                     ; coming from "evaluate term"?
                beq LB3DE                       ; brif so - don't allocate
                ldd ARYEND                      ; get end of arrays
                std V43                         ; save as top of source block
                addd #7                         ; 7 bytes per scalar entry
                std V41                         ; save as top of destination block
                ldx ARYTAB                      ; get bottom of arrays
                stx V47                         ; save as bottom of source block
                jsr LAC1E                       ; move the arrays up to make a hole
                ldx V41                         ; get new top of arrays
                stx ARYEND                      ; set new end of arrays
                ldx V45                         ; get bottom of destination block
                stx ARYTAB                      ; set as new start of arrays
                ldx V47                         ; get old end of variables
                ldd VARNAM                      ; get name of variable
                std ,x++                        ; set variable name and advance X to the value
                clra                            ; zero out the variable value
                clrb
                std ,x
                std 2,x
                sta 4,x
LB3DC           stx VARPTR                      ; save descriptor address of return value
LB3DE           rts
; Various integer conversion routines
LB3DF           fcb 0x90,0x80,0x00,0x00,0x00    ; FP constant -32768
LB3E4           jsr GETNCH                      ; fetch input character
LB3E6           jsr LB141                       ; evaluate numeric expression
LB3E9           lda FP0SGN                      ; get sign of value
                bmi LB44A                       ; brif negative (raise FC error)
INTCNV          jsr LB143                       ; TM error if string
                lda FP0EXP                      ; get exponent
                cmpa #0x90                      ; is it within the range for a 16 bit integer?
                blo LB3FE                       ; brif smaller than 32768
                ldx #LB3DF                      ; point to -32678 constant
                jsr LBC96                       ; is FPA0 equal to -32768?
                bne LB44A                       ; brif not - magnitude is too far negative
LB3FE           jsr LBCC8                       ; move binary point to the right of FPA0 and correct sign
                ldd FPA0+2                      ; get the resulting integer
                rts
LB404           ldd DIMFLG                      ; get dimensioning flag and variable type
                pshs b,a                        ; save them (to avoid issues while evaluating dimension values)
                nop                             ; dead space caused by 1.2 revision
                clrb                            ; reset dimension counter
LB40A           ldx VARNAM                      ; get variable name
                pshs x,b                        ; save dimension counter and variable name
                bsr LB3E4                       ; evaluate a dimension value (and skip either ( or ,)
                puls b,x,y                      ; get variable name, dimension counter, and dimensioning/type flag
                stx VARNAM                      ; restore variable name
                ldu FPA0+2                      ; get dimension size/index
                pshs u,y                        ; save dimension size and dimensioning/type flag
                incb                            ; bump dimension counter
                jsr GETCCH                      ; get what's after the dimension count
                cmpa #',                        ; do we have another dimension?
                beq LB40A                       ; brif so - parse it
                stb TMPLOC                      ; save dimension counter
                jsr LB267                       ; make sure we have a )
                puls a,b                        ; get back variable type and dimensioning flag
                std DIMFLG                      ; restore variable type and dimensioning flag
                ldx ARYTAB                      ; get start of arrays
LB42A           cmpx ARYEND                     ; are we at the end of the array table
                beq LB44F                       ; brif so
                ldd VARNAM                      ; get variable name
                cmpd ,x                         ; does it match?
                beq LB43B                       ; brif so
                ldd 2,x                         ; get length of this array
                leax d,x                        ; move to next array
                bra LB42A                       ; go check another entry
LB43B           ldb #2*9                        ; code for redimensioned array error
                lda DIMFLG                      ; are we dimensioning?
                bne LB44C                       ; brif so - raise error
                ldb TMPLOC                      ; get number of dimensions given
                cmpb 4,x                        ; does it match?
                beq LB4A0                       ; brif so
LB447           ldb #8*2                        ; raise "bad subscript"
                skip2
LB44A           ldb #4*2                        ; raise "illegal function call"
LB44C           jmp LAC46                       ; raise error
LB44F           ldd #5                          ; 5 bytes per array entry
                std COEFPT                      ; initialize array size to entry size
                ldd VARNAM                      ; get variable name
                std ,x                          ; set array name
                ldb TMPLOC                      ; get dimension count
                stb 4,x                         ; set dimension count
                jsr LAC33                       ; make sure we haven't overflowed memory
                stx V41                         ; save array descriptor address
LB461           ldb #11                         ; default dimension value (zero-based, gives max index of 10)
                clra                            ; zero extend (??? why not LDD above?)
                tst DIMFLG                      ; are we dimensioning?
                beq LB46D                       ; brif not
                puls a,b                        ; get dimension size
                addd #1                         ; account for zero based indexing
LB46D           std 5,x                         ; save dimension size
                bsr LB4CE                       ; multiply by accumulated array size
                std COEFPT                      ; save new array size
                leax 2,x                        ; move to next dimension
                dec TMPLOC                      ; have we done all dimensions?
                bne LB461                       ; brif not
                stx TEMPTR                      ; save end of array descriptor (minus 5)
                addd TEMPTR                     ; add total size of array to address of descriptor
                lbcs LAC44                      ; brif it overflows memory
                tfr d,x                         ; save end of array for later
                jsr LAC37                       ; does array fit in memory?
                subd #STKBUF-5                  ; subtract out the "stack fudge factor" but add 5 to the result
                std ARYEND                      ; save new end of arrays
                clra                            ; set up for clearing
LB48C           leax -1,x                       ; move back one
                sta 5,x                         ; blank out a byte in the array data
                cmpx TEMPTR                     ; have we reached the array header?
                bne LB48C                       ; brif not
                ldx V41                         ; get address of start of descriptor
                lda ARYEND                      ; get MSB of end of array back (B still has LSB)
                subd V41                        ; subtract start of descriptor
                std 2,x                         ; save length of array in array header
                lda DIMFLG                      ; are we dimensioning?
                bne LB4CD                       ; brif so - we're done
LB4A0           ldb 4,x                         ; get number of dimensions
                stb TMPLOC                      ; initialize counter
                clra                            ; initialize accumulated offset
                clrb
LB4A6           std COEFPT                      ; save accumulated offset
                puls a,b                        ; get desired index
                std FPA0+2                      ; save it
                cmpd 5,x                        ; is it in range for this dimension?
                bhs LB4EB                       ; brif not
                ldu COEFPT                      ; get accumulated offset
                beq LB4B9                       ; brif first dimension
                bsr LB4CE                       ; multiply accumulated offset by dimension length
                addd FPA0+2                     ; add in offset into this dimension
LB4B9           leax 2,x                        ; move to next dimension in header
                dec TMPLOC                      ; done all dimensions?
                bne LB4A6                       ; brif not
                std ,--s                        ; save D for multiply by 5 (should be pshs d)
                aslb                            ; times 2
                rola
                aslb                            ; times 4
                rola
                addd ,s++                       ; times 5
                leax d,x                        ; add in offset from start of array data
                leax 5,x                        ; offset to end of header
                stx VARPTR                      ; save pointer to element data
LB4CD           rts
; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry
LB4CE           lda #16                         ; 16 shifts to do a multiply
                sta V45                         ; save shift counter
                ldd 5,x                         ; get multiplier
                std BOTSTK                      ; save it
                clra                            ; zero out product
                clrb
LB4D8           aslb                            ; shift product left
                rola
                bcs LB4EB                       ; brif we have a carry
                asl COEFPT+1                    ; shift other factor left
                rol COEFPT
                bcc LB4E6                       ; brif no carry - this bit position is 0
                addd BOTSTK                     ; add in multiplier at this bit position
                bcs LB4EB                       ; brif carry - do an error
LB4E6           dec V45                         ; have we done all 16 bits?
                bne LB4D8                       ; brif not
                rts
LB4EB           jmp LB447                       ; raise a BS error
; MEM function
; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks
MEM             tfr s,d                         ; get stack pointer where we can do math
                subd ARYEND                     ; calculate number of bytes between the stack and the top of arrays
                skip1                           ; return result
; Convert unsigned value in B to FP
LB4F3           clra                            ; zero extend
; Convert signed value in D to FP
GIVABF          clr VALTYP                      ; set value type to numeric
                std FPA0                        ; save value in FPA0
                ldb #0x90                       ; exponent for top two bytes to be an integer
                jmp LBC82                       ; finish conversion to integer
; STR$ function
STR             jsr LB143                       ; make sure we have a number
                ldu #STRBUF+2                   ; convert FP number to string in temporary string buffer
                jsr LBDDC
                leas 2,s                        ; don't return to the function evaluator (which will do a numeric type check)
                ldx #STRBUF+1                   ; point to number string
                bra LB518                       ; to stash the string in string space and return to the "evaluate term" caller
; Reserve B bytes of string space. Return start in X and FRESPC
LB50D           stx V4D                         ; save X somewhere in case the caller needs it
LB50F           bsr LB56D                       ; allocate string space
LB511           stx STRDES+2                    ; save pointer to allocated space in the temporary descriptor
                stb STRDES                      ; save length in the temporary descriptor
                rts
LB516           leax -1,x                       ; move pointer back one (to compensate for the increment below)
; Scan from X until either NUL or one of the string terminators is found
LB518           lda #'"                         ; set terminator to be string delimiter
LB51A           sta CHARAC                      ; set both delimiters
                sta ENDCHR
LB51E           leax 1,x                        ; move to next character        
                stx RESSGN                      ; save start of string
                stx STRDES+2                    ; save start of string in the temporary string descriptor
                ldb #-1                         ; initialize length counter to -1 (compensate for initial INCB)
LB526           incb                            ; bump string length
                lda ,x+                         ; get character from string
                beq LB537                       ; brif end of line
                cmpa CHARAC                     ; is it delimiter #1?
                beq LB533                       ; brif so
                cmpa ENDCHR                     ; is it delimiter #2?
                bne LB526                       ; brif not - keep scanning
LB533           cmpa #'"                        ; string delimiter?
                beq LB539                       ; brif so - don't move pointer back
LB537           leax -1,x                       ; move pointer back (so we don't consume the delimiter)
LB539           stx COEFPT                      ; save end of string address
                stb STRDES                      ; save string length
                ldu RESSGN                      ; get start of string
                cmpu #STRBUF+2                  ; is it at the start of the string buffer?
                bhi LB54C                       ; brif so - don't copy it to string space
                bsr LB50D                       ; allocate string space
                ldx RESSGN                      ; point to beginning of the string
                jsr LB645                       ; copy string data (B bytes) from (X) to (FRESPC)
; Put temporary string descriptor on the string stack
LB54C           ldx TEMPPT                      ; get top of string stack
                cmpx #CFNBUF                    ; is the string stack full?
                bne LB558                       ; brif not
                ldb #15*2                       ; code for "string formula too complex"
LB555           jmp LAC46                       ; raise error
LB558           lda STRDES                      ; get string length
                sta 0,x                         ; save it in the string stack descriptor
                ldd STRDES+2                    ; get string data pointer
                std 2,x                         ; save in string stack descriptor
                lda #0xff                       ; set value type to string
                sta VALTYP
                stx LASTPT                      ; set pointer to last used entry on the string stack
                stx FPA0+2                      ; set pointer to descriptor in the current evaluation value
                leax 5,x                        ; advance string stack pointer
                stx TEMPPT
                rts
; Reserve B bytes in string space. If there isn't enough space, try compacting string space and
; then try the allocation again. If it still fails, raise OS error.
LB56D           clr GARBFL                      ; flag that compaction not yet done
LB56F           clra                            ; zero extend the length
                pshs d                          ; save requested string length
                ldd STRTAB                      ; get current bottom of strings
                subd ,s+                        ; calculate new bottom of strings and remove zero extension
                cmpd FRETOP                     ; does the string fit?
                blo LB585                       ; brif not - try compaction
                std STRTAB                      ; save new bottom of strings
                ldx STRTAB                      ; get bottom of strings
                leax 1,x                        ; now X points to the real start of the allocated space
                stx FRESPC                      ; save the string pointer
                puls b,pc                       ; restore length and return
LB585           ldb #2*13                       ; code for out of string space
                com GARBFL                      ; have we compacted string space yet?
                beq LB555                       ; brif so - raise error
                bsr LB591                       ; compact string space
                puls b                          ; get back string length
                bra LB56F                       ; go try allocation again
; Compact string space
; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer
; that hasn't already been moved into the freshly compacted string space. If then moves that string data
; up to the highest address it can go to. It repeats this process over and over until it finds no string
; that isn't already in the compacted space. While doing this, it has to search all strings on the string
; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string
; variables, and *every* entry in every string array.
LB591           ldx MEMSIZ                      ; get to of string space
LB593           stx STRTAB                      ; save top of uncompacted stringspace
                clra                            ; zero out D and reset pointer to discovered variable to NULL
                clrb
                std V4B
                ldx FRETOP                      ; point to bottom of string space
                stx V47                         ; save as lowest match address (match will be higher)
                ldx #STRSTK                     ; point to start of string stack
LB5A0           cmpx TEMPPT                     ; are we at the top of the string stack?
                beq LB5A8                       ; brif so - done with the string stack
                bsr LB5D8                       ; check for string in uncompacted space (and advance pointer)
                bra LB5A0                       ; check another on the string stack
LB5A8           ldx VARTAB                      ; point to start of scalar variables
LB5AA           cmpx ARYTAB                     ; end of scalars?
                beq LB5B2                       ; brif so
                bsr LB5D2                       ; check for string in uncompacted space and advance pointer
                bra LB5AA                       ; check another variable
LB5B2           stx V41                         ; save address of end of variables (address of first array)
LB5B4           ldx V41                         ; get start of the next array
LB5B6           cmpx ARYEND                     ; end of arrays?
                beq LB5EF                       ; brif so
                ldd 2,x                         ; get length of array
                addd V41                        ; add to start of array
                std V41                         ; save address of next array
                lda 1,x                         ; get second character of variable name
                bpl LB5B4                       ; brif numeric
                ldb 4,x                         ; get number of dimensions
                aslb                            ; two bytes per dimension size
                addb #5                         ; add in fixed overhead for array descriptor
                abx                             ; now X points to first array element
LB5CA           cmpx V41                        ; at the start of the next array?
                beq LB5B6                       ; brif so - go handle another array
                bsr LB5D8                       ; check for string in uncompacted space (and advance pointer)
                bra LB5CA                       ; process next array element
LB5D2           lda 1,x                         ; get second character of variable name
                leax 2,x                        ; move to variable data
                bpl LB5EC                       ; brif numeric
LB5D8           ldb ,x                          ; get length of string
                beq LB5EC                       ; brif NULL - don't need to check data pointer
                ldd 2,x                         ; get data pointer
                cmpd STRTAB                     ; is it in compacted string space?
                bhi LB5EC                       ; brif so
                cmpd V47                        ; is it better match than previous best?
                bls LB5EC                       ; brif not
                stx V4B                         ; save descriptor address of best match
                std V47                         ; save new best data pointer match
LB5EC           leax 5,x                        ; move to next descriptor
LB5EE           rts
LB5EF           ldx V4B                         ; get descriptor address of the matched string
                beq LB5EE                       ; brif we didn't find one - we're done
                clra                            ; zero extend length
                ldb ,x                          ; get string length
                decb                            ; subtract one (we won't have a NULL string here)
                addd V47                        ; now D points to the address of the end of the string data
                std V43                         ; save as top address of move
                ldx STRTAB                      ; set top of uncompacted space as destination
                stx V41
                jsr LAC20                       ; move string to top of uncompactedspace
                ldx V4B                         ; point to string descriptor
                ldd V45                         ; get new data pointer address
                std 2,x                         ; update descriptor
                ldx V45                         ; get bottom of copy destination
                leax -1,x                       ; move back below it
                jmp LB593                       ; go search for another string to move (and set new bottom of string space)
; Concatenate two strings. We come here directly from the operator handler rather than via a JSR.
LB60F           ldd FPA0+2                      ; get string descriptor for the first string
                pshs d                          ; save it
                jsr LB223                       ; evaluate a second string (concatenation is left associative)
                jsr LB146                       ; make sure we have a string
                puls x                          ; get back first string descriptor
                stx RESSGN                      ; save it
                ldb ,x                          ; get length of first string
                ldx FPA0+2                      ; get pointer to second string
                addb ,x                         ; add length of second string
                bcc LB62A                       ; brif combined length is OK
                ldb #2*14                       ; raise string too long error
                jmp LAC46
LB62A           jsr LB50D                       ; reserve room for new string
                ldx RESSGN                      ; get descriptor address of the first string
                ldb ,x                          ; get length of first string
                bsr LB643                       ; copy it to string space
                ldx V4D                         ; get descriptor address of second string
                bsr LB659                       ; get string details for second string
                bsr LB645                       ; copy second string into new string space
                ldx RESSGN                      ; get pointer to first string
                bsr LB659                       ; remove it from the string stack if possible
                jsr LB54C                       ; put new string on the string stack
                jmp LB168                       ; return to expression evaluator
; Copy B bytes to space pointed to by FRESPC
LB643           ldx 2,x                         ; get source address from string descriptor
LB645           ldu FRESPC                      ; get destination address
                incb                            ; compensate for decb
                bra LB64E                       ; do the copy
LB64A           lda ,x+                         ; copy a byte
                sta ,u+
LB64E           decb                            ; done yet?
                bne LB64A                       ; brif not
                stu FRESPC                      ; save destination pointer
                rts
; Fetch details of string in FPA0+2 and remove from the string stack if possible
LB654           jsr LB146                       ; make sure we have a string
LB657           ldx FPA0+2                      ; get descriptor pointer
LB659           ldb ,x                          ; get length of string
                bsr LB675                       ; see if it's at the top of the string stack and remove it if so
                bne LB672                       ; brif not removed
                ldx 5+2,x                       ; get start address of string just removed
                leax -1,x                       ; move pointer down 1
                cmpx STRTAB                     ; is it at the bottom of string space?
                bne LB66F                       ; brif not
                pshs b                          ; save length
                addd STRTAB                     ; add length to start of strings (A was cleared previously)
                std STRTAB                      ; save new string space start (deallocated space for this string)
                puls b                          ; get back string length
LB66F           leax 1,x                        ; restore pointer to pointing at the actual string data
                rts
LB672           ldx 2,x                         ; get data pointer for the string
                rts
; Remove string pointed to by X from the string stack if it is at the top of the stack; return with
; A clear and Z set if string removed
LB675           cmpx LASTPT                     ; is it at the top of the string stack?
                bne LB680                       ; brif not - do nothing
                stx TEMPPT                      ; save new top of stack
                leax -5,x                       ; move the "last" pointer back as well
                stx LASTPT
                clra                            ; flag string removed
LB680           rts
; LEN function
LEN             bsr LB686                       ; get string details
LB683           jmp LB4F3                       ; return unsigned length in B
LB686           bsr LB654                       ; get string details and remove from string stack
                clr VALTYP                      ; set value type to numeric
                tstb                            ; set flags according to length
                rts
; CHR$ function
CHR             jsr LB70E                       ; get 8 bit unsigned integer to B
LB68F           ldb #1                          ; allocate a one byte string
                jsr LB56D
                lda FPA0+3                      ; get character code
                jsr LB511                       ; save reserved string details in temp descriptor
                sta ,x                          ; put character in string
LB69B           leas 2,s                        ; don't go back to function handler - avoid numeric type check
LB69D           jmp LB54C                       ; return temporary string on string stack
; ASC function
ASC             bsr LB6A4                       ; get first character of argument
                bra LB683                       ; return unsigned code in B
LB6A4           bsr LB686                       ; fetch string details
                beq LB706                       ; brif NULL string
                ldb ,x                          ; get character at start of string
                rts
; LEFT$ function
LEFT            bsr LB6F5                       ; get arguments from the stack
LB6AD           clra                            ; clear pointer offset (set to start of string)
LB6AE           cmpb ,x                         ; are we asking for more characters than there are in the string?
                bls LB6B5                       ; brif not
                ldb ,x                          ; only return the number that are in the string
                clra                            ; force starting offset to be the start of the string
LB6B5           pshs b,a                        ; save offset and length
                jsr LB50F                       ; reserve space in string space
                ldx V4D                         ; point to original string descriptor
                bsr LB659                       ; get string details
                puls b                          ; get string offset
                abx                             ; now X points to the start of the data to copy
                puls b                          ; get length of copy
                jsr LB645                       ; copy the data to the allocated space
                bra LB69D                       ; return temp string on string stack
; RIGHT$ function
RIGHT           bsr LB6F5                       ; get arguments from stack
                suba ,x                         ; subtract length of original string from desired length
                nega                            ; now A is offset into old string where we start copying
                bra LB6AE                       ; go handle everything else
; MID$ function
MID             ldb #255                        ; default length is the whole string
                stb FPA0+3                      ; save it
                jsr GETCCH                      ; see what we have after offset
                cmpa #')                        ; end of function?
                beq LB6DE                       ; brif so - no length
                jsr LB26D                       ; force a comma
                bsr LB70B                       ; get length parameter
LB6DE           bsr LB6F5                       ; get string and offset parameters from the stack
                beq LB706                       ; brif we have a 0 offset requested (string offsets are 1-based)
                clrb                            ; clear length counter
                deca                            ; subtract one from position parameter (we work on 0-based, param is 1-based)
                cmpa ,x                         ; is start greater than length of string?
                bhs LB6B5                       ; brif so - return NULL string
                tfr a,b                         ; save absolute position parameter
                subb ,x                         ; now B is postition less length
                negb                            ; now B is amount of string to copy
                cmpb FPA0+3                     ; is it less than the length requested?
                bls LB6B5                       ; brif so
                ldb FPA0+3                      ; set length to the requested length
                bra LB6B5                       ; go finish up copying the substring
; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter
; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing
; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.)
LB6F5           jsr LB267                       ; make sure we have )
                ldu ,s                          ; get return address - we're going to mess with the stack
                ldx 5,s                         ; get address of string descriptor
                stx V4D                         ; save descriptor adddress
                lda 4,s                         ; get first numeric parameter in both A and B
                ldb 4,s
                leas 7,s                        ; clean up stack
                tfr u,pc                        ; return to original caller
LB706           jmp LB44A                       ; raise FC error
; Evaluate an unsigned 8 bit expression to B
LB709           jsr GETNCH                      ; move to next character
LB70B           jsr LB141                       ; evaluate a numeric expression
LB70E           jsr LB3E9                       ; convert to integer in D
                tsta                            ; are we negative or > 255?
                bne LB706                       ; brif so - FC error
                jmp GETCCH                      ; fetch current input character and return
; VAL function
VAL             jsr LB686                       ; get string details
                lbeq LBA39                      ; brif NULL string - return 0
                ldu CHARAD                      ; get input pointer so we can replace it later
                stx CHARAD                      ; point interpreter at string data
                abx                             ; calculate end address of the string
                lda ,x                          ; get byte after the end of the string
                pshs u,x,a                      ; save end of string address, input pointer, and character after end of string
                clr ,x                          ; put a NUL after the string (stops the number interpreter)
                jsr GETCCH                      ; get input character at start of string
                jsr LBD12                       ; evaluate numeric expression in string
                puls a,x,u                      ; get back saved character and pointers
                sta ,x                          ; restore byte after string
                stu CHARAD                      ; restore interpeter's input pointer
                rts
; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B
LB734           bsr LB73D                       ; evaluate expression
                stx BINVAL                      ; save result
LB738           jsr LB26D                       ; make sure there's a comma
                bra LB70B                       ; evaluate unsigned expression to B
; Evaluate unsigned expression in X
LB73D           jsr LB141                       ; evaluate numeric expression
LB740           lda FP0SGN                      ; is it negative?
                bmi LB706                       ; brif so
                lda FP0EXP                      ; get exponent
                cmpa #0x90                      ; largest possible exponent for 16 bits
                bhi LB706                       ; brif too large
                jsr LBCC8                       ; move binary point to right of FPA0
                ldx FPA0+2                      ; get resulting unsigned value
                rts
; PEEK function
PEEK            bsr LB740                       ; get address to X
                ldb ,x                          ; get the value at that address
                jmp LB4F3                       ; return B as unsigned value
; POKE function
POKE            bsr LB734                       ; evaluate address and byte value
                ldx BINVAL                      ; get address
                stb ,x                          ; put value there
                rts
; LLIST command
LLIST           ldb #-2                         ; set output device to printer
                stb DEVNUM
                jsr GETCCH                      ; reset flags for input character and fall through to LIST
; LIST command
LIST            pshs cc                         ; save zero flag (end of statement)
                jsr LAF67                       ; parse line number
                jsr LAD01                       ; find address of that line
                stx LSTTXT                      ; save that address as the start of the list
                puls cc                         ; get back ent of statement flag
                beq LB784                       ; brif end of line - list whole program
                jsr GETCCH                      ; are we at the end of the line (one number)?
                beq LB789                       ; brif end of line
                cmpa #0xac                      ; is it "-"?
                bne LB783                       ; brif not
                jsr GETNCH                      ; eat the "-"
                beq LB784                       ; brif no second number - list to end of program
                jsr LAF67                       ; evaluate the second number
                beq LB789                       ; brif illegal number
LB783           rts
LB784           ldu #0xffff                     ; this will cause listing to do the entire program
                stu BINVAL
LB789           leas 2,s                        ; don't return to the caller - we'll jump back to the main loop
                ldx LSTTXT                      ; get address of line to list
LB78D           jsr LB95C                       ; do a newline if needed
                jsr LA549                       ; do a break check
                ldd ,x                          ; get address of next line
                bne LB79F                       ; brif not end of program
LB797           jsr LA42D                       ; close output file
                clr DEVNUM                      ; reset device to screen
                jmp LAC73                       ; go back to immediate mode
LB79F           stx LSTTXT                      ; save new line address
                ldd 2,x                         ; get line number of this line
                cmpd BINVAL                     ; is it above the end line?
                bhi LB797                       ; brif so - return
                jsr LBDCC                       ; display line number
                jsr LB9AC                       ; put a space after it
                ldx LSTTXT                      ; get line address
                bsr LB7C2                       ; detokenize the line
                ldx [LSTTXT]                    ; get pointer to next line
                ldu #LINBUF+1                   ; point to start of detokenized line
LB7B9           lda ,u+                         ; get byte from detokenized line
                beq LB78D                       ; brif end of line
                jsr LB9B1                       ; output character
                bra LB7B9                       ; handle next character
; Detokenize a line from (X) to the line input buffer
LB7C2           jsr RVEC24                      ; do the RAM hook dance
                leax 4,x                        ; move past next line pointer and line number
                ldy #LINBUF+1                   ; point to line input buffer (destination)
LB7CB           lda ,x+                         ; get character from tokenized line
                beq LB820                       ; brif end of input
                bmi LB7E6                       ; brif it's a token
                cmpa #':                        ; colon?
                bne LB7E2                       ; brif not
                ldb ,x                          ; get what's after the colon
                cmpb #0x84                      ; ELSE?
                beq LB7CB                       ; brif so - suppress the colon
                cmpb #0x83                      ; '?
                beq LB7CB                       ; brif so - suppress the colon
                skip2
LB7E0           lda #'!                         ; placeholder for unknown token
LB7E2           bsr LB814                       ; stow output character
                bra LB7CB                       ; go process another input character
LB7E6           ldu #COMVEC-10                  ; point to command interptation table
                cmpa #0xff                      ; is it a function?
                bne LB7F1                       ; brif not
                lda ,x+                         ; get function token
                leau 5,u                        ; shift to the function half of the interpretation tables
LB7F1           anda #0x7f                      ; remove token bias
LB7F3           leau 10,u                       ; move to next command/function table
                tst ,u                          ; is this table active?
                beq LB7E0                       ; brif not - use place holder
                suba ,u                         ; subtract number of tokens handled by this table entry
                bpl LB7F3                       ; brif this token isn't handled here
                adda ,u                         ; undo extra subtraction
                ldu 1,u                         ; get reserved word list for this table
LB801           deca                            ; are we at the right entry?
                bmi LB80A                       ; brif so
LB804           tst ,u+                         ; end of entry?
                bpl LB804                       ; brif not
                bra LB801                       ; see if we're there yet
LB80A           lda ,u                          ; get character from wordlist
                bsr LB814                       ; put character in the buffer
                tst ,u+                         ; end of word?
                bpl LB80A                       ; brif not
                bra LB7CB                       ; go handle another input character
LB814           cmpy #LINBUF+LBUFMX             ; is there room?
                bhs LB820                       ; brif not
                anda #0x7f                      ; lose bit 7
                sta ,y+                         ; save character in output
                clr ,y                          ; make sure there's always a NUL terminator
LB820           rts
; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return
; length in D
LB821           jsr RVEC23                      ; do the RAM hook dance
                ldx CHARAD                      ; get input pointer
                ldu #LINBUF                     ; set destination pointer
LB829           clr V43                         ; clear alpha string flag
                clr V44                         ; clear DATA flag
LB82D           lda ,x+                         ; get input character
                beq LB852                       ; brif end of input
                tst V43                         ; are we handling an alphanumeric string?
                beq LB844                       ; brif not
                jsr LB3A2                       ; set carry if not alpha
                bcc LB852                       ; brif alpha
                cmpa #'0                        ; is it below the digits?
                blo LB842                       ; brif so
                cmpa #'9                        ; is it within the digits?
                bls LB852                       ; brif so
LB842           clr V43                         ; flag that we're past the alphanumeric string
LB844           cmpa #0x20                      ; space?
                beq LB852                       ; brif so - keep it
                sta V42                         ; save scan delimiter
                cmpa #'"                        ; string delimiter?
                beq LB886                       ; brif so - copy until another "
                tst V44                         ; doing "DATA"?
                beq LB86B                       ; brif not
LB852           sta ,u+                         ; put character in output
                beq LB85C                       ; brif end of input
                cmpa #':                        ; colon?
                beq LB829                       ; brif so - reset DATA and alpha string flags
LB85A           bra LB82D                       ; go process another input character
LB85C           clr ,u+                         ; put a double NUL at the end
                clr ,u+
                tfr u,d                         ; calculate length of result (includes double NUL and an extra two bytes)
                subd #LINHDR
                ldx #LINBUF-1                   ; point to one before the output
                stx CHARAD                      ; set input pointer there
                rts
LB86B           cmpa #'?                        ; print abbreviation?
                bne LB873                       ; brif not
                lda #0x87                       ; token for PRINT
                bra LB852                       ; go stash it
LB873           cmpa #''                        ; REM abbreviation?
                bne LB88A                       ; brif not
                ldd #0x3a83                     ; colon plus ' token
                std ,u++                        ; put it in the output
LB87C           clr V42                         ; set delimiter to NUL
LB87E           lda ,x+                         ; get input
                beq LB852                       ; brif end of line
                cmpa V42                        ; at the delimiter?
                beq LB852                       ; brif so
LB886           sta ,u+                         ; save in output
                bra LB87E                       ; keep scanning for delimiter
LB88A           cmpa #'0                        ; is it below digits?
                blo LB892                       ; brif so
                cmpa #';+1                      ; is it digit, colon, or semicolon?
                blo LB852                       ; brif so
LB892           leax -1,x                       ; move input pointer back one (to point at this input character)
                pshs u,x                        ; save input and output pointers
                clr V41                         ; set token type to 0 (command)
                ldu #COMVEC-10                  ; point to command interpretation table
LB89B           clr V42                         ; set token counter to 0 (0x80)
LB89D           leau 10,u                       ; 
                lda ,u                          ; get number of reserved words
                beq LB8D4                       ; brif this table isn't active
                ldy 1,u                         ; point to reserved words list
LB8A6           ldx ,s                          ; get input pointer
LB8A8           ldb ,y+                         ; get character from reserved word table
                subb ,x+                        ; compare with input character
                beq LB8A8                       ; brif exact match
                cmpb #0x80                      ; brif it was the last character in word and exact match
                bne LB8EA                       ; brif not
                leas 2,s                        ; remove original input pointer from stack
                puls u                          ; get back output pointer
                orb V42                         ; create token value (B has 0x80 from above)
                lda V41                         ; get token type
                bne LB8C2                       ; brif function
                cmpb #0x84                      ; is it ELSE?
                bne LB8C6                       ; brif not
                lda #':                         ; silently add a colon before ELSE
LB8C2           std ,u++                        ; put two byte token into output
                bra LB85A                       ; go handle more input
LB8C6           stb ,u+                         ; save single byte token
                cmpb #0x86                      ; DATA?
                bne LB8CE                       ; brif not
                inc V44                         ; set DATA flag
LB8CE           cmpb #0x82                      ; REM?
                beq LB87C                       ; brif so - skip over rest of line
LB8D2           bra LB85A                       ; go handle more input
LB8D4           ldu #COMVEC-5                   ; point to interpretation table, function style
LB8D7           com V41                         ; invert token flag
                bne LB89B                       ; brif we haven't already done functions
                puls x,u                        ; restore input and output pointers
                lda ,x+                         ; copy first character
                sta ,u+
                jsr LB3A2                       ; set C if not alpha
                bcs LB8D2                       ; brif not alpha - it isn't a variable
                com V43                         ; set alphanumeric string flag
                bra LB8D2                       ; process more input
LB8EA           inc V42                         ; bump token number
                deca                            ; checked all in this table?
                beq LB89D                       ; brif so
                leay -1,y                       ; unconsume last compared character
LB8F1           ldb ,y+                         ; end of entry?
                bpl LB8F1                       ; brif not
                bra LB8A6                       ; check next reserved word
; PRINT command
PRINT           beq LB958                       ; brif no argument - do a newline
                bsr LB8FE                       ; process print options
                clr DEVNUM                      ; reset output to screen
                rts
LB8FE           cmpa #'@                        ; is it PRINT @?
                bne LB907                       ; brif not
                jsr LA554                       ; move cursor to correct location
                bra LB911                       ; handle some more
LB907           cmpa #'#                        ; device number specified?
                bne LB918                       ; brif not
                jsr LA5A5                       ; parse device number
                jsr LA406                       ; check for valid output file
LB911           jsr GETCCH                      ; get input character
                beq LB958                       ; brif nothing - do newline
                jsr LB26D                       ; need comma after @ or #
LB918           jsr RVEC9                       ; do the RAM hook boogaloo
LB91B           beq LB965                       ; brif end of input
LB91D           cmpa #0xa4                      ; TAB(?
                beq LB97E                       ; brif so
                cmpa #',                        ; comma (next tab field)?
                beq LB966                       ; brif so
                cmpa #';                        ; semicolon (do not advance print position)
                beq LB997                       ; brif so
                jsr LB156                       ; evaluate expression
                lda VALTYP                      ; get type of value
                pshs a                          ; save it
                bne LB938                       ; brif string
                jsr LBDD9                       ; convert FP number to string
                jsr LB516                       ; parse a string and put on string stack
LB938           bsr LB99F                       ; print string
                puls b                          ; get back variable type
                jsr LA35F                       ; set up print parameters
                tst PRTDEV                      ; is it a display device?
                beq LB949                       ; brif so
                bsr LB958                       ; do a newline
                jsr GETCCH                      ; get input
                bra LB91B                       ; process more print stuff
LB949           tstb                            ; set flags on print position
                bne LB954                       ; brif not at start of line
                jsr GETCCH                      ; get current input
                cmpa #',                        ; comma?
                beq LB966                       ; skip to next tab field if so
                bsr LB9AC                       ; send a space
LB954           jsr GETCCH                      ; get input character
                bne LB91D                       ; brif not end of statement
LB958           lda #0x0d                       ; carriage return
                bra LB9B1                       ; send it to output
LB95C           jsr LA35F                       ; set up print parameters
LB95F           beq LB958                       ; brif width is 0
                lda DEVPOS                      ; get line position
                bne LB958                       ; brif not at start of line
LB965           rts
LB966           jsr LA35F                       ; set up print parameters
                beq LB975                       ; brif line width is 0
                ldb DEVPOS                      ; get line position
                cmpb DEVLCF                     ; at or past last comma field?
                blo LB977                       ; brif so
                bsr LB958                       ; move to next line
                bra LB997                       ; handle more stuff
LB975           ldb DEVPOS                      ; get line position
LB977           subb DEVCFW                     ; subtract a comma field width
                bhs LB977                       ; brif we don't have a remainder yet
                negb                            ; now B is number of of spaces needed
                bra LB98E                       ; go advance
LB97E           jsr LB709                       ; evaluate TAB distance
                cmpa #')                        ; closing )?
                lbne LB277                      ; brif not
                jsr LA35F                       ; set up print parameters
                subb DEVPOS                     ; subtract print position from desired position
                bls LB997                       ; brif we're already past it
LB98E           tst PRTDEV                      ; is it a display device?
                bne LB997                       ; brif not
LB992           bsr LB9AC                       ; output a space
                decb                            ; done enough?
                bne LB992                       ; brif not
LB997           jsr GETNCH                      ; get input character
                jmp LB91B                       ; process more items
; cpoy string from (X-1) to output
LB99C           jsr LB518                       ; parse the string
LB99F           jsr LB657                       ; get string details
LB9A2           incb                            ; compensate for decb
LB9A3           decb                            ; done all of the string?
                beq LB965                       ; brif so
                lda ,x+                         ; get character from string
                bsr LB9B1                       ; send to output
                bra LB9A3                       ; go do another character
LB9AC           lda #0x20                       ; space character
                skip2
LB9AF           lda #'?                         ; question mark character
LB9B1           jmp PUTCHR                      ; output character
; The floating point math package and related functions and operations follow from here
; to the end of the Color Basic ROM area
LB9B4           ldx #LBEC0                      ; point to FP constant 0.5
                bra LB9C2                       ; add 0.5 to FPA0
LB9B9           jsr LBB2F                       ; unpack FP data from (X) to FPA1
; subtraction operator
LB9BC           com FP0SGN                      ; invert sign of FPA0 (subtracting is adding the negative)
                com RESSGN                      ; that also inverts the sign differential
                bra LB9C5                       ; go add the negative of FPA0 to FPA1
LB9C2           jsr LBB2F                       ; unpack FP data from (X) to FPA1
; addition operator
LB9C5           tstb                            ; check exponent of FPA0
                lbeq LBC4A                      ; copy FPA1 to FPA0 if FPA0 is 0
                ldx #FP1EXP                     ; point X to FPA1 (first operand) as the operand to denormalize
LB9CD           tfr a,b                         ; put exponent of FPA1 into B
                tstb                            ; is FPA1 0?
                beq LBA3E                       ; brif exponent is 0 - no-op; adding 0 to FPA0
                subb FP0EXP                     ; get difference in exponents - number of bits to shift the smaller mantissa
                beq LBA3F                       ; brif exponents are equal - no need to denormalize
                blo LB9E2                       ; brif FPA0 > FPA1
                sta FP0EXP                      ; replace result exponent with FPA1's (FPA1 is bigger)
                lda FP1SGN                      ; also copy sign over
                sta FP0SGN
                ldx #FP0EXP                     ; point to FPA0 (we need to denormalize the smaller number)
                negb                            ; invert the difference - this is the number of bits to shift the mantissa
LB9E2           cmpb #-8                        ; do we have to shift by a whole byte?
                ble LBA3F                       ; brif so start by shifting whole bytes to the right
                clra                            ; clear overflow byte
                lsr 1,x                         ; shift high bit of mantissa right (LSR will force a zero into the high bit)
                jsr LBABA                       ; shift remainder of mantissa right -B times
LB9EC           ldb RESSGN                      ; get the sign flag
                bpl LB9FB                       ; brif signs are the same (we add the mantissas then)
                com 1,x                         ; complement the mantissa and extra precision bytes
                com 2,x
                com 3,x
                com 4,x
                coma
                adca #0                         ; add one to A (COM sets C); this may cause a carry to enter the ADD below
LB9FB           sta FPSBYT                      ; save extra precision byte
                lda FPA0+3                      ; add the main mantissa bytes (and propage carry from above)
                adca FPA1+3
                sta FPA0+3
                lda FPA0+2
                adca FPA1+2
                sta FPA0+2
                lda FPA0+1
                adca FPA1+1
                sta FPA0+1
                lda FPA0
                adca FPA1
                sta FPA0
                tstb                            ; were signs the same?
                bpl LBA5C                       ; brif so - number may have gotten bigger so normalize if needed
LBA18           bcs LBA1C                       ; brif we had a carry - result is positive?)
                bsr LBA79                       ; do a proper negation of FPA0 mantissa
LBA1C           clrb                            ; clear temporary exponent accumulator
LBA1D           lda FPA0                        ; test high byte of mantissa
                bne LBA4F                       ; brif not 0 - we need to do bit shifting
                lda FPA0+1                      ; shift left 8 bits
                sta FPA0
                lda FPA0+2
                sta FPA0+1
                lda FPA0+3
                sta FPA0+2
                lda FPSBYT
                sta FPA0+3
                clr FPSBYT
                addb #8                         ; account for 8 bits shifted
                cmpb #5*8                       ; shifted 5 bytes worth?
                blt LBA1D                       ; brif not
LBA39           clra                            ; zero out exponent and sign - result is 0
LBA3A           sta FP0EXP                      ; set exponent and sign
                sta FP0SGN
LBA3E           rts
LBA3F           bsr LBAAE                       ; shift FPA0 mantissa to the right
                clrb                            ; clear carry
                bra LB9EC                       ; get on with adding
LBA44           incb                            ; account for one bit shift
                asl FPSBYT                      ; shift mantissa and extra precision left
                rol FPA0+3
                rol FPA0+2
                rol FPA0+1
                rol FPA0
LBA4F           bpl LBA44                       ; brif we haven't got a 1 in bit 7
                lda FP0EXP                      ; get exponent of result
                pshs b                          ; subtract shift count from exponent
                suba ,s+
                sta FP0EXP                      ; save adjusted exponent
                bls LBA39                       ; brif we underflowed - set result to 0
	skip2
LBA5C           bcs LBA66                       ; brif mantissa overflowed
                asl FPSBYT                      ; get bit 7 of expra precision to C (used for round off)
                lda #0                          ; set to 0 without affecting C
                sta FPSBYT                      ; clear out extra precision bits
                bra LBA72                       ; go round off result
LBA66           inc FP0EXP                      ; bump exponent (for a right shift to bring carry in)
                beq LBA92                       ; brif we overflowed
                ror FPA0                        ; shift carry into mantissa, shift right
                ror FPA0+1
                ror FPA0+2
                ror FPA0+3
LBA72           bcc LBA78                       ; brif no round-off needed
                bsr LBA83                       ; add one to mantissa
                beq LBA66                       ; brif carry - need to shift right again
LBA78           rts
LBA79           com FP0SGN                      ; invert sign of value
LBA7B           com FPA0                        ; first do a one's copmlement
                com FPA0+1
                com FPA0+2
                com FPA0+3
LBA83           ldx FPA0+2                      ; add one to mantissa (after one's complement gives two's complement)
                leax 1,x                        ; bump low word
                stx FPA0+2
                bne LBA91                       ; brif no carry from low word
                ldx FPA0                        ; bump high word
                leax 1,x
                stx FPA0
LBA91           rts
LBA92           ldb #2*5                        ; code for overflow
                jmp LAC46                       ; raise error
LBA97           ldx #FPA2-1                     ; point to FPA2
LBA9A           lda 4,x                         ; shift mantissa right by 8 bits
                sta FPSBYT
                lda 3,x
                sta 4,x
                lda 2,x
                sta 3,x
                lda 1,x
                sta 2,x
                lda FPCARY                      ; and handle extra precision on the left
                sta 1,x
LBAAE           addb #8                         ; account for 8 bits shifted
                ble LBA9A                       ; brif more shifts needed
                lda FPSBYT                      ; get sub byte (extra precision)
                subb #8                         ; undo the 8 added above
                beq LBAC4                       ; brif difference is 0
LBAB8           asr 1,x                         ; shift mantissa and sub byte one bit (keep mantissa high bit set)
LBABA           ror 2,x
                ror 3,x
                ror 4,x
                rora
                incb                            ; account for one shift
                bne LBAB8                       ; brif not enought shifts yet
LBAC4           rts
LBAC5           fcb 0x81,0x00,0x00,0x00,0x00    ; packed FP 1.0
LBACA           bsr LBB2F                       ; unpack FP value from (X) to FPA1
; multiplication operator
LBACC           beq LBB2E                       ; brif exponent of FPA0 is 0 (result is 0)
                bsr LBB48                       ; calculate exponent of product
LBAD0           lda #0                          ; zero out mantissa of FPA2
                sta FPA2
                sta FPA2+1
                sta FPA2+2
                sta FPA2+3
                ldb FPA0+3                      ; multiply FPA1 by LSB of FPA0
                bsr LBB00
                ldb FPSBYT                      ; save extra precision byte
                stb VAE
                ldb FPA0+2
                bsr LBB00                       ; again for next byte of FPA0
                ldb FPSBYT
                stb VAD
                ldb FPA0+1                      ; again for next byte of FPA0
                bsr LBB00
                ldb FPSBYT
                stb VAC
                ldb FPA0                        ; and finally for the high byte
                bsr LBB02
                ldb FPSBYT
                stb VAB
                jsr LBC0B                       ; copy mantissa from FPA2 to FPA0 (result)
                jmp LBA1C                       ; normalize
LBB00           beq LBA97                       ; brif multiplier is 0 - just shift, don't multiply
LBB02           coma                            ; set carry
LBB03           lda FPA2                        ; get FPA2 MS byte
                rorb                            ; data bit to carry; will be 0 when all shifts done
                beq LBB2E                       ; brif 8 shifts done
                bcc LBB20                       ; brif data bit is 0 - no addition
                lda FPA2+3                      ; add mantissa of FPA1 and FPA2
                adda FPA1+3
                sta FPA2+3
                lda FPA2+2
                adca FPA1+2
                sta FPA2+2
                lda FPA2+1
                adca FPA1+1
                sta FPA2+1
                lda FPA2
                adca FPA1
LBB20           rora                            ; shift carry into FPA2
                sta FPA2
                ror FPA2+1
                ror FPA2+2
                ror FPA2+3
                ror FPSBYT
                clra                            ; clear carry
                bra LBB03
LBB2E           rts
; Unpack FP value from (X) to FPA1
LBB2F           ldd 1,x                         ; copy mantissa (and sign)
                sta FP1SGN                      ; save sign bit
                ora #0x80                       ; make sure mantissa has bit 7 set
                std FPA1
                ldb FP1SGN                      ; get sign
                eorb FP0SGN                     ; set if FPA0 sign differs
                stb RESSGN
                ldd 3,x                         ; copy remainder of mantissa
                std FPA1+2
                lda ,x                          ; and exponent
                sta FP1EXP
                ldb FP0EXP                      ; fetch FPA0 exponent and set flags
                rts
; Calculate eponent for product of FPA0 and FPA1
LBB48           tsta                            ; is FPA1 zero?
                beq LBB61                       ; brif so
                adda FP0EXP                     ; add to exponent of FPA0 (this is how scientific notation works)
                rora                            ; set V if we *don't* have an overflow
                rola
                bvc LBB61                       ; brif exponent too larger or small
                adda #0x80                      ; restore the bias
                sta FP0EXP                      ; set result exponent
                beq LBB63                       ; brif 0 - clear FPA0
                lda RESSGN                      ; the result sign (negative if signs differ) is the result sign
                sta FP0SGN                      ; so set it as such
                rts
LBB5C           lda FP0SGN                      ; get sign of FPA0
                coma                            ; invert sign
                bra LBB63                       ; zero sign and exponent
LBB61           leas 2,s                        ; don't go back to caller (mul/div) - return to previous caller
LBB63           lbpl LBA39                      ; brif we underflowed - go zero things out
LBB67           jmp LBA92                       ; raise overflow error
; fast multiply by 10 - leave result in FPA0
LBB6A           jsr LBC5F                       ; copy FPA0 to FPA1 (for addition later)
                beq LBB7C                       ; brif exponent is 0 - it's a no-op then
                adda #2                         ; this gives "times 4"
                bcs LBB67                       ; raise overflow if required
                clr RESSGN                      ; set result sign to "signs the same"
                jsr LB9CD                       ; add FPA1 to FPA0 "times 5"
                inc FP0EXP                      ; times 10
                beq LBB67                       ; brif overflow
LBB7C           rts
LBB7D           fcb 0x84,0x20,0x00,0x00,0x00    ; packed FP constant 10.0
; Divide by 10
LBB82           jsr LBC5F                       ; move FPA0 to FPA1
                ldx #LBB7D                      ; point to constant 10
                clrb                            ; zero sign
LBB89           stb RESSGN                      ; result will be positive or zero
                jsr LBC14                       ; unpack constant 10 to FPA0
                skip2                           ; fall through to division (divide FPA1 by 10)
LBB8F           bsr LBB2F                       ; unpack FP number from (X) to FPA1
; division operator
LBB91           beq LBC06                       ; brif FPA0 is 0 - division by zero
                neg FP0EXP                      ; get exponent of reciprocal of the divisor
                bsr LBB48                       ; calculate exponent of quotient
                inc FP0EXP                      ; bump exponent (due to division algorithm below)
                beq LBB67                       ; brif overflow
                ldx #FPA2                       ; point to temporary storage location
                ldb #4                          ; do 5 bytes
                stb TMPLOC                      ; save counter
                ldb #1                          ; shift counter and quotient byte
LBBA4           lda FPA0                        ; compare mantissa of FPA0 to FPA1, set C if FPA1 less
                cmpa FPA1
                bne LBBBD
                lda FPA0+1
                cmpa FPA1+1
                bne LBBBD
                lda FPA0+2
                cmpa FPA1+2
                bne LBBBD
                lda FPA0+3
                cmpa FPA1+3
                bne LBBBD
                coma                            ; set C if FPA0 = FPA1 (it "goes")
LBBBD           tfr cc,a                        ; save "it goes" status
                rolb                            ; rotate carry into quotient
                bcc LBBCC                       ; brif carry clear - haven't done 8 shifts yet
                stb ,x+                         ; save quotient byte
                dec TMPLOC                      ; done enough bytes?
                bmi LBBFC                       ; brif done all 5
                beq LBBF8                       ; brif last byte
                ldb #1                          ; reset shift counter and quotient byte
LBBCC           tfr a,cc                        ; get back carry status
                bcs LBBDE                       ; brif it "went"
LBBD0           asl FPA1+3                      ; shift mantissa (dividend) left
                rol FPA1+2
                rol FPA1+1
                rol FPA1
                bcs LBBBD                       ; brif carry - it "goes" so we have to bump quotient
                bmi LBBA4                       ; brif high order bit is set - compare mantissas
                bra LBBBD                       ; otherwise, count a 0 bit and try next bit
LBBDE           lda FPA1+3                      ; subtract mantissa of FPA0 from mantissa of FPA1
                suba FPA0+3
                sta FPA1+3
                lda FPA1+2
                sbca FPA0+2
                sta FPA1+2
                lda FPA1+1
                sbca FPA0+1
                sta FPA1+1
                lda FPA1
                sbca FPA0
                sta FPA1
                bra LBBD0                       ; go check for another go
LBBF8           ldb #0x40                       ; only two bits in last byte (for rounding)
                bra LBBCC                       ; go do the last byte
LBBFC           rorb                            ; get low bits to bits 7,6 and C to bit 5
                rorb
                rorb
                stb FPSBYT                      ; save result extra precision
                bsr LBC0B                       ; move FPA2 mantissa to FPA0 (result)
                jmp LBA1C                       ; go normalize the result
LBC06           ldb #2*10                       ; division by zero
                jmp LAC46                       ; raise error
; Copy mantissa of FPA2 to FPA0
LBC0B           ldx FPA2                        ; copy high word
                stx FPA0
                ldx FPA2+2                      ; copy low word
                stx FPA0+2
                rts
; unpack FP number at (X) to FPA0
LBC14           pshs a                          ; save register
                ldd 1,x                         ; get mantissa high word and sign
                sta FP0SGN                      ; set sign
                ora #0x80                       ; make sure mantissa always has bit 7 set
                std FPA0
                clr FPSBYT                      ; clear extra precision
                ldb ,x                          ; get exponent
                ldx 3,x                         ; copy mantissa low word
                stx FPA0+2
                stb FP0EXP                      ; save exponent (and set flags)
                puls a,pc                       ; restore register and return
LBC2A           ldx #V45                        ; point to FPA4
                bra LBC35                       ; pack FPA0 there
LBC2F           ldx #V40                        ; point to FPA3
                skip2                           ; fall through to pack FPA0 there
LBC33           ldx VARDES                      ; get variable descriptor pointer
; Pack FPA0 to (X)
LBC35           lda FP0EXP                      ; get exponent
                sta ,x                          ; save it
                lda FP0SGN                      ; get sign
                ora #0x7f                       ; force set low bits - only keep sign in high bit
                anda FPA0                       ; merge in bits 6-0 of high byte of mantissa
                sta 1,x                         ; save it
                lda FPA0+1                      ; copy next highest byte
                sta 2,x
                ldu FPA0+2                      ; and the low word of the mantissa
                stu 3,x
                rts
; Copy FPA1 to FPA0; return with sign in A
LBC4A           lda FP1SGN                      ; copy sign
LBC4C           sta FP0SGN
                ldx FP1EXP                      ; copy exponent, mantissa high byte
                stx FP0EXP
                clr FPSBYT                      ; clear extra precision
                lda FPA1+1                      ; copy mantissa second highest byte
                sta FPA0+1
                lda FP0SGN                      ; set sign for return
                ldx FPA1+2                      ; copy low word of mantissa
                stx FPA0+2
                rts
; Copy FPA0 to FPA1
LBC5F           ldd FP0EXP                      ; copy exponent and high byte of mantissa
                std FP1EXP
                ldx FPA0+1                      ; copy middle bytes of mantissa
                stx FPA1+1
                ldx FPA0+3                      ; copy low byte of mantissa and sign
                stx FPA1+3
                tsta                            ; set flags on exponent
                rts
; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive
LBC6D           ldb FP0EXP                      ; get exponent
                beq LBC79                       ; brif 0
LBC71           ldb FP0SGN                      ; get sign
LBC73           rolb                            ; get sign to C
                ldb #0xff                       ; set for negative result
                bcs LBC79                       ; brif negative
                negb                            ; set to 1 for positive
LBC79           rts
; SGN function
SGN             bsr LBC6D                       ; get sign of FPA0
LBC7C           stb FPA0                        ; save result
                clr FPA0+1                      ; clear next lower 8 bits
                ldb #0x88                       ; exponent if mantissa is 8 bit integer
LBC82           lda FPA0                        ; get high bits of mantissa
                suba #0x80                      ; set C if mantissa was positive (will cause a negation if it was negative)
LBC86           stb FP0EXP                      ; set exponent
                ldd ZERO                        ; clear out low word
                std FPA0+2
                sta FPSBYT                      ; clear extra precision
                sta FP0SGN                      ; set sign to positive
                jmp LBA18                       ; normalize the result
; ABS function
ABS             clr FP0SGN                      ; force FPA0 to be positive (yes, it's that simple)
                rts
; Compare packed FP number at (X) to FPA0
; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that
LBC96           ldb ,x                          ; get exponent of (X)
                beq LBC6D                       ; brif (X) is 0
                ldb 1,x                         ; get MS byte of mantissa of (X)
                eorb FP0SGN                     ; set bit 7 if signs of (X) and FPA0 differ
                bmi LBC71                       ; brif signs differ - no need to compare the magnitude
LBCA0           ldb FP0EXP                      ; compare exponents and brif different
                cmpb ,x
                bne LBCC3
                ldb 1,x                         ; compare mantissa (but we have to pack the FPA0 bits first
                orb #0x7f                       ; keep only sign bit (note: signs are the same)
                andb FPA0                       ; merge in the mantissa bits from FPA0
                cmpb 1,x                        ; do the packed versions match?
                bne LBCC3                       ; brif not
                ldb FPA0+1                      ; compare second byte of mantissas
                cmpb 2,x
                bne LBCC3
                ldb FPA0+2                      ; compare third byte of mantissas
                cmpb 3,x
                bne LBCC3
                ldb FPA0+3                      ; compare low byte of mantissas, but use subtraction so B = 0 on match
                subb 4,x
                bne LBCC3
                rts                             ; return B = 0 if (X) = FPA0
LBCC3           rorb                            ; shift carry to bit 7 (C set if FPA0 < (X))
                eorb FP0SGN                     ; invert the comparision sense if the signs are negative
                bra LBC73                       ; interpret comparison result
; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the
; result as a two's complement value.
LBCC8           ldb FP0EXP                      ; get exponent of FPA0
                beq LBD09                       ; brif FPA0 is zero - we don't have to do anything, just blank it
                subb #0xa0                      ; calculate number of shifts to get to the correct exponent (binary point to the right)
                lda FP0SGN                      ; do we have a positive number?
                bpl LBCD7                       ; brif so
                com FPCARY                      ; negate the mantissa and set extra inbound precision to the correct sign
                jsr LBA7B
LBCD7           ldx #FP0EXP                     ; point to FPA0
                cmpb #-8                        ; moving by whole bytes?
                bgt LBCE4                       ; brif not
                jsr LBAAE                       ; do bit shifting
                clr FPCARY                      ; clear carry in byte
                rts
LBCE4           clr FPCARY                      ; clear the extra carry in precision
                lda FP0SGN                      ; get sign of value
                rola                            ; get sign to carry (so rotate repeats the sign)
                ror FPA0                        ; shift the first bit
                jmp LBABA                       ; do the shifting dance
; INT function
INT             ldb FP0EXP                      ; get exponent
                cmpb #0xa0                      ; is the number big enough that there can be no fractional part?
                bhs LBD11                       ; brif so - we don't have to do anything
                bsr LBCC8                       ; go shift binary point to the right of the mantissa
                stb FPSBYT                      ; save extra precision bits
                lda FP0SGN                      ; get original sign
                stb FP0SGN                      ; force result to be positive
                suba #0x80                      ; set C if we had a positive result
                lda #0xa0                       ; set exponent to match denormalized result
                sta FP0EXP
                lda FPA0+3                      ; save low byte
                sta CHARAC
                jmp LBA18                       ; go normalize (this will correct for the two's complement representation of negatives)
LBD09           stb FPA0                        ; replace mantissa of FPA0 with contents of B
                stb FPA0+1
                stb FPA0+2
                stb FPA0+3
LBD11           rts
; Convert ASCII string to FP
; BUG: no overflow is checked on the decimal exponent in exponential notation.
LBD12           ldx ZERO                        ; zero out FPA0 and temporaries
                stx FP0SGN
                stx FP0EXP
                stx FPA0+1
                stx FPA0+2
                stx V47
                stx V45
                bcs LBD86                       ; brif input character is numeric
                jsr RVEC19                      ; do the RAM hook dance
                cmpa #'-                        ; regular negative sign
                bne LBD2D                       ; brif not
                com COEFCT                      ; invert sign
                bra LBD31                       ; process stuff after the sign
LBD2D           cmpa #'+                        ; regular plus?
                bne LBD35                       ; brif not
LBD31           jsr GETNCH                      ; get character after sign
                bcs LBD86                       ; brif numeric
LBD35           cmpa #'.                        ; decimal point?
                beq LBD61                       ; brif so
                cmpa #'E                        ; scientific notation
                bne LBD65                       ; brif not
                jsr GETNCH                      ; eat the "E"
                bcs LBDA5                       ; brif numeric
                cmpa #0xac                      ; negative sign (token)?
                beq LBD53                       ; brif so
                cmpa #'-                        ; regular negative?
                beq LBD53                       ; brif so
                cmpa #0xab                      ; plus sign (token)?
                beq LBD55                       ; brif so
                cmpa #'+                        ; regular plus?
                beq LBD55
                bra LBD59                       ; brif no sign found
LBD53           com V48                         ; set exponent sign to negative
LBD55           jsr GETNCH                      ; eat the sign
                bcs LBDA5                       ; brif numeric
LBD59           tst V48                         ; is the exponent sign negatvie?
                beq LBD65                       ; brif not
                neg V47                         ; negate base 10 exponent
                bra LBD65
LBD61           com V46                         ; toggle decimal point flag
                bne LBD31                       ; brif we haven't seen two decimal points
LBD65           lda V47                         ; get base 10 exponent
                suba V45                        ; subtract number of places to the right
                sta V47                         ; we now have a complete decimal exponent
                beq LBD7F                       ; brif we have no base 10 shifting required
                bpl LBD78                       ; brif positive exponent
LBD6F           jsr LBB82                       ; divide FPA0 by 10 (shift decimal point left)
                inc V47                         ; bump exponent
                bne LBD6F                       ; brif we haven't reached 0 yet
                bra LBD7F                       ; return result
LBD78           jsr LBB6A                       ; multiply by 10
                dec V47                         ; downshift the exponent
                bne LBD78                       ; brif not at 0 yet
LBD7F           lda COEFCT                      ; get desired sign
                bpl LBD11                       ; brif it will be positive - no need to do anything
                jmp LBEE9                       ; flip the sign of FPA0
LBD86           ldb V45                         ; get the decimal count
                subb V46                        ; (if decimal seen, will add one; otherwise it does nothing)
                stb V45
                pshs a                          ; save new digit
                jsr LBB6A                       ; multiply partial result by 10
                puls b                          ; get back digit
                subb #'0                        ; remove ASCII bias
                bsr LBD99                       ; add B to FPA0
                bra LBD31                       ; go process another digit
LBD99           jsr LBC2F                       ; save FPA0 to FPA3
                jsr LBC7C                       ; convert B to FP number
                ldx #V40                        ; point to FPA3
                jmp LB9C2                       ; add FPA3 and FPA0
LBDA5           ldb V47                         ; get exponent value
                aslb                            ; times 2
                aslb                            ; times 4
                addb V47                        ; times 5
                aslb                            ; times 10
                suba #'0                        ; remove ASCII bias
                pshs b                          ; save acculated result
                adda ,s+                        ; add new digit to accumulated result
                sta V47                         ; save new accumulated decimal exponent
                bra LBD55                       ; interpret another exponent character
LBDB6           fcb 0x9b,0x3e,0xbc,0x1f,0xfd    ; packed FP: 99999999.9
LBDBB           fcb 0x9e,0x6e,0x6b,0x27,0xfd    ; packed FP: 999999999
LBDC0           fcb 0x9e,0x6e,0x6b,0x28,0x00    ; pakced FP: 1E9
LBDC5           ldx #LABE8-1                    ; point to "IN" message
                bsr LBDD6                       ; output the string
                ldd CURLIN                      ; get basic line number
LBDCC           std FPA0                        ; save 16 bit unsigned integer
                ldb #0x90                       ; exponent for upper 16 bits of FPA0 to be an integer
                coma                            ; set C (force normalization to treat as positive)
                jsr LBC86                       ; zero bottom half, save exponent, and normalize
                bsr LBDD9                       ; convert FP number to ASCII string
LBDD6           jmp LB99C                       ; output string
; Convert FP number to ASCII string
LBDD9           ldu #STRBUF+3                   ; point to buffer address that will not cause string to go to string space
LBDDC           lda #0x20                       ; default sign is a space character
                ldb FP0SGN                      ; get sign of value
                bpl LBDE4                       ; brif positive
                lda #'-                         ; use negative sign
LBDE4           sta ,u+                         ; save sign
                stu COEFPT                      ; save output buffer pointer
                sta FP0SGN                      ; save sign character
                lda #'0                         ; result is 0 if exponent is 0
                ldb FP0EXP                      ; get exponent
                lbeq LBEB8                      ; brif FPA0 is 0
                clra                            ; base 10 exponent is 0 for > 1
                cmpb #0x80                      ; is number > 1?
                bhi LBDFF                       ; brif so
                ldx #LBDC0                      ; point to 1E+09
                jsr LBACA                       ; shift decimal to the right by 9 spaces
                lda #-9                         ; account for shift
LBDFF           sta V45                         ; save base 10 exponent
LBE01           ldx #LBDBB                      ; point to 999999999
                jsr LBCA0                       ; are we above that?
                bgt LBE18                       ; brif so
LBE09           ldx #LBDB6                      ; point to 99999999.9
                jsr LBCA0                       ; are we above that?
                bgt LBE1F                       ; brif in range
                jsr LBB6A                       ; multiply by 10 (we were small)
                dec V45                         ; account for shift
                bra LBE09                       ; see if we've come into range
LBE18           jsr LBB82                       ; divide by 10
                inc V45                         ; account for shift
                bra LBE01                       ; see if we've come into range
LBE1F           jsr LB9B4                       ; add 0.5 to FPA0 (rounding)
                jsr LBCC8                       ; do the integer dance
                ldb #1                          ; default decimal flag (force immediate decimal)
                lda V45                         ; get base 10 exponent
                adda #10                        ; account for "unormalized" number
                bmi LBE36                       ; brif number < 1.0
                cmpa #11                        ; do we have more than 9 places?
                bhs LBE36                       ; brif so - do scientific notation
                deca
                tfr a,b
                lda #2                          ; force no scientific notation
LBE36           deca                            ; subtract wo without affecting carry
                deca
                sta V47                         ; save exponent - 0 is do not display in scientific notation
                stb V45                         ; save number of places to left of decimal
                bgt LBE4B                       ; brif >= 1
                ldu COEFPT                      ; point to string buffer
                lda #'.                         ; put decimal
                sta ,u+
                tstb                            ; is there anything to left of decimal?
                beq LBE4B                       ; brif not
                lda #'0                         ; store a zero
                sta ,u+
LBE4B           ldx #LBEC5                      ; point to powers of 10
                ldb #0x80                       ; set digit counter to 0x80
LBE50           lda FPA0+3                      ; add mantissa to power of 10
                adda 3,x
                sta FPA0+3
                lda FPA0+2
                adca 2,x
                sta FPA0+2
                lda FPA0+1
                adca 1,x
                sta FPA0+1
                lda FPA0
                adca ,x
                sta FPA0
                incb                            ; add one to digit counter
                rorb                            ; put carry into bit 7
                rolb                            ; set V if carry and sign differ
                bvc LBE50                       ; brif positive mantissa or carry is 0 and negative mantissa
                bcc LBE72                       ; brif negative mantissa
                subb #10+1                      ; take 9's complement if adding mantissa
                negb
LBE72           addb #'0-1                      ; add ASCII bias
                leax 4,x                        ; move to next power of 10
                tfr b,a                         ; save digit
                anda #0x7f                      ; remove add/subtract flag
                sta ,u+                         ; put in output
                dec V45                         ; do we need a decimal yet?
                bne LBE84                       ; brif not
                lda #'.                         ; put decimal
                sta ,u+
LBE84           comb                            ; toggle bit 7 (add/sub flag)
                andb #0x80                      ; only keep bit 7
                cmpx #LBEC5+9*4                 ; done all places?
                bne LBE50                       ; brif not
LBE8C           lda ,-u                         ; get last character
                cmpa #'0                        ; was it 0?
                beq LBE8C                       ; brif so
                cmpa #'.                        ; decimal?
                bne LBE98                       ; brif not
                leau -1,u                       ; move past decimal if it isn't needed
LBE98           lda #'+                         ; plus sign
                ldb V47                         ; get scientific notation exponent
                beq LBEBA                       ; brif not scientific notation
                bpl LBEA3                       ; brif positive exponent
                lda #'-                         ; negative sign for base 10 exponent
                negb                            ; switch to positive exponent
LBEA3           sta 2,u                         ; put sign
                lda #'E                         ; put "E"
                sta 1,u
                lda #'0-1                       ; init to ASCII 0 (compensate for INC)
LBEAB           inca                            ; bump digit
                subb #10                        ; have we hit the correct one yet?
                bcc LBEAB                       ; brif not
                addb #'9+1                      ; convert units digit to ASCII
                std 3,u                         ; put exponent in output
                clr 5,u                         ; put trailing NUL
                bra LBEBC                       ; go reset pointer
LBEB8           sta ,u                          ; store last character
LBEBA           clr 1,u                         ; put NUL at the end
LBEBC           ldx #STRBUF+3                   ; point to start of string
                rts
LBEC0           fcb 0x80,0x00,0x00,0x00,0x00    ; packed FP 0.5
LBEC5           fqb -100000000
                fqb 10000000
                fqb -1000000
                fqb 100000
                fqb -10000
                fqb 1000
                fqb -100
                fqb 10
                fqb -1
LBEE9           lda FP0EXP                      ; get exponent of FPA0
                beq LBEEF                       ; brif 0 - don't flip sign
                com FP0SGN                      ; flip sign
LBEEF           rts
; Expand a polynomial of the form
; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table
LBEF0           stx COEFPT                      ; save coefficient table pointer
                jsr LBC2F                       ; copy FPA0 to FPA3
                bsr LBEFC                       ; multiply FPA3 by FPA0
                bsr LBF01                       ; expand polynomial
                ldx #V40                        ; point to FPA3
LBEFC           jmp LBACA                       ; multiply FPA0 by FPA3
LBEFF           stx COEFPT                      ; save coefficient table counter
LBF01           jsr LBC2A                       ; move FPA0 to FPA4
                ldx COEFPT                      ; get the current coefficient
                ldb ,x+                         ; get the number of entries
                stb COEFCT                      ; save as counter
                stx COEFPT                      ; save new pointer
LBF0C           bsr LBEFC                       ; multiply (X) and FPA0
                ldx COEFPT                      ; get this coefficient
                leax 5,x                        ; move to next one
                stx COEFPT                      ; save new pointer
                jsr LB9C2                       ; add (X) to FPA0
                ldx #V45                        ; point X to FPA4
                dec COEFCT                      ; done all coefficients?
                bne LBF0C                       ; brif more left
                rts
; RND function
RND             jsr LBC6D                       ; set flags on FPA0
                bmi LBF45                       ; brif negative - set seed
                beq LBF3B                       ; brif 0 - do random between 0 and 1
                bsr LBF38                       ; convert to integer
                jsr LBC2F                       ; save range value
                bsr LBF3B                       ; get random number
                ldx #V40                        ; point to FPA3
                bsr LBEFC                       ; multply (X) by FPA0
                ldx #LBAC5                      ; point to FP 1.0
                jsr LB9C2                       ; add 1 to FPA0
LBF38           jmp INT                         ; return integer value
LBF3B           ldx RVSEED+1                    ; move variable random number seed to FPA0
                stx FPA0
                ldx RVSEED+3
                stx FPA0+2
LBF45           ldx RSEED                       ; move fixed seed to FPA1
                stx FPA1
                ldx RSEED+2
                stx FPA1+2
                jsr LBAD0                       ; multiply them
                ldd VAD                         ; get lowest order  product bytes
                addd #0x658b                    ; add a constant
                std RVSEED+3                    ; save it as new seed
                std FPA0+2                      ; save in result
                ldd VAB                         ; get high order extra product bytes
                adcb #0xb0                      ; add upper bytes of constant
                adca #5
                std RVSEED+1                    ; save as new seed
                std FPA0                        ; save as result
                clr FP0SGN                      ; set result to positive
                lda #0x80                       ; set exponent to 0 < FPA0 < 1
                sta FP0EXP
                lda FPA2+2                      ; get a byte from FPA2
                sta FPSBYT                      ; save as extra precision
                jmp LBA1C                       ; go normalize FPA0
RSEED           fqb 0x40e64dab                  ; constant random number generator seed
; SIN function
SIN             jsr LBC5F                       ; copy FPA0 to FPA1
                ldx #LBFBD                      ; point to 2*pi
                ldb FP1SGN                      ; get sign of FPA1
                jsr LBB89                       ; divide FPA0 by 2*pi
                jsr LBC5F                       ; copy FPA0 to FPA1
                bsr LBF38                       ; convert FPA0 to an integer
                clr RESSGN                      ; set result to positive
                lda FP1EXP                      ; get exponent of FPA1
                ldb FP0EXP                      ; get exponent of FPA0
                jsr LB9BC                       ; subtract FPA0 from FPA1
                ldx #LBFC2                      ; point to FP 0.25
                jsr LB9B9                       ; subtract FPA0 from 0.25 (pi/2)
                lda FP0SGN                      ; get result sign
                pshs a                          ; save it
                bpl LBFA6                       ; brif positive
                jsr LB9B4                       ; add 0.5 (pi) to FPA0
                lda FP0SGN                      ; get sign of result
                bmi LBFA9                       ; brif negative
                com RELFLG                      ; if 3pi/2 >= arg >= pi/2
LBFA6           jsr LBEE9                       ; flip sign of FPA0
LBFA9           ldx #LBFC2                      ; point to 0.25
                jsr LB9C2                       ; add 0.25 (pi/2) to FPA0
                puls a                          ; get original sign
                tsta                            ; was it positive
                bpl LBFB7                       ; brif so
                jsr LBEE9                       ; flip result sign
LBFB7           ldx #LBFC7                      ; point to series coefficients
                jmp LBEF0                       ; go calculate value
LBFBD           fcb 0x83,0x49,0x0f,0xda,0xa2    ; 2*pi
LBFC2           fcb 0x7f,0x00,0x00,0x00,0x00    ; 0.25
; modified taylor series SIN coefficients
LBFC7           fcb 6-1                         ; six coefficients
                fcb 0x84,0xe6,0x1a,0x2d,0x1b    ; -((2pi)^11)/11!
                fcb 0x86,0x28,0x07,0xfb,0xf8    ; ((2pi)^9)/9!
                fcb 0x87,0x99,0x68,0x89,0x01    ; -((2pi)^7)/7!
                fcb 0x87,0x23,0x35,0xdf,0xe1    ; ((2pi)^5)/5!
                fcb 0x86,0xa5,0x5d,0xe7,0x28    ; -(2pi)^3)/3!
                fcb 0x83,0x49,0x0f,0xda,0xa2    ; 2*pi
; these 12 bytes are unused
                fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43
                fcb 0x89,0xcd,0xa6,0x81
; these are the hardware interrupt vectors (coco1/2 only)
                fdb SW3VEC
                fdb SW2VEC
                fdb FRQVEC
                fdb IRQVEC
                fdb SWIVEC
                fdb NMIVEC
                fdb RESVEC