------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--                  A S I S _ U L . E N V I R O N M E N T                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2004-2014, 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 3, 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 --
-- COPYING3. If not,  go to http://www.gnu.org/licenses for a complete copy --
-- of the license.                                                          --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Characters.Conversions;  use Ada.Characters.Conversions;
with Ada.Command_Line;
with Ada.Directories;             use Ada.Directories;
with Ada.Text_IO;                 use Ada.Text_IO;
with System.Multiprocessors;

with Hostparm;

with Asis.Ada_Environments;       use Asis.Ada_Environments;
with Asis.Extensions;             use Asis.Extensions;
with Asis.Implementation;         use Asis.Implementation;

with A4G.A_Types;                 use A4G.A_Types;

with ASIS_UL.Common;              use ASIS_UL.Common;
with ASIS_UL.Compiler_Options;    use ASIS_UL.Compiler_Options;
with ASIS_UL.Debug;               use ASIS_UL.Debug;
with ASIS_UL.Formatted_Output;
with ASIS_UL.Options;             use ASIS_UL.Options;
with ASIS_UL.Output;              use ASIS_UL.Output;
with ASIS_UL.Projects;            use ASIS_UL.Projects;
with ASIS_UL.Source_Table;        use ASIS_UL.Source_Table;
with ASIS_UL.String_Utilities;    use ASIS_UL.String_Utilities;
with ASIS_UL.Utilities;           use ASIS_UL.Utilities;

