1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
11 * Copyright (C) 1992-2001, Free Software Foundation, Inc. *
13 * GNAT is free software; you can redistribute it and/or modify it under *
14 * terms of the GNU General Public License as published by the Free Soft- *
15 * ware Foundation; either version 2, or (at your option) any later ver- *
16 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
17 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
19 * for more details. You should have received a copy of the GNU General *
20 * Public License distributed with GNAT; see file COPYING. If not, write *
21 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
22 * MA 02111-1307, USA. *
24 * As a special exception, if you link this file with other files to *
25 * produce an executable, this file does not by itself cause the resulting *
26 * executable to be covered by the GNU General Public License. This except- *
27 * ion does not however invalidate any other reasons why the executable *
28 * file might be covered by the GNU Public License. *
30 * GNAT was originally developed by the GNAT team at New York University. *
31 * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
33 ****************************************************************************/
35 /* Routines to support runtime exception handling */
49 /* We have not yet figured out how to import this directly */
52 _gnat_builtin_longjmp (ptr, flag)
54 int flag ATTRIBUTE_UNUSED;
56 __builtin_longjmp (ptr, 1);
59 /* When an exception is raised for which no handler exists, the procedure
60 Ada.Exceptions.Unhandled_Exception is called, which performs the call to
61 adafinal to complete finalization, and then prints out the error messages
62 for the unhandled exception. The final step is to call this routine, which
63 performs any system dependent cleanup required. */
66 __gnat_unhandled_terminate ()
68 /* Special termination handling for VMS */
74 /* Remove the exception vector so it won't intercept any errors
75 in the call to exit, and go into and endless loop */
77 SYS$SETEXV (1, 0, 3, &prvhnd);
81 /* Termination handling for all other systems. */
83 #elif !defined (__RT__)
88 /* Below is the eh personality routine for Ada to be called when the GCC
91 ??? It is currently inspired from the one for C++, needs cleanups and
92 additional comments. It also contains a big bunch of debugging code that
93 we shall get rid of at some point. */
95 #ifdef IN_RTS /* For eh personality routine */
97 /* ??? Does it make any sense to leave this for the compiler ? */
101 #include "unwind-dw2-fde.h"
102 #include "unwind-pe.h"
104 /* First define a set of useful structures and helper routines. */
106 typedef struct _Unwind_Context _Unwind_Context;
108 struct lsda_header_info
112 _Unwind_Ptr ttype_base;
113 const unsigned char *TType;
114 const unsigned char *action_table;
115 unsigned char ttype_encoding;
116 unsigned char call_site_encoding;
119 typedef struct lsda_header_info lsda_header_info;
121 typedef enum {false = 0, true = 1} bool;
123 static const unsigned char *
124 parse_lsda_header (_Unwind_Context *context, const unsigned char *p,
125 lsda_header_info *info)
128 unsigned char lpstart_encoding;
130 info->Start = (context ? _Unwind_GetRegionStart (context) : 0);
132 /* Find @LPStart, the base to which landing pad offsets are relative. */
133 lpstart_encoding = *p++;
134 if (lpstart_encoding != DW_EH_PE_omit)
135 p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart);
137 info->LPStart = info->Start;
139 /* Find @TType, the base of the handler and exception spec type data. */
140 info->ttype_encoding = *p++;
141 if (info->ttype_encoding != DW_EH_PE_omit)
143 p = read_uleb128 (p, &tmp);
144 info->TType = p + tmp;
149 /* The encoding and length of the call-site table; the action table
150 immediately follows. */
151 info->call_site_encoding = *p++;
152 p = read_uleb128 (p, &tmp);
153 info->action_table = p + tmp;
159 static const _Unwind_Ptr
160 get_ttype_entry (_Unwind_Context *context, lsda_header_info *info, long i)
164 i *= size_of_encoded_value (info->ttype_encoding);
165 read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr);
170 /* This is the structure of exception objects as built by the GNAT runtime
171 library (a-except.adb). The layouts should exactly match, and the "common"
172 header is mandated by the exception handling ABI. */
174 struct _GNAT_Exception {
175 struct _Unwind_Exception common;
179 char handled_by_others;
181 char select_cleanups;
185 /* The two constants below are specific ttype identifiers for special
186 exception ids. Their value is currently hardcoded at the gigi level
187 (see N_Exception_Handler). */
189 #define GNAT_OTHERS_ID ((_Unwind_Ptr) 0x0)
190 #define GNAT_ALL_OTHERS_ID ((_Unwind_Ptr) 0x1)
193 /* The DB stuff below is there for debugging purposes only. */
195 #define DB_PHASES 0x1
196 #define DB_SEARCH 0x2
197 #define DB_ECLASS 0x4
200 #define DB_FOUND 0x20
201 #define DB_INSTALL 0x40
202 #define DB_CALLS 0x80
204 #define AEHP_DB_SPECS \
205 (DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH)
210 static int db_specs = AEHP_DB_SPECS;
212 static int db_specs = 0;
215 #define START_DB(what) do { if (what & db_specs) {
216 #define END_DB(what) } \
219 /* The "action" stuff below if also there for debugging purposes only. */
222 _Unwind_Action action;
224 } action_description_t;
226 action_description_t action_descriptions [] = {
227 { _UA_SEARCH_PHASE, "SEARCH_PHASE" },
228 { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
229 { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
230 { _UA_FORCE_UNWIND, "FORCE_UNWIND" },
235 decode_actions (actions)
236 _Unwind_Action actions;
240 action_description_t * a = action_descriptions;
243 while (a->description != (char *)0)
245 if (actions & a->action)
247 printf ("%s ", a->description);
256 /* The following is defined from a-except.adb. It's purpose is to enable
257 automatic backtraces upon exception raise, as provided through the
258 GNAT.Traceback facilities. */
260 __gnat_notify_handled_exception (void * handler, bool others, bool db_notify);
262 /* Below is the eh personality routine per se. */
265 __gnat_eh_personality (int version,
266 _Unwind_Action actions,
267 _Unwind_Exception_Class exception_class,
268 struct _Unwind_Exception *ue_header,
269 struct _Unwind_Context *context)
271 enum found_handler_type
279 lsda_header_info info;
280 const unsigned char *language_specific_data;
281 const unsigned char *action_record;
282 const unsigned char *p;
283 _Unwind_Ptr landing_pad, ip;
284 int handler_switch_value;
286 bool hit_others_handler;
288 struct _GNAT_Exception * gnat_exception;
291 return _URC_FATAL_PHASE1_ERROR;
293 START_DB (DB_PHASES);
294 decode_actions (actions);
297 if (strcmp ( ((char *)&exception_class), "GNU") != 0
298 || strcmp ( ((char *)&exception_class)+4, "Ada") != 0)
300 START_DB (DB_SEARCH);
301 printf (" Exception Class doesn't match for ip = %p\n", ip);
304 printf (" => FOUND nothing\n");
306 return _URC_CONTINUE_UNWIND;
309 gnat_exception = (struct _GNAT_Exception *) ue_header;
311 START_DB (DB_PHASES);
312 if (gnat_exception->select_cleanups)
314 printf ("(select_cleanups) :\n");
322 language_specific_data = (const unsigned char *)
323 _Unwind_GetLanguageSpecificData (context);
325 /* If no LSDA, then there are no handlers or cleanups. */
326 if (! language_specific_data)
328 ip = _Unwind_GetIP (context) - 1;
330 START_DB (DB_SEARCH);
331 printf (" No Language Specific Data for ip = %p\n", ip);
334 printf (" => FOUND nothing\n");
336 return _URC_CONTINUE_UNWIND;
339 /* Parse the LSDA header. */
340 p = parse_lsda_header (context, language_specific_data, &info);
341 info.ttype_base = base_of_encoded_value (info.ttype_encoding, context);
342 ip = _Unwind_GetIP (context) - 1;
345 handler_switch_value = 0;
347 /* Search the call-site table for the action associated with this IP. */
348 while (p < info.action_table)
350 _Unwind_Ptr cs_start, cs_len, cs_lp, cs_action;
352 /* Note that all call-site encodings are "absolute" displacements. */
353 p = read_encoded_value (0, info.call_site_encoding, p, &cs_start);
354 p = read_encoded_value (0, info.call_site_encoding, p, &cs_len);
355 p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp);
356 p = read_uleb128 (p, &cs_action);
358 /* The table is sorted, so if we've passed the ip, stop. */
359 if (ip < info.Start + cs_start)
360 p = info.action_table;
361 else if (ip < info.Start + cs_start + cs_len)
364 landing_pad = info.LPStart + cs_lp;
366 action_record = info.action_table + cs_action - 1;
367 goto found_something;
371 START_DB (DB_SEARCH);
372 printf (" No Action entry for ip = %p\n", ip);
375 /* If ip is not present in the table, call terminate. This is for
376 a destructor inside a cleanup, or a library routine the compiler
377 was not expecting to throw.
380 (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate);
382 ??? Does this have a mapping in Ada semantics ? */
384 found_type = found_nothing;
390 found_type = found_nothing;
392 if (landing_pad == 0)
394 /* If ip is present, and has a null landing pad, there are
395 no cleanups or handlers to be run. */
396 START_DB (DB_SEARCH);
397 printf (" No Landing Pad for ip = %p\n", ip);
400 else if (action_record == 0)
402 START_DB (DB_SEARCH);
403 printf (" Null Action Record for ip = %p <===\n", ip);
408 signed long ar_filter, ar_disp;
410 signed long cleanup_filter = 0;
411 signed long handler_filter = 0;
413 START_DB (DB_SEARCH);
414 printf (" Landing Pad + Action Record for ip = %p\n", ip);
418 printf (" => Search for exception matching id %p\n",
422 /* Otherwise we have a catch handler or exception specification. */
429 p = read_sleb128 (p, &tmp); ar_filter = tmp;
430 read_sleb128 (p, &tmp); ar_disp = tmp;
433 printf ("ar_filter %d\n", ar_filter);
438 /* Zero filter values are cleanups. We should not be seeing
439 this for GNU-Ada though
440 saw_cleanup = true; */
441 START_DB (DB_SEARCH);
442 printf (" Null Filter for ip = %p <===\n", ip);
445 else if (ar_filter > 0)
447 _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter);
450 printf ("catch_type ");
454 case GNAT_ALL_OTHERS_ID:
455 printf ("GNAT_ALL_OTHERS_ID\n");
459 printf ("GNAT_OTHERS_ID\n");
463 printf ("%p\n", lp_id);
469 if (lp_id == GNAT_ALL_OTHERS_ID)
472 printf (" => SAW cleanup\n");
475 cleanup_filter = ar_filter;
476 gnat_exception->has_cleanup = true;
480 (lp_id == GNAT_OTHERS_ID && gnat_exception->handled_by_others);
482 if (hit_others_handler || lp_id == gnat_exception->id)
485 printf (" => SAW handler\n");
488 handler_filter = ar_filter;
493 /* Negative filter values are for C++ exception specifications.
494 Should not be there for Ada :/ */
497 if (actions & _UA_SEARCH_PHASE)
501 found_type = found_handler;
502 handler_switch_value = handler_filter;
508 found_type = found_cleanup;
512 if (actions & _UA_CLEANUP_PHASE)
516 found_type = found_handler;
517 handler_switch_value = handler_filter;
523 found_type = found_cleanup;
524 handler_switch_value = cleanup_filter;
531 action_record = p + ar_disp;
536 if (found_type == found_nothing) {
538 printf (" => FOUND nothing\n");
541 return _URC_CONTINUE_UNWIND;
544 if (actions & _UA_SEARCH_PHASE)
547 printf (" => Computing return for SEARCH\n");
550 if (found_type == found_cleanup
551 && !gnat_exception->select_cleanups)
554 printf (" => FOUND cleanup\n");
557 return _URC_CONTINUE_UNWIND;
561 printf (" => FOUND handler\n");
564 return _URC_HANDLER_FOUND;
569 START_DB (DB_INSTALL);
570 printf (" => INSTALLING context for filter %d\n",
571 handler_switch_value);
574 if (found_type == found_terminate)
576 /* Should not have this for Ada ? */
577 START_DB (DB_INSTALL);
578 printf (" => FOUND terminate <===\n");
583 /* Signal that we are going to enter a handler, which will typically
584 enable the debugger to take control and possibly output an automatic
585 backtrace. Note that we are supposed to provide the handler's entry
586 point here but we don't have it.
588 __gnat_notify_handled_exception
589 ((void *)landing_pad, hit_others_handler, true);
592 /* The GNU-Ada exception handlers know how to find the exception
593 occurrence without having to pass it as an argument so there
594 is no need to feed any specific register with this information.
596 This is why the two following lines are commented out. */
598 /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0),
599 (_Unwind_Ptr) &xh->unwindHeader); */
601 _Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
602 handler_switch_value);
604 _Unwind_SetIP (context, landing_pad);
606 return _URC_INSTALL_CONTEXT;
610 #endif /* IN_RTS - For eh personality routine */