From 4c2698ed6802669784e51f97b390e7f836457407 Mon Sep 17 00:00:00 2001 From: bosch Date: Thu, 20 Dec 2001 06:22:43 +0000 Subject: * bindgen.adb: Minor reformatting * cstand.adb: Minor reformatting * fmap.adb: Minor reformatting Change name from Add for Add_To_File_Map (Add is much too generic) Change Path_Name_Of to Mapped_Path_Name Change File_Name_Of to Mapped_File_Name Fix copyright dates in header * fmap.ads: Change name from Add for Add_To_File_Map (Add is much too generic) Change Path_Name_Of to Mapped_Path_Name Change File_Name_Of to Mapped_File_Name Fix copyright dates in header * fname-uf.adb: Minor reformatting. New names of stuff in Fmap. Add use clause for Fmap. * make.adb: Minor reformatting * osint.adb: Minor reformatting. Change of names in Fmap. Add use clause for Fmap. * prj-env.adb: Minor reformatting * prj-env.ads: Minor reformatting * switch.adb: Minor reformatting. Do proper raise of Bad_Switch if error found (there were odd exceptions to this general rule in -gnatec/-gnatem processing) * raise.c (__gnat_eh_personality): Exception handling personality routine for Ada. Still in rough state, inspired from the C++ version and still containing a bunch of debugging artifacts. (parse_lsda_header, get_ttype_entry): Local (static) helpers, also inspired from the C++ library. * raise.c (eh_personality): Add comments. Part of work for the GCC 3 exception handling integration. * Makefile.in: Remove use of 5smastop.adb which is obsolete. (HIE_SOURCES): Add s-secsta.ad{s,b}. (HIE_OBJS): Add s-fat*.o (RAVEN_SOURCES): Remove files that are no longer required. Add interrupt handling files. (RAVEN_MOD): Removed, no longer needed. * a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always Add 2001 to copyright date * g-regpat.adb: Change pragma Inline_Always to Inline. There is no need to force universal inlining for these cases. * s-taprob.adb: Minor clean ups so that this unit can be used in Ravenscar HI. * exp_ch7.adb: Allow use of secondary stack in HI mode. Disallow it when pragma Restrictions (No_Secondary_Stack) is specified. * prj-tree.ads (Project_Node_Record): Add comments for components Pkg_Id and Case_Insensitive. * g-socket.adb: Minor reformatting. Found while reading code. * prj-tree.ads: Minor reformatting git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@48195 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/raise.c | 526 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 525 insertions(+), 1 deletion(-) (limited to 'gcc/ada/raise.c') diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c index 43d630795a8..2d48db80693 100644 --- a/gcc/ada/raise.c +++ b/gcc/ada/raise.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * $Revision: 1.1 $ + * $Revision$ * * * Copyright (C) 1992-2001, Free Software Foundation, Inc. * * * @@ -84,3 +84,527 @@ __gnat_unhandled_terminate () __gnat_os_exit (1); #endif } + +/* Below is the eh personality routine for Ada to be called when the GCC + mechanism is used. + + ??? 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.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; + +struct lsda_header_info +{ + _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; +}; + +typedef struct lsda_header_info lsda_header_info; + +typedef enum {false = 0, true = 1} bool; + +static const unsigned char * +parse_lsda_header (_Unwind_Context *context, const unsigned char *p, + lsda_header_info *info) +{ + _Unwind_Ptr tmp; + unsigned char lpstart_encoding; + + info->Start = (context ? _Unwind_GetRegionStart (context) : 0); + + /* 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; + + /* Find @TType, the base of the handler and exception spec type data. */ + info->ttype_encoding = *p++; + if (info->ttype_encoding != DW_EH_PE_omit) + { + p = read_uleb128 (p, &tmp); + info->TType = p + tmp; + } + 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; + + return p; +} + + +static const _Unwind_Ptr +get_ttype_entry (_Unwind_Context *context, lsda_header_info *info, long i) +{ + _Unwind_Ptr ptr; + + i *= size_of_encoded_value (info->ttype_encoding); + read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr); + + return ptr; +} + +/* 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" + header is mandated by the exception handling ABI. */ + +struct _GNAT_Exception { + struct _Unwind_Exception common; + + _Unwind_Ptr id; + + char handled_by_others; + char has_cleanup; + char select_cleanups; +}; + + +/* 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) + + +/* The DB stuff below is there for debugging purposes only. */ + +#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 + +#define AEHP_DB_SPECS \ +(DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH) + +#undef AEHP_DB_SPECS + +#ifdef AEHP_DB_SPECS +static int db_specs = AEHP_DB_SPECS; +#else +static int db_specs = 0; +#endif + +#define START_DB(what) do { if (what & db_specs) { +#define END_DB(what) } \ + } while (0); + +/* The "action" stuff below if also there for debugging purposes only. */ + +typedef struct { + _Unwind_Action action; + char * description; +} action_description_t; + +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, (char *)0 } +}; + +static void +decode_actions (actions) + _Unwind_Action actions; +{ + int i; + + action_description_t * a = action_descriptions; + + printf ("\n"); + while (a->description != (char *)0) + { + if (actions & a->action) + { + printf ("%s ", a->description); + } + + a ++; + } + + printf (" : "); +} + +/* The following is defined from a-except.adb. It's purpose is to enable + automatic backtraces upon exception raise, as provided through the + GNAT.Traceback facilities. */ +extern void +__gnat_notify_handled_exception (void * handler, bool others, bool db_notify); + +/* Below is the eh personality routine per se. */ + +_Unwind_Reason_Code +__gnat_eh_personality (int version, + _Unwind_Action actions, + _Unwind_Exception_Class exception_class, + struct _Unwind_Exception *ue_header, + struct _Unwind_Context *context) +{ + 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; + + START_DB (DB_PHASES); + decode_actions (actions); + END_DB (DB_PHASES); + + if (strcmp ( ((char *)&exception_class), "GNU") != 0 + || strcmp ( ((char *)&exception_class)+4, "Ada") != 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; + } + + gnat_exception = (struct _GNAT_Exception *) ue_header; + + START_DB (DB_PHASES); + if (gnat_exception->select_cleanups) + { + printf ("(select_cleanups) :\n"); + } + else + { + printf (" :\n"); + } + END_DB (DB_PHASES); + + language_specific_data = (const unsigned char *) + _Unwind_GetLanguageSpecificData (context); + + /* 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; + } + + /* 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; + + /* Search the call-site table for the action associated with this IP. */ + while (p < info.action_table) + { + _Unwind_Ptr cs_start, cs_len, cs_lp, 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_uleb128 (p, &cs_action); + + /* 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 (cs_lp) + landing_pad = info.LPStart + cs_lp; + if (cs_action) + action_record = info.action_table + cs_action - 1; + goto found_something; + } + } + + START_DB (DB_SEARCH); + printf (" No Action entry for ip = %p\n", ip); + END_DB (DB_SEARCH); + + /* 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. + + found_type = + (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate); + + ??? Does this have a mapping in Ada semantics ? */ + + found_type = found_nothing; + + goto do_something; + + found_something: + + found_type = found_nothing; + + if (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); + } + else if (action_record == 0) + { + START_DB (DB_SEARCH); + printf (" Null Action Record for ip = %p <===\n", ip); + END_DB (DB_SEARCH); + } + else + { + signed long ar_filter, ar_disp; + + signed long cleanup_filter = 0; + signed long handler_filter = 0; + + START_DB (DB_SEARCH); + printf (" Landing Pad + Action Record for ip = %p\n", ip); + END_DB (DB_SEARCH); + + 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. */ + + while (1) + { + _Unwind_Ptr 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); + + 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); + } + 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); + + if (hit_others_handler || lp_id == gnat_exception->id) + { + START_DB (DB_SAW); + printf (" => SAW handler\n"); + END_DB (DB_SAW); + + handler_filter = ar_filter; + } + } + else + { + /* Negative filter values are for C++ exception specifications. + Should not be there for Ada :/ */ + } + + if (actions & _UA_SEARCH_PHASE) + { + if (handler_filter) + { + found_type = found_handler; + handler_switch_value = handler_filter; + break; + } + + if (cleanup_filter) + { + found_type = found_cleanup; + } + } + + if (actions & _UA_CLEANUP_PHASE) + { + if (handler_filter) + { + found_type = found_handler; + handler_switch_value = handler_filter; + break; + } + + if (cleanup_filter) + { + found_type = found_cleanup; + handler_switch_value = cleanup_filter; + break; + } + } + + if (ar_disp == 0) + break; + action_record = p + ar_disp; + } + } + + do_something: + if (found_type == found_nothing) { + START_DB (DB_FOUND); + printf (" => FOUND nothing\n"); + END_DB (DB_FOUND); + + return _URC_CONTINUE_UNWIND; + } + + if (actions & _UA_SEARCH_PHASE) + { + START_DB (DB_FOUND); + printf (" => Computing return for SEARCH\n"); + END_DB (DB_FOUND); + + if (found_type == found_cleanup + && !gnat_exception->select_cleanups) + { + START_DB (DB_FOUND); + printf (" => FOUND cleanup\n"); + END_DB (DB_FOUND); + + return _URC_CONTINUE_UNWIND; + } + + START_DB (DB_FOUND); + printf (" => FOUND handler\n"); + END_DB (DB_FOUND); + + return _URC_HANDLER_FOUND; + } + + install_context: + + START_DB (DB_INSTALL); + printf (" => INSTALLING context for filter %d\n", + handler_switch_value); + END_DB (DB_INSTALL); + + if (found_type == found_terminate) + { + /* Should not have this for Ada ? */ + START_DB (DB_INSTALL); + printf (" => FOUND terminate <===\n"); + END_DB (DB_INSTALL); + } + + + /* 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); + + + /* 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. + + This is why the two following lines are commented out. */ + + /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0), + (_Unwind_Ptr) &xh->unwindHeader); */ + + _Unwind_SetGR (context, __builtin_eh_return_data_regno (1), + handler_switch_value); + + _Unwind_SetIP (context, landing_pad); + + return _URC_INSTALL_CONTEXT; +} + + +#endif /* IN_RTS - For eh personality routine */ -- cgit v1.2.1