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