------------------------------------------------------------------------------ -- -- -- 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 process specific bind file"); Put_Line (" -m check missed units"); Put_Line (" -q quiet mode"); Put_Line (" -T 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;