67ce0d7e96
2007-10-15 Robert Dewar <dewar@adacore.com> * s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb, s-taprop-vxworks.adb, s-taprop-posix.adb, a-calend-vms.adb, a-calend.adb, a-nuflra.adb, a-tigeau.adb, a-wtgeau.adb, checks.adb, bindgen.adb, eval_fat.adb, exp_fixd.adb, fmap.adb, freeze.adb, g-awk.adb, g-calend.adb, g-diopit.adb, g-expect.adb, gnatchop.adb, gnatlink.adb, g-spipat.adb, g-thread.adb, make.adb, mdll.adb, mlib.adb, mlib-prj.adb, osint.adb, par-ch3.adb, prj.adb, prj-makr.adb, sem_prag.adb, sem_type.adb, s-fatgen.adb, s-fileio.adb, sinfo.ads, sinput-d.adb, s-taasde.adb, s-tasdeb.ads, s-tasren.adb, s-tassta.adb, s-tpobop.adb, s-tposen.adb, stylesw.adb, types.ads, uintp.adb, validsw.adb, makegpr.adb, a-rbtgso.adb, a-crbtgo.adb, a-coorse.adb, a-convec.adb, a-coinve.adb, a-cohama.adb, a-ciorse.adb, a-cihama.adb, a-cidlli.adb, a-chtgop.adb, a-cdlili.adb, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb, a-ciorma.adb, a-coorma.adb, a-ztgeau.adb, symbols-vms.adb, a-crdlli.adb, a-calari.adb, a-calfor.adb, s-os_lib.adb, s-regpat.adb, a-ngrear.adb: Minor reformatting. Add Unreferenced and Warnings (Off) pragmas for cases of variables modified calls where they are IN OUT or OUT parameters and the resulting values are not subsequently referenced. In a few cases, we also remove redundant code found by the new warnings. * ug_words, vms_data.ads, usage.adb, sem_util.adb, sem_util.ads, sem_warn.adb, sem_warn.ads, sem_res.adb, sem_ch7.adb, sem_ch8.adb, sem_ch5.adb, opt.ads, lib-xref.adb, lib-xref.ads, exp_smem.adb, sem_ch11.adb, exp_ch6.adb, einfo.ads, einfo.adb: implement a new warning controlled by -gnatw.o that warns on cases of out parameter values being ignored. From-SVN: r129318
518 lines
17 KiB
Ada
518 lines
17 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- M D L L --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- 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 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. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This package provides the core high level routines used by GNATDLL
|
|
-- to build Windows DLL.
|
|
|
|
with Ada.Text_IO;
|
|
|
|
with GNAT.Directory_Operations;
|
|
with MDLL.Utl;
|
|
with MDLL.Fil;
|
|
|
|
package body MDLL is
|
|
|
|
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 --
|
|
---------------------------
|
|
|
|
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 := 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 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 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
|
|
|
|
procedure Ada_Build_Non_Reloc_DLL;
|
|
-- Build a non relocatable DLL with Ada code
|
|
|
|
---------------------
|
|
-- Build_Reloc_DLL --
|
|
---------------------
|
|
|
|
procedure Build_Reloc_DLL is
|
|
|
|
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
|
|
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;
|
|
|
|
-- 1) Build base file with objects files
|
|
|
|
Utl.Gcc (Output_File => Jnk_File,
|
|
Files => Ofiles,
|
|
Options => All_Options,
|
|
Base_File => Bas_File,
|
|
Build_Lib => True);
|
|
|
|
-- 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
|
|
|
|
Utl.Gcc (Output_File => Jnk_File,
|
|
Files => Objects_Exp_File,
|
|
Options => All_Options,
|
|
Base_File => Bas_File,
|
|
Build_Lib => True);
|
|
|
|
-- 4) Build new exp from base file and the lib file (.a)
|
|
|
|
Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
Base_File => Bas_File,
|
|
Exp_Table => Exp_File,
|
|
Build_Import => Build_Import);
|
|
|
|
-- 5) Build the dynamic library
|
|
|
|
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);
|
|
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;
|
|
|
|
-------------------------
|
|
-- Ada_Build_Reloc_DLL --
|
|
-------------------------
|
|
|
|
procedure Ada_Build_Reloc_DLL is
|
|
Success : Boolean;
|
|
pragma Warnings (Off, Success);
|
|
|
|
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;
|
|
|
|
-- 1) Build base file with objects files
|
|
|
|
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;
|
|
|
|
-- 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
|
|
|
|
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;
|
|
|
|
-- 4) Build new exp from base file and the lib file (.a)
|
|
|
|
Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
Base_File => Bas_File,
|
|
Exp_Table => Exp_File,
|
|
Build_Import => Build_Import);
|
|
|
|
-- 5) Build the dynamic library
|
|
|
|
Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
|
|
|
|
declare
|
|
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
|
|
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);
|
|
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;
|
|
|
|
-------------------------
|
|
-- Build_Non_Reloc_DLL --
|
|
-------------------------
|
|
|
|
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...");
|
|
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;
|
|
|
|
-- Build exp table and the lib .a file
|
|
|
|
Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
Exp_Table => Exp_File,
|
|
Build_Import => Build_Import);
|
|
|
|
-- Build the DLL
|
|
|
|
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;
|
|
|
|
-----------------------------
|
|
-- Ada_Build_Non_Reloc_DLL --
|
|
-----------------------------
|
|
|
|
-- 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...");
|
|
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;
|
|
|
|
-- Build exp table and the lib .a file
|
|
|
|
Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
Exp_Table => Exp_File,
|
|
Build_Import => Build_Import);
|
|
|
|
-- Build the DLL
|
|
|
|
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;
|
|
|
|
-- Start of processing for Build_Dynamic_Library
|
|
|
|
begin
|
|
-- 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 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;
|
|
|
|
--------------------------
|
|
-- Build_Import_Library --
|
|
--------------------------
|
|
|
|
procedure Build_Import_Library
|
|
(Lib_Filename : String;
|
|
Def_Filename : String)
|
|
is
|
|
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 (Lib_Filename : String) is
|
|
|
|
function No_Lib_Prefix (Filename : String) return String;
|
|
-- Return Filename without the lib prefix if present
|
|
|
|
-------------------
|
|
-- 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);
|
|
end if;
|
|
|
|
Utl.Dlltool
|
|
(Def_File, Dll_File, Lib_File, Build_Import => True);
|
|
end Build_Import_Library;
|
|
|
|
-- Start of processing for Build_Import_Library
|
|
|
|
begin
|
|
Build_Import_Library (Lib_Filename);
|
|
end Build_Import_Library;
|
|
|
|
------------------
|
|
-- 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
|
|
return Lib_Filename;
|
|
end if;
|
|
end Get_Dll_Name;
|
|
|
|
end MDLL;
|