1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- ADA.EXCEPTIONS.EXCEPTION_PROPAGATION --
9 -- Copyright (C) 1992-2003 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 pragma Warnings
(Off
);
40 -- Since several constructs give warnings in 3.14a1, including unreferenced
41 -- variables and pragma Unreferenced itself.
43 separate (Ada
.Exceptions
)
44 package body Exception_Propagation
is
46 ------------------------------------------------
47 -- Entities to interface with the GCC runtime --
48 ------------------------------------------------
50 -- These come from "C++ ABI for Itanium: Exception handling", which is
51 -- the reference for GCC. They are used only when we are relying on
52 -- back-end tables for exception propagation, which in turn is currenly
53 -- only the case for Zero_Cost_Exceptions in GNAT5.
55 -- Return codes from the GCC runtime functions used to propagate
58 type Unwind_Reason_Code
is
60 URC_FOREIGN_EXCEPTION_CAUGHT
,
70 (URC_FOREIGN_EXCEPTION_CAUGHT
,
79 pragma Convention
(C
, Unwind_Reason_Code
);
90 (UA_SEARCH_PHASE
=> 1,
91 UA_CLEANUP_PHASE
=> 2,
92 UA_HANDLER_FRAME
=> 4,
93 UA_FORCE_UNWIND
=> 8);
95 pragma Convention
(C
, Unwind_Action
);
97 -- Mandatory common header for any exception object handled by the
98 -- GCC unwinding runtime.
100 subtype Exception_Class
is Interfaces
.Unsigned_64
;
102 GNAT_Exception_Class
: constant Exception_Class
:= 16#
474e552d41646100#
;
105 type Unwind_Exception
is record
106 Class
: Exception_Class
:= GNAT_Exception_Class
;
107 Cleanup
: System
.Address
:= System
.Null_Address
;
112 pragma Convention
(C
, Unwind_Exception
);
114 for Unwind_Exception
'Alignment use Standard
'Maximum_Alignment;
115 -- The C++ ABI mandates the common exception header to be at least
116 -- doubleword aligned, and the libGCC implementation actually makes it
117 -- maximally aligned (see unwind.h). We need to match this because:
119 -- 1/ We pass pointers to such headers down to the underlying
124 -- 2/ The GNAT_GCC_Exception record below starts with this common
125 -- common header and has a C counterpart which needs to be laid
126 -- out identically in raise.c. If the alignment of the C and Ada
127 -- common headers mismatch, their size may also differ, and the
128 -- layouts may not match anymore.
130 ---------------------------------------------------------------
131 -- GNAT specific entities to deal with the GCC eh circuitry --
132 ---------------------------------------------------------------
134 -- A GNAT exception object to be dealt with by the personality routine
135 -- called by the GCC unwinding runtime. This structure shall match the
136 -- one in raise.c and is currently experimental as it might be merged
137 -- with the GNAT runtime definition some day.
139 type GNAT_GCC_Exception
is record
140 Header
: Unwind_Exception
;
141 -- ABI Exception header first.
144 -- GNAT Exception identifier. This is used by the personality
145 -- routine to determine if the context it examines contains a
146 -- handler for the exception beeing propagated.
148 Handled_By_Others
: Boolean;
149 -- Is this exception handled by "when others" ? This is used by the
150 -- personality routine to determine if an "others" handler in the
151 -- context it examines may catch the exception beeing propagated.
153 N_Cleanups_To_Trigger
: Integer;
154 -- Number of cleanup only frames encountered in SEARCH phase.
155 -- This is used to control the forced unwinding triggered when
156 -- no handler has been found.
158 Next_Exception
: EOA
;
159 -- Used to create a linked list of exception occurrences.
162 pragma Convention
(C
, GNAT_GCC_Exception
);
164 type GNAT_GCC_Exception_Access
is access all GNAT_GCC_Exception
;
166 function To_GNAT_GCC_Exception
is new
167 Unchecked_Conversion
(System
.Address
, GNAT_GCC_Exception_Access
);
169 procedure Free
is new Unchecked_Deallocation
170 (GNAT_GCC_Exception
, GNAT_GCC_Exception_Access
);
172 procedure Free
is new Unchecked_Deallocation
173 (Exception_Occurrence
, EOA
);
177 Excep
: GNAT_GCC_Exception_Access
)
179 -- Remove Excep from the stack starting at Top.
180 -- Return True if Excep was found and removed, false otherwise.
182 -- Hooks called when entering/leaving an exception handler for a given
183 -- occurrence, aimed at handling the stack of active occurrences. The
184 -- calls are generated by gigi in tree_transform/N_Exception_Handler.
186 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
187 pragma Export
(C
, Begin_Handler
, "__gnat_begin_handler");
189 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
);
190 pragma Export
(C
, End_Handler
, "__gnat_end_handler");
192 function CleanupUnwind_Handler
193 (UW_Version
: Integer;
194 UW_Phases
: Unwind_Action
;
195 UW_Eclass
: Exception_Class
;
196 UW_Exception
: access GNAT_GCC_Exception
;
197 UW_Context
: System
.Address
;
198 UW_Argument
: System
.Address
)
199 return Unwind_Reason_Code
;
200 -- Hook called at each step of the forced unwinding we perform to
201 -- trigger cleanups found during the propagation of an unhandled
204 -- GCC runtime functions used. These are C non-void functions, actually,
205 -- but we ignore the return values. See raise.c as to why we are using
206 -- __gnat stubs for these.
208 procedure Unwind_RaiseException
209 (UW_Exception
: access GNAT_GCC_Exception
);
210 pragma Import
(C
, Unwind_RaiseException
, "__gnat_Unwind_RaiseException");
212 procedure Unwind_ForcedUnwind
213 (UW_Exception
: access GNAT_GCC_Exception
;
214 UW_Handler
: System
.Address
;
215 UW_Argument
: System
.Address
);
216 pragma Import
(C
, Unwind_ForcedUnwind
, "__gnat_Unwind_ForcedUnwind");
224 Excep
: GNAT_GCC_Exception_Access
)
227 Prev
: GNAT_GCC_Exception_Access
:= null;
229 GCC_Exception
: GNAT_GCC_Exception_Access
;
235 pragma Assert
(Iter
.Private_Data
/= System
.Null_Address
);
237 GCC_Exception
:= To_GNAT_GCC_Exception
(Iter
.Private_Data
);
239 if GCC_Exception
= Excep
then
242 -- Special case for the top of the stack: shift the contents
243 -- of the next item to the top, since top is at a fixed
244 -- location and can't be changed.
246 Iter
:= GCC_Exception
.Next_Exception
;
250 -- Stack is now empty
252 Top
.Private_Data
:= System
.Null_Address
;
255 Save_Occurrence_And_Private
(Top
.all, Iter
.all);
260 Prev
.Next_Exception
:= GCC_Exception
.Next_Exception
;
264 Free
(GCC_Exception
);
269 exit when GCC_Exception
.Next_Exception
= null;
271 Prev
:= GCC_Exception
;
272 Iter
:= GCC_Exception
.Next_Exception
;
278 ---------------------------
279 -- CleanupUnwind_Handler --
280 ---------------------------
282 function CleanupUnwind_Handler
283 (UW_Version
: Integer;
284 UW_Phases
: Unwind_Action
;
285 UW_Eclass
: Exception_Class
;
286 UW_Exception
: access GNAT_GCC_Exception
;
287 UW_Context
: System
.Address
;
288 UW_Argument
: System
.Address
)
289 return Unwind_Reason_Code
292 -- Terminate as soon as we know there is nothing more to run. The
293 -- count is maintained by the personality routine.
295 if UW_Exception
.N_Cleanups_To_Trigger
= 0 then
296 Unhandled_Exception_Terminate
;
299 -- We know there is at least one cleanup further up. Return so that it
300 -- is searched and entered, after which Unwind_Resume will be called
301 -- and this hook will gain control (with an updated count) again.
303 return URC_NO_REASON
;
304 end CleanupUnwind_Handler
;
306 ---------------------
307 -- Setup_Exception --
308 ---------------------
310 -- Push the current exception occurrence on the stack before overriding it.
312 procedure Setup_Exception
315 Reraised
: Boolean := False)
317 Top
: constant EOA
:= Current
;
319 GCC_Exception
: GNAT_GCC_Exception_Access
;
321 -- Note that we make no use of the Reraised indication at this point.
323 -- The information is still passed around just in case of future needs,
324 -- since we've already switched between using/not-using it a number of
328 -- If the current exception is not live, the stack is empty and there
329 -- is nothing to do. Note that the stack always appears empty for
330 -- mechanisms that do not require one. For the mechanism we implement
331 -- in this unit, the initial Private_Data allocation for an occurrence
332 -- is issued by Propagate_Exception.
334 if Top
.Private_Data
= System
.Null_Address
then
338 -- Shift the contents of the Top of the stack in a freshly allocated
339 -- entry, which leaves the room in the fixed Top entry available for the
340 -- occurrence about to be propagated.
342 Next
:= new Exception_Occurrence
;
343 Save_Occurrence_And_Private
(Next
.all, Top
.all);
345 -- Allocate Private_Data for the occurrence about to be propagated
346 -- and link everything together.
348 GCC_Exception
:= new GNAT_GCC_Exception
;
349 GCC_Exception
.Next_Exception
:= Next
;
351 Top
.Private_Data
:= GCC_Exception
.all'Address;
359 procedure Begin_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
361 -- Every necessary operation related to the occurrence stack has
362 -- already been performed by Propagate_Exception. This hook remains for
363 -- potential future necessity in optimizing the overall scheme, as well
364 -- a useful debugging tool.
372 procedure End_Handler
(GCC_Exception
: GNAT_GCC_Exception_Access
) is
376 Removed
:= Remove
(Get_Current_Excep
.all, GCC_Exception
);
377 pragma Assert
(Removed
);
380 -------------------------
381 -- Propagate_Exception --
382 -------------------------
384 -- Build an object suitable for the libgcc processing and call
385 -- Unwind_RaiseException to actually throw, taking care of handling
386 -- the two phase scheme it implements.
388 procedure Propagate_Exception
(From_Signal_Handler
: Boolean) is
389 Excep
: EOA
:= Get_Current_Excep
.all;
390 GCC_Exception
: GNAT_GCC_Exception_Access
;
393 if Excep
.Private_Data
= System
.Null_Address
then
394 GCC_Exception
:= new GNAT_GCC_Exception
;
395 Excep
.Private_Data
:= GCC_Exception
.all'Address;
397 GCC_Exception
:= To_GNAT_GCC_Exception
(Excep
.Private_Data
);
400 -- Fill in the useful flags for the personality routine called for each
401 -- frame via Unwind_RaiseException below.
403 GCC_Exception
.Id
:= Excep
.Id
;
404 GCC_Exception
.Handled_By_Others
:= not Excep
.Id
.Not_Handled_By_Others
;
405 GCC_Exception
.N_Cleanups_To_Trigger
:= 0;
407 -- Compute the backtrace for this occurrence if the corresponding
408 -- binder option has been set. Call_Chain takes care of the reraise
411 -- ??? Using Call_Chain here means we are going to walk up the stack
412 -- once only for backtracing purposes before doing it again for the
413 -- propagation per se.
415 -- The first inspection is much lighter, though, as it only requires
416 -- partial unwinding of each frame. Additionally, although we could use
417 -- the personality routine to record the addresses while propagating,
418 -- this method has two drawbacks:
420 -- 1) the trace is incomplete if the exception is handled since we
421 -- don't walk past the frame with the handler,
425 -- 2) we would miss the frames for which our personality routine is not
426 -- called, e.g. if C or C++ calls are on the way.
430 -- Perform a standard raise first. If a regular handler is found, it
431 -- will be entered after all the intermediate cleanups have run. If
432 -- there is no regular handler, control will get back to after the
433 -- call, with N_Cleanups_To_Trigger set to the number of frames with
434 -- cleanups found on the way up, and none of these already run.
436 Unwind_RaiseException
(GCC_Exception
);
438 -- If we get here we know the exception is not handled, as otherwise
439 -- Unwind_RaiseException arranges for the handler to be entered. Take
440 -- the necessary steps to enable the debugger to gain control while the
441 -- stack is still intact.
443 Notify_Unhandled_Exception
;
445 -- Now, if cleanups have been found, run a forced unwind to trigger
446 -- them. Control should not resume there, as the unwinding hook calls
447 -- Unhandled_Exception_Terminate as soon as the last cleanup has been
450 if GCC_Exception
.N_Cleanups_To_Trigger
/= 0 then
451 Unwind_ForcedUnwind
(GCC_Exception
,
452 CleanupUnwind_Handler
'Address,
453 System
.Null_Address
);
456 -- We get here when there is no handler or cleanup to be run at
457 -- all. The debugger has been notified before the second step above.
459 Unhandled_Exception_Terminate
;
460 end Propagate_Exception
;
466 -- The current model implemented for the stack of occurrences is a
467 -- simplification of previous attempts, which all prooved to be flawed or
468 -- would have needed significant additional circuitry to be made to work
471 -- We now represent every propagation by a new entry on the stack, which
472 -- means that an exception occurrence may appear more than once (e.g. when
473 -- it is reraised during the course of its own handler).
475 -- This may seem overcostly compared to the C++ model as implemented in
476 -- the g++ v3 libstd. This is actually understandable when one considers
477 -- the extra variations of possible run-time configurations induced by the
478 -- freedom offered by the Save_Occurrence/Reraise_Occurrence public
481 -- The basic point is that arranging for an occurrence to always appear at
482 -- most once on the stack requires a way to determine if a given occurence
483 -- is already there, which is not as easy as it might seem.
485 -- An attempt was made to use the Private_Data pointer for this purpose.
486 -- It did not work because:
488 -- 1/ The Private_Data has to be saved by Save_Occurrence to be usable
489 -- as a key in case of a later reraise,
491 -- 2/ There is no easy way to synchronize End_Handler for an occurrence
492 -- and the data attached to potential copies, so these copies may end
493 -- up pointing to stale data. Moreover ...
495 -- 3/ The same address may be reused for different occurrences, which
496 -- defeats the idea of using it as a key.
498 -- The example below illustrates:
500 -- Saved_CE : Exception_Occurrence;
503 -- raise Constraint_Error;
505 -- when CE: others =>
506 -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
509 -- <= Saved_CE.PDA is stale (!)
512 -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
515 -- Reraise_Occurrence (Saved_CE);
518 -- Not releasing the Private_Data via End_Handler could be an option,
519 -- but making this to work while still avoiding memory leaks is far
522 -- The current scheme has the advantage of beeing simple, and induces
523 -- extra costs only in reraise cases which is acceptable.
525 end Exception_Propagation
;