]>
Commit | Line | Data |
---|---|---|
f7f0159d AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
e8374e7a | 5 | -- G E T _ S C O S -- |
f7f0159d AC |
6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 2009-2019, 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 | ||
828d4cf0 | 26 | pragma Ada_2005; |
2c1a2cf3 RD |
27 | -- This unit is not part of the compiler proper, it is used in tools that |
28 | -- read SCO information from ALI files (Xcov and sco_test). Ada 2005 | |
29 | -- constructs may therefore be used freely (and are indeed). | |
828d4cf0 | 30 | |
06ad40d3 | 31 | with Namet; use Namet; |
828d4cf0 | 32 | with SCOs; use SCOs; |
828d4cf0 | 33 | with Types; use Types; |
f7f0159d AC |
34 | |
35 | with Ada.IO_Exceptions; use Ada.IO_Exceptions; | |
36 | ||
37 | procedure Get_SCOs is | |
38 | Dnum : Nat; | |
39 | C : Character; | |
40 | Loc1 : Source_Location; | |
41 | Loc2 : Source_Location; | |
42 | Cond : Character; | |
43 | Dtyp : Character; | |
44 | ||
45 | use ASCII; | |
46 | -- For CR/LF | |
47 | ||
ec80da28 RD |
48 | function At_EOL return Boolean; |
49 | -- Skips any spaces, then checks if we are the end of a line. If so, | |
50 | -- returns True (but does not skip over the EOL sequence). If not, | |
51 | -- then returns False. | |
52 | ||
f7f0159d AC |
53 | procedure Check (C : Character); |
54 | -- Checks that file is positioned at given character, and if so skips past | |
55 | -- it, If not, raises Data_Error. | |
56 | ||
57 | function Get_Int return Int; | |
58 | -- On entry the file is positioned to a digit. On return, the file is | |
59 | -- positioned past the last digit, and the returned result is the decimal | |
60 | -- value read. Data_Error is raised for overflow (value greater than | |
61 | -- Int'Last), or if the initial character is not a digit. | |
62 | ||
25adc5fb AC |
63 | procedure Get_Source_Location (Loc : out Source_Location); |
64 | -- Reads a source location in the form line:col and places the source | |
65 | -- location in Loc. Raises Data_Error if the format does not match this | |
66 | -- requirement. Note that initial spaces are not skipped. | |
67 | ||
68 | procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location); | |
f7f0159d AC |
69 | -- Skips initial spaces, then reads a source location range in the form |
70 | -- line:col-line:col and places the two source locations in Loc1 and Loc2. | |
71 | -- Raises Data_Error if format does not match this requirement. | |
72 | ||
73 | procedure Skip_EOL; | |
74 | -- Called with the current character about to be read being LF or CR. Skips | |
839de535 | 75 | -- past CR/LF characters until either a non-CR/LF character is found, or |
f7f0159d AC |
76 | -- the end of file is encountered. |
77 | ||
78 | procedure Skip_Spaces; | |
79 | -- Skips zero or more spaces at the current position, leaving the file | |
80 | -- positioned at the first non-blank character (or Types.EOF). | |
81 | ||
ec80da28 RD |
82 | ------------ |
83 | -- At_EOL -- | |
84 | ------------ | |
85 | ||
86 | function At_EOL return Boolean is | |
87 | begin | |
88 | Skip_Spaces; | |
89 | return Nextc = CR or else Nextc = LF; | |
90 | end At_EOL; | |
91 | ||
f7f0159d AC |
92 | ----------- |
93 | -- Check -- | |
94 | ----------- | |
95 | ||
96 | procedure Check (C : Character) is | |
97 | begin | |
98 | if Nextc = C then | |
99 | Skipc; | |
100 | else | |
101 | raise Data_Error; | |
102 | end if; | |
103 | end Check; | |
104 | ||
105 | ------------- | |
106 | -- Get_Int -- | |
107 | ------------- | |
108 | ||
109 | function Get_Int return Int is | |
110 | Val : Int; | |
111 | C : Character; | |
112 | ||
113 | begin | |
114 | C := Nextc; | |
115 | Val := 0; | |
116 | ||
117 | if C not in '0' .. '9' then | |
118 | raise Data_Error; | |
119 | end if; | |
120 | ||
121 | -- Loop to read digits of integer value | |
122 | ||
123 | loop | |
124 | declare | |
125 | pragma Unsuppress (Overflow_Check); | |
126 | begin | |
127 | Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0')); | |
128 | end; | |
129 | ||
130 | Skipc; | |
131 | C := Nextc; | |
132 | ||
133 | exit when C not in '0' .. '9'; | |
134 | end loop; | |
135 | ||
136 | return Val; | |
137 | ||
138 | exception | |
139 | when Constraint_Error => | |
140 | raise Data_Error; | |
141 | end Get_Int; | |
142 | ||
25adc5fb AC |
143 | ------------------------- |
144 | -- Get_Source_Location -- | |
145 | ------------------------- | |
f7f0159d | 146 | |
25adc5fb | 147 | procedure Get_Source_Location (Loc : out Source_Location) is |
f7f0159d | 148 | pragma Unsuppress (Range_Check); |
f7f0159d | 149 | begin |
25adc5fb | 150 | Loc.Line := Logical_Line_Number (Get_Int); |
f7f0159d | 151 | Check (':'); |
25adc5fb | 152 | Loc.Col := Column_Number (Get_Int); |
f7f0159d AC |
153 | exception |
154 | when Constraint_Error => | |
155 | raise Data_Error; | |
25adc5fb AC |
156 | end Get_Source_Location; |
157 | ||
158 | ------------------------------- | |
159 | -- Get_Source_Location_Range -- | |
160 | ------------------------------- | |
f7f0159d | 161 | |
25adc5fb AC |
162 | procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location) is |
163 | begin | |
164 | Skip_Spaces; | |
165 | Get_Source_Location (Loc1); | |
166 | Check ('-'); | |
167 | Get_Source_Location (Loc2); | |
168 | end Get_Source_Location_Range; | |
5cd7bb15 | 169 | |
f7f0159d AC |
170 | -------------- |
171 | -- Skip_EOL -- | |
172 | -------------- | |
173 | ||
174 | procedure Skip_EOL is | |
175 | C : Character; | |
176 | ||
177 | begin | |
178 | loop | |
179 | Skipc; | |
240fe2a4 | 180 | C := Nextc; |
f7f0159d | 181 | exit when C /= LF and then C /= CR; |
f7f0159d AC |
182 | end loop; |
183 | end Skip_EOL; | |
184 | ||
185 | ----------------- | |
186 | -- Skip_Spaces -- | |
187 | ----------------- | |
188 | ||
189 | procedure Skip_Spaces is | |
190 | begin | |
191 | while Nextc = ' ' loop | |
192 | Skipc; | |
193 | end loop; | |
194 | end Skip_Spaces; | |
195 | ||
828d4cf0 TQ |
196 | Buf : String (1 .. 32_768); |
197 | N : Natural; | |
198 | -- Scratch buffer, and index into it | |
199 | ||
06ad40d3 AC |
200 | Nam : Name_Id; |
201 | ||
7130729a | 202 | -- Start of processing for Get_SCOs |
f7f0159d AC |
203 | |
204 | begin | |
240fe2a4 | 205 | SCOs.Initialize; |
f7f0159d AC |
206 | |
207 | -- Loop through lines of SCO information | |
208 | ||
209 | while Nextc = 'C' loop | |
210 | Skipc; | |
211 | ||
212 | C := Getc; | |
213 | ||
214 | -- Make sure first line is a header line | |
215 | ||
216 | if SCO_Unit_Table.Last = 0 and then C /= ' ' then | |
217 | raise Data_Error; | |
218 | end if; | |
219 | ||
220 | -- Otherwise dispatch on type of line | |
221 | ||
222 | case C is | |
223 | ||
cf427f02 | 224 | -- Header or instance table entry |
f7f0159d AC |
225 | |
226 | when ' ' => | |
227 | ||
228 | -- Complete previous entry if any | |
229 | ||
230 | if SCO_Unit_Table.Last /= 0 then | |
231 | SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := | |
232 | SCO_Table.Last; | |
233 | end if; | |
234 | ||
828d4cf0 | 235 | Skip_Spaces; |
f7f0159d | 236 | |
cf427f02 AC |
237 | case Nextc is |
238 | ||
239 | -- Instance table entry | |
240 | ||
241 | when 'i' => | |
242 | declare | |
243 | Inum : SCO_Instance_Index; | |
244 | begin | |
245 | Skipc; | |
246 | Skip_Spaces; | |
247 | ||
248 | Inum := SCO_Instance_Index (Get_Int); | |
249 | SCO_Instance_Table.Increment_Last; | |
250 | pragma Assert (SCO_Instance_Table.Last = Inum); | |
251 | ||
252 | Skip_Spaces; | |
253 | declare | |
254 | SIE : SCO_Instance_Table_Entry | |
255 | renames SCO_Instance_Table.Table (Inum); | |
256 | begin | |
257 | SIE.Inst_Dep_Num := Get_Int; | |
258 | C := Getc; | |
259 | pragma Assert (C = '|'); | |
260 | Get_Source_Location (SIE.Inst_Loc); | |
261 | ||
7130729a TQ |
262 | if At_EOL then |
263 | SIE.Enclosing_Instance := 0; | |
264 | else | |
cf427f02 AC |
265 | Skip_Spaces; |
266 | SIE.Enclosing_Instance := | |
267 | SCO_Instance_Index (Get_Int); | |
268 | pragma Assert (SIE.Enclosing_Instance in | |
269 | SCO_Instance_Table.First | |
270 | .. SCO_Instance_Table.Last); | |
271 | end if; | |
272 | end; | |
273 | end; | |
274 | ||
275 | -- Unit header | |
276 | ||
277 | when '0' .. '9' => | |
278 | -- Scan out dependency number and file name | |
279 | ||
280 | Dnum := Get_Int; | |
281 | ||
282 | Skip_Spaces; | |
283 | ||
284 | N := 0; | |
285 | while Nextc > ' ' loop | |
286 | N := N + 1; | |
287 | Buf (N) := Getc; | |
288 | end loop; | |
289 | ||
290 | -- Make new unit table entry (will fill in To later) | |
291 | ||
292 | SCO_Unit_Table.Append ( | |
baa571ab AC |
293 | (File_Name => new String'(Buf (1 .. N)), |
294 | File_Index => 0, | |
295 | Dep_Num => Dnum, | |
296 | From => SCO_Table.Last + 1, | |
297 | To => 0)); | |
cf427f02 | 298 | |
4528392f AC |
299 | when others => |
300 | raise Program_Error; | |
cf427f02 | 301 | end case; |
f7f0159d AC |
302 | |
303 | -- Statement entry | |
304 | ||
25adc5fb | 305 | when 'S' | 's' => |
ec80da28 RD |
306 | declare |
307 | Typ : Character; | |
308 | Key : Character; | |
309 | ||
310 | begin | |
3128f955 AC |
311 | Key := 'S'; |
312 | ||
313 | -- If continuation, reset Last indication in last entry stored | |
314 | -- for previous CS or cs line. | |
25adc5fb AC |
315 | |
316 | if C = 's' then | |
317 | SCO_Table.Table (SCO_Table.Last).Last := False; | |
25adc5fb AC |
318 | end if; |
319 | ||
320 | -- Initialize to scan items on one line | |
321 | ||
ec80da28 | 322 | Skip_Spaces; |
25adc5fb AC |
323 | |
324 | -- Loop through items on one line | |
ec80da28 RD |
325 | |
326 | loop | |
06ad40d3 | 327 | Nam := No_Name; |
ec80da28 RD |
328 | Typ := Nextc; |
329 | ||
3128f955 AC |
330 | case Typ is |
331 | when '>' => | |
9c25bb25 AC |
332 | |
333 | -- Dominance marker may be present only at entry point | |
3128f955 AC |
334 | |
335 | pragma Assert (Key = 'S'); | |
336 | ||
9c25bb25 | 337 | Skipc; |
3128f955 | 338 | Key := '>'; |
9c25bb25 | 339 | Typ := Getc; |
3128f955 | 340 | |
7130729a TQ |
341 | -- Sanity check on dominance marker type indication |
342 | ||
343 | pragma Assert (Typ in 'A' .. 'Z'); | |
344 | ||
3128f955 AC |
345 | when '1' .. '9' => |
346 | Typ := ' '; | |
347 | ||
348 | when others => | |
349 | Skipc; | |
88a27b18 | 350 | if Typ = 'P' or else Typ = 'p' then |
3128f955 | 351 | if Nextc not in '1' .. '9' then |
06ad40d3 | 352 | Name_Len := 0; |
3128f955 | 353 | loop |
06ad40d3 AC |
354 | Name_Len := Name_Len + 1; |
355 | Name_Buffer (Name_Len) := Getc; | |
3128f955 | 356 | exit when Nextc = ':'; |
3128f955 | 357 | end loop; |
9c25bb25 | 358 | |
06ad40d3 | 359 | Skipc; -- Past ':' |
3128f955 | 360 | |
06ad40d3 | 361 | Nam := Name_Find; |
3128f955 | 362 | end if; |
94fb7608 | 363 | end if; |
3128f955 | 364 | end case; |
ec80da28 | 365 | |
3128f955 AC |
366 | if Key = '>' and then Typ /= 'E' then |
367 | Get_Source_Location (Loc1); | |
368 | Loc2 := No_Source_Location; | |
369 | else | |
370 | Get_Source_Location_Range (Loc1, Loc2); | |
371 | end if; | |
ec80da28 | 372 | |
828d4cf0 | 373 | SCO_Table.Append |
06ad40d3 AC |
374 | ((C1 => Key, |
375 | C2 => Typ, | |
376 | From => Loc1, | |
377 | To => Loc2, | |
378 | Last => At_EOL, | |
379 | Pragma_Sloc => No_Location, | |
380 | Pragma_Aspect_Name => Nam)); | |
ec80da28 | 381 | |
3128f955 AC |
382 | if Key = '>' then |
383 | Key := 'S'; | |
384 | end if; | |
385 | ||
ec80da28 | 386 | exit when At_EOL; |
ec80da28 RD |
387 | end loop; |
388 | end; | |
f7f0159d | 389 | |
f7f0159d AC |
390 | -- Decision entry |
391 | ||
06ad40d3 | 392 | when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' => |
f7f0159d | 393 | Dtyp := C; |
06ad40d3 AC |
394 | |
395 | if C = 'A' then | |
396 | Name_Len := 0; | |
397 | while Nextc /= ' ' loop | |
398 | Name_Len := Name_Len + 1; | |
399 | Name_Buffer (Name_Len) := Getc; | |
400 | end loop; | |
246ff1ae | 401 | |
06ad40d3 AC |
402 | Nam := Name_Find; |
403 | ||
404 | else | |
405 | Nam := No_Name; | |
406 | end if; | |
407 | ||
f7f0159d | 408 | Skip_Spaces; |
f7f0159d | 409 | |
25adc5fb AC |
410 | -- Output header |
411 | ||
412 | declare | |
413 | Loc : Source_Location; | |
414 | ||
415 | begin | |
416 | -- Acquire location information | |
417 | ||
418 | if Dtyp = 'X' then | |
419 | Loc := No_Source_Location; | |
420 | else | |
421 | Get_Source_Location (Loc); | |
422 | end if; | |
f7f0159d | 423 | |
828d4cf0 | 424 | SCO_Table.Append |
06ad40d3 AC |
425 | ((C1 => Dtyp, |
426 | C2 => ' ', | |
427 | From => Loc, | |
428 | To => No_Source_Location, | |
429 | Last => False, | |
430 | Pragma_Aspect_Name => Nam, | |
431 | others => <>)); | |
25adc5fb | 432 | end; |
f7f0159d | 433 | |
25adc5fb AC |
434 | -- Loop through terms in complex expression |
435 | ||
436 | C := Nextc; | |
437 | while C /= CR and then C /= LF loop | |
438 | if C = 'c' or else C = 't' or else C = 'f' then | |
439 | Cond := C; | |
440 | Skipc; | |
441 | Get_Source_Location_Range (Loc1, Loc2); | |
828d4cf0 TQ |
442 | SCO_Table.Append |
443 | ((C2 => Cond, | |
444 | From => Loc1, | |
445 | To => Loc2, | |
446 | Last => False, | |
447 | others => <>)); | |
f7f0159d | 448 | |
25adc5fb AC |
449 | elsif C = '!' or else |
450 | C = '&' or else | |
451 | C = '|' | |
452 | then | |
453 | Skipc; | |
f7f0159d | 454 | |
25adc5fb AC |
455 | declare |
456 | Loc : Source_Location; | |
457 | begin | |
458 | Get_Source_Location (Loc); | |
828d4cf0 TQ |
459 | SCO_Table.Append |
460 | ((C1 => C, | |
461 | From => Loc, | |
462 | Last => False, | |
463 | others => <>)); | |
25adc5fb | 464 | end; |
f7f0159d | 465 | |
25adc5fb AC |
466 | elsif C = ' ' then |
467 | Skip_Spaces; | |
f7f0159d | 468 | |
0bfc9a64 AC |
469 | elsif C = 'T' or else C = 'F' then |
470 | ||
471 | -- Chaining indicator: skip for now??? | |
472 | ||
473 | declare | |
474 | Loc1, Loc2 : Source_Location; | |
475 | pragma Unreferenced (Loc1, Loc2); | |
476 | begin | |
477 | Skipc; | |
478 | Get_Source_Location_Range (Loc1, Loc2); | |
479 | end; | |
480 | ||
25adc5fb AC |
481 | else |
482 | raise Data_Error; | |
483 | end if; | |
240fe2a4 | 484 | |
25adc5fb AC |
485 | C := Nextc; |
486 | end loop; | |
240fe2a4 | 487 | |
25adc5fb | 488 | -- Reset Last indication to True for last entry |
f7f0159d | 489 | |
25adc5fb | 490 | SCO_Table.Table (SCO_Table.Last).Last := True; |
f7f0159d | 491 | |
25adc5fb | 492 | -- No other SCO lines are possible |
f7f0159d AC |
493 | |
494 | when others => | |
495 | raise Data_Error; | |
496 | end case; | |
497 | ||
498 | Skip_EOL; | |
499 | end loop; | |
500 | ||
501 | -- Here with all SCO's stored, complete last SCO Unit table entry | |
502 | ||
503 | SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last; | |
504 | end Get_SCOs; |