1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * R A I S E - G C C *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2018, Free Software Foundation, Inc. *
10 * *
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. *
17 * *
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. *
21 * *
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/>. *
26 * *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
29 * *
30 ****************************************************************************/
31
32 /* Code related to the integration of the GCC mechanism for exception
33 handling. */
34
35 #ifndef IN_RTS
36 /* For gnat1/gnatbind compilation: use host headers. */
37 # include "config.h"
38 # include "system.h"
39 /* Don't use fancy_abort. */
40 # undef abort
41 #else
42 # ifndef CERT
43 # include "tconfig.h"
44 # include "tsystem.h"
45 # else
46 # define ATTRIBUTE_UNUSED __attribute__((unused))
47 # define HAVE_GETIPINFO 1
48 # endif
49 #endif
50
51 #include <stdarg.h>
52
53 #ifdef __cplusplus
54 # include <cstdlib>
55 #else
56 typedef char bool;
57 # define true 1
58 # define false 0
59 #endif
60
61 #include "raise.h"
62
63 #ifdef __APPLE__
64 /* On MacOS X, versions older than 10.5 don't export _Unwind_GetIPInfo. */
65 #undef HAVE_GETIPINFO
66 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1050
67 #define HAVE_GETIPINFO 1
68 #endif
69 #endif
70
71 #if defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
72 /* HP-UX B.11.31 ia64 libunwind doesn't have _Unwind_GetIPInfo. */
73 #undef HAVE_GETIPINFO
74 #define _UA_END_OF_STACK 0
75 #endif
76
77 /* The names of a couple of "standard" routines for unwinding/propagation
78 actually vary depending on the underlying GCC scheme for exception handling
79 (SJLJ or DWARF). We need a consistently named interface to import from
80 a-except, so wrappers are defined here. */
81
82 #ifndef IN_RTS
83 /* For gnat1/gnatbind compilation: cannot use unwind.h, as it is for the
84 target. So mimic configure...
85 This is a hack ???, the real fix is to link gnat1/gnatbind with the
86 runtime of the build compiler. */
87 # ifdef EH_MECHANISM_arm
88 # include "config/arm/unwind-arm.h"
89 # else
90 # include "unwind-generic.h"
91 # endif
92 #else
93 # include "unwind.h"
94 #endif
95
96 #ifdef __cplusplus
97 extern "C" {
98 #endif
99
100 typedef struct _Unwind_Context _Unwind_Context;
101 typedef struct _Unwind_Exception _Unwind_Exception;
102
103 _Unwind_Reason_Code
104 __gnat_Unwind_RaiseException (_Unwind_Exception *);
105
106 _Unwind_Reason_Code
107 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, _Unwind_Stop_Fn, void *);
108
109 extern struct Exception_Occurrence *__gnat_setup_current_excep
110 (_Unwind_Exception *);
111 extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
112
113 #ifdef CERT
114 /* Called in case of error during propagation. */
115 extern void __gnat_raise_abort (void) __attribute__ ((noreturn));
116 #define abort() __gnat_raise_abort()
117 #endif
118
119 #include "unwind-pe.h"
120
121 #ifdef __ARM_EABI_UNWINDER__
122 /* for memcmp */
123 #include <string.h>
124 #endif
125
126 /* The known and handled exception classes. */
127
128 #ifdef __ARM_EABI_UNWINDER__
129 #define CXX_EXCEPTION_CLASS "GNUCC++"
130 #define GNAT_EXCEPTION_CLASS "GNU-Ada"
131 #else
132 #define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
133 #define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
134 #endif
135
136 /* Structure of a C++ exception, represented as a C structure... See
137 unwind-cxx.h for the full definition. */
138
139 struct __cxa_exception
140 {
141 void *exceptionType;
142 void (*exceptionDestructor)(void *);
143
144 void (*unexpectedHandler)();
145 void (*terminateHandler)();
146
147 struct __cxa_exception *nextException;
148
149 int handlerCount;
150
151 #ifdef __ARM_EABI_UNWINDER__
152 struct __cxa_exception* nextPropagatingException;
153
154 int propagationCount;
155 #else
156 int handlerSwitchValue;
157 const unsigned char *actionRecord;
158 const unsigned char *languageSpecificData;
159 _Unwind_Ptr catchTemp;
160 void *adjustedPtr;
161 #endif
162
163 _Unwind_Exception unwindHeader;
164 };
165
166 /* --------------------------------------------------------------
167 -- The DB stuff below is there for debugging purposes only. --
168 -------------------------------------------------------------- */
169
170 #ifndef inhibit_libc
171
172 #define DB_PHASES 0x1
173 #define DB_CSITE 0x2
174 #define DB_ACTIONS 0x4
175 #define DB_REGIONS 0x8
176
177 #define DB_ERR 0x1000
178
179 /* The "action" stuff below is also there for debugging purposes only. */
180
181 typedef struct
182 {
183 _Unwind_Action phase;
184 const char * description;
185 } phase_descriptor;
186
187 static const phase_descriptor phase_descriptors[]
188 = {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
189 { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
190 { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
191 { _UA_FORCE_UNWIND, "FORCE_UNWIND" },
192 { -1, 0}};
193
194 static int
db_accepted_codes(void)195 db_accepted_codes (void)
196 {
197 static int accepted_codes = -1;
198
199 if (accepted_codes == -1)
200 {
201 char * db_env = (char *) getenv ("EH_DEBUG");
202
203 accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
204 /* Arranged for ERR stuff to always be visible when the variable
205 is defined. One may just set the variable to 0 to see the ERR
206 stuff only. */
207 }
208
209 return accepted_codes;
210 }
211
212 #define DB_INDENT_INCREASE 0x01
213 #define DB_INDENT_DECREASE 0x02
214 #define DB_INDENT_OUTPUT 0x04
215 #define DB_INDENT_NEWLINE 0x08
216 #define DB_INDENT_RESET 0x10
217
218 #define DB_INDENT_UNIT 8
219
220 static void
db_indent(int requests)221 db_indent (int requests)
222 {
223 static int current_indentation_level = 0;
224
225 if (requests & DB_INDENT_RESET)
226 current_indentation_level = 0;
227
228 if (requests & DB_INDENT_INCREASE)
229 current_indentation_level ++;
230
231 if (requests & DB_INDENT_DECREASE)
232 current_indentation_level --;
233
234 if (requests & DB_INDENT_NEWLINE)
235 fprintf (stderr, "\n");
236
237 if (requests & DB_INDENT_OUTPUT)
238 fprintf (stderr, "%*s", current_indentation_level * DB_INDENT_UNIT, " ");
239 }
240
241 static void ATTRIBUTE_PRINTF_2
db(int db_code,const char * msg_format,...)242 db (int db_code, const char * msg_format, ...)
243 {
244 if (db_accepted_codes () & db_code)
245 {
246 va_list msg_args;
247
248 db_indent (DB_INDENT_OUTPUT);
249
250 va_start (msg_args, msg_format);
251 vfprintf (stderr, msg_format, msg_args);
252 va_end (msg_args);
253 }
254 }
255
256 static void
db_phases(int phases)257 db_phases (int phases)
258 {
259 const phase_descriptor *a = phase_descriptors;
260
261 if (! (db_accepted_codes () & DB_PHASES))
262 return;
263
264 db (DB_PHASES, "\n");
265
266 for (; a->description != 0; a++)
267 if (phases & a->phase)
268 db (DB_PHASES, "%s ", a->description);
269
270 db (DB_PHASES, " :\n");
271 }
272 #else /* !inhibit_libc */
273 #define db_phases(X)
274 #define db_indent(X)
275 #define db(X, ...)
276 #endif /* !inhibit_libc */
277
278 /* ---------------------------------------------------------------
279 -- Now come a set of useful structures and helper routines. --
280 --------------------------------------------------------------- */
281
282 /* There are three major runtime tables involved, generated by the
283 GCC back-end. Contents slightly vary depending on the underlying
284 implementation scheme (dwarf zero cost / sjlj).
285
286 =======================================
287 * Tables for the dwarf zero cost case *
288 =======================================
289
290 They are fully documented in:
291 http://sourcery.mentor.com/public/cxx-abi/exceptions.pdf
292 Here is a shorter presentation, with some specific comments for Ada.
293
294 call_site []
295 -------------------------------------------------------------------
296 * region-start | region-length | landing-pad | first-action-index *
297 -------------------------------------------------------------------
298
299 Identify possible actions to be taken and where to resume control
300 for that when an exception propagates through a pc inside the region
301 delimited by start and length.
302
303 A null landing-pad indicates that nothing is to be done.
304
305 Otherwise, first-action-index provides an entry into the action[]
306 table which heads a list of possible actions to be taken (see below).
307
308 If it is determined that indeed an action should be taken, that
309 is, if one action filter matches the exception being propagated,
310 then control should be transferred to landing-pad.
311
312 A null first-action-index indicates that there are only cleanups
313 to run there.
314
315 action []
316 -------------------------------
317 * action-filter | next-action *
318 -------------------------------
319
320 This table contains lists (called action chains) of possible actions
321 associated with call-site entries described in the call-site [] table.
322 There is at most one action list per call-site entry. It is SLEB128
323 encoded.
324
325 A null action-filter indicates a cleanup.
326
327 Non null action-filters provide an index into the ttypes [] table
328 (see below), from which information may be retrieved to check if it
329 matches the exception being propagated.
330
331 * action-filter > 0:
332 means there is a regular handler to be run The value is also passed
333 to the landing pad to dispatch the exception.
334
335 * action-filter < 0:
336 means there is a some "exception_specification" data to retrieve,
337 which is only relevant for C++ and should never show up for Ada.
338 (Exception specification specifies which exceptions can be thrown
339 by a function. Such filter is emitted around the body of C++
340 functions defined like:
341 void foo ([...]) throw (A, B) { [...] }
342 These can be viewed as negativ filter: the landing pad is branched
343 to for exceptions that doesn't match the filter and usually aborts
344 the program).
345
346 * next-action
347 points to the next entry in the list using a relative byte offset. 0
348 indicates there is no other entry.
349
350 ttypes []
351 ---------------
352 * ttype-value *
353 ---------------
354
355 This table is an array of addresses.
356
357 A null value indicates a catch-all handler. (Not used by Ada)
358
359 Non null values are used to match the exception being propagated:
360 In C++ this is a pointer to some rtti data, while in Ada this is an
361 exception id (with a fake id for others).
362
363 For C++, this table is actually also used to store "exception
364 specification" data. The differentiation between the two kinds
365 of entries is made by the sign of the associated action filter,
366 which translates into positive or negative offsets from the
367 so called base of the table:
368
369 Exception Specification data is stored at positive offsets from
370 the ttypes table base, which Exception Type data is stored at
371 negative offsets:
372
373 ---------------------------------------------------------------------------
374
375 Here is a quick summary of the tables organization:
376
377 +-- Unwind_Context (pc, ...)
378 |
379 |(pc)
380 |
381 | CALL-SITE[]
382 |
383 | +=============================================================+
384 | | region-start + length | landing-pad | first-action-index |
385 | +=============================================================+
386 +-> | pc range 0 => no-action 0 => cleanups only |
387 | !0 => jump @ N --+ |
388 +====================================================== | ====+
389 |
390 |
391 ACTION [] |
392 |
393 +==========================================================+ |
394 | action-filter | next-action | |
395 +==========================================================+ |
396 | 0 => cleanup | |
397 | >0 => ttype index for handler ------+ 0 => end of chain | <-+
398 | <0 => ttype index for spec data | |
399 +==================================== | ===================+
400 |
401 |
402 TTYPES [] |
403 | Offset negated from
404 +=====================+ | the actual base.
405 | ttype-value | |
406 +============+=====================+ |
407 | | ... | |
408 | ... | exception id | <---+
409 | | ... |
410 | handlers +---------------------+
411 | | ... |
412 | ... | ... |
413 | | ... |
414 +============+=====================+ <<------ Table base
415 | ... | ... |
416 | specs | ... | (should not see negative filter
417 | ... | ... | values for Ada).
418 +============+=====================+
419
420
421 ============================
422 * Tables for the sjlj case *
423 ============================
424
425 So called "function contexts" are pushed on a context stack by calls to
426 _Unwind_SjLj_Register on function entry, and popped off at exit points by
427 calls to _Unwind_SjLj_Unregister. The current call_site for a function is
428 updated in the function context as the function's code runs along.
429
430 The generic unwinding engine in _Unwind_RaiseException walks the function
431 context stack and not the actual call chain.
432
433 The ACTION and TTYPES tables remain unchanged, which allows to search them
434 during the propagation phase to determine whether or not the propagated
435 exception is handled somewhere. When it is, we only "jump" up once directly
436 to the context where the handler will be found. Besides, this allows "break
437 exception unhandled" to work also
438
439 The CALL-SITE table is setup differently, though: the pc attached to the
440 unwind context is a direct index into the table, so the entries in this
441 table do not hold region bounds any more.
442
443 A special index (-1) is used to indicate that no action is possibly
444 connected with the context at hand, so null landing pads cannot appear
445 in the table.
446
447 Additionally, landing pad values in the table do not represent code address
448 to jump at, but so called "dispatch" indices used by a common landing pad
449 for the function to switch to the appropriate post-landing-pad.
450
451 +-- Unwind_Context (pc, ...)
452 |
453 | pc = call-site index
454 | 0 => terminate (should not see this for Ada)
455 | -1 => no-action
456 |
457 | CALL-SITE[]
458 |
459 | +=====================================+
460 | | landing-pad | first-action-index |
461 | +=====================================+
462 +-> | 0 => cleanups only |
463 | dispatch index N |
464 +=====================================+
465
466
467 ===================================
468 * Basic organization of this unit *
469 ===================================
470
471 The major point of this unit is to provide an exception propagation
472 personality routine for Ada. This is __gnat_personality_v0.
473
474 It is provided with a pointer to the propagated exception, an unwind
475 context describing a location the propagation is going through, and a
476 couple of other arguments including a description of the current
477 propagation phase.
478
479 It shall return to the generic propagation engine what is to be performed
480 next, after possible context adjustments, depending on what it finds in the
481 traversed context (a handler for the exception, a cleanup, nothing, ...),
482 and on the propagation phase.
483
484 A number of structures and subroutines are used for this purpose, as
485 sketched below:
486
487 o region_descriptor: General data associated with the context (base pc,
488 call-site table, action table, ttypes table, ...)
489
490 o action_descriptor: Data describing the action to be taken for the
491 propagated exception in the provided context (kind of action: nothing,
492 handler, cleanup; pointer to the action table entry, ...).
493
494 raise
495 |
496 ... (a-except.adb)
497 |
498 Propagate_Exception (a-exexpr.adb)
499 |
500 |
501 _Unwind_RaiseException (libgcc)
502 |
503 | (Ada frame)
504 |
505 +--> __gnat_personality_v0 (context, exception)
506 |
507 +--> get_region_description_for (context)
508 |
509 +--> get_action_description_for (ip, exception, region)
510 | |
511 | +--> get_call_site_action_for (context, region)
512 | (one version for each underlying scheme)
513 |
514 +--> setup_to_install (context)
515
516 This unit is inspired from the C++ version found in eh_personality.cc,
517 part of libstdc++-v3.
518
519 */
520
521
522 /* This is an incomplete "proxy" of the structure of exception objects as
523 built by the GNAT runtime library. Accesses to other fields than the common
524 header are performed through subprogram calls to alleviate the need of an
525 exact counterpart here and potential alignment/size issues for the common
526 header. See a-exexpr.adb. */
527
528 typedef struct
529 {
530 _Unwind_Exception common;
531 /* ABI header, maximally aligned. */
532 } _GNAT_Exception;
533
534 /* The two constants below are specific ttype identifiers for special
535 exception ids. Their type should match what a-exexpr exports. */
536
537 extern const int __gnat_others_value;
538 #define GNAT_OTHERS ((_Unwind_Ptr) &__gnat_others_value)
539
540 extern const int __gnat_all_others_value;
541 #define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
542
543 extern const int __gnat_unhandled_others_value;
544 #define GNAT_UNHANDLED_OTHERS ((_Unwind_Ptr) &__gnat_unhandled_others_value)
545
546 /* Describe the useful region data associated with an unwind context. */
547
548 typedef struct
549 {
550 /* The base pc of the region. */
551 _Unwind_Ptr base;
552
553 /* Pointer to the Language Specific Data for the region. */
554 _Unwind_Ptr lsda;
555
556 /* Call-Site data associated with this region. */
557 unsigned char call_site_encoding;
558 const unsigned char *call_site_table;
559
560 /* The base to which are relative landing pad offsets inside the call-site
561 entries . */
562 _Unwind_Ptr lp_base;
563
564 /* Action-Table associated with this region. */
565 const unsigned char *action_table;
566
567 /* Ttype data associated with this region. */
568 unsigned char ttype_encoding;
569 const unsigned char *ttype_table;
570 _Unwind_Ptr ttype_base;
571
572 } region_descriptor;
573
574 /* Extract and adjust the IP (instruction pointer) from an exception
575 context. */
576
577 static _Unwind_Ptr
get_ip_from_context(_Unwind_Context * uw_context)578 get_ip_from_context (_Unwind_Context *uw_context)
579 {
580 int ip_before_insn = 0;
581 #ifdef HAVE_GETIPINFO
582 _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
583 #else
584 _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
585 #endif
586 /* Subtract 1 if necessary because GetIPInfo yields a call return address
587 in this case, while we are interested in information for the call point.
588 This does not always yield the exact call instruction address but always
589 brings the IP back within the corresponding region. */
590 if (!ip_before_insn)
591 ip--;
592
593 return ip;
594 }
595
596 static void
db_region_for(region_descriptor * region,_Unwind_Ptr ip)597 db_region_for (region_descriptor *region, _Unwind_Ptr ip)
598 {
599 #ifndef inhibit_libc
600 if (! (db_accepted_codes () & DB_REGIONS))
601 return;
602
603 db (DB_REGIONS, "For ip @ %p => ", (void *)ip);
604
605 if (region->lsda)
606 db (DB_REGIONS, "lsda @ %p", (void *)region->lsda);
607 else
608 db (DB_REGIONS, "no lsda");
609
610 db (DB_REGIONS, "\n");
611 #endif
612 }
613
614 /* Retrieve the ttype entry associated with FILTER in the REGION's
615 ttype table. */
616
617 static _Unwind_Ptr
get_ttype_entry_for(region_descriptor * region,long filter)618 get_ttype_entry_for (region_descriptor *region, long filter)
619 {
620 _Unwind_Ptr ttype_entry;
621
622 filter *= size_of_encoded_value (region->ttype_encoding);
623 read_encoded_value_with_base
624 (region->ttype_encoding, region->ttype_base,
625 region->ttype_table - filter, &ttype_entry);
626
627 return ttype_entry;
628 }
629
630 /* Fill out the REGION descriptor for the provided UW_CONTEXT. */
631
632 static void
get_region_description_for(_Unwind_Context * uw_context,region_descriptor * region)633 get_region_description_for (_Unwind_Context *uw_context,
634 region_descriptor *region)
635 {
636 const unsigned char * p;
637 _uleb128_t tmp;
638 unsigned char lpbase_encoding;
639
640 /* Get the base address of the lsda information. If the provided context
641 is null or if there is no associated language specific data, there's
642 nothing we can/should do. */
643 region->lsda
644 = (_Unwind_Ptr) (uw_context
645 ? _Unwind_GetLanguageSpecificData (uw_context) : 0);
646
647 if (! region->lsda)
648 return;
649
650 /* Parse the lsda and fill the region descriptor. */
651 p = (const unsigned char *)region->lsda;
652
653 region->base = _Unwind_GetRegionStart (uw_context);
654
655 /* Find @LPStart, the base to which landing pad offsets are relative. */
656 lpbase_encoding = *p++;
657 if (lpbase_encoding != DW_EH_PE_omit)
658 p = read_encoded_value
659 (uw_context, lpbase_encoding, p, ®ion->lp_base);
660 else
661 region->lp_base = region->base;
662
663 /* Find @TType, the base of the handler and exception spec type data. */
664 region->ttype_encoding = *p++;
665 if (region->ttype_encoding != DW_EH_PE_omit)
666 {
667 p = read_uleb128 (p, &tmp);
668 region->ttype_table = p + tmp;
669 }
670 else
671 region->ttype_table = 0;
672
673 region->ttype_base
674 = base_of_encoded_value (region->ttype_encoding, uw_context);
675
676 /* Get the encoding and length of the call-site table; the action table
677 immediately follows. */
678 region->call_site_encoding = *p++;
679 region->call_site_table = read_uleb128 (p, &tmp);
680
681 region->action_table = region->call_site_table + tmp;
682 }
683
684
685 /* Describe an action to be taken when propagating an exception up to
686 some context. */
687
688 enum action_kind
689 {
690 /* Found some call site base data, but need to analyze further
691 before being able to decide. */
692 unknown,
693
694 /* There is nothing relevant in the context at hand. */
695 nothing,
696
697 /* There are only cleanups to run in this context. */
698 cleanup,
699
700 /* There is a handler for the exception in this context. */
701 handler,
702
703 /* There is a handler for the exception, but it is only for catching
704 unhandled exceptions. */
705 unhandler
706 };
707
708 /* filter value for cleanup actions. */
709 static const int cleanup_filter = 0;
710
711 typedef struct
712 {
713 /* The kind of action to be taken. */
714 enum action_kind kind;
715
716 /* A pointer to the action record entry. */
717 const unsigned char *table_entry;
718
719 /* Where we should jump to actually take an action (trigger a cleanup or an
720 exception handler). */
721 _Unwind_Ptr landing_pad;
722
723 /* If we have a handler matching our exception, these are the filter to
724 trigger it and the corresponding id. */
725 _Unwind_Sword ttype_filter;
726
727 } action_descriptor;
728
729 static void
db_action_for(action_descriptor * action,_Unwind_Ptr ip)730 db_action_for (action_descriptor *action, _Unwind_Ptr ip)
731 {
732 #ifndef inhibit_libc
733 db (DB_ACTIONS, "For ip @ %p => ", (void *)ip);
734
735 switch (action->kind)
736 {
737 case unknown:
738 db (DB_ACTIONS, "lpad @ %p, record @ %p\n",
739 (void *) action->landing_pad, action->table_entry);
740 break;
741
742 case nothing:
743 db (DB_ACTIONS, "Nothing\n");
744 break;
745
746 case cleanup:
747 db (DB_ACTIONS, "Cleanup\n");
748 break;
749
750 case handler:
751 db (DB_ACTIONS, "Handler, filter = %d\n", (int) action->ttype_filter);
752 break;
753
754 default:
755 db (DB_ACTIONS, "Err? Unexpected action kind !\n");
756 break;
757 }
758 #endif
759 }
760
761 /* Search the call_site_table of REGION for an entry appropriate for the
762 UW_CONTEXT's IP. If one is found, store the associated landing_pad
763 and action_table entry, and set the ACTION kind to unknown for further
764 analysis. Otherwise, set the ACTION kind to nothing.
765
766 There are two variants of this routine, depending on the underlying
767 mechanism (DWARF/SJLJ), which account for differences in the tables. */
768
769 #ifdef __USING_SJLJ_EXCEPTIONS__
770
771 #define __builtin_eh_return_data_regno(x) x
772
773 static void
get_call_site_action_for(_Unwind_Ptr call_site,region_descriptor * region,action_descriptor * action)774 get_call_site_action_for (_Unwind_Ptr call_site,
775 region_descriptor *region,
776 action_descriptor *action)
777 {
778 /* call_site is a direct index into the call-site table, with two special
779 values : -1 for no-action and 0 for "terminate". The latter should never
780 show up for Ada. To test for the former, beware that _Unwind_Ptr might
781 be unsigned. */
782
783 if ((int)call_site < 0)
784 {
785 action->kind = nothing;
786 }
787 else if (call_site == 0)
788 {
789 db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
790 action->kind = nothing;
791 }
792 else
793 {
794 _uleb128_t cs_lp, cs_action;
795 const unsigned char *p;
796
797 /* Let the caller know there may be an action to take, but let it
798 determine the kind. */
799 action->kind = unknown;
800
801 /* We have a direct index into the call-site table, but this table is
802 made of leb128 values, the encoding length of which is variable. We
803 can't merely compute an offset from the index, then, but have to read
804 all the entries before the one of interest. */
805 p = region->call_site_table;
806 do
807 {
808 p = read_uleb128 (p, &cs_lp);
809 p = read_uleb128 (p, &cs_action);
810 }
811 while (--call_site);
812
813 action->landing_pad = cs_lp + 1;
814
815 if (cs_action)
816 action->table_entry = region->action_table + cs_action - 1;
817 else
818 action->table_entry = 0;
819 }
820 }
821
822 #else /* !__USING_SJLJ_EXCEPTIONS__ */
823
824 static void
get_call_site_action_for(_Unwind_Ptr ip,region_descriptor * region,action_descriptor * action)825 get_call_site_action_for (_Unwind_Ptr ip,
826 region_descriptor *region,
827 action_descriptor *action)
828 {
829 const unsigned char *p = region->call_site_table;
830
831 /* Unless we are able to determine otherwise... */
832 action->kind = nothing;
833
834 db (DB_CSITE, "\n");
835
836 while (p < region->action_table)
837 {
838 _Unwind_Ptr cs_start, cs_len, cs_lp;
839 _uleb128_t cs_action;
840
841 /* Note that all call-site encodings are "absolute" displacements. */
842 p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
843 p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
844 p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
845 p = read_uleb128 (p, &cs_action);
846
847 db (DB_CSITE,
848 "c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
849 (char *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
850 (char *)region->lp_base + cs_lp, (void *)cs_lp);
851
852 /* The table is sorted, so if we've passed the IP, stop. */
853 if (ip < region->base + cs_start)
854 break;
855
856 /* If we have a match, fill the ACTION fields accordingly. */
857 else if (ip < region->base + cs_start + cs_len)
858 {
859 /* Let the caller know there may be an action to take, but let it
860 determine the kind. */
861 action->kind = unknown;
862
863 if (cs_lp)
864 action->landing_pad = region->lp_base + cs_lp;
865 else
866 action->landing_pad = 0;
867
868 if (cs_action)
869 action->table_entry = region->action_table + cs_action - 1;
870 else
871 action->table_entry = 0;
872
873 db (DB_CSITE, "+++\n");
874 return;
875 }
876 }
877
878 db (DB_CSITE, "---\n");
879 }
880
881 #endif /* __USING_SJLJ_EXCEPTIONS__ */
882
883 /* With CHOICE an exception choice representing an "exception - when"
884 argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
885 occurrence, return true if the latter matches the former, that is, if
886 PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
887 This takes care of the special Non_Ada_Error case on VMS. */
888
889 #define Is_Handled_By_Others __gnat_is_handled_by_others
890 #define Language_For __gnat_language_for
891 #define Foreign_Data_For __gnat_foreign_data_for
892 #define EID_For __gnat_eid_for
893
894 extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
895 extern char Language_For (_Unwind_Ptr eid);
896
897 extern void *Foreign_Data_For (_Unwind_Ptr eid);
898
899 extern Exception_Id EID_For (_GNAT_Exception * e);
900
901 #define Foreign_Exception system__exceptions__foreign_exception
902 extern struct Exception_Data Foreign_Exception;
903
904 #ifdef VMS
905 #define Non_Ada_Error system__aux_dec__non_ada_error
906 extern struct Exception_Data Non_Ada_Error;
907 #endif
908
909 /* Return true iff the exception class of EXCEPT is EC. */
910
911 static int
exception_class_eq(const _GNAT_Exception * except,const _Unwind_Exception_Class ec)912 exception_class_eq (const _GNAT_Exception *except,
913 const _Unwind_Exception_Class ec)
914 {
915 #ifdef __ARM_EABI_UNWINDER__
916 return memcmp (except->common.exception_class, ec, 8) == 0;
917 #else
918 return except->common.exception_class == ec;
919 #endif
920 }
921
922 /* Return how CHOICE matches PROPAGATED_EXCEPTION. */
923
924 static enum action_kind
is_handled_by(_Unwind_Ptr choice,_GNAT_Exception * propagated_exception)925 is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception)
926 {
927 /* All others choice match everything. */
928 if (choice == GNAT_ALL_OTHERS)
929 return handler;
930
931 /* GNAT exception occurrence. */
932 if (exception_class_eq (propagated_exception, GNAT_EXCEPTION_CLASS))
933 {
934 /* Pointer to the GNAT exception data corresponding to the propagated
935 occurrence. */
936 _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
937
938 if (choice == GNAT_UNHANDLED_OTHERS)
939 return unhandler;
940
941 E = (_Unwind_Ptr) EID_For (propagated_exception);
942
943 /* Base matching rules: An exception data (id) matches itself, "when
944 all_others" matches anything and "when others" matches anything
945 unless explicitly stated otherwise in the propagated occurrence. */
946 if (choice == E || (choice == GNAT_OTHERS && Is_Handled_By_Others (E)))
947 return handler;
948
949 #ifdef VMS
950 /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
951 may have different exception data pointers that should match for the
952 same condition code, if both an export and an import have been
953 registered. The import code for both the choice and the propagated
954 occurrence are expected to have been masked off regarding severity
955 bits already (at registration time for the former and from within the
956 low level exception vector for the latter). */
957 if ((Language_For (E) == 'V'
958 && choice != GNAT_OTHERS
959 && ((Language_For (choice) == 'V'
960 && Foreign_Data_For (choice) != 0
961 && Foreign_Data_For (choice) == Foreign_Data_For (E))
962 || choice == (_Unwind_Ptr)&Non_Ada_Error)))
963 return handler;
964 #endif
965
966 /* Otherwise, it doesn't match an Ada choice. */
967 return nothing;
968 }
969
970 /* All others and others choice match any foreign exception. */
971 if (choice == GNAT_ALL_OTHERS
972 || choice == GNAT_OTHERS
973 #ifndef CERT
974 || choice == (_Unwind_Ptr) &Foreign_Exception
975 #endif
976 )
977 return handler;
978
979 #ifndef CERT
980 /* C++ exception occurrences. */
981 if (exception_class_eq (propagated_exception, CXX_EXCEPTION_CLASS)
982 && Language_For (choice) == 'C')
983 {
984 void *choice_typeinfo = Foreign_Data_For (choice);
985 void *except_typeinfo =
986 (((struct __cxa_exception *)
987 ((_Unwind_Exception *)propagated_exception + 1)) - 1)
988 ->exceptionType;
989
990 /* Typeinfo are directly compared, which might not be correct if they
991 aren't merged. ??? We should call the == operator if this module is
992 compiled in C++. */
993 if (choice_typeinfo == except_typeinfo)
994 return handler;
995 }
996 #endif
997
998 return nothing;
999 }
1000
1001 /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
1002 UW_CONTEXT in REGION. */
1003
1004 static void
get_action_description_for(_Unwind_Ptr ip,_Unwind_Exception * uw_exception,_Unwind_Action uw_phase,region_descriptor * region,action_descriptor * action)1005 get_action_description_for (_Unwind_Ptr ip,
1006 _Unwind_Exception *uw_exception,
1007 _Unwind_Action uw_phase,
1008 region_descriptor *region,
1009 action_descriptor *action)
1010 {
1011 _GNAT_Exception *gnat_exception = (_GNAT_Exception *) uw_exception;
1012
1013 /* Search the call site table first, which may get us a landing pad as well
1014 as the head of an action record list. */
1015 get_call_site_action_for (ip, region, action);
1016 db_action_for (action, ip);
1017
1018 /* If there is not even a call_site entry, we are done. */
1019 if (action->kind == nothing)
1020 return;
1021
1022 /* Otherwise, check what we have at the place of the call site. */
1023
1024 /* No landing pad => no cleanups or handlers. */
1025 if (action->landing_pad == 0)
1026 {
1027 action->kind = nothing;
1028 return;
1029 }
1030
1031 /* Landing pad + null table entry => only cleanups. */
1032 else if (action->table_entry == 0)
1033 {
1034 action->kind = cleanup;
1035 action->ttype_filter = cleanup_filter;
1036 /* The filter initialization is not strictly necessary, as cleanup-only
1037 landing pads don't look at the filter value. It is there to ensure
1038 we don't pass random values and so trigger potential confusion when
1039 installing the context later on. */
1040 return;
1041 }
1042
1043 /* Landing pad + Table entry => handlers + possible cleanups. */
1044 else
1045 {
1046 const unsigned char * p = action->table_entry;
1047 _sleb128_t ar_filter, ar_disp;
1048
1049 action->kind = nothing;
1050
1051 while (1)
1052 {
1053 p = read_sleb128 (p, &ar_filter);
1054 read_sleb128 (p, &ar_disp);
1055 /* Don't assign p here, as it will be incremented by ar_disp
1056 below. */
1057
1058 /* Null filters are for cleanups. */
1059 if (ar_filter == cleanup_filter)
1060 {
1061 action->kind = cleanup;
1062 action->ttype_filter = cleanup_filter;
1063 /* The filter initialization is required here, to ensure
1064 the target landing pad branches to the cleanup code if
1065 we happen not to find a matching handler. */
1066 }
1067
1068 /* Positive filters are for regular handlers. */
1069 else if (ar_filter > 0)
1070 {
1071 /* Do not catch an exception if the _UA_FORCE_UNWIND flag is
1072 passed (to follow the ABI). */
1073 if (!(uw_phase & _UA_FORCE_UNWIND))
1074 {
1075 enum action_kind act;
1076
1077 /* See if the filter we have is for an exception which
1078 matches the one we are propagating. */
1079 _Unwind_Ptr choice =
1080 get_ttype_entry_for (region, ar_filter);
1081
1082 act = is_handled_by (choice, gnat_exception);
1083 if (act != nothing)
1084 {
1085 action->kind = act;
1086 action->ttype_filter = ar_filter;
1087 return;
1088 }
1089 }
1090 }
1091
1092 /* Negative filter values are for C++ exception specifications.
1093 Should not be there for Ada :/ */
1094 else
1095 db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
1096
1097 if (ar_disp == 0)
1098 return;
1099
1100 p += ar_disp;
1101 }
1102 }
1103 }
1104
1105 /* Setup in UW_CONTEXT the eh return target IP and data registers, which will
1106 be restored with the others and retrieved by the landing pad once the jump
1107 occurred. */
1108
1109 static void
setup_to_install(_Unwind_Context * uw_context,_Unwind_Exception * uw_exception,_Unwind_Ptr uw_landing_pad,int uw_filter)1110 setup_to_install (_Unwind_Context *uw_context,
1111 _Unwind_Exception *uw_exception,
1112 _Unwind_Ptr uw_landing_pad,
1113 int uw_filter)
1114 {
1115 /* 1/ exception object pointer, which might be provided back to
1116 _Unwind_Resume (and thus to this personality routine) if we are jumping
1117 to a cleanup. */
1118 _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
1119 (_Unwind_Word)uw_exception);
1120
1121 /* 2/ handler switch value register, which will also be used by the target
1122 landing pad to decide what action it shall take. */
1123 _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
1124 (_Unwind_Word)uw_filter);
1125
1126 /* Setup the address we should jump at to reach the code where there is the
1127 "something" we found. */
1128 _Unwind_SetIP (uw_context, uw_landing_pad);
1129 }
1130
1131 /* The following is defined from a-except.adb. Its purpose is to enable
1132 automatic backtraces upon exception raise, as provided through the
1133 GNAT.Traceback facilities. */
1134 extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
1135 extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
1136
1137 /* Below is the eh personality routine per se. We currently assume that only
1138 GNU-Ada exceptions are met. */
1139
1140 /* By default, the personality routine is public. */
1141 #define PERSONALITY_STORAGE
1142
1143 #ifdef __USING_SJLJ_EXCEPTIONS__
1144 #define PERSONALITY_FUNCTION __gnat_personality_sj0
1145 #elif defined (__SEH__)
1146 #define PERSONALITY_FUNCTION __gnat_personality_imp
1147 /* The public personality routine for seh is __gnat_personality_seh0, defined
1148 below using the SEH convention. This is a wrapper around the GNU routine,
1149 which is static. */
1150 #undef PERSONALITY_STORAGE
1151 #define PERSONALITY_STORAGE static
1152 #else
1153 #define PERSONALITY_FUNCTION __gnat_personality_v0
1154 #endif
1155
1156 /* Code executed to continue unwinding. With the ARM unwinder, the
1157 personality routine must unwind one frame (per EHABI 7.3 4.). */
1158
1159 static _Unwind_Reason_Code
continue_unwind(struct _Unwind_Exception * ue_header ATTRIBUTE_UNUSED,struct _Unwind_Context * uw_context ATTRIBUTE_UNUSED)1160 continue_unwind (struct _Unwind_Exception* ue_header ATTRIBUTE_UNUSED,
1161 struct _Unwind_Context* uw_context ATTRIBUTE_UNUSED)
1162 {
1163 #ifdef __ARM_EABI_UNWINDER__
1164 if (__gnu_unwind_frame (ue_header, uw_context) != _URC_OK)
1165 return _URC_FAILURE;
1166 #endif
1167 return _URC_CONTINUE_UNWIND;
1168 }
1169
1170 /* Common code for the body of GNAT personality routine. This code is shared
1171 between all unwinders. */
1172
1173 static _Unwind_Reason_Code
personality_body(_Unwind_Action uw_phases,_Unwind_Exception * uw_exception,_Unwind_Context * uw_context)1174 personality_body (_Unwind_Action uw_phases,
1175 _Unwind_Exception *uw_exception,
1176 _Unwind_Context *uw_context)
1177 {
1178 region_descriptor region;
1179 action_descriptor action;
1180 _Unwind_Ptr ip;
1181
1182 /* Debug traces. */
1183 db_indent (DB_INDENT_RESET);
1184 db_phases (uw_phases);
1185 db_indent (DB_INDENT_INCREASE);
1186
1187 /* Get the region description for the context we were provided with. This
1188 will tell us if there is some lsda, call_site, action and/or ttype data
1189 for the associated ip. */
1190 get_region_description_for (uw_context, ®ion);
1191
1192 /* No LSDA => no handlers or cleanups => we shall unwind further up. */
1193 if (! region.lsda)
1194 return continue_unwind (uw_exception, uw_context);
1195
1196 /* Get the instruction pointer. */
1197 ip = get_ip_from_context (uw_context);
1198 db_region_for (®ion, ip);
1199
1200 /* Search the call-site and action-record tables for the action associated
1201 with this IP. */
1202 get_action_description_for (ip, uw_exception, uw_phases, ®ion, &action);
1203 db_action_for (&action, ip);
1204
1205 /* Whatever the phase, if there is nothing relevant in this frame,
1206 unwinding should just go on. */
1207 if (action.kind == nothing)
1208 return continue_unwind (uw_exception, uw_context);
1209
1210 /* If we found something in search phase, we should return a code indicating
1211 what to do next depending on what we found. If we only have cleanups
1212 around, we shall try to unwind further up to find a handler, otherwise,
1213 tell we have a handler, which will trigger the second phase. */
1214 if (uw_phases & _UA_SEARCH_PHASE)
1215 {
1216 if (action.kind == cleanup)
1217 {
1218 return continue_unwind (uw_exception, uw_context);
1219 }
1220 else
1221 {
1222 #ifndef CERT
1223 struct Exception_Occurrence *excep;
1224
1225 /* Trigger the appropriate notification routines before the second
1226 phase starts, which ensures the stack is still intact.
1227 First, setup the Ada occurrence. */
1228 excep = __gnat_setup_current_excep (uw_exception);
1229 if (action.kind == unhandler)
1230 __gnat_notify_unhandled_exception (excep);
1231 else
1232 __gnat_notify_handled_exception (excep);
1233 #endif
1234
1235 return _URC_HANDLER_FOUND;
1236 }
1237 }
1238
1239 /* We found something in cleanup/handler phase, which might be the handler
1240 or a cleanup for a handled occurrence, or a cleanup for an unhandled
1241 occurrence (we are in a FORCED_UNWIND phase in this case). Install the
1242 context to get there. */
1243
1244 setup_to_install
1245 (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
1246
1247 #ifndef CERT
1248 /* Write current exception, so that it can be retrieved from Ada. It was
1249 already done during phase 1 (just above), but in between, one or several
1250 exceptions may have been raised (in cleanup handlers). */
1251 __gnat_setup_current_excep (uw_exception);
1252 #endif
1253
1254 return _URC_INSTALL_CONTEXT;
1255 }
1256
1257 #ifndef __ARM_EABI_UNWINDER__
1258 /* Major tweak for ia64-vms : the CHF propagation phase calls this personality
1259 routine with sigargs/mechargs arguments and has very specific expectations
1260 on possible return values.
1261
1262 We handle this with a number of specific tricks:
1263
1264 1. We tweak the personality routine prototype to have the "version" and
1265 "phases" two first arguments be void * instead of int and _Unwind_Action
1266 as nominally expected in the GCC context.
1267
1268 This allows us to access the full range of bits passed in every case and
1269 has no impact on the callers side since each argument remains assigned
1270 the same single 64bit slot.
1271
1272 2. We retrieve the corresponding int and _Unwind_Action values within the
1273 routine for regular use with truncating conversions. This is a noop when
1274 called from the libgcc unwinder.
1275
1276 3. We assume we're called by the VMS CHF when unexpected bits are set in
1277 both those values. The incoming arguments are then real sigargs and
1278 mechargs pointers, which we then redirect to __gnat_handle_vms_condition
1279 for proper processing.
1280 */
1281 #if defined (VMS) && defined (__IA64)
1282 typedef void * version_arg_t;
1283 typedef void * phases_arg_t;
1284 #else
1285 typedef int version_arg_t;
1286 typedef _Unwind_Action phases_arg_t;
1287 #endif
1288
1289 PERSONALITY_STORAGE _Unwind_Reason_Code
1290 PERSONALITY_FUNCTION (version_arg_t, phases_arg_t,
1291 _Unwind_Exception_Class, _Unwind_Exception *,
1292 _Unwind_Context *);
1293
1294 PERSONALITY_STORAGE _Unwind_Reason_Code
PERSONALITY_FUNCTION(version_arg_t version_arg,phases_arg_t phases_arg,_Unwind_Exception_Class uw_exception_class ATTRIBUTE_UNUSED,_Unwind_Exception * uw_exception,_Unwind_Context * uw_context)1295 PERSONALITY_FUNCTION (version_arg_t version_arg,
1296 phases_arg_t phases_arg,
1297 _Unwind_Exception_Class uw_exception_class
1298 ATTRIBUTE_UNUSED,
1299 _Unwind_Exception *uw_exception,
1300 _Unwind_Context *uw_context)
1301 {
1302 /* Fetch the version and phases args with their nominal ABI types for later
1303 use. This is a noop everywhere except on ia64-vms when called from the
1304 Condition Handling Facility. */
1305 int uw_version = (int) version_arg;
1306 _Unwind_Action uw_phases = (_Unwind_Action) phases_arg;
1307
1308 /* Check that we're called from the ABI context we expect, with a major
1309 possible variation on VMS for IA64. */
1310 if (uw_version != 1)
1311 {
1312 #if defined (VMS) && defined (__IA64)
1313
1314 /* Assume we're called with sigargs/mechargs arguments if really
1315 unexpected bits are set in our first two formals. Redirect to the
1316 GNAT condition handling code in this case. */
1317
1318 extern long __gnat_handle_vms_condition (void *, void *);
1319
1320 unsigned int version_unexpected_bits_mask = 0xffffff00U;
1321 unsigned int phases_unexpected_bits_mask = 0xffffff00U;
1322
1323 if ((unsigned int)uw_version & version_unexpected_bits_mask
1324 && (unsigned int)uw_phases & phases_unexpected_bits_mask)
1325 return __gnat_handle_vms_condition (version_arg, phases_arg);
1326 #endif
1327
1328 return _URC_FATAL_PHASE1_ERROR;
1329 }
1330
1331 return personality_body (uw_phases, uw_exception, uw_context);
1332 }
1333
1334 #else /* __ARM_EABI_UNWINDER__ */
1335
1336 PERSONALITY_STORAGE _Unwind_Reason_Code
1337 PERSONALITY_FUNCTION (_Unwind_State state,
1338 struct _Unwind_Exception* ue_header,
1339 struct _Unwind_Context* uw_context);
1340
1341 PERSONALITY_STORAGE _Unwind_Reason_Code
PERSONALITY_FUNCTION(_Unwind_State state,struct _Unwind_Exception * uw_exception,struct _Unwind_Context * uw_context)1342 PERSONALITY_FUNCTION (_Unwind_State state,
1343 struct _Unwind_Exception* uw_exception,
1344 struct _Unwind_Context* uw_context)
1345 {
1346 _Unwind_Action uw_phases;
1347
1348 switch (state & _US_ACTION_MASK)
1349 {
1350 case _US_VIRTUAL_UNWIND_FRAME:
1351 /* Phase 1. */
1352 uw_phases = _UA_SEARCH_PHASE;
1353 break;
1354
1355 case _US_UNWIND_FRAME_STARTING:
1356 /* Phase 2, to call a cleanup. */
1357 uw_phases = _UA_CLEANUP_PHASE;
1358 #if 0
1359 /* ??? We don't use UA_HANDLER_FRAME (except to debug). Futhermore,
1360 barrier_cache.sp isn't yet set. */
1361 if (!(state & _US_FORCE_UNWIND)
1362 && (uw_exception->barrier_cache.sp
1363 == _Unwind_GetGR (uw_context, UNWIND_STACK_REG)))
1364 uw_phases |= _UA_HANDLER_FRAME;
1365 #endif
1366 break;
1367
1368 case _US_UNWIND_FRAME_RESUME:
1369 /* Phase 2, called at the return of a cleanup. In the GNU
1370 implementation, there is nothing left to do, so we simply go on. */
1371 return continue_unwind (uw_exception, uw_context);
1372
1373 default:
1374 return _URC_FAILURE;
1375 }
1376 uw_phases |= (state & _US_FORCE_UNWIND);
1377
1378 /* The dwarf unwinder assumes the context structure holds things like the
1379 function and LSDA pointers. The ARM implementation caches these in
1380 the exception header (UCB). To avoid rewriting everything we make a
1381 virtual scratch register point at the UCB. This is a GNU specific
1382 requirement. */
1383 _Unwind_SetGR (uw_context, UNWIND_POINTER_REG, (_Unwind_Ptr) uw_exception);
1384
1385 return personality_body (uw_phases, uw_exception, uw_context);
1386 }
1387 #endif /* __ARM_EABI_UNWINDER__ */
1388
1389 /* Callback routine called by Unwind_ForcedUnwind to execute all the cleanup
1390 before exiting the task. */
1391
1392 #ifndef CERT
1393 _Unwind_Reason_Code
__gnat_cleanupunwind_handler(int version ATTRIBUTE_UNUSED,_Unwind_Action phases,_Unwind_Exception_Class eclass ATTRIBUTE_UNUSED,struct _Unwind_Exception * exception,struct _Unwind_Context * context ATTRIBUTE_UNUSED,void * arg ATTRIBUTE_UNUSED)1394 __gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
1395 _Unwind_Action phases,
1396 _Unwind_Exception_Class eclass ATTRIBUTE_UNUSED,
1397 struct _Unwind_Exception *exception,
1398 struct _Unwind_Context *context ATTRIBUTE_UNUSED,
1399 void *arg ATTRIBUTE_UNUSED)
1400 {
1401 /* Terminate when the end of the stack is reached. */
1402 if ((phases & _UA_END_OF_STACK) != 0
1403 #if defined (__ia64__) && defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
1404 /* Strictely follow the ia64 ABI: when end of stack is reached,
1405 the callback will be called with a NULL stack pointer.
1406 No need for that when using libgcc unwinder. */
1407 || _Unwind_GetGR (context, 12) == 0
1408 #endif
1409 )
1410 __gnat_unhandled_except_handler (exception);
1411
1412 /* We know there is at least one cleanup further up. Return so that it
1413 is searched and entered, after which Unwind_Resume will be called
1414 and this hook will gain control again. */
1415 return _URC_NO_REASON;
1416 }
1417 #endif
1418
1419 /* Define the consistently named wrappers imported by Propagate_Exception. */
1420
1421 _Unwind_Reason_Code
__gnat_Unwind_RaiseException(_Unwind_Exception * e)1422 __gnat_Unwind_RaiseException (_Unwind_Exception *e)
1423 {
1424 #ifdef __USING_SJLJ_EXCEPTIONS__
1425 return _Unwind_SjLj_RaiseException (e);
1426 #else
1427 return _Unwind_RaiseException (e);
1428 #endif
1429 }
1430
1431 _Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind(_Unwind_Exception * e ATTRIBUTE_UNUSED,_Unwind_Stop_Fn handler ATTRIBUTE_UNUSED,void * argument ATTRIBUTE_UNUSED)1432 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
1433 _Unwind_Stop_Fn handler ATTRIBUTE_UNUSED,
1434 void *argument ATTRIBUTE_UNUSED)
1435 {
1436 #ifdef __USING_SJLJ_EXCEPTIONS__
1437
1438 # if defined (__APPLE__) && defined (__arm__)
1439 /* There is not ForcedUnwind routine in arm-darwin system library. */
1440 return _URC_FATAL_PHASE1_ERROR;
1441 # else
1442 return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
1443 # endif
1444
1445 #else
1446 return _Unwind_ForcedUnwind (e, handler, argument);
1447 #endif
1448 }
1449
1450 #if defined (__SEH__) && !defined (__USING_SJLJ_EXCEPTIONS__)
1451
1452 #define STATUS_USER_DEFINED (1U << 29)
1453
1454 /* From unwind-seh.c. */
1455 #define GCC_MAGIC (('G' << 16) | ('C' << 8) | 'C')
1456 #define GCC_EXCEPTION(TYPE) \
1457 (STATUS_USER_DEFINED | ((TYPE) << 24) | GCC_MAGIC)
1458 #define STATUS_GCC_THROW GCC_EXCEPTION (0)
1459
1460 EXCEPTION_DISPOSITION __gnat_SEH_error_handler
1461 (struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
1462
1463 struct Exception_Data *
1464 __gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg);
1465
1466 struct _Unwind_Exception *
1467 __gnat_create_machine_occurrence_from_signal_handler (Exception_Id,
1468 const char *);
1469
1470 /* Unwind opcodes. */
1471 #define UWOP_PUSH_NONVOL 0
1472 #define UWOP_ALLOC_LARGE 1
1473 #define UWOP_ALLOC_SMALL 2
1474 #define UWOP_SET_FPREG 3
1475 #define UWOP_SAVE_NONVOL 4
1476 #define UWOP_SAVE_NONVOL_FAR 5
1477 #define UWOP_SAVE_XMM128 8
1478 #define UWOP_SAVE_XMM128_FAR 9
1479 #define UWOP_PUSH_MACHFRAME 10
1480
1481 /* Modify the IP value saved in the machine frame. This is really a kludge,
1482 that will be removed if we could propagate the Windows exception (and not
1483 the GCC one).
1484 What is very wrong is that the Windows unwinder will try to decode the
1485 instruction at IP, which isn't valid anymore after the adjust. */
1486
1487 static void
__gnat_adjust_context(unsigned char * unw,ULONG64 rsp)1488 __gnat_adjust_context (unsigned char *unw, ULONG64 rsp)
1489 {
1490 unsigned int len;
1491
1492 /* Version = 1, no flags, no prologue. */
1493 if (unw[0] != 1 || unw[1] != 0)
1494 return;
1495 len = unw[2];
1496 /* No frame pointer. */
1497 if (unw[3] != 0)
1498 return;
1499 unw += 4;
1500 while (len > 0)
1501 {
1502 /* Offset in prologue = 0. */
1503 if (unw[0] != 0)
1504 return;
1505 switch (unw[1] & 0xf)
1506 {
1507 case UWOP_ALLOC_LARGE:
1508 /* Expect < 512KB. */
1509 if ((unw[1] & 0xf0) != 0)
1510 return;
1511 rsp += *(unsigned short *)(unw + 2) * 8;
1512 len--;
1513 unw += 2;
1514 break;
1515 case UWOP_SAVE_NONVOL:
1516 case UWOP_SAVE_XMM128:
1517 len--;
1518 unw += 2;
1519 break;
1520 case UWOP_PUSH_MACHFRAME:
1521 {
1522 ULONG64 *rip;
1523 rip = (ULONG64 *)rsp;
1524 if ((unw[1] & 0xf0) == 0x10)
1525 rip++;
1526 /* Adjust rip. */
1527 (*rip)++;
1528 }
1529 return;
1530 default:
1531 /* Unexpected. */
1532 return;
1533 }
1534 unw += 2;
1535 len--;
1536 }
1537 }
1538
1539 EXCEPTION_DISPOSITION
__gnat_personality_seh0(PEXCEPTION_RECORD ms_exc,void * this_frame,PCONTEXT ms_orig_context,PDISPATCHER_CONTEXT ms_disp)1540 __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
1541 PCONTEXT ms_orig_context,
1542 PDISPATCHER_CONTEXT ms_disp)
1543 {
1544 /* Possibly transform run-time errors into Ada exceptions. As a small
1545 optimization, we call __gnat_SEH_error_handler only on non-user
1546 exceptions. */
1547 if (!(ms_exc->ExceptionCode & STATUS_USER_DEFINED))
1548 {
1549 struct Exception_Data *exception;
1550 const char *msg;
1551 ULONG64 excpip = (ULONG64) ms_exc->ExceptionAddress;
1552
1553 if (excpip != 0
1554 && excpip >= (ms_disp->ImageBase
1555 + ms_disp->FunctionEntry->BeginAddress)
1556 && excpip < (ms_disp->ImageBase
1557 + ms_disp->FunctionEntry->EndAddress))
1558 {
1559 /* This is a fault in this function. We need to adjust the return
1560 address before raising the GCC exception. */
1561 CONTEXT context;
1562 PRUNTIME_FUNCTION mf_func = NULL;
1563 ULONG64 mf_imagebase;
1564 ULONG64 mf_rsp = 0;
1565
1566 /* Get the context. */
1567 RtlCaptureContext (&context);
1568
1569 while (1)
1570 {
1571 PRUNTIME_FUNCTION RuntimeFunction;
1572 ULONG64 ImageBase;
1573 VOID *HandlerData;
1574 ULONG64 EstablisherFrame;
1575
1576 /* Get function metadata. */
1577 RuntimeFunction = RtlLookupFunctionEntry
1578 (context.Rip, &ImageBase, ms_disp->HistoryTable);
1579 if (RuntimeFunction == ms_disp->FunctionEntry)
1580 break;
1581 mf_func = RuntimeFunction;
1582 mf_imagebase = ImageBase;
1583 mf_rsp = context.Rsp;
1584
1585 if (!RuntimeFunction)
1586 {
1587 /* In case of failure, assume this is a leaf function. */
1588 context.Rip = *(ULONG64 *) context.Rsp;
1589 context.Rsp += 8;
1590 }
1591 else
1592 {
1593 /* Unwind. */
1594 RtlVirtualUnwind (0, ImageBase, context.Rip, RuntimeFunction,
1595 &context, &HandlerData, &EstablisherFrame,
1596 NULL);
1597 }
1598
1599 /* 0 means bottom of the stack. */
1600 if (context.Rip == 0)
1601 {
1602 mf_func = NULL;
1603 break;
1604 }
1605 }
1606 if (mf_func != NULL)
1607 __gnat_adjust_context
1608 ((unsigned char *)(mf_imagebase + mf_func->UnwindData), mf_rsp);
1609 }
1610
1611 exception = __gnat_map_SEH (ms_exc, &msg);
1612 if (exception != NULL)
1613 {
1614 struct _Unwind_Exception *exc;
1615
1616 /* Directly convert the system exception to a GCC one.
1617 This is really breaking the API, but is necessary for stack size
1618 reasons: the normal way is to call Raise_From_Signal_Handler,
1619 which build the exception and calls _Unwind_RaiseException, which
1620 unwinds the stack and will call this personality routine. But
1621 the Windows unwinder needs about 2KB of stack. */
1622 exc = __gnat_create_machine_occurrence_from_signal_handler
1623 (exception, msg);
1624 memset (exc->private_, 0, sizeof (exc->private_));
1625 ms_exc->ExceptionCode = STATUS_GCC_THROW;
1626 ms_exc->NumberParameters = 1;
1627 ms_exc->ExceptionInformation[0] = (ULONG_PTR)exc;
1628 }
1629
1630 }
1631
1632 return _GCC_specific_handler (ms_exc, this_frame, ms_orig_context,
1633 ms_disp, __gnat_personality_imp);
1634 }
1635 #endif /* SEH */
1636
1637 #if !defined (__USING_SJLJ_EXCEPTIONS__)
1638 /* Size of the _Unwind_Exception structure. This is used by g-cppexc to get
1639 the offset to the C++ object. */
1640
1641 const int __gnat_unwind_exception_size = sizeof (_Unwind_Exception);
1642 #endif
1643
1644 #ifdef __cplusplus
1645 }
1646 #endif
1647