OSDN Git Service

2009-08-17 Thomas Quinot <quinot@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / raise-gcc.c
index 8a7cf5a..1d9efb9 100644 (file)
@@ -6,24 +6,23 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *             Copyright (C) 1992-2007, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2009, 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- *
- * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+ * ware  Foundation;  either version 3,  or (at your option) any later ver- *
  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
- * for  more details.  You should have  received  a copy of the GNU General *
- * Public License  distributed with GNAT;  see file COPYING.  If not, write *
- * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
- * Boston, MA 02110-1301, USA.                                              *
+ * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
  *                                                                          *
- * As a  special  exception,  if you  link  this file  with other  files to *
- * produce an executable,  this file does not by itself cause the resulting *
- * executable to be covered by the GNU General Public License. This except- *
- * ion does not  however invalidate  any other reasons  why the  executable *
- * file might be covered by the  GNU Public License.                        *
+ * As a special exception under Section 7 of GPL version 3, you are granted *
+ * additional permissions described in the GCC Runtime Library Exception,   *
+ * version 3.1, as published by the Free Software Foundation.               *
+ *                                                                          *
+ * You should have received a copy of the GNU General Public License and    *
+ * a copy of the GCC Runtime Library Exception along with this program;     *
+ * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
+ * <http://www.gnu.org/licenses/>.                                          *
  *                                                                          *
  * GNAT was originally developed  by the GNAT team at  New York University. *
  * Extensive contributions were provided by Ada Core Technologies Inc.      *
@@ -35,6 +34,7 @@
 
 #ifdef IN_RTS
 #include "tconfig.h"
+#include "tsystem.h"
 /* In the top-of-tree GCC, tconfig does not include tm.h, but in GCC 3.2
    it does.  To avoid branching raise.c just for that purpose, we kludge by
    looking for a symbol always defined by tm.h and if it's not defined,
@@ -43,7 +43,6 @@
 #include "coretypes.h"
 #include "tm.h"
 #endif
-#include "tsystem.h"
 #include <sys/stat.h>
 #include <stdarg.h>
 typedef char bool;
@@ -362,7 +361,7 @@ db_phases (int phases)
    context stack and not the actual call chain.
 
    The ACTION and TTYPES tables remain unchanged, which allows to search them
-   during the propagation phase to determine wether or not the propagated
+   during the propagation phase to determine whether or not the propagated
    exception is handled somewhere. When it is, we only "jump" up once directly
    to the context where the handler will be found. Besides, this allows "break
    exception unhandled" to work also
@@ -663,16 +662,21 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
   return;
 }
 
-
 /* Search the call_site_table of REGION for an entry appropriate for the
-   UW_CONTEXT's ip. If one is found, store the associated landing_pad and
-   action_table entry, and set the ACTION kind to unknown for further
-   analysis. Otherwise, set the ACTION kind to nothing.
+   UW_CONTEXT's IP.  If one is found, store the associated landing_pad
+   and action_table entry, and set the ACTION kind to unknown for further
+   analysis.  Otherwise, set the ACTION kind to nothing.
 
    There are two variants of this routine, depending on the underlying
-   mechanism (dwarf/sjlj), which account for differences in the tables
-   organization.
-*/
+   mechanism (DWARF/SJLJ), which account for differences in the tables.  */
+
+#ifdef __APPLE__
+/* On MacOS X, versions older than 10.5 don't export _Unwind_GetIPInfo.  */
+#undef HAVE_GETIPINFO
+#if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1050
+#define HAVE_GETIPINFO 1
+#endif
+#endif
 
 #ifdef __USING_SJLJ_EXCEPTIONS__
 
