Merge pull request ocaml-multicore/ocaml-multicore#630 from sadiqj/si…

…gnals_multicore Make signals safe for multicore
sadiqj · Sep 6, 2021 · 8e3d529 · 8e3d529
2 parents a516ea5 + 1376415
commit 8e3d529
Show file tree

Hide file tree

Showing 11 changed files with 254 additions and 164 deletions.
diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h
@@ -41,10 +41,6 @@ void caml_handle_gc_interrupt(void);
 
 void caml_handle_incoming_interrupts(void);
 
-void caml_request_major_slice (void);
-
-void caml_request_minor_gc (void);
-
 void caml_interrupt_self(void);
 
 void caml_print_stats(void);
@@ -57,12 +53,6 @@ CAMLexport void caml_bt_exit_ocaml(void);
 CAMLexport void caml_acquire_domain_lock(void);
 CAMLexport void caml_release_domain_lock(void);
 
-CAMLextern void caml_enter_blocking_section(void);
-CAMLextern void caml_leave_blocking_section(void);
-
-CAMLextern void (*caml_enter_blocking_section_hook)(void);
-CAMLextern void (*caml_leave_blocking_section_hook)(void);
-
 CAMLextern void (*caml_atfork_hook)(void);
 
 CAMLextern void (*caml_domain_start_hook)(void);

diff --git a/runtime/caml/platform.h b/runtime/caml/platform.h
@@ -7,6 +7,7 @@
 #include <string.h>
 #include "config.h"
 #include "mlvalues.h"
+#include "signals.h"
 
 #if defined(MAP_ANON) && !defined(MAP_ANONYMOUS)
 #define MAP_ANONYMOUS MAP_ANON

diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h
@@ -16,6 +16,10 @@
 #ifndef CAML_SIGNALS_H
 #define CAML_SIGNALS_H
 
+#if defined(CAML_INTERNALS) && defined(POSIX_SIGNALS)
+#include<signal.h>
+#endif
+
 #ifndef CAML_NAME_SPACE
 #include "compatibility.h"
 #endif
@@ -26,31 +30,37 @@
 extern "C" {
 #endif
 
-#ifdef CAML_INTERNALS
-CAMLextern intnat volatile caml_signals_are_pending;
-CAMLextern intnat volatile caml_pending_signals[];
-CAMLextern int volatile caml_something_to_do;
-int caml_init_signal_stack(void);
-void caml_free_signal_stack(void);
-void caml_init_signal_handling(void);
-/* </private> */
-
 CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_enter_blocking_section_no_pending (void);
 CAMLextern void caml_leave_blocking_section (void);
 
+#ifdef CAML_INTERNALS
+CAMLextern atomic_intnat caml_pending_signals[];
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_requested_major_slice (Caml_state_field(requested_major_slice))
+#define caml_requested_minor_gc (Caml_state_field(requested_minor_gc))
+
+void caml_update_young_limit(void);
+void caml_request_major_slice (void);
+void caml_request_minor_gc (void);
 CAMLextern int caml_convert_signal_number (int);
 CAMLextern int caml_rev_convert_signal_number (int);
+value caml_execute_signal_exn(int signal_number, int in_signal_handler);
 CAMLextern void caml_record_signal(int signal_number);
-CAMLextern void caml_process_pending_signals(void);
+CAMLextern value caml_process_pending_signals_exn(void);
+void caml_set_action_pending (void);
 int caml_set_signal_action(int signo, int action);
 
+CAMLextern value caml_process_pending_signals_with_root_exn (value extra_root);
+void caml_init_signal_handling(void);
+int caml_init_signal_stack(void);
+void caml_free_signal_stack(void);
 
-CAMLextern void (* volatile caml_async_action_hook)(void);
+CAMLextern void (*caml_enter_blocking_section_hook)(void);
+CAMLextern void (*caml_leave_blocking_section_hook)(void);
 #endif /* CAML_INTERNALS */
 
-CAMLextern void caml_enter_blocking_section (void);
-CAMLextern void caml_leave_blocking_section (void);
-
 #ifdef __cplusplus
 }
 #endif

diff --git a/runtime/domain.c b/runtime/domain.c
@@ -995,22 +995,6 @@ void caml_interrupt_self() {
   interrupt_domain(&domain_self->interruptor);
 }
 
-/* Arrange for a major GC slice to be performed on the current domain
-   as soon as possible */
-void caml_request_major_slice (void)
-{
-  Caml_state->requested_major_slice = 1;
-  caml_interrupt_self();
-}
-
-/* Arrange for a minor GC to be performed on the current domain
-   as soon as possible */
-void caml_request_minor_gc (void)
-{
-  Caml_state->requested_minor_gc = 1;
-  caml_interrupt_self();
-}
-
 static void caml_poll_gc_work()
 {
   CAMLalloc_point_here;
@@ -1117,34 +1101,6 @@ CAMLexport void caml_bt_exit_ocaml(void)
   }
 }
 
-static void caml_enter_blocking_section_default(void)
-{
-  caml_bt_exit_ocaml();
-  caml_release_domain_lock();
-}
-
-static void caml_leave_blocking_section_default(void)
-{
-  caml_bt_enter_ocaml();
-  caml_acquire_domain_lock();
-}
-
-CAMLexport void (*caml_enter_blocking_section_hook)(void) =
-   caml_enter_blocking_section_default;
-CAMLexport void (*caml_leave_blocking_section_hook)(void) =
-   caml_leave_blocking_section_default;
-
-CAMLexport void caml_leave_blocking_section() {
-  caml_leave_blocking_section_hook();
-  caml_process_pending_signals();
-}
-
-CAMLexport void caml_enter_blocking_section() {
-
-  caml_process_pending_signals();
-  caml_enter_blocking_section_hook();
-}
-
 /* default handler for unix_fork, will be called by unix_fork. */
 static void caml_atfork_default(void) {
   caml_reset_domain_lock();

diff --git a/runtime/interp.c b/runtime/interp.c
@@ -1012,6 +1012,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
     process_signal:
       Setup_for_event;
       caml_handle_gc_interrupt();
+      caml_raise_if_exception(caml_process_pending_signals_exn());
       Restore_after_event;
       Next;
 

diff --git a/runtime/major_gc.c b/runtime/major_gc.c
@@ -30,6 +30,7 @@
 #include "caml/mlvalues.h"
 #include "caml/platform.h"
 #include "caml/roots.h"
+#include "caml/signals.h"
 #include "caml/shared_heap.h"
 #include "caml/startup_aux.h"
 #include "caml/weak.h"

diff --git a/runtime/memory.c b/runtime/memory.c
@@ -25,6 +25,7 @@
 #include "caml/fail.h"
 #include "caml/memory.h"
 #include "caml/major_gc.h"
+#include "caml/signals.h"
 #include "caml/shared_heap.h"
 #include "caml/domain.h"
 #include "caml/roots.h"