]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
ocean: change program to receive argc and argv
[ocean] / csrc / oceani.mdc
index af2e8b958b329a4c76495fa2fba9721a52d5911a..65790ec985469c5268208cd68bb38a8fc116f1df 100644 (file)
@@ -243,7 +243,7 @@ structures can be used.
                                fprintf(stderr, "oceani: type error in program - not running.\n");
                                exit(1);
                        }
-                       interp_prog(&context, context.prog, argv+optind+1);
+                       interp_prog(&context, context.prog, argc - optind, argv+optind);
                }
                free_exec(context.prog);
 
@@ -534,22 +534,6 @@ Named type are stored in a simple linked list.  Objects of each type are
                        printf("*Unknown*");            // NOTEST
        }
 
-       static struct value *val_alloc(struct parse_context *c, struct type *t,
-                                      struct value *init)
-       {
-               struct value *ret;
-
-               if (t->prepare_type)
-                       t->prepare_type(c, t, 0);
-
-               ret = calloc(1, t->size);
-               if (init)
-                       memcpy(ret, init, t->size);
-               else
-                       val_init(t, ret);
-               return ret;
-       }
-
 ###### forward decls
 
        static void free_value(struct type *type, struct value *v);
@@ -821,7 +805,6 @@ cannot nest, so a declaration while a name is in-scope is an error.
        struct variable {
                struct variable *previous;
                struct type *type;
-               struct value *val;
                struct binding *name;
                struct exec *where_decl;// where name was declared
                struct exec *where_set; // where type was set
@@ -971,6 +954,11 @@ recent instance.  These variables don't really belong in the
 is found.  Instead, they are detected and ignored when considering the
 list of in_scope names.
 
+The storage of the value of a variable will be described later.  For now
+we just need to know that when a variable goes out of scope, it might
+need to be freed.  For this we need to be able to find it, so assume that 
+`var_value()` will provide that.
+
 ###### variable fields
        struct variable *merged;
 
@@ -993,6 +981,9 @@ list of in_scope names.
                        }
        }
 
+###### forward decls
+       static struct value *var_value(struct parse_context *c, struct variable *v);
+
 ###### free context vars
 
        while (context.varlist) {
@@ -1004,8 +995,7 @@ list of in_scope names.
                        struct variable *t = v;
 
                        v = t->previous;
-                       free_value(t->type, t->val);
-                       free(t->val);
+                       free_value(t->type, var_value(&context, t));
                        if (t->depth == 0)
                                // This is a global constant
                                free_exec(t->where_decl);
@@ -1085,7 +1075,6 @@ all pending-scope variables become conditionally scoped.
                v->scope = InScope;
                v->in_scope = c->in_scope;
                c->in_scope = v;
-               v->val = NULL;
                return v;
        }
 
@@ -1194,6 +1183,112 @@ all pending-scope variables become conditionally scoped.
                }
        }
 
