mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-16 13:01:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

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

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

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

From-SVN: r125366
This commit is contained in:
Vincent Celier 2007-06-06 12:15:24 +02:00 committed by Arnaud Charlet
parent a538d22621
commit 6bb81bc17c
18 changed files with 1125 additions and 2622 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

240
gcc/ada/mlib-tgt-aix.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (AIX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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;

253
gcc/ada/mlib-tgt-darwin.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Darwin Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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
package body MLib.Tgt.Specific is
-- Non default subprograms
function Archive_Indexer_Options return String_List_Access;
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 Is_Archive_Ext (Ext : String) return Boolean;
-- Local objects
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.
Shared_Libgcc : aliased String := "-shared-libgcc";
Shared_Libgcc : aliased String := "-shared-libgcc";
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);
---------------------
-- 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;
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;

230
gcc/ada/mlib-tgt-hpux.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (HP-UX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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
package body MLib.Tgt.Specific is
---------------------
-- Archive_Builder --
---------------------
-- Non default subprograms
function Archive_Builder return String is
begin
return "ar";
end 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);
-----------------------------
-- Archive_Builder_Options --
-----------------------------
function DLL_Ext return String;
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;
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;

238
gcc/ada/mlib-tgt-irix.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (IRIX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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
package body MLib.Tgt.Specific is
---------------------
-- Archive_Builder --
---------------------
-- Non default subprogram
function Archive_Builder return String is
begin
return "ar";
end 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);
-----------------------------
-- 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;
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;

289
gcc/ada/mlib-tgt-linux.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (GNU/Linux Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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 --
---------------------
-- Non default subprograms
function Archive_Builder return String is
begin
return "ar";
end 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);
-----------------------------
-- 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;
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;

209
gcc/ada/mlib-tgt-lynxos.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (LynxOS Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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.Specific is
package body MLib.Tgt is
-- Non default subprograms
---------------------
-- 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 PIC_Option return String;
-----------------
-- Archive_Ext --
-----------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean;
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;
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;

225
gcc/ada/mlib-tgt-mingw.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Windows Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -25,73 +25,47 @@
-- --
------------------------------------------------------------------------------
-- 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;
-- 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 DLL_Prefix return String;
function Is_Archive_Ext (Ext : String) return Boolean;
function PIC_Option return String;
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;
-----------------
-- 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 --
---------------------------
@ -155,33 +129,6 @@ package body MLib.Tgt is
return "";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
@ -191,98 +138,6 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".dll";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator &
MLib.Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Name_Len := 0;
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
@ -292,22 +147,10 @@ package body MLib.Tgt is
return "";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
DLL_Prefix_Ptr := DLL_Prefix'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access;
end MLib.Tgt.Specific;

238
gcc/ada/mlib-tgt-solaris.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Solaris Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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
package body MLib.Tgt.Specific is
---------------------
-- Archive_Builder --
---------------------
-- Non default subprograms
function Archive_Builder return String is
begin
return "ar";
end 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);
-----------------------------
-- 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;
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;

31
gcc/ada/mlib-tgt-specific.adb Normal file
View File

@ -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;

35
gcc/ada/mlib-tgt-specific.ads Normal file
View File

@ -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;

