1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- A D A . E X C E P T I O N S . E X C E P T I O N _ P R O P A G A T I O N --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the version using the GCC EH mechanism
34 with Ada
.Unchecked_Conversion
;
35 with Ada
.Unchecked_Deallocation
;
37 with System
.Storage_Elements
; use System
.Storage_Elements
;
39 separate (Ada
.Exceptions
)
40 package body Exception_Propagation
is
42 ------------------------------------------------
43 -- Entities to interface with the GCC runtime --
44 ------------------------------------------------
46 -- These come from "C++ ABI for Itanium: Exception handling", which is
47 -- the reference for GCC. They are used only when we are relying on
48 -- back-end tables for exception propagation, which in turn is currently
49 -- only the case for Zero_Cost_Exceptions in GNAT5.
51 -- Return codes from the GCC runtime functions used to propagate
54 type Unwind_Reason_Code
is
56 URC_FOREIGN_EXCEPTION_CAUGHT
,
66 (URC_FOREIGN_EXCEPTION_CAUGHT
,
75 pragma Convention
(C
, Unwind_Reason_Code
);
86 (UA_SEARCH_PHASE
=> 1,
87 UA_CLEANUP_PHASE
=> 2,
88 UA_HANDLER_FRAME
=> 4,
89 UA_FORCE_UNWIND
=> 8);
91 pragma Convention
(C
, Unwind_Action
);
93 -- Mandatory common header for any exception object handled by the
94 -- GCC unwinding runtime.
96 type Exception_Class
is mod 2 ** 64;
98 GNAT_Exception_Class
: constant Exception_Class
:= 16#
474e552d41646100#
;
101 type Unwind_Word
is mod 2 ** System
.Word_Size
;
102 for Unwind_Word
'Size use System
.Word_Size
;
103 -- Map the corresponding C type used in Unwind_Exception below
105 type Unwind_Exception
is record
106 Class
: Exception_Class
:= GNAT_Exception_Class
;
107 Cleanup
: System
.Address
:= System
.Null_Address
;
108 Private1
: Unwind_Word
;
109 Private2
: Unwind_Word
;
111 -- Map the GCC struct used for exception handling
113 for Unwind_Exception
'Alignment use Standard
'Maximum_Alignment;
114 -- The C++ ABI mandates the common exception header to be at least
115 -- doubleword aligned, and the libGCC implementation actually makes it
116 -- maximally aligned (see unwind.h). See additional comments on the
119 --------------------------------------------------------------
120 -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
121 --------------------------------------------------------------
123 -- A GNAT exception object to be dealt with by the personality routine
124 -- called by the GCC unwinding runtime.
126 type GNAT_GCC_Exception
is record
127 Header
: Unwind_Exception
;
128 -- ABI Exception header first
131 -- GNAT Exception identifier. This is filled by Propagate_Exception
132 -- and then used by the personality routine to determine if the context
133 -- it examines contains a handler for the exception being propagated.
135 N_Cleanups_To_Trigger
: Integer;
136 -- Number of cleanup only frames encountered in SEARCH phase. This is
137 -- initialized to 0 by Propagate_Exception and maintained by the
138 -- personality routine to control a forced unwinding phase triggering
139 -- all the cleanups before calling Unhandled_Exception_Terminate when
140 -- an exception is not handled.
142 Next_Exception
: EOA
;
143 -- Used to create a linked list of exception occurrences
146 pragma Convention
(C
, GNAT_GCC_Exception
);
148 -- There is a subtle issue with the common header alignment, since the C
149 -- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
150 -- Standard'Maximum_Alignment, and those two values don't quite represent
151 -- the same concepts and so may be decoupled someday. One typical reason
152 -- is that BIGGEST_ALIGNMENT may be larger than what the underlying system
153 -- allocator guarantees, and there are extra costs involved in allocating
154 -- objects aligned to such factors.
156 -- To deal with the potential alignment differences between the C and Ada
157 -- representations, the Ada part of the whole structure is only accessed
158 -- by the personality routine through the accessors declared below. Ada
159 -- specific fields are thus always accessed through consistent layout, and
160 -- we expect the actual alignment to always be large enough to avoid traps
161 -- from the C accesses to the common header. Besides, accessors alleviate
162 -- the need for a C struct whole counterpart, both painful and error-prone
163 -- to maintain anyway.
165 type GNAT_GCC_Exception_Access
is access all GNAT_GCC_Exception
;
167 function To_GNAT_GCC_Exception
is new
168 Unchecked_Conversion
(System
.Address
, GNAT_GCC_Exception_Access
);
170 procedure Free
is new Unchecked_Deallocation
171 (GNAT_GCC_Exception
, GNAT_GCC_Exception_Access
);
173 procedure Free
is new Unchecked_Deallocation
174 (Exception_Occurrence
, EOA
);
176 function CleanupUnwind_Handler
177 (UW_Version
: Integer;
178 UW_Phases
: Unwind_Action
;
179 UW_Eclass
: Exception_Class
;
180 UW_Exception
: not null access GNAT_GCC_Exception
;
181 UW_Context
: System
.Address
;
182 UW_Argument
: System
.Address
) return Unwind_Reason_Code
;
183 -- Hook called at each step of the forced unwinding we perform to
184 -- trigger cleanups found during the propagation of an unhandled
187 -- GCC runtime functions used. These are C non-void functions, actually,
188 -- but we ignore the return values. See raise.c as to why we are using
189 -- __gnat stubs for these.
191 procedure Unwind_RaiseException
192 (UW_Exception
: not null access GNAT_GCC_Exception
);
193 pragma Import
(C
, Unwind_RaiseException
, "__gnat_Unwind_RaiseException");
195 procedure Unwind_ForcedUnwind
196 (UW_Exception
: not null access GNAT_GCC_Exception
;
197 UW_Handler
: System
.Address
;
198 UW_Argument
: System
.Address
);
199 pragma Import
(C
, Unwind_ForcedUnwind
, "__gnat_Unwind_ForcedUnwind");
201 ------------------------------------------------------------------
202 -- Occurrence Stack Management Facilities for the GCC-EH Scheme --
203 ------------------------------------------------------------------
207 Excep
: GNAT_GCC_Exception_Access
) return Boolean;
208 -- Remove Excep from the stack starting at Top.
209 -- Return True if Excep was found and removed, false otherwise.
211 -- Hooks called when entering/leaving an exception handler for a given
212 -- occurrence, aimed at handling the stack of active occurrences. The
213 -- calls are generated by gigi in tree_transform/N_Exception_Handler.
215 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
216 pragma Export
(C
, Begin_Handler
, "__gnat_begin_handler");
218 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
219 pragma Export
(C
, End_Handler
, "__gnat_end_handler");
221 Setup_Key
: constant := 16#DEAD#
;
222 -- To handle the case of a task "transferring" an exception occurrence to
223 -- another task, for instance via Exceptional_Complete_Rendezvous, we need
224 -- to be able to identify occurrences which have been Setup and not yet
225 -- Propagated. We hijack one of the common header fields for that purpose,
226 -- setting it to a special key value during the setup process, clearing it
227 -- at the very beginning of the propagation phase, and expecting it never
228 -- to be reset to the special value later on. A 16-bit value is used rather
229 -- than a 32-bit value for static compatibility with 16-bit targets such as
230 -- AAMP (where type Unwind_Word will be 16 bits).
232 function Is_Setup_And_Not_Propagated
(E
: EOA
) return Boolean;
234 procedure Set_Setup_And_Not_Propagated
(E
: EOA
);
235 procedure Clear_Setup_And_Not_Propagated
(E
: EOA
);
237 procedure Save_Occurrence_And_Private
238 (Target
: out Exception_Occurrence
;
239 Source
: Exception_Occurrence
);
240 -- Copy all the components of Source to Target as well as the
241 -- Private_Data pointer.
243 --------------------------------------------------------------------
244 -- Accessors to Basic Components of a GNAT Exception Data Pointer --
245 --------------------------------------------------------------------
247 -- As of today, these are only used by the C implementation of the GCC
248 -- propagation personality routine to avoid having to rely on a C
249 -- counterpart of the whole exception_data structure, which is both
250 -- painful and error prone. These subprograms could be moved to a more
251 -- widely visible location if need be.
253 function Is_Handled_By_Others
(E
: Exception_Data_Ptr
) return Boolean;
254 pragma Export
(C
, Is_Handled_By_Others
, "__gnat_is_handled_by_others");
255 pragma Warnings
(Off
, Is_Handled_By_Others
);
257 function Language_For
(E
: Exception_Data_Ptr
) return Character;
258 pragma Export
(C
, Language_For
, "__gnat_language_for");
260 function Import_Code_For
(E
: Exception_Data_Ptr
) return Exception_Code
;
261 pragma Export
(C
, Import_Code_For
, "__gnat_import_code_for");
263 function EID_For
(GNAT_Exception
: GNAT_GCC_Exception_Access
)
265 pragma Export
(C
, EID_For
, "__gnat_eid_for");
267 procedure Adjust_N_Cleanups_For
268 (GNAT_Exception
: GNAT_GCC_Exception_Access
;
269 Adjustment
: Integer);
270 pragma Export
(C
, Adjust_N_Cleanups_For
, "__gnat_adjust_n_cleanups_for");
272 ---------------------------------------------------------------------------
273 -- Objects to materialize "others" and "all others" in the GCC EH tables --
274 ---------------------------------------------------------------------------
276 -- Currently, these only have their address taken and compared so there is
277 -- no real point having whole exception data blocks allocated. In any case
278 -- the types should match what gigi and the personality routine expect.
279 -- The initial value is an arbitrary value that will not exceed the range
280 -- of Integer on 16-bit targets (such as AAMP).
282 Others_Value
: constant Integer := 16#
7FFF#
;
283 pragma Export
(C
, Others_Value
, "__gnat_others_value");
285 All_Others_Value
: constant Integer := 16#
7FFF#
;
286 pragma Export
(C
, All_Others_Value
, "__gnat_all_others_value");
294 Excep
: GNAT_GCC_Exception_Access
) return Boolean
296 Prev
: GNAT_GCC_Exception_Access
:= null;
298 GCC_Exception
: GNAT_GCC_Exception_Access
;
304 pragma Assert
(Iter
.Private_Data
/= System
.Null_Address
);
306 GCC_Exception
:= To_GNAT_GCC_Exception
(Iter
.Private_Data
);
308 if GCC_Exception
= Excep
then
311 -- Special case for the top of the stack: shift the contents
312 -- of the next item to the top, since top is at a fixed
313 -- location and can't be changed.
315 Iter
:= GCC_Exception
.Next_Exception
;
319 -- Stack is now empty
321 Top
.Private_Data
:= System
.Null_Address
;
324 Save_Occurrence_And_Private
(Top
.all, Iter
.all);
329 Prev
.Next_Exception
:= GCC_Exception
.Next_Exception
;
333 Free
(GCC_Exception
);
338 exit when GCC_Exception
.Next_Exception
= null;
340 Prev
:= GCC_Exception
;
341 Iter
:= GCC_Exception
.Next_Exception
;
347 ---------------------------
348 -- CleanupUnwind_Handler --
349 ---------------------------
351 function CleanupUnwind_Handler
352 (UW_Version
: Integer;
353 UW_Phases
: Unwind_Action
;
354 UW_Eclass
: Exception_Class
;
355 UW_Exception
: not null access GNAT_GCC_Exception
;
356 UW_Context
: System
.Address
;
357 UW_Argument
: System
.Address
) return Unwind_Reason_Code
360 (UW_Version
, UW_Phases
, UW_Eclass
, UW_Context
, UW_Argument
);
363 -- Terminate as soon as we know there is nothing more to run. The
364 -- count is maintained by the personality routine.
366 if UW_Exception
.N_Cleanups_To_Trigger
= 0 then
367 Unhandled_Exception_Terminate
;
370 -- We know there is at least one cleanup further up. Return so that it
371 -- is searched and entered, after which Unwind_Resume will be called
372 -- and this hook will gain control (with an updated count) again.
374 return URC_NO_REASON
;
375 end CleanupUnwind_Handler
;
377 ---------------------------------
378 -- Is_Setup_And_Not_Propagated --
379 ---------------------------------
381 function Is_Setup_And_Not_Propagated
(E
: EOA
) return Boolean is
382 GCC_E
: constant GNAT_GCC_Exception_Access
:=
383 To_GNAT_GCC_Exception
(E
.Private_Data
);
385 return GCC_E
/= null and then GCC_E
.Header
.Private1
= Setup_Key
;
386 end Is_Setup_And_Not_Propagated
;
388 ------------------------------------
389 -- Clear_Setup_And_Not_Propagated --
390 ------------------------------------
392 procedure Clear_Setup_And_Not_Propagated
(E
: EOA
) is
393 GCC_E
: constant GNAT_GCC_Exception_Access
:=
394 To_GNAT_GCC_Exception
(E
.Private_Data
);
396 pragma Assert
(GCC_E
/= null);
397 GCC_E
.Header
.Private1
:= 0;
398 end Clear_Setup_And_Not_Propagated
;
400 ----------------------------------
401 -- Set_Setup_And_Not_Propagated --
402 ----------------------------------
404 procedure Set_Setup_And_Not_Propagated
(E
: EOA
) is
405 GCC_E
: constant GNAT_GCC_Exception_Access
:=
406 To_GNAT_GCC_Exception
(E
.Private_Data
);
408 pragma Assert
(GCC_E
/= null);
409 GCC_E
.Header
.Private1
:= Setup_Key
;
410 end Set_Setup_And_Not_Propagated
;
412 --------------------------------
413 -- Save_Occurrence_And_Private --
414 --------------------------------
416 procedure Save_Occurrence_And_Private
417 (Target
: out Exception_Occurrence
;
418 Source
: Exception_Occurrence
)
421 Save_Occurrence_No_Private
(Target
, Source
);
422 Target
.Private_Data
:= Source
.Private_Data
;
423 end Save_Occurrence_And_Private
;
425 ---------------------
426 -- Setup_Exception --
427 ---------------------
429 -- In the GCC-EH implementation of the propagation scheme, this
430 -- subprogram should be understood as: Setup the exception occurrence
431 -- stack headed at Current for a forthcoming raise of Excep.
433 procedure Setup_Exception
436 Reraised
: Boolean := False)
438 Top
: constant EOA
:= Current
;
440 GCC_Exception
: GNAT_GCC_Exception_Access
;
443 -- The exception Excep is soon to be propagated, and the
444 -- storage used for that will be the occurrence statically allocated
445 -- for the current thread. This storage might currently be used for a
446 -- still active occurrence, so we need to push it on the thread's
447 -- occurrence stack (headed at that static occurrence) before it gets
450 -- What we do here is to trigger this push when need be, and allocate a
451 -- Private_Data block for the forthcoming Propagation.
453 -- Some tasking rendez-vous attempts lead to an occurrence transfer
454 -- from the server to the client (see Exceptional_Complete_Rendezvous).
455 -- In those cases Setup is called twice for the very same occurrence
456 -- before it gets propagated: once from the server, because this is
457 -- where the occurrence contents is elaborated and known, and then
458 -- once from the client when it detects the case and actually raises
459 -- the exception in its own context.
461 -- The Is_Setup_And_Not_Propagated predicate tells us when we are in
462 -- the second call to Setup for a Transferred occurrence, and there is
463 -- nothing to be done here in this situation. This predicate cannot be
464 -- True if we are dealing with a Reraise, and we may even be called
465 -- with a raw uninitialized Excep occurrence in this case so we should
466 -- not check anyway. Observe the front-end expansion for a "raise;" to
467 -- see that happening. We get a local occurrence and a direct call to
468 -- Save_Occurrence without the intermediate init-proc call.
470 if not Reraised
and then Is_Setup_And_Not_Propagated
(Excep
) then
474 -- Allocate what will be the Private_Data block for the exception
477 GCC_Exception
:= new GNAT_GCC_Exception
;
479 -- If the Top of the occurrence stack is not currently used for an
480 -- active exception (the stack is empty) we just need to setup the
481 -- Private_Data pointer.
483 -- Otherwise, we also need to shift the contents of the Top of the
484 -- stack in a freshly allocated entry and link everything together.
486 if Top
.Private_Data
/= System
.Null_Address
then
487 Next
:= new Exception_Occurrence
;
488 Save_Occurrence_And_Private
(Next
.all, Top
.all);
490 GCC_Exception
.Next_Exception
:= Next
;
491 Top
.Private_Data
:= GCC_Exception
.all'Address;
494 Top
.Private_Data
:= GCC_Exception
.all'Address;
496 Set_Setup_And_Not_Propagated
(Top
);
503 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
504 pragma Unreferenced
(GCC_Exception
);
507 -- Every necessary operation related to the occurrence stack has
508 -- already been performed by Propagate_Exception. This hook remains for
509 -- potential future necessity in optimizing the overall scheme, as well
510 -- a useful debugging tool.
519 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
522 Removed
:= Remove
(Get_Current_Excep
.all, GCC_Exception
);
523 pragma Assert
(Removed
);
526 -------------------------
527 -- Propagate_Exception --
528 -------------------------
530 -- Build an object suitable for the libgcc processing and call
531 -- Unwind_RaiseException to actually throw, taking care of handling
532 -- the two phase scheme it implements.
534 procedure Propagate_Exception
536 From_Signal_Handler
: Boolean)
538 pragma Inspection_Point
(E
);
539 pragma Unreferenced
(From_Signal_Handler
);
541 Excep
: constant EOA
:= Get_Current_Excep
.all;
542 GCC_Exception
: GNAT_GCC_Exception_Access
;
545 pragma Assert
(Excep
.Private_Data
/= System
.Null_Address
);
547 -- Retrieve the Private_Data for this occurrence and set the useful
548 -- flags for the personality routine, which will be called for each
549 -- frame via Unwind_RaiseException below.
551 GCC_Exception
:= To_GNAT_GCC_Exception
(Excep
.Private_Data
);
553 Clear_Setup_And_Not_Propagated
(Excep
);
555 GCC_Exception
.Id
:= Excep
.Id
;
556 GCC_Exception
.N_Cleanups_To_Trigger
:= 0;
558 -- Compute the backtrace for this occurrence if the corresponding
559 -- binder option has been set. Call_Chain takes care of the reraise
562 -- ??? Using Call_Chain here means we are going to walk up the stack
563 -- once only for backtracing purposes before doing it again for the
564 -- propagation per se.
566 -- The first inspection is much lighter, though, as it only requires
567 -- partial unwinding of each frame. Additionally, although we could use
568 -- the personality routine to record the addresses while propagating,
569 -- this method has two drawbacks:
571 -- 1) the trace is incomplete if the exception is handled since we
572 -- don't walk past the frame with the handler,
576 -- 2) we would miss the frames for which our personality routine is not
577 -- called, e.g. if C or C++ calls are on the way.
581 -- Perform a standard raise first. If a regular handler is found, it
582 -- will be entered after all the intermediate cleanups have run. If
583 -- there is no regular handler, control will get back to after the
584 -- call, with N_Cleanups_To_Trigger set to the number of frames with
585 -- cleanups found on the way up, and none of these already run.
587 Unwind_RaiseException
(GCC_Exception
);
589 -- If we get here we know the exception is not handled, as otherwise
590 -- Unwind_RaiseException arranges for the handler to be entered. Take
591 -- the necessary steps to enable the debugger to gain control while the
592 -- stack is still intact.
594 Notify_Unhandled_Exception
;
596 -- Now, if cleanups have been found, run a forced unwind to trigger
597 -- them. Control should not resume there, as the unwinding hook calls
598 -- Unhandled_Exception_Terminate as soon as the last cleanup has been
601 if GCC_Exception
.N_Cleanups_To_Trigger
/= 0 then
602 Unwind_ForcedUnwind
(GCC_Exception
,
603 CleanupUnwind_Handler
'Address,
604 System
.Null_Address
);
607 -- We get here when there is no handler or cleanup to be run at all.
608 -- The debugger has been notified before the second step above.
610 Unhandled_Exception_Terminate
;
611 end Propagate_Exception
;
613 ---------------------------
614 -- Adjust_N_Cleanups_For --
615 ---------------------------
617 procedure Adjust_N_Cleanups_For
618 (GNAT_Exception
: GNAT_GCC_Exception_Access
;
619 Adjustment
: Integer)
622 GNAT_Exception
.N_Cleanups_To_Trigger
:=
623 GNAT_Exception
.N_Cleanups_To_Trigger
+ Adjustment
;
624 end Adjust_N_Cleanups_For
;
631 (GNAT_Exception
: GNAT_GCC_Exception_Access
) return Exception_Id
634 return GNAT_Exception
.Id
;
637 ---------------------
638 -- Import_Code_For --
639 ---------------------
641 function Import_Code_For
642 (E
: SSL
.Exception_Data_Ptr
) return Exception_Code
645 return E
.all.Import_Code
;
648 --------------------------
649 -- Is_Handled_By_Others --
650 --------------------------
652 function Is_Handled_By_Others
(E
: SSL
.Exception_Data_Ptr
) return Boolean is
654 return not E
.all.Not_Handled_By_Others
;
655 end Is_Handled_By_Others
;
661 function Language_For
(E
: SSL
.Exception_Data_Ptr
) return Character is
670 -- The current model implemented for the stack of occurrences is a
671 -- simplification of previous attempts, which all proved to be flawed or
672 -- would have needed significant additional circuitry to be made to work
675 -- We now represent every propagation by a new entry on the stack, which
676 -- means that an exception occurrence may appear more than once (e.g. when
677 -- it is reraised during the course of its own handler).
679 -- This may seem overcostly compared to the C++ model as implemented in
680 -- the g++ v3 libstd. This is actually understandable when one considers
681 -- the extra variations of possible run-time configurations induced by the
682 -- freedom offered by the Save_Occurrence/Reraise_Occurrence public
685 -- The basic point is that arranging for an occurrence to always appear at
686 -- most once on the stack requires a way to determine if a given occurrence
687 -- is already there, which is not as easy as it might seem.
689 -- An attempt was made to use the Private_Data pointer for this purpose.
690 -- It did not work because:
692 -- 1) The Private_Data has to be saved by Save_Occurrence to be usable
693 -- as a key in case of a later reraise,
695 -- 2) There is no easy way to synchronize End_Handler for an occurrence
696 -- and the data attached to potential copies, so these copies may end
697 -- up pointing to stale data. Moreover ...
699 -- 3) The same address may be reused for different occurrences, which
700 -- defeats the idea of using it as a key.
702 -- The example below illustrates:
704 -- Saved_CE : Exception_Occurrence;
707 -- raise Constraint_Error;
709 -- when CE: others =>
710 -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
713 -- <= Saved_CE.PDA is stale (!)
716 -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
719 -- Reraise_Occurrence (Saved_CE);
722 -- Not releasing the Private_Data via End_Handler could be an option,
723 -- but making this to work while still avoiding memory leaks is far
726 -- The current scheme has the advantage of being simple, and induces
727 -- extra costs only in reraise cases which is acceptable.
729 end Exception_Propagation
;