mlib-tgt-specific.adb, [...]: New files.

2007-04-20  Vincent Celier  <celier@adacore.com>

	* mlib-tgt-specific.adb, mlib-tgt-specific.ads,
	mlib-tgt-vms.adb, mlib-tgt-vms.ads: New files.

	* mlib-tgt.adb, mlib-tgt.ads, mlib-tgt-darwin.adb, 
	mlib-tgt-vxworks.adb, mlib-tgt-mingw.adb, mlib-tgt-lynxos.adb, 
	mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, 
	mlib-tgt-vms-ia64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, 
	mlib-tgt-hpux.adb, mlib-tgt-tru64.adb: Make a common body for package
	MLib.Tgt, containing the default versions
	of the exported subprograms. For each platforms, create a specific
	version of the body of new child package MLib.Tgt.Specific that contains
	only the bodies of subprograms that are different from the default.
	(Archive_Builder_Append_Options): New function

From-SVN: r125366

1 files changed, 297 insertions, 46 deletions

diff --git a/gcc/ada/mlib-tgt.adb b/gcc/ada/mlib-tgt.adb
index c1bca97ef2b..8a242bc0871 100644
--- a/gcc/ada/mlib-tgt.adb
+++ b/gcc/ada/mlib-tgt.adb
@@ -3,11 +3,10 @@
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
 --                             M L I B . T G T                              --
---                            (Default Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2005, AdaCore                     --
+--                     Copyright (C) 2001-2007, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -29,6 +28,13 @@
 --  All subprograms are dummies, because they are never called,
 --  except Support_For_Libraries which returns None.
 
+with MLib.Fil;
+with Prj.Com;
+
+with MLib.Tgt.Specific;
+pragma Warnings (Off, MLib.Tgt.Specific);
+--  MLib.Tgt.Specific is with'ed only for elaboration purposes
+
 package body MLib.Tgt is
 
    ---------------------
@@ -37,45 +43,108 @@ package body MLib.Tgt is
 
    function Archive_Builder return String is
    begin
-      return "ar";
+      return Archive_Builder_Ptr.all;
    end Archive_Builder;
 
    -----------------------------
+   -- Archive_Builder_Default --
+   -----------------------------
+
+   function Archive_Builder_Default return String is
+   begin
+      return "ar";
+   end Archive_Builder_Default;
+
+   -----------------------------
    -- Archive_Builder_Options --
    -----------------------------
 
    function Archive_Builder_Options return String_List_Access is
    begin
-      return new String_List'(1 => new String'("cr"));
+      return Archive_Builder_Options_Ptr.all;
    end Archive_Builder_Options;
 
+   -------------------------------------
+   -- Archive_Builder_Options_Default --
+   -------------------------------------
+
+   function Archive_Builder_Options_Default return String_List_Access is
+   begin
+      return new String_List'(1 => new String'("cr"));
+   end Archive_Builder_Options_Default;
+
+   ------------------------------------
+   -- Archive_Builder_Append_Options --
+   ------------------------------------
+
+   function Archive_Builder_Append_Options return String_List_Access is
+   begin
+      return Archive_Builder_Append_Options_Ptr.all;
+   end Archive_Builder_Append_Options;
+
+   --------------------------------------------
+   -- Archive_Builder_Append_Options_Default --
+   --------------------------------------------
+
+   function Archive_Builder_Append_Options_Default return String_List_Access is
+   begin
+      return new String_List'(1 => new String'("q"));
+   end Archive_Builder_Append_Options_Default;
+
    -----------------
    -- Archive_Ext --
    -----------------
 
    function Archive_Ext return String is
    begin
-      return "";
+      return Archive_Ext_Ptr.all;
    end Archive_Ext;
 
+   -------------------------
+   -- Archive_Ext_Default --
+   -------------------------
+
+   function Archive_Ext_Default return String is
+   begin
+      return "a";
+   end Archive_Ext_Default;
+
    ---------------------
    -- Archive_Indexer --
    ---------------------
 
    function Archive_Indexer return String is
    begin
-      return "ranlib";
+      return Archive_Indexer_Ptr.all;
    end Archive_Indexer;
 
    -----------------------------
+   -- Archive_Indexer_Default --
+   -----------------------------
+
+   function Archive_Indexer_Default return String is
+   begin
+      return "ranlib";
+   end Archive_Indexer_Default;
+
+   -----------------------------
    -- Archive_Indexer_Options --
    -----------------------------
 
    function Archive_Indexer_Options return String_List_Access is
    begin
-      return new String_List (1 .. 0);
+      return Archive_Indexer_Options_Ptr.all;
    end Archive_Indexer_Options;
 
+   -------------------------------------
+   -- Archive_Indexer_Options_Default --
+   -------------------------------------
+
+   function Archive_Indexer_Options_Default return String_List_Access is
+   begin
+      return new String_List (1 .. 0);
+   end Archive_Indexer_Options_Default;
+
    ---------------------------
    -- Build_Dynamic_Library --
    ---------------------------
