diff options
Diffstat (limited to 'gcc/ada/raise.c')
| -rw-r--r-- | gcc/ada/raise.c | 1282 |
1 files changed, 888 insertions, 394 deletions
diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c index a9841740d88..751c01d70ca 100644 --- a/gcc/ada/raise.c +++ b/gcc/ada/raise.c @@ -6,8 +6,7 @@ * * * C Implementation File * * * - * * - * Copyright (C) 1992-2002, Free Software Foundation, Inc. * + * Copyright (C) 1992-2003, 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- * @@ -35,6 +34,14 @@ #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> typedef char bool; @@ -88,565 +95,1052 @@ __gnat_unhandled_terminate () } /* Below is the code related to the integration of the GCC mechanism for - exception handling. Still work in progress. */ + exception handling. */ #include "unwind.h" -/* If the underlying GCC scheme for exception handling is SJLJ, the standard - propagation routine (_Unwind_RaiseException) is actually renamed using a - #define directive (see unwing-sjlj.c). We need a consistently named - interface to import from a-except, so stubs are defined here, at the end - of this file. */ +/* 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 stubs are defined here. */ -_Unwind_Reason_Code -__gnat_Unwind_RaiseException PARAMS ((struct _Unwind_Exception *)); +typedef struct _Unwind_Context _Unwind_Context; +typedef struct _Unwind_Exception _Unwind_Exception; +_Unwind_Reason_Code +__gnat_Unwind_RaiseException PARAMS ((_Unwind_Exception *)); -/* Exception Handling personality routine for Ada. +_Unwind_Reason_Code +__gnat_Unwind_ForcedUnwind PARAMS ((_Unwind_Exception *, void *, void *)); - ??? It is currently inspired from the one for C++, needs cleanups and - additional comments. It also contains a big bunch of debugging code that - we shall get rid of at some point. */ #ifdef IN_RTS /* For eh personality routine */ -/* ??? Does it make any sense to leave this for the compiler ? */ - #include "dwarf2.h" #include "unwind-dw2-fde.h" #include "unwind-pe.h" -/* First define a set of useful structures and helper routines. */ -typedef struct _Unwind_Context _Unwind_Context; +/* -------------------------------------------------------------- + -- The DB stuff below is there for debugging purposes only. -- + -------------------------------------------------------------- */ -struct lsda_header_info +#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_Ptr Start; - _Unwind_Ptr LPStart; - _Unwind_Ptr ttype_base; - const unsigned char *TType; - const unsigned char *action_table; - unsigned char ttype_encoding; - unsigned char call_site_encoding; -}; + _Unwind_Action phase; + char * description; +} phase_descriptor; -typedef struct lsda_header_info lsda_header_info; +static 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 const unsigned char * -parse_lsda_header (context, p, info) - _Unwind_Context *context; - const unsigned char *p; - lsda_header_info *info; +static int +db_accepted_codes (void) { - _Unwind_Ptr tmp; - unsigned char lpstart_encoding; + static int accepted_codes = -1; - info->Start = (context ? _Unwind_GetRegionStart (context) : 0); + if (accepted_codes == -1) + { + char * db_env = getenv ("EH_DEBUG"); - /* Find @LPStart, the base to which landing pad offsets are relative. */ - lpstart_encoding = *p++; - if (lpstart_encoding != DW_EH_PE_omit) - p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart); - else - info->LPStart = info->Start; + 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. */ + } - /* Find @TType, the base of the handler and exception spec type data. */ - info->ttype_encoding = *p++; - if (info->ttype_encoding != DW_EH_PE_omit) + 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) { - p = read_uleb128 (p, &tmp); - info->TType = p + tmp; + current_indentation_level = 0; } - else - info->TType = 0; - /* The encoding and length of the call-site table; the action table - immediately follows. */ - info->call_site_encoding = *p++; - p = read_uleb128 (p, &tmp); - info->action_table = p + tmp; + 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, " "); + } - return p; } -static const _Unwind_Ptr -get_ttype_entry (context, info, i) - _Unwind_Context *context; - lsda_header_info *info; - long i; +static void +db (int db_code, 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) { - _Unwind_Ptr ptr; + phase_descriptor *a = phase_descriptors; + + if (! (db_accepted_codes() & DB_PHASES)) + return; - i *= size_of_encoded_value (info->ttype_encoding); - read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr); + db (DB_PHASES, "\n"); + + for (; a->description != 0; a++) + if (phases & a->phase) + db (DB_PHASES, "%s ", a->description); - return ptr; + db (DB_PHASES, " :\n"); } + +/* --------------------------------------------------------------- + -- 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 * + ======================================= + + 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 beeing propagated, + then control should be transfered 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. + + 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 beeing propagated. + + action-filter > 0 means there is a regular handler to be run, + + 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. + + next-action indexes the next entry in the list. 0 indicates there is + no other entry. + + ttypes [] + --------------- + * ttype-value * + --------------- + + A null value indicates a catch-all handler in C++, and an "others" + handler in Ada. + + Non null values are used to match the exception beeing propagated: + In C++ this is a pointer to some rtti data, while in Ada this is an + exception id. + + The special id value 1 indicates an "all_others" handler. + + 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 | | + +============+=====================+ | + | | 0 => "others" | | + | ... | 1 => "all others" | <---+ + | | X => 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 wether 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_eh_personality. + + 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_eh_personality (context, exception) + | + +--> get_region_descriptor_for (context) + | + +--> get_action_descriptor_for (context, 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 the structure of exception objects as built by the GNAT runtime - library (a-except.adb). The layouts should exactly match, and the "common" + library (a-exexpr.adb). The layouts should exactly match, and the "common" header is mandated by the exception handling ABI. */ -struct _GNAT_Exception +typedef struct { - struct _Unwind_Exception common; + _Unwind_Exception common; + /* ABI header, maximally aligned. */ + _Unwind_Ptr id; - char handled_by_others; - char has_cleanup; - char select_cleanups; -}; + /* Id of the exception beeing propagated, filled by Propagate_Exception. + + This is compared against the ttype entries associated with actions in the + examined context to see if one of these actions matches. */ + + bool handled_by_others; + /* Indicates wether a "when others" may catch this exception, also filled by + Propagate_Exception. + + This is used to decide if a GNAT_OTHERS ttype entry matches. */ + int n_cleanups_to_trigger; + /* Number of cleanups on the propagation way for the occurrence. This is + initialized to 0 by Propagate_Exception and computed by the personality + routine during the first phase of the propagation (incremented for each + context in which only cleanup actions match). + + This is used by Propagate_Exception when the occurrence is not handled, + to control a forced unwinding phase aimed at triggering all the cleanups + before calling Unhandled_Exception_Terminate. + + This is also used by __gnat_eh_personality to identify the point at which + the notification routine shall be called for a handled occurrence. */ +} _GNAT_Exception; /* The two constants below are specific ttype identifiers for special exception ids. Their value is currently hardcoded at the gigi level (see N_Exception_Handler). */ -#define GNAT_OTHERS_ID ((_Unwind_Ptr) 0x0) -#define GNAT_ALL_OTHERS_ID ((_Unwind_Ptr) 0x1) +#define GNAT_OTHERS ((_Unwind_Ptr) 0x0) +#define GNAT_ALL_OTHERS ((_Unwind_Ptr) 0x1) +/* Describe the useful region data associated with an unwind context. */ -/* The DB stuff below is there for debugging purposes only. */ +typedef struct +{ + /* The base pc of the region. */ + _Unwind_Ptr base; -#define DB_PHASES 0x1 -#define DB_SEARCH 0x2 -#define DB_ECLASS 0x4 -#define DB_MATCH 0x8 -#define DB_SAW 0x10 -#define DB_FOUND 0x20 -#define DB_INSTALL 0x40 -#define DB_CALLS 0x80 + /* Pointer to the Language Specific Data for the region. */ + _Unwind_Ptr lsda; -#define AEHP_DB_SPECS \ -(DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH) + /* Call-Site data associated with this region. */ + unsigned char call_site_encoding; + const unsigned char *call_site_table; -#undef AEHP_DB_SPECS + /* The base to which are relative landing pad offsets inside the call-site + entries . */ + _Unwind_Ptr lp_base; -#ifdef AEHP_DB_SPECS -static int db_specs = AEHP_DB_SPECS; -#else -static int db_specs = 0; -#endif + /* Action-Table associated with this region. */ + const unsigned char *action_table; -#define START_DB(what) do { if (what & db_specs) { -#define END_DB(what) } \ - } while (0); + /* Ttype data associated with this region. */ + unsigned char ttype_encoding; + const unsigned char *ttype_table; + _Unwind_Ptr ttype_base; + +} region_descriptor; + +static void +db_region_for (region, uw_context) + region_descriptor *region; + _Unwind_Context *uw_context; +{ + _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1; + + if (! (db_accepted_codes () & DB_REGIONS)) + return; + + db (DB_REGIONS, "For ip @ 0x%08x => ", ip); + + if (region->lsda) + db (DB_REGIONS, "lsda @ 0x%x", region->lsda); + else + db (DB_REGIONS, "no lsda"); + + db (DB_REGIONS, "\n"); +} + +/* Retrieve the ttype entry associated with FILTER in the REGION's + ttype table. */ + +static const _Unwind_Ptr +get_ttype_entry_for (region, filter) + 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 (uw_context, region) + _Unwind_Context *uw_context; + region_descriptor *region; +{ + const unsigned char * p; + _Unwind_Word 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 = (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, ®ion->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. */ + +typedef enum +{ + /* Found some call site base data, but need to analyze further + before beeing 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 +} action_kind; -/* The "action" stuff below is also there for debugging purposes only. */ typedef struct { - _Unwind_Action action; - char * description; -} action_description_t; + /* The kind of action to be taken. */ + 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; + _Unwind_Ptr ttype_entry; + +} action_descriptor; -static action_description_t action_descriptions[] - = {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" }, - { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" }, - { _UA_HANDLER_FRAME, "HANDLER_FRAME" }, - { _UA_FORCE_UNWIND, "FORCE_UNWIND" }, - { -1, 0}}; static void -decode_actions (actions) - _Unwind_Action actions; +db_action_for (action, uw_context) + action_descriptor *action; + _Unwind_Context *uw_context; { - int i; + _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1; - action_description_t *a = action_descriptions; + db (DB_ACTIONS, "For ip @ 0x%08x => ", ip); - printf ("\n"); - for (; a->description != 0; a++) - if (actions & a->action) - printf ("%s ", a->description); + switch (action->kind) + { + case unknown: + db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n", + ip, 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", action->ttype_filter); + break; + + default: + db (DB_ACTIONS, "Err? Unexpected action kind !\n"); + break; + } - printf (" : "); + return; } -/* 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 PARAMS ((void *, bool, bool)); -/* Below is the eh personality routine per se. */ +/* 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. -_Unwind_Reason_Code -__gnat_eh_personality (version, actions, exception_class, ue_header, context) - int version; - _Unwind_Action actions; - _Unwind_Exception_Class exception_class; - struct _Unwind_Exception *ue_header; - struct _Unwind_Context *context; + There are two variants of this routine, depending on the underlying + mechanism (dwarf/sjlj), which account for differences in the tables + organization. +*/ + +#ifdef __USING_SJLJ_EXCEPTIONS__ + +#define __builtin_eh_return_data_regno(x) x + +static void +get_call_site_action_for (uw_context, region, action) + _Unwind_Context *uw_context; + region_descriptor *region; + action_descriptor *action; { - enum found_handler_type - { - found_nothing, - found_terminate, - found_cleanup, - found_handler - } found_type; - lsda_header_info info; - const unsigned char *language_specific_data; - const unsigned char *action_record; - const unsigned char *p; - _Unwind_Ptr landing_pad, ip; - int handler_switch_value; - bool hit_others_handler; - struct _GNAT_Exception *gnat_exception; - - if (version != 1) - return _URC_FATAL_PHASE1_ERROR; + _Unwind_Ptr call_site + = _Unwind_GetIP (uw_context) - 1; + /* Subtract 1 because GetIP returns the actual call_site value + 1. */ - START_DB (DB_PHASES); - decode_actions (actions); - END_DB (DB_PHASES); + /* 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 (strcmp ((char *) &exception_class, "GNU") != 0 - || strcmp (((char *) &exception_class) + 4, "Ada") != 0) + if ((int)call_site < 0) { - START_DB (DB_SEARCH); - printf (" Exception Class doesn't match for ip = %p\n", ip); - END_DB (DB_SEARCH); - START_DB (DB_FOUND); - printf (" => FOUND nothing\n"); - END_DB (DB_FOUND); - return _URC_CONTINUE_UNWIND; + action->kind = nothing; + return; } + else if (call_site == 0) + { + db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n"); + action->kind = nothing; + return; + } + else + { + _Unwind_Word cs_lp, cs_action; - gnat_exception = (struct _GNAT_Exception *) ue_header; + /* Let the caller know there may be an action to take, but let it + determine the kind. */ + action->kind = unknown; - START_DB (DB_PHASES); - if (gnat_exception->select_cleanups) - printf ("(select_cleanups) :\n"); - else - printf (" :\n"); - END_DB (DB_PHASES); + /* 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. */ - language_specific_data - = (const unsigned char *) _Unwind_GetLanguageSpecificData (context); + const unsigned char * p = region->call_site_table; - /* If no LSDA, then there are no handlers or cleanups. */ - if (! language_specific_data) - { - ip = _Unwind_GetIP (context) - 1; - - START_DB (DB_SEARCH); - printf (" No Language Specific Data for ip = %p\n", ip); - END_DB (DB_SEARCH); - START_DB (DB_FOUND); - printf (" => FOUND nothing\n"); - END_DB (DB_FOUND); - return _URC_CONTINUE_UNWIND; + 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; + + return; } +} + +#else +/* ! __USING_SJLJ_EXCEPTIONS__ */ + +static void +get_call_site_action_for (uw_context, region, action) + _Unwind_Context *uw_context; + region_descriptor *region; + action_descriptor *action; +{ + _Unwind_Ptr ip + = _Unwind_GetIP (uw_context) - 1; + /* Substract 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. */ - /* Parse the LSDA header. */ - p = parse_lsda_header (context, language_specific_data, &info); - info.ttype_base = base_of_encoded_value (info.ttype_encoding, context); - ip = _Unwind_GetIP (context) - 1; - landing_pad = 0; - action_record = 0; - handler_switch_value = 0; + const unsigned char * p + = region->call_site_table; - /* Search the call-site table for the action associated with this IP. */ - while (p < info.action_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; _Unwind_Word cs_action; /* Note that all call-site encodings are "absolute" displacements. */ - p = read_encoded_value (0, info.call_site_encoding, p, &cs_start); - p = read_encoded_value (0, info.call_site_encoding, p, &cs_len); - p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp); + 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 @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\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. */ - if (ip < info.Start + cs_start) - p = info.action_table; - else if (ip < info.Start + cs_start + cs_len) + 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) - landing_pad = info.LPStart + cs_lp; + action->landing_pad = region->lp_base + cs_lp; + else + action->landing_pad = 0; + if (cs_action) - action_record = info.action_table + cs_action - 1; - goto found_something; + action->table_entry = region->action_table + cs_action - 1; + else + action->table_entry = 0; + + db (DB_CSITE, "+++\n"); + return; } } - START_DB (DB_SEARCH); - printf (" No Action entry for ip = %p\n", ip); - END_DB (DB_SEARCH); + db (DB_CSITE, "---\n"); +} - /* If ip is not present in the table, call terminate. This is for - a destructor inside a cleanup, or a library routine the compiler - was not expecting to throw. +#endif - found_type = - (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate); +/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to + UW_CONTEXT in REGION. */ - ??? Does this have a mapping in Ada semantics ? */ +static void +get_action_description_for (uw_context, uw_exception, region, action) + _Unwind_Context *uw_context; + _Unwind_Exception *uw_exception; + region_descriptor *region; + action_descriptor *action; +{ + _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception; - found_type = found_nothing; - goto do_something; + /* 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 (uw_context, region, action); + db_action_for (action, uw_context); - found_something: + /* If there is not even a call_site entry, we are done. */ + if (action->kind == nothing) + return; - found_type = found_nothing; + /* Otherwise, check what we have at the place of the call site */ - if (landing_pad == 0) + /* No landing pad => no cleanups or handlers. */ + if (action->landing_pad == 0) { - /* If ip is present, and has a null landing pad, there are - no cleanups or handlers to be run. */ - START_DB (DB_SEARCH); - printf (" No Landing Pad for ip = %p\n", ip); - END_DB (DB_SEARCH); + action->kind = nothing; + return; } - else if (action_record == 0) + + /* Landing pad + null table entry => only cleanups. */ + else if (action->table_entry == 0) { - START_DB (DB_SEARCH); - printf (" Null Action Record for ip = %p <===\n", ip); - END_DB (DB_SEARCH); + action->kind = cleanup; + return; } + + /* Landing pad + Table entry => handlers + possible cleanups. */ else { - signed long ar_filter, ar_disp; - signed long cleanup_filter = 0; - signed long handler_filter = 0; + const unsigned char * p = action->table_entry; - START_DB (DB_SEARCH); - printf (" Landing Pad + Action Record for ip = %p\n", ip); - END_DB (DB_SEARCH); + _Unwind_Sword ar_filter, ar_disp; - START_DB (DB_MATCH); - printf (" => Search for exception matching id %p\n", - gnat_exception->id); - END_DB (DB_MATCH); - - /* Otherwise we have a catch handler or exception specification. */ + action->kind = nothing; while (1) { - _Unwind_Word tmp; - - p = action_record; - p = read_sleb128 (p, &tmp); ar_filter = tmp; - read_sleb128 (p, &tmp); ar_disp = tmp; - - START_DB (DB_MATCH); - printf ("ar_filter %d\n", ar_filter); - END_DB (DB_MATCH); + 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 == 0) - { - /* Zero filter values are cleanups. We should not be seeing - this for GNU-Ada though - saw_cleanup = true; */ - START_DB (DB_SEARCH); - printf (" Null Filter for ip = %p <===\n", ip); - END_DB (DB_SEARCH); - } + action->kind = cleanup; + + /* Positive filters are for regular handlers. */ else if (ar_filter > 0) { - _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter); - - START_DB (DB_MATCH); - printf ("catch_type "); - - switch (lp_id) - { - case GNAT_ALL_OTHERS_ID: - printf ("GNAT_ALL_OTHERS_ID\n"); - break; - - case GNAT_OTHERS_ID: - printf ("GNAT_OTHERS_ID\n"); - break; - - default: - printf ("%p\n", lp_id); - break; - } - - END_DB (DB_MATCH); - - if (lp_id == GNAT_ALL_OTHERS_ID) - { - START_DB (DB_SAW); - printf (" => SAW cleanup\n"); - END_DB (DB_SAW); - - cleanup_filter = ar_filter; - gnat_exception->has_cleanup = true; - } - - hit_others_handler - = (lp_id == GNAT_OTHERS_ID - && gnat_exception->handled_by_others); + /* See if the filter we have is for an exception which matches + the one we are propagating. */ + _Unwind_Ptr eid = get_ttype_entry_for (region, ar_filter); - if (hit_others_handler || lp_id == gnat_exception->id) + if (eid == gnat_exception->id + || eid == GNAT_ALL_OTHERS + || (eid == GNAT_OTHERS && gnat_exception->handled_by_others)) { - START_DB (DB_SAW); - printf (" => SAW handler\n"); - END_DB (DB_SAW); - - handler_filter = ar_filter; + action->ttype_filter = ar_filter; + action->ttype_entry = eid; + action->kind = handler; + return; } } + + /* Negative filter values are for C++ exception specifications. + Should not be there for Ada :/ */ else - /* Negative filter values are for C++ exception specifications. - Should not be there for Ada :/ */ - ; + db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n"); - if (actions & _UA_SEARCH_PHASE) - { - if (handler_filter) - { - found_type = found_handler; - handler_switch_value = handler_filter; - break; - } + if (ar_disp == 0) + return; - if (cleanup_filter) - found_type = found_cleanup; - } + p += ar_disp; + } + } +} - if (actions & _UA_CLEANUP_PHASE) - { - if (handler_filter) - { - found_type = found_handler; - handler_switch_value = handler_filter; - break; - } +/* 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 + occured. */ - if (cleanup_filter) - { - found_type = found_cleanup; - handler_switch_value = cleanup_filter; - break; - } - } +static void +setup_to_install (uw_context, uw_exception, uw_landing_pad, uw_filter) + _Unwind_Context *uw_context; + _Unwind_Exception *uw_exception; + int uw_filter; + _Unwind_Ptr uw_landing_pad; +{ +#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. */ + _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); +#endif +} - if (ar_disp == 0) - break; +/* 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 PARAMS ((void)); +extern void __gnat_notify_unhandled_exception PARAMS ((void)); - action_record = p + ar_disp; - } - } +/* Below is the eh personality routine per se. We currently assume that only + GNU-Ada exceptions are met. */ - do_something: - if (found_type == found_nothing) - { - START_DB (DB_FOUND); - printf (" => FOUND nothing\n"); - END_DB (DB_FOUND); +_Unwind_Reason_Code +__gnat_eh_personality (uw_version, uw_phases, + uw_exception_class, uw_exception, uw_context) + 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; - return _URC_CONTINUE_UNWIND; - } + region_descriptor region; + action_descriptor action; - if (actions & _UA_SEARCH_PHASE) - { - START_DB (DB_FOUND); - printf (" => Computing return for SEARCH\n"); - END_DB (DB_FOUND); + if (uw_version != 1) + return _URC_FATAL_PHASE1_ERROR; - if (found_type == found_cleanup - && !gnat_exception->select_cleanups) + 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, ®ion); + db_region_for (®ion, uw_context); + + /* No LSDA => no handlers or cleanups => we shall unwind further up. */ + if (! region.lsda) + return _URC_CONTINUE_UNWIND; + + /* 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); + db_action_for (&action, uw_context); + + /* Whatever the phase, if there is nothing relevant in this frame, + unwinding should just go on. */ + if (action.kind == nothing) + return _URC_CONTINUE_UNWIND; + + /* 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) { - START_DB (DB_FOUND); - printf (" => FOUND cleanup\n"); - END_DB (DB_FOUND); - + gnat_exception->n_cleanups_to_trigger ++; return _URC_CONTINUE_UNWIND; } + else + { + /* Trigger the appropriate notification routines before the second + phase starts, which ensures the stack is still intact. */ + __gnat_notify_handled_exception (); - START_DB (DB_FOUND); - printf (" => FOUND handler\n"); - END_DB (DB_FOUND); - - return _URC_HANDLER_FOUND; + return _URC_HANDLER_FOUND; + } } - install_context: + /* 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. */ - START_DB (DB_INSTALL); - printf (" => INSTALLING context for filter %d\n", - handler_switch_value); - END_DB (DB_INSTALL); + /* 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) + gnat_exception->n_cleanups_to_trigger --; - if (found_type == found_terminate) - { - /* Should not have this for Ada ? */ - START_DB (DB_INSTALL); - printf (" => FOUND terminate <===\n"); - END_DB (DB_INSTALL); - } + setup_to_install + (uw_context, uw_exception, action.landing_pad, action.ttype_filter); + return _URC_INSTALL_CONTEXT; +} - /* Signal that we are going to enter a handler, which will typically - enable the debugger to take control and possibly output an automatic - backtrace. Note that we are supposed to provide the handler's entry - point here but we don't have it. */ - __gnat_notify_handled_exception ((void *)landing_pad, hit_others_handler, - true); +/* Define the consistently named stubs imported by Propagate_Exception. */ - /* The GNU-Ada exception handlers know how to find the exception - occurrence without having to pass it as an argument so there - is no need to feed any specific register with this information. +#ifdef __USING_SJLJ_EXCEPTIONS__ - This is why the two following lines are commented out. */ +#undef _Unwind_RaiseException - /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0), - (_Unwind_Ptr) &xh->unwindHeader); */ +_Unwind_Reason_Code +__gnat_Unwind_RaiseException (e) + _Unwind_Exception *e; +{ + return _Unwind_SjLj_RaiseException (e); +} - _Unwind_SetGR (context, __builtin_eh_return_data_regno (1), - handler_switch_value); - _Unwind_SetIP (context, landing_pad); +#undef _Unwind_ForcedUnwind - return _URC_INSTALL_CONTEXT; +_Unwind_Reason_Code +__gnat_Unwind_ForcedUnwind (e, handler, argument) + _Unwind_Exception *e; + void * handler; + void * argument; +{ + return _Unwind_SjLj_ForcedUnwind (e, handler, argument); } -/* Stubs for the libgcc unwinding interface, to be imported by a-except. */ - -#ifdef __USING_SJLJ_EXCEPTIONS__ +#else /* __USING_SJLJ_EXCEPTIONS__ */ _Unwind_Reason_Code __gnat_Unwind_RaiseException (e) - struct _Unwind_Exception *e; + _Unwind_Exception *e; { - return _Unwind_SjLj_RaiseException (e); + return _Unwind_RaiseException (e); } -#else -/* __USING_SJLJ_EXCEPTIONS__ not defined */ - _Unwind_Reason_Code -__gnat_Unwind_RaiseException (e) - struct _Unwind_Exception *e; +__gnat_Unwind_ForcedUnwind (e, handler, argument) + _Unwind_Exception *e; + void * handler; + void * argument; { - return _Unwind_RaiseException (e); + return _Unwind_ForcedUnwind (e, handler, argument); } - -#endif + +#endif /* __USING_SJLJ_EXCEPTIONS__ */ #else -/* IN_RTS not defined */ +/* ! IN_RTS */ /* The calls to the GCC runtime interface for exception raising are currently - issued from a-except.adb, which is used by both the runtime library and - the compiler. As the compiler binary is not linked against the GCC runtime - library, we need a stub for this interface in the compiler case. */ + issued from a-exexpr.adb, which is used by both the runtime library and the + compiler. -/* Since we don't link the compiler with a host libgcc, we should not be - using the GCC eh mechanism for the compiler and so expect this function - never to be called. */ + As the compiler binary is not linked against the GCC runtime library, we + need also need stubs for this interface in the compiler case. We should not + be using the GCC eh mechanism for the compiler, however, so expect these + functions never to be called. */ _Unwind_Reason_Code __gnat_Unwind_RaiseException (e) - struct _Unwind_Exception *e ATTRIBUTE_UNUSED; + _Unwind_Exception *e ATTRIBUTE_UNUSED; { abort (); } -#endif + +_Unwind_Reason_Code +__gnat_Unwind_ForcedUnwind (e, handler, argument) + _Unwind_Exception *e ATTRIBUTE_UNUSED; + void * handler ATTRIBUTE_UNUSED; + void * argument ATTRIBUTE_UNUSED; +{ + abort (); +} + +#endif /* IN_RTS */ |