]>
Commit | Line | Data |
---|---|---|
f7f0159d AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5ffe0bab | 5 | -- P U T _ S C O S -- |
f7f0159d AC |
6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
8d0d46f4 | 9 | -- Copyright (C) 2009-2021, Free Software Foundation, Inc. -- |
f7f0159d AC |
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 | ||
851e9f19 PMR |
26 | with Namet; |
27 | with Opt; | |
28 | with SCOs; use SCOs; | |
f7f0159d AC |
29 | |
30 | procedure Put_SCOs is | |
11bc76df AC |
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 | |
25adc5fb | 36 | |
cf427f02 AC |
37 | procedure Write_Instance_Table; |
38 | -- Output the SCO table of instances | |
39 | ||
25adc5fb AC |
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 | ||
828d4cf0 TQ |
46 | procedure Output_String (S : String); |
47 | -- Output S | |
48 | ||
25adc5fb AC |
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 | ||
828d4cf0 TQ |
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 | ||
cf427f02 AC |
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 | ||
11bc76df AC |
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); | |
e0c32166 | 115 | |
11bc76df AC |
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 | ||
25adc5fb AC |
133 | -- Start of processing for Put_SCOs |
134 | ||
f7f0159d | 135 | begin |
11bc76df AC |
136 | -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by |
137 | -- convention present but unused. | |
f7f0159d | 138 | |
240fe2a4 | 139 | for U in 1 .. SCO_Unit_Table.Last loop |
f7f0159d AC |
140 | declare |
141 | SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U); | |
142 | ||
143 | Start : Nat; | |
144 | Stop : Nat; | |
145 | ||
146 | begin | |
c5ff22e7 AC |
147 | Start := SUT.From; |
148 | Stop := SUT.To; | |
149 | ||
f7f0159d AC |
150 | -- Loop through SCO entries for this unit |
151 | ||
f7f0159d | 152 | loop |
240fe2a4 AC |
153 | exit when Start = Stop + 1; |
154 | pragma Assert (Start <= Stop); | |
155 | ||
156 | Output_SCO_Line : declare | |
8fb3f5df AC |
157 | T : SCO_Table_Entry renames SCO_Table.Table (Start); |
158 | Continuation : Boolean; | |
f7f0159d | 159 | |
e0c32166 | 160 | Ctr : Nat; |
11bc76df AC |
161 | -- Counter for statement entries |
162 | ||
f7f0159d | 163 | begin |
f7f0159d AC |
164 | case T.C1 is |
165 | ||
3128f955 | 166 | -- Statements (and dominance markers) |
f7f0159d | 167 | |
3128f955 | 168 | when 'S' | '>' => |
25adc5fb | 169 | Ctr := 0; |
8fb3f5df | 170 | Continuation := False; |
9dbf1c3e | 171 | loop |
8fb3f5df | 172 | if Ctr = 0 then |
11bc76df | 173 | Write_SCO_Initiate (U); |
8fb3f5df AC |
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 | ||
9dbf1c3e RD |
182 | Write_Info_Char (' '); |
183 | ||
828d4cf0 TQ |
184 | declare |
185 | Sent : SCO_Table_Entry | |
186 | renames SCO_Table.Table (Start); | |
187 | begin | |
3128f955 AC |
188 | if Sent.C1 = '>' then |
189 | Write_Info_Char (Sent.C1); | |
190 | end if; | |
191 | ||
828d4cf0 TQ |
192 | if Sent.C2 /= ' ' then |
193 | Write_Info_Char (Sent.C2); | |
3128f955 AC |
194 | |
195 | if Sent.C1 = 'S' | |
88a27b18 | 196 | and then (Sent.C2 = 'P' or else Sent.C2 = 'p') |
06ad40d3 | 197 | and then Sent.Pragma_Aspect_Name /= No_Name |
828d4cf0 | 198 | then |
06ad40d3 AC |
199 | Write_Info_Name (Sent.Pragma_Aspect_Name); |
200 | Write_Info_Char (':'); | |
828d4cf0 TQ |
201 | end if; |
202 | end if; | |
9dbf1c3e | 203 | |
3128f955 AC |
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; | |
828d4cf0 | 213 | end; |
9dbf1c3e | 214 | |
8fb3f5df AC |
215 | -- Increment entry counter (up to 6 entries per line, |
216 | -- continuation lines are marked Cs). | |
25adc5fb AC |
217 | |
218 | Ctr := Ctr + 1; | |
25adc5fb AC |
219 | if Ctr = 6 then |
220 | Write_Info_Terminate; | |
25adc5fb AC |
221 | Ctr := 0; |
222 | end if; | |
8fb3f5df | 223 | |
8fb3f5df AC |
224 | exit when SCO_Table.Table (Start).Last; |
225 | Start := Start + 1; | |
9dbf1c3e RD |
226 | end loop; |
227 | ||
b254da66 AC |
228 | if Ctr > 0 then |
229 | Write_Info_Terminate; | |
230 | end if; | |
82923c66 | 231 | |
9dbf1c3e | 232 | -- Decision |
f7f0159d | 233 | |
06ad40d3 | 234 | when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' => |
25adc5fb AC |
235 | Start := Start + 1; |
236 | ||
06ad40d3 AC |
237 | Write_SCO_Initiate (U); |
238 | Write_Info_Char (T.C1); | |
b26be063 | 239 | |
06ad40d3 AC |
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; | |
f7f0159d | 248 | |
06ad40d3 | 249 | -- Loop through table entries for this decision |
f7f0159d | 250 | |
06ad40d3 AC |
251 | loop |
252 | declare | |
246ff1ae | 253 | T : SCO_Table_Entry renames SCO_Table.Table (Start); |
f7f0159d | 254 | |
06ad40d3 | 255 | begin |
f7f0159d AC |
256 | Write_Info_Char (' '); |
257 | ||
06ad40d3 AC |
258 | if T.C1 = '!' or else |
259 | T.C1 = '&' or else | |
260 | T.C1 = '|' | |
261 | then | |
262 | Write_Info_Char (T.C1); | |
0566484a | 263 | pragma Assert (T.C2 /= '?'); |
06ad40d3 | 264 | Output_Source_Location (T.From); |
f7f0159d | 265 | |
06ad40d3 AC |
266 | else |
267 | Write_Info_Char (T.C2); | |
268 | Output_Range (T); | |
269 | end if; | |
f7f0159d | 270 | |
06ad40d3 AC |
271 | exit when T.Last; |
272 | Start := Start + 1; | |
273 | end; | |
274 | end loop; | |
25adc5fb | 275 | |
06ad40d3 | 276 | Write_Info_Terminate; |
25adc5fb | 277 | |
06ad40d3 | 278 | when ASCII.NUL => |
25adc5fb | 279 | |
06ad40d3 | 280 | -- Nullified entry: skip |
82923c66 | 281 | |
06ad40d3 | 282 | null; |
f7f0159d AC |
283 | |
284 | when others => | |
285 | raise Program_Error; | |
286 | end case; | |
240fe2a4 | 287 | end Output_SCO_Line; |
f7f0159d | 288 | |
f7f0159d | 289 | Start := Start + 1; |
f7f0159d AC |
290 | end loop; |
291 | end; | |
f7f0159d | 292 | end loop; |
cf427f02 AC |
293 | |
294 | if Opt.Generate_SCO_Instance_Table then | |
295 | Write_Instance_Table; | |
296 | end if; | |
f7f0159d | 297 | end Put_SCOs; |