Add functions

manual.md

@@ -1414,6 +1414,50 @@ Control Statements
   appear any place in the program.
 
 
+**Return From A Subroutine**
+**RETURN [_expression_] / RET.**
+
+  Ends the current `PROC`.  With an
+  _expression_, returns its integer value
+  as the function result.  Without an
+  expression, returns immediately with no
+  result; this is useful as an early exit
+  from nested loops.
+
+  `RETURN` is only valid inside a `PROC`.
+  Using it outside a `PROC` gives the `bad
+  RETURN` compiler error.
+
+  Subroutines that return a value can
+  be called in integer expressions with
+  `@name(...)`:
+
+      PROC Square X
+        RETURN X*X
+      ENDPROC
+
+      ? @Square(5)
+      A(1) = @Square(4)
+
+  Function arguments use the same syntax
+  as `EXEC` arguments, but the call must
+  use parentheses in an expression, so it
+  is distinct from the cross-compiler
+  `@symbol` address syntax.  The function
+  result is an integer.  A function should
+  contain at least one value-returning
+  `RETURN`; a bare `RETURN` does not
+  count.  The cross compiler reports an
+  error if it does not.  It does not
+  require every control-flow path to
+  return.
+
+  `RETURN` inside an `IF` is allowed.
+  `RETURN` inside a `FOR` loop is also
+  allowed; any active `FOR` state is
+  removed before returning.
+
+
 **Loop Until Condition Is True**  
 **REPEAT / R.**  
 **UNTIL _condition_ / U.**

src/actions.asm

@@ -23,6 +23,7 @@
         .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_DATA, E_POP_PROC_2
+        .export         E_RETURN
         .export         E_CONST_STRING
         .export         E_VAR_CREATE, E_VAR_WORD, E_VAR_SEARCH
         .export         E_VAR_SET_TYPE, E_LABEL_SET_TYPE
@@ -45,6 +46,9 @@
         .import         parser_error, parser_skipws, parser_emit_byte, parser_inc_opos
         ; From error.asm
         .importzp       ERR_LOOP, parse_err
+        .importzp       ERR_RETURN
+        ; From for_exit.asm
+        .importzp       TOK_FOR_EXIT
 
 .ifdef FASTBASIC_FP
         ; Exported only in Floating Point version
@@ -104,14 +108,14 @@ read_fp = AFP
 ;----------------------------------------------------------
 ; Use cassette buffer for loop stack, max 128 bytes
 loop_stk        =       $400
-; And at $480 store the "variable" stack, used procedure parameters
+; At $480 store the "variable" stack, used for variable IDs and the current
+; function label around nested function calls.
 var_stk         =       $480
 
 ;----------------------------------------------------------
         .segment "IDEZP": zeropage
         ; Relocation amount
 reloc_addr:     .res    2
-last_label_num: .res    1
 laddr_search_num: .res  1
 loop_exit_comp = laddr_search_num
 
@@ -505,7 +509,10 @@ xit:    rts
         jsr     push_codep
 
         ; Search in the label list
-        ldx     last_label_num
+        dec     var_sp
+        ldx     var_sp
+        lda     var_stk, x
+        tax
         jsr     laddr_search_start
         bcs     nfound
 
@@ -554,7 +561,10 @@ xit:    rts
 ::E_DO_EXEC:
 
         ; Emits a label, searching the label address in the label list
-        ldx     last_label_num
+        dec     var_sp
+        ldx     var_sp
+        lda     var_stk, x
+        tax
 start_searching:
         jsr     laddr_search_start
         bcs     nfound
@@ -579,7 +589,10 @@ ret:    rts
 ; Label search and create if not exists
 .proc   E_LABEL_CREATE
         jsr     label_search
-        stx     last_label_num
+        ldy     var_sp
+        txa
+        sta     var_stk, y
+        inc     var_sp
         ; Already defined, just store index
         bcc     ret
 
