Mercurial > hg > index.cgi
changeset 74:e74d00ac6b79
Split some code into separate files for easier management (2)
Because the source for lwbasic is so large, split it into several
different files to make it easier to navigate and modify. This is
part two of the split. Also includes fix for dependency tracking
related to the split in the make file.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sun, 06 Aug 2023 00:36:48 -0600 |
| parents | 2d52cd154ed1 |
| children | 5f8f0b0781e8 |
| files | Makefile src/genio.s src/interp.s src/lwbasic.s src/miscdata.s src/progctrl.s |
| diffstat | 6 files changed, 584 insertions(+), 680 deletions(-) [+] |
line wrap: on
line diff
--- a/Makefile Sun Aug 06 00:12:29 2023 -0600 +++ b/Makefile Sun Aug 06 00:36:48 2023 -0600 @@ -1,11 +1,14 @@ .PHONY: all all: bin/lwbasic.rom bin/lwbasic-coco2b.rom bin/lwbasic-coco3.rom bin/coco2.zip bin/coco2b.zip bin/coco3.zip -bin/lwbasic.rom: src/lwbasic.s +lwb_srcs := consscr.s defs.s genio.s init.s interp.s irq.s keyb.s miscdata.s print.s progctrl.s vars.s +lwb_srcs := $(addprefix src/,$(lwb_srcs)) + +bin/lwbasic.rom: src/lwbasic.s $(lwb_srcs) lwasm --tabs=16 --raw --list=src/lwbasic-coco2.list --symbols --output=bin/lwbasic.rom src/lwbasic.s -bin/lwbasic-coco2b.rom: src/lwbasic.s +bin/lwbasic-coco2b.rom: src/lwbasic.s $(lwb_srcs) lwasm --tabs=16 --raw --list=src/lwbasic-coco2b.list --symbols --output=bin/lwbasic-coco2b.rom -DCOCO2B=1 src/lwbasic.s -bin/lwbasic-coco3.rom: src/lwbasic.s +bin/lwbasic-coco3.rom: src/lwbasic.s $(lwb_srcs) lwasm --tabs=16 --raw --list=src/lwbasic-coco3.list --symbols --output=bin/lwbasic-coco3.rom -DCOCO3=1 src/lwbasic.s .PHONY: clean
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/genio.s Sun Aug 06 00:36:48 2023 -0600 @@ -0,0 +1,126 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; General I/O handling package +; +; These routines operate on the I/O channel specified by filenum. The defined values of filenum are: +; +; 0: keyboard/screen console +; +; Read a line from the active file into linebuff. The resulting line will be NUL terminated leading to at most +; linbuffsize-1 character input. The trailing CR/LF will not be included. The input will be echoed if linebuffecho is +; enabled. Exit with the length of the input line in B. +readline ldx #linebuff ; point to line input buffer + clr ,x ; make sure buffer is NUL terminated +readline0 bsr readchr ; read an input character + bcs readline1 ; brif not EOF + cmpa #0x0d ; CR (carriage return) + beq readline1 ; brif so - return + cmpa #0x03 ; BREAK? + bne readline3 ; brif not + coma ; set carry for irregular exit + skip1 +readline1 clra ; clear carry for regular exit + pshs cc ; save carry state + lda readlinenoecho ; are we echoing? + bne readline2 ; brif not + lda #0x0d ; echo carriage return + line feed + bsr writechr +readline2 tfr x,d ; get end address after input + subd #linebuff ; subtract start of buffer; D is now length and C is clear + clr ,x ; make sure line is NUL terminated + puls cc,pc ; restore BREAK flag (C) and return +readline3 cmpa #0x08 ; backspace? + bne readline4 ; brif not + cmpx #linebuff ; at start of buffer? + beq readline0 ; brif so - do nothing + leax -1,x ; move back buffer pointer + bsr readlinee ; write a BS + lda #0x20 ; write a space + bsr readlinee + lda #0x08 ; and finally a BS + bsr readlinee + bra readline0 ; go process more characters +readline4 cmpa #0x0c ; form feed? + bne readline5 ; brif not + bsr readlinee ; go echo character if needed + bra readline ; go restart line entry +readline5 cmpa #0x20 ; is it non-printing? + blo readline0 ; brif so - don't store it and continue + bsr readlines ; stash character in buffer and echo if necessary + bra readline0 ; go get another character +readlines cmpx #linebuff+linebuffsize-1 ; is the line buffer full? + bhs readlinee0 ; brif so - don't store character OR echo it + sta ,x+ ; stash character +readlinee ldb readlinenoecho ; are we echoing? + bne readlinee0 ; brif not + bsr writechr ; echo the character +readlinee0 rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Write a newline if not at left margin. This will unconditinally output a newline for devices where the horizontal +; position is not knowable. +writecondnl lda filenum ; get file number + bne writenl ; brif not screen - we'll do it unconditionally + lda console_curptr+1 ; get LSB of cursor pointer + anda #0x1f ; keep only the low 5 bits (32 characters per line) + beq writecondnl0 ; brif no newline is needed + ; fallthrough intended +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Write a newline to the chosen device. +writenl lda #0x0d ; code for carriage return - will serve as newline + ; fallthrough intended +; Write a character to the active file; all registers preserved but C will be set if the output file cannot handle +; an output character (doesn't exist, etc.) +writechr tst filenum ; is it screen? + beq writechr_scr ; brif writing to screen + orcc #1 ; unknown device flag +writecondnl0 rts +; Handle output to the screen. This is where we convert CR to CRLF +writechr_scr jsr console_outchr ; output the character + cmpa #0x0d ; was it CR? + bne writechr_scr0 ; brif not + lda #0x0a ; ouptut an LF + jsr console_outchr + lda #0x0d ; restore original value +writechr_scr0 andcc #0xfe ; clear error flag + rts +; Read a character from the active file and return it in A; in the event that EOF is detected, readeof will be nonzero +; and the call will return with carry set. +readchr clr fileeof ; flag not end of file (and clear carry) + lda filenum ; get input file number + beq readchr_kb ; brif keyboard input + com fileeof ; flag end of file (C set and fileeof nonzero) + rts +; Read character from keyboard; blink cursor while doing so +readchr_kb pshs b ; preserve B as temp storage + ldb [console_curptr] ; get character at cursor + inc console_blnkdel ; activate cursor blinking (first interrupt will cycle it) +readchr_kb0 jsr keyb_getkey ; read keyboard + bcc readchr_kb1 ; brif we got a result + cwai #0xaf ; wait for interrupt to scan keyboard + bra readchr_kb0 ; see if we have something yet +readchr_kb1 clr console_blnkdel ; disable cursor blinking + stb [console_curptr] ; restore screen character + clrb ; clear carry to indicate not eof + puls b,pc ; restore temp and return +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Write a character to the selected output device. If the device is one that does not support actual lower case, then +; conver the character to upper case. Otherwise, pass it through as is. Currently, only the console screen falls into +; this category. This *will* modify the character in A if a change is made. +writechrconduc tst filenum ; is it screen? + bne writechr ; brif not - just output it + tst console_truelc ; does the current text screen support actual lower case? + bne writechr ; brif so - just output character + cmpa #'a ; is it lower case? + blo writechr ; brif not + cmpa #'z ; is it still lower case? + bhi writechr ; brif not + suba #0x20 ; shift to upper case + bra writechr ; go output it +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Write a NUL terminated string at X to the screen. Conditionally convert to upper case based on the screen type. +writestrconduc0 bsr writechrconduc ; output the character +writestrconduc lda ,x+ ; fetch character from string + bne writestrconduc0 ; brif not end of string + rts + *pragmapop list
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interp.s Sun Aug 06 00:36:48 2023 -0600 @@ -0,0 +1,250 @@ + *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 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The error handler +; +; Enter with the error number in B. This routine will do some cleanup and handle any ON ERROR GOTO handler that +; may be active. +; +; Note the error message lookup does not need to be efficient which is why the lookup just runs through the list +; of error messages in sequence looking for NUL terminators. The specific handling of B (error number) below avoids +; issues if there happen to be error codes above 128. +ERROR clr filenum ; reset display device to console + jsr writecondnl ; do a newline if needed (will preserve B) + ldx #errormsg ; point to error message list + incb ; account for decb below + bra ERROR1 ; go search for correct message +ERROR0 lda ,x+ ; end of message? + bne ERROR0 ; brif not end of message +ERROR1 decb ; at the correct one? + bne ERROR0 ; brif not - skip to next one +ERROR2 jsr writestrconduc ; output error message + ldu curline ; are we in immediate mode? + beq ERROR3 ; brif so + ldx #inmsg ; point to " in " + jsr writestrconduc ; output " in " + ldd 2,u ; get line number + jsr print_uint16d ; display the line number +ERROR3 lds freetop ; reset the stack pointer (error routine could be called anywhere) + clr ,-s ; reset the call stack + sts stackptr + ; fall through to immediate mode intentional +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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
--- a/src/lwbasic.s Sun Aug 06 00:12:29 2023 -0600 +++ b/src/lwbasic.s Sun Aug 06 00:36:48 2023 -0600 @@ -41,685 +41,14 @@ include keyb.s include irq.s include consscr.s + include genio.s + include interp.s + include progctrl.s + include print.s + + include miscdata.s *pragmapop list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; General I/O handling package -; -; These routines operate on the I/O channel specified by filenum. The defined values of filenum are: -; -; 0: keyboard/screen console -; -; Read a line from the active file into linebuff. The resulting line will be NUL terminated leading to at most -; linbuffsize-1 character input. The trailing CR/LF will not be included. The input will be echoed if linebuffecho is -; enabled. Exit with the length of the input line in B. -readline ldx #linebuff ; point to line input buffer - clr ,x ; make sure buffer is NUL terminated -readline0 bsr readchr ; read an input character - bcs readline1 ; brif not EOF - cmpa #0x0d ; CR (carriage return) - beq readline1 ; brif so - return - cmpa #0x03 ; BREAK? - bne readline3 ; brif not - coma ; set carry for irregular exit - skip1 -readline1 clra ; clear carry for regular exit - pshs cc ; save carry state - lda readlinenoecho ; are we echoing? - bne readline2 ; brif not - lda #0x0d ; echo carriage return + line feed - bsr writechr -readline2 tfr x,d ; get end address after input - subd #linebuff ; subtract start of buffer; D is now length and C is clear - clr ,x ; make sure line is NUL terminated - puls cc,pc ; restore BREAK flag (C) and return -readline3 cmpa #0x08 ; backspace? - bne readline4 ; brif not - cmpx #linebuff ; at start of buffer? - beq readline0 ; brif so - do nothing - leax -1,x ; move back buffer pointer - bsr readlinee ; write a BS - lda #0x20 ; write a space - bsr readlinee - lda #0x08 ; and finally a BS - bsr readlinee - bra readline0 ; go process more characters -readline4 cmpa #0x0c ; form feed? - bne readline5 ; brif not - bsr readlinee ; go echo character if needed - bra readline ; go restart line entry -readline5 cmpa #0x20 ; is it non-printing? - blo readline0 ; brif so - don't store it and continue - bsr readlines ; stash character in buffer and echo if necessary - bra readline0 ; go get another character -readlines cmpx #linebuff+linebuffsize-1 ; is the line buffer full? - bhs readlinee0 ; brif so - don't store character OR echo it - sta ,x+ ; stash character -readlinee ldb readlinenoecho ; are we echoing? - bne readlinee0 ; brif not - bsr writechr ; echo the character -readlinee0 rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Write a newline if not at left margin. This will unconditinally output a newline for devices where the horizontal -; position is not knowable. -writecondnl lda filenum ; get file number - bne writenl ; brif not screen - we'll do it unconditionally - lda console_curptr+1 ; get LSB of cursor pointer - anda #0x1f ; keep only the low 5 bits (32 characters per line) - beq writecondnl0 ; brif no newline is needed - ; fallthrough intended -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Write a newline to the chosen device. -writenl lda #0x0d ; code for carriage return - will serve as newline - ; fallthrough intended -; Write a character to the active file; all registers preserved but C will be set if the output file cannot handle -; an output character (doesn't exist, etc.) -writechr tst filenum ; is it screen? - beq writechr_scr ; brif writing to screen - orcc #1 ; unknown device flag -writecondnl0 rts -; Handle output to the screen. This is where we convert CR to CRLF -writechr_scr jsr console_outchr ; output the character - cmpa #0x0d ; was it CR? - bne writechr_scr0 ; brif not - lda #0x0a ; ouptut an LF - jsr console_outchr - lda #0x0d ; restore original value -writechr_scr0 andcc #0xfe ; clear error flag - rts -; Read a character from the active file and return it in A; in the event that EOF is detected, readeof will be nonzero -; and the call will return with carry set. -readchr clr fileeof ; flag not end of file (and clear carry) - lda filenum ; get input file number - beq readchr_kb ; brif keyboard input - com fileeof ; flag end of file (C set and fileeof nonzero) - rts -; Read character from keyboard; blink cursor while doing so -readchr_kb pshs b ; preserve B as temp storage - ldb [console_curptr] ; get character at cursor - inc console_blnkdel ; activate cursor blinking (first interrupt will cycle it) -readchr_kb0 jsr keyb_getkey ; read keyboard - bcc readchr_kb1 ; brif we got a result - cwai #0xaf ; wait for interrupt to scan keyboard - bra readchr_kb0 ; see if we have something yet -readchr_kb1 clr console_blnkdel ; disable cursor blinking - stb [console_curptr] ; restore screen character - clrb ; clear carry to indicate not eof - puls b,pc ; restore temp and return -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Write a character to the selected output device. If the device is one that does not support actual lower case, then -; conver the character to upper case. Otherwise, pass it through as is. Currently, only the console screen falls into -; this category. This *will* modify the character in A if a change is made. -writechrconduc tst filenum ; is it screen? - bne writechr ; brif not - just output it - tst console_truelc ; does the current text screen support actual lower case? - bne writechr ; brif so - just output character - cmpa #'a ; is it lower case? - blo writechr ; brif not - cmpa #'z ; is it still lower case? - bhi writechr ; brif not - suba #0x20 ; shift to upper case - bra writechr ; go output it -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Write a NUL terminated string at X to the screen. Conditionally convert to upper case based on the screen type. -writestrconduc0 bsr writechrconduc ; output the character -writestrconduc lda ,x+ ; fetch character from string - bne writestrconduc0 ; brif not end of string - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; 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 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; The error handler -; -; Enter with the error number in B. This routine will do some cleanup and handle any ON ERROR GOTO handler that -; may be active. -; -; Note the error message lookup does not need to be efficient which is why the lookup just runs through the list -; of error messages in sequence looking for NUL terminators. The specific handling of B (error number) below avoids -; issues if there happen to be error codes above 128. -ERROR clr filenum ; reset display device to console - jsr writecondnl ; do a newline if needed (will preserve B) - ldx #errormsg ; point to error message list - incb ; account for decb below - bra ERROR1 ; go search for correct message -ERROR0 lda ,x+ ; end of message? - bne ERROR0 ; brif not end of message -ERROR1 decb ; at the correct one? - bne ERROR0 ; brif not - skip to next one -ERROR2 jsr writestrconduc ; output error message - ldu curline ; are we in immediate mode? - beq ERROR3 ; brif so - ldx #inmsg ; point to " in " - jsr writestrconduc ; output " in " - ldd 2,u ; get line number - jsr print_uint16d ; display the line number -ERROR3 lds freetop ; reset the stack pointer (error routine could be called anywhere) - clr ,-s ; reset the call stack - sts stackptr - ; fall through to immediate mode intentional -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; 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 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; The NEW command. -; -; This also includes several useful entry points: -; -; cmd_newraw: does the whole NEW but without any syntax checks -; cmd_newinptr: skips clearing the program text -; cmd_newvars: clears variables and resets the stack and other misc state -; cmd_newstack: just reset the stack and other misc state -cmd_new bne parse_lineno1 ; brif there was an argument - don't wipe things out on syntax error -cmd_newraw ldx progtext ; point to start of program - clr -1,x ; make sure there's a NUL before the start of the program - clr ,x+ ; put a NULL pointer at the start of the program - clr ,x+ - stx vartab ; set start of variables after that -cmd_newinptr ldx progtext ;* set input pointer to the NUL before the program; this will cause the - leax -1,x ;* the interpreter to drop to immediate mode no matter what it was - stx inputptr ;* executing before this call if called from the main loop -cmd_newvars ldx memsize ; get top of memory - stx stringtab ; clear out string space - ldx vartab ; get start of variables - stx objecttab ; set start of large objects (arrays) there too (clear vars) - stx freestart ; set start of free memory (end of large objects) (clear arrays) -cmd_newstack ldx #stringstackend ; reset string stack (string stack counts down) - stx stringstackptr - ldx ,s ; get return address - lds freetop ; reset stack to top of memory - clr ,-s ; put a flag to stop stack searches (NEXT, RETURN) - sts stackptr ; reset pointer for call stack - clr contstmt ; clear "CONT" destination - clr contstmt+1 - jmp ,x ; return to caller -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; 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 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; The END command. -cmd_end bne SNERROR ; error out if there is an argument - ;jsr closeall ; close all files for END - clra ; flag END (clear carry) - bra cmd_stop0 ; go do the stop/end -cmd_stop bne SNERROR ; raise error if there was an argument - coma ; flag STOP - set carry -cmd_stop0 ror endflag ; set stop/end flag -cmd_stop1 clr filenum ; reset I/O to console - ldx curline ; in immediate mode? - beq cmd_stop2 ; brif so - don't save the continue pointers - stx contline ; save pointer to current line for CONT - ldx curstmt ; get current statement address - stx contstmt ; save it for CONT -cmd_stop2 rol endflag ; get STOP/END to C (1=STOP) - bcc cmd_stop3 ; brif END - don't do message - ldx #breakmsg ; do "BREAK IN" - jmp ERROR2 ; the bottom half of the error handler can deal with the details -cmd_stop3 puls x,pc ; lose return address and return to caller of interpretation loop -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; REM and ' commands; also ELSE comes here since it needs to skip the rest of the line in that case. -cmd_else -cmd_apos -cmd_rem clra ; clear carry - ldx curline ; get start of current line - beq cmd_stop3 ; brif immediate mode - fall back to caller - ldx ,x ; get address of next line - leax -1,x ; move back one - stx inputptr ; put input pointer there - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; DATA command -; -; need to skip to the end of the current statement, which is either the end of the line OR a colon not included inside -; a quoted string -cmd_data ldx inputptr ; get input pointer -cmd_data0 lda ,x+ ; get character at pointer - beq cmd_data1 ; brif end of line - cmpa #': ; end of statement? - bne cmd_data2 ; brif not -cmd_data1 leax -1,x ; move back to the NUL or colon - stx inputptr ; reset input pointer for interpreter - rts -cmd_data2 cmpa #'" ; start of constant string? - bne cmd_data0 ; brif not - process more characters -cmd_data3 lda ,x+ ; get next string character - beq cmd_data1 ; brif end of line - cmpa #'" ; string delimiter? - bne cmd_data3 ; brif not - keep going - bra cmd_data0 ; process stuff outside string -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; RUN command -cmd_run ;jsr closeall ; close all files - jsr curchar ; what do we have as an argument? - bcs cmd_goto ; brif a digit - it's a line number (RUN ###); do GOTO - lbne SNERROR ; brif anything else on the line - not legit command - ldx progtext ; point to start of program - bra cmd_goto0 ; go transfer control to the start of the program -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; GOTO command -cmd_goto jsr parse_lineno ; parse the line number -cmd_gosub0 jsr prog_findlinecl ; go look up line number - bcc cmd_goto0 ; brif line found -ULERROR ldb #err_ul ; raise undefined line error - jmp ERROR -cmd_goto0 stx curline ; make sure we aren't flagging immediate mode - leax -1,x ; move input pointer to NUL before destination line - stx inputptr ; put input pointer there - rts ; resume interpretation at the new location -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; GOSUB command -cmd_gosub jsr parse_lineno ; parse the destination line so return location is after the line number - ldd #tok_gosub*256+4 ; stack frame details - bsr callstack_alloc ; make a stack frame - ldx curline ; save current line pointer - stx ,u - ldx inputptr ; save current input pointer - stx 2,u - bra cmd_gosub0 ; go finish up as a GOTO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; RETURN command -; POP command -; -; RETURN will search the call stack for the first GOSUB frame and remove all other placeholders it finds. A frame type -; of 0 will cause it to stop. -cmd_pop skip1lda ; set nonzero for POP -cmd_return clra ; set zero for RETURN - pshs a ; save operation type - bsr callstack_first ; get first entry on call stack - bne cmd_return1 ; brif there's a frame - don't error -RG_ERROR ldb #err_rg ; raise RETURN without GOSUB - jmp ERROR -cmd_return0 bsr callstack_next ; move to next entry - beq RG_ERROR ; brif end of stack - raise error -cmd_return1 cmpb #tok_gosub ; do we have a GOSUB frame? - bne cmd_return0 ; brif not - try again - lda ,s+ ; is it "POP"? - bne cmd_return2 ; brif so - don't change flow control but clear stack frame - ldx ,u ; get back saved line pointer - stx curline - ldx 2,u ; get back saved input pointer - stx inputptr -cmd_return2 bsr callstack_pop ; clean up call stack - bra cmd_data ; move to end of statement (move past any "ON GOSUB" entries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Point to the first entry on the call stack; yes this is trivial but it points to the payload, not the header. Also -; sets Z if there is nothing on the stack. -callstack_first ldu stackptr ; get stack pointer - ldb ,u++ ; set flags on frame type and adjust pointer - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Move to the next frame on the call stack; enter with U pointing to a stack frame payload area -callstack_next ldb -1,u ; get length of this frame - leau b,u ; move to the next frame - ldb -2,u ; set flags on frame type code - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Create a stack frame. Enter with the frame type flag in A and the size in B. -; -; The stack frame of size B bytes plus 2 bytes for the length and type flag will be allocated between the actual -; hardware stack and the current call stack pointer. Return with the pointer to the allocated frame in U. As long as -; there are no pointers to anything on the hardware stack, this will allow the stack to be entirely intact after -; the call. -callstack_alloc addb #2 ; account for the header bytes - pshs a,b ; save the type and length - negb ; need a negative offset - leax ,s ; point to current bottom of stack - leas b,s ; make a hole below the stack - leau ,s ; get a pointer to the destination for copying -callstack_alloc0 - lda ,x+ ; copy a byte down - sta ,u+ - cmpx stackptr ; have we reached the top of the stack? - blo callstack_alloc0 ; brif not - stu stackptr ; save the new call stack pointer - puls d ; get back the type and length values - std ,u++ ; save type and length - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Pop the call stack to the end of the frame pointed to by U; this will relocate the hardware stack to close the -; newly made gap in memory. -callstack_pop leau -2,u ; move back to header - ldb 1,u ; get length of frame - leax b,u ; point to element after this frame - sts ,--s ; save the current bottom of the stack - stx stackptr ; save new call stack pointer -callstack_pop0 lda ,-u ; copy a byte up - sta ,-x - cmpu ,s ; at the bottom of the call stack? - bhi callstack_pop0 ; brif not - leas 2,x ; reset the stack pointer (and lose the saved stack pointer value) - rts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Miscelaneous strings -prompt fcn 'OK' ; general prompt -breakmsg fcn 'BREAK' ; "BREAK" message -inmsg fcn ' in ' ; " in " message -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Print out an unsigned 16 bit value in D to the selected output stream -print_uint16d pshs d,x,y,u ; save number and make some temporaries on the stack - leay 2,s ; point to start of buffer - ldu #10000 ; do the 10000s digit - bsr print_uint16d4 - ldu #1000 ; do the 1000s digit - bsr print_uint16d4 - ldu #100 ; do the 100s digit - bsr print_uint16d4 - ldu #10 ; do the 10s digit - bsr print_uint16d4 - puls d ; get back number residue and clean up stack - addb #0x30 ; convert 1s digit to number - stb ,y ; stash it - clr 1,y ; NUL terminate it - leay ,s ; point to start of converted number -print_uint16d0 lda ,y ; get digit at start - cmpa #0x30 ; zero digit? - bne print_uint16d1 ; brif not - we can just show the number from here - ldb 1,y ; end of number? - beq print_uint16d1 ; brif so - show the zero anyway - leay 1,y ; move past the zero - bra print_uint16d0 ; see if we have more zeroes to skip -print_uint16d1 lda ,y+ ; get number digit - beq print_uint16d2 ; brif end of number - jsr writechr ; output the digit - bra print_uint16d1 ; handle next digit -print_uint16d2 leas 6,s ; clean up the stack - rts -print_uint16d4 lda #0x30-1 ; init digit value - pshs a,u ; save the digit position and digit value - ldd 5,s ; get back residue -print_uint16d5 inc ,s ; bump digit - subd 1,s ; subtract out place value - bcc print_uint16d5 ; brif we haven't got the right digit yet - addd 1,s ; restore residue - std 5,s ; save new residue - puls a,u ; get back digit and place value off stack - sta ,y+ ; save digit in buffer - rts - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; PRINT command -cmd_print beq cmd_printeol ; brif no argument - do a newline -cmd_print0 cmpa #'; ; semicolon? - bne cmd_print1 ; brif not - jsr nextchar ; skip the semicolon - bne cmd_print0 ; brif not end of the statement - rts -cmd_print1 jsr eval_expr ; evaluate the expression - ldb val0+val.type ; get value type - cmpb #valtype_int ; integer? - beq cmd_printint ; brif so - print integer - lda #'! ; flag unknown expression type - jsr console_outchr - jsr console_outchr - jsr console_outchr -cmd_printnext jsr curchar ; see what we have here - bra cmd_print ; and go process -cmd_printeol jmp console_outnl ; do a newline and return -cmd_printint leas -12,s ; make a buffer - leay ,s ; point to buffer - lda #0x20 ; default sign (positive) - ldb val0+val.int ; is it negative? - bpl cmd_printint0 ; brif not - jsr val_negint32 ; negate the integer - lda #'- ; negative sign -cmd_printint0 sta ,y+ ; save sign - ldu #cmd_printintpc ; point to positive constant table - ldx #10 ; there are 10 constants to process -; subtraction loop - positive residue -cmd_printint1 lda #'0-1 ; initialize digit - sta ,y -cmd_printint2 inc ,y ; bump digit - ldd val0+val.int+2 ; subtract constant - subd 2,u - std val0+val.int+2 - ldd val0+val.int - sbcb 1,u - sbca ,u - std val0+val.int - bcc cmd_printint2 ; brif we didn't go negative - ldd val0+val.int+2 ; undo last subtract - addd 2,u - std val0+val.int+2 - ldd val0+val.int - adcb 1,u - adca ,u - std val0+val.int - leay 1,y ; move to next digit in buffer - leau 4,u ; move to next constant - leax -1,x ; done all constants? - bne cmd_printint1 ; brif not - done all -cmd_printint5 clr ,y ; NUL terminate the string - leax 1,s ; point past the sign -cmd_printint6 lda ,x+ ; get digit - beq cmd_printint8 ; brif end of number - cmpa #'0 ; is it a zero? - beq cmd_printint6 ; brif so - skip it -cmd_printint7 lda ,s ; get the sign - sta ,--x ; put it at the start of the number - jsr console_outstr ; display the number - leas 12,s ; clean up stack - bra cmd_printnext ; go print the next thing -cmd_printint8 leax -1,x ; restore one of the zeros - bra cmd_printint7 ; go finish up -cmd_printintpc fqb 1000000000 ; 10^9 - fqb 100000000 ; 10^8 - fqb 10000000 ; 10^7 - fqb 1000000 ; 10^6 - fqb 100000 ; 10^5 - fqb 10000 ; 10^4 - fqb 1000 ; 10^3 - fqb 100 ; 10^2 - fqb 10 ; 10^1 - fqb 1 ; 10^0 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Error messages ; ; Each error begins with a deferr macro invocation which will define a symbol err_slug with the next error number
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/miscdata.s Sun Aug 06 00:36:48 2023 -0600 @@ -0,0 +1,8 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Miscelaneous strings +prompt fcn 'OK' ; general prompt +breakmsg fcn 'BREAK' ; "BREAK" message +inmsg fcn ' in ' ; " in " message + *pragmapop list
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/progctrl.s Sun Aug 06 00:36:48 2023 -0600 @@ -0,0 +1,188 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The END command. +cmd_end bne SNERROR ; error out if there is an argument + ;jsr closeall ; close all files for END + clra ; flag END (clear carry) + bra cmd_stop0 ; go do the stop/end +cmd_stop bne SNERROR ; raise error if there was an argument + coma ; flag STOP - set carry +cmd_stop0 ror endflag ; set stop/end flag +cmd_stop1 clr filenum ; reset I/O to console + ldx curline ; in immediate mode? + beq cmd_stop2 ; brif so - don't save the continue pointers + stx contline ; save pointer to current line for CONT + ldx curstmt ; get current statement address + stx contstmt ; save it for CONT +cmd_stop2 rol endflag ; get STOP/END to C (1=STOP) + bcc cmd_stop3 ; brif END - don't do message + ldx #breakmsg ; do "BREAK IN" + jmp ERROR2 ; the bottom half of the error handler can deal with the details +cmd_stop3 puls x,pc ; lose return address and return to caller of interpretation loop +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The NEW command. +; +; This also includes several useful entry points: +; +; cmd_newraw: does the whole NEW but without any syntax checks +; cmd_newinptr: skips clearing the program text +; cmd_newvars: clears variables and resets the stack and other misc state +; cmd_newstack: just reset the stack and other misc state +cmd_new bne cmd_new0 ; brif there was an argument - don't wipe things out on syntax error +cmd_newraw ldx progtext ; point to start of program + clr -1,x ; make sure there's a NUL before the start of the program + clr ,x+ ; put a NULL pointer at the start of the program + clr ,x+ + stx vartab ; set start of variables after that +cmd_newinptr ldx progtext ;* set input pointer to the NUL before the program; this will cause the + leax -1,x ;* the interpreter to drop to immediate mode no matter what it was + stx inputptr ;* executing before this call if called from the main loop +cmd_newvars ldx memsize ; get top of memory + stx stringtab ; clear out string space + ldx vartab ; get start of variables + stx objecttab ; set start of large objects (arrays) there too (clear vars) + stx freestart ; set start of free memory (end of large objects) (clear arrays) +cmd_newstack ldx #stringstackend ; reset string stack (string stack counts down) + stx stringstackptr + ldx ,s ; get return address + lds freetop ; reset stack to top of memory + clr ,-s ; put a flag to stop stack searches (NEXT, RETURN) + sts stackptr ; reset pointer for call stack + clr contstmt ; clear "CONT" destination + clr contstmt+1 + jmp ,x ; return to caller +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; REM and ' commands; also ELSE comes here since it needs to skip the rest of the line in that case. +cmd_else +cmd_apos +cmd_rem clra ; clear carry + ldx curline ; get start of current line + beq cmd_stop3 ; brif immediate mode - fall back to caller + ldx ,x ; get address of next line + leax -1,x ; move back one + stx inputptr ; put input pointer there +cmd_new0 rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; DATA command +; +; need to skip to the end of the current statement, which is either the end of the line OR a colon not included inside +; a quoted string +cmd_data ldx inputptr ; get input pointer +cmd_data0 lda ,x+ ; get character at pointer + beq cmd_data1 ; brif end of line + cmpa #': ; end of statement? + bne cmd_data2 ; brif not +cmd_data1 leax -1,x ; move back to the NUL or colon + stx inputptr ; reset input pointer for interpreter + rts +cmd_data2 cmpa #'" ; start of constant string? + bne cmd_data0 ; brif not - process more characters +cmd_data3 lda ,x+ ; get next string character + beq cmd_data1 ; brif end of line + cmpa #'" ; string delimiter? + bne cmd_data3 ; brif not - keep going + bra cmd_data0 ; process stuff outside string +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; RUN command +cmd_run ;jsr closeall ; close all files + jsr curchar ; what do we have as an argument? + bcs cmd_goto ; brif a digit - it's a line number (RUN ###); do GOTO + lbne SNERROR ; brif anything else on the line - not legit command + ldx progtext ; point to start of program + bra cmd_goto0 ; go transfer control to the start of the program +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; GOTO command +cmd_goto jsr parse_lineno ; parse the line number +cmd_gosub0 jsr prog_findlinecl ; go look up line number + bcc cmd_goto0 ; brif line found +ULERROR ldb #err_ul ; raise undefined line error + jmp ERROR +cmd_goto0 stx curline ; make sure we aren't flagging immediate mode + leax -1,x ; move input pointer to NUL before destination line + stx inputptr ; put input pointer there + rts ; resume interpretation at the new location +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; GOSUB command +cmd_gosub jsr parse_lineno ; parse the destination line so return location is after the line number + ldd #tok_gosub*256+4 ; stack frame details + bsr callstack_alloc ; make a stack frame + ldx curline ; save current line pointer + stx ,u + ldx inputptr ; save current input pointer + stx 2,u + bra cmd_gosub0 ; go finish up as a GOTO +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; RETURN command +; POP command +; +; RETURN will search the call stack for the first GOSUB frame and remove all other placeholders it finds. A frame type +; of 0 will cause it to stop. +cmd_pop skip1lda ; set nonzero for POP +cmd_return clra ; set zero for RETURN + pshs a ; save operation type + bsr callstack_first ; get first entry on call stack + bne cmd_return1 ; brif there's a frame - don't error +RG_ERROR ldb #err_rg ; raise RETURN without GOSUB + jmp ERROR +cmd_return0 bsr callstack_next ; move to next entry + beq RG_ERROR ; brif end of stack - raise error +cmd_return1 cmpb #tok_gosub ; do we have a GOSUB frame? + bne cmd_return0 ; brif not - try again + lda ,s+ ; is it "POP"? + bne cmd_return2 ; brif so - don't change flow control but clear stack frame + ldx ,u ; get back saved line pointer + stx curline + ldx 2,u ; get back saved input pointer + stx inputptr +cmd_return2 bsr callstack_pop ; clean up call stack + bra cmd_data ; move to end of statement (move past any "ON GOSUB" entries +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Point to the first entry on the call stack; yes this is trivial but it points to the payload, not the header. Also +; sets Z if there is nothing on the stack. +callstack_first ldu stackptr ; get stack pointer + ldb ,u++ ; set flags on frame type and adjust pointer + rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Move to the next frame on the call stack; enter with U pointing to a stack frame payload area +callstack_next ldb -1,u ; get length of this frame + leau b,u ; move to the next frame + ldb -2,u ; set flags on frame type code + rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Create a stack frame. Enter with the frame type flag in A and the size in B. +; +; The stack frame of size B bytes plus 2 bytes for the length and type flag will be allocated between the actual +; hardware stack and the current call stack pointer. Return with the pointer to the allocated frame in U. As long as +; there are no pointers to anything on the hardware stack, this will allow the stack to be entirely intact after +; the call. +callstack_alloc addb #2 ; account for the header bytes + pshs a,b ; save the type and length + negb ; need a negative offset + leax ,s ; point to current bottom of stack + leas b,s ; make a hole below the stack + leau ,s ; get a pointer to the destination for copying +callstack_alloc0 + lda ,x+ ; copy a byte down + sta ,u+ + cmpx stackptr ; have we reached the top of the stack? + blo callstack_alloc0 ; brif not + stu stackptr ; save the new call stack pointer + puls d ; get back the type and length values + std ,u++ ; save type and length + rts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Pop the call stack to the end of the frame pointed to by U; this will relocate the hardware stack to close the +; newly made gap in memory. +callstack_pop leau -2,u ; move back to header + ldb 1,u ; get length of frame + leax b,u ; point to element after this frame + sts ,--s ; save the current bottom of the stack + stx stackptr ; save new call stack pointer +callstack_pop0 lda ,-u ; copy a byte up + sta ,-x + cmpu ,s ; at the bottom of the call stack? + bhi callstack_pop0 ; brif not + leas 2,x ; reset the stack pointer (and lose the saved stack pointer value) + rts + *pragmapop list