------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A L I . U T I L -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ 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 -- Empty procedures needed to instantiate Scng. Error procedures are -- empty, because we don't want to report any errors when computing -- a source checksum. 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); -- Instantiation of Styleg, needed to instantiate Scng package Style is new Styleg (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); -- A Scanner is needed to get checksum of a source (procedure -- Get_File_Checksum). 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; -- Function used to compute hash of ALI file name package Interfaces is new Simple_HTable ( Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => File_Name_Type, Hash => Hash, Equal => "="); --------------------- -- Checksums_Match -- --------------------- function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is begin return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error; end Checksums_Match; --------------- -- Error_Msg -- --------------- procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is pragma Warnings (Off, Msg); pragma Warnings (Off, Flag_Location); begin null; end Error_Msg; ----------------- -- Error_Msg_S -- ----------------- procedure Error_Msg_S (Msg : String) is pragma Warnings (Off, Msg); begin null; end Error_Msg_S; ------------------ -- Error_Msg_SC -- ------------------ procedure Error_Msg_SC (Msg : String) is pragma Warnings (Off, Msg); begin null; end Error_Msg_SC; ------------------ -- Error_Msg_SP -- ------------------ procedure Error_Msg_SP (Msg : String) is pragma Warnings (Off, Msg); begin null; end Error_Msg_SP; ----------------------- -- Get_File_Checksum -- ----------------------- 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 we cannot find the file, then return an impossible checksum, -- impossible becaues checksums have the high order bit zero, so -- that checksums do not match. 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); -- Make sure that the project language reserved words are not -- recognized as reserved words, but as identifiers. The byte info for -- those names have been set if we are in gnatmake. Set_Name_Table_Byte (Name_Project, 0); Set_Name_Table_Byte (Name_Extends, 0); Set_Name_Table_Byte (Name_External, 0); -- Scan the complete file to compute its checksum loop Scanner.Scan; exit when Token = Tok_EOF; end loop; return Scans.Checksum; end Get_File_Checksum; ---------- -- Hash -- ---------- function Hash (F : File_Name_Type) return Header_Num is begin return Header_Num (Int (F) rem Header_Num'Range_Length); end Hash; --------------------------- -- Initialize_ALI_Source -- --------------------------- procedure Initialize_ALI_Source is begin -- When (re)initializing ALI data structures the ALI user expects to -- get a fresh set of data structures. Thus we first need to erase the -- marks put in the name table by the previous set of ALI routine calls. -- This loop is empty and harmless the first time in. 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; ----------------------- -- Obsolescent_Check -- ----------------------- procedure Obsolescent_Check (S : Source_Ptr) is pragma Warnings (Off, S); begin null; end Obsolescent_Check; --------------- -- Post_Scan -- --------------- procedure Post_Scan is begin null; end Post_Scan; -------------- -- Read_ALI -- -------------- procedure Read_ALI (Id : ALI_Id) is Afile : File_Name_Type; Text : Text_Buffer_Ptr; Idread : ALI_Id; begin -- Process all dependent units 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; -- Only process if not a generic (Afile /= No_File) and if -- file has not been processed already. if Afile /= No_File and then Get_Name_Table_Info (Afile) = 0 then Text := Read_Library_Info (Afile); -- Return with an error if source cannot be found and if this -- is not a library generic (now we can, but does not have to -- compile library generics) 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; -- Enter in ALIs table 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 the Unit is an Interface to a Stand-Alone Library, -- set the Interface flag in the Withs table, so that its -- dependant are not considered for elaboration order. if ALIs.Table (Idread).SAL_Interface then Withs.Table (W).SAL_Interface := True; Interface_Library_Unit := True; -- Set the entry in the Interfaces hash table, so that other -- units that import this unit will set the flag in their -- entry in the Withs table. Interfaces.Set (Afile, True); else -- Otherwise, recurse to get new dependents Read_ALI (Idread); end if; <> null; -- If the ALI file has already been processed and is an interface, -- set the flag in the entry of the Withs table. 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; ---------------------- -- Set_Source_Table -- ---------------------- 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 this is the first time we are seeing this source file, -- then make a new entry in the source table. 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; -- Initialize checksum fields Source.Table (S).Checksum := Sdep.Table (D).Checksum; Source.Table (S).All_Checksums_Match := True; -- In check source files mode, try to get time stamp from file if Opt.Check_Source_Files then Stamp := Source_File_Stamp (F); -- If we got the stamp, then set the stamp in the source -- table entry and mark it as set from the source so that -- it does not get subsequently changed. if Stamp (Stamp'First) /= ' ' then Source.Table (S).Stamp := Stamp; Source.Table (S).Source_Found := True; -- If we could not find the file, then the stamp is set -- from the dependency table entry (to be possibly reset -- if we find a later stamp in subsequent processing) else Source.Table (S).Stamp := Sdep.Table (D).Stamp; Source.Table (S).Source_Found := False; -- In All_Sources mode, flag error of file not found if Opt.All_Sources then Error_Msg_Name_1 := F; Error_Msg ("cannot locate %"); end if; end if; -- First time for this source file, but Check_Source_Files -- is off, so simply initialize the stamp from the Sdep entry else Source.Table (S).Source_Found := False; Source.Table (S).Stamp := Sdep.Table (D).Stamp; end if; -- Here if this is not the first time for this source file, -- so that the source table entry is already constructed. else S := Source_Id (Get_Name_Table_Info (F)); -- Update checksum flag if not Checksums_Match (Sdep.Table (D).Checksum, Source.Table (S).Checksum) then Source.Table (S).All_Checksums_Match := False; end if; -- Check for time stamp mismatch if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then Source.Table (S).All_Timestamps_Match := False; -- When we have a time stamp mismatch, we go look for the -- source file even if Check_Source_Files is false, since -- if we find it, then we can use it to resolve which of the -- two timestamps in the ALI files is likely to be correct. 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 the stamp in the source table entry was set from the -- source file, then we do not change it (the stamp in the -- source file is always taken as the "right" one). if Source.Table (S).Source_Found then null; -- Otherwise, we have no source file available, so we guess -- that the later of the two timestamps is the right one. -- Note that this guess only affects which error messages -- are issued later on, not correct functionality. 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; -- Set the checksum value in the source table 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; ---------------------- -- 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; ------------------------- -- Time_Stamp_Mismatch -- ------------------------- function Time_Stamp_Mismatch (A : ALI_Id; Read_Only : Boolean := False) return File_Name_Type is Src : Source_Id; -- Source file Id for the current Sdep entry 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 minimal recompilation is in action, replace the stamp -- of the source file in the table if checksums match. -- ??? It is probably worth updating the ALI file with a new -- field to avoid recomputing it each time. 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 -t debug flag set, output time stamp found/expected 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 the source file return Source.Table (Src).Sfile; end if; end if; end loop; return No_File; end Time_Stamp_Mismatch; end ALI.Util;