X-Git-Url: https://ocean-lang.org/code/?a=blobdiff_plain;f=csrc%2Foceani.mdc;h=65790ec985469c5268208cd68bb38a8fc116f1df;hb=a9cd2fcd52ae4ba9c19f775221cc14d2745083b3;hp=8faff44e41b8f8f7ab7c954d1436b554efa7b297;hpb=63a5c13d3ae31de4cc0814e83feffed6d56e0da6;p=ocean diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 8faff44..65790ec 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -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); @@ -592,11 +576,11 @@ later. In some cases a Boolean can be accepted as well as some other primary type, and in others any type is acceptable except a label (`Vlabel`). A separate function encoding these cases will simplify some code later. -## type functions +###### type functions int (*compat)(struct type *this, struct type *other); -## ast functions +###### ast functions static int type_compat(struct type *require, struct type *have, int rules) { @@ -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 = $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 = $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,24 +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; - - if (argv[0] == NULL) { - printf("Not enough args\n"); - exit(1); + struct value *vl = var_value(c, v->var); + struct value arg; + 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; } al = cast(binode, al->right); - if (vl) - free_value(v->var->type, vl); - if (!vl) { - 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); - argv++; } v = interp_exec(c, p->right, &vtype); free_value(vtype, &v); @@ -4274,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.