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 Namet; use Namet;
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 Write_Instance_Table;
38 -- Output the SCO table of instances
40 procedure Output_Range (T : SCO_Table_Entry);
41 -- Outputs T.From and T.To in line:col-line:col format
43 procedure Output_Source_Location (Loc : Source_Location);
44 -- Output source location in line:col format
46 procedure Output_String (S : String);
53 procedure Output_Range (T : SCO_Table_Entry) is
55 Output_Source_Location (T.From);
56 Write_Info_Char ('-');
57 Output_Source_Location (T.To);
60 ----------------------------
61 -- Output_Source_Location --
62 ----------------------------
64 procedure Output_Source_Location (Loc : Source_Location) is
66 Write_Info_Nat (Nat (Loc.Line));
67 Write_Info_Char (':');
68 Write_Info_Nat (Nat (Loc.Col));
69 end Output_Source_Location;
75 procedure Output_String (S : String) is
78 Write_Info_Char (S (J));
82 --------------------------
83 -- Write_Instance_Table --
84 --------------------------
86 procedure Write_Instance_Table is
88 for J in 1 .. SCO_Instance_Table.Last loop
90 SIE : SCO_Instance_Table_Entry
91 renames SCO_Instance_Table.Table (J);
93 Output_String ("C i ");
94 Write_Info_Nat (Nat (J));
95 Write_Info_Char (' ');
96 Write_Info_Nat (SIE.Inst_Dep_Num);
97 Write_Info_Char ('|');
98 Output_Source_Location (SIE.Inst_Loc);
100 if SIE.Enclosing_Instance > 0 then
101 Write_Info_Char (' ');
102 Write_Info_Nat (Nat (SIE.Enclosing_Instance));
104 Write_Info_Terminate;
107 end Write_Instance_Table;
109 ------------------------
110 -- Write_SCO_Initiate --
111 ------------------------
113 procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
114 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
117 if Current_SCO_Unit /= SU then
118 Write_Info_Initiate ('C');
119 Write_Info_Char (' ');
120 Write_Info_Nat (SUT.Dep_Num);
121 Write_Info_Char (' ');
123 Output_String (SUT.File_Name.all);
125 Write_Info_Terminate;
127 Current_SCO_Unit := SU;
130 Write_Info_Initiate ('C');
131 end Write_SCO_Initiate;
133 -- Start of processing for Put_SCOs
136 -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
137 -- convention present but unused.
139 for U in 1 .. SCO_Unit_Table.Last loop
141 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
150 -- Loop through SCO entries for this unit
153 exit when Start = Stop + 1;
154 pragma Assert (Start <= Stop);
156 Output_SCO_Line : declare
157 T : SCO_Table_Entry renames SCO_Table.Table (Start);
158 Continuation : Boolean;
161 -- Counter for statement entries
166 -- Statements (and dominance markers)
170 Continuation := False;
173 Write_SCO_Initiate (U);
174 if not Continuation then
175 Write_Info_Char ('S');
176 Continuation := True;
178 Write_Info_Char ('s');
182 Write_Info_Char (' ');
185 Sent : SCO_Table_Entry
186 renames SCO_Table.Table (Start);
188 if Sent.C1 = '>' then
189 Write_Info_Char (Sent.C1);
192 if Sent.C2 /= ' ' then
193 Write_Info_Char (Sent.C2);
196 and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
197 and then Sent.Pragma_Aspect_Name /= No_Name
199 Write_Info_Name (Sent.Pragma_Aspect_Name);
200 Write_Info_Char (':');
204 -- For dependence markers (except E), output sloc.
205 -- For >E and all statement entries, output sloc
208 if Sent.C1 = '>' and then Sent.C2 /= 'E' then
209 Output_Source_Location (Sent.From);
215 -- Increment entry counter (up to 6 entries per line,
216 -- continuation lines are marked Cs).
220 Write_Info_Terminate;
224 exit when SCO_Table.Table (Start).Last;
229 Write_Info_Terminate;
234 when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
237 Write_SCO_Initiate (U);
238 Write_Info_Char (T.C1);
241 Write_Info_Name (T.Pragma_Aspect_Name);
245 Write_Info_Char (' ');
246 Output_Source_Location (T.From);
249 -- Loop through table entries for this decision
253 T : SCO_Table_Entry renames SCO_Table.Table (Start);
256 Write_Info_Char (' ');
258 if T.C1 = '!' or else
262 Write_Info_Char (T.C1);
263 Output_Source_Location (T.From);
266 Write_Info_Char (T.C2);
275 Write_Info_Terminate;
279 -- Nullified entry: skip
293 if Opt.Generate_SCO_Instance_Table then
294 Write_Instance_Table;