317 lines
7.4 KiB
C
317 lines
7.4 KiB
C
#include <assert.h>
|
|
#include <inttypes.h>
|
|
#include <stdbool.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <time.h>
|
|
|
|
#include "gc.h"
|
|
|
|
extern int gc_counter;
|
|
extern int gc_ticks;
|
|
|
|
/* Alignment must ensure each object has enough room to hold a pair (BH . new_addr) */
|
|
#define GC_ALIGNMENT ((size_t)(sizeof(pair_t)))
|
|
|
|
/* Pairs are a type of object, but the value representation is different */
|
|
object_t *get_object(value_t v)
|
|
{
|
|
if (is_object(v))
|
|
return (object_t*)(v & ~(value_t)3);
|
|
else
|
|
abort();
|
|
}
|
|
|
|
pair_t *get_pair(value_t v)
|
|
{
|
|
if (is_pair(v))
|
|
return (pair_t*)(v - 2);
|
|
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);
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
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
|
|
{
|
|
switch (obj->tag)
|
|
{
|
|
case TYPE_TAG_VECTOR:
|
|
{
|
|
const vector_t *vec = (const vector_t*)obj;
|
|
const size_t nbytes = sizeof(vector_t) + sizeof(value_t) * vec->size;
|
|
vector_t *newvec = (vector_t*)gc_alloc(nbytes);
|
|
memcpy(newvec, vec, nbytes);
|
|
new_value = object_value(newvec);
|
|
}
|
|
break;
|
|
case TYPE_TAG_BYTESTR:
|
|
{
|
|
const byte_string_t *str = (const byte_string_t*)obj;
|
|
const size_t nbytes = sizeof(byte_string_t) + str->size;
|
|
byte_string_t *newstr = (byte_string_t*)gc_alloc(nbytes);
|
|
memcpy(newstr, str, nbytes);
|
|
new_value = object_value(newstr);
|
|
}
|
|
break;
|
|
case TYPE_TAG_BOX:
|
|
default: /* pair */
|
|
{
|
|
pair_t *p = (pair_t*)gc_alloc(sizeof(pair_t));
|
|
const pair_t *q = (const pair_t*)obj;
|
|
*p = *q;
|
|
|
|
//debug(("Moved pair from 0x%0.8X to 0x%0.8X.\n", q, p));
|
|
|
|
/* Keep the original tag bits (pair or object) */
|
|
new_value = pair_value(p) | (*value & 2);
|
|
}
|
|
break;
|
|
}
|
|
|
|
obj->tag = BROKEN_HEART;
|
|
obj->payload.values[0] = new_value;
|
|
}
|
|
|
|
#if 0
|
|
#ifndef NDEBUG
|
|
if (is_pair(new_value))
|
|
{
|
|
if (gc_range_of(get_pair(new_value)) != gc_current_range)
|
|
{
|
|
debug(("Invalid address after transfer: 0x%0.8X. Current GC: %d.\n",
|
|
get_pair(new_value), gc_current_range));
|
|
abort();
|
|
}
|
|
}
|
|
#endif
|
|
#endif
|
|
|
|
*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;
|
|
const intptr_t nelem = from_fixnum(vec->size);
|
|
|
|
for (intptr_t i = 0; i < nelem; ++i)
|
|
{
|
|
transfer_object(&vec->elements[i]);
|
|
}
|
|
|
|
return sizeof(vector_t) + (nelem * sizeof(value_t));
|
|
}
|
|
case TYPE_TAG_BYTESTR:
|
|
{
|
|
const byte_string_t *str = (const byte_string_t*)obj;
|
|
return sizeof(byte_string_t) + from_fixnum(str->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"));
|
|
|
|
/* Recursive calls to collector should never occur */
|
|
if (collecting)
|
|
{
|
|
debug(("Ran out of memory while collecting garbage!\n"));
|
|
abort();
|
|
}
|
|
else
|
|
collecting = true;
|
|
|
|
++gc_counter;
|
|
gc_ticks -= (int)clock();
|
|
|
|
/* 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 = (3 * min_limit) / 2;
|
|
|
|
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();
|
|
}
|
|
|
|
/* Done collecting. */
|
|
collecting = false;
|
|
|
|
gc_ticks += (int)clock();
|
|
}
|
|
|
|
/* vim:set sw=2 expandtab: */
|