with Binderr; use Binderr;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with System.CRC32;
with System.Memory;
with System.Address_To_Access_Conversions;
package body ALI.Util is
procedure Accumulate_Checksum (C : Character; Csum : in out Word);
pragma Inline (Accumulate_Checksum);
procedure Initialize_Checksum (Csum : out Word);
procedure Accumulate_Checksum (C : Character; Csum : in out Word) is
begin
System.CRC32.Update (System.CRC32.CRC32 (Csum), C);
end Accumulate_Checksum;
function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
begin
return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
end Checksums_Match;
function Get_File_Checksum (Fname : Name_Id) return Word is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
Csum : Word;
Ptr : Source_Ptr;
Bad : exception;
use ASCII;
procedure Free_Source;
procedure Free_Source is
package SB is
new System.Address_To_Access_Conversions (Big_Source_Buffer);
begin
System.Memory.Free (SB.To_Address (SB.Object_Pointer (Src)));
end Free_Source;
begin
Read_Source_File (Fname, 0, Hi, Src);
if Src = null then
raise Bad;
end if;
Initialize_Checksum (Csum);
Ptr := 0;
loop
case Src (Ptr) is
when ' ' | CR | LF | VT | FF | HT =>
Ptr := Ptr + 1;
when EOF =>
if Ptr = Hi then
Free_Source;
return Csum;
else
Ptr := Ptr + 1;
end if;
when '#' | '&' | '*' | ':' | '(' | ',' | '.' | '=' | '>' |
'<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
'0' .. '9' | 'a' .. 'z'
=>
Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
when 'A' .. 'Z' =>
Accumulate_Checksum
(Character'Val (Character'Pos (Src (Ptr)) + 32), Csum);
Ptr := Ptr + 1;
when '[' =>
raise Bad;
when '-' =>
if Src (Ptr + 1) = '-' then
Ptr := Ptr + 2;
while Src (Ptr) >= ' ' or else Src (Ptr) = HT loop
Ptr := Ptr + 1;
end loop;
else
Accumulate_Checksum ('-', Csum);
Ptr := Ptr + 1;
end if;
when '"' =>
Accumulate_Checksum ('"', Csum);
loop
Ptr := Ptr + 1;
exit when Src (Ptr) = '"';
if Src (Ptr) < ' ' then
raise Bad;
end if;
Accumulate_Checksum (Src (Ptr), Csum);
end loop;
Accumulate_Checksum ('"', Csum);
Ptr := Ptr + 1;
when '%' =>
Accumulate_Checksum ('%', Csum);
loop
Ptr := Ptr + 1;
exit when Src (Ptr) = '%';
if Src (Ptr) < ' ' then
raise Bad;
end if;
Accumulate_Checksum (Src (Ptr), Csum);
end loop;
Accumulate_Checksum ('%', Csum);
Ptr := Ptr + 1;
when ''' =>
Accumulate_Checksum (''', Csum);
if Src (Ptr + 2) = ''' then
Accumulate_Checksum (Src (Ptr + 1), Csum);
Accumulate_Checksum (''', Csum);
Ptr := Ptr + 3;
else
Ptr := Ptr + 1;
end if;
when Upper_Half_Character =>
Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
when ESC =>
raise Bad;
when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | SO |
SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
EM | FS | GS | RS | US | DEL
=>
raise Bad;
when '$' | '?' | '@' | '`' | '\' |
'^' | '~' | ']' | '{' | '}'
=>
raise Bad;
end case;
end loop;
exception
when Bad =>
Free_Source;
return Checksum_Error;
end Get_File_Checksum;
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;
end Initialize_ALI_Source;
procedure Initialize_Checksum (Csum : out Word) is
begin
System.CRC32.Initialize (System.CRC32.CRC32 (Csum));
end Initialize_Checksum;
procedure Read_ALI (Id : ALI_Id) is
Afile : File_Name_Type;
Text : Text_Buffer_Ptr;
Idread : ALI_Id;
begin
for I in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
for J in Units.Table (I).First_With .. Units.Table (I).Last_With loop
Afile := Withs.Table (J).Afile;
if Afile /= No_File and then Get_Name_Table_Info (Afile) = 0 then
Text := Read_Library_Info (Afile);
if Text = null then
Error_Msg_Name_1 := Afile;
Error_Msg_Name_2 := Withs.Table (J).Sfile;
Error_Msg ("% not found, % must be compiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
return;
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 (J).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 (J).Sfile;
Error_Msg ("% must be recompiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
end if;
Read_ALI (Idread);
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 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 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) 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 Source.Table (Src).Source_Found
or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
then
return Source.Table (Src).Sfile;
end if;
end loop;
return No_File;
end Time_Stamp_Mismatch;
end ALI.Util;