1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- ADA.EXCEPTIONS.STREAM_ATTRIBUTES --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 pragma Warnings
(Off
);
35 -- Allow withing of non-Preelaborated units in Ada 2005 mode where this
36 -- package will be categorized as Preelaborate. See AI-362 for details.
37 -- It is safe in the context of the run-time to violate the rules!
39 with System
.Exception_Table
; use System
.Exception_Table
;
40 with System
.Storage_Elements
; use System
.Storage_Elements
;
44 separate (Ada
.Exceptions
)
45 package body Stream_Attributes
is
51 function EId_To_String
(X
: Exception_Id
) return String is
56 return Exception_Name
(X
);
64 -- We use the null string to represent the null occurrence, otherwise
65 -- we output the Exception_Information string for the occurrence.
67 function EO_To_String
(X
: Exception_Occurrence
) return String is
69 if X
.Id
= Null_Id
then
72 return Exception_Information
(X
);
80 function String_To_EId
(S
: String) return Exception_Id
is
85 return Exception_Id
(Internal_Exception
(S
));
93 function String_To_EO
(S
: String) return Exception_Occurrence
is
97 X
: aliased Exception_Occurrence
;
98 -- This is the exception occurrence we will create
101 pragma No_Return
(Bad_EO
);
102 -- Signal bad exception occurrence string
104 procedure Next_String
;
105 -- On entry, To points to last character of previous line of the
106 -- message, terminated by LF. On return, From .. To are set to
107 -- specify the next string, or From > To if there are no more lines.
112 (Program_Error
'Identity,
113 "bad exception occurrence in stream input");
115 -- The following junk raise of Program_Error is required because
116 -- this is a No_Return function, and unfortunately Raise_Exception
117 -- can return (this particular call can't, but the back end is not
118 -- clever enough to know that).
123 procedure Next_String
is
127 if From
< S
'Last then
130 while To
< S
'Last - 1 loop
133 elsif S
(To
+ 1) = ASCII
.LF
then
142 -- Start of processing for String_To_EO
146 return Null_Occurrence
;
149 X
.Cleanup_Flag
:= False;
154 if S
(From
.. From
+ 15) /= "Exception name: " then
158 X
.Id
:= Exception_Id
(Internal_Exception
(S
(From
+ 16 .. To
)));
162 if From
<= To
and then S
(From
) = 'M' then
163 if S
(From
.. From
+ 8) /= "Message: " then
167 X
.Msg_Length
:= To
- From
- 8;
168 X
.Msg
(1 .. X
.Msg_Length
) := S
(From
+ 9 .. To
);
177 if From
<= To
and then S
(From
) = 'P' then
178 if S
(From
.. From
+ 3) /= "PID:" then
182 From
:= From
+ 5; -- skip past PID: space
184 while From
<= To
loop
185 X
.Pid
:= X
.Pid
* 10 +
186 (Character'Pos (S
(From
)) - Character'Pos ('0'));
193 X
.Num_Tracebacks
:= 0;
196 if S
(From
.. To
) /= "Call stack traceback locations:" then
211 or else S
(From
+ 1) /= 'x'
219 while From
<= To
loop
222 if Ch
in '0' .. '9' then
224 Character'Pos (S
(From
)) - Character'Pos ('0');
226 elsif Ch
in 'a' .. 'f' then
228 Character'Pos (S
(From
)) - Character'Pos ('a') + 10;
243 if X
.Num_Tracebacks
= Max_Tracebacks
then
247 X
.Num_Tracebacks
:= X
.Num_Tracebacks
+ 1;
248 X
.Tracebacks
(X
.Num_Tracebacks
) :=
249 TBE
.TB_Entry_For
(To_Address
(C
));
254 -- If an exception was converted to a string, it must have
255 -- already been raised, so flag it accordingly and we are done.
257 X
.Exception_Raised
:= True;
262 end Stream_Attributes
;