* *
* C Implementation File *
* *
- * Copyright (C) 1992-2005, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2011, 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. *
#ifdef IN_RTS
#include "tconfig.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,
- we include it. */
-#ifndef FIRST_PSEUDO_REGISTER
-#include "coretypes.h"
-#include "tm.h"
-#endif
#include "tsystem.h"
#include <sys/stat.h>
#include <stdarg.h>
#include "adaint.h"
#include "raise.h"
+#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
+
/* The names of a couple of "standard" routines for unwinding/propagation
actually vary depending on the underlying GCC scheme for exception handling
(SJLJ or DWARF). We need a consistently named interface to import from
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
+extern void __gnat_setup_current_excep (_Unwind_Exception *);
#ifdef IN_RTS /* For eh personality routine */
#include "unwind-dw2-fde.h"
#include "unwind-pe.h"
+/* The known and handled exception classes. */
+
+#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
+#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
typedef struct
{
_Unwind_Action phase;
- char * description;
+ const char * description;
} phase_descriptor;
-static phase_descriptor phase_descriptors[]
+static const phase_descriptor phase_descriptors[]
= {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
{ _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
{ _UA_HANDLER_FRAME, "HANDLER_FRAME" },
static void
db_phases (int phases)
{
- phase_descriptor *a = phase_descriptors;
+ const phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes() & DB_PHASES))
return;
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
===================================
The major point of this unit is to provide an exception propagation
- personality routine for Ada. This is __gnat_eh_personality.
+ personality routine for Ada. This is __gnat_personality_v0.
It is provided with a pointer to the propagated exception, an unwind
context describing a location the propagation is going through, and a
|
| (Ada frame)
|
- +--> __gnat_eh_personality (context, exception)
+ +--> __gnat_personality_v0 (context, exception)
|
+--> get_region_descriptor_for (context)
|
} region_descriptor;
+/* Extract and adjust the IP (instruction pointer) from an exception
+ context. */
+
+static _Unwind_Ptr
+get_ip_from_context (_Unwind_Context *uw_context)
+{
+ 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--;
+
+ return ip;
+}
+
static void
db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
{
- _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+ _Unwind_Ptr ip;
if (! (db_accepted_codes () & DB_REGIONS))
return;
+ ip = get_ip_from_context (uw_context);
+
db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
if (region->lsda)
} action_kind;
/* filter value for cleanup actions. */
-const int cleanup_filter = 0;
+static const int cleanup_filter = 0;
typedef struct
{
static void
db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
{
- _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+ _Unwind_Ptr ip = get_ip_from_context (uw_context);
db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
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 __USING_SJLJ_EXCEPTIONS__
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. */
+ _Unwind_Ptr call_site = get_ip_from_context (uw_context);
/* 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)
{
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)
}
}
-#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;
+ _Unwind_Ptr ip = get_ip_from_context (uw_context);
- const unsigned char * p
- = region->call_site_table;
-
- /* Unless we are able to determine otherwise ... */
+ /* Unless we are able to determine otherwise... */
action->kind = nothing;
db (DB_CSITE, "\n");
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;
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. */
#define Language_For __gnat_language_for
#define Import_Code_For __gnat_import_code_for
#define EID_For __gnat_eid_for
-#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
extern char Language_For (_Unwind_Ptr eid);
extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
extern Exception_Id EID_For (_GNAT_Exception * e);
-extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
static int
is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
{
- /* Pointer to the GNAT exception data corresponding to the propagated
- occurrence. */
- _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
-
- /* Base matching rules: An exception data (id) matches itself, "when
- all_others" matches anything and "when others" matches anything unless
- explicitly stated otherwise in the propagated occurrence. */
-
- bool is_handled =
- choice == E
- || choice == GNAT_ALL_OTHERS
- || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
-
- /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
- may have different exception data pointers that should match for the
- same condition code, if both an export and an import have been
- registered. The import code for both the choice and the propagated
- occurrence are expected to have been masked off regarding severity
- bits already (at registration time for the former and from within the
- low level exception vector for the latter). */
+ if (propagated_exception->common.exception_class == GNAT_EXCEPTION_CLASS)
+ {
+ /* Pointer to the GNAT exception data corresponding to the propagated
+ occurrence. */
+ _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
+
+ /* Base matching rules: An exception data (id) matches itself, "when
+ all_others" matches anything and "when others" matches anything
+ unless explicitly stated otherwise in the propagated occurrence. */
+
+ bool is_handled =
+ choice == E
+ || choice == GNAT_ALL_OTHERS
+ || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
+
+ /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
+ may have different exception data pointers that should match for the
+ same condition code, if both an export and an import have been
+ registered. The import code for both the choice and the propagated
+ occurrence are expected to have been masked off regarding severity
+ bits already (at registration time for the former and from within the
+ low level exception vector for the latter). */
#ifdef VMS
- #define Non_Ada_Error system__aux_dec__non_ada_error
- extern struct Exception_Data Non_Ada_Error;
-
- is_handled |=
- (Language_For (E) == 'V'
- && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
- && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
- && Import_Code_For (choice) == Import_Code_For (E))
- || choice == (_Unwind_Ptr)&Non_Ada_Error));
+# define Non_Ada_Error system__aux_dec__non_ada_error
+ extern struct Exception_Data Non_Ada_Error;
+
+ is_handled |=
+ (Language_For (E) == 'V'
+ && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
+ && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
+ && Import_Code_For (choice) == Import_Code_For (E))
+ || choice == (_Unwind_Ptr)&Non_Ada_Error));
#endif
- return is_handled;
+ return is_handled;
+ }
+ else
+ {
+# define Foreign_Exception system__exceptions__foreign_exception;
+ extern struct Exception_Data Foreign_Exception;
+
+ return choice == GNAT_ALL_OTHERS
+ || choice == GNAT_OTHERS
+ || choice == (_Unwind_Ptr)&Foreign_Exception;
+ }
}
/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
static void
get_action_description_for (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
+ _Unwind_Action uw_phase,
region_descriptor *region,
action_descriptor *action)
{
/* Positive filters are for regular handlers. */
else if (ar_filter > 0)
{
- /* See if the filter we have is for an exception which matches
- the one we are propagating. */
- _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
-
- if (is_handled_by (choice, gnat_exception))
- {
- action->kind = handler;
- action->ttype_filter = ar_filter;
- action->ttype_entry = choice;
- return;
- }
+ /* Do not catch an exception if the _UA_FORCE_UNWIND flag is
+ passed (to follow the ABI). */
+ if (!(uw_phase & _UA_FORCE_UNWIND))
+ {
+ /* See if the filter we have is for an exception which
+ matches the one we are propagating. */
+ _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
+
+ if (is_handled_by (choice, gnat_exception))
+ {
+ action->kind = handler;
+ action->ttype_filter = ar_filter;
+ action->ttype_entry = choice;
+ return;
+ }
+ }
}
/* Negative filter values are for C++ exception specifications.
_Unwind_Ptr uw_landing_pad,
int uw_filter)
{
-#ifndef EH_RETURN_DATA_REGNO
- /* We should not be called if the appropriate underlying support is not
- there. */
- abort ();
-#else
/* 1/ exception object pointer, which might be provided back to
_Unwind_Resume (and thus to this personality routine) if we are jumping
to a cleanup. */
/* Setup the address we should jump at to reach the code where there is the
"something" we found. */
_Unwind_SetIP (uw_context, uw_landing_pad);
-#endif
}
/* The following is defined from a-except.adb. Its purpose is to enable
/* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */
+#ifdef __USING_SJLJ_EXCEPTIONS__
+#define PERSONALITY_FUNCTION __gnat_personality_sj0
+#else
+#define PERSONALITY_FUNCTION __gnat_personality_v0
+#endif
+
+/* Major tweak for ia64-vms : the CHF propagation phase calls this personality
+ routine with sigargs/mechargs arguments and has very specific expectations
+ on possible return values.
+
+ We handle this with a number of specific tricks:
+
+ 1. We tweak the personality routine prototype to have the "version" and
+ "phases" two first arguments be void * instead of int and _Unwind_Action
+ as nominally expected in the GCC context.
+
+ This allows us to access the full range of bits passed in every case and
+ has no impact on the callers side since each argument remains assigned
+ the same single 64bit slot.
+
+ 2. We retrieve the corresponding int and _Unwind_Action values within the
+ routine for regular use with truncating conversions. This is a noop when
+ called from the libgcc unwinder.
+
+ 3. We assume we're called by the VMS CHF when unexpected bits are set in
+ both those values. The incoming arguments are then real sigargs and
+ mechargs pointers, which we then redirect to __gnat_handle_vms_condition
+ for proper processing.
+*/
+#if defined (VMS) && defined (__IA64)
+typedef void * version_arg_t;
+typedef void * phases_arg_t;
+#else
+typedef int version_arg_t;
+typedef _Unwind_Action phases_arg_t;
+#endif
+
_Unwind_Reason_Code
-__gnat_eh_personality (int uw_version,
- _Unwind_Action uw_phases,
- _Unwind_Exception_Class uw_exception_class,
- _Unwind_Exception *uw_exception,
- _Unwind_Context *uw_context)
-{
- _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
+PERSONALITY_FUNCTION (version_arg_t, phases_arg_t,
+ _Unwind_Exception_Class, _Unwind_Exception *,
+ _Unwind_Context *);
+_Unwind_Reason_Code
+PERSONALITY_FUNCTION (version_arg_t version_arg,
+ phases_arg_t phases_arg,
+ _Unwind_Exception_Class uw_exception_class,
+ _Unwind_Exception *uw_exception,
+ _Unwind_Context *uw_context)
+{
+ /* Fetch the version and phases args with their nominal ABI types for later
+ use. This is a noop everywhere except on ia64-vms when called from the
+ Condition Handling Facility. */
+ int uw_version = (int) version_arg;
+ _Unwind_Action uw_phases = (_Unwind_Action) phases_arg;
region_descriptor region;
action_descriptor action;
+ /* Check that we're called from the ABI context we expect, with a major
+ possible variation on VMS for IA64. */
if (uw_version != 1)
- return _URC_FATAL_PHASE1_ERROR;
+ {
+#if defined (VMS) && defined (__IA64)
+
+ /* Assume we're called with sigargs/mechargs arguments if really
+ unexpected bits are set in our first two formals. Redirect to the
+ GNAT condition handling code in this case. */
+
+ extern long __gnat_handle_vms_condition (void *, void *);
+
+ unsigned int version_unexpected_bits_mask = 0xffffff00U;
+ unsigned int phases_unexpected_bits_mask = 0xffffff00U;
+
+ if ((unsigned int)uw_version & version_unexpected_bits_mask
+ && (unsigned int)uw_phases & phases_unexpected_bits_mask)
+ return __gnat_handle_vms_condition (version_arg, phases_arg);
+#endif
+
+ return _URC_FATAL_PHASE1_ERROR;
+ }
db_indent (DB_INDENT_RESET);
db_phases (uw_phases);
/* Search the call-site and action-record tables for the action associated
with this IP. */
- get_action_description_for (uw_context, uw_exception, ®ion, &action);
+ get_action_description_for (uw_context, uw_exception, uw_phases,
+ ®ion, &action);
db_action_for (&action, uw_context);
/* Whatever the phase, if there is nothing relevant in this frame,
{
if (action.kind == cleanup)
{
- Adjust_N_Cleanups_For (gnat_exception, 1);
return _URC_CONTINUE_UNWIND;
}
else
{
/* Trigger the appropriate notification routines before the second
- phase starts, which ensures the stack is still intact. */
+ phase starts, which ensures the stack is still intact.
+ First, setup the Ada occurrence. */
+ __gnat_setup_current_excep (uw_exception);
__gnat_notify_handled_exception ();
return _URC_HANDLER_FOUND;
occurrence (we are in a FORCED_UNWIND phase in this case). Install the
context to get there. */
- /* 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
- proceed further or Unhandled_Exception_Terminate should be called. */
- if (action.kind == cleanup)
- Adjust_N_Cleanups_For (gnat_exception, -1);
-
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
+ /* Write current exception, so that it can be retrieved from Ada. */
+ __gnat_setup_current_excep (uw_exception);
+
return _URC_INSTALL_CONTEXT;
}
OSDN Git Service
