Google Git
Sign in
gnu / gcc / 93d183a5fff92d80c0545b7a7ce9b77fe7a258f7 / . / gcc / ada / raise-gcc.c
blob: 5fdd76fdccb105190ff3c23a7d8fe8e0568814ca [file] [log] [blame]
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* R A I S E - G C C *
* *
* C Implementation File *
* *
* Copyright (C) 1992-2021, 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 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. *
* *
* 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. *
* *
****************************************************************************/
/* Code related to the integration of the GCC mechanism for exception
handling. */
#ifndef IN_RTS
/* For gnat1/gnatbind compilation: use host headers. */
# include "config.h"
# include "system.h"
/* Don't use fancy_abort. */
# undef abort
#else
# if !defined(CERT) && !defined(STANDALONE)
# include "tconfig.h"
# include "tsystem.h"
# else
# include "runtime.h"
# define HAVE_GETIPINFO 1
# endif
#endif
#ifdef __cplusplus
# include <cstdarg>
# include <cstdlib>
#else
# include <stdarg.h>
# include <stdbool.h>
# include <stdlib.h>
#endif
#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
#if defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
/* HP-UX B.11.31 ia64 libunwind doesn't have _Unwind_GetIPInfo. */
#undef HAVE_GETIPINFO
#define _UA_END_OF_STACK 0
#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
a-except, so wrappers are defined here. */
#ifdef __CYGWIN__
/* Prevent compile error due to unwind-generic.h including <windows.h>,
see comment above #include <windows.h> in mingw32.h. */
#include "mingw32.h"
#endif
#ifndef IN_RTS
/* For gnat1/gnatbind compilation: cannot use unwind.h, as it is for the
target. So mimic configure...
This is a hack ???, the real fix is to link gnat1/gnatbind with the
runtime of the build compiler. */
# ifdef EH_MECHANISM_arm
# include "config/arm/unwind-arm.h"
# else
# include "unwind-generic.h"
# endif
#else
# include "unwind.h"
#endif
#ifdef __cplusplus
extern "C" {
#endif
typedef struct _Unwind_Context _Unwind_Context;
typedef struct _Unwind_Exception _Unwind_Exception;
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *);
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, _Unwind_Stop_Fn, void *);
extern struct Exception_Occurrence *
__gnat_setup_current_excep (_Unwind_Exception *, _Unwind_Action);
extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
#ifdef CERT
/* Called in case of error during propagation. */
extern void __gnat_raise_abort (void) __attribute__ ((noreturn));
#define abort() __gnat_raise_abort()
#elif defined(STANDALONE)
#define inhibit_libc
#endif
#include "unwind-pe.h"
#ifdef __ARM_EABI_UNWINDER__
/* for memcmp */
#include <string.h>
#endif
/* The known and handled exception classes. */
#ifdef __ARM_EABI_UNWINDER__
#define CXX_EXCEPTION_CLASS "GNUCC++"
#define GNAT_EXCEPTION_CLASS "GNU-Ada"
#else
#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
#endif
/* Structure of a C++ exception, represented as a C structure... See
unwind-cxx.h for the full definition. */
struct __cxa_exception
{
void *exceptionType;
void (*exceptionDestructor)(void *);
void (*unexpectedHandler)();
void (*terminateHandler)();
struct __cxa_exception *nextException;
int handlerCount;
#ifdef __ARM_EABI_UNWINDER__
struct __cxa_exception* nextPropagatingException;
int propagationCount;
#else
int handlerSwitchValue;
const unsigned char *actionRecord;
const unsigned char *languageSpecificData;
_Unwind_Ptr catchTemp;
void *adjustedPtr;
#endif
_Unwind_Exception unwindHeader;
};
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
#ifndef inhibit_libc
#define DB_PHASES 0x1
#define DB_CSITE 0x2
#define DB_ACTIONS 0x4
#define DB_REGIONS 0x8
#define DB_ERR 0x1000
/* The "action" stuff below is also there for debugging purposes only. */
typedef struct
{
_Unwind_Action phase;
const char * description;
} phase_descriptor;
static const phase_descriptor phase_descriptors[]
= {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
{ _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
{ _UA_HANDLER_FRAME, "HANDLER_FRAME" },
{ _UA_FORCE_UNWIND, "FORCE_UNWIND" },
{ -1, 0}};
static int
db_accepted_codes (void)
{
static int accepted_codes = -1;
if (accepted_codes == -1)
{
char * db_env = (char *) getenv ("EH_DEBUG");
accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
/* Arranged for ERR stuff to always be visible when the variable
is defined. One may just set the variable to 0 to see the ERR
stuff only. */
}
return accepted_codes;
}
#define DB_INDENT_INCREASE 0x01
#define DB_INDENT_DECREASE 0x02
#define DB_INDENT_OUTPUT 0x04
#define DB_INDENT_NEWLINE 0x08
#define DB_INDENT_RESET 0x10
#define DB_INDENT_UNIT 8
static void
db_indent (int requests)
{
static int current_indentation_level = 0;
if (requests & DB_INDENT_RESET)
current_indentation_level = 0;
if (requests & DB_INDENT_INCREASE)
current_indentation_level ++;
if (requests & DB_INDENT_DECREASE)
current_indentation_level --;
if (requests & DB_INDENT_NEWLINE)
fprintf (stderr, "\n");
if (requests & DB_INDENT_OUTPUT)
fprintf (stderr, "%*s", current_indentation_level * DB_INDENT_UNIT, " ");
}
static void ATTRIBUTE_PRINTF_2
db (int db_code, const char * msg_format, ...)
{
if (db_accepted_codes () & db_code)
{
va_list msg_args;
db_indent (DB_INDENT_OUTPUT);
va_start (msg_args, msg_format);
vfprintf (stderr, msg_format, msg_args);
va_end (msg_args);
}
}
static void
db_phases (int phases)
{
const phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes () & DB_PHASES))
return;
db (DB_PHASES, "\n");
for (; a->description != 0; a++)
if (phases & a->phase)
db (DB_PHASES, "%s ", a->description);
db (DB_PHASES, " :\n");
}
#else /* !inhibit_libc */
#define db_phases(X)
#define db_indent(X)
#define db(X, ...)
#endif /* !inhibit_libc */
/* ---------------------------------------------------------------
-- Now come a set of useful structures and helper routines. --
--------------------------------------------------------------- */
/* There are three major runtime tables involved, generated by the
GCC back-end. Contents slightly vary depending on the underlying
implementation scheme (dwarf zero cost / sjlj).
=======================================
* Tables for the dwarf zero cost case *
=======================================
They are fully documented in:
http://sourcery.mentor.com/public/cxx-abi/exceptions.pdf
Here is a shorter presentation, with some specific comments for Ada.
call_site []
-------------------------------------------------------------------
* region-start | region-length | landing-pad | first-action-index *
-------------------------------------------------------------------
Identify possible actions to be taken and where to resume control
for that when an exception propagates through a pc inside the region
delimited by start and length.
A null landing-pad indicates that nothing is to be done.
Otherwise, first-action-index provides an entry into the action[]
table which heads a list of possible actions to be taken (see below).
If it is determined that indeed an action should be taken, that
is, if one action filter matches the exception being propagated,
then control should be transferred to landing-pad.
A null first-action-index indicates that there are only cleanups
to run there.
action []
-------------------------------
* action-filter | next-action *
-------------------------------
This table contains lists (called action chains) of possible actions
associated with call-site entries described in the call-site [] table.
There is at most one action list per call-site entry. It is SLEB128
encoded.
A null action-filter indicates a cleanup.
Non null action-filters provide an index into the ttypes [] table
(see below), from which information may be retrieved to check if it
matches the exception being propagated.
* action-filter > 0:
means there is a regular handler to be run The value is also passed
to the landing pad to dispatch the exception.
* action-filter < 0:
means there is a some "exception_specification" data to retrieve,
which is only relevant for C++ and should never show up for Ada.
(Exception specification specifies which exceptions can be thrown
by a function. Such filter is emitted around the body of C++
functions defined like:
void foo ([...]) throw (A, B) { [...] }
These can be viewed as negativ filter: the landing pad is branched
to for exceptions that doesn't match the filter and usually aborts
the program).
* next-action
points to the next entry in the list using a relative byte offset. 0
indicates there is no other entry.
ttypes []
---------------
* ttype-value *
---------------
This table is an array of addresses.
A null value indicates a catch-all handler. (Not used by Ada)
Non null values are used to match the exception being propagated:
In C++ this is a pointer to some rtti data, while in Ada this is an
exception id (with a fake id for others).
For C++, this table is actually also used to store "exception
specification" data. The differentiation between the two kinds
of entries is made by the sign of the associated action filter,
which translates into positive or negative offsets from the
so called base of the table:
Exception Specification data is stored at positive offsets from
the ttypes table base, which Exception Type data is stored at
negative offsets:
---------------------------------------------------------------------------
Here is a quick summary of the tables organization:
+-- Unwind_Context (pc, ...)
|
|(pc)
|
| CALL-SITE[]
|
| +=============================================================+
| | region-start + length | landing-pad | first-action-index |
| +=============================================================+
+-> | pc range 0 => no-action 0 => cleanups only |
| !0 => jump @ N --+ |
+====================================================== | ====+
|
|
ACTION [] |
|
+==========================================================+ |
| action-filter | next-action | |
+==========================================================+ |
| 0 => cleanup | |
| >0 => ttype index for handler ------+ 0 => end of chain | <-+
| <0 => ttype index for spec data | |
+==================================== | ===================+
|
|
TTYPES [] |
| Offset negated from
+=====================+ | the actual base.
| ttype-value | |
+============+=====================+ |
| | ... | |
| ... | exception id | <---+
| | ... |
| handlers +---------------------+
| | ... |
| ... | ... |
| | ... |
+============+=====================+ <<------ Table base
| ... | ... |
| specs | ... | (should not see negative filter
| ... | ... | values for Ada).
+============+=====================+
============================
* Tables for the sjlj case *
============================
So called "function contexts" are pushed on a context stack by calls to
_Unwind_SjLj_Register on function entry, and popped off at exit points by
calls to _Unwind_SjLj_Unregister. The current call_site for a function is
updated in the function context as the function's code runs along.
The generic unwinding engine in _Unwind_RaiseException walks the function
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 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 CALL-SITE table is setup differently, though: the pc attached to the
unwind context is a direct index into the table, so the entries in this
table do not hold region bounds any more.
A special index (-1) is used to indicate that no action is possibly
connected with the context at hand, so null landing pads cannot appear
in the table.
Additionally, landing pad values in the table do not represent code address
to jump at, but so called "dispatch" indices used by a common landing pad
for the function to switch to the appropriate post-landing-pad.
+-- Unwind_Context (pc, ...)
|
| pc = call-site index
| 0 => terminate (should not see this for Ada)
| -1 => no-action
|
| CALL-SITE[]
|
| +=====================================+
| | landing-pad | first-action-index |
| +=====================================+
+-> | 0 => cleanups only |
| dispatch index N |
+=====================================+
===================================
* Basic organization of this unit *
===================================
The major point of this unit is to provide an exception propagation
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
couple of other arguments including a description of the current
propagation phase.
It shall return to the generic propagation engine what is to be performed
next, after possible context adjustments, depending on what it finds in the
traversed context (a handler for the exception, a cleanup, nothing, ...),
and on the propagation phase.
A number of structures and subroutines are used for this purpose, as
sketched below:
o region_descriptor: General data associated with the context (base pc,
call-site table, action table, ttypes table, ...)
o action_descriptor: Data describing the action to be taken for the
propagated exception in the provided context (kind of action: nothing,
handler, cleanup; pointer to the action table entry, ...).
raise
|
... (a-except.adb)
|
Propagate_Exception (a-exexpr.adb)
|
|
_Unwind_RaiseException (libgcc)
|
| (Ada frame)
|
+--> __gnat_personality_v0 (context, exception)
|
+--> get_region_description_for (context)
|
+--> get_action_description_for (ip, exception, region)
| |
| +--> get_call_site_action_for (context, region)
| (one version for each underlying scheme)
|
+--> setup_to_install (context)
This unit is inspired from the C++ version found in eh_personality.cc,
part of libstdc++-v3.
*/
/* This is an incomplete "proxy" of the structure of exception objects as
built by the GNAT runtime library. Accesses to other fields than the common
header are performed through subprogram calls to alleviate the need of an
exact counterpart here and potential alignment/size issues for the common
header. See a-exexpr.adb. */
typedef struct
{
_Unwind_Exception common;
/* ABI header, maximally aligned. */
} _GNAT_Exception;
/* The three constants below are specific ttype identifiers for special
exception ids. Their type should match what a-exexpr exports. */
extern char __gnat_others_value;
#define GNAT_OTHERS ((Exception_Id) &__gnat_others_value)
extern char __gnat_all_others_value;
#define GNAT_ALL_OTHERS ((Exception_Id) &__gnat_all_others_value)
extern char __gnat_unhandled_others_value;
#define GNAT_UNHANDLED_OTHERS ((Exception_Id) &__gnat_unhandled_others_value)
/* Describe the useful region data associated with an unwind context. */
typedef struct
{
/* The base pc of the region. */
_Unwind_Ptr base;
/* Pointer to the Language Specific Data for the region. */
_Unwind_Ptr lsda;
/* Call-Site data associated with this region. */
unsigned char call_site_encoding;
const unsigned char *call_site_table;
/* The base to which are relative landing pad offsets inside the call-site
entries . */
_Unwind_Ptr lp_base;
/* Action-Table associated with this region. */
const unsigned char *action_table;
/* Ttype data associated with this region. */
unsigned char ttype_encoding;
const unsigned char *ttype_table;
_Unwind_Ptr ttype_base;
} 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_Ptr ip)
{
#ifndef inhibit_libc
if (! (db_accepted_codes () & DB_REGIONS))
return;
db (DB_REGIONS, "For ip @ %p => ", (void *)ip);
if (region->lsda)
db (DB_REGIONS, "lsda @ %p", (void *)region->lsda);
else
db (DB_REGIONS, "no lsda");
db (DB_REGIONS, "\n");
#endif
}
/* Retrieve the ttype entry associated with FILTER in the REGION's
ttype table. */
static _Unwind_Ptr
get_ttype_entry_for (region_descriptor *region, long filter)
{
_Unwind_Ptr ttype_entry;
filter *= size_of_encoded_value (region->ttype_encoding);
read_encoded_value_with_base
(region->ttype_encoding, region->ttype_base,
region->ttype_table - filter, &ttype_entry);
return ttype_entry;
}
/* Fill out the REGION descriptor for the provided UW_CONTEXT. */
static void
get_region_description_for (_Unwind_Context *uw_context,
region_descriptor *region)
{
const unsigned char * p;
_uleb128_t tmp;
unsigned char lpbase_encoding;
/* Get the base address of the lsda information. If the provided context
is null or if there is no associated language specific data, there's
nothing we can/should do. */
region->lsda
= (_Unwind_Ptr) (uw_context
? _Unwind_GetLanguageSpecificData (uw_context) : 0);
if (! region->lsda)
return;
/* Parse the lsda and fill the region descriptor. */
p = (const unsigned char *)region->lsda;
region->base = _Unwind_GetRegionStart (uw_context);
/* Find @LPStart, the base to which landing pad offsets are relative. */
lpbase_encoding = *p++;
if (lpbase_encoding != DW_EH_PE_omit)
p = read_encoded_value
(uw_context, lpbase_encoding, p, &region->lp_base);
else
region->lp_base = region->base;
/* Find @TType, the base of the handler and exception spec type data. */
region->ttype_encoding = *p++;
if (region->ttype_encoding != DW_EH_PE_omit)
{
p = read_uleb128 (p, &tmp);
region->ttype_table = p + tmp;
}
else
region->ttype_table = 0;
region->ttype_base
= base_of_encoded_value (region->ttype_encoding, uw_context);
/* Get the encoding and length of the call-site table; the action table
immediately follows. */
region->call_site_encoding = *p++;
region->call_site_table = read_uleb128 (p, &tmp);
region->action_table = region->call_site_table + tmp;
}
/* Describe an action to be taken when propagating an exception up to
some context. */
enum action_kind
{
/* Found some call site base data, but need to analyze further
before being able to decide. */
unknown,
/* There is nothing relevant in the context at hand. */
nothing,
/* There are only cleanups to run in this context. */
cleanup,
/* There is a handler for the exception in this context. */
handler,
/* There is a handler for the exception, but it is only for catching
unhandled exceptions. */
unhandler
};
/* filter value for cleanup actions. */
static const int cleanup_filter = 0;
typedef struct
{
/* The kind of action to be taken. */
enum action_kind kind;
/* A pointer to the action record entry. */
const unsigned char *table_entry;
/* Where we should jump to actually take an action (trigger a cleanup or an
exception handler). */
_Unwind_Ptr landing_pad;
/* If we have a handler matching our exception, these are the filter to
trigger it and the corresponding id. */
_Unwind_Sword ttype_filter;
} action_descriptor;
static void
db_action_for (action_descriptor *action, _Unwind_Ptr ip)
{
#ifndef inhibit_libc
db (DB_ACTIONS, "For ip @ %p => ", (void *)ip);
switch (action->kind)
{
case unknown:
db (DB_ACTIONS, "lpad @ %p, record @ %p\n",
(void *) action->landing_pad, action->table_entry);
break;
case nothing:
db (DB_ACTIONS, "Nothing\n");
break;
case cleanup:
db (DB_ACTIONS, "Cleanup\n");
break;
case handler:
db (DB_ACTIONS, "Handler, filter = %d\n", (int) action->ttype_filter);
break;
default:
db (DB_ACTIONS, "Err? Unexpected action kind !\n");
break;
}
#endif
}
/* 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.
There are two variants of this routine, depending on the underlying
mechanism (DWARF/SJLJ), which account for differences in the tables. */
#ifdef __USING_SJLJ_EXCEPTIONS__
#define __builtin_eh_return_data_regno(x) x
static void
get_call_site_action_for (_Unwind_Ptr call_site,
region_descriptor *region,
action_descriptor *action)
{
/* 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. */
if ((int)call_site < 0)
{
action->kind = nothing;
}
else if (call_site == 0)
{
db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
action->kind = nothing;
}
else
{
_uleb128_t cs_lp, cs_action;
const unsigned char *p;
/* Let the caller know there may be an action to take, but let it
determine the kind. */
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
can't merely compute an offset from the index, then, but have to read
all the entries before the one of interest. */
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)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
}
}
#else /* !__USING_SJLJ_EXCEPTIONS__ */
static void
get_call_site_action_for (_Unwind_Ptr ip,
region_descriptor *region,
action_descriptor *action)
{
const unsigned char *p = region->call_site_table;
/* Unless we are able to determine otherwise... */
action->kind = nothing;
db (DB_CSITE, "\n");
while (p < region->action_table)
{
_Unwind_Ptr cs_start, cs_len, cs_lp;
_uleb128_t cs_action;
/* Note that all call-site encodings are "absolute" displacements. */
p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
p = read_uleb128 (p, &cs_action);
db (DB_CSITE,
"c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
(char *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
(char *)region->lp_base + cs_lp, (void *)cs_lp);
/* The table is sorted, so if we've passed the IP, stop. */
if (ip < region->base + cs_start)
break;
/* If we have a match, fill the ACTION fields accordingly. */
else if (ip < region->base + cs_start + cs_len)
{
/* Let the caller know there may be an action to take, but let it
determine the kind. */
action->kind = unknown;
if (cs_lp)
action->landing_pad = region->lp_base + cs_lp;
else
action->landing_pad = 0;
if (cs_action)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
db (DB_CSITE, "+++\n");
return;
}
}
db (DB_CSITE, "---\n");
}
#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 if the latter matches the former, that is, if
PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
*/
#define Is_Handled_By_Others __gnat_is_handled_by_others
#define Language_For __gnat_language_for
#define Foreign_Data_For __gnat_foreign_data_for
#define EID_For __gnat_eid_for
extern bool Is_Handled_By_Others (Exception_Id eid);
extern char Language_For (Exception_Id eid);
extern void *Foreign_Data_For (Exception_Id eid);
extern Exception_Id EID_For (_GNAT_Exception *e);
#define Foreign_Exception system__exceptions__foreign_exception
extern struct Exception_Data Foreign_Exception;
/* Return true iff the exception class of EXCEPT is EC. */
static int
exception_class_eq (const _GNAT_Exception *except,
const _Unwind_Exception_Class ec)
{
#ifdef __ARM_EABI_UNWINDER__
return memcmp (except->common.exception_class, ec, 8) == 0;
#else
return except->common.exception_class == ec;
#endif
}
/* Return how CHOICE matches PROPAGATED_EXCEPTION. */
static enum action_kind
is_handled_by (Exception_Id choice, _GNAT_Exception *propagated_exception)
{
/* All others choice match everything. */
if (choice == GNAT_ALL_OTHERS)
return handler;
/* GNAT exception occurrence. */
if (exception_class_eq (propagated_exception, GNAT_EXCEPTION_CLASS))
{
if (choice == GNAT_UNHANDLED_OTHERS)
return unhandler;
Exception_Id E = 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. */
if (choice == E || (choice == GNAT_OTHERS && Is_Handled_By_Others (E)))
return handler;
/* Otherwise, it doesn't match an Ada choice. */
return nothing;
}
/* All others and others choice match any foreign exception. */
if (choice == GNAT_ALL_OTHERS
|| choice == GNAT_OTHERS
#ifndef CERT
|| choice == &Foreign_Exception
#endif
)
return handler;
#ifndef CERT
/* C++ exception occurrences. */
if (exception_class_eq (propagated_exception, CXX_EXCEPTION_CLASS)
&& Language_For (choice) == 'C')
{
void *choice_typeinfo = Foreign_Data_For (choice);
void *except_typeinfo =
(((struct __cxa_exception *)
((_Unwind_Exception *)propagated_exception + 1)) - 1)
->exceptionType;
/* Typeinfo are directly compared, which might not be correct if they
aren't merged. ??? We should call the == operator if this module is
compiled in C++. */
if (choice_typeinfo == except_typeinfo)
return handler;
}
#endif
return nothing;
}
/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
UW_CONTEXT in REGION. */
static void
get_action_description_for (_Unwind_Ptr ip,
_Unwind_Exception *uw_exception,
_Unwind_Action uw_phase,
region_descriptor *region,
action_descriptor *action)
{
_GNAT_Exception *gnat_exception = (_GNAT_Exception *) uw_exception;
/* Search the call site table first, which may get us a landing pad as well
as the head of an action record list. */
get_call_site_action_for (ip, region, action);
db_action_for (action, ip);
/* If there is not even a call_site entry, we are done. */
if (action->kind == nothing)
return;
/* Otherwise, check what we have at the place of the call site. */
/* No landing pad => no cleanups or handlers. */
if (action->landing_pad == 0)
{
action->kind = nothing;
return;
}
/* Landing pad + null table entry => only cleanups. */
else if (action->table_entry == 0)
{
action->kind = cleanup;
action->ttype_filter = cleanup_filter;
/* The filter initialization is not strictly necessary, as cleanup-only
landing pads don't look at the filter value. It is there to ensure
we don't pass random values and so trigger potential confusion when
installing the context later on. */
return;
}
/* Landing pad + Table entry => handlers + possible cleanups. */
else
{
const unsigned char * p = action->table_entry;
_sleb128_t ar_filter, ar_disp;
action->kind = nothing;
while (1)
{
p = read_sleb128 (p, &ar_filter);
read_sleb128 (p, &ar_disp);
/* Don't assign p here, as it will be incremented by ar_disp
below. */
/* Null filters are for cleanups. */
if (ar_filter == cleanup_filter)
{
action->kind = cleanup;
action->ttype_filter = cleanup_filter;
/* The filter initialization is required here, to ensure
the target landing pad branches to the cleanup code if
we happen not to find a matching handler. */
}
/* Positive filters are for regular handlers. */
else if (ar_filter > 0)
{
/* Do not catch an exception if the _UA_FORCE_UNWIND flag is
passed (to follow the ABI). */
if (!(uw_phase & _UA_FORCE_UNWIND))
{
enum action_kind act;
/* See if the filter we have is for an exception which
matches the one we are propagating. */
Exception_Id choice
= (Exception_Id) get_ttype_entry_for (region, ar_filter);
act = is_handled_by (choice, gnat_exception);
if (act != nothing)
{
action->kind = act;
action->ttype_filter = ar_filter;
return;
}
}
}
/* Negative filter values are for C++ exception specifications.
Should not be there for Ada :/ */
else
db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
if (ar_disp == 0)
return;
p += ar_disp;
}
}
}
/* Setup in UW_CONTEXT the eh return target IP and data registers, which will
be restored with the others and retrieved by the landing pad once the jump
occurred. */
static void
setup_to_install (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
_Unwind_Ptr uw_landing_pad,
int uw_filter)
{
/* 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. */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
(_Unwind_Word)uw_exception);
/* 2/ handler switch value register, which will also be used by the target
landing pad to decide what action it shall take. */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
(_Unwind_Word)uw_filter);
/* 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);
}
/* The following is defined from a-except.adb. Its purpose is to enable
automatic backtraces upon exception raise, as provided through the
GNAT.Traceback facilities. */
extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
/* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */
/* By default, the personality routine is public. */
#define PERSONALITY_STORAGE
#ifdef __USING_SJLJ_EXCEPTIONS__
#define PERSONALITY_FUNCTION __gnat_personality_sj0
#elif defined (__SEH__)
#define PERSONALITY_FUNCTION __gnat_personality_imp
/* The public personality routine for seh is __gnat_personality_seh0, defined
below using the SEH convention. This is a wrapper around the GNU routine,
which is static. */
#undef PERSONALITY_STORAGE
#define PERSONALITY_STORAGE static
#else
#define PERSONALITY_FUNCTION __gnat_personality_v0
#endif
#if defined (__ARM_EABI_UNWINDER__) \
&& (defined (IN_RTS) || GCC_VERSION > 9000)
#define TARGET_ATTRIBUTE __attribute__((target ("general-regs-only")))
#else
#define TARGET_ATTRIBUTE
#endif
/* Code executed to continue unwinding. With the ARM unwinder, the
personality routine must unwind one frame (per EHABI 7.3 4.). */
static _Unwind_Reason_Code
TARGET_ATTRIBUTE
continue_unwind (struct _Unwind_Exception* ue_header ATTRIBUTE_UNUSED,
struct _Unwind_Context* uw_context ATTRIBUTE_UNUSED)
{
#ifdef __ARM_EABI_UNWINDER__
if (__gnu_unwind_frame (ue_header, uw_context) != _URC_OK)
return _URC_FAILURE;
#endif
return _URC_CONTINUE_UNWIND;
}
/* Common code for the body of GNAT personality routine. This code is shared
between all unwinders. */
static _Unwind_Reason_Code
TARGET_ATTRIBUTE
personality_body (_Unwind_Action uw_phases,
_Unwind_Exception *uw_exception,
_Unwind_Context *uw_context)
{
region_descriptor region;
action_descriptor action;
_Unwind_Ptr ip;
/* Debug traces. */
db_indent (DB_INDENT_RESET);
db_phases (uw_phases);
db_indent (DB_INDENT_INCREASE);
/* Get the region description for the context we were provided with. This
will tell us if there is some lsda, call_site, action and/or ttype data
for the associated ip. */
get_region_description_for (uw_context, &region);
/* No LSDA => no handlers or cleanups => we shall unwind further up. */
if (! region.lsda)
return continue_unwind (uw_exception, uw_context);
/* Get the instruction pointer. */
ip = get_ip_from_context (uw_context);
db_region_for (&region, ip);
/* Search the call-site and action-record tables for the action associated
with this IP. */
get_action_description_for (ip, uw_exception, uw_phases, &region, &action);
db_action_for (&action, ip);
/* Whatever the phase, if there is nothing relevant in this frame,
unwinding should just go on. */
if (action.kind == nothing)
return continue_unwind (uw_exception, uw_context);
/* If we found something in search phase, we should return a code indicating
what to do next depending on what we found. If we only have cleanups
around, we shall try to unwind further up to find a handler, otherwise,
tell we have a handler, which will trigger the second phase. */
if (uw_phases & _UA_SEARCH_PHASE)
{
if (action.kind == cleanup)
{
return continue_unwind (uw_exception, uw_context);
}
else
{
#ifdef __ARM_EABI_UNWINDER__
/* Though we do not use this field ourselves, initializing
it is required by the ARM EH ABI before a personality
function in phase1 returns _URC_HANDLER_FOUND, so that
any personality function can use it in phase2 to test
whether the handler frame was reached. */
uw_exception->barrier_cache.sp
= _Unwind_GetGR (uw_context, UNWIND_STACK_REG);
#endif
#ifndef CERT
/* Trigger the appropriate notification routines before the second
phase starts, when the stack is still intact. First install what
needs to be installed in the current exception buffer and fetch
the Ada occurrence pointer to use. */
struct Exception_Occurrence *excep
= __gnat_setup_current_excep (uw_exception, uw_phases);
if (action.kind == unhandler)
__gnat_notify_unhandled_exception (excep);
else
__gnat_notify_handled_exception (excep);
#endif
return _URC_HANDLER_FOUND;
}
}
/* We found something in cleanup/handler phase, which might be the handler
or a cleanup for a handled occurrence, or a cleanup for an unhandled
occurrence (we are in a FORCED_UNWIND phase in this case). Install the
context to get there. */
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
#ifndef CERT
/* Write current exception so that it can be retrieved from Ada. It was
already done during phase 1, but one or several exceptions may have been
raised in cleanup handlers in between. */
__gnat_setup_current_excep (uw_exception, uw_phases);
#endif
return _URC_INSTALL_CONTEXT;
}
#ifndef __ARM_EABI_UNWINDER__
typedef int version_arg_t;
typedef _Unwind_Action phases_arg_t;
PERSONALITY_STORAGE _Unwind_Reason_Code
PERSONALITY_FUNCTION (version_arg_t, phases_arg_t,
_Unwind_Exception_Class, _Unwind_Exception *,
_Unwind_Context *);
PERSONALITY_STORAGE _Unwind_Reason_Code
PERSONALITY_FUNCTION (version_arg_t version_arg,
phases_arg_t phases_arg,
_Unwind_Exception_Class uw_exception_class
ATTRIBUTE_UNUSED,
_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;
/* Check that we're called from the ABI context we expect. */
if (uw_version != 1)
return _URC_FATAL_PHASE1_ERROR;
return personality_body (uw_phases, uw_exception, uw_context);
}
#else /* __ARM_EABI_UNWINDER__ */
PERSONALITY_STORAGE _Unwind_Reason_Code
PERSONALITY_FUNCTION (_Unwind_State state,
struct _Unwind_Exception* ue_header,
struct _Unwind_Context* uw_context);
PERSONALITY_STORAGE _Unwind_Reason_Code
TARGET_ATTRIBUTE
PERSONALITY_FUNCTION (_Unwind_State state,
struct _Unwind_Exception* uw_exception,
struct _Unwind_Context* uw_context)
{
_Unwind_Action uw_phases;
switch (state & _US_ACTION_MASK)
{
case _US_VIRTUAL_UNWIND_FRAME:
/* Phase 1. */
uw_phases = _UA_SEARCH_PHASE;
break;
case _US_UNWIND_FRAME_STARTING:
/* Phase 2, to call a cleanup. */
uw_phases = _UA_CLEANUP_PHASE;
#if 0
/* ??? We don't use UA_HANDLER_FRAME (except to debug). Futhermore,
barrier_cache.sp isn't yet set. */
if (!(state & _US_FORCE_UNWIND)
&& (uw_exception->barrier_cache.sp
== _Unwind_GetGR (uw_context, UNWIND_STACK_REG)))
uw_phases |= _UA_HANDLER_FRAME;
#endif
break;
case _US_UNWIND_FRAME_RESUME:
/* Phase 2, called at the return of a cleanup. In the GNU
implementation, there is nothing left to do, so we simply go on. */
return continue_unwind (uw_exception, uw_context);
default:
return _URC_FAILURE;
}
uw_phases |= (state & _US_FORCE_UNWIND);
/* The dwarf unwinder assumes the context structure holds things like the
function and LSDA pointers. The ARM implementation caches these in
the exception header (UCB). To avoid rewriting everything we make a
virtual scratch register point at the UCB. This is a GNU specific
requirement. */
_Unwind_SetGR (uw_context, UNWIND_POINTER_REG, (_Unwind_Ptr) uw_exception);
return personality_body (uw_phases, uw_exception, uw_context);
}
#endif /* __ARM_EABI_UNWINDER__ */
/* Callback routine called by Unwind_ForcedUnwind to execute all the cleanup
before exiting the task. */
#ifndef CERT
_Unwind_Reason_Code
__gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
_Unwind_Action phases,
_Unwind_Exception_Class eclass ATTRIBUTE_UNUSED,
struct _Unwind_Exception *exception,
struct _Unwind_Context *context ATTRIBUTE_UNUSED,
void *arg ATTRIBUTE_UNUSED)
{
/* Terminate when the end of the stack is reached. */
if ((phases & _UA_END_OF_STACK) != 0
#if defined (__ia64__) && defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
/* Strictely follow the ia64 ABI: when end of stack is reached,
the callback will be called with a NULL stack pointer.
No need for that when using libgcc unwinder. */
|| _Unwind_GetGR (context, 12) == 0
#endif
)
__gnat_unhandled_except_handler (exception);
/* We know there is at least one cleanup further up. Return so that it
is searched and entered, after which Unwind_Resume will be called
and this hook will gain control again. */
return _URC_NO_REASON;
}
#endif
/* Define the consistently named wrappers imported by Propagate_Exception. */
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
#ifdef __USING_SJLJ_EXCEPTIONS__
return _Unwind_SjLj_RaiseException (e);
#else
return _Unwind_RaiseException (e);
#endif
}
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
_Unwind_Stop_Fn handler ATTRIBUTE_UNUSED,
void *argument ATTRIBUTE_UNUSED)
{
#ifdef __USING_SJLJ_EXCEPTIONS__
# if defined (__APPLE__) && defined (__arm__)
/* There is not ForcedUnwind routine in arm-darwin system library. */
return _URC_FATAL_PHASE1_ERROR;
# else
return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
# endif
#else
return _Unwind_ForcedUnwind (e, handler, argument);
#endif
}
#if defined (__SEH__) && !defined (__USING_SJLJ_EXCEPTIONS__)
#define STATUS_USER_DEFINED (1U << 29)
/* From unwind-seh.c. */
#define GCC_MAGIC (('G' << 16) | ('C' << 8) | 'C')
#define GCC_EXCEPTION(TYPE) \
(STATUS_USER_DEFINED | ((TYPE) << 24) | GCC_MAGIC)
#define STATUS_GCC_THROW GCC_EXCEPTION (0)
struct Exception_Data *
__gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg);
struct _Unwind_Exception *
__gnat_create_machine_occurrence_from_signal_handler (Exception_Id,
const char *);
/* Unwind opcodes. */
#define UWOP_PUSH_NONVOL 0
#define UWOP_ALLOC_LARGE 1
#define UWOP_ALLOC_SMALL 2
#define UWOP_SET_FPREG 3
#define UWOP_SAVE_NONVOL 4
#define UWOP_SAVE_NONVOL_FAR 5
#define UWOP_SAVE_XMM128 8
#define UWOP_SAVE_XMM128_FAR 9
#define UWOP_PUSH_MACHFRAME 10
/* Modify the IP value saved in the machine frame. This is really a kludge,
that will be removed if we could propagate the Windows exception (and not
the GCC one).
What is very wrong is that the Windows unwinder will try to decode the
instruction at IP, which isn't valid anymore after the adjustment. */
static void
__gnat_adjust_context (unsigned char *unw, ULONG64 rsp)
{
unsigned int len;
/* Version 1 or 2. */
if (unw[0] != 1 && unw[0] != 2)
return;
/* No flags, no prologue. */
if (unw[1] != 0)
return;
len = unw[2];
/* No frame. */
if (unw[3] != 0)
return;
/* ??? Skip the first 2 undocumented opcodes for version 2. */
if (unw[0] == 2)
unw += 8;
else
unw += 4;
while (len > 0)
{
/* Offset in prologue = 0. */
if (unw[0] != 0)
return;
switch (unw[1] & 0xf)
{
case UWOP_ALLOC_LARGE:
/* Expect < 512KB. */
if ((unw[1] & 0xf0) != 0)
return;
rsp += *(unsigned short *)(unw + 2) * 8;
len--;
unw += 2;
break;
case UWOP_SAVE_NONVOL:
case UWOP_SAVE_XMM128:
len--;
unw += 2;
break;
case UWOP_PUSH_MACHFRAME:
{
ULONG64 *rip;
rip = (ULONG64 *)rsp;
if ((unw[1] & 0xf0) == 0x10)
rip++;
/* Adjust rip. */
(*rip)++;
}
return;
default:
/* Unexpected. */
return;
}
unw += 2;
len--;
}
}
EXCEPTION_DISPOSITION
__gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
PCONTEXT ms_orig_context,
PDISPATCHER_CONTEXT ms_disp)
{
/* Possibly transform run-time errors into Ada exceptions. */
if (!(ms_exc->ExceptionCode & STATUS_USER_DEFINED))
{
struct Exception_Data *exception;
const char *msg;
ULONG64 excpip = (ULONG64) ms_exc->ExceptionAddress;
if (excpip != 0
&& excpip >= (ms_disp->ImageBase
+ ms_disp->FunctionEntry->BeginAddress)
&& excpip < (ms_disp->ImageBase
+ ms_disp->FunctionEntry->EndAddress))
{
/* This is a fault in this function. We need to adjust the return
address before raising the GCC exception. In order to do that,
we need to locate the machine frame that has been pushed onto
the stack in response to the hardware exception, so we will do
a private unwinding from here, i.e. the frame of the personality
routine, up to the frame immediately following the frame of this
function. This frame corresponds to a dummy prologue which is
never actually executed but instead appears before the real entry
point of an interrupt routine and exists only to provide a place
to simulate the push of a machine frame. */
CONTEXT context;
PRUNTIME_FUNCTION mf_func = NULL;
ULONG64 mf_imagebase;
ULONG64 mf_rsp = 0;
/* Get the current context. */
RtlCaptureContext (&context);
while (1)
{
PRUNTIME_FUNCTION RuntimeFunction;
ULONG64 ImageBase;
VOID *HandlerData;
ULONG64 EstablisherFrame;
/* Get function metadata. */
RuntimeFunction
= RtlLookupFunctionEntry (context.Rip, &ImageBase,
ms_disp->HistoryTable);
/* Stop once we reached the frame of this function. */
if (RuntimeFunction == ms_disp->FunctionEntry)
break;
mf_func = RuntimeFunction;
mf_imagebase = ImageBase;
mf_rsp = context.Rsp;
if (RuntimeFunction)
{
/* Unwind. */
RtlVirtualUnwind (0, ImageBase, context.Rip, RuntimeFunction,
&context, &HandlerData, &EstablisherFrame,
NULL);
}
else
{
/* In case of failure, assume this is a leaf function. */
context.Rip = *(ULONG64 *) context.Rsp;
context.Rsp += 8;
}
/* 0 means bottom of the stack. */
if (context.Rip == 0)
{
mf_func = NULL;
break;
}
}
/* If we have found the machine frame, adjust the return address. */
if (mf_func != NULL)
__gnat_adjust_context
((unsigned char *)(mf_imagebase + mf_func->UnwindData), mf_rsp);
}
exception = __gnat_map_SEH (ms_exc, &msg);
if (exception != NULL)
{
/* Directly convert the system exception into a GCC one.
This is really breaking the API, but is necessary for stack size
reasons: the normal way is to call Raise_From_Signal_Handler,
which builds the exception and calls _Unwind_RaiseException,
which unwinds the stack and will call this personality routine.
But the Windows unwinder needs about 2KB of stack. */
struct _Unwind_Exception *exc
= __gnat_create_machine_occurrence_from_signal_handler (exception,
msg);
memset (exc->private_, 0, sizeof (exc->private_));
ms_exc->ExceptionCode = STATUS_GCC_THROW;
ms_exc->NumberParameters = 1;
ms_exc->ExceptionInformation[0] = (ULONG_PTR)exc;
}
}
return
_GCC_specific_handler (ms_exc, this_frame, ms_orig_context, ms_disp,
PERSONALITY_FUNCTION);
}
/* Define __gnat_personality_v0 for convenience */
PERSONALITY_STORAGE ATTRIBUTE_UNUSED _Unwind_Reason_Code
__gnat_personality_v0 (version_arg_t version_arg,
phases_arg_t phases_arg,
_Unwind_Exception_Class uw_exception_class,
_Unwind_Exception *uw_exception,
_Unwind_Context *uw_context)
{
return PERSONALITY_FUNCTION
(version_arg, phases_arg, uw_exception_class, uw_exception, uw_context);
}
#endif /* SEH */
#if !defined (__USING_SJLJ_EXCEPTIONS__)
/* Size of the _Unwind_Exception structure. This is used by g-cppexc to get
the offset to the C++ object. */
const int __gnat_unwind_exception_size = sizeof (_Unwind_Exception);
#endif
#ifdef __cplusplus
}
#endif