void sexp_print_array(secd_t *secd, cell_t *p, const cell_t *cell) {
const cell_t *arr = arr_val(cell, 0);
const size_t len = arr_size(secd, cell);
size_t i;
secd_pprintf(secd, p, "#(");
for (i = cell->as.arr.offset; i < len; ++i) {
sexp_pprint(secd, p, arr + i);
secd_pprintf(secd, p, " ");
}
secd_pprintf(secd, p, ")");
}
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));
}
}
cell_t *serialize_cell(secd_t *secd, cell_t *cell) {
cell_t *opt = SECD_NIL;
switch (cell_type(cell)) {
case CELL_CONS: {
cell_t *cdrc = chain_index(secd, get_cdr(cell), SECD_NIL);
opt = chain_index(secd, get_car(cell), cdrc);
}
break;
case CELL_PORT:
opt = secd_pserialize(secd, cell);
break;
case CELL_SYM:
opt = new_cons(secd, cell, SECD_NIL);
break;
case CELL_INT:
case CELL_CHAR:
opt = new_cons(secd, cell, SECD_NIL);
break;
case CELL_OP: {
cell_t *namec = new_symbol(secd, opcode_table[ cell->as.op ].name);
opt = new_cons(secd, namec, SECD_NIL);
}
break;
case CELL_FUNC:
opt = new_cons(secd, new_number(secd, (long)cell->as.ptr), SECD_NIL);
break;
case CELL_ARRMETA: {
cell_t *typec = chain_sym(secd,
(cell->as.mcons.cells ? "cell" : "byte"),
SECD_NIL);
cell_t *nextc = chain_index(secd, mcons_next(cell), typec);
opt = chain_index(secd, mcons_prev(cell), nextc);
}
break;
case CELL_FRAME: {
cell_t *ioc = chain_index(secd, cell->as.frame.io, SECD_NIL);
cell_t *nextc = chain_index(secd, cell->as.frame.cons.cdr, ioc);
opt = chain_index(secd, cell->as.frame.cons.car, nextc);
}
break;
case CELL_KONT: {
cell_t *kctrl = chain_index(secd, cell->as.kont.ctrl, SECD_NIL);
cell_t *kenv = chain_index(secd, cell->as.kont.env, kctrl);
opt = chain_index(secd, cell->as.kont.stack, kenv);
}
break;
case CELL_FREE: {
cell_t *nextc = chain_index(secd, get_cdr(cell), SECD_NIL);
opt = chain_index(secd, get_car(cell), nextc);
}
break;
case CELL_REF:
opt = chain_index(secd, cell->as.ref, SECD_NIL);
break;
case CELL_ERROR:
opt = chain_string(secd, errmsg(cell), SECD_NIL);
break;
case CELL_UNDEF:
opt = SECD_NIL;
break;
case CELL_ARRAY:
opt = chain_index(secd, arr_val(cell, -1), SECD_NIL);
break;
case CELL_STR:
case CELL_BYTES:
opt = chain_index(secd, arr_meta((cell_t *)strmem(cell)), SECD_NIL);
break;
}
opt = new_cons(secd, secd_type_sym(secd, cell), opt);
cell_t *refc = new_cons(secd, new_number(secd, cell->nref), opt);
return new_cons(secd, new_number(secd, cell - secd->begin), refc);
}