OSDN Git Service

2006-10-31 Javier Miranda <miranda@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / init.c
index 990d0cb..9e33079 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT 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- *
@@ -39,9 +39,9 @@
     installed by this file are used to handle resulting signals that come
     from these probes failing (i.e. touching protected pages) */
 
-/* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
-   5zinit.adb. All these files implement the required functionality for
-   different targets. */
+/* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
+   s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement
+   the required functionality for different targets. */
 
 /* The following include is here to meet the published VxWorks requirement
    that the __vxworks header appear before any other include. */
 
 extern void __gnat_raise_program_error (const char *, int);
 
-/* Addresses of exception data blocks for predefined exceptions. */
+/* Addresses of exception data blocks for predefined exceptions. Tasking_Error
+   is not used in this unit, and the abort signal is only used on IRIX. */
 extern struct Exception_Data constraint_error;
 extern struct Exception_Data numeric_error;
 extern struct Exception_Data program_error;
 extern struct Exception_Data storage_error;
-extern struct Exception_Data tasking_error;
-extern struct Exception_Data _abort_signal;
-
-#define Lock_Task system__soft_links__lock_task
-extern void (*Lock_Task) (void);
-
-#define Unlock_Task system__soft_links__unlock_task
-extern void (*Unlock_Task) (void);
-
-#define Get_Machine_State_Addr \
-                      system__soft_links__get_machine_state_addr
-extern struct Machine_State *(*Get_Machine_State_Addr) (void);
-
-#define Check_Abort_Status     \
-                      system__soft_links__check_abort_status
-extern int (*Check_Abort_Status) (void);
 
+/* For the Cert run time we use the regular raise exception routine because
+   Raise_From_Signal_Handler is not available. */
+#ifdef CERT
+#define Raise_From_Signal_Handler \
+                      __gnat_raise_exception
+extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#else
 #define Raise_From_Signal_Handler \
                       ada__exceptions__raise_from_signal_handler
 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#endif
 
-#define Propagate_Signal_Exception \
-                      __gnat_propagate_sig_exc
-extern void Propagate_Signal_Exception (struct Machine_State *,
-                                        struct Exception_Data *,
-                                        const char *);
-
-/* Copies of global values computed by the binder */
-int   __gl_main_priority            = -1;
-int   __gl_time_slice_val           = -1;
-char  __gl_wc_encoding              = 'n';
-char  __gl_locking_policy           = ' ';
-char  __gl_queuing_policy           = ' ';
-char  __gl_task_dispatching_policy  = ' ';
-char *__gl_restrictions             = 0;
-char *__gl_interrupt_states         = 0;
-int   __gl_num_interrupt_states     = 0;
-int   __gl_unreserve_all_interrupts = 0;
-int   __gl_exception_tracebacks     = 0;
-int   __gl_zero_cost_exceptions     = 0;
-int   __gl_detect_blocking          = 0;
+/* Global values computed by the binder */
+int   __gl_main_priority                 = -1;
+int   __gl_time_slice_val                = -1;
+char  __gl_wc_encoding                   = 'n';
+char  __gl_locking_policy                = ' ';
+char  __gl_queuing_policy                = ' ';
+char  __gl_task_dispatching_policy       = ' ';
+char *__gl_priority_specific_dispatching = 0;
+int   __gl_num_specific_dispatching      = 0;
+char *__gl_interrupt_states              = 0;
+int   __gl_num_interrupt_states          = 0;
+int   __gl_unreserve_all_interrupts      = 0;
+int   __gl_exception_tracebacks          = 0;
+int   __gl_zero_cost_exceptions          = 0;
+int   __gl_detect_blocking               = 0;
+int   __gl_default_stack_size            = -1;
 
 /* Indication of whether synchronous signal handler has already been
    installed by a previous call to adainit */
 int  __gnat_handler_installed      = 0;
 
+#ifndef IN_RTS
+int __gnat_inside_elab_final_code = 0;
+/* ??? This variable is obsolete since 2001-08-29 but is kept to allow
+   bootstrap from old GNAT versions (< 3.15). */
+#endif
+
 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
    is defined. If this is not set them a void implementation will be defined
    at the end of this unit. */
@@ -147,115 +142,47 @@ __gnat_get_interrupt_state (int intrup)
     return __gl_interrupt_states [intrup];
 }
 
-/**********************/
-/* __gnat_set_globals */
-/**********************/
+/***********************************/
+/* __gnat_get_specific_dispatching */
+/***********************************/
 
