static pic_value
weak_call(pic_state *pic)
{
pic_value key, val, weak;
int n;
n = pic_get_args(pic, "o|o", &key, &val);
if (! pic_obj_p(pic, key)) {
pic_error(pic, "attempted to set a non-object key", 1, key);
}
weak = pic_closure_ref(pic, 0);
if (n == 1) {
if (! pic_weak_has(pic, weak, key)) {
return pic_false_value(pic);
}
return pic_cons(pic, key, pic_weak_ref(pic, weak, key));
} else {
if (pic_undef_p(pic, val)) {
if (pic_weak_has(pic, weak, key)) {
pic_weak_del(pic, weak, key);
}
} else {
pic_weak_set(pic, weak, key, val);
}
return pic_undef_value(pic);
}
}
static void
gc_mark(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return;
gc_mark_object(pic, pic_ptr(pic, v));
}
static bool
is_shared_object(pic_state *pic, pic_value obj, struct writer_control *p) {
pic_value shared = p->shared;
if (! pic_obj_p(pic, obj)) {
return false;
}
if (! pic_weak_has(pic, shared, obj)) {
return false;
}
return pic_int(pic, pic_weak_ref(pic, shared, obj)) > 0;
}
pic_value
pic_protect(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return v;
if (pic->ai >= pic->arena_size) {
pic->arena_size = pic->arena_size * 2 + 1;
pic->arena = pic_realloc(pic, pic->arena, sizeof(struct object *) * pic->arena_size);
}
pic->arena[pic->ai++] = pic_ptr(pic, v);
return v;
}
struct pic_dict *
pic_attr(pic_state *pic, pic_value obj)
{
struct pic_dict *dict;
if (! pic_obj_p(obj)) {
pic_errorf(pic, "attribute: expected heap object, but got immediate value ~s", obj);
}
if (! pic_reg_has(pic, pic->attrs, pic_ptr(obj))) {
dict = pic_make_dict(pic);
pic_reg_set(pic, pic->attrs, pic_ptr(obj), pic_obj_value(dict));
return dict;
}
return pic_dict_ptr(pic_reg_ref(pic, pic->attrs, pic_ptr(obj)));
}
static pic_value
reg_call(pic_state *pic)
{
struct pic_proc *self = pic_get_proc(pic);
struct pic_reg *reg;
pic_value key, val;
int n;
n = pic_get_args(pic, "o|o", &key, &val);
if (! pic_obj_p(key)) {
pic_errorf(pic, "attempted to set a non-object key '~s' in a register", key);
}
reg = pic_reg_ptr(pic_proc_env_ref(pic, self, "reg"));
if (n == 1) {
return reg_get(pic, reg, pic_obj_ptr(key));
} else {
return reg_set(pic, reg, pic_obj_ptr(key), val);
}
}
void
pic_gc(pic_state *pic)
{
struct context *cxt;
size_t j;
khash_t(oblist) *s = &pic->oblist;
struct symbol *sym;
int it;
struct object *obj, *prev, *next;
assert(pic->gc_attrs == NULL);
if (! pic->gc_enable) {
return;
}
/* scan objects */
for (cxt = pic->cxt; cxt != NULL; cxt = cxt->prev) {
if (cxt->fp) gc_mark_object(pic, (struct object *)cxt->fp);
if (cxt->sp) gc_mark_object(pic, (struct object *)cxt->sp);
if (cxt->irep) gc_mark_object(pic, (struct object *)cxt->irep);
gc_mark(pic, cxt->conts);
}
for (j = 0; j < pic->ai; ++j) {
gc_mark_object(pic, (struct object *)pic->arena[j]);
}
gc_mark(pic, pic->globals);
gc_mark(pic, pic->halt);
/* scan weak references */
do {
struct object *key;
pic_value val;
int it;
khash_t(attr) *h;
struct attr *attr;
j = 0;
attr = pic->gc_attrs;
while (attr != NULL) {
h = &attr->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
key = kh_key(h, it);
val = kh_val(h, it);
if (is_alive(key)) {
if (pic_obj_p(pic, val) && ! is_alive((struct object *) pic_ptr(pic, val))) {
gc_mark(pic, val);
++j;
}
}
}
attr = attr->prev;
}
} while (j > 0);
/* reclaim dead weak references */
while (pic->gc_attrs != NULL) {
khash_t(attr) *h = &pic->gc_attrs->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
obj = kh_key(h, it);
if (! is_alive(obj)) {
kh_del(attr, h, it);
}
}
pic->gc_attrs = pic->gc_attrs->prev;
}
for (it = kh_begin(s); it != kh_end(s); ++it) {
if (! kh_exist(s, it))
continue;
sym = kh_val(s, it);
if (sym && ! is_alive((struct object *)sym)) {
kh_del(oblist, s, it);
}
}
/* reclaim dead objects */
for (prev = &pic->gc_head, obj = prev->next; obj != &pic->gc_head; prev = obj, obj = next) {
next = obj->next;
if (is_alive(obj)) {
unmark(obj);
} else {
gc_finalize_object(pic, obj);
pic_free(pic, obj);
prev->next = next;
obj = prev;
}
}
}
static void
gc_mark_object(pic_state *pic, struct object *obj)
{
loop:
if (is_alive(obj))
return;
mark(obj);
#define LOOP(o) obj = (struct object *)(o); goto loop
switch (obj_type(obj)) {
case PIC_TYPE_PAIR: {
struct pair *pair = (struct pair *) obj;
gc_mark(pic, pair->car);
if (pic_obj_p(pic, pair->cdr)) {
LOOP(pic_ptr(pic, pair->cdr));
}
break;
}
case PIC_TYPE_FRAME: {
struct frame *frame = (struct frame *) obj;
int i;
for (i = 0; i < frame->regc; ++i) {
gc_mark(pic, frame->regs[i]);
}
if (frame->up) {
LOOP(frame->up);
}
break;
}
case PIC_TYPE_PROC_FUNC: {
struct proc *proc = (struct proc *) obj;
if (proc->env) {
LOOP(proc->env);
}
break;
}
case PIC_TYPE_PROC_IREP: {
struct proc *proc = (struct proc *) obj;
if (proc->env) {
gc_mark_object(pic, (struct object *) proc->env);
}
LOOP(proc->u.irep);
break;
}
case PIC_TYPE_IREP: {
struct irep *irep = (struct irep *) obj;
size_t i;
for (i = 0; i < irep->objc; ++i) {
gc_mark(pic, irep->obj[i]);
}
for (i = 0; i < irep->irepc; ++i) {
gc_mark_object(pic, (struct object *) irep->irep[i]);
}
break;
}
case PIC_TYPE_VECTOR: {
struct vector *vec = (struct vector *) obj;
int i;
for (i = 0; i < vec->len; ++i) {
gc_mark(pic, vec->data[i]);
}
break;
}
case PIC_TYPE_DICT: {
struct dict *dict = (struct dict *) obj;
khash_t(dict) *h = &dict->hash;
int it;
for (it = 0; it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, (struct object *) kh_key(h, it));
gc_mark(pic, kh_val(h, it));
}
}
break;
}
case PIC_TYPE_RECORD: {
struct record *rec = (struct record *) obj;
gc_mark(pic, rec->datum);
LOOP(rec->type);
break;
}
case PIC_TYPE_SYMBOL: {
struct symbol *sym = (struct symbol *) obj;
LOOP(sym->str);
break;
}
case PIC_TYPE_ATTR: {
struct attr *attr = (struct attr *) obj;
attr->prev = pic->gc_attrs;
pic->gc_attrs = attr;
break;
}
case PIC_TYPE_STRING: {
struct string *str = (struct string *) obj;
LOOP(str->rope);
break;
}
case PIC_TYPE_ROPE_NODE: {
struct rope_node *node = (struct rope_node *) obj;
gc_mark_object(pic, (struct object *) node->s1);
LOOP(node->s2);
break;
}
case PIC_TYPE_ROPE_LEAF:
case PIC_TYPE_BLOB:
case PIC_TYPE_DATA:
break;
default:
PIC_UNREACHABLE();
}
}
