Skip to content

R
riscv-gcc-1
Commit 6bb81bc1 by Vincent Celier Committed by Arnaud Charlet
Options

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

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

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

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

From-SVN: r125366
parent a538d226
Showing with 626 additions and 1794 deletions
gcc/ada/mlib-tgt-aix.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (AIX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,22 +25,40 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static, dynamic or relocatable libraries.
-- This is the AIX version of the body
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with Prj.Util; use Prj.Util;
package body MLib.Tgt is
package body MLib.Tgt.Specific is
-- Non default subprograms
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function DLL_Ext return String;
function Support_For_Libraries return Library_Support;
-- Local variables
No_Arguments : aliased Argument_List := (1 .. 0 => null);
Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
......@@ -66,51 +84,6 @@ package body MLib.Tgt is
-- libgnarl. Depends on the thread library (Native or FSU). Resolved for
-- the first library linked against libgnarl.
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
---------------------
-- Archive_Indexer --
---------------------
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
---------------------------
-- Build_Dynamic_Library --
---------------------------
......@@ -217,162 +190,6 @@ package body MLib.Tgt is
return "a";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
function Is_Archive_Ext (Ext : String) return Boolean is
begin
return Ext = ".a";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
function PIC_Option return String is
begin
return "-fPIC";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
......@@ -382,4 +199,9 @@ package body MLib.Tgt is
return Static_Only;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-hpux.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (HP-UX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,65 +25,35 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- libraries (static only on HP-UX).
-- This is the HP-UX version of the body
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with System;
package body MLib.Tgt is
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
package body MLib.Tgt.Specific is
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-- Non default subprograms
-----------------
-- 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;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
function DLL_Ext return String;
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
function Is_Archive_Ext (Ext : String) return Boolean;
---------------------------
-- Build_Dynamic_Library --
......@@ -197,42 +167,6 @@ package body MLib.Tgt is
return "sl";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
......@@ -242,124 +176,8 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".so";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
function PIC_Option return String is
begin
return "-fPIC";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-irix.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (IRIX Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006, AdaCore --
-- Copyright (C) 2003-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,65 +25,33 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static, dynamic and shared libraries.
-- This is the IRIX version of the body
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with System;
package body MLib.Tgt is
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
---------------------
-- Archive_Indexer --
---------------------
package body MLib.Tgt.Specific is
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
-- Non default subprogram
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
function Is_Archive_Ext (Ext : String) return Boolean;
---------------------------
-- Build_Dynamic_Library --
......@@ -226,51 +194,6 @@ package body MLib.Tgt is
end if;
end Build_Dynamic_Library;
-------------
-- DLL_Ext --
-------------
function DLL_Ext return String is
begin
return "so";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
......@@ -280,124 +203,7 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".so";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
function PIC_Option return String is
begin
return "-fPIC";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-lynxos.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (LynxOS Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,61 +25,35 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static libraries.
-- This is the LynxOS version of the body
with MLib.Fil;
with Namet; use Namet;
with Prj.Com;
package body MLib.Tgt is
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
package body MLib.Tgt.Specific is
-----------------------------
-- Archive_Builder_Options --
-----------------------------
-- Non default subprograms
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
function DLL_Ext return String;
---------------------
-- Archive_Indexer --
---------------------
function Dynamic_Option return String;
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
function PIC_Option return String;
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean;
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
function Support_For_Libraries return Library_Support;
---------------------------
-- Build_Dynamic_Library --
......@@ -125,15 +99,6 @@ package body MLib.Tgt is
return "";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
......@@ -143,126 +108,6 @@ package body MLib.Tgt is
return "";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
function Is_Archive_Ext (Ext : String) return Boolean is
begin
return Ext = ".a";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
......@@ -290,4 +135,12 @@ package body MLib.Tgt is
return Static_Only;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access;
PIC_Option_Ptr := PIC_Option'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-mingw.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Windows Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,72 +25,46 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static, dynamic and shared libraries.
-- This is the Windows version of the body. Works only with GCC versions
-- supporting the "-shared" option.
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with MLib.Fil;
with MLib.Utl;
package body MLib.Tgt is
package body MLib.Tgt.Specific is
package Files renames MLib.Fil;
package Tools renames MLib.Utl;
No_Argument_List : constant String_List := (1 .. 0 => null);
-- Used as value of parameter Options or Options2 in calls to Gcc
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
-- Non default subprograms
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
function DLL_Ext return String;
---------------------
-- Archive_Indexer --
---------------------
function DLL_Prefix return String;
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
function Is_Archive_Ext (Ext : String) return Boolean;
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
function PIC_Option return String;
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
No_Argument_List : constant String_List := (1 .. 0 => null);
-- Used as value of parameter Options or Options2 in calls to Gcc
---------------------------
-- Build_Dynamic_Library --
......@@ -156,33 +130,6 @@ package body MLib.Tgt is
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
......@@ -191,98 +138,6 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".dll";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator &
MLib.Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Name_Len := 0;
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
......@@ -292,22 +147,10 @@ package body MLib.Tgt is
return "";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
DLL_Prefix_Ptr := DLL_Prefix'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-solaris.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (Solaris Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,65 +25,33 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static, dynamic and shared libraries.
-- This is the Solaris version of the body
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with System;
package body MLib.Tgt is
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
---------------------
-- Archive_Indexer --
---------------------
package body MLib.Tgt.Specific is
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
-- Non default subprograms
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
function Is_Archive_Ext (Ext : String) return Boolean;
---------------------------
-- Build_Dynamic_Library --
......@@ -182,51 +150,6 @@ package body MLib.Tgt is
end if;
end Build_Dynamic_Library;
-------------
-- DLL_Ext --
-------------
function DLL_Ext return String is
begin
return "so";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
......@@ -236,124 +159,7 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".so";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
function PIC_Option return String is
begin
return "-fPIC";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-specific.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/mlib-tgt-specific.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/mlib-tgt-tru64.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (True64 Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,70 +25,41 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static, dynamic and shared libraries.
-- This is the True64 version of the body
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt;
with Output; use Output;
with Prj.Com;
with System;
package body MLib.Tgt is
package body MLib.Tgt.Specific is
use GNAT;
use MLib;
Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
---------------------
-- Archive_Builder --
---------------------
function Archive_Builder return String is
begin
return "ar";
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
-- Non default subprogram
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
---------------------
-- Archive_Indexer --
---------------------
function Is_Archive_Ext (Ext : String) return Boolean;
function Archive_Indexer return String is
begin
return "ranlib";
end Archive_Indexer;
function PIC_Option return String;
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
-- Local variables
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
---------------------------
-- Build_Dynamic_Library --
......@@ -192,51 +163,6 @@ package body MLib.Tgt is
end if;
end Build_Dynamic_Library;
-------------
-- DLL_Ext --
-------------
function DLL_Ext return String is
begin
return "so";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
function Dynamic_Option return String is
begin
return "-shared";
end Dynamic_Option;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
......@@ -246,99 +172,6 @@ package body MLib.Tgt is
return Ext = ".a" or else Ext = ".so";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
......@@ -348,22 +181,8 @@ package body MLib.Tgt is
return "";
end PIC_Option;
-----------------------------------------------
-- Standalone_Library_Auto_Init_Is_Supported --
-----------------------------------------------
function Standalone_Library_Auto_Init_Is_Supported return Boolean is
begin
return True;
end Standalone_Library_Auto_Init_Is_Supported;
---------------------------
-- Support_For_Libraries --
---------------------------
function Support_For_Libraries return Library_Support is
begin
return Full;
end Support_For_Libraries;
end MLib.Tgt;
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-vms.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/mlib-tgt-vms.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/mlib-tgt-vxworks.adb
......@@ -2,12 +2,12 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- M L I B . T G T --
-- M L I B . T G T . S P E C I F I C --
-- (VxWorks Version) --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,17 +25,12 @@
-- --
------------------------------------------------------------------------------
-- This package provides a set of target dependent routines to build
-- static libraries.
-- This is the VxWorks version of the body
with MLib.Fil;
with Namet; use Namet;
with Prj.Com;
with Sdefault;
with Types; use Types;
package body MLib.Tgt is
package body MLib.Tgt.Specific is
-----------------------
-- Local Subprograms --
......@@ -45,6 +40,36 @@ package body MLib.Tgt is
-- Returns the required suffix for some utilities
-- (such as ar and ranlib) that depend on the real target.
-- Non default subprograms
function Archive_Builder return String;
function Archive_Indexer return String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
function DLL_Ext return String;
function Dynamic_Option return String;
function PIC_Option return String;
function Standalone_Library_Auto_Init_Is_Supported return Boolean;
function Support_For_Libraries return Library_Support;
---------------------
-- Archive_Builder --
---------------------
......@@ -54,24 +79,6 @@ package body MLib.Tgt is
return "ar" & Get_Target_Suffix;
end Archive_Builder;
-----------------------------
-- Archive_Builder_Options --
-----------------------------
function Archive_Builder_Options return String_List_Access is
begin
return new String_List'(1 => new String'("cr"));
end Archive_Builder_Options;
-----------------
-- Archive_Ext --
-----------------
function Archive_Ext return String is
begin
return "a";
end Archive_Ext;
---------------------
-- Archive_Indexer --
---------------------
......@@ -81,15 +88,6 @@ package body MLib.Tgt is
return "ranlib" & Get_Target_Suffix;
end Archive_Indexer;
-----------------------------
-- Archive_Indexer_Options --
-----------------------------
function Archive_Indexer_Options return String_List_Access is
begin
return new String_List (1 .. 0);
end Archive_Indexer_Options;
---------------------------
-- Build_Dynamic_Library --
---------------------------
......@@ -134,15 +132,6 @@ package body MLib.Tgt is
return "";
end DLL_Ext;
----------------
-- DLL_Prefix --
----------------
function DLL_Prefix return String is
begin
return "lib";
end DLL_Prefix;
--------------------
-- Dynamic_Option --
--------------------
......@@ -186,126 +175,6 @@ package body MLib.Tgt is
end if;
end Get_Target_Suffix;
-------------------
-- Is_Object_Ext --
-------------------
function Is_Object_Ext (Ext : String) return Boolean is
begin
return Ext = ".o";
end Is_Object_Ext;
--------------
-- Is_C_Ext --
--------------
function Is_C_Ext (Ext : String) return Boolean is
begin
return Ext = ".c";
end Is_C_Ext;
--------------------
-- Is_Archive_Ext --
--------------------
function Is_Archive_Ext (Ext : String) return Boolean is
begin
return Ext = ".a";
end Is_Archive_Ext;
-------------
-- Libgnat --
-------------
function Libgnat return String is
begin
return "libgnat.a";
end Libgnat;
------------------------
-- Library_Exists_For --
------------------------
function Library_Exists_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, DLL_Ext));
end if;
end;
end if;
end Library_Exists_For;
---------------------------
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
else
declare
Lib_Name : constant String :=
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
else
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
end if;
return Name_Find;
end;
end if;
end Library_File_Name_For;
----------------
-- Object_Ext --
----------------
function Object_Ext return String is
begin
return "o";
end Object_Ext;
----------------
-- PIC_Option --
----------------
......@@ -333,4 +202,14 @@ package body MLib.Tgt is
return Static_Only;
end Support_For_Libraries;
end MLib.Tgt;
begin
Archive_Builder_Ptr := Archive_Builder'Access;
Archive_Indexer_Ptr := Archive_Indexer'Access;
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access;
PIC_Option_Ptr := PIC_Option'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access;
end MLib.Tgt.Specific;
gcc/ada/mlib-tgt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2005, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -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;
......@@ -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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment