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