Mercurial > hg > index.cgi
view src/interp.s @ 125:0607e4e20702
Correct offset error for keyword table lookup
author | William Astle <lost@l-w.ca> |
---|---|
date | Sun, 07 Jan 2024 20:35:51 -0700 |
parents | eb2681108660 |
children | ac183a519439 |
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 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 stx inputptr ; set input pointer jsr curchar ; skip spaces and set flags bcs immediate1 ; brif there's a line number tsta ; is there anything there at all (end of line)? beq immediate0 ; brif not - read another line ldx inputptr ; get the modified input pointer processing above jsr tokenize ; tokenize the line at inputptr, return with result at tokebuff and X jsr interpretline ; go interpret the tokenized line bra immediate ; go handle another line immediate1 bsr parse_lineno ; parse the line number bsr prog_findline ; go see if the line is in the program bne immediate3 ; brif not - no need to delete it ldu ,x ; get next line pointer which is where we start the copy from leay ,x ; use temp pointer for copying immediate2 lda ,u+ ; get source byte sta ,y+ ; stash it cmpu vartab ; did we reach the end of the program text? blo immediate2 ; brif not sty vartab ; save new end of program 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 pshs x ; save program insert location and line number ldx inputptr ; point to line text jsr tokenize ; tokenize line, get length to D leay ,x ; save tokenized line pointer addd #4 ; account for next line pointer and line number ldx vartab ; get start of copy location leau d,x ; set destination copy location D bytes further up stu vartab ; save new end of program immediate4 lda ,-x ; get byte from program sta ,-u ; stash it above the empty space cmpx ,s ; did we reach the insertion point? bne immediate4 ; brif not - keep going leas 2,s ; clear insertion location stu ,x++ ; set next line pointer to not null ldd binval ; set the line number for the program std ,x++ immediate5 lda ,y+ ; get byte from tokenized line sta ,x+ ; stash it in the program bne immediate5 ; brif not at end of tokenized line (see note for fixlineptrs) immediate6 bsr prog_fixlineptrs ; fix up line pointers (all of them) ldx vartab ; clear out variables stx objecttab stx freestart bra immediate0 ; go handle more input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Fix up next line pointers. Enter at prog_fixlineptrs to do the entire program. Enter at prog_fixlineptrsx to start ; at the line pointered to by X, which MUST NOT point to the end of the program. ; ; Works by simply scanning for a NUL in the program text after a line header (pointer to next line and line number) ; and uses that as the new next line pointer. A NULL next line pointer flags the end of the program. ; ; Observation: if the program text format is changed such that it can include NULs embedded within a line, this routine ; will need to be updated to grok that. prog_fixlineptrs ldx progtext ; point to start of program prog_fixlineptrsx ldu ,x ; are we at the end of the program? beq prog_findline2 ; brif not (borrow RTS from findline) leau 4,x ; point to line text (past pointer and line number) prog_fixlineptrs1 lda ,u+ ; are we at the end of this line? bne prog_fixlineptrs1 ; brif not stu ,x ; set the next pointer for the previous line leax ,u ; move to the next line bra prog_fixlineptrsx ; go handle the next line ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Find a line in the program. Returns with C set and Z clear if no match and C clear and Z set if a match is found. X ; will point to either the exact matched line *or* the line that would be immediately after the desired line number if ; the line had been present, which could be the end of the program. D and U are clobbered. Enter at prog_findlinex to ; start searching at the line pointed to by X. Enter at prog_findline to start at the beginning of the program. Enter ; with the desired line number in binval. prog_findlinecl ldx curline ; get current line pointer beq prog_findline ; brif immediate mode ldd binval ; get desired line number cmpd 2,x ; is the desired line number >= current line? beq prog_findline2 ; brif this is the right line (optimizes goto self) bhi prog_findlinex ; brif desired line higher: start here instead of program start prog_findline ldx progtext ; point to start of program prog_findlinex ldu binval ; get line number to search for prog_findline0 ldd ,x ; end of program? beq prog_findline1 ; brif not cmpu 2,x ; does line number match? Z set if so, clear if not; C set not found bls prog_findline2 ldx ,x ; move to next line bra prog_findline0 ; see if we found the line yet prog_findline1 coma ; set carry for not found; also clears Z because D is zero from above prog_findline2 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 #primaryjump ; point to jump table anda #0x7f ; lose bit 7 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