#include #include #include #include #include #include #include #include "gc.h" gc_stats_t gc_stats; /* Helper macros to reduce duplication */ #define VECTOR_BYTES(nelem) (sizeof(vector_t) + (sizeof(value_t) * (nelem))) #define BYTESTR_BYTES(size) (sizeof(byte_string_t) + (size)) /* Alignment must ensure each object has enough room to hold a pair (BH . new_addr) */ #define GC_ALIGNMENT ((size_t)(sizeof(pair_t))) object_t *get_object(value_t v) { if (is_object(v)) return _get_object(v); else abort(); } value_t cons(value_t car, value_t cdr) { gc_root_t car_root, cdr_root; pair_t *p; register_gc_root(&car_root, car); register_gc_root(&cdr_root, cdr); p = gc_alloc(sizeof(pair_t)); p->car = car_root.value; p->cdr = cdr_root.value; unregister_gc_root(&car_root); unregister_gc_root(&cdr_root); return pair_value(p); } pair_t *get_pair(value_t v) { if (is_pair(v)) return _get_pair(v); else abort(); } value_t make_box(value_t initial_value) { gc_root_t iv_root; box_t *box; register_gc_root(&iv_root, initial_value); box = (box_t*)gc_alloc(sizeof(box_t)); box->tag = TYPE_TAG_BOX; box->value = iv_root.value; unregister_gc_root(&iv_root); return object_value(box); } box_t *get_box(value_t v) { if (is_box(v)) return _get_box(v); else abort(); } value_t make_vector(size_t nelem, value_t initial_value) { gc_root_t iv_root; vector_t *vec; register_gc_root(&iv_root, initial_value); vec = (vector_t*)gc_alloc(VECTOR_BYTES(nelem)); vec->tag = TYPE_TAG_VECTOR; vec->size = nelem; for (int i = 0; i < nelem; ++i) vec->elements[i] = iv_root.value; unregister_gc_root(&iv_root); return object_value(vec); } vector_t *get_vector(value_t v) { if (is_vector(v)) return _get_vector(v); else abort(); } value_t make_byte_string(size_t size, int default_value) { const size_t nbytes = BYTESTR_BYTES(size); byte_string_t *str; str = (byte_string_t*)gc_alloc(nbytes); str->tag = TYPE_TAG_BYTESTR; str->size = size; memset(str->bytes, default_value, size); return object_value(str); } byte_string_t *get_byte_string(value_t v) { if (is_byte_string(v)) return _get_byte_string(v); else abort(); } intptr_t get_fixnum(value_t v) { if (is_fixnum(v)) return _get_fixnum(v); else abort(); } /****************************************************************************/ static char *gc_ranges[2]; static size_t gc_min_size; static size_t gc_max_size; static size_t gc_soft_limit; static int gc_current_range; static size_t gc_free_space; static char *gc_free_ptr; static gc_root_t gc_root_list = { .value = NIL, .prev = &gc_root_list, .next = &gc_root_list }; static inline size_t gc_align(size_t nbytes) __attribute__ ((const)); static int gc_range_of(void *object) __attribute__ ((const)); static void transfer_object(value_t *value); static size_t transfer_children(object_t *object); static inline size_t gc_align(size_t nbytes) { return ((nbytes + GC_ALIGNMENT - 1) & ~(GC_ALIGNMENT - 1)); } static int gc_range_of(void *object) { if (((uintptr_t)object >= (uintptr_t)gc_ranges[0]) && ((uintptr_t)object < (uintptr_t)gc_ranges[1])) return 0; if (((uintptr_t)object >= (uintptr_t)gc_ranges[1]) && ((uintptr_t)object < (uintptr_t)gc_ranges[2])) return 1; return -1; } void gc_init(size_t min_size, size_t max_size) { assert(min_size <= max_size); gc_ranges[0] = (char*)malloc(max_size); gc_ranges[1] = (char*)malloc(max_size); assert(gc_ranges[0] && gc_ranges[1]); gc_current_range = 0; gc_free_ptr = gc_ranges[gc_current_range]; gc_min_size = min_size; gc_max_size = max_size; gc_soft_limit = gc_min_size; gc_free_space = gc_soft_limit; gc_stats.collections = 0; gc_stats.total_ticks = 0; gc_stats.high_water = 0; } void register_gc_root(gc_root_t *root, value_t v) { root->value = v; root->prev = &gc_root_list; root->next = gc_root_list.next; root->next->prev = root; gc_root_list.next = root; } void unregister_gc_root(gc_root_t *root) { assert(root && root->prev && root->next); /* Uninitialized */ assert((root->prev != root) && (root->next != root)); /* Already removed */ /* Cut the given root out of the list */ root->prev->next = root->next; root->next->prev = root->prev; /* Remove dead references to root list; protects against double-removal */ root->prev = root->next = root; } void *gc_alloc(size_t nbytes) { nbytes = gc_align(nbytes); if (nbytes > gc_free_space) collect_garbage(nbytes); void *p = gc_free_ptr; gc_free_ptr += nbytes; gc_free_space -= nbytes; //debug(("Found %d bytes at %#.8p.\n", nbytes, p)); return p; } static void transfer_object(value_t *value) { if (is_object(*value)) { object_t *obj = get_object(*value); value_t new_value; assert(gc_range_of(obj) != gc_current_range); if (obj->tag == BROKEN_HEART) { /* Object has already been moved; just update the reference */ new_value = obj->payload.values[0]; } else { size_t nbytes; switch (obj->tag) { case TYPE_TAG_VECTOR: nbytes = VECTOR_BYTES(((const vector_t*)obj)->size); break; case TYPE_TAG_BYTESTR: nbytes = BYTESTR_BYTES(((const byte_string_t*)obj)->size); break; case TYPE_TAG_BOX: default: /* pair */ nbytes = sizeof(pair_t); break; } { void *newobj = gc_alloc(nbytes); memcpy(newobj, obj, nbytes); /* Keep the original tag bits (pair or object) */ new_value = object_value(newobj) | (*value & 2); } obj->tag = BROKEN_HEART; obj->payload.values[0] = new_value; } *value = new_value; } } static inline size_t transfer_children(object_t *obj) { switch (obj->tag) { case TYPE_TAG_VECTOR: { vector_t *vec = (vector_t*)obj; for (size_t i = 0; i < vec->size; ++i) { transfer_object(&vec->elements[i]); } return VECTOR_BYTES(vec->size); } case TYPE_TAG_BYTESTR: { return BYTESTR_BYTES(((const byte_string_t*)obj)->size); } case TYPE_TAG_BOX: default: /* pair */ { pair_t *p = (pair_t*)obj; transfer_object(&p->car); transfer_object(&p->cdr); return sizeof(pair_t); } } } void collect_garbage(size_t min_free) { static bool collecting = false; gc_root_t *root; char *object_ptr; //debug(("Collecting garbage...\n")); ++gc_stats.collections; gc_stats.total_ticks -= clock(); /* Recursive calls to collector should never occur */ if (collecting) { debug(("Ran out of memory while collecting garbage!\n")); abort(); } else collecting = true; /* Swap ranges; new "current" range is initially empty, old one is full */ gc_current_range = 1 - gc_current_range; gc_free_ptr = (char*)&gc_ranges[gc_current_range][0]; gc_free_space = gc_soft_limit; object_ptr = gc_free_ptr; /* Transfer GC roots (if necessary) */ root = gc_root_list.next; while (root != &gc_root_list) { transfer_object(&root->value); root = root->next; } /* Keep transferring until no more objects in the new range refer to the old one */ while (object_ptr < gc_free_ptr) { object_ptr += gc_align(transfer_children((object_t*)object_ptr)); } //debug(("Finished collection with %d bytes to spare (out of %d bytes).\n", gc_free_space, gc_soft_limit)); { size_t bytes_used = gc_soft_limit - gc_free_space; size_t min_limit = bytes_used + min_free; size_t new_limit = (5 * min_limit) / 3; if (new_limit > gc_max_size) new_limit = gc_max_size; else if (new_limit < gc_min_size) new_limit = gc_min_size; gc_free_space = (gc_free_space + new_limit) - gc_soft_limit; gc_soft_limit = new_limit; } if (gc_free_space < min_free) { out_of_memory(); } if (gc_soft_limit > gc_stats.high_water) { gc_stats.high_water = gc_soft_limit; } /* Done collecting. */ collecting = false; gc_stats.total_ticks += clock(); } /* vim:set sw=2 expandtab: */