------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--                 A S I S _ U L . S O U R C E _ T A B L E                  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2011, AdaCore                     --
--                                                                          --
-- Asis Utility Library (ASIS UL) is free software; you can redistribute it --
-- and/or  modify  it  under  terms  of  the  GNU General Public License as --
-- published by the Free Software Foundation; either version 2, or (at your --
-- option)  any later version.  ASIS UL  is distributed in the hope that it --
-- will  be  useful,  but  WITHOUT  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,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;     use  Ada.Characters.Handling;
with Ada.Text_IO;                 use  Ada.Text_IO;

with GNAT.Directory_Operations;   use GNAT.Directory_Operations;
with GNAT.OS_Lib;                 use GNAT.OS_Lib;

with Asis.Compilation_Units;
with Asis.Elements;
with Asis.Extensions;

with Table;

with ASIS_UL.Common;              use ASIS_UL.Common;
with ASIS_UL.Compiler_Options;    use ASIS_UL.Compiler_Options;
with ASIS_UL.Debug;               use ASIS_UL.Debug;
with ASIS_UL.Environment;         use ASIS_UL.Environment;
with ASIS_UL.Misc;                use ASIS_UL.Misc;
with ASIS_UL.Options;             use ASIS_UL.Options;
with ASIS_UL.Output;              use ASIS_UL.Output;
with ASIS_UL.Strings;             use ASIS_UL.Strings;

