s-intman-posix.adb (Notify_Exception): Adjust signature, as handler for sigactions with SA_SIGINFO set.

2005-03-08  Olivier Hainque  <hainque@adacore.com>

	* s-intman-posix.adb (Notify_Exception): Adjust signature, as handler
	for sigactions with SA_SIGINFO set. Call
	__gnat_adjust_context_for_raise before raising, to perform the
	potentially required adjustments to the machine context for the GCC
	unwinder.

	* raise.h (__gnat_adjust_context_for_raise): New prototype.

	* init.c (__gnat_adjust_context_for_raise) HPUX: Initial revision.
	Adjust PC by one in the provided machine context.
	(__gnat_install_handler) HPUX: Set SA_SIGINFO in the sigaction flags,
	so that the handler is passed the context structure to adjust prior to
	the raise.
	(__gnat_error_handler) HPUX: Adjust the signature to match what an
	SA_SIGINFO sigaction should look like. Call
	__gnat_adjust_context_for_raise before actually raising.
	(__gnat_adjust_context_for_raise): Default noop to help PC
	adjustments before raise from signal handlers.
	(__gnat_error_handler): Indirectly call a predicate function to
	determine if a condition should be resignaled or not.
	(__gnat_set_resignal_predicate): User interface to modify the predicate.
	(__gnat_default_resignal_p): Default GNAT predicate.

From-SVN: r96482

3 files changed, 176 insertions, 39 deletions

diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index e41c509..e2b6ec4 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -547,7 +547,7 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 {
 }
 
-/* Routines called by 5amastop.adb.  */
+/* Routines called by s-mastop-tru64.adb.  */
 
 #define SC_GP 29
 
@@ -558,7 +558,7 @@ __gnat_get_code_loc (struct sigcontext *context)
 }
 
 void
-__gnat_enter_handler ( struct sigcontext *context, char *pc)
+__gnat_enter_handler (struct sigcontext *context, char *pc)
 {
   context->sc_pc = (long) pc;
   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
@@ -578,11 +578,29 @@ __gnat_machine_state_length (void)
 #elif defined (__hpux__)
 
 #include <signal.h>
+#include <sys/ucontext.h>
 
-static void __gnat_error_handler (int);
+static void
+__gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext);
+
+/* __gnat_adjust_context_for_raise - see comments along with the default
+   version later in this file.  */
+
+#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
+{
+  mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
+
+  if (UseWideRegs (mcontext))
+    mcontext->ss_wide.ss_32.ss_pcoq_head_lo ++;
+  else
+    mcontext->ss_narrow.ss_pcoq_head ++;
+}
 
 static void
-__gnat_error_handler (int sig)
+__gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext)
 {
   struct Exception_Data *exception;
   char *msg;
@@ -610,6 +628,8 @@ __gnat_error_handler (int sig)
       msg = "unhandled signal";
     }
 
+  __gnat_adjust_context_for_raise (sig, ucontext);
+
   Raise_From_Signal_Handler (exception, msg);
 }
 
@@ -637,8 +657,8 @@ __gnat_install_handler (void)
 
   sigaltstack (&stack, NULL);
 
-  act.sa_handler = __gnat_error_handler;
-  act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
+  act.sa_sigaction = __gnat_error_handler;
+  act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK | SA_SIGINFO;
   sigemptyset (&act.sa_mask);
 
   /* Do not install handlers if interrupt state is "System" */
@@ -835,9 +855,16 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
    __gnat_plist_init();
 
+   /* Note that we do not activate this for the compiler itself to avoid a
+      bootstrap path problem.  Older version of gnatbind will generate a call
+      to __gnat_initialize() without argument. Therefore we cannot use eh in
+      this case.  It will be possible to remove the following #ifdef at some
+      point.  */
+#ifdef IN_RTS
    /* Install the Structured Exception handler.  */
    if (eh)
      __gnat_install_SEH_handler (eh);
+#endif
 }
 
 /***************************************/
@@ -1285,6 +1312,70 @@ struct descriptor_s {unsigned short len, mbz; char *adr; };
 
 long __gnat_error_handler (int *, void *);
 
