l4/pkg/ocaml/contrib/byterun/signals.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: signals.c 7904 2007-02-23 09:29:45Z xleroy $ */
  15
  16 /* Signal handling, code common to the bytecode and native systems */
  17
  18 #include <signal.h>
  19 #include "alloc.h"
  20 #include "callback.h"
  21 #include "config.h"
  22 #include "fail.h"
  23 #include "memory.h"
  24 #include "misc.h"
  25 #include "mlvalues.h"
  26 #include "roots.h"
  27 #include "signals.h"
  28 #include "signals_machdep.h"
  29 #include "sys.h"
  30
  31 #ifndef NSIG
  32 #define NSIG 64
  33 #endif
  34
  35 /* The set of pending signals (received but not yet processed) */
  36
  37 CAMLexport intnat volatile caml_signals_are_pending = 0;
  38 CAMLexport intnat volatile caml_pending_signals[NSIG];
  39
  40 /* Execute all pending signals */
  41
  42 void caml_process_pending_signals(void)
  43 {
  44   int i;
  45
  46   if (caml_signals_are_pending) {
  47     caml_signals_are_pending = 0;
  48     for (i = 0; i < NSIG; i++) {
  49       if (caml_pending_signals[i]) {
  50         caml_pending_signals[i] = 0;
  51         caml_execute_signal(i, 0);
  52       }
  53     }
  54   }
  55 }
  56
  57 /* Record the delivery of a signal, and arrange for it to be processed
  58    as soon as possible:
  59    - in bytecode: via caml_something_to_do, processed in caml_process_event
  60    - in native-code: by playing with the allocation limit, processed
  61        in caml_garbage_collection
  62 */
  63
  64 void caml_record_signal(int signal_number)
  65 {
  66   caml_pending_signals[signal_number] = 1;
  67   caml_signals_are_pending = 1;
  68 #ifndef NATIVE_CODE
  69   caml_something_to_do = 1;
  70 #else
  71   caml_young_limit = caml_young_end;
  72 #endif
  73 }
  74
  75 /* Management of blocking sections. */
  76
  77 static intnat volatile caml_async_signal_mode = 0;
  78
  79 static void caml_enter_blocking_section_default(void)
  80 {
  81   Assert (caml_async_signal_mode == 0);
  82   caml_async_signal_mode = 1;
  83 }
  84
  85 static void caml_leave_blocking_section_default(void)
  86 {
  87   Assert (caml_async_signal_mode == 1);
  88   caml_async_signal_mode = 0;
  89 }
  90
  91 static int caml_try_leave_blocking_section_default(void)
  92 {
  93   intnat res;
  94   Read_and_clear(res, caml_async_signal_mode);
  95   return res;
  96 }
  97
  98 CAMLexport void (*caml_enter_blocking_section_hook)(void) =
  99    caml_enter_blocking_section_default;
 100 CAMLexport void (*caml_leave_blocking_section_hook)(void) =
 101    caml_leave_blocking_section_default;
 102 CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
 103    caml_try_leave_blocking_section_default;
 104
 105 CAMLexport void caml_enter_blocking_section(void)
 106 {
 107   while (1){
 108     /* Process all pending signals now */
 109     caml_process_pending_signals();
 110     caml_enter_blocking_section_hook ();
 111     /* Check again for pending signals.
 112        If none, done; otherwise, try again */
 113     if (! caml_signals_are_pending) break;
 114     caml_leave_blocking_section_hook ();
 115   }
 116 }
 117
 118 CAMLexport void caml_leave_blocking_section(void)
 119 {
 120   caml_leave_blocking_section_hook ();
 121   caml_process_pending_signals();
 122 }
 123
 124 /* Execute a signal handler immediately */
 125
 126 static value caml_signal_handlers = 0;
 127
 128 void caml_execute_signal(int signal_number, int in_signal_handler)
 129 {
 130   value res;
 131 #ifdef POSIX_SIGNALS
 132   sigset_t sigs;
 133   /* Block the signal before executing the handler, and record in sigs
 134      the original signal mask */
 135   sigemptyset(&sigs);
 136   sigaddset(&sigs, signal_number);
 137   sigprocmask(SIG_BLOCK, &sigs, &sigs);
 138 #endif
 139   res = caml_callback_exn(
 140            Field(caml_signal_handlers, signal_number),
 141            Val_int(caml_rev_convert_signal_number(signal_number)));
 142 #ifdef POSIX_SIGNALS
 143   if (! in_signal_handler) {
 144     /* Restore the original signal mask */
 145     sigprocmask(SIG_SETMASK, &sigs, NULL);
 146   } else if (Is_exception_result(res)) {
 147     /* Restore the original signal mask and unblock the signal itself */
 148     sigdelset(&sigs, signal_number);
 149     sigprocmask(SIG_SETMASK, &sigs, NULL);
 150   }
 151 #endif
 152   if (Is_exception_result(res)) caml_raise(Extract_exception(res));
 153 }
 154
 155 /* Arrange for a garbage collection to be performed as soon as possible */
 156
 157 int volatile caml_force_major_slice = 0;
 158
 159 void caml_urge_major_slice (void)
 160 {
 161   caml_force_major_slice = 1;
 162 #ifndef NATIVE_CODE
 163   caml_something_to_do = 1;
 164 #else
 165   caml_young_limit = caml_young_end;
 166   /* This is only moderately effective on ports that cache [caml_young_limit]
 167      in a register, since [caml_modify] is called directly, not through
 168      [caml_c_call], so it may take a while before the register is reloaded
 169      from [caml_young_limit]. */
 170 #endif
 171 }
 172
 173 /* OS-independent numbering of signals */
 174
 175 #ifndef SIGABRT
 176 #define SIGABRT -1
 177 #endif
 178 #ifndef SIGALRM
 179 #define SIGALRM -1
 180 #endif
 181 #ifndef SIGFPE
 182 #define SIGFPE -1
 183 #endif
 184 #ifndef SIGHUP
 185 #define SIGHUP -1
 186 #endif
 187 #ifndef SIGILL
 188 #define SIGILL -1
 189 #endif
 190 #ifndef SIGINT
 191 #define SIGINT -1
 192 #endif
 193 #ifndef SIGKILL
 194 #define SIGKILL -1
 195 #endif
 196 #ifndef SIGPIPE
 197 #define SIGPIPE -1
 198 #endif
 199 #ifndef SIGQUIT
 200 #define SIGQUIT -1
 201 #endif
 202 #ifndef SIGSEGV
 203 #define SIGSEGV -1
 204 #endif
 205 #ifndef SIGTERM
 206 #define SIGTERM -1
 207 #endif
 208 #ifndef SIGUSR1
 209 #define SIGUSR1 -1
 210 #endif
 211 #ifndef SIGUSR2
 212 #define SIGUSR2 -1
 213 #endif
 214 #ifndef SIGCHLD
 215 #define SIGCHLD -1
 216 #endif
 217 #ifndef SIGCONT
 218 #define SIGCONT -1
 219 #endif
 220 #ifndef SIGSTOP
 221 #define SIGSTOP -1
 222 #endif
 223 #ifndef SIGTSTP
 224 #define SIGTSTP -1
 225 #endif
 226 #ifndef SIGTTIN
 227 #define SIGTTIN -1
 228 #endif
 229 #ifndef SIGTTOU
 230 #define SIGTTOU -1
 231 #endif
 232 #ifndef SIGVTALRM
 233 #define SIGVTALRM -1
 234 #endif
 235 #ifndef SIGPROF
 236 #define SIGPROF -1
 237 #endif
 238
 239 static int posix_signals[] = {
 240   SIGABRT, SIGALRM, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL, SIGPIPE,
 241   SIGQUIT, SIGSEGV, SIGTERM, SIGUSR1, SIGUSR2, SIGCHLD, SIGCONT,
 242   SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGVTALRM, SIGPROF
 243 };
 244
 245 CAMLexport int caml_convert_signal_number(int signo)
 246 {
 247   if (signo < 0 && signo >= -(sizeof(posix_signals) / sizeof(int)))
 248     return posix_signals[-signo-1];
 249   else
 250     return signo;
 251 }
 252
 253 CAMLexport int caml_rev_convert_signal_number(int signo)
 254 {
 255   int i;
 256   for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
 257     if (signo == posix_signals[i]) return -i - 1;
 258   return signo;
 259 }
 260
 261 /* Installation of a signal handler (as per [Sys.signal]) */
 262
 263 CAMLprim value caml_install_signal_handler(value signal_number, value action)
 264 {
 265   CAMLparam2 (signal_number, action);
 266   CAMLlocal1 (res);
 267   int sig, act, oldact;
 268
 269   sig = caml_convert_signal_number(Int_val(signal_number));
 270   if (sig < 0 || sig >= NSIG)
 271     caml_invalid_argument("Sys.signal: unavailable signal");
 272   switch(action) {
 273   case Val_int(0):              /* Signal_default */
 274     act = 0;
 275     break;
 276   case Val_int(1):              /* Signal_ignore */
 277     act = 1;
 278     break;
 279   default:                      /* Signal_handle */
 280     act = 2;
 281     break;
 282   }
 283   oldact = caml_set_signal_action(sig, act);
 284   switch (oldact) {
 285   case 0:                       /* was Signal_default */
 286     res = Val_int(0);
 287     break;
 288   case 1:                       /* was Signal_ignore */
 289     res = Val_int(1);
 290     break;
 291   case 2:                       /* was Signal_handle */
 292     res = caml_alloc_small (1, 0);
 293     Field(res, 0) = Field(caml_signal_handlers, sig);
 294     break;
 295   default:                      /* error in caml_set_signal_action */
 296     caml_sys_error(NO_ARG);
 297   }
 298   if (Is_block(action)) {
 299     if (caml_signal_handlers == 0) {
 300       caml_signal_handlers = caml_alloc(NSIG, 0);
 301       caml_register_global_root(&caml_signal_handlers);
 302     }
 303     caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
 304   }
 305   caml_process_pending_signals();
 306   CAMLreturn (res);
 307 }