-/* This routine is called from the binder generated main program.  It copies
-   the values for global quantities computed by the binder into the following
-   global locations. The reason that we go through this copy, rather than just
-   define the global locations in the binder generated file, is that they are
-   referenced from the runtime, which may be in a shared library, and the
-   binder file is not in the shared library. Global references across library
-   boundaries like this are not handled correctly in all systems.  */
+char __gnat_get_specific_dispatching (int);
 
-/* For detailed description of the parameters to this routine, see the
-   section titled Run-Time Globals in package Bindgen (bindgen.adb) */
+/* This routine is called from the run time as needed to determine the
+   priority specific dispatching policy, as set by a
+   Priority_Specific_Dispatching pragma appearing anywhere in the current
+   partition. The input argument is the priority number, and the result is
+   the upper case first character of the policy name, e.g. 'F' for
+   FIFO_Within_Priorities. A space ' ' is returned if no
+   Priority_Specific_Dispatching pragma is used in the partition. */
 
-void
-__gnat_set_globals (int main_priority,
-                    int time_slice_val,
-                    char wc_encoding,
-                    char locking_policy,
-                    char queuing_policy,
-                    char task_dispatching_policy,
-                    char *restrictions,
-                    char *interrupt_states,
-                    int num_interrupt_states,
-                    int unreserve_all_interrupts,
-                    int exception_tracebacks,
-                    int zero_cost_exceptions,
-                    int detect_blocking)
+char
+__gnat_get_specific_dispatching (int priority)
 {
-  static int already_called = 0;
-
-  /* If this procedure has been already called once, check that the
-     arguments in this call are consistent with the ones in the previous
-     calls. Otherwise, raise a Program_Error exception.
-
-     We do not check for consistency of the wide character encoding
-     method. This default affects only Wide_Text_IO where no explicit
-     coding method is given, and there is no particular reason to let
-     this default be affected by the source representation of a library
-     in any case.
-
-     We do not check either for the consistency of exception tracebacks,
-     because exception tracebacks are not normally set in Stand-Alone
-     libraries. If a library or the main program set the exception
-     tracebacks, then they are never reset afterwards (see below).
-
-     The value of main_priority is meaningful only when we are invoked
-     from the main program elaboration routine of an Ada application.
-     Checking the consistency of this parameter should therefore not be
-     done. Since it is assured that the main program elaboration will
-     always invoke this procedure before any library elaboration
-     routine, only the value of main_priority during the first call
-     should be taken into account and all the subsequent ones should be
-     ignored. Note that the case where the main program is not written
-     in Ada is also properly handled, since the default value will then
-     be used for this parameter.
-
-     For identical reasons, the consistency of time_slice_val should not
-     be checked. */
-
-  if (already_called)
-    {
-      if (__gl_locking_policy             != locking_policy
-         || __gl_queuing_policy           != queuing_policy
-         || __gl_task_dispatching_policy  != task_dispatching_policy
-         || __gl_unreserve_all_interrupts != unreserve_all_interrupts
-         || __gl_zero_cost_exceptions     != zero_cost_exceptions)
-       __gnat_raise_program_error (__FILE__, __LINE__);
+  if (__gl_num_specific_dispatching == 0)
+    return ' ';
+  else if (priority >= __gl_num_specific_dispatching)
+    return 'F';
+  else
+    return __gl_priority_specific_dispatching [priority];
+}
 
-      /* If either a library or the main program set the exception traceback
-         flag, it is never reset later */
+#ifndef IN_RTS
 
-      if (exception_tracebacks != 0)
-         __gl_exception_tracebacks = exception_tracebacks;
+/**********************/
+/* __gnat_set_globals */
+/**********************/
 
-      return;
-    }
-  already_called = 1;
-
-  __gl_main_priority            = main_priority;
-  __gl_time_slice_val           = time_slice_val;
-  __gl_wc_encoding              = wc_encoding;
-  __gl_locking_policy           = locking_policy;
-  __gl_queuing_policy           = queuing_policy;
-  __gl_restrictions             = restrictions;
-  __gl_interrupt_states         = interrupt_states;
-  __gl_num_interrupt_states     = num_interrupt_states;
-  __gl_task_dispatching_policy  = task_dispatching_policy;
-  __gl_unreserve_all_interrupts = unreserve_all_interrupts;
-  __gl_exception_tracebacks     = exception_tracebacks;
-  __gl_detect_blocking          = detect_blocking;
-
-  /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
-     a-except.adb, which is also part of the compiler sources. Since the
-     compiler is built with an older release of GNAT, the call generated by
-     the old binder to this function does not provide any value for the
-     corresponding argument, so the global has to be initialized in some
-     reasonable other way. This could be removed as soon as the next major
-     release is out.  */
+/* This routine is kept for boostrapping purposes, since the binder generated
+   file now sets the __gl_* variables directly. */
 