241
gcc/ada/mlib-tgt-tru64.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (True64 Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -25,71 +25,42 @@
-- --
------------------------------------------------------------------------------
-- 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;
-- Non default subprogram
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 Is_Archive_Ext (Ext : String) return Boolean;
function PIC_Option return String;
-- Local variables
Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
---------------------
-- 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 --
---------------------------
@ -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;

310
gcc/ada/mlib-tgt-vms-alpha.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Alpha VMS Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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
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;
@ -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 --
-------------
-- Package initialization
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;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
end MLib.Tgt.Specific;

355
gcc/ada/mlib-tgt-vms-ia64.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Integrity VMS Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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 --
-------------
-- Package initialization
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;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
end MLib.Tgt.Specific;

142
gcc/ada/mlib-tgt-vms.adb Normal file
View File

@ -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;

31
gcc/ada/mlib-tgt-vms.ads Normal file
View File

@ -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;

211
gcc/ada/mlib-tgt-vxworks.adb
View File

@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (VxWorks Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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;

341
gcc/ada/mlib-tgt.adb
View File

@ -3,11 +3,10 @@
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- (Default Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -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;
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;

128
gcc/ada/mlib-tgt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2005, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -32,7 +32,7 @@
-- In the default version, libraries are not supported, so function
-- Support_For_Libraries return None.
with Prj; use Prj;
with Prj; use Prj;
package MLib.Tgt is
@ -59,6 +59,10 @@ package MLib.Tgt is
function Archive_Builder_Options return String_List_Access;
-- A list of options to invoke the Archive_Builder, usually "cr" for "ar"
function Archive_Builder_Append_Options return String_List_Access;
-- A list of options to use with the archive builder to append object
-- files ("q", for example).
function Archive_Indexer return String;
-- Returns the name of the program, if any, that generates an index to the
-- contents of an archive, usually "ranlib". If there is no archive indexer
@ -79,7 +83,7 @@ package MLib.Tgt is
-- For Unix and Windows, return "a".
function Object_Ext return String;
-- System dependent object extension, without leadien dot.
-- System dependent object extension, without leading dot.
-- On Unix, returns "o".
function DLL_Prefix return String;
@ -103,6 +107,10 @@ package MLib.Tgt is
function Is_Archive_Ext (Ext : String) return Boolean;
-- Returns True iff Ext is an extension for a library
function Default_Symbol_File_Name return String;
-- Returns the name of the symbol file when Library_Symbol_File is not
-- specified. Return the empty string when symbol files are not supported.
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
@ -113,9 +121,9 @@ package MLib.Tgt is
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
-- Build a dynamic/relocatable library
--
-- Ofiles is the list of all object files in the library
@ -158,8 +166,114 @@ package MLib.Tgt is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type;
-- Returns the file name of the library file of a library project.
-- This function can only be called for library projects.
private
-- Access to subprogram types for indirection
type String_Function is access function return String;
type Is_Ext_Function is access function (Ext : String) return Boolean;
type String_List_Access_Function is access function
return String_List_Access;
type Build_Dynamic_Library_Function is access procedure
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
type Library_Exists_For_Function is access function
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
type Library_File_Name_For_Function is access function
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type;
type Boolean_Function is access function return Boolean;
type Library_Support_Function is access function return Library_Support;
function Archive_Builder_Default return String;
Archive_Builder_Ptr : String_Function := Archive_Builder_Default'Access;
function Archive_Builder_Options_Default return String_List_Access;
Archive_Builder_Options_Ptr : String_List_Access_Function :=
Archive_Builder_Options_Default'Access;
function Archive_Builder_Append_Options_Default return String_List_Access;
Archive_Builder_Append_Options_Ptr :
String_List_Access_Function :=
Archive_Builder_Append_Options_Default'Access;
function Archive_Ext_Default return String;
Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access;
function Archive_Indexer_Default return String;
Archive_Indexer_Ptr : String_Function := Archive_Indexer_Default'Access;
function Archive_Indexer_Options_Default return String_List_Access;
Archive_Indexer_Options_Ptr : String_List_Access_Function :=
Archive_Indexer_Options_Default'Access;
function Default_Symbol_File_Name_Default return String;
Default_Symbol_File_Name_Ptr : String_Function :=
Default_Symbol_File_Name_Default'Access;
Build_Dynamic_Library_Ptr : Build_Dynamic_Library_Function;
function DLL_Ext_Default return String;
DLL_Ext_Ptr : String_Function := DLL_Ext_Default'Access;
function DLL_Prefix_Default return String;
DLL_Prefix_Ptr : String_Function := DLL_Prefix_Default'Access;
function Dynamic_Option_Default return String;
Dynamic_Option_Ptr : String_Function := Dynamic_Option_Default'Access;
function Is_Object_Ext_Default (Ext : String) return Boolean;
Is_Object_Ext_Ptr : Is_Ext_Function := Is_Object_Ext_Default'Access;
function Is_C_Ext_Default (Ext : String) return Boolean;
Is_C_Ext_Ptr : Is_Ext_Function := Is_C_Ext_Default'Access;
function Is_Archive_Ext_Default (Ext : String) return Boolean;
Is_Archive_Ext_Ptr : Is_Ext_Function := Is_Archive_Ext_Default'Access;
function Libgnat_Default return String;
Libgnat_Ptr : String_Function := Libgnat_Default'Access;
function Library_Exists_For_Default
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
Library_Exists_For_Ptr : Library_Exists_For_Function :=
Library_Exists_For_Default'Access;
function Library_File_Name_For_Default
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type;
Library_File_Name_For_Ptr : Library_File_Name_For_Function :=
Library_File_Name_For_Default'Access;
function Object_Ext_Default return String;
Object_Ext_Ptr : String_Function := Object_Ext_Default'Access;
function PIC_Option_Default return String;
PIC_Option_Ptr : String_Function := PIC_Option_Default'Access;
function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean;
Standalone_Library_Auto_Init_Is_Supported_Ptr : Boolean_Function :=
Standalone_Library_Auto_Init_Is_Supported_Default'Access;
function Support_For_Libraries_Default return Library_Support;
Support_For_Libraries_Ptr : Library_Support_Function :=
Support_For_Libraries_Default'Access;
end MLib.Tgt;