1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Debug; use Debug;
28 with Binderr; use Binderr;
30 with Namet; use Namet;
32 with Output; use Output;
33 with Osint; use Osint;
34 with Scans; use Scans;
37 with Snames; use Snames;
40 package body ALI.Util is
42 -- Empty procedures needed to instantiate Scng. Error procedures are
43 -- empty, because we don't want to report any errors when computing
48 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
50 procedure Error_Msg_S (Msg : String);
52 procedure Error_Msg_SC (Msg : String);
54 procedure Error_Msg_SP (Msg : String);
56 -- Instantiation of Styleg, needed to instantiate Scng
58 package Style is new Styleg
59 (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
61 -- A Scanner is needed to get checksum of a source (procedure
62 -- Get_File_Checksum).
64 package Scanner is new Scng
65 (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
67 type Header_Num is range 0 .. 1_000;
69 function Hash (F : File_Name_Type) return Header_Num;
70 -- Function used to compute hash of ALI file name
72 package Interfaces is new Simple_HTable (
73 Header_Num => Header_Num,
76 Key => File_Name_Type,
84 function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
86 return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
89 pragma Warnings (Off);
90 -- To avoid warnings on non referenced parameters of the error procedures
96 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
101 pragma Warnings (Off);
102 -- To avoid warnings on non referenced parameters of the error procedures
108 procedure Error_Msg_S (Msg : String) is
117 procedure Error_Msg_SC (Msg : String) is
126 procedure Error_Msg_SP (Msg : String) is
131 pragma Warnings (On);
133 -----------------------
134 -- Get_File_Checksum --
135 -----------------------
137 function Get_File_Checksum (Fname : Name_Id) return Word is
139 Source_Index : Source_File_Index;
141 Full_Name := Find_File (Fname, Osint.Source);
143 -- If we cannot find the file, then return an impossible checksum,
144 -- impossible becaues checksums have the high order bit zero, so
145 -- that checksums do not match.
147 if Full_Name = No_File then
148 return Checksum_Error;
151 Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
153 if Source_Index = No_Source_File then
154 return Checksum_Error;
157 Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
159 -- Make sure that the project language reserved words are not
160 -- recognized as reserved words, but as identifiers. The byte info for
161 -- those names have been set if we are in gnatmake.
163 Set_Name_Table_Byte (Name_Project, 0);
164 Set_Name_Table_Byte (Name_Extends, 0);
165 Set_Name_Table_Byte (Name_External, 0);
167 -- Scan the complete file to compute its checksum
171 exit when Token = Tok_EOF;
174 return Scans.Checksum;
175 end Get_File_Checksum;
181 function Hash (F : File_Name_Type) return Header_Num is
183 return Header_Num (Int (F) rem Header_Num'Range_Length);
186 ---------------------------
187 -- Initialize_ALI_Source --
188 ---------------------------
190 procedure Initialize_ALI_Source is
192 -- When (re)initializing ALI data structures the ALI user expects to
193 -- get a fresh set of data structures. Thus we first need to erase the
194 -- marks put in the name table by the previous set of ALI routine calls.
195 -- This loop is empty and harmless the first time in.
197 for J in Source.First .. Source.Last loop
198 Set_Name_Table_Info (Source.Table (J).Sfile, 0);
199 Source.Table (J).Source_Found := False;
204 end Initialize_ALI_Source;
210 procedure Post_Scan is
219 procedure Read_ALI (Id : ALI_Id) is
220 Afile : File_Name_Type;
221 Text : Text_Buffer_Ptr;
225 -- Process all dependent units
227 for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
229 W in Units.Table (U).First_With .. Units.Table (U).Last_With
231 Afile := Withs.Table (W).Afile;
233 -- Only process if not a generic (Afile /= No_File) and if
234 -- file has not been processed already.
237 and then Get_Name_Table_Info (Afile) = 0
239 Text := Read_Library_Info (Afile);
241 -- Return with an error if source cannot be found and if this
242 -- is not a library generic (now we can, but does not have to
243 -- compile library generics)
246 if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
247 Error_Msg_Name_1 := Afile;
248 Error_Msg_Name_2 := Withs.Table (W).Sfile;
249 Error_Msg ("% not found, % must be compiled");
250 Set_Name_Table_Info (Afile, Int (No_Unit_Id));
254 goto Skip_Library_Generics;
258 -- Enter in ALIs table
264 Ignore_ED => Force_RM_Elaboration_Order,
269 if ALIs.Table (Idread).Compile_Errors then
270 Error_Msg_Name_1 := Withs.Table (W).Sfile;
271 Error_Msg ("% had errors, must be fixed, and recompiled");
272 Set_Name_Table_Info (Afile, Int (No_Unit_Id));
274 elsif ALIs.Table (Idread).No_Object then
275 Error_Msg_Name_1 := Withs.Table (W).Sfile;
276 Error_Msg ("% must be recompiled");
277 Set_Name_Table_Info (Afile, Int (No_Unit_Id));
280 -- If the Unit is an Interface to a Stand-Alone Library,
281 -- set the Interface flag in the Withs table, so that its
282 -- dependant are not considered for elaboration order.
284 if ALIs.Table (Idread).Interface then
285 Withs.Table (W).Interface := True;
286 Interface_Library_Unit := True;
288 -- Set the entry in the Interfaces hash table, so that other
289 -- units that import this unit will set the flag in their
290 -- entry in the Withs table.
292 Interfaces.Set (Afile, True);
295 -- Otherwise, recurse to get new dependents
300 <<Skip_Library_Generics>> null;
302 -- If the ALI file has already been processed and is an interface,
303 -- set the flag in the entry of the Withs table.
305 elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
306 Withs.Table (W).Interface := True;
312 ----------------------
313 -- Set_Source_Table --
314 ----------------------
316 procedure Set_Source_Table (A : ALI_Id) is
319 Stamp : Time_Stamp_Type;
323 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
325 F := Sdep.Table (D).Sfile;
329 -- If this is the first time we are seeing this source file,
330 -- then make a new entry in the source table.
332 if Get_Name_Table_Info (F) = 0 then
333 Source.Increment_Last;
335 Set_Name_Table_Info (F, Int (S));
336 Source.Table (S).Sfile := F;
337 Source.Table (S).All_Timestamps_Match := True;
339 -- Initialize checksum fields
341 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
342 Source.Table (S).All_Checksums_Match := True;
344 -- In check source files mode, try to get time stamp from file
346 if Opt.Check_Source_Files then
347 Stamp := Source_File_Stamp (F);
349 -- If we got the stamp, then set the stamp in the source
350 -- table entry and mark it as set from the source so that
351 -- it does not get subsequently changed.
353 if Stamp (Stamp'First) /= ' ' then
354 Source.Table (S).Stamp := Stamp;
355 Source.Table (S).Source_Found := True;
357 -- If we could not find the file, then the stamp is set
358 -- from the dependency table entry (to be possibly reset
359 -- if we find a later stamp in subsequent processing)
362 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
363 Source.Table (S).Source_Found := False;
365 -- In All_Sources mode, flag error of file not found
367 if Opt.All_Sources then
368 Error_Msg_Name_1 := F;
369 Error_Msg ("cannot locate %");
373 -- First time for this source file, but Check_Source_Files
374 -- is off, so simply initialize the stamp from the Sdep entry
377 Source.Table (S).Source_Found := False;
378 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
381 -- Here if this is not the first time for this source file,
382 -- so that the source table entry is already constructed.
385 S := Source_Id (Get_Name_Table_Info (F));
387 -- Update checksum flag
389 if not Checksums_Match
390 (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
392 Source.Table (S).All_Checksums_Match := False;
395 -- Check for time stamp mismatch
397 if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
398 Source.Table (S).All_Timestamps_Match := False;
400 -- When we have a time stamp mismatch, we go look for the
401 -- source file even if Check_Source_Files is false, since
402 -- if we find it, then we can use it to resolve which of the
403 -- two timestamps in the ALI files is likely to be correct.
405 if not Check_Source_Files then
406 Stamp := Source_File_Stamp (F);
408 if Stamp (Stamp'First) /= ' ' then
409 Source.Table (S).Stamp := Stamp;
410 Source.Table (S).Source_Found := True;
414 -- If the stamp in the source table entry was set from the
415 -- source file, then we do not change it (the stamp in the
416 -- source file is always taken as the "right" one).
418 if Source.Table (S).Source_Found then
421 -- Otherwise, we have no source file available, so we guess
422 -- that the later of the two timestamps is the right one.
423 -- Note that this guess only affects which error messages
424 -- are issued later on, not correct functionality.
427 if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
428 Source.Table (S).Stamp := Sdep.Table (D).Stamp;
434 -- Set the checksum value in the source table
436 S := Source_Id (Get_Name_Table_Info (F));
437 Source.Table (S).Checksum := Sdep.Table (D).Checksum;
441 end Set_Source_Table;
443 ----------------------
444 -- Set_Source_Table --
445 ----------------------
447 procedure Set_Source_Table is
449 for A in ALIs.First .. ALIs.Last loop
450 Set_Source_Table (A);
452 end Set_Source_Table;
454 -------------------------
455 -- Time_Stamp_Mismatch --
456 -------------------------
458 function Time_Stamp_Mismatch
460 Read_Only : Boolean := False)
461 return File_Name_Type
464 -- Source file Id for the current Sdep entry
467 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
468 Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
470 if Opt.Minimal_Recompilation
471 and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
473 -- If minimal recompilation is in action, replace the stamp
474 -- of the source file in the table if checksums match.
476 -- ??? It is probably worth updating the ALI file with a new
477 -- field to avoid recomputing it each time.
480 (Get_File_Checksum (Sdep.Table (D).Sfile),
481 Source.Table (Src).Checksum)
483 Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
488 if (not Read_Only) or else Source.Table (Src).Source_Found then
489 if not Source.Table (Src).Source_Found
490 or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
492 -- If -t debug flag set, output time stamp found/expected
494 if Source.Table (Src).Source_Found and Debug_Flag_T then
495 Write_Str ("Source: """);
496 Get_Name_String (Sdep.Table (D).Sfile);
497 Write_Str (Name_Buffer (1 .. Name_Len));
500 Write_Str (" time stamp expected: ");
501 Write_Line (String (Sdep.Table (D).Stamp));
503 Write_Str (" time stamp found: ");
504 Write_Line (String (Source.Table (Src).Stamp));
507 -- Return the source file
509 return Source.Table (Src).Sfile;
515 end Time_Stamp_Mismatch;