-#ifdef IN_RTS
-  __gl_zero_cost_exceptions = zero_cost_exceptions;
-#else
-  __gl_zero_cost_exceptions = 0;
-  /* We never build the compiler to run in ZCX mode currently anyway.  */
-#endif
+void
+__gnat_set_globals ()
+{
 }
 
+#endif
+
 /* Notes on the Zero Cost Exceptions scheme and its impact on the signal
    handlers implemented below :
 
@@ -284,22 +211,18 @@ __gnat_set_globals (int main_priority,
    the triggering instruction happens to be the very first of a region, the
    later adjustments performed by the unwinder would yield an address outside
    that region. We need to compensate for those adjustments at some point,
-   which we currently do in the GCC unwinding fallback macro.
+   which we used to do in the GCC unwinding fallback macro.
 
    The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
-   describes a couple of issues with our current approach. Basically: on some
-   targets the adjustment to apply depends on the triggering signal, which is
-   not easily accessible from the macro, and we actually do not tackle this as
-   of today. Besides, other languages, e.g. Java, deal with this by performing
-   the adjustment in the signal handler before the raise, so our adjustments
-   may break those front-ends.
-
-   To have it all right, we should either find a way to deal with the signal
-   variants from the macro and convert Java on all targets (ugh), or remove
-   our macro adjustments and update our signal handlers a-la-java way.  The
-   latter option appears the simplest, although some targets have their share
-   of subtleties to account for.  See for instance the syscall(SYS_sigaction)
-   story in libjava/include/i386-signal.h.  */
+   describes a couple of issues with the fallback based compensation approach.
+   First, on some targets the adjustment to apply depends on the triggering
+   signal, which is not easily accessible from the macro.  Besides, other
+   languages, e.g. Java, deal with this by performing the adjustment in the
+   signal handler before the raise, so fallback adjustments just break those
+   front-ends.
+
+   We now follow the Java way for most targets, via adjust_context_for_raise
+   below.  */
 
 /***************/
 /* AIX Section */
@@ -405,18 +328,14 @@ __gnat_install_handler (void)
 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 extern char *__gnat_get_code_loc (struct sigcontext *);
 extern void __gnat_set_code_loc (struct sigcontext *, char *);
-extern void __gnat_enter_handler (struct sigcontext *, char *);
 extern size_t __gnat_machine_state_length (void);
 
-extern long exc_lookup_gp (char *);
-extern void exc_resume (struct sigcontext *);
-
 static void
-__gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
+__gnat_error_handler
+  (int sig, siginfo_t *sip, struct sigcontext *context ATTRIBUTE_UNUSED)
 {
   struct Exception_Data *exception;
   static int recurse = 0;
-  struct sigcontext *mstate;
   const char *msg;
 
   /* If this was an explicit signal from a "kill", just resignal it.  */
@@ -474,10 +393,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
     }
 
   recurse = 0;
-  mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    *mstate = *context;
-
   Raise_From_Signal_Handler (exception, (char *) msg);
 }
 
@@ -526,14 +441,6 @@ __gnat_set_code_loc (struct sigcontext *context, char *pc)
 }
 
 
-void
-__gnat_enter_handler (struct sigcontext *context, char *pc)
-{
-  context->sc_pc = (long) pc;
-  context->sc_regs[SC_GP] = exc_lookup_gp (pc);
-  exc_resume (context);
-}
-
 size_t
 __gnat_machine_state_length (void)
 {
@@ -569,10 +476,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 }
 
 static void
-__gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext)
+__gnat_error_handler
+  (int sig, siginfo_t *siginfo ATTRIBUTE_UNUSED, void *ucontext)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {
@@ -649,7 +557,8 @@ __gnat_install_handler (void)
 /* GNU/Linux Section */
 /*********************/
 
-#elif defined (linux) && (defined (i386) || defined (__x86_64__))
+#elif defined (linux) && (defined (i386) || defined (__x86_64__) \
+                          || defined (__ia64__))
 
 #include <signal.h>
 
