with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C.Strings;
with Hostparm;
with Opt;
with Output; use Output;
with Namet; use Namet;
with MLib.Utl; use MLib.Utl;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body MLib is
procedure Build_Library
(Ofiles : Argument_List;
Afiles : Argument_List;
Output_File : String;
Output_Dir : String)
is
pragma Warnings (Off, Afiles);
use GNAT.OS_Lib;
begin
if not Opt.Quiet_Output then
Write_Line ("building a library...");
Write_Str (" make ");
Write_Line (Output_File);
end if;
Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
end Build_Library;
procedure Check_Library_Name (Name : String) is
begin
if Name'Length = 0 then
Fail ("library name cannot be empty");
end if;
if Name'Length > Max_Characters_In_Library_Name then
Fail ("illegal library name """, Name, """: too long");
end if;
if not Is_Letter (Name (Name'First)) then
Fail ("illegal library name """,
Name,
""": should start with a letter");
end if;
for Index in Name'Range loop
if not Is_Alphanumeric (Name (Index)) then
Fail ("illegal library name """,
Name,
""": should include only letters and digits");
end if;
end loop;
end Check_Library_Name;
procedure Copy_ALI_Files
(Files : Argument_List;
To : Name_Id;
Interfaces : String_List)
is
Success : Boolean := False;
To_Dir : constant String := Get_Name_String (To);
Is_Interface : Boolean := False;
procedure Verbose_Copy (Index : Positive);
procedure Verbose_Copy (Index : Positive) is
begin
if Opt.Verbose_Mode then
Write_Str ("Copying """);
Write_Str (Files (Index).all);
Write_Str (""" to """);
Write_Str (To_Dir);
Write_Line ("""");
end if;
end Verbose_Copy;
begin
if Interfaces'Length = 0 then
for Index in Files'Range loop
Verbose_Copy (Index);
Copy_File
(Files (Index).all,
To_Dir,
Success,
Mode => Overwrite,
Preserve => Preserve);
exit when not Success;
end loop;
else
for Index in Files'Range loop
declare
File_Name : String := Base_Name (Files (Index).all);
begin
Canonical_Case_File_Name (File_Name);
Is_Interface := False;
for Index in Interfaces'Range loop
if File_Name = Interfaces (Index).all then
Is_Interface := True;
exit;
end if;
end loop;
if Is_Interface then
Success := False;
Verbose_Copy (Index);
declare
FD : File_Descriptor;
Len : Integer;
Actual_Len : Integer;
S : String_Access;
Curr : Natural;
P_Line_Found : Boolean;
Status : Boolean;
begin
Name_Len := Files (Index)'Length;
Name_Buffer (1 .. Name_Len) := Files (Index).all;
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.NUL;
FD := Open_Read (Name_Buffer'Address, Binary);
if FD /= Invalid_FD then
Len := Integer (File_Length (FD));
S := new String (1 .. Len + 3);
Curr := 1;
Actual_Len := Len;
while Actual_Len /= 0 loop
Actual_Len := Read (FD, S (Curr)'Address, Len);
Curr := Curr + Actual_Len;
end loop;
Close (FD, Status);
P_Line_Found := False;
for Index in 1 .. Len - 3 loop
if (S (Index) = ASCII.LF or else
S (Index) = ASCII.CR)
and then
S (Index + 1) = 'P'
then
S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
S (Index + 2 .. Index + 4) := " SL";
P_Line_Found := True;
exit;
end if;
end loop;
if P_Line_Found then
Name_Len := To_Dir'Length;
Name_Buffer (1 .. Name_Len) := To_Dir;
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator;
Name_Buffer
(Name_Len + 1 .. Name_Len + File_Name'Length) :=
File_Name;
Name_Len := Name_Len + File_Name'Length + 1;
Name_Buffer (Name_Len) := ASCII.NUL;
FD := Create_File (Name_Buffer'Address, Binary);
if FD /= Invalid_FD then
Actual_Len := Write (FD, S (1)'Address, Len + 3);
Close (FD, Status);
Success := Status and Actual_Len = Len + 3;
if Success then
Set_Read_Only (
Name_Buffer (1 .. Name_Len - 1));
end if;
end if;
end if;
end if;
end;
else
Success := True;
end if;
end;
if not Success then
Fail ("could not copy ALI files to library dir");
end if;
end loop;
end if;
end Copy_ALI_Files;
function Linker_Library_Path_Option return String_Access is
Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
begin
if S'Length = 0 then
return null;
else
return new String'(S);
end if;
end Linker_Library_Path_Option;
begin
if Hostparm.OpenVMS then
Preserve := None;
end if;
end MLib;