]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: clean up interp_prog()
[ocean] / csrc / oceani.mdc
index 3474508cf6a7018b186c795196f1822ee1332116..b83f6bca4e5a3683d1166281cca7c2852e4dfd9b 100644 (file)
@@ -105,6 +105,7 @@ structures can be used.
 
 ###### Parser: header
        ## macros
+       struct parse_context;
        ## ast
        struct parse_context {
                struct token_config config;
@@ -242,7 +243,7 @@ structures can be used.
                                fprintf(stderr, "oceani: type error in program - not running.\n");
                                exit(1);
                        }
-                       interp_prog(context.prog, argv+optind+1);
+                       interp_prog(&context, context.prog, argv+optind+1);
                }
                free_exec(context.prog);
 
@@ -429,6 +430,7 @@ Named type are stored in a simple linked list.  Objects of each type are
                struct type *next;
                int size, align;
                void (*init)(struct type *type, struct value *val);
+               void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
                void (*print)(struct type *type, struct value *val);
                void (*print_type)(struct type *type, FILE *f);
                int (*cmp_order)(struct type *t1, struct type *t2,
@@ -532,12 +534,14 @@ Named type are stored in a simple linked list.  Objects of each type are
                        printf("*Unknown*");            // NOTEST
        }
 
-       static struct value *val_alloc(struct type *t, struct value *init)
+       static struct value *val_alloc(struct parse_context *c, struct type *t,
+                                      struct value *init)
        {
                struct value *ret;
 
-               if (!t->size)
-                       val_init(t, NULL);
+               if (t->prepare_type)
+                       t->prepare_type(c, t, 0);
+
                ret = calloc(1, t->size);
                if (init)
                        memcpy(ret, init, t->size);
@@ -1419,11 +1423,12 @@ in `rval`.
                struct value rval, *lval;
        };
 
-       static struct lrval _interp_exec(struct exec *e);
+       static struct lrval _interp_exec(struct parse_context *c, struct exec *e);
 
-       static struct value interp_exec(struct exec *e, struct type **typeret)
+       static struct value interp_exec(struct parse_context *c, struct exec *e,
+                                       struct type **typeret)
        {
-               struct lrval ret = _interp_exec(e);
+               struct lrval ret = _interp_exec(c, e);
 
                if (!ret.type) abort();
                if (typeret)
@@ -1433,16 +1438,19 @@ in `rval`.
                return ret.rval;
        }
 
-       static struct value *linterp_exec(struct exec *e, struct type **typeret)
+       static struct value *linterp_exec(struct parse_context *c, struct exec *e,
+                                         struct type **typeret)
        {
-               struct lrval ret = _interp_exec(e);
+               struct lrval ret = _interp_exec(c, e);
 
-               if (typeret)
+               if (ret.lval)
                        *typeret = ret.type;
+               else
+                       free_value(ret.type, &ret.rval);
                return ret.lval;
        }
 
