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

with GNATELIM.Process_Bind_File; use GNATELIM.Process_Bind_File;

with GNATELIM.Analysis;          use GNATELIM.Analysis;
with GNATELIM.Output;            use GNATELIM.Output;
with GNATELIM.Options;           use GNATELIM.Options;
with GNATELIM.Errors;            use GNATELIM.Errors;

with Asis;
with Asis.Exceptions;
with Asis.Errors;
with Asis.Implementation;
with Asis.Ada_Environments;
with Asis.Compilation_Units;

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

procedure GNATELIM.Driver is

   My_Context      : Asis.Context;

   Dirs            : String (1 .. 1000);
   Dirs_Ptr        : Natural := 0;
   --  Storage for "-T" switches

   Bindfile        : String (1 .. 256);
   Bindfile_Ptr    : Natural := 0;
   --  Storage for bindfile name

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

   procedure Clean;
   --  does the ASIS finalization steps (Close->Dissociate->Finalize)
   --  in case of any failure, if necessary

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

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

   procedure Brief_Help is
   begin

      Put_Line ("");
      Put_Line ("Usage: gnatelim [options] name");
      Put_Line ("  name     full expanded Ada name of a main subprogram "
                      & "of a program (partition)");
      Put_Line ("gnatelim options:");
      Put_Line ("  -v       verbose mode");
      Put_Line ("  -a       process RTL components");
      Put_Line ("  -b<file> process specific bind file");
      Put_Line ("  -m       check missed units");
      Put_Line ("  -q       quiet mode");
      Put_Line ("  -T<dir>  look in this dir for tree files");

   end Brief_Help;

   -------------
   --  Clean  --
   -------------

   procedure Clean is
   begin

      if Asis.Ada_Environments.Is_Open (My_Context) then
         Asis.Ada_Environments.Close (My_Context);
      end if;

      Asis.Ada_Environments.Dissociate (My_Context);
      Asis.Implementation.Finalize;

   end Clean;

   First_Parameter_Index : Natural := 0;

   Main_Unit : Asis.Compilation_Unit;

