| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- M D L L -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, 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; |
