1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009-2011, 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 ------------------------------------------------------------------------------
26 with Par_SCO; use Par_SCO;
32 procedure Output_Range (T : SCO_Table_Entry);
33 -- Outputs T.From and T.To in line:col-line:col format
35 procedure Output_Source_Location (Loc : Source_Location);
36 -- Output source location in line:col format
42 procedure Output_Range (T : SCO_Table_Entry) is
44 Output_Source_Location (T.From);
45 Write_Info_Char ('-');
46 Output_Source_Location (T.To);
49 ----------------------------
50 -- Output_Source_Location --
51 ----------------------------
53 procedure Output_Source_Location (Loc : Source_Location) is
55 Write_Info_Nat (Nat (Loc.Line));
56 Write_Info_Char (':');
57 Write_Info_Nat (Nat (Loc.Col));
58 end Output_Source_Location;
60 -- Start of processing for Put_SCOs
63 -- Loop through entries in SCO_Unit_Table
65 for U in 1 .. SCO_Unit_Table.Last loop
67 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
76 -- Write unit header (omitted if no SCOs are generated for this unit)
79 Write_Info_Initiate ('C');
80 Write_Info_Char (' ');
81 Write_Info_Nat (SUT.Dep_Num);
82 Write_Info_Char (' ');
84 for N in SUT.File_Name'Range loop
85 Write_Info_Char (SUT.File_Name (N));
91 -- Loop through SCO entries for this unit
94 exit when Start = Stop + 1;
95 pragma Assert (Start <= Stop);
97 Output_SCO_Line : declare
98 T : SCO_Table_Entry renames SCO_Table.Table (Start);
99 Continuation : Boolean;
108 Continuation := False;
110 if SCO_Pragma_Disabled
111 (SCO_Table.Table (Start).Pragma_Sloc)
117 Write_Info_Initiate ('C');
118 if not Continuation then
119 Write_Info_Char ('S');
120 Continuation := True;
122 Write_Info_Char ('s');
126 Write_Info_Char (' ');
128 if SCO_Table.Table (Start).C2 /= ' ' then
129 Write_Info_Char (SCO_Table.Table (Start).C2);
132 Output_Range (SCO_Table.Table (Start));
134 -- Increment entry counter (up to 6 entries per line,
135 -- continuation lines are marked Cs).
139 Write_Info_Terminate;
144 exit when SCO_Table.Table (Start).Last;
146 pragma Assert (SCO_Table.Table (Start).C1 = 's');
149 Write_Info_Terminate;
151 -- Statement continuations should not occur since they
152 -- are supposed to have been handled in the loop above.
159 when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
162 -- For disabled pragma, or nested decision therein, skip
165 if SCO_Pragma_Disabled (T.Pragma_Sloc) then
166 while not SCO_Table.Table (Start).Last loop
170 -- For all other cases output decision line
173 Write_Info_Initiate ('C');
174 Write_Info_Char (T.C1);
177 Write_Info_Char (' ');
178 Output_Source_Location (T.From);
181 -- Loop through table entries for this decision
186 renames SCO_Table.Table (Start);
189 Write_Info_Char (' ');
191 if T.C1 = '!' or else
195 Write_Info_Char (T.C1);
196 Output_Source_Location (T.From);
199 Write_Info_Char (T.C2);
208 Write_Info_Terminate;