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