1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- ADA.EXCEPTIONS.EXCEPTION_TRACES -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 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 32with Ada.Unchecked_Conversion; 33 34pragma Warnings (Off); 35with Ada.Exceptions.Last_Chance_Handler; 36pragma Warnings (On); 37-- Bring last chance handler into closure 38 39separate (Ada.Exceptions) 40package 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 201end Exception_Traces; 202