1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
11 * Copyright (C) 1992-2002, 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 */
52 /* We have not yet figured out how to import this directly */
55 _gnat_builtin_longjmp (ptr, flag)
57 int flag ATTRIBUTE_UNUSED;
59 __builtin_longjmp (ptr, 1);
62 /* When an exception is raised for which no handler exists, the procedure
63 Ada.Exceptions.Unhandled_Exception is called, which performs the call to
64 adafinal to complete finalization, and then prints out the error messages
65 for the unhandled exception. The final step is to call this routine, which
66 performs any system dependent cleanup required. */
69 __gnat_unhandled_terminate ()
71 /* Special termination handling for VMS */
77 /* Remove the exception vector so it won't intercept any errors
78 in the call to exit, and go into and endless loop */
80 SYS$SETEXV (1, 0, 3, &prvhnd);
84 /* Termination handling for all other systems. */
86 #elif !defined (__RT__)
91 /* Below is the code related to the integration of the GCC mechanism for
92 exception handling. */
96 /* Exception Handling personality routine for Ada.
98 ??? It is currently inspired from the one for C++, needs cleanups and
99 additional comments. It also contains a big bunch of debugging code that
100 we shall get rid of at some point. */
102 #ifdef IN_RTS /* For eh personality routine */
104 /* ??? Does it make any sense to leave this for the compiler ? */
107 #include "unwind-dw2-fde.h"
108 #include "unwind-pe.h"
110 /* First define a set of useful structures and helper routines. */
112 typedef struct _Unwind_Context _Unwind_Context;
114 struct lsda_header_info
118 _Unwind_Ptr ttype_base;
119 const unsigned char *TType;
120 const unsigned char *action_table;
121 unsigned char ttype_encoding;
122 unsigned char call_site_encoding;
125 typedef struct lsda_header_info lsda_header_info;
127 static const unsigned char *
128 parse_lsda_header (context, p, info)
129 _Unwind_Context *context;
130 const unsigned char *p;
131 lsda_header_info *info;
134 unsigned char lpstart_encoding;
136 info->Start = (context ? _Unwind_GetRegionStart (context) : 0);
138 /* Find @LPStart, the base to which landing pad offsets are relative. */
139 lpstart_encoding = *p++;
140 if (lpstart_encoding != DW_EH_PE_omit)
141 p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart);
143 info->LPStart = info->Start;
145 /* Find @TType, the base of the handler and exception spec type data. */
146 info->ttype_encoding = *p++;
147 if (info->ttype_encoding != DW_EH_PE_omit)
149 p = read_uleb128 (p, &tmp);
150 info->TType = p + tmp;
155 /* The encoding and length of the call-site table; the action table
156 immediately follows. */
157 info->call_site_encoding = *p++;
158 p = read_uleb128 (p, &tmp);
159 info->action_table = p + tmp;
164 static const _Unwind_Ptr
165 get_ttype_entry (context, info, i)
166 _Unwind_Context *context;
167 lsda_header_info *info;
172 i *= size_of_encoded_value (info->ttype_encoding);
173 read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr);
178 /* This is the structure of exception objects as built by the GNAT runtime
179 library (a-except.adb). The layouts should exactly match, and the "common"
180 header is mandated by the exception handling ABI. */
182 struct _GNAT_Exception
184 struct _Unwind_Exception common;
186 char handled_by_others;
188 char select_cleanups;
192 /* The two constants below are specific ttype identifiers for special
193 exception ids. Their value is currently hardcoded at the gigi level
194 (see N_Exception_Handler). */
196 #define GNAT_OTHERS_ID ((_Unwind_Ptr) 0x0)
197 #define GNAT_ALL_OTHERS_ID ((_Unwind_Ptr) 0x1)
200 /* The DB stuff below is there for debugging purposes only. */
202 #define DB_PHASES 0x1
203 #define DB_SEARCH 0x2
204 #define DB_ECLASS 0x4
207 #define DB_FOUND 0x20
208 #define DB_INSTALL 0x40
209 #define DB_CALLS 0x80
211 #define AEHP_DB_SPECS \
212 (DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH)
217 static int db_specs = AEHP_DB_SPECS;
219 static int db_specs = 0;
222 #define START_DB(what) do { if (what & db_specs) {
223 #define END_DB(what) } \
226 /* The "action" stuff below is also there for debugging purposes only. */
230 _Unwind_Action action;
232 } action_description_t;
234 static action_description_t action_descriptions[]
235 = {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
236 { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
237 { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
238 { _UA_FORCE_UNWIND, "FORCE_UNWIND" },
242 decode_actions (actions)
243 _Unwind_Action actions;
247 action_description_t *a = action_descriptions;
250 for (; a->description != 0; a++)
251 if (actions & a->action)
252 printf ("%s ", a->description);
257 /* The following is defined from a-except.adb. Its purpose is to enable
258 automatic backtraces upon exception raise, as provided through the
259 GNAT.Traceback facilities. */
260 extern void __gnat_notify_handled_exception PARAMS ((void *, bool, bool));
262 /* Below is the eh personality routine per se. */
265 __gnat_eh_personality (version, actions, exception_class, ue_header, context)
267 _Unwind_Action actions;
268 _Unwind_Exception_Class exception_class;
269 struct _Unwind_Exception *ue_header;
270 struct _Unwind_Context *context;
272 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;
285 bool hit_others_handler;
286 struct _GNAT_Exception *gnat_exception;
289 return _URC_FATAL_PHASE1_ERROR;
291 START_DB (DB_PHASES);
292 decode_actions (actions);
295 if (strcmp ((char *) &exception_class, "GNU") != 0
296 || strcmp (((char *) &exception_class) + 4, "Ada") != 0)
298 START_DB (DB_SEARCH);
299 printf (" Exception Class doesn't match for ip = %p\n", ip);
302 printf (" => FOUND nothing\n");
304 return _URC_CONTINUE_UNWIND;
307 gnat_exception = (struct _GNAT_Exception *) ue_header;
309 START_DB (DB_PHASES);
310 if (gnat_exception->select_cleanups)
311 printf ("(select_cleanups) :\n");
316 language_specific_data
317 = (const unsigned char *) _Unwind_GetLanguageSpecificData (context);
319 /* If no LSDA, then there are no handlers or cleanups. */
320 if (! language_specific_data)
322 ip = _Unwind_GetIP (context) - 1;
324 START_DB (DB_SEARCH);
325 printf (" No Language Specific Data for ip = %p\n", ip);
328 printf (" => FOUND nothing\n");
330 return _URC_CONTINUE_UNWIND;
333 /* Parse the LSDA header. */
334 p = parse_lsda_header (context, language_specific_data, &info);
335 info.ttype_base = base_of_encoded_value (info.ttype_encoding, context);
336 ip = _Unwind_GetIP (context) - 1;
339 handler_switch_value = 0;
341 /* Search the call-site table for the action associated with this IP. */
342 while (p < info.action_table)
344 _Unwind_Ptr cs_start, cs_len, cs_lp;
345 _Unwind_Word cs_action;
347 /* Note that all call-site encodings are "absolute" displacements. */
348 p = read_encoded_value (0, info.call_site_encoding, p, &cs_start);
349 p = read_encoded_value (0, info.call_site_encoding, p, &cs_len);
350 p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp);
351 p = read_uleb128 (p, &cs_action);
353 /* The table is sorted, so if we've passed the ip, stop. */
354 if (ip < info.Start + cs_start)
355 p = info.action_table;
356 else if (ip < info.Start + cs_start + cs_len)
359 landing_pad = info.LPStart + cs_lp;
361 action_record = info.action_table + cs_action - 1;
362 goto found_something;
366 START_DB (DB_SEARCH);
367 printf (" No Action entry for ip = %p\n", ip);
370 /* If ip is not present in the table, call terminate. This is for
371 a destructor inside a cleanup, or a library routine the compiler
372 was not expecting to throw.
375 (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate);
377 ??? Does this have a mapping in Ada semantics ? */
379 found_type = found_nothing;
384 found_type = found_nothing;
386 if (landing_pad == 0)
388 /* If ip is present, and has a null landing pad, there are
389 no cleanups or handlers to be run. */
390 START_DB (DB_SEARCH);
391 printf (" No Landing Pad for ip = %p\n", ip);
394 else if (action_record == 0)
396 START_DB (DB_SEARCH);
397 printf (" Null Action Record for ip = %p <===\n", ip);
402 signed long ar_filter, ar_disp;
403 signed long cleanup_filter = 0;
404 signed long handler_filter = 0;
406 START_DB (DB_SEARCH);
407 printf (" Landing Pad + Action Record for ip = %p\n", ip);
411 printf (" => Search for exception matching id %p\n",
415 /* Otherwise we have a catch handler or exception specification. */
422 p = read_sleb128 (p, &tmp); ar_filter = tmp;
423 read_sleb128 (p, &tmp); ar_disp = tmp;
426 printf ("ar_filter %d\n", ar_filter);
431 /* Zero filter values are cleanups. We should not be seeing
432 this for GNU-Ada though
433 saw_cleanup = true; */
434 START_DB (DB_SEARCH);
435 printf (" Null Filter for ip = %p <===\n", ip);
438 else if (ar_filter > 0)
440 _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter);
443 printf ("catch_type ");
447 case GNAT_ALL_OTHERS_ID:
448 printf ("GNAT_ALL_OTHERS_ID\n");
452 printf ("GNAT_OTHERS_ID\n");
456 printf ("%p\n", lp_id);
462 if (lp_id == GNAT_ALL_OTHERS_ID)
465 printf (" => SAW cleanup\n");
468 cleanup_filter = ar_filter;
469 gnat_exception->has_cleanup = true;
473 = (lp_id == GNAT_OTHERS_ID
474 && gnat_exception->handled_by_others);
476 if (hit_others_handler || lp_id == gnat_exception->id)
479 printf (" => SAW handler\n");
482 handler_filter = ar_filter;
486 /* Negative filter values are for C++ exception specifications.
487 Should not be there for Ada :/ */
490 if (actions & _UA_SEARCH_PHASE)
494 found_type = found_handler;
495 handler_switch_value = handler_filter;
500 found_type = found_cleanup;
503 if (actions & _UA_CLEANUP_PHASE)
507 found_type = found_handler;
508 handler_switch_value = handler_filter;
514 found_type = found_cleanup;
515 handler_switch_value = cleanup_filter;
523 action_record = p + ar_disp;
528 if (found_type == found_nothing)
531 printf (" => FOUND nothing\n");
534 return _URC_CONTINUE_UNWIND;
537 if (actions & _UA_SEARCH_PHASE)
540 printf (" => Computing return for SEARCH\n");
543 if (found_type == found_cleanup
544 && !gnat_exception->select_cleanups)
547 printf (" => FOUND cleanup\n");
550 return _URC_CONTINUE_UNWIND;
554 printf (" => FOUND handler\n");
557 return _URC_HANDLER_FOUND;
562 START_DB (DB_INSTALL);
563 printf (" => INSTALLING context for filter %d\n",
564 handler_switch_value);
567 if (found_type == found_terminate)
569 /* Should not have this for Ada ? */
570 START_DB (DB_INSTALL);
571 printf (" => FOUND terminate <===\n");
576 /* Signal that we are going to enter a handler, which will typically
577 enable the debugger to take control and possibly output an automatic
578 backtrace. Note that we are supposed to provide the handler's entry
579 point here but we don't have it. */
580 __gnat_notify_handled_exception ((void *)landing_pad, hit_others_handler,
583 /* The GNU-Ada exception handlers know how to find the exception
584 occurrence without having to pass it as an argument so there
585 is no need to feed any specific register with this information.
587 This is why the two following lines are commented out. */
589 /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0),
590 (_Unwind_Ptr) &xh->unwindHeader); */
592 _Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
593 handler_switch_value);
595 _Unwind_SetIP (context, landing_pad);
597 return _URC_INSTALL_CONTEXT;
601 #else /* IN_RTS - For eh personality routine */
603 /* The calls to the GCC runtime interface for exception raising are currently
604 issued from a-except.adb, which is used by both the runtime library and
605 the compiler. As the compiler binary is not linked against the GCC runtime
606 library, we need a stub for this interface in the compiler case. */
610 _Unwind_RaiseException (e)
611 struct _Unwind_Exception *e ATTRIBUTE_UNUSED;
613 /* Since we don't link the compiler with a host libgcc, we should not be
614 using the GCC eh mechanism for the compiler and so expect this function
615 never to be called. */