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)); } }