------------------------------------------------------------------------------
-- --
-- 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;
syntax highlighted by Code2HTML, v. 0.9.1