summaryrefslogtreecommitdiff
path: root/libguile/whippet/benchmarks
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/whippet/benchmarks')
-rw-r--r--libguile/whippet/benchmarks/README.md35
-rw-r--r--libguile/whippet/benchmarks/ephemerons-embedder.h54
-rw-r--r--libguile/whippet/benchmarks/ephemerons-types.h21
-rw-r--r--libguile/whippet/benchmarks/ephemerons.c272
-rw-r--r--libguile/whippet/benchmarks/finalizers-embedder.h55
-rw-r--r--libguile/whippet/benchmarks/finalizers-types.h22
-rw-r--r--libguile/whippet/benchmarks/finalizers.c284
-rw-r--r--libguile/whippet/benchmarks/heap-objects.h19
-rw-r--r--libguile/whippet/benchmarks/mt-gcbench-embedder.h54
-rw-r--r--libguile/whippet/benchmarks/mt-gcbench-types.h34
-rw-r--r--libguile/whippet/benchmarks/mt-gcbench.c402
-rw-r--r--libguile/whippet/benchmarks/quads-embedder.h37
-rw-r--r--libguile/whippet/benchmarks/quads-types.h15
-rw-r--r--libguile/whippet/benchmarks/quads.c181
-rw-r--r--libguile/whippet/benchmarks/simple-allocator.h21
-rw-r--r--libguile/whippet/benchmarks/simple-gc-embedder.h183
-rw-r--r--libguile/whippet/benchmarks/simple-roots-api.h26
-rw-r--r--libguile/whippet/benchmarks/simple-roots-types.h17
-rw-r--r--libguile/whippet/benchmarks/simple-tagging-scheme.h29
19 files changed, 1761 insertions, 0 deletions
diff --git a/libguile/whippet/benchmarks/README.md b/libguile/whippet/benchmarks/README.md
new file mode 100644
index 000000000..00ec1f731
--- /dev/null
+++ b/libguile/whippet/benchmarks/README.md
@@ -0,0 +1,35 @@
+# Benchmarks
+
+ - [`mt-gcbench.c`](./mt-gcbench.c): The multi-threaded [GCBench
+ benchmark](https://hboehm.info/gc/gc_bench.html). An old but
+ standard benchmark that allocates different sizes of binary trees.
+ As parameters it takes a heap multiplier and a number of mutator
+ threads. We analytically compute the peak amount of live data and
+ then size the GC heap as a multiplier of that size. It has a peak
+ heap consumption of 10 MB or so per mutator thread: not very large.
+ At a 2x heap multiplier, it causes about 30 collections for the `mmc`
+ collector, and runs somewhere around 200-400 milliseconds in
+ single-threaded mode, on the machines I have in 2022. For low thread
+ counts, the GCBench benchmark is small; but then again many Guile
+ processes also are quite short-lived, so perhaps it is useful to
+ ensure that small heaps remain lightweight.
+
+ To stress `mmc`'s handling of fragmentation, we modified this
+ benchmark to intersperse pseudorandomly-sized holes between tree
+ nodes.
+
+ - [`quads.c`](./quads.c): A synthetic benchmark that allocates quad
+ trees. The mutator begins by allocating one long-lived tree of depth
+ N, and then allocates 13% of the heap in depth-3 trees, 20 times,
+ simulating a fixed working set and otherwise an allocation-heavy
+ workload. By observing the times to allocate 13% of the heap in
+ garbage we can infer mutator overheads, and also note the variance
+ for the cycles in which GC hits.
+
+## License
+
+mt-gcbench.c was originally from https://hboehm.info/gc/gc_bench/, which
+has a somewhat unclear license. I have modified GCBench significantly
+so that I can slot in different GC implementations. Other files are
+distributed under the Whippet license; see the top-level
+[README.md](../README.md) for more.
diff --git a/libguile/whippet/benchmarks/ephemerons-embedder.h b/libguile/whippet/benchmarks/ephemerons-embedder.h
new file mode 100644
index 000000000..5b17178cd
--- /dev/null
+++ b/libguile/whippet/benchmarks/ephemerons-embedder.h
@@ -0,0 +1,54 @@
+#ifndef EPHEMERONS_EMBEDDER_H
+#define EPHEMERONS_EMBEDDER_H
+
+#include <stddef.h>
+
+#include "ephemerons-types.h"
+#include "gc-ephemeron.h"
+
+struct gc_heap;
+
+#define DEFINE_METHODS(name, Name, NAME) \
+ static inline size_t name##_size(Name *obj) GC_ALWAYS_INLINE; \
+ static inline void visit_##name##_fields(Name *obj,\
+ void (*visit)(struct gc_edge edge, \
+ struct gc_heap *heap, \
+ void *visit_data), \
+ struct gc_heap *heap, \
+ void *visit_data) GC_ALWAYS_INLINE;
+FOR_EACH_HEAP_OBJECT_KIND(DEFINE_METHODS)
+#undef DEFINE_METHODS
+
+static inline size_t small_object_size(SmallObject *obj) { return sizeof(*obj); }
+static inline size_t ephemeron_size(Ephemeron *obj) { return gc_ephemeron_size(); }
+static inline size_t box_size(Box *obj) { return sizeof(*obj); }
+
+static inline void
+visit_small_object_fields(SmallObject *obj,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap,
+ void *visit_data) {}
+
+static inline void
+visit_ephemeron_fields(Ephemeron *ephemeron,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+
+ struct gc_heap *heap,
+ void *visit_data) {
+ gc_trace_ephemeron((struct gc_ephemeron*)ephemeron, visit, heap, visit_data);
+}
+
+static inline void
+visit_box_fields(Box *box,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap,
+ void *visit_data) {
+ visit(gc_edge(&box->obj), heap, visit_data);
+}
+
+#include "simple-gc-embedder.h"
+
+#endif // EPHEMERONS_EMBEDDER_H
diff --git a/libguile/whippet/benchmarks/ephemerons-types.h b/libguile/whippet/benchmarks/ephemerons-types.h
new file mode 100644
index 000000000..d2a4b9a5b
--- /dev/null
+++ b/libguile/whippet/benchmarks/ephemerons-types.h
@@ -0,0 +1,21 @@
+#ifndef EPHEMERONS_TYPES_H
+#define EPHEMERONS_TYPES_H
+
+#define FOR_EACH_HEAP_OBJECT_KIND(M) \
+ M(box, Box, BOX) \
+ M(ephemeron, Ephemeron, EPHEMERON) \
+ M(small_object, SmallObject, SMALL_OBJECT)
+
+#include "heap-objects.h"
+#include "simple-tagging-scheme.h"
+
+struct SmallObject {
+ struct gc_header header;
+};
+
+struct Box {
+ struct gc_header header;
+ void *obj;
+};
+
+#endif // EPHEMERONS_TYPES_H
diff --git a/libguile/whippet/benchmarks/ephemerons.c b/libguile/whippet/benchmarks/ephemerons.c
new file mode 100644
index 000000000..2262bd5c9
--- /dev/null
+++ b/libguile/whippet/benchmarks/ephemerons.c
@@ -0,0 +1,272 @@
+#include <errno.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <sys/time.h>
+
+#include "assert.h"
+#include "gc-api.h"
+#include "gc-basic-stats.h"
+#include "gc-ephemeron.h"
+#include "simple-roots-api.h"
+#include "ephemerons-types.h"
+#include "simple-allocator.h"
+
+typedef HANDLE_TO(SmallObject) SmallObjectHandle;
+typedef HANDLE_TO(struct gc_ephemeron) EphemeronHandle;
+typedef HANDLE_TO(Box) BoxHandle;
+
+static SmallObject* allocate_small_object(struct gc_mutator *mut) {
+ return gc_allocate_with_kind(mut, ALLOC_KIND_SMALL_OBJECT, sizeof(SmallObject));
+}
+
+static Box* allocate_box(struct gc_mutator *mut) {
+ return gc_allocate_with_kind(mut, ALLOC_KIND_BOX, sizeof(Box));
+}
+
+static struct gc_ephemeron* allocate_ephemeron(struct gc_mutator *mut) {
+ struct gc_ephemeron *ret = gc_allocate_ephemeron(mut);
+ *tag_word(gc_ref_from_heap_object(ret)) = tag_live(ALLOC_KIND_EPHEMERON);
+ return ret;
+}
+
+/* Get the current time in microseconds */
+static unsigned long current_time(void)
+{
+ struct timeval t;
+ if (gettimeofday(&t, NULL) == -1)
+ return 0;
+ return t.tv_sec * 1000 * 1000 + t.tv_usec;
+}
+
+struct thread {
+ struct gc_mutator *mut;
+ struct gc_mutator_roots roots;
+};
+
+static void print_elapsed(const char *what, unsigned long start) {
+ unsigned long end = current_time();
+ unsigned long msec = (end - start) / 1000;
+ unsigned long usec = (end - start) % 1000;
+ printf("Completed %s in %lu.%.3lu msec\n", what, msec, usec);
+}
+
+struct call_with_gc_data {
+ void* (*f)(struct thread *);
+ struct gc_heap *heap;
+};
+static void* call_with_gc_inner(struct gc_stack_addr *addr, void *arg) {
+ struct call_with_gc_data *data = arg;
+ struct gc_mutator *mut = gc_init_for_thread(addr, data->heap);
+ struct thread t = { mut, };
+ gc_mutator_set_roots(mut, &t.roots);
+ void *ret = data->f(&t);
+ gc_finish_for_thread(mut);
+ return ret;
+}
+static void* call_with_gc(void* (*f)(struct thread *),
+ struct gc_heap *heap) {
+ struct call_with_gc_data data = { f, heap };
+ return gc_call_with_stack_addr(call_with_gc_inner, &data);
+}
+
+#define CHECK(x) \
+ do { \
+ if (!(x)) { \
+ fprintf(stderr, "%s:%d: check failed: %s\n", __FILE__, __LINE__, #x); \
+ exit(1); \
+ } \
+ } while (0)
+
+#define CHECK_EQ(x, y) CHECK((x) == (y))
+#define CHECK_NE(x, y) CHECK((x) != (y))
+#define CHECK_NULL(x) CHECK_EQ(x, NULL)
+#define CHECK_NOT_NULL(x) CHECK_NE(x, NULL)
+
+static size_t ephemeron_chain_length(struct gc_ephemeron **loc,
+ SmallObject *key) {
+ struct gc_ephemeron *head = gc_ephemeron_chain_head(loc);
+ size_t len = 0;
+ while (head) {
+ CHECK_EQ(key, (SmallObject*)gc_ref_value(gc_ephemeron_key(head)));
+ Box *value = gc_ref_heap_object(gc_ephemeron_value(head));
+ CHECK_NOT_NULL(value);
+ key = value->obj;
+ CHECK_NOT_NULL(key);
+ head = gc_ephemeron_chain_next(head);
+ len++;
+ }
+ return len;
+}
+
+static double heap_size;
+static double heap_multiplier;
+static size_t nthreads;
+
+static void cause_gc(struct gc_mutator *mut) {
+ // Doing a full collection lets us reason precisely about liveness.
+ gc_collect(mut, GC_COLLECTION_MAJOR);
+}
+
+static void make_ephemeron_chain(struct thread *t, EphemeronHandle *head,
+ SmallObjectHandle *head_key, size_t length) {
+ BoxHandle tail_box = { NULL };
+ PUSH_HANDLE(t, tail_box);
+
+ CHECK_NULL(HANDLE_REF(*head_key));
+ HANDLE_SET(*head_key, allocate_small_object(t->mut));
+
+ for (size_t i = 0; i < length; i++) {
+ HANDLE_SET(tail_box, allocate_box(t->mut));
+ HANDLE_REF(tail_box)->obj = HANDLE_REF(*head_key);
+ HANDLE_SET(*head_key, allocate_small_object(t->mut));
+ struct gc_ephemeron *ephemeron = allocate_ephemeron(t->mut);
+ gc_ephemeron_init(t->mut, ephemeron,
+ gc_ref_from_heap_object(HANDLE_REF(*head_key)),
+ gc_ref_from_heap_object(HANDLE_REF(tail_box)));
+ gc_ephemeron_chain_push(HANDLE_LOC(*head), ephemeron);
+ }
+
+ POP_HANDLE(t);
+}
+
+static void* run_one_test(struct thread *t) {
+ size_t unit_size = gc_ephemeron_size() + sizeof(Box);
+ size_t list_length = heap_size / nthreads / heap_multiplier / unit_size;
+
+ printf("Allocating ephemeron list %zu nodes long. Total size %.3fGB.\n",
+ list_length, list_length * unit_size / 1e9);
+
+ unsigned long thread_start = current_time();
+
+ SmallObjectHandle head_key = { NULL };
+ EphemeronHandle head = { NULL };
+
+ PUSH_HANDLE(t, head_key);
+ PUSH_HANDLE(t, head);
+
+ make_ephemeron_chain(t, &head, &head_key, list_length);
+
+ size_t measured_length = ephemeron_chain_length(HANDLE_LOC(head),
+ HANDLE_REF(head_key));
+ CHECK_EQ(measured_length, list_length);
+
+ cause_gc(t->mut);
+ measured_length = ephemeron_chain_length(HANDLE_LOC(head),
+ HANDLE_REF(head_key));
+ CHECK_EQ(measured_length, list_length);
+
+ if (!GC_CONSERVATIVE_ROOTS) {
+ HANDLE_SET(head_key, NULL);
+ cause_gc(t->mut);
+ measured_length = ephemeron_chain_length(HANDLE_LOC(head),
+ HANDLE_REF(head_key));
+ CHECK_EQ(measured_length, 0);
+ }
+
+ // swap head_key for a key halfway in, cause gc
+ // check length is expected half-length; warn, or error if precise
+ // clear and return
+
+ print_elapsed("thread", thread_start);
+
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+
+ return NULL;
+}
+
+static void* run_one_test_in_thread(void *arg) {
+ struct gc_heap *heap = arg;
+ return call_with_gc(run_one_test, heap);
+}
+
+struct join_data { int status; pthread_t thread; };
+static void *join_thread(void *data) {
+ struct join_data *join_data = data;
+ void *ret;
+ join_data->status = pthread_join(join_data->thread, &ret);
+ return ret;
+}
+
+#define MAX_THREAD_COUNT 256
+
+int main(int argc, char *argv[]) {
+ if (argc < 4 || 5 < argc) {
+ fprintf(stderr, "usage: %s HEAP_SIZE MULTIPLIER NTHREADS [GC-OPTIONS]\n", argv[0]);
+ return 1;
+ }
+
+ heap_size = atof(argv[1]);
+ heap_multiplier = atof(argv[2]);
+ nthreads = atol(argv[3]);
+
+ if (heap_size < 8192) {
+ fprintf(stderr,
+ "Heap size should probably be at least 8192, right? '%s'\n",
+ argv[1]);
+ return 1;
+ }
+ if (!(1.0 < heap_multiplier && heap_multiplier < 100)) {
+ fprintf(stderr, "Failed to parse heap multiplier '%s'\n", argv[2]);
+ return 1;
+ }
+ if (nthreads < 1 || nthreads > MAX_THREAD_COUNT) {
+ fprintf(stderr, "Expected integer between 1 and %d for thread count, got '%s'\n",
+ (int)MAX_THREAD_COUNT, argv[2]);
+ return 1;
+ }
+
+ printf("Allocating heap of %.3fGB (%.2f multiplier of live data).\n",
+ heap_size / 1e9, heap_multiplier);
+
+ struct gc_options *options = gc_allocate_options();
+ gc_options_set_int(options, GC_OPTION_HEAP_SIZE_POLICY, GC_HEAP_SIZE_FIXED);
+ gc_options_set_size(options, GC_OPTION_HEAP_SIZE, heap_size);
+ if (argc == 5) {
+ if (!gc_options_parse_and_set_many(options, argv[4])) {
+ fprintf(stderr, "Failed to set GC options: '%s'\n", argv[4]);
+ return 1;
+ }
+ }
+
+ struct gc_heap *heap;
+ struct gc_mutator *mut;
+ struct gc_basic_stats stats;
+ if (!gc_init(options, NULL, &heap, &mut, GC_BASIC_STATS, &stats)) {
+ fprintf(stderr, "Failed to initialize GC with heap size %zu bytes\n",
+ (size_t)heap_size);
+ return 1;
+ }
+ struct thread main_thread = { mut, };
+ gc_mutator_set_roots(mut, &main_thread.roots);
+
+ pthread_t threads[MAX_THREAD_COUNT];
+ // Run one of the threads in the main thread.
+ for (size_t i = 1; i < nthreads; i++) {
+ int status = pthread_create(&threads[i], NULL, run_one_test_in_thread, heap);
+ if (status) {
+ errno = status;
+ perror("Failed to create thread");
+ return 1;
+ }
+ }
+ run_one_test(&main_thread);
+ for (size_t i = 1; i < nthreads; i++) {
+ struct join_data data = { 0, threads[i] };
+ gc_call_without_gc(mut, join_thread, &data);
+ if (data.status) {
+ errno = data.status;
+ perror("Failed to join thread");
+ return 1;
+ }
+ }
+
+ gc_basic_stats_finish(&stats);
+ fputs("\n", stdout);
+ gc_basic_stats_print(&stats, stdout);
+
+ return 0;
+}
+
diff --git a/libguile/whippet/benchmarks/finalizers-embedder.h b/libguile/whippet/benchmarks/finalizers-embedder.h
new file mode 100644
index 000000000..0dde1ae29
--- /dev/null
+++ b/libguile/whippet/benchmarks/finalizers-embedder.h
@@ -0,0 +1,55 @@
+#ifndef FINALIZERS_EMBEDDER_H
+#define FINALIZERS_EMBEDDER_H
+
+#include <stddef.h>
+
+#include "finalizers-types.h"
+#include "gc-finalizer.h"
+
+struct gc_heap;
+
+#define DEFINE_METHODS(name, Name, NAME) \
+ static inline size_t name##_size(Name *obj) GC_ALWAYS_INLINE; \
+ static inline void visit_##name##_fields(Name *obj,\
+ void (*visit)(struct gc_edge edge, \
+ struct gc_heap *heap, \
+ void *visit_data), \
+ struct gc_heap *heap, \
+ void *visit_data) GC_ALWAYS_INLINE;
+FOR_EACH_HEAP_OBJECT_KIND(DEFINE_METHODS)
+#undef DEFINE_METHODS
+
+static inline size_t small_object_size(SmallObject *obj) { return sizeof(*obj); }
+static inline size_t finalizer_size(Finalizer *obj) { return gc_finalizer_size(); }
+static inline size_t pair_size(Pair *obj) { return sizeof(*obj); }
+
+static inline void
+visit_small_object_fields(SmallObject *obj,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap,
+ void *visit_data) {}
+
+static inline void
+visit_finalizer_fields(Finalizer *finalizer,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+
+ struct gc_heap *heap,
+ void *visit_data) {
+ gc_trace_finalizer((struct gc_finalizer*)finalizer, visit, heap, visit_data);
+}
+
+static inline void
+visit_pair_fields(Pair *pair,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap,
+ void *visit_data) {
+ visit(gc_edge(&pair->car), heap, visit_data);
+ visit(gc_edge(&pair->cdr), heap, visit_data);
+}
+
+#include "simple-gc-embedder.h"
+
+#endif // FINALIZERS_EMBEDDER_H
diff --git a/libguile/whippet/benchmarks/finalizers-types.h b/libguile/whippet/benchmarks/finalizers-types.h
new file mode 100644
index 000000000..3597ad5d7
--- /dev/null
+++ b/libguile/whippet/benchmarks/finalizers-types.h
@@ -0,0 +1,22 @@
+#ifndef FINALIZERS_TYPES_H
+#define FINALIZERS_TYPES_H
+
+#define FOR_EACH_HEAP_OBJECT_KIND(M) \
+ M(pair, Pair, PAIR) \
+ M(finalizer, Finalizer, FINALIZER) \
+ M(small_object, SmallObject, SMALL_OBJECT)
+
+#include "heap-objects.h"
+#include "simple-tagging-scheme.h"
+
+struct SmallObject {
+ struct gc_header header;
+};
+
+struct Pair {
+ struct gc_header header;
+ void *car;
+ void *cdr;
+};
+
+#endif // FINALIZERS_TYPES_H
diff --git a/libguile/whippet/benchmarks/finalizers.c b/libguile/whippet/benchmarks/finalizers.c
new file mode 100644
index 000000000..537307118
--- /dev/null
+++ b/libguile/whippet/benchmarks/finalizers.c
@@ -0,0 +1,284 @@
+#include <errno.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <sys/time.h>
+
+#include "assert.h"
+#include "gc-api.h"
+#include "gc-basic-stats.h"
+#include "gc-finalizer.h"
+#include "simple-roots-api.h"
+#include "finalizers-types.h"
+#include "simple-allocator.h"
+
+typedef HANDLE_TO(SmallObject) SmallObjectHandle;
+typedef HANDLE_TO(struct gc_finalizer) FinalizerHandle;
+typedef HANDLE_TO(Pair) PairHandle;
+
+static SmallObject* allocate_small_object(struct gc_mutator *mut) {
+ return gc_allocate_with_kind(mut, ALLOC_KIND_SMALL_OBJECT, sizeof(SmallObject));
+}
+
+static Pair* allocate_pair(struct gc_mutator *mut) {
+ return gc_allocate_with_kind(mut, ALLOC_KIND_PAIR, sizeof(Pair));
+}
+
+static struct gc_finalizer* allocate_finalizer(struct gc_mutator *mut) {
+ struct gc_finalizer *ret = gc_allocate_finalizer(mut);
+ *tag_word(gc_ref_from_heap_object(ret)) = tag_live(ALLOC_KIND_FINALIZER);
+ return ret;
+}
+
+/* Get the current time in microseconds */
+static unsigned long current_time(void)
+{
+ struct timeval t;
+ if (gettimeofday(&t, NULL) == -1)
+ return 0;
+ return t.tv_sec * 1000 * 1000 + t.tv_usec;
+}
+
+struct thread {
+ struct gc_mutator *mut;
+ struct gc_mutator_roots roots;
+};
+
+static void print_elapsed(const char *what, unsigned long start) {
+ unsigned long end = current_time();
+ unsigned long msec = (end - start) / 1000;
+ unsigned long usec = (end - start) % 1000;
+ printf("Completed %s in %lu.%.3lu msec\n", what, msec, usec);
+}
+
+struct call_with_gc_data {
+ void* (*f)(struct thread *);
+ struct gc_heap *heap;
+};
+static void* call_with_gc_inner(struct gc_stack_addr *addr, void *arg) {
+ struct call_with_gc_data *data = arg;
+ struct gc_mutator *mut = gc_init_for_thread(addr, data->heap);
+ struct thread t = { mut, };
+ gc_mutator_set_roots(mut, &t.roots);
+ void *ret = data->f(&t);
+ gc_finish_for_thread(mut);
+ return ret;
+}
+static void* call_with_gc(void* (*f)(struct thread *),
+ struct gc_heap *heap) {
+ struct call_with_gc_data data = { f, heap };
+ return gc_call_with_stack_addr(call_with_gc_inner, &data);
+}
+
+#define CHECK(x) \
+ do { \
+ if (!(x)) { \
+ fprintf(stderr, "%s:%d: check failed: %s\n", __FILE__, __LINE__, #x); \
+ exit(1); \
+ } \
+ } while (0)
+
+#define CHECK_EQ(x, y) CHECK((x) == (y))
+#define CHECK_NE(x, y) CHECK((x) != (y))
+#define CHECK_NULL(x) CHECK_EQ(x, NULL)
+#define CHECK_NOT_NULL(x) CHECK_NE(x, NULL)
+
+static double heap_size;
+static double heap_multiplier;
+static size_t nthreads;
+
+static void cause_gc(struct gc_mutator *mut) {
+ // Doing a full collection lets us reason precisely about liveness.
+ gc_collect(mut, GC_COLLECTION_MAJOR);
+}
+
+static inline void set_car(struct gc_mutator *mut, Pair *obj, void *val) {
+ void **field = &obj->car;
+ if (val)
+ gc_write_barrier(mut, gc_ref_from_heap_object(obj), sizeof(Pair),
+ gc_edge(field),
+ gc_ref_from_heap_object(val));
+ *field = val;
+}
+
+static inline void set_cdr(struct gc_mutator *mut, Pair *obj, void *val) {
+ void **field = &obj->cdr;
+ if (val)
+ gc_write_barrier(mut, gc_ref_from_heap_object(obj), sizeof(Pair),
+ gc_edge(field),
+ gc_ref_from_heap_object(val));
+ field = val;
+}
+
+static Pair* make_finalizer_chain(struct thread *t, size_t length) {
+ PairHandle head = { NULL };
+ PairHandle tail = { NULL };
+ PUSH_HANDLE(t, head);
+ PUSH_HANDLE(t, tail);
+
+ for (size_t i = 0; i < length; i++) {
+ HANDLE_SET(tail, HANDLE_REF(head));
+ HANDLE_SET(head, allocate_pair(t->mut));
+ set_car(t->mut, HANDLE_REF(head), allocate_small_object(t->mut));
+ set_cdr(t->mut, HANDLE_REF(head), HANDLE_REF(tail));
+ struct gc_finalizer *finalizer = allocate_finalizer(t->mut);
+ gc_finalizer_attach(t->mut, finalizer, 0,
+ gc_ref_from_heap_object(HANDLE_REF(head)),
+ gc_ref_from_heap_object(HANDLE_REF(head)->car));
+ }
+
+ Pair *ret = HANDLE_REF(head);
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+ return ret;
+}
+
+static void* run_one_test(struct thread *t) {
+ size_t unit_size = gc_finalizer_size() + sizeof(Pair);
+ size_t list_length = heap_size / nthreads / heap_multiplier / unit_size;
+ ssize_t outstanding = list_length;
+
+ printf("Allocating list %zu nodes long. Total size %.3fGB.\n",
+ list_length, list_length * unit_size / 1e9);
+
+ unsigned long thread_start = current_time();
+
+ PairHandle chain = { NULL };
+ PUSH_HANDLE(t, chain);
+
+ HANDLE_SET(chain, make_finalizer_chain(t, list_length));
+ cause_gc(t->mut);
+
+ size_t finalized = 0;
+ for (struct gc_finalizer *f = gc_pop_finalizable(t->mut);
+ f;
+ f = gc_pop_finalizable(t->mut)) {
+ Pair* p = gc_ref_heap_object(gc_finalizer_object(f));
+ SmallObject* o = gc_ref_heap_object(gc_finalizer_closure(f));
+ CHECK_EQ(p->car, o);
+ finalized++;
+ }
+ printf("thread %p: GC before clear finalized %zu nodes.\n", t, finalized);
+ outstanding -= finalized;
+
+ HANDLE_SET(chain, NULL);
+ cause_gc(t->mut);
+
+ finalized = 0;
+ for (struct gc_finalizer *f = gc_pop_finalizable(t->mut);
+ f;
+ f = gc_pop_finalizable(t->mut)) {
+ Pair* p = gc_ref_heap_object(gc_finalizer_object(f));
+ SmallObject* o = gc_ref_heap_object(gc_finalizer_closure(f));
+ CHECK_EQ(p->car, o);
+ finalized++;
+ }
+ printf("thread %p: GC after clear finalized %zu nodes.\n", t, finalized);
+ outstanding -= finalized;
+
+ print_elapsed("thread", thread_start);
+
+ POP_HANDLE(t);
+
+ return (void*)outstanding;
+}
+
+static void* run_one_test_in_thread(void *arg) {
+ struct gc_heap *heap = arg;
+ return call_with_gc(run_one_test, heap);
+}
+
+struct join_data { int status; pthread_t thread; };
+static void *join_thread(void *data) {
+ struct join_data *join_data = data;
+ void *ret;
+ join_data->status = pthread_join(join_data->thread, &ret);
+ return ret;
+}
+
+#define MAX_THREAD_COUNT 256
+
+int main(int argc, char *argv[]) {
+ if (argc < 4 || 5 < argc) {
+ fprintf(stderr, "usage: %s HEAP_SIZE MULTIPLIER NTHREADS [GC-OPTIONS]\n", argv[0]);
+ return 1;
+ }
+
+ heap_size = atof(argv[1]);
+ heap_multiplier = atof(argv[2]);
+ nthreads = atol(argv[3]);
+
+ if (heap_size < 8192) {
+ fprintf(stderr,
+ "Heap size should probably be at least 8192, right? '%s'\n",
+ argv[1]);
+ return 1;
+ }
+ if (!(1.0 < heap_multiplier && heap_multiplier < 100)) {
+ fprintf(stderr, "Failed to parse heap multiplier '%s'\n", argv[2]);
+ return 1;
+ }
+ if (nthreads < 1 || nthreads > MAX_THREAD_COUNT) {
+ fprintf(stderr, "Expected integer between 1 and %d for thread count, got '%s'\n",
+ (int)MAX_THREAD_COUNT, argv[2]);
+ return 1;
+ }
+
+ printf("Allocating heap of %.3fGB (%.2f multiplier of live data).\n",
+ heap_size / 1e9, heap_multiplier);
+
+ struct gc_options *options = gc_allocate_options();
+ gc_options_set_int(options, GC_OPTION_HEAP_SIZE_POLICY, GC_HEAP_SIZE_FIXED);
+ gc_options_set_size(options, GC_OPTION_HEAP_SIZE, heap_size);
+ if (argc == 5) {
+ if (!gc_options_parse_and_set_many(options, argv[4])) {
+ fprintf(stderr, "Failed to set GC options: '%s'\n", argv[4]);
+ return 1;
+ }
+ }
+
+ struct gc_heap *heap;
+ struct gc_mutator *mut;
+ struct gc_basic_stats stats;
+ if (!gc_init(options, NULL, &heap, &mut, GC_BASIC_STATS, &stats)) {
+ fprintf(stderr, "Failed to initialize GC with heap size %zu bytes\n",
+ (size_t)heap_size);
+ return 1;
+ }
+ struct thread main_thread = { mut, };
+ gc_mutator_set_roots(mut, &main_thread.roots);
+
+ pthread_t threads[MAX_THREAD_COUNT];
+ // Run one of the threads in the main thread.
+ for (size_t i = 1; i < nthreads; i++) {
+ int status = pthread_create(&threads[i], NULL, run_one_test_in_thread, heap);
+ if (status) {
+ errno = status;
+ perror("Failed to create thread");
+ return 1;
+ }
+ }
+ ssize_t outstanding = (size_t)run_one_test(&main_thread);
+ for (size_t i = 1; i < nthreads; i++) {
+ struct join_data data = { 0, threads[i] };
+ void *ret = gc_call_without_gc(mut, join_thread, &data);
+ if (data.status) {
+ errno = data.status;
+ perror("Failed to join thread");
+ return 1;
+ }
+ ssize_t thread_outstanding = (ssize_t)ret;
+ outstanding += thread_outstanding;
+ }
+
+ if (outstanding)
+ printf("\n\nWARNING: %zd nodes outstanding!!!\n\n", outstanding);
+
+ gc_basic_stats_finish(&stats);
+ fputs("\n", stdout);
+ gc_basic_stats_print(&stats, stdout);
+
+ return 0;
+}
+
diff --git a/libguile/whippet/benchmarks/heap-objects.h b/libguile/whippet/benchmarks/heap-objects.h
new file mode 100644
index 000000000..14ec2e3d8
--- /dev/null
+++ b/libguile/whippet/benchmarks/heap-objects.h
@@ -0,0 +1,19 @@
+#ifndef HEAP_OBJECTS_H
+#define HEAP_OBJECTS_H
+
+#include "gc-inline.h"
+#include "gc-edge.h"
+
+#define DECLARE_NODE_TYPE(name, Name, NAME) \
+ struct Name; \
+ typedef struct Name Name;
+FOR_EACH_HEAP_OBJECT_KIND(DECLARE_NODE_TYPE)
+#undef DECLARE_NODE_TYPE
+
+#define DEFINE_ENUM(name, Name, NAME) ALLOC_KIND_##NAME,
+enum alloc_kind {
+ FOR_EACH_HEAP_OBJECT_KIND(DEFINE_ENUM)
+};
+#undef DEFINE_ENUM
+
+#endif // HEAP_OBJECTS_H
diff --git a/libguile/whippet/benchmarks/mt-gcbench-embedder.h b/libguile/whippet/benchmarks/mt-gcbench-embedder.h
new file mode 100644
index 000000000..110e7e05e
--- /dev/null
+++ b/libguile/whippet/benchmarks/mt-gcbench-embedder.h
@@ -0,0 +1,54 @@
+#ifndef MT_GCBENCH_EMBEDDER_H
+#define MT_GCBENCH_EMBEDDER_H
+
+#include "gc-config.h"
+#include "mt-gcbench-types.h"
+
+struct gc_heap;
+
+#define DEFINE_METHODS(name, Name, NAME) \
+ static inline size_t name##_size(Name *obj) GC_ALWAYS_INLINE; \
+ static inline void visit_##name##_fields(Name *obj,\
+ void (*visit)(struct gc_edge edge, \
+ struct gc_heap *heap, \
+ void *visit_data), \
+ struct gc_heap *heap, \
+ void *visit_data) GC_ALWAYS_INLINE;
+FOR_EACH_HEAP_OBJECT_KIND(DEFINE_METHODS)
+#undef DEFINE_METHODS
+
+static inline size_t node_size(Node *obj) {
+ return sizeof(Node);
+}
+static inline size_t double_array_size(DoubleArray *array) {
+ return sizeof(*array) + array->length * sizeof(double);
+}
+static inline size_t hole_size(Hole *hole) {
+ return sizeof(*hole) + hole->length * sizeof(uintptr_t);
+}
+static inline void
+visit_node_fields(Node *node,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap, void *visit_data) {
+ visit(gc_edge(&node->left), heap, visit_data);
+ visit(gc_edge(&node->right), heap, visit_data);
+}
+static inline void
+visit_double_array_fields(DoubleArray *obj,
+ void (*visit)(struct gc_edge edge,
+ struct gc_heap *heap, void *visit_data),
+ struct gc_heap *heap, void *visit_data) {
+}
+static inline void
+visit_hole_fields(Hole *obj,
+ void (*visit)(struct gc_edge edge,
+ struct gc_heap *heap, void *visit_data),
+ struct gc_heap *heap, void *visit_data) {
+ if (GC_PRECISE_ROOTS)
+ GC_CRASH();
+}
+
+#include "simple-gc-embedder.h"
+
+#endif // MT_GCBENCH_EMBEDDER_H
diff --git a/libguile/whippet/benchmarks/mt-gcbench-types.h b/libguile/whippet/benchmarks/mt-gcbench-types.h
new file mode 100644
index 000000000..60bddc489
--- /dev/null
+++ b/libguile/whippet/benchmarks/mt-gcbench-types.h
@@ -0,0 +1,34 @@
+#ifndef GCBENCH_TYPES_H
+#define GCBENCH_TYPES_H
+
+#include <stddef.h>
+#include <stdint.h>
+
+#define FOR_EACH_HEAP_OBJECT_KIND(M) \
+ M(node, Node, NODE) \
+ M(double_array, DoubleArray, DOUBLE_ARRAY) \
+ M(hole, Hole, HOLE)
+
+#include "heap-objects.h"
+#include "simple-tagging-scheme.h"
+
+struct Node {
+ struct gc_header header;
+ struct Node *left;
+ struct Node *right;
+ int i, j;
+};
+
+struct DoubleArray {
+ struct gc_header header;
+ size_t length;
+ double values[0];
+};
+
+struct Hole {
+ struct gc_header header;
+ size_t length;
+ uintptr_t values[0];
+};
+
+#endif // GCBENCH_TYPES_H
diff --git a/libguile/whippet/benchmarks/mt-gcbench.c b/libguile/whippet/benchmarks/mt-gcbench.c
new file mode 100644
index 000000000..9b2521043
--- /dev/null
+++ b/libguile/whippet/benchmarks/mt-gcbench.c
@@ -0,0 +1,402 @@
+// This is adapted from a benchmark written by John Ellis and Pete Kovac
+// of Post Communications.
+// It was modified by Hans Boehm of Silicon Graphics.
+// Translated to C++ 30 May 1997 by William D Clinger of Northeastern Univ.
+// Translated to C 15 March 2000 by Hans Boehm, now at HP Labs.
+//
+// This is no substitute for real applications. No actual application
+// is likely to behave in exactly this way. However, this benchmark was
+// designed to be more representative of real applications than other
+// Java GC benchmarks of which we are aware.
+// It attempts to model those properties of allocation requests that
+// are important to current GC techniques.
+// It is designed to be used either to obtain a single overall performance
+// number, or to give a more detailed estimate of how collector
+// performance varies with object lifetimes. It prints the time
+// required to allocate and collect balanced binary trees of various
+// sizes. Smaller trees result in shorter object lifetimes. Each cycle
+// allocates roughly the same amount of memory.
+// Two data structures are kept around during the entire process, so
+// that the measured performance is representative of applications
+// that maintain some live in-memory data. One of these is a tree
+// containing many pointers. The other is a large array containing
+// double precision floating point numbers. Both should be of comparable
+// size.
+//
+// The results are only really meaningful together with a specification
+// of how much memory was used. It is possible to trade memory for
+// better time performance. This benchmark should be run in a 32 MB
+// heap, though we don't currently know how to enforce that uniformly.
+//
+// Unlike the original Ellis and Kovac benchmark, we do not attempt
+// measure pause times. This facility should eventually be added back
+// in. There are several reasons for omitting it for now. The original
+// implementation depended on assumptions about the thread scheduler
+// that don't hold uniformly. The results really measure both the
+// scheduler and GC. Pause time measurements tend to not fit well with
+// current benchmark suites. As far as we know, none of the current
+// commercial Java implementations seriously attempt to minimize GC pause
+// times.
+
+#include <errno.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/time.h>
+
+#include "assert.h"
+#include "gc-api.h"
+#include "gc-basic-stats.h"
+#include "mt-gcbench-types.h"
+#include "simple-roots-api.h"
+#include "simple-allocator.h"
+
+#define MAX_THREAD_COUNT 256
+
+static const int long_lived_tree_depth = 16; // about 4Mb
+static const int array_size = 500000; // about 4Mb
+static const int min_tree_depth = 4;
+static const int max_tree_depth = 16;
+
+typedef HANDLE_TO(Node) NodeHandle;
+typedef HANDLE_TO(DoubleArray) DoubleArrayHandle;
+
+static Node* allocate_node(struct gc_mutator *mut) {
+ // memset to 0 by the collector.
+ return gc_allocate_with_kind(mut, ALLOC_KIND_NODE, sizeof (Node));
+}
+
+static DoubleArray* allocate_double_array(struct gc_mutator *mut,
+ size_t size) {
+ // May be uninitialized.
+ size_t bytes = sizeof(DoubleArray) + sizeof (double) * size;
+ DoubleArray *ret =
+ gc_allocate_pointerless_with_kind(mut, ALLOC_KIND_DOUBLE_ARRAY, bytes);
+ ret->length = size;
+ return ret;
+}
+
+static Hole* allocate_hole(struct gc_mutator *mut, size_t size) {
+ size_t bytes = sizeof(Hole) + sizeof (uintptr_t) * size;
+ Hole *ret = gc_allocate_with_kind(mut, ALLOC_KIND_HOLE, bytes);
+ ret->length = size;
+ return ret;
+}
+
+static unsigned long current_time(void) {
+ struct timeval t = { 0 };
+ gettimeofday(&t, NULL);
+ return t.tv_sec * 1000 * 1000 + t.tv_usec;
+}
+
+static double elapsed_millis(unsigned long start) {
+ return (current_time() - start) * 1e-3;
+}
+
+// Nodes used by a tree of a given size
+static int tree_size(int i) {
+ return ((1 << (i + 1)) - 1);
+}
+
+// Number of iterations to use for a given tree depth
+static int compute_num_iters(int i) {
+ return 2 * tree_size(max_tree_depth + 2) / tree_size(i);
+}
+
+// A power-law distribution. Each integer was selected by starting at 0, taking
+// a random number in [0,1), and then accepting the integer if the random number
+// was less than 0.15, or trying again with the next integer otherwise. Useful
+// for modelling allocation sizes or number of garbage objects to allocate
+// between live allocations.
+static const uint8_t power_law_distribution[256] = {
+ 1, 15, 3, 12, 2, 8, 4, 0, 18, 7, 9, 8, 15, 2, 36, 5,
+ 1, 9, 6, 11, 9, 19, 2, 0, 0, 3, 9, 6, 3, 2, 1, 1,
+ 6, 1, 8, 4, 2, 0, 5, 3, 7, 0, 0, 3, 0, 4, 1, 7,
+ 1, 8, 2, 2, 2, 14, 0, 7, 8, 0, 2, 1, 4, 12, 7, 5,
+ 0, 3, 4, 13, 10, 2, 3, 7, 0, 8, 0, 23, 0, 16, 1, 1,
+ 6, 28, 1, 18, 0, 3, 6, 5, 8, 6, 14, 5, 2, 5, 0, 11,
+ 0, 18, 4, 16, 1, 4, 3, 13, 3, 23, 7, 4, 10, 5, 3, 13,
+ 0, 14, 5, 5, 2, 5, 0, 16, 2, 0, 1, 1, 0, 0, 4, 2,
+ 7, 7, 0, 5, 7, 2, 1, 24, 27, 3, 7, 1, 0, 8, 1, 4,
+ 0, 3, 0, 7, 7, 3, 9, 2, 9, 2, 5, 10, 1, 1, 12, 6,
+ 2, 9, 5, 0, 4, 6, 0, 7, 2, 1, 5, 4, 1, 0, 1, 15,
+ 4, 0, 15, 4, 0, 0, 32, 18, 2, 2, 1, 7, 8, 3, 11, 1,
+ 2, 7, 11, 1, 9, 1, 2, 6, 11, 17, 1, 2, 5, 1, 14, 3,
+ 6, 1, 1, 15, 3, 1, 0, 6, 10, 8, 1, 3, 2, 7, 0, 1,
+ 0, 11, 3, 3, 5, 8, 2, 0, 0, 7, 12, 2, 5, 20, 3, 7,
+ 4, 4, 5, 22, 1, 5, 2, 7, 15, 2, 4, 6, 11, 8, 12, 1
+};
+
+static size_t power_law(size_t *counter) {
+ return power_law_distribution[(*counter)++ & 0xff];
+}
+
+struct thread {
+ struct gc_mutator *mut;
+ struct gc_mutator_roots roots;
+ size_t counter;
+};
+
+static void allocate_garbage(struct thread *t) {
+ size_t hole = power_law(&t->counter);
+ if (hole) {
+ allocate_hole(t->mut, hole);
+ }
+}
+
+static inline void set_field(struct gc_mutator *mut, Node *obj,
+ Node **field, Node *val) {
+ gc_write_barrier(mut, gc_ref_from_heap_object(obj), sizeof(Node),
+ gc_edge(field),
+ gc_ref_from_heap_object(val));
+ *field = val;
+}
+
+// Build tree top down, assigning to older objects.
+static void populate(struct thread *t, int depth, Node *node) {
+ struct gc_mutator *mut = t->mut;
+ if (depth <= 0)
+ return;
+
+ NodeHandle self = { node };
+ PUSH_HANDLE(t, self);
+ allocate_garbage(t);
+ NodeHandle l = { allocate_node(mut) };
+ PUSH_HANDLE(t, l);
+ allocate_garbage(t);
+ NodeHandle r = { allocate_node(mut) };
+ PUSH_HANDLE(t, r);
+
+ set_field(mut, HANDLE_REF(self), &HANDLE_REF(self)->left, HANDLE_REF(l));
+ set_field(mut, HANDLE_REF(self), &HANDLE_REF(self)->right, HANDLE_REF(r));
+ // i is 0 because the memory is zeroed.
+ HANDLE_REF(self)->j = depth;
+
+ populate(t, depth-1, HANDLE_REF(self)->left);
+ populate(t, depth-1, HANDLE_REF(self)->right);
+
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+}
+
+// Build tree bottom-up
+static Node* make_tree(struct thread *t, int depth) {
+ struct gc_mutator *mut = t->mut;
+ if (depth <= 0)
+ return allocate_node(mut);
+
+ NodeHandle left = { make_tree(t, depth-1) };
+ PUSH_HANDLE(t, left);
+ NodeHandle right = { make_tree(t, depth-1) };
+ PUSH_HANDLE(t, right);
+
+ allocate_garbage(t);
+ Node *result = allocate_node(mut);
+ result->left = HANDLE_REF(left);
+ result->right = HANDLE_REF(right);
+ // i is 0 because the memory is zeroed.
+ result->j = depth;
+
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+
+ return result;
+}
+
+static void validate_tree(Node *tree, int depth) {
+#ifndef NDEBUG
+ GC_ASSERT_EQ(tree->i, 0);
+ GC_ASSERT_EQ(tree->j, depth);
+ if (depth == 0) {
+ GC_ASSERT(!tree->left);
+ GC_ASSERT(!tree->right);
+ } else {
+ GC_ASSERT(tree->left);
+ GC_ASSERT(tree->right);
+ validate_tree(tree->left, depth - 1);
+ validate_tree(tree->right, depth - 1);
+ }
+#endif
+}
+
+static void time_construction(struct thread *t, int depth) {
+ struct gc_mutator *mut = t->mut;
+ int num_iters = compute_num_iters(depth);
+ NodeHandle temp_tree = { NULL };
+ PUSH_HANDLE(t, temp_tree);
+
+ printf("Creating %d trees of depth %d\n", num_iters, depth);
+
+ {
+ unsigned long start = current_time();
+ for (int i = 0; i < num_iters; ++i) {
+ HANDLE_SET(temp_tree, allocate_node(mut));
+ populate(t, depth, HANDLE_REF(temp_tree));
+ validate_tree(HANDLE_REF(temp_tree), depth);
+ HANDLE_SET(temp_tree, NULL);
+ }
+ printf("\tTop down construction took %.3f msec\n",
+ elapsed_millis(start));
+ }
+
+ {
+ long start = current_time();
+ for (int i = 0; i < num_iters; ++i) {
+ HANDLE_SET(temp_tree, make_tree(t, depth));
+ validate_tree(HANDLE_REF(temp_tree), depth);
+ HANDLE_SET(temp_tree, NULL);
+ }
+ printf("\tBottom up construction took %.3f msec\n",
+ elapsed_millis(start));
+ }
+
+ POP_HANDLE(t);
+}
+
+struct call_with_gc_data {
+ void* (*f)(struct thread *);
+ struct gc_heap *heap;
+};
+static void* call_with_gc_inner(struct gc_stack_addr *addr, void *arg) {
+ struct call_with_gc_data *data = arg;
+ struct gc_mutator *mut = gc_init_for_thread(addr, data->heap);
+ struct thread t = { mut, };
+ gc_mutator_set_roots(mut, &t.roots);
+ void *ret = data->f(&t);
+ gc_finish_for_thread(mut);
+ return ret;
+}
+static void* call_with_gc(void* (*f)(struct thread *),
+ struct gc_heap *heap) {
+ struct call_with_gc_data data = { f, heap };
+ return gc_call_with_stack_addr(call_with_gc_inner, &data);
+}
+
+static void* run_one_test(struct thread *t) {
+ NodeHandle long_lived_tree = { NULL };
+ NodeHandle temp_tree = { NULL };
+ DoubleArrayHandle array = { NULL };
+
+ PUSH_HANDLE(t, long_lived_tree);
+ PUSH_HANDLE(t, temp_tree);
+ PUSH_HANDLE(t, array);
+
+ // Create a long lived object
+ printf(" Creating a long-lived binary tree of depth %d\n",
+ long_lived_tree_depth);
+ HANDLE_SET(long_lived_tree, allocate_node(t->mut));
+ populate(t, long_lived_tree_depth, HANDLE_REF(long_lived_tree));
+
+ // Create long-lived array, filling half of it
+ printf(" Creating a long-lived array of %d doubles\n", array_size);
+ HANDLE_SET(array, allocate_double_array(t->mut, array_size));
+ for (int i = 0; i < array_size/2; ++i) {
+ HANDLE_REF(array)->values[i] = 1.0/i;
+ }
+
+ for (int d = min_tree_depth; d <= max_tree_depth; d += 2) {
+ time_construction(t, d);
+ }
+
+ validate_tree(HANDLE_REF(long_lived_tree), long_lived_tree_depth);
+
+ // Fake reference to LongLivedTree and array to keep them from being optimized
+ // away.
+ if (HANDLE_REF(long_lived_tree)->i != 0
+ || HANDLE_REF(array)->values[1000] != 1.0/1000)
+ fprintf(stderr, "Failed\n");
+
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+ POP_HANDLE(t);
+ return NULL;
+}
+
+static void* run_one_test_in_thread(void *arg) {
+ struct gc_heap *heap = arg;
+ return call_with_gc(run_one_test, heap);
+}
+
+struct join_data { int status; pthread_t thread; };
+static void *join_thread(void *data) {
+ struct join_data *join_data = data;
+ void *ret;
+ join_data->status = pthread_join(join_data->thread, &ret);
+ return ret;
+}
+
+int main(int argc, char *argv[]) {
+ size_t heap_max_live =
+ tree_size(long_lived_tree_depth) * sizeof(Node) +
+ tree_size(max_tree_depth) * sizeof(Node) +
+ sizeof(DoubleArray) + sizeof(double) * array_size;
+ if (argc < 3 || argc > 4) {
+ fprintf(stderr, "usage: %s MULTIPLIER NTHREADS [GC-OPTIONS]\n", argv[0]);
+ return 1;
+ }
+
+ double multiplier = atof(argv[1]);
+ size_t nthreads = atol(argv[2]);
+
+ if (!(0.1 < multiplier && multiplier < 100)) {
+ fprintf(stderr, "Failed to parse heap multiplier '%s'\n", argv[1]);
+ return 1;
+ }
+ if (nthreads < 1 || nthreads > MAX_THREAD_COUNT) {
+ fprintf(stderr, "Expected integer between 1 and %d for thread count, got '%s'\n",
+ (int)MAX_THREAD_COUNT, argv[2]);
+ return 1;
+ }
+
+ size_t heap_size = heap_max_live * multiplier * nthreads;
+
+ struct gc_options *options = gc_allocate_options();
+ gc_options_set_int(options, GC_OPTION_HEAP_SIZE_POLICY, GC_HEAP_SIZE_FIXED);
+ gc_options_set_size(options, GC_OPTION_HEAP_SIZE, heap_size);
+ if (argc == 4) {
+ if (!gc_options_parse_and_set_many(options, argv[3])) {
+ fprintf(stderr, "Failed to set GC options: '%s'\n", argv[3]);
+ return 1;
+ }
+ }
+
+ struct gc_heap *heap;
+ struct gc_mutator *mut;
+ struct gc_basic_stats stats;
+ if (!gc_init(options, NULL, &heap, &mut, GC_BASIC_STATS, &stats)) {
+ fprintf(stderr, "Failed to initialize GC with heap size %zu bytes\n",
+ heap_size);
+ return 1;
+ }
+ struct thread main_thread = { mut, };
+ gc_mutator_set_roots(mut, &main_thread.roots);
+
+ printf("Garbage Collector Test\n");
+ printf(" Live storage will peak at %zd bytes.\n\n", heap_max_live);
+
+ pthread_t threads[MAX_THREAD_COUNT];
+ // Run one of the threads in the main thread.
+ for (size_t i = 1; i < nthreads; i++) {
+ int status = pthread_create(&threads[i], NULL, run_one_test_in_thread, heap);
+ if (status) {
+ errno = status;
+ perror("Failed to create thread");
+ return 1;
+ }
+ }
+ run_one_test(&main_thread);
+ for (size_t i = 1; i < nthreads; i++) {
+ struct join_data data = { 0, threads[i] };
+ gc_call_without_gc(mut, join_thread, &data);
+ if (data.status) {
+ errno = data.status;
+ perror("Failed to join thread");
+ return 1;
+ }
+ }
+
+ gc_basic_stats_finish(&stats);
+ fputs("\n", stdout);
+ gc_basic_stats_print(&stats, stdout);
+}
diff --git a/libguile/whippet/benchmarks/quads-embedder.h b/libguile/whippet/benchmarks/quads-embedder.h
new file mode 100644
index 000000000..1d9d3f71c
--- /dev/null
+++ b/libguile/whippet/benchmarks/quads-embedder.h
@@ -0,0 +1,37 @@
+#ifndef QUADS_EMBEDDER_H
+#define QUADS_EMBEDDER_H
+
+#include <stddef.h>
+
+#include "quads-types.h"
+
+struct gc_heap;
+
+#define DEFINE_METHODS(name, Name, NAME) \
+ static inline size_t name##_size(Name *obj) GC_ALWAYS_INLINE; \
+ static inline void visit_##name##_fields(Name *obj,\
+ void (*visit)(struct gc_edge edge, \
+ struct gc_heap *heap, \
+ void *visit_data), \
+ struct gc_heap *heap, \
+ void *visit_data) GC_ALWAYS_INLINE;
+FOR_EACH_HEAP_OBJECT_KIND(DEFINE_METHODS)
+#undef DEFINE_METHODS
+
+static inline size_t quad_size(Quad *obj) {
+ return sizeof(Quad);
+}
+
+static inline void
+visit_quad_fields(Quad *quad,
+ void (*visit)(struct gc_edge edge, struct gc_heap *heap,
+ void *visit_data),
+ struct gc_heap *heap,
+ void *visit_data) {
+ for (size_t i = 0; i < 4; i++)
+ visit(gc_edge(&quad->kids[i]), heap, visit_data);
+}
+
+#include "simple-gc-embedder.h"
+
+#endif // QUADS_EMBEDDER_H
diff --git a/libguile/whippet/benchmarks/quads-types.h b/libguile/whippet/benchmarks/quads-types.h
new file mode 100644
index 000000000..935591ef2
--- /dev/null
+++ b/libguile/whippet/benchmarks/quads-types.h
@@ -0,0 +1,15 @@
+#ifndef QUADS_TYPES_H
+#define QUADS_TYPES_H
+
+#define FOR_EACH_HEAP_OBJECT_KIND(M) \
+ M(quad, Quad, QUAD)
+
+#include "heap-objects.h"
+#include "simple-tagging-scheme.h"
+
+struct Quad {
+ struct gc_header header;
+ struct Quad *kids[4];
+};
+
+#endif // QUADS_TYPES_H
diff --git a/libguile/whippet/benchmarks/quads.c b/libguile/whippet/benchmarks/quads.c
new file mode 100644
index 000000000..6fa19f452
--- /dev/null
+++ b/libguile/whippet/benchmarks/quads.c
@@ -0,0 +1,181 @@
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <sys/time.h>
+
+#include "assert.h"
+#include "gc-api.h"
+#include "gc-basic-stats.h"
+#include "simple-roots-api.h"
+#include "quads-types.h"
+#include "simple-allocator.h"
+
+typedef HANDLE_TO(Quad) QuadHandle;
+
+static Quad* allocate_quad(struct gc_mutator *mut) {
+ // memset to 0 by the collector.
+ return gc_allocate_with_kind(mut, ALLOC_KIND_QUAD, sizeof (Quad));
+}
+
+/* Get the current time in microseconds */
+static unsigned long current_time(void)
+{
+ struct timeval t;
+ if (gettimeofday(&t, NULL) == -1)
+ return 0;
+ return t.tv_sec * 1000 * 1000 + t.tv_usec;
+}
+
+struct thread {
+ struct gc_mutator *mut;
+ struct gc_mutator_roots roots;
+ size_t counter;
+};
+
+// Build tree bottom-up
+static Quad* make_tree(struct thread *t, int depth) {
+ if (depth<=0) {
+ return allocate_quad(t->mut);
+ } else {
+ QuadHandle kids[4] = { { NULL }, };
+ for (size_t i = 0; i < 4; i++) {
+ HANDLE_SET(kids[i], make_tree(t, depth-1));
+ PUSH_HANDLE(t, kids[i]);
+ }
+
+ Quad *result = allocate_quad(t->mut);
+ for (size_t i = 0; i < 4; i++)
+ result->kids[i] = HANDLE_REF(kids[i]);
+
+ for (size_t i = 0; i < 4; i++)
+ POP_HANDLE(t);
+
+ return result;
+ }
+}
+
+static void validate_tree(Quad *tree, int depth) {
+ for (size_t i = 0; i < 4; i++) {
+ if (depth == 0) {
+ if (tree->kids[i])
+ abort();
+ } else {
+ if (!tree->kids[i])
+ abort();
+ validate_tree(tree->kids[i], depth - 1);
+ }
+ }
+}
+
+static void print_elapsed(const char *what, unsigned long start) {
+ unsigned long end = current_time();
+ unsigned long msec = (end - start) / 1000;
+ unsigned long usec = (end - start) % 1000;
+ printf("Completed %s in %lu.%.3lu msec\n", what, msec, usec);
+}
+
+static size_t parse_size(char *arg, const char *what) {
+ long val = atol(arg);
+ if (val <= 0) {
+ fprintf(stderr, "Failed to parse %s '%s'\n", what, arg);
+ exit(1);
+ }
+ return val;
+}
+
+static size_t tree_size(size_t depth) {
+ size_t nquads = 0;
+ size_t leaf_count = 1;
+ for (size_t i = 0; i <= depth; i++) {
+ if (nquads > ((size_t)-1) - leaf_count) {
+ fprintf(stderr,
+ "error: address space too small for quad tree of depth %zu\n",
+ depth);
+ exit(1);
+ }
+ nquads += leaf_count;
+ leaf_count *= 4;
+ }
+ return nquads;
+}
+
+#define MAX_THREAD_COUNT 256
+
+int main(int argc, char *argv[]) {
+ if (argc < 3 || 4 < argc) {
+ fprintf(stderr, "usage: %s DEPTH MULTIPLIER [GC-OPTIONS]\n", argv[0]);
+ return 1;
+ }
+
+ size_t depth = parse_size(argv[1], "depth");
+ double multiplier = atof(argv[2]);
+
+ if (!(1.0 < multiplier && multiplier < 100)) {
+ fprintf(stderr, "Failed to parse heap multiplier '%s'\n", argv[2]);
+ return 1;
+ }
+
+ size_t nquads = tree_size(depth);
+ size_t tree_bytes = nquads * sizeof(Quad);
+ size_t heap_size = tree_bytes * multiplier;
+
+ printf("Allocating heap of %.3fGB (%.2f multiplier of live data).\n",
+ heap_size / 1e9, multiplier);
+
+ struct gc_options *options = gc_allocate_options();
+ gc_options_set_int(options, GC_OPTION_HEAP_SIZE_POLICY, GC_HEAP_SIZE_FIXED);
+ gc_options_set_size(options, GC_OPTION_HEAP_SIZE, heap_size);
+ if (argc == 4) {
+ if (!gc_options_parse_and_set_many(options, argv[3])) {
+ fprintf(stderr, "Failed to set GC options: '%s'\n", argv[3]);
+ return 1;
+ }
+ }
+
+ struct gc_heap *heap;
+ struct gc_mutator *mut;
+ struct gc_basic_stats stats;
+ if (!gc_init(options, NULL, &heap, &mut, GC_BASIC_STATS, &stats)) {
+ fprintf(stderr, "Failed to initialize GC with heap size %zu bytes\n",
+ heap_size);
+ return 1;
+ }
+ struct thread t = { mut, };
+ gc_mutator_set_roots(mut, &t.roots);
+
+ QuadHandle quad = { NULL };
+
+ PUSH_HANDLE(&t, quad);
+
+ printf("Making quad tree of depth %zu (%zu nodes). Total size %.3fGB.\n",
+ depth, nquads, (nquads * sizeof(Quad)) / 1e9);
+ unsigned long start = current_time();
+ HANDLE_SET(quad, make_tree(&t, depth));
+ print_elapsed("construction", start);
+
+ validate_tree(HANDLE_REF(quad), depth);
+
+ size_t garbage_step = heap_size / 7.5;
+ printf("Allocating %.3f GB of garbage, 20 times, validating live tree each time.\n",
+ garbage_step / 1e9);
+ unsigned long garbage_start = current_time();
+ for (size_t i = 0; i < 20; i++) {
+ size_t garbage_depth = 3;
+ start = current_time();
+ for (size_t i = garbage_step/(tree_size(garbage_depth)*4*sizeof(Quad*)); i; i--)
+ make_tree(&t, garbage_depth);
+ print_elapsed("allocating garbage", start);
+
+ start = current_time();
+ validate_tree(HANDLE_REF(quad), depth);
+ }
+ print_elapsed("allocation loop", garbage_start);
+
+ gc_basic_stats_finish(&stats);
+ fputs("\n", stdout);
+ gc_basic_stats_print(&stats, stdout);
+
+ POP_HANDLE(&t);
+ return 0;
+}
+
diff --git a/libguile/whippet/benchmarks/simple-allocator.h b/libguile/whippet/benchmarks/simple-allocator.h
new file mode 100644
index 000000000..09ed8f3be
--- /dev/null
+++ b/libguile/whippet/benchmarks/simple-allocator.h
@@ -0,0 +1,21 @@
+#ifndef SIMPLE_ALLOCATOR_H
+#define SIMPLE_ALLOCATOR_H
+
+#include "simple-tagging-scheme.h"
+#include "gc-api.h"
+
+static inline void*
+gc_allocate_with_kind(struct gc_mutator *mut, enum alloc_kind kind, size_t bytes) {
+ void *obj = gc_allocate(mut, bytes, GC_ALLOCATION_TAGGED);
+ *tag_word(gc_ref_from_heap_object(obj)) = tag_live(kind);
+ return obj;
+}
+
+static inline void*
+gc_allocate_pointerless_with_kind(struct gc_mutator *mut, enum alloc_kind kind, size_t bytes) {
+ void *obj = gc_allocate(mut, bytes, GC_ALLOCATION_TAGGED_POINTERLESS);
+ *tag_word(gc_ref_from_heap_object(obj)) = tag_live(kind);
+ return obj;
+}
+
+#endif // SIMPLE_ALLOCATOR_H
diff --git a/libguile/whippet/benchmarks/simple-gc-embedder.h b/libguile/whippet/benchmarks/simple-gc-embedder.h
new file mode 100644
index 000000000..904d2c740
--- /dev/null
+++ b/libguile/whippet/benchmarks/simple-gc-embedder.h
@@ -0,0 +1,183 @@
+#include <stdatomic.h>
+
+#include "simple-tagging-scheme.h"
+#include "simple-roots-types.h"
+#include "gc-config.h"
+#include "gc-embedder-api.h"
+
+#define GC_EMBEDDER_EPHEMERON_HEADER struct gc_header header;
+#define GC_EMBEDDER_FINALIZER_HEADER struct gc_header header;
+
+static inline size_t gc_finalizer_priority_count(void) { return 2; }
+
+static inline int
+gc_is_valid_conservative_ref_displacement(uintptr_t displacement) {
+#if GC_CONSERVATIVE_ROOTS || GC_CONSERVATIVE_TRACE
+ // Here is where you would allow tagged heap object references.
+ return displacement == 0;
+#else
+ // Shouldn't get here.
+ GC_CRASH();
+#endif
+}
+
+// No external objects in simple benchmarks.
+static inline int gc_extern_space_visit(struct gc_extern_space *space,
+ struct gc_edge edge,
+ struct gc_ref ref) {
+ GC_CRASH();
+}
+static inline void gc_extern_space_start_gc(struct gc_extern_space *space,
+ int is_minor_gc) {
+}
+static inline void gc_extern_space_finish_gc(struct gc_extern_space *space,
+ int is_minor_gc) {
+}
+
+static inline void gc_trace_object(struct gc_ref ref,
+ void (*trace_edge)(struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data),
+ struct gc_heap *heap,
+ void *trace_data,
+ size_t *size) {
+#if GC_CONSERVATIVE_TRACE
+ // Shouldn't get here.
+ GC_CRASH();
+#else
+ switch (tag_live_alloc_kind(*tag_word(ref))) {
+#define SCAN_OBJECT(name, Name, NAME) \
+ case ALLOC_KIND_##NAME: \
+ if (trace_edge) \
+ visit_##name##_fields(gc_ref_heap_object(ref), trace_edge, \
+ heap, trace_data); \
+ if (size) \
+ *size = name##_size(gc_ref_heap_object(ref)); \
+ break;
+ FOR_EACH_HEAP_OBJECT_KIND(SCAN_OBJECT)
+#undef SCAN_OBJECT
+ default:
+ GC_CRASH();
+ }
+#endif
+}
+
+static inline void visit_roots(struct handle *roots,
+ void (*trace_edge)(struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data),
+ struct gc_heap *heap,
+ void *trace_data) {
+ for (struct handle *h = roots; h; h = h->next)
+ trace_edge(gc_edge(&h->v), heap, trace_data);
+}
+
+static inline void gc_trace_mutator_roots(struct gc_mutator_roots *roots,
+ void (*trace_edge)(struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data),
+ struct gc_heap *heap,
+ void *trace_data) {
+ if (roots)
+ visit_roots(roots->roots, trace_edge, heap, trace_data);
+}
+
+static inline void gc_trace_heap_roots(struct gc_heap_roots *roots,
+ void (*trace_edge)(struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data),
+ struct gc_heap *heap,
+ void *trace_data) {
+ if (roots)
+ visit_roots(roots->roots, trace_edge, heap, trace_data);
+}
+
+static inline uintptr_t gc_object_forwarded_nonatomic(struct gc_ref ref) {
+ uintptr_t tag = *tag_word(ref);
+ return (tag & gcobj_not_forwarded_bit) ? 0 : tag;
+}
+
+static inline void gc_object_forward_nonatomic(struct gc_ref ref,
+ struct gc_ref new_ref) {
+ *tag_word(ref) = gc_ref_value(new_ref);
+}
+
+static inline struct gc_atomic_forward
+gc_atomic_forward_begin(struct gc_ref ref) {
+ uintptr_t tag = atomic_load_explicit(tag_word(ref), memory_order_acquire);
+ enum gc_forwarding_state state;
+ if (tag == gcobj_busy)
+ state = GC_FORWARDING_STATE_BUSY;
+ else if (tag & gcobj_not_forwarded_bit)
+ state = GC_FORWARDING_STATE_NOT_FORWARDED;
+ else
+ state = GC_FORWARDING_STATE_FORWARDED;
+ return (struct gc_atomic_forward){ ref, tag, state };
+}
+
+static inline int
+gc_atomic_forward_retry_busy(struct gc_atomic_forward *fwd) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_BUSY);
+ uintptr_t tag = atomic_load_explicit(tag_word(fwd->ref),
+ memory_order_acquire);
+ if (tag == gcobj_busy)
+ return 0;
+ if (tag & gcobj_not_forwarded_bit) {
+ fwd->state = GC_FORWARDING_STATE_NOT_FORWARDED;
+ fwd->data = tag;
+ } else {
+ fwd->state = GC_FORWARDING_STATE_FORWARDED;
+ fwd->data = tag;
+ }
+ return 1;
+}
+
+static inline void
+gc_atomic_forward_acquire(struct gc_atomic_forward *fwd) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_NOT_FORWARDED);
+ if (atomic_compare_exchange_strong(tag_word(fwd->ref), &fwd->data,
+ gcobj_busy))
+ fwd->state = GC_FORWARDING_STATE_ACQUIRED;
+ else if (fwd->data == gcobj_busy)
+ fwd->state = GC_FORWARDING_STATE_BUSY;
+ else {
+ GC_ASSERT((fwd->data & gcobj_not_forwarded_bit) == 0);
+ fwd->state = GC_FORWARDING_STATE_FORWARDED;
+ }
+}
+
+static inline void
+gc_atomic_forward_abort(struct gc_atomic_forward *fwd) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_ACQUIRED);
+ atomic_store_explicit(tag_word(fwd->ref), fwd->data, memory_order_release);
+ fwd->state = GC_FORWARDING_STATE_NOT_FORWARDED;
+}
+
+static inline size_t
+gc_atomic_forward_object_size(struct gc_atomic_forward *fwd) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_ACQUIRED);
+ switch (tag_live_alloc_kind(fwd->data)) {
+#define OBJECT_SIZE(name, Name, NAME) \
+ case ALLOC_KIND_##NAME: \
+ return name##_size(gc_ref_heap_object(fwd->ref));
+ FOR_EACH_HEAP_OBJECT_KIND(OBJECT_SIZE)
+#undef OBJECT_SIZE
+ default:
+ GC_CRASH();
+ }
+}
+
+static inline void
+gc_atomic_forward_commit(struct gc_atomic_forward *fwd, struct gc_ref new_ref) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_ACQUIRED);
+ *tag_word(new_ref) = fwd->data;
+ atomic_store_explicit(tag_word(fwd->ref), gc_ref_value(new_ref),
+ memory_order_release);
+ fwd->state = GC_FORWARDING_STATE_FORWARDED;
+}
+
+static inline uintptr_t
+gc_atomic_forward_address(struct gc_atomic_forward *fwd) {
+ GC_ASSERT(fwd->state == GC_FORWARDING_STATE_FORWARDED);
+ return fwd->data;
+}
diff --git a/libguile/whippet/benchmarks/simple-roots-api.h b/libguile/whippet/benchmarks/simple-roots-api.h
new file mode 100644
index 000000000..d94397adf
--- /dev/null
+++ b/libguile/whippet/benchmarks/simple-roots-api.h
@@ -0,0 +1,26 @@
+#ifndef SIMPLE_ROOTS_API_H
+#define SIMPLE_ROOTS_API_H
+
+#include "gc-config.h"
+#include "simple-roots-types.h"
+
+#define HANDLE_TO(T) union { T* v; struct handle handle; }
+#define HANDLE_LOC(h) &(h).v
+#define HANDLE_REF(h) (h).v
+#define HANDLE_SET(h,val) do { (h).v = val; } while (0)
+#define PUSH_HANDLE(cx, h) push_handle(&(cx)->roots.roots, &h.handle)
+#define POP_HANDLE(cx) pop_handle(&(cx)->roots.roots)
+
+static inline void push_handle(struct handle **roots, struct handle *handle) {
+ if (GC_PRECISE_ROOTS) {
+ handle->next = *roots;
+ *roots = handle;
+ }
+}
+
+static inline void pop_handle(struct handle **roots) {
+ if (GC_PRECISE_ROOTS)
+ *roots = (*roots)->next;
+}
+
+#endif // SIMPLE_ROOTS_API_H
diff --git a/libguile/whippet/benchmarks/simple-roots-types.h b/libguile/whippet/benchmarks/simple-roots-types.h
new file mode 100644
index 000000000..6d47fa788
--- /dev/null
+++ b/libguile/whippet/benchmarks/simple-roots-types.h
@@ -0,0 +1,17 @@
+#ifndef SIMPLE_ROOTS_TYPES_H
+#define SIMPLE_ROOTS_TYPES_H
+
+struct handle {
+ void *v;
+ struct handle *next;
+};
+
+struct gc_heap_roots {
+ struct handle *roots;
+};
+
+struct gc_mutator_roots {
+ struct handle *roots;
+};
+
+#endif // SIMPLE_ROOTS_TYPES_H
diff --git a/libguile/whippet/benchmarks/simple-tagging-scheme.h b/libguile/whippet/benchmarks/simple-tagging-scheme.h
new file mode 100644
index 000000000..b6b8a924c
--- /dev/null
+++ b/libguile/whippet/benchmarks/simple-tagging-scheme.h
@@ -0,0 +1,29 @@
+#ifndef SIMPLE_TAGGING_SCHEME_H
+#define SIMPLE_TAGGING_SCHEME_H
+
+#include <stdint.h>
+
+struct gc_header {
+ uintptr_t tag;
+};
+
+// Alloc kind is in bits 1-7, for live objects.
+static const uintptr_t gcobj_alloc_kind_mask = 0x7f;
+static const uintptr_t gcobj_alloc_kind_shift = 1;
+static const uintptr_t gcobj_forwarded_mask = 0x1;
+static const uintptr_t gcobj_not_forwarded_bit = 0x1;
+static const uintptr_t gcobj_busy = 0;
+static inline uint8_t tag_live_alloc_kind(uintptr_t tag) {
+ return (tag >> gcobj_alloc_kind_shift) & gcobj_alloc_kind_mask;
+}
+static inline uintptr_t tag_live(uint8_t alloc_kind) {
+ return ((uintptr_t)alloc_kind << gcobj_alloc_kind_shift)
+ | gcobj_not_forwarded_bit;
+}
+
+static inline uintptr_t* tag_word(struct gc_ref ref) {
+ struct gc_header *header = gc_ref_heap_object(ref);
+ return &header->tag;
+}
+
+#endif // SIMPLE_TAGGING_SCHEME_H