Initial check-in.
This commit is contained in:
commit
9fa0a09509
|
|
@ -0,0 +1,15 @@
|
|||
CFLAGS = -std=c99 -O2 -DNDEBUG -fprofile-generate
|
||||
|
||||
all: gc
|
||||
|
||||
.PHONY: all clean
|
||||
|
||||
ifneq (,$(wildcard *.gcda *.gcno))
|
||||
CFLAGS += -fprofile-use
|
||||
dummy := $(shell rm -f gc)
|
||||
endif
|
||||
|
||||
clean:
|
||||
-rm -f gc gc.gcda gc.gcno
|
||||
|
||||
gc: gc.c
|
||||
|
|
@ -0,0 +1,424 @@
|
|||
#include <sys/time.h>
|
||||
|
||||
#include <assert.h>
|
||||
#include <inttypes.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
|
||||
#ifndef NDEBUG
|
||||
# define debug(printf_args) ((void)printf printf_args)
|
||||
#else
|
||||
# define debug(printf_args) ((void)0)
|
||||
#endif
|
||||
|
||||
typedef uintptr_t value_t;
|
||||
|
||||
/* NIL: 00000000 00000000 00000000 00000000 */
|
||||
/* Pair: aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa00 (where aa... >= 1024) */
|
||||
/* Object: aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa10 */
|
||||
/* Fixnum: snnnnnnn nnnnnnnn nnnnnnnn nnnnnnn1 */
|
||||
|
||||
#define NIL ((value_t)0)
|
||||
|
||||
/* Special values (1 <= n < 1024) */
|
||||
/* These correspond to pairs within the first page of memory */
|
||||
#define SPECIAL_VALUE(n) ((value_t)(4*n))
|
||||
#define MAX_SPECIAL SPECIAL_VALUE(1023)
|
||||
|
||||
#define BROKEN_HEART SPECIAL_VALUE(1)
|
||||
|
||||
typedef struct pair
|
||||
{
|
||||
value_t car;
|
||||
value_t cdr;
|
||||
} pair_t;
|
||||
|
||||
typedef struct object
|
||||
{
|
||||
value_t tag;
|
||||
union {
|
||||
value_t values[0];
|
||||
char bytes[0];
|
||||
} payload;
|
||||
} object_t;
|
||||
|
||||
typedef struct gc_root
|
||||
{
|
||||
value_t value;
|
||||
struct gc_root *prev;
|
||||
struct gc_root *next;
|
||||
} gc_root_t;
|
||||
|
||||
static inline bool is_pair(value_t v)
|
||||
{
|
||||
return ((v & 0x3) == 0) && (v > MAX_SPECIAL);
|
||||
}
|
||||
|
||||
static inline bool is_object(value_t v)
|
||||
{
|
||||
return ((v & 0x1) == 0) && (v > MAX_SPECIAL);
|
||||
}
|
||||
|
||||
static inline bool is_fixnum(value_t v)
|
||||
{
|
||||
return (v & 1) != 0;
|
||||
}
|
||||
|
||||
static inline value_t to_fixnum(intptr_t n)
|
||||
{
|
||||
return (value_t)(n << 1) | 1;
|
||||
}
|
||||
|
||||
static inline intptr_t from_fixnum(value_t n)
|
||||
{
|
||||
return ((intptr_t)n) >> 1;
|
||||
}
|
||||
|
||||
static inline value_t pair_value(pair_t *p)
|
||||
{
|
||||
return (value_t)p;
|
||||
}
|
||||
|
||||
static inline value_t object_value(object_t *obj)
|
||||
{
|
||||
return (value_t)obj | 2;
|
||||
}
|
||||
|
||||
object_t *get_object(value_t v);
|
||||
pair_t *get_pair(value_t pair);
|
||||
value_t get_cdr(value_t pair);
|
||||
void replace_car(value_t pair, value_t car);
|
||||
void replace_cdr(value_t pair, value_t cdr);
|
||||
value_t cons(value_t car, value_t cdr);
|
||||
|
||||
void register_gc_root(gc_root_t *root, value_t v);
|
||||
void unregister_gc_root(gc_root_t *root);
|
||||
void *gc_alloc(size_t nbytes);
|
||||
void collect_garbage(size_t min_free);
|
||||
|
||||
/***********************************************/
|
||||
|
||||
/* 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;
|
||||
else
|
||||
abort();
|
||||
}
|
||||
|
||||
static int cons_counter = 0;
|
||||
|
||||
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);
|
||||
|
||||
++cons_counter;
|
||||
|
||||
return pair_value(p);
|
||||
}
|
||||
|
||||
/* Equal to the max. active set size. */
|
||||
#define GC_RANGE_SIZE (256*1024*1024)
|
||||
|
||||
/* GC starts after this much space has been allocated. Increases by 5% each time. */
|
||||
#define GC_INIT_SIZE 1024
|
||||
|
||||
/* Alignment must ensure each object has enough room to hold a pair (BH . new_addr) */
|
||||
#define GC_ALIGNMENT ((size_t)(sizeof(pair_t)))
|
||||
|
||||
static pair_t gc_ranges[2][GC_RANGE_SIZE / sizeof(pair_t)];
|
||||
static char *gc_free_ptr = (char*)&gc_ranges[0][0];
|
||||
static size_t gc_free_space = GC_INIT_SIZE;
|
||||
static size_t gc_soft_limit = GC_INIT_SIZE;
|
||||
static int current_gc_range = 0;
|
||||
static gc_root_t gc_root_list = { NIL, &gc_root_list, &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 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;
|
||||
}
|
||||
|
||||
static void out_of_memory(void) __attribute__ ((noreturn));
|
||||
static void out_of_memory(void)
|
||||
{
|
||||
fprintf(stderr, "Out of memory!\n");
|
||||
abort();
|
||||
}
|
||||
|
||||
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) != current_gc_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)
|
||||
{
|
||||
#if 0
|
||||
case TYPE_TAG_VECTOR:
|
||||
break;
|
||||
#endif
|
||||
default: /* pair or compatible */
|
||||
{
|
||||
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) */
|
||||
#if 0
|
||||
if (is_pair(*value))
|
||||
new_value = pair_value(p);
|
||||
else
|
||||
new_value = object_value((object_t*)p);
|
||||
#else
|
||||
new_value = pair_value(p) | (*value & 2);
|
||||
#endif
|
||||
}
|
||||
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)) != current_gc_range)
|
||||
{
|
||||
debug(("Invalid address after transfer: 0x%0.8X. Current GC: %d.\n",
|
||||
get_pair(new_value), current_gc_range));
|
||||
abort();
|
||||
}
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
*value = new_value;
|
||||
}
|
||||
}
|
||||
|
||||
static inline size_t transfer_children(object_t *obj)
|
||||
{
|
||||
switch (obj->tag)
|
||||
{
|
||||
#if 0 /* Don't support other kinds of GC objects yet */
|
||||
case TYPE_TAG_VECTOR:
|
||||
{
|
||||
return sizeof(*obj) +
|
||||
sizeof(value_t) * from_fixnum(obj->payload.values[0]);
|
||||
}
|
||||
#endif
|
||||
default:
|
||||
{
|
||||
/* Object is a pair or compatible type (e.g. box) */
|
||||
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;
|
||||
|
||||
/* Swap ranges; new "current" range is initially empty, old one is full */
|
||||
current_gc_range = 1 - current_gc_range;
|
||||
gc_free_ptr = (char*)&gc_ranges[current_gc_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_RANGE_SIZE)
|
||||
new_limit = GC_RANGE_SIZE;
|
||||
else if (new_limit < GC_INIT_SIZE)
|
||||
new_limit = GC_INIT_SIZE;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
struct timeval start_time;
|
||||
gc_root_t list_root;
|
||||
int count = 0;
|
||||
|
||||
gettimeofday(&start_time, NULL);
|
||||
srand((unsigned int)start_time.tv_usec);
|
||||
|
||||
register_gc_root(&list_root, NIL);
|
||||
|
||||
while (1)
|
||||
{
|
||||
int r = rand() & 0xffff;
|
||||
|
||||
if (r == 0)
|
||||
list_root.value = to_fixnum(rand());
|
||||
else if (r & 1)
|
||||
list_root.value = cons(to_fixnum(rand()), list_root.value);
|
||||
else if (r & 2)
|
||||
list_root.value = cons(list_root.value, to_fixnum(rand()));
|
||||
else if (r & 4)
|
||||
{
|
||||
list_root.value = cons(list_root.value, cons(to_fixnum(-1), NIL));
|
||||
get_pair(get_pair(list_root.value)->cdr)->cdr = list_root.value;
|
||||
}
|
||||
|
||||
if (cons_counter >= 1000000)
|
||||
{
|
||||
struct timeval end_time;
|
||||
double seconds;
|
||||
gettimeofday(&end_time, NULL);
|
||||
|
||||
seconds = (end_time.tv_sec - start_time.tv_sec)
|
||||
+ 0.000001 * (end_time.tv_usec - start_time.tv_usec);
|
||||
|
||||
printf("%d conses took %.6f seconds.\n", cons_counter, seconds);
|
||||
|
||||
gettimeofday(&start_time, NULL);
|
||||
cons_counter = 0;
|
||||
|
||||
if (++count == 50)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
unregister_gc_root(&list_root);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* vim:set sw=2 expandtab: */
|
||||
Loading…
Reference in New Issue