OSDN Git Service

2007-04-20 Ed Schonberg <schonberg@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / mlib-tgt-tru64.adb
index 267f65d..50290d2 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-2005 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.
+--  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,*";
-
-   No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-   Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
-
-   Wl_Init_String : aliased String         := "-Wl,-init";
-   Wl_Init        : constant String_Access := Wl_Init_String'Access;
-   Wl_Fini_String : aliased String         := "-Wl,-fini";
-   Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
-
-   Init_Fini_List :  constant Argument_List_Access :=
-                       new Argument_List'(1 => Wl_Init,
-                                          2 => null,
-                                          3 => Wl_Fini,
-                                          4 => null);
-   --  Used to put switches for automatic elaboration/finalization
-
-   ---------------------
-   -- 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 subprogram
 
-   -----------------
-   -- 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 --
@@ -127,16 +83,16 @@ package body MLib.Tgt is
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
       pragma Unreferenced (Symbol_Data);
+      pragma Unreferenced (Auto_Init);
+      --  Initialization is done through the contructor mechanism
 
       Lib_File : constant String :=
                    Lib_Dir & Directory_Separator & "lib" &
-                   Fil.Ext_To (Lib_Filename, DLL_Ext);
+                   Fil.Append_To (Lib_Filename, DLL_Ext);
 
       Version_Arg          : String_Access;
       Symbolic_Link_Needed : Boolean := False;
 
-      Init_Fini : Argument_List_Access := Empty_Argument_List;
-
    begin
       if Opt.Verbose_Mode then
          Write_Str ("building relocatable shared library ");
@@ -145,20 +101,11 @@ package body MLib.Tgt is
 
       --  If specified, add automatic elaboration/finalization
 
-      if Auto_Init then
-         Init_Fini := Init_Fini_List;
-         Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-         Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-      end if;
-
       if Lib_Version = "" then
          Utl.Gcc
            (Output_File => Lib_File,
             Objects     => Ofiles,
-            Options     =>
-              Options &
-              Expect_Unresolved'Access &
-              Init_Fini.all,
+            Options     => Options & Expect_Unresolved'Access,
             Options_2   => Options_2,
             Driver_Name => Driver_Name);
 
@@ -170,10 +117,7 @@ package body MLib.Tgt is
               (Output_File => Lib_Version,
                Objects     => Ofiles,
                Options     =>
-                 Options &
-                 Version_Arg &
-                 Expect_Unresolved'Access &
-                 Init_Fini.all,
+                 Options & Version_Arg & Expect_Unresolved'Access,
                Options_2   => Options_2,
                Driver_Name => Driver_Name);
             Symbolic_Link_Needed := Lib_Version /= Lib_File;
@@ -183,10 +127,7 @@ package body MLib.Tgt is
               (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                Objects     => Ofiles,
                Options     =>
-                 Options &
-                 Version_Arg &
-                 Expect_Unresolved'Access &
-                 Init_Fini.all,
+                 Options & Version_Arg & Expect_Unresolved'Access,
                Options_2   => Options_2,
                Driver_Name => Driver_Name);
             Symbolic_Link_Needed :=
@@ -222,42 +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;
-
-   --------------------
-   -- 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 --
    --------------------
@@ -267,101 +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.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 "o";
-   end Object_Ext;
-
    ----------------
    -- PIC_Option --
    ----------------
@@ -371,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;