@@ -693,6 +706,28 @@ rtsclc: clc
         rts     ; C is cleared on exit!
 .endproc
 
+.proc   E_RETURN
+        ; Find the enclosing PROC, removing any active FOR state.
+        ldx     loop_sp
+        beq     bad_return
+loop:
+        lda     loop_stk-3, x
+        cmp     #LT_PROC_2
+        beq     pop_codep::rtsclc
+        cmp     #LT_FOR_1
+        bne     next
+        lda     #TOK_FOR_EXIT
+        jsr     parser_emit_byte
+next:
+        dex
+        dex
+        dex
+        bne     loop
+bad_return:
+        ldy     #ERR_RETURN
+        jmp     parser_error
+.endproc
+
 .proc   E_POP_PROC_2
         ; Pop saved position, store
         lda     #LT_PROC_2
@@ -725,7 +760,6 @@ retry:  dey
         bmi     retry           ; FOR(2)/WHILE(2)/IF/ELSE/ELIF are > 127
         cpx     #LT_PROC_DATA+1 ; PROC(1)/DATA
         bcc     loop_error
-ok:
         ; Store slot
         sty     loop_exit_comp
         ; Check if enough stack

src/compiler/compile.cc

@@ -261,6 +261,14 @@ int compiler::compile_file(std::string iname, std::string output_filename,
         return 1;
     }
 
+    // Check functions used in expressions return a value somewhere.
+    auto function_error = s.validate_functions();
+    if(function_error.size())
+    {
+        std::cerr << iname << ": " << function_error << "\n";
+        return 1;
+    }
+
     s.emit_tok("TOK_END");
     // Optimize
     if(optimize)

src/compiler/parser-actions.cc

@@ -127,6 +127,15 @@ static bool get_asm_word_constant(parse &s)
         // Reads ASM constant
         if(s.get_ident(name))
         {
+            // A following '(' means a user function call, not an ASM symbol.
+            auto ident_end = s.pos;
+            s.skipws();
+            if(s.pos < s.str.size() && s.str[s.pos] == '(')
+            {
+                s.pos = start;
+                return false;
+            }
+            s.pos = ident_end;
             s.add_text("@" + name);
             s.add_s_var("@" + name);
             s.emit_word(name);
@@ -399,6 +408,28 @@ static bool SMB_E_POP_PROC_DATA(parse &s)
     return true;
 }
 
+static bool SMB_E_RETURN(parse &s)
+{
+    s.debug("E_RETURN");
+    int proc = -1;
+    for(int i = (int)s.jumps.size() - 1; i >= 0; i--)
+    {
+        if(s.jumps[i].type == LT_PROC_2)
+        {
+            proc = i;
+            break;
+        }
+    }
+    if(proc < 0)
+        return s.loop_error("return outside proc");
+    for(int i = (int)s.jumps.size() - 1; i > proc; i--)
+    {
+        if(s.jumps[i].type == LT_FOR_1)
+            s.emit_tok("TOK_FOR_EXIT");
+    }
+    return true;
+}
+
 static bool SMB_E_POP_PROC_2(parse &s)
 {
     // nothing to do!
@@ -597,10 +628,17 @@ static bool SMB_E_LABEL_DEF(parse &s)
     s.debug("E_LABEL_DEF");
     auto &v = s.labels;
     auto name = s.last_label;
+    s.proc_names[l] = name;
     if(v[name].is_defined())
         return s.loop_error("new label, got label already defined '" + name + "'");
     s.current_params = 0;
     s.emit_label(s.label_prefix + name);
+    // The label remains current for E_PROC_CHECK / E_LABEL_SET_TYPE; discard
+    // the saved outer context.
+    if(!s.label_stack.empty())
+        s.label_stack.pop_back();
+    if(!s.param_stack.empty())
+        s.param_stack.pop_back();
     return true;
 }
 
@@ -632,6 +670,25 @@ static bool SMB_E_COUNT_PARAM(parse &s)
     return false;
 }
 
