Mailing list for all users of the OCaml language and system.
 help / color / mirror / Atom feed
* more patches (for Unix signal mask)
@ 1999-05-16 21:40 Joerg Czeranski
  1999-05-17 11:03 ` Are exceptions evil? (was: more patches) Joerg Czeranski
                   ` (2 more replies)
  0 siblings, 3 replies; 7+ messages in thread
From: Joerg Czeranski @ 1999-05-16 21:40 UTC (permalink / raw)
  To: caml-list

Hi!

I had a look at the web interface to Caml's CVS repository
and noticed that my previous patches are already incorporated
(except for byterun/intern.c, but I'm not so sure that it makes
a difference at all). :-)

The DEC/Compaq C compiler people acknowledged that the sigsetjmp()
handling in byterun/interp.c is a bug and they promised to fix
it in a later compiler version.

Now for my new O'Caml problems:

An exception raised from C code (e.g. in the Unix module for every
system call error) resets the current signal mask -
by calling siglongjmp() in the bytecode interpreter or in
default_reset_sigmask() for native binaries.

I'm porting a small shell to O'Caml and it's mandatory that SIGCHLD
stays blocked while process group data structures are modified, because
the SIGCHLD handler has to modify them, too.

I replaced all sigsetjmp() calls with _setjmp() calls (setjmp() is
allowed to modify the signal mask, too, as per Single Unix Spec v2)
and handled jumps out of signal handlers separately.

Tracing the resulting binaries for the 2*3 cases that I know -
raise in Caml code vs. raise in C code and
raise without signal handlers vs. raise out of asynchronously
handled signal vs. raise out of synchronously handled signal -
seems to indicate that signal masks retain their proper values.

sigaction() calls with SA_NODEFER and/or non-empty sa_mask fields
are not yet handled, but they're not supported in O'Caml 2.02's
Sys module anyway.

The Single Unix Spec advises against using _setjmp() and for using
sigsetjmp(), but I don't know how that could work without mistreating
the signal mask in O'Caml.

joerch

==================== patches ====================
*** byterun/interp.c.orig	Mon Mar 15 16:07:12 1999
--- byterun/interp.c	Sun May 16 22:23:02 1999
***************
*** 201,207 ****
    initial_external_raise = external_raise;
    callback_depth++;
  
!   if (sigsetjmp(raise_buf.buf, 1)) {
      local_roots = initial_local_roots;
      accu = exn_bucket;
      goto raise_exception;
--- 201,207 ----
    initial_external_raise = external_raise;
    callback_depth++;
  
!   if (_setjmp(raise_buf.buf)) {
      local_roots = initial_local_roots;
      accu = exn_bucket;
      goto raise_exception;
*** byterun/fail.h.orig	Fri Nov 20 16:36:26 1998
--- byterun/fail.h	Sun May 16 00:31:31 1999
***************
*** 30,46 ****
  #define STACK_OVERFLOW_EXN 8    /* "Stack_overflow" */
  #define SYS_BLOCKED_IO 9        /* "Sys_blocked_io" */
  
- #ifdef POSIX_SIGNALS
  struct longjmp_buffer {
-   sigjmp_buf buf;
- };
- #else
- struct longjmp_buffer {
    jmp_buf buf;
  };
- #define sigsetjmp(buf,save) setjmp(buf)
- #define siglongjmp(buf,val) longjmp(buf,val)
- #endif
  
  extern struct longjmp_buffer * external_raise;
  extern value exn_bucket;
--- 30,38 ----
*** byterun/fail.c.orig	Sun Feb 14 17:48:22 1999
--- byterun/fail.c	Sun May 16 01:13:01 1999
***************
*** 32,38 ****
    Unlock_exn();
    exn_bucket = v;
    if (external_raise == NULL) fatal_uncaught_exception(v);
!   siglongjmp(external_raise->buf, 1);
  }
  
  void raise_constant(value tag)
--- 32,38 ----
    Unlock_exn();
    exn_bucket = v;
    if (external_raise == NULL) fatal_uncaught_exception(v);
!   _longjmp(external_raise->buf, 1);
  }
  
  void raise_constant(value tag)
*** byterun/debugger.c.orig	Tue Sep  2 14:53:57 1997
--- byterun/debugger.c	Sun May 16 01:13:37 1999
***************
*** 149,155 ****
  
    /* Catch exceptions raised by output_val */
    saved_external_raise = external_raise;
