view src/interp.s @ 132:917b4893bb3d

Checkpoint before redoing a bunch of code for clarity
author William Astle <lost@l-w.ca>
date Mon, 24 Jun 2024 23:44:39 -0600
parents 95f174bf459b
children e49bd0493baf
line wrap: on
line source

                *pragmapush list
                *pragma list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Fetch next input character, skip spaces. This is structured the way it is to avoid burning any register except A
; which is used for the returned value. Z will be set if the input character is NUL or a colon. C will be set if the
; input character is an ASCII digit. This allows testing Z to identify the end of a command due to either a colon or
; the end of a line.
;
; Compared to Color Basic, the instruction sequence only varies in the handling of the LDA. In Color Basic, the sequence
; is an LDA extended followed by a JMP extended. This totals to 9 cycles (5 for LDA, 4 for JMP). In LWBasic, an LDA
; with extended indirect addressing is used. This also totals 9 cycles. The only other difference is when a space is
; detected where the branch can be direct to the nextchar code instead of having to branch around a direct page JUMP
; which saves 3 cycles for the case where a space is detected. In other words, this is only slower by virtue of the
; fact that it is called with an extended JSR instead of a direct JSR which causes one extra cycle to be used there
; and one extra byte for each call to nextchar or curchar.
;
; On 6309, native move saves an extra cycle in the LDA sequence using the LDA extended followed by JMP extended
; sequence.
;
; This whole thing could be sped up by keeping the input pointer in a register. However, retaining the ability to
; use Y without having to save it first is likely more beneficial.
nextchar        inc inputptr+1                  ; bump LSB of input pointer
                bne curchar                     ; brif no carry
                inc inputptr                    ; bump MSB
curchar         lda [inputptr]                  ; read the byte
                cmpa #'9+1                      ; clear C if above ASCII digits, Z if colon
                bhs curchar0                    ; brif above the ASCII digits
                cmpa #0x20                      ; is it a space?
                beq nextchar                    ; brif so - skip over it
                suba #'0                        ; clever way to set C if >= ASCII 0, Z if zero
                suba #-'0
curchar0        rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This is exactly the same as nextchar except it doesn't skip spaces. Unfortunately, for efficiency purposes, we need
; to actually duplicate code here.
nextcharraw     inc inputptr+1                  ; bump LSB of input pointer
                bne curchar                     ; brif no carry
                inc inputptr                    ; bump MSB
curcharraw      lda [inputptr]                  ; fetch the byte
                cmpa #'9+1                      ; clear C if above digits, set Z if colon
                bhs curcharraw0                 ; brif above digits
                suba #'0                        ; clever way to set C if >= ASCII 0, Z if zero
                suba #-'0
curcharraw0     rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Set carry if upper/lower case alpha
setcifalpha     cmpa #'z+1                      ; is it above lower case Z?
                bhs setcifalpha0                ; brif so, C clear
                suba #'a                        ; set C if >= lower case A
                suba #-'a
                bcs setcifalpha0                ; brif lower case alpha
setcifualpha    cmpa #'Z+1                      ; is it above upper case Z?
                bhs setcifalpha0                ; brif so, C clear
                suba #'A                        ; set C if >= upper case A
                suba #-'A
setcifalpha0    rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Set carry if digit
setcifdigit     cmpa #'9+1                      ; is it above digit 9?
                bhs setcifdigit0                ; brif so, C clear
                suba #'0                        ; set C if >= digit 0
                suba #-'0
setcifdigit0    rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Immediate mode handler
immediatee      jsr ERRORstr                    ; get error string
                jsr writestrconduc              ; display it
                ldx #atmsg                      ; output " at "
                jsr writestrconduc
                leax ,u                         ; point to error location
                jsr console_outstr              ; display remaining line part (but preserve case this time)
immediate       jsr writecondnl                 ; do newline if required
                ldx #prompt                     ; point to prompt string
                jsr console_outstrn
immediate0      jsr readline                    ; read input line
                bcs immediate0                  ; brif ended with BREAK
                ldx #linebuff                   ; point to start of line input buffer
immediate0a     lda ,x                          ; do we have anything at all?
                beq immediate0                  ; brif not - just read another line
                cmpa #0x20                      ; space?
                bne immediate0c                 ; brif not