+static bool SMB_E_MARK_FUNCTION(parse &s)
+{
+    s.debug("E_MARK_FUNCTION");
+    s.labels[s.last_label].mark_function_call();
+    return true;
+}
+
+static bool SMB_E_MARK_RETURN(parse &s)
+{
+    s.debug("E_MARK_RETURN");
+    if(!s.proc_stack.empty())
+    {
+        auto name = s.proc_names.find(s.proc_stack.back());
+        if(name != s.proc_names.end())
+            s.labels[name->second].mark_return();
+    }
+    return true;
+}
+
 // Called in EXEC, creates a label if not exists, if already exists checks
 // that it is a PROC.
 static bool SMB_E_LABEL_CREATE(parse &s)
@@ -648,6 +705,8 @@ static bool SMB_E_LABEL_CREATE(parse &s)
     // Store variable name
     s.add_text(name);
     s.add_s_var(name);
+    s.label_stack.push_back(s.last_label);
+    s.param_stack.push_back(s.current_params);
     s.last_label = name;
     s.current_params = 0;
     return true;
@@ -664,6 +723,12 @@ static bool SMB_E_DO_EXEC(parse &s)
                               std::to_string(pnum),
                           s.pos);
     s.emit_word(s.label_prefix + s.last_label);
+    if(s.label_stack.empty() || s.param_stack.empty())
+        return false;
+    s.last_label = s.label_stack.back();
+    s.label_stack.pop_back();
+    s.current_params = s.param_stack.back();
+    s.param_stack.pop_back();
     return true;
 }
 
@@ -743,6 +808,8 @@ static bool SMB_E_DATA_FILE(parse &s)
 static std::map<std::string, bool (*)(parse &s)> actions = {
     {"E_CONST_STRING", SMB_E_CONST_STRING},
     {"E_COUNT_PARAM", SMB_E_COUNT_PARAM},
+    {"E_MARK_FUNCTION", SMB_E_MARK_FUNCTION},
+    {"E_MARK_RETURN", SMB_E_MARK_RETURN},
     {"E_DATA_FILE", SMB_E_DATA_FILE},
     {"E_DO_EXEC", SMB_E_DO_EXEC},
     {"E_ELSEIF", SMB_E_ELSEIF},
@@ -769,6 +836,7 @@ static std::map<std::string, bool (*)(parse &s)> actions = {
     {"E_PUSH_LT", SMB_E_PUSH_LT},
     {"E_PUSH_VAR", SMB_E_PUSH_VAR},
     {"E_REM", SMB_E_REM},
+    {"E_RETURN", SMB_E_RETURN},
     {"E_VAR_CREATE", SMB_E_VAR_CREATE},
     {"E_VAR_SEARCH", SMB_E_VAR_SEARCH},
     {"E_VAR_SET_TYPE", SMB_E_VAR_SET_TYPE},

src/compiler/parser.h

@@ -159,7 +159,10 @@ class parse
     std::vector<std::string> proc_stack;
     std::map<std::string, int> vars;
     std::map<std::string, labelType> labels;
+    std::map<std::string, std::string> proc_names; // internal loop label -> name
     std::vector<jump> jumps;
+    std::vector<int> param_stack; // saved current_params around label contexts
+    std::vector<std::string> label_stack; // saved last_label around label contexts
     int label_num;
     bool finalized;
     std::vector<codew> *code;
@@ -241,6 +244,19 @@ class parse
         return "EXIT without loop";
     }
 
+    std::string validate_functions()
+    {
+        // Cross-compiler diagnostic: a procedure used as a function must
+        // contain at least one RETURN.  We deliberately do not try to prove
+        // that every control-flow path returns.
+        for(auto &l : labels)
+        {
+            if(l.second.is_function_call() && !l.second.has_return())
+                return "function '" + l.first + "' does not return a value";
+        }
+        return std::string();
+    }
+
     void set_input_file(std::string fn) { in_fname = fn; }
 
     void new_line(std::string l, int ln)