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