------------------------------------------------------------------------------
--                                                                          --
--                     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-2007, 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.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

   -----------------------
   -- 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

      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 : SF_Record;
   --  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;

      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));
      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)
   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;
      end if;

      if not Use_Project_File
        and then
         not Is_Regular_File (Fname)
      then
         Error (Fname & " not found");
         return;
      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
            Error (Short_Source_Name_String.all & " duplicated");
            return;
         end if;

      else

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

         Full_Source_Name_String  :=
           new String'(Normalize_Pathname
                         (Fname,
                          Resolve_Links  => False,
                          Case_Sensitive => False));

         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.
               Error (Short_Source_Name_String.all & " duplicated");
               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 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;
      end if;

      Free (Short_Source_Name_String);
      Free (Full_Source_Name_String);

   end Add_Source_To_Process;

   -----------------------
   -- 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;

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

   procedure Create_Tree
     (SF           : SF_Id;
      Success      : out Boolean;
      Compiler_Out : String := "")
   is
   begin
      --  ??? Do we need a trace of the compiler call in debug mode?
      if Verbose_Mode 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);

      if not Success then
         Error (Source_Name (SF) & " is not a legal Ada source");
         Set_Source_Status (SF, Not_A_Legal_Source);
      end if;

   end Create_Tree;

   ---------------
   -- 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 :=
              To_String (Asis.Compilation_Units.Text_Name
                (Asis.Elements.Enclosing_Compilation_Unit (El)));

            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;

   ----------
   -- 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) := 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 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 then
         Info ("[" & N (2 .. N'Last) & "]  " & Short_Source_Name (SF));

      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 /= No_SF_Id;
   end Present;

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

   procedure Read_Args_From_File (Par_File_Name : String) 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;

      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;

            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;

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

   begin

      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
         Add_Source_To_Process (Get_File_Name, No_More_Args);
         exit when No_More_Args;
      end loop;

      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;

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

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

   -------------------------
   -- 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_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) is

      Success : Boolean;
   begin
      Context_Clean_Up;

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

   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        ("Hash_Link         =" &
                   Source_File_Table.Table (SF) .Hash_Link'Img);

   end Source_Debug_Image;

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

   procedure Source_Table_Debug_Image is
   begin
      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 Source_Table_Debug_Image;

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

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

begin
   New_SF_Record.Source_Name       := Nil_String_Loc;
   New_SF_Record.Short_Source_Name := Nil_String_Loc;
   New_SF_Record.Suffixless_Name   := Nil_String_Loc;
   New_SF_Record.Status            := Waiting;
   New_SF_Record.Hash_Link         := No_SF_Id;
   New_SF_Record.Could_Be_Body     := False;
end ASIS_UL.Source_Table;