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, 63 insertions, 226 deletions

diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb
index 737a40a..848a11c 100644
--- a/gcc/ada/mlib-tgt-linux.adb
+++ b/gcc/ada/mlib-tgt-linux.adb
@@ -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                     --
 --                           (GNU/Linux Version)                            --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -25,68 +25,35 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the GNU/Linux version of the body
 
 with MLib.Fil;
 with MLib.Utl;
-with Namet;  use Namet;
 with Opt;
 with Output; use Output;
-with Prj.Com;
 with System;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
 
-   use GNAT;
    use MLib;
 
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
-
-   function Archive_Builder return String is
-   begin
-      return "ar";
-   end Archive_Builder;
-
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
-
-   function Archive_Builder_Options return String_List_Access is
-   begin
-      return new String_List'(1 => new String'("cr"));
-   end Archive_Builder_Options;
-
-   -----------------
-   -- Archive_Ext --
-   -----------------
-
-   function Archive_Ext return  String is
-   begin
-      return "a";
-   end Archive_Ext;
-
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
+   --  Non default subprograms
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   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);
 
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
-
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   function Is_Archive_Ext (Ext : String) return Boolean;
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -114,8 +81,10 @@ package body MLib.Tgt is
       --  Initialization is done through the contructor mechanism
 
       Lib_File : constant String :=
-                   Lib_Dir & Directory_Separator & "lib" &
-                   Fil.Append_To (Lib_Filename, DLL_Ext);
+                   "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
+
+      Lib_Path : constant String :=
+                   Lib_Dir & Directory_Separator & Lib_File;
 
       Version_Arg          : String_Access;
       Symbolic_Link_Needed : Boolean := False;
@@ -123,12 +92,12 @@ package body MLib.Tgt is
    begin
       if Opt.Verbose_Mode then
          Write_Str ("building relocatable shared library ");
-         Write_Line (Lib_File);
+         Write_Line (Lib_Path);
       end if;
 
       if Lib_Version = "" then
          Utl.Gcc
-           (Output_File => Lib_File,
+           (Output_File => Lib_Path,
             Objects     => Ofiles,
             Options     => Options,
             Driver_Name => Driver_Name,
@@ -194,7 +163,7 @@ package body MLib.Tgt is
                   Options     => Options & Version_Arg,
                   Driver_Name => Driver_Name,
                   Options_2   => Options_2);
-               Symbolic_Link_Needed := Lib_Version /= Lib_File;
+               Symbolic_Link_Needed := Lib_Version /= Lib_Path;
 
             else
                Utl.Gcc
@@ -204,14 +173,14 @@ package body MLib.Tgt is
                   Driver_Name => Driver_Name,
                   Options_2   => Options_2);
                Symbolic_Link_Needed :=
-                 Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
+                 Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
             end if;
 
             if Symbolic_Link_Needed then
                declare
                   Success : Boolean;
                   Oldpath : String (1 .. Lib_Version'Length + 1);
-                  Newpath : String (1 .. Lib_File'Length + 1);
+                  Newpath : String (1 .. Lib_Path'Length + 1);
 
                   Result : Integer;
                   pragma Unreferenced (Result);
@@ -224,63 +193,48 @@ package body MLib.Tgt is
                begin
                   Oldpath (1 .. Lib_Version'Length) := Lib_Version;
                   Oldpath (Oldpath'Last)            := ASCII.NUL;
-                  Newpath (1 .. Lib_File'Length)    := Lib_File;
+                  Newpath (1 .. Lib_Path'Length)    := Lib_Path;
                   Newpath (Newpath'Last)            := ASCII.NUL;
 
-                  Delete_File (Lib_File, Success);
+                  Delete_File (Lib_Path, Success);
 
                   Result := Symlink (Oldpath'Address, Newpath'Address);
                end;
+
+               if Ok_Maj then
+                  declare
+                     Success : Boolean;
+                     Oldpath : String (1 .. Lib_Version'Length + 1);
+                     Maj_Path : constant String :=
+                                  Lib_Dir & Directory_Separator &
+                                  Maj_Version (1 .. Last_Maj);
+                     Newpath : String (1 .. Maj_Path'Length + 1);
+
+                     Result  : Integer;
+                     pragma Unreferenced (Result);
+
+                     function Symlink
+                       (Oldpath : System.Address;
+                        Newpath : System.Address) return Integer;
+                     pragma Import (C, Symlink, "__gnat_symlink");
+
+                  begin
+                     Oldpath (1 .. Lib_Version'Length) := Lib_Version;
+                     Oldpath (Oldpath'Last)            := ASCII.NUL;
+                     Newpath (1 .. Maj_Path'Length)    := Maj_Path;
+                     Newpath (Newpath'Last)            := ASCII.NUL;
+
+                     Delete_File (Maj_Path, Success);
+
+                     Result := Symlink (Oldpath'Address, Newpath'Address);
+                  end;
+               end if;
+
             end if;
          end;
       end if;
    end Build_Dynamic_Library;
 
-   -------------
-   -- DLL_Ext --
-   -------------
-
-   function DLL_Ext return String is
-   begin
-      return "so";
-   end DLL_Ext;
-
-   ----------------
-   -- DLL_Prefix --
-   ----------------
-
-   function DLL_Prefix return String is
-   begin
-      return "lib";
-   end DLL_Prefix;
-
-   --------------------
-   -- 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 --
-   --------------
-
-   function Is_C_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".c";
-   end Is_C_Ext;
-
    --------------------
    -- Is_Archive_Ext --
    --------------------
@@ -290,124 +244,7 @@ package body MLib.Tgt is
       return Ext = ".a" or else Ext = ".so";
    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;
-      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 & "lib" &
-                  Fil.Append_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;
-      In_Tree : Project_Tree_Ref) return Name_Id
-   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_Name;
-
-      else
-         declare
-            Lib_Name : constant String :=
-                         Get_Name_String
-                           (In_Tree.Projects.Table (Project).Library_Name);
-
-         begin
-            Name_Len := 3;
-            Name_Buffer (1 .. Name_Len) := "lib";
-
-            if In_Tree.Projects.Table (Project).Library_Kind =
-                 Static
-            then
-               Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
-            else
-               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;
-
-   ----------------
-   -- Object_Ext --
-   ----------------
-
-   function Object_Ext return String is
-   begin
-      return "o";
-   end Object_Ext;
-
-   ----------------
-   -- PIC_Option --
-   ----------------
-
-   function PIC_Option return String is
-   begin
-      return "-fPIC";
-   end PIC_Option;
-
-   -----------------------------------------------
-   -- Standalone_Library_Auto_Init_Is_Supported --
-   -----------------------------------------------
-
-   function Standalone_Library_Auto_Init_Is_Supported return Boolean is
-   begin
-      return True;
-   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;
+   Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
+end MLib.Tgt.Specific;