Implement absolute address for DATA statements.

This increases the parser size but is faster at run time, and allows the
cross compiler to optimize datas away from code, making compiled code
smaller.

Author: dmsc

src/actions.asm

@@ -22,25 +22,25 @@
         .export         E_REM, E_EOL, E_NUMBER_WORD, E_NUMBER_BYTE
         .export         E_PUSH_LT, E_POP_LOOP, E_POP_REPEAT
         .export         E_POP_IF, E_ELSEIF, E_EXIT_LOOP
-        .export         E_POP_WHILE, E_POP_FOR, E_POP_PROC_1, E_POP_PROC_2, E_POP_DATA
+        .export         E_POP_WHILE, E_POP_FOR, E_POP_PROC_DATA, E_POP_PROC_2
         .export         E_CONST_STRING
         .export         E_VAR_CREATE, E_VAR_WORD, E_VAR_SEARCH
-        .export         E_VAR_SET_TYPE
+        .export         E_VAR_SET_TYPE, E_LABEL_SET_TYPE
         .export         E_LABEL, E_LABEL_DEF
         .export         E_PUSH_VAR, E_POP_VAR
-        .exportzp       VT_WORD, VT_STRING, VT_FLOAT
+        .exportzp       VT_WORD, VT_STRING, VT_FLOAT, VT_UNDEF
         .exportzp       VT_ARRAY_WORD, VT_ARRAY_BYTE, VT_ARRAY_STRING, VT_ARRAY_FLOAT
-        .exportzp       LT_PROC_1, LT_PROC_2, LT_DATA, LT_DO_LOOP, LT_REPEAT, LT_WHILE_1, LT_WHILE_2, LT_FOR_1, LT_FOR_2, LT_EXIT, LT_IF, LT_ELSE, LT_ELIF
+        .exportzp       LT_PROC_DATA, LT_PROC_2, LT_DO_LOOP, LT_REPEAT, LT_WHILE_1, LT_WHILE_2, LT_FOR_1, LT_FOR_2, LT_EXIT, LT_IF, LT_ELSE, LT_ELIF
         .importzp       loop_sp, bpos, bptr, tmp1, tmp2, tmp3, opos
         ; From runtime.asm
         .import         read_word
         ; From vars.asm
         .import         var_search, name_new
-        .import         label_search
+        .import         list_search
         .importzp       var_namelen, label_count, var_count
         ; From alloc.asm
         .import         alloc_laddr
-        .importzp       prog_ptr, laddr_ptr, laddr_buf, var_ptr, label_ptr
+        .importzp       prog_ptr, laddr_ptr, laddr_buf, var_ptr, label_ptr, label_buf
         ; From parser.asm
         .import         parser_error, parser_skipws, parser_emit_byte, parser_inc_opos
         ; From error.asm
@@ -87,8 +87,7 @@ read_fp = AFP
                 ;                     ; EXIT?   PUSH?
                 ;                     ; bit-7   bit-6
                 LT_EXIT               ; error   yes
-                LT_PROC_1             ; error   yes
-                LT_DATA               ; error   yes
+                LT_PROC_DATA          ; error   yes
                 LT_FOR_2              ; yes     yes
                 LT_LAST_JUMP = 63
                 LT_PROC_2             ; yes     no
@@ -402,13 +401,16 @@ no_float:
 xit:    rts
 .endproc
 
-; Support for labels (PROC/EXEC)
+; Support for labels (DATA/PROC/EXEC)
 ; ------------------------------
 ;
 ; We keep two lists:
 ;  - label_buf/ptr: a list of all the labels, sorted by the label number.
 ;                   one byte for each character in the name, last byte with
 ;                   bit 7 set.
+;                   After the name there is one byte with the label type,
+;                   same as var-types.
+;
 ;  - laddr_buf/ptr: a list with each label reference:
 ;                   byte 0: the label number,
 ;                   byte 1: the type of reference,