+/* To deal with VMS conditions and their mapping to Ada exceptions,
+   the __gnat_error_handler routine below is installed as an exception
+   vector having precedence over DEC frame handlers.  Some conditions
+   still need to be handled by such handlers, however, in which case
+   __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
+   instance the use of a third party library compiled with DECAda and
+   performing it's own exception handling internally.
+
+   To allow some user-level flexibility, which conditions should be
+   resignaled is controlled by a predicate function, provided with the
+   condition value and returning a boolean indication stating whether
+   this condition should be resignaled or not.
+
+   That predicate function is called indirectly, via a function pointer,
+   by __gnat_error_handler, and changing that pointer is allowed to the
+   the user code by way of the __gnat_set_resignal_predicate interface.
+
+   The user level function may then implement what it likes, including
+   for instance the maintenance of a dynamic data structure if the set
+   of to be resignalled conditions has to change over the program's
+   lifetime.
+
+   ??? This is not a perfect solution to deal with the possible
+   interactions between the GNAT and the DECAda exception handling
+   models and better (more general) schemes are studied.  This is so
+   just provided as a conveniency workaround in the meantime, and
+   should be use with caution since the implementation has been kept
+   very simple.  */
+
+typedef int
+resignal_predicate (int code);
+
+/* Default GNAT predicate for resignaling conditions.  */
+
+static int
+__gnat_default_resignal_p (int code)
+{
+  return
+    code == CMA$_EXIT_THREAD
+    || code == SS$_DEBUG /* Gdb attach, resignal to merge activate gdbstub. */
+    || code == 1409786   /* Nickerson bug #33 ??? */
+    || code == 1381050   /* Nickerson bug #33 ??? */
+    || code == 20480426  /* RDB-E-STREAM_EOF */
+    || code == 11829410  /* Resignalled as Use_Error for CE10VRC */
+  ;
+}
+
+/* Static pointer to predicate that the __gnat_error_handler exception
+   vector invokes to determine if it should resignal a condition.  */
+
+static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
+
+/* User interface to change the predicate pointer to PREDICATE. Reset to
+   the default if PREDICATE is null.  */
+
+void
+__gnat_set_resignal_predicate (resignal_predicate * predicate)
+{
+  if (predicate == 0)
+    __gnat_resignal_p = __gnat_default_resignal_p;
+  else
+    __gnat_resignal_p = predicate;
+}
+
 long
 __gnat_error_handler (int *sigargs, void *mechargs)
 {
@@ -1301,30 +1392,10 @@ __gnat_error_handler (int *sigargs, void *mechargs)
   long curr_invo_handle;
   long *mstate;
 
-  /* Resignaled condtions aren't effected by by pragma Import_Exception */
-
-  switch (sigargs[1])
-  {
-
-    case CMA$_EXIT_THREAD:
-      return SS$_RESIGNAL;
-
-    case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
-      return SS$_RESIGNAL;
-
-    case 1409786: /* Nickerson bug #33 ??? */
-      return SS$_RESIGNAL;
-
-    case 1381050: /* Nickerson bug #33 ??? */
-      return SS$_RESIGNAL;
-
-    case 20480426: /* RDB-E-STREAM_EOF */
-      return SS$_RESIGNAL;
-
-    case 11829410: /* Resignalled as Use_Error for CE10VRC */
-      return SS$_RESIGNAL;
-
-  }
+  /* Check for conditions to resignal which aren't effected by pragma
+     Import_Exception.  */
+  if (__gnat_resignal_p (sigargs [1]))
+    return SS$_RESIGNAL;
 
 #ifdef IN_RTS
   /* See if it's an imported exception. Beware that registered exceptions
@@ -1901,3 +1972,43 @@ __gnat_init_float (void)
 {
 }
 #endif
+
+/***********************************/
+/* __gnat_adjust_context_for_raise */
+/***********************************/
+
+#ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+/* All targets without a specific version will use an empty one */
+
+/* UCONTEXT is a pointer to a context structure received by a signal handler
+   about to propagate an exception. Adjust it to compensate the fact that the
+   generic unwinder thinks the corresponding PC is a call return address.  */
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
+				 void *ucontext ATTRIBUTE_UNUSED)
+{
+  /* The point is that the interrupted context PC typically is the address
+     that we should search an EH region for, which is different from the call
+     return address case. The target independant part of the GCC unwinder
+     don't differentiate the two situations, so we compensate here for the
+     adjustments it will blindly make.
+
+     signo is passed because on some targets for some signals the PC in
+     context points to the instruction after the faulting one, in which case
+     the unwinder adjustment is still desired.  */
+
+  /* On a number of targets, we have arranged for the adjustment to be
+     performed by the MD_FALLBACK_FRAME_STATE circuitry, so we don't provide a
+     specific instance of this routine.  The MD_FALLBACK doesn't have access
+     to the signal number, though, so the compensation is systematic there and
+     might be wrong in some cases.  */
+
+  /* Having the compensation wrong leads to potential failures.  A very
+     typical case is what happens when there is no compensation and a signal
+     triggers for the first instruction in a region : the unwinder adjustment
+     has it search in the wrong EH region.  */
+}
+
+#endif
diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h
index 8ef77d7..ad5bacf 100644
--- a/gcc/ada/raise.h
+++ b/gcc/ada/raise.h
@@ -70,5 +70,6 @@ extern void __gnat_initialize		(void *);
 extern void __gnat_init_float		(void);
 extern void __gnat_install_handler	(void);
 extern void __gnat_install_SEH_handler  (void *);
