diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:15:24 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:15:24 +0000 |
| commit | 9ddd4ab9339105b6c6bbfc569add25e25898119f (patch) | |
| tree | e3ad95a5caf09f3f07c1c1bd55bfd20e252e81b3 | |
| parent | 6627c62635ac31e87d0998aacef986b3b4142a7d (diff) | |
| download | gcc-9ddd4ab9339105b6c6bbfc569add25e25898119f.tar.gz | |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125366 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/ada/mlib-tgt-aix.adb | 240 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-darwin.adb | 245 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-hpux.adb | 230 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-irix.adb | 238 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-linux.adb | 289 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-lynxos.adb | 209 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-mingw.adb | 217 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-solaris.adb | 238 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-specific.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-specific.ads | 35 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-tru64.adb | 233 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms-alpha.adb | 310 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms-ia64.adb | 355 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms.adb | 142 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms.ads | 31 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vxworks.adb | 211 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt.adb | 343 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt.ads | 128 |
18 files changed, 1114 insertions, 2611 deletions
diff --git a/gcc/ada/mlib-tgt-aix.adb b/gcc/ada/mlib-tgt-aix.adb index 12fb4694b86..9545e8af2bf 100644 --- a/gcc/ada/mlib-tgt-aix.adb +++ b/gcc/ada/mlib-tgt-aix.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,22 +25,40 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-darwin.adb b/gcc/ada/mlib-tgt-darwin.adb index 31f03083833..3ae2fcfbdb6 100644 --- a/gcc/ada/mlib-tgt-darwin.adb +++ b/gcc/ada/mlib-tgt-darwin.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,70 +25,53 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-hpux.adb b/gcc/ada/mlib-tgt-hpux.adb index 985667d7200..63ff69ec0d2 100644 --- a/gcc/ada/mlib-tgt-hpux.adb +++ b/gcc/ada/mlib-tgt-hpux.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,65 +25,35 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index 2df88abe88d..3b45aea0df7 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,65 +25,33 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index 737a40a9ee8..848a11ca4e7 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (GNU/Linux Version) -- -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,68 +25,35 @@ -- -- ------------------------------------------------------------------------------ --- This package provides a set of target dependent routines to build --- static, dynamic and shared libraries. - -- This is the GNU/Linux version of the body with MLib.Fil; with MLib.Utl; -with Namet; use Namet; with Opt; with Output; use Output; -with Prj.Com; with System; -package body MLib.Tgt is +package body MLib.Tgt.Specific is - use GNAT; use MLib; - --------------------- - -- Archive_Builder -- - --------------------- - - function Archive_Builder return String is - begin - return "ar"; - end Archive_Builder; - - ----------------------------- - -- Archive_Builder_Options -- - ----------------------------- - - function Archive_Builder_Options return String_List_Access is - begin - return new String_List'(1 => new String'("cr")); - end Archive_Builder_Options; - - ----------------- - -- Archive_Ext -- - ----------------- - - function Archive_Ext return String is - begin - return "a"; - end Archive_Ext; - - --------------------- - -- Archive_Indexer -- - --------------------- + -- Non default subprograms - function Archive_Indexer return String is - begin - return "ranlib"; - end Archive_Indexer; + procedure Build_Dynamic_Library + (Ofiles : Argument_List; + Foreign : Argument_List; + Afiles : Argument_List; + Options : Argument_List; + Options_2 : Argument_List; + Interfaces : Argument_List; + Lib_Filename : String; + Lib_Dir : String; + Symbol_Data : Symbol_Record; + Driver_Name : Name_Id := No_Name; + Lib_Version : String := ""; + Auto_Init : Boolean := False); - ----------------------------- - -- Archive_Indexer_Options -- - ----------------------------- - - function Archive_Indexer_Options return String_List_Access is - begin - return new String_List (1 .. 0); - end Archive_Indexer_Options; + function Is_Archive_Ext (Ext : String) return Boolean; --------------------------- -- Build_Dynamic_Library -- @@ -114,8 +81,10 @@ package body MLib.Tgt is -- Initialization is done through the contructor mechanism Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -123,12 +92,12 @@ package body MLib.Tgt is begin if Opt.Verbose_Mode then Write_Str ("building relocatable shared library "); - Write_Line (Lib_File); + Write_Line (Lib_Path); end if; if Lib_Version = "" then Utl.Gcc - (Output_File => Lib_File, + (Output_File => Lib_Path, Objects => Ofiles, Options => Options, Driver_Name => Driver_Name, @@ -194,7 +163,7 @@ package body MLib.Tgt is Options => Options & Version_Arg, Driver_Name => Driver_Name, Options_2 => Options_2); - Symbolic_Link_Needed := Lib_Version /= Lib_File; + Symbolic_Link_Needed := Lib_Version /= Lib_Path; else Utl.Gcc @@ -204,14 +173,14 @@ package body MLib.Tgt is Driver_Name => Driver_Name, Options_2 => Options_2); Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; + Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; end if; if Symbolic_Link_Needed then declare Success : Boolean; Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); + Newpath : String (1 .. Lib_Path'Length + 1); Result : Integer; pragma Unreferenced (Result); @@ -224,63 +193,48 @@ package body MLib.Tgt is begin Oldpath (1 .. Lib_Version'Length) := Lib_Version; Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; + Newpath (1 .. Lib_Path'Length) := Lib_Path; Newpath (Newpath'Last) := ASCII.NUL; - Delete_File (Lib_File, Success); + Delete_File (Lib_Path, Success); Result := Symlink (Oldpath'Address, Newpath'Address); end; + + if Ok_Maj then + declare + Success : Boolean; + Oldpath : String (1 .. Lib_Version'Length + 1); + Maj_Path : constant String := + Lib_Dir & Directory_Separator & + Maj_Version (1 .. Last_Maj); + Newpath : String (1 .. Maj_Path'Length + 1); + + Result : Integer; + pragma Unreferenced (Result); + + function Symlink + (Oldpath : System.Address; + Newpath : System.Address) return Integer; + pragma Import (C, Symlink, "__gnat_symlink"); + + begin + Oldpath (1 .. Lib_Version'Length) := Lib_Version; + Oldpath (Oldpath'Last) := ASCII.NUL; + Newpath (1 .. Maj_Path'Length) := Maj_Path; + Newpath (Newpath'Last) := ASCII.NUL; + + Delete_File (Maj_Path, Success); + + Result := Symlink (Oldpath'Address, Newpath'Address); + end; + end if; + end if; end; end if; end Build_Dynamic_Library; - ------------- - -- DLL_Ext -- - ------------- - - function DLL_Ext return String is - begin - return "so"; - end DLL_Ext; - - ---------------- - -- DLL_Prefix -- - ---------------- - - function DLL_Prefix return String is - begin - return "lib"; - end DLL_Prefix; - - -------------------- - -- Dynamic_Option -- - -------------------- - - function Dynamic_Option return String is - begin - return "-shared"; - end Dynamic_Option; - - ------------------- - -- Is_Object_Ext -- - ------------------- - - function Is_Object_Ext (Ext : String) return Boolean is - begin - return Ext = ".o"; - end Is_Object_Ext; - - -------------- - -- Is_C_Ext -- - -------------- - - function Is_C_Ext (Ext : String) return Boolean is - begin - return Ext = ".c"; - end Is_C_Ext; - -------------------- -- Is_Archive_Ext -- -------------------- @@ -290,124 +244,7 @@ package body MLib.Tgt is return Ext = ".a" or else Ext = ".so"; end Is_Archive_Ext; - ------------- - -- Libgnat -- - ------------- - - function Libgnat return String is - begin - return "libgnat.a"; - end Libgnat; - - ------------------------ - -- Library_Exists_For -- - ------------------------ - - function Library_Exists_For - (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Boolean - is - begin - if not In_Tree.Projects.Table (Project).Library then - Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & - "for non library project"); - return False; - - else - declare - Lib_Dir : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Dir); - Lib_Name : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Name); - - begin - if In_Tree.Projects.Table (Project).Library_Kind = Static then - return Is_Regular_File - (Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Name, Archive_Ext)); - - else - return Is_Regular_File - (Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Name, DLL_Ext)); - end if; - end; - end if; - end Library_Exists_For; - - --------------------------- - -- Library_File_Name_For -- - --------------------------- - - function Library_File_Name_For - (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Name_Id - is - begin - if not In_Tree.Projects.Table (Project).Library then - Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & - "for non library project"); - return No_Name; - - else - declare - Lib_Name : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Name); - - begin - Name_Len := 3; - Name_Buffer (1 .. Name_Len) := "lib"; - - if In_Tree.Projects.Table (Project).Library_Kind = - Static - then - Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext)); - else - Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext)); - end if; - - return Name_Find; - end; - end if; - end Library_File_Name_For; - - ---------------- - -- Object_Ext -- - ---------------- - - function Object_Ext return String is - begin - return "o"; - end Object_Ext; - - ---------------- - -- PIC_Option -- - ---------------- - - function PIC_Option return String is - begin - return "-fPIC"; - end PIC_Option; - - ----------------------------------------------- - -- Standalone_Library_Auto_Init_Is_Supported -- - ----------------------------------------------- - - function Standalone_Library_Auto_Init_Is_Supported return Boolean is - begin - return True; - end Standalone_Library_Auto_Init_Is_Supported; - - --------------------------- - -- Support_For_Libraries -- - --------------------------- - - function Support_For_Libraries return Library_Support is - begin - return Full; - end Support_For_Libraries; - -end MLib.Tgt; +begin + Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; + Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; +end MLib.Tgt.Specific; diff --git a/gcc/ada/mlib-tgt-lynxos.adb b/gcc/ada/mlib-tgt-lynxos.adb index 4da0d4ab81f..0a667d50014 100644 --- a/gcc/ada/mlib-tgt-lynxos.adb +++ b/gcc/ada/mlib-tgt-lynxos.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,61 +25,35 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 675f0152175..cba87e59b37 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,72 +25,46 @@ -- -- ------------------------------------------------------------------------------ --- 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 -- @@ -156,33 +130,6 @@ package body MLib.Tgt is 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; diff --git a/gcc/ada/mlib-tgt-solaris.adb b/gcc/ada/mlib-tgt-solaris.adb index a66753e2c6c..1692ccdb28b 100644 --- a/gcc/ada/mlib-tgt-solaris.adb +++ b/gcc/ada/mlib-tgt-solaris.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,65 +25,33 @@ -- -- ------------------------------------------------------------------------------ --- 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 index 00000000000..03067b9c1ed --- /dev/null +++ b/gcc/ada/mlib-tgt-specific.adb @@ -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 index 00000000000..f35c04fe4c2 --- /dev/null +++ b/gcc/ada/mlib-tgt-specific.ads @@ -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; diff --git a/gcc/ada/mlib-tgt-tru64.adb b/gcc/ada/mlib-tgt-tru64.adb index a211d650869..50290d26897 100644 --- a/gcc/ada/mlib-tgt-tru64.adb +++ b/gcc/ada/mlib-tgt-tru64.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,70 +25,41 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt-vms-alpha.adb b/gcc/ada/mlib-tgt-vms-alpha.adb index 8c2aa1b023b..b091799764a 100644 --- a/gcc/ada/mlib-tgt-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-vms-alpha.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -29,22 +29,41 @@ 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; diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index ca8ed75460b..9aad7b87908 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -29,29 +29,48 @@ 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 index 00000000000..b01ea9d899f --- /dev/null +++ b/gcc/ada/mlib-tgt-vms.adb @@ -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 index 00000000000..c544c7f4e10 --- /dev/null +++ b/gcc/ada/mlib-tgt-vms.ads @@ -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; diff --git a/gcc/ada/mlib-tgt-vxworks.adb b/gcc/ada/mlib-tgt-vxworks.adb index b9e24afb227..d658d47ccf3 100644 --- a/gcc/ada/mlib-tgt-vxworks.adb +++ b/gcc/ada/mlib-tgt-vxworks.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (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- -- @@ -25,17 +25,12 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/mlib-tgt.adb b/gcc/ada/mlib-tgt.adb index c1bca97ef2b..8a242bc0871 100644 --- a/gcc/ada/mlib-tgt.adb +++ b/gcc/ada/mlib-tgt.adb @@ -3,11 +3,10 @@ -- GNAT COMPILER COMPONENTS -- -- -- -- M L I B . T G T -- --- (Default Version) -- -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2007, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,6 +28,13 @@ -- All subprograms are dummies, because they are never called, -- except Support_For_Libraries which returns None. +with MLib.Fil; +with Prj.Com; + +with MLib.Tgt.Specific; +pragma Warnings (Off, MLib.Tgt.Specific); +-- MLib.Tgt.Specific is with'ed only for elaboration purposes + package body MLib.Tgt is --------------------- @@ -37,45 +43,108 @@ package body MLib.Tgt is function Archive_Builder return String is begin - return "ar"; + return Archive_Builder_Ptr.all; end Archive_Builder; ----------------------------- + -- Archive_Builder_Default -- + ----------------------------- + + function Archive_Builder_Default return String is + begin + return "ar"; + end Archive_Builder_Default; + + ----------------------------- -- Archive_Builder_Options -- ----------------------------- function Archive_Builder_Options return String_List_Access is begin - return new String_List'(1 => new String'("cr")); + return Archive_Builder_Options_Ptr.all; end Archive_Builder_Options; + ------------------------------------- + -- Archive_Builder_Options_Default -- + ------------------------------------- + + function Archive_Builder_Options_Default return String_List_Access is + begin + return new String_List'(1 => new String'("cr")); + end Archive_Builder_Options_Default; + + ------------------------------------ + -- Archive_Builder_Append_Options -- + ------------------------------------ + + function Archive_Builder_Append_Options return String_List_Access is + begin + return Archive_Builder_Append_Options_Ptr.all; + end Archive_Builder_Append_Options; + + -------------------------------------------- + -- Archive_Builder_Append_Options_Default -- + -------------------------------------------- + + function Archive_Builder_Append_Options_Default return String_List_Access is + begin + return new String_List'(1 => new String'("q")); + end Archive_Builder_Append_Options_Default; + ----------------- -- Archive_Ext -- ----------------- function Archive_Ext return String is begin - return ""; + return Archive_Ext_Ptr.all; end Archive_Ext; + ------------------------- + -- Archive_Ext_Default -- + ------------------------- + + function Archive_Ext_Default return String is + begin + return "a"; + end Archive_Ext_Default; + --------------------- -- Archive_Indexer -- --------------------- function Archive_Indexer return String is begin - return "ranlib"; + return Archive_Indexer_Ptr.all; end Archive_Indexer; ----------------------------- + -- Archive_Indexer_Default -- + ----------------------------- + + function Archive_Indexer_Default return String is + begin + return "ranlib"; + end Archive_Indexer_Default; + + ----------------------------- -- Archive_Indexer_Options -- ----------------------------- function Archive_Indexer_Options return String_List_Access is begin - return new String_List (1 .. 0); + return Archive_Indexer_Options_Ptr.all; end Archive_Indexer_Options; + ------------------------------------- + -- Archive_Indexer_Options_Default -- + ------------------------------------- + + function Archive_Indexer_Options_Default return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options_Default; + --------------------------- -- Build_Dynamic_Library -- --------------------------- @@ -90,93 +159,170 @@ package body MLib.Tgt is Lib_Filename : String; Lib_Dir : String; Symbol_Data : Symbol_Record; - Driver_Name : Name_Id := No_Name; - Lib_Version : String := ""; - Auto_Init : Boolean := False) + Driver_Name : Name_Id := No_Name; + Lib_Version : String := ""; + Auto_Init : Boolean := False) is - pragma Unreferenced (Ofiles); - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); - pragma Unreferenced (Options); - pragma Unreferenced (Options_2); - pragma Unreferenced (Interfaces); - pragma Unreferenced (Lib_Filename); - pragma Unreferenced (Lib_Dir); - pragma Unreferenced (Symbol_Data); - pragma Unreferenced (Driver_Name); - pragma Unreferenced (Lib_Version); - pragma Unreferenced (Auto_Init); - - begin - null; + begin + Build_Dynamic_Library_Ptr + (Ofiles, + Foreign, + Afiles, + Options, + Options_2, + Interfaces, + Lib_Filename, + Lib_Dir, + Symbol_Data, + Driver_Name, + Lib_Version, + Auto_Init); end Build_Dynamic_Library; + ------------------------------ + -- Default_Symbol_File_Name -- + ------------------------------ + + function Default_Symbol_File_Name return String is + begin + return Default_Symbol_File_Name_Ptr.all; + end Default_Symbol_File_Name; + + -------------------------------------- + -- Default_Symbol_File_Name_Default -- + -------------------------------------- + + function Default_Symbol_File_Name_Default return String is + begin + return ""; + end Default_Symbol_File_Name_Default; + ------------- -- DLL_Ext -- ------------- function DLL_Ext return String is begin - return ""; + return DLL_Ext_Ptr.all; end DLL_Ext; + --------------------- + -- DLL_Ext_Default -- + --------------------- + + function DLL_Ext_Default return String is + begin + return "so"; + end DLL_Ext_Default; + ---------------- -- DLL_Prefix -- ---------------- function DLL_Prefix return String is begin - return "lib"; + return DLL_Prefix_Ptr.all; end DLL_Prefix; + ------------------------ + -- DLL_Prefix_Default -- + ------------------------ + + function DLL_Prefix_Default return String is + begin + return "lib"; + end DLL_Prefix_Default; + -------------------- -- Dynamic_Option -- -------------------- function Dynamic_Option return String is begin - return ""; + return Dynamic_Option_Ptr.all; end Dynamic_Option; + ---------------------------- + -- Dynamic_Option_Default -- + ---------------------------- + + function Dynamic_Option_Default return String is + begin + return "-shared"; + end Dynamic_Option_Default; + ------------------- -- Is_Object_Ext -- ------------------- function Is_Object_Ext (Ext : String) return Boolean is - pragma Unreferenced (Ext); begin - return False; + return Is_Object_Ext_Ptr (Ext); end Is_Object_Ext; + --------------------------- + -- Is_Object_Ext_Default -- + --------------------------- + + function Is_Object_Ext_Default (Ext : String) return Boolean is + begin + return Ext = ".o"; + end Is_Object_Ext_Default; + -------------- -- Is_C_Ext -- -------------- function Is_C_Ext (Ext : String) return Boolean is - pragma Unreferenced (Ext); begin - return False; + return Is_C_Ext_Ptr (Ext); end Is_C_Ext; + ---------------------- + -- Is_C_Ext_Default -- + ---------------------- + + function Is_C_Ext_Default (Ext : String) return Boolean is + begin + return Ext = ".c"; + end Is_C_Ext_Default; + -------------------- -- Is_Archive_Ext -- -------------------- function Is_Archive_Ext (Ext : String) return Boolean is - pragma Unreferenced (Ext); begin - return False; + return Is_Archive_Ext_Ptr (Ext); end Is_Archive_Ext; + ---------------------------- + -- Is_Archive_Ext_Default -- + ---------------------------- + + function Is_Archive_Ext_Default (Ext : String) return Boolean is + begin + return Ext = ".a"; + end Is_Archive_Ext_Default; + ------------- -- Libgnat -- ------------- function Libgnat return String is begin - return "libgnat.a"; + return Libgnat_Ptr.all; end Libgnat; + --------------------- + -- Libgnat_Default -- + --------------------- + + function Libgnat_Default return String is + begin + return "libgnat.a"; + end Libgnat_Default; + ------------------------ -- Library_Exists_For -- ------------------------ @@ -184,60 +330,165 @@ package body MLib.Tgt is function Library_Exists_For (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean is - pragma Unreferenced (Project); - pragma Unreferenced (In_Tree); begin - return False; + return Library_Exists_For_Ptr (Project, In_Tree); end Library_Exists_For; + -------------------------------- + -- Library_Exists_For_Default -- + -------------------------------- + + function Library_Exists_For_Default + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is + begin + if not In_Tree.Projects.Table (Project).Library then + Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & + "for non library project"); + return False; + + else + declare + Lib_Dir : constant String := + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); + Lib_Name : constant String := + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); + + begin + if In_Tree.Projects.Table (Project).Library_Kind = Static then + return Is_Regular_File + (Lib_Dir & Directory_Separator & "lib" & + Fil.Append_To (Lib_Name, Archive_Ext)); + + else + return Is_Regular_File + (Lib_Dir & Directory_Separator & DLL_Prefix & + Fil.Append_To (Lib_Name, DLL_Ext)); + end if; + end; + end if; + end Library_Exists_For_Default; + --------------------------- -- Library_File_Name_For -- --------------------------- function Library_File_Name_For (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Name_Id + In_Tree : Project_Tree_Ref) return File_Name_Type is - pragma Unreferenced (Project); - pragma Unreferenced (In_Tree); begin - return No_Name; + return Library_File_Name_For_Ptr (Project, In_Tree); end Library_File_Name_For; + ----------------------------------- + -- Library_File_Name_For_Default -- + ----------------------------------- + + function Library_File_Name_For_Default + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return File_Name_Type + is + begin + if not In_Tree.Projects.Table (Project).Library then + Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & + "for non library project"); + return No_File; + + else + declare + Lib_Name : constant String := + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); + + begin + if In_Tree.Projects.Table (Project).Library_Kind = Static then + Name_Len := 3; + Name_Buffer (1 .. Name_Len) := "lib"; + Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext)); + else + Name_Len := 0; + Add_Str_To_Name_Buffer (DLL_Prefix); + Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext)); + end if; + + return Name_Find; + end; + end if; + end Library_File_Name_For_Default; + ---------------- -- Object_Ext -- ---------------- function Object_Ext return String is begin - return ""; + return Object_Ext_Ptr.all; end Object_Ext; + ------------------------ + -- Object_Ext_Default -- + ------------------------ + + function Object_Ext_Default return String is + begin + return "o"; + end Object_Ext_Default; + ---------------- -- PIC_Option -- ---------------- function PIC_Option return String is begin - return ""; + return PIC_Option_Ptr.all; end PIC_Option; + ------------------------ + -- PIC_Option_Default -- + ------------------------ + + function PIC_Option_Default return String is + begin + return "-fPIC"; + end PIC_Option_Default; + ----------------------------------------------- -- Standalone_Library_Auto_Init_Is_Supported -- ----------------------------------------------- function Standalone_Library_Auto_Init_Is_Supported return Boolean is begin - return False; + return Standalone_Library_Auto_Init_Is_Supported_Ptr.all; end Standalone_Library_Auto_Init_Is_Supported; + ------------------------------------------------------- + -- Standalone_Library_Auto_Init_Is_Supported_Default -- + ------------------------------------------------------- + + function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean is + begin + return True; + end Standalone_Library_Auto_Init_Is_Supported_Default; + --------------------------- -- Support_For_Libraries -- --------------------------- function Support_For_Libraries return Library_Support is begin - return None; + return Support_For_Libraries_Ptr.all; end Support_For_Libraries; + ----------------------------------- + -- Support_For_Libraries_Default -- + ----------------------------------- + + function Support_For_Libraries_Default return Library_Support is + begin + return Full; + end Support_For_Libraries_Default; + end MLib.Tgt; diff --git a/gcc/ada/mlib-tgt.ads b/gcc/ada/mlib-tgt.ads index 5bc175e94a7..670db4548b9 100644 --- a/gcc/ada/mlib-tgt.ads +++ b/gcc/ada/mlib-tgt.ads @@ -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; |