@@ -433,14 +435,15 @@ xit:    rts
 ;
 ; Label definition search/create
 .proc   E_LABEL_DEF
+        lda     #0              ; Type of label: undefined
         jsr     label_create
 
         ; Fills all undefined labels with current position:
         bcs     nfound
 
         ; If we found a *definition* for the label, error out (label already
         ; defined).
-cloop:  bmi     error
+cloop:  bmi     xit_label_err
 
         ; Write current codep to AX
         jsr     patch_codep
@@ -460,25 +463,52 @@ nfound:
         jsr     add_laddr_list
         ; Ok, advance parsing pointer with the label length
         bcc     advance_varn
-
-error:  sec
         rts
 .endproc
 
+; Sets the type of the last label defined
+.proc   E_LABEL_SET_TYPE
+        jsr     get_last_tok    ; Get variable TYPE from last token
+
+        ldy     #$FF
+        dec     label_ptr+1
+        sta     (label_ptr), y  ; Store to (label_ptr - 1)
+        inc     label_ptr+1
+        clc
+xit:    rts
+.endproc
+
         ; Create a label if not exists and starts searching in the label
         ; address list.
         ;
         ; This jumps to next_laddr, so it returns the same values.
 .proc   label_create
         ; Check if we have a valid name - this exits on error!
-        jsr     label_search
-        bcc     xit
+        sta     tmp3    ; Store label type
+        ldx     #label_buf - prog_ptr
+        ldy     label_count
+        jsr     list_search
+        bcs     do_create
+        ; Check if type is compatible
+        cmp     tmp3
+        beq     no_create       ; Yes, search address
+xit_pop_2:              ; Exit from caller with error
+        pla
+        pla
+::xit_label_err:
+        sec
+        rts
+
+do_create:
+        ; See if we need to create it
+        lda     tmp3
+        bne     xit_pop_2
         ; Create a new label
         ldx     #label_ptr - prog_ptr
         jsr     name_new
         ldx     label_count
         inc     label_count
-xit:
+no_create:
         lda     laddr_buf
         ldy     laddr_buf+1
         sty     tmp1+1
@@ -560,6 +590,7 @@ xit:    rts
 
 ; Label search / create (on use)
 .proc   E_LABEL
+        jsr     get_last_tok    ; Get label TYPE from last token
         jsr     label_create
         ; Emits a label, searching the label address in the label list
         bcs     nfound
@@ -691,7 +722,7 @@ retry:  dey
         bmi     loop_error
         lda     loop_stk, y
         bmi     retry           ; FOR(2)/WHILE(2)/IF/ELSE/ELIF are > 127
-        cmp     #LT_DATA+1      ; PROC(1)/DATA
+        cmp     #LT_PROC_DATA+1 ; PROC(1)/DATA
         bcc     loop_error
 ok:
         ; Store slot
@@ -788,14 +819,9 @@ no_elif:
         rts
 .endproc
 
-.proc   E_POP_DATA
-        ; Pop saved position, store
-        lda     #LT_DATA
-        .byte   $2C   ; Skip 2 bytes over next "LDA"
-.endproc        ; Fall through
-.proc   E_POP_PROC_1
+.proc   E_POP_PROC_DATA
         ; Pop saved "jump to end" position
-        lda     #LT_PROC_1
+        lda     #LT_PROC_DATA
 .endproc        ; Fall through
 
 .proc   pop_patch_codep

src/basic.syn