+#### Storing Values
+
+The value of a variable is store separately from the variable, on an
+analogue of a stack frame.  There are (currently) two frames that can be
+active.  A global frame which currently only stores constants, and a
+stacked frame which stores local variables.  Each variable knows if it
+is global or not, and what its index into the frame is.
+
+Values in the global frame are known immediately they are relevant, so
+the frame needs to be reallocated as it grows so it can store those
+values.  The local frame doesn't get values until the interpreted phase
+is started, so there is no need to allocate until the size is known.
+
+###### variable fields
+               short frame_pos;
+               short global;
+
+###### parse context
+
+       short global_size, global_alloc;
+       short local_size;
+       void *global, *local;
+
+###### ast functions
+
+       static struct value *var_value(struct parse_context *c, struct variable *v)
+       {
+               if (!v->global) {
+                       if (!c->local || !v->type)
+                               return NULL;
+                       if (v->frame_pos + v->type->size > c->local_size) {
+                               printf("INVALID frame_pos\n"); // NOTEST
+                               exit(2);
+                       }
+                       return c->local + v->frame_pos;
+               }
+               if (c->global_size > c->global_alloc) {
+                       int old = c->global_alloc;
+                       c->global_alloc = (c->global_size | 1023) + 1024;
+                       c->global = realloc(c->global, c->global_alloc);
+                       memset(c->global + old, 0, c->global_alloc - old);
+               }
+               return c->global + v->frame_pos;
+       }
+
+       static struct value *global_alloc(struct parse_context *c, struct type *t,
+                                         struct variable *v, struct value *init)
+       {
+               struct value *ret;
+               struct variable scratch;
+
+               if (t->prepare_type)
+                       t->prepare_type(c, t, 1);
+
+               if (c->global_size & (t->align - 1))
+                       c->global_size = (c->global_size + t->align) & ~(t->align-1);
+               if (!v) {
+                       v = &scratch;
+                       v->type = t;
+               }
+               v->frame_pos = c->global_size;
+               v->global = 1;
+               c->global_size += v->type->size;
+               ret = var_value(c, v);
+               if (init)
+                       memcpy(ret, init, t->size);
+               else
+                       val_init(t, ret);
+               return ret;
+       }
+
+As global values are found -- struct field initializers, labels etc --
+`global_alloc()` is called to record the value in the global frame.
+
+When the program is fully parsed, we need to walk the list of variables
+to find any that weren't merged away and that aren't global, and to
+calculate the frame size and assign a frame position for each variable.
+For this we have `scope_finalize()`.
+
+###### ast functions
+
+       static void scope_finalize(struct parse_context *c)
+       {
+               struct binding *b;
+
+               for (b = c->varlist; b; b = b->next) {
+                       struct variable *v;
+                       for (v = b->var; v; v = v->previous) {
+                               struct type *t = v->type;
+                               if (v->merged && v->merged != v)
+                                       continue;
+                               if (v->global)
+                                       continue;
+                               if (c->local_size & (t->align - 1))
+                                       c->local_size = (c->local_size + t->align) & ~(t->align-1);
+                               v->frame_pos = c->local_size;
+                               c->local_size += v->type->size;
+                       }
+               }
+               c->local = calloc(1, c->local_size);
+       }
+
+###### free context vars
+       free(context.global);
+       free(context.local);
+
 ### Executables
 
 Executables can be lots of different things.  In many cases an
@@ -1536,13 +1631,14 @@ with a const size by whether they are prepared at parse time or not.
        static void array_prepare_type(struct parse_context *c, struct type *type,
                                       int parse_time)
        {
+               struct value *vsize;
                mpz_t q;
                if (!type->array.vsize || type->array.static_size)
                        return;
 
+               vsize = var_value(c, type->array.vsize);
                mpz_init(q);
-               mpz_tdiv_q(q, mpq_numref(type->array.vsize->val->num),
-                          mpq_denref(type->array.vsize->val->num));
+               mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
                type->array.size = mpz_get_si(q);
                mpz_clear(q);
 
@@ -1828,7 +1924,6 @@ function will be needed.
                        if (t->structure.fields[i].init) {
                                free_value(t->structure.fields[i].type,
                                           t->structure.fields[i].init);
-                               free(t->structure.fields[i].init);
                        }
                free(t->structure.fields);
        }
