1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- ADA.EXCEPTIONS.EXCEPTION_TRACES -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2012, 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 (Exception_Trace = Unhandled_Raise and then Is_Unhandled)) 89 then 90 -- Exception trace messages need to be protected when several tasks 91 -- can issue them at the same time. 92 93 Lock_Task.all; 94 To_Stderr (Nline); 95 96 if Is_Unhandled then 97 To_Stderr ("Unhandled "); 98 end if; 99 100 To_Stderr ("Exception raised"); 101 To_Stderr (Nline); 102 To_Stderr (Tailored_Exception_Information (Excep.all)); 103 Unlock_Task.all; 104 end if; 105 106 -- Call the user-specific actions 107 -- ??? We should presumably look at the reraise status here. 108 109 if Raise_Hook_Initialized 110 and then Exception_Data_Ptr (Excep.Id).Raise_Hook /= null 111 then 112 To_Action (Exception_Data_Ptr (Excep.Id).Raise_Hook) (Excep.all); 113 end if; 114 115 if Global_Action /= null then 116 Global_Action (Excep.all); 117 end if; 118 end Notify_Exception; 119 120 ------------------------------ 121 -- Notify_Handled_Exception -- 122 ------------------------------ 123 124 procedure Notify_Handled_Exception (Excep : EOA) is 125 begin 126 Notify_Exception (Excep, Is_Unhandled => False); 127 end Notify_Handled_Exception; 128 129 -------------------------------- 130 -- Notify_Unhandled_Exception -- 131 -------------------------------- 132 133 procedure Notify_Unhandled_Exception (Excep : EOA) is 134 begin 135 -- Check whether there is any termination handler to be executed for 136 -- the environment task, and execute it if needed. Here we handle both 137 -- the Abnormal and Unhandled_Exception task termination. Normal 138 -- task termination routine is executed elsewhere (either in the 139 -- Task_Wrapper or in the Adafinal routine for the environment task). 140 141 Task_Termination_Handler.all (Excep.all); 142 143 Notify_Exception (Excep, Is_Unhandled => True); 144 Debug_Unhandled_Exception (SSL.Exception_Data_Ptr (Excep.Id)); 145 end Notify_Unhandled_Exception; 146 147 ----------------------------------- 148 -- Unhandled_Exception_Terminate -- 149 ----------------------------------- 150 151 procedure Unhandled_Exception_Terminate (Excep : EOA) is 152 Occ : Exception_Occurrence; 153 -- This occurrence will be used to display a message after finalization. 154 -- It is necessary to save a copy here, or else the designated value 155 -- could be overwritten if an exception is raised during finalization 156 -- (even if that exception is caught). The occurrence is saved on the 157 -- stack to avoid dynamic allocation (if this exception is due to lack 158 -- of space in the heap, we therefore avoid a second failure). We assume 159 -- that there is enough room on the stack however. 160 161 begin 162 Save_Occurrence (Occ, Excep.all); 163 Last_Chance_Handler (Occ); 164 end Unhandled_Exception_Terminate; 165 166 ------------------------------------ 167 -- Handling GNAT.Exception_Traces -- 168 ------------------------------------ 169 170 -- The bulk of exception traces output is centralized in Notify_Exception, 171 -- for both the Handled and Unhandled cases. Extra task specific output is 172 -- triggered in the task wrapper for unhandled occurrences in tasks. It is 173 -- not performed in this unit to avoid dragging dependencies against the 174 -- tasking units here. 175 176 -- We used to rely on the output performed by Unhanded_Exception_Terminate 177 -- for the case of an unhandled occurrence in the environment thread, and 178 -- the task wrapper was responsible for the whole output in the tasking 179 -- case. 180 181 -- This initial scheme had a drawback: the output from Terminate only 182 -- occurs after finalization is done, which means possibly never if some 183 -- tasks keep hanging around. 184 185 -- The first "presumably obvious" fix consists in moving the Terminate 186 -- output before the finalization. It has not been retained because it 187 -- introduces annoying changes in output orders when the finalization 188 -- itself issues outputs, this also in "regular" cases not resorting to 189 -- Exception_Traces. 190 191 -- Today's solution has the advantage of simplicity and better isolates 192 -- the Exception_Traces machinery. 193 194 -- It currently outputs the information about unhandled exceptions twice 195 -- in the environment thread, once in the notification routine and once in 196 -- the termination routine. Avoiding the second output is possible but so 197 -- far has been considered undesirable. It would mean changing the order 198 -- of outputs between the two runs with or without exception traces, while 199 -- it seems preferable to only have additional outputs in the former 200 -- case. 201 202end Exception_Traces; 203