------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- M L I B . U T L -- -- -- -- B o d y -- -- -- -- Copyright (C) 2002-2006, AdaCore -- -- -- -- 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, 51 Franklin Street, Fifth Floor, -- -- Boston, MA 02110-1301, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with MLib.Fil; use MLib.Fil; with MLib.Tgt; use MLib.Tgt; with Namet; use Namet; with Opt; with Osint; with Output; use Output; with GNAT; use GNAT; package body MLib.Utl is Initialized : Boolean := False; Gcc_Name : constant String := Osint.Program_Name ("gcc").all; Gcc_Exec : OS_Lib.String_Access; Ar_Name : OS_Lib.String_Access; Ar_Exec : OS_Lib.String_Access; Ar_Options : OS_Lib.String_List_Access; Ranlib_Name : OS_Lib.String_Access; Ranlib_Exec : OS_Lib.String_Access := null; Ranlib_Options : OS_Lib.String_List_Access := null; procedure Initialize; -- Look for the tools in the path and record the full path for each one -------- -- Ar -- -------- procedure Ar (Output_File : String; Objects : Argument_List) is Full_Output_File : constant String := Ext_To (Output_File, Archive_Ext); Arguments : OS_Lib.Argument_List_Access; Success : Boolean; Line_Length : Natural := 0; begin Utl.Initialize; Arguments := new String_List (1 .. 1 + Ar_Options'Length + Objects'Length); Arguments (1 .. Ar_Options'Length) := Ar_Options.all; -- "ar cr ..." Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File); Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects; Delete_File (Full_Output_File); if not Opt.Quiet_Output then Write_Str (Ar_Name.all); Line_Length := Ar_Name'Length; for J in Arguments'Range loop -- Make sure the Output buffer does not overflow if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then Write_Eol; Line_Length := 0; end if; Write_Char (' '); Write_Str (Arguments (J).all); Line_Length := Line_Length + 1 + Arguments (J)'Length; end loop; Write_Eol; end if; OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success); if not Success then Fail (Ar_Name.all, " execution error."); end if; -- If we have found ranlib, run it over the library if Ranlib_Exec /= null then if not Opt.Quiet_Output then Write_Str (Ranlib_Name.all); Write_Char (' '); Write_Line (Arguments (Ar_Options'Length + 1).all); end if; OS_Lib.Spawn (Ranlib_Exec.all, Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)), Success); if not Success then Fail (Ranlib_Name.all, " execution error."); end if; end if; end Ar; ----------------- -- Delete_File -- ----------------- procedure Delete_File (Filename : String) is File : constant String := Filename & ASCII.Nul; Success : Boolean; begin OS_Lib.Delete_File (File'Address, Success); if Opt.Verbose_Mode then if Success then Write_Str ("deleted "); else Write_Str ("could not delete "); end if; Write_Line (Filename); end if; end Delete_File; --------- -- Gcc -- --------- procedure Gcc (Output_File : String; Objects : Argument_List; Options : Argument_List; Options_2 : Argument_List; Driver_Name : Name_Id := No_Name) is Arguments : OS_Lib.Argument_List (1 .. 7 + Objects'Length + Options'Length + Options_2'Length); A : Natural := 0; Success : Boolean; Out_Opt : constant OS_Lib.String_Access := new String'("-o"); Out_V : constant OS_Lib.String_Access := new String'(Output_File); Lib_Dir : constant OS_Lib.String_Access := new String'("-L" & Lib_Directory); Lib_Opt : constant OS_Lib.String_Access := new String'(Dynamic_Option); Driver : String_Access; begin Utl.Initialize; if Driver_Name = No_Name then Driver := Gcc_Exec; else Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name)); if Driver = null then Fail (Get_Name_String (Driver_Name), " not found in path"); end if; end if; if Lib_Opt'Length /= 0 then A := A + 1; Arguments (A) := Lib_Opt; end if; A := A + 1; Arguments (A) := Out_Opt; A := A + 1; Arguments (A) := Out_V; A := A + 1; Arguments (A) := Lib_Dir; A := A + Options'Length; Arguments (A - Options'Length + 1 .. A) := Options; A := A + Objects'Length; Arguments (A - Objects'Length + 1 .. A) := Objects; A := A + Options_2'Length; Arguments (A - Options_2'Length + 1 .. A) := Options_2; if not Opt.Quiet_Output then Write_Str (Driver.all); for J in 1 .. A loop Write_Char (' '); Write_Str (Arguments (J).all); end loop; Write_Eol; end if; OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success); if not Success then if Driver_Name = No_Name then Fail (Gcc_Name, " execution error"); else Fail (Get_Name_String (Driver_Name), " execution error"); end if; end if; end Gcc; ---------------- -- Initialize -- ---------------- procedure Initialize is begin if not Initialized then Initialized := True; -- gcc Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name); if Gcc_Exec = null then Fail (Gcc_Name, " not found in path"); elsif Opt.Verbose_Mode then Write_Str ("found "); Write_Line (Gcc_Exec.all); end if; -- ar Ar_Name := Osint.Program_Name (Archive_Builder); Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all); if Ar_Exec = null then Fail (Ar_Name.all, " not found in path"); elsif Opt.Verbose_Mode then Write_Str ("found "); Write_Line (Ar_Exec.all); end if; Ar_Options := Archive_Builder_Options; -- ranlib Ranlib_Name := Osint.Program_Name (Archive_Indexer); if Ranlib_Name'Length > 0 then Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all); if Ranlib_Exec /= null and then Opt.Verbose_Mode then Write_Str ("found "); Write_Line (Ranlib_Exec.all); end if; end if; Ranlib_Options := Archive_Indexer_Options; end if; end Initialize; ------------------- -- Lib_Directory -- ------------------- function Lib_Directory return String is Libgnat : constant String := Tgt.Libgnat; begin Name_Len := Libgnat'Length; Name_Buffer (1 .. Name_Len) := Libgnat; Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library)); -- Remove libgnat.a return Name_Buffer (1 .. Name_Len - Libgnat'Length); end Lib_Directory; end MLib.Utl;