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;