1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- ADA.EXCEPTIONS.EXCEPTION_TRACES --
9 -- Copyright (C) 1992-2024, 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 with Ada
.Unchecked_Conversion
;
34 pragma Warnings
(Off
);
35 with Ada
.Exceptions
.Last_Chance_Handler
;
37 -- Bring last chance handler into closure
39 separate (Ada
.Exceptions
)
40 package body Exception_Traces
is
42 Nline
: constant String := String'(1 => ASCII.LF);
43 -- Convenient shortcut
45 type Exception_Action is access procedure (E : Exception_Occurrence);
46 pragma Favor_Top_Level (Exception_Action);
48 Global_Action : Exception_Action := null;
49 pragma Atomic (Global_Action);
51 (Ada, Global_Action, "__gnat_exception_actions_global_action");
52 -- Global action, executed whenever an exception is raised. Changing the
53 -- export name must be coordinated with code in g-excact.adb.
55 Global_Unhandled_Action : Exception_Action := null;
56 pragma Atomic (Global_Unhandled_Action);
58 (Ada, Global_Unhandled_Action,
59 "__gnat_exception_actions_global_unhandled_action");
60 -- Global action, executed whenever an unhandled exception is raised.
61 -- Changing the export name must be coordinated with code in g-excact.adb.
63 Raise_Hook_Initialized : Boolean := False;
65 (Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized");
67 procedure Last_Chance_Handler (Except : Exception_Occurrence);
68 pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
69 pragma No_Return (Last_Chance_Handler);
70 -- Users can replace the default version of this routine,
71 -- Ada.Exceptions.Last_Chance_Handler.
73 function To_Action is new Ada.Unchecked_Conversion
74 (Raise_Action, Exception_Action);
76 -----------------------
77 -- Local Subprograms --
78 -----------------------
80 procedure Notify_Exception (Excep : EOA; Is_Unhandled : Boolean);
81 -- Factorizes the common processing for Notify_Handled_Exception and
82 -- Notify_Unhandled_Exception. Is_Unhandled is set to True only in the
83 -- latter case because Notify_Handled_Exception may be called for an
84 -- actually unhandled occurrence in the Front-End-SJLJ case.
86 ----------------------
87 -- Notify_Exception --
88 ----------------------
90 procedure Notify_Exception (Excep : EOA; Is_Unhandled : Boolean) is
91 -- Save actions locally to avoid any race condition that would
92 -- reset them to null.
93 Action : constant Exception_Action := Global_Action;
94 Unhandled_Action : constant Exception_Action := Global_Unhandled_Action;
97 -- Output the exception information required by the Exception_Trace
98 -- configuration. Take care not to output information about internal
101 if not Excep.Id.Not_Handled_By_Others
103 (Exception_Trace = Every_Raise
107 (Exception_Trace = Unhandled_Raise
108 or else Exception_Trace = Unhandled_Raise_In_Main)))
110 -- Exception trace messages need to be protected when several tasks
111 -- can issue them at the same time.
116 if Exception_Trace /= Unhandled_Raise_In_Main then
118 To_Stderr ("Unhandled ");
121 To_Stderr ("Exception raised");
125 To_Stderr (Exception_Information (Excep.all));
129 -- Call the user-specific actions
130 -- ??? We should presumably look at the reraise status here.
132 if Raise_Hook_Initialized
133 and then Exception_Data_Ptr (Excep.Id).Raise_Hook /= null
135 To_Action (Exception_Data_Ptr (Excep.Id).Raise_Hook) (Excep.all);
138 if Is_Unhandled and Unhandled_Action /= null then
139 Unhandled_Action (Excep.all);
142 if Action /= null then
145 end Notify_Exception;
147 ------------------------------
148 -- Notify_Handled_Exception --
149 ------------------------------
151 procedure Notify_Handled_Exception (Excep : EOA) is
153 Notify_Exception (Excep, Is_Unhandled => False);
154 end Notify_Handled_Exception;
156 --------------------------------
157 -- Notify_Unhandled_Exception --
158 --------------------------------
160 procedure Notify_Unhandled_Exception (Excep : EOA) is
162 -- Check whether there is any termination handler to be executed for
163 -- the environment task, and execute it if needed. Here we handle both
164 -- the Abnormal and Unhandled_Exception task termination. Normal
165 -- task termination routine is executed elsewhere (either in the
166 -- Task_Wrapper or in the Adafinal routine for the environment task).
168 Task_Termination_Handler.all (Excep.all);
170 Notify_Exception (Excep, Is_Unhandled => True);
171 Debug_Unhandled_Exception (SSL.Exception_Data_Ptr (Excep.Id));
172 end Notify_Unhandled_Exception;
174 -----------------------------------
175 -- Unhandled_Exception_Terminate --
176 -----------------------------------
178 procedure Unhandled_Exception_Terminate (Excep : EOA) is
179 Occ : Exception_Occurrence;
180 -- This occurrence will be used to display a message after finalization.
181 -- It is necessary to save a copy here, or else the designated value
182 -- could be overwritten if an exception is raised during finalization
183 -- (even if that exception is caught). The occurrence is saved on the
184 -- stack to avoid dynamic allocation (if this exception is due to lack
185 -- of space in the heap, we therefore avoid a second failure). We assume
186 -- that there is enough room on the stack however.
189 Save_Occurrence (Occ, Excep.all);
190 Last_Chance_Handler (Occ);
191 end Unhandled_Exception_Terminate;
193 ------------------------------------
194 -- Handling GNAT.Exception_Traces --
195 ------------------------------------
197 -- The bulk of exception traces output is centralized in Notify_Exception,
198 -- for both the Handled and Unhandled cases. Extra task specific output is
199 -- triggered in the task wrapper for unhandled occurrences in tasks. It is
200 -- not performed in this unit to avoid dependencies on the tasking units
203 -- We used to rely on the output performed by Unhanded_Exception_Terminate
204 -- for the case of an unhandled occurrence in the environment thread, and
205 -- the task wrapper was responsible for the whole output in the tasking
208 -- This initial scheme had a drawback: the output from Terminate only
209 -- occurs after finalization is done, which means possibly never if some
210 -- tasks keep hanging around.
212 -- The first "presumably obvious" fix consists in moving the Terminate
213 -- output before the finalization. It has not been retained because it
214 -- introduces annoying changes in output orders when the finalization
215 -- itself issues outputs, this also in "regular" cases not resorting to
218 -- Today's solution has the advantage of simplicity and better isolates
219 -- the Exception_Traces machinery.
221 end Exception_Traces;