with Ada.Text_IO;
with GNAT.Directory_Operations;
with MDLL.Utl;
with MDLL.Fil;
package body MDLL is
use Ada;
use GNAT;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Bargs_Options : Argument_List;
Largs_Options : Argument_List;
Lib_Filename : String;
Def_Filename : String;
Lib_Address : String := "";
Build_Import : Boolean := False;
Relocatable : Boolean := False;
Map_File : Boolean := False)
is
use type OS_Lib.Argument_List;
Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
Def_File : aliased constant String := Def_Filename;
Jnk_File : aliased String := Base_Filename & ".jnk";
Bas_File : aliased constant String := Base_Filename & ".base";
Dll_File : aliased String := Base_Filename & ".dll";
Exp_File : aliased String := Base_Filename & ".exp";
Lib_File : aliased constant String := "lib" & Base_Filename & ".a";
Bas_Opt : aliased String := "-Wl,--base-file," & Bas_File;
Lib_Opt : aliased String := "-mdll";
Out_Opt : aliased String := "-o";
Adr_Opt : aliased String := "-Wl,--image-base=" & Lib_Address;
Map_Opt : aliased String := "-Wl,-Map," & Lib_Filename & ".map";
L_Afiles : Argument_List := Afiles;
All_Options : constant Argument_List := Options & Largs_Options;
procedure Build_Reloc_DLL;
procedure Ada_Build_Reloc_DLL;
procedure Build_Non_Reloc_DLL;
procedure Ada_Build_Non_Reloc_DLL;
procedure Build_Reloc_DLL is
Objects_Exp_File : constant OS_Lib.Argument_List
:= Exp_File'Unchecked_Access & Ofiles;
Success : Boolean;
begin
if not Quiet then
Text_IO.Put_Line ("building relocatable DLL...");
Text_IO.Put ("make " & Dll_File);
if Build_Import then
Text_IO.Put_Line (" and " & Lib_File);
else
Text_IO.New_Line;
end if;
end if;
Utl.Gcc (Output_File => Jnk_File,
Files => Ofiles,
Options => All_Options,
Base_File => Bas_File,
Build_Lib => True);
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => False);
Utl.Gcc (Output_File => Jnk_File,
Files => Objects_Exp_File,
Options => All_Options,
Base_File => Bas_File,
Build_Lib => True);
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => Build_Import);
declare
Params : OS_Lib.Argument_List :=
Adr_Opt'Unchecked_Access & All_Options;
begin
if Map_File then
Params := Map_Opt'Unchecked_Access & Params;
end if;
Utl.Gcc
(Output_File => Dll_File,
Files => Objects_Exp_File,
Options => Params,
Build_Lib => True);
end;
OS_Lib.Delete_File (Exp_File, Success);
OS_Lib.Delete_File (Bas_File, Success);
OS_Lib.Delete_File (Jnk_File, Success);
exception
when others =>
OS_Lib.Delete_File (Exp_File, Success);
OS_Lib.Delete_File (Bas_File, Success);
OS_Lib.Delete_File (Jnk_File, Success);
raise;
end Build_Reloc_DLL;
procedure Ada_Build_Reloc_DLL is
Success : Boolean;
begin
if not Quiet then
Text_IO.Put_Line ("Building relocatable DLL...");
Text_IO.Put ("make " & Dll_File);
if Build_Import then
Text_IO.Put_Line (" and " & Lib_File);
else
Text_IO.New_Line;
end if;
end if;
Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
Params : constant OS_Lib.Argument_List :=
Out_Opt'Unchecked_Access &
Jnk_File'Unchecked_Access &
Lib_Opt'Unchecked_Access &
Bas_Opt'Unchecked_Access &
Ofiles &
All_Options;
begin
Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => False);
Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
Params : constant OS_Lib.Argument_List :=
Out_Opt'Unchecked_Access &
Jnk_File'Unchecked_Access &
Lib_Opt'Unchecked_Access &
Bas_Opt'Unchecked_Access &
Exp_File'Unchecked_Access &
Ofiles &
All_Options;
begin
Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => Build_Import);
Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
Params : OS_Lib.Argument_List :=
Out_Opt'Unchecked_Access &
Dll_File'Unchecked_Access &
Lib_Opt'Unchecked_Access &
Exp_File'Unchecked_Access &
Adr_Opt'Unchecked_Access &
Ofiles &
All_Options;
begin
if Map_File then
Params := Map_Opt'Unchecked_Access & Params;
end if;
Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
OS_Lib.Delete_File (Exp_File, Success);
OS_Lib.Delete_File (Bas_File, Success);
OS_Lib.Delete_File (Jnk_File, Success);
exception
when others =>
OS_Lib.Delete_File (Exp_File, Success);
OS_Lib.Delete_File (Bas_File, Success);
OS_Lib.Delete_File (Jnk_File, Success);
raise;
end Ada_Build_Reloc_DLL;
procedure Build_Non_Reloc_DLL is
Success : Boolean;
begin
if not Quiet then
Text_IO.Put_Line ("building non relocatable DLL...");
Text_IO.Put ("make " & Dll_File &
" using address " & Lib_Address);
if Build_Import then
Text_IO.Put_Line (" and " & Lib_File);
else
Text_IO.New_Line;
end if;
end if;
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Exp_Table => Exp_File,
Build_Import => Build_Import);
declare
Params : OS_Lib.Argument_List :=
Adr_Opt'Unchecked_Access & All_Options;
begin
if Map_File then
Params := Map_Opt'Unchecked_Access & Params;
end if;
Utl.Gcc (Output_File => Dll_File,
Files => Exp_File'Unchecked_Access & Ofiles,
Options => Params,
Build_Lib => True);
end;
OS_Lib.Delete_File (Exp_File, Success);
exception
when others =>
OS_Lib.Delete_File (Exp_File, Success);
raise;
end Build_Non_Reloc_DLL;
procedure Ada_Build_Non_Reloc_DLL is
Success : Boolean;
begin
if not Quiet then
Text_IO.Put_Line ("building non relocatable DLL...");
Text_IO.Put ("make " & Dll_File &
" using address " & Lib_Address);
if Build_Import then
Text_IO.Put_Line (" and " & Lib_File);
else
Text_IO.New_Line;
end if;
end if;
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Exp_Table => Exp_File,
Build_Import => Build_Import);
Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
Params : OS_Lib.Argument_List :=
Out_Opt'Unchecked_Access &
Dll_File'Unchecked_Access &
Lib_Opt'Unchecked_Access &
Exp_File'Unchecked_Access &
Adr_Opt'Unchecked_Access &
Ofiles &
All_Options;
begin
if Map_File then
Params := Map_Opt'Unchecked_Access & Params;
end if;
Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
OS_Lib.Delete_File (Exp_File, Success);
exception
when others =>
OS_Lib.Delete_File (Exp_File, Success);
raise;
end Ada_Build_Non_Reloc_DLL;
begin
if L_Afiles'Length > 1 then
declare
Filename : constant String :=
Directory_Operations.Base_Name (L_Afiles (1).all);
First : constant Positive := Filename'First;
begin
if Filename (First .. First + 1) = "b~" then
L_Afiles (L_Afiles'Last) := Afiles (1);
L_Afiles (1) := Afiles (Afiles'Last);
end if;
end;
end if;
case Relocatable is
when True =>
if L_Afiles'Length = 0 then
Build_Reloc_DLL;
else
Ada_Build_Reloc_DLL;
end if;
when False =>
if L_Afiles'Length = 0 then
Build_Non_Reloc_DLL;
else
Ada_Build_Non_Reloc_DLL;
end if;
end case;
end Build_Dynamic_Library;
procedure Build_Import_Library
(Lib_Filename : String;
Def_Filename : String)
is
procedure Build_Import_Library (Def_Base_Filename : String);
Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
procedure Build_Import_Library (Def_Base_Filename : String) is
Def_File : String renames Def_Filename;
Dll_File : constant String := Def_Base_Filename & ".dll";
Lib_File : constant String := "lib" & Base_Filename & ".a";
begin
if not Quiet then
Text_IO.Put_Line ("Building import library...");
Text_IO.Put_Line ("make " & Lib_File &
" to use dynamic library " & Dll_File);
end if;
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Build_Import => True);
end Build_Import_Library;
begin
if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
Build_Import_Library (Base_Filename (4 .. Base_Filename'Last));
else
Build_Import_Library (Base_Filename);
end if;
end Build_Import_Library;
end MDLL;