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;
28 with Snames; use Snames;
31 Current_SCO_Unit : SCO_Unit_Index := 0;
32 -- Initial value must not be a valid unit index
34 procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
35 -- Start SCO line for unit SU, also emitting SCO unit header if necessary
37 procedure Output_Range (T : SCO_Table_Entry);
38 -- Outputs T.From and T.To in line:col-line:col format
40 procedure Output_Source_Location (Loc : Source_Location);
41 -- Output source location in line:col format
43 procedure Output_String (S : String);
50 procedure Output_Range (T : SCO_Table_Entry) is
52 Output_Source_Location (T.From);
53 Write_Info_Char ('-');
54 Output_Source_Location (T.To);
57 ----------------------------
58 -- Output_Source_Location --
59 ----------------------------
61 procedure Output_Source_Location (Loc : Source_Location) is
63 Write_Info_Nat (Nat (Loc.Line));
64 Write_Info_Char (':');
65 Write_Info_Nat (Nat (Loc.Col));
66 end Output_Source_Location;
72 procedure Output_String (S : String) is
75 Write_Info_Char (S (J));
79 ------------------------
80 -- Write_SCO_Initiate --
81 ------------------------
83 procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
84 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
87 if Current_SCO_Unit /= SU then
88 Write_Info_Initiate ('C');
89 Write_Info_Char (' ');
90 Write_Info_Nat (SUT.Dep_Num);
91 Write_Info_Char (' ');
93 Output_String (SUT.File_Name.all);
97 Current_SCO_Unit := SU;
100 Write_Info_Initiate ('C');
101 end Write_SCO_Initiate;
103 -- Start of processing for Put_SCOs
106 -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
107 -- convention present but unused.
109 for U in 1 .. SCO_Unit_Table.Last loop
111 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
120 -- Loop through SCO entries for this unit
123 exit when Start = Stop + 1;
124 pragma Assert (Start <= Stop);
126 Output_SCO_Line : declare
127 T : SCO_Table_Entry renames SCO_Table.Table (Start);
128 Continuation : Boolean;
131 -- Counter for statement entries
140 Continuation := False;
142 if SCO_Pragma_Disabled
143 (SCO_Table.Table (Start).Pragma_Sloc)
149 Write_SCO_Initiate (U);
150 if not Continuation then
151 Write_Info_Char ('S');
152 Continuation := True;
154 Write_Info_Char ('s');
158 Write_Info_Char (' ');
161 Sent : SCO_Table_Entry
162 renames SCO_Table.Table (Start);
164 if Sent.C2 /= ' ' then
165 Write_Info_Char (Sent.C2);
167 and then Sent.Pragma_Name /= Unknown_Pragma
170 Pnam : constant String :=
171 Sent.Pragma_Name'Img;
173 -- Strip leading "PRAGMA_"
176 (Pnam (Pnam'First + 7 .. Pnam'Last));
177 Write_Info_Char (':');
185 -- Increment entry counter (up to 6 entries per line,
186 -- continuation lines are marked Cs).
190 Write_Info_Terminate;
195 exit when SCO_Table.Table (Start).Last;
197 pragma Assert (SCO_Table.Table (Start).C1 = 's');
201 Write_Info_Terminate;
204 -- Statement continuations should not occur since they
205 -- are supposed to have been handled in the loop above.
212 when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
215 -- For disabled pragma, or nested decision therein, skip
218 if SCO_Pragma_Disabled (T.Pragma_Sloc) then
219 while not SCO_Table.Table (Start).Last loop
223 -- For all other cases output decision line
226 Write_SCO_Initiate (U);
227 Write_Info_Char (T.C1);
230 Write_Info_Char (' ');
231 Output_Source_Location (T.From);
234 -- Loop through table entries for this decision
239 renames SCO_Table.Table (Start);
242 Write_Info_Char (' ');
244 if T.C1 = '!' or else
248 Write_Info_Char (T.C1);
249 Output_Source_Location (T.From);
252 Write_Info_Char (T.C2);
261 Write_Info_Terminate;