-       static struct lrval _interp_exec(struct exec *e)
+       static struct lrval _interp_exec(struct parse_context *c, struct exec *e)
        {
                struct lrval ret;
                struct value rv = {}, *lrv = NULL;
@@ -1485,10 +1493,6 @@ different phases of parse, analyse, print, interpret.
 
 Thus far we have arrays and structs.
 
-Some complex types need do not exist in a name table, so they are kept
-on a linked list in the context (`anon_typelist`).  This allows them to
-be freed when parsing is complete.
-
 #### Arrays
 
 Arrays can be declared by giving a size and a type, as `[size]type' so
@@ -1503,39 +1507,67 @@ ever be referenced by the name it is declared with.  It is likely that
 a "`copy`" primitive will eventually be define which can be used to
 make a copy of an array with controllable recursive depth.
 
+For now we have two sorts of array, those with fixed size either because
+it is given as a literal number or because it is a struct member (which
+cannot have a runtime-changing size), and those with a size that is
+determined at runtime - local variables with a const size.  The former
+have their size calculated at parse time, the latter at run time.
+
+For the latter type, the `size` field of the type is the size of a
+pointer, and the array is reallocated every time it comes into scope.
+
+We differentiate struct fields with a const size from local variables
+with a const size by whether they are prepared at parse time or not.
+
 ###### type union fields
 
        struct {
-               int size;
+               short size;
+               short static_size;
                struct variable *vsize;
                struct type *member;
        } array;
 
 ###### value union fields
-       void *array;
+       void *array;  // used if not static_size
 
 ###### value functions
 
-       static void array_init(struct type *type, struct value *val)
+       static void array_prepare_type(struct parse_context *c, struct type *type,
+                                      int parse_time)
        {
-               int i;
+               mpz_t q;
+               if (!type->array.vsize || type->array.static_size)
+                       return;
 
-               if (type->array.vsize) {
-                       mpz_t q;
-                       mpz_init(q);
-                       mpz_tdiv_q(q, mpq_numref(type->array.vsize->val->num),
-                                  mpq_denref(type->array.vsize->val->num));
-                       type->array.size = mpz_get_si(q);
-                       mpz_clear(q);
+               mpz_init(q);
+               mpz_tdiv_q(q, mpq_numref(type->array.vsize->val->num),
+                          mpq_denref(type->array.vsize->val->num));
+               type->array.size = mpz_get_si(q);
+               mpz_clear(q);
+
+               if (parse_time) {
+                       type->array.static_size = 1;
+                       type->size = type->array.size * type->array.member->size;
+                       type->align = type->array.member->align;
                }
-               type->size = type->array.size * type->array.member->size;
-               type->align = type->array.member->align;
+       }
+
+       static void array_init(struct type *type, struct value *val)
+       {
+               int i;
+               void *ptr = val->ptr;
 
                if (!val)
-                       return;         
+                       return;
+               if (!type->array.static_size) {
+                       val->array = calloc(type->array.size, 
+                                           type->array.member->size);
+                       ptr = val->array;
+               }
                for (i = 0; i < type->array.size; i++) {
                        struct value *v;
-                       v = (void*)val->ptr + i * type->array.member->size;
+                       v = (void*)ptr + i * type->array.member->size;
                        val_init(type->array.member, v);
                }
        }
@@ -1543,12 +1575,17 @@ make a copy of an array with controllable recursive depth.
        static void array_free(struct type *type, struct value *val)
        {
                int i;
+               void *ptr = val->ptr;
 
+               if (!type->array.static_size)
+                       ptr = val->array;
                for (i = 0; i < type->array.size; i++) {
                        struct value *v;
-                       v = (void*)val->ptr + i * type->array.member->size;
+                       v = (void*)ptr + i * type->array.member->size;
                        free_value(type->array.member, v);
                }
+               if (!type->array.static_size)
+                       free(ptr);
        }
 
        static int array_compat(struct type *require, struct type *have)
@@ -1577,9 +1614,12 @@ make a copy of an array with controllable recursive depth.
 
        static struct type array_prototype = {
                .init = array_init,
+               .prepare_type = array_prepare_type,
                .print_type = array_print_type,
                .compat = array_compat,
                .free = array_free,
+               .size = sizeof(void*),
+               .align = sizeof(void*),
        };
 
 ###### declare terminals
@@ -1587,20 +1627,21 @@ make a copy of an array with controllable recursive depth.
 
 ###### type grammar
 
-       | [ NUMBER ] Type ${
-               $0 = calloc(1, sizeof(struct type));
-               *($0) = array_prototype;
-               $0->array.member = $<4;
-               $0->array.vsize = NULL;
-               {
+       | [ NUMBER ] Type ${ {
                char tail[3];
                mpq_t num;
+               struct text noname = { "", 0 };
+               struct type *t;
+
+               $0 = t = add_type(c, noname, &array_prototype);
+               t->array.member = $<4;
+               t->array.vsize = NULL;
                if (number_parse(num, tail, $2.txt) == 0)
                        tok_err(c, "error: unrecognised number", &$2);
                else if (tail[0])
                        tok_err(c, "error: unsupported number suffix", &$2);
                else {
-                       $0->array.size = mpz_get_ui(mpq_numref(num));
+                       t->array.size = mpz_get_ui(mpq_numref(num));
                        if (mpz_cmp_ui(mpq_denref(num), 1) != 0) {
                                tok_err(c, "error: array size must be an integer",
                                        &$2);
@@ -1609,41 +1650,26 @@ make a copy of an array with controllable recursive depth.
                                        &$2);
                        mpq_clear(num);
                }
-               $0->next = c->anon_typelist;
-               c->anon_typelist = $0;
-               }
-       }$
+               t->array.static_size = 1;
+               t->size = t->array.size * t->array.member->size;
+               t->align = t->array.member->align;
+       } }$
 
        | [ IDENTIFIER ] Type ${ {
                struct variable *v = var_ref(c, $2.txt);
+               struct text noname = { "", 0 };
 
                if (!v)
                        tok_err(c, "error: name undeclared", &$2);
                else if (!v->constant)
                        tok_err(c, "error: array size must be a constant", &$2);
 
-               $0 = calloc(1, sizeof(struct type));
-               *($0) = array_prototype;
+               $0 = add_type(c, noname, &array_prototype);
                $0->array.member = $<4;
                $0->array.size = 0;
                $0->array.vsize = v;
-               $0->next = c->anon_typelist;
-               c->anon_typelist = $0;
        } }$
 
-###### parse context
-
-       struct type *anon_typelist;
-
-###### free context types
-
-       while (context.anon_typelist) {
-               struct type *t = context.anon_typelist;
-
-               context.anon_typelist = t->next;
-               free(t);
-       }
-
 ###### Binode types
        Index,
 
@@ -1688,17 +1714,22 @@ make a copy of an array with controllable recursive depth.
        case Index: {
                mpz_t q;
                long i;
+               void *ptr;
 
-               lleft = linterp_exec(b->left, &ltype);
-               right = interp_exec(b->right, &rtype);
+               lleft = linterp_exec(c, b->left, &ltype);
+               right = interp_exec(c, b->right, &rtype);
                mpz_init(q);
                mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num));
                i = mpz_get_si(q);
                mpz_clear(q);
 
+               if (ltype->array.static_size)
+                       ptr = lleft;
+               else
+                       ptr = *(void**)lleft;
                rvtype = ltype->array.member;
                if (i >= 0 && i < ltype->array.size)
-                       lrv = (void*)lleft + i * rvtype->size;
+                       lrv = ptr + i * rvtype->size;
                else
                        val_init(ltype->array.member, &rv);
                ltype = NULL;
@@ -1770,7 +1801,12 @@ function will be needed.
                for (i = 0; i < type->structure.nfields; i++) {
                        struct value *v;
                        v = (void*) val->ptr + type->structure.fields[i].offset;
-                       val_init(type->structure.fields[i].type, v);
+                       if (type->structure.fields[i].init)
+                               dup_value(type->structure.fields[i].type, 
+                                         type->structure.fields[i].init,
+                                         v);
+                       else
+                               val_init(type->structure.fields[i].type, v);
                }
        }
 
@@ -1888,7 +1924,7 @@ function will be needed.
        {
                struct fieldref *f = cast(fieldref, e);
                struct type *ltype;
-               struct value *lleft = linterp_exec(f->left, &ltype);
+               struct value *lleft = linterp_exec(c, f->left, &ltype);
                lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset;
                rvtype = ltype->structure.fields[f->index].type;
                break;
@@ -1977,15 +2013,16 @@ function will be needed.
                        if (!ok)
                                c->parse_error = 1;
                        else {
-                               struct value vl = interp_exec($5, NULL);
-                               $0->f.init = val_alloc($0->f.type, &vl);
+                               struct value vl = interp_exec(c, $5, NULL);
+                               $0->f.init = val_alloc(c, $0->f.type, &vl);
                        }
                } }$
                | IDENTIFIER : Type ${
                        $0 = calloc(1, sizeof(struct fieldlist));
                        $0->f.name = $1.txt;
                        $0->f.type = $<3;
-                       $0->f.init = val_alloc($0->f.type, NULL);
+                       if ($0->f.type->prepare_type)
+                               $0->f.type->prepare_type(c, $0->f.type, 1);
                }$
 
 ###### forward decls
@@ -2451,11 +2488,11 @@ there.
 
        case CondExpr: {
                struct binode *b2 = cast(binode, b->right);
-               left = interp_exec(b->left, &ltype);
+               left = interp_exec(c, b->left, &ltype);
                if (left.bool)
-                       rv = interp_exec(b2->left, &rvtype);
+                       rv = interp_exec(c, b2->left, &rvtype);
                else
-                       rv = interp_exec(b2->right, &rvtype);
+                       rv = interp_exec(c, b2->right, &rvtype);
                }
                break;
 
@@ -2568,27 +2605,27 @@ evaluate the second expression if not necessary.
 
 ###### interp binode cases
        case And:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                rv.bool = rv.bool && right.bool;
                break;
        case AndThen:
-               rv = interp_exec(b->left, &rvtype);
+               rv = interp_exec(c, b->left, &rvtype);
                if (rv.bool)
-                       rv = interp_exec(b->right, NULL);
+                       rv = interp_exec(c, b->right, NULL);
                break;
        case Or:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                rv.bool = rv.bool || right.bool;
                break;
        case OrElse:
-               rv = interp_exec(b->left, &rvtype);
+               rv = interp_exec(c, b->left, &rvtype);
                if (!rv.bool)
-                       rv = interp_exec(b->right, NULL);
+                       rv = interp_exec(c, b->right, NULL);
                break;
        case Not:
-               rv = interp_exec(b->right, &rvtype);
+               rv = interp_exec(c, b->right, &rvtype);
                rv.bool = !rv.bool;
                break;
 
@@ -2696,8 +2733,8 @@ expression operator, and the `CMPop` non-terminal will match one of them.
        case NEql:
        {
                int cmp;
-               left = interp_exec(b->left, &ltype);
-               right = interp_exec(b->right, &rtype);
+               left = interp_exec(c, b->left, &ltype);
+               right = interp_exec(c, b->right, &rtype);
                cmp = value_cmp(ltype, rtype, &left, &right);
                rvtype = Tbool;
                switch (b->op) {
@@ -2871,30 +2908,30 @@ should only insert brackets were needed for precedence.
 ###### interp binode cases
 
        case Plus:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                mpq_add(rv.num, rv.num, right.num);
                break;
        case Minus:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                mpq_sub(rv.num, rv.num, right.num);
                break;
        case Times:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                mpq_mul(rv.num, rv.num, right.num);
                break;
        case Divide:
-               rv = interp_exec(b->left, &rvtype);
-               right = interp_exec(b->right, &rtype);
+               rv = interp_exec(c, b->left, &rvtype);
+               right = interp_exec(c, b->right, &rtype);
                mpq_div(rv.num, rv.num, right.num);
                break;
        case Rem: {
                mpz_t l, r, rem;
 
-               left = interp_exec(b->left, &ltype);
-               right = interp_exec(b->right, &rtype);
+               left = interp_exec(c, b->left, &ltype);
+               right = interp_exec(c, b->right, &rtype);
                mpz_init(l); mpz_init(r); mpz_init(rem);
                mpz_tdiv_q(l, mpq_numref(left.num), mpq_denref(left.num));
                mpz_tdiv_q(r, mpq_numref(right.num), mpq_denref(right.num));
@@ -2906,24 +2943,24 @@ should only insert brackets were needed for precedence.
                break;
        }
        case Negate:
-               rv = interp_exec(b->right, &rvtype);
+               rv = interp_exec(c, b->right, &rvtype);
                mpq_neg(rv.num, rv.num);
                break;
        case Absolute:
-               rv = interp_exec(b->right, &rvtype);
+               rv = interp_exec(c, b->right, &rvtype);
                mpq_abs(rv.num, rv.num);
                break;
        case Bracket:
-               rv = interp_exec(b->right, &rvtype);
+               rv = interp_exec(c, b->right, &rvtype);
                break;
        case Concat:
-               left = interp_exec(b->left, &ltype);
-               right = interp_exec(b->right, &rtype);
+               left = interp_exec(c, b->left, &ltype);
+               right = interp_exec(c, b->right, &rtype);
                rvtype = Tstr;
                rv.str = text_join(left.str, right.str);
                break;
        case StringConv:
-               right = interp_exec(b->right, &rvtype);
+               right = interp_exec(c, b->right, &rvtype);
                rtype = Tstr;
                rvtype = Tnum;
 
@@ -3145,7 +3182,7 @@ is in-place.
                while (rvtype == Tnone &&
                       b) {
                        if (b->left)
-                               rv = interp_exec(b->left, &rvtype);
+                               rv = interp_exec(c, b->left, &rvtype);
                        b = cast(binode, b->right);
                }
                break;
@@ -3234,7 +3271,7 @@ same solution.
                        if (b->left) {
                                if (sep)
                                        putchar(sep);
-                               left = interp_exec(b->left, &ltype);
+                               left = interp_exec(c, b->left, &ltype);
                                print_value(ltype, &left);
                                free_value(ltype, &left);
                                if (b->right)
@@ -3365,8 +3402,8 @@ it is declared, and error will be raised as the name is created as
 ###### interp binode cases
 
        case Assign:
-               lleft = linterp_exec(b->left, &ltype);
-               right = interp_exec(b->right, &rtype);
+               lleft = linterp_exec(c, b->left, &ltype);
+               right = interp_exec(c, b->right, &rtype);
                if (lleft) {
                        free_value(ltype, lleft);
                        dup_value(ltype, &right, lleft);
@@ -3379,15 +3416,14 @@ it is declared, and error will be raised as the name is created as
                struct variable *v = cast(var, b->left)->var;
                if (v->merged)
                        v = v->merged;
+               free_value(v->type, v->val);
+               free(v->val);
                if (b->right) {
-                       right = interp_exec(b->right, &rtype);
-                       free_value(v->type, v->val);
-                       free(v->val);
-                       v->val = val_alloc(v->type, &right);
+                       right = interp_exec(c, b->right, &rtype);
+                       v->val = val_alloc(c, v->type, &right);
                        rtype = Tnone;
                } else {
-                       free_value(v->type, v->val);
-                       v->val = val_alloc(v->type, NULL);
+                       v->val = val_alloc(c, v->type, NULL);
                }
                break;
        }
@@ -3415,7 +3451,7 @@ function.
                        if (v->var->type == Tnone) {
                                /* Convert this to a label */
                                v->var->type = Tlabel;
-                               v->var->val = val_alloc(Tlabel, NULL);
+                               v->var->val = val_alloc(c, Tlabel, NULL);
                                v->var->val->label = v->var->val;
                        }
                }
@@ -3439,7 +3475,7 @@ function.
 ###### interp binode cases
 
        case Use:
-               rv = interp_exec(b->right, &rvtype);
+               rv = interp_exec(c, b->right, &rvtype);
                break;
 
 ### The Conditional Statement
@@ -3869,44 +3905,44 @@ defined.
                struct value v, cnd;
                struct type *vtype, *cndtype;
                struct casepart *cp;
-               struct cond_statement *c = cast(cond_statement, e);
+               struct cond_statement *cs = cast(cond_statement, e);
 
-               if (c->forpart)
-                       interp_exec(c->forpart, NULL);
+               if (cs->forpart)
+                       interp_exec(c, cs->forpart, NULL);
                do {
-                       if (c->condpart)
-                               cnd = interp_exec(c->condpart, &cndtype);
+                       if (cs->condpart)
+                               cnd = interp_exec(c, cs->condpart, &cndtype);
                        else
                                cndtype = Tnone;
                        if (!(cndtype == Tnone ||
                              (cndtype == Tbool && cnd.bool != 0)))
                                break;
                        // cnd is Tnone or Tbool, doesn't need to be freed
-                       if (c->dopart)
-                               interp_exec(c->dopart, NULL);
+                       if (cs->dopart)
+                               interp_exec(c, cs->dopart, NULL);
 
-                       if (c->thenpart) {
-                               rv = interp_exec(c->thenpart, &rvtype);
-                               if (rvtype != Tnone || !c->dopart)
+                       if (cs->thenpart) {
+                               rv = interp_exec(c, cs->thenpart, &rvtype);
+                               if (rvtype != Tnone || !cs->dopart)
                                        goto Xcond_done;
                                free_value(rvtype, &rv);
                                rvtype = Tnone;
                        }
-               } while (c->dopart);
+               } while (cs->dopart);
 
-               for (cp = c->casepart; cp; cp = cp->next) {
-                       v = interp_exec(cp->value, &vtype);
+               for (cp = cs->casepart; cp; cp = cp->next) {
+                       v = interp_exec(c, cp->value, &vtype);
                        if (value_cmp(cndtype, vtype, &v, &cnd) == 0) {
                                free_value(vtype, &v);
                                free_value(cndtype, &cnd);
-                               rv = interp_exec(cp->action, &rvtype);
+                               rv = interp_exec(c, cp->action, &rvtype);
                                goto Xcond_done;
                        }
                        free_value(vtype, &v);
                }
                free_value(cndtype, &cnd);
-               if (c->elsepart)
-                       rv = interp_exec(c->elsepart, &rvtype);
+               if (cs->elsepart)
+                       rv = interp_exec(c, cs->elsepart, &rvtype);
                else
                        rvtype = Tnone;
        Xcond_done:
@@ -4022,8 +4058,8 @@ searching through for the Nth constant for decreasing N.
                if (!ok)
                        c->parse_error = 1;
                else if (v) {
-                       struct value res = interp_exec($5, &v->type);
-                       v->val = val_alloc(v->type, &res);
+                       struct value res = interp_exec(c, $5, &v->type);
+                       v->val = val_alloc(c, v->type, &res);
                }
        } }$
 
@@ -4172,7 +4208,7 @@ analysis is a bit more interesting at this level.
                return !!ok;
        }
 
-       static void interp_prog(struct exec *prog, char **argv)
+       static void interp_prog(struct parse_context *c, struct exec *prog, char **argv)
        {
                struct binode *p = cast(binode, prog);
                struct binode *al;
@@ -4185,25 +4221,30 @@ analysis is a bit more interesting at this level.
                while (al) {
                        struct var *v = cast(var, al->left);
                        struct value *vl = v->var->val;
+                       struct value arg;
 
                        if (argv[0] == NULL) {
                                printf("Not enough args\n");
                                exit(1);
                        }
-                       al = cast(binode, al->right);
-                       if (vl)
-                               free_value(v->var->type, vl);
+                       if (v->var->type != Tstr) {
+                               printf("Arg not string!!\n"); // NOTEST
+                               exit(2);                      // NOTEST
+                       }
                        if (!vl) {
-                               vl = val_alloc(v->var->type, NULL);
+                               vl = val_alloc(c, v->var->type, NULL);
                                v->var->val = vl;
                        }
-                       free_value(v->var->type, vl);
-                       vl->str.len = strlen(argv[0]);
-                       vl->str.txt = malloc(vl->str.len);
-                       memcpy(vl->str.txt, argv[0], vl->str.len);
+
+                       arg.str.txt = argv[0];
+                       arg.str.len = strlen(argv[0]);
+                       free_value(Tstr, vl);
+                       dup_value(Tstr, &arg, vl);
+
+                       al = cast(binode, al->right);
                        argv++;
                }
-               v = interp_exec(p->right, &vtype);
+               v = interp_exec(c, p->right, &vtype);
                free_value(vtype, &v);
        }