Skip to content

Commit 2c85e04

Browse files
jhjourdanjhjourdan
committed
Merge pull request #9674 from jhjourdan/memprof_thread_alloc_callback_2
Memprof: provide the guarantee that an allocation callback is always run in the same thread the allocation takes place. Attempt II. (cherry picked from commit 0cb298f)
1 parent e3f69df commit 2c85e04

17 files changed

Lines changed: 693 additions & 482 deletions

‎Changes‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -155,6 +155,10 @@ OCaml 4.12.0
155155
(Enguerrand Decorne, KC Sivaramakrishnan, Xavier Leroy, Stephen Dolan,
156156
David Allsopp, Nicolás Ojeda Bär review by Xavier Leroy, Nicolás Ojeda Bär)
157157

158+
* #9674: Memprof: guarantee that an allocation callback is always run
159+
in the same thread the allocation takes place
160+
(Jacques-Henri Jourdan, review by Stephen Dolan)
161+
158162
### Code generation and optimizations:
159163

160164
- #9551: ocamlc no longer loads DLLs at link time to check that

‎otherlibs/systhreads/st_stubs.c‎

Lines changed: 23 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,7 @@ struct caml_thread_struct {
9393
int backtrace_pos; /* Saved Caml_state->backtrace_pos */
9494
backtrace_slot * backtrace_buffer; /* Saved Caml_state->backtrace_buffer */
9595
value backtrace_last_exn; /* Saved Caml_state->backtrace_last_exn (root) */
96-
struct caml_memprof_th_ctx memprof_ctx;
96+
struct caml_memprof_th_ctx *memprof_ctx;
9797
};
9898

9999
typedef struct caml_thread_struct * caml_thread_t;
@@ -152,9 +152,7 @@ static void (*prev_scan_roots_hook) (scanning_action);
152152

153153
static void caml_thread_scan_roots(scanning_action action)
154154
{
155-
caml_thread_t th;
156-
157-
th = curr_thread;
155+
caml_thread_t th = curr_thread;
158156
do {
159157
(*action)(th->descr, &th->descr);
160158
(*action)(th->backtrace_last_exn, &th->backtrace_last_exn);
@@ -174,6 +172,17 @@ static void caml_thread_scan_roots(scanning_action action)
174172
if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
175173
}
176174

175+
/* Hook for iterating over Memprof's entries arrays */
176+
177+
static void memprof_ctx_iter(th_ctx_action f, void* data)
178+
{
179+
caml_thread_t th = curr_thread;
180+
do {
181+
f(th->memprof_ctx, data);
182+
th = th->next;
183+
} while (th != curr_thread);
184+
}
185+
177186
/* Saving and restoring runtime state in curr_thread */
178187

179188
Caml_inline void caml_thread_save_runtime_state(void)
@@ -196,7 +205,7 @@ Caml_inline void caml_thread_save_runtime_state(void)
196205
curr_thread->backtrace_pos = Caml_state->backtrace_pos;
197206
curr_thread->backtrace_buffer = Caml_state->backtrace_buffer;
198207
curr_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
199-
caml_memprof_save_th_ctx(&curr_thread->memprof_ctx);
208+
caml_memprof_leave_thread();
200209
}
201210

202211
Caml_inline void caml_thread_restore_runtime_state(void)
@@ -219,7 +228,7 @@ Caml_inline void caml_thread_restore_runtime_state(void)
219228
Caml_state->backtrace_pos = curr_thread->backtrace_pos;
220229
Caml_state->backtrace_buffer = curr_thread->backtrace_buffer;
221230
Caml_state->backtrace_last_exn = curr_thread->backtrace_last_exn;
222-
caml_memprof_restore_th_ctx(&curr_thread->memprof_ctx);
231+
caml_memprof_enter_thread(curr_thread->memprof_ctx);
223232
}
224233

225234
/* Hooks for caml_enter_blocking_section and caml_leave_blocking_section */
@@ -349,7 +358,7 @@ static caml_thread_t caml_thread_new_info(void)
349358
th->backtrace_pos = 0;
350359
th->backtrace_buffer = NULL;
351360
th->backtrace_last_exn = Val_unit;
352-
caml_memprof_init_th_ctx(&th->memprof_ctx);
361+
th->memprof_ctx = caml_memprof_new_th_ctx();
353362
return th;
354363
}
355364

@@ -394,20 +403,15 @@ static void caml_thread_remove_info(caml_thread_t th)
394403

