static value make_list(constant loc, cstlist csts, int has_tail, bool save_location, fncode fn) { struct list *l; if (has_tail && csts != NULL) { l = csts->cst ? make_constant(csts->cst, FALSE, fn) : NULL; csts = csts->next; } else l = NULL; GCPRO1(l); /* Remember that csts is in reverse order ... */ while (csts) { value tmp = make_constant(csts->cst, save_location, fn); l = alloc_list(tmp, l); SET_READONLY(l); SET_IMMUTABLE(l); csts = csts->next; } if (save_location) { value vloc = make_location(&loc->loc); l = alloc_list(vloc, l); SET_READONLY(l); SET_IMMUTABLE(l); } GCPOP(1); return l; }
static value make_symbol(cstpair p, fncode fn) { struct symbol *sym; struct string *s = alloc_string(p->cst1->u.string); GCPRO1(s); SET_IMMUTABLE(s); SET_READONLY(s); sym = alloc_symbol(s, make_constant(p->cst2, FALSE, fn)); SET_IMMUTABLE(sym); SET_READONLY(sym); GCPOP(1); return sym; }
static u16 global_add(struct global_state *gstate, struct string *name, value val) { struct symbol *pos; ivalue old_size, aindex; GCCHECK(val); GCPRO2(gstate, name); old_size = vector_len(gstate->environment->values); aindex = env_add_entry(gstate->environment, val); if (vector_len(gstate->environment->values) != old_size) /* Increase mvars too */ { struct vector *new_mvars = alloc_vector(vector_len(gstate->environment->values)); memcpy(new_mvars->data, gstate->mvars->data, gstate->mvars->o.size - sizeof(struct obj)); gstate->mvars = new_mvars; } GCPOP(2); gstate->mvars->data[aindex] = makeint(var_normal); pos = table_add_fast(gstate->global, name, makeint(aindex)); SET_READONLY(pos); /* index of global vars never changes */ return aindex; }
struct string *make_filename(const char *fname) { if (strcmp(fname, last_c_filename)) { free((void *)last_c_filename); last_c_filename = xstrdup(fname); last_filename = alloc_string(fname); SET_READONLY(last_filename); } return last_filename; }
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); }
static value make_quote(constant c, bool save_location, fncode fn) { struct list *l; value quote; l = alloc_list(make_constant(c->u.constant, save_location, fn), NULL); SET_READONLY(l); SET_IMMUTABLE(l); GCPRO1(l); quote = make_gsymbol("quote", fn); l = alloc_list(quote, l); SET_READONLY(l); SET_IMMUTABLE(l); if (save_location) { value loc = make_location(&c->loc); l = alloc_list(loc, l); SET_READONLY(l); SET_IMMUTABLE(l); } GCPOP(1); return l; }
struct closure *alloc_closure0(struct code *code) { struct closure *newp; GCCHECK(code); GCPRO1(code); newp = (struct closure *)allocate_record(type_function, 1); GCPOP(1); newp->code = code; SET_READONLY(newp); return newp; }
struct closure *unsafe_alloc_and_push_closure(u8 nb_variables) { /* This could (should?) be optimised to avoid the need for GCPRO1/stack_reserve/GCPOP */ struct closure *newp = (struct closure *)unsafe_allocate_record(type_function, nb_variables + 1); SET_READONLY(newp); GCPRO1(newp); stack_reserve(sizeof(value)); GCPOP(1); stack_push(newp); return newp; }
static value make_table(cstlist csts, fncode fn) { struct table *t = alloc_table(DEF_TABLE_SIZE); GCPRO1(t); for (; csts; csts = csts->next) table_set(t, csts->cst->u.constpair->cst1->u.string, make_constant(csts->cst->u.constpair->cst2, FALSE, fn), NULL); table_foreach(t, protect_symbol); SET_READONLY(t); GCPOP(1); return t; }
static value make_gsymbol(const char *name, fncode fn) { struct table *gsymbols = (fn ? fnglobals(fn) : globals)->gsymbols; struct symbol *gsym; if (!table_lookup(gsymbols, name, &gsym)) { struct string *s; GCPRO1(gsymbols); s = alloc_string(name); SET_READONLY(s); GCPOP(1); gsym = table_add_fast(gsymbols, s, makeint(table_entries(gsymbols))); } return gsym; }
static value make_array(cstlist csts, fncode fn) { struct list *l; struct vector *v; uvalue size = 0, i; cstlist scan; for (scan = csts; scan; scan = scan->next) size++; /* This intermediate step is necessary as v is IMMUTABLE (so must be allocated after its contents) */ l = make_list(NULL, csts, 0, FALSE, fn); GCPRO1(l); v = alloc_vector(size); SET_IMMUTABLE(v); SET_READONLY(v); GCPOP(1); for (i = 0; i < size; i++, l = l->cdr) v->data[i] = l->car; return v; }
value make_constant(constant c, bool save_location, fncode fn) { struct obj *cst; switch (c->vclass) { case cst_string: cst = (value)alloc_string(c->u.string); SET_READONLY(cst); SET_IMMUTABLE(cst); return cst; case cst_gsymbol: return make_gsymbol(c->u.string, fn); case cst_quote: return make_quote(c, save_location, fn); case cst_list: return make_list(c, c->u.constants, 1, save_location, fn); case cst_array: return make_array(c->u.constants, fn); case cst_int: return makeint(c->u.integer); case cst_float: return alloc_mudlle_float(c->u.mudlle_float); case cst_table: return make_table(c->u.constants, fn); case cst_symbol: return make_symbol(c->u.constpair, fn); default: abort(); } }
static void protect_symbol(struct symbol *s) { SET_READONLY(v); }