immediate0b     leax 1,x                        ; move past the space
                bra immediate0a                 ; keep looking for the start of input
immediate0c     bsr setcifdigit                 ; do we have a line number?
                bcs immediate1                  ; brif so - go handle program editing
                clrb                            ; flag to do actual parsing
                jsr parse                       ; go parse the line
                bcs immediatee                  ; brif there was a parse error
                bra *
                jsr interpretline               ; go interpret the tokenized line
                bra immediate                   ; go handle another line
immediate1      bsr parse_lineno                ; parse the line number
                jsr prog_remove                 ; remove the line from the program if it exists
immediate3      jsr curchar                     ; skip any spaces after line number
                tsta                            ; is it the end of input (don't test for colon)
                beq immediate6                  ; brif so - we don't need to insert a line
                ldx inputptr                    ; point to line text
                jsr parse                       ; tokenize line, get length to D
                ldy binval                      ; get the line number
                jsr prog_insert                 ; insert the encoded line at X into program as line Y
immediate6      ldx vartab                      ; clear out variables
                stx objecttab
                stx freestart
                bra immediate0                  ; go handle more input
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Find line number table entry
;
; Entry:
; D: the desired line number
;
; Exit:
; U: pointer to line number table entry
; CC.C: clear
;
; Error:
; CC.C: set
;
; This works by doing a binary search through the line number table.
prog_findline   ldu prog_linetab                ; point to program line table
                ldx prog_linetabp               ; get end of table
                leax -prog_lineentl,u           ; move back to the start of the last entry
                pshs x,u                        ; save "high" at 0,s and "low" at 2,s
                tfr d,x                         ; save line number for later comparisons
prog_findline1  ldd ,s                          ; get high pointer
                subd 2,s                        ; get different with low pointer
                bcs prog_findline2              ; brif high is below low - we didn't find it
                lsra                            ; find half way
                rorb
                andb #0b11111100                ; round down for 4 bytes per entry
                addd prog_linetab               ; offset into line table
                tfr d,u                         ; move to a pointer
                cmpx linetabent_num,u           ; is the desired number less, equal, or greater?
                beq prog_findline2              ; brif match
                blo prog_findline3              ; brif desired line is lower
                leau prog_lineentl,u            ; skip past this non-matching item
                stu 2,s                         ; save new low pointer
                bra prog_findline1              ; go do another iteration
prog_findline2  leas 4,s                        ; clean up the temporaries (C clear from compare above)
                rts
prog_findline3  leau -prog_lineentl,u           ; move before this non-matching entry
                stu ,s                          ; save new top entry pointer
                bra prog_findline1              ; go do another iteration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Delete a line from the program:
;
; Entry:
; D: the line number to delete
;
; This routine removes a line from the program. This works by deallocating the line data and moving all subsequent
; line data forward to close the gap. The line table pointer will also be removed and the subsequent line table
; entries will also be brought forward to fill the gap. While closing the gap in the line table, the line data
; pointers will be adjusted to account for the relocation of the line data following the deleted line. The line number
; table size allocation will not be adjusted.
prog_delline    bsr prog_findline               ; get a pointer to the desired line table entry
                bcs prog_delline3               ; brif the line wasn't in the program - we have nothing to do
                ldd linetabent_size+linetabent_ptr,u ; get pointer to next line data
                subd linetabent_ptr,u           ; now D is the length of the line data to collapse out
                pshs d                          ; save the calculated length - we need it for later
                ldy linetabent_ptr,u            ; get pointer to the line data to delete
                leax d,y                        ; point to data to move
                bra prog_delline1               ; go handle the loop, including the case where we copy nothing
prog_delline0   lda ,x+                         ; copy a byte down
                sta ,y+
prog_delline1   cmpx vartab                     ; at the end of the program?
                blo prog_delline0               ; brif not
                sty vartab                      ; save new variable table location
prog_delline2   ldx linetabent_size+linetabent_num,u ; get number of next line
                ldd linetabent_size+linetabent_ptr,u ; get pointer for next line
                subd ,s                         ; adjust for length removed in the line data
                std ,u++                        ; save in the vacated entry
                stx ,u++
                cmpu prog_linetabp              ; at the end of allocated table entries?
                blo prog_delline2               ; brif not
                leau -linetabent_size,u         ; move back to the last actual entry
                stu prog_linetabp               ; update the line table pointer
                leas 2,s                        ; clear out the temp we no longer need
                jsr cmd_newvars                 ; clear the variables out
prog_delline3   rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; prog_shrinklt: shrink the line table to its minimum possible size, but keep it a multiple of linetab_stride entries
prog_shrinklt   ldd prog_linetabp               ; get the end of the table entries
                subd prog_linetab               ; now we have the length of the table
                andb #(linetabent_size*linetab_stride)-1 ; is there a remainder?
                beq prog_shrinklt0              ; brif not
                addd #linetabent_size*linetab_strider
prog_shrinklt0  tfr d,u                         ; put in a pointer register
                leau linetabent_size,x          ; move to the end of the phantom entry
                cmpu prog_text                  ; anything to do?
                beq prog_shrinklt2              ; brif not
                ldx prog_text                   ; point to source copy point
prog_shrinklt1  lda ,x+                         ; copy a byte down
                sta ,u+
                cmpx vartab                     ; end of program?
                blo prog_shrinklt1              ; brif not
                stu vartab                      ; save new end of program
                jmp cmd_newvars                 ; clear variables
prog_shrinklt2  rts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Insert a line into the program
;
; Entry:
; D: length of line to insert
; X: pointer to line data to insert
; U: the line number we're adding
prog_addline    pshs d,x,u                      ; save length and pointer
                ldx prog_linetabp               ; get line table pointer
                leax linetabent_size,x          ; add in space for new entry
                cmpx prog_text                  ; did we run into the program?
                blo prog_addline0               ; brif not
                addd #linetabent_size*linetab_stride ; add in space for expanded line table
prog_addline0   addd vartab                     ; calculate the new end of program data
                jsr checkmem_addr               ; verify there is enough memory
                cmpx prog_text                  ; do we need to expand the line number table?
                blo prog_addline3               ; brif not
                ldx vartab                      ; point to byte past end of program
                leau linetab_stride*linetabent_size,x ; set up destination pointer
                stu vartab                      ; set up new end of program text
prog_addline1   lda ,-x                         ; copy a byte up
                sta ,-u
                cmpx prog_text                  ; did we hit the start of the program?
                bne prog_addline1               ; brif not
                ldx prog_linetab                ; point to start of line table
prog_addline2   ldd linetabent_ptr,x            ; get pointer to this line
                addd #linetab_stride*linetabent_size ; adjust offset for the expanded table
                std linetabent_ptr,x
                leax linetabent_size,x          ; move to next entry
                cmpx prog_linetabp              ; at end of table?
                bls prog_addline2               ; brif we're at the end of the table
prog_addline3   ldx prog_linetabp               ; repoint to first "free" table entry
                ldd linetabent_ptr,x            ; get pointer for the end of the program
                std linetabent_ptr+linetabent_size,x ; move it a slot forward
                ldd 4,s                         ; get desired line number
                std linetabent_num,x            ; put line number in
                bra prog_addline5               ; brif so - this is where we add it
prog_linetab4   cmpd -linetabent_size+linetabent_num,x ; is our line number less than previous entry?
                bhs prog_addline6               ; brif not - we're at the right place
                leax -linetabent_size,x         ; move back an entry
                ldu linetabent_num,x            ; move line number to next entry
                stu linetabent_num+linetabent_size,x
                ldu linetabent_ptr,x            ; and move the pointer
                stu linetabent_ptr+linetabent_size,x
prog_linetab5   cmpx prog_linetab               ; at the start of the table?
                bhi prog_addline4               ; brif not
prog_linetab6   ldu vartab                      ; point to end of program data
                ldd ,s                          ; get length of line
                leay d,u                        ; Y points to the destination of the move
                sty vartab                      ; save new end of program text
                bra prog_linetab8               ; jump into loop in case nothing to copy
prog_linetab7   lda ,-u                         ; copy a byte up
                sta ,-y
prog_linetab8   cmpu linetabent_ptr,x           ; finished the copy?
                bne prog_linetab7               ; brif not
prog_linetab9   leax linetabent_size,x          ; move to next entry
                ldd linetabent_ptr,x            ; adjust the pointer for the newly inserted line
                addd ,s
                std linetabent_ptr,x
                cmpx prog_linetabp              ; run through the whole table?
                blo prog_linetab9               ; brif not
                puls y                          ; get copy length to counter
                puls x                          ; get pointer to line data
prog_linetab10  lda ,x+                         ; copy a byte into the program data
                sta ,u+
                leay -1,y                       ; done all of it?
                bne prog_linetab10              ; brif not
                leas 2,s                        ; lose line number
                jmp cmd_newvar                  ; erase variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Parse a line number and return it in binval; raise syntax error if the line number overflows 16 bits unsigned.
; Preserves; registers except D. This will accept the entire 16 bit unsigned number range which is why there is
; a BCS after every shift or add. Enter with the input pointer pointing to the number to parse.
parse_lineno    ldd zero                        ; clear out accumlator but preserve carry flag
                std binval
                jsr curchar                     ; set flags on current character; skip spaces
                bcc parse_lineno1               ; brif first character wasn't a digit - default to zero
parse_lineno0   suba #0x30                      ; adjust to binary digit
                pshs a                          ; save digit so we can add it later
                ldd binval                      ; get accumulated number
                lslb                            ; multiply accumulator by 10
                rola                            ; times 2
                bcs SNERROR                     ; brif overflow
                lslb
                rola                            ; times 4
                bcs SNERROR                     ; brif overflow
                addd binval                     ; times 5 (add orignal value to times 4)
                bcs SNERROR                     ; brif overflow
                lslb
                rola                            ; times 10
                bcs SNERROR                     ; brif overflow
                addb ,s+                        ; add in accumulated digit
                adca #0
                bcs SNERROR                     ; brif overflow
                std binval                      ; save accumulated number
                jsr nextcharraw                 ; get next input character; DO NOT skip spaces
                bcs parse_lineno0               ; brif it's also a digit
parse_lineno1   rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Main interpretation loop
;
; Enter at interpret with inputptr pointing to the code stream to interpret.
; Enter at interpretline with X pointing to the command stream to interpret which will return to the caller one the
;     command stream has completed. STOP or BREAK will return with carry set while END or falling off the end of the
;     code will return with carry clear. In the event of an error, the usual error processing will be done and control
;     will return to immediate mode with the stack reset.
interpret       jsr breakcheck                  ; check for BREAK
                bcs cmd_stop0                   ; brif BREAK detected - go stop the program
                ldx inputptr                    ; get interpration address
                stx curstmt                     ; save address of the current statement (needed for some stuff)
                lda ,x+                         ; are we at the end of the line?
                beq interpret0                  ; brif so
                cmpa #':                        ; end of statement?
                beq interpret3                  ; brif so - do a statement
SNERROR         ldb #err_sn                     ; raise a syntax error
                jmp ERROR
interpret0      sta endflag                     ; flag the program exit state as "END" (will be zero)
                ldd curline                     ; were we in immediate mode?
                bne interpret1                  ; brif not
                clra                            ; clear carry to indicate normal exit
                rts                             ; return to caller
interpret1      ldd ,x                          ; are we at the end of the program?
                beq interpret4                  ; brif so - bail out
                stx curline                     ; save pointer to current line
                leax 3,x                        ; set input pointer one before the start of the line text
interpret2      stx inputptr
interpret3      jsr nextchar                    ; fetch first character of next statement
                beq interpret                   ; brif end of statement - do the next statement dance
                tsta                            ; set flags properly for token
                lbpl cmd_let                    ; brif no command - do assignment (LET command is optional)
                ldx #exectab_cmd                ; point to jump table
                leax a,x                        ; get half way to the correct offset
                ldx a,x                         ; get the address the other half of the way from here
                jsr nextchar                    ; skip past token and set flags
                jsr ,x                          ; call the routine
                bra interpret                   ; go handle the next statement dance
interpret4      bsr cmd_stop1                   ; make sure stack is aligned correctly (will not return)
interpretline   clr curline                     ; blank out current line pointer (for immediate mode)
                clr curline+1
                leax -1,x                       ; move back before start of code stream
                bra interpret2                  ; go interpret this statement and then continue with stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Check for character in B and raise a syntax error if not found at current input pointer. If it is found, fetch the
; next input character.
syncheckb       cmpb [inputptr]                 ; do we have a syntax match?
                bne SNERROR                     ; brif not
                jmp nextchar                    ; return next input character
                *pragmapop list