1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Debug
; use Debug
;
27 with Binderr
; use Binderr
;
29 with Output
; use Output
;
30 with Osint
; use Osint
;
31 with Scans
; use Scans
;
37 with System
.OS_Lib
; use System
.OS_Lib
;
39 package body ALI
.Util
is
41 -- Empty procedures needed to instantiate Scng. Error procedures are
42 -- empty, because we don't want to report any errors when computing
45 procedure Post_Scan
is null;
47 procedure Error_Msg
(Msg
: String; Flag_Location
: Source_Ptr
) is null;
48 procedure Error_Msg_S
(Msg
: String) is null;
49 procedure Error_Msg_SC
(Msg
: String) is null;
50 procedure Error_Msg_SP
(Msg
: String) is null;
52 -- Instantiation of Styleg, needed to instantiate Scng
54 package Style
is new Styleg
55 (Error_Msg
, Error_Msg_S
, Error_Msg_SC
, Error_Msg_SP
);
57 -- A Scanner is needed to get checksum of a source (procedure
58 -- Get_File_Checksum).
60 package Scanner
is new Scng
61 (Post_Scan
, Error_Msg
, Error_Msg_S
, Error_Msg_SC
, Error_Msg_SP
, Style
);
63 type Header_Num
is range 0 .. 1_000
;
65 function Hash
(F
: File_Name_Type
) return Header_Num
;
66 -- Function used to compute hash of ALI file name
68 package Interfaces
is new Simple_HTable
(
69 Header_Num
=> Header_Num
,
72 Key
=> File_Name_Type
,
80 function Checksums_Match
(Checksum1
, Checksum2
: Word
) return Boolean is
82 return Checksum1
= Checksum2
and then Checksum1
/= Checksum_Error
;
85 -----------------------
86 -- Get_File_Checksum --
87 -----------------------
89 function Get_File_Checksum
(Fname
: File_Name_Type
) return Word
is
90 Full_Name
: File_Name_Type
;
91 Source_Index
: Source_File_Index
;
94 Full_Name
:= Find_File
(Fname
, Osint
.Source
);
96 -- If we cannot find the file, then return an impossible checksum,
97 -- impossible because checksums have the high order bit zero, so
98 -- that checksums do not match.
100 if Full_Name
= No_File
then
101 return Checksum_Error
;
104 Source_Index
:= Sinput
.C
.Load_File
(Get_Name_String
(Full_Name
));
106 if Source_Index
<= No_Source_File
then
107 return Checksum_Error
;
110 Scanner
.Initialize_Scanner
(Source_Index
);
112 -- Scan the complete file to compute its checksum
116 exit when Token
= Tok_EOF
;
119 return Scans
.Checksum
;
120 end Get_File_Checksum
;
126 function Hash
(F
: File_Name_Type
) return Header_Num
is
128 return Header_Num
(Int
(F
) mod Header_Num
'Range_Length);
131 ---------------------------
132 -- Initialize_ALI_Source --
133 ---------------------------
135 procedure Initialize_ALI_Source
is
137 -- When (re)initializing ALI data structures the ALI user expects to
138 -- get a fresh set of data structures. Thus we first need to erase the
139 -- marks put in the name table by the previous set of ALI routine calls.
140 -- This loop is empty and harmless the first time in.
142 for J
in Source
.First
.. Source
.Last
loop
143 Set_Name_Table_Int
(Source
.Table
(J
).Sfile
, 0);
144 Source
.Table
(J
).Source_Found
:= False;
149 end Initialize_ALI_Source
;
151 ----------------------
152 -- Read_Withed_ALIs --
153 ----------------------
155 procedure Read_Withed_ALIs
(Id
: ALI_Id
) is
156 Afile
: File_Name_Type
;
157 Text
: Text_Buffer_Ptr
;
161 -- Process all dependent units
163 for U
in ALIs
.Table
(Id
).First_Unit
.. ALIs
.Table
(Id
).Last_Unit
loop
165 W
in Units
.Table
(U
).First_With
.. Units
.Table
(U
).Last_With
167 Afile
:= Withs
.Table
(W
).Afile
;
169 -- Only process if not a generic (Afile /= No_File) and if
170 -- file has not been processed already.
173 and then Get_Name_Table_Int
(Afile
) = 0
175 Text
:= Read_Library_Info
(Afile
);
177 -- Unless in GNATprove mode, return with an error if source
178 -- cannot be found. We used to skip this check when we did not
179 -- compile library generics separately, but we now always do,
180 -- so there is no special case here anymore.
184 if not GNATprove_Mode
then
185 Error_Msg_File_1
:= Afile
;
186 Error_Msg_File_2
:= Withs
.Table
(W
).Sfile
;
187 Error_Msg
("{ not found, { must be compiled");
188 Set_Name_Table_Int
(Afile
, Int
(No_Unit_Id
));
193 -- Enter in ALIs table
203 if ALIs
.Table
(Idread
).Compile_Errors
204 and then not GNATprove_Mode
206 Error_Msg_File_1
:= Withs
.Table
(W
).Sfile
;
207 Error_Msg
("{ had errors, must be fixed, and recompiled");
208 Set_Name_Table_Int
(Afile
, Int
(No_Unit_Id
));
210 -- In GNATprove mode, object files are never generated, so
211 -- No_Object=True is not considered an error.
213 elsif ALIs
.Table
(Idread
).No_Object
214 and then not GNATprove_Mode
216 Error_Msg_File_1
:= Withs
.Table
(W
).Sfile
;
217 Error_Msg
("{ must be recompiled");
218 Set_Name_Table_Int
(Afile
, Int
(No_Unit_Id
));
221 -- If the Unit is an Interface to a Stand-Alone Library,
222 -- set the Interface flag in the Withs table, so that its
223 -- dependant are not considered for elaboration order.
225 if ALIs
.Table
(Idread
).SAL_Interface
then
226 Withs
.Table
(W
).SAL_Interface
:= True;
227 Interface_Library_Unit
:= True;
229 -- Set the entry in the Interfaces hash table, so that
230 -- other units that import this unit will set the flag
231 -- in their entry in the Withs table.
233 Interfaces
.Set
(Afile
, True);
236 -- Otherwise, recurse to get new dependents
238 Read_Withed_ALIs
(Idread
);
242 -- If the ALI file has already been processed and is an interface,
243 -- set the flag in the entry of the Withs table.
245 elsif Interface_Library_Unit
and then Interfaces
.Get
(Afile
) then
246 Withs
.Table
(W
).SAL_Interface
:= True;
250 end Read_Withed_ALIs
;
252 ----------------------
253 -- Set_Source_Table --
254 ----------------------
256 procedure Set_Source_Table
(A
: ALI_Id
) is
259 Stamp
: Time_Stamp_Type
;
263 ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
265 F
:= Sdep
.Table
(D
).Sfile
;
269 -- If this is the first time we are seeing this source file,
270 -- then make a new entry in the source table.
272 if Get_Name_Table_Int
(F
) = 0 then
273 Source
.Increment_Last
;
275 Set_Name_Table_Int
(F
, Int
(S
));
276 Source
.Table
(S
).Sfile
:= F
;
277 Source
.Table
(S
).All_Timestamps_Match
:= True;
279 -- Initialize checksum fields
281 Source
.Table
(S
).Checksum
:= Sdep
.Table
(D
).Checksum
;
282 Source
.Table
(S
).All_Checksums_Match
:= True;
284 -- In check source files mode, try to get time stamp from file
286 if Opt
.Check_Source_Files
then
287 Stamp
:= Source_File_Stamp
(F
);
289 -- If we got the stamp, then set the stamp in the source
290 -- table entry and mark it as set from the source so that
291 -- it does not get subsequently changed.
293 if Stamp
(Stamp
'First) /= ' ' then
294 Source
.Table
(S
).Stamp
:= Stamp
;
295 Source
.Table
(S
).Source_Found
:= True;
296 Source
.Table
(S
).Stamp_File
:= F
;
298 -- If we could not find the file, then the stamp is set
299 -- from the dependency table entry (to be possibly reset
300 -- if we find a later stamp in subsequent processing)
303 Source
.Table
(S
).Stamp
:= Sdep
.Table
(D
).Stamp
;
304 Source
.Table
(S
).Source_Found
:= False;
305 Source
.Table
(S
).Stamp_File
:= ALIs
.Table
(A
).Afile
;
307 -- In All_Sources mode, flag error of file not found
309 if Opt
.All_Sources
then
310 Error_Msg_File_1
:= F
;
311 Error_Msg
("cannot locate {");
315 -- First time for this source file, but Check_Source_Files
316 -- is off, so simply initialize the stamp from the Sdep entry
319 Source
.Table
(S
).Stamp
:= Sdep
.Table
(D
).Stamp
;
320 Source
.Table
(S
).Source_Found
:= False;
321 Source
.Table
(S
).Stamp_File
:= ALIs
.Table
(A
).Afile
;
324 -- Here if this is not the first time for this source file,
325 -- so that the source table entry is already constructed.
328 S
:= Source_Id
(Get_Name_Table_Int
(F
));
330 -- Update checksum flag
332 if not Checksums_Match
333 (Sdep
.Table
(D
).Checksum
, Source
.Table
(S
).Checksum
)
335 Source
.Table
(S
).All_Checksums_Match
:= False;
338 -- Check for time stamp mismatch
340 if Sdep
.Table
(D
).Stamp
/= Source
.Table
(S
).Stamp
then
341 Source
.Table
(S
).All_Timestamps_Match
:= False;
343 -- When we have a time stamp mismatch, we go look for the
344 -- source file even if Check_Source_Files is false, since
345 -- if we find it, then we can use it to resolve which of the
346 -- two timestamps in the ALI files is likely to be correct.
347 -- We only look in the current directory, because when
348 -- Check_Source_Files is false, other search directories are
349 -- likely to be incorrect.
351 if not Check_Source_Files
352 and then Is_Regular_File
(Get_Name_String
(F
))
354 Stamp
:= Source_File_Stamp
(F
);
356 if Stamp
(Stamp
'First) /= ' ' then
357 Source
.Table
(S
).Stamp
:= Stamp
;
358 Source
.Table
(S
).Source_Found
:= True;
359 Source
.Table
(S
).Stamp_File
:= F
;
363 -- If the stamp in the source table entry was set from the
364 -- source file, then we do not change it (the stamp in the
365 -- source file is always taken as the "right" one).
367 if Source
.Table
(S
).Source_Found
then
370 -- Otherwise, we have no source file available, so we guess
371 -- that the later of the two timestamps is the right one.
372 -- Note that this guess only affects which error messages
373 -- are issued later on, not correct functionality.
376 if Sdep
.Table
(D
).Stamp
> Source
.Table
(S
).Stamp
then
377 Source
.Table
(S
).Stamp
:= Sdep
.Table
(D
).Stamp
;
378 Source
.Table
(S
).Stamp_File
:= ALIs
.Table
(A
).Afile
;
384 -- Set the checksum value in the source table
386 S
:= Source_Id
(Get_Name_Table_Int
(F
));
387 Source
.Table
(S
).Checksum
:= Sdep
.Table
(D
).Checksum
;
391 end Set_Source_Table
;
393 ----------------------
394 -- Set_Source_Table --
395 ----------------------
397 procedure Set_Source_Table
is
399 for A
in ALIs
.First
.. ALIs
.Last
loop
400 Set_Source_Table
(A
);
402 end Set_Source_Table
;
404 -------------------------
405 -- Time_Stamp_Mismatch --
406 -------------------------
408 function Time_Stamp_Mismatch
410 Read_Only
: Boolean := False) return File_Name_Type
413 -- Source file Id for the current Sdep entry
416 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
417 Src
:= Source_Id
(Get_Name_Table_Int
(Sdep
.Table
(D
).Sfile
));
419 if Opt
.Minimal_Recompilation
420 and then Sdep
.Table
(D
).Stamp
/= Source
.Table
(Src
).Stamp
422 -- If minimal recompilation is in action, replace the stamp
423 -- of the source file in the table if checksums match.
425 -- ??? It is probably worth updating the ALI file with a new
426 -- field to avoid recomputing it each time. In any case we ensure
427 -- that we don't gobble up string table space by doing a mark
428 -- release around this computation.
433 (Get_File_Checksum
(Sdep
.Table
(D
).Sfile
),
434 Source
.Table
(Src
).Checksum
)
438 Write_Str
(Get_Name_String
(Sdep
.Table
(D
).Sfile
));
439 Write_Str
(": up to date, different timestamps " &
440 "but same checksum");
444 Sdep
.Table
(D
).Stamp
:= Source
.Table
(Src
).Stamp
;
450 if not Read_Only
or else Source
.Table
(Src
).Source_Found
then
451 if not Source
.Table
(Src
).Source_Found
452 or else Sdep
.Table
(D
).Stamp
/= Source
.Table
(Src
).Stamp
454 -- If -dt debug flag set, output time stamp found/expected
456 if Source
.Table
(Src
).Source_Found
and then Debug_Flag_T
then
457 Write_Str
("Source: """);
458 Get_Name_String
(Sdep
.Table
(D
).Sfile
);
459 Write_Str
(Name_Buffer
(1 .. Name_Len
));
462 Write_Str
(" time stamp expected: ");
463 Write_Line
(String (Sdep
.Table
(D
).Stamp
));
465 Write_Str
(" time stamp found: ");
466 Write_Line
(String (Source
.Table
(Src
).Stamp
));
469 -- Return the source file
471 return Source
.Table
(Src
).Sfile
;
477 end Time_Stamp_Mismatch
;