/* Deallocation */
cell_t *drop_dependencies(secd_t *secd, cell_t *c) {
enum cell_type t = cell_type(c);
switch (t) {
case CELL_SYM:
if (c->as.sym.size != DONT_FREE_THIS)
free((char *)c->as.sym.data);
/* TODO: this silently ignores symbol memory corruption */
c->as.sym.size = DONT_FREE_THIS;
break;
case CELL_FRAME:
drop_cell(secd, c->as.frame.io);
// fall through
case CELL_CONS:
if (not_nil(c)) {
drop_cell(secd, get_car(c));
drop_cell(secd, get_cdr(c));
}
break;
case CELL_STR:
case CELL_ARRAY:
drop_array(secd, arr_mem(c));
break;
case CELL_REF:
drop_cell(secd, c->as.ref);
break;
case CELL_PORT:
secd_pclose(secd, c);
break;
case CELL_ARRMETA:
if (c->as.mcons.cells) {
size_t size = arrmeta_size(secd, c);
size_t i;
/* free the items */
for (i = 0; i < size; ++i) {
/* don't free uninitialized */
cell_t *ith = meta_mem(c) + i;
if (cell_type(ith) != CELL_UNDEF)
drop_dependencies(secd, ith);
}
}
break;
case CELL_INT: case CELL_FUNC: case CELL_OP:
case CELL_ERROR: case CELL_UNDEF:
return c;
default:
return new_error(secd, "drop_dependencies: unknown cell_type 0x%x", t);
}
return c;
}
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;
}
