rosella/gc.h

#ifndef GC_H_6b8a27c99f2eb5eb5437e045fa4af1c3
#define GC_H_6b8a27c99f2eb5eb5437e045fa4af1c3

#include <assert.h>
#include <inttypes.h>
#include <stdbool.h>
#include <stdio.h>
#include <time.h>

#ifndef NDEBUG
#  define debug(printf_args) ((void)printf printf_args)
#else
#  define debug(printf_args) ((void)0)
#endif

/* Like assert(), but for things we want to check even in release builds. */
/* More informative than a simple "if (!x) abort();" statement. */
#define release_assert(expr) ((void)_release_assert((expr), #expr, __FILE__, __LINE__))

/* Evaluates to false, but with an expression that conveys what went wrong. */
#define NOTREACHED(msg) 0

typedef uintptr_t value_t;
typedef intptr_t fixnum_t;
typedef double native_float_t;

#if INTPTR_MAX - 0 == 0
/* The INTPTR_ macros are defined, but not given values. */
#  undef INTPTR_MIN
#  undef INTPTR_MAX
#  define INTPTR_MIN INT32_MIN
#  define INTPTR_MAX INT32_MAX
#endif

#define FIXNUM_MIN (INTPTR_MIN/2)
#define FIXNUM_MAX (INTPTR_MAX/2)

/* Builtins replace the normal run_byte_code() and perform_tail_call() steps.
 * The argv, k, and ctx inputs can be found in the state fields, and should be
 * updated as necessary (particularly argv) before the builtin returns. The
 * 'lambda' field will refer to the builtin itself, and in1-in3 are all free. */
struct interp_state;
typedef void (builtin_fn_t)(struct interp_state *state);

/* NIL:    00000000 00000000 00000000 00000000                       */
/* Object: aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa00 (where aa... >= 1024) */
/* Pair:   aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa10                       */
/* Fixnum: snnnnnnn nnnnnnnn nnnnnnnn nnnnnnn1                       */

#define NIL               ((value_t)0)

/* Special values (0 <= n < 1024) */
/* These correspond to objects within the first page of memory */
#define SPECIAL_VALUE(n)  ((value_t)(4*(n)+4))
#define TYPE_TAG(n)       SPECIAL_VALUE(768+(n))
#define MAX_SPECIAL       SPECIAL_VALUE(1023)

#define BROKEN_HEART      SPECIAL_VALUE(0)
#define FALSE_VALUE       SPECIAL_VALUE(1)
#define TRUE_VALUE        SPECIAL_VALUE(2)
#define UNDEFINED         SPECIAL_VALUE(3)
#define GC_GEN0_POISON    SPECIAL_VALUE(4)
#define GC_GEN1_POISON    SPECIAL_VALUE(5)

#define TYPE_TAG_BOX      TYPE_TAG(0)
#define TYPE_TAG_VECTOR   TYPE_TAG(1)
#define TYPE_TAG_BYTESTR  TYPE_TAG(2)
#define TYPE_TAG_STRUCT   TYPE_TAG(3)
#define TYPE_TAG_WEAK_BOX TYPE_TAG(4)
#define TYPE_TAG_WILL     TYPE_TAG(5)
#define TYPE_TAG_FLOAT    TYPE_TAG(6)
#define TYPE_TAG_BUILTIN  TYPE_TAG(7)

#define CAR(x) (get_pair(x)->car)
#define CDR(x) (get_pair(x)->cdr)
#define CADR(x) CAR(CDR(x))
#define CDDR(x) CDR(CDR(x))

#define _CAR(x) (_get_pair(x)->car)
#define _CDR(x) (_get_pair(x)->cdr)
#define _CADR(x) _CAR(_CDR(x))
#define _CDDR(x) _CDR(_CDR(x))

/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
#define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s])

#define STRUCTURE_SLOT_SUPERS   0
#define STRUCTURE_SLOT_NSLOTS   1
#define STRUCTURE_SLOT_CALLABLE 2
#define STRUCTURE_SLOTS         3

/* Invoke this macro after creating any reference from a Gen-1 GC object to a Gen-0 object. */
/* If unsure, invoke the macro; at most there will be a slight cost in performance. */
/* Failing to invoke the macro before the next Gen-0 GC can lead to incorrect behavior. */
#define WRITE_BARRIER(value) ((void)_gc_write_barrier((value)))