@@ -86,9 +86,9 @@ EXTERN {
  E_REM, E_NUMBER_WORD, E_NUMBER_BYTE, E_EOL
  E_PUSH_LT, E_POP_LOOP, E_POP_REPEAT
  E_POP_IF, E_ELSEIF, E_EXIT_LOOP
- E_POP_WHILE, E_POP_FOR, E_POP_PROC_1, E_POP_PROC_2, E_POP_DATA
+ E_POP_WHILE, E_POP_FOR, E_POP_PROC_DATA, E_POP_PROC_2
  E_CONST_STRING
- E_VAR_CREATE, E_VAR_SET_TYPE
+ E_VAR_CREATE, E_VAR_SET_TYPE, E_LABEL_SET_TYPE
  E_VAR_WORD, E_VAR_SEARCH
  E_LABEL, E_LABEL_DEF
  E_PUSH_VAR, E_POP_VAR
@@ -176,6 +176,8 @@ ADR_EXPR: string or variable
         STR_EXPR
         emit { TOK_VAR_LOAD, VT_ARRAY_WORD   } E_VAR_SEARCH
         emit { TOK_VAR_LOAD, VT_ARRAY_BYTE   } E_VAR_SEARCH
+        emit { TOK_NUM, VT_ARRAY_WORD   } E_LABEL
+        emit { TOK_NUM, VT_ARRAY_BYTE   } E_LABEL
         emit { TOK_VAR_LOAD, VT_ARRAY_STRING } E_VAR_SEARCH
 #@if FASTBASIC_FP
         emit { TOK_VAR_LOAD, VT_ARRAY_FLOAT  } E_VAR_SEARCH "%"
@@ -388,9 +390,9 @@ VAR_CREATE_TYPE:
 # NOTE: the creation rule (E_VAR_SET_TYPE) always fails, so the parser uses the next
 #       rules using the created variable.
 VAR_WORD_LVALUE_SADDR: integer variable
+        ARRAY_WORD_ADDR emit TOK_SADDR
         E_VAR_CREATE VAR_CREATE_TYPE E_VAR_SET_TYPE
         emit TOK_VAR_SADDR E_VAR_WORD
-        ARRAY_WORD_ADDR emit TOK_SADDR
 
 VAR_STR_LVALUE_SADDR:
         emit { TOK_VAR_SADDR, VT_STRING } E_VAR_SEARCH "$"
@@ -441,6 +443,7 @@ SOUND_S1:
 # Word Arrays
 ARRAY_WORD_ADDR:
         emit { TOK_VAR_LOAD, VT_ARRAY_WORD } E_VAR_SEARCH emit TOK_PUSH PAR_EXPR emit { TOK_USHL, TOK_ADD }
+        emit { TOK_NUM, VT_ARRAY_WORD } E_LABEL emit TOK_PUSH PAR_EXPR emit { TOK_USHL, TOK_ADD }
 
 # String Arrays
 ARRAY_STRING_ADDR:
@@ -449,6 +452,7 @@ ARRAY_STRING_ADDR:
 # Byte Arrays
 ARRAY_BYTE_ADDR:
         emit { TOK_VAR_LOAD, VT_ARRAY_BYTE } E_VAR_SEARCH emit TOK_PUSH PAR_EXPR emit TOK_ADD
+        emit { TOK_NUM, VT_ARRAY_BYTE } E_LABEL emit TOK_PUSH PAR_EXPR emit TOK_ADD
 
 #@if FASTBASIC_FP
 # Float Arrays
@@ -559,16 +563,16 @@ DATA_BYTES: data byte
 DATA_TYPE: data type
         # Note: E_VAR_SET_TYPE skips white space, this allows spaces between
         #       the data type and the "=".
-        TYPE_BYTE E_VAR_SET_TYPE "=" E_NUMBER_BYTE DATA_BYTES
-        TYPE_WORD E_VAR_SET_TYPE "=" E_NUMBER_WORD DATA_WORDS
+        TYPE_BYTE EQUAL E_LABEL_SET_TYPE E_NUMBER_BYTE DATA_BYTES
+        TYPE_WORD EQUAL E_LABEL_SET_TYPE E_NUMBER_WORD DATA_WORDS
 
 DATA_END:
         ","
-        E_POP_DATA
+        E_POP_PROC_DATA
 
-DATA_VAR: new array name
-        emit TOK_VAR_SADDR E_VAR_CREATE "()" emit { TOK_CDATA, LT_DATA } E_PUSH_LT
-        pass
+DATA_VAR: new data array name
+        DATA_TYPE
+        emit { TOK_JUMP, LT_PROC_DATA } E_PUSH_LT E_LABEL_DEF "()" DATA_TYPE
 
 # Parse a line
 PARSE_LINE_COMMAND:
@@ -619,10 +623,10 @@ PARSE_LINE_COMMAND:
         "PAuse" EXPR emit TOK_PAUSE
         "INC" VAR_WORD_LVALUE_SADDR emit TOK_INC
         "DEc" VAR_WORD_LVALUE_SADDR emit TOK_DEC
-        "PROc" emit { TOK_JUMP, LT_PROC_1 } E_PUSH_LT E_LABEL_DEF emit LT_PROC_2 E_PUSH_LT
-        "ENDProc" E_POP_PROC_2 emit TOK_RET E_POP_PROC_1
-        "EXEc" emit TOK_CALL E_LABEL
-        "DAta" DATA_VAR DATA_TYPE DATA_END
+        "PROc" emit { TOK_JUMP, LT_PROC_DATA } E_PUSH_LT E_LABEL_DEF emit LT_PROC_2 E_PUSH_LT
+        "ENDProc" E_POP_PROC_2 emit TOK_RET E_POP_PROC_DATA
+        "EXEc" emit { TOK_CALL, VT_UNDEF } E_LABEL
+        "DAta" DATA_VAR DATA_END
         "END" emit TOK_END
 #@if FASTBASIC_FP
         "DEG" emit { TOK_1, TOK_BYTE_POKE, DEGFLAG }

src/compiler/looptype.cc

@@ -25,11 +25,10 @@ std::string get_loop_name(enum LoopType l)
 {
     switch( l )
     {
-        case LT_PROC_1:
         case LT_PROC_2:
             return "PROC";
-        case LT_DATA:
-            return "DATA";
+        case LT_PROC_DATA:
+            return "PROC/DATA";
         case LT_EXIT:
             return "EXIT";
         case LT_DO_LOOP:
@@ -55,12 +54,10 @@ std::string get_loop_name(enum LoopType l)
 
 LoopType get_looptype(std::string t)
 {
-    if( t == "LT_PROC_1" )
-        return LT_PROC_1;
+    if( t == "LT_PROC_DATA" )
+        return LT_PROC_DATA;
     if( t == "LT_PROC_2" )
         return LT_PROC_2;
-    if( t == "LT_DATA" )
-        return LT_DATA;
     if( t == "LT_DO_LOOP" )
         return LT_DO_LOOP;
     if( t == "LT_REPEAT" )

src/compiler/looptype.h

@@ -24,8 +24,7 @@
 
 enum LoopType {
     // First entries can't use "EXIT"
-    LT_PROC_1 = 0,
-    LT_DATA,
+    LT_PROC_DATA = 0,
     LT_EXIT,
     // From here, loops don't push jump destinations
     LT_LAST_JUMP = 32,

src/compiler/main.cc

@@ -168,7 +168,7 @@ int main(int argc, char **argv)
             break;
         ln++;
         if( do_debug )
-            std::cerr << iname << ": parsing line " << ln << "\n";
+            std::cout << iname << ": parsing line " << ln << "\n";
         s.new_line(line, ln);
         while( s.pos != line.length() )
         {
@@ -204,8 +204,8 @@ int main(int argc, char **argv)
     }
     if( do_debug )
     {
-        std::cerr << "parse end:\n";
-        std::cerr << "MAX LEVEL: " << s.maxlvl << "\n";
+        std::cout << "parse end:\n";
+        std::cout << "MAX LEVEL: " << s.maxlvl << "\n";
     }
     // Check unclosed loops
     auto loop_error = s.check_loops();