@@ -90,93 +159,170 @@ package body MLib.Tgt is
       Lib_Filename : String;
       Lib_Dir      : String;
       Symbol_Data  : Symbol_Record;
-      Driver_Name  : Name_Id := No_Name;
-      Lib_Version  : String  := "";
-      Auto_Init    : Boolean := False)
+      Driver_Name  : Name_Id  := No_Name;
+      Lib_Version  : String   := "";
+      Auto_Init    : Boolean  := False)
    is
-      pragma Unreferenced (Ofiles);
-      pragma Unreferenced (Foreign);
-      pragma Unreferenced (Afiles);
-      pragma Unreferenced (Options);
-      pragma Unreferenced (Options_2);
-      pragma Unreferenced (Interfaces);
-      pragma Unreferenced (Lib_Filename);
-      pragma Unreferenced (Lib_Dir);
-      pragma Unreferenced (Symbol_Data);
-      pragma Unreferenced (Driver_Name);
-      pragma Unreferenced (Lib_Version);
-      pragma Unreferenced (Auto_Init);
-
-   begin
-      null;
+   begin
+      Build_Dynamic_Library_Ptr
+        (Ofiles,
+         Foreign,
+         Afiles,
+         Options,
+         Options_2,
+         Interfaces,
+         Lib_Filename,
+         Lib_Dir,
+         Symbol_Data,
+         Driver_Name,
+         Lib_Version,
+         Auto_Init);
    end Build_Dynamic_Library;
 
+   ------------------------------
+   -- Default_Symbol_File_Name --
+   ------------------------------
+
+   function Default_Symbol_File_Name return String is
+   begin
+      return Default_Symbol_File_Name_Ptr.all;
+   end Default_Symbol_File_Name;
+
+   --------------------------------------
+   -- Default_Symbol_File_Name_Default --
+   --------------------------------------
+
+   function Default_Symbol_File_Name_Default return String is
+   begin
+      return "";
+   end Default_Symbol_File_Name_Default;
+
    -------------
    -- DLL_Ext --
    -------------
 
    function DLL_Ext return String is
    begin
-      return "";
+      return DLL_Ext_Ptr.all;
    end DLL_Ext;
 
+   ---------------------
+   -- DLL_Ext_Default --
+   ---------------------
+
+   function DLL_Ext_Default return String is
+   begin
+      return "so";
+   end DLL_Ext_Default;
+
    ----------------
    -- DLL_Prefix --
    ----------------
 
    function DLL_Prefix return String is
    begin
-      return "lib";
+      return DLL_Prefix_Ptr.all;
    end DLL_Prefix;
 
+   ------------------------
+   -- DLL_Prefix_Default --
+   ------------------------
+
+   function DLL_Prefix_Default return String is
+   begin
+      return "lib";
+   end DLL_Prefix_Default;
+
    --------------------
    -- Dynamic_Option --
    --------------------
 
    function Dynamic_Option return String is
    begin
-      return "";
+      return Dynamic_Option_Ptr.all;
    end Dynamic_Option;
 
+   ----------------------------
+   -- Dynamic_Option_Default --
+   ----------------------------
+
+   function Dynamic_Option_Default return String is
+   begin
+      return "-shared";
+   end Dynamic_Option_Default;
+
    -------------------
    -- Is_Object_Ext --
    -------------------
 
    function Is_Object_Ext (Ext : String) return Boolean is
-      pragma Unreferenced (Ext);
    begin
-      return False;
+      return Is_Object_Ext_Ptr (Ext);
    end Is_Object_Ext;
 
+   ---------------------------
+   -- Is_Object_Ext_Default --
+   ---------------------------
+
+   function Is_Object_Ext_Default (Ext : String) return Boolean is
+   begin
+      return Ext = ".o";
+   end Is_Object_Ext_Default;
+
    --------------
    -- Is_C_Ext --
    --------------
 
    function Is_C_Ext (Ext : String) return Boolean is
-      pragma Unreferenced (Ext);
    begin
-      return False;
+      return Is_C_Ext_Ptr (Ext);
    end Is_C_Ext;
 
+   ----------------------
+   -- Is_C_Ext_Default --
+   ----------------------
+
+   function Is_C_Ext_Default (Ext : String) return Boolean is
+   begin
+      return Ext = ".c";
+   end Is_C_Ext_Default;
+
    --------------------
    -- Is_Archive_Ext --
    --------------------
 
    function Is_Archive_Ext (Ext : String) return Boolean is
-      pragma Unreferenced (Ext);
    begin
-      return False;
+      return Is_Archive_Ext_Ptr (Ext);
    end Is_Archive_Ext;
 
+   ----------------------------
+   -- Is_Archive_Ext_Default --
+   ----------------------------
+
+   function Is_Archive_Ext_Default (Ext : String) return Boolean is
+   begin
+      return Ext = ".a";
+   end Is_Archive_Ext_Default;
+
    -------------
    -- Libgnat --
    -------------
 
    function Libgnat return String is
    begin
