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

1288 lines
30 KiB
C
Raw Blame History

#define _POSIX_C_SOURCE 199309L
#include <assert.h>
#include <ctype.h>
#include <inttypes.h>
#include <setjmp.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "gc.h"
#include "builtin.h"
#if 1
#define ENABLE_BACKTRACE
#include <execinfo.h>
#endif
/****************************************************************************/
#if _CLOCK_MONOTONIC
# define TIMING_CLOCK CLOCK_MONOTONIC
#else
# define TIMING_CLOCK CLOCK_REALTIME
#endif
#define FLAG_PROC_BIT ((uint8_t)0x20)
#define FLAG_LIVE_BIT ((uint8_t)0x10)
#define FLAG_GC_BITS ((uint8_t)0x30)
#define FLAG_TAG_BITS ((uint8_t)0x0f)
/* Helper macros to reduce duplication */
#define VECTOR_BYTES(nelem) (sizeof(vector_t) + (sizeof(value_t) * (nelem)))
#define BYTESTR_BYTES(nbytes) (sizeof(byte_string_t) + (nbytes))
#define STRUCT_BYTES(nslots) (sizeof(struct_t) + (sizeof(value_t) * (nslots)))
#define GC_MIN(x, y) (((y)<(x))?(y):(x))
#define GC_MAX(x, y) (((y)>(x))?(y):(x))
#define GC_DEBUG_LEVEL_TRACE 3
#define GC_DEBUG_LEVEL_INFO 2
#define GC_DEBUG_LEVEL_WARN 1
#define GC_DEBUG_LEVEL_QUIET 0
#define debug_warn(fmt, args...) \
((gc_debug_level >= GC_DEBUG_LEVEL_WARN) ? (void)(fprintf(stderr,fmt,##args)) : (void)0)
#define debug_info(fmt, args...) \
((gc_debug_level >= GC_DEBUG_LEVEL_INFO) ? (void)(fprintf(stderr,fmt,##args)) : (void)0)
#define debug_trace(fmt, args...) \
((gc_debug_level >= GC_DEBUG_LEVEL_TRACE) ? (void)(fprintf(stderr,fmt,##args)) : (void)0)
/****************************************************************************/
typedef struct seen_value
{
value_t value;
struct seen_value *prev;
} seen_value_t;
/****************************************************************************/
const char *const object_tag_names[16] = {
"special", "box", "weak box", "pair", "fpnum", "builtin", "(6)", "(7)",
"vector", "byte string", "struct", "will", "(12)", "(13)", "(14)", "(15)"
};
object_block_t object_blocks[OBJECT_BLOCK_MAX + 1];
gc_stats_t gc_stats;
static value_t gc_free_list;
static value_t gc_weak_box_list;
static value_t gc_will_list;
static value_t gc_will_active_list;
static value_t gc_next_live_value;
static size_t gc_live_bytes; /* as of last GC pass */
static size_t gc_total_bytes; /* as of last allocate_object()/free_object() or GC pass */
static bool gc_enabled;
static gc_root_t gc_root_list = {
.value = UNDEFINED,
.prev = &gc_root_list,
.next = &gc_root_list
};
static gc_root_t structure_type_root;
static int gc_debug_level = GC_DEBUG_LEVEL_QUIET;
/****************************************************************************/
static inline value_t value_from_index(int blk, int idx);
static void allocate_block(void);
static value_t allocate_object(int tag);
static void free_object(value_t value);
static void clear_gc_flag_bits(void);
static inline bool is_object_live(value_t value);
static inline bool is_object_processed(value_t value);
static inline void set_object_live(value_t value);
static inline void set_object_processed(value_t value);
static inline void clear_object_live(value_t value);
static inline void clear_object_processed(value_t value);
/* The 'will' accessors are private to the GC, unlike other similar routines. */
static inline bool is_will(value_t value);
static inline will_t *get_will(value_t value);
static value_t make_will(value_t value, value_t finalizer);
/****************************************************************************/
static inline uint8_t *_get_flags(value_t value)
{
return &object_blocks[OBJECT_BLOCK(value)].flag_bits[OBJECT_INDEX(value)];
}
static inline value_t value_from_index(int blk, int idx)
{
int tag = (int)object_blocks[blk].flag_bits[idx] & FLAG_TAG_BITS;
/* Unallocated objects have zeroed flag bitfields */
if (tag == 0) return UNDEFINED;
return OBJECT(blk, idx, tag);
}
static void allocate_block(void)
{
int blk;
for (blk = 0; blk <= OBJECT_BLOCK_MAX; ++blk)
{
object_block_t *block = &object_blocks[blk];
/* stop at first unallocated block */
if (!block->objects)
{
int idx;
block->objects = (object_t*)calloc(OBJECT_INDEX_MAX+1, sizeof(object_t));
if (!block->objects)
{
release_assert(NOTREACHED("out of memory"));
return;
}
block->flag_bits = (uint8_t*)calloc(OBJECT_INDEX_MAX+1, sizeof(uint8_t));
if (!block->flag_bits)
{
free(block->objects);
block->objects = NULL;
release_assert(NOTREACHED("out of memory"));
return;
}
/* Connect the objects inside the block into a linked list */
for (idx = 0; idx < OBJECT_INDEX_MAX; ++idx)
{
/* Any object type would work here; box is simplest */
block->objects[idx].next = OBJECT(blk, idx+1, OBJECT_TAG_BOX);
}
/* Prepend the list of objects in the block to the free list */
block->objects[OBJECT_INDEX_MAX].next = gc_free_list;
gc_free_list = OBJECT(blk, 0, OBJECT_TAG_BOX);
return;
}
}
/* reached end of block array without finding any unallocated */
release_assert(NOTREACHED("out of object blocks"));
}
static value_t allocate_object(int tag)
{
assert((0 <= tag) && (tag <= 15));
/*
** Run GC when total memory used is either twice the total
** live after last GC pass, or 16MB, whichever is greater.
*/
if (gc_total_bytes >= GC_MAX(2 * gc_live_bytes, 16 * 1024 * 1024))
{
if (gc_enabled)
{
collect_garbage();
}
}
if (is_nil(gc_free_list))
{
allocate_block();
assert(!is_nil(gc_free_list));
}
{
int blk = OBJECT_BLOCK(gc_free_list);
int idx = OBJECT_INDEX(gc_free_list);
value_t result = OBJECT(blk, idx, tag);
gc_free_list = _get_object(gc_free_list)->next;
gc_total_bytes += sizeof(object_t);
*_get_flags(result) = (uint8_t)tag;
memset(_get_object(result), 0, sizeof(object_t));
return result;
}
}
static void free_object(value_t value)
{
object_t *obj = _get_object(value);
if (is_vector(value))
{
gc_total_bytes -= VECTOR_BYTES(obj->vector->nelements);
free(obj->vector);
}
else if (is_byte_string(value))
{
gc_total_bytes -= BYTESTR_BYTES(obj->byte_string->nbytes);
free(obj->byte_string);
}
else if (is_struct(value))
{
gc_total_bytes -= STRUCT_BYTES(obj->structure->nslots);
free(obj->structure);
}
else if (is_will(value))
{
gc_total_bytes -= sizeof(will_t);
free(obj->will);
}
*_get_flags(value) = 0;
obj->next = gc_free_list;
gc_total_bytes -= sizeof(object_t);
gc_free_list = value;
}
/* Prepare for GC by clearing all "live" and "processed" bits */
static void clear_gc_flag_bits(void)
{
int blk;
for (blk = 0; (blk <= OBJECT_BLOCK_MAX) && object_blocks[blk].objects; ++blk)
{
object_block_t *block = &object_blocks[blk];
int idx;
for (idx = 0; idx <= OBJECT_INDEX_MAX; ++idx)
{
block->flag_bits[idx] &= ~FLAG_GC_BITS;
}
}
}
static inline bool is_object_live(value_t v)
{
/* non-objects can't be added to the free list, so they're always "live" */
return !is_object(v) || (*_get_flags(v) & FLAG_LIVE_BIT) != 0;
}
static inline bool is_object_processed(value_t v)
{
/* non-objects don't need to be processed */
return !is_object(v) || (*_get_flags(v) & FLAG_PROC_BIT) != 0;
}
static inline void set_object_live(value_t v)
{
assert(is_object(v));
*_get_flags(v) |= FLAG_LIVE_BIT;
}
static inline void set_object_processed(value_t v)
{
assert(is_object(v));
*_get_flags(v) |= FLAG_PROC_BIT;
}
static inline void clear_object_live(value_t v)
{
assert(is_object(v));
*_get_flags(v) &= ~FLAG_LIVE_BIT;
}
static inline void clear_object_processed(value_t v)
{
assert(is_object(v));
*_get_flags(v) &= ~FLAG_PROC_BIT;
}
/****************************************************************************/
static inline bool is_will(value_t value)
{
return is_object_type(value, OBJECT_TAG_WILL);
}
static inline will_t *get_will(value_t value)
{
return _get_typed_object(value, OBJECT_TAG_WILL)->will;
}
/****************************************************************************/
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;
}
/****************************************************************************/
value_t make_box(value_t init)
{
gc_root_t init_root;
value_t result;
register_gc_root(&init_root, init);
result = allocate_object(OBJECT_TAG_BOX);
unregister_gc_root(&init_root);
get_box(result)->value = init;
return result;
}
value_t make_weak_box(value_t init)
{
gc_root_t init_root;
value_t result;
register_gc_root(&init_root, init);
result = allocate_object(OBJECT_TAG_WEAK_BOX);
unregister_gc_root(&init_root);
get_weak_box(result)->value = init;
get_weak_box(result)->next = gc_weak_box_list;
gc_weak_box_list = result;
return result;
}
value_t make_pair(value_t car, value_t cdr)
{
gc_root_t car_root;
gc_root_t cdr_root;
value_t result;
register_gc_root(&car_root, car);
register_gc_root(&cdr_root, cdr);
result = allocate_object(OBJECT_TAG_PAIR);
unregister_gc_root(&car_root);
unregister_gc_root(&cdr_root);
get_pair(result)->car = car;
get_pair(result)->cdr = cdr;
return result;
}
value_t make_float(fpnum_t value)
{
value_t result = allocate_object(OBJECT_TAG_FPNUM);
_get_object(result)->fpnum = value;
return result;
}
value_t make_builtin_fn(builtin_fn_t *fn)
{
value_t result = allocate_object(OBJECT_TAG_BUILTIN_FN);
_get_object(result)->builtin_fn = fn;
return result;
}
value_t make_vector(size_t nelem, value_t init)
{
gc_root_t init_root;
value_t result;
vector_t *vec;
register_gc_root(&init_root, init);
result = allocate_object(OBJECT_TAG_VECTOR);
unregister_gc_root(&init_root);
vec = (vector_t*)malloc(VECTOR_BYTES(nelem));
release_assert(vec != NULL);
gc_total_bytes += VECTOR_BYTES(nelem);
_get_object(result)->vector = vec;
vec->immutable = false;
vec->nelements = nelem;
for (size_t i = 0; i < nelem; ++i)
vec->elements[i] = init;
return result;
}
value_t make_byte_string(size_t nbytes, int init)
{
value_t result;
byte_string_t *bstr;
result = allocate_object(OBJECT_TAG_BYTE_STRING);
bstr = (byte_string_t*)malloc(BYTESTR_BYTES(nbytes));
release_assert(bstr != NULL);
gc_total_bytes += BYTESTR_BYTES(nbytes);
_get_object(result)->byte_string = bstr;
bstr->immutable = false;
bstr->nbytes = nbytes;
memset(bstr->bytes, init, nbytes);
return result;
}
value_t make_struct(value_t type)
{
gc_root_t type_root;
fixnum_t nslots;
value_t result;
struct_t *str;
register_gc_root(&type_root, type);
release_assert(struct_is_a(type, get_structure_type()));
release_assert(get_struct(type)->immutable);
nslots = get_fixnum(SLOT_VALUE(STRUCTURE, type, NSLOTS));
result = allocate_object(OBJECT_TAG_STRUCT);
unregister_gc_root(&type_root);
str = (struct_t*)malloc(STRUCT_BYTES(nslots));
release_assert(str != NULL);
gc_total_bytes += STRUCT_BYTES(nslots);
_get_object(result)->structure = str;
str->immutable = false;
str->nslots = nslots;
str->type = type;
for (int i = 0; i < nslots; ++i)
str->slots[i] = UNDEFINED;
return result;
}
/* wills can only be created in this module, via register_finalizer() */
static value_t make_will(value_t value, value_t finalizer)
{
gc_root_t value_root;
gc_root_t finalizer_root;
value_t result;
will_t *will;
register_gc_root(&value_root, value);
register_gc_root(&finalizer_root, finalizer);
result = allocate_object(OBJECT_TAG_WILL);
unregister_gc_root(&value_root);
unregister_gc_root(&finalizer_root);
will = (will_t*)malloc(sizeof(will_t));
release_assert(will != NULL);
gc_total_bytes += sizeof(will_t);
_get_object(result)->will = will;
will->value = value;
will->finalizer = finalizer;
will->next = gc_will_list;
gc_will_list = result;
return result;
}
/****************************************************************************/
value_t string_to_value(const char *s)
{
size_t len = strlen(s);
value_t v = make_byte_string(len, '\0');
memcpy(get_byte_string(v)->bytes, s, len);
return v;
}
char *value_to_string(value_t v)
{
byte_string_t *str = get_byte_string(v);
char *s = (char*)malloc(str->nbytes + 1);
memcpy(s, str->bytes, str->nbytes);
s[str->nbytes] = '\0';
return s;
}
int byte_strcmp(value_t s1, value_t s2)
{
byte_string_t *bstr1 = get_byte_string(s1);
byte_string_t *bstr2 = get_byte_string(s2);
int cmp = memcmp(bstr1->bytes, bstr2->bytes, GC_MIN(bstr1->nbytes, bstr2->nbytes));
if (cmp == 0)
{
/* Prefix is the same, so compare lengths */
if (bstr1->nbytes < bstr2->nbytes)
cmp = -1;
else if (bstr1->nbytes > bstr2->nbytes)
cmp = 1;
}
return cmp;
}
value_t get_structure_type(void)
{
return structure_type_root.value;
}
value_t make_struct_type(value_t super, fixnum_t nslots, value_t callable)
{
gc_root_t super_root;
gc_root_t callable_root;
value_t result;
register_gc_root(&super_root, super);
register_gc_root(&callable_root, callable);
if (super != FALSE_VALUE)
{
release_assert(struct_is_a(super, get_structure_type()));
release_assert(get_struct(super)->immutable);
}
result = make_struct(get_structure_type());
unregister_gc_root(&super_root);
unregister_gc_root(&callable_root);
get_struct(result)->slots[STRUCTURE_SLOT_SUPER] = super;
get_struct(result)->slots[STRUCTURE_SLOT_NSLOTS] = make_fixnum(nslots);
get_struct(result)->slots[STRUCTURE_SLOT_CALLABLE] = callable;
get_struct(result)->immutable = true;
return result;
}
bool struct_is_a(value_t value, value_t type)
{
value_t tortoise, hare;
/* The trivial cases: non-struct and exact match */
if (!is_struct(value)) return false;
if (get_struct(value)->type == type) return true;
/* Look for type in superclasses; detect cycles using "tortoise and hare" algorithm */
tortoise = hare = SLOT_VALUE(STRUCTURE, get_struct(value)->type, SUPER);
do {
if (hare == type) return true;
if (hare == FALSE_VALUE) return false;
release_assert(is_struct(hare));
hare = SLOT_VALUE(STRUCTURE, hare, SUPER);
if (hare == type) return true;
if (hare == FALSE_VALUE) return false;
release_assert(is_struct(hare));
hare = SLOT_VALUE(STRUCTURE, hare, SUPER);
/* Tortoise moves ahead one item for every two items covered by hare. */
/* If there are no cycles in the superclass list, it will always be behind. */
tortoise = SLOT_VALUE(STRUCTURE, tortoise, SUPER);
} while (hare != tortoise);
/* Tortoise caught up with hare, meaning we detected a cycle. */
/* If type was in the cycle, it would have been found by now. */
return false;
}
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))
{
(void)make_will(value, finalizer);
}
}
/*************************** Common Collector Code **************************/
static void structure_init(void);
static void mark_roots_live(void);
static void mark_children_live(value_t parent);
static void process_weak_boxes(void);
static void process_wills(void);
static void update_weak_box_list(void);
static void structure_init(void)
{
value_t result;
struct_t *str;
/* Instances of this structure describe structures. */
/* It is both a structure and a structure description, and thus an instance of itself. */
result = allocate_object(OBJECT_TAG_STRUCT);
str = (struct_t*)malloc(STRUCT_BYTES(STRUCTURE_SLOTS));
release_assert(str != NULL);
gc_total_bytes += STRUCT_BYTES(STRUCTURE_SLOTS);
_get_object(result)->structure = str;
str->immutable = true;
str->type = result;
str->nslots = STRUCTURE_SLOTS;
/* Slot 1: Superclass, if any, or #f */
str->slots[STRUCTURE_SLOT_SUPER] = FALSE_VALUE;
/* Slot 2: Total number of slots (excl. type) */
str->slots[STRUCTURE_SLOT_NSLOTS] = make_fixnum(STRUCTURE_SLOTS);
/* Slot 3: Callable object used as proxy when structure is APPLY'd. */
/* Can be LAMBDA, callable structure instance, builtin, or FALSE_VALUE. */
str->slots[STRUCTURE_SLOT_CALLABLE] = FALSE_VALUE;
register_gc_root(&structure_type_root, result);
}
void gc_init(void)
{
const char *gc_debug_env;
memset(object_blocks, 0, sizeof object_blocks);
gc_free_list = NIL;
gc_weak_box_list = NIL;
gc_will_list = NIL;
gc_will_active_list = NIL;
gc_next_live_value = NIL;
gc_live_bytes = 0;
gc_total_bytes = 0;
clear_gc_stats();
if ((gc_debug_env = getenv("GC_DEBUG")) != NULL)
{
if (strcmp(gc_debug_env, "warn") == 0)
{
gc_debug_level = GC_DEBUG_LEVEL_WARN;
}
else if (strcmp(gc_debug_env, "info") == 0)
{
gc_debug_level = GC_DEBUG_LEVEL_INFO;
}
else if (strcmp(gc_debug_env, "trace") == 0)
{
gc_debug_level = GC_DEBUG_LEVEL_TRACE;
}
else
{
char *endp;
long val;
val = strtol(gc_debug_env, &endp, 0);
if (endp && (endp[0] == '\0'))
{
gc_debug_level = val;
}
}
}
gc_enabled = true;
structure_init();
}
void clear_gc_stats(void)
{
gc_stats.passes = 0;
gc_stats.total_ns = 0;
gc_stats.peak_ns = 0;
gc_stats.total_freed = 0;
gc_stats.peak_allocated = 0;
}
static inline void mark_object_live(value_t value)
{
if (is_object(value) && !is_object_live(value))
{
set_object_live(value);
if ((gc_next_live_value > value) ||
(gc_next_live_value == NIL))
{
gc_next_live_value = value;
}
}
}
static void mark_roots_live(void)
{
/* Mark registered GC roots as live */
for (gc_root_t *root = gc_root_list.next; root != &gc_root_list; root = root->next)
{
mark_object_live(root->value);
}
/* Pending wills and associated finalizers are also roots */
for (value_t will = gc_will_list; !is_nil(will); will = get_will(will)->next)
{
mark_object_live(will);
mark_object_live(get_will(will)->finalizer);
/* Processing for values of pending wills occurs separately from the main GC */
set_object_processed(will);
}
/* Active wills and associated values and finalizers are also roots */
for (value_t will = gc_will_active_list; !is_nil(will); will = get_will(will)->next)
{
mark_object_live(will);
mark_object_live(get_will(will)->value);
mark_object_live(get_will(will)->finalizer);
/* No further processing is required for active wills */
set_object_processed(will);
}
}
static void mark_children_live(value_t value)
{
if (is_box(value))
{
mark_object_live(get_box(value)->value);
}
else if (is_pair(value))
{
mark_object_live(get_pair(value)->car);
mark_object_live(get_pair(value)->cdr);
}
else if (is_vector(value))
{
vector_t *vec = get_vector(value);
int i;
for (i = 0; i < vec->nelements; ++i)
mark_object_live(vec->elements[i]);
}
else if (is_struct(value))
{
struct_t *str = get_struct(value);
int i;
mark_object_live(str->type);
for (i = 0; i < str->nslots; ++i)
mark_object_live(str->slots[i]);
}
}
static value_t next_live_object(void)
{
int blk;
int idx;
if (is_nil(gc_next_live_value))
return NIL;
blk = OBJECT_BLOCK(gc_next_live_value);
for (idx = OBJECT_INDEX(gc_next_live_value); idx <= OBJECT_INDEX_MAX; ++idx)
{
uint8_t flags = object_blocks[blk].flag_bits[idx];
if ((flags & (FLAG_LIVE_BIT | FLAG_PROC_BIT)) == FLAG_LIVE_BIT)
{
gc_next_live_value = value_from_index(blk, idx);;
return gc_next_live_value;;
}
}
for (++blk; (blk <= OBJECT_BLOCK_MAX) && object_blocks[blk].objects; ++blk)
{
for (idx = 0; idx <= OBJECT_INDEX_MAX; ++idx)
{
uint8_t flags = object_blocks[blk].flag_bits[idx];
if ((flags & (FLAG_LIVE_BIT | FLAG_PROC_BIT)) == FLAG_LIVE_BIT)
{
gc_next_live_value = value_from_index(blk, idx);
return gc_next_live_value;
}
}
}
gc_next_live_value = NIL;
return NIL;
}
static void process_live_objects(void)
{
value_t next;
while (!is_nil(next = next_live_object()))
{
mark_children_live(next);
set_object_processed(next);
}
}
static void process_weak_boxes(void)
{
value_t wb;
for (wb = gc_weak_box_list; !is_nil(wb); wb = get_weak_box(wb)->next)
{
weak_box_t *box = get_weak_box(wb);
if (!is_object_live(box->value))
{
/* The value in the box is an unreachable object; change to #f. */
/*
** NOTE: An object is considered unreachable via weak box when it
** could be finalized, even though it will be kept alive until any
** finalizers are removed from the 'active' list. The finalizers
** may restore the object to a reachable state, in which case it
** will not be collected--but the weak reference will remain broken.
**
** Restoring references to otherwise GC'able objects is not recommended.
*/
box->value = FALSE_VALUE;
}
}
}
static void process_wills(void)
{
value_t *will = &gc_will_list;
while (!is_nil(*will))
{
will_t *w = get_will(*will);
if (!is_object_live(w->value))
{
/* The will is associated with an unreachable object; activate it. */
/* First, ensure the object remains reachable for the finalizer. */
mark_object_live(w->value);
/* Insert the will into the 'active' list. */
w->next = gc_will_active_list;
gc_will_active_list = *will;
/* Remove the will from the 'pending' list. */
*will = w->next;
}
else
{
/* Move on to this will's 'next' pointer */
will = &w->next;
}
}
}
static void update_weak_box_list(void)
{
value_t *wb = &gc_weak_box_list;
while (!is_nil(*wb))
{
if (!is_object_live(*wb))
{
/* Box is no longer reachable; remove it from the list by updating *wb. */
*wb = get_weak_box(*wb)->next;
}
else
{
/* Move on to next box */
wb = &get_weak_box(*wb)->next;
}
}
}
static void free_unreachable_objects(void)
{
int blk;
for (blk = 0; (blk <= OBJECT_BLOCK_MAX) && object_blocks[blk].objects; ++blk)
{
int idx;
for (idx = 0; idx <= OBJECT_INDEX_MAX; ++idx)
{
value_t value = value_from_index(blk, idx);
if (is_object(value) && !is_object_live(value))
{
free_object(value);
}
}
}
}
static void _out_of_memory(void) __attribute__ ((noreturn));
static void _out_of_memory(void)
{
out_of_memory();
abort();
}
void collect_garbage(void)
{
#ifndef NO_STATS
size_t initial_bytes = gc_total_bytes;
#ifndef NO_TIMING_STATS
struct timespec start_time;
clock_gettime(TIMING_CLOCK, &start_time);
#endif
#endif
debug_info("Performing garbage collection pass...\n");
/* Start with no live/processed values */
clear_gc_flag_bits();
gc_next_live_value = NIL;
/* Prime the pump */
mark_roots_live();
/* Keep marking children until there are no more live, unprocessed objects. */
process_live_objects();
/* These have to be examined after normal reachability has been determined. */
process_weak_boxes();
process_wills();
/*
** Keep marking children until there are no more live, unprocessed objects.
**
** 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() marks the value of any will newly placed
** on the active list as live. Note that these values may be finalized
** in any order, and that any weak references have already been cleared.
*/
process_live_objects();
/* Remove any unreachable weak boxes from the weak box list. */
update_weak_box_list();
/* Finally, return any unreachable objects to the free list. */
free_unreachable_objects();
/* Record total "live" allocation after GC. Determines threshold for next GC. */
gc_live_bytes = gc_total_bytes;
debug_info("Finished collection; active set is %ld bytes.\n", (long)gc_live_bytes);
#ifndef NO_STATS
gc_stats.passes += 1;
#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.peak_ns)
gc_stats.peak_ns = nsec;
}
#endif
gc_stats.total_freed += (initial_bytes - gc_live_bytes);
if (initial_bytes > gc_stats.peak_allocated)
gc_stats.peak_allocated = initial_bytes;
#endif
}
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;
}
}
void print_backtrace(void)
{
#ifdef ENABLE_BACKTRACE
void *frames[32];
backtrace(frames, 32);
backtrace_symbols_fd(frames, 32, 2);
#endif
}
void _release_assert(const char *str, const char *file, int line)
{
fprintf(stderr, "ERROR: Invalid state detected in %s, line %d.\n"
"Assertion failed: %s\n",
file, line, str);
abort();
}
static void _fprint_value(FILE *f, value_t v, seen_value_t *seen)
{
seen_value_t new_seen = { v, seen };
int depth = 0;
value_t builtin_name = reverse_lookup_builtin(v);
if (is_byte_string(builtin_name))
{
fputs("#=", f);
_fprint_value(f, builtin_name, NULL);
return;
}
if (is_object(v) && !(is_float(v) || is_builtin_fn(v) || is_byte_string(v)))
{
for (seen_value_t *sv = seen; sv; sv = sv->prev)
{
if (v == sv->value)
{
fputs("#<cycle>", f);
return;
}
if (++depth >= 3)
{
fputs("...", f);
return;
}
}
}
if (v == UNDEFINED)
{
fputs("#<undefined>", f);
}
else if (v == NIL)
{
fputs("nil", f);
}
else if (v == FALSE_VALUE)
{
fputs("#f", f);
}
else if (v == TRUE_VALUE)
{
fputs("#t", f);
}
else if (v == END_PROGRAM)
{
fputs("#<endp>", f);
}
else if (is_fixnum(v))
{
fprintf(f, "%lld", (long long int)get_fixnum(v));
}
else if (is_box(v))
{
fputs("#&", f);
_fprint_value(f, get_box(v)->value, &new_seen);
}
else if (is_weak_box(v))
{
fputs("#W&", f);
_fprint_value(f, get_weak_box(v)->value, &new_seen);
}
else if (is_pair(v))
{
fputc('(', f);
_fprint_value(f, get_pair(v)->car, &new_seen);
v = get_pair(v)->cdr;
while (is_pair(v))
{
fputc(' ', f);
_fprint_value(f, get_pair(v)->car, &new_seen);
v = get_pair(v)->cdr;
}
if (v != NIL)
{
fputs(" . ", f);
_fprint_value(f, v, &new_seen);
}
fputc(')', f);
}
else if (is_float(v))
{
fprintf(f, "%f", (double)get_float(v));
}
else if (is_builtin_fn(v))
{
fprintf(f, "#<builtin:%p>", get_builtin_fn(v));
}
else if (is_vector(v))
{
vector_t *vec = get_vector(v);
if (vec->immutable)
fputs("#@", f);
fputs("#(", f);
for (size_t i = 0; i < vec->nelements; ++i)
{
if (i != 0) fputc(' ', f);
_fprint_value(f, vec->elements[i], &new_seen);
}
fputc(')', f);
}
else if (is_byte_string(v))
{
byte_string_t *str = get_byte_string(v);
size_t written = 0;
if (str->immutable)
fputs("#@", f);
fputc('"', f);
for (size_t i = 0; i < str->nbytes; ++i)
{
int ch = str->bytes[i];
if (isprint(ch) && (ch != '\\') && (ch != '\"'))
{
fputc(str->bytes[i], f);
++written;
}
else
{
fprintf(f, "\\x%.2X", (int)str->bytes[i]);
written += 4;
}
if (written >= 20)
{
fputs("...", f);
break;
}
}
fputc('"', f);
}
else if (is_struct(v))
{
struct_t *str = get_struct(v);
if (str->immutable)
fputs("#@", f);
fputs("#S(", f);
_fprint_value(f, str->type, &new_seen);
for (size_t i = 0; i < str->nslots; ++i)
{
fputc(' ', f);
_fprint_value(f, str->slots[i], &new_seen);
}
fputc(')', f);
}
else
{
fprintf(f, "#<unknown:0x%08lx>", (unsigned long)v);
}
}
void fprint_value(FILE *f, value_t v)
{
_fprint_value(f, v, NULL);
}
static double ns2sec(nsec_t ns) __attribute__ ((const));
static double ns2sec(nsec_t ns)
{
return ns / 1.0e9;
}
void fprint_gc_stats(FILE *f)
{
if (gc_stats.passes)
{
fprintf(f, "GC: %lld bytes freed by %d GCs in %0.6f sec => %0.3f MB/sec.\n"
"GC: Peak pre-GC memory use was %lld bytes.\n",
gc_stats.total_freed,
gc_stats.passes,
ns2sec(gc_stats.total_ns),
(gc_stats.total_freed / ns2sec(gc_stats.total_ns)) / (1024*1024),
gc_stats.peak_allocated);
}
else
{
fputs("GC: No garbage collection was performed.\n", f);
}
}
/* vim:set sw=2 expandtab: */
Reference in New Issue View Git Blame Copy Permalink