@@ -2014,7 +2109,7 @@ function will be needed.
                                c->parse_error = 1;
                        else {
                                struct value vl = interp_exec(c, $5, NULL);
-                               $0->f.init = val_alloc(c, $0->f.type, &vl);
+                               $0->f.init = global_alloc(c, $0->f.type, NULL, &vl);
                        }
                } }$
                | IDENTIFIER : Type ${
@@ -2272,7 +2367,6 @@ link to find the primary instance.
                        v->where_decl = $0;
                        v->where_set = $0;
                        v->type = $<Type;
-                       v->val = NULL;
                } else {
                        v = var_ref(c, $1.txt);
                        $0->var = v;
@@ -2290,7 +2384,6 @@ link to find the primary instance.
                        v->where_decl = $0;
                        v->where_set = $0;
                        v->type = $<Type;
-                       v->val = NULL;
                        v->constant = 1;
                } else {
                        v = var_ref(c, $1.txt);
@@ -2310,7 +2403,6 @@ link to find the primary instance.
                        /* This might be a label - allocate a var just in case */
                        v = var_decl(c, $1.txt);
                        if (v) {
-                               v->val = NULL;
                                v->type = Tnone;
                                v->where_decl = $0;
                                v->where_set = $0;
@@ -2381,7 +2473,6 @@ link to find the primary instance.
                if (v->type == NULL) {
                        if (type && *ok != 0) {
                                v->type = type;
-                               v->val = NULL;
                                v->where_set = prog;
                                *ok = 2;
                        }
@@ -2406,7 +2497,7 @@ link to find the primary instance.
 
                if (v->merged)
                        v = v->merged;
-               lrv = v->val;
+               lrv = var_value(c, v);
                rvtype = v->type;
                break;
        }
@@ -3414,16 +3505,19 @@ it is declared, and error will be raised as the name is created as
        case Declare:
        {
                struct variable *v = cast(var, b->left)->var;
+               struct value *val;
                if (v->merged)
                        v = v->merged;
-               free_value(v->type, v->val);
-               free(v->val);
+               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) {
                        right = interp_exec(c, b->right, &rtype);
-                       v->val = val_alloc(c, v->type, &right);
+                       memcpy(val, &right, rtype->size);
                        rtype = Tnone;
                } else {
-                       v->val = val_alloc(c, v->type, NULL);
+                       val_init(v->type, val);
                }
                break;
        }
@@ -3450,9 +3544,11 @@ function.
                        struct var *v = cast(var, $0->right);
                        if (v->var->type == Tnone) {
                                /* Convert this to a label */
+                               struct value *val;
+
                                v->var->type = Tlabel;
-                               v->var->val = val_alloc(c, Tlabel, NULL);
-                               v->var->val->label = v->var->val;
+                               val = global_alloc(c, Tlabel, v->var, NULL);
+                               val->label = val;
                        }
                }
        }$
@@ -4059,7 +4155,7 @@ searching through for the Nth constant for decreasing N.
                        c->parse_error = 1;
                else if (v) {
                        struct value res = interp_exec(c, $5, &v->type);
-                       v->val = val_alloc(c, v->type, &res);
+                       global_alloc(c, v->type, v, &res);
                }
        } }$
 
