111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- A L I . U T I L --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
145
|
9 -- Copyright (C) 1992-2019, 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
|
145
|
218 procedure Read_Withed_ALIs (Id : ALI_Id) is
|
111
|
219 Afile : File_Name_Type;
|
|
220 Text : Text_Buffer_Ptr;
|
|
221 Idread : ALI_Id;
|
|
222
|
|
223 begin
|
|
224 -- Process all dependent units
|
|
225
|
|
226 for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
|
|
227 for
|
|
228 W in Units.Table (U).First_With .. Units.Table (U).Last_With
|
|
229 loop
|
|
230 Afile := Withs.Table (W).Afile;
|
|
231
|
|
232 -- Only process if not a generic (Afile /= No_File) and if
|
|
233 -- file has not been processed already.
|
|
234
|
|
235 if Afile /= No_File
|
|
236 and then Get_Name_Table_Int (Afile) = 0
|
|
237 then
|
|
238 Text := Read_Library_Info (Afile);
|
|
239
|
145
|
240 -- Unless in GNATprove mode, return with an error if source
|
111
|
241 -- cannot be found. We used to skip this check when we did not
|
|
242 -- compile library generics separately, but we now always do,
|
|
243 -- so there is no special case here anymore.
|
|
244
|
|
245 if Text = null then
|
|
246
|
145
|
247 if not GNATprove_Mode then
|
111
|
248 Error_Msg_File_1 := Afile;
|
|
249 Error_Msg_File_2 := Withs.Table (W).Sfile;
|
|
250 Error_Msg ("{ not found, { must be compiled");
|
|
251 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
252 return;
|
|
253 end if;
|
|
254
|
|
255 else
|
|
256 -- Enter in ALIs table
|
|
257
|
|
258 Idread :=
|
|
259 Scan_ALI
|
|
260 (F => Afile,
|
|
261 T => Text,
|
|
262 Ignore_ED => False,
|
|
263 Err => False);
|
|
264
|
|
265 Free (Text);
|
|
266
|
|
267 if ALIs.Table (Idread).Compile_Errors
|
145
|
268 and then not GNATprove_Mode
|
111
|
269 then
|
|
270 Error_Msg_File_1 := Withs.Table (W).Sfile;
|
|
271 Error_Msg ("{ had errors, must be fixed, and recompiled");
|
|
272 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
273
|
|
274 -- In GNATprove mode, object files are never generated, so
|
|
275 -- No_Object=True is not considered an error.
|
|
276
|
|
277 elsif ALIs.Table (Idread).No_Object
|
|
278 and then not GNATprove_Mode
|
|
279 then
|
|
280 Error_Msg_File_1 := Withs.Table (W).Sfile;
|
|
281 Error_Msg ("{ must be recompiled");
|
|
282 Set_Name_Table_Int (Afile, Int (No_Unit_Id));
|
|
283 end if;
|
|
284
|
|
285 -- If the Unit is an Interface to a Stand-Alone Library,
|
|
286 -- set the Interface flag in the Withs table, so that its
|
|
287 -- dependant are not considered for elaboration order.
|
|
288
|
|
289 if ALIs.Table (Idread).SAL_Interface then
|
|
290 Withs.Table (W).SAL_Interface := True;
|
|
291 Interface_Library_Unit := True;
|
|
292
|
|
293 -- Set the entry in the Interfaces hash table, so that
|
|
294 -- other units that import this unit will set the flag
|
|
295 -- in their entry in the Withs table.
|
|
296
|
|
297 Interfaces.Set (Afile, True);
|
|
298
|
|
299 else
|
|
300 -- Otherwise, recurse to get new dependents
|
|
301
|
|
302 Read_Withed_ALIs (Idread);
|
|
303 end if;
|
|
304 end if;
|
|
305
|
|
306 -- If the ALI file has already been processed and is an interface,
|
|
307 -- set the flag in the entry of the Withs table.
|
|
308
|
|
309 elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
|
|
310 Withs.Table (W).SAL_Interface := True;
|
|
311 end if;
|
|
312 end loop;
|
|
313 end loop;
|
|
314 end Read_Withed_ALIs;
|
|
315
|
|
316 ----------------------
|
|
317 -- Set_Source_Table --
|
|
318 ----------------------
|
|
319
|
|
320 procedure Set_Source_Table (A : ALI_Id) is
|
|
321 F : File_Name_Type;
|
|
322 S : Source_Id;
|
|
323 Stamp : Time_Stamp_Type;
|
|
324
|
|
325 begin
|
|
326 Sdep_Loop : for D in
|
|
327 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
|
|
328 loop
|
|
329 F := Sdep.Table (D).Sfile;
|
|
330
|
|
331 if F /= No_File then
|
|
332
|
|
333 -- If this is the first time we are seeing this source file,
|
|
334 -- then make a new entry in the source table.
|
|
335
|
|
336 if Get_Name_Table_Int (F) = 0 then
|
|
337 Source.Increment_Last;
|
|
338 S := Source.Last;
|
|
339 Set_Name_Table_Int (F, Int (S));
|
|
340 Source.Table (S).Sfile := F;
|
|
341 Source.Table (S).All_Timestamps_Match := True;
|
|
342
|
|
343 -- Initialize checksum fields
|
|
344
|
|
345 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
|
|
346 Source.Table (S).All_Checksums_Match := True;
|
|
347
|
|
348 -- In check source files mode, try to get time stamp from file
|
|
349
|
|
350 if Opt.Check_Source_Files then
|
|
351 Stamp := Source_File_Stamp (F);
|
|
352
|
|
353 -- If we got the stamp, then set the stamp in the source
|
|
354 -- table entry and mark it as set from the source so that
|
|
355 -- it does not get subsequently changed.
|
|
356
|
|
357 if Stamp (Stamp'First) /= ' ' then
|
|
358 Source.Table (S).Stamp := Stamp;
|
|
359 Source.Table (S).Source_Found := True;
|
|
360 Source.Table (S).Stamp_File := F;
|
|
361
|
|
362 -- If we could not find the file, then the stamp is set
|
|
363 -- from the dependency table entry (to be possibly reset
|
|
364 -- if we find a later stamp in subsequent processing)
|
|
365
|
|
366 else
|
|
367 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
368 Source.Table (S).Source_Found := False;
|
|
369 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
370
|
|
371 -- In All_Sources mode, flag error of file not found
|
|
372
|
|
373 if Opt.All_Sources then
|
|
374 Error_Msg_File_1 := F;
|
|
375 Error_Msg ("cannot locate {");
|
|
376 end if;
|
|
377 end if;
|
|
378
|
|
379 -- First time for this source file, but Check_Source_Files
|
|
380 -- is off, so simply initialize the stamp from the Sdep entry
|
|
381
|
|
382 else
|
|
383 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
384 Source.Table (S).Source_Found := False;
|
|
385 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
386 end if;
|
|
387
|
|
388 -- Here if this is not the first time for this source file,
|
|
389 -- so that the source table entry is already constructed.
|
|
390
|
|
391 else
|
|
392 S := Source_Id (Get_Name_Table_Int (F));
|
|
393
|
|
394 -- Update checksum flag
|
|
395
|
|
396 if not Checksums_Match
|
|
397 (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
|
|
398 then
|
|
399 Source.Table (S).All_Checksums_Match := False;
|
|
400 end if;
|
|
401
|
|
402 -- Check for time stamp mismatch
|
|
403
|
|
404 if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
|
|
405 Source.Table (S).All_Timestamps_Match := False;
|
|
406
|
|
407 -- When we have a time stamp mismatch, we go look for the
|
|
408 -- source file even if Check_Source_Files is false, since
|
|
409 -- if we find it, then we can use it to resolve which of the
|
|
410 -- two timestamps in the ALI files is likely to be correct.
|
|
411 -- We only look in the current directory, because when
|
|
412 -- Check_Source_Files is false, other search directories are
|
|
413 -- likely to be incorrect.
|
|
414
|
|
415 if not Check_Source_Files
|
|
416 and then Is_Regular_File (Get_Name_String (F))
|
|
417 then
|
|
418 Stamp := Source_File_Stamp (F);
|
|
419
|
|
420 if Stamp (Stamp'First) /= ' ' then
|
|
421 Source.Table (S).Stamp := Stamp;
|
|
422 Source.Table (S).Source_Found := True;
|
|
423 Source.Table (S).Stamp_File := F;
|
|
424 end if;
|
|
425 end if;
|
|
426
|
|
427 -- If the stamp in the source table entry was set from the
|
|
428 -- source file, then we do not change it (the stamp in the
|
|
429 -- source file is always taken as the "right" one).
|
|
430
|
|
431 if Source.Table (S).Source_Found then
|
|
432 null;
|
|
433
|
|
434 -- Otherwise, we have no source file available, so we guess
|
|
435 -- that the later of the two timestamps is the right one.
|
|
436 -- Note that this guess only affects which error messages
|
|
437 -- are issued later on, not correct functionality.
|
|
438
|
|
439 else
|
|
440 if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
|
|
441 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
|
|
442 Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
|
|
443 end if;
|
|
444 end if;
|
|
445 end if;
|
|
446 end if;
|
|
447
|
|
448 -- Set the checksum value in the source table
|
|
449
|
|
450 S := Source_Id (Get_Name_Table_Int (F));
|
|
451 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
|
|
452 end if;
|
|
453
|
|
454 end loop Sdep_Loop;
|
|
455 end Set_Source_Table;
|
|
456
|
|
457 ----------------------
|
|
458 -- Set_Source_Table --
|
|
459 ----------------------
|
|
460
|
|
461 procedure Set_Source_Table is
|
|
462 begin
|
|
463 for A in ALIs.First .. ALIs.Last loop
|
|
464 Set_Source_Table (A);
|
|
465 end loop;
|
|
466 end Set_Source_Table;
|
|
467
|
|
468 -------------------------
|
|
469 -- Time_Stamp_Mismatch --
|
|
470 -------------------------
|
|
471
|
|
472 function Time_Stamp_Mismatch
|
|
473 (A : ALI_Id;
|
|
474 Read_Only : Boolean := False) return File_Name_Type
|
|
475 is
|
|
476 Src : Source_Id;
|
|
477 -- Source file Id for the current Sdep entry
|
|
478
|
|
479 begin
|
|
480 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
|
|
481 Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile));
|
|
482
|
|
483 if Opt.Minimal_Recompilation
|
|
484 and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
|
|
485 then
|
|
486 -- If minimal recompilation is in action, replace the stamp
|
|
487 -- of the source file in the table if checksums match.
|
|
488
|
|
489 -- ??? It is probably worth updating the ALI file with a new
|
|
490 -- field to avoid recomputing it each time. In any case we ensure
|
|
491 -- that we don't gobble up string table space by doing a mark
|
|
492 -- release around this computation.
|
|
493
|
|
494 Stringt.Mark;
|
|
495
|
|
496 if Checksums_Match
|
|
497 (Get_File_Checksum (Sdep.Table (D).Sfile),
|
|
498 Source.Table (Src).Checksum)
|
|
499 then
|
|
500 if Verbose_Mode then
|
|
501 Write_Str (" ");
|
|
502 Write_Str (Get_Name_String (Sdep.Table (D).Sfile));
|
|
503 Write_Str (": up to date, different timestamps " &
|
|
504 "but same checksum");
|
|
505 Write_Eol;
|
|
506 end if;
|
|
507
|
|
508 Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
|
|
509 end if;
|
|
510
|
|
511 Stringt.Release;
|
|
512 end if;
|
|
513
|
|
514 if (not Read_Only) or else Source.Table (Src).Source_Found then
|
|
515 if not Source.Table (Src).Source_Found
|
|
516 or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
|
|
517 then
|
|
518 -- If -dt debug flag set, output time stamp found/expected
|
|
519
|
|
520 if Source.Table (Src).Source_Found and then Debug_Flag_T then
|
|
521 Write_Str ("Source: """);
|
|
522 Get_Name_String (Sdep.Table (D).Sfile);
|
|
523 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
524 Write_Line ("""");
|
|
525
|
|
526 Write_Str (" time stamp expected: ");
|
|
527 Write_Line (String (Sdep.Table (D).Stamp));
|
|
528
|
|
529 Write_Str (" time stamp found: ");
|
|
530 Write_Line (String (Source.Table (Src).Stamp));
|
|
531 end if;
|
|
532
|
|
533 -- Return the source file
|
|
534
|
|
535 return Source.Table (Src).Sfile;
|
|
536 end if;
|
|
537 end if;
|
|
538 end loop;
|
|
539
|
|
540 return No_File;
|
|
541 end Time_Stamp_Mismatch;
|
|
542
|
|
543 end ALI.Util;
|