1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
#include "Rts.h"
#include <string.h>
#include <time.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 {
int64_t timestamp_sec;
int64_t timestamp_nsec;
// 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 fatal_failure = false;
if (fatal_failure) goto cleanup_no_mutex;
// Do this now already, before waiting on the mutex
struct timespec now;
if (clock_gettime(CLOCK_MONOTONIC, &now) != 0) {
perror("clock_gettime");
fatal_failure = true;
goto cleanup_no_mutex;
}
if (mtx_lock(&detlog_mutex) != thrd_success) {
fprintf(stderr, "ghc-gc-hook: ERROR: Mutex lock failed\n");
fatal_failure = true;
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");
fatal_failure = true;
goto cleanup;
}
}
struct ShadowDetails *dst = &detlog[detlog_length];
dst->timestamp_sec = now.tv_sec;
dst->timestamp_nsec = now.tv_nsec;
shadow_copy(dst, 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;
}
|