!   if (sigsetjmp(raise_buf.buf, 1) == 0) {
      external_raise = &raise_buf;
      output_val(chan, val, Val_unit);
    } else {
--- 149,155 ----
  
    /* Catch exceptions raised by output_val */
    saved_external_raise = external_raise;
!   if (_setjmp(raise_buf.buf) == 0) {
      external_raise = &raise_buf;
      output_val(chan, val, Val_unit);
    } else {
*** byterun/signals.c.orig	Mon Oct 26 20:18:04 1998
--- byterun/signals.c	Sun May 16 01:13:49 1999
***************
*** 45,53 ****
  #endif
  #endif
    if (async_signal_mode){
!     leave_blocking_section ();
!     execute_signal(signal_number);
!     enter_blocking_section ();
    }else{
      pending_signal = signal_number;
      something_to_do = 1;
--- 45,76 ----
  #endif
  #endif
    if (async_signal_mode){
!     if (external_raise == NULL) {
!       leave_blocking_section ();
!       execute_signal(signal_number);
!       enter_blocking_section ();
!     } else {
!       struct longjmp_buffer raise_buf, *saved_external_raise;
! 
!       saved_external_raise = external_raise;
!       if (_setjmp(raise_buf.buf))
!       {
! 	sigset_t s;
! 
! 	external_raise = saved_external_raise;
! 	sigemptyset(&s);
! 	sigaddset(&s, signal_number);
! 	sigprocmask(SIG_UNBLOCK, &s, NULL);
! 	_longjmp(external_raise->buf, 1);
!       }
!       else
!       {
! 	external_raise = &raise_buf;
!         leave_blocking_section ();
!         execute_signal(signal_number);
!         enter_blocking_section ();
!       }
!     }
    }else{
      pending_signal = signal_number;
      something_to_do = 1;
*** asmrun/stack.h.orig	Wed Nov 18 19:10:52 1998
--- asmrun/stack.h	Sun May 16 02:31:25 1999
***************
*** 85,89 ****
--- 85,95 ----
  extern value caml_globals[];
  extern long * caml_frametable[];
  
+ struct caml_sigblock_node {
+   struct caml_sigblock_node *next;
+   int signal_number;
+ };
+ 
+ extern struct caml_sigblock_node *caml_sigblock_stack;
  
  #endif /* _stack_ */
*** asmrun/fail.c.orig	Thu Nov 26 11:00:51 1998
--- asmrun/fail.c	Sun May 16 02:48:11 1999
***************
*** 36,41 ****
--- 36,42 ----
  
  static void default_reset_sigmask(void)
  {
+ #if 0
  #ifdef POSIX_SIGNALS
    sigset_t mask;
    sigemptyset(&mask);
***************
*** 45,50 ****
--- 46,52 ----
    sigsetmask(0);
  #endif
  #endif
+ #endif
  }
  
  void (*caml_reset_sigmask)(void) = default_reset_sigmask;
***************
*** 55,66 ****
--- 57,79 ----
  
  char * caml_exception_pointer = NULL;
  
+ struct caml_sigblock_node *caml_sigblock_stack = NULL;
+ 
+ 
  void mlraise(value v)
  {
+   sigset_t s;
+   int do_unblock;
+   struct caml_sigblock_node *stack;
+ 
    (*caml_reset_sigmask)();
    Unlock_exn();
    if (caml_exception_pointer == NULL) fatal_uncaught_exception(v);
  
+   sigemptyset(&s);
+   do_unblock = 0;
+   stack = caml_sigblock_stack;
+ 
  #ifndef Stack_grows_upwards
  #define PUSHED_AFTER <
  #else
***************
*** 70,76 ****
--- 83,102 ----
           (char *) local_roots PUSHED_AFTER caml_exception_pointer) {
      local_roots = local_roots->next;
    }
+ 
+   while (stack != NULL &&
+          (char *)stack PUSHED_AFTER caml_exception_pointer) {
+     sigaddset(&s, stack->signal_number);
+     do_unblock = 1;
+     stack = stack->next;
+   }
  #undef PUSHED_AFTER
+ 
+   if (do_unblock)
+   {
+     sigprocmask(SIG_UNBLOCK, &s, NULL);
+     caml_sigblock_stack = stack;
+   }
  
    raise_caml_exception(v);
  }
*** asmrun/signals.c.orig	Thu Nov 26 11:08:37 1998
--- asmrun/signals.c	Sun May 16 02:39:14 1999
***************
*** 115,123 ****
--- 115,131 ----
    if (async_signal_mode) {
      /* We are interrupting a C function blocked on I/O.
         Callback the Caml code immediately. */
+     struct caml_sigblock_node sigblock_node;
+ 
+     sigblock_node.next = caml_sigblock_stack;
+     sigblock_node.signal_number = sig;
+     caml_sigblock_stack = &sigblock_node;
+ 
      leave_blocking_section();
      callback(Field(signal_handlers, sig), Val_int(sig));
      enter_blocking_section();
+ 
+     caml_sigblock_stack = sigblock_node.next;
    } else {
      /* We can't execute the signal code immediately.
         Instead, we remember the signal and play with the allocation limit
==================== end of patches ====================




^ permalink raw reply	[flat|nested] 7+ messages in thread
end of thread, other threads:[~1999-05-28 15:06 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1999-05-16 21:40 more patches (for Unix signal mask) Joerg Czeranski
1999-05-17 11:03 ` Are exceptions evil? (was: more patches) Joerg Czeranski
1999-05-18  1:25 ` UPDATE: more patches Joerg Czeranski
1999-05-18 16:10 ` more patches (for Unix signal mask) Xavier Leroy
1999-05-19 18:32   ` Joerg Czeranski
1999-05-25 15:16     ` John Skaller
1999-05-27 19:10       ` Xavier Leroy

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox