cell_t *alloc_array(secd_t *secd, size_t size) {
/* look through the list of arrays */
cell_t *cur = secd->arrlist;
while (not_nil(mcons_next(cur))) {
if (is_array_free(secd, cur)) {
size_t cursize = arrmeta_size(secd, cur);
if (cursize >= size) {
/* allocate this gap */
if (cursize > size + 1) {
/* make a free gap after */
cell_t *newmeta = cur + size + 1;
cell_t *prevmeta = mcons_prev(cur);
init_meta(secd, newmeta, prevmeta, cur);
cur->as.mcons.prev = newmeta;
prevmeta->as.mcons.next = newmeta;
mark_free(newmeta, true);
}
mark_free(cur, false);
return meta_mem(cur);
}
}
cur = mcons_next(cur);
}
/* no chunks of sufficient size found, move secd->arrayptr */
if (secd->arrayptr - secd->fixedptr <= (int)size)
return &secd_out_of_memory;
/* create new metadata cons at arrayptr - size - 1 */
cell_t *oldmeta = secd->arrayptr;
cell_t *meta = oldmeta - size - 1;
init_meta(secd, meta, oldmeta, SECD_NIL);
oldmeta->as.mcons.next = meta;
secd->arrayptr = meta;
memdebugf("NEW ARR[%ld], size %zd\n", cell_index(secd, meta), size);
mark_free(meta, false);
return meta_mem(meta);
}
/* 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_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;
}