package body ASIS_UL.Environment is

   Tmpdir_Needs_To_Be_Displayed : Boolean := True;

   Tmpdir    : constant String := "TMPDIR";
   Gnutmpdir : constant String := "GNUTMPDIR";
   No_Dir    : aliased String  := "";
   Temp_Dir  : String_Access   := No_Dir'Access;
   --  If non-empty, points to the name of the directory to create the tool's
   --  temporary directory into. If empty, the temporary directory is created
   --  in the current directory.

   Tmp_Dir_Already_Created : Boolean := False;

   -----------------------
   -- Local subprograms --
   -----------------------

   pragma Warnings (Off, More_Arguments);
   --  At least gnatstub does not use this procedure, so we have to avoid
   --  warnings about unreferenced procedure

   procedure Check_Parameters;
   --  Checks that the tool settings are compatible with each other. All
   --  possible check are tool-specific, the corresponding subunit
   --  should be provided for each tool

   --  ???Scan_Parameters and Initialize are gone; the *_New version should
   --  be renamed.
   --  These two procedures Scan_Parameters and Check_Parameters - are a part
   --  of the Initialize procedure.  The important thing is that after
   --  finishing Initialize either the source table should contain at least one
   --  name of an existing file (in case if the tool is based on
   --  ASIS_UL.Several_Files_Driver driver), or ASIS_UL.Common.Arg_File should
   --  point to an existing file (in case if the tool is based on
   --  ASIS_UL.One_Arg_Driver driver procedure). File names in both cases
   --  should be full normalized names.
   --
   --  ASIS_UL.Compiler_Options.Arg_List should collect all the needed options
   --  to call gcc for tree creation

   procedure Tool_Specific_Initialization_1;
   procedure Tool_Specific_Initialization_2;
   --  Do the initialization actions that are specific for a tool. The first
   --  subprogram is called before reading the tool command-line parameters,
   --  the second - when the command-line parameters have just been read in and
   --  analyzed. If the tool needs any specific initialization actions, the
   --  corresponding subunits should be provided for these subprograms.

   procedure Set_Tree_Name;
   --  This procedure is supposed to be called when a tree file has just been
   --  created for the Ada source which (full normalized) name is contained
   --  in ASIS_UL.Common.Arg_File. It sets into ASIS_UL.Common.Tree_File the
   --  (short) name of the corresponding tree file.

   --------------------------
   -- Builder_Command_Line --
   --------------------------

   function Builder_Command_Line return Argument_List is

      Ignored_Args, Builder_Args, Inner_Args : String_Vector;

      Cur : Positive := 1;

      use Ada.Command_Line;

   begin
      --  Tell the builder to keep quiet

      if Debug_Flag_C then
         Append (Builder_Args, "-v");
      else
         Append (Builder_Args, "-q");
      end if;

      --  Tell the builder to create necessary directories if they don't exist

      Append (Builder_Args, "-p");

      --  Tell the builder not to complain about missing object files. We are
      --  pretending that the ASIS tool is the compiler, but of course ASIS
      --  tools don't generate object files.

      Append (Builder_Args, "-gnatc");

      --  Tell the builder to place ALI files in a subdirectory of the object
      --  directory -- a different subdirectory for each tool. This is
      --  necessary because otherwise the ALI files would conflict with each
      --  other. For one thing, ASIS tools run the compiler (the real one) with
      --  different switches than normal builds, so we don't want to overwrite
      --  one kind of ALI file with the other. For another thing, just because
      --  the files generated by gnat2xml are up to date doesn't mean that the
      --  files generated by gnatcheck are up to date. So if the object
      --  directory is 'obj', normal builds put ALI files in obj, "gnat2xml
      --  --incremental" puts ALI files in obj/ALI-FILES-gnat2xml, and so on.

      Append (Builder_Args,
              String'("--subdirs=" & "ALI-FILES-" & Tool_Name.all));

      --  Now copy all command-line arguments from this invocation of an ASIS
      --  tool (the outer one) into Ignored_Args, Builder_Args, or Inner_Args,
      --  with some modifications. Builder_Args are passed to the
      --  builder. Inner_Args are passed to the inner invocations of the ASIS
      --  tool by passing them to the builder after "-cargs".

      while Cur <= Argument_Count loop
         declare
            Arg : constant String := Argument (Cur);

            function Match
              (Args : in out String_Vector;
               Check : String;
               Kind : Character := ' ') return Boolean
              with Pre => Kind in ' ' | ':' | '=' | '!';
            --  Checks if Arg matches Check. Kind = ' ' means Arg does not have
            --  a parameter. The other possibilities for Kind mean the same
            --  thing as in GNAT.Command_Line.Getopt. If there is a match, then
            --  we move past the arg and its parameter, if any, and return
            --  True. If no match, we return False.

            function Match
              (Args : in out String_Vector;
               Check : String;
               Kind : Character := ' ') return Boolean is

               Saved_Cur : constant Positive := Cur;
            begin
               case Kind is
                  when ' ' =>
                     if Arg = Check then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                     end if;

                  when ':' =>
                     if Arg = Check then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                        Append (Args, Argument (Cur));
                        Cur := Cur + 1;
                     elsif Has_Prefix (Arg, Prefix => Check) then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                     end if;

                  when '=' =>
                     if Arg = Check then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                        Append (Args, Argument (Cur));
                        Cur := Cur + 1;
                     elsif Has_Prefix (Arg, Prefix => Check & "=") then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                     end if;

                  when '!' =>
                     if Has_Prefix (Arg, Prefix => Check) then
                        Append (Args, Arg);
                        Cur := Cur + 1;
                     end if;

                  when others => raise Program_Error;
               end case;

               return Cur /= Saved_Cur;
            end Match;

         begin
            --  We shouldn't be seeing -c, -gnatea, -gnatez, or -gnatc here;
            --  those are passed to the inner invocations, whereas we're in the
            --  outer one. Might as well ignore them. "--incremental" needs to
            --  be ignored; the inner invocations shouldn't get here.
            --  "--output-dir" is handled specially below. Project-related
            --  arguments go in Builder_Args. Non-switches (i.e. file names) go
            --  in Builder_Args. Anything else goes in Inner_Args.

            if Match (Ignored_Args, "-c", ' ')
              or else Match (Ignored_Args, "-gnatea", ' ')
              or else Match (Ignored_Args, "-gnatez", ' ')
              or else Match (Ignored_Args, "-gnatc", '!')
              or else Match (Ignored_Args, "--incremental", ' ')
              or else Match (Ignored_Args, "--output-dir", '=')

              or else Match (Builder_Args, "-j", '!')
              or else Match (Builder_Args, "-P", ':')
              or else Match (Builder_Args, "-U", ' ')
              or else Match (Builder_Args, "-X", '!')
              or else Match (Builder_Args, "--subdirs", '=')
              or else Match (Builder_Args, "--no_objects_dir", ' ')
            then
               null; -- One of those Matches already Appended as appropriate
            elsif not Has_Prefix (Arg, Prefix => "-") then
               Append (Builder_Args, Arg);
               Cur := Cur + 1;
            else
               Append (Inner_Args, Arg);
               Cur := Cur + 1;
            end if;
         end;
      end loop;

      --  Tell the builder to pretend that the ASIS tool is the compiler

      Append (Builder_Args,
              String'("--GCC=" & Ada.Command_Line.Command_Name));

      --  Modify the --output-dir= switch so it uses a full pathname.
      --  Otherwise, the output files would end up in something like
      --  obj/ALI-FILES-gnat2xml.

      if Out_Dir /= null then
         Append (Inner_Args,
                 String'("--output-dir=" & Out_Dir.all));
      end if;

      --  Append extra args specific to the ASIS tool

      Append (Inner_Args, Extra_Inner_Args);

      --  -cargs means to pass the following arguments along to the ASIS tool

      if Last_Index (Inner_Args) > 0 then
         Prepend (Inner_Args, "-cargs");
      end if;

      --  Finally, construct the result, which is basically
      --  "Builder_Args & Inner_Args".

      return Result : Argument_List
        (1 .. Last_Index (Builder_Args) + Last_Index (Inner_Args))
      do
         declare
            X : Natural := 0;
         begin
            for Arg of Builder_Args loop
               X := X + 1;
               Result (X) := new String'(Arg);
            end loop;

            for Arg of Inner_Args loop
               X := X + 1;
               Result (X) := new String'(Arg);
            end loop;

            pragma Assert (X = Result'Last);
         end;
      end return;
   end Builder_Command_Line;

   ----------------------
   -- Check_Parameters --
   ----------------------

   procedure Check_Parameters is separate;

   --------------
   -- Clean_Up --
   --------------

   procedure Clean_Up is
      Success : Boolean := False;
   begin
      Source_Table_Debug_Image;

      if not Debug_Flag_N then

         if Get_Config_File_Name /= "" then
            Delete_File (Get_Config_File_Name, Success);

            if not Success then
               Error ("cannot remove configuration pragmas file");
            end if;
         end if;

         if Get_Mapping_File_Name /= "" then
            Delete_File (Get_Mapping_File_Name, Success);

            if not Success then
               Error ("cannot remove mapping file");
            end if;
         end if;
      end if;

      Context_Clean_Up;

      --  Cleaning up temporary dir

      if not Debug_Flag_N and then Tool_Temp_Dir /= null then

         Change_Dir (Tool_Current_Dir);

         for J in 1 .. 10 loop
            --  On windows, there might be a slight delay between the return of
            --  the close function on a file descriptor and the actual closing
            --  done by the system. Since it's not possible to remove a
            --  directory as long as there are handles on it, this Remove_Dir
            --  may fail. So, if a call to Remove_Dir raises Directory_Error,
            --  we try several times after some delay, and only if all the
            --  attempts fail, we generate an error message and raise an
            --  exception.

            begin
               Remove_Dir (Tool_Temp_Dir.all, Recursive => True);
               Success                 := True;
               Tmp_Dir_Already_Created := False;
               exit;
            exception
               when Directory_Error =>
                  delay 0.05;
            end;

         end loop;

         if not Success then
            --  Because of some unknown reason the temporary directory cannot
            --  be removed:
            Free (Tool_Temp_Dir);  -- to avoid cycling
            Error ("cannot remove temporary directory");
            raise Fatal_Error;
         end if;

         Free (Tool_Temp_Dir);

      end if;

   end Clean_Up;

   ----------------------
   -- Context_Clean_Up --
   ----------------------

   procedure Context_Clean_Up is
   begin

      if Is_Open (The_Context) then
         Close (The_Context);
      end if;

      if Has_Associations (The_Context) then
         Dissociate (The_Context);
      end if;

   end Context_Clean_Up;

   --------------------
   -- Go_To_Temp_Dir --
   --------------------

   procedure Go_To_Temp_Dir (With_Dir_For_Comp_Output : Boolean := False) is
      FD        : File_Descriptor;
      Temp_Name : Temp_File_Name;
      Success   : Boolean;
   begin
      if Tmp_Dir_Already_Created then
         Change_Dir (Tool_Temp_Dir.all);
         return;
      end if;

      if Temp_Dir'Length /= 0 then

         --  In verbose mode, display once the value of TMPDIR, so that
         --  if temp files cannot be created, it is easier to understand
         --  where temp files are supposed to be created.

         if ASIS_UL.Options.Verbose_Mode and then
           Tmpdir_Needs_To_Be_Displayed
         then
            Info_No_EOL ("TMPDIR = """);
            Info_No_EOL (Temp_Dir.all);
            Info        ("""");
            Tmpdir_Needs_To_Be_Displayed := False;
         end if;

         Change_Dir (Temp_Dir.all);
      end if;

      --  ??? We create the temp dir by first creating the temp file, then
      --  closing and deleting it, then creating a dir with the same name.
      --  This is not atomic as another program can sneak in between file
      --  deletion and dir creation and snatch this name for itself. This is
      --  quite unlikely and anyway we don't have any other system-independent
      --  way at the moment
      Create_Temp_File (FD, Temp_Name);
      Close (FD);
      Delete_File (Temp_Name, Success);

      if not Success then
         Error ("can not delete the temporary file that was "
              & "just created");

         raise Fatal_Error;
      end if;

      Tool_Temp_Dir := new String' -- Remove NUL
        (Normalize_Pathname
           (Temp_Name (Temp_Name'First .. Temp_Name'Last - 1)));

      Parallel_Make_Dir (Tool_Temp_Dir.all);

      Change_Dir (Tool_Current_Dir);

      if Is_Regular_File ("gnat.adc") then

         if Hostparm.OpenVMS then
            Copy_File
              (Name     => "gnat.adc",
               Pathname => Tool_Temp_Dir.all & Directory_Separator &
                           "gnat.adc",
               Success  => Success,
               Mode     => Copy,
               Preserve => None);

         else
            Copy_File
              (Name     => "gnat.adc",
               Pathname => Tool_Temp_Dir.all & Directory_Separator &
                           "gnat.adc",
               Success  => Success,
               Mode     => Copy);
         end if;

      end if;

      Change_Dir (Tool_Temp_Dir.all);

      if Project_File /= null
        and then
         Project_Support_Type = Use_Tmp_Project_File
      then

         declare
            Temp_Project_File : File_Type;
         begin
            --  Creating the temporary project file
            Create (Temp_Project_File, Out_File, "tmp.gpr");

            Put (Temp_Project_File, "project Tmp extends """);
            Put (Temp_Project_File, Project_File.all);
            Put (Temp_Project_File, """ is");
            New_Line (Temp_Project_File);

            Put (Temp_Project_File, "   for Object_Dir use """ &
                 ASIS_Current_Directory.all & """;");
            New_Line (Temp_Project_File);

            Put (Temp_Project_File, "end Tmp;");
            New_Line (Temp_Project_File);

            Close (Temp_Project_File);

            --  Storing the temporary project file as an option:

            Store_Option ("-Ptmp.gpr");
            Set_Arg_List;

         exception
            when others =>
               Error ("can not create the temporary project file");
               raise Fatal_Error;
         end;

      end if;

      if With_Dir_For_Comp_Output then
         Create_Temp_File (FD, Temp_Name);
         Close (FD);
         Delete_File (Temp_Name, Success);

         if not Success then
            Error ("can not delete the temporary file that was "
                 & "just created");

            raise Fatal_Error;
         end if;

         Compiler_Output_File_Name := new String' -- Remove NUL
           (Temp_Name (Temp_Name'First .. Temp_Name'Last - 1) &
            Directory_Separator & "compiler_diag.txt");

         Parallel_Make_Dir (Compiler_Output_File_Name.all);
      end if;

      Tmp_Dir_Already_Created := True;

   exception
      when Directory_Error =>
         Error ("cannot create the temporary directory");
         raise Fatal_Error;
   end Go_To_Temp_Dir;

   --------------------
   -- Initialize_New --
   --------------------

   procedure Initialize_New
     (Prj : in out ASIS_UL.Projects.Arg_Project_Type'Class)
   is
   begin
      Tool_Specific_Initialization_1;
      --  A tool-specific version should be provided!

      Scan_Parameters_New (Prj);

      --  If we wanted to allow -files= in Incremental_Mode, we would need to
      --  add a -files= switch to the builder.

      if Incremental_Mode and Files_Switch_Used then
         Error ("-files= is incompatible with --incremental");
      end if;

      Check_Parameters; --  A tool-specific version should be provided!

      Tool_Specific_Initialization_2;
      --  A tool-specific version should be provided!

      if not ASIS_UL.Options.Nothing_To_Do then
         Set_Log_File;
         Go_To_Temp_Dir;

         if Incremental_Mode then
            Change_Dir (Tool_Current_Dir);
         else
            Store_I_Options;
         end if;

         --  Create output directory if necessary

         if Out_Dir /= null  then
            Parallel_Make_Dir
              (Out_Dir.all, Give_Message => Verbose_Mode);
         end if;
      end if;

   exception
      when Parameter_Error =>
         --  The diagnosis is already generated
         Try_Help;
         raise Fatal_Error;
      when Fatal_Error =>
         --  The diagnosis is already generated
         raise;
      when others =>
         Error ("initialization failed");
         --  Exception info will be generated in main driver
         raise;
   end Initialize_New;

   --------------------
   -- More_Arguments --
   --------------------

   function More_Arguments
     (Store_Arguments : Boolean := True;
      In_Switches     : Boolean := False;
      Parser          : Opt_Parser := Command_Line_Parser)
      return            Boolean
   is
      Result : Boolean := False;
   begin
      loop
         declare
            Arg : constant String := Get_Argument
              (Do_Expansion => True,
               Parser       => Parser);
         begin
            exit when Arg = "";
            Result := True;

            if In_Switches then
               Error ("Switches attribute cannot contain argument sources");
               raise Parameter_Error;
            end if;

            if ASIS_UL.Projects.U_Option_Set then
               ASIS_UL.Projects.Store_Main_Unit (Arg, Store_Arguments);
            else
               Store_Sources_To_Process (Arg, Store_Arguments);
            end if;
         end;
      end loop;

      return Result;
   end More_Arguments;

   ---------------------
   -- Prepare_Context --
   ---------------------

   procedure Prepare_Context (Success : out Boolean) is
   begin
      Compile
        (Source_File  => ASIS_UL.Common.Arg_File,
         Args         => ASIS_UL.Compiler_Options.Arg_List.all,
         Success      => Success,
         GCC          => Gcc_To_Call,
         Use_GNATMAKE => Use_Gnatmake_To_Compile,
         Use_Temp_Prj => Project_Support_Type = Use_Tmp_Project_File,
         Display_Call => Debug_Flag_D);

      if not Success then
         Error ("the argument source is illegal");
      else
         Set_Tree_Name;

         Asis.Implementation.Initialize ("-ws");

         Asis.Ada_Environments.Associate
           (The_Context => The_Context,
            Name        => "",
            Parameters  => "-C1 " & To_Wide_String (Tree_File.all));

         Open (The_Context);

         if Debug_Flag_T then
            Print_Tree_Sources;
         end if;

         The_CU := Asis.Extensions.Main_Unit_In_Current_Tree (The_Context);
      end if;

   end Prepare_Context;

   ------------------------
   -- Print_Command_Line --
   ------------------------

   procedure Print_Command_Line is
      use Ada.Command_Line;
   begin
      if ASIS_UL.Options.Incremental_Mode then
         Formatted_Output.Put ("(outer)\n  ");
      elsif ASIS_UL.Options.Mimic_gcc then
         Formatted_Output.Put ("(inner)\n  ");
      end if;
      Formatted_Output.Put ("\1", Command_Name);

      for X in 1 .. Argument_Count loop
         Formatted_Output.Put (" \1", Argument (X));
      end loop;
      Formatted_Output.Put ("\n");
   end Print_Command_Line;

   -------------------------
   -- Scan_Parameters_New --
   -------------------------

   procedure Scan_Parameters_New
     (Prj : in out ASIS_UL.Projects.Arg_Project_Type'Class)
   is
   begin

      Initialize_Option_Scan
        (Stop_At_First_Non_Switch => False,
         Section_Delimiters       => Prj.Section_Delimiters);

      Prj.Scan_Arguments (First_Pass => True);

      if Print_Version then
         Print_Tool_Version (2004);
         OS_Exit (0);
      end if;

      if Print_Usage then
         Prj.Print_Tool_Usage;
         OS_Exit (0);
      end if;

      --  If we have the project file specified as a tool parameter, analyze it

      ASIS_UL.Projects.Process_Project_File (Prj);

      --  And finally - analyze the command-line parameters. We do this even in
      --  Incremental_Mode, so we get any errors on the outer call to the ASIS
      --  tool, rather than on the inner calls.

      Initialize_Option_Scan
        (Stop_At_First_Non_Switch => False,
         Section_Delimiters       => Prj.Section_Delimiters);

      Prj.Scan_Arguments;

   end Scan_Parameters_New;

   ---------------------
   -- Scan_Common_Arg --
   ---------------------

   function Scan_Common_Arg
     (My_Project  : in out ASIS_UL.Projects.Arg_Project_Type'Class;
      First_Pass : Boolean;
      Parser : Opt_Parser;
      In_Switches : Boolean;
      In_Project_File : Boolean;
      Initial_Char : Character)
     return Common_Arg_Status is

      Result : Common_Arg_Status := Arg_Not_Processed;
      --  Every switch recognized below MUST set Result!

      --  Note also that if you add processing for a switch here, you must add
      --  it to the string passed to Getopt in each ASIS tool you want to
      --  support that switch.
   begin
      case Initial_Char is
         when 'c' =>
            if Full_Switch (Parser => Parser) = "c" then
               Result := Arg_Processed;
            end if;

         when 'd' =>
            if Full_Switch (Parser => Parser) = "d" then -- "-dX"
               Result := Arg_Processed;
               if First_Pass then -- Set debug flags early
                  Set_Debug_Options (Parameter (Parser => Parser));

                  if Parameter (Parser => Parser) = "1" then -- Debug_Flag_1
                     Info ("current directory = " & Current_Directory);
                  end if;
               end if;
            end if;

         when 'f' =>
            if Full_Switch (Parser => Parser) = "files" then
               Result := Arg_Processed;
               if First_Pass then
                  Files_Switch_Used := True;
                  Read_Args_From_File
                    (Parameter (Parser => Parser),
                     Arg_Project         => My_Project,
                     Store_With_No_Check => True);

               elsif In_Project_File then
                  if In_Switches then
                     Error ("-files option is not allowed " &
                              "for Switches attribute");
                     raise Parameter_Error;
                  else
                     Read_Args_From_File
                       (Parameter (Parser => Parser),
                        Arg_Project       => My_Project,
                        Store_With_No_Check => True);
                  end if;
               end if;
            end if;

         when 'g' =>
            --  Various options that are passed to gnat2xml when it is
            --  called from gnatmake with -GCC=gnat2xml. These should mostly
            --  be passed along to the real compiler.

            --  The "-gnatea" switch is used to detect that we were called from
            --  the builder.
            if Full_Switch (Parser => Parser) = "gnatea" then
               Result := Arg_Processed;
               if First_Pass then
                  Mimic_gcc := True;
               else
                  Store_Option
                    ("-" & Full_Switch (Parser => Parser));
               end if;

            elsif Full_Switch (Parser => Parser) in "gnatec" | "gnatem" then
               Result := Arg_Processed;
               if not First_Pass then
                  Store_GNAT_Option_With_Path
                    (Full_Switch (Parser => Parser),
                     Parameter (Parser => Parser));
               end if;

            elsif Full_Switch (Parser => Parser) in
              "gnatA" |
              "gnatez"
            then
               Result := Arg_Processed;
               if not First_Pass then
                  Store_Option
                    ("-" & Full_Switch (Parser => Parser));
               end if;

            elsif Full_Switch (Parser => Parser) = "gnatc" then
               Result := Arg_Processed;
               --  We can ignore -gnatc, because ASIS always calls the compiler
               --  with -gnatc.
            end if;

         when 'j' =>
            if Full_Switch (Parser => Parser) = "j" then
               Result := Arg_Processed;
               if not First_Pass then
                  begin
                     ASIS_UL.Options.Process_Num :=
                       Natural'Value (Parameter (Parser => Parser));

                     if ASIS_UL.Options.Process_Num = 0 then
                        ASIS_UL.Options.Process_Num :=
                          Positive (System.Multiprocessors.Number_Of_CPUs);
                     end if;
                  exception
                     when Constraint_Error =>
                        Error ("Wrong Parameter of '-j' option: " &
                               Parameter (Parser => Parser));
                        raise Parameter_Error;
                  end;
               end if;
            end if;

         when 'o' =>
            if Full_Switch (Parser => Parser) = "o" then
               --  See comments on Compiler_Output_Subdir for details about
               --  this horsing around. Here, we set Compiler_Output_Subdir and
               --  also pass the -o switch along to the compiler. Note that we
               --  specifically check for files ending in ".o", so we process
               --  things like "-o /some/directory/ALI-FILES-toolname/blah.o",
               --  but we do not process things like "-o blah.adb.pretty".
               --  That's important because gnatpp also has a -o switch, so we
               --  want to let gnatpp handle "-o blah.adb.pretty".
               declare
                  Param : constant String := Parameter (Parser => Parser);
               begin
                  if Has_Suffix (Param, Suffix => ".o") then
                     pragma Assert (Mimic_gcc);
                     Result := Arg_Processed;
                     if First_Pass then
                        pragma Assert (Compiler_Output_Subdir = null);
                        Compiler_Output_Subdir :=
                          new String'(Containing_Directory (Param));
                     else
                        --  Can't use Store_GNAT_Option_With_Path, because it
                        --  inserts an extra "=" that gcc doesn't like.
                        Store_Option ("-" & Full_Switch (Parser => Parser));
                        Store_Option (Parameter (Parser => Parser));
                     end if;
                  end if;
               end;
            end if;

         when 'v' =>
            if Full_Switch (Parser => Parser) = "v" then
               Result := Arg_Processed;
               if First_Pass then -- Handle verbose switch early
                  Verbose_Mode := True;
                  if False then -- Disable this for now
                     Print_Command_Line;
                  end if;
               end if;
            end if;

         when '-' =>
            if Full_Switch (Parser => Parser) = "-help" then
               Result := Quit;
               if In_Project_File then
                  Error ("project file should not contain '--help' option");
                  raise Parameter_Error;
               end if;

               Print_Usage := True;
            elsif Full_Switch (Parser => Parser) = "-version" then
               Result := Quit;
               if In_Project_File then
                  Error
                    ("project file should not contain '--version' option");
                  raise Parameter_Error;
               end if;

               Print_Version := True;
            end if;

            if Full_Switch (Parser => Parser) = "-incremental" then
               Result := Arg_Processed;
               if First_Pass then -- Process --incremental early
                  Incremental_Mode := True;
               end if;

            elsif Full_Switch (Parser => Parser) = "-output-dir" then
               Result := Arg_Processed;
               if not First_Pass then
                  Out_Dir := new String'
                    (Full_Name (Parameter (Parser => Parser)));
               end if;
            end if;

         when others => null;
      end case;

      return Result;
   end Scan_Common_Arg;

   -------------------
   -- Set_Tree_Name --
   -------------------

   procedure Set_Tree_Name is
      Dot_Idx : Natural := 0;
      DS_Idx  : Natural;
   begin

      Free (Tree_File);

      if Arg_File = null then
         Tree_File := new String'("");
      else
         for J in reverse Arg_File'Range loop
            if Arg_File (J) = '.' then
               Dot_Idx := J - 1;
               exit;
            end if;
         end loop;

         DS_Idx := Arg_File'First;

         for J in reverse Arg_File'Range loop
            if Arg_File (J) = Directory_Separator then
               DS_Idx := J + 1;
               exit;
            end if;
         end loop;

         Tree_File := new String'(Arg_File (DS_Idx .. Dot_Idx) & ".adt");

      end if;

   end Set_Tree_Name;

   ----------------------------------
   -- Tool_Specific_Initialization --
   ----------------------------------

   procedure Tool_Specific_Initialization_1 is separate;
   procedure Tool_Specific_Initialization_2 is separate;

begin
   --  Check if we have the directory for temporary stuff specified
   declare
      Dir : String_Access;

   begin
      --  On VMS, if GNUTMPDIR is defined, use it

      if Hostparm.OpenVMS then
         Dir := Getenv (Gnutmpdir);

         --  Otherwise, if GNUTMPDIR is not defined, try TMPDIR

         if Dir'Length = 0 then
            Dir := Getenv (Tmpdir);
         end if;

      else
         Dir := Getenv (Tmpdir);
      end if;

      if Dir'Length > 0 and then
        Is_Absolute_Path (Dir.all) and then
        Is_Directory (Dir.all)
      then
         Temp_Dir := new String'(Normalize_Pathname (Dir.all));
      end if;

      Free (Dir);
   end;
end ASIS_UL.Environment;
