Mercurial > hg > index.cgi
view src/interp.s @ 140:86f6f3a71e60 default tip
Fix some bugs in tokenization/parsing routine
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Tue, 16 Jul 2024 22:30:07 -0600 |
| parents | e49bd0493baf |
| children |
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 mode 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. This operates as follows: ; 1. Write a newline if needed ; 2. Output the prompt if needed ; 3. Read an input line ; 4. If the line is terminated by BREAK/ESC, go back to 3 ; 5. Find the first non-space character. If it is numeric, go on to 7 ; 6. Tokenize the input line, interpret it, and go back to 1 ; 7. Parse the line number. If it is invalid, do a syntax error ; 8. Find the line number in the program and remove it if present ; 9. If there is no non-space character after the number, go back to 3 ; 10. Tokenize the line and insert it into the program ; 11. Go back to 3 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? beq immediate0a ; brif so leax -1,x ; compensate for extra increment above bsr setcifdigit ; do we have a line number? bcs immediate1 ; brif so - go handle program editing jsr parse ; parse the line into tokens bcs immediatee ; brif there was a parse error jsr interpretline ; go interpret the tokenized line bra immediate ; go handle another line immediatee jmp SNERROR ; go do a syntax error immediate1 stx inputptr ; save input pointer for parsing purposes bsr parse_lineno ; parse the line number that was provided bsr prog_delline ; remove the line from the program if it exists 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 ldd binval ; get the line number jsr prog_addline ; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 parse_lineno2 ; brif overflow lslb rola ; times 4 bcs parse_lineno2 ; brif overflow addd binval ; times 5 (add orignal value to times 4) bcs parse_lineno2 ; brif overflow lslb rola ; times 10 bcs parse_lineno2 ; brif overflow addb ,s+ ; add in accumulated digit adca #0 bcs parse_lineno2 ; 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 parse_lineno2 jmp SNERROR ; relay to syntax error ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 -linetabent_size,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 linetabent_size,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 or set from rts ;* subtraction above prog_findline3 leau -linetabent_size,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 bsr prog_shrinklt ; shrink the line table if appropriate jmp cmd_newvars ; clear out the variable table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; prog_shrinklt: shrink the line table to its minimum possible size, but keep it a multiple of linetab_stride entries. ; This will leave the state of the variable table undefined so it needs to be cleared out properly before doing anything ; else after using this routine. prog_shrinklt ldd prog_linetabp ; get the end of the table entries subd prog_linetab ; now we have the length of the table pshs d ; save original size bitb #(linetabent_size*linetab_stride)-1 ; is there a remainder? beq prog_shrinklt0 ; brif not andb #~((linetabent_size*linetab_stride)-1) ; actually round down now addd #linetabent_size*linetab_stride ; and go up to the next stride prog_shrinklt0 subd ,s++ ; now D is the difference in size; will be negative if shrinking bne prog_resizelt ; brif there is something to do - go resize the table prog_delline3 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; prog_expandlt: expand the line table by one stride size. prog_expandlt ldd #linetabent_size*linetab_stride ; get size of an expansion strider ; fall through to the resize routine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Adjust the size of the program line table, either larger or smaller. ; ; Enter: ; D: the number of bytes to expand the table by; negative to shrink it; must be a multiple of the table entry size ; ; Exit: ; D: the number of bytes the table was expanded (negative means shrinkage) ; * prog_text: points to the new start of the program text ; * vartab: points to the new start of the variable table ; * all program line pointers are adjusted by D bytes ; ; Error: ; * OM error if there isn't enough memory to expand the table by D bytes prog_resizelt pshs d ; we're going to need the size number later ldu prog_text ; point to start of program text leax d,u ; point to the new address to copy to addd vartab ; calculate the new start of the variable table tfr d,y ; save it for later jsr mem_checkptr ; throw an error if it doesn't fit ldd vartab ; get the end of the program text subd prog_text ; now D is the number of bytes to copy stx prog_text ; save new program text pointer sty vartab ; save new variable table pointer jsr mem_copy ; copy the program text up or down ldx prog_linetab ; point to first entry in the program line table prog_resizelt0 ldd linetabent_ptr,x ; get the pointer for this entry addd ,s ; add in the offset std linetabent_ptr,x ; save updated pointer leax 4,x ; move to next entry cmpx prog_text ; end of table? blo prog_resizelt0 ; brif not puls d,pc ; clean up stack and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Insert a line into the program. ; ; Note that we do a sequential walk back from the end of the line table looking for the insert location because we can ; update all the line data pointers on the way through and that has to be done one by one anyway. ; ; Entry: ; D: length of line to insert ; X: pointer to line data to insert *which MUST be within the prog_text...vartab area* ; 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 bsr prog_expandlt ; expand the program line table ldx 2,s ; adjust the pointer for the line to insert leax d,x stx 2,s prog_addline0 ldu prog_linetabp ; point to the end of the line table leax linetabent_size,x ; point to the new end of the table stx prog_linetabp ; save new end of table pointer ldd linetabent_ptr,u ; move the dummy end of table pointer up one slot addd ,s ; (and adjust for the insert) std linetabent_ptr,x ldx 4,s ; get the new line number prog_addline1 cmpu prog_linetab ; are we at the start of the line table? beq prog_addline2 ; brif so - we're inserting here cmpx -linetabent_size+linetabent_num,u ; how does this line compare with the previous table entry? bhs prog_addline2 ; brif our number is larger (or equal) to previous entry number ldd -linetabent_size+linetabent_num,u ; copy line number up one slot std linetabent_num,u ldd -linetabent_size+linetabent_ptr,u ; get pointer of that entry addd ,s ; add the size of the newly inserted line to adjust for after insert std linetabent_ptr,u ; save it in the new slot leau -linetabent_size,u ; move back a slot bra prog_addline1 ; go check another slot prog_addline2 ldd linetabent_size+linetabent_ptr,u ; get pointer to the line to move out of the way subd ,s ; unadjust for the insert size - get original location std linetabent_ptr,u ; set the data pointer for the new entry stx linetabent_num,u ; set the line number for this entry tfr d,x ; set insertion point ldu 2,s ; get the source data to insert ldd ,s ; get length of source data jsr mem_insert ; shift the block into place jmp cmd_newvars ; erase variables and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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