+extern void __gnat_adjust_context_for_raise (int, void *);
 
 extern int gnat_exit_status;
diff --git a/gcc/ada/s-intman-posix.adb b/gcc/ada/s-intman-posix.adb
index 801adac..154a7f4 100644
--- a/gcc/ada/s-intman-posix.adb
+++ b/gcc/ada/s-intman-posix.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -88,7 +88,10 @@ package body System.Interrupt_Management is
    -- Local Subprograms --
    -----------------------
 
-   procedure Notify_Exception (signo : Signal);
+   procedure Notify_Exception
+     (signo    : Signal;
+      siginfo  : System.Address;
+      ucontext : System.Address);
    --  This function identifies the Ada exception to be raised using
    --  the information when the system received a synchronous signal.
    --  Since this function is machine and OS dependent, different code
@@ -101,7 +104,24 @@ package body System.Interrupt_Management is
    Signal_Mask : aliased sigset_t;
    --  The set of signals handled by Notify_Exception
 
-   procedure Notify_Exception (signo : Signal) is
+   procedure Notify_Exception
+     (signo    : Signal;
+      siginfo  : System.Address;
+      ucontext : System.Address)
+   is
+      pragma Unreferenced (siginfo);
+
+      --  The GCC unwinder requires adjustments to the signal's machine
+      --  context to be able to properly unwind through the signal handler.
+      --  This is achieved by the target specific subprogram below, provided
+      --  by init.c to be usable by the non-tasking handler also.
+
+      procedure Adjust_Context_For_Raise
+        (signo    : Signal;
+         ucontext : System.Address);
+      pragma Import
+        (C, Adjust_Context_For_Raise, "__gnat_adjust_context_for_raise");
+
       Result  : Interfaces.C.int;
 
    begin
@@ -111,6 +131,11 @@ package body System.Interrupt_Management is
       Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
       pragma Assert (Result = 0);
 
+      --  Perform the necessary context adjustments required by the GCC/ZCX
+      --  unwinder, harmless in the SJLJ case.
+
+      Adjust_Context_For_Raise (signo, ucontext);
+
       --  Check that treatment of exception propagation here
       --  is consistent with treatment of the abort signal in
       --  System.Task_Primitives.Operations.
@@ -179,12 +204,12 @@ begin
 
       --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
       --  number argument to the handler when it is called. The set of extra
-      --  parameters typically includes a pointer to a structure describing
-      --  the interrupted context. Although the Notify_Exception handler does
-      --  not use this information, it is actually required for the GCC/ZCX
-      --  exception propagation scheme because on some targets (at least
-      --  alpha-tru64), the structure contents are not even filled when this
-      --  flag is not set.
+      --  parameters includes a pointer to the interrupted context, which the
+      --  ZCX propagation scheme needs.
+
+      --  Most man pages for sigaction mention that sa_sigaction should be set
+      --  instead of sa_handler when SA_SIGINFO is on.  In practice, the two
+      --  fields are actually union'ed and located at the same offset.
 
       --  On some targets, we set sa_flags to SA_NODEFER so that during the
       --  handler execution we do not change the Signal_Mask to be masked for