|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
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 --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
131
|
32 -- This is the version using the GCC EH mechanism, which could rely on
|
|
|
33 -- different underlying unwinding engines, for example DWARF or ARM unwind
|
|
|
34 -- info based. Here is a sketch of the most prominent data structures
|
|
|
35 -- involved:
|
|
|
36
|
|
|
37 -- (s-excmac.ads)
|
|
|
38 -- GNAT_GCC_Exception:
|
|
|
39 -- *-----------------------------------*
|
|
|
40 -- o-->| (s-excmac.ads) |
|
|
|
41 -- | | Header : <gcc occurrence type> |
|
|
|
42 -- | | - Class |
|
|
|
43 -- | | ... | Constraint_Error:
|
|
|
44 -- | |-----------------------------------* Program_Error:
|
|
|
45 -- | | (a-except.ads) | Foreign_Exception:
|
|
|
46 -- | | Occurrence : Exception_Occurrence |
|
|
|
47 -- | | | (s-stalib. ads)
|
|
|
48 -- | | - Id : Exception_Id --------------> Exception_Data
|
|
|
49 -- o------ - Machine_Occurrence | *------------------------*
|
|
|
50 -- | - Msg | | Not_Handled_By_Others |
|
|
|
51 -- | - Traceback | | Lang |
|
|
|
52 -- | ... | | Foreign_Data --o |
|
|
|
53 -- *-----------------------------------* | Full_Name | |
|
|
|
54 -- || | ... | |
|
|
|
55 -- || foreign rtti blob *----------------|-------*
|
|
|
56 -- || *---------------* |
|
|
|
57 -- || | ... ... |<-------------------------o
|
|
|
58 -- || *---------------*
|
|
|
59 -- ||
|
|
|
60 -- Setup_Current_Excep()
|
|
|
61 -- ||
|
|
|
62 -- || Latch into ATCB or
|
|
|
63 -- || environment Current Exception Buffer:
|
|
|
64 -- ||
|
|
|
65 -- vv
|
|
|
66 -- <> : Exception_Occurrence
|
|
|
67 -- *---------------------------*
|
|
|
68 -- | ... ... ... ... ... ... * --- Get_Current_Excep() ---->
|
|
|
69 -- *---------------------------*
|
|
|
70
|
|
|
71 -- On "raise" events, the runtime allocates a new GNAT_GCC_Exception
|
|
|
72 -- instance and eventually calls into libgcc's Unwind_RaiseException.
|
|
|
73 -- This part handles the object through the header part only.
|
|
|
74
|
|
|
75 -- During execution, Get_Current_Excep provides a pointer to the
|
|
|
76 -- Exception_Occurrence being raised or last raised by the current task.
|
|
|
77
|
|
|
78 -- This is actually the address of a statically allocated
|
|
|
79 -- Exception_Occurrence attached to the current ATCB or to the environment
|
|
|
80 -- thread into which an occurrence being raised is synchronized at critical
|
|
|
81 -- points during the raise process, via Setup_Current_Excep.
|
|
111
|
82
|
|
|
83 with Ada.Unchecked_Conversion;
|
|
|
84 with Ada.Unchecked_Deallocation;
|
|
|
85
|
|
|
86 with System.Storage_Elements; use System.Storage_Elements;
|
|
|
87 with System.Exceptions.Machine; use System.Exceptions.Machine;
|
|
|
88
|
|
|
89 separate (Ada.Exceptions)
|
|
|
90 package body Exception_Propagation is
|
|
|
91
|
|
|
92 use Exception_Traces;
|
|
|
93
|
|
|
94 Foreign_Exception : aliased System.Standard_Library.Exception_Data;
|
|
|
95 pragma Import (Ada, Foreign_Exception,
|
|
|
96 "system__exceptions__foreign_exception");
|
|
|
97 -- Id for foreign exceptions
|
|
|
98
|
|
|
99 --------------------------------------------------------------
|
|
|
100 -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
|
|
|
101 --------------------------------------------------------------
|
|
|
102
|
|
131
|
103 -- Phase identifiers (Unwind Actions)
|
|
|
104
|
|
|
105 type Unwind_Action is new Integer;
|
|
|
106 pragma Convention (C, Unwind_Action);
|
|
|
107
|
|
|
108 UA_SEARCH_PHASE : constant Unwind_Action := 1;
|
|
|
109 UA_CLEANUP_PHASE : constant Unwind_Action := 2;
|
|
|
110 UA_HANDLER_FRAME : constant Unwind_Action := 4;
|
|
|
111 UA_FORCE_UNWIND : constant Unwind_Action := 8;
|
|
|
112 UA_END_OF_STACK : constant Unwind_Action := 16; -- GCC extension
|
|
|
113
|
|
|
114 pragma Unreferenced
|
|
|
115 (UA_HANDLER_FRAME,
|
|
|
116 UA_FORCE_UNWIND,
|
|
|
117 UA_END_OF_STACK);
|
|
|
118
|
|
111
|
119 procedure GNAT_GCC_Exception_Cleanup
|
|
|
120 (Reason : Unwind_Reason_Code;
|
|
|
121 Excep : not null GNAT_GCC_Exception_Access);
|
|
|
122 pragma Convention (C, GNAT_GCC_Exception_Cleanup);
|
|
|
123 -- Procedure called when a GNAT GCC exception is free.
|
|
|
124
|
|
|
125 procedure Propagate_GCC_Exception
|
|
|
126 (GCC_Exception : not null GCC_Exception_Access);
|
|
|
127 pragma No_Return (Propagate_GCC_Exception);
|
|
|
128 -- Propagate a GCC exception
|
|
|
129
|
|
|
130 procedure Reraise_GCC_Exception
|
|
|
131 (GCC_Exception : not null GCC_Exception_Access);
|
|
|
132 pragma No_Return (Reraise_GCC_Exception);
|
|
|
133 pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
|
|
|
134 -- Called to implement raise without exception, ie reraise. Called
|
|
|
135 -- directly from gigi.
|
|
|
136
|
|
|
137 function Setup_Current_Excep
|
|
131
|
138 (GCC_Exception : not null GCC_Exception_Access;
|
|
|
139 Phase : Unwind_Action) return EOA;
|
|
111
|
140 pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
|
|
131
|
141 -- Acknowledge GCC_Exception as the current exception object being
|
|
|
142 -- raised, which could be an Ada or a foreign exception object. Return
|
|
|
143 -- a pointer to the embedded Ada occurrence for an Ada exception object,
|
|
|
144 -- to the current exception buffer otherwise.
|
|
|
145 --
|
|
|
146 -- Synchronize the current exception buffer as needed for possible
|
|
|
147 -- accesses through Get_Current_Except.all afterwards, depending on the
|
|
|
148 -- Phase bits, received either from the personality routine, from a
|
|
|
149 -- forced_unwind cleanup handler, or just before the start of propagation
|
|
|
150 -- for an Ada exception (Phase 0 in this case).
|
|
111
|
151
|
|
|
152 procedure Unhandled_Except_Handler
|
|
|
153 (GCC_Exception : not null GCC_Exception_Access);
|
|
|
154 pragma No_Return (Unhandled_Except_Handler);
|
|
|
155 pragma Export (C, Unhandled_Except_Handler,
|
|
|
156 "__gnat_unhandled_except_handler");
|
|
|
157 -- Called for handle unhandled exceptions, ie the last chance handler
|
|
|
158 -- on platforms (such as SEH) that never returns after throwing an
|
|
|
159 -- exception. Called directly by gigi.
|
|
|
160
|
|
|
161 function CleanupUnwind_Handler
|
|
|
162 (UW_Version : Integer;
|
|
|
163 UW_Phases : Unwind_Action;
|
|
|
164 UW_Eclass : Exception_Class;
|
|
|
165 UW_Exception : not null GCC_Exception_Access;
|
|
|
166 UW_Context : System.Address;
|
|
|
167 UW_Argument : System.Address) return Unwind_Reason_Code;
|
|
|
168 pragma Import (C, CleanupUnwind_Handler,
|
|
|
169 "__gnat_cleanupunwind_handler");
|
|
|
170 -- Hook called at each step of the forced unwinding we perform to trigger
|
|
|
171 -- cleanups found during the propagation of an unhandled exception.
|
|
|
172
|
|
|
173 -- GCC runtime functions used. These are C non-void functions, actually,
|
|
|
174 -- but we ignore the return values. See raise.c as to why we are using
|
|
|
175 -- __gnat stubs for these.
|
|
|
176
|
|
|
177 procedure Unwind_RaiseException
|
|
|
178 (UW_Exception : not null GCC_Exception_Access);
|
|
|
179 pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
|
|
|
180
|
|
|
181 procedure Unwind_ForcedUnwind
|
|
|
182 (UW_Exception : not null GCC_Exception_Access;
|
|
|
183 UW_Handler : System.Address;
|
|
|
184 UW_Argument : System.Address);
|
|
|
185 pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
|
|
|
186
|
|
|
187 procedure Set_Exception_Parameter
|
|
|
188 (Excep : EOA;
|
|
|
189 GCC_Exception : not null GCC_Exception_Access);
|
|
|
190 pragma Export
|
|
|
191 (C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
|
|
|
192 -- Called inserted by gigi to set the exception choice parameter from the
|
|
|
193 -- gcc occurrence.
|
|
|
194
|
|
|
195 procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
|
|
|
196 -- Utility routine to initialize occurrence Excep from a foreign exception
|
|
|
197 -- whose machine occurrence is Mo. The message is empty, the backtrace
|
|
|
198 -- is empty too and the exception identity is Foreign_Exception.
|
|
|
199
|
|
145
|
200 -- Hooks called when entering/leaving an exception handler for a
|
|
|
201 -- given occurrence. The calls are generated by gigi in
|
|
|
202 -- Exception_Handler_to_gnu_gcc.
|
|
|
203
|
|
|
204 -- Begin_Handler_v1, called when entering an exception handler,
|
|
|
205 -- claims responsibility for the handler to release the
|
|
|
206 -- GCC_Exception occurrence. End_Handler_v1, called when
|
|
|
207 -- leaving the handler, releases the occurrence, unless the
|
|
|
208 -- occurrence is propagating further up, or the handler is
|
|
|
209 -- dynamically nested in the context of another handler that
|
|
|
210 -- claimed responsibility for releasing that occurrence.
|
|
|
211
|
|
|
212 -- Responsibility is claimed by changing the Cleanup field to
|
|
|
213 -- Claimed_Cleanup, which enables claimed exceptions to be
|
|
|
214 -- recognized, and avoids accidental releases even by foreign
|
|
|
215 -- handlers.
|
|
|
216
|
|
|
217 function Begin_Handler_v1
|
|
|
218 (GCC_Exception : not null GCC_Exception_Access)
|
|
|
219 return System.Address;
|
|
|
220 pragma Export (C, Begin_Handler_v1, "__gnat_begin_handler_v1");
|
|
|
221 -- Called when entering an exception handler. Claim
|
|
|
222 -- responsibility for releasing GCC_Exception, by setting the
|
|
|
223 -- cleanup/release function to Claimed_Cleanup, and return the
|
|
|
224 -- address of the previous cleanup/release function.
|
|
|
225
|
|
|
226 procedure End_Handler_v1
|
|
|
227 (GCC_Exception : not null GCC_Exception_Access;
|
|
|
228 Saved_Cleanup : System.Address;
|
|
|
229 Propagating_Exception : GCC_Exception_Access);
|
|
|
230 pragma Export (C, End_Handler_v1, "__gnat_end_handler_v1");
|
|
|
231 -- Called when leaving an exception handler. Restore the
|
|
|
232 -- Saved_Cleanup in the GCC_Exception occurrence, and then release
|
|
|
233 -- it, unless it remains claimed by an enclosing handler, or
|
|
|
234 -- GCC_Exception and Propagating_Exception are the same
|
|
|
235 -- occurrence. Propagating_Exception could be either an
|
|
|
236 -- occurrence (re)raised within the handler of GCC_Exception, when
|
|
|
237 -- we're executing as an exceptional cleanup, or null, if we're
|
|
|
238 -- completing the handler of GCC_Exception normally.
|
|
|
239
|
|
|
240 procedure Claimed_Cleanup
|
|
|
241 (Reason : Unwind_Reason_Code;
|
|
|
242 GCC_Exception : not null GCC_Exception_Access);
|
|
|
243 pragma Export (C, Claimed_Cleanup, "__gnat_claimed_cleanup");
|
|
|
244 -- A do-nothing placeholder installed as GCC_Exception.Cleanup
|
|
|
245 -- while handling GCC_Exception, to claim responsibility for
|
|
|
246 -- releasing it, and to stop it from being accidentally released.
|
|
|
247
|
|
|
248 -- The following are version 0 implementations of the version 1
|
|
|
249 -- hooks above. They remain in place for compatibility with the
|
|
|
250 -- output of compilers that still use version 0, such as those
|
|
|
251 -- used during bootstrap. They are interoperable with the v1
|
|
|
252 -- hooks, except that the older versions may malfunction when
|
|
|
253 -- handling foreign exceptions passed to Reraise_Occurrence.
|
|
111
|
254
|
|
|
255 procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
|
|
|
256 pragma Export (C, Begin_Handler, "__gnat_begin_handler");
|
|
145
|
257 -- Called when entering an exception handler translated by an old
|
|
|
258 -- compiler. It does nothing.
|
|
111
|
259
|
|
|
260 procedure End_Handler (GCC_Exception : GCC_Exception_Access);
|
|
|
261 pragma Export (C, End_Handler, "__gnat_end_handler");
|
|
145
|
262 -- Called when leaving an exception handler translated by an old
|
|
|
263 -- compiler. It releases GCC_Exception, unless it is null. It is
|
|
|
264 -- only ever null when the handler has a 'raise;' translated by a
|
|
|
265 -- v0-using compiler. The artificial handler variable passed to
|
|
|
266 -- End_Handler was set to null to tell End_Handler to refrain from
|
|
|
267 -- releasing the reraised exception. In v1 safer ways are used to
|
|
|
268 -- accomplish that.
|
|
111
|
269
|
|
|
270 --------------------------------------------------------------------
|
|
|
271 -- Accessors to Basic Components of a GNAT Exception Data Pointer --
|
|
|
272 --------------------------------------------------------------------
|
|
|
273
|
|
|
274 -- As of today, these are only used by the C implementation of the GCC
|
|
|
275 -- propagation personality routine to avoid having to rely on a C
|
|
|
276 -- counterpart of the whole exception_data structure, which is both
|
|
|
277 -- painful and error prone. These subprograms could be moved to a more
|
|
|
278 -- widely visible location if need be.
|
|
|
279
|
|
|
280 function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
|
|
|
281 pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
|
|
|
282 pragma Warnings (Off, Is_Handled_By_Others);
|
|
|
283
|
|
|
284 function Language_For (E : Exception_Data_Ptr) return Character;
|
|
|
285 pragma Export (C, Language_For, "__gnat_language_for");
|
|
|
286
|
|
|
287 function Foreign_Data_For (E : Exception_Data_Ptr) return Address;
|
|
|
288 pragma Export (C, Foreign_Data_For, "__gnat_foreign_data_for");
|
|
|
289
|
|
|
290 function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
|
|
|
291 return Exception_Id;
|
|
|
292 pragma Export (C, EID_For, "__gnat_eid_for");
|
|
|
293
|
|
|
294 ---------------------------------------------------------------------------
|
|
|
295 -- Objects to materialize "others" and "all others" in the GCC EH tables --
|
|
|
296 ---------------------------------------------------------------------------
|
|
|
297
|
|
|
298 -- Currently, these only have their address taken and compared so there is
|
|
|
299 -- no real point having whole exception data blocks allocated. Note that
|
|
|
300 -- there are corresponding declarations in gigi (trans.c) which must be
|
|
|
301 -- kept properly synchronized.
|
|
|
302
|
|
|
303 Others_Value : constant Character := 'O';
|
|
|
304 pragma Export (C, Others_Value, "__gnat_others_value");
|
|
|
305
|
|
|
306 All_Others_Value : constant Character := 'A';
|
|
|
307 pragma Export (C, All_Others_Value, "__gnat_all_others_value");
|
|
|
308
|
|
|
309 Unhandled_Others_Value : constant Character := 'U';
|
|
|
310 pragma Export (C, Unhandled_Others_Value, "__gnat_unhandled_others_value");
|
|
|
311 -- Special choice (emitted by gigi) to catch and notify unhandled
|
|
|
312 -- exceptions on targets which always handle exceptions (such as SEH).
|
|
|
313 -- The handler will simply call Unhandled_Except_Handler.
|
|
|
314
|
|
|
315 -------------------------
|
|
|
316 -- Allocate_Occurrence --
|
|
|
317 -------------------------
|
|
|
318
|
|
|
319 function Allocate_Occurrence return EOA is
|
|
|
320 Res : GNAT_GCC_Exception_Access;
|
|
|
321
|
|
|
322 begin
|
|
|
323 Res := New_Occurrence;
|
|
|
324 Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address;
|
|
|
325 Res.Occurrence.Machine_Occurrence := Res.all'Address;
|
|
|
326
|
|
|
327 return Res.Occurrence'Access;
|
|
|
328 end Allocate_Occurrence;
|
|
|
329
|
|
|
330 --------------------------------
|
|
|
331 -- GNAT_GCC_Exception_Cleanup --
|
|
|
332 --------------------------------
|
|
|
333
|
|
|
334 procedure GNAT_GCC_Exception_Cleanup
|
|
|
335 (Reason : Unwind_Reason_Code;
|
|
|
336 Excep : not null GNAT_GCC_Exception_Access)
|
|
|
337 is
|
|
|
338 pragma Unreferenced (Reason);
|
|
|
339
|
|
|
340 procedure Free is new Unchecked_Deallocation
|
|
|
341 (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
|
|
|
342
|
|
|
343 Copy : GNAT_GCC_Exception_Access := Excep;
|
|
|
344
|
|
|
345 begin
|
|
|
346 -- Simply free the memory
|
|
|
347
|
|
|
348 Free (Copy);
|
|
|
349 end GNAT_GCC_Exception_Cleanup;
|
|
|
350
|
|
|
351 ----------------------------
|
|
|
352 -- Set_Foreign_Occurrence --
|
|
|
353 ----------------------------
|
|
|
354
|
|
|
355 procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
|
|
|
356 begin
|
|
|
357 Excep.all := (
|
|
|
358 Id => Foreign_Exception'Access,
|
|
|
359 Machine_Occurrence => Mo,
|
|
|
360 Msg => <>,
|
|
|
361 Msg_Length => 0,
|
|
|
362 Exception_Raised => True,
|
|
|
363 Pid => Local_Partition_ID,
|
|
|
364 Num_Tracebacks => 0,
|
|
|
365 Tracebacks => <>);
|
|
|
366 end Set_Foreign_Occurrence;
|
|
|
367
|
|
|
368 -------------------------
|
|
|
369 -- Setup_Current_Excep --
|
|
|
370 -------------------------
|
|
|
371
|
|
|
372 function Setup_Current_Excep
|
|
131
|
373 (GCC_Exception : not null GCC_Exception_Access;
|
|
|
374 Phase : Unwind_Action) return EOA
|
|
111
|
375 is
|
|
|
376 Excep : constant EOA := Get_Current_Excep.all;
|
|
|
377
|
|
|
378 begin
|
|
|
379
|
|
|
380 if GCC_Exception.Class = GNAT_Exception_Class then
|
|
|
381
|
|
131
|
382 -- Ada exception : latch the occurrence data in the Current
|
|
|
383 -- Exception Buffer if needed and return a pointer to the original
|
|
|
384 -- Ada exception object. This particular object was specifically
|
|
|
385 -- allocated for this raise and is thus more precise than the fixed
|
|
|
386 -- Current Exception Buffer address.
|
|
111
|
387
|
|
|
388 declare
|
|
|
389 GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
|
|
|
390 To_GNAT_GCC_Exception (GCC_Exception);
|
|
|
391 begin
|
|
131
|
392
|
|
|
393 -- When reaching here during SEARCH_PHASE, no need to
|
|
|
394 -- replicate the copy performed at the propagation start.
|
|
|
395
|
|
|
396 if Phase /= UA_SEARCH_PHASE then
|
|
|
397 Excep.all := GNAT_Occurrence.Occurrence;
|
|
|
398 end if;
|
|
111
|
399 return GNAT_Occurrence.Occurrence'Access;
|
|
|
400 end;
|
|
|
401
|
|
|
402 else
|
|
131
|
403
|
|
|
404 -- Foreign exception (caught by Ada handler, reaching here from
|
|
|
405 -- personality routine) : The original exception object doesn't hold
|
|
|
406 -- an Ada occurrence info. Set the foreign data pointer in the
|
|
|
407 -- Current Exception Buffer and return the address of the latter.
|
|
111
|
408
|
|
|
409 Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
|
|
|
410
|
|
|
411 return Excep;
|
|
|
412 end if;
|
|
|
413 end Setup_Current_Excep;
|
|
|
414
|
|
145
|
415 ----------------------
|
|
|
416 -- Begin_Handler_v1 --
|
|
|
417 ----------------------
|
|
|
418
|
|
|
419 function Begin_Handler_v1
|
|
|
420 (GCC_Exception : not null GCC_Exception_Access)
|
|
|
421 return System.Address is
|
|
|
422 Saved_Cleanup : constant System.Address := GCC_Exception.Cleanup;
|
|
|
423 begin
|
|
|
424 -- Claim responsibility for releasing this exception, and stop
|
|
|
425 -- others from releasing it.
|
|
|
426 GCC_Exception.Cleanup := Claimed_Cleanup'Address;
|
|
|
427 return Saved_Cleanup;
|
|
|
428 end Begin_Handler_v1;
|
|
|
429
|
|
|
430 --------------------
|
|
|
431 -- End_Handler_v1 --
|
|
|
432 --------------------
|
|
|
433
|
|
|
434 procedure End_Handler_v1
|
|
|
435 (GCC_Exception : not null GCC_Exception_Access;
|
|
|
436 Saved_Cleanup : System.Address;
|
|
|
437 Propagating_Exception : GCC_Exception_Access) is
|
|
|
438 begin
|
|
|
439 GCC_Exception.Cleanup := Saved_Cleanup;
|
|
|
440 -- Restore the Saved_Cleanup, so that it is either used to
|
|
|
441 -- release GCC_Exception below, or transferred to the next
|
|
|
442 -- handler of the Propagating_Exception occurrence. The
|
|
|
443 -- following test ensures that an occurrence is only released
|
|
|
444 -- once, even after reraises.
|
|
|
445 --
|
|
|
446 -- The idea is that the GCC_Exception is not to be released
|
|
|
447 -- unless it had an unclaimed Cleanup when the handler started
|
|
|
448 -- (see Begin_Handler_v1 above), but if we propagate across its
|
|
|
449 -- handler a reraise of the same exception, we transfer to the
|
|
|
450 -- Propagating_Exception the responsibility for running the
|
|
|
451 -- Saved_Cleanup when its handler completes.
|
|
|
452 --
|
|
|
453 -- This ownership transfer mechanism ensures safety, as in
|
|
|
454 -- single release and no dangling pointers, because there is no
|
|
|
455 -- way to hold on to the Machine_Occurrence of an
|
|
|
456 -- Exception_Occurrence: the only situations in which another
|
|
|
457 -- Exception_Occurrence gets the same Machine_Occurrence are
|
|
|
458 -- through Reraise_Occurrence, and plain reraise, and so we
|
|
|
459 -- have the following possibilities:
|
|
|
460 --
|
|
|
461 -- - Reraise_Occurrence is handled within the running handler,
|
|
|
462 -- and so when completing the dynamically nested handler, we
|
|
|
463 -- must NOT release the exception. A Claimed_Cleanup upon
|
|
|
464 -- entry of the nested handler, installed when entering the
|
|
|
465 -- enclosing handler, ensures the exception will not be
|
|
|
466 -- released by the nested handler, but rather by the enclosing
|
|
|
467 -- handler.
|
|
|
468 --
|
|
|
469 -- - Reraise_Occurrence/reraise escapes the running handler,
|
|
|
470 -- and we run as an exceptional cleanup for GCC_Exception. The
|
|
|
471 -- Saved_Cleanup was reinstalled, but since we're propagating
|
|
|
472 -- the same machine occurrence, we do not release it. Instead,
|
|
|
473 -- we transfer responsibility for releasing it to the eventual
|
|
|
474 -- handler of the propagating exception.
|
|
|
475 --
|
|
|
476 -- - An unrelated exception propagates through the running
|
|
|
477 -- handler. We restored GCC_Exception.Saved_Cleanup above.
|
|
|
478 -- Since we're propagating a different exception, we proceed to
|
|
|
479 -- release GCC_Exception, unless Saved_Cleanup was
|
|
|
480 -- Claimed_Cleanup, because then we know we're not in the
|
|
|
481 -- outermost handler for GCC_Exception.
|
|
|
482 --
|
|
|
483 -- - The handler completes normally, so it reinstalls the
|
|
|
484 -- Saved_Cleanup and runs it, unless it was Claimed_Cleanup.
|
|
|
485 -- If Saved_Cleanup is null, Unwind_DeleteException (currently)
|
|
|
486 -- has no effect, so we could skip it, but if it is ever
|
|
|
487 -- changed to do more in this case, we're ready for that,
|
|
|
488 -- calling it exactly once.
|
|
|
489 if Saved_Cleanup /= Claimed_Cleanup'Address
|
|
|
490 and then
|
|
|
491 Propagating_Exception /= GCC_Exception
|
|
|
492 then
|
|
|
493 declare
|
|
|
494 Current : constant EOA := Get_Current_Excep.all;
|
|
|
495 Cur_Occ : constant GCC_Exception_Access
|
|
|
496 := To_GCC_Exception (Current.Machine_Occurrence);
|
|
|
497 begin
|
|
|
498 -- If we are releasing the Machine_Occurrence of the current
|
|
|
499 -- exception, reset the access to it, so that it is no
|
|
|
500 -- longer accessible.
|
|
|
501 if Cur_Occ = GCC_Exception then
|
|
|
502 Current.Machine_Occurrence := System.Null_Address;
|
|
|
503 end if;
|
|
|
504 end;
|
|
|
505 Unwind_DeleteException (GCC_Exception);
|
|
|
506 end if;
|
|
|
507 end End_Handler_v1;
|
|
|
508
|
|
|
509 ---------------------
|
|
|
510 -- Claimed_Cleanup --
|
|
|
511 ---------------------
|
|
|
512
|
|
|
513 procedure Claimed_Cleanup
|
|
|
514 (Reason : Unwind_Reason_Code;
|
|
|
515 GCC_Exception : not null GCC_Exception_Access) is
|
|
|
516 pragma Unreferenced (Reason);
|
|
|
517 pragma Unreferenced (GCC_Exception);
|
|
|
518 begin
|
|
|
519 -- This procedure should never run. If it does, it's either a
|
|
|
520 -- version 0 handler or a foreign handler, attempting to
|
|
|
521 -- release an exception while a version 1 handler that claimed
|
|
|
522 -- responsibility for releasing the exception remains still
|
|
|
523 -- active. This placeholder stops GCC_Exception from being
|
|
|
524 -- released by them.
|
|
|
525
|
|
|
526 -- We could get away with just Null_Address instead, with
|
|
|
527 -- nearly the same effect, but with this placeholder we can
|
|
|
528 -- detect and report unexpected releases, and we can tell apart
|
|
|
529 -- a GCC_Exception without a Cleanup, from one with another
|
|
|
530 -- active handler, so as to still call Unwind_DeleteException
|
|
|
531 -- exactly once: currently, Unwind_DeleteException does nothing
|
|
|
532 -- when the Cleanup is null, but should it ever be changed to
|
|
|
533 -- do more, we'll still be safe.
|
|
|
534 null;
|
|
|
535 end Claimed_Cleanup;
|
|
|
536
|
|
111
|
537 -------------------
|
|
|
538 -- Begin_Handler --
|
|
|
539 -------------------
|
|
|
540
|
|
|
541 procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is
|
|
|
542 pragma Unreferenced (GCC_Exception);
|
|
|
543 begin
|
|
|
544 null;
|
|
|
545 end Begin_Handler;
|
|
|
546
|
|
|
547 -----------------
|
|
|
548 -- End_Handler --
|
|
|
549 -----------------
|
|
|
550
|
|
|
551 procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
|
|
|
552 begin
|
|
|
553 if GCC_Exception /= null then
|
|
|
554
|
|
|
555 -- The exception might have been reraised, in this case the cleanup
|
|
|
556 -- mustn't be called.
|
|
|
557
|
|
|
558 Unwind_DeleteException (GCC_Exception);
|
|
|
559 end if;
|
|
|
560 end End_Handler;
|
|
|
561
|
|
|
562 -----------------------------
|
|
|
563 -- Reraise_GCC_Exception --
|
|
|
564 -----------------------------
|
|
|
565
|
|
|
566 procedure Reraise_GCC_Exception
|
|
|
567 (GCC_Exception : not null GCC_Exception_Access)
|
|
|
568 is
|
|
|
569 begin
|
|
|
570 -- Simply propagate it
|
|
|
571
|
|
|
572 Propagate_GCC_Exception (GCC_Exception);
|
|
|
573 end Reraise_GCC_Exception;
|
|
|
574
|
|
|
575 -----------------------------
|
|
|
576 -- Propagate_GCC_Exception --
|
|
|
577 -----------------------------
|
|
|
578
|
|
|
579 -- Call Unwind_RaiseException to actually throw, taking care of handling
|
|
|
580 -- the two phase scheme it implements.
|
|
|
581
|
|
|
582 procedure Propagate_GCC_Exception
|
|
|
583 (GCC_Exception : not null GCC_Exception_Access)
|
|
|
584 is
|
|
131
|
585 -- Acknowledge the current exception info now, before unwinding
|
|
|
586 -- starts so it is available even from C++ handlers involved before
|
|
|
587 -- our personality routine.
|
|
|
588
|
|
|
589 Excep : constant EOA :=
|
|
|
590 Setup_Current_Excep (GCC_Exception, Phase => 0);
|
|
111
|
591
|
|
|
592 begin
|
|
|
593 -- Perform a standard raise first. If a regular handler is found, it
|
|
|
594 -- will be entered after all the intermediate cleanups have run. If
|
|
|
595 -- there is no regular handler, it will return.
|
|
|
596
|
|
|
597 Unwind_RaiseException (GCC_Exception);
|
|
|
598
|
|
|
599 -- If we get here we know the exception is not handled, as otherwise
|
|
|
600 -- Unwind_RaiseException arranges for the handler to be entered. Take
|
|
|
601 -- the necessary steps to enable the debugger to gain control while the
|
|
|
602 -- stack is still intact.
|
|
|
603
|
|
|
604 Notify_Unhandled_Exception (Excep);
|
|
|
605
|
|
|
606 -- Now, un a forced unwind to trigger cleanups. Control should not
|
|
|
607 -- resume there, if there are cleanups and in any cases as the
|
|
|
608 -- unwinding hook calls Unhandled_Exception_Terminate when end of
|
|
|
609 -- stack is reached.
|
|
|
610
|
|
|
611 Unwind_ForcedUnwind
|
|
|
612 (GCC_Exception,
|
|
|
613 CleanupUnwind_Handler'Address,
|
|
|
614 System.Null_Address);
|
|
|
615
|
|
|
616 -- We get here in case of error. The debugger has been notified before
|
|
|
617 -- the second step above.
|
|
|
618
|
|
|
619 Unhandled_Except_Handler (GCC_Exception);
|
|
|
620 end Propagate_GCC_Exception;
|
|
|
621
|
|
|
622 -------------------------
|
|
|
623 -- Propagate_Exception --
|
|
|
624 -------------------------
|
|
|
625
|
|
131
|
626 procedure Propagate_Exception (Excep : Exception_Occurrence) is
|
|
111
|
627 begin
|
|
|
628 Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
|
|
|
629 end Propagate_Exception;
|
|
|
630
|
|
|
631 -----------------------------
|
|
|
632 -- Set_Exception_Parameter --
|
|
|
633 -----------------------------
|
|
|
634
|
|
|
635 procedure Set_Exception_Parameter
|
|
|
636 (Excep : EOA;
|
|
|
637 GCC_Exception : not null GCC_Exception_Access)
|
|
|
638 is
|
|
|
639 begin
|
|
|
640 -- Setup the exception occurrence
|
|
|
641
|
|
|
642 if GCC_Exception.Class = GNAT_Exception_Class then
|
|
|
643
|
|
|
644 -- From the GCC exception
|
|
|
645
|
|
|
646 declare
|
|
|
647 GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
|
|
|
648 To_GNAT_GCC_Exception (GCC_Exception);
|
|
|
649 begin
|
|
|
650 Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
|
|
|
651 end;
|
|
|
652
|
|
|
653 else
|
|
|
654 -- A default one
|
|
|
655
|
|
|
656 Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
|
|
|
657 end if;
|
|
|
658 end Set_Exception_Parameter;
|
|
|
659
|
|
|
660 ------------------------------
|
|
|
661 -- Unhandled_Except_Handler --
|
|
|
662 ------------------------------
|
|
|
663
|
|
|
664 procedure Unhandled_Except_Handler
|
|
|
665 (GCC_Exception : not null GCC_Exception_Access)
|
|
|
666 is
|
|
|
667 Excep : EOA;
|
|
|
668 begin
|
|
131
|
669 Excep := Setup_Current_Excep (GCC_Exception, Phase => UA_CLEANUP_PHASE);
|
|
111
|
670 Unhandled_Exception_Terminate (Excep);
|
|
|
671 end Unhandled_Except_Handler;
|
|
|
672
|
|
|
673 -------------
|
|
|
674 -- EID_For --
|
|
|
675 -------------
|
|
|
676
|
|
|
677 function EID_For
|
|
|
678 (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
|
|
|
679 is
|
|
|
680 begin
|
|
|
681 return GNAT_Exception.Occurrence.Id;
|
|
|
682 end EID_For;
|
|
|
683
|
|
|
684 ----------------------
|
|
|
685 -- Foreign_Data_For --
|
|
|
686 ----------------------
|
|
|
687
|
|
|
688 function Foreign_Data_For
|
|
|
689 (E : SSL.Exception_Data_Ptr) return Address
|
|
|
690 is
|
|
|
691 begin
|
|
|
692 return E.Foreign_Data;
|
|
|
693 end Foreign_Data_For;
|
|
|
694
|
|
|
695 --------------------------
|
|
|
696 -- Is_Handled_By_Others --
|
|
|
697 --------------------------
|
|
|
698
|
|
|
699 function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
|
|
|
700 begin
|
|
|
701 return not E.all.Not_Handled_By_Others;
|
|
|
702 end Is_Handled_By_Others;
|
|
|
703
|
|
|
704 ------------------
|
|
|
705 -- Language_For --
|
|
|
706 ------------------
|
|
|
707
|
|
|
708 function Language_For (E : SSL.Exception_Data_Ptr) return Character is
|
|
|
709 begin
|
|
|
710 return E.all.Lang;
|
|
|
711 end Language_For;
|
|
|
712
|
|
|
713 end Exception_Propagation;
|
