------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--                      G N A T E L I M . D R I V E R                       --
--                                                                          --
--                       P r o c e d u r e   B o d y                        --
--                                                                          --
--            Copyright (C) 1998-2005 Ada Core Technologies, Inc.           --
--                                                                          --
-- GNATELIM  is  free software;  you can  redistribute it and/or  modify it --
-- under the terms of the  GNU  General Public License  as published by the --
-- Free Software Foundation; either version 2 or (at your option) any later --
-- version. GNATELIM is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense for  more details.  You should  have  received  a copy of the  GNU --
-- General Public License distributed with GNAT; see file COPYING.  If not, --
-- write to  the  Free  Software  Foundation,  59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA.                                              --
--                                                                          --
-- The original version  of  Gnatelim  was developed by  Alain  Le  Guennec --
-- It is now maintained by Ada Core Technologies Inc  (http://www.gnat.com) --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;   use Ada.Characters.Handling;
with Ada.Exceptions;            use Ada.Exceptions;
with Ada.Strings.Fixed;         use Ada.Strings.Fixed;
with Ada.Wide_Text_IO;          use Ada.Wide_Text_IO;
with Ada.Command_Line;          use Ada.Command_Line;

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

with ASIS_UL.Compiler_Options;  use ASIS_UL.Compiler_Options;

with Gnatelim.Analyze;
with Gnatelim.Bind_File;
with Gnatelim.Nodes;            use Gnatelim.Nodes;
with Gnatelim.Output;           use Gnatelim.Output;
with Gnatelim.Errors;           use Gnatelim.Errors;

procedure Gnatelim.Driver is

   Bindfile, Main_Proc : String_Access;
   --  Storage for bindfile and main procedure names

   Main : Node;
   --  ???

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

   procedure Brief_Help;
   --  Prints brief help information to stdout.

   function Detect_Target return String;
   --  Detects if this is a cross version of the tool by analysing its name.
   --  In case if it is a cross version, returns the prefix of the name
   --  detecting the specific cross version, othervise returns an empty
   --  string   (in case of gnaampelim, returns "AAMP")

   function Compiler_To_Call return String;
   --  Detects the name of the compiler to call

   function Gnatmake_To_Call return String;
   --  Detects the name of gnatmake to call

   procedure Locate_Main_Unit (Par : String);
   --  This procedure tries to locate the file containing the main procedure
   --  name and to set full normalized name of this file as the value of
   --  Main_Proc. In case if it is impossible because of any reason, this
   --  procesure assigns to Main_Proc the reference to a Par string as it is
   --  passed to the procedure

   ----------------
   -- Brief_Help --
   ----------------

   procedure Brief_Help is
   begin

      Put_Gnatelim_Version;
      Put_Line ("");
      Put_Line ("Usage: gnatelim [options] name [gcc_switches]");
      Put_Line ("  name     the name of the source file containing the main");
      Put_Line ("           subprogram of a program (partition)");
      Put_Line ("gnatelim options:");
      Put_Line ("  -v       verbose mode");
      Put_Line ("  -a       also analyze RTL components used by a program");
      Put_Line ("  -b<file> process specific bind file");
      Put_Line ("  -q       quiet mode");
      Put_Line ("  -I<dir>  look in this dir for source files; can be repeated"
                & " any number");
      Put_Line ("           of times. Specify -I- to exclude current dir.");
      Put_Line ("  -C<file> file that contains configuration pragmas. Must be"
                & " with full path.");
      Put_Line ("  --GCC=<file> use this GCC instead of the one on the path");
      Put_Line ("  --GNATMAKE=<file> "
                & "use this GNATMAKE instead of the one on the path");
      Put      ("  gcc_switches  '-cargs switches' where 'switches' is ");
      Put_Line ("a list of of switches");
      Put_Line ("                that are valid switches for gcc");
   end Brief_Help;

   ----------------------
   -- Compiler_To_Call --
   ----------------------

   function Compiler_To_Call return String is
      Target : constant String := Detect_Target;
   begin

      if Target = "AAMP" then
         return "gnaamp";
      else
         return Target & "gcc";
      end if;

   end Compiler_To_Call;

   -------------------
   -- Detect_Target --
   -------------------

   function Detect_Target return String is
      Name     : constant String  :=
        To_Lower (Base_Name (Normalize_Pathname (Command_Name)));
      Tgt_Last : constant Integer := Index (Name, "gnatelim") - 1;
   begin

      if Name = "gnaampelim" then
         return "AAMP";
      elsif Tgt_Last > Name'First then
         return Name (Name'First .. Tgt_Last);
      else
         return "";
      end if;

   exception
      when others =>
         return "";

   end Detect_Target;

   ----------------------
   -- Gnatmake_To_Call --
   ----------------------

   function Gnatmake_To_Call return String is
      Target : constant String := Detect_Target;
   begin

      if Target = "AAMP" then
         return "gnaampmake";
      else
         return Target & "gnatmake";
      end if;

   end Gnatmake_To_Call;

   ----------------------
   -- Locate_Main_Unit --
   ----------------------

   procedure Locate_Main_Unit (Par : String) is
   begin

      if Is_Regular_File (Par) then
         Main_Proc := new String'(Normalize_Pathname (Par));
      elsif Is_Regular_File (Par & ".adb") then
         Main_Proc := new String'(Normalize_Pathname (Par & ".adb"));
      elsif Is_Regular_File (Par & ".ads") then
         Main_Proc := new String'(Normalize_Pathname (Par & ".ads"));
      end if;

      if Main_Proc = null then
         Main_Proc := new String'(Par);
      end if;

   end Locate_Main_Unit;

begin  --  Gnatelim.Driver's body.

   --  Parse command-line arguments.

   Initialize_Option_Scan
     (Stop_At_First_Non_Switch => True,
      Section_Delimiters       => "cargs");

   loop
      case Getopt ("-help -GCC=: -GNATMAKE=: a b: m q v C: I: d dv dh v") is

         when ASCII.Nul =>
            exit;

         when 'a' =>
            Gnatelim.Eliminate_In_RTL := True;

         when 'b' =>
            Bindfile := new String'(Parameter);

         when 'm' =>
            null; --  Obsolete switch, for backwards compatibility

         when 'q' =>
            Gnatelim.Quiet_Mode := True;

         when 'v' =>
            Gnatelim.Verbose_Mode := True;

         when 'C' =>
            Store_gnatec_Option (Parameter);

         when 'I' =>
            Store_I_Option (Parameter);

         when '-' =>
            if Full_Switch = "-help" then
               Brief_Help;
               OS_Exit (1);

            elsif Full_Switch = "-GCC=" then
               Gcc := new String'(Parameter);

            elsif Full_Switch = "-GNATMAKE=" then
               Gnatmake := new String'(Parameter);
            end if;

         when 'd' =>
            --  Debug switches

            if Full_Switch = "dv" then
               Gnatelim.Output_Debug_Information := True;

            elsif Full_Switch = "dh" then
               Gnatelim.Eliminate_Homonyms_By_Profile := True;

            elsif Full_Switch = "d" then
               Gnatelim.Progress_Indicator_Mode := True;

            end if;

         when others =>
            null;

      end case;

   end loop;

   if Bindfile = null then
      Bindfile := new String'("");
   end if;

   if Gnatmake = null then
      Gnatmake := Locate_Exec_On_Path (Gnatmake_To_Call);
   end if;

   if Gnatmake = null then
      Error (To_Wide_String (Gnatmake_To_Call) & " not found on the path");
   end if;

   if Gcc = null then
      Gcc := Locate_Exec_On_Path (Compiler_To_Call);
   end if;

   if Gcc = null then
      Error (To_Wide_String (Compiler_To_Call) & " not found on the path");
   end if;

   --  Clear environment variables that set objects path for gnatmake, as
   --  gnatelim will define its own
   Setenv ("ADA_PRJ_OBJECTS_FILE", "");
   Setenv ("ADA_OBJECTS_PATH", "");

   Locate_Main_Unit (Get_Argument);

   if Main_Proc = null or else Main_Proc.all = "" then
      Error ("gnatelim: can not locate the main unit");
   end if;

   Process_cargs_Section;

   Set_Arg_List;

   if Main_Proc.all = "" then
      Brief_Help;
      OS_Exit (1);
   end if;

   if Verbose_Mode then
      Put ("--  ");
      Put_Gnatelim_Version;
      New_Line;
      Put_Line ("--  Copyright 1997-2003, Free Software Foundation, Inc.");
      New_Line;
   end if;

   Warning ("Processing bind file...");
   Gnatelim.Bind_File.Process_Bind_File
     (Main_Proc.all, Bindfile.all);

   Warning ("Registering subprograms...");
   Main := Gnatelim.Analyze (Main_Proc);

   Main.Flags (FLAG_USED) := True;
   Register_Node (Main);

   Warning ("Analyzing usage...");

   Gnatelim.Nodes.Transitive_Closure;

   Warning ("Generating pragmas...");
   Gnatelim.Output.Report_Unused_Subprograms;

exception

   when Fatal_Error =>
      OS_Exit (1);

   when Invalid_Switch =>
      Brief_Help;
      New_Line;
      Put_Line ("Unknown switch: -" & To_Wide_String (Full_Switch));

   when Ex : others =>
      Set_Output (Standard_Error);
      New_Line;

      Put ("Unexpected exception in ");
      Put_Gnatelim_Version;
      New_Line;
      Put (To_Wide_String (Exception_Name (Ex)));
      Put (" was raised: ");

      if Exception_Message (Ex)'Length = 0 then
         Put_Line ("(no exception message)");
      else
         Put_Line (To_Wide_String (Exception_Message (Ex)));
      end if;

      Put_Line ("Please report to report@gnat.com");

      --  Exit cleanly.
      Set_Output (Standard_Output);
      OS_Exit (1);

end Gnatelim.Driver;