mlib-tgt-specific.adb, [...]: New files.
authorVincent Celier <celier@adacore.com>
Wed, 6 Jun 2007 10:15:24 +0000 (12:15 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 6 Jun 2007 10:15:24 +0000 (12:15 +0200)
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

18 files changed:
gcc/ada/mlib-tgt-aix.adb
gcc/ada/mlib-tgt-darwin.adb
gcc/ada/mlib-tgt-hpux.adb
gcc/ada/mlib-tgt-irix.adb
gcc/ada/mlib-tgt-linux.adb
gcc/ada/mlib-tgt-lynxos.adb
gcc/ada/mlib-tgt-mingw.adb
gcc/ada/mlib-tgt-solaris.adb
gcc/ada/mlib-tgt-specific.adb [new file with mode: 0644]
gcc/ada/mlib-tgt-specific.ads [new file with mode: 0644]
gcc/ada/mlib-tgt-tru64.adb
gcc/ada/mlib-tgt-vms-alpha.adb
gcc/ada/mlib-tgt-vms-ia64.adb
gcc/ada/mlib-tgt-vms.adb [new file with mode: 0644]
gcc/ada/mlib-tgt-vms.ads [new file with mode: 0644]
gcc/ada/mlib-tgt-vxworks.adb
gcc/ada/mlib-tgt.adb
gcc/ada/mlib-tgt.ads

index 12fb4694b86b7bc11c2abe3f0dd7d567c4a2e5a9..9545e8af2bf4ed1174c0871f89cc7bf13f4fd958 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                    --
 --                              (AIX Version)                               --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2003-2006, AdaCore                     --
+--                     Copyright (C) 2003-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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic or relocatable libraries.
-
 --  This is the AIX version of the body
 
 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 
 with MLib.Fil;
 with MLib.Utl;
-with Namet;    use Namet;
 with Opt;
 with Output;   use Output;
 with Prj.Com;
 with Prj.Util; use Prj.Util;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
+
+   --  Non default subprograms
+
+   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 DLL_Ext return String;
+
+   function Support_For_Libraries return Library_Support;
+
+   --  Local variables
 
    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
@@ -66,51 +84,6 @@ package body MLib.Tgt is
    --  libgnarl. Depends on the thread library (Native or FSU). Resolved for
    --  the first library linked against libgnarl.
 
-   ---------------------
-   -- 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 --
-   ---------------------
-
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
-
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
-
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
-
    ---------------------------
    -- Build_Dynamic_Library --
    ---------------------------
@@ -217,162 +190,6 @@ package body MLib.Tgt is
       return "a";
    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 --
-   --------------------
-
-   function Is_Archive_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".a";
-   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 --
    ---------------------------
@@ -382,4 +199,9 @@ package body MLib.Tgt is
       return Static_Only;
    end Support_For_Libraries;
 
-end MLib.Tgt;
+begin
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   Support_For_Libraries_Ptr := Support_For_Libraries'Access;
+
+end MLib.Tgt.Specific;
index 31f03083833a3e254ab93381f70a84205329bfbd..3ae2fcfbdb6286f890a146f44a834927b41bc01a 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                    --
 --                             (Darwin 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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the Darwin version of the body
 
 with MLib;     use MLib;
 with MLib.Fil;
 with MLib.Utl;
-with Namet;    use Namet;
 with Opt;      use Opt;
 with Output;   use Output;
-with Prj.Com;
 
 with System;
 
-package body MLib.Tgt is
-
-   Flat_Namespace : aliased String := "-Wl,-flat_namespace";
-   --  Instruct the linker to build the shared library as a flat
-   --  namespace image. The default is a two-level namespace image.
+package body MLib.Tgt.Specific is
 
-   Shared_Libgcc : aliased String := "-shared-libgcc";
+   --  Non default subprograms
 
-   No_Shared_Libgcc_Options   : aliased Argument_List :=
-                                  (1 => Flat_Namespace'Access);
-   With_Shared_Libgcc_Options : aliased Argument_List :=
-                                  (1 => Flat_Namespace'Access,
-                                   2 => Shared_Libgcc'Access);
+   function Archive_Indexer_Options return String_List_Access;
 
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
+   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 return String is
-   begin
-      return "ar";
-   end Archive_Builder;
+   function DLL_Ext return String;
 
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
+   function Dynamic_Option return String;
 
-   function Archive_Builder_Options return String_List_Access is
-   begin
-      return new String_List'(1 => new String'("cr"));
-   end Archive_Builder_Options;
+   function Is_Archive_Ext (Ext : String) return Boolean;
 
-   -----------------
-   -- Archive_Ext --
-   -----------------
+   --  Local objects
 
-   function Archive_Ext return  String is
-   begin
-      return "a";
-   end Archive_Ext;
+   Flat_Namespace : aliased String := "-Wl,-flat_namespace";
+   --  Instruct the linker to build the shared library as a flat
+   --  namespace image. The default is a two-level namespace image.
 
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
+   Shared_Libgcc  : aliased String := "-shared-libgcc";
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   Shared_Options : constant Argument_List :=
+                               (1 => Flat_Namespace'Access,
+                                2 => Shared_Libgcc'Access);
 
    -----------------------------
    -- Archive_Indexer_Options --
@@ -127,8 +110,6 @@ package body MLib.Tgt is
                    Lib_Dir & Directory_Separator & "lib" &
                    Fil.Append_To (Lib_Filename, DLL_Ext);
 
-      Shared_Options : Argument_List_Access;
-
       Symbolic_Link_Needed : Boolean := False;
 
    begin
@@ -137,21 +118,13 @@ package body MLib.Tgt is
          Write_Line (Lib_File);
       end if;
 
-      --  Invoke gcc with -shared-libgcc, but only for GCC 4 or higher
-
-      if GCC_Version >= 4 then
-         Shared_Options := With_Shared_Libgcc_Options'Access;
-      else
-         Shared_Options := No_Shared_Libgcc_Options'Access;
-      end if;
-
       --  If specified, add automatic elaboration/finalization
 
       if Lib_Version = "" then
          Utl.Gcc
            (Output_File => Lib_File,
             Objects     => Ofiles,
-            Options     => Options & Shared_Options.all,
+            Options     => Options & Shared_Options,
             Driver_Name => Driver_Name,
             Options_2   => Options_2);
 
@@ -161,7 +134,7 @@ package body MLib.Tgt is
             Utl.Gcc
               (Output_File => Lib_Version,
                Objects     => Ofiles,
-               Options     => Options & Shared_Options.all,
+               Options     => Options & Shared_Options,
                Driver_Name => Driver_Name,
                Options_2   => Options_2);
             Symbolic_Link_Needed := Lib_Version /= Lib_File;
@@ -170,7 +143,7 @@ package body MLib.Tgt is
             Utl.Gcc
               (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                Objects     => Ofiles,
-               Options     => Options & Shared_Options.all,
+               Options     => Options & Shared_Options,
                Driver_Name => Driver_Name,
                Options_2   => Options_2);
             Symbolic_Link_Needed :=
@@ -214,15 +187,6 @@ package body MLib.Tgt is
       return "dylib";
    end DLL_Ext;
 
-   ----------------
-   -- DLL_Prefix --
-   ----------------
-
-   function DLL_Prefix return String is
-   begin
-      return "lib";
-   end DLL_Prefix;
-
    --------------------
    -- Dynamic_Option --
    --------------------
@@ -232,24 +196,6 @@ package body MLib.Tgt is
       return "-dynamiclib";
    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 --
    --------------------
@@ -259,123 +205,10 @@ package body MLib.Tgt is
       return Ext = ".dylib" or else Ext = ".a";
    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
+   Archive_Indexer_Options_Ptr := Archive_Indexer_Options'Access;
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   Dynamic_Option_Ptr := Dynamic_Option'Access;
+   Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
+end MLib.Tgt.Specific;
index 985667d7200a180ca163223ae4decf0d800b5934..63ff69ec0d2b6f813a9365ad13f7fea8ee85e25a 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                    --
 --                             (HP-UX Version)                              --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2003-2006, AdaCore                     --
+--                     Copyright (C) 2003-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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  libraries (static only on HP-UX).
-
 --  This is the HP-UX 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
-
-   ---------------------
-   -- 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;
+package body MLib.Tgt.Specific is
 
-   ---------------------
-   -- 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 DLL_Ext return String;
 
-   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 --
@@ -197,42 +167,6 @@ package body MLib.Tgt is
       return "sl";
    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 --
    --------------------
@@ -242,124 +176,8 @@ 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;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
+end MLib.Tgt.Specific;
index 2df88abe88d1176375f04726028edf02304591e2..3b45aea0df7b366475a76fb8cf41fddd8105c014 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                    --
 --                              (IRIX Version)                              --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2003-2006, AdaCore                     --
+--                     Copyright (C) 2003-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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the IRIX 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
-
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
-
-   function Archive_Builder return String is
-   begin
-      return "ar";
-   end Archive_Builder;
-
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
+package body MLib.Tgt.Specific is
 
-   function Archive_Builder_Options return String_List_Access is
-   begin
-      return new String_List'(1 => new String'("cr"));
-   end Archive_Builder_Options;
+   --  Non default subprogram
 
-   -----------------
-   -- Archive_Ext --
-   -----------------
-
-   function Archive_Ext return String is
-   begin
-      return "a";
-   end Archive_Ext;
-
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
-
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
-
-   -----------------------------
-   -- Archive_Indexer_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_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 --
@@ -226,51 +194,6 @@ package body MLib.Tgt is
       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 --
    --------------------
@@ -280,124 +203,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;
index 737a40a9ee84b13330b128df79e8a67ec7445ba4..848a11ca4e7e9f9481e6c0d68831e9e479ad0b9d 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                     --
 --                           (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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  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;
index 4da0d4ab81f7b2db9f07f8404d3e746adb9ab985..0a667d50014e12d382b01c47d7ce4f2df3c54cae 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                     --
 --                             (LynxOS Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2003-2006 Free Software Foundation, Inc.         --
+--           Copyright (C) 2003-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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static libraries.
-
 --  This is the LynxOS version of the body
 
-with MLib.Fil;
-with Namet;  use Namet;
-with Prj.Com;
-
-package body MLib.Tgt is
-
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
-
-   function Archive_Builder return String is
-   begin
-      return "ar";
-   end Archive_Builder;
+package body MLib.Tgt.Specific is
 
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
+   --  Non default subprograms
 
-   function Archive_Builder_Options return String_List_Access is
-   begin
-      return new String_List'(1 => new String'("cr"));
-   end Archive_Builder_Options;
-
-   -----------------
-   -- Archive_Ext --
-   -----------------
+   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_Ext return String is
-   begin
-      return "a";
-   end Archive_Ext;
+   function DLL_Ext return String;
 
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
+   function Dynamic_Option return String;
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   function PIC_Option return String;
 
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
+   function Standalone_Library_Auto_Init_Is_Supported return Boolean;
 
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   function Support_For_Libraries return Library_Support;
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -125,15 +99,6 @@ package body MLib.Tgt is
       return "";
    end DLL_Ext;
 
-   ----------------
-   -- DLL_Prefix --
-   ----------------
-
-   function DLL_Prefix return String is
-   begin
-      return "lib";
-   end DLL_Prefix;
-
    --------------------
    -- Dynamic_Option --
    --------------------
@@ -143,126 +108,6 @@ package body MLib.Tgt is
       return "";
    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 --
-   --------------------
-
-   function Is_Archive_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".a";
-   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 --
    ----------------
@@ -290,4 +135,12 @@ package body MLib.Tgt is
       return Static_Only;
    end Support_For_Libraries;
 
-end MLib.Tgt;
+begin
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   Dynamic_Option_Ptr := Dynamic_Option'Access;
+   PIC_Option_Ptr := PIC_Option'Access;
+   Standalone_Library_Auto_Init_Is_Supported_Ptr :=
+     Standalone_Library_Auto_Init_Is_Supported'Access;
+   Support_For_Libraries_Ptr := Support_For_Libraries'Access;
+end MLib.Tgt.Specific;
index 675f015217597c48ae35cdbe03771618564463da..cba87e59b37c9f4c75e8ebe7620821fb2acc5f42 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-2006, 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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  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 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;
 
-   No_Argument_List : constant String_List := (1 .. 0 => null);
-   --  Used as value of parameter Options or Options2 in calls to Gcc
-
-   ---------------------
-   -- 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;
+   --  Non default subprograms
 
-   -----------------
-   -- Archive_Ext --
-   -----------------
+   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_Ext return  String is
-   begin
-      return "a";
-   end Archive_Ext;
+   function DLL_Ext return String;
 
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
+   function DLL_Prefix return String;
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   function Is_Archive_Ext (Ext : String) return Boolean;
 
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
+   function PIC_Option return String;
 
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   No_Argument_List : constant String_List := (1 .. 0 => null);
+   --  Used as value of parameter Options or Options2 in calls to Gcc
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -155,33 +129,6 @@ package body MLib.Tgt is
       return "";
    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 --
    --------------------
@@ -191,98 +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;
-      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" &
-                  MLib.Fil.Append_To (Lib_Name, Archive_Ext));
-
-            else
-               return Is_Regular_File
-                 (Lib_Dir & Directory_Separator &
-                  MLib.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
-            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 (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 --
    ----------------
@@ -292,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 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;
+   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;
index a66753e2c6cc2ccdd8e1ff6f3d8a8d2fb8911410..1692ccdb28beadf8f31832a252163585c7bf0d34 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                     --
 --                            (Solaris Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---              Copyright (C) 2002-2006 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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the Solaris 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
-
-   ---------------------
-   -- 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 --
-   ---------------------
+package body MLib.Tgt.Specific is
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   --  Non default subprograms
 
-   -----------------------------
-   -- Archive_Indexer_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_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 --
@@ -182,51 +150,6 @@ package body MLib.Tgt is
       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 --
    --------------------
@@ -236,124 +159,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;
diff --git a/gcc/ada/mlib-tgt-specific.adb b/gcc/ada/mlib-tgt-specific.adb
new file mode 100644 (file)
index 0000000..03067b9
--- /dev/null
@@ -0,0 +1,31 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    M L I B . T G T . S P E C I F I C                     --
+--                          (Default empty version)                         --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 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- --
+-- ware  Foundation;  either version 2,  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 COPYING.  If not, write --
+-- 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Default empty version
+
+package body MLib.Tgt.Specific is
+end MLib.Tgt.Specific;
diff --git a/gcc/ada/mlib-tgt-specific.ads b/gcc/ada/mlib-tgt-specific.ads
new file mode 100644 (file)
index 0000000..f35c04f
--- /dev/null
@@ -0,0 +1,35 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    M L I B . T G T . S P E C I F I C                     --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 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- --
+-- ware  Foundation;  either version 2,  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 COPYING.  If not, write --
+-- 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 child package of package MLib.Tgt has no interface.
+--  For each platform, there is a specific body that defines the subprogram
+--  that are different from the default defined in the body of MLib.Tgt,
+--  and modify the corresponding access to subprogram value in the private
+--  part of MLib.Tgt.
+
+package MLib.Tgt.Specific is
+   pragma Elaborate_Body;
+end MLib.Tgt.Specific;
index a211d6508694127ac304f18b25de0e57729646be..50290d26897a647f4b75199fb6d887d19a1e05df 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                     --
 --                             (True64 Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2006 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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static, dynamic and shared libraries.
-
 --  This is the True64 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;
 
-   Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
-
-   ---------------------
-   -- Archive_Builder --
-   ---------------------
-
-   function Archive_Builder return String is
-   begin
-      return "ar";
-   end Archive_Builder;
-
-   -----------------------------
-   -- Archive_Builder_Options --
-   -----------------------------
+   --  Non default subprogram
 
-   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;
+   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 --
-   ---------------------
+   function Is_Archive_Ext (Ext : String) return Boolean;
 
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
+   function PIC_Option return String;
 
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
+   --  Local variables
 
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -192,51 +163,6 @@ package body MLib.Tgt is
       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 --
    --------------------
@@ -246,99 +172,6 @@ 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 --
    ----------------
@@ -348,22 +181,8 @@ 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 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;
+   PIC_Option_Ptr := PIC_Option'Access;
+end MLib.Tgt.Specific;
index 8c2aa1b023b32860c531c781ffa515ddd2f09ce4..b091799764aab69fd46a841b0e523826488e5f65 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                     --
 --                           (Alpha VMS Version)                            --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-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- --
 
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-
 with MLib.Fil;
 with MLib.Utl;
-with Namet;    use Namet;
-with Opt;      use Opt;
-with Output;   use Output;
-with Prj.Com;
+
+with MLib.Tgt.VMS;
+pragma Warnings (Off, MLib.Tgt.VMS);
+--  MLib.Tgt.VMS is with'ed only for elaboration purposes
+
+with Opt;    use Opt;
+with Output; use Output;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
 with System;           use System;
 with System.Case_Util; use System.Case_Util;
 with System.CRTL;      use System.CRTL;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
+
+   --  Non default subprogram. See comment in mlib-tgt.ads.
+
+   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);
 
-   use GNAT;
+   --  Local variables
 
    Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
    Additional_Objects  : Argument_List_Access := Empty_Argument_List'Access;
@@ -67,56 +86,8 @@ package body MLib.Tgt is
 
    Shared_Libgcc : aliased String := "-shared-libgcc";
 
-   No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
-   Shared_Libgcc_Switch    : aliased Argument_List :=
-                               (1 => Shared_Libgcc'Access);
-   Link_With_Shared_Libgcc : Argument_List_Access :=
-                               No_Shared_Libgcc_Switch'Access;
-
-   ---------------------
-   -- 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 "olb";
-   end Archive_Ext;
-
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
-
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
-
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
-
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   Shared_Libgcc_Switch : constant Argument_List :=
+                            (1 => Shared_Libgcc'Access);
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -160,9 +131,9 @@ package body MLib.Tgt is
 
       function Version_String return String;
       --  Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
-      --  not Autonomous, otherwise returns "".
-      --  When Symbol_Data.Symbol_Policy is Autonomous, fails gnatmake if
-      --  Lib_Version is not the image of a positive number.
+      --  not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy
+      --  is Autonomous, fails gnatmake if Lib_Version is not the image of a
+      --  positive number.
 
       ------------------
       -- Is_Interface --
@@ -215,6 +186,7 @@ package body MLib.Tgt is
 
       function Version_String return String is
          Version : Integer := 0;
+
       begin
          if Lib_Version = ""
            or else Symbol_Data.Symbol_Policy /= Autonomous
@@ -240,6 +212,10 @@ package body MLib.Tgt is
          end if;
       end Version_String;
 
+      ---------------------
+      -- Local Variables --
+      ---------------------
+
       Opt_File_Name  : constant String := Option_File_Name;
       Version        : constant String := Version_String;
       For_Linker_Opt : String_Access;
@@ -247,14 +223,6 @@ package body MLib.Tgt is
    --  Start of processing for Build_Dynamic_Library
 
    begin
-      --  Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
-
-      if GCC_Version >= 3 then
-         Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
-      else
-         Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
-      end if;
-
       --  If option file name does not ends with ".opt", append "/OPTIONS"
       --  to its specification for the VMS linker.
 
@@ -277,7 +245,7 @@ package body MLib.Tgt is
       --  "gnatsym" is necessary for building the option file
 
       if Gnatsym_Path = null then
-         Gnatsym_Path := OS_Lib.Locate_Exec_On_Path (Gnatsym_Name);
+         Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name);
 
          if Gnatsym_Path = null then
             Fail (Gnatsym_Name, " not found in path");
@@ -443,6 +411,11 @@ package body MLib.Tgt is
          when Restricted =>
             Last_Argument := Last_Argument + 1;
             Arguments (Last_Argument) := new String'("-R");
+
+         when Direct =>
+            Last_Argument := Last_Argument + 1;
+            Arguments (Last_Argument) := new String'("-D");
+
       end case;
 
       --  Add each relevant object file
@@ -502,7 +475,7 @@ package body MLib.Tgt is
         (Output_File => Lib_File,
          Objects     => Ofiles & Additional_Objects.all,
          Options     => VMS_Options,
-         Options_2   => Link_With_Shared_Libgcc.all &
+         Options_2   => Shared_Libgcc_Switch &
                         Opts (Opts'First .. Last_Opt) &
                         Opts2 (Opts2'First .. Last_Opt2) & Options_2,
          Driver_Name => Driver_Name);
@@ -530,191 +503,8 @@ package body MLib.Tgt is
       end if;
    end Build_Dynamic_Library;
 
-   -------------
-   -- DLL_Ext --
-   -------------
-
-   function DLL_Ext return String is
-   begin
-      return "exe";
-   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 = ".obj";
-   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 --
-   --------------------
-
-   function Is_Archive_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".olb" or else Ext = ".exe";
-   end Is_Archive_Ext;
-
-   -------------
-   -- Libgnat --
-   -------------
-
-   function Libgnat return String is
-      Libgnat_A : constant String := "libgnat.a";
-      Libgnat_Olb : constant String := "libgnat.olb";
-
-   begin
-      Name_Len := Libgnat_A'Length;
-      Name_Buffer (1 .. Name_Len) := Libgnat_A;
-
-      if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
-         return Libgnat_A;
-
-      else
-         return Libgnat_Olb;
-      end if;
-   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
-         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.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               return Is_Regular_File
-                 (Lib_Dir & Directory_Separator & "lib" &
-                  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;
-      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.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               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 "obj";
-   end Object_Ext;
-
-   ----------------
-   -- PIC_Option --
-   ----------------
-
-   function PIC_Option return String is
-   begin
-      return "";
-   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;
+--  Package initialization
 
-end MLib.Tgt;
+begin
+   Build_Dynamic_Library_Ptr    := Build_Dynamic_Library'Access;
+end MLib.Tgt.Specific;
index ca8ed75460bfc7e0c937277b4d43098864277070..9aad7b879087adc7d3282a2b70e105cd0a640c4e 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                     --
 --                         (Integrity VMS Version)                          --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2004-2005 Free Software Foundation, Inc.        --
+--            Copyright (C) 2004-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- --
 
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-
 with MLib.Fil;
 with MLib.Utl;
-with Namet;    use Namet;
-with Opt;      use Opt;
-with Output;   use Output;
-with Prj.Com;
+
+with MLib.Tgt.VMS;
+pragma Warnings (Off, MLib.Tgt.VMS);
+--  MLib.Tgt.VMS is with'ed only for elaboration purposes
+
+with Opt;    use Opt;
+with Output; use Output;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
 with System;           use System;
 with System.Case_Util; use System.Case_Util;
 with System.CRTL;      use System.CRTL;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
 
-   use GNAT;
+   --  Non default subprogram. See comment in mlib-tgt.ads
+
+   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);
+
+   --  Local variables
 
    Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
    Additional_Objects  : Argument_List_Access := Empty_Argument_List'Access;
    --  Used to add the generated auto-init object files for auto-initializing
    --  stand-alone libraries.
 
-   Macro_Name   : constant String := "mcr gnu:[bin]gcc -c -x assembler";
+   Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
    --  The name of the command to invoke the macro-assembler
 
    VMS_Options : Argument_List := (1 .. 1 => null);
@@ -60,63 +79,15 @@ package body MLib.Tgt is
 
    Gnatsym_Path : String_Access;
 
-   Arguments : Argument_List_Access := null;
+   Arguments     : Argument_List_Access := null;
    Last_Argument : Natural := 0;
 
    Success : Boolean := False;
 
    Shared_Libgcc : aliased String := "-shared-libgcc";
 
-   No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
-   Shared_Libgcc_Switch    : aliased Argument_List :=
-                               (1 => Shared_Libgcc'Access);
-   Link_With_Shared_Libgcc : Argument_List_Access :=
-                               No_Shared_Libgcc_Switch'Access;
-
-   ---------------------
-   -- 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 "olb";
-   end Archive_Ext;
-
-   ---------------------
-   -- Archive_Indexer --
-   ---------------------
-
-   function Archive_Indexer return String is
-   begin
-      return "ranlib";
-   end Archive_Indexer;
-
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
-
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
+   Shared_Libgcc_Switch : constant Argument_List :=
+                            (1 => Shared_Libgcc'Access);
 
    ---------------------------
    -- Build_Dynamic_Library --
@@ -160,9 +131,9 @@ package body MLib.Tgt is
 
       function Version_String return String;
       --  Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
-      --  not Autonomous, otherwise returns "".
-      --  When Symbol_Data.Symbol_Policy is Autonomous, fails gnatmake if
-      --  Lib_Version is not the image of a positive number.
+      --  not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy
+      --  is Autonomous, fails gnatmake if Lib_Version is not the image of a
+      --  positive number.
 
       ------------------
       -- Is_Interface --
@@ -240,6 +211,10 @@ package body MLib.Tgt is
          end if;
       end Version_String;
 
+      ---------------------
+      -- Local Variables --
+      ---------------------
+
       Opt_File_Name  : constant String := Option_File_Name;
       Version        : constant String := Version_String;
       For_Linker_Opt : String_Access;
@@ -247,14 +222,6 @@ package body MLib.Tgt is
    --  Start of processing for Build_Dynamic_Library
 
    begin
-      --  Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
-
-      if GCC_Version >= 3 then
-         Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
-      else
-         Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
-      end if;
-
       --  Option file must end with ".opt"
 
       if Opt_File_Name'Length > 4
@@ -275,7 +242,7 @@ package body MLib.Tgt is
       --  "gnatsym" is necessary for building the option file
 
       if Gnatsym_Path = null then
-         Gnatsym_Path := OS_Lib.Locate_Exec_On_Path (Gnatsym_Name);
+         Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name);
 
          if Gnatsym_Path = null then
             Fail (Gnatsym_Name, " not found in path");
@@ -295,13 +262,15 @@ package body MLib.Tgt is
             Len             : Natural;
             OK              : Boolean := True;
 
-            command  : constant String :=
-                         Macro_Name & " " & Macro_File_Name & ASCII.NUL;
+            command : constant String :=
+                        Macro_Name & " " & Macro_File_Name & ASCII.NUL;
             --  The command to invoke the assembler on the generated auto-init
             --  assembly file.
+            --  Why odd lower case name ???
 
             mode : constant String := "r" & ASCII.NUL;
             --  The mode for the invocation of Popen
+            --  Why odd lower case name ???
 
          begin
             To_Upper (Init_Proc);
@@ -315,26 +284,26 @@ package body MLib.Tgt is
             --  Create and write the auto-init assembly file
 
             declare
-               First_Line : constant String :=
-                 ASCII.HT &
-                 ".type " & Init_Proc & "#, @function" &
-                 ASCII.LF;
+               First_Line  : constant String :=
+                               ASCII.HT
+                               & ".type " & Init_Proc & "#, @function"
+                               & ASCII.LF;
                Second_Line : constant String :=
-                 ASCII.HT &
-                 ".global " & Init_Proc & "#" &
-                 ASCII.LF;
-               Third_Line : constant String :=
-                 ASCII.HT &
-                 ".global LIB$INITIALIZE#" &
-                 ASCII.LF;
+                               ASCII.HT
+                               & ".global " & Init_Proc & "#"
+                               & ASCII.LF;
+               Third_Line  : constant String :=
+                               ASCII.HT
+                               & ".global LIB$INITIALIZE#"
+                               & ASCII.LF;
                Fourth_Line : constant String :=
-                 ASCII.HT &
-                 ".section LIB$INITIALIZE#,""a"",@progbits" &
-                 ASCII.LF;
-               Fifth_Line : constant String :=
-                 ASCII.HT &
-                 "data4 @fptr(" & Init_Proc & "#)" &
-                  ASCII.LF;
+                               ASCII.HT
+                               & ".section LIB$INITIALIZE#,""a"",@progbits"
+                               & ASCII.LF;
+               Fifth_Line  : constant String :=
+                               ASCII.HT
+                               & "data4 @fptr(" & Init_Proc & "#)"
+                               & ASCII.LF;
 
             begin
                Macro_File := Create_File (Macro_File_Name, Text);
@@ -476,6 +445,10 @@ package body MLib.Tgt is
          when Restricted =>
             Last_Argument := Last_Argument + 1;
             Arguments (Last_Argument) := new String'("-R");
+
+         when Direct =>
+            Last_Argument := Last_Argument + 1;
+            Arguments (Last_Argument) := new String'("-D");
       end case;
 
       --  Add each relevant object file
@@ -535,7 +508,7 @@ package body MLib.Tgt is
         (Output_File => Lib_File,
          Objects     => Ofiles & Additional_Objects.all,
          Options     => VMS_Options,
-         Options_2   => Link_With_Shared_Libgcc.all &
+         Options_2   => Shared_Libgcc_Switch &
                         Opts (Opts'First .. Last_Opt) &
                         Opts2 (Opts2'First .. Last_Opt2) & Options_2,
          Driver_Name => Driver_Name);
@@ -549,7 +522,9 @@ package body MLib.Tgt is
          declare
             Auto_Init_Object_File_Name : constant String :=
                                            Lib_Filename & "__init.obj";
+
             Disregard : Boolean;
+            pragma Warnings (Off, Disregard);
 
          begin
             if Verbose_Mode then
@@ -563,190 +538,8 @@ package body MLib.Tgt is
       end if;
    end Build_Dynamic_Library;
 
-   -------------
-   -- DLL_Ext --
-   -------------
-
-   function DLL_Ext return String is
-   begin
-      return "exe";
-   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 = ".obj";
-   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 --
-   --------------------
-
-   function Is_Archive_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".olb" or else Ext = ".exe";
-   end Is_Archive_Ext;
-
-   -------------
-   -- Libgnat --
-   -------------
-
-   function Libgnat return String is
-      Libgnat_A : constant String := "libgnat.a";
-      Libgnat_Olb : constant String := "libgnat.olb";
-
-   begin
-      Name_Len := Libgnat_A'Length;
-      Name_Buffer (1 .. Name_Len) := Libgnat_A;
-
-      if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
-         return Libgnat_A;
-
-      else
-         return Libgnat_Olb;
-      end if;
-   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
-         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.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               return Is_Regular_File
-                 (Lib_Dir & Directory_Separator & "lib" &
-                  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;
-      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.Ext_To (Lib_Name, Archive_Ext));
-
-            else
-               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 "obj";
-   end Object_Ext;
-
-   ----------------
-   -- PIC_Option --
-   ----------------
-
-   function PIC_Option return String is
-   begin
-      return "";
-   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;
+--  Package initialization
 
-end MLib.Tgt;
+begin
+   Build_Dynamic_Library_Ptr    := Build_Dynamic_Library'Access;
+end MLib.Tgt.Specific;
diff --git a/gcc/ada/mlib-tgt-vms.adb b/gcc/ada/mlib-tgt-vms.adb
new file mode 100644 (file)
index 0000000..b01ea9d
--- /dev/null
@@ -0,0 +1,142 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                         M L I B . T G T . V M S                          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2003-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 2,  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 COPYING.  If not, write --
+-- 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 is the part of MLib.Tgt.Specific common to both VMS versions
+
+package body MLib.Tgt.VMS is
+
+   --  Non default subprograms. See comments in mlib-tgt.ads
+
+   function Archive_Ext return String;
+
+   function Default_Symbol_File_Name return String;
+
+   function DLL_Ext return String;
+
+   function Is_Object_Ext (Ext : String) return Boolean;
+
+   function Is_Archive_Ext (Ext : String) return Boolean;
+
+   function Libgnat return String;
+
+   function Object_Ext return String;
+
+   function PIC_Option return String;
+
+   -----------------
+   -- Archive_Ext --
+   -----------------
+
+   function Archive_Ext return String is
+   begin
+      return "olb";
+   end Archive_Ext;
+
+   ------------------------------
+   -- Default_Symbol_File_Name --
+   ------------------------------
+
+   function Default_Symbol_File_Name return String is
+   begin
+      return "symvec.opt";
+   end Default_Symbol_File_Name;
+
+   -------------
+   -- DLL_Ext --
+   -------------
+
+   function DLL_Ext return String is
+   begin
+      return "exe";
+   end DLL_Ext;
+
+   -------------------
+   -- Is_Object_Ext --
+   -------------------
+
+   function Is_Object_Ext (Ext : String) return Boolean is
+   begin
+      return Ext = ".obj";
+   end Is_Object_Ext;
+
+   --------------------
+   -- Is_Archive_Ext --
+   --------------------
+
+   function Is_Archive_Ext (Ext : String) return Boolean is
+   begin
+      return Ext = ".olb" or else Ext = ".exe";
+   end Is_Archive_Ext;
+
+   -------------
+   -- Libgnat --
+   -------------
+
+   function Libgnat return String is
+      Libgnat_A : constant String := "libgnat.a";
+      Libgnat_Olb : constant String := "libgnat.olb";
+
+   begin
+      Name_Len := Libgnat_A'Length;
+      Name_Buffer (1 .. Name_Len) := Libgnat_A;
+
+      if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
+         return Libgnat_A;
+      else
+         return Libgnat_Olb;
+      end if;
+   end Libgnat;
+
+   ----------------
+   -- Object_Ext --
+   ----------------
+
+   function Object_Ext return String is
+   begin
+      return "obj";
+   end Object_Ext;
+
+   ----------------
+   -- PIC_Option --
+   ----------------
+
+   function PIC_Option return String is
+   begin
+      return "";
+   end PIC_Option;
+
+--  Package initialization
+
+begin
+   Archive_Ext_Ptr              := Archive_Ext'Access;
+   Default_Symbol_File_Name_Ptr := Default_Symbol_File_Name'Access;
+   DLL_Ext_Ptr                  := DLL_Ext'Access;
+   Is_Object_Ext_Ptr            := Is_Object_Ext'Access;
+   Is_Archive_Ext_Ptr           := Is_Archive_Ext'Access;
+   Libgnat_Ptr                  := Libgnat'Access;
+   Object_Ext_Ptr               := Object_Ext'Access;
+   PIC_Option_Ptr               := PIC_Option'Access;
+end MLib.Tgt.VMS;
diff --git a/gcc/ada/mlib-tgt-vms.ads b/gcc/ada/mlib-tgt-vms.ads
new file mode 100644 (file)
index 0000000..c544c7f
--- /dev/null
@@ -0,0 +1,31 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                         M L I B . T G T . V M S                          --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 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 2,  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 COPYING.  If not, write --
+-- 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 is the part of MLib.Tgt.Specific common to both VMS versions
+
+package MLib.Tgt.VMS is
+   pragma Elaborate_Body;
+end MLib.Tgt.VMS;
index b9e24afb22727cf4e12283875a798fca02471eee..d658d47ccf39ca1a681f814664a3081bd558a724 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                     --
 --                            (VxWorks Version)                             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2003-2006 Free Software Foundation, Inc.         --
+--           Copyright (C) 2003-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- --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides a set of target dependent routines to build
---  static libraries.
-
 --  This is the VxWorks version of the body
 
-with MLib.Fil;
-with Namet;  use Namet;
-with Prj.Com;
 with Sdefault;
+with Types;    use Types;
 
-package body MLib.Tgt is
+package body MLib.Tgt.Specific is
 
    -----------------------
    -- Local Subprograms --
@@ -45,6 +40,36 @@ package body MLib.Tgt is
    --  Returns the required suffix for some utilities
    --  (such as ar and ranlib) that depend on the real target.
 
+   --  Non default subprograms
+
+   function Archive_Builder return String;
+
+   function Archive_Indexer return String;
+
+   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 DLL_Ext return String;
+
+   function Dynamic_Option return String;
+
+   function PIC_Option return String;
+
+   function Standalone_Library_Auto_Init_Is_Supported return Boolean;
+
+   function Support_For_Libraries return Library_Support;
+
    ---------------------
    -- Archive_Builder --
    ---------------------
@@ -54,24 +79,6 @@ package body MLib.Tgt is
       return "ar" & Get_Target_Suffix;
    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 --
    ---------------------
@@ -81,15 +88,6 @@ package body MLib.Tgt is
       return "ranlib" & Get_Target_Suffix;
    end Archive_Indexer;
 
-   -----------------------------
-   -- Archive_Indexer_Options --
-   -----------------------------
-
-   function Archive_Indexer_Options return String_List_Access is
-   begin
-      return new String_List (1 .. 0);
-   end Archive_Indexer_Options;
-
    ---------------------------
    -- Build_Dynamic_Library --
    ---------------------------
@@ -134,15 +132,6 @@ package body MLib.Tgt is
       return "";
    end DLL_Ext;
 
-   ----------------
-   -- DLL_Prefix --
-   ----------------
-
-   function DLL_Prefix return String is
-   begin
-      return "lib";
-   end DLL_Prefix;
-
    --------------------
    -- Dynamic_Option --
    --------------------
@@ -186,126 +175,6 @@ package body MLib.Tgt is
       end if;
    end Get_Target_Suffix;
 
-   -------------------
-   -- 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 --
-   --------------------
-
-   function Is_Archive_Ext (Ext : String) return Boolean is
-   begin
-      return Ext = ".a";
-   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 --
    ----------------
@@ -333,4 +202,14 @@ package body MLib.Tgt is
       return Static_Only;
    end Support_For_Libraries;
 
-end MLib.Tgt;
+begin
+   Archive_Builder_Ptr := Archive_Builder'Access;
+   Archive_Indexer_Ptr := Archive_Indexer'Access;
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr := DLL_Ext'Access;
+   Dynamic_Option_Ptr := Dynamic_Option'Access;
+   PIC_Option_Ptr := PIC_Option'Access;
+   Standalone_Library_Auto_Init_Is_Supported_Ptr :=
+     Standalone_Library_Auto_Init_Is_Supported'Access;
+   Support_For_Libraries_Ptr := Support_For_Libraries'Access;
+end MLib.Tgt.Specific;
index c1bca97ef2bb791ef59025524332ca08107a5f16..8a242bc08712e15f82b98a9112efc0b0b60f3cc0 100644 (file)
@@ -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- --
 --  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;
index 5bc175e94a762868795eb0fe05f0795e96fe50b2..670db4548b999fe7f1ccc8f118e9cd7d30d650ed 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     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- --
@@ -32,7 +32,7 @@
 --  In the default version, libraries are not supported, so function
 --  Support_For_Libraries return None.
 
-with Prj;         use Prj;
+with Prj; use Prj;
 
 package MLib.Tgt is
 
@@ -59,6 +59,10 @@ package MLib.Tgt is
    function Archive_Builder_Options return String_List_Access;
    --  A list of options to invoke the Archive_Builder, usually "cr" for "ar"
 
+   function Archive_Builder_Append_Options return String_List_Access;
+   --  A list of options to use with the archive builder to append object
+   --  files ("q", for example).
+
    function Archive_Indexer return String;
    --  Returns the name of the program, if any, that generates an index to the
    --  contents of an archive, usually "ranlib". If there is no archive indexer
@@ -79,7 +83,7 @@ package MLib.Tgt is
    --  For Unix and Windows, return "a".
 
    function Object_Ext return String;
-   --  System dependent object extension, without leadien dot.
+   --  System dependent object extension, without leading dot.
    --  On Unix, returns "o".
 
    function DLL_Prefix return String;
@@ -103,6 +107,10 @@ package MLib.Tgt is
    function Is_Archive_Ext (Ext : String) return Boolean;
    --  Returns True iff Ext is an extension for a library
 
+   function Default_Symbol_File_Name return String;
+   --  Returns the name of the symbol file when Library_Symbol_File is not
+   --  specified. Return the empty string when symbol files are not supported.
+
    procedure Build_Dynamic_Library
      (Ofiles       : Argument_List;
       Foreign      : Argument_List;
@@ -113,9 +121,9 @@ package 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);
    --  Build a dynamic/relocatable library
    --
    --  Ofiles is the list of all object files in the library
@@ -158,8 +166,114 @@ package MLib.Tgt is
 
    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;
    --  Returns the file name of the library file of a library project.
    --  This function can only be called for library projects.
 
+private
+   --  Access to subprogram types for indirection
+
+   type String_Function is access function return String;
+   type Is_Ext_Function is access function (Ext : String) return Boolean;
+   type String_List_Access_Function is access function
+     return String_List_Access;
+   type Build_Dynamic_Library_Function is access procedure
+     (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);
+
+   type Library_Exists_For_Function is access function
+     (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
+
+   type Library_File_Name_For_Function is access function
+     (Project : Project_Id;
+      In_Tree : Project_Tree_Ref) return File_Name_Type;
+
+   type Boolean_Function is access function return Boolean;
+
+   type Library_Support_Function is access function return Library_Support;
+
+   function Archive_Builder_Default return String;
+   Archive_Builder_Ptr : String_Function := Archive_Builder_Default'Access;
+
+   function Archive_Builder_Options_Default return String_List_Access;
+   Archive_Builder_Options_Ptr : String_List_Access_Function :=
+                                   Archive_Builder_Options_Default'Access;
+
+   function Archive_Builder_Append_Options_Default return String_List_Access;
+
+   Archive_Builder_Append_Options_Ptr :
+     String_List_Access_Function :=
+       Archive_Builder_Append_Options_Default'Access;
+
+   function Archive_Ext_Default return String;
+   Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access;
+
+   function Archive_Indexer_Default return String;
+   Archive_Indexer_Ptr : String_Function := Archive_Indexer_Default'Access;
+
+   function Archive_Indexer_Options_Default return String_List_Access;
+   Archive_Indexer_Options_Ptr : String_List_Access_Function :=
+                                   Archive_Indexer_Options_Default'Access;
+
+   function Default_Symbol_File_Name_Default return String;
+   Default_Symbol_File_Name_Ptr : String_Function :=
+                                    Default_Symbol_File_Name_Default'Access;
+
+   Build_Dynamic_Library_Ptr : Build_Dynamic_Library_Function;
+
+   function DLL_Ext_Default return String;
+   DLL_Ext_Ptr : String_Function := DLL_Ext_Default'Access;
+
+   function DLL_Prefix_Default return String;
+   DLL_Prefix_Ptr : String_Function := DLL_Prefix_Default'Access;
+
+   function Dynamic_Option_Default return String;
+   Dynamic_Option_Ptr : String_Function := Dynamic_Option_Default'Access;
+
+   function Is_Object_Ext_Default (Ext : String) return Boolean;
+   Is_Object_Ext_Ptr : Is_Ext_Function := Is_Object_Ext_Default'Access;
+
+   function Is_C_Ext_Default (Ext : String) return Boolean;
+   Is_C_Ext_Ptr : Is_Ext_Function := Is_C_Ext_Default'Access;
+
+   function Is_Archive_Ext_Default (Ext : String) return Boolean;
+   Is_Archive_Ext_Ptr : Is_Ext_Function := Is_Archive_Ext_Default'Access;
+
+   function Libgnat_Default return String;
+   Libgnat_Ptr : String_Function := Libgnat_Default'Access;
+
+   function Library_Exists_For_Default
+     (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
+   Library_Exists_For_Ptr : Library_Exists_For_Function :=
+                              Library_Exists_For_Default'Access;
+
+   function Library_File_Name_For_Default
+     (Project : Project_Id;
+      In_Tree : Project_Tree_Ref) return File_Name_Type;
+   Library_File_Name_For_Ptr : Library_File_Name_For_Function :=
+                                 Library_File_Name_For_Default'Access;
+
+   function Object_Ext_Default return String;
+   Object_Ext_Ptr : String_Function := Object_Ext_Default'Access;
+
+   function PIC_Option_Default return String;
+   PIC_Option_Ptr : String_Function := PIC_Option_Default'Access;
+
+   function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean;
+   Standalone_Library_Auto_Init_Is_Supported_Ptr : Boolean_Function :=
+            Standalone_Library_Auto_Init_Is_Supported_Default'Access;
+
+   function Support_For_Libraries_Default return Library_Support;
+   Support_For_Libraries_Ptr : Library_Support_Function :=
+                                 Support_For_Libraries_Default'Access;
 end MLib.Tgt;