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 default version, using the __builtin_setjmp/longjmp EH
35 with System.Storage_Elements; use System.Storage_Elements;
37 with Ada.Unchecked_Conversion;
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 -- Common binding to __builtin_longjmp for sjlj variants.
48 -- The builtin expects a pointer type for the jmpbuf address argument, and
49 -- System.Address doesn't work because this is really an integer type.
51 type Jmpbuf_Address is access Character;
53 function To_Jmpbuf_Address is new
54 Ada.Unchecked_Conversion (System.Address, Jmpbuf_Address);
56 procedure builtin_longjmp (buffer : Jmpbuf_Address; Flag : Integer);
57 pragma No_Return (builtin_longjmp);
58 pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
60 -------------------------
61 -- Propagate_Exception --
62 -------------------------
64 procedure Propagate_Exception
66 From_Signal_Handler : Boolean)
68 pragma Inspection_Point (E);
70 Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
71 Excep : constant EOA := Get_Current_Excep.all;
73 -- Compute the backtrace for this occurrence if corresponding binder
74 -- option has been set. Call_Chain takes care of the reraise case.
78 -- Note on above call to Call_Chain:
80 -- We used to only do this if From_Signal_Handler was not set,
81 -- based on the assumption that backtracing from a signal handler
82 -- would not work due to stack layout oddities. However, since
84 -- 1. The flag is never set in tasking programs (Notify_Exception
85 -- performs regular raise statements), and
87 -- 2. No problem has shown up in tasking programs around here so
88 -- far, this turned out to be too strong an assumption.
90 -- As, in addition, the test was
92 -- 1. preventing the production of backtraces in non-tasking
95 -- 2. introducing a behavior inconsistency between
96 -- the tasking and non-tasking cases,
98 -- we have simply removed it
100 -- If the jump buffer pointer is non-null, transfer control using
101 -- it. Otherwise announce an unhandled exception (note that this
102 -- means that we have no finalizations to do other than at the outer
103 -- level). Perform the necessary notification tasks in both cases.
105 if Jumpbuf_Ptr /= Null_Address then
106 if not Excep.Exception_Raised then
107 Excep.Exception_Raised := True;
108 Exception_Traces.Notify_Handled_Exception;
111 builtin_longjmp (To_Jmpbuf_Address (Jumpbuf_Ptr), 1);
114 Exception_Traces.Notify_Unhandled_Exception;
115 Exception_Traces.Unhandled_Exception_Terminate;
117 end Propagate_Exception;
119 end Exception_Propagation;