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-2011, 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);
79 type Unwind_Action is new Integer;
80 pragma Convention (C, Unwind_Action);
82 UA_SEARCH_PHASE : constant Unwind_Action := 1;
83 UA_CLEANUP_PHASE : constant Unwind_Action := 2;
84 UA_HANDLER_FRAME : constant Unwind_Action := 4;
85 UA_FORCE_UNWIND : constant Unwind_Action := 8;
86 UA_END_OF_STACK : constant Unwind_Action := 16; -- GCC extension ?
94 -- Mandatory common header for any exception object handled by the
95 -- GCC unwinding runtime.
97 type Exception_Class is mod 2 ** 64;
99 GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
102 type Unwind_Word is mod 2 ** System.Word_Size;
103 for Unwind_Word'Size use System.Word_Size;
104 -- Map the corresponding C type used in Unwind_Exception below
106 type Unwind_Exception is record
107 Class : Exception_Class;
108 Cleanup : System.Address;
109 Private1 : Unwind_Word;
110 Private2 : Unwind_Word;
112 pragma Convention (C, Unwind_Exception);
113 -- Map the GCC struct used for exception handling
115 for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
116 -- The C++ ABI mandates the common exception header to be at least
117 -- doubleword aligned, and the libGCC implementation actually makes it
118 -- maximally aligned (see unwind.h). See additional comments on the
121 type GCC_Exception_Access is access all Unwind_Exception;
122 -- Pointer to a GCC exception. Do not use convention C as on VMS this
123 -- would imply the use of 32-bits pointers.
125 procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access);
126 pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
127 -- Procedure to free any GCC exception
129 Foreign_Exception : aliased System.Standard_Library.Exception_Data;
130 pragma Import (Ada, Foreign_Exception,
131 "system__exceptions__foreign_exception");
132 -- Id for foreign exceptions
134 --------------------------------------------------------------
135 -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
136 --------------------------------------------------------------
138 -- A GNAT exception object to be dealt with by the personality routine
139 -- called by the GCC unwinding runtime.
141 type GNAT_GCC_Exception is record
142 Header : Unwind_Exception;
143 -- ABI Exception header first
145 Occurrence : Exception_Occurrence;
146 -- The Ada occurrence
149 pragma Convention (C, GNAT_GCC_Exception);
151 -- There is a subtle issue with the common header alignment, since the C
152 -- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
153 -- Standard'Maximum_Alignment, and those two values don't quite represent
154 -- the same concepts and so may be decoupled someday. One typical reason
155 -- is that BIGGEST_ALIGNMENT may be larger than what the underlying system
156 -- allocator guarantees, and there are extra costs involved in allocating
157 -- objects aligned to such factors.
159 -- To deal with the potential alignment differences between the C and Ada
160 -- representations, the Ada part of the whole structure is only accessed
161 -- by the personality routine through the accessors declared below. Ada
162 -- specific fields are thus always accessed through consistent layout, and
163 -- we expect the actual alignment to always be large enough to avoid traps
164 -- from the C accesses to the common header. Besides, accessors alleviate
165 -- the need for a C struct whole counterpart, both painful and error-prone
166 -- to maintain anyway.
168 type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
170 function To_GCC_Exception is new
171 Unchecked_Conversion (GNAT_GCC_Exception_Access, GCC_Exception_Access);
173 function To_GNAT_GCC_Exception is new
174 Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
176 procedure GNAT_GCC_Exception_Cleanup
177 (Reason : Unwind_Reason_Code;
178 Excep : not null GNAT_GCC_Exception_Access);
179 pragma Convention (C, GNAT_GCC_Exception_Cleanup);
180 -- Procedure called when a GNAT GCC exception is free.
182 procedure Propagate_GCC_Exception
183 (GCC_Exception : not null GCC_Exception_Access);
184 pragma No_Return (Propagate_GCC_Exception);
185 -- Propagate a GCC exception
187 procedure Reraise_GCC_Exception
188 (GCC_Exception : not null GCC_Exception_Access);
189 pragma No_Return (Reraise_GCC_Exception);
190 pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
191 -- Called to implement raise without exception, ie reraise. Called
192 -- directly from gigi.
194 procedure Setup_Current_Excep
195 (GCC_Exception : not null GCC_Exception_Access);
196 pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
197 -- Write Get_Current_Excep.all from GCC_Exception
199 function CleanupUnwind_Handler
200 (UW_Version : Integer;
201 UW_Phases : Unwind_Action;
202 UW_Eclass : Exception_Class;
203 UW_Exception : not null GCC_Exception_Access;
204 UW_Context : System.Address;
205 UW_Argument : System.Address) return Unwind_Reason_Code;
206 -- Hook called at each step of the forced unwinding we perform to
207 -- trigger cleanups found during the propagation of an unhandled
210 -- GCC runtime functions used. These are C non-void functions, actually,
211 -- but we ignore the return values. See raise.c as to why we are using
212 -- __gnat stubs for these.
214 procedure Unwind_RaiseException
215 (UW_Exception : not null GCC_Exception_Access);
216 pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
218 procedure Unwind_ForcedUnwind
219 (UW_Exception : not null GCC_Exception_Access;
220 UW_Handler : System.Address;
221 UW_Argument : System.Address);
222 pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
224 -- Hooks called when entering/leaving an exception handler for a given
225 -- occurrence, aimed at handling the stack of active occurrences. The
226 -- calls are generated by gigi in tree_transform/N_Exception_Handler.
228 procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
229 pragma Export (C, Begin_Handler, "__gnat_begin_handler");
231 procedure End_Handler (GCC_Exception : GCC_Exception_Access);
232 pragma Export (C, End_Handler, "__gnat_end_handler");
234 --------------------------------------------------------------------
235 -- Accessors to Basic Components of a GNAT Exception Data Pointer --
236 --------------------------------------------------------------------
238 -- As of today, these are only used by the C implementation of the GCC
239 -- propagation personality routine to avoid having to rely on a C
240 -- counterpart of the whole exception_data structure, which is both
241 -- painful and error prone. These subprograms could be moved to a more
242 -- widely visible location if need be.
244 function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
245 pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
246 pragma Warnings (Off, Is_Handled_By_Others);
248 function Language_For (E : Exception_Data_Ptr) return Character;
249 pragma Export (C, Language_For, "__gnat_language_for");
251 function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
252 pragma Export (C, Import_Code_For, "__gnat_import_code_for");
254 function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
256 pragma Export (C, EID_For, "__gnat_eid_for");
258 ---------------------------------------------------------------------------
259 -- Objects to materialize "others" and "all others" in the GCC EH tables --
260 ---------------------------------------------------------------------------
262 -- Currently, these only have their address taken and compared so there is
263 -- no real point having whole exception data blocks allocated. In any case
264 -- the types should match what gigi and the personality routine expect.
265 -- The initial value is an arbitrary value that will not exceed the range
266 -- of Integer on 16-bit targets (such as AAMP).
268 Others_Value : constant Integer := 16#7FFF#;
269 pragma Export (C, Others_Value, "__gnat_others_value");
271 All_Others_Value : constant Integer := 16#7FFF#;
272 pragma Export (C, All_Others_Value, "__gnat_all_others_value");
274 --------------------------------
275 -- GNAT_GCC_Exception_Cleanup --
276 --------------------------------
278 procedure GNAT_GCC_Exception_Cleanup
279 (Reason : Unwind_Reason_Code;
280 Excep : not null GNAT_GCC_Exception_Access)
282 pragma Unreferenced (Reason);
284 procedure Free is new Unchecked_Deallocation
285 (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
287 Copy : GNAT_GCC_Exception_Access := Excep;
290 -- Simply free the memory
293 end GNAT_GCC_Exception_Cleanup;
295 ---------------------------
296 -- CleanupUnwind_Handler --
297 ---------------------------
299 function CleanupUnwind_Handler
300 (UW_Version : Integer;
301 UW_Phases : Unwind_Action;
302 UW_Eclass : Exception_Class;
303 UW_Exception : not null GCC_Exception_Access;
304 UW_Context : System.Address;
305 UW_Argument : System.Address) return Unwind_Reason_Code
307 pragma Unreferenced (UW_Version, UW_Eclass, UW_Context, UW_Argument);
310 -- Terminate when the end of the stack is reached
312 if UW_Phases >= UA_END_OF_STACK then
313 Setup_Current_Excep (UW_Exception);
314 Unhandled_Exception_Terminate;
317 -- We know there is at least one cleanup further up. Return so that it
318 -- is searched and entered, after which Unwind_Resume will be called
319 -- and this hook will gain control again.
321 return URC_NO_REASON;
322 end CleanupUnwind_Handler;
324 -------------------------
325 -- Setup_Current_Excep --
326 -------------------------
328 procedure Setup_Current_Excep
329 (GCC_Exception : not null GCC_Exception_Access)
331 Excep : constant EOA := Get_Current_Excep.all;
334 -- Setup the exception occurrence
336 if GCC_Exception.Class = GNAT_Exception_Class then
338 -- From the GCC exception
341 GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
342 To_GNAT_GCC_Exception (GCC_Exception);
344 Excep.all := GNAT_Occurrence.Occurrence;
350 Excep.Id := Foreign_Exception'Access;
351 Excep.Msg_Length := 0;
352 Excep.Exception_Raised := True;
353 Excep.Pid := Local_Partition_ID;
354 Excep.Num_Tracebacks := 0;
356 end Setup_Current_Excep;
362 procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is
363 pragma Unreferenced (GCC_Exception);
372 procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
374 if GCC_Exception /= null then
376 -- The exception might have been reraised, in this case the cleanup
377 -- mustn't be called.
379 Unwind_DeleteException (GCC_Exception);
383 -----------------------------
384 -- Reraise_GCC_Exception --
385 -----------------------------
387 procedure Reraise_GCC_Exception
388 (GCC_Exception : not null GCC_Exception_Access)
391 -- Simply propagate it
392 Propagate_GCC_Exception (GCC_Exception);
393 end Reraise_GCC_Exception;
395 -----------------------------
396 -- Propagate_GCC_Exception --
397 -----------------------------
399 -- Call Unwind_RaiseException to actually throw, taking care of handling
400 -- the two phase scheme it implements.
402 procedure Propagate_GCC_Exception
403 (GCC_Exception : not null GCC_Exception_Access)
406 -- Perform a standard raise first. If a regular handler is found, it
407 -- will be entered after all the intermediate cleanups have run. If
408 -- there is no regular handler, it will return.
410 Unwind_RaiseException (GCC_Exception);
412 -- If we get here we know the exception is not handled, as otherwise
413 -- Unwind_RaiseException arranges for the handler to be entered. Take
414 -- the necessary steps to enable the debugger to gain control while the
415 -- stack is still intact.
417 Setup_Current_Excep (GCC_Exception);
418 Notify_Unhandled_Exception;
420 -- Now, un a forced unwind to trigger cleanups. Control should not
421 -- resume there, if there are cleanups and in any cases as the
422 -- unwinding hook calls Unhandled_Exception_Terminate when end of
425 Unwind_ForcedUnwind (GCC_Exception,
426 CleanupUnwind_Handler'Address,
427 System.Null_Address);
429 -- We get here in case of error. The debugger has been notified before
430 -- the second step above.
432 Setup_Current_Excep (GCC_Exception);
433 Unhandled_Exception_Terminate;
434 end Propagate_GCC_Exception;
436 -------------------------
437 -- Propagate_Exception --
438 -------------------------
440 -- Build an object suitable for the libgcc processing and call
441 -- Unwind_RaiseException to actually do the raise, taking care of
442 -- handling the two phase scheme it implements.
444 procedure Propagate_Exception is
445 Excep : constant EOA := Get_Current_Excep.all;
446 GCC_Exception : GNAT_GCC_Exception_Access;
449 -- Compute the backtrace for this occurrence if the corresponding
450 -- binder option has been set. Call_Chain takes care of the reraise
453 -- ??? Using Call_Chain here means we are going to walk up the stack
454 -- once only for backtracing purposes before doing it again for the
455 -- propagation per se.
457 -- The first inspection is much lighter, though, as it only requires
458 -- partial unwinding of each frame. Additionally, although we could use
459 -- the personality routine to record the addresses while propagating,
460 -- this method has two drawbacks:
462 -- 1) the trace is incomplete if the exception is handled since we
463 -- don't walk past the frame with the handler,
467 -- 2) we would miss the frames for which our personality routine is not
468 -- called, e.g. if C or C++ calls are on the way.
472 -- Allocate the GCC exception
475 new GNAT_GCC_Exception'
476 (Header => (Class => GNAT_Exception_Class,
477 Cleanup => GNAT_GCC_Exception_Cleanup'Address,
480 Occurrence => Excep.all);
484 Propagate_GCC_Exception (To_GCC_Exception (GCC_Exception));
485 end Propagate_Exception;
492 (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
495 return GNAT_Exception.Occurrence.Id;
498 ---------------------
499 -- Import_Code_For --
500 ---------------------
502 function Import_Code_For
503 (E : SSL.Exception_Data_Ptr) return Exception_Code
506 return E.all.Import_Code;
509 --------------------------
510 -- Is_Handled_By_Others --
511 --------------------------
513 function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
515 return not E.all.Not_Handled_By_Others;
516 end Is_Handled_By_Others;
522 function Language_For (E : SSL.Exception_Data_Ptr) return Character is
527 end Exception_Propagation;