------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               G N A T L S                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2019, 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 3,  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 COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with ALI;         use ALI;
with ALI.Util;    use ALI.Util;
with Binderr;     use Binderr;
with Butil;       use Butil;
with Csets;
with Fname;       use Fname;
with Gnatvsn;     use Gnatvsn;
with Make_Util;   use Make_Util;
with Namet;       use Namet;
with Opt;         use Opt;
with Osint;       use Osint;
with Osint.L;     use Osint.L;
with Output;      use Output;
with Rident;      use Rident;
with Sdefault;
with Snames;
with Stringt;
with Switch;      use Switch;
with Types;       use Types;

with GNAT.Case_Util;            use GNAT.Case_Util;
with GNAT.Command_Line;         use GNAT.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib;               use GNAT.OS_Lib;

procedure Gnatls is
   pragma Ident (Gnat_Static_Version_String);

   --  NOTE : The following string may be used by other tools, such as
   --  GNAT Studio. So it can only be modified if these other uses are checked
   --  and coordinated.

   Project_Search_Path : constant String := "Project Search Path:";
   --  Label displayed in verbose mode before the directories in the project
   --  search path. Do not modify without checking NOTE above.

   Prj_Path : String_Access;

   Max_Column : constant := 80;

   No_Obj : aliased String := "<no_obj>";

   No_Runtime : Boolean := False;
   --  Set to True if there is no default runtime and --RTS= is not specified

   type File_Status is (
     OK,                  --  matching timestamp
     Checksum_OK,         --  only matching checksum
     Not_Found,           --  file not found on source PATH
     Not_Same,            --  neither checksum nor timestamp matching
     Not_First_On_PATH);  --  matching file hidden by Not_Same file on path

   type Dir_Data;
   type Dir_Ref is access Dir_Data;

   type Dir_Data is record
      Value : String_Access;
      Next  : Dir_Ref;
   end record;
   --  Simply linked list of dirs

   First_Source_Dir : Dir_Ref;
   Last_Source_Dir  : Dir_Ref;
   --  The list of source directories from the command line.
   --  These directories are added using Osint.Add_Src_Search_Dir
   --  after those of the GNAT Project File, if any.

   First_Lib_Dir : Dir_Ref;
   Last_Lib_Dir  : Dir_Ref;
   --  The list of object directories from the command line.
   --  These directories are added using Osint.Add_Lib_Search_Dir
   --  after those of the GNAT Project File, if any.

   Main_File : File_Name_Type;
   Ali_File  : File_Name_Type;
   Text      : Text_Buffer_Ptr;
   Next_Arg  : Positive;

   Too_Long : Boolean := False;
   --  When True, lines are too long for multi-column output and each
   --  item of information is on a different line.

   Selective_Output : Boolean := False;
   Print_Usage      : Boolean := False;
   Print_Unit       : Boolean := True;
   Print_Source     : Boolean := True;
   Print_Object     : Boolean := True;
   --  Flags controlling the form of the output

   Also_Predef       : Boolean := False;  --  -a
   Dependable        : Boolean := False;  --  -d
   License           : Boolean := False;  --  -l
   Very_Verbose_Mode : Boolean := False;  --  -V
   --  Command line flags

   Unit_Start   : Integer;
   Unit_End     : Integer;
   Source_Start : Integer;
   Source_End   : Integer;
   Object_Start : Integer;
   Object_End   : Integer;
   --  Various column starts and ends

   Spaces : constant String (1 .. Max_Column) := (others => ' ');

   RTS_Specified : String_Access := null;
   --  Used to detect multiple use of --RTS= switch

   Exit_Status : Exit_Code_Type := E_Success;
   --  Reset to E_Fatal if bad error found

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Add_Lib_Dir (Dir : String);
   --  Add an object directory in the list First_Lib_Dir-Last_Lib_Dir

   procedure Add_Source_Dir (Dir : String);
   --  Add a source directory in the list First_Source_Dir-Last_Source_Dir

   procedure Find_General_Layout;
   --  Determine the structure of the output (multi columns or not, etc)

   procedure Find_Status
     (FS       : in out File_Name_Type;
      Stamp    : Time_Stamp_Type;
      Checksum : Word;
      Status   : out File_Status);
   --  Determine the file status (Status) of the file represented by FS with
   --  the expected Stamp and checksum given as argument. FS will be updated
   --  to the full file name if available.

   function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
   --  Give the Sdep entry corresponding to the unit U in ali record A

   procedure Output_Object (O : File_Name_Type);
   --  Print out the name of the object when requested

   procedure Output_Source (Sdep_I : Sdep_Id);
   --  Print out the name and status of the source corresponding to this
   --  sdep entry.

   procedure Output_Status (FS : File_Status; Verbose : Boolean);
   --  Print out FS either in a coded form if verbose is false or in an
   --  expanded form otherwise.

   procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
   --  Print out information on the unit when requested

   procedure Reset_Print;
   --  Reset Print flags properly when selective output is chosen

   procedure Scan_Ls_Arg (Argv : String);
   --  Scan and process user specific arguments (Argv is a single argument)

   procedure Search_RTS (Name : String);
   --  Find include and objects path for the RTS name.

   procedure Usage;
   --  Print usage message

   procedure Output_License_Information;
   pragma No_Return (Output_License_Information);
   --  Output license statement, and if not found, output reference to COPYING

   function Image (Restriction : Restriction_Id) return String;
   --  Returns the capitalized image of Restriction

   function Normalize (Path : String) return String;
   --  Returns a normalized path name. On Windows, the directory separators are
   --  set to '\' in Normalize_Pathname.

   ------------------------------------------
   -- GNATDIST specific output subprograms --
   ------------------------------------------

   package GNATDIST is

      --  Any modification to this subunit requires synchronization with the
      --  GNATDIST sources.

      procedure Output_ALI (A : ALI_Id);
      --  Comment required saying what this routine does ???

      procedure Output_No_ALI (Afile : File_Name_Type);
      --  Comments required saying what this routine does ???

   end GNATDIST;

   ------------------------------
   -- Support for project path --
   ------------------------------

   package Prj_Env is

      procedure Initialize_Default_Project_Path
        (Self         : in out String_Access;
         Target_Name  : String;
         Runtime_Name : String := "");
      --  Initialize Self. It will then contain the default project path on
      --  the given target and runtime (including directories specified by the
      --  environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
      --  ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
      --  then the path contains only those directories specified by the
      --  environment variables (except "-"). This does nothing if Self has
      --  already been initialized.

      procedure Add_Directories
        (Self    : in out String_Access;
         Path    : String;
         Prepend : Boolean := False);
      --  Add one or more directories to the path. Directories added with this
      --  procedure are added in order after the current directory and before
      --  the path given by the environment variable GPR_PROJECT_PATH. A value
      --  of "-" will remove the default project directory from the project
      --  path.
      --
      --  Calls to this subprogram must be performed before the first call to
      --  Find_Project below, or PATH will be added at the end of the search
      --  path.

      function Get_Runtime_Path
        (Self : String_Access;
         Path : String) return String_Access;
      --  Compute the full path for the project-based runtime name.
      --  Path is simply searched on the project path.

   end Prj_Env;

   -----------------
   -- Add_Lib_Dir --
   -----------------

   procedure Add_Lib_Dir (Dir : String) is
   begin
      if First_Lib_Dir = null then
         First_Lib_Dir :=
           new Dir_Data'
             (Value => new String'(Dir),
              Next  => null);
         Last_Lib_Dir := First_Lib_Dir;

      else
         Last_Lib_Dir.Next :=
           new Dir_Data'
             (Value => new String'(Dir),
              Next  => null);
         Last_Lib_Dir := Last_Lib_Dir.Next;
      end if;
   end Add_Lib_Dir;

   --------------------
   -- Add_Source_Dir --
   --------------------

   procedure Add_Source_Dir (Dir : String) is
   begin
      if First_Source_Dir = null then
         First_Source_Dir :=
           new Dir_Data'
             (Value => new String'(Dir),
              Next  => null);
         Last_Source_Dir := First_Source_Dir;

      else
         Last_Source_Dir.Next :=
           new Dir_Data'
             (Value => new String'(Dir),
              Next  => null);
         Last_Source_Dir := Last_Source_Dir.Next;
      end if;
   end Add_Source_Dir;

   ------------------------------
   -- Corresponding_Sdep_Entry --
   ------------------------------

   function Corresponding_Sdep_Entry
     (A : ALI_Id;
      U : Unit_Id) return Sdep_Id
   is
   begin
      for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
         if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
            return D;
         end if;
      end loop;

      Error_Msg_Unit_1 := Units.Table (U).Uname;
      Error_Msg_File_1 := ALIs.Table (A).Afile;
      Write_Eol;
      Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
      Exit_Program (E_Fatal);
      return No_Sdep_Id;
   end Corresponding_Sdep_Entry;

   -------------------------
   -- Find_General_Layout --
   -------------------------

   procedure Find_General_Layout is
      Max_Unit_Length : Integer := 11;
      Max_Src_Length  : Integer := 11;
      Max_Obj_Length  : Integer := 11;

      Len : Integer;
      FS  : File_Name_Type;

   begin
      --  Compute maximum of each column

      for Id in ALIs.First .. ALIs.Last loop
         Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
         if Also_Predef or else not Is_Internal_Unit then

            if Print_Unit then
               Len := Name_Len - 1;
               Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
            end if;

            if Print_Source then
               FS := Full_Source_Name (ALIs.Table (Id).Sfile);

               if FS = No_File then
                  Get_Name_String (ALIs.Table (Id).Sfile);
                  Name_Len := Name_Len + 13;
               else
                  Get_Name_String (FS);
               end if;

               Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
            end if;

            if Print_Object then
               if ALIs.Table (Id).No_Object then
                  Max_Obj_Length :=
                    Integer'Max (Max_Obj_Length, No_Obj'Length);
               else
                  Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
                  Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
               end if;
            end if;
         end if;
      end loop;

      --  Verify is output is not wider than maximum number of columns

      Too_Long :=
        Verbose_Mode
          or else
            (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;

      --  Set start and end of columns

      Object_Start := 1;
      Object_End   := Object_Start - 1;

      if Print_Object then
         Object_End   := Object_Start + Max_Obj_Length;
      end if;

      Unit_Start := Object_End + 1;
      Unit_End   := Unit_Start - 1;

      if Print_Unit then
         Unit_End   := Unit_Start + Max_Unit_Length;
      end if;

      Source_Start := Unit_End + 1;

      if Source_Start > Spaces'Last then
         Source_Start := Spaces'Last;
      end if;

      Source_End := Source_Start - 1;

      if Print_Source then
         Source_End := Source_Start + Max_Src_Length;
      end if;
   end Find_General_Layout;

   -----------------
   -- Find_Status --
   -----------------

   procedure Find_Status
     (FS       : in out File_Name_Type;
      Stamp    : Time_Stamp_Type;
      Checksum : Word;
      Status   : out File_Status)
   is
      Tmp1 : File_Name_Type;
      Tmp2 : File_Name_Type;

   begin
      Tmp1 := Full_Source_Name (FS);

      if Tmp1 = No_File then
         Status := Not_Found;

      elsif File_Stamp (Tmp1) = Stamp then
         FS     := Tmp1;
         Status := OK;

      elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
         FS := Tmp1;
         Status := Checksum_OK;

      else
         Tmp2 := Matching_Full_Source_Name (FS, Stamp);

         if Tmp2 = No_File then
            Status := Not_Same;
            FS     := Tmp1;

         else
            Status := Not_First_On_PATH;
            FS := Tmp2;
         end if;
      end if;
   end Find_Status;

   --------------
   -- GNATDIST --
   --------------

   package body GNATDIST is

      N_Flags   : Natural;
      N_Indents : Natural := 0;

      type Token_Type is
        (T_No_ALI,
         T_ALI,
         T_Unit,
         T_With,
         T_Source,
         T_Afile,
         T_Ofile,
         T_Sfile,
         T_Name,
         T_Main,
         T_Kind,
         T_Flags,
         T_Preelaborated,
         T_Pure,
         T_Has_RACW,
         T_Remote_Types,
         T_Shared_Passive,
         T_RCI,
         T_Predefined,
         T_Internal,
         T_Is_Generic,
         T_Procedure,
         T_Function,
         T_Package,
         T_Subprogram,
         T_Spec,
         T_Body);

      Image : constant array (Token_Type) of String_Access :=
                (T_No_ALI         => new String'("No_ALI"),
                 T_ALI            => new String'("ALI"),
                 T_Unit           => new String'("Unit"),
                 T_With           => new String'("With"),
                 T_Source         => new String'("Source"),
                 T_Afile          => new String'("Afile"),
                 T_Ofile          => new String'("Ofile"),
                 T_Sfile          => new String'("Sfile"),
                 T_Name           => new String'("Name"),
                 T_Main           => new String'("Main"),
                 T_Kind           => new String'("Kind"),
                 T_Flags          => new String'("Flags"),
                 T_Preelaborated  => new String'("Preelaborated"),
                 T_Pure           => new String'("Pure"),
                 T_Has_RACW       => new String'("Has_RACW"),
                 T_Remote_Types   => new String'("Remote_Types"),
                 T_Shared_Passive => new String'("Shared_Passive"),
                 T_RCI            => new String'("RCI"),
                 T_Predefined     => new String'("Predefined"),
                 T_Internal       => new String'("Internal"),
                 T_Is_Generic     => new String'("Is_Generic"),
                 T_Procedure      => new String'("procedure"),
                 T_Function       => new String'("function"),
                 T_Package        => new String'("package"),
                 T_Subprogram     => new String'("subprogram"),
                 T_Spec           => new String'("spec"),
                 T_Body           => new String'("body"));

      procedure Output_Name  (N : Name_Id);
      --  Remove any encoding info (%b and %s) and output N

      procedure Output_Afile (A : File_Name_Type);
      procedure Output_Ofile (O : File_Name_Type);
      procedure Output_Sfile (S : File_Name_Type);
      --  Output various names. Check that the name is different from no name.
      --  Otherwise, skip the output.

      procedure Output_Token (T : Token_Type);
      --  Output token using specific format. That is several indentations and:
      --
      --  T_No_ALI  .. T_With : <token> & " =>" & NL
      --  T_Source  .. T_Kind : <token> & " => "
      --  T_Flags             : <token> & " =>"
      --  T_Preelab .. T_Body : " " & <token>

      procedure Output_Sdep  (S : Sdep_Id);
      procedure Output_Unit  (U : Unit_Id);
      procedure Output_With  (W : With_Id);
      --  Output this entry as a global section (like ALIs)

      ------------------
      -- Output_Afile --
      ------------------

      procedure Output_Afile (A : File_Name_Type) is
      begin
         if A /= No_File then
            Output_Token (T_Afile);
            Write_Name (A);
            Write_Eol;
         end if;
      end Output_Afile;

      ----------------
      -- Output_ALI --
      ----------------

      procedure Output_ALI (A : ALI_Id) is
      begin
         Output_Token (T_ALI);
         N_Indents := N_Indents + 1;

         Output_Afile (ALIs.Table (A).Afile);
         Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
         Output_Sfile (ALIs.Table (A).Sfile);

         --  Output Main

         if ALIs.Table (A).Main_Program /= None then
            Output_Token (T_Main);

            if ALIs.Table (A).Main_Program = Proc then
               Output_Token (T_Procedure);
            else
               Output_Token (T_Function);
            end if;

            Write_Eol;
         end if;

         --  Output Units

         for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
            Output_Unit (U);
         end loop;

         --  Output Sdeps

         for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
            Output_Sdep (S);
         end loop;

         N_Indents := N_Indents - 1;
      end Output_ALI;

      -------------------
      -- Output_No_ALI --
      -------------------

      procedure Output_No_ALI (Afile : File_Name_Type) is
      begin
         Output_Token (T_No_ALI);
         N_Indents := N_Indents + 1;
         Output_Afile (Afile);
         N_Indents := N_Indents - 1;
      end Output_No_ALI;

      -----------------
      -- Output_Name --
      -----------------

      procedure Output_Name (N : Name_Id) is
      begin
         --  Remove any encoding info (%s or %b)

         Get_Name_String (N);

         if Name_Len > 2
           and then Name_Buffer (Name_Len - 1) = '%'
         then
            Name_Len := Name_Len - 2;
         end if;

         Output_Token (T_Name);
         Write_Str (Name_Buffer (1 .. Name_Len));
         Write_Eol;
      end Output_Name;

      ------------------
      -- Output_Ofile --
      ------------------

      procedure Output_Ofile (O : File_Name_Type) is
      begin
         if O /= No_File then
            Output_Token (T_Ofile);
            Write_Name (O);
            Write_Eol;
         end if;
      end Output_Ofile;

      -----------------
      -- Output_Sdep --
      -----------------

      procedure Output_Sdep (S : Sdep_Id) is
      begin
         Output_Token (T_Source);
         Write_Name (Sdep.Table (S).Sfile);
         Write_Eol;
      end Output_Sdep;

      ------------------
      -- Output_Sfile --
      ------------------

      procedure Output_Sfile (S : File_Name_Type) is
         FS : File_Name_Type := S;

      begin
         if FS /= No_File then

            --  We want to output the full source name

            FS := Full_Source_Name (FS);

            --  There is no full source name. This occurs for instance when a
            --  withed unit has a spec file but no body file. This situation is
            --  not a problem for GNATDIST since the unit may be located on a
            --  partition we do not want to build. However, we need to locate
            --  the spec file and to find its full source name. Replace the
            --  body file name with the spec file name used to compile the
            --  current unit when possible.

            if FS = No_File then
               Get_Name_String (S);

               if Name_Len > 4
                 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
               then
                  Name_Buffer (Name_Len) := 's';
                  FS := Full_Source_Name (Name_Find);
               end if;
            end if;
         end if;

         if FS /= No_File then
            Output_Token (T_Sfile);
            Write_Name (FS);
            Write_Eol;
         end if;
      end Output_Sfile;

      ------------------
      -- Output_Token --
      ------------------

      procedure Output_Token (T : Token_Type) is
      begin
         case T is
            when T_No_ALI .. T_Flags =>
               for J in 1 .. N_Indents loop
                  Write_Str ("   ");
               end loop;

               Write_Str (Image (T).all);

               for J in Image (T)'Length .. 12 loop
                  Write_Char (' ');
               end loop;

               Write_Str ("=>");

               if T in T_No_ALI .. T_With then
                  Write_Eol;
               elsif T in T_Source .. T_Name then
                  Write_Char (' ');
               end if;

            when T_Preelaborated .. T_Body =>
               if T in T_Preelaborated .. T_Is_Generic then
                  if N_Flags = 0 then
                     Output_Token (T_Flags);
                  end if;

                  N_Flags := N_Flags + 1;
               end if;

               Write_Char (' ');
               Write_Str  (Image (T).all);
         end case;
      end Output_Token;

      -----------------
      -- Output_Unit --
      -----------------

      procedure Output_Unit (U : Unit_Id) is
      begin
         Output_Token (T_Unit);
         N_Indents := N_Indents + 1;

         --  Output Name

         Output_Name (Name_Id (Units.Table (U).Uname));

         --  Output Kind

         Output_Token (T_Kind);

         if Units.Table (U).Unit_Kind = 'p' then
            Output_Token (T_Package);
         else
            Output_Token (T_Subprogram);
         end if;

         if Name_Buffer (Name_Len) = 's' then
            Output_Token (T_Spec);
         else
            Output_Token (T_Body);
         end if;

         Write_Eol;

         --  Output source file name

         Output_Sfile (Units.Table (U).Sfile);

         --  Output Flags

         N_Flags := 0;

         if Units.Table (U).Preelab then
            Output_Token (T_Preelaborated);
         end if;

         if Units.Table (U).Pure then
            Output_Token (T_Pure);
         end if;

         if Units.Table (U).Has_RACW then
            Output_Token (T_Has_RACW);
         end if;

         if Units.Table (U).Remote_Types then
            Output_Token (T_Remote_Types);
         end if;

         if Units.Table (U).Shared_Passive then
            Output_Token (T_Shared_Passive);
         end if;

         if Units.Table (U).RCI then
            Output_Token (T_RCI);
         end if;

         if Units.Table (U).Predefined then
            Output_Token (T_Predefined);
         end if;

         if Units.Table (U).Internal then
            Output_Token (T_Internal);
         end if;

         if Units.Table (U).Is_Generic then
            Output_Token (T_Is_Generic);
         end if;

         if N_Flags > 0 then
            Write_Eol;
         end if;

         --  Output Withs

         for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
            Output_With (W);
         end loop;

         N_Indents := N_Indents - 1;
      end Output_Unit;

      -----------------
      -- Output_With --
      -----------------

      procedure Output_With (W : With_Id) is
      begin
         Output_Token (T_With);
         N_Indents := N_Indents + 1;

         Output_Name (Name_Id (Withs.Table (W).Uname));

         --  Output Kind

         Output_Token (T_Kind);

         if Name_Buffer (Name_Len) = 's' then
            Output_Token (T_Spec);
         else
            Output_Token (T_Body);
         end if;

         Write_Eol;

         Output_Afile (Withs.Table (W).Afile);
         Output_Sfile (Withs.Table (W).Sfile);

         N_Indents := N_Indents - 1;
      end Output_With;

   end GNATDIST;

   -----------
   -- Image --
   -----------

   function Image (Restriction : Restriction_Id) return String is
      Result : String := Restriction'Img;
      Skip   : Boolean := True;

   begin
      for J in Result'Range loop
         if Skip then
            Skip := False;
            Result (J) := To_Upper (Result (J));

         elsif Result (J) = '_' then
            Skip := True;

         else
            Result (J) := To_Lower (Result (J));
         end if;
      end loop;

      return Result;
   end Image;

   ---------------
   -- Normalize --
   ---------------

   function Normalize (Path : String) return String is
   begin
      return Normalize_Pathname (Path);
   end Normalize;

   --------------------------------
   -- Output_License_Information --
   --------------------------------

   procedure Output_License_Information is
   begin
      case Build_Type is
         when others =>
            Write_Str ("Please refer to file COPYING in your distribution"
                     & " for license terms.");
            Write_Eol;
      end case;

      Exit_Program (E_Success);
   end Output_License_Information;

   -------------------
   -- Output_Object --
   -------------------

   procedure Output_Object (O : File_Name_Type) is
      Object_Name : String_Access;

   begin
      if Print_Object then
         if O /= No_File then
            Get_Name_String (O);
            Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
         else
            Object_Name := No_Obj'Unchecked_Access;
         end if;

         Write_Str (Object_Name.all);

         if Print_Source or else Print_Unit then
            if Too_Long then
               Write_Eol;
               Write_Str ("   ");
            else
               Write_Str (Spaces
                (Object_Start + Object_Name'Length .. Object_End));
            end if;
         end if;
      end if;
   end Output_Object;

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

   procedure Output_Source (Sdep_I : Sdep_Id) is
      Stamp       : Time_Stamp_Type;
      Checksum    : Word;
      FS          : File_Name_Type;
      Status      : File_Status;
      Object_Name : String_Access;

   begin
      if Sdep_I = No_Sdep_Id then
         return;
      end if;

      Stamp    := Sdep.Table (Sdep_I).Stamp;
      Checksum := Sdep.Table (Sdep_I).Checksum;
      FS       := Sdep.Table (Sdep_I).Sfile;

      if Print_Source then
         Find_Status (FS, Stamp, Checksum, Status);
         Get_Name_String (FS);

         Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));

         if Verbose_Mode then
            Write_Str ("  Source => ");
            Write_Str (Object_Name.all);

            if not Too_Long then
               Write_Str
                 (Spaces (Source_Start + Object_Name'Length .. Source_End));
            end if;

            Output_Status (Status, Verbose => True);
            Write_Eol;
            Write_Str ("   ");

         else
            if not Selective_Output then
               Output_Status (Status, Verbose => False);
            end if;

            Write_Str (Object_Name.all);
         end if;
      end if;
   end Output_Source;

   -------------------
   -- Output_Status --
   -------------------

   procedure Output_Status (FS : File_Status; Verbose : Boolean) is
   begin
      if Verbose then
         case FS is
            when OK =>
               Write_Str (" unchanged");

            when Checksum_OK =>
               Write_Str (" slightly modified");

            when Not_Found =>
               Write_Str (" file not found");

            when Not_Same =>
               Write_Str (" modified");

            when Not_First_On_PATH =>
               Write_Str (" unchanged version not first on PATH");
         end case;

      else
         case FS is
            when OK =>
               Write_Str ("  OK ");

            when Checksum_OK =>
               Write_Str (" MOK ");

            when Not_Found =>
               Write_Str (" ??? ");

            when Not_Same =>
               Write_Str (" DIF ");

            when Not_First_On_PATH =>
               Write_Str (" HID ");
         end case;
      end if;
   end Output_Status;

   -----------------
   -- Output_Unit --
   -----------------

   procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
      Kind : Character;
      U    : Unit_Record renames Units.Table (U_Id);

   begin
      if Print_Unit then
         Get_Name_String (U.Uname);
         Kind := Name_Buffer (Name_Len);
         Name_Len := Name_Len - 2;

         if not Verbose_Mode then
            Write_Str (Name_Buffer (1 .. Name_Len));

         else
            Write_Str ("Unit => ");
            Write_Eol;
            Write_Str ("     Name   => ");
            Write_Str (Name_Buffer (1 .. Name_Len));
            Write_Eol;
            Write_Str ("     Kind   => ");

            if Units.Table (U_Id).Unit_Kind = 'p' then
               Write_Str ("package ");
            else
               Write_Str ("subprogram ");
            end if;

            if Kind = 's' then
               Write_Str ("spec");
            else
               Write_Str ("body");
            end if;
         end if;

         if Verbose_Mode then
            if U.Preelab             or else
               U.No_Elab             or else
               U.Pure                or else
               U.Dynamic_Elab        or else
               U.Has_RACW            or else
               U.Remote_Types        or else
               U.Shared_Passive      or else
               U.RCI                 or else
               U.Predefined          or else
               U.Internal            or else
               U.Is_Generic          or else
               U.Init_Scalars        or else
               U.SAL_Interface       or else
               U.Body_Needed_For_SAL or else
               U.Elaborate_Body
            then
               Write_Eol;
               Write_Str ("     Flags  =>");

               if U.Preelab then
                  Write_Str (" Preelaborable");
               end if;

               if U.No_Elab then
                  Write_Str (" No_Elab_Code");
               end if;

               if U.Pure then
                  Write_Str (" Pure");
               end if;

               if U.Dynamic_Elab then
                  Write_Str (" Dynamic_Elab");
               end if;

               if U.Has_RACW then
                  Write_Str (" Has_RACW");
               end if;

               if U.Remote_Types then
                  Write_Str (" Remote_Types");
               end if;

               if U.Shared_Passive then
                  Write_Str (" Shared_Passive");
               end if;

               if U.RCI then
                  Write_Str (" RCI");
               end if;

               if U.Predefined then
                  Write_Str (" Predefined");
               end if;

               if U.Internal then
                  Write_Str (" Internal");
               end if;

               if U.Is_Generic then
                  Write_Str (" Is_Generic");
               end if;

               if U.Init_Scalars then
                  Write_Str (" Init_Scalars");
               end if;

               if U.SAL_Interface then
                  Write_Str (" SAL_Interface");
               end if;

               if U.Body_Needed_For_SAL then
                  Write_Str (" Body_Needed_For_SAL");
               end if;

               if U.Elaborate_Body then
                  Write_Str (" Elaborate Body");
               end if;

               if U.Remote_Types then
                  Write_Str (" Remote_Types");
               end if;

               if U.Shared_Passive then
                  Write_Str (" Shared_Passive");
               end if;

               if U.Predefined then
                  Write_Str (" Predefined");
               end if;
            end if;

            declare
               Restrictions : constant Restrictions_Info :=
                                ALIs.Table (ALI).Restrictions;

            begin
               --  If the source was compiled with pragmas Restrictions,
               --  Display these restrictions.

               if Restrictions.Set /= (All_Restrictions => False) then
                  Write_Eol;
                  Write_Str ("     pragma Restrictions  =>");

                  --  For boolean restrictions, just display the name of the
                  --  restriction; for valued restrictions, also display the
                  --  restriction value.

                  for Restriction in All_Restrictions loop
                     if Restrictions.Set (Restriction) then
                        Write_Eol;
                        Write_Str ("       ");
                        Write_Str (Image (Restriction));

                        if Restriction in All_Parameter_Restrictions then
                           Write_Str (" =>");
                           Write_Str (Restrictions.Value (Restriction)'Img);
                        end if;
                     end if;
                  end loop;
               end if;

               --  If the unit violates some Restrictions, display the list of
               --  these restrictions.

               if Restrictions.Violated /= (All_Restrictions => False) then
                  Write_Eol;
                  Write_Str ("     Restrictions violated =>");

                  --  For boolean restrictions, just display the name of the
                  --  restriction. For valued restrictions, also display the
                  --  restriction value.

                  for Restriction in All_Restrictions loop
                     if Restrictions.Violated (Restriction) then
                        Write_Eol;
                        Write_Str ("       ");
                        Write_Str (Image (Restriction));

                        if Restriction in All_Parameter_Restrictions then
                           if Restrictions.Count (Restriction) > 0 then
                              Write_Str (" =>");

                              if Restrictions.Unknown (Restriction) then
                                 Write_Str (" at least");
                              end if;

                              Write_Str (Restrictions.Count (Restriction)'Img);
                           end if;
                        end if;
                     end if;
                  end loop;
               end if;
            end;
         end if;

         if Print_Source then
            if Too_Long then
               Write_Eol;
               Write_Str ("   ");
            else
               Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
            end if;
         end if;
      end if;
   end Output_Unit;

   package body Prj_Env is

      Uninitialized_Prefix : constant String := '#' & Path_Separator;
      --  Prefix to indicate that the project path has not been initialized
      --  yet. Must be two characters long.

      ---------------------
      -- Add_Directories --
      ---------------------

      procedure Add_Directories
        (Self    : in out String_Access;
         Path    : String;
         Prepend : Boolean := False)
      is
         Tmp : String_Access;

      begin
         if Self = null then
            Self := new String'(Uninitialized_Prefix & Path);
         else
            Tmp := Self;
            if Prepend then
               Self := new String'(Path & Path_Separator & Tmp.all);
            else
               Self := new String'(Tmp.all & Path_Separator & Path);
            end if;
            Free (Tmp);
         end if;
      end Add_Directories;

      -------------------------------------
      -- Initialize_Default_Project_Path --
      -------------------------------------

      procedure Initialize_Default_Project_Path
        (Self         : in out String_Access;
         Target_Name  : String;
         Runtime_Name : String := "")
      is
         Add_Default_Dir : Boolean := Target_Name /= "-";
         First           : Positive;
         Last            : Positive;

         Ada_Project_Path      : constant String := "ADA_PROJECT_PATH";
         Gpr_Project_Path      : constant String := "GPR_PROJECT_PATH";
         Gpr_Project_Path_File : constant String := "GPR_PROJECT_PATH_FILE";
         --  Names of alternate env. variables that contain path name(s) of
         --  directories where project files may reside. They are taken into
         --  account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
         --  ADA_PROJECT_PATH.

         Gpr_Prj_Path_File : String_Access;
         Gpr_Prj_Path      : String_Access;
         Ada_Prj_Path      : String_Access;
         --  The path name(s) of directories where project files may reside.
         --  May be empty.

         Prefix  : String_Ptr;
         Runtime : String_Ptr;

         procedure Add_Target (Suffix : String);
         --  Add :<prefix>/<target>/Suffix to the project path

         FD  : File_Descriptor;
         Len : Integer;

         ----------------
         -- Add_Target --
         ----------------

         procedure Add_Target (Suffix : String) is
            Extra_Sep : constant String :=
               (if Target_Name (Target_Name'Last) = '/' then
                  ""
                else
                  (1 => Directory_Separator));
            --  Note: Target_Name has a trailing / when it comes from Sdefault

         begin
            Add_Str_To_Name_Buffer
              (Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
         end Add_Target;

      --  Start of processing for Initialize_Default_Project_Path

      begin
         if Self /= null
           and then (Self'Length = 0
                      or else Self (Self'First) /= '#')
         then
            return;
         end if;

         --  The current directory is always first in the search path. Since
         --  the Project_Path currently starts with '#:' as a sign that it is
         --  not initialized, we simply replace '#' with '.'

         if Self = null then
            Self := new String'('.' & Path_Separator);
         else
            Self (Self'First) := '.';
         end if;

         --  Then the reset of the project path (if any) currently contains the
         --  directories added through Add_Search_Project_Directory

         --  If environment variables are defined and not empty, add their
         --  content

         Gpr_Prj_Path_File := Getenv (Gpr_Project_Path_File);
         Gpr_Prj_Path      := Getenv (Gpr_Project_Path);
         Ada_Prj_Path      := Getenv (Ada_Project_Path);

         if Gpr_Prj_Path_File.all /= "" then
            FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);

            if FD = Invalid_FD then
               Osint.Fail
                 ("warning: could not read project path file """
                  & Gpr_Prj_Path_File.all & """");
            end if;

            Len := Integer (File_Length (FD));

            declare
               Buffer : String (1 .. Len);
               Index  : Positive := 1;
               Last   : Positive;
               Tmp    : String_Access;

            begin
               --  Read the file

               Len := Read (FD, Buffer (1)'Address, Len);
               Close (FD);

               --  Scan the file line by line

               while Index < Buffer'Last loop

                  --  Find the end of line

                  Last := Index;
                  while Last <= Buffer'Last
                    and then Buffer (Last) /= ASCII.LF
                    and then Buffer (Last) /= ASCII.CR
                  loop
                     Last := Last + 1;
                  end loop;

                  --  Ignore empty lines

                  if Last > Index then
                     Tmp := Self;
                     Self :=
                       new String'
                         (Tmp.all & Path_Separator &
                          Buffer (Index .. Last - 1));
                     Free (Tmp);
                  end if;

                  --  Find the beginning of the next line

                  Index := Last;
                  while Buffer (Index) = ASCII.CR or else
                        Buffer (Index) = ASCII.LF
                  loop
                     Index := Index + 1;
                  end loop;
               end loop;
            end;

         end if;

         if Gpr_Prj_Path.all /= "" then
            Add_Directories (Self, Gpr_Prj_Path.all);
         end if;

         Free (Gpr_Prj_Path);

         if Ada_Prj_Path.all /= "" then
            Add_Directories (Self, Ada_Prj_Path.all);
         end if;

         Free (Ada_Prj_Path);

         --  Copy to Name_Buffer, since we will need to manipulate the path

         Name_Len := Self'Length;
         Name_Buffer (1 .. Name_Len) := Self.all;

         --  Scan the directory path to see if "-" is one of the directories.
         --  Remove each occurrence of "-" and set Add_Default_Dir to False.
         --  Also resolve relative paths and symbolic links.

         First := 3;
         loop
            while First <= Name_Len
              and then (Name_Buffer (First) = Path_Separator)
            loop
               First := First + 1;
            end loop;

            exit when First > Name_Len;

            Last := First;

            while Last < Name_Len
              and then Name_Buffer (Last + 1) /= Path_Separator
            loop
               Last := Last + 1;
            end loop;

            --  If the directory is "-", set Add_Default_Dir to False and
            --  remove from path.

            if Name_Buffer (First .. Last) = "-" then
               Add_Default_Dir := False;

               for J in Last + 1 .. Name_Len loop
                  Name_Buffer (J - 2) := Name_Buffer (J);
               end loop;

               Name_Len := Name_Len - 2;

               --  After removing the '-', go back one character to get the
               --  next directory correctly.

               Last := Last - 1;

            else
               declare
                  New_Dir : constant String :=
                              Normalize_Pathname
                                (Name_Buffer (First .. Last),
                                 Resolve_Links => Opt.Follow_Links_For_Dirs);
                  New_Len  : Positive;
                  New_Last : Positive;

               begin
                  --  If the absolute path was resolved and is different from
                  --  the original, replace original with the resolved path.

                  if New_Dir /= Name_Buffer (First .. Last)
                    and then New_Dir'Length /= 0
                  then
                     New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
                     New_Last := First + New_Dir'Length - 1;
                     Name_Buffer (New_Last + 1 .. New_Len) :=
                       Name_Buffer (Last + 1 .. Name_Len);
                     Name_Buffer (First .. New_Last) := New_Dir;
                     Name_Len := New_Len;
                     Last := New_Last;
                  end if;
               end;
            end if;

            First := Last + 1;
         end loop;

         Free (Self);

         --  Set the initial value of Current_Project_Path

         if Add_Default_Dir then
            if Sdefault.Search_Dir_Prefix = null then

               --  gprbuild case

               Prefix := new String'(Executable_Prefix_Path);

            else
               Prefix := new String'(Sdefault.Search_Dir_Prefix.all
                                     & ".." & Dir_Separator
                                     & ".." & Dir_Separator
                                     & ".." & Dir_Separator
                                     & ".." & Dir_Separator);
            end if;

            if Prefix.all /= "" then
               if Target_Name /= "" then

                  if Runtime_Name /= "" then
                     if Base_Name (Runtime_Name) = Runtime_Name then

                        --  $prefix/$target/$runtime/lib/gnat

                        Add_Target
                          (Runtime_Name & Directory_Separator &
                           "lib" & Directory_Separator & "gnat");

                        --  $prefix/$target/$runtime/share/gpr

                        Add_Target
                          (Runtime_Name & Directory_Separator &
                             "share" & Directory_Separator & "gpr");

                     else
                        Runtime :=
                          new String'(Normalize_Pathname (Runtime_Name));

                        --  $runtime_dir/lib/gnat

                        Add_Str_To_Name_Buffer
                          (Path_Separator & Runtime.all & Directory_Separator &
                           "lib" & Directory_Separator & "gnat");

                        --  $runtime_dir/share/gpr

                        Add_Str_To_Name_Buffer
                          (Path_Separator & Runtime.all & Directory_Separator &
                           "share" & Directory_Separator & "gpr");
                     end if;
                  end if;

                  --  $prefix/$target/lib/gnat

                  Add_Target
                    ("lib" & Directory_Separator & "gnat");

                  --  $prefix/$target/share/gpr

                  Add_Target
                    ("share" & Directory_Separator & "gpr");
               end if;

               --  $prefix/share/gpr

               Add_Str_To_Name_Buffer
                 (Path_Separator & Prefix.all & "share"
                  & Directory_Separator & "gpr");

               --  $prefix/lib/gnat

               Add_Str_To_Name_Buffer
                 (Path_Separator & Prefix.all & "lib"
                  & Directory_Separator & "gnat");
            end if;

            Free (Prefix);
         end if;

         Self := new String'(Name_Buffer (1 .. Name_Len));
      end Initialize_Default_Project_Path;

      -----------------------
      -- Get_Runtime_Path --
      -----------------------

      function Get_Runtime_Path
        (Self : String_Access;
         Path : String) return String_Access
      is
         First : Natural;
         Last  : Natural;

      begin

         if Is_Absolute_Path (Path) then
            if Is_Directory (Path) then
               return new String'(Path);
            else
               return null;
            end if;

         else
            --  Because we do not want to resolve symbolic links, we cannot
            --  use Locate_Regular_File. Instead we try each possible path
            --  successively.

            First := Self'First;
            while First <= Self'Last loop
               while First <= Self'Last
                 and then Self (First) = Path_Separator
               loop
                  First := First + 1;
               end loop;

               exit when First > Self'Last;

               Last := First;
               while Last < Self'Last
                 and then Self (Last + 1) /= Path_Separator
               loop
                  Last := Last + 1;
               end loop;

               Name_Len := 0;

               if not Is_Absolute_Path (Self (First .. Last)) then
                  Add_Str_To_Name_Buffer (Get_Current_Dir);  -- ??? System call
                  Add_Char_To_Name_Buffer (Directory_Separator);
               end if;

               Add_Str_To_Name_Buffer (Self (First .. Last));
               Add_Char_To_Name_Buffer (Directory_Separator);
               Add_Str_To_Name_Buffer (Path);

               if Is_Directory (Name_Buffer (1 .. Name_Len)) then
                  return new String'(Name_Buffer (1 .. Name_Len));
               end if;

               First := Last + 1;
            end loop;
         end if;

         return null;
      end Get_Runtime_Path;

   end Prj_Env;

   -----------------
   -- Reset_Print --
   -----------------

   procedure Reset_Print is
   begin
      if not Selective_Output then
         Selective_Output := True;
         Print_Source := False;
         Print_Object := False;
         Print_Unit   := False;
      end if;
   end Reset_Print;

   ----------------
   -- Search_RTS --
   ----------------

   procedure Search_RTS (Name : String) is
      Src_Path : String_Ptr;
      Lib_Path : String_Ptr;
      --  Paths for source and include subdirs

      Rts_Full_Path : String_Access;
      --  Full path for RTS project

   begin
      --  Try to find the RTS

      Src_Path := Get_RTS_Search_Dir (Name, Include);
      Lib_Path := Get_RTS_Search_Dir (Name, Objects);

      --  For non-project RTS, both the include and the objects directories
      --  must be present.

      if Src_Path /= null and then Lib_Path /= null then
         Add_Search_Dirs (Src_Path, Include);
         Add_Search_Dirs (Lib_Path, Objects);
         Prj_Env.Initialize_Default_Project_Path
           (Prj_Path,
            Target_Name  => Sdefault.Target_Name.all,
            Runtime_Name => Name);
         return;
      end if;

      if Lib_Path /= null then
         Osint.Fail ("RTS path not valid: missing adainclude directory");
      elsif Src_Path /= null then
         Osint.Fail ("RTS path not valid: missing adalib directory");
      end if;

      --  Try to find the RTS on the project path. First setup the project path

      Prj_Env.Initialize_Default_Project_Path
        (Prj_Path,
         Target_Name  => Sdefault.Target_Name.all,
         Runtime_Name => Name);

      Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);

      if Rts_Full_Path /= null then

         --  Directory name was found on the project path. Look for the
         --  include subdirectory(s).

         Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);

         if Src_Path /= null then
            Add_Search_Dirs (Src_Path, Include);

            --  Add the lib subdirectory if it exists

            Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);

            if Lib_Path /= null then
               Add_Search_Dirs (Lib_Path, Objects);
            end if;

            return;
         end if;
      end if;

      Osint.Fail
        ("RTS path not valid: missing adainclude and adalib directories");
   end Search_RTS;

   -------------------
   -- Scan_Ls_Arg --
   -------------------

   procedure Scan_Ls_Arg (Argv : String) is
      FD  : File_Descriptor;
      Len : Integer;
      OK  : Boolean;

   begin
      pragma Assert (Argv'First = 1);

      if Argv'Length = 0 then
         return;
      end if;

      OK := True;
      if Argv (1) = '-' then
         if Argv'Length = 1 then
            Fail ("switch character cannot be followed by a blank");

         --  Processing for -I-

         elsif Argv (2 .. Argv'Last) = "I-" then
            Opt.Look_In_Primary_Dir := False;

         --  Forbid -?- or -??- where ? is any character

         elsif (Argv'Length = 3 and then Argv (3) = '-')
           or else (Argv'Length = 4 and then Argv (4) = '-')
         then
            Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");

         --  Processing for -Idir

         elsif Argv (2) = 'I' then
            Add_Source_Dir (Argv (3 .. Argv'Last));
            Add_Lib_Dir (Argv (3 .. Argv'Last));

         --  Processing for -aIdir (to gcc this is like a -I switch)

         elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
            Add_Source_Dir (Argv (4 .. Argv'Last));

         --  Processing for -aOdir

         elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
            Add_Lib_Dir (Argv (4 .. Argv'Last));

         --  Processing for -aLdir (to gnatbind this is like a -aO switch)

         elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
            Add_Lib_Dir (Argv (4 .. Argv'Last));

         --  Processing for -aP<dir>

         elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
            Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));

         --  Processing for -nostdinc

         elsif Argv (2 .. Argv'Last) = "nostdinc" then
            Opt.No_Stdinc := True;

         --  Processing for one character switches

         elsif Argv'Length = 2 then
            case Argv (2) is
               when 'a' => Also_Predef               := True;
               when 'h' => Print_Usage               := True;
               when 'u' => Reset_Print; Print_Unit   := True;
               when 's' => Reset_Print; Print_Source := True;
               when 'o' => Reset_Print; Print_Object := True;
               when 'v' => Verbose_Mode              := True;
               when 'd' => Dependable                := True;
               when 'l' => License                   := True;
               when 'V' => Very_Verbose_Mode         := True;

               when others => OK := False;
            end case;

         --  Processing for -files=file

         elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
            FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);

            if FD = Invalid_FD then
               Osint.Fail ("could not find text file """ &
                           Argv (8 .. Argv'Last) & '"');
            end if;

            Len := Integer (File_Length (FD));

            declare
               Buffer : String (1 .. Len + 1);
               Index  : Positive := 1;
               Last   : Positive;

            begin
               --  Read the file

               Len := Read (FD, Buffer (1)'Address, Len);
               Buffer (Buffer'Last) := ASCII.NUL;
               Close (FD);

               --  Scan the file line by line

               while Index < Buffer'Last loop

                  --  Find the end of line

                  Last := Index;
                  while Last <= Buffer'Last
                    and then Buffer (Last) /= ASCII.LF
                    and then Buffer (Last) /= ASCII.CR
                  loop
                     Last := Last + 1;
                  end loop;

                  --  Ignore empty lines

                  if Last > Index then
                     Add_File (Buffer (Index .. Last - 1));
                  end if;

                  --  Find the beginning of the next line

                  Index := Last;
                  while Buffer (Index) = ASCII.CR or else
                        Buffer (Index) = ASCII.LF
                  loop
                     Index := Index + 1;
                  end loop;
               end loop;
            end;

         --  Processing for --RTS=path

         elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
            if Argv'Length <= 6 or else Argv (6) /= '='then
               Osint.Fail ("missing path for --RTS");

            else
               --  Check that it is the first time we see this switch or, if
               --  it is not the first time, the same path is specified.

               if RTS_Specified = null then
                  RTS_Specified := new String'(Argv (7 .. Argv'Last));

               elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
                  Osint.Fail ("--RTS cannot be specified multiple times");
               end if;

               --  Valid --RTS switch

               Opt.No_Stdinc := True;
               Opt.RTS_Switch := True;
            end if;

         else
            OK := False;
         end if;

      --  If not a switch, it must be a file name

      else
         Add_File (Argv);
      end if;

      if not OK then
         Write_Str ("warning: unknown switch """);
         Write_Str (Argv);
         Write_Line ("""");
      end if;

   end Scan_Ls_Arg;

   -----------
   -- Usage --
   -----------

   procedure Usage is
   begin
      --  Usage line

      Write_Str ("Usage: ");
      Osint.Write_Program_Name;
      Write_Str ("  switches  [list of object files]");
      Write_Eol;
      Write_Eol;

      --  GNATLS switches

      Write_Str ("switches:");
      Write_Eol;

      Display_Usage_Version_And_Help;

      --  Line for -a

      Write_Str ("  -a         also output relevant predefined units");
      Write_Eol;

      --  Line for -u

      Write_Str ("  -u         output only relevant unit names");
      Write_Eol;

      --  Line for -h

      Write_Str ("  -h         output this help message");
      Write_Eol;

      --  Line for -s

      Write_Str ("  -s         output only relevant source names");
      Write_Eol;

      --  Line for -o

      Write_Str ("  -o         output only relevant object names");
      Write_Eol;

      --  Line for -d

      Write_Str ("  -d         output sources on which specified units " &
                               "depend");
      Write_Eol;

      --  Line for -l

      Write_Str ("  -l         output license information");
      Write_Eol;

      --  Line for -v

      Write_Str ("  -v         verbose output, full path and unit " &
                               "information");
      Write_Eol;
      Write_Eol;

      --  Line for -files=

      Write_Str ("  -files=fil files are listed in text file 'fil'");
      Write_Eol;

      --  Line for -aI switch

      Write_Str ("  -aIdir     specify source files search path");
      Write_Eol;

      --  Line for -aO switch

      Write_Str ("  -aOdir     specify object files search path");
      Write_Eol;

      --  Line for -aP switch

      Write_Str ("  -aPdir     specify project search path");
      Write_Eol;

      --  Line for -I switch

      Write_Str ("  -Idir      like -aIdir -aOdir");
      Write_Eol;

      --  Line for -I- switch

      Write_Str ("  -I-        do not look for sources & object files");
      Write_Str (" in the default directory");
      Write_Eol;

      --  Line for -nostdinc

      Write_Str ("  -nostdinc  do not look for source files");
      Write_Str (" in the system default directory");
      Write_Eol;

      --  Line for --RTS

      Write_Str ("  --RTS=dir  specify the default source and object search"
                 & " path");
      Write_Eol;

      --  File Status explanation

      Write_Eol;
      Write_Str (" file status can be:");
      Write_Eol;

      for ST in File_Status loop
         Write_Str ("   ");
         Output_Status (ST, Verbose => False);
         Write_Str (" ==> ");
         Output_Status (ST, Verbose => True);
         Write_Eol;
      end loop;
   end Usage;

   procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);

--  Start of processing for Gnatls

begin
   --  Initialize standard packages

   Csets.Initialize;
   Snames.Initialize;
   Stringt.Initialize;

   --  First check for --version or --help

   Check_Version_And_Help ("GNATLS", "1992");

   --  Loop to scan out arguments

   Next_Arg := 1;
   Scan_Args : while Next_Arg < Arg_Count loop
      declare
         Next_Argv : String (1 .. Len_Arg (Next_Arg));
      begin
         Fill_Arg (Next_Argv'Address, Next_Arg);
         Scan_Ls_Arg (Next_Argv);
      end;

      Next_Arg := Next_Arg + 1;
   end loop Scan_Args;

   --  If -l (output license information) is given, it must be the only switch

   if License then
      if Arg_Count = 2 then
         Output_License_Information;
         Exit_Program (E_Success);

      else
         Set_Standard_Error;
         Write_Str ("Can't use -l with another switch");
         Write_Eol;
         Try_Help;
         Exit_Program (E_Fatal);
      end if;
   end if;

   --  Handle --RTS switch

   if RTS_Specified /= null then
      Search_RTS (RTS_Specified.all);
   end if;

   --  Add the source and object directories specified on the command line, if
   --  any, to the searched directories.

   while First_Source_Dir /= null loop
      Add_Src_Search_Dir (First_Source_Dir.Value.all);
      First_Source_Dir := First_Source_Dir.Next;
   end loop;

   while First_Lib_Dir /= null loop
      Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
      First_Lib_Dir := First_Lib_Dir.Next;
   end loop;

   --  Finally, add the default directories

   Osint.Add_Default_Search_Dirs;

   --  If --RTS= is not specified, check if there is a default runtime

   if RTS_Specified = null then
      declare
         FD   : File_Descriptor;
         Text : Source_Buffer_Ptr;
         Hi   : Source_Ptr;

      begin
         Name_Buffer (1 .. 10) := "system.ads";
         Name_Len := 10;

         Read_Source_File (Name_Find, 0, Hi, Text, FD);

         if Null_Source_Buffer_Ptr (Text) then
            No_Runtime := True;
         end if;
      end;
   end if;

   if Verbose_Mode then
      Write_Eol;
      Display_Version ("GNATLS", "1997");
      Write_Eol;

      if No_Runtime then
         Write_Str
           ("Default runtime not available. Use --RTS= with a valid runtime");
         Write_Eol;
         Write_Eol;
         Exit_Status := E_Warnings;
      end if;

      Write_Str ("Source Search Path:");
      Write_Eol;

      for J in 1 .. Nb_Dir_In_Src_Search_Path loop
         Write_Str ("   ");

         if Dir_In_Src_Search_Path (J)'Length = 0 then
            Write_Str ("<Current_Directory>");
            Write_Eol;

         elsif not No_Runtime then
            Write_Str
              (Normalize
                 (To_Host_Dir_Spec
                      (Dir_In_Src_Search_Path (J).all, True).all));
            Write_Eol;
         end if;
      end loop;

      Write_Eol;
      Write_Eol;
      Write_Str ("Object Search Path:");
      Write_Eol;

      for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
         Write_Str ("   ");

         if Dir_In_Obj_Search_Path (J)'Length = 0 then
            Write_Str ("<Current_Directory>");
            Write_Eol;

         elsif not No_Runtime then
            Write_Str
              (Normalize
                 (To_Host_Dir_Spec
                      (Dir_In_Obj_Search_Path (J).all, True).all));
            Write_Eol;
         end if;
      end loop;

      Write_Eol;
      Write_Eol;
      Write_Str (Project_Search_Path);
      Write_Eol;
      Write_Str ("   <Current_Directory>");
      Write_Eol;

      Prj_Env.Initialize_Default_Project_Path
        (Prj_Path, Target_Name => Sdefault.Target_Name.all);

      declare
         First        : Natural;
         Last         : Natural;

      begin

         if Prj_Path.all /= "" then
            First := Prj_Path'First;
            loop
               while First <= Prj_Path'Last
                 and then (Prj_Path (First) = Path_Separator)
               loop
                  First := First + 1;
               end loop;

               exit when First > Prj_Path'Last;

               Last := First;
               while Last < Prj_Path'Last
                 and then Prj_Path (Last + 1) /= Path_Separator
               loop
                  Last := Last + 1;
               end loop;

               if First /= Last or else Prj_Path (First) /= '.' then

                  --  If the directory is ".", skip it as it is the current
                  --  directory and it is already the first directory in the
                  --  project path.

                  Write_Str ("   ");
                  Write_Str
                    (Normalize
                      (To_Host_Dir_Spec
                        (Prj_Path (First .. Last), True).all));
                  Write_Eol;
               end if;

               First := Last + 1;
            end loop;
         end if;
      end;

      Write_Eol;
   end if;

   --  Output usage information when requested

   if Print_Usage then
      Usage;
   end if;

   if not More_Lib_Files then
      if not Print_Usage and then not Verbose_Mode then
         if Arg_Count = 1 then
            Usage;
         else
            Try_Help;
            Exit_Status := E_Fatal;
         end if;
      end if;

      Exit_Program (Exit_Status);
   end if;

   Initialize_ALI;
   Initialize_ALI_Source;

   --  Print out all libraries for which no ALI files can be located

   while More_Lib_Files loop
      Main_File := Next_Main_Lib_File;
      Ali_File  := Full_Lib_File_Name (Lib_File_Name (Main_File));

      if Ali_File = No_File then
         if Very_Verbose_Mode then
            GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));

         else
            Set_Standard_Error;
            Write_Str ("Can't find library info for ");
            Get_Name_String (Main_File);
            Write_Char ('"'); -- "
            Write_Str (Name_Buffer (1 .. Name_Len));
            Write_Char ('"'); -- "
            Write_Eol;
            Exit_Status := E_Fatal;
         end if;

      else
         Ali_File := Strip_Directory (Ali_File);

         if Get_Name_Table_Int (Ali_File) = 0 then
            Text := Read_Library_Info (Ali_File, True);

            declare
               Discard : ALI_Id;
            begin
               Discard :=
                 Scan_ALI
                   (Ali_File,
                    Text,
                    Ignore_ED     => False,
                    Err           => False,
                    Ignore_Errors => True);
            end;

            Free (Text);
         end if;
      end if;
   end loop;

   --  Reset default output file descriptor, if needed

   Set_Standard_Output;

   if Very_Verbose_Mode then
      for A in ALIs.First .. ALIs.Last loop
         GNATDIST.Output_ALI (A);
      end loop;

      return;
   end if;

   Find_General_Layout;

   for Id in ALIs.First .. ALIs.Last loop
      declare
         Last_U : Unit_Id;

      begin
         Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);

         if Also_Predef or else not Is_Internal_Unit then
            if ALIs.Table (Id).No_Object then
               Output_Object (No_File);
            else
               Output_Object (ALIs.Table (Id).Ofile_Full_Name);
            end if;

            --  In verbose mode print all main units in the ALI file, otherwise
            --  just print the first one to ease columnwise printout

            if Verbose_Mode then
               Last_U := ALIs.Table (Id).Last_Unit;
            else
               Last_U := ALIs.Table (Id).First_Unit;
            end if;

            for U in ALIs.Table (Id).First_Unit .. Last_U loop
               if U /= ALIs.Table (Id).First_Unit
                 and then Selective_Output
                 and then Print_Unit
               then
                  Write_Eol;
               end if;

               Output_Unit (Id, U);

               --  Output source now, unless if it will be done as part of
               --  outputing dependencies.

               if not (Dependable and then Print_Source) then
                  Output_Source (Corresponding_Sdep_Entry (Id, U));
               end if;
            end loop;

            --  Print out list of units on which this unit depends (D lines)

            if Dependable and then Print_Source then
               if Verbose_Mode then
                  Write_Str ("depends upon");
                  Write_Eol;
                  Write_Str ("   ");
               else
                  Write_Eol;
               end if;

               for D in
                 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
               loop
                  if Also_Predef
                    or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
                  then
                     if Verbose_Mode then
                        Write_Str ("   ");
                        Output_Source (D);

                     elsif Too_Long then
                        Write_Str ("   ");
                        Output_Source (D);
                        Write_Eol;

                     else
                        Write_Str (Spaces (1 .. Source_Start - 2));
                        Output_Source (D);
                        Write_Eol;
                     end if;
                  end if;
               end loop;
            end if;

            Write_Eol;
         end if;
      end;
   end loop;

   --  All done. Set proper exit status

   Namet.Finalize;
   Exit_Program (Exit_Status);
end Gnatls;