1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . E X C E P T I O N S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- 10-- -- 11-- This specification is derived from the Ada Reference Manual for use with -- 12-- GNAT. The copyright notice above, and the license provisions that follow -- 13-- apply solely to the contents of the part following the private keyword. -- 14-- -- 15-- GNAT is free software; you can redistribute it and/or modify it under -- 16-- terms of the GNU General Public License as published by the Free Soft- -- 17-- ware Foundation; either version 2, or (at your option) any later ver- -- 18-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 19-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 20-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 21-- for more details. You should have received a copy of the GNU General -- 22-- Public License distributed with GNAT; see file COPYING. If not, write -- 23-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 24-- MA 02111-1307, USA. -- 25-- -- 26-- As a special exception, if other files instantiate generics from this -- 27-- unit, or you link this unit with other files to produce an executable, -- 28-- this unit does not by itself cause the resulting executable to be -- 29-- covered by the GNU General Public License. This exception does not -- 30-- however invalidate any other reasons why the executable file might be -- 31-- covered by the GNU Public License. -- 32-- -- 33-- GNAT was originally developed by the GNAT team at New York University. -- 34-- Extensive contributions were provided by Ada Core Technologies Inc. -- 35-- -- 36------------------------------------------------------------------------------ 37 38pragma Polling (Off); 39-- We must turn polling off for this unit, because otherwise we get 40-- elaboration circularities with ourself. 41 42with System; 43with System.Standard_Library; 44with System.Traceback_Entries; 45 46package Ada.Exceptions is 47 48 type Exception_Id is private; 49 Null_Id : constant Exception_Id; 50 51 type Exception_Occurrence is limited private; 52 type Exception_Occurrence_Access is access all Exception_Occurrence; 53 54 Null_Occurrence : constant Exception_Occurrence; 55 56 function Exception_Name (X : Exception_Occurrence) return String; 57 -- Same as Exception_Name (Exception_Identity (X)) 58 59 function Exception_Name (Id : Exception_Id) return String; 60 61 procedure Raise_Exception (E : Exception_Id; Message : String := ""); 62 -- Note: it would be really nice to give a pragma No_Return for this 63 -- procedure, but it would be wrong, since Raise_Exception does return 64 -- if given the null exception. However we do special case the name in 65 -- the test in the compiler for issuing a warning for a missing return 66 -- after this call. Program_Error seems reasonable enough in such a case. 67 -- See also the routine Raise_Exception_Always in the private part. 68 69 function Exception_Message (X : Exception_Occurrence) return String; 70 71 procedure Reraise_Occurrence (X : Exception_Occurrence); 72 -- Note: it would be really nice to give a pragma No_Return for this 73 -- procedure, but it would be wrong, since Reraise_Occurrence does return 74 -- if the argument is the null exception occurrence. See also procedure 75 -- Reraise_Occurrence_Always in the private part of this package. 76 77 function Exception_Identity (X : Exception_Occurrence) return Exception_Id; 78 79 function Exception_Information (X : Exception_Occurrence) return String; 80 -- The format of the exception information is as follows: 81 -- 82 -- exception name (as in Exception_Name) 83 -- message (or a null line if no message) 84 -- PID=nnnn 85 -- 0xyyyyyyyy 0xyyyyyyyy ... 86 -- 87 -- The lines are separated by a ASCII.LF character 88 -- The nnnn is the partition Id given as decimal digits. 89 -- The 0x... line represents traceback program counter locations, 90 -- in order with the first one being the exception location. 91 92 -- Note on ordering: the compiler uses the Save_Occurrence procedure, but 93 -- not the function from Rtsfind, so it is important that the procedure 94 -- come first, since Rtsfind finds the first matching entity. 95 96 procedure Save_Occurrence 97 (Target : out Exception_Occurrence; 98 Source : Exception_Occurrence); 99 100 function Save_Occurrence 101 (Source : Exception_Occurrence) 102 return Exception_Occurrence_Access; 103 104private 105 package SSL renames System.Standard_Library; 106 107 subtype EOA is Exception_Occurrence_Access; 108 109 Exception_Msg_Max_Length : constant := 200; 110 111 ------------------ 112 -- Exception_Id -- 113 ------------------ 114 115 subtype Code_Loc is System.Address; 116 -- Code location used in building exception tables and for call 117 -- addresses when propagating an exception. 118 -- Values of this type are created by using Label'Address or 119 -- extracted from machine states using Get_Code_Loc. 120 121 Null_Loc : constant Code_Loc := System.Null_Address; 122 -- Null code location, used to flag outer level frame 123 124 type Exception_Id is new SSL.Exception_Data_Ptr; 125 126 function EId_To_String (X : Exception_Id) return String; 127 function String_To_EId (S : String) return Exception_Id; 128 pragma Stream_Convert (Exception_Id, String_To_EId, EId_To_String); 129 -- Functions for implementing Exception_Id stream attributes 130 131 Null_Id : constant Exception_Id := null; 132 133 ------------------------- 134 -- Private Subprograms -- 135 ------------------------- 136 137 function Current_Target_Exception return Exception_Occurrence; 138 pragma Export 139 (Ada, Current_Target_Exception, 140 "__gnat_current_target_exception"); 141 -- This routine should return the current raised exception on targets 142 -- which have built-in exception handling such as the Java Virtual 143 -- Machine. For other targets this routine is simply ignored. Currently, 144 -- only JGNAT uses this. See 4jexcept.ads for details. The pragma Export 145 -- allows this routine to be accessed elsewhere in the run-time, even 146 -- though it is in the private part of this package (it is not allowed 147 -- to be in the visible part, since this is set by the reference manual). 148 149 function Exception_Name_Simple (X : Exception_Occurrence) return String; 150 -- Like Exception_Name, but returns the simple non-qualified name of 151 -- the exception. This is used to implement the Exception_Name function 152 -- in Current_Exceptions (the DEC compatible unit). It is called from 153 -- the compiler generated code (using Rtsfind, which does not respect 154 -- the private barrier, so we can place this function in the private 155 -- part where the compiler can find it, but the spec is unchanged.) 156 157 procedure Raise_Exception_Always (E : Exception_Id; Message : String := ""); 158 pragma No_Return (Raise_Exception_Always); 159 pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception"); 160 -- This differs from Raise_Exception only in that the caller has determined 161 -- that for sure the parameter E is not null, and that therefore the call 162 -- to this procedure cannot return. The expander converts Raise_Exception 163 -- calls to Raise_Exception_Always if it can determine this is the case. 164 -- The Export allows this routine to be accessed from Pure units. 165 166 procedure Raise_From_Signal_Handler 167 (E : Exception_Id; 168 M : SSL.Big_String_Ptr); 169 pragma Export 170 (Ada, Raise_From_Signal_Handler, 171 "ada__exceptions__raise_from_signal_handler"); 172 pragma No_Return (Raise_From_Signal_Handler); 173 -- This routine is used to raise an exception from a signal handler. 174 -- The signal handler has already stored the machine state (i.e. the 175 -- state that corresponds to the location at which the signal was 176 -- raised). E is the Exception_Id specifying what exception is being 177 -- raised, and M is a pointer to a null-terminated string which is the 178 -- message to be raised. Note that this routine never returns, so it is 179 -- permissible to simply jump to this routine, rather than call it. This 180 -- may be appropriate for systems where the right way to get out of a 181 -- signal handler is to alter the PC value in the machine state or in 182 -- some other way ask the operating system to return here rather than 183 -- to the original location. 184 185 procedure Reraise_Occurrence_Always (X : Exception_Occurrence); 186 pragma No_Return (Reraise_Occurrence_Always); 187 -- This differs from Raise_Occurrence only in that the caller guarantees 188 -- that for sure the parameter X is not the null occurrence, and that 189 -- therefore this procedure cannot return. The expander uses this routine 190 -- in the translation of a raise statement with no parameter (reraise). 191 192 procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence); 193 pragma No_Return (Reraise_Occurrence_No_Defer); 194 -- Exactly like Reraise_Occurrence, except that abort is not deferred 195 -- before the call and the parameter X is known not to be the null 196 -- occurrence. This is used in generated code when it is known 197 -- that abort is already deferred. 198 199 ----------------------- 200 -- Polling Interface -- 201 ----------------------- 202 203 -- The GNAT compiler has an option to generate polling calls to the Poll 204 -- routine in this package. Specifying the -gnatP option for a compilation 205 -- causes a call to Ada.Exceptions.Poll to be generated on every subprogram 206 -- entry and on every iteration of a loop, thus avoiding the possibility of 207 -- a case of unbounded time between calls. 208 209 -- This polling interface may be used for instrumentation or debugging 210 -- purposes (e.g. implementing watchpoints in software or in the debugger). 211 212 -- In the GNAT technology itself, this interface is used to implement 213 -- immediate aynschronous transfer of control and immediate abort on 214 -- targets which do not provide for one thread interrupting another. 215 216 -- Note: this used to be in a separate unit called System.Poll, but that 217 -- caused horrible circular elaboration problems between System.Poll and 218 -- Ada.Exceptions. One way of solving such circularities is unification! 219 220 procedure Poll; 221 -- Check for asynchronous abort. Note that we do not inline the body. 222 -- This makes the interface more useful for debugging purposes. 223 224 -------------------------- 225 -- Exception_Occurrence -- 226 -------------------------- 227 228 package TBE renames System.Traceback_Entries; 229 230 Max_Tracebacks : constant := 50; 231 -- Maximum number of trace backs stored in exception occurrence 232 233 type Tracebacks_Array is array (1 .. Max_Tracebacks) of TBE.Traceback_Entry; 234 -- Traceback array stored in exception occurrence 235 236 type Exception_Occurrence is record 237 Id : Exception_Id; 238 -- Exception_Identity for this exception occurrence 239 -- WARNING System.System.Finalization_Implementation.Finalize_List 240 -- relies on the fact that this field is always first in the exception 241 -- occurrence 242 243 Msg_Length : Natural := 0; 244 -- Length of message (zero = no message) 245 246 Msg : String (1 .. Exception_Msg_Max_Length); 247 -- Characters of message 248 249 Cleanup_Flag : Boolean; 250 -- The cleanup flag is normally False, it is set True for an exception 251 -- occurrence passed to a cleanup routine, and will still be set True 252 -- when the cleanup routine does a Reraise_Occurrence call using this 253 -- exception occurrence. This is used to avoid recording a bogus trace 254 -- back entry from this reraise call. 255 256 Exception_Raised : Boolean := False; 257 -- Set to true to indicate that this exception occurrence has actually 258 -- been raised. When an exception occurrence is first created, this is 259 -- set to False, then when it is processed by Raise_Current_Exception, 260 -- it is set to True. If Raise_Current_Exception is used to raise an 261 -- exception for which this flag is already True, then it knows that 262 -- it is dealing with the reraise case (which is useful to distinguish 263 -- for exception tracing purposes). 264 265 Pid : Natural; 266 -- Partition_Id for partition raising exception 267 268 Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0; 269 -- Number of traceback entries stored 270 271 Tracebacks : Tracebacks_Array; 272 -- Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks)) 273 274 Private_Data : System.Address := System.Null_Address; 275 -- Field used by low level exception mechanism to store specific data. 276 -- Currently used by the GCC exception mechanism to store a pointer to 277 -- a GNAT_GCC_Exception. 278 end record; 279 280 function "=" (Left, Right : Exception_Occurrence) return Boolean 281 is abstract; 282 -- Don't allow comparison on exception occurrences, we should not need 283 -- this, and it would not work right, because of the Msg and Tracebacks 284 -- fields which have unused entries not copied by Save_Occurrence. 285 286 function EO_To_String (X : Exception_Occurrence) return String; 287 function String_To_EO (S : String) return Exception_Occurrence; 288 pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String); 289 -- Functions for implementing Exception_Occurrence stream attributes 290 291 Null_Occurrence : constant Exception_Occurrence := ( 292 Id => Null_Id, 293 Msg_Length => 0, 294 Msg => (others => ' '), 295 Cleanup_Flag => False, 296 Exception_Raised => False, 297 Pid => 0, 298 Num_Tracebacks => 0, 299 Tracebacks => (others => TBE.Null_TB_Entry), 300 Private_Data => System.Null_Address); 301 302end Ada.Exceptions; 303