|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P U T _ S C O S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2009-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Namet;
|
|
|
27 with Opt;
|
|
|
28 with SCOs; use SCOs;
|
|
|
29
|
|
|
30 procedure Put_SCOs is
|
|
|
31 Current_SCO_Unit : SCO_Unit_Index := 0;
|
|
|
32 -- Initial value must not be a valid unit index
|
|
|
33
|
|
|
34 procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
|
|
|
35 -- Start SCO line for unit SU, also emitting SCO unit header if necessary
|
|
|
36
|
|
|
37 procedure Write_Instance_Table;
|
|
|
38 -- Output the SCO table of instances
|
|
|
39
|
|
|
40 procedure Output_Range (T : SCO_Table_Entry);
|
|
|
41 -- Outputs T.From and T.To in line:col-line:col format
|
|
|
42
|
|
|
43 procedure Output_Source_Location (Loc : Source_Location);
|
|
|
44 -- Output source location in line:col format
|
|
|
45
|
|
|
46 procedure Output_String (S : String);
|
|
|
47 -- Output S
|
|
|
48
|
|
|
49 ------------------
|
|
|
50 -- Output_Range --
|
|
|
51 ------------------
|
|
|
52
|
|
|
53 procedure Output_Range (T : SCO_Table_Entry) is
|
|
|
54 begin
|
|
|
55 Output_Source_Location (T.From);
|
|
|
56 Write_Info_Char ('-');
|
|
|
57 Output_Source_Location (T.To);
|
|
|
58 end Output_Range;
|
|
|
59
|
|
|
60 ----------------------------
|
|
|
61 -- Output_Source_Location --
|
|
|
62 ----------------------------
|
|
|
63
|
|
|
64 procedure Output_Source_Location (Loc : Source_Location) is
|
|
|
65 begin
|
|
|
66 Write_Info_Nat (Nat (Loc.Line));
|
|
|
67 Write_Info_Char (':');
|
|
|
68 Write_Info_Nat (Nat (Loc.Col));
|
|
|
69 end Output_Source_Location;
|
|
|
70
|
|
|
71 -------------------
|
|
|
72 -- Output_String --
|
|
|
73 -------------------
|
|
|
74
|
|
|
75 procedure Output_String (S : String) is
|
|
|
76 begin
|
|
|
77 for J in S'Range loop
|
|
|
78 Write_Info_Char (S (J));
|
|
|
79 end loop;
|
|
|
80 end Output_String;
|
|
|
81
|
|
|
82 --------------------------
|
|
|
83 -- Write_Instance_Table --
|
|
|
84 --------------------------
|
|
|
85
|
|
|
86 procedure Write_Instance_Table is
|
|
|
87 begin
|
|
|
88 for J in 1 .. SCO_Instance_Table.Last loop
|
|
|
89 declare
|
|
|
90 SIE : SCO_Instance_Table_Entry
|
|
|
91 renames SCO_Instance_Table.Table (J);
|
|
|
92 begin
|
|
|
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);
|
|
|
99
|
|
|
100 if SIE.Enclosing_Instance > 0 then
|
|
|
101 Write_Info_Char (' ');
|
|
|
102 Write_Info_Nat (Nat (SIE.Enclosing_Instance));
|
|
|
103 end if;
|
|
|
104 Write_Info_Terminate;
|
|
|
105 end;
|
|
|
106 end loop;
|
|
|
107 end Write_Instance_Table;
|
|
|
108
|
|
|
109 ------------------------
|
|
|
110 -- Write_SCO_Initiate --
|
|
|
111 ------------------------
|
|
|
112
|
|
|
113 procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
|
|
|
114 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
|
|
|
115
|
|
|
116 begin
|
|
|
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 (' ');
|
|
|
122
|
|
|
123 Output_String (SUT.File_Name.all);
|
|
|
124
|
|
|
125 Write_Info_Terminate;
|
|
|
126
|
|
|
127 Current_SCO_Unit := SU;
|
|
|
128 end if;
|
|
|
129
|
|
|
130 Write_Info_Initiate ('C');
|
|
|
131 end Write_SCO_Initiate;
|
|
|
132
|
|
|
133 -- Start of processing for Put_SCOs
|
|
|
134
|
|
|
135 begin
|
|
|
136 -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
|
|
|
137 -- convention present but unused.
|
|
|
138
|
|
|
139 for U in 1 .. SCO_Unit_Table.Last loop
|
|
|
140 declare
|
|
|
141 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
|
|
|
142
|
|
|
143 Start : Nat;
|
|
|
144 Stop : Nat;
|
|
|
145
|
|
|
146 begin
|
|
|
147 Start := SUT.From;
|
|
|
148 Stop := SUT.To;
|
|
|
149
|
|
|
150 -- Loop through SCO entries for this unit
|
|
|
151
|
|
|
152 loop
|
|
|
153 exit when Start = Stop + 1;
|
|
|
154 pragma Assert (Start <= Stop);
|
|
|
155
|
|
|
156 Output_SCO_Line : declare
|
|
|
157 T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
|
|
158 Continuation : Boolean;
|
|
|
159
|
|
|
160 Ctr : Nat;
|
|
|
161 -- Counter for statement entries
|
|
|
162
|
|
|
163 begin
|
|
|
164 case T.C1 is
|
|
|
165
|
|
|
166 -- Statements (and dominance markers)
|
|
|
167
|
|
|
168 when 'S' | '>' =>
|
|
|
169 Ctr := 0;
|
|
|
170 Continuation := False;
|
|
|
171 loop
|
|
|
172 if Ctr = 0 then
|
|
|
173 Write_SCO_Initiate (U);
|
|
|
174 if not Continuation then
|
|
|
175 Write_Info_Char ('S');
|
|
|
176 Continuation := True;
|
|
|
177 else
|
|
|
178 Write_Info_Char ('s');
|
|
|
179 end if;
|
|
|
180 end if;
|
|
|
181
|
|
|
182 Write_Info_Char (' ');
|
|
|
183
|
|
|
184 declare
|
|
|
185 Sent : SCO_Table_Entry
|
|
|
186 renames SCO_Table.Table (Start);
|
|
|
187 begin
|
|
|
188 if Sent.C1 = '>' then
|
|
|
189 Write_Info_Char (Sent.C1);
|
|
|
190 end if;
|
|
|
191
|
|
|
192 if Sent.C2 /= ' ' then
|
|
|
193 Write_Info_Char (Sent.C2);
|
|
|
194
|
|
|
195 if Sent.C1 = 'S'
|
|
|
196 and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
|
|
|
197 and then Sent.Pragma_Aspect_Name /= No_Name
|
|
|
198 then
|
|
|
199 Write_Info_Name (Sent.Pragma_Aspect_Name);
|
|
|
200 Write_Info_Char (':');
|
|
|
201 end if;
|
|
|
202 end if;
|
|
|
203
|
|
|
204 -- For dependence markers (except E), output sloc.
|
|
|
205 -- For >E and all statement entries, output sloc
|
|
|
206 -- range.
|
|
|
207
|
|
|
208 if Sent.C1 = '>' and then Sent.C2 /= 'E' then
|
|
|
209 Output_Source_Location (Sent.From);
|
|
|
210 else
|
|
|
211 Output_Range (Sent);
|
|
|
212 end if;
|
|
|
213 end;
|
|
|
214
|
|
|
215 -- Increment entry counter (up to 6 entries per line,
|
|
|
216 -- continuation lines are marked Cs).
|
|
|
217
|
|
|
218 Ctr := Ctr + 1;
|
|
|
219 if Ctr = 6 then
|
|
|
220 Write_Info_Terminate;
|
|
|
221 Ctr := 0;
|
|
|
222 end if;
|
|
|
223
|
|
|
224 exit when SCO_Table.Table (Start).Last;
|
|
|
225 Start := Start + 1;
|
|
|
226 end loop;
|
|
|
227
|
|
|
228 if Ctr > 0 then
|
|
|
229 Write_Info_Terminate;
|
|
|
230 end if;
|
|
|
231
|
|
|
232 -- Decision
|
|
|
233
|
|
|
234 when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
|
|
|
235 Start := Start + 1;
|
|
|
236
|
|
|
237 Write_SCO_Initiate (U);
|
|
|
238 Write_Info_Char (T.C1);
|
|
|
239
|
|
|
240 if T.C1 = 'A' then
|
|
|
241 Write_Info_Name (T.Pragma_Aspect_Name);
|
|
|
242 end if;
|
|
|
243
|
|
|
244 if T.C1 /= 'X' then
|
|
|
245 Write_Info_Char (' ');
|
|
|
246 Output_Source_Location (T.From);
|
|
|
247 end if;
|
|
|
248
|
|
|
249 -- Loop through table entries for this decision
|
|
|
250
|
|
|
251 loop
|
|
|
252 declare
|
|
|
253 T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
|
|
254
|
|
|
255 begin
|
|
|
256 Write_Info_Char (' ');
|
|
|
257
|
|
|
258 if T.C1 = '!' or else
|
|
|
259 T.C1 = '&' or else
|
|
|
260 T.C1 = '|'
|
|
|
261 then
|
|
|
262 Write_Info_Char (T.C1);
|
|
|
263 pragma Assert (T.C2 /= '?');
|
|
|
264 Output_Source_Location (T.From);
|
|
|
265
|
|
|
266 else
|
|
|
267 Write_Info_Char (T.C2);
|
|
|
268 Output_Range (T);
|
|
|
269 end if;
|
|
|
270
|
|
|
271 exit when T.Last;
|
|
|
272 Start := Start + 1;
|
|
|
273 end;
|
|
|
274 end loop;
|
|
|
275
|
|
|
276 Write_Info_Terminate;
|
|
|
277
|
|
|
278 when ASCII.NUL =>
|
|
|
279
|
|
|
280 -- Nullified entry: skip
|
|
|
281
|
|
|
282 null;
|
|
|
283
|
|
|
284 when others =>
|
|
|
285 raise Program_Error;
|
|
|
286 end case;
|
|
|
287 end Output_SCO_Line;
|
|
|
288
|
|
|
289 Start := Start + 1;
|
|
|
290 end loop;
|
|
|
291 end;
|
|
|
292 end loop;
|
|
|
293
|
|
|
294 if Opt.Generate_SCO_Instance_Table then
|
|
|
295 Write_Instance_Table;
|
|
|
296 end if;
|
|
|
297 end Put_SCOs;
|
