]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
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 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- |
d23b8f57 RK |
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. -- | |
71ff80dc | 34 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
d23b8f57 RK |
35 | -- -- |
36 | ------------------------------------------------------------------------------ | |
37 | ||
38 | pragma Polling (Off); | |
39 | -- We must turn polling off for this unit, because otherwise we get | |
40 | -- elaboration circularities with ourself. | |
41 | ||
42 | with System; | |
43 | with System.Standard_Library; | |
fbf5a39b | 44 | with System.Traceback_Entries; |
d23b8f57 RK |
45 | |
46 | package 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 | -- | |
07fc65c4 | 87 | -- The lines are separated by a ASCII.LF character |
d23b8f57 RK |
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) | |
07fc65c4 | 102 | return Exception_Occurrence_Access; |
d23b8f57 RK |
103 | |
104 | private | |
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 | |
fbf5a39b | 117 | -- addresses when propagating an exception. |
d23b8f57 RK |
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 | ||
d23b8f57 RK |
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 | ||
d23b8f57 RK |
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 | ||
d23b8f57 RK |
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 | ||
fbf5a39b AC |
228 | package TBE renames System.Traceback_Entries; |
229 | ||
d23b8f57 RK |
230 | Max_Tracebacks : constant := 50; |
231 | -- Maximum number of trace backs stored in exception occurrence | |
232 | ||
fbf5a39b | 233 | type Tracebacks_Array is array (1 .. Max_Tracebacks) of TBE.Traceback_Entry; |
d23b8f57 RK |
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)) | |
fbf5a39b AC |
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. | |
d23b8f57 RK |
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, | |
fbf5a39b AC |
299 | Tracebacks => (others => TBE.Null_TB_Entry), |
300 | Private_Data => System.Null_Address); | |
d23b8f57 RK |
301 | |
302 | end Ada.Exceptions; |