Remove 50ms delay at exit for programs using threads

$ cat /tmp/b.ml
let () = Thread.join (Thread.create ignore ())
let () = for _ = 0 to 100000; do () done
$ ocamlopt -I +threads unix.cmxa threads.cmxa /tmp/b.ml -o b
$ time ./b # before this commit

real	0m0.053s
user	0m0.000s
sys	0m0.000s
$ time ./b # after this commit

real	0m0.003s
user	0m0.000s
sys	0m0.000s

5 files changed, 31 insertions, 23 deletions

diff --git a/Changes b/Changes
index fc61b9226e..d10e567c31 100644
--- a/Changes
+++ b/Changes
@@ -396,6 +396,9 @@ Working version
 - GPR#1073: Remove statically allocated compare stack.
   (Stephen Dolan)
 
+- GPR#1269: Remove 50ms delay at exit for programs using threads
+  (Valentin Gatien-Baron, review by Stephen Dolan)
+
 * MPR#7594, GPR#1274: String_val now returns 'const char*', not
   'char*' when -safe-string is enabled at configure time.
   New macro Bytes_val for accessing bytes values.
diff --git a/byterun/startup_aux.c b/byterun/startup_aux.c
index 7cf6c6dac2..957ead867f 100644
--- a/byterun/startup_aux.c
+++ b/byterun/startup_aux.c
@@ -138,11 +138,11 @@ int caml_startup_aux(int pooling)
   return 1;
 }
 
-static void do_at_exit()
+static void call_registered_value(char* name)
 {
-  value *at_exit = caml_named_value("Pervasives.do_at_exit");
-  if (at_exit != NULL)
-    caml_callback_exn(*at_exit, Val_unit);
+  value *f = caml_named_value(name);
+  if (f != NULL)
+    caml_callback_exn(*f, Val_unit);
 }
 
 CAMLexport void caml_shutdown(void)
@@ -156,7 +156,8 @@ CAMLexport void caml_shutdown(void)
   if (startup_count > 0)
     return;
 
-  do_at_exit();
+  call_registered_value("Pervasives.do_at_exit");
+  call_registered_value("Thread.at_shutdown");
   caml_finalise_heap();
 #ifndef NATIVE_CODE
   caml_free_shared_libs();
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
index df3c7e7cf5..f7816860e7 100644
--- a/otherlibs/systhreads/st_stubs.c
+++ b/otherlibs/systhreads/st_stubs.c
@@ -505,7 +505,9 @@ CAMLprim value caml_thread_initialize(value unit)   /* ML */
   return Val_unit;
 }
 
-/* Cleanup the thread machinery on program exit or DLL unload. */
+/* Cleanup the thread machinery when the runtime is shut down. Joining the tick
+   thread take 25ms on average / 50ms in the worst case, so we don't do it on
+   program exit. */
 
 CAMLprim value caml_thread_cleanup(value unit)   /* ML */
 {
diff --git a/otherlibs/systhreads/thread.ml b/otherlibs/systhreads/thread.ml
index c55ff3fe99..ec05f39504 100644
--- a/otherlibs/systhreads/thread.ml
+++ b/otherlibs/systhreads/thread.ml
@@ -57,18 +57,17 @@ let preempt_signal =
   | "Win32" -> Sys.sigterm
   | _       -> Sys.sigvtalrm
 
-let _ =
+let () =
   Sys.set_signal preempt_signal (Sys.Signal_handle preempt);
-  thread_initialize();
-  at_exit
-    (fun () ->
-        thread_cleanup();
-        (* In case of DLL-embedded OCaml the preempt_signal handler
-           will point to nowhere after DLL unloading and an accidental
-           preempt_signal will crash the main program. So restore the
-           default handler. *)
-        Sys.set_signal preempt_signal Sys.Signal_default
-    )
+  thread_initialize ();
+  Callback.register "Thread.at_shutdown" (fun () ->
+    thread_cleanup();
+    (* In case of DLL-embedded OCaml the preempt_signal handler
+       will point to nowhere after DLL unloading and an accidental
+       preempt_signal will crash the main program. So restore the
+       default handler. *)
+    Sys.set_signal preempt_signal Sys.Signal_default
+  )
 
 (* Wait functions *)
 
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index f6a6f1153e..b9e52401a7 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -1200,12 +1200,15 @@ val exit : int -> 'a
    terminates early because of an uncaught exception. *)
 
 val at_exit : (unit -> unit) -> unit
-(** Register the given function to be called at program
-   termination time. The functions registered with [at_exit]
-   will be called when the program executes {!Pervasives.exit},
-   or terminates, either normally or because of an uncaught exception.
-   The functions are called in 'last in, first out' order:
-   the function most recently added with [at_exit] is called first. *)
+(** Register the given function to be called at program termination
+   time. The functions registered with [at_exit] will be called when
+   the program does any of the following:
+   - executes {!Pervasives.exit}
+   - terminates, either normally or because of an uncaught
+     exception
+   - executes the C function [caml_shutdown].
+   The functions are called in 'last in, first out' order: the
+   function most recently added with [at_exit] is called first. *)
 
 (**/**)