@@ -683,14 +687,21 @@ get_call_site_action_for (_Unwind_Context *uw_context,
                           region_descriptor *region,
                           action_descriptor *action)
 {
-  _Unwind_Ptr call_site
-    = _Unwind_GetIP (uw_context) - 1;
-  /* Subtract 1 because GetIP returns the actual call_site value + 1.  */
+  int ip_before_insn = 0;
+#ifdef HAVE_GETIPINFO
+  _Unwind_Ptr call_site = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
+#else
+  _Unwind_Ptr call_site = _Unwind_GetIP (uw_context);
+#endif
+  /* Subtract 1 if necessary because GetIPInfo returns the actual call site
+     value + 1 in this case.  */
+  if (!ip_before_insn)
+    call_site--;
 
   /* call_site is a direct index into the call-site table, with two special
-     values : -1 for no-action and 0 for "terminate". The latter should never
-     show up for Ada. To test for the former, beware that _Unwind_Ptr might be
-     unsigned.  */
+     values : -1 for no-action and 0 for "terminate".  The latter should never
+     show up for Ada.  To test for the former, beware that _Unwind_Ptr might
+     be unsigned.  */
 
   if ((int)call_site < 0)
     {
@@ -712,18 +723,17 @@ get_call_site_action_for (_Unwind_Context *uw_context,
       action->kind = unknown;
 
       /* We have a direct index into the call-site table, but this table is
-        made of leb128 values, the encoding length of which is variable. We
+        made of leb128 values, the encoding length of which is variable.  We
         can't merely compute an offset from the index, then, but have to read
         all the entries before the one of interest.  */
 
-      const unsigned char * p = region->call_site_table;
+      const unsigned char *p = region->call_site_table;
 
       do {
        p = read_uleb128 (p, &cs_lp);
        p = read_uleb128 (p, &cs_action);
       } while (--call_site);
 
-
       action->landing_pad = cs_lp + 1;
 
       if (cs_action)
@@ -735,29 +745,28 @@ get_call_site_action_for (_Unwind_Context *uw_context,
     }
 }
 
-#else
-/* ! __USING_SJLJ_EXCEPTIONS__ */
+#else /* !__USING_SJLJ_EXCEPTIONS__  */
 
 static void
 get_call_site_action_for (_Unwind_Context *uw_context,
                           region_descriptor *region,
                           action_descriptor *action)
 {
-  _Unwind_Ptr ip
-    = _Unwind_GetIP (uw_context) - 1;
-  /* Subtract 1 because GetIP yields a call return address while we are
-     interested in information for the call point. This does not always yield
-     the exact call instruction address but always brings the ip back within
-     the corresponding region.
-
-     ??? When unwinding up from a signal handler triggered by a trap on some
-     instruction, we usually have the faulting instruction address here and
-     subtracting 1 might get us into the wrong region.  */
-
-  const unsigned char * p
-    = region->call_site_table;
-
-  /* Unless we are able to determine otherwise ... */
+  const unsigned char *p = region->call_site_table;
+  int ip_before_insn = 0;
+#ifdef HAVE_GETIPINFO
+  _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
+#else
+  _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
+#endif
+  /* Subtract 1 if necessary because GetIPInfo yields a call return address
+     in this case, while we are interested in information for the call point.
+     This does not always yield the exact call instruction address but always
+     brings the IP back within the corresponding region.  */
+  if (!ip_before_insn)
+    ip--;
+
+  /* Unless we are able to determine otherwise...  */
   action->kind = nothing;
 
   db (DB_CSITE, "\n");
@@ -778,7 +787,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
          region->base+cs_start, cs_start, cs_len,
          region->lp_base+cs_lp, cs_lp);
 
-      /* The table is sorted, so if we've passed the ip, stop.  */
+      /* The table is sorted, so if we've passed the IP, stop.  */
       if (ip < region->base + cs_start)
        break;
 
@@ -807,11 +816,11 @@ get_call_site_action_for (_Unwind_Context *uw_context,
   db (DB_CSITE, "---\n");
 }
 
-#endif
+#endif /* __USING_SJLJ_EXCEPTIONS__  */
 
 /* With CHOICE an exception choice representing an "exception - when"
    argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
-   occurrence, return true iif the latter matches the former, that is, if
+   occurrence, return true if the latter matches the former, that is, if
    PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
    This takes care of the special Non_Ada_Error case on VMS.  */
 
@@ -1135,7 +1144,7 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
   /* If we are going to install a cleanup context, decrement the cleanup
      count.  This is required in a FORCED_UNWINDing phase (for an unhandled
      exception), as this is used from the forced unwinding handler in
-     Ada.Exceptions.Exception_Propagation to decide wether unwinding should
+     Ada.Exceptions.Exception_Propagation to decide whether unwinding should
      proceed further or Unhandled_Exception_Terminate should be called.  */
   if (action.kind == cleanup)
     Adjust_N_Cleanups_For (gnat_exception, -1);