@@ -4082,12 +4178,13 @@ searching through for the Nth constant for decreasing N.
                                        printf("const\n");
                                target = i;
                        } else {
+                               struct value *val = var_value(&context, v);
                                printf("    %.*s :: ", v->name->name.len, v->name->name.txt);
                                type_print(v->type, stdout);
                                printf(" = ");
                                if (v->type == Tstr)
                                        printf("\"");
-                               print_value(v->type, v->val);
+                               print_value(v->type, val);
                                if (v->type == Tstr)
                                        printf("\"");
                                printf("\n");
@@ -4175,43 +4272,57 @@ analysis is a bit more interesting at this level.
 
        static int analyse_prog(struct exec *prog, struct parse_context *c)
        {
-               struct binode *b = cast(binode, prog);
+               struct binode *bp = cast(binode, prog);
+               struct binode *b;
                int ok = 1;
+               int arg = 0;
+               struct type *argv_type;
+               struct text argv_type_name = { " argv", 5 };
 
-               if (!b)
+               if (!bp)
                        return 0;       // NOTEST
-               do {
-                       ok = 1;
-                       propagate_types(b->right, c, &ok, Tnone, 0);
-               } while (ok == 2);
-               if (!ok)
-                       return 0;
 
-               for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
-                       struct var *v = cast(var, b->left);
-                       if (!v->var->type) {
-                               v->var->where_set = b;
-                               v->var->type = Tstr;
-                               v->var->val = NULL;
+               argv_type = add_type(c, argv_type_name, &array_prototype);
+               argv_type->array.member = Tstr;
+
+               for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) {
+                       struct var *v;
+                       ok = 1;
+                       switch (arg++) {
+                       case 0: /* argc */
+                               v = cast(var, b->left);
+                               argv_type->array.vsize = v->var;
+                               propagate_types(b->left, c, &ok, Tnum, 0);
+                               break;
+                       case 1: /* argv */
+                               propagate_types(b->left, c, &ok, argv_type, 0);
+                               break;
+                       default: /* invalid */
+                               propagate_types(b->left, c, &ok, Tnone, 0);
                        }
                }
-               b = cast(binode, prog);
+
                do {
                        ok = 1;
-                       propagate_types(b->right, c, &ok, Tnone, 0);
+                       propagate_types(bp->right, c, &ok, Tnone, 0);
                } while (ok == 2);
                if (!ok)
                        return 0;
 
                /* Make sure everything is still consistent */
-               propagate_types(b->right, c, &ok, Tnone, 0);
-               return !!ok;
+               propagate_types(bp->right, c, &ok, Tnone, 0);
+               if (!ok)
+                       return 0;
+               scope_finalize(c);
+               return 1;
        }
 
-       static void interp_prog(struct parse_context *c, struct exec *prog, char **argv)
+       static void interp_prog(struct parse_context *c, struct exec *prog, 
+                               int argc, char **argv)
        {
                struct binode *p = cast(binode, prog);
                struct binode *al;
+               int anum = 0;
                struct value v;
                struct type *vtype;
 
@@ -4220,29 +4331,36 @@ analysis is a bit more interesting at this level.
                al = cast(binode, p->left);
                while (al) {
                        struct var *v = cast(var, al->left);
-                       struct value *vl = v->var->val;
+                       struct value *vl = var_value(c, v->var);
                        struct value arg;
-
-                       if (argv[0] == NULL) {
-                               printf("Not enough args\n");
-                               exit(1);
-                       }
-                       if (v->var->type != Tstr) {
-                               printf("Arg not string!!\n"); // NOTEST
-                               exit(2);                      // NOTEST
-                       }
-                       if (!vl) {
-                               vl = val_alloc(c, v->var->type, NULL);
-                               v->var->val = vl;
+                       struct type *t;
+                       mpq_t argcq;
+                       int i;
+
+                       switch (anum++) {
+                       case 0: /* argc */
+                               if (v->var->type == Tnum) {
+                                       mpq_init(argcq);
+                                       mpq_set_ui(argcq, argc, 1);
+                                       memcpy(vl, &argcq, sizeof(argcq));
+                               }
+                               break;
+                       case 1: /* argv */
+                               t = v->var->type;
+                               t->prepare_type(c, t, 0);
+                               array_init(v->var->type, vl);
+                               for (i = 0; i < argc; i++) {
+                                       struct value *vl2 = vl->array + i * v->var->type->array.member->size;
+                                       
+
+                                       arg.str.txt = argv[i];
+                                       arg.str.len = strlen(argv[i]);
+                                       free_value(Tstr, vl2);
+                                       dup_value(Tstr, &arg, vl2);
+                               }
+                               break;
                        }
-
-                       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(c, p->right, &vtype);
                free_value(vtype, &v);
@@ -4279,12 +4397,12 @@ things which will likely grow as the languages grows.
                name:string
                alive:Boolean
 
-       program Astr Bstr:
+       program argc argv:
                print "Hello World, what lovely oceans you have!"
                print "Are there", five, "?"
                print pi, pie, "but", cake
 
-               A := $Astr; B := $Bstr
+               A := $argv[1]; B := $argv[2]
 
                /* When a variable is defined in both branches of an 'if',
                 * and used afterwards, the variables are merged.