Mercurial > hg > index.cgi
view src/lwbasic.s @ 73:2d52cd154ed1
Split some code into separate files for easier management
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 one of the split.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sun, 06 Aug 2023 00:12:29 -0600 |
| parents | f492fa6f6dc8 |
| children | e74d00ac6b79 |
line wrap: on
line source
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; LWBasic Version 0.1 ; Copyright © 2022 Lost Wizard Enterprises Incorporated ; ; This is LWBasic, a replacement Basic ROM system for the TRS-80 Color Computer which ; is most definitely not binary compatible with the stock ROMs. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *pragmapush list *pragma nolist *pragma noexpandcond *pragma cescapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Utility macros ; ; skip next byte; flags preserved skip1 macro noexpand fcb 0x21 ; opcode for BRN endm ; skip next byte and load nonzero to A skip1lda macro noexpand fcb 0x86 ; opcode for LDA immediate endm ; skip next byte and load nonzero to B skip1ldb macro noexpand fcb 0xc6 ; opcoe for LDB immediate endm ; skip next 2 bytes; clobbers flags skip2 macro noexpand fcb 0x8c ; opcode for CMPX immediate endm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Include the various sub source files include defs.s include vars.s *pragmapop list org 0x8000 ; the hardware puts the ROMs here; it's not negotiable ROMSTART equ * *pragmapush list *pragma nolist include init.s include keyb.s include irq.s include consscr.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 ; ; deferr slug ; ; This is then followed by the error message defined with fcn. ; ; Real error numbers start at 1; 0 is used to indicate no error. *pragmapush list *pragma nolist __errnum set 0 deferr macro noexpand err_{1} equ __errnum __errnum set __errnum+1 endm *pragmapop list errormsg deferr none fcn 'No error' deferr nf fcn 'NEXT without FOR' deferr sn fcn 'Syntax error' deferr ul fcn 'Undefined line number' deferr rg fcn 'RETURN without GOSUB' deferr ov fcn 'Overflow' deferr tm fcn 'Type mismatch' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The LET command which is the default if no token begins a statement cmd_let jmp SNERROR ; not yet implemented ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Expression Evaluation Package ; ; This is the expression evaluator. It handles everything from parsing numbers to dispatching function calls. The main ; entry point is eval_expr which will evaluate an arbitrary expression. It returns as soon as it reaches something it ; doesn't understand as part of an expression. ; ; The special handling for relational operators is required because Basic allows them in all eval_expr clrb ; flag previous operator as minimum precdence (end of expression) eval_expraux jsr eval_term ; evaluate the first term of the expression eval_expr0 jsr curchar ; fetch current input beq eval_expr1 ; brif end of expression - we're done cmpa #tok_or ; is it above operators? bhi eval_expr1 ; brif so suba #tok_plus ; offset to zero for first operator token bcc eval_expr2 ; brif it is an operator eval_expr1 rts eval_expr2 pshs b ; save previous operator precedence ldx #oper_tab ; point to operator table tfr a,b ; shift to B for "ABX" abx ; add three times (3 bytes per entry) abx ; OBS: TFR + ABX + ABX + ABX is faster than LDB + MUL + ABX abx ; now X points to the operator entry in the table ldb ,x ; get precedence of current operation cmpb ,s ; is it higher than the current operation? bhi eval_expr3 ; brif so - process this operator puls b,pc ; return current value to complete previous operation eval_expr3 jsr nextchar ; eat the operator token ldx 1,x ; get handler address of this operator leas -val.size,s ; make room for the result accumulator pshs x ; save handler address for later lda val0+val.type ; get current value type ldx val0 ; get value accumlator contents (6 bytes) ldy val0+2 ldu val0+4 pshs a,x,y,u ; save it on the stack jsr eval_expraux ; evaluate the following term and higher precedence expressions puls a,x,y,u ; get back saved value stx val1 ; save it to the second value accumulator sty val1+2 stu val1+4 sta val1+val.type ; save previous value type ldx #val1 ; point to left operand ldu #val0 ; point to right operand leay 2,s ; point to return value location jsr [,s++] ; go handle the operator puls a,x,y,u ; get return value sta val0 stx val0+1 sty val0+3 stu val0+5 puls b ; get back the previous operator precedence bra eval_expr0 ; go process another operator or end of expression eval_term jsr curchar ; get current input character beq eval_term0 ; brif end of input - this is an error bcs eval_number ; brif digit - we have a number ; bmi eval_func ; brif we have a token - handle function call cmpa #'. ; decimal point? beq eval_number ; brif so - evaluate number cmpa #'- ; negative sign? beq eval_number ; brif so - evaluate number cmpa #'+ ; positive sign? beq eval_number ; brif so - evaluate number eval_term0 jmp SNERROR ; we have something unrecognized - raise error ; Evaluate a number constant. Currently this only handles 32 bit integers. eval_number ldb #valtype_int ; start with integer value stb val0+val.type ; set return value ldx zero ; blank out the value stx val0 stx val0+2 stx val0+4 bra eval_number1 ; go do the parsing eval_number0 jsr nextchar ; fetch next input beq eval_numberr ; brif end of expression - bail eval_number1 cmpa #'- ; negative (ascii sign)? beq eval_number3 ; brif so cmpa #tok_minus ; negative (operator negative)? bne eval_number2 ; brif not eval_number3 com val0+val.fpsign ; invert sign bra eval_number0 ; deal with next input eval_number2 cmpa #'+ ; unary +? beq eval_number0 ; brif so - skip it eval_number5 cmpa #'. ; decimal point? beq eval_float ; brif decimal - force float cmpa #'0 ; is it a number? blo eval_numberr ; brif below digit cmpa #'9 ; is it still a number? bhi eval_numberr ; brif above digit suba #'0 ; offset to binary digit value pshs a ; save digit value ldx val0+val.int ; get current value for later (for quick multiply by 10) ldd val0+val.int+2 pshs d,x ; stored with words swapped on stack for efficiency for later lsl val0+val.int+3 ; times 2 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed lsl val0+val.int+3 ; times 4 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed ldd val0+val.int+2 ; times 5 (add original value) addd ,s++ std val0+val.int+2 ldd val0+val.int adcb 1,s adca ,s++ std val0+val.int bcs OVERROR lsl val0+val.int+3 ; times 10 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed ldd val0+val.int+2 ; get low word addb ,s+ ; add in current digit adca #0 std val0+val.int+2 ldd val0+val.int adcb #0 adca #0 std val0+val.int bcs OVERROR ; brif overflowed bpl eval_number4 ; brif we haven't wrapped negative cmpd #0x8000 ; is it valid negative two's complement? bhi OVERROR ; brif not ldd val0+val.int+2 ; is it still valid two's complement (max negative)? bne OVERROR ; brif so eval_number4 jsr nextchar ; fetch next input character bra eval_number5 ; go handle it OVERROR ldb #err_ov ; flag overflow jmp ERROR eval_numberr ldb val0+val.fpsign ; is the number we want negative? beq eval_numberr0 ; brif not jsr val_negint32 ; negate the integer eval_numberr0 rts eval_float jmp SNERROR ; we don't handle floating point yet ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Operator table ; ; Each entry starts with the precedence value followed by the handler routine. Each handler will receive its left ; operand in val1 and its right operand in val0 and should return its result in val0. oper_tab fcb 0x79 ; addition fdb oper_plus fcb 0x79 ; subtraction fdb oper_minus fcb 0x7b ; multiplication fdb SNERROR fcb 0x7b ; division fdb SNERROR fcb 0x7f ; exponentiation fdb SNERROR fcb 0x64 ; less than fdb SNERROR fcb 0x64 ; equal to fdb SNERROR fcb 0x64 ; greater than fdb SNERROR fcb 0x64 ; less than or equal to fdb SNERROR fcb 0x64 ; greater than or equal to fdb SNERROR fcb 0x64 ; not equal to fdb SNERROR fcb 0x50 ; boolean AND fdb SNERROR fcb 0x46 ; boolean OR fdb SNERROR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Operator handling routines ; ; binary plus: addition and concatenation oper_plus ldb val.type,x ; get type of the left operand cmpb valtype_string ; is it string? bne oper_plus0 ; brif not cmpb val.type,u ; is right operand also string? lbeq SNERROR ; brif so - do string concatenation oper_plus0 bsr val_matchtypes ; go match data types jmp val_add ; go add the values ; binary minus: subtraction oper_minus bsr val_matchtypes ; go match data types jmp val_sub ; do subtraction ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Arithmetic package ; ; This section contains routines that handle floating point and integer arithmetic. ; ; Most routines take a pointer to a value accumulator in X. Some take two pointers with the second in U. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Match operands for a numeric calculation. This works as follows: ; ; * If both operands are the same, ensure the type is numeric and return ; * If one operand is floating point, convert the other to floating point, as long as it is numeric ; * If one or both oeprands are not numeric, raise a type mismatch ; The operands are in (X) and (U) val_matchtypes ldb val.type,x ; get the type of first argument cmpb #valtype_int ; is it integer? beq val_matchtypes0 ; brif so cmpb #valtype_float ; is it floating point? beq val_matchtypes1 ; brif so TMERROR ldb #err_tm ; raise a type mismatch jmp ERROR val_matchtypes0 ldb val.type,u ; get type of second operand cmpb #valtype_int ; is it integer? bne val_matchtypes2 ; brif not val_matchtypes3 rts val_matchtypes2 cmpb #valtype_float ; is it floating point? bne TMERROR ; brif not - raise error pshs u ; save pointer to second operand bsr val_int32tofp ; convert first argument to floating point puls u,pc ; restore second operand pointer and return val_matchtypes1 ldb val.type,u ; get second argument type cmpb #valtype_float ; is it floating point? beq val_matchtypes3 ; brif so - we're good cmpb #valtype_int ; is it integer? bne TMERROR ; brif not - invalid type combination pshs x,u ; save value pointers leax ,u ; convert (U) to floating point bsr val_int32tofp puls x,u,pc ; restore argument pointers and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Negate the 32 bit integer (for fp mantissa) at (X) val_negint32 ldd zero ; subtract integer value from zero subd val.int+2,x std val.int+2,x ldd zero sbcb val.int+1,x sbca val.int,x std val.int,x rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Convert integer value at (X) to floating point value at (X). Enter at val_uint32tofp to treat the 32 bit value as ; unsigned. Otherwise enter at val_int32tofp to treat it as signed. val_uint32tofp clr val.fpsign,x ; for positive sign bra val_int32tofpp ; go process as positive val_int32tofp ldb val.int,x ; get sign to A sex sta val.fpsign,x ; set sign of result bpl val_int32tofpp ; brif positive - don't need to do a two's complement adjustment bsr val_negint32 ; negate the integer value val_int32tofpp ldb valtype_float ; set result to floating point stb val.type,x ldb #0xa0 ; exponent to have binary point to the right of the mantissa stb val.fpexp,x ; set the exponent clrb ; clear out extra precision bits ; fall through to normalize the value at (X) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Normalize floating point value at (X); this will shift the mantissa until there is a one in the leftmost ; bit of the mantissa. The algorithm is as follows: ; ; 1. Shift the mantissa left until a 1 bit is found in the high bit of the mantissa. ; 1a. If more than 40 bits of left shifts occur, determine that the value is zero and return ; 2. Adjust exponent based on number of shifts ; 2a. If new exponent went below -127, then underflow occurred and zero out value ; 2b. If new exponent went above +127, raise an overflow ; 3. If bit 7 of the extra precision byte is clear, return the resulting value ; 4. Add one to the mantissa ; 5. If a carry in (4) occurred, then set high bit of mantissa and bump exponent ; 6. If new exponent carries, then raise overflow ; 7. Return result. ; ; Note that if we carried in (4), the only possible result is that the mantissa ; rolled over to all zeroes so there is no need to shift the entire mantissa right ; nor is there any reason to check for additional rounding. ; ; The above algorithm has some optimizations in the code sequence below. fp_normalize pshs b ; save extra bits clrb ; set shift counter/exponent adjustment fp_normalize0 lda val.fpmant,x ; set flags on high word of mantissa bne fp_normalize2 ; brif we don't have a full byte to shift addb #8 ; account for a while byte of shifts ldu val.fpmant+1,x ; shift mantissa left 8 bits stu val.fpmant,x lda val.fpmant+3,x sta val.fpmant+2,x lda ,s ; and include extra bits sta val.fpmant+3,x clr ,s ; and blank extra bits cmpb #40 ; have we shifted 40 bits? blo fp_normalize0 ; brif not - keep shifting bra fp_normalize7 ; go zero out the value fp_normalize1 incb ; account for one bit of shifting lsl ,s ; shift mantissa and extra bits left (will not be more than 7 shifts) rol val.fpmant+3,x rol val.fpmant+2,x rol val.fpmant+1,x rol val.fpmant,x fp_normalize2 bpl fp_normalize1 ; brif we have to do a bit shift pshs b ; apply exponent counter to exponent lda val.fpexp,x suba ,s+ bls fp_normalize6 ; brif we underflowed to zero bcc fp_normalize3 ; brif we did not overflow OVERROR2 jmp OVERROR ; raise overflow fp_normalize3 lsl ,s+ ; set C if the high bit of extra precision is set bcs fp_normalize5 ; brif bit set - we have to do rounding fp_normalize4 rts ; return if no rounding fp_normalize5 ldu val.fpmant+2,x ; add one to mantissa leau 1,u stu val.fpmant+2,x bne fp_normalize4 ; brif low word doesn't carry ldu val.fpmant,x leau 1,u stu val.fpmant,x bne fp_normalize4 ; brif high word doesn't carry ror val.fpmant,x ; shift right C in to high bit of mantissa (already set to get here) inc val.fpexp,x ; bump exponent for a right shift beq OVERROR2 ; brif it overflows (> +127) rts ; return result (only possible result was mantissa wrapped to zero) fp_normalize6 clr val.fpmant,x ; clear mantissa clr val.fpmant+1,x clr val.fpmant+2,x clr val.fpmant+3,x fp_normalize7 clr val.fpexp,x ; clear exponent and sign clr val.fpsign,x puls b,pc ; clean up stack and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Addition and subtraction of values; must enter with values of matching types ; ; Calculates (X) + (U) -> (Y) (addition) ; Calculates (X) - (U) -> (Y) (subtraction) val_add ldb val.type,x ; get type of left operand stb val.type,y ; set result type cmpb #valtype_float ; is it float? beq fp_add ; brif so ldd val.int+2,x ; do the addition addd val.int+2,u std val.int+2,y ldd val.int,x adcb val.int+1,u adca val.int,u std val.int,y lbvs OVERROR ; brif calculation overflowed rts val_sub ldb val.type,x ; get type of left operand stb val.type,y ; set result type cmpb #valtype_float ; floating point? beq fp_sub ; brif so ldd val.int+2,x ; do the subtraction subd val.int+2,u std val.int+2,y ldd val.int,x sbcb val.int+1,u sbca val.int,u std val.int,y lbvs OVERROR ; brif overflow rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; FP subtraction: just invert the sign of the second operand and add; operands must be writable and they should be ; considered to be clobbered fp_sub com val.fpsign,u ; negate right operand ; fall through to addition ; FP addition: this requires that *both operands* are writable and they may be clobbered fp_add ldb val.fpexp,u ; is the second operand zero? beq fp_add0 ; brif so - it's a no-op - copy the left operand to the output lda val.fpexp,x ; is left operand zero? bne fp_add1 ; brif not - we have to do the add leau ,x ; copy the right operand to the output fp_add0 ldd ,u ; copy the value across std ,y ldd 2,u std 2,y ldd 4,u std 4,y rts fp_add1 subb val.fpexp,x ; get difference in exponents beq fp_add6 ; brif they're the same - no denormalizing is needed bhi fp_add2 ; brif second one is bigger, need to right-shift the mantissa of first exg x,u ; swap the operands (we can do that for addition)l second is now biggest negb ; invert the shift count fp_add2 cmpb #32 ; are we shifting more than 32 bits? blo fp_add0 ; brif so - we're effectively adding zero so bail out fp_add3 cmpb #8 ; have 8 bits to move? bhs fp_add5 ; brif not lda val.fpmant+2,x ; shift 8 bits right sta val.fpmant+3,x lda val.fpmant+1,x sta val.fpmant+2,x lda val.fpmant,x sta val.fpmant+1,x clr val.fpmant,x subb #8 ; account for 8 shifts bra fp_add3 ; see if we have a whole byte to shift fp_add4 lsr val.fpmant,x ; shift right one bit ror val.fpmant+1,x ror val.fpmant+2,x ror val.fpmant+3,x fp_add5 decb ; done all shifts? bmi fp_add4 ; brif not - do a shift fp_add6 ldb val.fpexp,u ; set exponent of result stb val.fpexp,y ldb val.fpsign,u ; fetch sign of larger value stb val.fpsign,y ; set result sign cmpb val.fpsign,x bne fp_add8 ; brif not - need to subtract the operands ldd val.fpmant+2,u ; add the mantissas addd val.fpmant+2,x std val.fpmant+2,y ldd val.fpmant,u adcb val.fpmant+1,x adca val.fpmant,x std val.fpmant,y clrb ; clear extra precision bits bcc fp_add7 ; brif no carry ror val.fpmant,y ; shift carry into mantissa ror val.fpmant+1,y ror val.fpmant+2,y ror val.fpmant+3,y rorb ; keep bits for founding inc val.fpexp,y ; bump exponent to account for shift lbeq OVERROR ; brif it overflowed fp_add7 leax ,y ; point to result jmp fp_normalize ; go normalize the result fp_add8 ldd val.fpmant+2,u ; subtract operands subd val.fpmant+2,x std val.fpmant+2,y ldd val.fpmant,u sbcb val.fpmant+1,x sbca val.fpmant,x std val.fpmant,y bcc fp_add7 ; brif we didn't carry - no need to fix up ldd zero ; negate the mantissa bits since we use sign+magnitude subd val.fpmant+2,y std val.fpmant+2,y ldd zero sbcb val.fpmant+1,y sbca val.fpmant,y std val.fpmant,y neg val.fpsign,y ; invert sign of result since we went past zero clrb ; clear extra precision bits bra fp_add7 ; go normalize the result and return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Pack a floating point value at (X) fp_packval ldb val.fpsign,x ; get sign bmi fp_packval ; brif negative - the default 1 bit will do ldb val.fpmant,x ; clear high bit of mantissa for positive andb #0x7f stb val.fpmant,x fp_packval0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Unpack a floating point value at (X) fp_unpackval0 ldb val.fpmant,x ; get high byte of mantissa sex ; now A is value for sign byte sta val.fpsign,x ; set sign orb #0x80 ; set high bit of mantissa stb val.fpmant,x rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The LIST command. ; ; Syntax: ; LIST ; LIST <line> ; LIST <line>- ; LIST -<line> ; LIST <start>-<end> cmd_list bne cmd_list1 ; brif we have arguments ldx progtext ; point to start of program cmd_list0 ldd #65535 ; set last line to list to max line number std binval bra cmd_list2 ; go do the listing cmd_list1 jsr parse_lineno ; parse starting line number (will default to 0) jsr prog_findline ; find the line or the one after where it would be jsr curchar ; are we at the end of the command? beq cmd_list2 ; brif so - we have a single line (binval will have the start line #) ldb #tok_minus ; insist on a - for a range if more than one line number jsr syncheckb beq cmd_list0 ; brif open ended ending - set to max line number jsr parse_lineno ; parse ending of range cmd_list2 ldd ,x ; are we at the end of the program? bne cmd_list4 ; brif not cmd_list3 rts cmd_list4 ldd 2,x ; get line number cmpd binval ; have we reached the end of the range? bhi cmd_list3 ; brif so - we're done jsr print_uint16d ; print out line number lda #0x20 ; and a space jsr writechr pshs x ; save start of this line (in case detokenizing exits early) leax 4,x ; move past line header bsr detokenize ; detokenize line to current output stream ldx [,s++] ; point to next line using saved pointer and clear it from the stack ; need to add a break check here bra cmd_list2 ; go handle another line ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Detokenize a line to the current output stream detokenize lda ,x+ ; get character from tokenized line bmi detokenize1 ; brif it's a keyword token lbeq writecondnl ; do a newline if needed and return cmpa #': ; is it a colon? bne detokenize0 ; brif not ldb ,x ; fetch subsequent character cmpb #tok_apos ; apostrophe version of REM? beq detokenize ; brif so - skip the colon cmpb #tok_else ; ELSE? beq detokenize ; brif so - skip the colon detokenize0 jsr writechr ; output it unmolested bra detokenize ; go handle another character detokenize1 ldu #primarydict ; point to primary dictionary table cmpa #0xff ; is it a secondary token? bne detokenize3 ; brif not ldu #secondarydict ; point to secondary dictionary table lda ,x+ ; get secondary token value bne detokenize3 ; brif not end of line leax -1,x ; don't consume the NUL detokenize2 lda #'! ; invalid token flag bra detokenize0 ; output it and continue detokenize3 anda #0x7f ; lose the high bit beq detokenize6 ; brif already at the right place detokenize4 ldb ,u ; end of dictionary table? beq detokenize2 ; brif so - show invalid tokenf lag detokenize5 ldb ,u+ ; fetch character in this keyboard bpl detokenize5 ; brif not end of keyword (high bit set) deca ; at the right token? bne detokenize4 ; brif not - skip another detokenize6 lda ,u+ ; get keyword character bmi detokenize7 ; brif end of keyword jsr writechr ; output it bra detokenize6 ; go fetch another detokenize7 anda #0x7f ; lose the high bit bra detokenize0 ; write it and move on with the input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Canonicalize certain sequences; ALL the rewrite sequences must make the result shorter or keep it the same size makecanontab fcb tok_less,2 fcb tok_greater,tok_notequal fcb tok_equal,tok_lessequal fcb tok_greater,2 fcb tok_less,tok_notequal fcb tok_equal,tok_greaterequal fcb tok_equal,2 fcb tok_greater,tok_greaterequal fcb tok_less,tok_lessequal fcb 0 makecanon leay ,x ; point output to start of the buffer makecanon0 lda ,x+ ; get current byte sta ,y+ ; save in output bne makecanon1 ; brif not end of line rts makecanon1 bpl makecanon0 ; brif not a token cmpa #0xff ; is it secondary? bne makecanon2 ; brif not leax 1,x ; move past second half bra makecanon0 ; go handle next byte makecanon2 ldu #makecanontab ; point to replacement table makecanon3 cmpa ,u+ ; is it this entry? beq makecanon4 ; brif so ldb ,u+ ; get number of entries lslb ; 2 bytes per leau b,u ; move past entry ldb ,u ; end of table? bne makecanon3 ; brif not bra makecanon0 ; no substitutions found makecanon4 pshs x ; save original source pointer makecanon5 lda ,x+ ; get next character cmpa #0x20 ; is it space? beq makecanon5 ; brif so - skip it ldb ,u+ ; get number of replacement candidates makecanon6 cmpa ,u++ ; does it match? beq makecanon7 ; brif so decb ; seen all of them? bne makecanon6 ; brif not puls x ; restore input pointer bra makecanon0 ; go handle next input makecanon7 leas 2,s ; clear saved input pointer lda -1,u ; get replacement token sta -1,y ; put it in the output bra makecanon0 ; go handle more input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Tokenize line to tokebuff ; ; Enter with X pointing to the text to tokenize. ; Exit with X pointing to the start of the tokenized line and D holding the length of the tokenized line. tokenize clr tok_skipkw ; clear "not token" flag clr tok_skipdt ; clear the "in data" flag ldy #tokebuff ; point to destination buffer pshs y ; set return value tokenize0 lda ,x+ ; get input character bne tokenize3 ; brif not end of input tokenize1 sta ,y+ ; blank out final byte in result tokenize2 ldx #tokebuff ; point to start of tokenized line bsr makecanon ; canonicalize certain sequences tfr y,d ; get end address to accumulator subd #tokebuff ; subtract out start; gives length of result puls x,pc ; set return pointer and return tokenize3 tst tok_skipkw ; are we in the middle of a "not token"? beq tokenize6 ; brif not jsr setcifalpha ; is it alpha bcs tokenize4 ; brif so - store it and continue jsr setcifdigit ; is it numeric? bcc tokenize5 ; brif not tokenize4 sta ,y+ ; save output character bra tokenize0 ; check for another tokenize5 clr tok_skipkw ; clear the "not token" flag tokenize6 cmpa #'" ; is it a string? bne tokenize8 ; brif not sta ,y+ ; save string delimiter tokenize7 lda ,x+ ; get input character beq tokenize1 ; brif end of input sta ,y+ ; save it in output cmpa #'" ; end of string? bne tokenize7 ; brif not bra tokenize0 ; brif tokenize8 cmpa #': ; end of statement? bne tokenize9 ; brif not clr tok_skipdt ; reset "in data" flag bra tokenize4 ; stash it and continue tokenize9 cmpa #0x20 ; is it a space? beq tokenize4 ; brif so - stash it unmodified tst tok_skipdt ; are we "in data"? bne tokenize4 ; brif so - don't tokenize it cmpa #'? ; PRINT shortcut? bne tokenize10 ; brif not lda #tok_print ; load token for PRINT bra tokenize4 ; move stash it and move on tokenize10 cmpa #'' ; ' shortcut for remark? bne tokenize12 ; brif not ldd #':*256+tok_apos ; put token for ' and an implied colon std ,y++ ; stash it tokenize11 lda ,x+ ; fetch byte from input sta ,y+ ; stash in output bne tokenize11 ; brif not end of input bra tokenize2 ; go finish up tokenize12 jsr setcifdigit ; is it a digit? bcs tokenize4 ; brif so - pass it through tsta ; is the high bit set? bmi tokenize0 ; ignore it if so ldu #primarydict ; point to keyword table leax -1,x ; back up input to start of potential token clr tok_kwtype ; set secondary table flag to primary table clr tok_kwmatch ; clear the matched token clr tok_kwmatch+1 clr tok_kwmatchl ; set length matched pshs x ; save start of input token tokenize13 clr tok_kwnum ; clear keyword number tokenize14 ldb ,u ; are we at the end of the table? bne tokenize16 ; brif not ldu #secondarydict ; point to secondary token dictionary com tok_kwtype ; flip to secondary token flag bne tokenize13 ; brif we haven't already done the secondaries puls x ; get back input pointer ldb tok_kwmatchl ; get length of best match beq tokenize15 ; brif we don't have a match abx ; move input pointer past matched token ldd tok_kwmatch ; get matched token number tsta ; is it a primary? beq tokenize24 ; brif so bra tokenize23 ; go stash two byte token tokenize15 com tok_skipkw ; set "not token flag" lda ,x+ ; get character bra tokenize4 ; stash it and continue tokenize16 ldx ,s ; get back start of input token clra ; initalize match length counter tokenize17 inca ; bump length counter ldb ,x+ ; get input character cmpb #'z ; is it above lower case Z? bhi tokenize18 ; brif so cmpb #'a ; is it below lower case A? blo tokenize18 ; brif so subb #0x20 ; convert to upper case tokenize18 subb ,u+ ; does it match? beq tokenize17 ; brif so - check another cmpb #0x80 ; did it match with high bit set? beq tokenize21 ; brif so - exact match leau -1,u ; back up to current test character tokenize19 ldb ,u+ ; end of token? bpl tokenize19 ; brif not tokenize20 inc tok_kwnum ; bump token counter bra tokenize14 ; go check another one tokenize21 cmpa tok_kwmatchl ; is it a longer match? bls tokenize20 ; brif not, ignore it sta tok_kwmatchl ; save new match length ldd tok_kwtype ; get the matched token count orb #0x80 ; set token flag std tok_kwmatch ; save matched token bra tokenize20 ; keep looking through the tables tokenize22 lda #': ; for putting implied colons in tokenize23 std ,y++ ; put output into buffer jmp tokenize0 ; go handle more input tokenize24 cmpb #tok_else ; is it ELSE? beq tokenize22 ; brif so - stash it with colon cmpb #tok_data ; is it DATA? bne tokenize26 ; brif not stb tok_skipdt ; set "in data" flag tokenize25 stb ,y+ ; stash token jmp tokenize0 ; go handle more tokenize26 cmpb #tok_rem ; is it REM? beq tokenize28 ; brif so cmpb #tok_apos ; apostrophe REM? bne tokenize25 ; brif not - stash token and continue lda #': ; stash the implied colon sta ,y+ bra tokenize28 tokenize27 ldb ,x+ ; fetch next input character tokenize28 stb ,y+ ; stash the character bne tokenize27 ; brif not end of input - do another jmp tokenize2 ; stash end of buffer and handle cleanup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Special tokenization handling ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Keyword dictionaries and jump tables. These are defined by several macros which ensure that each command or function ; entry has an associated jump table entry. These macros are: ; ; defcmd string,symbase ; deffunc string,symbase,flags ; cmdtab ; functab ; cmdjump ; funcjump ; defcmd and deffunc will add an entry into the relevant dictionary table as well as adding one to the relevant jump ; tables. The cmdtab, functab, cmdjump, and funcjump will output the table definitions. *pragmapush list *pragma nolist __cmdnum set 0x80 __funcnum set 0x80 defcmd macro noexpand setstr __cmdtab="%(__cmdtab)\tfcs {1}\n" ifstr ne,"{3}","" setstr __cmdjump="%(__cmdjump)\tfdb {3}\n" else setstr __cmdjump="%(__cmdjump)\tfdb cmd_{2}\n" endc tok_{2} equ __cmdnum __cmdnum set __cmdnum+1 endm deffunc macro noexpand setstr __functab="%(__functab)\tfcs {1}\n" ifstr ne,"{4}","" setstr __funcjump="%(__funcjump)\tfcb {3}\n\tfdb {4}\n" else setstr __funcjump="%(__funcjump)\tfcb {3}\n\tfdb func_{2}\n" endc tok_{2} equ __funcnum __funcnum set __funcnum+1 endm cmdtab macro *pragmapush list *pragma nolist includestr "%(__cmdtab)" *pragmapop list fcb 0 ; flag end of table endm functab macro *pragmapush list *pragma nolist includestr "%(__functab)" *pragmapop list fcb 0 ; flag end of table endm cmdjump macro *pragmapush nolist *pragma nolist includestr "%(__cmdjump)" *pragmapop list endm funcjump macro *pragmapush nolist *pragma nolist includestr "%(__funcjump)" *pragmapop list endm *pragmapop list defcmd 'REM',rem defcmd /'/,apos defcmd 'DATA',data defcmd 'ELSE',else defcmd 'END',end defcmd 'STOP',stop defcmd 'LET',let defcmd 'NEW',new defcmd 'PRINT',print defcmd 'LIST',list defcmd 'RUN',run defcmd 'GOTO',goto defcmd 'GOSUB',gosub defcmd 'RETURN',return defcmd 'POP',pop defcmd '+',plus,SNERROR ; IMPORTANT: the operators from + to OR MUST stay in this exact sequence defcmd '-',minus,SNERROR ; with no gaps because a secondary lookup table is used for operator defcmd '*',times,SNERROR ; handling during binary operator handling. defcmd '/',divide,SNERROR defcmd '^',power,SNERROR defcmd '<',less,SNERROR defcmd '>',greater,SNERROR defcmd '=',equal,SNERROR defcmd '<=',lessequal,SNERROR defcmd '>=',greaterequal,SNERROR defcmd '<>',notequal,SNERROR defcmd 'AND',and,SNERROR defcmd 'OR',or,SNERROR defcmd 'NOT',not,SNERROR primarydict cmdtab secondarydict functab primaryjump cmdjump secondaryjump funcjump ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Need to ensure the vectors are at 0xbff2 zmb 0xbff2-* ; pad ROM up to the vector point fdb SW3VEC ; SWI3 vector fdb SW2VEC ; SWI2 vector fdb FRQVEC ; FIRQ vector fdb IRQVEC ; IRQ vector fdb SWIVEC ; SWI vector fdb NMIVEC ; NMI vector fdb START ; RESET vector (ROM entry point) endc ifdef COCO3 zmb 0xfff2-* ; pad ROM to bottom of vectors fdb INT.SWI3 ; SWI3 vector fdb INT.SWI2 ; SWI2 vector fdb INT.FIRQ ; FIRQ vector fdb INT.IRQ ; IRQ vector fdb INT.SWI ; SWI vector fdb INT.NMI ; NMI vector fdb START ; RESET vector (ROM entry point) else zmb 0x10000-* ; pad ROM to full size endc