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