@@ -663,6 +572,38 @@ __gnat_install_handler (void)
 #define NULL ((void *) 0)
 #endif
 
+#if defined (MaRTE)
+
+/* MaRTE OS provides its own version of sigaction, sigfillset, and
+   sigemptyset (overriding these symbol names). We want to make sure that
+   the versions provided by the underlying C library are used here (these
+   versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
+   and fake_linux_sigemptyset, respectively). The MaRTE library will not
+   always be present (it will not be linked if no tasking constructs are
+   used), so we use the weak symbol mechanism to point always to the symbols
+   defined within the C library. */
+
+#pragma weak linux_sigaction
+int linux_sigaction (int signum, const struct sigaction *act,
+                    struct sigaction *oldact) {
+  return sigaction (signum, act, oldact);
+}
+#define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
+
+#pragma weak fake_linux_sigfillset
+void fake_linux_sigfillset (sigset_t *set) {
+  sigfillset (set);
+}
+#define sigfillset(set) fake_linux_sigfillset (set)
+
+#pragma weak fake_linux_sigemptyset
+void fake_linux_sigemptyset (sigset_t *set) {
+  sigemptyset (set);
+}
+#define sigemptyset(set) fake_linux_sigemptyset (set)
+
+#endif
+
 static void __gnat_error_handler (int, siginfo_t *siginfo, void *ucontext);
 
 /* __gnat_adjust_context_for_raise - see comments along with the default
@@ -679,6 +620,8 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
   mcontext->gregs[REG_EIP]++;
 #elif defined (__x86_64__)
   mcontext->gregs[REG_RIP]++;
+#elif defined (__ia64__)
+  mcontext->sc_ip++;
 #endif
 }
 
@@ -800,7 +743,7 @@ static void
 __gnat_error_handler (int sig)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {
@@ -870,10 +813,11 @@ __gnat_install_handler (void)
 #define SIGNAL_STACK_SIZE 4096
 #define SIGNAL_STACK_ALIGNMENT 64
 
-struct Machine_State
-{
-  sigcontext_t context;
-};
+#define Check_Abort_Status     \
+                      system__soft_links__check_abort_status
+extern int (*Check_Abort_Status) (void);
+
+extern struct Exception_Data _abort_signal;
 
 static void __gnat_error_handler (int, int, sigcontext_t *);
 
@@ -890,9 +834,8 @@ static void __gnat_error_handler (int, int, sigcontext_t *);
 */
 
 static void
-__gnat_error_handler (int sig, int code, sigcontext_t *sc)
+__gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
 {
-  struct Machine_State  *mstate;
   struct Exception_Data *exception;
   const char *msg;
 
@@ -967,10 +910,6 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc)
       msg = "unhandled signal";
     }
 
-  mstate = (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
-
   Raise_From_Signal_Handler (exception, msg);
 }
 
@@ -1210,35 +1149,35 @@ extern Exception_Code Base_Code_In (Exception_Code);
 /* DEC Ada exceptions are not defined in a header file, so they
    must be declared as external addresses */
 