typedef struct object
{
  value_t tag;
  value_t forward; /* only if tag == BROKEN_HEART */
} object_t;

/* CAR is anything *other* than a valid type tag or BROKEN_HEART. */
typedef struct pair
{
  value_t car;
  value_t cdr;
} pair_t;

typedef struct box
{
  value_t tag;   /* TYPE_TAG_BOX */
  value_t value;
} box_t;

typedef struct vector
{
  value_t tag;         /* TYPE_TAG_VECTOR */
  size_t  size;
  value_t hash;
  value_t elements[0];
} vector_t;

typedef struct byte_string
{
  value_t tag;      /* TYPE_TAG_BYTESTR */
  size_t  size;
  uint8_t bytes[0];
} byte_string_t;

/* Equivalent to vector_t */
typedef struct structure
{
  value_t tag;      /* TYPE_TAG_STRUCT */
  value_t type;
  size_t  nslots;
  value_t hash;
  value_t slots[0];
} struct_t;

typedef struct weak_box
{
  value_t tag;
  value_t value;
  value_t next;
} weak_box_t;

typedef struct will
{
  value_t tag;
  value_t value;
  value_t finalizer;
  value_t next;
} will_t;

typedef struct float_object
{
  value_t tag;
  native_float_t value;
} float_object_t;

typedef struct builtin_fn_object
{
  value_t tag;
  builtin_fn_t *fn;
} builtin_fn_object_t;

typedef struct gc_root
{
  value_t value;
  struct gc_root *prev;
  struct gc_root *next;
} gc_root_t;

/* uint64_t isn't present everywhere  */
typedef unsigned long long nsec_t;
typedef unsigned long long llsize_t;

typedef struct gc_stats
{
  struct {
    int      passes;
    nsec_t   total_ns;
    nsec_t   max_ns;
    nsec_t   max_gen1_ns;
    llsize_t total_freed;
  }      gen[2];
  size_t gen1_high_water;
} gc_stats_t;

extern gc_stats_t gc_stats;

/* Must be #t or #f; for generalized booleans use _get_boolean(). */
bool get_boolean(value_t v);

fixnum_t get_fixnum(value_t v);

object_t *get_object(value_t v);

pair_t *get_pair(value_t pair);
value_t cons(value_t car, value_t cdr);

value_t make_box(value_t initial_value);
box_t *get_box(value_t v);

value_t make_vector(size_t elements, value_t default_value);
vector_t *get_vector(value_t v);

value_t make_byte_string(size_t size, int default_value);
byte_string_t *get_byte_string(value_t v); 

/* Returns a byte string w/ bytes from 's' (excl. terminating NUL). */
value_t string_to_value(const char *s);

/* Return a new C string which must be free()'d by caller. */
char *value_to_string(value_t v);

/* Like strcmp(), but for byte strings. */
int byte_strcmp(value_t s1, value_t s2);

value_t get_hash_value(value_t val);
value_t combine_hash_values(value_t h1, value_t h2);

value_t make_struct(value_t type);
struct_t *get_struct(value_t v);
value_t get_structure_type(void);

/* True if 'value' is (1) a structure, and (2) an instance of 'type'. */
bool struct_is_a(value_t value, value_t type);

value_t make_weak_box(value_t value);
weak_box_t *get_weak_box(value_t v);

/* Finalizers are register-and-forget; there should be no external references to wills. */
void register_finalizer(value_t value, value_t finalizer);
bool are_finalizers_pending(void);

/* If *value == #f on return there are no more finalizers. */
void get_next_finalizer(value_t *value, value_t *finalizer);

value_t make_float(native_float_t value);
native_float_t get_float(value_t v);

value_t make_builtin_fn(builtin_fn_t *fn);
builtin_fn_t *get_builtin_fn(value_t v);

/****************************************************************************/

static inline bool is_nil(value_t v)
{
  return v == NIL;
}

static inline bool is_undefined(value_t v)
{
  return v == UNDEFINED;
}

static inline value_t boolean_value(bool b)
{
  return b ? TRUE_VALUE : FALSE_VALUE;
}

