summaryrefslogtreecommitdiff
path: root/cbits
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2022-04-21 00:28:51 +0200
committerTom Smeding <tom@tomsmeding.com>2022-04-21 00:28:51 +0200
commite6ca9f166c5af915946bb8ae5ed7e5a42f40b8bd (patch)
treef7f6af4edca512c2a6de0aed094aec5d5d10582f /cbits
Initial
Diffstat (limited to 'cbits')
-rw-r--r--cbits/hook.c176
1 files changed, 176 insertions, 0 deletions
diff --git a/cbits/hook.c b/cbits/hook.c
new file mode 100644
index 0000000..e05ccd4
--- /dev/null
+++ b/cbits/hook.c
@@ -0,0 +1,176 @@
+#include "Rts.h"
+#include <string.h>
+
+// needs C11
+#include <threads.h>
+
+static size_t min_sz(size_t a, size_t b) {
+ return a < b ? a : b;
+}
+
+extern RtsConfig rtsConfig;
+
+// A copy of GCDetails_ with known structure that can be depended on by the Haskell code.
+struct ShadowDetails {
+ // The generation number of this GC
+ uint32_t gen;
+ // Number of threads used in this GC
+ uint32_t threads;
+ // Number of bytes allocated since the previous GC
+ uint64_t allocated_bytes;
+ // Total amount of live data in the heap (incliudes large + compact data).
+ // Updated after every GC. Data in uncollected generations (in minor GCs)
+ // are considered live.
+ uint64_t live_bytes;
+ // Total amount of live data in large objects
+ uint64_t large_objects_bytes;
+ // Total amount of live data in compact regions
+ uint64_t compact_bytes;
+ // Total amount of slop (wasted memory)
+ uint64_t slop_bytes;
+ // Total amount of memory in use by the RTS
+ uint64_t mem_in_use_bytes;
+ // Total amount of data copied during this GC
+ uint64_t copied_bytes;
+ // In parallel GC, the max amount of data copied by any one thread
+ uint64_t par_max_copied_bytes;
+ // In parallel GC, the amount of balanced data copied by all threads
+ uint64_t par_balanced_copied_bytes;
+ // The time elapsed during synchronisation before GC
+ // NOTE: nanoseconds!
+ uint64_t sync_elapsed_ns;
+ // The CPU time used during GC itself
+ // NOTE: nanoseconds!
+ uint64_t cpu_ns;
+ // The time elapsed during GC itself
+ // NOTE: nanoseconds!
+ uint64_t elapsed_ns;
+
+ // Concurrent garbage collector
+
+ // The CPU time used during the post-mark pause phase of the concurrent
+ // nonmoving GC.
+ // NOTE: nanoseconds!
+ uint64_t nonmoving_gc_sync_cpu_ns;
+ // The time elapsed during the post-mark pause phase of the concurrent
+ // nonmoving GC.
+ // NOTE: nanoseconds!
+ uint64_t nonmoving_gc_sync_elapsed_ns;
+ // The CPU time used during the post-mark pause phase of the concurrent
+ // nonmoving GC.
+ // NOTE: nanoseconds!
+ uint64_t nonmoving_gc_cpu_ns;
+ // The time elapsed during the post-mark pause phase of the concurrent
+ // nonmoving GC.
+ // NOTE: nanoseconds!
+ uint64_t nonmoving_gc_elapsed_ns;
+};
+
+static void shadow_copy(struct ShadowDetails *dst, const struct GCDetails_ *src) {
+#define COPY(field) dst->field = src->field;
+#define COPYTIME(field) dst->field = TimeToNS(src->field);
+ COPY(gen);
+ COPY(threads);
+ COPY(allocated_bytes);
+ COPY(live_bytes);
+ COPY(large_objects_bytes);
+ COPY(compact_bytes);
+ COPY(slop_bytes);
+ COPY(mem_in_use_bytes);
+ COPY(copied_bytes);
+ COPY(par_max_copied_bytes);
+ COPY(par_balanced_copied_bytes);
+ COPYTIME(sync_elapsed_ns);
+ COPYTIME(cpu_ns);
+ COPYTIME(elapsed_ns);
+
+ COPYTIME(nonmoving_gc_sync_cpu_ns);
+ COPYTIME(nonmoving_gc_sync_elapsed_ns);
+ COPYTIME(nonmoving_gc_cpu_ns);
+ COPYTIME(nonmoving_gc_elapsed_ns);
+#undef COPY
+#undef COPYTIME
+}
+
+// --------
+// GLOBAL VARIABLES
+// --------
+
+static void (*old_hook)(const struct GCDetails_ *details) = NULL;
+static mtx_t detlog_mutex;
+static size_t detlog_capacity = 0, detlog_length = 0;
+static struct ShadowDetails *detlog = NULL;
+
+// --------
+// END OF GLOBAL VARIABLES
+// --------
+
+static void hook_callback(const struct GCDetails_ *details) {
+ static bool alloc_failed = false;
+
+ if (alloc_failed) goto cleanup_no_mutex;
+
+ if (mtx_lock(&detlog_mutex) != thrd_success) {
+ fprintf(stderr, "ghc-gc-hook: ERROR: Mutex lock failed\n");
+ alloc_failed = true; // dumb proxy for "don't do anything anymore please"
+ goto cleanup_no_mutex;
+ }
+
+ // mutex is locked from here
+
+ if (detlog_length == detlog_capacity) {
+ detlog_capacity = detlog_capacity == 0 ? 128 : 2 * detlog_capacity;
+ detlog = realloc(detlog, detlog_capacity * sizeof(detlog[0]));
+ if (detlog == NULL || detlog_capacity == 0) { // also check for overflow here
+ fprintf(stderr, "ghc-gc-hook: ERROR: Could not allocate memory for GC log hook\n");
+ alloc_failed = true;
+ goto cleanup;
+ }
+ }
+
+ shadow_copy(&detlog[detlog_length], details);
+ detlog_length++;
+
+cleanup:
+ mtx_unlock(&detlog_mutex); // ignore return value
+
+cleanup_no_mutex:
+ if (old_hook) old_hook(details);
+}
+
+// --------
+// EXPORTED FUNCTIONS
+// --------
+
+void copy_log_to_buffer(size_t space_available, char *buffer, size_t *unit_size, size_t *num_stored) {
+ if (mtx_lock(&detlog_mutex) != thrd_success) {
+ fprintf(stderr, "ghc-gc-hook: ERROR: Mutex lock failed\n");
+ *unit_size = 0;
+ *num_stored = 0;
+ return;
+ }
+
+ const size_t sz = sizeof(detlog[0]);
+ const size_t n = min_sz(space_available / sz, detlog_length);
+
+ // First copy over the fitting items
+ memcpy(buffer, detlog, n * sz);
+ *unit_size = sz;
+ *num_stored = n;
+
+ // Then shift back the remaining items
+ memmove(detlog, detlog + n, (detlog_length - n) * sizeof(detlog[0]));
+ detlog_length -= n;
+
+ mtx_unlock(&detlog_mutex);
+}
+
+void set_gchook() {
+ if (mtx_init(&detlog_mutex, mtx_plain) != thrd_success) {
+ fprintf(stderr, "ghc-gc-hook: ERROR: Mutex initialisation failed\n");
+ return;
+ }
+
+ old_hook = rtsConfig.gcDoneHook;
+ rtsConfig.gcDoneHook = hook_callback;
+}