--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/mdll.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,517 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                 M D L L                                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2015, 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;