Mercurial > hg > index.cgi
view src/interp.s-saved @ 134:3ab4b62665c3
Make a backup of the interp.s code for a complete refactor
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Mon, 24 Jun 2024 23:49:10 -0600 |
| parents | src/interp.s@917b4893bb3d |
| 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 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