#ifdef IN_RTS
#include "tconfig.h"
#include "tsystem.h"
#include <sys/stat.h>
typedef char bool;
# define true 1
# define false 0
#else
#include "config.h"
#include "system.h"
#endif
#include "adaint.h"
#include "raise.h"
void
_gnat_builtin_longjmp (ptr, flag)
void *ptr;
int flag ATTRIBUTE_UNUSED;
{
__builtin_longjmp (ptr, 1);
}
void
__gnat_unhandled_terminate ()
{
#ifdef VMS
{
long prvhnd;
SYS$SETEXV (1, 0, 3, &prvhnd);
__gnat_os_exit (1);
}
#elif !defined (__RT__)
__gnat_os_exit (1);
#endif
}
#include "unwind.h"
#ifdef IN_RTS
#include "dwarf2.h"
#include "unwind-dw2-fde.h"
#include "unwind-pe.h"
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;
static const unsigned char *
parse_lsda_header (context, p, info)
_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);
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;
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;
info->call_site_encoding = *p++;
p = read_uleb128 (p, &tmp);
info->action_table = p + tmp;
return p;
}
static const _Unwind_Ptr
get_ttype_entry (context, info, i)
_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;
}
struct _GNAT_Exception
{
struct _Unwind_Exception common;
_Unwind_Ptr id;
char handled_by_others;
char has_cleanup;
char select_cleanups;
};
#define GNAT_OTHERS_ID ((_Unwind_Ptr) 0x0)
#define GNAT_ALL_OTHERS_ID ((_Unwind_Ptr) 0x1)
#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);
typedef struct
{
_Unwind_Action action;
char * description;
} action_description_t;
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;
{
int i;
action_description_t *a = action_descriptions;
printf ("\n");
for (; a->description != 0; a++)
if (actions & a->action)
printf ("%s ", a->description);
printf (" : ");
}
extern void __gnat_notify_handled_exception PARAMS ((void *, bool, bool));
_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;
{
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 (! 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;
}
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;
while (p < info.action_table)
{
_Unwind_Ptr cs_start, cs_len, cs_lp;
_Unwind_Word cs_action;
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);
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);
found_type = found_nothing;
goto do_something;
found_something:
found_type = found_nothing;
if (landing_pad == 0)
{
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);
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);
if (ar_filter == 0)
{
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
;
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)
{
START_DB (DB_INSTALL);
printf (" => FOUND terminate <===\n");
END_DB (DB_INSTALL);
}
__gnat_notify_handled_exception ((void *)landing_pad, hit_others_handler,
true);
_Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
handler_switch_value);
_Unwind_SetIP (context, landing_pad);
return _URC_INSTALL_CONTEXT;
}
#ifdef __USING_SJLJ_EXCEPTIONS__
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (e)
struct _Unwind_Exception *e;
{
return _Unwind_SjLj_RaiseException (e);
}
#else
void
__gnat_Unwind_RaiseException (e)
struct _Unwind_Exception *e;
{
return _Unwind_RaiseException (e);
}
#endif
#else
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (e)
struct _Unwind_Exception *e ATTRIBUTE_UNUSED;
{
abort ();
}
#endif