| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T M A I N -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision: 1.1 $ |
| -- -- |
| -- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT 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 COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Csets; |
| with GNAT.Case_Util; |
| with GNAT.OS_Lib; use GNAT.OS_Lib; |
| with Namet; use Namet; |
| with Opt; |
| with Osint; use Osint; |
| with Output; use Output; |
| with Prj; use Prj; |
| with Prj.Env; |
| with Prj.Ext; use Prj.Ext; |
| with Prj.Pars; |
| with Prj.Util; use Prj.Util; |
| with Snames; use Snames; |
| with Stringt; use Stringt; |
| with Table; |
| with Types; use Types; |
| |
| procedure Gnatmain is |
| |
| Ada_Include_Path : constant String := "ADA_INCLUDE_PATH"; |
| Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH"; |
| |
| type Tool_Type is (None, List, Xref, Find, Stub, Make, Comp, Bind, Link); |
| |
| -- The tool that is going to be called |
| |
| Tool : Tool_Type := None; |
| |
| -- For each tool, Tool_Package_Names contains the name of the |
| -- corresponding package in the project file. |
| |
| Tool_Package_Names : constant array (Tool_Type) of Name_Id := |
| (None => No_Name, |
| List => Name_Gnatls, |
| Xref => Name_Cross_Reference, |
| Find => Name_Finder, |
| Stub => Name_Gnatstub, |
| Comp => No_Name, |
| Make => No_Name, |
| Bind => No_Name, |
| Link => No_Name); |
| |
| -- For each tool, Tool_Names contains the name of the executable |
| -- to be spawned. |
| |
| Gnatmake : constant String_Access := new String'("gnatmake"); |
| |
| Tool_Names : constant array (Tool_Type) of String_Access := |
| (None => null, |
| List => new String'("gnatls"), |
| Xref => new String'("gnatxref"), |
| Find => new String'("gnatfind"), |
| Stub => new String'("gnatstub"), |
| Comp => Gnatmake, |
| Make => Gnatmake, |
| Bind => Gnatmake, |
| Link => Gnatmake); |
| |
| Project_File : String_Access; |
| Project : Prj.Project_Id; |
| Current_Verbosity : Prj.Verbosity := Prj.Default; |
| |
| -- This flag indicates a switch -p (for gnatxref and gnatfind) for |
| -- an old fashioned project file. -p cannot be used in conjonction |
| -- with -P. |
| |
| Old_Project_File_Used : Boolean := False; |
| |
| Next_Arg : Positive; |
| |
| -- A table to keep the switches on the command line |
| |
| package Saved_Switches is new Table.Table ( |
| Table_Component_Type => String_Access, |
| Table_Index_Type => Integer, |
| Table_Low_Bound => 1, |
| Table_Initial => 20, |
| Table_Increment => 100, |
| Table_Name => "Gnatmain.Saved_Switches"); |
| |
| -- A table to keep the switches from the project file |
| |
| package Switches is new Table.Table ( |
| Table_Component_Type => String_Access, |
| Table_Index_Type => Integer, |
| Table_Low_Bound => 1, |
| Table_Initial => 20, |
| Table_Increment => 100, |
| Table_Name => "Gnatmain.Switches"); |
| |
| procedure Add_Switch (Argv : String; And_Save : Boolean); |
| -- Add a switch in one of the tables above |
| |
| procedure Display (Program : String; Args : Argument_List); |
| -- Displays Program followed by the arguments in Args |
| |
| function Index (Char : Character; Str : String) return Natural; |
| -- Returns the first occurrence of Char in Str. |
| -- Returns 0 if Char is not in Str. |
| |
| procedure Scan_Arg (Argv : String; And_Save : Boolean); |
| -- Scan and process arguments. Argv is a single argument. |
| |
| procedure Usage; |
| -- Output usage |
| |
| ---------------- |
| -- Add_Switch -- |
| ---------------- |
| |
| procedure Add_Switch (Argv : String; And_Save : Boolean) is |
| begin |
| if And_Save then |
| Saved_Switches.Increment_Last; |
| Saved_Switches.Table (Saved_Switches.Last) := new String'(Argv); |
| |
| else |
| Switches.Increment_Last; |
| Switches.Table (Switches.Last) := new String'(Argv); |
| end if; |
| end Add_Switch; |
| |
| ------------- |
| -- Display -- |
| ------------- |
| |
| procedure Display (Program : String; Args : Argument_List) is |
| begin |
| if not Opt.Quiet_Output then |
| Write_Str (Program); |
| |
| for J in Args'Range loop |
| Write_Str (" "); |
| Write_Str (Args (J).all); |
| end loop; |
| |
| Write_Eol; |
| end if; |
| end Display; |
| |
| ----------- |
| -- Index -- |
| ----------- |
| |
| function Index (Char : Character; Str : String) return Natural is |
| begin |
| for Index in Str'Range loop |
| if Str (Index) = Char then |
| return Index; |
| end if; |
| end loop; |
| |
| return 0; |
| end Index; |
| |
| -------------- |
| -- Scan_Arg -- |
| -------------- |
| |
| procedure Scan_Arg (Argv : String; And_Save : Boolean) is |
| begin |
| pragma Assert (Argv'First = 1); |
| |
| if Argv'Length = 0 then |
| return; |
| end if; |
| |
| if Argv (1) = Switch_Character or else Argv (1) = '-' then |
| |
| if Argv'Length = 1 then |
| Fail ("switch character cannot be followed by a blank"); |
| end if; |
| |
| -- The two style project files (-p and -P) cannot be used together |
| |
| if (Tool = Find or else Tool = Xref) |
| and then Argv (2) = 'p' |
| then |
| Old_Project_File_Used := True; |
| if Project_File /= null then |
| Fail ("-P and -p cannot be used together"); |
| end if; |
| end if; |
| |
| -- -q Be quiet: do not output tool command |
| |
| if Argv (2 .. Argv'Last) = "q" then |
| Opt.Quiet_Output := True; |
| |
| -- Only gnatstub and gnatmake have a -q switch |
| |
| if Tool = Stub or else Tool_Names (Tool) = Gnatmake then |
| Add_Switch (Argv, And_Save); |
| end if; |
| |
| -- gnatmake will take care of the project file related switches |
| |
| elsif Tool_Names (Tool) = Gnatmake then |
| Add_Switch (Argv, And_Save); |
| |
| -- -vPx Specify verbosity while parsing project files |
| |
| elsif Argv'Length = 4 and then Argv (2 .. 3) = "vP" then |
| case Argv (4) is |
| when '0' => |
| Current_Verbosity := Prj.Default; |
| when '1' => |
| Current_Verbosity := Prj.Medium; |
| when '2' => |
| Current_Verbosity := Prj.High; |
| when others => |
| null; |
| end case; |
| |
| -- -Pproject_file Specify project file to be used |
| |
| elsif Argv'Length >= 3 and then Argv (2) = 'P' then |
| |
| -- Only one -P switch can be used |
| |
| if Project_File /= null then |
| Fail (Argv & ": second project file forbidden (first is """ & |
| Project_File.all & """)"); |
| |
| -- The two style project files (-p and -P) cannot be used together |
| |
| elsif Old_Project_File_Used then |
| Fail ("-p and -P cannot be used together"); |
| |
| else |
| Project_File := new String'(Argv (3 .. Argv'Last)); |
| end if; |
| |
| -- -Xexternal=value Specify an external reference to be used |
| -- in project files |
| |
| elsif Argv'Length >= 5 and then Argv (2) = 'X' then |
| declare |
| Equal_Pos : constant Natural := |
| Index ('=', Argv (3 .. Argv'Last)); |
| begin |
| if Equal_Pos >= 4 and then |
| Equal_Pos /= Argv'Last then |
| Add (External_Name => Argv (3 .. Equal_Pos - 1), |
| Value => Argv (Equal_Pos + 1 .. Argv'Last)); |
| else |
| Fail (Argv & " is not a valid external assignment."); |
| end if; |
| end; |
| |
| else |
| Add_Switch (Argv, And_Save); |
| end if; |
| |
| else |
| Add_Switch (Argv, And_Save); |
| end if; |
| |
| end Scan_Arg; |
| |
| ----------- |
| -- Usage -- |
| ----------- |
| |
| procedure Usage is |
| begin |
| Write_Str ("Usage: "); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" list switches [list of object files]"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" xref switches file1 file2 ..."); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" find switches pattern[:sourcefile[:line[:column]]] " & |
| "[file1 file2 ...]"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" stub switches filename [directory]"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" comp switches files"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" make switches [files]"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" bind switches files"); |
| Write_Eol; |
| |
| Osint.Write_Program_Name; |
| Write_Str (" link switches files"); |
| Write_Eol; |
| |
| Write_Eol; |
| |
| Write_Str ("switches interpreted by "); |
| Osint.Write_Program_Name; |
| Write_Str (" for List Xref and Find:"); |
| Write_Eol; |
| |
| Write_Str (" -q Be quiet: do not output tool command"); |
| Write_Eol; |
| |
| Write_Str (" -Pproj Use GNAT Project File proj"); |
| Write_Eol; |
| |
| Write_Str (" -vPx Specify verbosity when parsing " & |
| "GNAT Project Files"); |
| Write_Eol; |
| |
| Write_Str (" -Xnm=val Specify an external reference for " & |
| "GNAT Project Files"); |
| Write_Eol; |
| |
| Write_Eol; |
| |
| Write_Str ("all other arguments are transmited to the tool"); |
| Write_Eol; |
| |
| Write_Eol; |
| |
| end Usage; |
| |
| begin |
| |
| Osint.Initialize (Unspecified); |
| |
| Namet.Initialize; |
| Csets.Initialize; |
| |
| Snames.Initialize; |
| |
| Prj.Initialize; |
| |
| if Arg_Count = 1 then |
| Usage; |
| return; |
| end if; |
| |
| -- Get the name of the tool |
| |
| declare |
| Tool_Name : String (1 .. Len_Arg (1)); |
| |
| begin |
| Fill_Arg (Tool_Name'Address, 1); |
| GNAT.Case_Util.To_Lower (Tool_Name); |
| |
| if Tool_Name = "list" then |
| Tool := List; |
| |
| elsif Tool_Name = "xref" then |
| Tool := Xref; |
| |
| elsif Tool_Name = "find" then |
| Tool := Find; |
| |
| elsif Tool_Name = "stub" then |
| Tool := Stub; |
| |
| elsif Tool_Name = "comp" then |
| Tool := Comp; |
| |
| elsif Tool_Name = "make" then |
| Tool := Make; |
| |
| elsif Tool_Name = "bind" then |
| Tool := Bind; |
| |
| elsif Tool_Name = "link" then |
| Tool := Link; |
| |
| else |
| Fail ("first argument needs to be ""list"", ""xref"", ""find""" & |
| ", ""stub"", ""comp"", ""make"", ""bind"" or ""link"""); |
| end if; |
| end; |
| |
| Next_Arg := 2; |
| |
| -- Get the command line switches that follow the name of the tool |
| |
| Scan_Args : while Next_Arg < Arg_Count loop |
| declare |
| Next_Argv : String (1 .. Len_Arg (Next_Arg)); |
| |
| begin |
| Fill_Arg (Next_Argv'Address, Next_Arg); |
| Scan_Arg (Next_Argv, And_Save => True); |
| end; |
| |
| Next_Arg := Next_Arg + 1; |
| end loop Scan_Args; |
| |
| -- If a switch -P was specified, parse the project file. |
| -- Project_File is always null if we are going to invoke gnatmake, |
| -- that is when Tool is Comp, Make, Bind or Link. |
| |
| if Project_File /= null then |
| |
| Prj.Pars.Set_Verbosity (To => Current_Verbosity); |
| |
| Prj.Pars.Parse |
| (Project => Project, |
| Project_File_Name => Project_File.all); |
| |
| if Project = Prj.No_Project then |
| Fail ("""" & Project_File.all & """ processing failed"); |
| end if; |
| |
| -- Check if a package with the name of the tool is in the project file |
| -- and if there is one, get the switches, if any, and scan them. |
| |
| declare |
| Data : Prj.Project_Data := Prj.Projects.Table (Project); |
| Pkg : Prj.Package_Id := |
| Prj.Util.Value_Of |
| (Name => Tool_Package_Names (Tool), |
| In_Packages => Data.Decl.Packages); |
| Element : Package_Element; |
| Default_Switches_Array : Array_Element_Id; |
| Switches : Prj.Variable_Value; |
| Current : Prj.String_List_Id; |
| The_String : String_Element; |
| |
| begin |
| if Pkg /= No_Package then |
| Element := Packages.Table (Pkg); |
| |
| -- Packages Gnatls and Gnatstub have a single attribute Switches, |
| -- that is not an associative array. |
| |
| if Tool = List or else Tool = Stub then |
| Switches := |
| Prj.Util.Value_Of |
| (Variable_Name => Name_Switches, |
| In_Variables => Element.Decl.Attributes); |
| |
| -- Packages Cross_Reference (for gnatxref) and Finder |
| -- (for gnatfind) have an attributed Default_Switches, |
| -- an associative array, indexed by the name of the |
| -- programming language. |
| else |
| Default_Switches_Array := |
| Prj.Util.Value_Of |
| (Name => Name_Default_Switches, |
| In_Arrays => Packages.Table (Pkg).Decl.Arrays); |
| Switches := Prj.Util.Value_Of |
| (Index => Name_Ada, |
| In_Array => Default_Switches_Array); |
| |
| end if; |
| |
| -- If there are switches specified in the package of the |
| -- project file corresponding to the tool, scan them. |
| |
| case Switches.Kind is |
| when Prj.Undefined => |
| null; |
| |
| when Prj.Single => |
| if String_Length (Switches.Value) > 0 then |
| String_To_Name_Buffer (Switches.Value); |
| Scan_Arg |
| (Name_Buffer (1 .. Name_Len), |
| And_Save => False); |
| end if; |
| |
| when Prj.List => |
| Current := Switches.Values; |
| while Current /= Prj.Nil_String loop |
| The_String := String_Elements.Table (Current); |
| |
| if String_Length (The_String.Value) > 0 then |
| String_To_Name_Buffer (The_String.Value); |
| Scan_Arg |
| (Name_Buffer (1 .. Name_Len), |
| And_Save => False); |
| end if; |
| |
| Current := The_String.Next; |
| end loop; |
| end case; |
| end if; |
| end; |
| |
| -- Set up the environment variables ADA_INCLUDE_PATH and |
| -- ADA_OBJECTS_PATH. |
| |
| Setenv |
| (Name => Ada_Include_Path, |
| Value => Prj.Env.Ada_Include_Path (Project).all); |
| Setenv |
| (Name => Ada_Objects_Path, |
| Value => Prj.Env.Ada_Objects_Path |
| (Project, Including_Libraries => False).all); |
| |
| end if; |
| |
| -- Gather all the arguments, those from the project file first, |
| -- locate the tool and call it with the arguments. |
| |
| declare |
| Args : Argument_List (1 .. Switches.Last + Saved_Switches.Last + 4); |
| Arg_Num : Natural := 0; |
| Tool_Path : String_Access; |
| Success : Boolean; |
| |
| procedure Add (Arg : String_Access); |
| |
| procedure Add (Arg : String_Access) is |
| begin |
| Arg_Num := Arg_Num + 1; |
| Args (Arg_Num) := Arg; |
| end Add; |
| |
| begin |
| |
| case Tool is |
| when Comp => |
| Add (new String'("-u")); |
| Add (new String'("-f")); |
| |
| when Bind => |
| Add (new String'("-b")); |
| |
| when Link => |
| Add (new String'("-l")); |
| |
| when others => |
| null; |
| |
| end case; |
| |
| for Index in 1 .. Switches.Last loop |
| Arg_Num := Arg_Num + 1; |
| Args (Arg_Num) := Switches.Table (Index); |
| end loop; |
| |
| for Index in 1 .. Saved_Switches.Last loop |
| Arg_Num := Arg_Num + 1; |
| Args (Arg_Num) := Saved_Switches.Table (Index); |
| end loop; |
| |
| Tool_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Tool_Names (Tool).all); |
| |
| if Tool_Path = null then |
| Fail ("error, unable to locate " & Tool_Names (Tool).all); |
| end if; |
| |
| Display (Tool_Names (Tool).all, Args (1 .. Arg_Num)); |
| |
| GNAT.OS_Lib.Spawn (Tool_Path.all, Args (1 .. Arg_Num), Success); |
| |
| end; |
| |
| end Gnatmain; |
