]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: guard against code section being empty.
[ocean] / csrc / oceani.mdc
index af24d9becd86326c48633e66cd0718a5510479da..6c5b4466a229ec73a63ac565e5e5300cbd43b740 100644 (file)
@@ -236,6 +236,11 @@ structures can be used.
                        }
                } else
                        ss = s;                         // NOTEST
+               if (!ss->code) {
+                       fprintf(stderr, "oceani: no code found in requested section\n");        // NOTEST
+                       exit(1);                        // NOTEST
+               }
+
                parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
 
                if (!context.prog) {
@@ -263,7 +268,7 @@ structures can be used.
                        free(s);
                        s = t;
                }
-               ## free context vars
+               ## free global vars
                ## free context types
                ## free context storage
                exit(context.parse_error ? 1 : 0);
@@ -498,8 +503,10 @@ Named type are stored in a simple linked list.  Objects of each type are
 
        static void free_value(struct type *type, struct value *v)
        {
-               if (type && v)
+               if (type && v) {
                        type->free(type, v);
+                       memset(v, 0x5a, type->size);
+               }
        }
 
        static void type_print(struct type *type, FILE *f)
@@ -846,6 +853,42 @@ cannot nest, so a declaration while a name is in-scope is an error.
                ## variable fields
        };
 
+When a scope closes, the values of the variables might need to be freed.
+This happens in the context of some `struct exec` and each `exec` will
+need to know which variables need to be freed when it completes.
+
+####### exec fields
+       struct variable *to_free;
+
+####### variable fields
+       struct exec *cleanup_exec;
+       struct variable *next_free;
+
+####### interp exec cleanup
+       {
+               struct variable *v;
+               for (v = e->to_free; v; v = v->next_free) {
+                       struct value *val = var_value(c, v);
+                       free_value(v->type, val);
+               }
+       }
+
+###### ast functions
+       static void variable_unlink_exec(struct variable *v)
+       {
+               struct variable **vp;
+               if (!v->cleanup_exec)
+                       return;
+               for (vp = &v->cleanup_exec->to_free;
+                   *vp; vp = &(*vp)->next_free) {
+                       if (*vp != v)
+                               continue;
+                       *vp = v->next_free;
+                       v->cleanup_exec = NULL;
+                       break;
+               }
+       }
+
 While the naming seems strange, we include local constants in the
 definition of variables.  A name declared `var := value` can
 subsequently be changed, but a name declared `var ::= value` cannot -
@@ -953,13 +996,13 @@ Each variable records a scope depth and is in one of four states:
   enclosed the declaration, and that has closed.
 
 - "conditionally in scope".  The "in scope" block and all parallel
-  scopes have closed, and no further mention of the name has been
-  seen.  This state includes a secondary nest depth which records the
-  outermost scope seen since the variable became conditionally in
-  scope.  If a use of the name is found, the variable becomes "in
-  scope" and that secondary depth becomes the recorded scope depth.
-  If the name is declared as a new variable, the old variable becomes
-  "out of scope" and the recorded scope depth stays unchanged.
+  scopes have closed, and no further mention of the name has been seen.
+  This state includes a secondary nest depth (`min_depth`) which records
+  the outermost scope seen since the variable became conditionally in
+  scope.  If a use of the name is found, the variable becomes "in scope"
+  and that secondary depth becomes the recorded scope depth.  If the
+  name is declared as a new variable, the old variable becomes "out of
+  scope" and the recorded scope depth stays unchanged.
 
 - "out of scope".  The variable is neither in scope nor conditionally
   in scope.  It is permanently out of scope now and can be removed from
@@ -1010,13 +1053,14 @@ need to be freed.  For this we need to be able to find it, so assume that
                            v->merged == secondary->merged) {
                                v->scope = OutScope;
                                v->merged = primary;
+                               variable_unlink_exec(v);
                        }
        }
 
 ###### forward decls
        static struct value *var_value(struct parse_context *c, struct variable *v);
 
-###### free context vars
+###### free global vars
 
        while (context.varlist) {
                struct binding *b = context.varlist;
@@ -1027,10 +1071,11 @@ need to be freed.  For this we need to be able to find it, so assume that
                        struct variable *t = v;
 
                        v = t->previous;
-                       free_value(t->type, var_value(&context, t));
-                       if (t->depth == 0)
-                               // This is a global constant
-                               free_exec(t->where_decl);
+                       if (t->global) {
+                               free_value(t->type, var_value(&context, t));
+                               if (t->depth == 0)
+                                       free_exec(t->where_decl);
+                       }
                        free(t);
                }
        }
