nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
rosella/gc.c

780 lines
18 KiB
C
Raw Blame History

#define _POSIX_C_SOURCE 199309L
#include <assert.h>
#include <inttypes.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "gc.h"
#if _CLOCK_MONOTONIC
# define TIMING_CLOCK CLOCK_MONOTONIC
#else
# define TIMING_CLOCK CLOCK_REALTIME
#endif
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))
#define STRUCT_BYTES(nslots) (sizeof(struct_t) + (sizeof(value_t) * (nslots)))
/* Alignment must ensure each object has enough room to hold a forwarding object */
#define GC_ALIGNMENT ((size_t)(sizeof(object_t)))
/****************************************************************************/
static char *gc_ranges[2];
static size_t gc_min_size;
static size_t gc_max_size;
static size_t gc_soft_limit;
static bool gc_enabled;
static int gc_current_range;
static char *gc_free_ptr;
static char *gc_range_end;
static value_t gc_weak_box_list;
static value_t gc_will_list;
static value_t gc_will_active_list;
static gc_root_t gc_root_list = {
.value = NIL,
.prev = &gc_root_list,
.next = &gc_root_list
};
void register_gc_root(gc_root_t *root, value_t v)
{
root->value = v;
root->next = &gc_root_list;
gc_root_list.prev->next = root;
root->prev = gc_root_list.prev;
gc_root_list.prev = 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;
}
/****************************************************************************/
object_t *get_object(value_t v)
{
if (is_object(v))
return _get_object(v);
else
abort();
}
/* No one outside this module should care... */
static inline bool is_broken_heart(value_t v)
{
return is_object(v) && (_get_object(v)->tag == BROKEN_HEART);
}
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 = (pair_t*)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();
}
value_t make_struct(value_t type, size_t nslots)
{
gc_root_t type_root;
struct_t *s;
register_gc_root(&type_root, type);
s = (struct_t*)gc_alloc(STRUCT_BYTES(nslots));
s->tag = TYPE_TAG_STRUCT;
s->type = type_root.value;
s->nslots = nslots;
for (int i = 0; i < nslots; ++i)
s->slots[i] = NIL;
unregister_gc_root(&type_root);
return object_value(s);
}
struct_t *get_struct(value_t v)
{
if (is_struct(v))
return _get_struct(v);
else
abort();
}
value_t make_weak_box(value_t initial_value)
{
gc_root_t iv_root;
weak_box_t *box;
register_gc_root(&iv_root, initial_value);
box = (weak_box_t*)gc_alloc(sizeof(weak_box_t));
box->tag = TYPE_TAG_WEAK_BOX;
box->value = iv_root.value;
box->next = gc_weak_box_list;
gc_weak_box_list = object_value(box);
unregister_gc_root(&iv_root);
return object_value(box);
}
weak_box_t *get_weak_box(value_t v)
{
if (is_weak_box(v))
return _get_weak_box(v);
else
abort();
}
void register_finalizer(value_t value, value_t finalizer)
{
/* Non-objects are never GC'd, so their finalizers will never be invoked. */
if (is_object(value))
{
gc_root_t value_root, finalizer_root;
will_t *w;
register_gc_root(&value_root, value);
register_gc_root(&finalizer_root, finalizer);
w = (will_t*)gc_alloc(sizeof(will_t));
w->tag = TYPE_TAG_WILL;
w->value = value_root.value;
w->finalizer = finalizer_root.value;
w->next = gc_will_list;
gc_will_list = object_value(w);
unregister_gc_root(&value_root);
unregister_gc_root(&finalizer_root);
}
}
/* The 'will' accessors are private to the GC, unlike other similar routines. */
static inline will_t *_get_will(value_t v)
{
return (will_t*)_get_object(v);
}
static will_t *get_will(value_t v)
{
if (is_will(v))
return _get_will(v);
else
abort();
}
fixnum_t get_fixnum(value_t v)
{
if (is_fixnum(v))
return _get_fixnum(v);
else
abort();
}
/****************************************************************************/
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 void _collect_garbage(size_t min_free);
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 (((value_t)object >= (value_t)gc_ranges[0]) &&
((value_t)object < (value_t)gc_ranges[1]))
return 0;
if (((value_t)object >= (value_t)gc_ranges[1]) &&
((value_t)object < (value_t)gc_ranges[2]))
return 1;
return -1;
}
static inline size_t gc_free_space(void)
{
return gc_range_end - gc_free_ptr;
}
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_range_end = gc_free_ptr + gc_soft_limit;
gc_stats.collections = 0;
gc_stats.total_ns = 0;
gc_stats.total_freed = 0;
gc_stats.high_water = 0;
gc_stats.max_ns = 0;
gc_weak_box_list = NIL;
gc_will_list = NIL;
gc_will_active_list = NIL;
gc_enabled = true;
}
/* Preconditions: nbytes pre-aligned a la gc_align(), and space exists. */
static inline void *_gc_alloc(size_t nbytes)
{
void *p = gc_free_ptr;
assert(nbytes == gc_align(nbytes));
assert(nbytes <= gc_free_space());
gc_free_ptr += nbytes;
return p;
}
void *gc_alloc(size_t nbytes)
{
nbytes = gc_align(nbytes);
if (nbytes > gc_free_space())
_collect_garbage(nbytes);
return _gc_alloc(nbytes);
}
/* Precondition: *value refers to an object (or pair). */
static void transfer_object(value_t *value)
{
if (is_object(*value))
{
object_t *obj = _get_object(*value);
size_t nbytes;
void *newobj;
assert(gc_range_of(obj) != gc_current_range);
if (obj->tag == BROKEN_HEART)
{
/* Object has already been moved; just update the reference */
*value = obj->forward;
return;
}
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_STRUCT:
nbytes = STRUCT_BYTES(((const struct_t*)obj)->nslots);
break;
case TYPE_TAG_WEAK_BOX:
nbytes = sizeof(weak_box_t);
break;
case TYPE_TAG_WILL:
nbytes = sizeof(will_t);
break;
case TYPE_TAG_BOX:
nbytes = sizeof(box_t);
break;
default: /* pair */
nbytes = sizeof(pair_t);
break;
}
newobj = _gc_alloc(gc_align(nbytes));
memcpy(newobj, obj, nbytes);
/* Keep the original tag bits (pair or object) */
obj->tag = BROKEN_HEART;
*value = obj->forward = (object_value(newobj) & ~2) | (*value & 2);
}
}
static size_t transfer_vector(vector_t *vec)
{
assert(vec->tag == TYPE_TAG_VECTOR);
for (size_t i = 0; i < vec->size; ++i)
transfer_object(&vec->elements[i]);
return VECTOR_BYTES(vec->size);
}
static size_t transfer_struct(struct_t *s)
{
assert(s->tag == TYPE_TAG_STRUCT);
transfer_object(&s->type);
for (size_t i = 0; i < s->nslots; ++i)
transfer_object(&s->slots[i]);
return STRUCT_BYTES(s->nslots);
}
static size_t transfer_pair(pair_t *p)
{
transfer_object(&p->car);
transfer_object(&p->cdr);
return sizeof(pair_t);
}
static size_t transfer_will(will_t *w)
{
assert(w->tag == TYPE_TAG_WILL);
transfer_object(&w->finalizer);
/* Weak boxes are discarded when there are no other references,
* but wills need to remain until their finalizers are invoked. */
transfer_object(&w->next);
return sizeof(will_t);
}
static size_t transfer_children(object_t *obj)
{
switch (obj->tag)
{
case TYPE_TAG_VECTOR:
return transfer_vector((vector_t*)obj);
case TYPE_TAG_BYTESTR:
return BYTESTR_BYTES(((const byte_string_t*)obj)->size);
case TYPE_TAG_STRUCT:
return transfer_struct((struct_t*)obj);
case TYPE_TAG_WEAK_BOX:
return sizeof(weak_box_t);
case TYPE_TAG_WILL:
return transfer_will((will_t*)obj);
case TYPE_TAG_BOX:
default: /* pair */
return transfer_pair((pair_t*)obj);
}
}
static void swap_gc_ranges(void)
{
gc_current_range = 1 - gc_current_range;
gc_free_ptr = gc_ranges[gc_current_range];
gc_range_end = gc_free_ptr + gc_soft_limit;
}
static void transfer_roots(void)
{
/* Transfer registered GC roots */
for (gc_root_t *root = gc_root_list.next; root != &gc_root_list; root = root->next)
transfer_object(&root->value);
/* Ensure pending will list is transferred */
transfer_object(&gc_will_list);
/* The values associated with active wills are also roots */
for (value_t *will = &gc_will_active_list; !is_nil(*will); will = &_get_will(*will)->next)
transfer_object(&get_will(*will)->value);
/* Ensure active list itself is transferred */
transfer_object(&gc_will_active_list);
}
static void process_weak_boxes(void)
{
value_t wb = gc_weak_box_list;
while (!is_nil(wb))
{
weak_box_t *box;
if (is_broken_heart(wb))
{
/* Box has been moved; get a pointer to the new location, but don't update list yet. */
value_t fw = _get_object(wb)->forward;
assert(is_weak_box(fw));
box = _get_weak_box(fw);
}
else
{
/* Box hasn't been moved yet, but may live on as the value of a will. */
assert(is_weak_box(wb));
box = _get_weak_box(wb);
}
if (is_broken_heart(box->value))
{
/* The value in the box is reachable; update w/ new location. */
box->value = _get_object(box->value)->forward;
}
else if (is_object(box->value))
{
/* The value in the box is an unreachable object; change to #f. */
/* Note that an object is considered unreachable via weak box when it could be finalized,
* even though it will be kept alive until the finalizer(s) is/are removed from the 'active'
* list and the finalizer(s) itself/themselves may restore the object to a reachable state. */
/* This last behavior is not recommended. */
box->value = FALSE_VALUE;
}
/* Move on to this box's 'next' pointer */
wb = box->next;
}
}
/* Precondition: The wills themselves, and their finalizers,
* have already been transferred (recursively). */
static void process_wills(void)
{
/*
* Was value transferred (broken heart), and thus reachable?
* Yes ==> update value.
* No ==> transfer value and move will to active list.
*/
value_t *will = &gc_will_list;
while (!is_nil(*will))
{
will_t *w = get_will(*will);
if (is_broken_heart(w->value))
{
/* The value associated with the will is still reachable; update w/ new location. */
w->value = _get_object(w->value)->forward;
/* Move on to this will's 'next' pointer */
will = &w->next;
}
else
{
assert(is_object(w->value));
/*
* The will is associated with an unreachable object; activate it.
*/
/* First, ensure that the value remains reachable for the finalizer. */
transfer_object(&w->value);
/* Remove the will from the 'pending' list. */
*will = w->next;
/* Insert the will into the 'active' list. */
w->next = gc_will_active_list;
gc_will_active_list = object_value(w);
}
}
}
static void update_weak_box_list(void)
{
value_t *wb = &gc_weak_box_list;
while (!is_nil(*wb))
{
if (is_broken_heart(*wb))
{
/* The box itself is reachable; need to update 'next' pointer to new location */
*wb = _get_object(*wb)->forward;
/* Move on to next box's 'next' pointer */
assert(is_weak_box(*wb));
wb = &_get_weak_box(*wb)->next;
}
else
{
/* Box is no longer reachable; remove it from the list by updating 'next' pointer. */
assert(is_weak_box(*wb));
*wb = _get_weak_box(*wb)->next;
}
}
}
#define GC_DEFLATE_SIZE (64*1024)
static void update_soft_limit(size_t min_free)
{
size_t bytes_used = gc_free_ptr - gc_ranges[gc_current_range];
size_t min_limit = bytes_used + min_free;
size_t new_limit = (4 * min_limit) / 3;
if (gc_soft_limit > GC_DEFLATE_SIZE)
{
size_t deflate_limit = gc_soft_limit - GC_DEFLATE_SIZE;
if (new_limit < deflate_limit)
new_limit = deflate_limit;
}
if (new_limit > gc_max_size)
new_limit = gc_max_size;
else if (new_limit < gc_min_size)
new_limit = gc_min_size;
gc_soft_limit = new_limit;
/* Update end of range to reflect new limit */
gc_range_end = gc_ranges[gc_current_range] + gc_soft_limit;
#ifndef NO_STATS
if (gc_soft_limit > gc_stats.high_water)
{
gc_stats.high_water = gc_soft_limit;
}
#endif
}
static void _collect_garbage(size_t min_free)
{
if (gc_enabled)
{
char *object_ptr;
#ifndef NO_STATS
#ifndef NO_TIMING_STATS
struct timespec start_time;
clock_gettime(TIMING_CLOCK, &start_time);
#endif
gc_stats.total_freed -= gc_free_space();
++gc_stats.collections;
#endif
//debug(("Collecting garbage...\n"));
swap_gc_ranges();
/* New "current" range is initially empty, old one is full */
object_ptr = gc_free_ptr;
/* Prime the pump */
transfer_roots();
/* Keep transferring until no more objects in the new range refer to the old one,
* other than pending wills and weak boxes. */
while (object_ptr < gc_free_ptr)
{
object_ptr += gc_align(transfer_children((object_t*)object_ptr));
}
/* These have to be examined after normal reachability has been determined */
process_weak_boxes();
process_wills();
/* Keep transferring until no more objects in the new range refer to the old one.
* This is so that values which are otherwise unreachable, but have finalizers which
* may be able to reach them, are not collected prematurely. process_wills() transfers
* the value of any will newly placed on the active list. Note that these values may
* be finalized in any order, and that any weak references have already been cleared. */
while (object_ptr < gc_free_ptr)
{
object_ptr += gc_align(transfer_children((object_t*)object_ptr));
}
update_weak_box_list();
#ifndef NDEBUG
/* Clear old range, to make it easier to detect bugs. */
memset(gc_ranges[1-gc_current_range], 0, gc_soft_limit);
#endif
//debug(("Finished collection with %d bytes to spare (out of %d bytes).\n", gc_free_space(), gc_soft_limit));
#ifndef NO_STATS
#ifndef NO_TIMING_STATS
{
struct timespec end_time;
nsec_t nsec;
clock_gettime(TIMING_CLOCK, &end_time);
nsec = (end_time.tv_sec - start_time.tv_sec) * 1000000000LL;
nsec += (end_time.tv_nsec - start_time.tv_nsec);
gc_stats.total_ns += nsec;
if (nsec > gc_stats.max_ns)
gc_stats.max_ns = nsec;
}
}
#endif
gc_stats.total_freed += gc_free_space();
#endif
update_soft_limit(min_free);
if (gc_free_space() < min_free)
{
out_of_memory();
}
}
void collect_garbage(size_t min_free)
{
bool was_enabled = set_gc_enabled(true);
_collect_garbage(min_free);
set_gc_enabled(was_enabled);
}
bool set_gc_enabled(bool enable)
{
bool was_enabled = gc_enabled;
gc_enabled = enable;
return was_enabled;
}
bool are_finalizers_pending(void)
{
return !is_nil(gc_will_active_list);
}
/* Finalizer can be registered as #f, but value must be an object.
* Returning with value == #f means there are no more finalizers. */
void get_next_finalizer(value_t *value, value_t *finalizer)
{
assert(value && finalizer);
if (is_nil(gc_will_active_list))
{
*value = *finalizer = FALSE_VALUE;
}
else
{
will_t *w = get_will(gc_will_active_list);
*value = w->value;
*finalizer = w->finalizer;
/* Remove this finalizer from the list -- up to caller to keep values reachable. */
gc_will_active_list = w->next;
}
}
/* vim:set sw=2 expandtab: */
Reference in New Issue View Git Blame Copy Permalink