void secd_print_env(secd_t *secd) {
cell_t *env = secd->env;
int i = 0;
secd_printf(secd, ";;Environment:\n");
while (not_nil(env)) {
secd_printf(secd, ";; Frame #%d:\n", i++);
cell_t *frame = get_car(env);
cell_t *symlist = get_car(frame);
cell_t *vallist = get_cdr(frame);
while (not_nil(symlist)) {
if (is_symbol(symlist)) {
secd_printf(secd, ";; . %s\t=>\t", symname(symlist));
dbg_print_cell(secd, vallist);
break;
}
cell_t *sym = get_car(symlist);
cell_t *val = get_car(vallist);
if (!is_symbol(sym)) {
errorf("print_env: not a symbol at *%p in symlist\n", sym);
dbg_printc(secd, sym);
}
secd_printf(secd, ";; %s\t=>\t", symname(sym));
dbg_print_cell(secd, val);
symlist = list_next(secd, symlist);
vallist = list_next(secd, vallist);
}
env = list_next(secd, env);
}
}
void dbg_print_cell(secd_t *secd, const cell_t *c) {
if (is_nil(c)) {
secd_printf(secd, "NIL\n");
return;
}
char buf[128];
if (c->nref > DONT_FREE_THIS - 100000) strncpy(buf, "-", 64);
else snprintf(buf, 128, "%ld", (long)c->nref);
printf("[%ld]^%s: ", cell_index(secd, c), buf);
switch (cell_type(c)) {
case CELL_CONS:
printf("CONS([%ld], [%ld])\n",
cell_index(secd, get_car(c)), cell_index(secd, get_cdr(c)));
break;
case CELL_FRAME:
printf("FRAME(syms: [%ld], vals: [%ld])\n",
cell_index(secd, get_car(c)), cell_index(secd, get_cdr(c)));
break;
case CELL_INT: printf("%d\n", c->as.num); break;
case CELL_CHAR:
if (isprint(c->as.num)) printf("#\\%c\n", (char)c->as.num);
else printf("#x%x\n", c->as.num);
break;
case CELL_OP:
sexp_print_opcode(secd, secd->output_port, c->as.op);
printf("\n");
break;
case CELL_FUNC: printf("*%p()\n", c->as.ptr); break;
case CELL_KONT: printf("KONT[%ld, %ld, %ld]\n",
cell_index(secd, c->as.kont.stack),
cell_index(secd, c->as.kont.env),
cell_index(secd, c->as.kont.ctrl)); break;
case CELL_ARRAY: printf("ARR[%ld]\n",
cell_index(secd, arr_val(c, 0))); break;
case CELL_STR: printf("STR[%ld\n",
cell_index(secd, (cell_t*)strval(c))); break;
case CELL_SYM: printf("SYM[%08x]='%s'\n",
symhash(c), symname(c)); break;
case CELL_BYTES: printf("BVECT[%ld]\n",
cell_index(secd, (cell_t*)strval(c))); break;
case CELL_REF: printf("REF[%ld]\n",
cell_index(secd, c->as.ref)); break;
case CELL_ERROR: printf("ERR[%s]\n", errmsg(c)); break;
case CELL_ARRMETA: printf("META[%ld, %ld]\n",
cell_index(secd, mcons_prev((cell_t*)c)),
cell_index(secd, mcons_next((cell_t*)c))); break;
case CELL_UNDEF: printf("#?\n"); break;
case CELL_FREE: printf("FREE\n"); break;
default: printf("unknown type: %d\n", cell_type(c));
}
}
