blob: 5b4f1f0fe4626fca57b97f743e90aea9e026ca00 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . U T L --
-- --
-- B o d y --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 2001, Ada Core Technologies, 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 MLib.Fil;
with MLib.Tgt;
with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
package body MLib.Utl is
use GNAT;
package Files renames MLib.Fil;
package Target renames MLib.Tgt;
Initialized : Boolean := False;
Gcc_Name : constant String := "gcc";
Gcc_Exec : OS_Lib.String_Access;
Ar_Name : constant String := "ar";
Ar_Exec : OS_Lib.String_Access;
Ranlib_Name : constant String := "ranlib";
Ranlib_Exec : OS_Lib.String_Access;
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
Create_Add_Opt : OS_Lib.String_Access := new String' ("cr");
Full_Output_File : constant String :=
Files.Ext_To (Output_File, Target.Archive_Ext);
Arguments : OS_Lib.Argument_List (1 .. 2 + Objects'Length);
Success : Boolean;
begin
Initialize;
Arguments (1) := Create_Add_Opt; -- "ar cr ..."
Arguments (2) := new String'(Full_Output_File);
Arguments (3 .. Arguments'Last) := Objects;
Delete_File (Full_Output_File);
if not Opt.Quiet_Output then
Write_Str (Ar_Name);
for J in Arguments'Range loop
Write_Char (' ');
Write_Str (Arguments (J).all);
end loop;
Write_Eol;
end if;
OS_Lib.Spawn (Ar_Exec.all, Arguments, Success);
if not Success then
Fail (Ar_Name, " 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);
Write_Char (' ');
Write_Line (Arguments (2).all);
end if;
OS_Lib.Spawn (Ranlib_Exec.all, (1 => Arguments (2)), Success);
if not Success then
Fail (Ranlib_Name, " execution error.");
end if;
end if;
end Ar;
-----------------
-- Delete_File --
-----------------
procedure Delete_File (Filename : in 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;
Base_File : String := "")
is
Arguments : OS_Lib.Argument_List
(1 .. 7 + Objects'Length + Options'Length);
A : Natural := 0;
Success : Boolean;
Out_Opt : OS_Lib.String_Access := new String' ("-o");
Out_V : OS_Lib.String_Access := new String' (Output_File);
Lib_Dir : OS_Lib.String_Access := new String' ("-L" & Lib_Directory);
Lib_Opt : OS_Lib.String_Access := new String' (Target.Dynamic_Option);
begin
Initialize;
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;
if not Opt.Quiet_Output then
Write_Str (Gcc_Exec.all);
for J in 1 .. A loop
Write_Char (' ');
Write_Str (Arguments (J).all);
end loop;
Write_Eol;
end if;
OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
if not Success then
Fail (Gcc_Name, " execution error");
end if;
end Gcc;
----------------
-- Initialize --
----------------
procedure Initialize is
use type OS_Lib.String_Access;
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_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name);
if Ar_Exec = null then
Fail (Ar_Name, " not found in path");
elsif Opt.Verbose_Mode then
Write_Str ("found ");
Write_Line (Ar_Exec.all);
end if;
-- ranlib
Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name);
if Ranlib_Exec /= null and then Opt.Verbose_Mode then
Write_Str ("found ");
Write_Line (Ranlib_Exec.all);
end if;
end if;
end Initialize;
-------------------
-- Lib_Directory --
-------------------
function Lib_Directory return String is
Libgnat : constant String := Target.Libgnat;
begin
Name_Len := Libgnat'Length;
Name_Buffer (1 .. Name_Len) := Libgnat;
Get_Name_String (Find_File (Name_Enter, Library));
-- Remove libgnat.a
return Name_Buffer (1 .. Name_Len - Libgnat'Length);
end Lib_Directory;
end MLib.Utl;