static inline bool is_boolean(value_t v)
{
  return (v == FALSE_VALUE) || (v == TRUE_VALUE);
}

static inline bool _get_boolean(value_t v)
{
  return v != FALSE_VALUE;
}

static inline value_t fixnum_value(fixnum_t n)
{
  return (value_t)(n << 1) | 1;
}

static inline bool is_fixnum(value_t v)
{
  return (v & 1) != 0;
}

static inline fixnum_t _get_fixnum(value_t n)
{
  return ((fixnum_t)n) >> 1;
}

static inline bool is_valid_fixnum(fixnum_t n)
{
  return _get_fixnum(fixnum_value(n)) == n;
}

static inline value_t object_value(void *obj)
{
  assert((uintptr_t)obj >= 4096);
  assert(((uintptr_t)obj & 3) == 0);
  return (value_t)obj;
}

static inline bool is_object(value_t v)
{
  /* Neither pairs nor other objects can exist below (void*)4096. */
  return ((v & 0x1) == 0) && (v > MAX_SPECIAL);
}

/* Pairs are a type of object, but the value representation is different */
static inline object_t *_get_object(value_t v)
{
  return (object_t*)(v & ~(value_t)3);
}

static inline value_t pair_value(pair_t *p)
{
  assert((uintptr_t)p >= 4096);
  assert(((uintptr_t)p & 3) == 0);
  return (value_t)p + 2;
}

static inline bool is_pair(value_t v)
{
  return ((v & 0x3) == 2);
}

static inline pair_t *_get_pair(value_t v)
{
  return (pair_t*)_get_object(v);
}

static inline bool is_list(value_t v)
{
  return is_nil(v) || is_pair(v);
}

static inline bool is_box(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_BOX);
}

static inline box_t *_get_box(value_t v)
{
  return (box_t*)_get_object(v);
}

static inline bool is_vector(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_VECTOR);
}

static inline vector_t *_get_vector(value_t v)
{
  return (vector_t*)_get_object(v);
}

static inline bool is_byte_string(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_BYTESTR);
}

static inline byte_string_t *_get_byte_string(value_t v)
{
  return (byte_string_t*)_get_object(v);
}

static inline bool is_struct(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_STRUCT);
}

static inline struct_t *_get_struct(value_t v)
{
  return (struct_t*)_get_object(v);
}

static inline bool is_weak_box(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_WEAK_BOX);
}

static inline weak_box_t *_get_weak_box(value_t v)
{
  return (weak_box_t*)_get_object(v);
}

static inline bool is_will(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_WILL);
}

static inline bool is_float(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_FLOAT);
}

static inline native_float_t _get_float(value_t v)
{
  return ((float_object_t*)_get_object(v))->value;
}

static inline bool is_builtin_fn(value_t v)
{
  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_BUILTIN);
}

static inline builtin_fn_t *_get_builtin_fn(value_t v)
{
  return ((builtin_fn_object_t*)_get_object(v))->fn;
}

void gc_init(size_t gen0_size, size_t gen1_min_size, size_t gen1_max_size);
void clear_gc_stats(void);
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);
bool set_gc_enabled(bool enable);
void _gc_mark_updated_gen1_object(value_t v);

void fprint_value(FILE *f, value_t v);
void fprint_gc_stats(FILE *f);

static inline void print_value(value_t v)
{
  fprint_value(stdout, v);
}

static inline void print_gc_stats(void)
{
  fprint_gc_stats(stderr);
}

static inline bool is_gen0_object(value_t v)
{
  /* These private variables are exported ONLY for use by this inline function. */
  extern char *gc_gen0_range;
  extern char *gc_gen0_range_end;

  const char const *obj = (const char*)_get_object(v);
  return (obj <  gc_gen0_range_end)
      && (obj >= gc_gen0_range)
      && is_object(v);
}

/* Don't call this directly; use the WRITE_BARRIER macro. */
static inline void _gc_write_barrier(value_t v)
{
  assert(is_object(v));
  if (!is_gen0_object(v))
  {
    _gc_mark_updated_gen1_object(v);
  }
}

/* Implements the release_assert() macro */
void _release_assert(bool expr, const char *str, const char *file, int line);

/* To be provided by the main application */
void out_of_memory(void);

#endif
/* vim:set sw=2 expandtab: */