634 lines
20 KiB
Ada
634 lines
20 KiB
Ada
|
------------------------------------------------------------------------------
|
||
|
-- --
|
||
|
-- GNAT COMPILER COMPONENTS --
|
||
|
-- --
|
||
|
-- M L I B . U T L --
|
||
|
-- --
|
||
|
-- B o d y --
|
||
|
-- --
|
||
|
-- Copyright (C) 2002-2008, 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 3, 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 COPYING3. If not, go to --
|
||
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
||
|
-- --
|
||
|
-- 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 Opt;
|
||
|
with Osint;
|
||
|
with Output; use Output;
|
||
|
|
||
|
with Interfaces.C.Strings; use Interfaces.C.Strings;
|
||
|
|
||
|
with System;
|
||
|
|
||
|
package body MLib.Utl is
|
||
|
|
||
|
Adalib_Path : String_Access := null;
|
||
|
-- Path of the GNAT adalib directory, specified in procedure
|
||
|
-- Specify_Adalib_Dir. Used in function Lib_Directory.
|
||
|
|
||
|
Gcc_Name : String_Access;
|
||
|
-- Default value of the "gcc" executable used in procedure Gcc
|
||
|
|
||
|
Gcc_Exec : String_Access;
|
||
|
-- The full path name of the "gcc" executable
|
||
|
|
||
|
Ar_Name : String_Access;
|
||
|
-- The name of the archive builder for the platform, set when procedure Ar
|
||
|
-- is called for the first time.
|
||
|
|
||
|
Ar_Exec : String_Access;
|
||
|
-- The full path name of the archive builder
|
||
|
|
||
|
Ar_Options : String_List_Access;
|
||
|
-- The minimum options used when invoking the archive builder
|
||
|
|
||
|
Ar_Append_Options : String_List_Access;
|
||
|
-- The options to be used when invoking the archive builder to add chunks
|
||
|
-- of object files, when building the archive in chunks.
|
||
|
|
||
|
Opt_Length : Natural := 0;
|
||
|
-- The max number of options for the Archive_Builder
|
||
|
|
||
|
Initial_Size : Natural := 0;
|
||
|
-- The minimum number of bytes for the invocation of the Archive Builder
|
||
|
-- (without name of the archive or object files).
|
||
|
|
||
|
Ranlib_Name : String_Access;
|
||
|
-- The name of the archive indexer for the platform, if there is one
|
||
|
|
||
|
Ranlib_Exec : String_Access := null;
|
||
|
-- The full path name of the archive indexer
|
||
|
|
||
|
Ranlib_Options : String_List_Access := null;
|
||
|
-- The options to be used when invoking the archive indexer, if any
|
||
|
|
||
|
--------
|
||
|
-- Ar --
|
||
|
--------
|
||
|
|
||
|
procedure Ar (Output_File : String; Objects : Argument_List) is
|
||
|
Full_Output_File : constant String :=
|
||
|
Ext_To (Output_File, Archive_Ext);
|
||
|
|
||
|
Arguments : Argument_List_Access;
|
||
|
Last_Arg : Natural := 0;
|
||
|
Success : Boolean;
|
||
|
Line_Length : Natural := 0;
|
||
|
|
||
|
Maximum_Size : Integer;
|
||
|
pragma Import (C, Maximum_Size, "__gnat_link_max");
|
||
|
-- Maximum number of bytes to put in an invocation of the
|
||
|
-- Archive_Builder.
|
||
|
|
||
|
Size : Integer;
|
||
|
-- The number of bytes for the invocation of the archive builder
|
||
|
|
||
|
Current_Object : Natural;
|
||
|
|
||
|
procedure Display;
|
||
|
-- Display an invocation of the Archive Builder
|
||
|
|
||
|
-------------
|
||
|
-- Display --
|
||
|
-------------
|
||
|
|
||
|
procedure Display is
|
||
|
begin
|
||
|
if not Opt.Quiet_Output then
|
||
|
Write_Str (Ar_Name.all);
|
||
|
Line_Length := Ar_Name'Length;
|
||
|
|
||
|
for J in 1 .. Last_Arg 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 (' ');
|
||
|
|
||
|
-- Only output the first object files when not in verbose mode
|
||
|
|
||
|
if (not Opt.Verbose_Mode) and then J = Opt_Length + 3 then
|
||
|
Write_Str ("...");
|
||
|
exit;
|
||
|
end if;
|
||
|
|
||
|
Write_Str (Arguments (J).all);
|
||
|
Line_Length := Line_Length + 1 + Arguments (J)'Length;
|
||
|
end loop;
|
||
|
|
||
|
Write_Eol;
|
||
|
end if;
|
||
|
|
||
|
end Display;
|
||
|
|
||
|
begin
|
||
|
if Ar_Exec = null then
|
||
|
Ar_Name := Osint.Program_Name (Archive_Builder, "gnatmake");
|
||
|
Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
|
||
|
|
||
|
if Ar_Exec = null then
|
||
|
Free (Ar_Name);
|
||
|
Ar_Name := new String'(Archive_Builder);
|
||
|
Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
|
||
|
end if;
|
||
|
|
||
|
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;
|
||
|
|
||
|
Initial_Size := 0;
|
||
|
for J in Ar_Options'Range loop
|
||
|
Initial_Size := Initial_Size + Ar_Options (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
Ar_Append_Options := Archive_Builder_Append_Options;
|
||
|
|
||
|
Opt_Length := Ar_Options'Length;
|
||
|
|
||
|
if Ar_Append_Options /= null then
|
||
|
Opt_Length := Natural'Max (Ar_Append_Options'Length, Opt_Length);
|
||
|
|
||
|
Size := 0;
|
||
|
for J in Ar_Append_Options'Range loop
|
||
|
Size := Size + Ar_Append_Options (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
Initial_Size := Integer'Max (Initial_Size, Size);
|
||
|
end if;
|
||
|
|
||
|
-- ranlib
|
||
|
|
||
|
Ranlib_Name := Osint.Program_Name (Archive_Indexer, "gnatmake");
|
||
|
|
||
|
if Ranlib_Name'Length > 0 then
|
||
|
Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
|
||
|
|
||
|
if Ranlib_Exec = null then
|
||
|
Free (Ranlib_Name);
|
||
|
Ranlib_Name := new String'(Archive_Indexer);
|
||
|
Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
|
||
|
end if;
|
||
|
|
||
|
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;
|
||
|
|
||
|
Arguments :=
|
||
|
new String_List (1 .. 1 + Opt_Length + Objects'Length);
|
||
|
Arguments (1 .. Ar_Options'Length) := Ar_Options.all; -- "ar cr ..."
|
||
|
Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
|
||
|
|
||
|
Delete_File (Full_Output_File);
|
||
|
|
||
|
Size := Initial_Size + Full_Output_File'Length + 1;
|
||
|
|
||
|
-- Check the full size of a call of the archive builder with all the
|
||
|
-- object files.
|
||
|
|
||
|
for J in Objects'Range loop
|
||
|
Size := Size + Objects (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
-- If the size is not too large or if it is not possible to build the
|
||
|
-- archive in chunks, build the archive in a single invocation.
|
||
|
|
||
|
if Size <= Maximum_Size or else Ar_Append_Options = null then
|
||
|
Last_Arg := Ar_Options'Length + 1 + Objects'Length;
|
||
|
Arguments (Ar_Options'Length + 2 .. Last_Arg) := Objects;
|
||
|
|
||
|
Display;
|
||
|
|
||
|
Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
|
||
|
|
||
|
else
|
||
|
-- Build the archive in several invocation, making sure to not
|
||
|
-- go over the maximum size for each invocation.
|
||
|
|
||
|
Last_Arg := Ar_Options'Length + 1;
|
||
|
Current_Object := Objects'First;
|
||
|
Size := Initial_Size + Full_Output_File'Length + 1;
|
||
|
|
||
|
-- First invocation
|
||
|
|
||
|
while Current_Object <= Objects'Last loop
|
||
|
Size := Size + Objects (Current_Object)'Length + 1;
|
||
|
exit when Size > Maximum_Size;
|
||
|
Last_Arg := Last_Arg + 1;
|
||
|
Arguments (Last_Arg) := Objects (Current_Object);
|
||
|
Current_Object := Current_Object + 1;
|
||
|
end loop;
|
||
|
|
||
|
Display;
|
||
|
|
||
|
Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
|
||
|
|
||
|
Arguments (1 .. Ar_Append_Options'Length) := Ar_Append_Options.all;
|
||
|
Arguments
|
||
|
(Ar_Append_Options'Length + 1) := new String'(Full_Output_File);
|
||
|
|
||
|
-- Appending invocation(s)
|
||
|
|
||
|
Big_Loop : while Success and then Current_Object <= Objects'Last loop
|
||
|
Last_Arg := Ar_Append_Options'Length + 1;
|
||
|
Size := Initial_Size + Full_Output_File'Length + 1;
|
||
|
|
||
|
Inner_Loop : while Current_Object <= Objects'Last loop
|
||
|
Size := Size + Objects (Current_Object)'Length + 1;
|
||
|
exit Inner_Loop when Size > Maximum_Size;
|
||
|
Last_Arg := Last_Arg + 1;
|
||
|
Arguments (Last_Arg) := Objects (Current_Object);
|
||
|
Current_Object := Current_Object + 1;
|
||
|
end loop Inner_Loop;
|
||
|
|
||
|
Display;
|
||
|
|
||
|
Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
|
||
|
end loop Big_Loop;
|
||
|
end if;
|
||
|
|
||
|
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;
|
||
|
|
||
|
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
|
||
|
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
|
||
|
Link_Bytes : Integer := 0;
|
||
|
-- Projected number of bytes for the linker command line
|
||
|
|
||
|
Link_Max : Integer;
|
||
|
pragma Import (C, Link_Max, "__gnat_link_max");
|
||
|
-- Maximum number of bytes on the command line supported by the OS
|
||
|
-- linker. Passed this limit the response file mechanism must be used
|
||
|
-- if supported.
|
||
|
|
||
|
Object_List_File_Supported : Boolean;
|
||
|
for Object_List_File_Supported'Size use Character'Size;
|
||
|
pragma Import
|
||
|
(C, Object_List_File_Supported, "__gnat_objlist_file_supported");
|
||
|
-- Predicate indicating whether the linker has an option whereby the
|
||
|
-- names of object files can be passed to the linker in a file.
|
||
|
|
||
|
Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr;
|
||
|
pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option");
|
||
|
-- Pointer to a string representing the linker option which specifies
|
||
|
-- the response file.
|
||
|
|
||
|
Using_GNU_Linker : Boolean;
|
||
|
for Using_GNU_Linker'Size use Character'Size;
|
||
|
pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker");
|
||
|
-- Predicate indicating whether this target uses the GNU linker. In
|
||
|
-- this case we must output a GNU linker compatible response file.
|
||
|
|
||
|
Opening : aliased constant String := """";
|
||
|
Closing : aliased constant String := '"' & ASCII.LF;
|
||
|
-- Needed to quote object paths in object list files when GNU linker
|
||
|
-- is used.
|
||
|
|
||
|
Tname : String_Access;
|
||
|
Tname_FD : File_Descriptor := Invalid_FD;
|
||
|
-- Temporary file used by linker to pass list of object files on
|
||
|
-- certain systems with limitations on size of arguments.
|
||
|
|
||
|
Closing_Status : Boolean;
|
||
|
-- For call to Close
|
||
|
|
||
|
Arguments :
|
||
|
Argument_List
|
||
|
(1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
|
||
|
|
||
|
A : Natural := 0;
|
||
|
Success : Boolean;
|
||
|
|
||
|
Out_Opt : constant String_Access := new String'("-o");
|
||
|
Out_V : constant String_Access := new String'(Output_File);
|
||
|
Lib_Dir : constant String_Access := new String'("-L" & Lib_Directory);
|
||
|
Lib_Opt : constant String_Access := new String'(Dynamic_Option);
|
||
|
|
||
|
Driver : String_Access;
|
||
|
|
||
|
type Object_Position is (First, Second, Last);
|
||
|
|
||
|
Position : Object_Position;
|
||
|
|
||
|
procedure Write_RF (A : System.Address; N : Integer);
|
||
|
-- Write a string to the response file and check if it was successful.
|
||
|
-- Fail the program if it was not successful (disk full).
|
||
|
|
||
|
--------------
|
||
|
-- Write_RF --
|
||
|
--------------
|
||
|
|
||
|
procedure Write_RF (A : System.Address; N : Integer) is
|
||
|
Status : Integer;
|
||
|
begin
|
||
|
Status := Write (Tname_FD, A, N);
|
||
|
|
||
|
if Status /= N then
|
||
|
Fail ("cannot generate response file to link library: disk full");
|
||
|
end if;
|
||
|
end Write_RF;
|
||
|
|
||
|
begin
|
||
|
if Driver_Name = No_Name then
|
||
|
if Gcc_Exec = null then
|
||
|
if Gcc_Name = null then
|
||
|
Gcc_Name := Osint.Program_Name ("gcc", "gnatmake");
|
||
|
end if;
|
||
|
|
||
|
Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all);
|
||
|
|
||
|
if Gcc_Exec = null then
|
||
|
Fail (Gcc_Name.all & " not found in path");
|
||
|
end if;
|
||
|
end if;
|
||
|
|
||
|
Driver := Gcc_Exec;
|
||
|
|
||
|
else
|
||
|
Driver := 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;
|
||
|
|
||
|
Link_Bytes := 0;
|
||
|
|
||
|
if Lib_Opt'Length /= 0 then
|
||
|
A := A + 1;
|
||
|
Arguments (A) := Lib_Opt;
|
||
|
Link_Bytes := Link_Bytes + Lib_Opt'Length + 1;
|
||
|
end if;
|
||
|
|
||
|
A := A + 1;
|
||
|
Arguments (A) := Out_Opt;
|
||
|
Link_Bytes := Link_Bytes + Out_Opt'Length + 1;
|
||
|
|
||
|
A := A + 1;
|
||
|
Arguments (A) := Out_V;
|
||
|
Link_Bytes := Link_Bytes + Out_V'Length + 1;
|
||
|
|
||
|
A := A + 1;
|
||
|
Arguments (A) := Lib_Dir;
|
||
|
Link_Bytes := Link_Bytes + Lib_Dir'Length + 1;
|
||
|
|
||
|
A := A + Options'Length;
|
||
|
Arguments (A - Options'Length + 1 .. A) := Options;
|
||
|
|
||
|
for J in Options'Range loop
|
||
|
Link_Bytes := Link_Bytes + Options (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
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;
|
||
|
|
||
|
-- Do not display all the object files if not in verbose mode, only
|
||
|
-- the first one.
|
||
|
|
||
|
Position := First;
|
||
|
for J in Objects'Range loop
|
||
|
if Opt.Verbose_Mode or else Position = First then
|
||
|
Write_Char (' ');
|
||
|
Write_Str (Objects (J).all);
|
||
|
Position := Second;
|
||
|
|
||
|
elsif Position = Second then
|
||
|
Write_Str (" ...");
|
||
|
Position := Last;
|
||
|
end if;
|
||
|
end loop;
|
||
|
|
||
|
for J in Options_2'Range loop
|
||
|
Write_Char (' ');
|
||
|
Write_Str (Options_2 (J).all);
|
||
|
end loop;
|
||
|
|
||
|
Write_Eol;
|
||
|
end if;
|
||
|
|
||
|
for J in Objects'Range loop
|
||
|
Link_Bytes := Link_Bytes + Objects (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
for J in Options_2'Range loop
|
||
|
Link_Bytes := Link_Bytes + Options_2 (J)'Length + 1;
|
||
|
end loop;
|
||
|
|
||
|
if Object_List_File_Supported and then Link_Bytes > Link_Max then
|
||
|
-- Create a temporary file containing the object files, one object
|
||
|
-- file per line for maximal compatibility with linkers supporting
|
||
|
-- this option.
|
||
|
|
||
|
Create_Temp_File (Tname_FD, Tname);
|
||
|
|
||
|
-- If target is using the GNU linker we must add a special header
|
||
|
-- and footer in the response file.
|
||
|
|
||
|
-- The syntax is : INPUT (object1.o object2.o ... )
|
||
|
|
||
|
-- Because the GNU linker does not like name with characters such
|
||
|
-- as '!', we must put the object paths between double quotes.
|
||
|
|
||
|
if Using_GNU_Linker then
|
||
|
declare
|
||
|
GNU_Header : aliased constant String := "INPUT (";
|
||
|
|
||
|
begin
|
||
|
Write_RF (GNU_Header'Address, GNU_Header'Length);
|
||
|
end;
|
||
|
end if;
|
||
|
|
||
|
for J in Objects'Range loop
|
||
|
-- Opening quote for GNU linker
|
||
|
|
||
|
if Using_GNU_Linker then
|
||
|
Write_RF (Opening'Address, 1);
|
||
|
end if;
|
||
|
|
||
|
Write_RF
|
||
|
(Objects (J).all'Address, Objects (J).all'Length);
|
||
|
|
||
|
-- Closing quote for GNU linker
|
||
|
|
||
|
if Using_GNU_Linker then
|
||
|
Write_RF (Closing'Address, 2);
|
||
|
|
||
|
else
|
||
|
Write_RF (ASCII.LF'Address, 1);
|
||
|
end if;
|
||
|
end loop;
|
||
|
|
||
|
-- Handle GNU linker response file footer
|
||
|
|
||
|
if Using_GNU_Linker then
|
||
|
declare
|
||
|
GNU_Footer : aliased constant String := ")";
|
||
|
|
||
|
begin
|
||
|
Write_RF (GNU_Footer'Address, GNU_Footer'Length);
|
||
|
end;
|
||
|
end if;
|
||
|
|
||
|
Close (Tname_FD, Closing_Status);
|
||
|
|
||
|
if not Closing_Status then
|
||
|
Fail ("cannot generate response file to link library: disk full");
|
||
|
end if;
|
||
|
|
||
|
A := A + 1;
|
||
|
Arguments (A) :=
|
||
|
new String'(Value (Object_File_Option_Ptr) & Tname.all);
|
||
|
|
||
|
else
|
||
|
A := A + Objects'Length;
|
||
|
Arguments (A - Objects'Length + 1 .. A) := Objects;
|
||
|
end if;
|
||
|
|
||
|
A := A + Options_2'Length;
|
||
|
Arguments (A - Options_2'Length + 1 .. A) := Options_2;
|
||
|
|
||
|
Spawn (Driver.all, Arguments (1 .. A), Success);
|
||
|
|
||
|
if Tname /= null then
|
||
|
Delete_File (Tname.all, Closing_Status);
|
||
|
|
||
|
if not Closing_Status then
|
||
|
Write_Str ("warning: could not delete response file """);
|
||
|
Write_Str (Tname.all);
|
||
|
Write_Line (""" to link library");
|
||
|
end if;
|
||
|
end if;
|
||
|
|
||
|
if not Success then
|
||
|
if Driver_Name = No_Name then
|
||
|
Fail (Gcc_Name.all & " execution error");
|
||
|
else
|
||
|
Fail (Get_Name_String (Driver_Name) & " execution error");
|
||
|
end if;
|
||
|
end if;
|
||
|
end Gcc;
|
||
|
|
||
|
-------------------
|
||
|
-- Lib_Directory --
|
||
|
-------------------
|
||
|
|
||
|
function Lib_Directory return String is
|
||
|
Libgnat : constant String := Tgt.Libgnat;
|
||
|
|
||
|
begin
|
||
|
-- If procedure Specify_Adalib_Dir has been called, used the specified
|
||
|
-- value.
|
||
|
|
||
|
if Adalib_Path /= null then
|
||
|
return Adalib_Path.all;
|
||
|
end if;
|
||
|
|
||
|
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;
|
||
|
|
||
|
------------------------
|
||
|
-- Specify_Adalib_Dir --
|
||
|
------------------------
|
||
|
|
||
|
procedure Specify_Adalib_Dir (Path : String) is
|
||
|
begin
|
||
|
if Path'Length = 0 then
|
||
|
Adalib_Path := null;
|
||
|
else
|
||
|
Adalib_Path := new String'(Path);
|
||
|
end if;
|
||
|
end Specify_Adalib_Dir;
|
||
|
|
||
|
end MLib.Utl;
|