diff options
Diffstat (limited to 'gcc-4.3.1/gcc/ada/mdll.adb')
| -rw-r--r-- | gcc-4.3.1/gcc/ada/mdll.adb | 517 |
1 files changed, 517 insertions, 0 deletions
diff --git a/gcc-4.3.1/gcc/ada/mdll.adb b/gcc-4.3.1/gcc/ada/mdll.adb new file mode 100644 index 000000000..e6eb5e936 --- /dev/null +++ b/gcc-4.3.1/gcc/ada/mdll.adb @@ -0,0 +1,517 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; |