diff options
Diffstat (limited to 'gcc/ada/gnatmain.adb')
| -rw-r--r-- | gcc/ada/gnatmain.adb | 594 |
1 files changed, 594 insertions, 0 deletions
diff --git a/gcc/ada/gnatmain.adb b/gcc/ada/gnatmain.adb new file mode 100644 index 00000000000..0903f516175 --- /dev/null +++ b/gcc/ada/gnatmain.adb @@ -0,0 +1,594 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T M A I N -- +-- -- +-- B o d y -- +-- -- +-- $Revision$ +-- -- +-- 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 occurence 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; |