Mercurial > hg > index.cgi
view src/progctrl.s @ 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 | |
| children | a6a53e5c04bd |
line wrap: on
line source
*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