-      return "libgnat.a";
+      return Libgnat_Ptr.all;
    end Libgnat;
 
+   ---------------------
+   -- Libgnat_Default --
+   ---------------------
+
+   function Libgnat_Default return String is
+   begin
+      return "libgnat.a";
+   end Libgnat_Default;
+
    ------------------------
    -- Library_Exists_For --
    ------------------------
@@ -184,60 +330,165 @@ package body MLib.Tgt is
    function Library_Exists_For
      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
    is
-      pragma Unreferenced (Project);
-      pragma Unreferenced (In_Tree);
    begin
-      return False;
+      return Library_Exists_For_Ptr (Project, In_Tree);
    end Library_Exists_For;
 
+   --------------------------------
+   -- Library_Exists_For_Default --
+   --------------------------------
+
+   function Library_Exists_For_Default
+     (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
+   is
+   begin
+      if not In_Tree.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
+                           (In_Tree.Projects.Table (Project).Library_Dir);
+            Lib_Name : constant String :=
+                         Get_Name_String
+                           (In_Tree.Projects.Table (Project).Library_Name);
+
+         begin
+            if In_Tree.Projects.Table (Project).Library_Kind = Static then
+               return Is_Regular_File
+                 (Lib_Dir & Directory_Separator & "lib" &
+                  Fil.Append_To (Lib_Name, Archive_Ext));
+
+            else
+               return Is_Regular_File
+                 (Lib_Dir & Directory_Separator & DLL_Prefix &
+                  Fil.Append_To (Lib_Name, DLL_Ext));
+            end if;
+         end;
+      end if;
+   end Library_Exists_For_Default;
+
    ---------------------------
    -- Library_File_Name_For --
    ---------------------------
 
    function Library_File_Name_For
      (Project : Project_Id;
-      In_Tree : Project_Tree_Ref) return Name_Id
+      In_Tree : Project_Tree_Ref) return File_Name_Type
    is
-      pragma Unreferenced (Project);
-      pragma Unreferenced (In_Tree);
    begin
-      return No_Name;
+      return Library_File_Name_For_Ptr (Project, In_Tree);
    end Library_File_Name_For;
 
+   -----------------------------------
+   -- Library_File_Name_For_Default --
+   -----------------------------------
+
+   function Library_File_Name_For_Default
+     (Project : Project_Id;
+      In_Tree : Project_Tree_Ref) return File_Name_Type
+   is
+   begin
+      if not In_Tree.Projects.Table (Project).Library then
+         Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
+                       "for non library project");
+         return No_File;
+
+      else
+         declare
+            Lib_Name : constant String :=
+                         Get_Name_String
+                           (In_Tree.Projects.Table (Project).Library_Name);
+
+         begin
+            if In_Tree.Projects.Table (Project).Library_Kind = Static then
+               Name_Len := 3;
+               Name_Buffer (1 .. Name_Len) := "lib";
+               Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
+            else
+               Name_Len := 0;
+               Add_Str_To_Name_Buffer (DLL_Prefix);
+               Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
+            end if;
+
+            return Name_Find;
+         end;
+      end if;
+   end Library_File_Name_For_Default;
+
    ----------------
    -- Object_Ext --
    ----------------
 
    function Object_Ext return String is
    begin
-      return "";
+      return Object_Ext_Ptr.all;
    end Object_Ext;
 
+   ------------------------
+   -- Object_Ext_Default --
+   ------------------------
+
+   function Object_Ext_Default return String is
+   begin
+      return "o";
+   end Object_Ext_Default;
+
    ----------------
    -- PIC_Option --
    ----------------
 
    function PIC_Option return String is
    begin
-      return "";
+      return PIC_Option_Ptr.all;
    end PIC_Option;
 
+   ------------------------
+   -- PIC_Option_Default --
+   ------------------------
+
+   function PIC_Option_Default return String is
+   begin
+      return "-fPIC";
+   end PIC_Option_Default;
+
    -----------------------------------------------
    -- Standalone_Library_Auto_Init_Is_Supported --
    -----------------------------------------------
 
    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
    begin
-      return False;
+      return Standalone_Library_Auto_Init_Is_Supported_Ptr.all;
    end Standalone_Library_Auto_Init_Is_Supported;
 
+   -------------------------------------------------------
+   -- Standalone_Library_Auto_Init_Is_Supported_Default --
+   -------------------------------------------------------
+
+   function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean is
+   begin
+      return True;
+   end Standalone_Library_Auto_Init_Is_Supported_Default;
+
    ---------------------------
    -- Support_For_Libraries --
    ---------------------------
 
    function Support_For_Libraries return Library_Support is
    begin
-      return None;
+      return Support_For_Libraries_Ptr.all;
    end Support_For_Libraries;
 
+   -----------------------------------
+   -- Support_For_Libraries_Default --
+   -----------------------------------
+
+   function Support_For_Libraries_Default return Library_Support is
+   begin
+      return Full;
+   end Support_For_Libraries_Default;
+
 end MLib.Tgt;