395404
static void caml_thread_reinitialize(void)
396405
{
397-
caml_thread_t thr, next;
398406
struct channel * chan;
399407

400408
/* Remove all other threads (now nonexistent)
401409
from the doubly-linked list of threads */
402-
thr = curr_thread->next;
403-
while (thr != curr_thread) {
404-
next = thr->next;
405-
caml_stat_free(thr);
406-
thr = next;
410+
while (curr_thread->next != curr_thread) {
411+
caml_memprof_delete_th_ctx(curr_thread->next->memprof_ctx);
412+
caml_thread_remove_info(curr_thread->next);
407413
}
408-
curr_thread->next = curr_thread;
409-
curr_thread->prev = curr_thread;
410-
all_threads = curr_thread;
414+
411415
/* Reinitialize the master lock machinery,
412416
just in case the fork happened while other threads were doing
413417
caml_leave_blocking_section */
@@ -450,6 +454,7 @@ CAMLprim value caml_thread_initialize(value unit) /* ML */
450454
#ifdef NATIVE_CODE
451455
curr_thread->exit_buf = &caml_termination_jmpbuf;
452456
#endif
457+
curr_thread->memprof_ctx = &caml_memprof_main_ctx;
453458
/* The stack-related fields will be filled in at the next
454459
caml_enter_blocking_section */
455460
/* Associate the thread descriptor with the thread */
@@ -468,6 +473,7 @@ CAMLprim value caml_thread_initialize(value unit) /* ML */
468473
caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
469474
prev_stack_usage_hook = caml_stack_usage_hook;
470475
caml_stack_usage_hook = caml_thread_stack_usage;
476+
caml_memprof_th_ctx_iter_hook = memprof_ctx_iter;
471477
/* Set up fork() to reinitialize the thread machinery in the child
472478
(PR#4577) */
473479
st_atfork(caml_thread_reinitialize);
@@ -499,7 +505,7 @@ static void caml_thread_stop(void)
499505
below uses accurate information. */
500506
caml_thread_save_runtime_state();
501507
/* Tell memprof that this thread is terminating. */
502-
caml_memprof_stop_th_ctx(&curr_thread->memprof_ctx);
508+
caml_memprof_delete_th_ctx(curr_thread->memprof_ctx);
503509
/* Signal that the thread has terminated */
504510
caml_threadstatus_terminate(Terminated(curr_thread->descr));
505511
/* Remove th from the doubly-linked list of threads and free its info block */

‎otherlibs/systhreads/thread.ml‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,20 +27,27 @@ external yield : unit -> unit = "caml_thread_yield"
2727
external self : unit -> t = "caml_thread_self" [@@noalloc]
2828
external id : t -> int = "caml_thread_id" [@@noalloc]
2929
external join : t -> unit = "caml_thread_join"
30-
external exit : unit -> unit = "caml_thread_exit"
30+
external exit_stub : unit -> unit = "caml_thread_exit"
3131

3232
(* For new, make sure the function passed to thread_new never
3333
raises an exception. *)
3434

35+
let[@inline never] check_memprof_cb () = ref ()
36+
3537
let create fn arg =
3638
thread_new
3739
(fun () ->
3840
try
39-
fn arg; ()
41+
fn arg;
42+
ignore (Sys.opaque_identity (check_memprof_cb ()))
4043
with exn ->
4144
flush stdout; flush stderr;
4245
thread_uncaught_exception exn)
4346

47+
let exit () =
48+
ignore (Sys.opaque_identity (check_memprof_cb ()));
49+
exit_stub ()
50+
4451
(* Thread.kill is currently not implemented due to problems with
4552
cleanup handlers on several platforms *)
4653

‎runtime/caml/memprof.h‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -40,13 +40,15 @@ extern void caml_memprof_do_roots(scanning_action f);
4040
extern void caml_memprof_update_clean_phase(void);
4141
extern void caml_memprof_invert_tracked(void);
4242

43-
struct caml_memprof_th_ctx {
44-
int suspended, callback_running;
45-
};
46-
CAMLextern void caml_memprof_init_th_ctx(struct caml_memprof_th_ctx*);
47-
CAMLextern void caml_memprof_stop_th_ctx(struct caml_memprof_th_ctx*);
48-
CAMLextern void caml_memprof_save_th_ctx(struct caml_memprof_th_ctx*);
49-
CAMLextern void caml_memprof_restore_th_ctx(const struct caml_memprof_th_ctx*);
43+
CAMLextern struct caml_memprof_th_ctx caml_memprof_main_ctx;
44+
45+
CAMLextern struct caml_memprof_th_ctx* caml_memprof_new_th_ctx(void);
46+
CAMLextern void caml_memprof_leave_thread(void);
47+
CAMLextern void caml_memprof_enter_thread(struct caml_memprof_th_ctx*);
48+
CAMLextern void caml_memprof_delete_th_ctx(struct caml_memprof_th_ctx*);
49+
50+
typedef void (*th_ctx_action)(struct caml_memprof_th_ctx*, void*);
51+
extern void (*caml_memprof_th_ctx_iter_hook)(th_ctx_action, void*);
5052

5153
#endif
5254

0 commit comments

Comments
 (0)