with Debug; use Debug;
with Binderr; use Binderr;
with Lib; use Lib;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Osint; use Osint;
with Scans; use Scans;
with Scng;
with Sinput.C;
with Snames; use Snames;
with Styleg;
package body ALI.Util is
procedure Post_Scan;
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
procedure Error_Msg_S (Msg : String);
procedure Error_Msg_SC (Msg : String);
procedure Error_Msg_SP (Msg : String);
procedure Obsolescent_Check (S : Source_Ptr);
package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
package Scanner is new Scng
(Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP,
Obsolescent_Check, Style);
type Header_Num is range 0 .. 1_000;
function Hash (F : File_Name_Type) return Header_Num;
package Interfaces is new Simple_HTable (
Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
begin
return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
end Checksums_Match;
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
pragma Warnings (Off, Msg);
pragma Warnings (Off, Flag_Location);
begin
null;
end Error_Msg;
procedure Error_Msg_S (Msg : String) is
pragma Warnings (Off, Msg);
begin
null;
end Error_Msg_S;
procedure Error_Msg_SC (Msg : String) is
pragma Warnings (Off, Msg);
begin
null;
end Error_Msg_SC;
procedure Error_Msg_SP (Msg : String) is
pragma Warnings (Off, Msg);
begin
null;
end Error_Msg_SP;
function Get_File_Checksum (Fname : Name_Id) return Word is
Full_Name : Name_Id;
Source_Index : Source_File_Index;
begin
Full_Name := Find_File (Fname, Osint.Source);
if Full_Name = No_File then
return Checksum_Error;
end if;
Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
if Source_Index = No_Source_File then
return Checksum_Error;
end if;
Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
Set_Name_Table_Byte (Name_Project, 0);
Set_Name_Table_Byte (Name_Extends, 0);
Set_Name_Table_Byte (Name_External, 0);
loop
Scanner.Scan;
exit when Token = Tok_EOF;
end loop;
return Scans.Checksum;
end Get_File_Checksum;
function Hash (F : File_Name_Type) return Header_Num is
begin
return Header_Num (Int (F) rem Header_Num'Range_Length);
end Hash;
procedure Initialize_ALI_Source is
begin
for J in Source.First .. Source.Last loop
Set_Name_Table_Info (Source.Table (J).Sfile, 0);
Source.Table (J).Source_Found := False;
end loop;
Source.Init;
Interfaces.Reset;
end Initialize_ALI_Source;
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
procedure Post_Scan is
begin
null;
end Post_Scan;
procedure Read_ALI (Id : ALI_Id) is
Afile : File_Name_Type;
Text : Text_Buffer_Ptr;
Idread : ALI_Id;
begin
for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
for
W in Units.Table (U).First_With .. Units.Table (U).Last_With
loop
Afile := Withs.Table (W).Afile;
if Afile /= No_File
and then Get_Name_Table_Info (Afile) = 0
then
Text := Read_Library_Info (Afile);
if Text = null then
if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
Error_Msg_Name_1 := Afile;
Error_Msg_Name_2 := Withs.Table (W).Sfile;
Error_Msg ("% not found, % must be compiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
return;
else
goto Skip_Library_Generics;
end if;
end if;
Idread :=
Scan_ALI
(F => Afile,
T => Text,
Ignore_ED => Force_RM_Elaboration_Order,
Err => False);
Free (Text);
if ALIs.Table (Idread).Compile_Errors then
Error_Msg_Name_1 := Withs.Table (W).Sfile;
Error_Msg ("% had errors, must be fixed, and recompiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
elsif ALIs.Table (Idread).No_Object then
Error_Msg_Name_1 := Withs.Table (W).Sfile;
Error_Msg ("% must be recompiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
end if;
if ALIs.Table (Idread).SAL_Interface then
Withs.Table (W).SAL_Interface := True;
Interface_Library_Unit := True;
Interfaces.Set (Afile, True);
else
Read_ALI (Idread);
end if;
<<Skip_Library_Generics>> null;
elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
Withs.Table (W).SAL_Interface := True;
end if;
end loop;
end loop;
end Read_ALI;
procedure Set_Source_Table (A : ALI_Id) is
F : File_Name_Type;
S : Source_Id;
Stamp : Time_Stamp_Type;
begin
Sdep_Loop : for D in
ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
loop
F := Sdep.Table (D).Sfile;
if F /= No_Name then
if Get_Name_Table_Info (F) = 0 then
Source.Increment_Last;
S := Source.Last;
Set_Name_Table_Info (F, Int (S));
Source.Table (S).Sfile := F;
Source.Table (S).All_Timestamps_Match := True;
Source.Table (S).Checksum := Sdep.Table (D).Checksum;
Source.Table (S).All_Checksums_Match := True;
if Opt.Check_Source_Files then
Stamp := Source_File_Stamp (F);
if Stamp (Stamp'First) /= ' ' then
Source.Table (S).Stamp := Stamp;
Source.Table (S).Source_Found := True;
else
Source.Table (S).Stamp := Sdep.Table (D).Stamp;
Source.Table (S).Source_Found := False;
if Opt.All_Sources then
Error_Msg_Name_1 := F;
Error_Msg ("cannot locate %");
end if;
end if;
else
Source.Table (S).Source_Found := False;
Source.Table (S).Stamp := Sdep.Table (D).Stamp;
end if;
else
S := Source_Id (Get_Name_Table_Info (F));
if not Checksums_Match
(Sdep.Table (D).Checksum, Source.Table (S).Checksum)
then
Source.Table (S).All_Checksums_Match := False;
end if;
if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
Source.Table (S).All_Timestamps_Match := False;
if not Check_Source_Files then
Stamp := Source_File_Stamp (F);
if Stamp (Stamp'First) /= ' ' then
Source.Table (S).Stamp := Stamp;
Source.Table (S).Source_Found := True;
end if;
end if;
if Source.Table (S).Source_Found then
null;
else
if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
Source.Table (S).Stamp := Sdep.Table (D).Stamp;
end if;
end if;
end if;
end if;
S := Source_Id (Get_Name_Table_Info (F));
Source.Table (S).Checksum := Sdep.Table (D).Checksum;
end if;
end loop Sdep_Loop;
end Set_Source_Table;
procedure Set_Source_Table is
begin
for A in ALIs.First .. ALIs.Last loop
Set_Source_Table (A);
end loop;
end Set_Source_Table;
function Time_Stamp_Mismatch
(A : ALI_Id;
Read_Only : Boolean := False)
return File_Name_Type
is
Src : Source_Id;
begin
for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
if Opt.Minimal_Recompilation
and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
then
if Checksums_Match
(Get_File_Checksum (Sdep.Table (D).Sfile),
Source.Table (Src).Checksum)
then
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
end if;
end if;
if (not Read_Only) or else Source.Table (Src).Source_Found then
if not Source.Table (Src).Source_Found
or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
then
if Source.Table (Src).Source_Found and Debug_Flag_T then
Write_Str ("Source: """);
Get_Name_String (Sdep.Table (D).Sfile);
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Line ("""");
Write_Str (" time stamp expected: ");
Write_Line (String (Sdep.Table (D).Stamp));
Write_Str (" time stamp found: ");
Write_Line (String (Source.Table (Src).Stamp));
end if;
return Source.Table (Src).Sfile;
end if;
end if;
end loop;
return No_File;
end Time_Stamp_Mismatch;
end ALI.Util;