diff options
Diffstat (limited to 'cbits')
| -rw-r--r-- | cbits/hook.c | 176 |
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; +} |