OSDN Git Service

2007-04-20 Vincent Celier <celier@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / mlib-tgt-mingw.adb
index 0dddb89..cba87e5 100644 (file)
@@ -2,12 +2,12 @@
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
---                             M L I B . T G T                              --
+--                    M L I B . T G T . S P E C I F I C                     --
 --                            (Windows Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-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- --
 -- 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 COPYING.  If not, write --
--- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the Windows version of the body. Works only with GCC versions
 --  supporting the "-shared" option.
 
-with Namet;  use Namet;
 with Opt;
 with Output; use Output;
-with Prj.Com;
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 with MLib.Fil;
 with MLib.Utl;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
 
    package Files renames MLib.Fil;
    package Tools renames MLib.Utl;
 
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
+   --  Non default subprograms
 
-   function Archive_Builder return String is
-   begin
-      return "ar";
-   end Archive_Builder;
-
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
+   procedure Build_Dynamic_Library
+     (Ofiles       : Argument_List;
+      Foreign      : Argument_List;
+      Afiles       : Argument_List;
+      Options      : Argument_List;
+      Options_2    : Argument_List;
+      Interfaces   : Argument_List;
+      Lib_Filename : String;
+      Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
+      Driver_Name  : Name_Id := No_Name;
+      Lib_Version  : String  := "";
+      Auto_Init    : Boolean := False);
 
-   function Archive_Builder_Options return String_List_Access is
-   begin
-      return new String_List'(1 => new String'("cr"));
-   end Archive_Builder_Options;
+   function DLL_Ext return String;
 
-   -----------------
-   -- Archive_Ext --
-   -----------------
+   function DLL_Prefix return String;
 
-   function Archive_Ext return  String is
-   begin
-      return "a";
-   end Archive_Ext;
+   function Is_Archive_Ext (Ext : String) return Boolean;
 
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
+   function PIC_Option return String;
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   No_Argument_List : constant String_List := (1 .. 0 => null);
+   --  Used as value of parameter Options or Options2 in calls to Gcc
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -102,14 +86,14 @@ package body MLib.Tgt is
    is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
-      pragma Unreferenced (Auto_Init);
       pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Interfaces);
       pragma Unreferenced (Lib_Version);
+      pragma Unreferenced (Auto_Init);
 
       Lib_File : constant String :=
                    Lib_Dir & Directory_Separator &
-                   Files.Ext_To (Lib_Filename, DLL_Ext);
+                   Files.Append_To (Lib_Filename, DLL_Ext);
 
    --  Start of processing for Build_Dynamic_Library
 
@@ -122,7 +106,7 @@ package body MLib.Tgt is
       Tools.Gcc
         (Output_File => Lib_File,
          Objects     => Ofiles,
-         Options     => Tools.No_Argument_List,
+         Options     => No_Argument_List,
          Options_2   => Options & Options_2,
          Driver_Name => Driver_Name);
    end Build_Dynamic_Library;
@@ -136,32 +120,14 @@ package body MLib.Tgt is
       return "dll";
    end DLL_Ext;
 
-   --------------------
-   -- Dynamic_Option --
-   --------------------
-
-   function Dynamic_Option return String is
-   begin
-      return "-shared";
-   end Dynamic_Option;
-
-   -------------------
-   -- Is_Object_Ext --
-   -------------------
-
-   function Is_Object_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".o";
-   end Is_Object_Ext;
-
-   --------------
-   -- Is_C_Ext --
-   --------------
+   ----------------
+   -- DLL_Prefix --
+   ----------------
 
-   function Is_C_Ext (Ext : String) return Boolean is
+   function DLL_Prefix return String is
    begin
-      return Ext = ".c";
-   end Is_C_Ext;
+      return "";
+   end DLL_Prefix;
 
    --------------------
    -- Is_Archive_Ext --
@@ -172,91 +138,6 @@ package body MLib.Tgt is
       return Ext = ".a" or else Ext = ".dll";
    end Is_Archive_Ext;
 
-   -------------
-   -- Libgnat --
-   -------------
-
-   function Libgnat return String is
-   begin
-      return "libgnat.a";
-   end Libgnat;
-
-   ------------------------
-   -- Library_Exists_For --
-   ------------------------
-
-   function Library_Exists_For (Project : Project_Id) return Boolean is
-   begin
-      if not Projects.Table (Project).Library then
-         Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
-                       "for non library project");
-         return False;
-
-      else
-         declare
-            Lib_Dir : constant String :=
-                        Get_Name_String
-                          (Projects.Table (Project).Library_Dir);
-            Lib_Name : constant String :=
-                         Get_Name_String
-                           (Projects.Table (Project).Library_Name);
-
-         begin
-            if Projects.Table (Project).Library_Kind = Static then
-               return Is_Regular_File
-                 (Lib_Dir & Directory_Separator & "lib" &
-                  MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               return Is_Regular_File
-                 (Lib_Dir & Directory_Separator &
-                  MLib.Fil.Ext_To (Lib_Name, DLL_Ext));
-            end if;
-         end;
-      end if;
-   end Library_Exists_For;
-
-   ---------------------------
-   -- Library_File_Name_For --
-   ---------------------------
-
-   function Library_File_Name_For (Project : Project_Id) return Name_Id is
-   begin
-      if not Projects.Table (Project).Library then
-         Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
-                       "for non library project");
-         return No_Name;
-
-      else
-         declare
-            Lib_Name : constant String :=
-              Get_Name_String (Projects.Table (Project).Library_Name);
-
-         begin
-            if Projects.Table (Project).Library_Kind = Static then
-               Name_Len := 3;
-               Name_Buffer (1 .. Name_Len) := "lib";
-               Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               Name_Len := 0;
-               Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
-            end if;
-
-            return Name_Find;
-         end;
-      end if;
-   end Library_File_Name_For;
-
-   ----------------
-   -- Object_Ext --
-   ----------------
-
-   function Object_Ext return String is
-   begin
-      return "o";
-   end Object_Ext;
-
    ----------------
    -- PIC_Option --
    ----------------
@@ -266,22 +147,10 @@ package body MLib.Tgt is
       return "";
    end PIC_Option;
 
-   -----------------------------------------------
-   -- Standalone_Library_Auto_Init_Is_Supported --
-   -----------------------------------------------
-
-   function Standalone_Library_Auto_Init_Is_Supported return Boolean is
-   begin
-      return False;
-   end Standalone_Library_Auto_Init_Is_Supported;
-
-   ---------------------------
-   -- Support_For_Libraries --
-   ---------------------------
-
-   function Support_For_Libraries return Library_Support is
-   begin
-      return Full;
-   end Support_For_Libraries;
-
-end MLib.Tgt;
+begin
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   DLL_Prefix_Ptr := DLL_Prefix'Access;
+   Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
+   PIC_Option_Ptr := PIC_Option'Access;
+end MLib.Tgt.Specific;