clist_t* clist_copy(clist_t *list) { if (list == NULL) return NULL; clist_t *copyList = new_clist(); cnode_t *node = NULL; for (node = list->front; node != NULL; node = node->next) { clist_push_back(copyList, node->data); } return copyList; }
static clist make_clist(block_t heap, int count, va_list args) { clist first = NULL, *scan = &first; while (count-- > 0) { *scan = new_clist(heap, va_arg(args, component), NULL); scan = &(*scan)->next; } return first; }
constant new_constant(block_t heap, enum constant_class vclass, ...) { va_list args; constant newp = allocate(heap, sizeof *newp); newp->vclass = vclass; va_start(args, vclass); switch (vclass) { case cst_int: newp->u.integer = va_arg(args, int); break; case cst_string: newp->u.string = va_arg(args, str_and_len_t); break; case cst_list: { cstlist clhead = newp->u.constants = va_arg(args, cstlist); cstlist *clp = &newp->u.constants; while (*clp && ((*clp)->cst == NULL || (*clp)->cst->vclass != cst_expression)) clp = &(*clp)->next; cstlist cltail = *clp; if (cltail == NULL) break; if (clp == &newp->u.constants) { /* the first expression is the list tail */ newp = clhead->cst; cltail = cltail->next; } else if (clp == &newp->u.constants->next) { /* the first expression is the last element before the tail */ if (newp->u.constants->cst) newp = newp->u.constants->cst; else newp->u.constants = NULL; } else { /* the first expression is here, so truncate the tail */ *clp = NULL; } build_heap = heap; component l = new_component(heap, -1, c_constant, newp); for (; cltail; cltail = cltail->next) { component c = new_component(heap, -1, c_constant, cltail->cst); l = build_exec(build_recall(GEP "pcons"), 2, c, l); } newp = allocate(heap, sizeof *newp); newp->vclass = cst_expression; newp->u.expression = l; break; } case cst_array: case cst_table: { newp->u.constants = va_arg(args, cstlist); bool dynamic = false; for (cstlist cl = newp->u.constants; cl; cl = cl->next) if (cl->cst->vclass == cst_expression) { dynamic = true; break; } if (!dynamic) break; build_heap = heap; clist cargs = NULL; for (cstlist cl = newp->u.constants; cl; cl = cl->next) cargs = new_clist(heap, new_component(heap, -1, c_constant, cl->cst), cargs); cargs = new_clist(heap, build_recall(GEP "sequence"), cargs); component c = new_component(heap, 0, c_execute, cargs); if (vclass == cst_table) c = build_exec(build_recall(GEP "vector_to_ptable"), 1, c); newp->vclass = cst_expression; newp->u.expression = c; break; } case cst_float: newp->u.mudlle_float = va_arg(args, double); break; case cst_bigint: newp->u.bigint_str = va_arg(args, const char *); break; case cst_symbol: { newp->u.constpair = va_arg(args, cstpair); if (newp->u.constpair->cst1->vclass != cst_expression && newp->u.constpair->cst2->vclass != cst_expression) break; build_heap = heap; component c = build_exec(build_recall(GEP "make_psymbol"), 2, new_component(heap, -1, c_constant, newp->u.constpair->cst1), new_component(heap, -1, c_constant, newp->u.constpair->cst2)); newp->vclass = cst_expression; newp->u.expression = c; break; } case cst_expression: newp->u.expression = va_arg(args, component); break; default: abort(); } va_end(args); return newp; }
static void generate_component(component comp, fncode fn) { clist args; set_lineno(comp->lineno, fn); switch (comp->vclass) { case c_assign: { ulong offset; bool is_static; variable_class vclass = env_lookup(comp->u.assign.symbol, &offset, false, true, &is_static); 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; } } if (is_static) { ins1(op_recall + vclass, offset, fn); generate_component(comp->u.assign.value, fn); mexecute(g_symbol_set, NULL, 2, fn); break; } generate_component(comp->u.assign.value, fn); set_lineno(comp->lineno, fn); if (vclass == global_var) massign(offset, comp->u.assign.symbol, fn); else ins1(op_assign + vclass, 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_vref: case c_recall: { bool is_vref = comp->vclass == c_vref; ulong offset; bool is_static; variable_class vclass = env_lookup(comp->u.recall, &offset, true, is_vref, &is_static); if (is_static) { assert(vclass != global_var); ins1(op_recall + vclass, offset, fn); ulong gidx = is_vref ? g_make_symbol_ref : g_symbol_get; mexecute(gidx, NULL, 1, fn); break; } if (vclass != global_var) ins1((is_vref ? op_vref : op_recall) + vclass, offset, fn); else if (is_vref) { if (!mwritable(offset, comp->u.recall)) return; ins_constant(makeint(offset), fn); } else mrecall(offset, comp->u.recall, fn); if (is_vref) mexecute(g_make_variable_ref, "make_variable_ref", 1, fn); break; } case c_constant: ins_constant(make_constant(comp->u.cst), fn); break; case c_closure: { uword idx; idx = add_constant(generate_function(comp->u.closure, false, fn), fn); if (idx < ARG1_MAX) ins1(op_closure_code1, idx, fn); else ins2(op_closure_code2, idx, fn); break; } case c_block: generate_block(comp->u.blk, fn); break; case c_labeled: start_block(comp->u.labeled.name, fn); generate_component(comp->u.labeled.expression, fn); end_block(fn); break; case c_exit: generate_component(comp->u.labeled.expression, fn); if (!exit_block(comp->u.labeled.name, fn)) { if (!comp->u.labeled.name) log_error("no loop to exit from"); else log_error("no block labeled %s", comp->u.labeled.name); } break; case c_execute: { uword count; generate_args(comp->u.execute->next, fn, &count); set_lineno(comp->lineno, fn); 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: { block cb = new_codeblock(fnmemory(fn), NULL, new_clist(fnmemory(fn), args->next->c, new_clist(fnmemory(fn), component_undefined, NULL)), NULL, NULL, -1); generate_if(args->c, new_component(fnmemory(fn), args->next->c->lineno, c_block, cb), component_undefined, fn); break; } case b_ifelse: generate_if(args->c, args->next->c, args->next->next->c, fn); break; case b_sc_and: case b_sc_or: generate_if(comp, component_true, component_false, fn); break; case b_while: generate_while(args->c, args->next->c, fn); break; case b_loop: { label loop = new_label(fn); env_start_loop(); set_label(loop, fn); start_block(NULL, fn); generate_component(args->c, fn); branch(op_loop1, loop, fn); end_block(fn); env_end_loop(); adjust_depth(1, fn); break; } case b_add: case b_subtract: case b_ref: case b_set: case b_bitor: case b_bitand: case b_not: case b_eq: case b_ne: case b_lt: case b_le: case b_ge: case b_gt: { uword count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); set_lineno(comp->lineno, fn); ins0(builtin_ops[comp->u.builtin.fn], fn); break; } default: { uword count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); set_lineno(comp->lineno, fn); mexecute(builtin_functions[comp->u.builtin.fn], NULL, count, fn); break; } } break; default: abort(); } }