1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2023, Free Software Foundation, Inc. *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 3, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. *
18 * As a special exception under Section 7 of GPL version 3, you are granted *
19 * additional permissions described in the GCC Runtime Library Exception, *
20 * version 3.1, as published by the Free Software Foundation. *
22 * You should have received a copy of the GNU General Public License and *
23 * a copy of the GCC Runtime Library Exception along with this program; *
24 * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
25 * <http://www.gnu.org/licenses/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
32 /* Code related to the integration of the GCC mechanism for exception
36 /* For gnat1/gnatbind compilation: use host headers. */
39 /* Don't use fancy_abort. */
42 # if !defined(CERT) && !defined(STANDALONE)
47 # define HAVE_GETIPINFO 1
63 /* On MacOS X, versions older than 10.5 don't export _Unwind_GetIPInfo. */
65 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1050
66 #define HAVE_GETIPINFO 1
70 #if defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
71 /* HP-UX B.11.31 ia64 libunwind doesn't have _Unwind_GetIPInfo. */
73 #define _UA_END_OF_STACK 0
76 /* The names of a couple of "standard" routines for unwinding/propagation
77 actually vary depending on the underlying GCC scheme for exception handling
78 (SJLJ or DWARF). We need a consistently named interface to import from
79 a-except, so wrappers are defined here. */
81 #if defined (__CYGWIN__) || (defined(__SEH__) && defined(STANDALONE))
82 /* Prevent compile error due to unwind-generic.h including <windows.h>,
83 see comment above #include <windows.h> in mingw32.h. */
88 /* For gnat1/gnatbind compilation: cannot use unwind.h, as it is for the
89 target. So mimic configure...
90 This is a hack ???, the real fix is to link gnat1/gnatbind with the
91 runtime of the build compiler. */
92 # ifdef EH_MECHANISM_arm
93 # include "config/arm/unwind-arm.h"
95 # include "unwind-generic.h"
105 typedef struct _Unwind_Context _Unwind_Context
;
106 typedef struct _Unwind_Exception _Unwind_Exception
;
109 __gnat_Unwind_RaiseException (_Unwind_Exception
*);
112 __gnat_Unwind_ForcedUnwind (_Unwind_Exception
*, _Unwind_Stop_Fn
, void *);
114 extern struct Exception_Occurrence
*
115 __gnat_setup_current_excep (_Unwind_Exception
*, _Unwind_Action
);
117 extern void __gnat_unhandled_except_handler (_Unwind_Exception
*);
120 /* Called in case of error during propagation. */
121 extern void __gnat_raise_abort (void) __attribute__ ((noreturn
));
122 #define abort() __gnat_raise_abort()
124 #elif defined(STANDALONE)
128 #include "unwind-pe.h"
130 #ifdef __ARM_EABI_UNWINDER__
135 /* The known and handled exception classes. */
137 #ifdef __ARM_EABI_UNWINDER__
138 #define CXX_EXCEPTION_CLASS "GNUCC++"
139 #define GNAT_EXCEPTION_CLASS "GNU-Ada"
141 #define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
142 #define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
145 /* Structure of a C++ exception, represented as a C structure... See
146 unwind-cxx.h for the full definition. */
148 struct __cxa_exception
151 void (*exceptionDestructor
)(void *);
153 void (*unexpectedHandler
)();
154 void (*terminateHandler
)();
156 struct __cxa_exception
*nextException
;
160 #ifdef __ARM_EABI_UNWINDER__
161 struct __cxa_exception
* nextPropagatingException
;
163 int propagationCount
;
165 int handlerSwitchValue
;
166 const unsigned char *actionRecord
;
167 const unsigned char *languageSpecificData
;
168 _Unwind_Ptr catchTemp
;
172 _Unwind_Exception unwindHeader
;
175 /* --------------------------------------------------------------
176 -- The DB stuff below is there for debugging purposes only. --
177 -------------------------------------------------------------- */
181 #define DB_PHASES 0x1
183 #define DB_ACTIONS 0x4
184 #define DB_REGIONS 0x8
186 #define DB_ERR 0x1000
188 /* The "action" stuff below is also there for debugging purposes only. */
192 _Unwind_Action phase
;
193 const char * description
;
196 static const phase_descriptor phase_descriptors
[]
197 = {{ _UA_SEARCH_PHASE
, "SEARCH_PHASE" },
198 { _UA_CLEANUP_PHASE
, "CLEANUP_PHASE" },
199 { _UA_HANDLER_FRAME
, "HANDLER_FRAME" },
200 { _UA_FORCE_UNWIND
, "FORCE_UNWIND" },
204 db_accepted_codes (void)
206 static int accepted_codes
= -1;
208 if (accepted_codes
== -1)
210 char * db_env
= (char *) getenv ("EH_DEBUG");
212 accepted_codes
= db_env
? (atoi (db_env
) | DB_ERR
) : 0;
213 /* Arranged for ERR stuff to always be visible when the variable
214 is defined. One may just set the variable to 0 to see the ERR
218 return accepted_codes
;
221 #define DB_INDENT_INCREASE 0x01
222 #define DB_INDENT_DECREASE 0x02
223 #define DB_INDENT_OUTPUT 0x04
224 #define DB_INDENT_NEWLINE 0x08
225 #define DB_INDENT_RESET 0x10
227 #define DB_INDENT_UNIT 8
230 db_indent (int requests
)
232 static int current_indentation_level
= 0;
234 if (requests
& DB_INDENT_RESET
)
235 current_indentation_level
= 0;
237 if (requests
& DB_INDENT_INCREASE
)
238 current_indentation_level
++;
240 if (requests
& DB_INDENT_DECREASE
)
241 current_indentation_level
--;
243 if (requests
& DB_INDENT_NEWLINE
)
244 fprintf (stderr
, "\n");
246 if (requests
& DB_INDENT_OUTPUT
)
247 fprintf (stderr
, "%*s", current_indentation_level
* DB_INDENT_UNIT
, " ");
250 static void ATTRIBUTE_PRINTF_2
251 db (int db_code
, const char * msg_format
, ...)
253 if (db_accepted_codes () & db_code
)
257 db_indent (DB_INDENT_OUTPUT
);
259 va_start (msg_args
, msg_format
);
260 vfprintf (stderr
, msg_format
, msg_args
);
266 db_phases (int phases
)
268 const phase_descriptor
*a
= phase_descriptors
;
270 if (! (db_accepted_codes () & DB_PHASES
))
273 db (DB_PHASES
, "\n");
275 for (; a
->description
!= 0; a
++)
276 if (phases
& a
->phase
)
277 db (DB_PHASES
, "%s ", a
->description
);
279 db (DB_PHASES
, " :\n");
281 #else /* !inhibit_libc */
285 #endif /* !inhibit_libc */
287 /* ---------------------------------------------------------------
288 -- Now come a set of useful structures and helper routines. --
289 --------------------------------------------------------------- */
291 /* There are three major runtime tables involved, generated by the
292 GCC back-end. Contents slightly vary depending on the underlying
293 implementation scheme (dwarf zero cost / sjlj).
295 =======================================
296 * Tables for the dwarf zero cost case *
297 =======================================
299 They are fully documented in:
300 http://sourcery.mentor.com/public/cxx-abi/exceptions.pdf
301 Here is a shorter presentation, with some specific comments for Ada.
304 -------------------------------------------------------------------
305 * region-start | region-length | landing-pad | first-action-index *
306 -------------------------------------------------------------------
308 Identify possible actions to be taken and where to resume control
309 for that when an exception propagates through a pc inside the region
310 delimited by start and length.
312 A null landing-pad indicates that nothing is to be done.
314 Otherwise, first-action-index provides an entry into the action[]
315 table which heads a list of possible actions to be taken (see below).
317 If it is determined that indeed an action should be taken, that
318 is, if one action filter matches the exception being propagated,
319 then control should be transferred to landing-pad.
321 A null first-action-index indicates that there are only cleanups
325 -------------------------------
326 * action-filter | next-action *
327 -------------------------------
329 This table contains lists (called action chains) of possible actions
330 associated with call-site entries described in the call-site [] table.
331 There is at most one action list per call-site entry. It is SLEB128
334 A null action-filter indicates a cleanup.
336 Non null action-filters provide an index into the ttypes [] table
337 (see below), from which information may be retrieved to check if it
338 matches the exception being propagated.
341 means there is a regular handler to be run The value is also passed
342 to the landing pad to dispatch the exception.
345 means there is a some "exception_specification" data to retrieve,
346 which is only relevant for C++ and should never show up for Ada.
347 (Exception specification specifies which exceptions can be thrown
348 by a function. Such filter is emitted around the body of C++
349 functions defined like:
350 void foo ([...]) throw (A, B) { [...] }
351 These can be viewed as negativ filter: the landing pad is branched
352 to for exceptions that doesn't match the filter and usually aborts
356 points to the next entry in the list using a relative byte offset. 0
357 indicates there is no other entry.
364 This table is an array of addresses.
366 A null value indicates a catch-all handler. (Not used by Ada)
368 Non null values are used to match the exception being propagated:
369 In C++ this is a pointer to some rtti data, while in Ada this is an
370 exception id (with a fake id for others).
372 For C++, this table is actually also used to store "exception
373 specification" data. The differentiation between the two kinds
374 of entries is made by the sign of the associated action filter,
375 which translates into positive or negative offsets from the
376 so called base of the table:
378 Exception Specification data is stored at positive offsets from
379 the ttypes table base, which Exception Type data is stored at
382 ---------------------------------------------------------------------------
384 Here is a quick summary of the tables organization:
386 +-- Unwind_Context (pc, ...)
392 | +=============================================================+
393 | | region-start + length | landing-pad | first-action-index |
394 | +=============================================================+
395 +-> | pc range 0 => no-action 0 => cleanups only |
396 | !0 => jump @ N --+ |
397 +====================================================== | ====+
402 +==========================================================+ |
403 | action-filter | next-action | |
404 +==========================================================+ |
406 | >0 => ttype index for handler ------+ 0 => end of chain | <-+
407 | <0 => ttype index for spec data | |
408 +==================================== | ===================+
412 | Offset negated from
413 +=====================+ | the actual base.
415 +============+=====================+ |
417 | ... | exception id | <---+
419 | handlers +---------------------+
423 +============+=====================+ <<------ Table base
425 | specs | ... | (should not see negative filter
426 | ... | ... | values for Ada).
427 +============+=====================+
430 ============================
431 * Tables for the sjlj case *
432 ============================
434 So called "function contexts" are pushed on a context stack by calls to
435 _Unwind_SjLj_Register on function entry, and popped off at exit points by
436 calls to _Unwind_SjLj_Unregister. The current call_site for a function is
437 updated in the function context as the function's code runs along.
439 The generic unwinding engine in _Unwind_RaiseException walks the function
440 context stack and not the actual call chain.
442 The ACTION and TTYPES tables remain unchanged, which allows to search them
443 during the propagation phase to determine whether or not the propagated
444 exception is handled somewhere. When it is, we only "jump" up once directly
445 to the context where the handler will be found. Besides, this allows "break
446 exception unhandled" to work also
448 The CALL-SITE table is setup differently, though: the pc attached to the
449 unwind context is a direct index into the table, so the entries in this
450 table do not hold region bounds any more.
452 A special index (-1) is used to indicate that no action is possibly
453 connected with the context at hand, so null landing pads cannot appear
456 Additionally, landing pad values in the table do not represent code address
457 to jump at, but so called "dispatch" indices used by a common landing pad
458 for the function to switch to the appropriate post-landing-pad.
460 +-- Unwind_Context (pc, ...)
462 | pc = call-site index
463 | 0 => terminate (should not see this for Ada)
468 | +=====================================+
469 | | landing-pad | first-action-index |
470 | +=====================================+
471 +-> | 0 => cleanups only |
473 +=====================================+
476 ===================================
477 * Basic organization of this unit *
478 ===================================
480 The major point of this unit is to provide an exception propagation
481 personality routine for Ada. This is __gnat_personality_v0.
483 It is provided with a pointer to the propagated exception, an unwind
484 context describing a location the propagation is going through, and a
485 couple of other arguments including a description of the current
488 It shall return to the generic propagation engine what is to be performed
489 next, after possible context adjustments, depending on what it finds in the
490 traversed context (a handler for the exception, a cleanup, nothing, ...),
491 and on the propagation phase.
493 A number of structures and subroutines are used for this purpose, as
496 o region_descriptor: General data associated with the context (base pc,
497 call-site table, action table, ttypes table, ...)
499 o action_descriptor: Data describing the action to be taken for the
500 propagated exception in the provided context (kind of action: nothing,
501 handler, cleanup; pointer to the action table entry, ...).
507 Propagate_Exception (a-exexpr.adb)
510 _Unwind_RaiseException (libgcc)
514 +--> __gnat_personality_v0 (context, exception)
516 +--> get_region_description_for (context)
518 +--> get_action_description_for (ip, exception, region)
520 | +--> get_call_site_action_for (context, region)
521 | (one version for each underlying scheme)
523 +--> setup_to_install (context)
525 This unit is inspired from the C++ version found in eh_personality.cc,
526 part of libstdc++-v3.
531 /* This is an incomplete "proxy" of the structure of exception objects as
532 built by the GNAT runtime library. Accesses to other fields than the common
533 header are performed through subprogram calls to alleviate the need of an
534 exact counterpart here and potential alignment/size issues for the common
535 header. See a-exexpr.adb. */
539 _Unwind_Exception common
;
540 /* ABI header, maximally aligned. */
543 /* The three constants below are specific ttype identifiers for special
544 exception ids. Their type should match what a-exexpr exports. */
546 extern char __gnat_others_value
;
547 #define GNAT_OTHERS ((Exception_Id) &__gnat_others_value)
549 extern char __gnat_all_others_value
;
550 #define GNAT_ALL_OTHERS ((Exception_Id) &__gnat_all_others_value)
552 extern char __gnat_unhandled_others_value
;
553 #define GNAT_UNHANDLED_OTHERS ((Exception_Id) &__gnat_unhandled_others_value)
555 /* Describe the useful region data associated with an unwind context. */
559 /* The base pc of the region. */
562 /* Pointer to the Language Specific Data for the region. */
565 /* Call-Site data associated with this region. */
566 unsigned char call_site_encoding
;
567 const unsigned char *call_site_table
;
569 /* The base to which are relative landing pad offsets inside the call-site
573 /* Action-Table associated with this region. */
574 const unsigned char *action_table
;
576 /* Ttype data associated with this region. */
577 unsigned char ttype_encoding
;
578 const unsigned char *ttype_table
;
579 _Unwind_Ptr ttype_base
;
583 /* Extract and adjust the IP (instruction pointer) from an exception
587 get_ip_from_context (_Unwind_Context
*uw_context
)
589 int ip_before_insn
= 0;
590 #ifdef HAVE_GETIPINFO
591 _Unwind_Ptr ip
= _Unwind_GetIPInfo (uw_context
, &ip_before_insn
);
593 _Unwind_Ptr ip
= _Unwind_GetIP (uw_context
);
595 /* Subtract 1 if necessary because GetIPInfo yields a call return address
596 in this case, while we are interested in information for the call point.
597 This does not always yield the exact call instruction address but always
598 brings the IP back within the corresponding region. */
606 db_region_for (region_descriptor
*region
, _Unwind_Ptr ip
)
609 if (! (db_accepted_codes () & DB_REGIONS
))
612 db (DB_REGIONS
, "For ip @ %p => ", (void *)ip
);
615 db (DB_REGIONS
, "lsda @ %p", (void *)region
->lsda
);
617 db (DB_REGIONS
, "no lsda");
619 db (DB_REGIONS
, "\n");
623 /* Retrieve the ttype entry associated with FILTER in the REGION's
627 get_ttype_entry_for (region_descriptor
*region
, long filter
)
629 _Unwind_Ptr ttype_entry
;
631 filter
*= size_of_encoded_value (region
->ttype_encoding
);
632 read_encoded_value_with_base
633 (region
->ttype_encoding
, region
->ttype_base
,
634 region
->ttype_table
- filter
, &ttype_entry
);
639 /* Fill out the REGION descriptor for the provided UW_CONTEXT. */
642 get_region_description_for (_Unwind_Context
*uw_context
,
643 region_descriptor
*region
)
645 const unsigned char * p
;
647 unsigned char lpbase_encoding
;
649 /* Get the base address of the lsda information. If the provided context
650 is null or if there is no associated language specific data, there's
651 nothing we can/should do. */
653 = (_Unwind_Ptr
) (uw_context
654 ? _Unwind_GetLanguageSpecificData (uw_context
) : 0);
659 /* Parse the lsda and fill the region descriptor. */
660 p
= (const unsigned char *)region
->lsda
;
662 region
->base
= _Unwind_GetRegionStart (uw_context
);
664 /* Find @LPStart, the base to which landing pad offsets are relative. */
665 lpbase_encoding
= *p
++;
666 if (lpbase_encoding
!= DW_EH_PE_omit
)
667 p
= read_encoded_value
668 (uw_context
, lpbase_encoding
, p
, ®ion
->lp_base
);
670 region
->lp_base
= region
->base
;
672 /* Find @TType, the base of the handler and exception spec type data. */
673 region
->ttype_encoding
= *p
++;
674 if (region
->ttype_encoding
!= DW_EH_PE_omit
)
676 p
= read_uleb128 (p
, &tmp
);
677 region
->ttype_table
= p
+ tmp
;
680 region
->ttype_table
= 0;
683 = base_of_encoded_value (region
->ttype_encoding
, uw_context
);
685 /* Get the encoding and length of the call-site table; the action table
686 immediately follows. */
687 region
->call_site_encoding
= *p
++;
688 region
->call_site_table
= read_uleb128 (p
, &tmp
);
690 region
->action_table
= region
->call_site_table
+ tmp
;
694 /* Describe an action to be taken when propagating an exception up to
699 /* Found some call site base data, but need to analyze further
700 before being able to decide. */
703 /* There is nothing relevant in the context at hand. */
706 /* There are only cleanups to run in this context. */
709 /* There is a handler for the exception in this context. */
712 /* There is a handler for the exception, but it is only for catching
713 unhandled exceptions. */
717 /* filter value for cleanup actions. */
718 static const int cleanup_filter
= 0;
722 /* The kind of action to be taken. */
723 enum action_kind kind
;
725 /* A pointer to the action record entry. */
726 const unsigned char *table_entry
;
728 /* Where we should jump to actually take an action (trigger a cleanup or an
729 exception handler). */
730 _Unwind_Ptr landing_pad
;
732 /* If we have a handler matching our exception, these are the filter to
733 trigger it and the corresponding id. */
734 _Unwind_Sword ttype_filter
;
739 db_action_for (action_descriptor
*action
, _Unwind_Ptr ip
)
742 db (DB_ACTIONS
, "For ip @ %p => ", (void *)ip
);
744 switch (action
->kind
)
747 db (DB_ACTIONS
, "lpad @ %p, record @ %p\n",
748 (void *) action
->landing_pad
, action
->table_entry
);
752 db (DB_ACTIONS
, "Nothing\n");
756 db (DB_ACTIONS
, "Cleanup\n");
760 db (DB_ACTIONS
, "Handler, filter = %d\n", (int) action
->ttype_filter
);
764 db (DB_ACTIONS
, "Err? Unexpected action kind !\n");
770 /* Search the call_site_table of REGION for an entry appropriate for the
771 UW_CONTEXT's IP. If one is found, store the associated landing_pad
772 and action_table entry, and set the ACTION kind to unknown for further
773 analysis. Otherwise, set the ACTION kind to nothing.
775 There are two variants of this routine, depending on the underlying
776 mechanism (DWARF/SJLJ), which account for differences in the tables. */
778 #ifdef __USING_SJLJ_EXCEPTIONS__
780 #define __builtin_eh_return_data_regno(x) x
783 get_call_site_action_for (_Unwind_Ptr call_site
,
784 region_descriptor
*region
,
785 action_descriptor
*action
)
787 /* call_site is a direct index into the call-site table, with two special
788 values : -1 for no-action and 0 for "terminate". The latter should never
789 show up for Ada. To test for the former, beware that _Unwind_Ptr might
792 if ((int)call_site
< 0)
794 action
->kind
= nothing
;
796 else if (call_site
== 0)
798 db (DB_ERR
, "========> Err, null call_site for Ada/sjlj\n");
799 action
->kind
= nothing
;
803 _uleb128_t cs_lp
, cs_action
;
804 const unsigned char *p
;
806 /* Let the caller know there may be an action to take, but let it
807 determine the kind. */
808 action
->kind
= unknown
;
810 /* We have a direct index into the call-site table, but this table is
811 made of leb128 values, the encoding length of which is variable. We
812 can't merely compute an offset from the index, then, but have to read
813 all the entries before the one of interest. */
814 p
= region
->call_site_table
;
817 p
= read_uleb128 (p
, &cs_lp
);
818 p
= read_uleb128 (p
, &cs_action
);
822 action
->landing_pad
= cs_lp
+ 1;
825 action
->table_entry
= region
->action_table
+ cs_action
- 1;
827 action
->table_entry
= 0;
831 #else /* !__USING_SJLJ_EXCEPTIONS__ */
834 get_call_site_action_for (_Unwind_Ptr ip
,
835 region_descriptor
*region
,
836 action_descriptor
*action
)
838 const unsigned char *p
= region
->call_site_table
;
840 /* Unless we are able to determine otherwise... */
841 action
->kind
= nothing
;
845 while (p
< region
->action_table
)
847 _Unwind_Ptr cs_start
, cs_len
, cs_lp
;
848 _uleb128_t cs_action
;
850 /* Note that all call-site encodings are "absolute" displacements. */
851 p
= read_encoded_value (0, region
->call_site_encoding
, p
, &cs_start
);
852 p
= read_encoded_value (0, region
->call_site_encoding
, p
, &cs_len
);
853 p
= read_encoded_value (0, region
->call_site_encoding
, p
, &cs_lp
);
854 p
= read_uleb128 (p
, &cs_action
);
857 "c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
858 (char *)region
->base
+ cs_start
, (void *)cs_start
, (void *)cs_len
,
859 (char *)region
->lp_base
+ cs_lp
, (void *)cs_lp
);
861 /* The table is sorted, so if we've passed the IP, stop. */
862 if (ip
< region
->base
+ cs_start
)
865 /* If we have a match, fill the ACTION fields accordingly. */
866 else if (ip
< region
->base
+ cs_start
+ cs_len
)
868 /* Let the caller know there may be an action to take, but let it
869 determine the kind. */
870 action
->kind
= unknown
;
873 action
->landing_pad
= region
->lp_base
+ cs_lp
;
875 action
->landing_pad
= 0;
878 action
->table_entry
= region
->action_table
+ cs_action
- 1;
880 action
->table_entry
= 0;
882 db (DB_CSITE
, "+++\n");
887 db (DB_CSITE
, "---\n");
890 #endif /* __USING_SJLJ_EXCEPTIONS__ */
892 /* With CHOICE an exception choice representing an "exception - when"
893 argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
894 occurrence, return true if the latter matches the former, that is, if
895 PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
898 #define Is_Handled_By_Others __gnat_is_handled_by_others
899 #define Language_For __gnat_language_for
900 #define Foreign_Data_For __gnat_foreign_data_for
901 #define EID_For __gnat_eid_for
903 extern bool Is_Handled_By_Others (Exception_Id eid
);
904 extern char Language_For (Exception_Id eid
);
905 extern void *Foreign_Data_For (Exception_Id eid
);
906 extern Exception_Id
EID_For (_GNAT_Exception
*e
);
908 #define Foreign_Exception system__exceptions__foreign_exception
909 extern struct Exception_Data Foreign_Exception
;
911 /* Return true iff the exception class of EXCEPT is EC. */
914 exception_class_eq (const _GNAT_Exception
*except
,
915 const _Unwind_Exception_Class ec
)
917 #ifdef __ARM_EABI_UNWINDER__
918 return memcmp (except
->common
.exception_class
, ec
, 8) == 0;
920 return except
->common
.exception_class
== ec
;
924 /* Return how CHOICE matches PROPAGATED_EXCEPTION. */
926 static enum action_kind
927 is_handled_by (Exception_Id choice
, _GNAT_Exception
*propagated_exception
)
929 /* All others choice match everything. */
930 if (choice
== GNAT_ALL_OTHERS
)
933 /* GNAT exception occurrence. */
934 if (exception_class_eq (propagated_exception
, GNAT_EXCEPTION_CLASS
))
936 if (choice
== GNAT_UNHANDLED_OTHERS
)
939 Exception_Id E
= EID_For (propagated_exception
);
941 /* Base matching rules: An exception data (id) matches itself, "when
942 all_others" matches anything and "when others" matches anything
943 unless explicitly stated otherwise in the propagated occurrence. */
944 if (choice
== E
|| (choice
== GNAT_OTHERS
&& Is_Handled_By_Others (E
)))
947 /* Otherwise, it doesn't match an Ada choice. */
951 /* All others and others choice match any foreign exception. */
952 if (choice
== GNAT_ALL_OTHERS
953 || choice
== GNAT_OTHERS
955 || choice
== &Foreign_Exception
961 /* C++ exception occurrences. */
962 if (exception_class_eq (propagated_exception
, CXX_EXCEPTION_CLASS
)
963 && Language_For (choice
) == 'C')
965 void *choice_typeinfo
= Foreign_Data_For (choice
);
966 void *except_typeinfo
=
967 (((struct __cxa_exception
*)
968 ((_Unwind_Exception
*)propagated_exception
+ 1)) - 1)
971 /* Typeinfo are directly compared, which might not be correct if they
972 aren't merged. ??? We should call the == operator if this module is
974 if (choice_typeinfo
== except_typeinfo
)
982 /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
983 UW_CONTEXT in REGION. */
986 get_action_description_for (_Unwind_Ptr ip
,
987 _Unwind_Exception
*uw_exception
,
988 _Unwind_Action uw_phase
,
989 region_descriptor
*region
,
990 action_descriptor
*action
)
992 _GNAT_Exception
*gnat_exception
= (_GNAT_Exception
*) uw_exception
;
994 /* Search the call site table first, which may get us a landing pad as well
995 as the head of an action record list. */
996 get_call_site_action_for (ip
, region
, action
);
997 db_action_for (action
, ip
);
999 /* If there is not even a call_site entry, we are done. */
1000 if (action
->kind
== nothing
)
1003 /* Otherwise, check what we have at the place of the call site. */
1005 /* No landing pad => no cleanups or handlers. */
1006 if (action
->landing_pad
== 0)
1008 action
->kind
= nothing
;
1012 /* Landing pad + null table entry => only cleanups. */
1013 else if (action
->table_entry
== 0)
1015 action
->kind
= cleanup
;
1016 action
->ttype_filter
= cleanup_filter
;
1017 /* The filter initialization is not strictly necessary, as cleanup-only
1018 landing pads don't look at the filter value. It is there to ensure
1019 we don't pass random values and so trigger potential confusion when
1020 installing the context later on. */
1024 /* Landing pad + Table entry => handlers + possible cleanups. */
1027 const unsigned char * p
= action
->table_entry
;
1028 _sleb128_t ar_filter
, ar_disp
;
1030 action
->kind
= nothing
;
1034 p
= read_sleb128 (p
, &ar_filter
);
1035 read_sleb128 (p
, &ar_disp
);
1036 /* Don't assign p here, as it will be incremented by ar_disp
1039 /* Null filters are for cleanups. */
1040 if (ar_filter
== cleanup_filter
)
1042 action
->kind
= cleanup
;
1043 action
->ttype_filter
= cleanup_filter
;
1044 /* The filter initialization is required here, to ensure
1045 the target landing pad branches to the cleanup code if
1046 we happen not to find a matching handler. */
1049 /* Positive filters are for regular handlers. */
1050 else if (ar_filter
> 0)
1052 /* Do not catch an exception if the _UA_FORCE_UNWIND flag is
1053 passed (to follow the ABI). */
1054 if (!(uw_phase
& _UA_FORCE_UNWIND
))
1056 enum action_kind act
;
1058 /* See if the filter we have is for an exception which
1059 matches the one we are propagating. */
1061 = (Exception_Id
) get_ttype_entry_for (region
, ar_filter
);
1063 act
= is_handled_by (choice
, gnat_exception
);
1067 action
->ttype_filter
= ar_filter
;
1073 /* Negative filter values are for C++ exception specifications.
1074 Should not be there for Ada :/ */
1076 db (DB_ERR
, "========> Err, filter < 0 for Ada/dwarf\n");
1086 /* Setup in UW_CONTEXT the eh return target IP and data registers, which will
1087 be restored with the others and retrieved by the landing pad once the jump
1091 setup_to_install (_Unwind_Context
*uw_context
,
1092 _Unwind_Exception
*uw_exception
,
1093 _Unwind_Ptr uw_landing_pad
,
1096 /* 1/ exception object pointer, which might be provided back to
1097 _Unwind_Resume (and thus to this personality routine) if we are jumping
1099 _Unwind_SetGR (uw_context
, __builtin_eh_return_data_regno (0),
1100 (_Unwind_Word
)uw_exception
);
1102 /* 2/ handler switch value register, which will also be used by the target
1103 landing pad to decide what action it shall take. */
1104 _Unwind_SetGR (uw_context
, __builtin_eh_return_data_regno (1),
1105 (_Unwind_Word
)uw_filter
);
1107 /* Setup the address we should jump at to reach the code where there is the
1108 "something" we found. */
1109 _Unwind_SetIP (uw_context
, uw_landing_pad
);
1112 /* The following is defined from a-except.adb. Its purpose is to enable
1113 automatic backtraces upon exception raise, as provided through the
1114 GNAT.Traceback facilities. */
1115 extern void __gnat_notify_handled_exception (struct Exception_Occurrence
*);
1116 extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence
*);
1118 /* Below is the eh personality routine per se. We currently assume that only
1119 GNU-Ada exceptions are met. */
1121 /* By default, the personality routine is public. */
1122 #define PERSONALITY_STORAGE
1124 #ifdef __USING_SJLJ_EXCEPTIONS__
1125 #define PERSONALITY_FUNCTION __gnat_personality_sj0
1126 #elif defined (__SEH__)
1127 #define PERSONALITY_FUNCTION __gnat_personality_imp
1128 /* The public personality routine for seh is __gnat_personality_seh0, defined
1129 below using the SEH convention. This is a wrapper around the GNU routine,
1131 #undef PERSONALITY_STORAGE
1132 #define PERSONALITY_STORAGE static
1134 #define PERSONALITY_FUNCTION __gnat_personality_v0
1137 #if defined (__ARM_EABI_UNWINDER__) \
1138 && (defined (IN_RTS) || GCC_VERSION > 9000)
1139 #define TARGET_ATTRIBUTE __attribute__((target ("general-regs-only")))
1141 #define TARGET_ATTRIBUTE
1144 /* Code executed to continue unwinding. With the ARM unwinder, the
1145 personality routine must unwind one frame (per EHABI 7.3 4.). */
1147 static _Unwind_Reason_Code
1149 continue_unwind (struct _Unwind_Exception
* ue_header ATTRIBUTE_UNUSED
,
1150 struct _Unwind_Context
* uw_context ATTRIBUTE_UNUSED
)
1152 #ifdef __ARM_EABI_UNWINDER__
1153 if (__gnu_unwind_frame (ue_header
, uw_context
) != _URC_OK
)
1154 return _URC_FAILURE
;
1156 return _URC_CONTINUE_UNWIND
;
1159 /* Common code for the body of GNAT personality routine. This code is shared
1160 between all unwinders. */
1162 static _Unwind_Reason_Code
1164 personality_body (_Unwind_Action uw_phases
,
1165 _Unwind_Exception
*uw_exception
,
1166 _Unwind_Context
*uw_context
)
1168 region_descriptor region
;
1169 action_descriptor action
;
1173 db_indent (DB_INDENT_RESET
);
1174 db_phases (uw_phases
);
1175 db_indent (DB_INDENT_INCREASE
);
1177 /* Get the region description for the context we were provided with. This
1178 will tell us if there is some lsda, call_site, action and/or ttype data
1179 for the associated ip. */
1180 get_region_description_for (uw_context
, ®ion
);
1182 /* No LSDA => no handlers or cleanups => we shall unwind further up. */
1184 return continue_unwind (uw_exception
, uw_context
);
1186 /* Get the instruction pointer. */
1187 ip
= get_ip_from_context (uw_context
);
1188 db_region_for (®ion
, ip
);
1190 /* Search the call-site and action-record tables for the action associated
1192 get_action_description_for (ip
, uw_exception
, uw_phases
, ®ion
, &action
);
1193 db_action_for (&action
, ip
);
1195 /* Whatever the phase, if there is nothing relevant in this frame,
1196 unwinding should just go on. */
1197 if (action
.kind
== nothing
)
1198 return continue_unwind (uw_exception
, uw_context
);
1200 /* If we found something in search phase, we should return a code indicating
1201 what to do next depending on what we found. If we only have cleanups
1202 around, we shall try to unwind further up to find a handler, otherwise,
1203 tell we have a handler, which will trigger the second phase. */
1204 if (uw_phases
& _UA_SEARCH_PHASE
)
1206 if (action
.kind
== cleanup
)
1208 return continue_unwind (uw_exception
, uw_context
);
1212 #ifdef __ARM_EABI_UNWINDER__
1213 /* Though we do not use this field ourselves, initializing
1214 it is required by the ARM EH ABI before a personality
1215 function in phase1 returns _URC_HANDLER_FOUND, so that
1216 any personality function can use it in phase2 to test
1217 whether the handler frame was reached. */
1218 uw_exception
->barrier_cache
.sp
1219 = _Unwind_GetGR (uw_context
, UNWIND_STACK_REG
);
1223 /* Trigger the appropriate notification routines before the second
1224 phase starts, when the stack is still intact. First install what
1225 needs to be installed in the current exception buffer and fetch
1226 the Ada occurrence pointer to use. */
1228 struct Exception_Occurrence
*excep
1229 = __gnat_setup_current_excep (uw_exception
, uw_phases
);
1231 if (action
.kind
== unhandler
)
1232 __gnat_notify_unhandled_exception (excep
);
1234 __gnat_notify_handled_exception (excep
);
1237 return _URC_HANDLER_FOUND
;
1241 /* We found something in cleanup/handler phase, which might be the handler
1242 or a cleanup for a handled occurrence, or a cleanup for an unhandled
1243 occurrence (we are in a FORCED_UNWIND phase in this case). Install the
1244 context to get there. */
1247 (uw_context
, uw_exception
, action
.landing_pad
, action
.ttype_filter
);
1250 /* Write current exception so that it can be retrieved from Ada. It was
1251 already done during phase 1, but one or several exceptions may have been
1252 raised in cleanup handlers in between. */
1253 __gnat_setup_current_excep (uw_exception
, uw_phases
);
1256 return _URC_INSTALL_CONTEXT
;
1259 #ifndef __ARM_EABI_UNWINDER__
1260 typedef int version_arg_t
;
1261 typedef _Unwind_Action phases_arg_t
;
1263 PERSONALITY_STORAGE _Unwind_Reason_Code
1264 PERSONALITY_FUNCTION (version_arg_t
, phases_arg_t
,
1265 _Unwind_Exception_Class
, _Unwind_Exception
*,
1268 PERSONALITY_STORAGE _Unwind_Reason_Code
1269 PERSONALITY_FUNCTION (version_arg_t version_arg
,
1270 phases_arg_t phases_arg
,
1271 _Unwind_Exception_Class uw_exception_class
1273 _Unwind_Exception
*uw_exception
,
1274 _Unwind_Context
*uw_context
)
1276 /* Fetch the version and phases args with their nominal ABI types for later
1277 use. This is a noop everywhere except on ia64-vms when called from the
1278 Condition Handling Facility. */
1279 int uw_version
= (int) version_arg
;
1280 _Unwind_Action uw_phases
= (_Unwind_Action
) phases_arg
;
1282 /* Check that we're called from the ABI context we expect. */
1283 if (uw_version
!= 1)
1284 return _URC_FATAL_PHASE1_ERROR
;
1286 return personality_body (uw_phases
, uw_exception
, uw_context
);
1289 #else /* __ARM_EABI_UNWINDER__ */
1291 PERSONALITY_STORAGE _Unwind_Reason_Code
1292 PERSONALITY_FUNCTION (_Unwind_State state
,
1293 struct _Unwind_Exception
* ue_header
,
1294 struct _Unwind_Context
* uw_context
);
1296 PERSONALITY_STORAGE _Unwind_Reason_Code
1298 PERSONALITY_FUNCTION (_Unwind_State state
,
1299 struct _Unwind_Exception
* uw_exception
,
1300 struct _Unwind_Context
* uw_context
)
1302 _Unwind_Action uw_phases
;
1304 switch (state
& _US_ACTION_MASK
)
1306 case _US_VIRTUAL_UNWIND_FRAME
:
1308 uw_phases
= _UA_SEARCH_PHASE
;
1311 case _US_UNWIND_FRAME_STARTING
:
1312 /* Phase 2, to call a cleanup. */
1313 uw_phases
= _UA_CLEANUP_PHASE
;
1315 /* ??? We don't use UA_HANDLER_FRAME (except to debug). Futhermore,
1316 barrier_cache.sp isn't yet set. */
1317 if (!(state
& _US_FORCE_UNWIND
)
1318 && (uw_exception
->barrier_cache
.sp
1319 == _Unwind_GetGR (uw_context
, UNWIND_STACK_REG
)))
1320 uw_phases
|= _UA_HANDLER_FRAME
;
1324 case _US_UNWIND_FRAME_RESUME
:
1325 /* Phase 2, called at the return of a cleanup. In the GNU
1326 implementation, there is nothing left to do, so we simply go on. */
1327 return continue_unwind (uw_exception
, uw_context
);
1330 return _URC_FAILURE
;
1332 uw_phases
|= (state
& _US_FORCE_UNWIND
);
1334 /* The dwarf unwinder assumes the context structure holds things like the
1335 function and LSDA pointers. The ARM implementation caches these in
1336 the exception header (UCB). To avoid rewriting everything we make a
1337 virtual scratch register point at the UCB. This is a GNU specific
1339 _Unwind_SetGR (uw_context
, UNWIND_POINTER_REG
, (_Unwind_Ptr
) uw_exception
);
1341 return personality_body (uw_phases
, uw_exception
, uw_context
);
1343 #endif /* __ARM_EABI_UNWINDER__ */
1345 /* Callback routine called by Unwind_ForcedUnwind to execute all the cleanup
1346 before exiting the task. */
1350 __gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED
,
1351 _Unwind_Action phases
,
1352 _Unwind_Exception_Class eclass ATTRIBUTE_UNUSED
,
1353 struct _Unwind_Exception
*exception
,
1354 struct _Unwind_Context
*context ATTRIBUTE_UNUSED
,
1355 void *arg ATTRIBUTE_UNUSED
)
1357 /* Terminate when the end of the stack is reached. */
1358 if ((phases
& _UA_END_OF_STACK
) != 0
1359 #if defined (__ia64__) && defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
1360 /* Strictely follow the ia64 ABI: when end of stack is reached,
1361 the callback will be called with a NULL stack pointer.
1362 No need for that when using libgcc unwinder. */
1363 || _Unwind_GetGR (context
, 12) == 0
1366 __gnat_unhandled_except_handler (exception
);
1368 /* We know there is at least one cleanup further up. Return so that it
1369 is searched and entered, after which Unwind_Resume will be called
1370 and this hook will gain control again. */
1371 return _URC_NO_REASON
;
1375 /* Define the consistently named wrappers imported by Propagate_Exception. */
1378 __gnat_Unwind_RaiseException (_Unwind_Exception
*e
)
1380 #ifdef NO_EXCEPTION_PROPAGATION
1384 #ifdef __USING_SJLJ_EXCEPTIONS__
1385 return _Unwind_SjLj_RaiseException (e
);
1387 return _Unwind_RaiseException (e
);
1392 __gnat_Unwind_ForcedUnwind (_Unwind_Exception
*e ATTRIBUTE_UNUSED
,
1393 _Unwind_Stop_Fn handler ATTRIBUTE_UNUSED
,
1394 void *argument ATTRIBUTE_UNUSED
)
1396 #ifdef __USING_SJLJ_EXCEPTIONS__
1398 # if defined (__APPLE__) && defined (__arm__)
1399 /* There is not ForcedUnwind routine in arm-darwin system library. */
1400 return _URC_FATAL_PHASE1_ERROR
;
1402 return _Unwind_SjLj_ForcedUnwind (e
, handler
, argument
);
1406 return _Unwind_ForcedUnwind (e
, handler
, argument
);
1410 #if defined (__SEH__) && !defined (__USING_SJLJ_EXCEPTIONS__)
1412 #define STATUS_USER_DEFINED (1U << 29)
1414 /* From unwind-seh.c. */
1415 #define GCC_MAGIC (('G' << 16) | ('C' << 8) | 'C')
1416 #define GCC_EXCEPTION(TYPE) \
1417 (STATUS_USER_DEFINED | ((TYPE) << 24) | GCC_MAGIC)
1418 #define STATUS_GCC_THROW GCC_EXCEPTION (0)
1420 struct Exception_Data
*
1421 __gnat_map_SEH (EXCEPTION_RECORD
* ExceptionRecord
, const char **msg
);
1423 struct _Unwind_Exception
*
1424 __gnat_create_machine_occurrence_from_signal_handler (Exception_Id
,
1427 /* Unwind opcodes. */
1428 #define UWOP_PUSH_NONVOL 0
1429 #define UWOP_ALLOC_LARGE 1
1430 #define UWOP_ALLOC_SMALL 2
1431 #define UWOP_SET_FPREG 3
1432 #define UWOP_SAVE_NONVOL 4
1433 #define UWOP_SAVE_NONVOL_FAR 5
1434 #define UWOP_SAVE_XMM128 8
1435 #define UWOP_SAVE_XMM128_FAR 9
1436 #define UWOP_PUSH_MACHFRAME 10
1438 /* Modify the IP value saved in the machine frame. This is really a kludge,
1439 that will be removed if we could propagate the Windows exception (and not
1442 What is very wrong is that the Windows unwinder will try to decode the
1443 instruction at IP, which isn't valid anymore after the adjustment. */
1446 __gnat_adjust_context (unsigned char *unw
, ULONG64 rsp
)
1450 /* Version 1 or 2. */
1451 if (unw
[0] != 1 && unw
[0] != 2)
1453 /* No flags, no prologue. */
1460 /* ??? Skip the first 2 undocumented opcodes for version 2. */
1467 /* Offset in prologue = 0. */
1470 switch (unw
[1] & 0xf)
1472 case UWOP_ALLOC_LARGE
:
1473 /* Expect < 512KB. */
1474 if ((unw
[1] & 0xf0) != 0)
1476 rsp
+= *(unsigned short *)(unw
+ 2) * 8;
1480 case UWOP_SAVE_NONVOL
:
1481 case UWOP_SAVE_XMM128
:
1485 case UWOP_PUSH_MACHFRAME
:
1488 rip
= (ULONG64
*)rsp
;
1489 if ((unw
[1] & 0xf0) == 0x10)
1504 EXCEPTION_DISPOSITION
1505 __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc
, void *this_frame
,
1506 PCONTEXT ms_orig_context
,
1507 PDISPATCHER_CONTEXT ms_disp
)
1509 /* Possibly transform run-time errors into Ada exceptions. */
1510 if (!(ms_exc
->ExceptionCode
& STATUS_USER_DEFINED
))
1512 struct Exception_Data
*exception
;
1514 ULONG64 excpip
= (ULONG64
) ms_exc
->ExceptionAddress
;
1517 && excpip
>= (ms_disp
->ImageBase
1518 + ms_disp
->FunctionEntry
->BeginAddress
)
1519 && excpip
< (ms_disp
->ImageBase
1520 + ms_disp
->FunctionEntry
->EndAddress
))
1522 /* This is a fault in this function. We need to adjust the return
1523 address before raising the GCC exception. In order to do that,
1524 we need to locate the machine frame that has been pushed onto
1525 the stack in response to the hardware exception, so we will do
1526 a private unwinding from here, i.e. the frame of the personality
1527 routine, up to the frame immediately following the frame of this
1528 function. This frame corresponds to a dummy prologue which is
1529 never actually executed but instead appears before the real entry
1530 point of an interrupt routine and exists only to provide a place
1531 to simulate the push of a machine frame. */
1533 PRUNTIME_FUNCTION mf_func
= NULL
;
1534 ULONG64 mf_imagebase
;
1537 /* Get the current context. */
1538 RtlCaptureContext (&context
);
1542 PRUNTIME_FUNCTION RuntimeFunction
;
1545 ULONG64 EstablisherFrame
;
1547 /* Get function metadata. */
1549 = RtlLookupFunctionEntry (context
.Rip
, &ImageBase
,
1550 ms_disp
->HistoryTable
);
1552 /* Stop once we reached the frame of this function. */
1553 if (RuntimeFunction
== ms_disp
->FunctionEntry
)
1556 mf_func
= RuntimeFunction
;
1557 mf_imagebase
= ImageBase
;
1558 mf_rsp
= context
.Rsp
;
1560 if (RuntimeFunction
)
1563 RtlVirtualUnwind (0, ImageBase
, context
.Rip
, RuntimeFunction
,
1564 &context
, &HandlerData
, &EstablisherFrame
,
1569 /* In case of failure, assume this is a leaf function. */
1570 context
.Rip
= *(ULONG64
*) context
.Rsp
;
1574 /* 0 means bottom of the stack. */
1575 if (context
.Rip
== 0)
1582 /* If we have found the machine frame, adjust the return address. */
1583 if (mf_func
!= NULL
)
1584 __gnat_adjust_context
1585 ((unsigned char *)(mf_imagebase
+ mf_func
->UnwindData
), mf_rsp
);
1588 exception
= __gnat_map_SEH (ms_exc
, &msg
);
1589 if (exception
!= NULL
)
1591 /* Directly convert the system exception into a GCC one.
1593 This is really breaking the API, but is necessary for stack size
1594 reasons: the normal way is to call Raise_From_Signal_Handler,
1595 which builds the exception and calls _Unwind_RaiseException,
1596 which unwinds the stack and will call this personality routine.
1597 But the Windows unwinder needs about 2KB of stack. */
1598 struct _Unwind_Exception
*exc
1599 = __gnat_create_machine_occurrence_from_signal_handler (exception
,
1601 memset (exc
->private_
, 0, sizeof (exc
->private_
));
1602 ms_exc
->ExceptionCode
= STATUS_GCC_THROW
;
1603 ms_exc
->NumberParameters
= 1;
1604 ms_exc
->ExceptionInformation
[0] = (ULONG_PTR
)exc
;
1610 _GCC_specific_handler (ms_exc
, this_frame
, ms_orig_context
, ms_disp
,
1611 PERSONALITY_FUNCTION
);
1614 /* Define __gnat_personality_v0 for convenience */
1616 PERSONALITY_STORAGE ATTRIBUTE_UNUSED _Unwind_Reason_Code
1617 __gnat_personality_v0 (version_arg_t version_arg
,
1618 phases_arg_t phases_arg
,
1619 _Unwind_Exception_Class uw_exception_class
,
1620 _Unwind_Exception
*uw_exception
,
1621 _Unwind_Context
*uw_context
)
1623 return PERSONALITY_FUNCTION
1624 (version_arg
, phases_arg
, uw_exception_class
, uw_exception
, uw_context
);
1629 #if !defined (__USING_SJLJ_EXCEPTIONS__)
1630 /* Size of the _Unwind_Exception structure. This is used by g-cppexc to get
1631 the offset to the C++ object. */
1633 const int __gnat_unwind_exception_size
= sizeof (_Unwind_Exception
);