1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009, 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 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. 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
27 with Types; use Types;
29 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
34 Loc1 : Source_Location;
35 Loc2 : Source_Location;
42 function At_EOL return Boolean;
43 -- Skips any spaces, then checks if we are the end of a line. If so,
44 -- returns True (but does not skip over the EOL sequence). If not,
45 -- then returns False.
47 procedure Check (C : Character);
48 -- Checks that file is positioned at given character, and if so skips past
49 -- it, If not, raises Data_Error.
51 function Get_Int return Int;
52 -- On entry the file is positioned to a digit. On return, the file is
53 -- positioned past the last digit, and the returned result is the decimal
54 -- value read. Data_Error is raised for overflow (value greater than
55 -- Int'Last), or if the initial character is not a digit.
57 procedure Get_Source_Location (Loc : out Source_Location);
58 -- Reads a source location in the form line:col and places the source
59 -- location in Loc. Raises Data_Error if the format does not match this
60 -- requirement. Note that initial spaces are not skipped.
62 procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location);
63 -- Skips initial spaces, then reads a source location range in the form
64 -- line:col-line:col and places the two source locations in Loc1 and Loc2.
65 -- Raises Data_Error if format does not match this requirement.
68 -- Called with the current character about to be read being LF or CR. Skips
69 -- past CR/LF characters until either a non-CR/LF character is found, or
70 -- the end of file is encountered.
72 procedure Skip_Spaces;
73 -- Skips zero or more spaces at the current position, leaving the file
74 -- positioned at the first non-blank character (or Types.EOF).
80 function At_EOL return Boolean is
83 return Nextc = CR or else Nextc = LF;
90 procedure Check (C : Character) is
103 function Get_Int return Int is
111 if C not in '0' .. '9' then
115 -- Loop to read digits of integer value
119 pragma Unsuppress (Overflow_Check);
121 Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
127 exit when C not in '0' .. '9';
133 when Constraint_Error =>
137 -------------------------
138 -- Get_Source_Location --
139 -------------------------
141 procedure Get_Source_Location (Loc : out Source_Location) is
142 pragma Unsuppress (Range_Check);
144 Loc.Line := Logical_Line_Number (Get_Int);
146 Loc.Col := Column_Number (Get_Int);
148 when Constraint_Error =>
150 end Get_Source_Location;
152 -------------------------------
153 -- Get_Source_Location_Range --
154 -------------------------------
156 procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location) is
159 Get_Source_Location (Loc1);
161 Get_Source_Location (Loc2);
162 end Get_Source_Location_Range;
167 procedure Skip_EOL is
174 exit when C /= LF and then C /= CR;
179 exit when C /= LF and then C /= CR;
188 procedure Skip_Spaces is
190 while Nextc = ' ' loop
195 -- Start of processing for Get_Scos
200 -- Loop through lines of SCO information
202 while Nextc = 'C' loop
207 -- Make sure first line is a header line
209 if SCO_Unit_Table.Last = 0 and then C /= ' ' then
213 -- Otherwise dispatch on type of line
221 -- Complete previous entry if any
223 if SCO_Unit_Table.Last /= 0 then
224 SCO_Unit_Table.Table (SCO_Unit_Table.Last).To :=
228 -- Scan out dependency number and file name
231 Ptr : String_Ptr := new String (1 .. 32768);
241 while Nextc > ' ' loop
246 -- Make new unit table entry (will fill in To later)
248 SCO_Unit_Table.Append (
249 (File_Name => new String'(Ptr.all (1 .. N)),
251 From => SCO_Table.Last + 1,
265 -- If continuation, reset Last indication in last entry
266 -- stored for previous CS or cs line, and start with key
267 -- set to s for continuations.
270 SCO_Table.Table (SCO_Table.Last).Last := False;
273 -- CS case (first line, so start with key set to S)
279 -- Initialize to scan items on one line
283 -- Loop through items on one line
288 if Typ in '1' .. '9' then
294 Get_Source_Location_Range (Loc1, Loc2);
310 when 'I' | 'E' | 'P' | 'W' | 'X' =>
317 Loc : Source_Location;
321 -- Acquire location information
324 Loc := No_Source_Location;
326 Get_Source_Location (Loc);
329 -- C2 is a space except for pragmas where it is 'e' since
330 -- clearly the pragma is enabled if it was written out.
342 To => No_Source_Location,
346 -- Loop through terms in complex expression
349 while C /= CR and then C /= LF loop
350 if C = 'c' or else C = 't' or else C = 'f' then
353 Get_Source_Location_Range (Loc1, Loc2);
360 elsif C = '!' or else
367 Loc : Source_Location;
369 Get_Source_Location (Loc);
370 Add_SCO (C1 => C, From => Loc, Last => False);
383 -- Reset Last indication to True for last entry
385 SCO_Table.Table (SCO_Table.Last).Last := True;
387 -- No other SCO lines are possible
396 -- Here with all SCO's stored, complete last SCO Unit table entry
398 SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;