-extern int ADA$_PROGRAM_ERROR __attribute__ ((weak));
-extern int ADA$_LOCK_ERROR __attribute__ ((weak));
-extern int ADA$_EXISTENCE_ERROR __attribute__ ((weak));
-extern int ADA$_KEY_ERROR __attribute__ ((weak));
-extern int ADA$_KEYSIZERR __attribute__ ((weak));
-extern int ADA$_STAOVF __attribute__ ((weak));
-extern int ADA$_CONSTRAINT_ERRO __attribute__ ((weak));
-extern int ADA$_IOSYSFAILED __attribute__ ((weak));
-extern int ADA$_LAYOUT_ERROR __attribute__ ((weak));
-extern int ADA$_STORAGE_ERROR __attribute__ ((weak));
-extern int ADA$_DATA_ERROR __attribute__ ((weak));
-extern int ADA$_DEVICE_ERROR __attribute__ ((weak));
-extern int ADA$_END_ERROR __attribute__ ((weak));
-extern int ADA$_MODE_ERROR __attribute__ ((weak));
-extern int ADA$_NAME_ERROR __attribute__ ((weak));
-extern int ADA$_STATUS_ERROR __attribute__ ((weak));
-extern int ADA$_NOT_OPEN __attribute__ ((weak));
-extern int ADA$_ALREADY_OPEN __attribute__ ((weak));
-extern int ADA$_USE_ERROR __attribute__ ((weak));
-extern int ADA$_UNSUPPORTED __attribute__ ((weak));
-extern int ADA$_FAC_MODE_MISMAT __attribute__ ((weak));
-extern int ADA$_ORG_MISMATCH __attribute__ ((weak));
-extern int ADA$_RFM_MISMATCH __attribute__ ((weak));
-extern int ADA$_RAT_MISMATCH __attribute__ ((weak));
-extern int ADA$_MRS_MISMATCH __attribute__ ((weak));
-extern int ADA$_MRN_MISMATCH __attribute__ ((weak));
-extern int ADA$_KEY_MISMATCH __attribute__ ((weak));
-extern int ADA$_MAXLINEXC __attribute__ ((weak));
-extern int ADA$_LINEXCMRS __attribute__ ((weak));
+extern int ADA$_PROGRAM_ERROR;
+extern int ADA$_LOCK_ERROR;
+extern int ADA$_EXISTENCE_ERROR;
+extern int ADA$_KEY_ERROR;
+extern int ADA$_KEYSIZERR;
+extern int ADA$_STAOVF;
+extern int ADA$_CONSTRAINT_ERRO;
+extern int ADA$_IOSYSFAILED;
+extern int ADA$_LAYOUT_ERROR;
+extern int ADA$_STORAGE_ERROR;
+extern int ADA$_DATA_ERROR;
+extern int ADA$_DEVICE_ERROR;
+extern int ADA$_END_ERROR;
+extern int ADA$_MODE_ERROR;
+extern int ADA$_NAME_ERROR;
+extern int ADA$_STATUS_ERROR;
+extern int ADA$_NOT_OPEN;
+extern int ADA$_ALREADY_OPEN;
+extern int ADA$_USE_ERROR;
+extern int ADA$_UNSUPPORTED;
+extern int ADA$_FAC_MODE_MISMAT;
+extern int ADA$_ORG_MISMATCH;
+extern int ADA$_RFM_MISMATCH;
+extern int ADA$_RAT_MISMATCH;
+extern int ADA$_MRS_MISMATCH;
+extern int ADA$_MRN_MISMATCH;
+extern int ADA$_KEY_MISMATCH;
+extern int ADA$_MAXLINEXC;
+extern int ADA$_LINEXCMRS;
 
 /* DEC Ada specific conditions */
 static const struct cond_except dec_ada_cond_except_table [] = {
@@ -1332,6 +1271,12 @@ const int *cond_resignal_table [] = {
   0
 };
 
+const int facility_resignal_table [] = {
+  0x1380000, /* RDB */
+  0x2220000, /* SQL */
+  0
+};
+
 /* Default GNAT predicate for resignaling conditions.  */
 
 static int
@@ -1339,6 +1284,10 @@ __gnat_default_resignal_p (int code)
 {
   int i, iexcept;
 
+  for (i = 0; facility_resignal_table [i]; i++)
+    if ((code & 0xfff0000) == facility_resignal_table [i])
+      return 1;
+
   for (i = 0, iexcept = 0;
        cond_resignal_table [i] &&
        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
@@ -1389,7 +1338,7 @@ copy_msg (msgdesc, message)
   /* Check for buffer overflow and truncate if necessary */
   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
              msgdesc->len :
-             len + msgdesc->len - Default_Exception_Msg_Max_Length);
+             Default_Exception_Msg_Max_Length - 1 - len);
   strncpy (&message [len], msgdesc->adr, copy_len);
   message [len + copy_len] = 0;
 
@@ -1397,17 +1346,14 @@ copy_msg (msgdesc, message)
 }
 
 long
