aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.0/gcc/ada/mdll.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.0/gcc/ada/mdll.adb')
-rw-r--r--gcc-4.4.0/gcc/ada/mdll.adb517
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;