1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009-2012, 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
136 -- Statements (and dominance markers)
140 Continuation := False;
143 Write_SCO_Initiate (U);
144 if not Continuation then
145 Write_Info_Char ('S');
146 Continuation := True;
148 Write_Info_Char ('s');
152 Write_Info_Char (' ');
155 Sent : SCO_Table_Entry
156 renames SCO_Table.Table (Start);
158 if Sent.C1 = '>' then
159 Write_Info_Char (Sent.C1);
162 if Sent.C2 /= ' ' then
163 Write_Info_Char (Sent.C2);
166 and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
167 and then Sent.Pragma_Name /= Unknown_Pragma
169 -- Strip leading "PRAGMA_"
172 Pnam : constant String :=
173 Sent.Pragma_Name'Img;
176 (Pnam (Pnam'First + 7 .. Pnam'Last));
177 Write_Info_Char (':');
182 -- For dependence markers (except E), output sloc.
183 -- For >E and all statement entries, output sloc
186 if Sent.C1 = '>' and then Sent.C2 /= 'E' then
187 Output_Source_Location (Sent.From);
193 -- Increment entry counter (up to 6 entries per line,
194 -- continuation lines are marked Cs).
198 Write_Info_Terminate;
202 exit when SCO_Table.Table (Start).Last;
207 Write_Info_Terminate;
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;