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 Setup_Key : constant := 16#DEAD#;
228 -- To handle the case of a task "transferring" an exception occurrence to
229 -- another task, for instance via Exceptional_Complete_Rendezvous, we need
230 -- to be able to identify occurrences which have been Setup and not yet
231 -- Propagated. We hijack one of the common header fields for that purpose,
232 -- setting it to a special key value during the setup process, clearing it
233 -- at the very beginning of the propagation phase, and expecting it never
234 -- to be reset to the special value later on. A 16-bit value is used rather
235 -- than a 32-bit value for static compatibility with 16-bit targets such as
236 -- AAMP (where type Unwind_Word will be 16 bits).
238 function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
240 procedure Set_Setup_And_Not_Propagated (E : EOA);
241 procedure Clear_Setup_And_Not_Propagated (E : EOA);
243 ------------------------------------------------------------
244 -- Accessors to basic components of a GNAT exception data --
245 ------------------------------------------------------------
247 -- As of today, these are only used by the C implementation of the
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
251 -- more 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");
256 function Language_For (E : Exception_Data_Ptr) return Character;
257 pragma Export (C, Language_For, "__gnat_language_for");
259 function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
260 pragma Export (C, Import_Code_For, "__gnat_import_code_for");
262 function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
264 pragma Export (C, EID_For, "__gnat_eid_for");
266 procedure Adjust_N_Cleanups_For
267 (GNAT_Exception : GNAT_GCC_Exception_Access;
268 Adjustment : Integer);
269 pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
277 Excep : GNAT_GCC_Exception_Access) return Boolean
279 Prev : GNAT_GCC_Exception_Access := null;
281 GCC_Exception : GNAT_GCC_Exception_Access;
287 pragma Assert (Iter.Private_Data /= System.Null_Address);
289 GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
291 if GCC_Exception = Excep then
294 -- Special case for the top of the stack: shift the contents
295 -- of the next item to the top, since top is at a fixed
296 -- location and can't be changed.
298 Iter := GCC_Exception.Next_Exception;
302 -- Stack is now empty
304 Top.Private_Data := System.Null_Address;
307 Save_Occurrence_And_Private (Top.all, Iter.all);
312 Prev.Next_Exception := GCC_Exception.Next_Exception;
316 Free (GCC_Exception);
321 exit when GCC_Exception.Next_Exception = null;
323 Prev := GCC_Exception;
324 Iter := GCC_Exception.Next_Exception;
330 ---------------------------
331 -- CleanupUnwind_Handler --
332 ---------------------------
334 function CleanupUnwind_Handler
335 (UW_Version : Integer;
336 UW_Phases : Unwind_Action;
337 UW_Eclass : Exception_Class;
338 UW_Exception : access GNAT_GCC_Exception;
339 UW_Context : System.Address;
340 UW_Argument : System.Address) return Unwind_Reason_Code
343 -- Terminate as soon as we know there is nothing more to run. The
344 -- count is maintained by the personality routine.
346 if UW_Exception.N_Cleanups_To_Trigger = 0 then
347 Unhandled_Exception_Terminate;
350 -- We know there is at least one cleanup further up. Return so that it
351 -- is searched and entered, after which Unwind_Resume will be called
352 -- and this hook will gain control (with an updated count) again.
354 return URC_NO_REASON;
355 end CleanupUnwind_Handler;
357 ---------------------------------
358 -- Is_Setup_And_Not_Propagated --
359 ---------------------------------
361 function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
362 GCC_E : GNAT_GCC_Exception_Access :=
363 To_GNAT_GCC_Exception (E.Private_Data);
365 return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
366 end Is_Setup_And_Not_Propagated;
368 ------------------------------------
369 -- Clear_Setup_And_Not_Propagated --
370 ------------------------------------
372 procedure Clear_Setup_And_Not_Propagated (E : EOA) is
373 GCC_E : GNAT_GCC_Exception_Access :=
374 To_GNAT_GCC_Exception (E.Private_Data);
376 pragma Assert (GCC_E /= null);
377 GCC_E.Header.Private1 := 0;
378 end Clear_Setup_And_Not_Propagated;
380 ----------------------------------
381 -- Set_Setup_And_Not_Propagated --
382 ----------------------------------
384 procedure Set_Setup_And_Not_Propagated (E : EOA) is
385 GCC_E : GNAT_GCC_Exception_Access :=
386 To_GNAT_GCC_Exception (E.Private_Data);
388 pragma Assert (GCC_E /= null);
389 GCC_E.Header.Private1 := Setup_Key;
390 end Set_Setup_And_Not_Propagated;
392 ---------------------
393 -- Setup_Exception --
394 ---------------------
396 -- In this implementation of the exception propagation scheme, this
397 -- subprogram should be understood as: Setup the exception occurrence
398 -- stack headed at Current for a forthcoming raise of Excep.
400 procedure Setup_Exception
403 Reraised : Boolean := False)
405 Top : constant EOA := Current;
407 GCC_Exception : GNAT_GCC_Exception_Access;
411 -- The exception Excep is soon to be propagated, and the storage used
412 -- for that will be the occurrence statically allocated for the current
413 -- thread. This storage might currently be used for a still active
414 -- occurrence, so we need to push it on the thread's occurrence stack
415 -- (headed at that static occurrence) before it gets clobbered.
417 -- What we do here is to trigger this push when need be, and allocate a
418 -- Private_Data block for the forthcoming Propagation.
420 -- Some tasking rendez-vous attempts lead to an occurrence transfer
421 -- from the server to the client (see Exceptional_Complete_Rendezvous).
422 -- In those cases Setup is called twice for the very same occurrence
423 -- before it gets propagated: once from the server, because this is
424 -- where the occurrence contents is elaborated and known, and then
425 -- once from the client when it detects the case and actually raises
426 -- the exception in its own context.
428 -- The Is_Setup_And_Not_Propagated predicate tells us when we are in
429 -- the second call to Setup for a Transferred occurrence, and there is
430 -- nothing to be done here in this situation. This predicate cannot be
431 -- True if we are dealing with a Reraise, and we may even be called
432 -- with a raw uninitialized Excep occurrence in this case so we should
433 -- not check anyway. Observe the front-end expansion for a "raise;" to
434 -- see that happening. We get a local occurrence and a direct call to
435 -- Save_Occurrence without the intermediate init-proc call.
437 if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
441 -- Allocate what will be the Private_Data block for the exception
444 GCC_Exception := new GNAT_GCC_Exception;
446 -- If the Top of the occurrence stack is not currently used for an
447 -- active exception (the stack is empty) we just need to setup the
448 -- Private_Data pointer.
450 -- Otherwise, we also need to shift the contents of the Top of the
451 -- stack in a freshly allocated entry and link everything together.
453 if Top.Private_Data /= System.Null_Address then
454 Next := new Exception_Occurrence;
455 Save_Occurrence_And_Private (Next.all, Top.all);
457 GCC_Exception.Next_Exception := Next;
458 Top.Private_Data := GCC_Exception.all'Address;
461 Top.Private_Data := GCC_Exception.all'Address;
463 Set_Setup_And_Not_Propagated (Top);
471 procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
473 -- Every necessary operation related to the occurrence stack has
474 -- already been performed by Propagate_Exception. This hook remains for
475 -- potential future necessity in optimizing the overall scheme, as well
476 -- a useful debugging tool.
485 procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
488 Removed := Remove (Get_Current_Excep.all, GCC_Exception);
489 pragma Assert (Removed);
492 -------------------------
493 -- Propagate_Exception --
494 -------------------------
496 -- Build an object suitable for the libgcc processing and call
497 -- Unwind_RaiseException to actually throw, taking care of handling
498 -- the two phase scheme it implements.
500 procedure Propagate_Exception (From_Signal_Handler : Boolean) is
501 Excep : EOA := Get_Current_Excep.all;
502 GCC_Exception : GNAT_GCC_Exception_Access;
505 pragma Assert (Excep.Private_Data /= System.Null_Address);
507 -- Retrieve the Private_Data for this occurrence and set the useful
508 -- flags for the personality routine, which will be called for each
509 -- frame via Unwind_RaiseException below.
511 GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
513 Clear_Setup_And_Not_Propagated (Excep);
515 GCC_Exception.Id := Excep.Id;
516 GCC_Exception.N_Cleanups_To_Trigger := 0;
518 -- Compute the backtrace for this occurrence if the corresponding
519 -- binder option has been set. Call_Chain takes care of the reraise
522 -- ??? Using Call_Chain here means we are going to walk up the stack
523 -- once only for backtracing purposes before doing it again for the
524 -- propagation per se.
526 -- The first inspection is much lighter, though, as it only requires
527 -- partial unwinding of each frame. Additionally, although we could use
528 -- the personality routine to record the addresses while propagating,
529 -- this method has two drawbacks:
531 -- 1) the trace is incomplete if the exception is handled since we
532 -- don't walk past the frame with the handler,
536 -- 2) we would miss the frames for which our personality routine is not
537 -- called, e.g. if C or C++ calls are on the way.
541 -- Perform a standard raise first. If a regular handler is found, it
542 -- will be entered after all the intermediate cleanups have run. If
543 -- there is no regular handler, control will get back to after the
544 -- call, with N_Cleanups_To_Trigger set to the number of frames with
545 -- cleanups found on the way up, and none of these already run.
547 Unwind_RaiseException (GCC_Exception);
549 -- If we get here we know the exception is not handled, as otherwise
550 -- Unwind_RaiseException arranges for the handler to be entered. Take
551 -- the necessary steps to enable the debugger to gain control while the
552 -- stack is still intact.
554 Notify_Unhandled_Exception;
556 -- Now, if cleanups have been found, run a forced unwind to trigger
557 -- them. Control should not resume there, as the unwinding hook calls
558 -- Unhandled_Exception_Terminate as soon as the last cleanup has been
561 if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
562 Unwind_ForcedUnwind (GCC_Exception,
563 CleanupUnwind_Handler'Address,
564 System.Null_Address);
567 -- We get here when there is no handler or cleanup to be run at
568 -- all. The debugger has been notified before the second step above.
570 Unhandled_Exception_Terminate;
571 end Propagate_Exception;
573 ---------------------------
574 -- Adjust_N_Cleanups_For --
575 ---------------------------
577 procedure Adjust_N_Cleanups_For
578 (GNAT_Exception : GNAT_GCC_Exception_Access;
579 Adjustment : Integer)
582 GNAT_Exception.N_Cleanups_To_Trigger :=
583 GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
584 end Adjust_N_Cleanups_For;
591 (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
594 return GNAT_Exception.Id;
597 ---------------------
598 -- Import_Code_For --
599 ---------------------
601 function Import_Code_For
602 (E : SSL.Exception_Data_Ptr) return Exception_Code
605 return E.all.Import_Code;
608 --------------------------
609 -- Is_Handled_By_Others --
610 --------------------------
612 function Is_Handled_By_Others
613 (E : SSL.Exception_Data_Ptr) return Boolean
616 return not E.all.Not_Handled_By_Others;
617 end Is_Handled_By_Others;
623 function Language_For
624 (E : SSL.Exception_Data_Ptr) return Character
634 -- The current model implemented for the stack of occurrences is a
635 -- simplification of previous attempts, which all prooved to be flawed or
636 -- would have needed significant additional circuitry to be made to work
639 -- We now represent every propagation by a new entry on the stack, which
640 -- means that an exception occurrence may appear more than once (e.g. when
641 -- it is reraised during the course of its own handler).
643 -- This may seem overcostly compared to the C++ model as implemented in
644 -- the g++ v3 libstd. This is actually understandable when one considers
645 -- the extra variations of possible run-time configurations induced by the
646 -- freedom offered by the Save_Occurrence/Reraise_Occurrence public
649 -- The basic point is that arranging for an occurrence to always appear at
650 -- most once on the stack requires a way to determine if a given occurence
651 -- is already there, which is not as easy as it might seem.
653 -- An attempt was made to use the Private_Data pointer for this purpose.
654 -- It did not work because:
656 -- 1) The Private_Data has to be saved by Save_Occurrence to be usable
657 -- as a key in case of a later reraise,
659 -- 2) There is no easy way to synchronize End_Handler for an occurrence
660 -- and the data attached to potential copies, so these copies may end
661 -- up pointing to stale data. Moreover ...
663 -- 3) The same address may be reused for different occurrences, which
664 -- defeats the idea of using it as a key.
666 -- The example below illustrates:
668 -- Saved_CE : Exception_Occurrence;
671 -- raise Constraint_Error;
673 -- when CE: others =>
674 -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
677 -- <= Saved_CE.PDA is stale (!)
680 -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
683 -- Reraise_Occurrence (Saved_CE);
686 -- Not releasing the Private_Data via End_Handler could be an option,
687 -- but making this to work while still avoiding memory leaks is far
690 -- The current scheme has the advantage of beeing simple, and induces
691 -- extra costs only in reraise cases which is acceptable.
693 end Exception_Propagation;