diff --git a/src/actions.asm b/src/actions.asm index 65e3e69..2eb59aa 100644 --- a/src/actions.asm +++ b/src/actions.asm @@ -38,10 +38,12 @@ .import read_word ; From vars.asm .import var_search, name_new, label_search - .importzp var_namelen, label_count, var_count + .importzp label_count, var_count ; From alloc.asm .import alloc_laddr .importzp prog_ptr, laddr_ptr, laddr_buf, var_ptr, label_ptr + ; From interpreter.asm + .importzp move_source ; From parser.asm .import parser_error, parser_skipws, parser_emit_byte, parser_inc_opos ; From error.asm @@ -300,60 +302,15 @@ cbyte: stx tmp2+1 .proc E_NUMBER_FP jsr read_fp bcs E_CONST_STRING::xrts - lda FR0 - ldx FR0+1 - jsr emit_AX - lda FR0+2 - ldx FR0+3 - jsr emit_AX - lda FR0+4 - ldx FR0+5 - jmp emit_AX -.endproc -.endif ; FASTBASIC_FP - -; Variable matching. -; The parser calls the routine to check if there is a variable -; with the correct type -.proc E_VAR_SEARCH - jsr get_last_tok ; Get variable TYPE from last token - .byte $2C ; Skip 2 bytes over next "LDA" -.endproc ; Fall through -.proc E_VAR_WORD - lda #VT_WORD - sta tmp3 ; Store variable type - ; Check if we have a valid name - this exits on error! - ; Search existing var - jsr var_search - bcs exit - cmp tmp3 - beq emit_varn -not_found: - sec -exit: + ldx #256-6 +loop: + lda <(FR0 - 250), x + jsr parser_emit_byte + inx + bne loop rts .endproc - -; Creates a new variable, with no type (the type will be set by parser next) -.proc E_VAR_CREATE - ; Check if we have a valid name - this exits on error! - ; Search existing var - jsr var_search - bcc E_VAR_WORD::not_found ; Exit with error if already exists - ; Create new variable - exits on error - ldx #var_ptr - prog_ptr - jsr name_new - ldx var_count - inc var_count - ; Fall through -.endproc - ; Emits the variable, advancing pointers. -.proc emit_varn - ; Store VARN - txa - clc - jmp parser_emit_byte -.endproc +.endif ; FASTBASIC_FP ; Sets the type of a variable - variable number and new type must be in the stack: .proc E_VAR_SET_TYPE @@ -473,34 +430,48 @@ xit: rts bne comp ; Assume laddr_buf+1 is never 0 .endproc -; Adds a label address pointer to the list -.proc add_laddr_list - pha - - lda laddr_ptr - sta tmp2 - lda laddr_ptr+1 - sta tmp2+1 - - lda #4 - jsr alloc_laddr - - ldy #0 - lda laddr_search_num - sta (tmp2), y - - pla +; Variable matching. +; The parser calls the routine to check if there is a variable +; with the correct type +.proc E_VAR_SEARCH + jsr get_last_tok ; Get variable TYPE from last token + .byte $2C ; Skip 2 bytes over next "LDA" +.endproc ; Fall through +.proc E_VAR_WORD + lda #VT_WORD + sta tmp3 ; Store variable type + ; Check if we have a valid name - this exits on error! + ; Search existing var + jsr var_search + bcs exit + cmp tmp3 + beq emit_varn +::xit_label_err: +not_found: + sec +exit: + rts +.endproc - iny - sta (tmp2), y - jsr get_codep - ldy #3 - sta (tmp2), y - dey +; Creates a new variable, with no type (the type will be set by parser next) +.proc E_VAR_CREATE + ; Check if we have a valid name - this exits on error! + ; Search existing var + jsr var_search + bcc E_VAR_WORD::not_found ; Exit with error if already exists + ; Create new variable - exits on error + ldx #var_ptr - prog_ptr + jsr name_new + ldx var_count + inc var_count + ; Fall through +.endproc + ; Emits the variable, advancing pointers. +.proc emit_varn + ; Store VARN txa - sta (tmp2), y - ; clc ; get_codep clears carry -xit: rts + clc + jmp parser_emit_byte .endproc ; Pushes the PROC/DATA loop, search, create a label and define the location @@ -533,7 +504,49 @@ cloop: bmi xit_label_err ; No more entries, adds our address as a "definition" (A = 128) nfound: lda #128 - bmi add_laddr_list +.endproc ; Fall through + +; Adds a label address pointer to the list +; Note: relies on alloc_laddr expanding laddr_ptr = mem_end, where move_dwn is +; called with length = 0 and returns with move_source unchanged (pointing to +; the newly allocated 4-byte slot). +.proc add_laddr_list + pha + + lda #4 + jsr alloc_laddr + + jsr get_codep + ldy #3 + sta (move_source), y + dey + txa + sta (move_source), y + dey + pla + sta (move_source), y + dey + lda laddr_search_num + sta (move_source), y + ; clc ; get_codep clears carry +xit: rts +.endproc + +; Label search and create if not exists +.proc E_LABEL_CREATE + jsr label_search + txa + jsr push_var ; Does not modify C + ; Already defined, just store index + bcc E_VAR_WORD::exit + +do_create: + ; Create a new label + ldx #label_ptr - prog_ptr + jsr name_new + inc label_count + clc + rts .endproc ; Label search on use @@ -543,15 +556,14 @@ nfound: ; Check if we have a valid name - this exits on error! jsr label_search - bcs xit + bcs E_VAR_WORD::exit ; Check if type is compatible cmp tmp3 - beq start_searching -::xit_label_err: - sec -xit: rts + bne xit_label_err + ; Search the label address in the label list (X = label index) + beq start_searching ; Get EXEC label address and store - this is split because we first parse the ; label (and create it if needed), then parse arguments and at last emit the ; call address @@ -577,25 +589,6 @@ cloop: nfound: lda #0 jsr add_laddr_list bcc emit_addr -ret: rts -.endproc - -; Label search and create if not exists -.proc E_LABEL_CREATE - jsr label_search - txa - jsr push_var ; Does not modify C - ; Already defined, just store index - bcc ret - -do_create: - ; Create a new label - ldx #label_ptr - prog_ptr - jsr name_new - inc label_count - clc -ret: rts - .endproc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -744,7 +737,7 @@ bad_return: jsr pop_codep::get jsr patch_codep ; And check for more possible EXIT's - jmp check_loop_exit + bcc check_loop_exit .endproc .proc E_EXIT_LOOP @@ -796,16 +789,13 @@ move: lda #LT_WHILE_2 ; Save current position jsr pop_patch_codep - ; Pop saved "loop reentry" position - lda #LT_WHILE_1 ; And store dec opos dec opos - jsr pop_emit_addr - ; Checks for an "EXIT" - jmp check_loop_exit -.endproc - + ; Pop saved "loop reentry" position + lda #LT_WHILE_1 + .byte $2C ; Skip 2 bytes over next "LDA" +.endproc ; Fall through .proc E_POP_LOOP ; Pop saved position, store lda #LT_DO_LOOP @@ -816,7 +806,7 @@ move: lda #LT_REPEAT jsr pop_emit_addr ; Checks for an "EXIT" - jmp check_loop_exit + bcc check_loop_exit .endproc .proc E_POP_FOR @@ -831,7 +821,7 @@ move: ; Save current position jsr pop_patch_codep ; Checks for an "EXIT" - jmp check_loop_exit + bcc check_loop_exit .endproc .proc E_POP_IF diff --git a/src/alloc.asm b/src/alloc.asm index 0bcadf7..95b8c6d 100644 --- a/src/alloc.asm +++ b/src/alloc.asm @@ -94,6 +94,10 @@ alloc_size= tmp1 .endproc ; Fall through .proc alloc_laddr + ; Note: add_laddr_list relies on laddr_ptr being at mem_end (so the + ; move length is 0 and move_dwn leaves move_source pointing to the old + ; laddr_ptr; if length != 0, move_dwn returns move_source - 1). + .assert laddr_ptr = mem_end, error, "laddr_ptr must be at mem_end" ldx #laddr_ptr - mem_start .endproc ; Fall through diff --git a/src/parse.asm b/src/parse.asm index 9928efb..1b8b9a0 100644 --- a/src/parse.asm +++ b/src/parse.asm @@ -50,11 +50,12 @@ .segment "IDEZP": zeropage buf_ptr:.res 2 bmax: .res 1 -pptr: .res 2 parse_err: .res 1 ; Error to report if the statement does not parse +pptr: .res 1 ; This variables are cleared in one loop: zp_clear_start: + .res 1 ; pptr+1 opos: .res 1 linenum: .res 2 loop_sp: .res 1 @@ -260,9 +261,8 @@ ucase_end: inc buf_ptr+1 : - lda #0 parse_start: - ; Parse statement, A=0 on input + ; Parse statement, pptr+1=0 on input ldx #ERR_PARSE stx parse_err ldx #<(PARSE_START-1) @@ -270,6 +270,7 @@ parse_start: ; Parser sub parser_sub: + lda pptr+1 pha lda pptr pha @@ -339,7 +340,6 @@ pcall: bcc pcall_ml tay - lda pptr+1 bcs parser_sub ; Jump always pemit_ret: @@ -362,14 +362,14 @@ pexit_ok: inc bpos lda (bptr), y eor #':' ; Colon: continue parsing line - beq parse_start ; jump with A=0 + beq parse_start ; Current syntax file always checks for EOL at the end of parsing, ; no need to check here ; eor #$9B^':' ; bne set_parse_error - ; End parsing of current line, jump with A=0 + ; End parsing of current line jmp parse_line ; Calls a machine-language subroutine diff --git a/src/vars.asm b/src/vars.asm index 9fdea24..9d93d7d 100644 --- a/src/vars.asm +++ b/src/vars.asm @@ -20,7 +20,6 @@ ; -------------------------------------------- .export var_search, label_search, name_new - .exportzp var_namelen ; From alloc.asm .importzp var_buf, prog_ptr, label_count, var_count, label_buf @@ -47,9 +46,6 @@ len: .res 1 search_count: .res 1 -; Use a longer name for external references -var_namelen= len - ;---------------------------------------------------------- .code @@ -204,17 +200,13 @@ exit_2: ; Common proc to add a new label or variable ; X = ZP address of label/var table pointer + ; Always called after var_search/label_search with C=1 and "var" + ; already pointing to the end of the table. .proc name_new - ; Pointer to end of var/label list to "var" - lda prog_ptr, x - sta var - lda prog_ptr+1, x - sta var+1 ; Allocate memory for name lda len beq var_getlen::exit_2 - clc - adc #1 + adc #0 ; C=1 on entry, so A = len + 1 jsr alloc_area_8 ; Set type to 0 initially