@@ -1065,7 +1110,7 @@ switch.  Other scopes are "sequential".
 
 When exiting a parallel scope we check if there are any variables that
 were previously pending and are still visible. If there are, then
-there weren't redeclared in the most recent scope, so they cannot be
+they weren't redeclared in the most recent scope, so they cannot be
 merged and must become out-of-scope.  If it is not the first of
 parallel scopes (based on `child_count`), we check that there was a
 previous binding that is still pending-scope.  If there isn't, the new
@@ -1139,9 +1184,17 @@ all pending-scope variables become conditionally scoped.
                return v;
        }
 
-       static void var_block_close(struct parse_context *c, enum closetype ct)
+       static void var_block_close(struct parse_context *c, enum closetype ct,
+                                   struct exec *e)
        {
-               /* Close off all variables that are in_scope */
+               /* Close off all variables that are in_scope.
+                * Some variables in c->scope may already be not-in-scope,
+                * such as when a PendingScope variable is hidden by a new
+                * variable with the same name.
+                * So we check for v->name->var != v and drop them.
+                * If we choose to make a variable OutScope, we drop it
+                * immediately too.
+                */
                struct variable *v, **vp, *v2;
 
                scope_pop(c);
@@ -1150,11 +1203,19 @@ all pending-scope variables become conditionally scoped.
                     (v->scope == OutScope || v->name->var != v)
                     ? (*vp =  v->in_scope, 0)
                     : ( vp = &v->in_scope, 0)) {
-                       if (v->name->var != v) {
+                       v->min_depth = c->scope_depth;
+                       if (v->name->var != v)
                                /* This is still in scope, but we haven't just
                                 * closed the scope.
                                 */
                                continue;
+                       v->min_depth = c->scope_depth;
+                       if (v->scope == InScope) {
+                               /* This variable gets cleaned up when 'e' finishes */
+                               variable_unlink_exec(v);
+                               v->cleanup_exec = e;
+                               v->next_free = e->to_free;
+                               e->to_free = v;
                        }
                        switch (ct) {
                        case CloseElse:
@@ -1163,14 +1224,17 @@ all pending-scope variables become conditionally scoped.
                                case InScope:
                                case CondScope:
                                        if (c->scope_stack->child_count == 1)
+                                               /* first among parallel branches */
                                                v->scope = PendingScope;
                                        else if (v->previous &&
                                                 v->previous->scope == PendingScope)
+                                               /* all previous branches used name */
                                                v->scope = PendingScope;
-                                       else if (v->type == Tlabel)     // UNTESTED
+                                       else if (v->type == Tlabel)
+                                               /* Labels remain pending even when not used */
                                                v->scope = PendingScope;        // UNTESTED
-                                       else if (v->name->var == v)     // UNTESTED
-                                               v->scope = OutScope;    // UNTESTED
+                                       else
+                                               v->scope = OutScope;
                                        if (ct == CloseElse) {
                                                /* All Pending variables with this name
                                                 * are now Conditional */
@@ -1181,13 +1245,16 @@ all pending-scope variables become conditionally scoped.
                                        }
                                        break;
                                case PendingScope:
-                                       for (v2 = v;
-                                            v2 && v2->scope == PendingScope;
-                                            v2 = v2->previous)
-                                               if (v2->type != Tlabel)
-                                                       v2->scope = OutScope;
-                                       break;
-                               case OutScope: break;   // UNTESTED
+                                       /* Not possible as it would require
+                                        * parallel scope to be nested immediately
+                                        * in a parallel scope, and that never
+                                        * happens.
+                                        */                     // NOTEST
+                               case OutScope:
+                                       /* Not possible as we already tested for
+                                        * OutScope
+                                        */
+                                       abort();                // NOTEST
                                }
                                break;
                        case CloseSequential:
@@ -1206,10 +1273,9 @@ all pending-scope variables become conditionally scoped.
                                        for (v2 = v;
                                             v2 && v2->scope == PendingScope;
                                             v2 = v2->previous)
-                                               if (v2->type == Tlabel) {
+                                               if (v2->type == Tlabel)
                                                        v2->scope = CondScope;
-                                                       v2->min_depth = c->scope_depth;
-                                               } else
+                                               else
                                                        v2->scope = OutScope;
                                        break;
                                case CondScope:
@@ -1249,7 +1315,7 @@ is started, so there is no need to allocate until the size is known.
        {
                if (!v->global) {
                        if (!c->local || !v->type)
-                               return NULL;
+                               return NULL;                    // NOTEST
                        if (v->frame_pos + v->type->size > c->local_size) {
                                printf("INVALID frame_pos\n");  // NOTEST
                                exit(2);                        // NOTEST
@@ -1365,6 +1431,7 @@ from the `exec_types` enum.
        struct exec {
                enum exec_types type;
                int line, column;
+               ## exec fields
        };
        struct binode {
                struct exec;
@@ -1462,12 +1529,21 @@ also want to know what sort of bracketing to use.
        static void print_exec(struct exec *e, int indent, int bracket)
        {
                if (!e)
-                       return;         // NOTEST
+                       return;
                switch (e->type) {
                case Xbinode:
                        print_binode(cast(binode, e), indent, bracket); break;
                ## print exec cases
                }
+               if (e->to_free) {
+                       struct variable *v;
+                       do_indent(indent, "/* FREE");
+                       for (v = e->to_free; v; v = v->next_free)
+                               printf(" %.*s(%c%d+%d)", v->name->name.len, v->name->name.txt,
+                                      v->global ? 'G':'L',
+                                      v->frame_pos, v->type ? v->type->size:0);
+                       printf(" */\n");
+               }
        }
 
 ###### forward decls
@@ -1613,6 +1689,7 @@ in `rval`.
                ret.lval = lrv;
                ret.rval = rv;
                ret.type = rvtype;
+               ## interp exec cleanup
                return ret;
        }
 
@@ -2271,6 +2348,9 @@ or as an indented list of one parameter per line
        do
                code block
 
+For constructing these lists we use a `List` binode, which will be
+further detailed when Expression Lists are introduced.
+
 ###### Binode types
        Func, List,
 
@@ -2284,7 +2364,7 @@ or as an indented list of one parameter per line
                        $0->op = Func;
                        $0->left = reorder_bilist($<Ar);
                        $0->right = $<Bl;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        if (c->scope_stack && !c->parse_error) abort();
                }$
                | func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${
@@ -2292,7 +2372,7 @@ or as an indented list of one parameter per line
                        $0->op = Func;
                        $0->left = reorder_bilist($<Ar);
                        $0->right = $<Bl;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        if (c->scope_stack && !c->parse_error) abort();
                }$
                | func main NEWLINE OpenScope OptNL do Block Newlines ${
@@ -2300,7 +2380,7 @@ or as an indented list of one parameter per line
                        $0->op = Func;
                        $0->left = NULL;
                        $0->right = $<Bl;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        if (c->scope_stack && !c->parse_error) abort();
                }$
 
@@ -2734,6 +2814,57 @@ there.
                }
                break;
 
+### Expression list
+
+We take a brief detour, now that we have expressions, to describe lists
+of expressions.  These will be needed for function parameters and
+possibly other situations.  They seem generic enough to introduce here
+to be used elsewhere.
+
+And ExpressionList will use the `List` type of `binode`, building up at
+the end.  And place where they are used will probably call
+`reorder_bilist()` to get a more normal first/next arrangement.
+
+###### declare terminals
+       $TERM ,
+
+`List` execs have no implicit semantics, so they are never propagated or
+interpreted.  The can be printed as a comma separate list, which is how
+they are parsed.  Note they are also used for function formal parameter
+lists.  In that case a separate function is used to print them.
+
+###### print binode cases
+       case List:
+               while (b) {
+                       printf(" ");
+                       print_exec(b->left, -1, bracket);
+                       if (b->right)
+                               printf(",");
+                       b = cast(binode, b->right);
+               }
+               break;
+
+###### propagate binode cases
+       case List: abort(); // NOTEST
+###### interp binode cases
+       case List: abort(); // NOTEST
+
+###### Grammar
+
+       $*binode
+       ExpressionList -> ExpressionList , Expression ${
+                       $0 = new(binode);
+                       $0->op = List;
+                       $0->left = $<1;
+                       $0->right = $<3;
+               }$
+               | Expression ${
+                       $0 = new(binode);
+                       $0->op = List;
+                       $0->left = NULL;
+                       $0->right = $<1;
+               }$
+
 ### Expressions: Boolean
 
 The next class of expressions to use the `binode` will be Boolean
@@ -3431,62 +3562,47 @@ is in-place.
 expressions and prints the values separated by spaces and terminated
 by a newline.  No control of formatting is possible.
 
-`print` faces the same list-ordering issue as blocks, and uses the
-same solution.
+`print` uses `ExpressionList` to collect the expressions and stores them
+on the left side of a `Print` binode unlessthere is a trailing comma
+when the list is stored on the `right` side and no trailing newline is
+printed.
 
 ###### Binode types
        Print,
 
 ##### expr precedence
-       $TERM print ,
+       $TERM print
 
 ###### SimpleStatement Grammar
 
        | print ExpressionList ${
-               $0 = reorder_bilist($<2);
-       }$
-       | print ExpressionList , ${
                $0 = new(binode);
                $0->op = Print;
                $0->right = NULL;
-               $0->left = $<2;
-               $0 = reorder_bilist($0);
+               $0->left = reorder_bilist($<EL);
        }$
+       | print ExpressionList , ${ {
+               $0 = new(binode);
+               $0->op = Print;
+               $0->right = reorder_bilist($<EL);
+               $0->left = NULL;
+       } }$
        | print ${
                $0 = new(binode);
                $0->op = Print;
+               $0->left = NULL;
                $0->right = NULL;
        }$
 
-###### Grammar
-
-       $*binode
-       ExpressionList -> ExpressionList , Expression ${
-               $0 = new(binode);
-               $0->op = Print;
-               $0->left = $<1;
-               $0->right = $<3;
-               }$
-               | Expression ${
-                       $0 = new(binode);
-                       $0->op = Print;
-                       $0->left = NULL;
-                       $0->right = $<1;
-               }$
-
 ###### print binode cases
 
        case Print:
                do_indent(indent, "print");
-               while (b) {
-                       if (b->left) {
-                               printf(" ");
-                               print_exec(b->left, -1, bracket);
-                               if (b->right)
-                                       printf(",");
-                       }
-                       b = cast(binode, b->right);
-               }
+               if (b->right) {
+                       print_exec(b->right, -1, bracket);
+                       printf(",");
+               } else
+                       print_exec(b->left, -1, bracket);
                if (indent >= 0)
                        printf("\n");
                break;
@@ -3495,30 +3611,33 @@ same solution.
 
        case Print:
                /* don't care but all must be consistent */
-               propagate_types(b->left, c, ok, NULL, Rnolabel);
-               propagate_types(b->right, c, ok, NULL, Rnolabel);
+               if (b->left)
+                       b = cast(binode, b->left);
+               else
+                       b = cast(binode, b->right);
+               while (b) {
+                       propagate_types(b->left, c, ok, NULL, Rnolabel);
+                       b = cast(binode, b->right);
+               }
                break;
 
 ###### interp binode cases
 
        case Print:
        {
-               char sep = 0;
-               int eol = 1;
-               for ( ; b; b = cast(binode, b->right))
-                       if (b->left) {
-                               if (sep)
-                                       putchar(sep);
-                               left = interp_exec(c, b->left, &ltype);
-                               print_value(ltype, &left);
-                               free_value(ltype, &left);
-                               if (b->right)
-                                       sep = ' ';
-                       } else if (sep)
-                               eol = 0;
-               ltype = Tnone;
-               if (eol)
+               struct binode *b2 = cast(binode, b->left);
+               if (!b2)
+                       b2 = cast(binode, b->right);
+               for (; b2; b2 = cast(binode, b2->right)) {
+                       left = interp_exec(c, b2->left, &ltype);
+                       print_value(ltype, &left);
+                       free_value(ltype, &left);
+                       if (b2->right)
+                               putchar(' ');
+               }
+               if (b->right == NULL)
                        printf("\n");
+               ltype = Tnone;
                break;
        }
 
@@ -3653,7 +3772,6 @@ it is declared, and error will be raised as the name is created as
                struct value *val;
                v = v->merged;
                val = var_value(c, v);
-               free_value(v->type, val);
                if (v->type->prepare_type)
                        v->type->prepare_type(c, v->type, 0);
                if (b->right) {
@@ -3860,13 +3978,13 @@ casepart` to track a list of case parts.
                        $0->forpart = $<FP;
                        $0->thenpart = $<TP;
                        $0->looppart = $<WP;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        }$
                | ForPart OptNL WhilePart CondSuffix ${
                        $0 = $<CS;
                        $0->forpart = $<FP;
                        $0->looppart = $<WP;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        }$
                | WhilePart CondSuffix ${
                        $0 = $<CS;
@@ -3877,21 +3995,21 @@ casepart` to track a list of case parts.
                        $0->condpart = $<SP;
                        $CP->next = $0->casepart;
                        $0->casepart = $<CP;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        }$
                | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
                        $0 = $<CS;
                        $0->condpart = $<SP;
                        $CP->next = $0->casepart;
                        $0->casepart = $<CP;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        }$
                | IfPart IfSuffix ${
                        $0 = $<IS;
                        $0->condpart = $IP.condpart; $IP.condpart = NULL;
                        $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
                        // This is where we close an "if" statement
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                        }$
 
        CondSuffix -> IfSuffix ${
@@ -3915,12 +4033,12 @@ casepart` to track a list of case parts.
        ElsePart -> else OpenBlock Newlines ${
                        $0 = new(cond_statement);
                        $0->elsepart = $<OB;
-                       var_block_close(c, CloseElse);
+                       var_block_close(c, CloseElse, $0->elsepart);
                }$
                | else OpenScope CondStatement ${
                        $0 = new(cond_statement);
                        $0->elsepart = $<CS;
-                       var_block_close(c, CloseElse);
+                       var_block_close(c, CloseElse, $0->elsepart);
                }$
 
        $*casepart
@@ -3928,7 +4046,7 @@ casepart` to track a list of case parts.
                        $0 = calloc(1,sizeof(struct casepart));
                        $0->value = $<Ex;
                        $0->action = $<Bl;
-                       var_block_close(c, CloseParallel);
+                       var_block_close(c, CloseParallel, $0->action);
                }$
 
        $*exec
@@ -3939,7 +4057,7 @@ casepart` to track a list of case parts.
 
        ThenPart -> then OpenBlock ${
                        $0 = $<OB;
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0);
                }$
 
        $*binode
@@ -3949,33 +4067,33 @@ casepart` to track a list of case parts.
                        $0->op = Loop;
                        $0->left = $<UB;
                        $0->right = $<OB;
-                       var_block_close(c, CloseSequential);
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0->right);
+                       var_block_close(c, CloseSequential, $0);
                }$
                | while OpenScope Expression OpenScope ColonBlock ${
                        $0 = new(binode);
                        $0->op = Loop;
                        $0->left = $<Exp;
                        $0->right = $<CB;
-                       var_block_close(c, CloseSequential);
-                       var_block_close(c, CloseSequential);
+                       var_block_close(c, CloseSequential, $0->right);
+                       var_block_close(c, CloseSequential, $0);
                }$
 
        $cond_statement
        IfPart -> if UseBlock OptNL then OpenBlock ${
                        $0.condpart = $<UB;
                        $0.thenpart = $<OB;
-                       var_block_close(c, CloseParallel);
+                       var_block_close(c, CloseParallel, $0.thenpart);
                }$
                | if OpenScope Expression OpenScope ColonBlock ${
                        $0.condpart = $<Ex;
                        $0.thenpart = $<CB;
-                       var_block_close(c, CloseParallel);
+                       var_block_close(c, CloseParallel, $0.thenpart);
                }$
                | if OpenScope Expression OpenScope OptNL then Block ${
                        $0.condpart = $<Ex;
                        $0.thenpart = $<Bl;
-                       var_block_close(c, CloseParallel);
+                       var_block_close(c, CloseParallel, $0.thenpart);
                }$
 
        $*exec
@@ -4395,7 +4513,6 @@ analysis is a bit more interesting at this level.
 
 ###### print binode cases
        case Func:
-       case List:
                do_indent(indent, "func main(");
                for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
                        struct variable *v = cast(var, b2->left)->var;
@@ -4414,7 +4531,6 @@ analysis is a bit more interesting at this level.
                break;
 
 ###### propagate binode cases
-       case List:
        case Func: abort();             // NOTEST
 
 ###### core functions
@@ -4507,8 +4623,6 @@ analysis is a bit more interesting at this level.
        }
 
 ###### interp binode cases
-       case List: abort();     // NOTEST
-
        case Func:
                rv = interp_exec(c, b->right, &rvtype);
                break;