111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- A L I . U T I L --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
131
|
9 -- Copyright (C) 1992-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 Debug; use Debug;
|
|
27 with Binderr; use Binderr;
|
|
28 with Opt; use Opt;
|
|
29 with Output; use Output;
|
|
30 with Osint; use Osint;
|
|
31 with Scans; use Scans;
|
|
32 with Scng;
|
|
33 with Sinput.C;
|
|
34 with Snames; use Snames;
|
|
35 with Stringt;
|
|
36 with Styleg;
|
|
37
|
|
38 with System.OS_Lib; use System.OS_Lib;
|
|
39
|
|
40 package body ALI.Util is
|
|
41
|
|
42 -- Empty procedures needed to instantiate Scng. Error procedures are
|
|
43 -- empty, because we don't want to report any errors when computing
|
|
44 -- a source checksum.
|
|
45
|
|
46 procedure Post_Scan;
|
|
47
|
|
48 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
|
|
49
|
|
50 procedure Error_Msg_S (Msg : String);
|
|
51
|
|
52 procedure Error_Msg_SC (Msg : String);
|
|
53
|
|
54 procedure Error_Msg_SP (Msg : String);
|
|
55
|
|
56 -- Instantiation of Styleg, needed to instantiate Scng
|
|
57
|
|
58 package Style is new Styleg
|
|
59 (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
|
|
60
|
|
61 -- A Scanner is needed to get checksum of a source (procedure
|
|
62 -- Get_File_Checksum).
|
|
63
|
|
64 package Scanner is new Scng
|
|
65 (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
|
|
66
|
|
67 type Header_Num is range 0 .. 1_000;
|
|
68
|
|
69 function Hash (F : File_Name_Type) return Header_Num;
|
|
70 -- Function used to compute hash of ALI file name
|
|
71
|
|
72 package Interfaces is new Simple_HTable (
|
|
73 Header_Num => Header_Num,
|
|
74 Element => Boolean,
|
|
75 No_Element => False,
|
|
76 Key => File_Name_Type,
|
|
77 Hash => Hash,
|
|
78 Equal => "=");
|
|
79
|
|
80 ---------------------
|
|
81 -- Checksums_Match --
|
|
82 ---------------------
|
|
83
|
|
84 function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
|
|
85 begin
|
|
86 return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
|
|
87 end Checksums_Match;
|
|
88
|
|
89 ---------------
|
|
90 -- Error_Msg --
|
|
91 ---------------
|
|
92
|
|
93 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
|
|
94 pragma Warnings (Off, Msg);
|
|
95 pragma Warnings (Off, Flag_Location);
|
|
96 begin
|
|
97 null;
|
|
98 end Error_Msg;
|
|
99
|
|
100 -----------------
|
|
101 -- Error_Msg_S --
|
|
102 -----------------
|
|
103
|
|
104 procedure Error_Msg_S (Msg : String) is
|
|
105 pragma Warnings (Off, Msg);
|
|
106 begin
|
|
107 null;
|
|
108 end Error_Msg_S;
|
|
109
|
|
110 ------------------
|
|
111 -- Error_Msg_SC --
|
|
112 ------------------
|
|
113
|
|
114 procedure Error_Msg_SC (Msg : String) is
|
|
115 pragma Warnings (Off, Msg);
|
|
116 begin
|
|
117 null;
|
|
118 end Error_Msg_SC;
|
|
119
|
|
120 ------------------
|
|
121 -- Error_Msg_SP --
|
|
122 ------------------
|
|
123
|
|
124 procedure Error_Msg_SP (Msg : String) is
|
|
125 pragma Warnings (Off, Msg);
|
|
126 begin
|
|
127 null;
|
|
128 end Error_Msg_SP;
|
|
129
|
|
130 -----------------------
|
|
131 -- Get_File_Checksum --
|
|
132 -----------------------
|
|
133
|
|
134 function Get_File_Checksum (Fname : File_Name_Type) return Word is
|
|
135 Full_Name : File_Name_Type;
|
|
136 Source_Index : Source_File_Index;
|
|
137
|
|
138 begin
|
|
139 Full_Name := Find_File (Fname, Osint.Source);
|
|
140
|
|
141 -- If we cannot find the file, then return an impossible checksum,
|
|
142 -- impossible because checksums have the high order bit zero, so
|
|
143 -- that checksums do not match.
|
|
144
|
|
145 if Full_Name = No_File then
|
|
146 return Checksum_Error;
|
|
147 end if;
|
|
148
|
|
149 Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
|
|
150
|
|
151 if Source_Index <= No_Source_File then
|
|
152 return Checksum_Error;
|
|
153 end if;
|
|
154
|
|
155 Scanner.Initialize_Scanner (Source_Index);
|
|
156
|
|
157 -- Make sure that the project language reserved words are not
|
|
158 -- recognized as reserved words, but as identifiers. The byte info for
|
|
159 -- those names have been set if we are in gnatmake.
|
|
160
|
|
161 Set_Name_Table_Byte (Name_Project, 0);
|
|
162 Set_Name_Table_Byte (Name_Extends, 0);
|
|
163 Set_Name_Table_Byte (Name_External, 0);
|
|
164 Set_Name_Table_Byte (Name_External_As_List, 0);
|
|
165
|
|
166 -- Scan the complete file to compute its checksum
|
|
167
|
|
168 loop
|
|
169 Scanner.Scan;
|
|
170 exit when Token = Tok_EOF;
|
|
171 end loop;
|
|
172
|
|
173 return Scans.Checksum;
|
|
174 end Get_File_Checksum;
|
|
175
|
|
176 ----------
|
|
177 -- Hash --
|
|
178 ----------
|
|
179
|
|
180 function Hash (F : File_Name_Type) return Header_Num is
|
|
181 begin
|
|
182 return Header_Num (Int (F) rem Header_Num'Range_Length);
|
|
183 end Hash;
|
|
184
|
|
185 ---------------------------
|
|
186 -- Initialize_ALI_Source --
|
|
187 ---------------------------
|
|
188
|
|
189 procedure Initialize_ALI_Source is
|
|
190 begin
|
|
191 -- When (re)initializing ALI data structures the ALI user expects to
|
|
192 -- get a fresh set of data structures. Thus we first need to erase the
|
|
193 -- marks put in the name table by the previous set of ALI routine calls.
|
|
194 -- This loop is empty and harmless the first time in.
|
|
195
|
|
196 for J in Source.First .. Source.Last loop
|
|
197 Set_Name_Table_Int (Source.Table (J).Sfile, 0);
|
|
198 Source.Table (J).Source_Found := False;
|
|
199 end loop;
|
|
200
|
|
201 Source.Init;
|
|
202 Interfaces.Reset;
|
|
203 end Initialize_ALI_Source;
|
|
204
|
|
205 ---------------
|
|
206 -- Post_Scan --
|
|
207 ---------------
|
|
208
|
|
209 procedure Post_Scan is
|
|
210 begin
|
|
211 null;
|
|
212 end Post_Scan;
|
|
213
|
|
214 ----------------------
|
|
215 -- Read_Withed_ALIs --
|
|
216 ----------------------
|
|
217
|
|
218 procedure Read_Withed_ALIs
|
|
219 (Id : ALI_Id;
|
|
220 Ignore_Errors : Boolean := False)
|
|
221 is
|
|
222 Afile : File_Name_Type;
|
|
223 Text : Text_Buffer_Ptr;
|
|
224 Idread : ALI_Id;
|
|
225
|
|
226 begin
|
|
227 -- Process all dependent units
|
|
228
|
|
229 for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
|
|
230 for
|
|
231 W in Units.Table (U).First_With .. Units.Table (U).Last_With
|
|
232 loop
|
|
233 Afile := Withs.Table (W).Afile;
|
|
234
|
|
235 -- Only process if not a generic (Afile /= No_File) and if
|
|
236 -- file has not been processed already.
|
|
237
|
|
238 if Afile /= No_File
|
|
239 and then Get_Name_Table_Int (Afile) = 0
|
|
240 then
|
|
241 Text := Read_Library_Info (Afile);
|
|
242
|
|
243 -- Unless Ignore_Errors is true, return with an error if source
|
|
244 -- cannot be found. We used to skip this check when we did not
|
|
245 -- compile library generics separately, but we now always do,
|
|
246 -- so there is no special case here anymore.
|
|
247
|
|
248 if Text = null then
|
|
249
|
|
250 if not Ignore_Errors then
|
|
251 Error_Msg_File_1 := Afile;
|
|
252 Error_Msg_File_2 := Withs.Table (W).Sfile;
|
|
253 Error_Msg ("{ not found, { must be compiled");
|
|
254 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
255 return;
|
|
256 end if;
|
|
257
|
|
258 else
|
|
259 -- Enter in ALIs table
|
|
260
|
|
261 Idread :=
|
|
262 Scan_ALI
|
|
263 (F => Afile,
|
|
264 T => Text,
|
|
265 Ignore_ED => False,
|
|
266 Err => False);
|
|
267
|
|
268 Free (Text);
|
|
269
|
|
270 if ALIs.Table (Idread).Compile_Errors
|
|
271 and then not Ignore_Errors
|
|
272 then
|
|
273 Error_Msg_File_1 := Withs.Table (W).Sfile;
|
|
274 Error_Msg ("{ had errors, must be fixed, and recompiled");
|
|
275 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
276
|
|
277 -- In GNATprove mode, object files are never generated, so
|
|
278 -- No_Object=True is not considered an error.
|
|
279
|
|
280 elsif ALIs.Table (Idread).No_Object
|
|
281 and then not GNATprove_Mode
|
|
282 and then not Ignore_Errors
|
|
283 then
|
|
284 Error_Msg_File_1 := Withs.Table (W).Sfile;
|
|
285 Error_Msg ("{ must be recompiled");
|
|
286 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
287 end if;
|
|
288
|
|
289 -- If the Unit is an Interface to a Stand-Alone Library,
|
|
290 -- set the Interface flag in the Withs table, so that its
|
|
291 -- dependant are not considered for elaboration order.
|
|
292
|
|
293 if ALIs.Table (Idread).SAL_Interface then
|
|
294 Withs.Table (W).SAL_Interface := True;
|
|
295 Interface_Library_Unit := True;
|
|
296
|
|
297 -- Set the entry in the Interfaces hash table, so that
|
|
298 -- other units that import this unit will set the flag
|
|
299 -- in their entry in the Withs table.
|
|
300
|
|
301 Interfaces.Set (Afile, True);
|
|
302
|
|
303 else
|
|
304 -- Otherwise, recurse to get new dependents
|
|
305
|
|
306 Read_Withed_ALIs (Idread);
|
|
307 end if;
|
|
308 end if;
|
|
309
|
|
310 -- If the ALI file has already been processed and is an interface,
|
|
311 -- set the flag in the entry of the Withs table.
|
|
312
|
|
313 elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
|
|
314 Withs.Table (W).SAL_Interface := True;
|
|
315 end if;
|
|
316 end loop;
|
|
317 end loop;
|
|
318 end Read_Withed_ALIs;
|
|
319
|
|
320 ----------------------
|
|
321 -- Set_Source_Table --
|
|
322 ----------------------
|
|
323
|
|
324 procedure Set_Source_Table (A : ALI_Id) is
|
|
325 F : File_Name_Type;
|
|
326 S : Source_Id;
|
|
327 Stamp : Time_Stamp_Type;
|
|
328
|
|
329 begin
|
|
330 Sdep_Loop : for D in
|
|
331 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
|
|
332 loop
|
|
333 F := Sdep.Table (D).Sfile;
|
|
334
|
|
335 if F /= No_File then
|
|
336
|
|
337 -- If this is the first time we are seeing this source file,
|
|
338 -- then make a new entry in the source table.
|
|
339
|
|
340 if Get_Name_Table_Int (F) = 0 then
|
|
341 Source.Increment_Last;
|
|
342 S := Source.Last;
|
|
343 Set_Name_Table_Int (F, Int (S));
|
|
344 Source.Table (S).Sfile := F;
|
|
345 Source.Table (S).All_Timestamps_Match := True;
|
|
346
|
|
347 -- Initialize checksum fields
|
|
348
|
|
349 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
|
|
350 Source.Table (S).All_Checksums_Match := True;
|
|
351
|
|
352 -- In check source files mode, try to get time stamp from file
|
|
353
|
|
354 if Opt.Check_Source_Files then
|
|
355 Stamp := Source_File_Stamp (F);
|
|
356
|
|
357 -- If we got the stamp, then set the stamp in the source
|
|
358 -- table entry and mark it as set from the source so that
|
|
359 -- it does not get subsequently changed.
|
|
360
|
|
361 if Stamp (Stamp'First) /= ' ' then
|
|
362 Source.Table (S).Stamp := Stamp;
|
|
363 Source.Table (S).Source_Found := True;
|
|
364 Source.Table (S).Stamp_File := F;
|
|
365
|
|
366 -- If we could not find the file, then the stamp is set
|
|
367 -- from the dependency table entry (to be possibly reset
|
|
368 -- if we find a later stamp in subsequent processing)
|
|
369
|
|
370 else
|
|
371 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
372 Source.Table (S).Source_Found := False;
|
|
373 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
374
|
|
375 -- In All_Sources mode, flag error of file not found
|
|
376
|
|
377 if Opt.All_Sources then
|
|
378 Error_Msg_File_1 := F;
|
|
379 Error_Msg ("cannot locate {");
|
|
380 end if;
|
|
381 end if;
|
|
382
|
|
383 -- First time for this source file, but Check_Source_Files
|
|
384 -- is off, so simply initialize the stamp from the Sdep entry
|
|
385
|
|
386 else
|
|
387 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
388 Source.Table (S).Source_Found := False;
|
|
389 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
390 end if;
|
|
391
|
|
392 -- Here if this is not the first time for this source file,
|
|
393 -- so that the source table entry is already constructed.
|
|
394
|
|
395 else
|
|
396 S := Source_Id (Get_Name_Table_Int (F));
|
|
397
|
|
398 -- Update checksum flag
|
|
399
|
|
400 if not Checksums_Match
|
|
401 (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
|
|
402 then
|
|
403 Source.Table (S).All_Checksums_Match := False;
|
|
404 end if;
|
|
405
|
|
406 -- Check for time stamp mismatch
|
|
407
|
|
408 if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
|
|
409 Source.Table (S).All_Timestamps_Match := False;
|
|
410
|
|
411 -- When we have a time stamp mismatch, we go look for the
|
|
412 -- source file even if Check_Source_Files is false, since
|
|
413 -- if we find it, then we can use it to resolve which of the
|
|
414 -- two timestamps in the ALI files is likely to be correct.
|
|
415 -- We only look in the current directory, because when
|
|
416 -- Check_Source_Files is false, other search directories are
|
|
417 -- likely to be incorrect.
|
|
418
|
|
419 if not Check_Source_Files
|
|
420 and then Is_Regular_File (Get_Name_String (F))
|
|
421 then
|
|
422 Stamp := Source_File_Stamp (F);
|
|
423
|
|
424 if Stamp (Stamp'First) /= ' ' then
|
|
425 Source.Table (S).Stamp := Stamp;
|
|
426 Source.Table (S).Source_Found := True;
|
|
427 Source.Table (S).Stamp_File := F;
|
|
428 end if;
|
|
429 end if;
|
|
430
|
|
431 -- If the stamp in the source table entry was set from the
|
|
432 -- source file, then we do not change it (the stamp in the
|
|
433 -- source file is always taken as the "right" one).
|
|
434
|
|
435 if Source.Table (S).Source_Found then
|
|
436 null;
|
|
437
|
|
438 -- Otherwise, we have no source file available, so we guess
|
|
439 -- that the later of the two timestamps is the right one.
|
|
440 -- Note that this guess only affects which error messages
|
|
441 -- are issued later on, not correct functionality.
|
|
442
|
|
443 else
|
|
444 if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
|
|
445 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
446 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
447 end if;
|
|
448 end if;
|
|
449 end if;
|
|
450 end if;
|
|
451
|
|
452 -- Set the checksum value in the source table
|
|
453
|
|
454 S := Source_Id (Get_Name_Table_Int (F));
|
|
455 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
|
|
456 end if;
|
|
457
|
|
458 end loop Sdep_Loop;
|
|
459 end Set_Source_Table;
|
|
460
|
|
461 ----------------------
|
|
462 -- Set_Source_Table --
|
|
463 ----------------------
|
|
464
|
|
465 procedure Set_Source_Table is
|
|
466 begin
|
|
467 for A in ALIs.First .. ALIs.Last loop
|
|
468 Set_Source_Table (A);
|
|
469 end loop;
|
|
470 end Set_Source_Table;
|
|
471
|
|
472 -------------------------
|
|
473 -- Time_Stamp_Mismatch --
|
|
474 -------------------------
|
|
475
|
|
476 function Time_Stamp_Mismatch
|
|
477 (A : ALI_Id;
|
|
478 Read_Only : Boolean := False) return File_Name_Type
|
|
479 is
|
|
480 Src : Source_Id;
|
|
481 -- Source file Id for the current Sdep entry
|
|
482
|
|
483 begin
|
|
484 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
|
|
485 Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile));
|
|
486
|
|
487 if Opt.Minimal_Recompilation
|
|
488 and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
|
|
489 then
|
|
490 -- If minimal recompilation is in action, replace the stamp
|
|
491 -- of the source file in the table if checksums match.
|
|
492
|
|
493 -- ??? It is probably worth updating the ALI file with a new
|
|
494 -- field to avoid recomputing it each time. In any case we ensure
|
|
495 -- that we don't gobble up string table space by doing a mark
|
|
496 -- release around this computation.
|
|
497
|
|
498 Stringt.Mark;
|
|
499
|
|
500 if Checksums_Match
|
|
501 (Get_File_Checksum (Sdep.Table (D).Sfile),
|
|
502 Source.Table (Src).Checksum)
|
|
503 then
|
|
504 if Verbose_Mode then
|
|
505 Write_Str (" ");
|
|
506 Write_Str (Get_Name_String (Sdep.Table (D).Sfile));
|
|
507 Write_Str (": up to date, different timestamps " &
|
|
508 "but same checksum");
|
|
509 Write_Eol;
|
|
510 end if;
|
|
511
|
|
512 Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
|
|
513 end if;
|
|
514
|
|
515 Stringt.Release;
|
|
516 end if;
|
|
517
|
|
518 if (not Read_Only) or else Source.Table (Src).Source_Found then
|
|
519 if not Source.Table (Src).Source_Found
|
|
520 or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
|
|
521 then
|
|
522 -- If -dt debug flag set, output time stamp found/expected
|
|
523
|
|
524 if Source.Table (Src).Source_Found and then Debug_Flag_T then
|
|
525 Write_Str ("Source: """);
|
|
526 Get_Name_String (Sdep.Table (D).Sfile);
|
|
527 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
528 Write_Line ("""");
|
|
529
|
|
530 Write_Str (" time stamp expected: ");
|
|
531 Write_Line (String (Sdep.Table (D).Stamp));
|
|
532
|
|
533 Write_Str (" time stamp found: ");
|
|
534 Write_Line (String (Source.Table (Src).Stamp));
|
|
535 end if;
|
|
536
|
|
537 -- Return the source file
|
|
538
|
|
539 return Source.Table (Src).Sfile;
|
|
540 end if;
|
|
541 end if;
|
|
542 end loop;
|
|
543
|
|
544 return No_File;
|
|
545 end Time_Stamp_Mismatch;
|
|
546
|
|
547 end ALI.Util;
|