/* machine printing, (write) */
void sexp_pprint(secd_t* secd, cell_t *port, const cell_t *cell) {
switch (cell_type(cell)) {
case CELL_UNDEF: secd_pprintf(secd, port, "#?"); break;
case CELL_INT: secd_pprintf(secd, port, "%d", cell->as.num); break;
case CELL_CHAR:
if (isprint(cell->as.num))
secd_pprintf(secd, port, "#\\%c", (char)cell->as.num);
else
secd_pprintf(secd, port, "#\\x%x", numval(cell));
break;
case CELL_OP: sexp_print_opcode(secd, port, cell->as.op); break;
case CELL_FUNC: secd_pprintf(secd, port, "##func*%p", cell->as.ptr); break;
case CELL_FRAME: secd_pprintf(secd, port,
"##frame@%ld ", cell_index(secd, cell)); break;
case CELL_KONT: secd_pprintf(secd, port,
"##kont@%ld ", cell_index(secd, cell)); break;
case CELL_CONS: sexp_print_list(secd, port, cell); break;
case CELL_ARRAY: sexp_print_array(secd, port, cell); break;
case CELL_STR: secd_pprintf(secd, port, "\"%s\"", strval(cell) + cell->as.str.offset); break;
case CELL_SYM: secd_pprintf(secd, port, "%s", symname(cell)); break;
case CELL_BYTES: sexp_print_bytes(secd, port, strval(cell), mem_size(cell)); break;
case CELL_ERROR: secd_pprintf(secd, port, "#!\"%s\"", errmsg(cell)); break;
case CELL_PORT: sexp_pprint_port(secd, port, cell); break;
case CELL_REF: sexp_pprint(secd, port, cell->as.ref); break;
default: errorf("sexp_print: unknown cell type %d", (int)cell_type(cell));
}
}
static void sexp_print_list(secd_t *secd, cell_t *port, const cell_t *cell) {
secd_pprintf(secd, port, "(");
const cell_t *iter = cell;
while (not_nil(iter)) {
if (iter != cell) secd_pprintf(secd, port, " ");
if (cell_type(iter) != CELL_CONS) {
secd_pprintf(secd, port, ". ");
sexp_pprint(secd, port, iter); break;
}
cell_t *head = get_car(iter);
sexp_pprint(secd, port, head);
iter = list_next(secd, iter);
}
secd_pprintf(secd, port, ") ");
}
/* human-readable, (display) */
void sexp_display(secd_t *secd, cell_t *port, cell_t *cell) {
switch (cell_type(cell)) {
case CELL_STR:
secd_pprintf(secd, port, "%s", strval(cell));
break;
default: sexp_pprint(secd, port, cell);
}
}
int secd_dump_state(secd_t *secd, cell_t *fname) {
cell_t *p = secd_newport(secd, "w", "file", fname);
secd_pprintf(secd, p,
";; secd->fixedptr = %ld\n", cell_index(secd, secd->fixedptr));
secd_pprintf(secd, p,
";; secd->arrayptr = %ld\n", cell_index(secd, secd->arrayptr));
secd_pprintf(secd, p,
";; secd->end = %ld\n", cell_index(secd, secd->end));
secd_pprintf(secd, p, ";; secd->input_port = %ld, secd->output_port = %ld\n",
cell_index(secd, secd->input_port), cell_index(secd, secd->output_port));
secd_pprintf(secd, p, ";; SECD = (%ld, %ld, %ld, %ld)\n",
cell_index(secd, secd->stack), cell_index(secd, secd->env),
cell_index(secd, secd->control), cell_index(secd, secd->dump));
secd_pprintf(secd, p, ";; secd->free = %ld (%ld free)\n",
cell_index(secd, secd->free), secd->stat.free_cells);
/* dump fixed heap */
long i;
long n_fixed = secd->fixedptr - secd->begin;
secd_pprintf(secd, p, "\n;; SECD persistent heap:\n");
for (i = 0; i < n_fixed; ++i) {
cell_t *cell_info = serialize_cell(secd, secd->begin + i);
sexp_pprint(secd, p, cell_info);
secd_pprintf(secd, p, "\n");
free_cell(secd, cell_info);
}
secd_pprintf(secd, p, "\n;; SECD array heap:\n");
cell_t *mcons = secd->arrlist;
while (mcons_next(mcons)) {
cell_t *cell_info = serialize_cell(secd, mcons);
sexp_pprint(secd, p, cell_info);
if (!mcons->as.mcons.free)
secd_pdump_array(secd, p, mcons);
secd_pprintf(secd, p, "\n");
free_cell(secd, cell_info);
mcons = mcons_next(mcons);
}
secd_pclose(secd, p);
free_cell(secd, p);
return 0;
}
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, ")");
}
int secd_pdump_array(secd_t *secd, cell_t *p, cell_t *mcons) {
if (mcons->as.mcons.cells) {
secd_pprintf(secd, p, " #(");
cell_t *mem = meta_mem(mcons);
size_t len = arrmeta_size(secd, mcons);
size_t i;
for (i = 0; i < len; ++i) {
cell_t *item_info = serialize_cell(secd, mem + i);
sexp_pprint(secd, p, item_info);
free_cell(secd, item_info);
}
secd_pprintf(secd, p, ")");
} else {
sexp_print_bytes(secd, p, (char *)(mcons + 1),
sizeof(cell_t) * arrmeta_size(secd, mcons));
}
return 0;
}
void sexp_print(secd_t *secd, const cell_t *cell) {
sexp_pprint(secd, secd->output_port, cell);
}