begin  --  GNATELIM.Driver's body.

   --  Parse command-line arguments.

   for C in 1 .. Argument_Count loop

      declare
         Arg : String := Argument (C);
      begin

         if Arg (Arg'First) = '-' then

            if Arg (Arg'First + 1 .. Arg'Last) = "q" then
               GNATELIM.Options.Quiet_Mode := True;

            elsif Arg (Arg'First + 1 .. Arg'Last) = "dv" then
               GNATELIM.Options.Debug_Mode := True;

            elsif Arg (Arg'First + 1 .. Arg'Last) = "v" then
               GNATELIM.Options.Verbose_Mode := True;

            elsif Arg (Arg'First + 1 .. Arg'Last) = "m" then
               GNATELIM.Options.Skip_Missed_Units := False;

            elsif Arg (Arg'First + 1 .. Arg'Last) = "a" then
               GNATELIM.Options.Dont_Eliminate_In_RTS := False;

            elsif Arg (Arg'First + 1) = 'T' and then Arg'Length > 2 then
               Dirs (Dirs_Ptr + 1 .. Dirs_Ptr + Arg'Length + 1) := Arg & ' ';
               Dirs_Ptr := Dirs_Ptr + Arg'Length + 1;

            elsif Arg (Arg'First + 1) = 'b' and then Arg'Length > 2 then
               Bindfile_Ptr := Arg'Length - 2;
               Bindfile (1 .. Bindfile_Ptr) := Arg (3 .. Arg'Length);

            else
               Error ("gnatelim: invalid switch: "
                      & To_Wide_String (Arg (Arg'First + 1 .. Arg'Last)));
            end if;

         else
            First_Parameter_Index := C;
            exit;
         end if;

      end;

   end loop;

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

   if (First_Parameter_Index = 0) then

      Brief_Help;

      raise Fatal_Error;

   end if;

   --  ASIS Initialization:

   Asis.Implementation.Initialize;
   Asis.Ada_Environments.Associate
     (My_Context, "My_Context", To_Wide_String (Dirs (1 .. Dirs_Ptr)) & "-CA");
   Asis.Ada_Environments.Open (My_Context);

   --  Computing the main unit:

   Main_Unit := Asis.Compilation_Units.Library_Unit_Declaration
     (To_Wide_String (Argument (First_Parameter_Index)), My_Context);

   if Asis.Compilation_Units.Is_Nil (Main_Unit) then
      --  May be this is a spec-less subprogram. Let's get the body.
      Main_Unit := Asis.Compilation_Units.Compilation_Unit_Body
        (To_Wide_String (Argument (First_Parameter_Index)), My_Context);
   end if;

   if Asis.Compilation_Units.Is_Nil (Main_Unit) then
      Error ("gnatelim: Library item corresponding to "
             & To_Wide_String (Argument (First_Parameter_Index))
             & " not found.");
   end if;

   if not Asis.Compilation_Units.Can_Be_Main_Program (Main_Unit) then
      Error ("gnatelim: the unit corresponding to "
             & To_Wide_String (Argument (First_Parameter_Index))
             & " cannot be a main program.");
   end if;

   --  obtaining from a bind file a list of units making up a program
   --  (partition)
   declare
      Partition_Complete : Boolean := False;
      Needed_Units : Asis.Compilation_Unit_List :=
        Get_Units_From_Bind_File
        (My_Context, Argument (Argument_Count), Bindfile (1 .. Bindfile_Ptr));
   begin
      Partition_Complete := True;

      Warning ("gnatelim: starting analysis...", True);

      Analyze_Partition (Main_Unit, Needed_Units);

   exception

      when others =>

         if Partition_Complete then
            --  We let the global handler provide more informations.
            raise;
         else
            --  ??? How could we get here
            Error ("gnatelim: the set of files making the partition "
                 & "is incomplete.");
         end if;
   end;

   --  Reporting results of the analysis:
   Report_Unused_Subprograms;

   --  ASIS Finalization:
   Clean;

exception

   when Ex : Asis.Exceptions.ASIS_Inappropriate_Context
          |  Asis.Exceptions.ASIS_Inappropriate_Container
          |  Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit
          |  Asis.Exceptions.ASIS_Inappropriate_Element
          |  Asis.Exceptions.ASIS_Inappropriate_Line
          |  Asis.Exceptions.ASIS_Inappropriate_Line_Number
          |  Asis.Exceptions.ASIS_Failed
     =>
      Set_Output (Standard_Error);
      New_Line;


      Put ("Unexpected bug in ");
      Put_Gnatelim_Version;
      New_Line;
      Put (To_Wide_String (Exception_Name (Ex)));
      Put_Line (" raised");
      Put ("gnatelim: ASIS Diagnosis is " &  Asis.Implementation.Diagnosis);
      New_Line;
      Put ("gnatelim: Status Value   is ");
      Put_Line
        (Asis.Errors.Error_Kinds 'Wide_Image (Asis.Implementation.Status));
      New_Line;
      Put_Line ("Please report to report@gnat.com.");

      --  Exit cleanly.
      Set_Output (Standard_Output);
      Set_Exit_Status (Failure);
      Clean;

   when Fatal_Error =>
      Clean;

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

      if Exception_Identity (Ex) = Program_Error'Identity and then
         Exception_Message (Ex) = "Inconsistent versions of GNAT and ASIS"
      then
         Put_Gnatelim_Version;
         New_Line;
         Put ("is inconsistent with the GNAT version");
         New_Line;
         Put ("Check your installation of GNAT, ASIS and the GNAT toolset");
         New_Line;
      else
         Put ("Unexpected bug 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");
      end if;

      --  Exit cleanly.
      Set_Output (Standard_Output);
      Set_Exit_Status (Failure);
      Clean;

end GNATELIM.Driver;