-__gnat_error_handler (int *sigargs, void *mechargs)
+__gnat_handle_vms_condition (int *sigargs, void *mechargs)
 {
   struct Exception_Data *exception = 0;
   Exception_Code base_code;
   struct descriptor_s gnat_facility = {4,0,"GNAT"};
   char message [Default_Exception_Msg_Max_Length];
 
-  char *msg = "";
-  char curr_icb[544];
-  long curr_invo_handle;
-  long *mstate;
+  const char *msg = "";
 
   /* Check for conditions to resignal which aren't effected by pragma
      Import_Exception.  */
@@ -1423,7 +1369,11 @@ __gnat_error_handler (int *sigargs, void *mechargs)
   if (exception)
     {
       message [0] = 0;
+
+      /* Subtract PC & PSL fields which messes with PUTMSG */
+      sigargs [0] -= 2;
       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
+      sigargs [0] += 2;
       msg = message;
 
       exception->Name_Length = 19;
@@ -1470,24 +1420,20 @@ __gnat_error_handler (int *sigargs, void *mechargs)
        {
          int i;
 
-         /* Scan the DEC Ada exception condition table for a match and fetch the
-            associated GNAT exception pointer */
+         /* Scan the DEC Ada exception condition table for a match and fetch
+            the associated GNAT exception pointer */
          for (i = 0;
               dec_ada_cond_except_table [i].cond &&
-              !LIB$MATCH_COND (&sigargs [1], &dec_ada_cond_except_table [i].cond);
+              !LIB$MATCH_COND (&sigargs [1],
+                               &dec_ada_cond_except_table [i].cond);
               i++);
-         exception = (struct Exception_Data *) dec_ada_cond_except_table [i].except;
-
-         if (exception)
-           /* DEC Ada exceptions never have a PC and PSL appended, but LIB$STOP
-              (which is how we got here from Bliss code)
-              allows slots for them and the result is 2 words of garbage on the
-              end, so the count must be decremented. */
-           sigargs [0] -= 2;
-         else
+         exception = (struct Exception_Data *)
+           dec_ada_cond_except_table [i].except;
+
+         if (!exception)
            {
-             /* Scan the VMS standard condition table for a match and fetch the
-                associated GNAT exception pointer */
+             /* Scan the VMS standard condition table for a match and fetch
+                the associated GNAT exception pointer */
              for (i = 0;
                   cond_except_table [i].cond &&
                   !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
@@ -1504,43 +1450,111 @@ __gnat_error_handler (int *sigargs, void *mechargs)
        exception = &program_error;
 #endif
        message [0] = 0;
+       /* Subtract PC & PSL fields which messes with PUTMSG */
+       sigargs [0] -= 2;
        SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
+       sigargs [0] += 2;
        msg = message;
        break;
       }
 
-  mstate = (long *) (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    {
-      lib_get_curr_invo_context (&curr_icb);
-      lib_get_prev_invo_context (&curr_icb);
-      lib_get_prev_invo_context (&curr_icb);
-      curr_invo_handle = lib_get_invo_handle (&curr_icb);
-      *mstate = curr_invo_handle;
-    }
-  Raise_From_Signal_Handler (exception, msg);
+ __gnat_adjust_context_for_raise (0, (void *)mechargs);
+ Raise_From_Signal_Handler (exception, msg);
+}
+
+long
+__gnat_error_handler (int *sigargs, void *mechargs)
+{
+  return __gnat_handle_vms_condition (sigargs, mechargs);
 }
 
 void
 __gnat_install_handler (void)
 {
-  long prvhnd;
-#if defined (IN_RTS) && !defined (__IA64)
-  char *c;
+  long prvhnd ATTRIBUTE_UNUSED;
 
-  c = (char *) xmalloc (2049);
+#if !defined (IN_RTS)
+  SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
+#endif
 
-  __gnat_error_prehandler_stack = &c[2048];
+  /* On alpha-vms, we avoid the global vector annoyance thanks to frame based
+     handlers to turn conditions into exceptions since GCC 3.4.  The global
+     vector is still required for earlier GCC versions.  We're resorting to
+     the __gnat_error_prehandler assembly function in this case.  */
 
-  /* __gnat_error_prehandler is an assembly function.  */
-  SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
-#else
-  SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
+#if defined (IN_RTS) && defined (__alpha__)
+  if ((__GNUC__ * 10 + __GNUC_MINOR__) < 34)
+    {
+      char * c = (char *) xmalloc (2049);
+
+      __gnat_error_prehandler_stack = &c[2048];
+      SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
+    }
 #endif
 
   __gnat_handler_installed = 1;
 }
 
+/* __gnat_adjust_context_for_raise for alpha - see comments along with the
+   default version later in this file.  */
+
+#if defined (IN_RTS) && defined (__alpha__)
+
+#include <vms/chfctxdef.h>
+#include <vms/chfdef.h>
+
+#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
+{
+  /* Add one to the address of the instruction signaling the condition,
+     located in the sigargs array.  */
+
+  CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
+  CHF$SIGNAL_ARRAY * sigargs
+    = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
+
+  int vcount = sigargs->chf$is_sig_args;
+  int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
+
+  (*pc_slot) ++;
+}
+
+#endif
+
+/* __gnat_adjust_context_for_raise for ia64.  */
+
+#if defined (IN_RTS) && defined (__IA64)
+
+#include <vms/chfctxdef.h>
+#include <vms/chfdef.h>
+
+#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+typedef unsigned long long u64;
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
+{
+  /* Add one to the address of the instruction signaling the condition,
+     located in the 64bits sigargs array.  */
+
+  CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
+
+  CHF64$SIGNAL_ARRAY *chfsig64
+    = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
+
+  u64 * post_sigarray
+    = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
+
+  u64 * ih_pc_loc = post_sigarray - 2;
+
+  (*ih_pc_loc) ++;
+}
+
+#endif
+
 /*******************/
 /* FreeBSD Section */
 /*******************/
@@ -1548,13 +1562,27 @@ __gnat_install_handler (void)
 #elif defined (__FreeBSD__)
 
 #include <signal.h>
+#include <sys/ucontext.h>
 #include <unistd.h>
 
-static void __gnat_error_handler (int, int, struct sigcontext *);
+static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
+void __gnat_adjust_context_for_raise (int, void*);
+
+/* __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;
+  mcontext->mc_eip++;
+}
 
 static void
-__gnat_error_handler (int sig, int code __attribute__ ((unused)),
-                     struct sigcontext *sc __attribute__ ((unused)))
+__gnat_error_handler (int sig, siginfo_t *info __attribute__ ((unused)),
+                     ucontext_t *ucontext)
 {
   struct Exception_Data *exception;
   const char *msg;
@@ -1586,6 +1614,7 @@ __gnat_error_handler (int sig, int code __attribute__ ((unused)),
       msg = "unhandled signal";
     }
 
+  __gnat_adjust_context_for_raise (sig, ucontext);
   Raise_From_Signal_Handler (exception, msg);
 }
 
@@ -1599,7 +1628,7 @@ __gnat_install_handler ()
      signal that might cause a scheduling event! */
 
   act.sa_handler = __gnat_error_handler;
-  act.sa_flags = SA_NODEFER | SA_RESTART;
+  act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
   (void) sigemptyset (&act.sa_mask);
 
   (void) sigaction (SIGILL,  &act, NULL);
@@ -1618,21 +1647,37 @@ __gnat_install_handler ()
 
 #include <signal.h>
 #include <taskLib.h>
+
+#ifndef __RTP__
 #include <intLib.h>
 #include <iv.h>
+#endif
 
 #ifdef VTHREADS
 #include "private/vThreadsP.h"
 #endif
 
-extern int __gnat_inum_to_ivec (int);
 static void __gnat_error_handler (int, int, struct sigcontext *);
 void __gnat_map_signal (int);
 
-#ifndef __alpha_vxworks
+#ifndef __RTP__
+
+/* Directly vectored Interrupt routines are not supported when using RTPs */
+
+extern int __gnat_inum_to_ivec (int);
+
+/* This is needed by the GNAT run time to handle Vxworks interrupts */
+int
+__gnat_inum_to_ivec (int num)
+{
+  return INUM_TO_IVEC (num);
+}
+#endif
+
+#if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
 
 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
-   on Alpha VxWorks */
+   on Alpha VxWorks and VxWorks 6.x (including RTPs). */
 
 extern long getpid (void);
 
@@ -1643,13 +1688,6 @@ getpid (void)
 }
 #endif
 
-/* This is needed by the GNAT run time to handle Vxworks interrupts */
-int
-__gnat_inum_to_ivec (int num)
-{
-  return INUM_TO_IVEC (num);
-}
-
 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
    The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
 void
@@ -1662,13 +1700,13 @@ __gnat_clear_exception_count (void)
 #endif
 }
 
-/* Exported to 5zintman.adb in order to handle different signal
+/* Exported to s-intman-vxworks.adb in order to handle different signal
    to exception mappings in different VxWorks versions */
 void
 __gnat_map_signal (int sig)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {
@@ -1768,7 +1806,7 @@ __gnat_init_float (void)
 #endif
 
   /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask
-     field of the Floating-point Status Register (see the Sparc Architecture
+     field of the Floating-point Status Register (see the SPARC Architecture
      Manual Version 9, p 48).  */
 #if defined (sparc64)