-- --
-- B o d y --
-- --
--- $Revision$
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, Free Software Foundation, 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- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides the core high level routines used by GNATDLL
--- to build Windows DLL
+-- to build Windows DLL.
with Ada.Text_IO;
+with GNAT.Directory_Operations;
with MDLL.Utl;
with MDLL.Fil;
use Ada;
use GNAT;
+ -- Convention used for the library names on Windows:
+ -- DLL: <name>.dll
+ -- Import library: lib<name>.dll
+
+ function Get_Dll_Name (Lib_Filename : String) return String;
+ -- Returns <Lib_Filename> if it contains a file extension otherwise it
+ -- returns <Lib_Filename>.dll.
+
---------------------------
-- Build_Dynamic_Library --
---------------------------
Def_Filename : String;
Lib_Address : String := "";
Build_Import : Boolean := False;
- Relocatable : 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 String := Def_Filename;
- Jnk_File : aliased String := Base_Filename & ".jnk";
- Bas_File : aliased String := Base_Filename & ".base";
- Dll_File : aliased String := Base_Filename & ".dll";
- Exp_File : aliased String := Base_Filename & ".exp";
- Lib_File : aliased String := "lib" & Base_Filename & ".a";
+ 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 := Get_Dll_Name (Lib_Filename);
+ Exp_File : aliased String := Base_Filename & ".exp";
+ Lib_File : aliased constant String := "lib" & Base_Filename & ".dll.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;
+ -- Local afiles list. This list can be reordered to ensure that the
+ -- binder ALI file is not the first entry in this list.
All_Options : constant Argument_List := Options & Largs_Options;
procedure Build_Reloc_DLL;
- -- Build a relocatable DLL with only objects file specified.
- -- this use the well known 5 steps build. (see GNAT User's Guide).
+ -- Build a relocatable DLL with only objects file specified. This uses
+ -- the well known five step build (see GNAT User's Guide).
procedure Ada_Build_Reloc_DLL;
- -- Build a relocatable DLL with Ada code.
- -- this use the well known 5 steps build. (see GNAT User's Guide).
+ -- Build a relocatable DLL with Ada code. This uses the well known five
+ -- step build (see GNAT User's Guide).
procedure Build_Non_Reloc_DLL;
- -- Build a non relocatable DLL containing no Ada code.
+ -- Build a non relocatable DLL containing no Ada code
procedure Ada_Build_Non_Reloc_DLL;
- -- Build a non relocatable DLL with Ada code.
+ -- Build a non relocatable DLL with Ada code
---------------------
-- Build_Reloc_DLL --
---------------------
procedure Build_Reloc_DLL is
- -- Objects plus the export table (.exp) file
- Objects_Exp_File : constant OS_Lib.Argument_List
- := Exp_File'Unchecked_Access & Ofiles;
+ Objects_Exp_File : constant OS_Lib.Argument_List :=
+ Exp_File'Unchecked_Access & Ofiles;
+ -- Objects plus the export table (.exp) file
Success : Boolean;
+ pragma Warnings (Off, Success);
begin
if not Quiet then
end if;
end if;
- -- 1) Build base file with objects files.
+ -- 1) Build base file with objects files
Utl.Gcc (Output_File => Jnk_File,
Files => Ofiles,
Base_File => Bas_File,
Build_Lib => True);
- -- 2) Build exp from base file.
+ -- 2) Build exp from base file
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => False);
- -- 3) Build base file with exp file and objects files.
+ -- 3) Build base file with exp file and objects files
Utl.Gcc (Output_File => Jnk_File,
Files => Objects_Exp_File,
-- 5) Build the dynamic library
- Utl.Gcc (Output_File => Dll_File,
- Files => Objects_Exp_File,
- Options => Adr_Opt'Unchecked_Access & All_Options,
- Build_Lib => True);
+ declare
+ Params : constant OS_Lib.Argument_List :=
+ Map_Opt'Unchecked_Access &
+ Adr_Opt'Unchecked_Access & All_Options;
+ First_Param : Positive := Params'First + 1;
+
+ begin
+ if Map_File then
+ First_Param := Params'First;
+ end if;
+
+ Utl.Gcc
+ (Output_File => Dll_File,
+ Files => Objects_Exp_File,
+ Options => Params (First_Param .. Params'Last),
+ Build_Lib => True);
+ end;
OS_Lib.Delete_File (Exp_File, Success);
OS_Lib.Delete_File (Bas_File, Success);
procedure Ada_Build_Reloc_DLL is
Success : Boolean;
+ pragma Warnings (Off, Success);
+
begin
if not Quiet then
Text_IO.Put_Line ("Building relocatable DLL...");
end if;
end if;
- -- 1) Build base file with objects files.
+ -- 1) Build base file with objects files
- Utl.Gnatbind (Afiles, Options & Bargs_Options);
+ Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
- Params : OS_Lib.Argument_List :=
- Out_Opt'Unchecked_Access & Jnk_File'Unchecked_Access &
- Lib_Opt'Unchecked_Access &
- Bas_Opt'Unchecked_Access & Ofiles & All_Options;
+ 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 (Afiles (Afiles'Last).all, Params);
+ Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
- -- 2) Build exp from base file.
+ -- 2) Build exp from base file
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Base_File => Bas_File,
Exp_Table => Exp_File,
Build_Import => False);
- -- 3) Build base file with exp file and objects files.
+ -- 3) Build base file with exp file and objects files
- Utl.Gnatbind (Afiles, Options & Bargs_Options);
+ Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
declare
- Params : 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;
+ 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 (Afiles (Afiles'Last).all, Params);
+ Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
end;
-- 4) Build new exp from base file and the lib file (.a)
-- 5) Build the dynamic library
- Utl.Gnatbind (Afiles, Options & Bargs_Options);
+ 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;
+ Params : constant OS_Lib.Argument_List :=
+ Map_Opt'Unchecked_Access &
+ Out_Opt'Unchecked_Access &
+ Dll_File'Unchecked_Access &
+ Lib_Opt'Unchecked_Access &
+ Exp_File'Unchecked_Access &
+ Adr_Opt'Unchecked_Access &
+ Ofiles &
+ All_Options;
+ First_Param : Positive := Params'First + 1;
+
begin
- Utl.Gnatlink (Afiles (Afiles'Last).all, Params);
+ if Map_File then
+ First_Param := Params'First;
+ end if;
+
+ Utl.Gnatlink
+ (L_Afiles (L_Afiles'Last).all,
+ Params (First_Param .. Params'Last));
end;
OS_Lib.Delete_File (Exp_File, Success);
procedure Build_Non_Reloc_DLL is
Success : Boolean;
+ pragma Warnings (Off, Success);
+
begin
if not Quiet then
Text_IO.Put_Line ("building non relocatable DLL...");
end if;
end if;
- -- Build exp table and the lib .a file.
+ -- Build exp table and the lib .a file
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Exp_Table => Exp_File,
-- Build the DLL
- Utl.Gcc (Output_File => Dll_File,
- Files => Exp_File'Unchecked_Access & Ofiles,
- Options => Adr_Opt'Unchecked_Access & All_Options,
- Build_Lib => True);
+ 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);
-- Ada_Build_Non_Reloc_DLL --
-----------------------------
- -- Build a non relocatable DLL with Ada code.
+ -- Build a non relocatable DLL with Ada code
procedure Ada_Build_Non_Reloc_DLL is
Success : Boolean;
+ pragma Warnings (Off, Success);
+
begin
if not Quiet then
Text_IO.Put_Line ("building non relocatable DLL...");
end if;
end if;
- -- Build exp table and the lib .a file.
+ -- Build exp table and the lib .a file
Utl.Dlltool (Def_File, Dll_File, Lib_File,
Exp_Table => Exp_File,
-- Build the DLL
- Utl.Gnatbind (Afiles, Options & Bargs_Options);
+ 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;
+ Out_Opt'Unchecked_Access &
+ Dll_File'Unchecked_Access &
+ Lib_Opt'Unchecked_Access &
+ Exp_File'Unchecked_Access &
+ Adr_Opt'Unchecked_Access &
+ Ofiles &
+ All_Options;
begin
- Utl.Gnatlink (Afiles (Afiles'Last).all, Params);
+ 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);
raise;
end Ada_Build_Non_Reloc_DLL;
+ -- Start of processing for Build_Dynamic_Library
+
begin
- case Relocatable is
+ -- On Windows the binder file must not be in the first position in the
+ -- list. This is due to the way DLL's are built on Windows. We swap the
+ -- first ali with the last one if it is the case.
+
+ if L_Afiles'Length > 1 then
+ declare
+ Filename : constant String :=
+ Directory_Operations.Base_Name
+ (L_Afiles (L_Afiles'First).all);
+ First : constant Positive := Filename'First;
+ begin
+ if Filename (First .. First + 1) = "b~" then
+ L_Afiles (L_Afiles'Last) := Afiles (Afiles'First);
+ L_Afiles (L_Afiles'First) := Afiles (Afiles'Last);
+ end if;
+ end;
+ end if;
+
+ case Relocatable is
when True =>
- if Afiles'Length = 0 then
+ if L_Afiles'Length = 0 then
Build_Reloc_DLL;
else
Ada_Build_Reloc_DLL;
end if;
when False =>
- if Afiles'Length = 0 then
+ if L_Afiles'Length = 0 then
Build_Non_Reloc_DLL;
else
Ada_Build_Non_Reloc_DLL;
end if;
-
end case;
end Build_Dynamic_Library;
(Lib_Filename : String;
Def_Filename : String)
is
-
- procedure Build_Import_Library (Def_Base_Filename : String);
- -- Build an import library.
- -- this is to build only a .a library to link against a DLL.
-
- Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
+ procedure Build_Import_Library (Lib_Filename : String);
+ -- Build an import library. This is to build only a .a library to link
+ -- against a DLL.
--------------------------
-- Build_Import_Library --
--------------------------
- procedure Build_Import_Library (Def_Base_Filename : String) is
+ procedure Build_Import_Library (Lib_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";
+ function No_Lib_Prefix (Filename : String) return String;
+ -- Return Filename without the lib prefix if present
- begin
+ -------------------
+ -- No_Lib_Prefix --
+ -------------------
+
+ function No_Lib_Prefix (Filename : String) return String is
+ begin
+ if Filename (Filename'First .. Filename'First + 2) = "lib" then
+ return Filename (Filename'First + 3 .. Filename'Last);
+ else
+ return Filename;
+ end if;
+ end No_Lib_Prefix;
+
+ -- Local variables
+
+ Def_File : String renames Def_Filename;
+ Dll_File : constant String := Get_Dll_Name (Lib_Filename);
+ Base_Filename : constant String :=
+ MDLL.Fil.Ext_To (No_Lib_Prefix (Lib_Filename));
+ Lib_File : constant String := "lib" & Base_Filename & ".dll.a";
+
+ -- Start of processing for Build_Import_Library
+ 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);
+ 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);
+ Utl.Dlltool
+ (Def_File, Dll_File, Lib_File, Build_Import => True);
end Build_Import_Library;
+ -- Start of processing for Build_Import_Library
+
begin
- -- If the library has the form lib<name>.a then the def file should
- -- be <name>.def and the DLL to link against <name>.dll
- -- this is a Windows convention and we try as much as possible to
- -- follow the platform convention.
+ Build_Import_Library (Lib_Filename);
+ end Build_Import_Library;
- if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
- Build_Import_Library (Base_Filename (4 .. Base_Filename'Last));
+ ------------------
+ -- Get_Dll_Name --
+ ------------------
+
+ function Get_Dll_Name (Lib_Filename : String) return String is
+ begin
+ if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
+ return Lib_Filename & ".dll";
else
- Build_Import_Library (Base_Filename);
+ return Lib_Filename;
end if;
- end Build_Import_Library;
+ end Get_Dll_Name;
end MDLL;
OSDN Git Service
