Cherry-pick of ocaml/ocaml 1eeb0e7fe595f5f9e1ea1edbdf785ff3b49feeeb (ocaml-flambda#12)

Author: poechsel

otherlibs/systhreads/st_stubs.c

@@ -133,6 +133,7 @@ static st_retcode caml_threadstatus_wait (value);
 #ifdef NATIVE_CODE
 extern struct longjmp_buffer caml_termination_jmpbuf;
 extern void (*caml_termination_hook)(void);
+extern int caml_stop_stack_overflow_detection(void);
 #endif
 
 /* Hook for scanning the stacks of the other threads */
@@ -543,6 +544,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
     caml_thread_stop();
 #ifdef NATIVE_CODE
   }
+  caml_stop_stack_overflow_detection();
 #endif
   /* The thread now stops running */
   return 0;

runtime/fail_nat.c

@@ -32,6 +32,8 @@
 #include "caml/roots.h"
 #include "caml/callback.h"
 
+extern void caml_terminate_signals(void);
+
 /* The globals holding predefined exceptions */
 
 typedef value caml_generated_constant[1];
@@ -70,7 +72,10 @@ void caml_raise(value v)
   if (Is_exception_result(v))
     v = Extract_exception(v);
 
-  if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
+  if (Caml_state->exception_pointer == NULL) {
+    caml_terminate_signals();
+    caml_fatal_uncaught_exception(v);
+  }
 
   while (Caml_state->local_roots != NULL &&
          (char *) Caml_state->local_roots < Caml_state->exception_pointer) {

runtime/signals_nat.c

@@ -174,8 +174,6 @@ DECLARE_SIGNAL_HANDLER(trap_handler)
 #error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined"
 #endif
 
-static char sig_alt_stack[SIGSTKSZ];
-
 /* Code compiled with ocamlopt never accesses more than
    EXTRA_STACK bytes below the stack pointer. */
 #define EXTRA_STACK 256
@@ -245,6 +243,10 @@ DECLARE_SIGNAL_HANDLER(segv_handler)
 
 /* Initialization of signal stuff */
 
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+static int setup_stack_overflow_detection(void);
+#endif
+
 void caml_init_signals(void)
 {
   /* Bound-check trap handling */
@@ -269,28 +271,91 @@ void caml_init_signals(void)
 #endif
 
 #ifdef HAS_STACK_OVERFLOW_DETECTION
-  {
-    stack_t stk;
+  if (setup_stack_overflow_detection() != -1) {
     struct sigaction act;
-    stk.ss_sp = sig_alt_stack;
-    stk.ss_size = SIGSTKSZ;
-    stk.ss_flags = 0;
     SET_SIGACT(act, segv_handler);
     act.sa_flags |= SA_ONSTACK | SA_NODEFER;
     sigemptyset(&act.sa_mask);
-    if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
+    sigaction(SIGSEGV, &act, NULL);
   }
 #endif
 }
 
-CAMLexport void caml_setup_stack_overflow_detection(void)
+/* Termination of signal stuff */
+
+#if defined(TARGET_power) || defined(TARGET_s390x) \
+    || defined(HAS_STACK_OVERFLOW_DETECTION)
+static void set_signal_default(int signum)
 {
+  struct sigaction act;
+  sigemptyset(&act.sa_mask);
+  act.sa_handler = SIG_DFL;
+  act.sa_flags = 0;
+  sigaction(signum, &act, NULL);
+}
+#endif
+
+int caml_stop_stack_overflow_detection(void);
+
+void caml_terminate_signals(void)
+{
+#if defined(TARGET_power)
+  set_signal_default(SIGTRAP);
+#endif
+
+#if defined(TARGET_s390x)
+  set_signal_default(SIGFPE);
+#endif
+
 #ifdef HAS_STACK_OVERFLOW_DETECTION
+  set_signal_default(SIGSEGV);
+  caml_stop_stack_overflow_detection();
+#endif
+}
+
+/* Allocate and select an alternate stack for handling signals,
+   especially SIGSEGV signals.
+   Each thread needs its own alternate stack.
+   The alternate stack used to be statically-allocated for the main thread,
+   but this is incompatible with Glibc 2.34 and newer, where SIGSTKSZ
+   may not be a compile-time constant (issue #10250). */
+
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+static int setup_stack_overflow_detection(void)
+{
   stack_t stk;
   stk.ss_sp = malloc(SIGSTKSZ);
+  if (stk.ss_sp == NULL) return -1;
   stk.ss_size = SIGSTKSZ;
   stk.ss_flags = 0;
-  if (stk.ss_sp)
-    sigaltstack(&stk, NULL);
+  if (sigaltstack(&stk, NULL) == -1) {
+    free(stk.ss_sp);
+    return -1;
+  }
+  /* Success (or stack overflow detection not available) */
+  return 0;
+}
+#endif
+
+CAMLexport void caml_setup_stack_overflow_detection(void)
+{
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+  setup_stack_overflow_detection();
+#endif
+}
+
+CAMLexport int caml_stop_stack_overflow_detection(void)
+{
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+  stack_t oldstk, stk;
+  stk.ss_flags = SS_DISABLE;
+  if (sigaltstack(&stk, &oldstk) == -1) return -1;
+  /* If caml_setup_stack_overflow_detection failed, we are not using
+     an alternate signal stack.  SS_DISABLE will be set in oldstk,
+     and there is nothing to free in this case. */
+  if (! (oldstk.ss_flags & SS_DISABLE)) free(oldstk.ss_sp);
+  return 0;
+#else
+  return 0;
 #endif
 }

runtime/startup_nat.c

@@ -92,6 +92,7 @@ void (*caml_termination_hook)(void *) = NULL;
 
 extern value caml_start_program (caml_domain_state*);
 extern void caml_init_signals (void);
+extern void caml_terminate_signals(void);
 #ifdef _WIN32
 extern void caml_win32_overflow_detection (void);
 #endif
@@ -106,6 +107,7 @@ extern void caml_install_invalid_parameter_handler();
 value caml_startup_common(char_os **argv, int pooling)
 {
   char_os * exe_name, * proc_self_exe;
+  value res;
   char tos;
 
   /* Initialize the domain */
@@ -152,10 +154,13 @@ value caml_startup_common(char_os **argv, int pooling)
     exe_name = caml_search_exe_in_path(exe_name);
   caml_sys_init(exe_name, argv);
   if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
+    caml_terminate_signals();
     if (caml_termination_hook != NULL) caml_termination_hook(NULL);
     return Val_unit;
   }
-  return caml_start_program(Caml_state);
+  res = caml_start_program(Caml_state);
+  caml_terminate_signals();
+  return res;
 }
 
 value caml_startup_exn(char_os **argv)

runtime/sys.c

@@ -112,6 +112,8 @@ static void caml_sys_check_path(value name)
   }
 }
 
+extern void caml_terminate_signals(void);
+
 CAMLprim value caml_sys_exit(value retcode_v)
 {
   int retcode = Int_val(retcode_v);
@@ -159,6 +161,9 @@ CAMLprim value caml_sys_exit(value retcode_v)
     caml_shutdown();
 #ifdef _WIN32
   caml_restore_win32_terminal();
+#endif
+#ifdef NATIVE_CODE
+  caml_terminate_signals();
 #endif
   exit(retcode);
 }