package body ASIS_UL.Source_Table is

   More_Then_One_Arg_File_Specified : Boolean := False;
   Arg_File_Name                    : String_Access;

   Current_SF : SF_Id;
   --  The Id of the currently processed source

   -----------------------------
   --  Temporary file storage --
   -----------------------------

   package Temp_File_Storage is new Table.Table (
     Table_Component_Type => String_Access,
     Table_Index_Type     => Natural,
     Table_Low_Bound      => 1,
     Table_Initial        => 100,
     Table_Increment      => 100,
     Table_Name           => "Temp file storage");

   -----------------------
   -- Source File table --
   -----------------------

   type SF_Record is record

      Source_Name  : String_Loc;
      --  If ASIS_UL.Common.Use_Project_File is set OFF, this field stores the
      --  source name with full directory information in absolute form,
      --  otherwise its value is the same is of Short_Source_Name field.

      Short_Source_Name : String_Loc;
      --  The source name without directory information

      Suffixless_Name : String_Loc;
      --  The source name without directory information and suffix (if any)
      --  is used to create the names of the tree file and ALI files

      CU_Name : String_Loc;
      --  The (full expanded) Ada name of a compilation unit contained in the
      --  source, is set to Nil_String_Loc if the unit name is unknown at the
      --  moment or if the source file does not contain a legal unit.

      Could_Be_Body : Boolean;
      --  This flag indicates that the source file could be a body. For now,
      --  to decide that it could, we check that the suffix is '.adb'

      Status : SF_Status;
      --  Status of the given source. Initially is set to Waiting, then is
      --  changed according to the results of the metrics computation

      Hash_Link : SF_Id;
      --  Link to next entry in files table for same hash code

      Info : SF_Info;
      --  An integer value associated with each source. The usage is up to a
      --  client.

   end record;

   package Source_File_Table is new Table.Table (
     Table_Component_Type => SF_Record,
     Table_Index_Type     => SF_Id,
     Table_Low_Bound      => First_SF_Id,
     Table_Initial        => 100,
     Table_Increment      => 100,
     Table_Name           => "Source file table");

   Source_Table : Source_File_Table.Table_Ptr renames Source_File_Table.Table;

   Last_Arg_Source : SF_Id := No_SF_Id;
   --  Used to store the Id of the last argument source

   Next_Source : SF_Id := First_SF_Id;
   --  Used in source file iterator

   function Is_A_Body (SF : SF_Id) return Boolean;
   --  Checks if SF could be an Ada body file.

   Short_Source_Name_String : String_Access;
   Full_Source_Name_String  : String_Access;
   --  Two handlers for a file name (with no path information and with full
   --  absolute path) used for the file before we decide that the file should
   --  be stored into a file table. Also used in File_Find for storing the
   --  short file name to be passed into Hash function.

   New_SF_Record : constant SF_Record :=
     (Source_Name       => Nil_String_Loc,
      Short_Source_Name => Nil_String_Loc,
      Suffixless_Name   => Nil_String_Loc,
      CU_Name           => Nil_String_Loc,
      Status            => Waiting,
      Hash_Link         => No_SF_Id,
      Could_Be_Body     => False,
      Info              => 0);
   --  Used to set the initial attributes for the new source file

   --  Hash function is the same as in Namet, the only difference is the way
   --  it takes the argument to compute the hash value:

   Hash_Num : constant Integer := 2**12;
   --  Number of headers in the hash table. Current hash algorithm is closely
   --  tailored to this choice, so it can only be changed if a corresponding
   --  change is made to the hash algorithm.

   Hash_Max : constant Integer := Hash_Num - 1;
   --  Indexes in the hash header table run from 0 to Hash_Num - 1

   subtype Hash_Index_Type is Integer range 0 .. Hash_Max;
   --  Range of hash index values

   Hash_Table : array (Hash_Index_Type) of SF_Id := (others => No_SF_Id);
   --  The hash table is used to locate existing entries in the files table.
   --  The entries point to the first names table entry whose hash value
   --  matches the hash code. Then subsequent names table entries with the
   --  same hash code value are linked through the Hash_Link fields.

   function Hash (File_Name : String) return Hash_Index_Type;
   --  Compute hash code for the file name. The argument should be a short
   --  file name with no directory information

   function Same_Name_File_Find (Short_SF_Name : String) return SF_Id;
   --  Similar to File_Find, but looks for the file with the same short name.

   procedure Source_Debug_Image (SF : SF_Id);
   --  Prints out the debug image of a single source stored in the source file
   --  table

   ----------------------------------------------------------------------
   -- Source file access/update routines not used outside this package --
   ----------------------------------------------------------------------

   procedure Set_Source_Name       (SF : SF_Id; N : String);
   procedure Set_Short_Source_Name (SF : SF_Id; N : String);
   procedure Set_Suffixless_Name   (SF : SF_Id; N : String);

   -----------------------
   -- Add_Needed_Source --
   -----------------------

   function Add_Needed_Source (Fname : String) return SF_Id is
      Old_SF     : SF_Id;
      Hash_Index : Hash_Index_Type;
      First_Idx  : Natural;
      Last_Idx   : Natural;

      Result : SF_Id;
   begin
      pragma Assert (Is_Regular_File (Fname));

      Source_File_Table.Append (New_SF_Record);
      Result := Source_File_Table.Last;

      if Debug_Flag_S then
         Info ("Adding needed source :>" & Fname & "<, ID=" & Result'Img);
      end if;

      Short_Source_Name_String := new String'(Base_Name (Fname));
      Hash_Index := Hash (To_Lower (Short_Source_Name_String.all));

      if Present (Hash_Table (Hash_Index)) then

         Old_SF := Hash_Table (Hash_Index);

         while Present (Source_Table (Old_SF).Hash_Link) loop
            Old_SF := Source_Table (Old_SF).Hash_Link;
         end loop;

         Source_Table (Old_SF).Hash_Link := Result;

      else
         Hash_Table (Hash_Index) := Result;
      end if;

      if Use_Project_File then
         Set_Source_Name (Result, Short_Source_Name_String.all);
      else
         Set_Source_Name
           (Result,
             Normalize_Pathname
              (Fname,
               Resolve_Links  => False,
               Case_Sensitive => True));
      end if;

      Set_Short_Source_Name (Result, Short_Source_Name_String.all);

      First_Idx := Short_Source_Name_String'First;
      Last_Idx  := Short_Source_Name_String'Last;

      for J in reverse  First_Idx + 1 .. Last_Idx loop

         if Short_Source_Name_String (J) = '.' then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      Set_Suffixless_Name
        (Result, Short_Source_Name_String (First_Idx .. Last_Idx));

      if To_Lower (Short_Source_Name_String
           (Last_Idx + 1 .. Short_Source_Name_String'Last)) = ".adb"
      then
         Source_Table (Result).Could_Be_Body := True;
      end if;

      Free (Short_Source_Name_String);

      return Result;

   end Add_Needed_Source;

   ---------------------------
   -- Add_Source_To_Process --
   ---------------------------

   procedure Add_Source_To_Process
     (Fname              : String;
      No_Argument        : out Boolean;
      Duplication_Report : Boolean := True)
   is
      Old_SF : SF_Id;
      New_SF : SF_Id;

      Hash_Index : Hash_Index_Type;

      First_Idx : Natural;
      Last_Idx  : Natural;

   begin

      if Fname = "" then
         No_Argument := True;
         return;
      else
         No_Argument := False;
         Free (Full_Source_Name_String);
         Free (Short_Source_Name_String);
      end if;

      if Debug_Flag_S then
         Info ("Adding file to source table:>" & Fname & "<");
      end if;

      if not Use_Project_File then

         if Is_Regular_File (Fname) then
            Short_Source_Name_String := new String'(Fname);
         elsif Source_Search_Path /= null then

            Short_Source_Name_String :=
              Locate_Regular_File (File_Name => Fname,
                                   Path      => Source_Search_Path.all);
         end if;

         if Short_Source_Name_String = null then
            Warning (Fname & " not found");
            return;
         else
            Full_Source_Name_String := new String'
              (Normalize_Pathname
                 (Short_Source_Name_String.all,
                  Resolve_Links  => False,
                  Case_Sensitive => True));

            Free (Short_Source_Name_String);
         end if;

      end if;

      Short_Source_Name_String := new String'(Base_Name (Fname));
      Hash_Index := Hash (To_Lower (Short_Source_Name_String.all));

      if Use_Project_File then
         Old_SF := File_Find (Short_Source_Name_String.all);

         if Present (Old_SF) then

            if Duplication_Report or else Debug_Flag_S then
               Error (Short_Source_Name_String.all & " duplicated");
            end if;

            return;
         end if;

      else

         --  Check if we already have a file with the same short name:

         if Present (Hash_Table (Hash_Index)) then
            Old_SF := File_Find (Full_Source_Name_String.all);

            if Present (Old_SF) then
               --  This means that we have already stored exactly the same
               --  file.
               if Duplication_Report or else Debug_Flag_S then
                  Error (Short_Source_Name_String.all & " duplicated");
               end if;

               return;
            else
               Old_SF := Same_Name_File_Find (Full_Source_Name_String.all);

               if Present (Old_SF) then
                  Error ("more then one version of "
                    & Short_Source_Name_String.all & " processed");
               end if;

            end if;

         end if;

      end if;

      --  If we are here, we have to store the file in the table

      Source_File_Table.Append (New_SF_Record);
      Last_Arg_Source := Source_File_Table.Last;
      New_SF          := Last_Arg_Source;

      if Debug_Flag_S then
         Info ("new source file index:" & New_SF'Img);
      end if;

      if Present (Hash_Table (Hash_Index)) then

         Old_SF := Hash_Table (Hash_Index);

         while Present (Source_Table (Old_SF).Hash_Link) loop
            Old_SF := Source_Table (Old_SF).Hash_Link;
         end loop;

         Source_Table (Old_SF).Hash_Link := New_SF;

      else
         Hash_Table (Hash_Index) := New_SF;
      end if;

      if Use_Project_File then
         Set_Source_Name (New_SF, Short_Source_Name_String.all);
      else
         Set_Source_Name (New_SF, Full_Source_Name_String.all);
      end if;

      Set_Short_Source_Name (New_SF, Short_Source_Name_String.all);

      First_Idx := Short_Source_Name_String'First;
      Last_Idx  := Short_Source_Name_String'Last;

      for J in reverse  First_Idx + 1 .. Last_Idx loop

         if Short_Source_Name_String (J) = '.' then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      Set_Suffixless_Name
        (New_SF, Short_Source_Name_String (First_Idx .. Last_Idx));

      if To_Lower (Short_Source_Name_String
           (Last_Idx + 1 .. Short_Source_Name_String'Last)) = ".adb"
      then
         Source_Table (New_SF).Could_Be_Body := True;
      elsif Last_Idx - 1 >= Short_Source_Name_String'First
         and then
            To_Lower (Short_Source_Name_String
              (Last_Idx - 1 .. Short_Source_Name_String'Last)) = ".2.ada"
      then
         Source_Table (New_SF).Could_Be_Body := True;
      end if;

      Free (Short_Source_Name_String);
      Free (Full_Source_Name_String);

   end Add_Source_To_Process;

   procedure Add_Needed_Source (Fname : String) is
      Tmp_SF_Id : constant SF_Id := Add_Needed_Source (Fname);
      pragma Unreferenced (Tmp_SF_Id);
   begin
      null;
   end Add_Needed_Source;

   -----------------------
   -- Already_Processed --
   -----------------------

   function Already_Processed
     (Include_Needed_Sources : Boolean)
      return                   Natural
   is
      Result   : Natural := 0;
      Loop_End : SF_Id;
   begin

      if Include_Needed_Sources then
         Loop_End := Last_Source;
      else
         Loop_End := Last_Argument_Source;
      end if;

      for J in First_SF_Id .. Loop_End loop

         if Source_Status (J) /= Waiting then
            Result := Result + 1;
         end if;

      end loop;

      return Result;
   end Already_Processed;

   --------------------------
   -- Arg_Source_File_Name --
   --------------------------

   function Arg_Source_File_Name return String is
   begin
      if Arg_File_Name = null then
         return "";
      else
         return Arg_File_Name.all;
      end if;
   end Arg_Source_File_Name;

   -----------------
   -- Create_Tree --
   -----------------

   procedure Create_Tree
     (SF               :     SF_Id;
      Success          : out Boolean;
      Compiler_Out     :     String  := "";
      All_Warnings_Off :     Boolean := True)
   is
   begin
      --  ??? Do we need a trace of the compiler call in debug mode?
      if Debug_Mode or else Debug_Flag_C then
         Info ("...compiling " &  Source_Name (SF));
      end if;

      Asis.Extensions.Compile
        (new String'(Source_Name (SF)),
         Arg_List.all,
         Success,
         GCC              => Gcc_To_Call,
         Use_GNATMAKE     => Use_Gnatmake_To_Compile,
         Use_Temp_Prj     => Project_Support_Type = Use_Tmp_Project_File,
         Compiler_Out     => Compiler_Out,
         All_Warnings_Off => All_Warnings_Off,
         Display_Call     => Debug_Mode or else Debug_Flag_C);

      if not Success then
         Set_Source_Status (SF, Not_A_Legal_Source);
         Illegal_File_Detected := True;

         Error ("cannot compile """ & Short_Source_Name (SF) & """");
      end if;

   end Create_Tree;

   -------------
   -- CU_Name --
   -------------

   function CU_Name (SF : SF_Id) return String is
   begin
      return Get_String (Source_Table (SF).CU_Name);
   end CU_Name;

   ---------------
   -- File_Find --
   ---------------

   function File_Find (El : Asis.Element) return SF_Id is
      Result     : SF_Id := No_SF_Id;
   begin

      if not Asis.Elements.Is_Nil (El) then

         declare
            Full_Source_Name : constant String := Normalize_Pathname
              (To_String (Asis.Compilation_Units.Text_Name
                 (Asis.Elements.Enclosing_Compilation_Unit (El))),
               Case_Sensitive => True);

            Short_Source_Name : constant String :=
              Base_Name (Full_Source_Name);
         begin
            if Use_Project_File then
               Result := File_Find (Short_Source_Name);
            else
               Result := File_Find (Full_Source_Name);
            end if;
         end;
      end if;

      return Result;
   end File_Find;

   function File_Find
     (SF_Name        : String;
      Use_Short_Name : Boolean := False)
      return           SF_Id
   is
      Result       : SF_Id := No_SF_Id;
      Next_SF      : SF_Id;
      Base_SF_Name : constant String := Base_Name (SF_Name);
   begin
      Next_SF := Hash_Table (Hash (Base_Name (SF_Name)));

      while Present (Next_SF) loop

         if ((Use_Project_File or else Use_Short_Name)
            and then
             Base_SF_Name = Short_Source_Name (Next_SF))
           or else
            SF_Name = Source_Name (Next_SF)
         then
            Result := Next_SF;
            exit;
         end if;

         Next_SF := Source_Table (Next_SF).Hash_Link;
      end loop;

      return Result;
   end File_Find;

   --------------------
   -- Get_Current_SF --
   --------------------

   function Get_Current_SF return SF_Id is
   begin
      return Current_SF;
   end Get_Current_SF;

   ----------
   -- Hash --
   ----------

   --  The code is taken from Namet with small modifications

   function Hash (File_Name : String) return Hash_Index_Type is
      subtype Int_0_12 is Integer range 0 .. 12;
      --  Used to avoid when others on case jump below

      Name_Len    : constant Natural                := File_Name'Length;
      Name_Buffer : constant String (1 .. Name_Len) := To_Lower (File_Name);
      --  This allows us to use from Namet without any change at all

      Even_Name_Len : Integer;
      --  Last even numbered position (used for >12 case)

   begin

      --  Special test for 12 (rather than counting on a when others for the
      --  case statement below) avoids some Ada compilers converting the case
      --  statement into successive jumps.

      --  The case of a name longer than 12 characters is handled by taking
      --  the first 6 odd numbered characters and the last 6 even numbered
      --  characters

      if Name_Len > 12 then
         Even_Name_Len := (Name_Len) / 2 * 2;

         return ((((((((((((
           Character'Pos (Name_Buffer (01))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
           Character'Pos (Name_Buffer (03))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
           Character'Pos (Name_Buffer (05))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
           Character'Pos (Name_Buffer (07))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
           Character'Pos (Name_Buffer (09))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
           Character'Pos (Name_Buffer (11))) * 2 +
           Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
      end if;

      --  For the cases of 1-12 characters, all characters participate in the
      --  hash. The positioning is randomized, with the bias that characters
      --  later on participate fully (i.e. are added towards the right side).

      case Int_0_12 (Name_Len) is

         when 0 =>
            return 0;

         when 1 =>
            return
               Character'Pos (Name_Buffer (1));

         when 2 =>
            return ((
              Character'Pos (Name_Buffer (1))) * 64 +
              Character'Pos (Name_Buffer (2))) mod Hash_Num;

         when 3 =>
            return (((
              Character'Pos (Name_Buffer (1))) * 16 +
              Character'Pos (Name_Buffer (3))) * 16 +
              Character'Pos (Name_Buffer (2))) mod Hash_Num;

         when 4 =>
            return ((((
              Character'Pos (Name_Buffer (1))) * 8 +
              Character'Pos (Name_Buffer (2))) * 8 +
              Character'Pos (Name_Buffer (3))) * 8 +
              Character'Pos (Name_Buffer (4))) mod Hash_Num;

         when 5 =>
            return (((((
              Character'Pos (Name_Buffer (4))) * 8 +
              Character'Pos (Name_Buffer (1))) * 4 +
              Character'Pos (Name_Buffer (3))) * 4 +
              Character'Pos (Name_Buffer (5))) * 8 +
              Character'Pos (Name_Buffer (2))) mod Hash_Num;

         when 6 =>
            return ((((((
              Character'Pos (Name_Buffer (5))) * 4 +
              Character'Pos (Name_Buffer (1))) * 4 +
              Character'Pos (Name_Buffer (4))) * 4 +
              Character'Pos (Name_Buffer (2))) * 4 +
              Character'Pos (Name_Buffer (6))) * 4 +
              Character'Pos (Name_Buffer (3))) mod Hash_Num;

         when 7 =>
            return (((((((
              Character'Pos (Name_Buffer (4))) * 4 +
              Character'Pos (Name_Buffer (3))) * 4 +
              Character'Pos (Name_Buffer (1))) * 4 +
              Character'Pos (Name_Buffer (2))) * 2 +
              Character'Pos (Name_Buffer (5))) * 2 +
              Character'Pos (Name_Buffer (7))) * 2 +
              Character'Pos (Name_Buffer (6))) mod Hash_Num;

         when 8 =>
            return ((((((((
              Character'Pos (Name_Buffer (2))) * 4 +
              Character'Pos (Name_Buffer (1))) * 4 +
              Character'Pos (Name_Buffer (3))) * 2 +
              Character'Pos (Name_Buffer (5))) * 2 +
              Character'Pos (Name_Buffer (7))) * 2 +
              Character'Pos (Name_Buffer (6))) * 2 +
              Character'Pos (Name_Buffer (4))) * 2 +
              Character'Pos (Name_Buffer (8))) mod Hash_Num;

         when 9 =>
            return (((((((((
              Character'Pos (Name_Buffer (2))) * 4 +
              Character'Pos (Name_Buffer (1))) * 4 +
              Character'Pos (Name_Buffer (3))) * 4 +
              Character'Pos (Name_Buffer (4))) * 2 +
              Character'Pos (Name_Buffer (8))) * 2 +
              Character'Pos (Name_Buffer (7))) * 2 +
              Character'Pos (Name_Buffer (5))) * 2 +
              Character'Pos (Name_Buffer (6))) * 2 +
              Character'Pos (Name_Buffer (9))) mod Hash_Num;

         when 10 =>
            return ((((((((((
              Character'Pos (Name_Buffer (01))) * 2 +
              Character'Pos (Name_Buffer (02))) * 2 +
              Character'Pos (Name_Buffer (08))) * 2 +
              Character'Pos (Name_Buffer (03))) * 2 +
              Character'Pos (Name_Buffer (04))) * 2 +
              Character'Pos (Name_Buffer (09))) * 2 +
              Character'Pos (Name_Buffer (06))) * 2 +
              Character'Pos (Name_Buffer (05))) * 2 +
              Character'Pos (Name_Buffer (07))) * 2 +
              Character'Pos (Name_Buffer (10))) mod Hash_Num;

         when 11 =>
            return (((((((((((
              Character'Pos (Name_Buffer (05))) * 2 +
              Character'Pos (Name_Buffer (01))) * 2 +
              Character'Pos (Name_Buffer (06))) * 2 +
              Character'Pos (Name_Buffer (09))) * 2 +
              Character'Pos (Name_Buffer (07))) * 2 +
              Character'Pos (Name_Buffer (03))) * 2 +
              Character'Pos (Name_Buffer (08))) * 2 +
              Character'Pos (Name_Buffer (02))) * 2 +
              Character'Pos (Name_Buffer (10))) * 2 +
              Character'Pos (Name_Buffer (04))) * 2 +
              Character'Pos (Name_Buffer (11))) mod Hash_Num;

         when 12 =>
            return ((((((((((((
              Character'Pos (Name_Buffer (03))) * 2 +
              Character'Pos (Name_Buffer (02))) * 2 +
              Character'Pos (Name_Buffer (05))) * 2 +
              Character'Pos (Name_Buffer (01))) * 2 +
              Character'Pos (Name_Buffer (06))) * 2 +
              Character'Pos (Name_Buffer (04))) * 2 +
              Character'Pos (Name_Buffer (08))) * 2 +
              Character'Pos (Name_Buffer (11))) * 2 +
              Character'Pos (Name_Buffer (07))) * 2 +
              Character'Pos (Name_Buffer (09))) * 2 +
              Character'Pos (Name_Buffer (10))) * 2 +
              Character'Pos (Name_Buffer (12))) mod Hash_Num;

      end case;
   end Hash;

   ----------
   -- Init --
   ----------

   procedure Init is
   begin
      Source_File_Table.Init;
      Hash_Table        := (others => No_SF_Id);
      Illegal_Sources   := 0;
      Tool_Failures     := 0;
      Out_File_Problems := 0;
   end Init;

   ------------------------
   -- Is_Argument_Source --
   ------------------------

   function Is_Argument_Source (SF : SF_Id) return Boolean is
   begin
      return SF in First_SF_Id .. Last_Argument_Source;
   end Is_Argument_Source;

   ---------------
   -- Is_A_Body --
   ---------------

   function Is_A_Body (SF : SF_Id) return Boolean is
   begin
      return Source_Table (SF).Could_Be_Body;
   end Is_A_Body;

   ----------------------
   -- Is_Needed_Source --
   ----------------------

   function Is_Needed_Source (SF : SF_Id) return Boolean is
   begin
      return SF in Last_Argument_Source + 1 .. Source_File_Table.Last;
   end Is_Needed_Source;

   -----------------
   -- Last_Source --
   -----------------

   function Last_Source return SF_Id is
   begin
      return Source_File_Table.Last;
   end Last_Source;

   --------------------------
   -- Last_Argument_Source --
   --------------------------

   function Last_Argument_Source return SF_Id is
   begin
      return Last_Arg_Source;
   end Last_Argument_Source;

   -------------------------------
   -- Next_Non_Processed_Source --
   -------------------------------

   function Next_Non_Processed_Source
     (Only_Bodies            : Boolean := False;
      Include_Needed_Sources : Boolean := False)
      return                  SF_Id
   is
      Up_To            : SF_Id   := Last_Argument_Source;
      New_Source_Found : Boolean := False;
   begin

      if Include_Needed_Sources then
         Up_To := Last_Source;
      end if;

      for J in Next_Source .. Up_To loop

         if Source_Status (J) = Waiting and then
            (not Only_Bodies
            or else
             Is_A_Body (J))
         then
            Next_Source      := J;
            New_Source_Found := True;
            exit;
         end if;

      end loop;

      if not New_Source_Found then
         Next_Source := No_SF_Id;
      end if;

      return Next_Source;
   end Next_Non_Processed_Source;

   -------------------
   -- Output_Source --
   -------------------

   procedure Output_Source (SF : SF_Id) is
      N : constant String := Natural'Image (Sources_Left);
   begin

      if not (ASIS_UL.Common.Multiple_File_Mode or else Verbose_Mode)
        or else
         Is_Needed_Source (SF)
      then
         return;
      end if;

      if Progress_Indicator_Mode then
         declare
            Current : constant Integer := Total_Sources - Sources_Left + 1;
            Percent : String :=
              Integer'Image ((Current * 100) / Total_Sources);
         begin
            Percent (1) := '(';
            Info ("completed" & Integer'Image (Current) & " out of"
                  & Integer'Image (Total_Sources) & " "
                  & Percent & "%)...");
         end;
      end if;

      if Verbose_Mode or else Debug_Mode or else Debug_Flag_S then
         Info_No_EOL ("[" & N (2 .. N'Last) & "] ");

         if Debug_Flag_S then
            Info (Source_Name (SF));
         else
            Info (Short_Source_Name (SF));
         end if;

      elsif not (Quiet_Mode or Progress_Indicator_Mode) then
         Info_No_EOL ("Units remaining:");
         Info_No_EOL (N);
         Info_No_EOL ("     ");
         Info_No_EOL ((1 => ASCII.CR));
      end if;

      Sources_Left := Sources_Left - 1;

   end Output_Source;

   -------------
   -- Present --
   -------------

   function Present (SF : SF_Id) return Boolean is
   begin
      return SF in  First_SF_Id .. Source_File_Table.Last;
   end Present;

   -------------------------
   -- Read_Args_From_File --
   -------------------------

   procedure Read_Args_From_File
     (Par_File_Name       : String;
      Store_With_No_Check : Boolean := False)
   is

      No_More_Args : Boolean := False;

      Arg_File         : File_Type;
      File_Name_Buffer : String (1 .. 16 * 1024);
      File_Name_Len    : Natural := 0;
      Next_Ch          : Character;
      End_Of_Line      : Boolean;
      Tmp_Str          : String_Access;

      function Get_File_Name return String;
      --  Reads from Par_File_Name the name of the next file (the file to read
      --  from should exist and be opened). Returns an empty string if there is
      --  no file names in Par_File_Name any more

      function Get_File_Name return String is
      begin
         File_Name_Len := 0;

         if not End_Of_File (Arg_File) then
            Get (Arg_File, Next_Ch);

            while Is_White_Space (Next_Ch)
               or else
                  Next_Ch = ASCII.LF
               or else
                  Next_Ch = ASCII.CR
            loop
               exit when End_Of_File (Arg_File);
               Get (Arg_File, Next_Ch);
            end loop;

            --  If we are here. Next_Ch is neither a white space nor
            --  end-of-line character. Two cases are possible, they require
            --  different processing:
            --
            --  1. Next_Ch = '"', this means that the file name is surrounded
            --     by quotation marks and it can contain spaces inside.
            --
            --  2. Next_Ch /= '"', this means that the file name is bounded by
            --     a white space or end-of-line character

            if Next_Ch = '"' then

               --  We do not generate any warning for badly formatted content
               --  of the file such as
               --
               --    file_name_1
               --    "file name 2
               --    file_name_3
               --
               --  (We do not check that quotation marks correctly go by pairs)

               --  Skip leading '"'
               Get (Arg_File, Next_Ch);

               while not (Next_Ch = '"'
                  or else
                     Next_Ch = ASCII.LF
                  or else
                     Next_Ch = ASCII.CR)
               loop
                  File_Name_Len := File_Name_Len + 1;
                  File_Name_Buffer (File_Name_Len) := Next_Ch;

                  Look_Ahead (Arg_File, Next_Ch, End_Of_Line);

                  exit when End_Of_Line or else End_Of_File (Arg_File);

                  Get (Arg_File, Next_Ch);
               end loop;

               if Next_Ch = '"'
                 and then
                  not Ada.Text_IO.End_Of_Line (Arg_File)
               then
                  --  skip trailing '"'
                  Get (Arg_File, Next_Ch);
               end if;
            else
               while not (Is_White_Space (Next_Ch)
                  or else
                     Next_Ch = ASCII.LF
                  or else
                     Next_Ch = ASCII.CR)
               loop
                  File_Name_Len := File_Name_Len + 1;
                  File_Name_Buffer (File_Name_Len) := Next_Ch;

                  Look_Ahead (Arg_File, Next_Ch, End_Of_Line);

                  exit when End_Of_Line or else End_Of_File (Arg_File);

                  Get (Arg_File, Next_Ch);
               end loop;
            end if;

         end if;

         return File_Name_Buffer (1 .. File_Name_Len);
      end Get_File_Name;

   begin
      ASIS_UL.Options.No_Argument_File_Specified := False;

      if not Is_Regular_File (Par_File_Name) then
         Error (Par_File_Name & " does not exist");
         return;
      end if;

      Open (Arg_File, In_File, Par_File_Name);

      loop

         Tmp_Str := new String'(Get_File_Name);

         if Store_With_No_Check then
            Store_Sources_To_Process (Tmp_Str.all, No_More_Args);
         else
            Add_Source_To_Process (Tmp_Str.all, No_More_Args);
         end if;

         Free (Tmp_Str);

         exit when No_More_Args;

      end loop;

      if not More_Then_One_Arg_File_Specified then

         if Arg_File_Name /= null then
            --  We have already encountered one non-empty argument file
            Free (Arg_File_Name);
            More_Then_One_Arg_File_Specified := True;
         else
            Arg_File_Name := new String'(Par_File_Name);
         end if;

      end if;

      Close (Arg_File);
   exception
      when others =>
         Error ("cannot read arguments from " & Par_File_Name);
         --  Exception info will be generated in main driver
         raise;
   end Read_Args_From_File;

   ---------------------------------
   -- Read_Args_From_Temp_Storage --
   ---------------------------------

   procedure Read_Args_From_Temp_Storage (Duplication_Report : Boolean) is
      Tmp : Boolean;
   begin

      for J in Temp_File_Storage.First .. Temp_File_Storage.Last loop
         Add_Source_To_Process
           (Fname              => Temp_File_Storage.Table (J).all,
            No_Argument        => Tmp,
            Duplication_Report =>  Duplication_Report);

         Free (Temp_File_Storage.Table (J));
      end loop;

   end Read_Args_From_Temp_Storage;

   ---------------------------
   -- Reset_Source_Iterator --
   ---------------------------

   procedure Reset_Source_Iterator is
   begin
      Next_Source := First_SF_Id;
   end Reset_Source_Iterator;

   ------------------------
   -- Temp_Storage_Empty --
   ------------------------

   function Temp_Storage_Empty return Boolean is
   begin
      return Temp_File_Storage.Last < Temp_File_Storage.First;
   end Temp_Storage_Empty;

   -------------------------
   -- Same_Name_File_Find --
   -------------------------

   function Same_Name_File_Find (Short_SF_Name : String) return SF_Id is
      Result     : SF_Id := No_SF_Id;
      Next_SF    : SF_Id;
   begin
      Next_SF := Hash_Table (Hash (Short_SF_Name));

      while Present (Next_SF) loop

         if Short_SF_Name = Short_Source_Name (Next_SF) then
            Result := Next_SF;
            exit;
         end if;

         Next_SF := Source_Table (Next_SF).Hash_Link;
      end loop;

      return Result;
   end Same_Name_File_Find;

   -----------------
   -- Set_CU_Name --
   -----------------

   procedure Set_CU_Name (SF : SF_Id; N : String) is
   begin
      Source_Table (SF).CU_Name := Enter_String (N);
   end Set_CU_Name;

   --------------------
   -- Set_Current_SF --
   --------------------

   procedure Set_Current_SF (SF : SF_Id) is
   begin
      Current_SF := SF;
   end Set_Current_SF;

   ---------------------
   -- Set_Source_Info --
   ---------------------

   procedure Set_Source_Info (SF : SF_Id; Info : SF_Info) is
   begin
      Source_Table (SF).Info := Info;
   end Set_Source_Info;

   ---------------------------
   -- Set_Short_Source_Name --
   ---------------------------

   procedure Set_Short_Source_Name (SF : SF_Id; N : String) is
   begin
      Source_Table (SF).Short_Source_Name := Enter_String (N);
   end Set_Short_Source_Name;

   ---------------------
   -- Set_Source_Name --
   ---------------------

   procedure Set_Source_Name (SF : SF_Id; N : String) is
   begin
      Source_Table (SF).Source_Name := Enter_String (N);
   end Set_Source_Name;

   -----------------------
   -- Set_Source_Status --
   -----------------------

   procedure Set_Source_Status (SF : SF_Id; S : SF_Status) is
   begin
      Source_Table (SF).Status := S;

      case S is
         when Not_A_Legal_Source =>
            Illegal_Sources := Illegal_Sources + 1;
         when Error_Detected =>
            Tool_Failures := Tool_Failures + 1;
         when Out_File_Problem =>
            Out_File_Problems := Out_File_Problems + 1;
         when others =>
            null;
      end case;

   end Set_Source_Status;

   -------------------------
   -- Set_Suffixless_Name --
   -------------------------

   procedure Set_Suffixless_Name   (SF : SF_Id; N : String) is
   begin
      Source_Table (SF).Suffixless_Name := Enter_String (N);
   end Set_Suffixless_Name;

   -----------------------
   -- Short_Source_Name --
   -----------------------

   function Short_Source_Name (SF : SF_Id) return String is
   begin
      return Get_String (Source_Table (SF).Short_Source_Name);
   end Short_Source_Name;

   ---------------------
   -- Source_Clean_Up --
   ---------------------

   procedure Source_Clean_Up
     (SF             : SF_Id;
      Keep_ALI_Files : Boolean := False)
   is
      Success : Boolean;
      pragma Unreferenced (Success);
   begin
      Context_Clean_Up;

      Delete_File (Suffixless_Name (SF) & ".adt", Success);

      if not Keep_ALI_Files then
         Delete_File (Suffixless_Name (SF) & ".ali", Success);
      end if;

   end Source_Clean_Up;

   -----------------
   -- Source_Name --
   -----------------

   function Source_Name (SF : SF_Id) return String is
   begin
      return Get_String (Source_Table (SF).Source_Name);
   end Source_Name;

   -----------------
   -- Source_Info --
   -----------------

   function Source_Info (SF : SF_Id) return SF_Info is
   begin
      return  Source_Table (SF).Info;
   end Source_Info;

   -------------------
   -- Source_Status --
   -------------------

   function Source_Status (SF : SF_Id) return SF_Status is
   begin
      return Source_Table (SF).Status;
   end Source_Status;

   ------------------------
   -- Source_Debug_Image --
   ------------------------

   procedure Source_Debug_Image (SF : SF_Id) is
      Ident_String : constant String := "   ";
   begin
      Info ("SF =" & SF'Img);

      Info_No_EOL (Ident_String);
      Info        ("Source_Name       = >" & Source_Name (SF) & "<");

      Info_No_EOL (Ident_String);
      Info        ("Short_Source_Name = >" & Short_Source_Name (SF) & "<");

      Info_No_EOL (Ident_String);
      Info        ("Source_Status     = " & Source_Status (SF)'Img);

      Info_No_EOL (Ident_String);
      Info        ("Contained Ada CU  = >" & CU_Name (SF) & "<");

      Info_No_EOL (Ident_String);
      Info        ("Hash_Link         =" &
                   Source_File_Table.Table (SF).Hash_Link'Img);

      if Source_File_Table.Table (SF).Info /= 0 then
         Info_No_EOL (Ident_String);
         Info        ("Info              =" &
                      Source_File_Table.Table (SF).Info'Img);
      end if;

   end Source_Debug_Image;

   ------------------------------
   -- Source_Table_Debug_Image --
   ------------------------------

   procedure Source_Table_Debug_Image is
   begin
      if Debug_Flag_S or else ASIS_UL.Options.Debug_Mode then

         Info ("-= SOURCE TABLE DEBUG IMAGE =-");

         if Last_Argument_Source < First_SF_Id then
            Info ("  No source stored in source table");
            return;
         end if;

         Info ("");
         Info ("-= Argument sources =-");

         for J in First_SF_Id .. Last_Argument_Source loop
            Source_Debug_Image (J);
         end loop;

         Info ("");

         if Last_Source = Last_Argument_Source then
            Info ("  No needed source added in source table");
            return;
         end if;

         Info ("-= Needed sources =-");
         for J in Last_Argument_Source + 1 .. Last_Source loop
            Source_Debug_Image (J);
         end loop;

      end if;
   end Source_Table_Debug_Image;

   ------------------------------
   -- Store_Sources_To_Process --
   ------------------------------

   procedure Store_Sources_To_Process
     (Fname              : String;
      No_Argument        : out Boolean)
   is
   begin

      if Fname = "" then
         No_Argument := True;
         return;
      else
         ASIS_UL.Options.No_Argument_File_Specified := False;
         No_Argument                                := False;
         Temp_File_Storage.Append (new String'(Fname));

         if Debug_Flag_S then
            Info ("Storing argument file:>" & Fname & "<");
         end if;
      end if;

   end Store_Sources_To_Process;

   ---------------------
   -- Suffixless_Name --
   ---------------------

   function Suffixless_Name   (SF : SF_Id) return String is
   begin
      return Get_String (Source_Table (SF).Suffixless_Name);
   end Suffixless_Name;

end ASIS_UL.Source_Table;
