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-2009, 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 pragma Warnings (Off);
38 -- Since several constructs give warnings in 3.14a1, including unreferenced
39 -- variables and pragma Unreferenced itself.
41 separate (Ada.Exceptions)
42 package body Exception_Propagation is
44 procedure builtin_longjmp (buffer : Address; Flag : Integer);
45 pragma No_Return (builtin_longjmp);
46 pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
52 procedure Setup_Exception
55 Reraised : Boolean := False)
57 pragma Unreferenced (Excep, Current, Reraised);
59 -- In the GNAT-SJLJ case this "stack" only exists implicitly, by way of
60 -- local occurrence declarations together with save/restore operations
61 -- generated by the front-end, and this routine has nothing to do.
66 -------------------------
67 -- Propagate_Exception --
68 -------------------------
70 procedure Propagate_Exception
72 From_Signal_Handler : Boolean)
74 pragma Inspection_Point (E);
76 Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
77 Excep : constant EOA := Get_Current_Excep.all;
79 -- Compute the backtrace for this occurrence if corresponding binder
80 -- option has been set. Call_Chain takes care of the reraise case.
84 -- Note on above call to Call_Chain:
86 -- We used to only do this if From_Signal_Handler was not set,
87 -- based on the assumption that backtracing from a signal handler
88 -- would not work due to stack layout oddities. However, since
90 -- 1. The flag is never set in tasking programs (Notify_Exception
91 -- performs regular raise statements), and
93 -- 2. No problem has shown up in tasking programs around here so
94 -- far, this turned out to be too strong an assumption.
96 -- As, in addition, the test was
98 -- 1. preventing the production of backtraces in non-tasking
101 -- 2. introducing a behavior inconsistency between
102 -- the tasking and non-tasking cases,
104 -- we have simply removed it
106 -- If the jump buffer pointer is non-null, transfer control using
107 -- it. Otherwise announce an unhandled exception (note that this
108 -- means that we have no finalizations to do other than at the outer
109 -- level). Perform the necessary notification tasks in both cases.
111 if Jumpbuf_Ptr /= Null_Address then
112 if not Excep.Exception_Raised then
113 Excep.Exception_Raised := True;
114 Exception_Traces.Notify_Handled_Exception;
117 builtin_longjmp (Jumpbuf_Ptr, 1);
120 Exception_Traces.Notify_Unhandled_Exception;
121 Exception_Traces.Unhandled_Exception_Terminate;
123 end Propagate_Exception;
125 end Exception_Propagation;