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-2004 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
36 with Ada
.Unchecked_Conversion
;
37 with Ada
.Unchecked_Deallocation
;
39 with System
.Storage_Elements
; use System
.Storage_Elements
;
41 pragma Warnings
(Off
);
42 -- Since several constructs give warnings in 3.14a1, including unreferenced
43 -- variables and pragma Unreferenced itself.
45 separate (Ada
.Exceptions
)
46 package body Exception_Propagation
is
48 ------------------------------------------------
49 -- Entities to interface with the GCC runtime --
50 ------------------------------------------------
52 -- These come from "C++ ABI for Itanium: Exception handling", which is
53 -- the reference for GCC. They are used only when we are relying on
54 -- back-end tables for exception propagation, which in turn is currenly
55 -- only the case for Zero_Cost_Exceptions in GNAT5.
57 -- Return codes from the GCC runtime functions used to propagate
60 type Unwind_Reason_Code
is
62 URC_FOREIGN_EXCEPTION_CAUGHT
,
72 (URC_FOREIGN_EXCEPTION_CAUGHT
,
81 pragma Convention
(C
, Unwind_Reason_Code
);
92 (UA_SEARCH_PHASE
=> 1,
93 UA_CLEANUP_PHASE
=> 2,
94 UA_HANDLER_FRAME
=> 4,
95 UA_FORCE_UNWIND
=> 8);
97 pragma Convention
(C
, Unwind_Action
);
99 -- Mandatory common header for any exception object handled by the
100 -- GCC unwinding runtime.
102 subtype Exception_Class
is Interfaces
.Unsigned_64
;
104 GNAT_Exception_Class
: constant Exception_Class
:= 16#
474e552d41646100#
;
107 type Unwind_Word
is mod 2 ** System
.Word_Size
;
108 for Unwind_Word
'Size use System
.Word_Size
;
109 -- Map the corresponding C type used in Unwind_Exception below
111 type Unwind_Exception
is record
112 Class
: Exception_Class
:= GNAT_Exception_Class
;
113 Cleanup
: System
.Address
:= System
.Null_Address
;
114 Private1
: Unwind_Word
;
115 Private2
: Unwind_Word
;
117 -- Map the GCC struct used for exception handling
119 for Unwind_Exception
'Alignment use Standard
'Maximum_Alignment;
120 -- The C++ ABI mandates the common exception header to be at least
121 -- doubleword aligned, and the libGCC implementation actually makes it
122 -- maximally aligned (see unwind.h). See additional comments on the
125 --------------------------------------------------------------
126 -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
127 --------------------------------------------------------------
129 -- A GNAT exception object to be dealt with by the personality routine
130 -- called by the GCC unwinding runtime.
132 type GNAT_GCC_Exception
is record
133 Header
: Unwind_Exception
;
134 -- ABI Exception header first.
137 -- GNAT Exception identifier. This is filled by Propagate_Exception
138 -- and then used by the personality routine to determine if the context
139 -- it examines contains a handler for the exception beeing propagated.
141 N_Cleanups_To_Trigger
: Integer;
142 -- Number of cleanup only frames encountered in SEARCH phase. This is
143 -- initialized to 0 by Propagate_Exception and maintained by the
144 -- personality routine to control a forced unwinding phase triggering
145 -- all the cleanups before calling Unhandled_Exception_Terminate when
146 -- an exception is not handled.
148 Next_Exception
: EOA
;
149 -- Used to create a linked list of exception occurrences.
152 pragma Convention
(C
, GNAT_GCC_Exception
);
154 -- There is a subtle issue with the common header alignment, since the C
155 -- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
156 -- Standard'Maximum_Alignment, and those two values don't quite represent
157 -- the same concepts and so may be decoupled someday. One typical reason
158 -- is that BIGGEST_ALIGNMENT may be larger than what the underlying system
159 -- allocator guarantees, and there are extra costs involved in allocating
160 -- objects aligned to such factors.
162 -- To deal with the potential alignment differences between the C and Ada
163 -- representations, the Ada part of the whole structure is only accessed
164 -- by the personality routine through the accessors declared below. Ada
165 -- specific fields are thus always accessed through consistent layout, and
166 -- we expect the actual alignment to always be large enough to avoid traps
167 -- from the C accesses to the common header. Besides, accessors aleviate
168 -- the need for a C struct whole conterpart, both painful and errorprone
169 -- to maintain anyway.
171 type GNAT_GCC_Exception_Access
is access all GNAT_GCC_Exception
;
173 function To_GNAT_GCC_Exception
is new
174 Unchecked_Conversion
(System
.Address
, GNAT_GCC_Exception_Access
);
176 procedure Free
is new Unchecked_Deallocation
177 (GNAT_GCC_Exception
, GNAT_GCC_Exception_Access
);
179 procedure Free
is new Unchecked_Deallocation
180 (Exception_Occurrence
, EOA
);
182 function CleanupUnwind_Handler
183 (UW_Version
: Integer;
184 UW_Phases
: Unwind_Action
;
185 UW_Eclass
: Exception_Class
;
186 UW_Exception
: access GNAT_GCC_Exception
;
187 UW_Context
: System
.Address
;
188 UW_Argument
: System
.Address
) return Unwind_Reason_Code
;
189 -- Hook called at each step of the forced unwinding we perform to
190 -- trigger cleanups found during the propagation of an unhandled
193 -- GCC runtime functions used. These are C non-void functions, actually,
194 -- but we ignore the return values. See raise.c as to why we are using
195 -- __gnat stubs for these.
197 procedure Unwind_RaiseException
198 (UW_Exception
: access GNAT_GCC_Exception
);
199 pragma Import
(C
, Unwind_RaiseException
, "__gnat_Unwind_RaiseException");
201 procedure Unwind_ForcedUnwind
202 (UW_Exception
: access GNAT_GCC_Exception
;
203 UW_Handler
: System
.Address
;
204 UW_Argument
: System
.Address
);
205 pragma Import
(C
, Unwind_ForcedUnwind
, "__gnat_Unwind_ForcedUnwind");
207 --------------------------------------------
208 -- Occurrence stack management facilities --
209 --------------------------------------------
213 Excep
: GNAT_GCC_Exception_Access
) return Boolean;
214 -- Remove Excep from the stack starting at Top.
215 -- Return True if Excep was found and removed, false otherwise.
217 -- Hooks called when entering/leaving an exception handler for a given
218 -- occurrence, aimed at handling the stack of active occurrences. The
219 -- calls are generated by gigi in tree_transform/N_Exception_Handler.
221 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
222 pragma Export
(C
, Begin_Handler
, "__gnat_begin_handler");
224 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
225 pragma Export
(C
, End_Handler
, "__gnat_end_handler");
227 -- To handle the case of a task "transferring" an exception occurrence to
228 -- another task, for instance via Exceptional_Complete_Rendezvous, we need
229 -- to be able to identify occurrences which have been Setup and not yet
230 -- Propagated. We hijack one of the common header fields for that purpose,
231 -- setting it to a special key value during the setup process, clearing it
232 -- at the very beginning of the propagation phase, and expecting it never
233 -- to be reset to the special value later on.
235 Setup_Key
: constant := 16#DEAD_BEEF#
;
237 function Is_Setup_And_Not_Propagated
(E
: EOA
) return Boolean;
239 procedure Set_Setup_And_Not_Propagated
(E
: EOA
);
240 procedure Clear_Setup_And_Not_Propagated
(E
: EOA
);
242 ------------------------------------------------------------
243 -- Accessors to basic components of a GNAT exception data --
244 ------------------------------------------------------------
246 -- As of today, these are only used by the C implementation of the
247 -- propagation personality routine to avoid having to rely on a C
248 -- counterpart of the whole exception_data structure, which is both
249 -- painful and error prone. These subprograms could be moved to a
250 -- more widely visible location if need be.
252 function Is_Handled_By_Others
(E
: Exception_Data_Ptr
) return Boolean;
253 pragma Export
(C
, Is_Handled_By_Others
, "__gnat_is_handled_by_others");
255 function Language_For
(E
: Exception_Data_Ptr
) return Character;
256 pragma Export
(C
, Language_For
, "__gnat_language_for");
258 function Import_Code_For
(E
: Exception_Data_Ptr
) return Exception_Code
;
259 pragma Export
(C
, Import_Code_For
, "__gnat_import_code_for");
261 function EID_For
(GNAT_Exception
: GNAT_GCC_Exception_Access
)
263 pragma Export
(C
, EID_For
, "__gnat_eid_for");
265 procedure Adjust_N_Cleanups_For
266 (GNAT_Exception
: GNAT_GCC_Exception_Access
;
267 Adjustment
: Integer);
268 pragma Export
(C
, Adjust_N_Cleanups_For
, "__gnat_adjust_n_cleanups_for");
276 Excep
: GNAT_GCC_Exception_Access
) return Boolean
278 Prev
: GNAT_GCC_Exception_Access
:= null;
280 GCC_Exception
: GNAT_GCC_Exception_Access
;
286 pragma Assert
(Iter
.Private_Data
/= System
.Null_Address
);
288 GCC_Exception
:= To_GNAT_GCC_Exception
(Iter
.Private_Data
);
290 if GCC_Exception
= Excep
then
293 -- Special case for the top of the stack: shift the contents
294 -- of the next item to the top, since top is at a fixed
295 -- location and can't be changed.
297 Iter
:= GCC_Exception
.Next_Exception
;
301 -- Stack is now empty
303 Top
.Private_Data
:= System
.Null_Address
;
306 Save_Occurrence_And_Private
(Top
.all, Iter
.all);
311 Prev
.Next_Exception
:= GCC_Exception
.Next_Exception
;
315 Free
(GCC_Exception
);
320 exit when GCC_Exception
.Next_Exception
= null;
322 Prev
:= GCC_Exception
;
323 Iter
:= GCC_Exception
.Next_Exception
;
329 ---------------------------
330 -- CleanupUnwind_Handler --
331 ---------------------------
333 function CleanupUnwind_Handler
334 (UW_Version
: Integer;
335 UW_Phases
: Unwind_Action
;
336 UW_Eclass
: Exception_Class
;
337 UW_Exception
: access GNAT_GCC_Exception
;
338 UW_Context
: System
.Address
;
339 UW_Argument
: System
.Address
) return Unwind_Reason_Code
342 -- Terminate as soon as we know there is nothing more to run. The
343 -- count is maintained by the personality routine.
345 if UW_Exception
.N_Cleanups_To_Trigger
= 0 then
346 Unhandled_Exception_Terminate
;
349 -- We know there is at least one cleanup further up. Return so that it
350 -- is searched and entered, after which Unwind_Resume will be called
351 -- and this hook will gain control (with an updated count) again.
353 return URC_NO_REASON
;
354 end CleanupUnwind_Handler
;
356 ---------------------------------
357 -- Is_Setup_And_Not_Propagated --
358 ---------------------------------
360 function Is_Setup_And_Not_Propagated
(E
: EOA
) return Boolean is
361 GCC_E
: GNAT_GCC_Exception_Access
:=
362 To_GNAT_GCC_Exception
(E
.Private_Data
);
364 return GCC_E
/= null and then GCC_E
.Header
.Private1
= Setup_Key
;
365 end Is_Setup_And_Not_Propagated
;
367 ------------------------------------
368 -- Clear_Setup_And_Not_Propagated --
369 ------------------------------------
371 procedure Clear_Setup_And_Not_Propagated
(E
: EOA
) is
372 GCC_E
: GNAT_GCC_Exception_Access
:=
373 To_GNAT_GCC_Exception
(E
.Private_Data
);
375 pragma Assert
(GCC_E
/= null);
376 GCC_E
.Header
.Private1
:= 0;
377 end Clear_Setup_And_Not_Propagated
;
379 ----------------------------------
380 -- Set_Setup_And_Not_Propagated --
381 ----------------------------------
383 procedure Set_Setup_And_Not_Propagated
(E
: EOA
) is
384 GCC_E
: GNAT_GCC_Exception_Access
:=
385 To_GNAT_GCC_Exception
(E
.Private_Data
);
387 pragma Assert
(GCC_E
/= null);
388 GCC_E
.Header
.Private1
:= Setup_Key
;
389 end Set_Setup_And_Not_Propagated
;
391 ---------------------
392 -- Setup_Exception --
393 ---------------------
395 -- In this implementation of the exception propagation scheme, this
396 -- subprogram should be understood as: Setup the exception occurrence
397 -- stack headed at Current for a forthcoming raise of Excep.
399 procedure Setup_Exception
402 Reraised
: Boolean := False)
404 Top
: constant EOA
:= Current
;
406 GCC_Exception
: GNAT_GCC_Exception_Access
;
410 -- The exception Excep is soon to be propagated, and the storage used
411 -- for that will be the occurrence statically allocated for the current
412 -- thread. This storage might currently be used for a still active
413 -- occurrence, so we need to push it on the thread's occurrence stack
414 -- (headed at that static occurrence) before it gets clobbered.
416 -- What we do here is to trigger this push when need be, and allocate a
417 -- Private_Data block for the forthcoming Propagation.
419 -- Some tasking rendez-vous attempts lead to an occurrence transfer
420 -- from the server to the client (see Exceptional_Complete_Rendezvous).
421 -- In those cases Setup is called twice for the very same occurrence
422 -- before it gets propagated: once from the server, because this is
423 -- where the occurrence contents is elaborated and known, and then
424 -- once from the client when it detects the case and actually raises
425 -- the exception in its own context.
427 -- The Is_Setup_And_Not_Propagated predicate tells us when we are in
428 -- the second call to Setup for a Transferred occurrence, and there is
429 -- nothing to be done here in this situation. This predicate cannot be
430 -- True if we are dealing with a Reraise, and we may even be called
431 -- with a raw uninitialized Excep occurrence in this case so we should
432 -- not check anyway. Observe the front-end expansion for a "raise;" to
433 -- see that happening. We get a local occurrence and a direct call to
434 -- Save_Occurrence without the intermediate init-proc call.
436 if not Reraised
and then Is_Setup_And_Not_Propagated
(Excep
) then
440 -- Allocate what will be the Private_Data block for the exception
443 GCC_Exception
:= new GNAT_GCC_Exception
;
445 -- If the Top of the occurrence stack is not currently used for an
446 -- active exception (the stack is empty) we just need to setup the
447 -- Private_Data pointer.
449 -- Otherwise, we also need to shift the contents of the Top of the
450 -- stack in a freshly allocated entry and link everything together.
452 if Top
.Private_Data
/= System
.Null_Address
then
453 Next
:= new Exception_Occurrence
;
454 Save_Occurrence_And_Private
(Next
.all, Top
.all);
456 GCC_Exception
.Next_Exception
:= Next
;
457 Top
.Private_Data
:= GCC_Exception
.all'Address;
460 Top
.Private_Data
:= GCC_Exception
.all'Address;
462 Set_Setup_And_Not_Propagated
(Top
);
470 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
472 -- Every necessary operation related to the occurrence stack has
473 -- already been performed by Propagate_Exception. This hook remains for
474 -- potential future necessity in optimizing the overall scheme, as well
475 -- a useful debugging tool.
484 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
487 Removed
:= Remove
(Get_Current_Excep
.all, GCC_Exception
);
488 pragma Assert
(Removed
);
491 -------------------------
492 -- Propagate_Exception --
493 -------------------------
495 -- Build an object suitable for the libgcc processing and call
496 -- Unwind_RaiseException to actually throw, taking care of handling
497 -- the two phase scheme it implements.
499 procedure Propagate_Exception
(From_Signal_Handler
: Boolean) is
500 Excep
: EOA
:= Get_Current_Excep
.all;
501 GCC_Exception
: GNAT_GCC_Exception_Access
;
504 pragma Assert
(Excep
.Private_Data
/= System
.Null_Address
);
506 -- Retrieve the Private_Data for this occurrence and set the useful
507 -- flags for the personality routine, which will be called for each
508 -- frame via Unwind_RaiseException below.
510 GCC_Exception
:= To_GNAT_GCC_Exception
(Excep
.Private_Data
);
512 Clear_Setup_And_Not_Propagated
(Excep
);
514 GCC_Exception
.Id
:= Excep
.Id
;
515 GCC_Exception
.N_Cleanups_To_Trigger
:= 0;
517 -- Compute the backtrace for this occurrence if the corresponding
518 -- binder option has been set. Call_Chain takes care of the reraise
521 -- ??? Using Call_Chain here means we are going to walk up the stack
522 -- once only for backtracing purposes before doing it again for the
523 -- propagation per se.
525 -- The first inspection is much lighter, though, as it only requires
526 -- partial unwinding of each frame. Additionally, although we could use
527 -- the personality routine to record the addresses while propagating,
528 -- this method has two drawbacks:
530 -- 1) the trace is incomplete if the exception is handled since we
531 -- don't walk past the frame with the handler,
535 -- 2) we would miss the frames for which our personality routine is not
536 -- called, e.g. if C or C++ calls are on the way.
540 -- Perform a standard raise first. If a regular handler is found, it
541 -- will be entered after all the intermediate cleanups have run. If
542 -- there is no regular handler, control will get back to after the
543 -- call, with N_Cleanups_To_Trigger set to the number of frames with
544 -- cleanups found on the way up, and none of these already run.
546 Unwind_RaiseException
(GCC_Exception
);
548 -- If we get here we know the exception is not handled, as otherwise
549 -- Unwind_RaiseException arranges for the handler to be entered. Take
550 -- the necessary steps to enable the debugger to gain control while the
551 -- stack is still intact.
553 Notify_Unhandled_Exception
;
555 -- Now, if cleanups have been found, run a forced unwind to trigger
556 -- them. Control should not resume there, as the unwinding hook calls
557 -- Unhandled_Exception_Terminate as soon as the last cleanup has been
560 if GCC_Exception
.N_Cleanups_To_Trigger
/= 0 then
561 Unwind_ForcedUnwind
(GCC_Exception
,
562 CleanupUnwind_Handler
'Address,
563 System
.Null_Address
);
566 -- We get here when there is no handler or cleanup to be run at
567 -- all. The debugger has been notified before the second step above.
569 Unhandled_Exception_Terminate
;
570 end Propagate_Exception
;
572 ---------------------------
573 -- Adjust_N_Cleanups_For --
574 ---------------------------
576 procedure Adjust_N_Cleanups_For
577 (GNAT_Exception
: GNAT_GCC_Exception_Access
;
578 Adjustment
: Integer)
581 GNAT_Exception
.N_Cleanups_To_Trigger
:=
582 GNAT_Exception
.N_Cleanups_To_Trigger
+ Adjustment
;
583 end Adjust_N_Cleanups_For
;
590 (GNAT_Exception
: GNAT_GCC_Exception_Access
) return Exception_Id
593 return GNAT_Exception
.Id
;
596 ---------------------
597 -- Import_Code_For --
598 ---------------------
600 function Import_Code_For
601 (E
: SSL
.Exception_Data_Ptr
) return Exception_Code
604 return E
.all.Import_Code
;
607 --------------------------
608 -- Is_Handled_By_Others --
609 --------------------------
611 function Is_Handled_By_Others
612 (E
: SSL
.Exception_Data_Ptr
) return Boolean
615 return not E
.all.Not_Handled_By_Others
;
616 end Is_Handled_By_Others
;
622 function Language_For
623 (E
: SSL
.Exception_Data_Ptr
) return Character
633 -- The current model implemented for the stack of occurrences is a
634 -- simplification of previous attempts, which all prooved to be flawed or
635 -- would have needed significant additional circuitry to be made to work
638 -- We now represent every propagation by a new entry on the stack, which
639 -- means that an exception occurrence may appear more than once (e.g. when
640 -- it is reraised during the course of its own handler).
642 -- This may seem overcostly compared to the C++ model as implemented in
643 -- the g++ v3 libstd. This is actually understandable when one considers
644 -- the extra variations of possible run-time configurations induced by the
645 -- freedom offered by the Save_Occurrence/Reraise_Occurrence public
648 -- The basic point is that arranging for an occurrence to always appear at
649 -- most once on the stack requires a way to determine if a given occurence
650 -- is already there, which is not as easy as it might seem.
652 -- An attempt was made to use the Private_Data pointer for this purpose.
653 -- It did not work because:
655 -- 1) The Private_Data has to be saved by Save_Occurrence to be usable
656 -- as a key in case of a later reraise,
658 -- 2) There is no easy way to synchronize End_Handler for an occurrence
659 -- and the data attached to potential copies, so these copies may end
660 -- up pointing to stale data. Moreover ...
662 -- 3) The same address may be reused for different occurrences, which
663 -- defeats the idea of using it as a key.
665 -- The example below illustrates:
667 -- Saved_CE : Exception_Occurrence;
670 -- raise Constraint_Error;
672 -- when CE: others =>
673 -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
676 -- <= Saved_CE.PDA is stale (!)
679 -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
682 -- Reraise_Occurrence (Saved_CE);
685 -- Not releasing the Private_Data via End_Handler could be an option,
686 -- but making this to work while still avoiding memory leaks is far
689 -- The current scheme has the advantage of beeing simple, and induces
690 -- extra costs only in reraise cases which is acceptable.
692 end Exception_Propagation
;