static void traverse(pic_state *pic, pic_value obj, struct writer_control *p) { pic_value shared = p->shared; if (p->op == OP_WRITE_SIMPLE) { return; } switch (pic_type(pic, obj)) { case PIC_TYPE_PAIR: case PIC_TYPE_VECTOR: case PIC_TYPE_DICT: { if (! pic_weak_has(pic, shared, obj)) { /* first time */ pic_weak_set(pic, shared, obj, pic_int_value(pic, 0)); if (pic_pair_p(pic, obj)) { /* pair */ traverse(pic, pic_car(pic, obj), p); traverse(pic, pic_cdr(pic, obj), p); } else if (pic_vec_p(pic, obj)) { /* vector */ int i, len = pic_vec_len(pic, obj); for (i = 0; i < len; ++i) { traverse(pic, pic_vec_ref(pic, obj, i), p); } } else { /* dictionary */ int it = 0; pic_value val; while (pic_dict_next(pic, obj, &it, NULL, &val)) { traverse(pic, val, p); } } if (p->op == OP_WRITE) { if (pic_int(pic, pic_weak_ref(pic, shared, obj)) == 0) { pic_weak_del(pic, shared, obj); } } } else { /* second time */ pic_weak_set(pic, shared, obj, pic_int_value(pic, 1)); } break; } default: break; } }
static void write_dict(pic_state *pic, pic_value dict, pic_value port, struct writer_control *p) { pic_value key, val; int it = 0; pic_fprintf(pic, port, "#.(dictionary"); while (pic_dict_next(pic, dict, &it, &key, &val)) { pic_fprintf(pic, port, " '%s ", pic_sym(pic, key)); write_core(pic, val, port, p); } pic_fprintf(pic, port, ")"); }
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(pic, obj)) { case PIC_TYPE_PAIR: { gc_mark(pic, obj->u.pair.car); if (obj_p(pic, obj->u.pair.cdr)) { LOOP(obj_ptr(pic, obj->u.pair.cdr)); } break; } case PIC_TYPE_FRAME: { int i; for (i = 0; i < obj->u.frame.regc; ++i) { gc_mark(pic, obj->u.frame.regs[i]); } if (obj->u.frame.up) { LOOP(obj->u.frame.up); } break; } case PIC_TYPE_PROC_FUNC: { if (obj->u.proc.env) { LOOP(obj->u.proc.env); } break; } case PIC_TYPE_PROC_IREP: { if (obj->u.proc.env) { gc_mark_object(pic, (struct object *)obj->u.proc.env); } LOOP(obj->u.proc.u.irep); break; } case PIC_TYPE_IREP: { size_t i; for (i = 0; i < obj->u.irep.objc; ++i) { gc_mark(pic, obj->u.irep.obj[i]); } for (i = 0; i < obj->u.irep.irepc; ++i) { gc_mark_object(pic, (struct object *)obj->u.irep.irep[i]); } break; } case PIC_TYPE_PORT: { break; } case PIC_TYPE_ERROR: { gc_mark_object(pic, (struct object *)obj->u.err.type); gc_mark(pic, obj->u.err.irrs); LOOP(obj->u.err.msg); break; } case PIC_TYPE_STRING: { break; } case PIC_TYPE_VECTOR: { int i; for (i = 0; i < obj->u.vec.len; ++i) { gc_mark(pic, obj->u.vec.data[i]); } break; } case PIC_TYPE_BLOB: { break; } case PIC_TYPE_DATA: { break; } case PIC_TYPE_DICT: { pic_value key, val; int it = 0; while (pic_dict_next(pic, obj_value(pic, &obj->u.dict), &it, &key, &val)) { gc_mark(pic, key); gc_mark(pic, val); } break; } case PIC_TYPE_RECORD: { gc_mark(pic, obj->u.rec.datum); LOOP(obj->u.rec.type); break; } case PIC_TYPE_SYMBOL: { LOOP(obj->u.sym.str); break; } case PIC_TYPE_WEAK: { struct weak *weak = (struct weak *)obj; weak->prev = pic->heap->weaks; pic->heap->weaks = weak; break; } default: PIC_UNREACHABLE(); } }