void mprepare_vars(struct mprepare_state *s) { mfile f = s->f; block_t heap = s->heap; vlist reads, writes, defines; imported_modules = s->lmodules; all_writable = f->vclass == f_plain; all_readable = f->vclass == f_plain || !s->all_loaded; readable = writable = definable = NULL; if (f->name) { this_module = alloc_string(f->name); SET_READONLY(this_module); } else this_module = NULL; /* Change status of variables */ for (defines = f->defines; defines; defines = defines->next) { u16 n = global_lookup(s->ccontext->gstate, defines->var); struct string *omod; int ostatus = module_vstatus(s->ccontext->gstate, n, &omod); if (!module_vset(s->ccontext->gstate, n, var_module, this_module)) log_error("cannot define %s: belongs to module %s", defines->var, omod->str); else if (ostatus == var_write) warning("%s was writable", defines->var); definable = new_glist(heap, n, definable); } for (writes = f->writes; writes; writes = writes->next) { u16 n = global_lookup(s->ccontext->gstate, writes->var); if (!module_vset(s->ccontext->gstate, n, var_write, NULL)) { struct string *belongs; module_vstatus(s->ccontext->gstate, n, &belongs); log_error("cannot write %s: belongs to module %s", writes->var, belongs->str); } writable = new_glist(heap, n, writable); } for (reads = f->reads; reads; reads = reads->next) readable = new_glist(heap, global_lookup(s->ccontext->gstate, reads->var), readable); }
u16 mglobal_lookup(struct global_state *gstate, struct string *name) /* Returns: the index for global variable name in environment. If name doesn't exist yet, returns GLOBAL_INVALID */ { mtype t; return global_lookup(gstate, name->str, &t); }
u16 global_add(struct global_state *gstate, const char *name, mtype t) /* Effects: adds name to global environment gstate, along with its type (t) If variable already exists, change its type to t. Returns: the new variable's index Modifies: gstate */ { struct string *tname; mtype current_type; u16 pos = global_lookup(gstate, name, ¤t_type); if (pos != GLOBAL_INVALID) { gstate->types->data[pos] = makeint(t); return pos; } GCPRO1(gstate); tname = alloc_string(name); GCPOP(1); return global_add1(gstate, tname, t, NULL); }
void generate_component(component comp, const char *mlabel, bool discard, fncode fn) { clist args; switch (comp->vclass) { case c_assign: { u16 offset; mtype t; variable_class vclass = env_lookup(comp->l, comp->u.assign.symbol, &offset, &t, FALSE); component val = comp->u.assign.value; if (val->vclass == c_closure) { /* Defining a function, give it a name */ if (vclass == global_var) val->u.closure->varname = comp->u.assign.symbol; else { char *varname = allocate(fnmemory(fn), strlen(comp->u.assign.symbol) + 7); sprintf(varname, "local-%s", comp->u.assign.symbol); val->u.closure->varname = varname; } } generate_component(comp->u.assign.value, NULL, FALSE, fn); if (t != stype_any) ins0(OPmscheck4 + t, fn); if (vclass == global_var) massign(comp->l, offset, comp->u.assign.symbol, fn); else if (vclass == closure_var) ins1(OPmwritec, offset, fn); else ins1(OPmwritel, offset, fn); /* Note: varname becomes a dangling pointer when fnmemory(fn) is deallocated, but it is never used again so this does not cause a problem. */ break; } case c_recall: scompile_recall(comp->l, comp->u.recall, fn); break; case c_constant: ins_constant(make_constant(comp->u.cst, FALSE, fn), fn); break; case c_scheme: scheme_compile_mgc(comp->l, make_constant(comp->u.cst, TRUE, fn), discard, fn); discard = FALSE; break; case c_closure: generate_function(comp->u.closure, fn); break; case c_block: generate_block(comp->u.blk, discard, fn); discard = FALSE; break; case c_decl: { vlist decl, next; /* declare variables one at a time (any x = y, y = 2; is an error) */ for (decl = comp->u.decls; decl; decl = next) { next = decl->next; decl->next = NULL; env_declare(decl); generate_decls(decl, fn); } generate_component(component_undefined, NULL, FALSE, fn); break; } case c_labeled: { start_block(comp->u.labeled.name, FALSE, discard, fn); generate_component(comp->u.labeled.expression, comp->u.labeled.name, discard, fn); end_block(fn); discard = FALSE; break; } case c_exit: { bool discard_exit; label exitlab = exit_block(comp->u.labeled.name, FALSE, &discard_exit, fn); if (comp->u.labeled.expression != component_undefined && discard_exit) warning(comp->l, "break result is ignored"); generate_component(comp->u.labeled.expression, NULL, discard_exit, fn); if (exitlab) branch(OPmba3, exitlab, fn); else { if (!comp->u.labeled.name) log_error(comp->l, "No loop to exit from"); else log_error(comp->l, "No block labeled %s", comp->u.labeled.name); } /* Callers expect generate_component to increase stack depth by 1 */ if (discard_exit) adjust_depth(1, fn); break; } case c_continue: { bool discard_exit; /* Meaningless for continue blocks */ label exitlab = exit_block(comp->u.labeled.name, TRUE, &discard_exit, fn); if (exitlab) branch(OPmba3, exitlab, fn); else { if (comp->u.labeled.name[0] == '<') log_error(comp->l, "No loop to continue"); else log_error(comp->l, "No loop labeled %s", comp->u.labeled.name); } /* Callers expect generate_component to increase stack depth by 1 (*/ adjust_depth(1, fn); break; } case c_execute: { u16 count; generate_args(comp->u.execute->next, fn, &count); generate_execute(comp->u.execute->c, count, fn); break; } case c_builtin: args = comp->u.builtin.args; switch (comp->u.builtin.fn) { case b_if: generate_if(args->c, args->next->c, NULL, TRUE, fn); generate_component(component_undefined, NULL, FALSE, fn); break; case b_ifelse: generate_if(args->c, args->next->c, args->next->next->c, discard, fn); discard = FALSE; break; case b_sc_and: case b_sc_or: generate_if(comp, component_true, component_false, discard, fn); discard = FALSE; break; case b_while: enter_loop(fn); generate_while(args->c, args->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; case b_dowhile: enter_loop(fn); generate_dowhile(args->c, args->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; case b_for: enter_loop(fn); generate_for(args->c, args->next->c, args->next->next->c, args->next->next->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; default: { u16 count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); ins0(builtin_ops[comp->u.builtin.fn], fn); break; } case b_cons: { u16 count; u16 goffset; mtype t; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); goffset = global_lookup(fnglobals(fn), builtin_functions[comp->u.builtin.fn], &t); mexecute(comp->l, goffset, NULL, count, fn); break; } } break; default: assert(0); } if (discard) ins0(OPmpop, fn); }