Skip to content

R
riscv-gcc-1
Commit 2cd44f5a by Vincent Celier Committed by Arnaud Charlet
Options

clean.adb, [...] (Create_Sym_Links): New procedure. 

2007-08-14  Vincent Celier  <celier@adacore.com>

	* clean.adb, fmap.adb, sinput-p.adb, sinput-p.ads, gnatcmd.adb, 
	gnatname.adb, makeutl.ads, makeutl.adb, makegpr.adb, mlib-tgt-vms.adb
	mlib-tgt-darwin.adb, mlib-tgt-lynxos.adb, mlib-prj.adb, mlib-tgt.adb, 
	mlib-tgt.ads, mlib-tgt-irix.adb mlib-tgt-hpux.adb, mlib-tgt-linux.adb, 
	mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, 
	mlib-tgt-mingw.adb, mlib-tgt-vxworks.adb, mlib-tgt-aix.adb,
	mlib-tgt-tru64.adb, mlib.ads, mlib.adb (Create_Sym_Links): New
	procedure.
	(Major_Id_Name): New function.
	mlib-tgt.ads/mlib.tgt.adb:
	(Library_Major_Minor_Id_Supported): New function, default returns True
	Most mlib-tgt-*.adb that support shared libraries and symbolic links:
	(Build_Dynamic_Library): Add support for major/minor ids for shared libs
	Other mlib-tgt-*.adb (aix, mingw, vms, vxworks, xi):
	Implementation of Library_Major_Minor_Id_Supported returns False
	clean.adb:
	(Clean_Library_Directory): If major/minor ids are supported, clean all
	library files.
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

From-SVN: r127432
parent c9b9ec14
Showing with 1015 additions and 818 deletions
gcc/ada/clean.adb
...@@ -168,15 +168,13 @@ package body Clean is ...@@ -168,15 +168,13 @@ package body Clean is
----------------------------- -----------------------------
procedure Add_Source_Dir (N : String); procedure Add_Source_Dir (N : String);
-- Call Add_Src_Search_Dir. -- Call Add_Src_Search_Dir and output one line when in verbose mode
-- Output one line when in verbose mode.
procedure Add_Source_Directories is procedure Add_Source_Directories is
new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir); new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
procedure Add_Object_Dir (N : String); procedure Add_Object_Dir (N : String);
-- Call Add_Lib_Search_Dir. -- Call Add_Lib_Search_Dir and output one line when in verbose mode
-- Output one line when in verbose mode.
procedure Add_Object_Directories is procedure Add_Object_Directories is
new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir); new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
...@@ -187,9 +185,9 @@ package body Clean is ...@@ -187,9 +185,9 @@ package body Clean is
function Assembly_File_Name (Source : File_Name_Type) return String; function Assembly_File_Name (Source : File_Name_Type) return String;
-- Returns the assembly file name corresponding to Source -- Returns the assembly file name corresponding to Source
procedure Clean_Archive (Project : Project_Id); procedure Clean_Archive (Project : Project_Id; Global : Boolean);
-- Delete a global archive or a fake library project archive and the -- Delete a global archive or library project archive and the dependency
-- dependency file, if they exist. -- file, if they exist.
procedure Clean_Executables; procedure Clean_Executables;
-- Do the cleaning work when no project file is specified -- Do the cleaning work when no project file is specified
...@@ -199,14 +197,13 @@ package body Clean is ...@@ -199,14 +197,13 @@ package body Clean is
-- a source of the project. -- a source of the project.
procedure Clean_Library_Directory (Project : Project_Id); procedure Clean_Library_Directory (Project : Project_Id);
-- Delete the library file in a library directory and any ALI file -- Delete the library file in a library directory and any ALI file of a
-- of a source of the project in a library ALI directory. -- source of the project in a library ALI directory.
procedure Clean_Project (Project : Project_Id); procedure Clean_Project (Project : Project_Id);
-- Do the cleaning work when a project file is specified. -- Do the cleaning work when a project file is specified. This procedure
-- This procedure calls itself recursively when there are several -- calls itself recursively when there are several project files in the
-- project files in the tree rooted at the main project file and switch -r -- tree rooted at the main project file and switch -r has been specified.
-- has been specified.
function Debug_File_Name (Source : File_Name_Type) return String; function Debug_File_Name (Source : File_Name_Type) return String;
-- Name of the expanded source file corresponding to Source -- Name of the expanded source file corresponding to Source
...@@ -252,8 +249,8 @@ package body Clean is ...@@ -252,8 +249,8 @@ package body Clean is
-- not itself extended. Returns No_Project if Project is No_Project. -- not itself extended. Returns No_Project if Project is No_Project.
procedure Usage; procedure Usage;
-- Display the usage. -- Display the usage. If called several times, the usage is displayed only
-- If called several times, the usage is displayed only the first time. -- the first time.
-------------------- --------------------
-- Add_Object_Dir -- -- Add_Object_Dir --
...@@ -337,19 +334,16 @@ package body Clean is ...@@ -337,19 +334,16 @@ package body Clean is
-- Clean_Archive -- -- Clean_Archive --
------------------- -------------------
procedure Clean_Archive (Project : Project_Id) is procedure Clean_Archive (Project : Project_Id; Global : Boolean) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir; Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project); Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Lib_Prefix : constant String :=
"lib" & Get_Name_String (Data.Display_Name);
Archive_Name : constant String := Lib_Prefix : String_Access;
Lib_Prefix & '.' & Archive_Ext; Archive_Name : String_Access;
-- The name of the archive file for this project -- The name of the archive file for this project
Archive_Dep_Name : constant String := Archive_Dep_Name : String_Access;
Lib_Prefix & ".deps";
-- The name of the archive dependency file for this project -- The name of the archive dependency file for this project
Obj_Dir : constant String := Obj_Dir : constant String :=
...@@ -358,12 +352,29 @@ package body Clean is ...@@ -358,12 +352,29 @@ package body Clean is
begin begin
Change_Dir (Obj_Dir); Change_Dir (Obj_Dir);
if Is_Regular_File (Archive_Name) then -- First, get the lib prefix, the archive file name and the archive
Delete (Obj_Dir, Archive_Name); -- dependency file name.
if Global then
Lib_Prefix :=
new String'("lib" & Get_Name_String (Data.Display_Name));
else
Lib_Prefix :=
new String'("lib" & Get_Name_String (Data.Library_Name));
end if; end if;
if Is_Regular_File (Archive_Dep_Name) then Archive_Name := new String'(Lib_Prefix.all & '.' & Archive_Ext);
Delete (Obj_Dir, Archive_Dep_Name); Archive_Dep_Name := new String'(Lib_Prefix.all & ".deps");
-- Delete the archive file and the archive dependency file, if they
-- exist.
if Is_Regular_File (Archive_Name.all) then
Delete (Obj_Dir, Archive_Name.all);
end if;
if Is_Regular_File (Archive_Dep_Name.all) then
Delete (Obj_Dir, Archive_Dep_Name.all);
end if; end if;
Change_Dir (Current_Dir); Change_Dir (Current_Dir);
...@@ -620,6 +631,8 @@ package body Clean is ...@@ -620,6 +631,8 @@ package body Clean is
-- Clean_Library_Directory -- -- Clean_Library_Directory --
----------------------------- -----------------------------
Empty_String : aliased String := "";
procedure Clean_Library_Directory (Project : Project_Id) is procedure Clean_Library_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir; Current : constant String := Get_Current_Dir;
Data : constant Project_Data := Project_Tree.Projects.Table (Project); Data : constant Project_Data := Project_Tree.Projects.Table (Project);
...@@ -636,8 +649,19 @@ package body Clean is ...@@ -636,8 +649,19 @@ package body Clean is
Delete_File : Boolean; Delete_File : Boolean;
Minor : String_Access := Empty_String'Unchecked_Access;
Major : String_Access := Empty_String'Unchecked_Access;
begin begin
if Data.Library then if Data.Library then
if Data.Library_Kind /= Static
and then MLib.Tgt.Library_Major_Minor_Id_Supported
and then Data.Lib_Internal_Name /= No_Name
then
Minor := new String'(Get_Name_String (Data.Lib_Internal_Name));
Major := new String'(MLib.Major_Id_Name (DLL_Name, Minor.all));
end if;
declare declare
Lib_Directory : constant String := Lib_Directory : constant String :=
Get_Name_String (Data.Display_Library_Dir); Get_Name_String (Data.Display_Library_Dir);
...@@ -663,7 +687,9 @@ package body Clean is ...@@ -663,7 +687,9 @@ package body Clean is
declare declare
Filename : constant String := Name (1 .. Last); Filename : constant String := Name (1 .. Last);
begin begin
if Is_Regular_File (Filename) then if Is_Regular_File (Filename)
or else Is_Symbolic_Link (Filename)
then
Canonical_Case_File_Name (Name (1 .. Last)); Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False; Delete_File := False;
...@@ -672,14 +698,16 @@ package body Clean is ...@@ -672,14 +698,16 @@ package body Clean is
or else or else
((Data.Library_Kind = Dynamic or else ((Data.Library_Kind = Dynamic or else
Data.Library_Kind = Relocatable) Data.Library_Kind = Relocatable)
and then Name (1 .. Last) = DLL_Name) and then
(Name (1 .. Last) = DLL_Name
or else Name (1 .. Last) = Minor.all
or else Name (1 .. Last) = Major.all))
then then
if not Do_Nothing then if not Do_Nothing then
Set_Writable (Filename); Set_Writable (Filename);
end if; end if;
Delete (Lib_Directory, Filename); Delete (Lib_Directory, Filename);
exit;
end if; end if;
end if; end if;
end; end;
...@@ -852,7 +880,7 @@ package body Clean is ...@@ -852,7 +880,7 @@ package body Clean is
-- Source_Dirs or Source_Files is specified as an empty list, -- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects. -- so always look for Ada units in extending projects.
if Data.Languages (Ada_Language_Index) if Data.Langs (Ada_Language_Index)
or else Data.Extends /= No_Project or else Data.Extends /= No_Project
then then
for Unit in Unit_Table.First .. for Unit in Unit_Table.First ..
...@@ -1011,7 +1039,7 @@ package body Clean is ...@@ -1011,7 +1039,7 @@ package body Clean is
end loop; end loop;
if Global_Archive then if Global_Archive then
Clean_Archive (Project); Clean_Archive (Project, Global => True);
end if; end if;
end if; end if;
...@@ -1044,9 +1072,9 @@ package body Clean is ...@@ -1044,9 +1072,9 @@ package body Clean is
-- the fake archive and the dependency file, if they exist. -- the fake archive and the dependency file, if they exist.
if Data.Library if Data.Library
and then not Data.Languages (Ada_Language_Index) and then not Data.Langs (Ada_Language_Index)
then then
Clean_Archive (Project); Clean_Archive (Project, Global => False);
end if; end if;
end if; end if;
end; end;
...@@ -1072,7 +1100,7 @@ package body Clean is ...@@ -1072,7 +1100,7 @@ package body Clean is
then then
Delete_Binder_Generated_Files Delete_Binder_Generated_Files
(Get_Name_String (Data.Display_Object_Dir), (Get_Name_String (Data.Display_Object_Dir),
Data.Library_Name); File_Name_Type (Data.Library_Name));
end if; end if;
end if; end if;
...@@ -1226,6 +1254,7 @@ package body Clean is ...@@ -1226,6 +1254,7 @@ package body Clean is
else else
if Force_Deletions if Force_Deletions
or else Is_Writable_File (Full_Name (1 .. Last)) or else Is_Writable_File (Full_Name (1 .. Last))
or else Is_Symbolic_Link (Full_Name (1 .. Last))
then then
Delete_File (Full_Name (1 .. Last), Success); Delete_File (Full_Name (1 .. Last), Success);
else else
......
gcc/ada/fmap.adb
...@@ -133,15 +133,26 @@ package body Fmap is ...@@ -133,15 +133,26 @@ package body Fmap is
File_Name : File_Name_Type; File_Name : File_Name_Type;
Path_Name : File_Name_Type) Path_Name : File_Name_Type)
is is
Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name);
File_Entry : constant Int := File_Hash_Table.Get (File_Name);
begin begin
File_Mapping.Increment_Last; if Unit_Entry = No_Entry or else
Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last); File_Mapping.Table (Unit_Entry).Fname /= File_Name
File_Mapping.Table (File_Mapping.Last) := then
(Uname => Unit_Name, Fname => File_Name); File_Mapping.Increment_Last;
Path_Mapping.Increment_Last; Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
File_Hash_Table.Set (File_Name, Path_Mapping.Last); File_Mapping.Table (File_Mapping.Last) :=
Path_Mapping.Table (Path_Mapping.Last) := (Uname => Unit_Name, Fname => File_Name);
(Uname => Unit_Name, Fname => Path_Name); end if;
if File_Entry = No_Entry or else
Path_Mapping.Table (File_Entry).Fname /= Path_Name
then
Path_Mapping.Increment_Last;
File_Hash_Table.Set (File_Name, Path_Mapping.Last);
Path_Mapping.Table (Path_Mapping.Last) :=
(Uname => Unit_Name, Fname => Path_Name);
end if;
end Add_To_File_Map; end Add_To_File_Map;
---------- ----------
...@@ -352,18 +363,6 @@ package body Fmap is ...@@ -352,18 +363,6 @@ package body Fmap is
Name_Buffer (1 .. Name_Len) := SP (First .. Last); Name_Buffer (1 .. Name_Len) := SP (First .. Last);
Pname := Find_File_Name; Pname := Find_File_Name;
-- Check for duplicate entries
if Unit_Hash_Table.Get (Uname) /= No_Entry then
Empty_Tables;
return;
end if;
if File_Hash_Table.Get (Fname) /= No_Entry then
Empty_Tables;
return;
end if;
-- Add the mappings for this unit name -- Add the mappings for this unit name
Add_To_File_Map (Uname, Fname, Pname); Add_To_File_Map (Uname, Fname, Pname);
...@@ -442,6 +441,8 @@ package body Fmap is ...@@ -442,6 +441,8 @@ package body Fmap is
File : File_Descriptor; File : File_Descriptor;
N_Bytes : Integer; N_Bytes : Integer;
File_Entry : Int;
Status : Boolean; Status : Boolean;
-- For the call to Close -- For the call to Close
...@@ -509,13 +510,15 @@ package body Fmap is ...@@ -509,13 +510,15 @@ package body Fmap is
for Unit in Last_In_Table + 1 .. File_Mapping.Last loop for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
Put_Line (Name_Id (File_Mapping.Table (Unit).Uname)); Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
Put_Line (Name_Id (File_Mapping.Table (Unit).Fname)); Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
Put_Line (Name_Id (Path_Mapping.Table (Unit).Fname)); File_Entry :=
File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
end loop; end loop;
-- Before closing the file, write the buffer to the file. -- Before closing the file, write the buffer to the file. It is
-- It is guaranteed that the Buffer is not empty, because -- guaranteed that the Buffer is not empty, because Put_Line has
-- Put_Line has been called at least 3 times, and after -- been called at least 3 times, and after a call to Put_Line, the
-- a call to Put_Line, the Buffer is not empty. -- Buffer is not empty.
N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
......
gcc/ada/gnatcmd.adb
...@@ -66,15 +66,16 @@ procedure GNATCmd is ...@@ -66,15 +66,16 @@ procedure GNATCmd is
-- Prefix of binder generated file, changed to b__ for VMS -- Prefix of binder generated file, changed to b__ for VMS
Old_Project_File_Used : Boolean := False; Old_Project_File_Used : Boolean := False;
-- This flag indicates a switch -p (for gnatxref and gnatfind) for an old -- This flag indicates a switch -p (for gnatxref and gnatfind) for
-- fashioned project file. -p cannot be used in conjonction with -P. -- an old fashioned project file. -p cannot be used in conjonction
-- with -P.
Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary
Temp_File_Name : String_Access := null; Temp_File_Name : String_Access := null;
-- The name of the temporary text file to put a list of source/object -- The name of the temporary text file to put a list of source/object
-- files to pass to a tool, when the number of files exceeds the value of -- files to pass to a tool, when there are more than
-- Max_Files_On_The_Command_Line. -- Max_Files_On_The_Command_Line files.
ASIS_Main : String_Access := null; ASIS_Main : String_Access := null;
-- Main for commands Check, Metric and Pretty, when -U is used -- Main for commands Check, Metric and Pretty, when -U is used
...@@ -220,7 +221,7 @@ procedure GNATCmd is ...@@ -220,7 +221,7 @@ procedure GNATCmd is
-- exec directory. This procedure is only used for GNAT LINK when a project -- exec directory. This procedure is only used for GNAT LINK when a project
-- file is specified. -- file is specified.
function Configuration_Pragmas_File return Name_Id; function Configuration_Pragmas_File return Path_Name_Type;
-- Return an argument, if there is a configuration pragmas file to be -- Return an argument, if there is a configuration pragmas file to be
-- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT -- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT
-- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT -- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
...@@ -398,12 +399,12 @@ procedure GNATCmd is ...@@ -398,12 +399,12 @@ procedure GNATCmd is
-- There is a body, check if it is for this project -- There is a body, check if it is for this project
if All_Projects or else if All_Projects or else
Unit_Data.File_Names (Body_Part).Project = Project Unit_Data.File_Names (Body_Part).Project = Project
then then
Subunit := False; Subunit := False;
if Unit_Data.File_Names (Specification).Name = if
No_File Unit_Data.File_Names (Specification).Name = No_File
then then
-- We have a body with no spec: we need to check if -- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain -- this is a subunit, because gnatls will complain
...@@ -687,11 +688,11 @@ procedure GNATCmd is ...@@ -687,11 +688,11 @@ procedure GNATCmd is
-- Configuration_Pragmas_File -- -- Configuration_Pragmas_File --
-------------------------------- --------------------------------
function Configuration_Pragmas_File return Name_Id is function Configuration_Pragmas_File return Path_Name_Type is
begin begin
Prj.Env.Create_Config_Pragmas_File Prj.Env.Create_Config_Pragmas_File
(Project, Project, Project_Tree, Include_Config_Files => False); (Project, Project, Project_Tree, Include_Config_Files => False);
return Name_Id (Project_Tree.Projects.Table (Project).Config_File_Name); return Project_Tree.Projects.Table (Project).Config_File_Name;
end Configuration_Pragmas_File; end Configuration_Pragmas_File;
------------------------------ ------------------------------
...@@ -776,7 +777,7 @@ procedure GNATCmd is ...@@ -776,7 +777,7 @@ procedure GNATCmd is
Last : Natural; Last : Natural;
Udata : Unit_Data; Udata : Unit_Data;
Path : File_Name_Type; Path : Path_Name_Type;
begin begin
if GN_Path = null then if GN_Path = null then
...@@ -832,7 +833,7 @@ procedure GNATCmd is ...@@ -832,7 +833,7 @@ procedure GNATCmd is
while not End_Of_File (File) loop while not End_Of_File (File) loop
Get_Line (File, Line, Last); Get_Line (File, Line, Last);
Path := No_File; Path := No_Path;
for Unit in Unit_Table.First .. for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units) Unit_Table.Last (Project_Tree.Units)
...@@ -859,7 +860,7 @@ procedure GNATCmd is ...@@ -859,7 +860,7 @@ procedure GNATCmd is
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
if Path /= No_File then if Path /= No_Path then
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'(Get_Name_String (Path)); new String'(Get_Name_String (Path));
...@@ -917,7 +918,7 @@ procedure GNATCmd is ...@@ -917,7 +918,7 @@ procedure GNATCmd is
-- Check if there are library project files -- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then if MLib.Tgt.Support_For_Libraries /= None then
Set_Libraries (Project, Project_Tree, There_Are_Libraries); Set_Libraries (Project, Project_Tree, There_Are_Libraries);
end if; end if;
...@@ -1354,6 +1355,8 @@ begin ...@@ -1354,6 +1355,8 @@ begin
VMS_Conv.Initialize; VMS_Conv.Initialize;
Set_Mode (Ada_Only);
-- Add the directory where the GNAT driver is invoked in front of the path, -- Add the directory where the GNAT driver is invoked in front of the path,
-- if the GNAT driver is invoked with directory information. Do not do this -- if the GNAT driver is invoked with directory information. Do not do this
-- for VMS, where the notion of path does not really exist. -- for VMS, where the notion of path does not really exist.
...@@ -2023,10 +2026,10 @@ begin ...@@ -2023,10 +2026,10 @@ begin
end loop; end loop;
declare declare
CP_File : constant Name_Id := Configuration_Pragmas_File; CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
begin begin
if CP_File /= No_Name then if CP_File /= No_Path then
if The_Command = Elim then if The_Command = Elim then
First_Switches.Increment_Last; First_Switches.Increment_Last;
First_Switches.Table (First_Switches.Last) := First_Switches.Table (First_Switches.Last) :=
...@@ -2093,8 +2096,8 @@ begin ...@@ -2093,8 +2096,8 @@ begin
-- indicate to gnatstub the name of the body file with -- indicate to gnatstub the name of the body file with
-- a -o switch. -- a -o switch.
if Data.Naming.Ada_Spec_Suffix /= if Body_Suffix_Id_Of (Project_Tree, "ada", Data.Naming) /=
Prj.Default_Ada_Spec_Suffix Prj.Default_Ada_Spec_Suffix
then then
if File_Index /= 0 then if File_Index /= 0 then
declare declare
...@@ -2103,14 +2106,18 @@ begin ...@@ -2103,14 +2106,18 @@ begin
Last : Natural := Spec'Last; Last : Natural := Spec'Last;
begin begin
Get_Name_String (Data.Naming.Ada_Spec_Suffix); Get_Name_String
(Spec_Suffix_Id_Of
(Project_Tree, "ada", Data.Naming));
if Spec'Length > Name_Len if Spec'Length > Name_Len
and then Spec (Last - Name_Len + 1 .. Last) = and then Spec (Last - Name_Len + 1 .. Last) =
Name_Buffer (1 .. Name_Len) Name_Buffer (1 .. Name_Len)
then then
Last := Last - Name_Len; Last := Last - Name_Len;
Get_Name_String (Data.Naming.Ada_Body_Suffix); Get_Name_String
(Body_Suffix_Id_Of
(Project_Tree, "ada", Data.Naming));
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'("-o"); new String'("-o");
...@@ -2218,6 +2225,17 @@ begin ...@@ -2218,6 +2225,17 @@ begin
if ASIS_Main /= null then if ASIS_Main /= null then
Get_Closure; Get_Closure;
-- On VMS, set up again the env var for source dirs file. This is
-- because the call to gnatmake has set this env var to another
-- file that has now been deleted.
if Hostparm.OpenVMS then
Setenv
(Project_Include_Path_File,
Prj.Env.Ada_Include_Path
(Project, Project_Tree, Recursive => True));
end if;
-- For gnat check, gnat pretty, gnat metric, gnat list, and gnat -- For gnat check, gnat pretty, gnat metric, gnat list, and gnat
-- stack, if no file has been put on the command line, call tool -- stack, if no file has been put on the command line, call tool
-- with all the sources of the main project. -- with all the sources of the main project.
...@@ -2298,13 +2316,18 @@ begin ...@@ -2298,13 +2316,18 @@ begin
exception exception
when Error_Exit => when Error_Exit =>
Prj.Env.Delete_All_Path_Files (Project_Tree); if not Keep_Temporary_Files then
Delete_Temp_Config_Files; Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files;
end if;
Set_Exit_Status (Failure); Set_Exit_Status (Failure);
when Normal_Exit => when Normal_Exit =>
Prj.Env.Delete_All_Path_Files (Project_Tree); if not Keep_Temporary_Files then
Delete_Temp_Config_Files; Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files;
end if;
-- Since GNATCmd is normally called from DCL (the VMS shell), it must -- Since GNATCmd is normally called from DCL (the VMS shell), it must
-- return an understandable VMS exit status. However the exit status -- return an understandable VMS exit status. However the exit status
......
gcc/ada/gnatname.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -299,6 +299,8 @@ procedure Gnatname is ...@@ -299,6 +299,8 @@ procedure Gnatname is
-- Start of processing for Gnatname -- Start of processing for Gnatname
begin begin
Prj.Set_Mode (Prj.Ada_Only);
-- Add the directory where gnatname is invoked in front of the -- Add the directory where gnatname is invoked in front of the
-- path, if gnatname is invoked with directory information. -- path, if gnatname is invoked with directory information.
-- Only do this if the platform is not VMS, where the notion of path -- Only do this if the platform is not VMS, where the notion of path
......
gcc/ada/makegpr.adb
...@@ -1404,12 +1404,12 @@ package body Makegpr is ...@@ -1404,12 +1404,12 @@ package body Makegpr is
Source : Other_Source; Source : Other_Source;
Archive_Name : constant String := Archive_Name : constant String :=
"lib" & Get_Name_String (Data.Display_Name) "lib" & Get_Name_String (Data.Library_Name)
& '.' & Archive_Ext; & '.' & Archive_Ext;
-- The name of the archive file for this project -- The name of the archive file for this project
Archive_Dep_Name : constant String := Archive_Dep_Name : constant String :=
"lib" & Get_Name_String (Data.Display_Name) "lib" & Get_Name_String (Data.Library_Name)
& ".deps"; & ".deps";
-- The name of the archive dependency file for this project -- The name of the archive dependency file for this project
...@@ -1425,6 +1425,12 @@ package body Makegpr is ...@@ -1425,6 +1425,12 @@ package body Makegpr is
Lib_Opts : Argument_List_Access := No_Argument'Access; Lib_Opts : Argument_List_Access := No_Argument'Access;
begin begin
-- Nothing to do if the project is externally built
if Data.Externally_Built then
return;
end if;
Check_Archive_Builder; Check_Archive_Builder;
-- If Unconditionally is False, check if the archive need to be built -- If Unconditionally is False, check if the archive need to be built
...@@ -1619,7 +1625,7 @@ package body Makegpr is ...@@ -1619,7 +1625,7 @@ package body Makegpr is
-- If there are sources in Ada, then gnatmake will build the library, -- If there are sources in Ada, then gnatmake will build the library,
-- so nothing to do. -- so nothing to do.
if not Data.Languages (Ada_Language_Index) then if not Data.Langs (Ada_Language_Index) then
-- Get all the object files of the project -- Get all the object files of the project
...@@ -1637,7 +1643,6 @@ package body Makegpr is ...@@ -1637,7 +1643,6 @@ package body Makegpr is
if Data.Library_Kind = Static then if Data.Library_Kind = Static then
MLib.Build_Library MLib.Build_Library
(Ofiles => Arguments (1 .. Last_Argument), (Ofiles => Arguments (1 .. Last_Argument),
Afiles => No_Argument,
Output_File => Get_Name_String (Data.Library_Name), Output_File => Get_Name_String (Data.Library_Name),
Output_Dir => Get_Name_String (Data.Display_Library_Dir)); Output_Dir => Get_Name_String (Data.Display_Library_Dir));
...@@ -1698,10 +1703,7 @@ package body Makegpr is ...@@ -1698,10 +1703,7 @@ package body Makegpr is
MLib.Tgt.Build_Dynamic_Library MLib.Tgt.Build_Dynamic_Library
(Ofiles => Arguments (1 .. Last_Argument), (Ofiles => Arguments (1 .. Last_Argument),
Foreign => Arguments (1 .. Last_Argument), Options => Lib_Opts.all,
Afiles => No_Argument,
Options => No_Argument,
Options_2 => Lib_Opts.all,
Interfaces => No_Argument, Interfaces => No_Argument,
Lib_Filename => Get_Name_String (Data.Library_Name), Lib_Filename => Get_Name_String (Data.Library_Name),
Lib_Dir => Get_Name_String (Data.Library_Dir), Lib_Dir => Get_Name_String (Data.Library_Dir),
...@@ -1817,6 +1819,7 @@ package body Makegpr is ...@@ -1817,6 +1819,7 @@ package body Makegpr is
Source_Name : constant String := Get_Name_String (Source.File_Name); Source_Name : constant String := Get_Name_String (Source.File_Name);
Source_Path : constant String := Get_Name_String (Source.Path_Name); Source_Path : constant String := Get_Name_String (Source.Path_Name);
Object_Name : constant String := Get_Name_String (Source.Object_Name); Object_Name : constant String := Get_Name_String (Source.Object_Name);
C_Object_Name : String := Object_Name;
Dep_Name : constant String := Get_Name_String (Source.Dep_Name); Dep_Name : constant String := Get_Name_String (Source.Dep_Name);
C_Source_Path : String := Source_Path; C_Source_Path : String := Source_Path;
...@@ -1832,6 +1835,7 @@ package body Makegpr is ...@@ -1832,6 +1835,7 @@ package body Makegpr is
begin begin
Canonical_Case_File_Name (C_Source_Path); Canonical_Case_File_Name (C_Source_Path);
Canonical_Case_File_Name (C_Object_Name);
-- Assume the worst, so that statement "return;" may be used if there -- Assume the worst, so that statement "return;" may be used if there
-- is any problem. -- is any problem.
...@@ -1957,10 +1961,14 @@ package body Makegpr is ...@@ -1957,10 +1961,14 @@ package body Makegpr is
Start := 1; Start := 1;
Finish := Index (Name_Buffer (1 .. Name_Len), ": "); Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
if Finish /= 0 then
Canonical_Case_File_Name (Name_Buffer (1 .. Finish - 1));
end if;
-- First line must start with name of object file, followed by colon -- First line must start with name of object file, followed by colon
if Finish = 0 or else if Finish = 0 or else
Name_Buffer (1 .. Finish - 1) /= Object_Name Name_Buffer (1 .. Finish - 1) /= C_Object_Name
then then
if Verbose_Mode then if Verbose_Mode then
Write_Str (" -> dependency file "); Write_Str (" -> dependency file ");
...@@ -2155,7 +2163,7 @@ package body Makegpr is ...@@ -2155,7 +2163,7 @@ package body Makegpr is
Project_Table.Last (Project_Tree.Projects) Project_Table.Last (Project_Tree.Projects)
loop loop
if if
Project_Tree.Projects.Table (Project).Languages Project_Tree.Projects.Table (Project).Langs
(C_Plus_Plus_Language_Index) (C_Plus_Plus_Language_Index)
then then
C_Plus_Plus_Is_Used := True; C_Plus_Plus_Is_Used := True;
...@@ -2430,7 +2438,7 @@ package body Makegpr is ...@@ -2430,7 +2438,7 @@ package body Makegpr is
Dummy : Boolean := False; Dummy : Boolean := False;
Ada_Is_A_Language : constant Boolean := Ada_Is_A_Language : constant Boolean :=
Data.Languages (Ada_Language_Index); Data.Langs (Ada_Language_Index);
begin begin
Ada_Mains.Init; Ada_Mains.Init;
...@@ -2814,7 +2822,7 @@ package body Makegpr is ...@@ -2814,7 +2822,7 @@ package body Makegpr is
if not Local_Errors if not Local_Errors
and then Data.Library and then Data.Library
and then not Data.Languages (Ada_Language_Index) and then not Data.Langs (Ada_Language_Index)
and then not Compile_Only and then not Compile_Only
then then
Build_Library (Project, Need_To_Rebuild_Archive); Build_Library (Project, Need_To_Rebuild_Archive);
...@@ -3349,6 +3357,8 @@ package body Makegpr is ...@@ -3349,6 +3357,8 @@ package body Makegpr is
procedure Initialize is procedure Initialize is
begin begin
Set_Mode (Ada_Only);
-- Do some necessary package initializations -- Do some necessary package initializations
Csets.Initialize; Csets.Initialize;
...@@ -3795,7 +3805,7 @@ package body Makegpr is ...@@ -3795,7 +3805,7 @@ package body Makegpr is
-- Only Ada sources in the main project, and even maybe not -- Only Ada sources in the main project, and even maybe not
if not Data.Languages (Ada_Language_Index) then if not Data.Langs (Ada_Language_Index) then
-- Fail if the main project has no source of any language -- Fail if the main project has no source of any language
...@@ -3825,7 +3835,7 @@ package body Makegpr is ...@@ -3825,7 +3835,7 @@ package body Makegpr is
-- There are other language sources. First check if there are also -- There are other language sources. First check if there are also
-- sources in Ada. -- sources in Ada.
if Data.Languages (Ada_Language_Index) then if Data.Langs (Ada_Language_Index) then
-- There is a mix of Ada and other language sources in the main -- There is a mix of Ada and other language sources in the main
-- project. Any main that is not a source of the other languages -- project. Any main that is not a source of the other languages
...@@ -3953,7 +3963,7 @@ package body Makegpr is ...@@ -3953,7 +3963,7 @@ package body Makegpr is
-- If C++ is one of the languages, add the --LINK switch to -- If C++ is one of the languages, add the --LINK switch to
-- the linking switches. -- the linking switches.
if Data.Languages (C_Plus_Plus_Language_Index) then if Data.Langs (C_Plus_Plus_Language_Index) then
Add_Argument (Dash_largs, Verbose_Mode); Add_Argument (Dash_largs, Verbose_Mode);
Add_C_Plus_Plus_Link_For_Gnatmake; Add_C_Plus_Plus_Link_For_Gnatmake;
Add_Argument (Dash_margs, Verbose_Mode); Add_Argument (Dash_margs, Verbose_Mode);
...@@ -3969,7 +3979,7 @@ package body Makegpr is ...@@ -3969,7 +3979,7 @@ package body Makegpr is
-- First, get the linker to invoke -- First, get the linker to invoke
if Data.Languages (C_Plus_Plus_Language_Index) then if Data.Langs (C_Plus_Plus_Language_Index) then
Get_Compiler (C_Plus_Plus_Language_Index); Get_Compiler (C_Plus_Plus_Language_Index);
Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index); Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index); Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
......
gcc/ada/makeutl.adb
...@@ -24,9 +24,9 @@ ...@@ -24,9 +24,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line; with Ada.Command_Line; use Ada.Command_Line;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output;
with Prj.Ext; with Prj.Ext;
with Prj.Util; with Prj.Util;
with Snames; use Snames; with Snames; use Snames;
...@@ -83,6 +83,46 @@ package body Makeutl is ...@@ -83,6 +83,46 @@ package body Makeutl is
procedure Add_Linker_Option (Option : String); procedure Add_Linker_Option (Option : String);
---------
-- Add --
---------
procedure Add
(Option : String_Access;
To : in out String_List_Access;
Last : in out Natural)
is
begin
if Last = To'Last then
declare
New_Options : constant String_List_Access :=
new String_List (1 .. To'Last * 2);
begin
New_Options (To'Range) := To.all;
-- Set all elements of the original options to null to avoid
-- deallocation of copies.
To.all := (others => null);
Free (To);
To := New_Options;
end;
end if;
Last := Last + 1;
To (Last) := Option;
end Add;
procedure Add
(Option : String;
To : in out String_List_Access;
Last : in out Natural)
is
begin
Add (Option => new String'(Option), To => To, Last => Last);
end Add;
----------------------- -----------------------
-- Add_Linker_Option -- -- Add_Linker_Option --
----------------------- -----------------------
...@@ -110,6 +150,31 @@ package body Makeutl is ...@@ -110,6 +150,31 @@ package body Makeutl is
end if; end if;
end Add_Linker_Option; end Add_Linker_Option;
-----------------
-- Create_Name --
-----------------
function Create_Name (Name : String) return File_Name_Type is
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Name);
return Name_Find;
end Create_Name;
function Create_Name (Name : String) return Name_Id is
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Name);
return Name_Find;
end Create_Name;
function Create_Name (Name : String) return Path_Name_Type is
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Name);
return Name_Find;
end Create_Name;
---------------------- ----------------------
-- Delete_All_Marks -- -- Delete_All_Marks --
---------------------- ----------------------
...@@ -190,6 +255,31 @@ package body Makeutl is ...@@ -190,6 +255,31 @@ package body Makeutl is
return Union_Id (Key.File) mod Max_Mask_Num; return Union_Id (Key.File) mod Max_Mask_Num;
end Hash; end Hash;
------------
-- Inform --
------------
procedure Inform (N : File_Name_Type; Msg : String) is
begin
Inform (Name_Id (N), Msg);
end Inform;
procedure Inform (N : Name_Id := No_Name; Msg : String) is
begin
Osint.Write_Program_Name;
Write_Str (": ");
if N /= No_Name then
Write_Str ("""");
Write_Name (N);
Write_Str (""" ");
end if;
Write_Str (Msg);
Write_Eol;
end Inform;
---------------------------- ----------------------------
-- Is_External_Assignment -- -- Is_External_Assignment --
---------------------------- ----------------------------
......
gcc/ada/makeutl.ads
...@@ -38,17 +38,39 @@ package Makeutl is ...@@ -38,17 +38,39 @@ package Makeutl is
S2 : String := ""; S2 : String := "";
S3 : String := ""); S3 : String := "");
Do_Fail : Fail_Proc := Osint.Fail'Access; Do_Fail : Fail_Proc := Osint.Fail'Access;
-- Comment required ??? -- Failing procedure called from procedure Test_If_Relative_Path below.
-- May be redirected.
function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
-- Find the index of a unit in a source file. Return zero if the file Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
-- is not a multi-unit source file. -- The project tree
Main_Config_Project : Project_Id;
-- The project id of the main configuration project
procedure Add
(Option : String_Access;
To : in out String_List_Access;
Last : in out Natural);
procedure Add
(Option : String;
To : in out String_List_Access;
Last : in out Natural);
-- Add a string to a list of strings
function Create_Name (Name : String) return File_Name_Type;
function Create_Name (Name : String) return Name_Id;
function Create_Name (Name : String) return Path_Name_Type;
-- Get the Name_Id of a name
function Executable_Prefix_Path return String; function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the -- Return the absolute path parent directory of the directory where the
-- current executable resides, if its directory is named "bin", otherwise -- current executable resides, if its directory is named "bin", otherwise
-- return an empty string. -- return an empty string.
procedure Inform (N : Name_Id := No_Name; Msg : String);
procedure Inform (N : File_Name_Type; Msg : String);
-- Prints out the program name followed by a colon, N and S
function Is_External_Assignment (Argv : String) return Boolean; function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct -- Verify that an external assignment switch is syntactically correct
-- --
...@@ -73,6 +95,10 @@ package Makeutl is ...@@ -73,6 +95,10 @@ package Makeutl is
-- and to retrieve them when a project file is used, to verify that the -- and to retrieve them when a project file is used, to verify that the
-- files exist and that they belong to a project file. -- files exist and that they belong to a project file.
function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
-- Find the index of a unit in a source file. Return zero if the file
-- is not a multi-unit source file.
package Mains is package Mains is
-- Mains are stored in a table. An index is used to retrieve the mains -- Mains are stored in a table. An index is used to retrieve the mains
......
gcc/ada/mlib-prj.adb
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT COMPILER COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
-- M L I B . P R J -- -- M L I B . P R J --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
...@@ -46,7 +46,6 @@ with Ada.Characters.Handling; ...@@ -46,7 +46,6 @@ with Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable; with GNAT.HTable;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System; with System; use System;
with System.Case_Util; use System.Case_Util; with System.Case_Util; use System.Case_Util;
...@@ -74,9 +73,6 @@ package body MLib.Prj is ...@@ -74,9 +73,6 @@ package body MLib.Prj is
G_Trasym_Ads : File_Name_Type := No_File; G_Trasym_Ads : File_Name_Type := No_File;
-- Name_Id for "g-trasym.ads" -- Name_Id for "g-trasym.ads"
No_Argument_List : aliased String_List := (1 .. 0 => null);
No_Argument : constant String_List_Access := No_Argument_List'Access;
Arguments : String_List_Access := No_Argument; Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of -- Used to accumulate arguments for the invocation of gnatbind and of
-- the compiler. Also used to collect the interface ALI when copying -- the compiler. Also used to collect the interface ALI when copying
...@@ -118,18 +114,6 @@ package body MLib.Prj is ...@@ -118,18 +114,6 @@ package body MLib.Prj is
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- List of non-Ada object files
Foreign_Objects : Argument_List_Access;
package Foreigns is new Table.Table
(Table_Name => "Mlib.Prj.Foreigns",
Table_Component_Type => String_Access,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 20,
Table_Increment => 100);
-- List of ALI files -- List of ALI files
Ali_Files : Argument_List_Access; Ali_Files : Argument_List_Access;
...@@ -240,7 +224,7 @@ package body MLib.Prj is ...@@ -240,7 +224,7 @@ package body MLib.Prj is
procedure Reset_Tables; procedure Reset_Tables;
-- Make sure that all the above tables are empty -- Make sure that all the above tables are empty
-- (Objects, ALIs, Options, ...). -- (Objects, Ali_Files, Options).
function SALs_Use_Constructors return Boolean; function SALs_Use_Constructors return Boolean;
-- Indicate if Stand-Alone Libraries are automatically initialized using -- Indicate if Stand-Alone Libraries are automatically initialized using
...@@ -326,10 +310,6 @@ package body MLib.Prj is ...@@ -326,10 +310,6 @@ package body MLib.Prj is
-- Set to True for the first warning about a unit missing from the -- Set to True for the first warning about a unit missing from the
-- interface set. -- interface set.
Gtrasymobj_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with
-- g-trasym.obj.
Data : Project_Data := In_Tree.Projects.Table (For_Project); Data : Project_Data := In_Tree.Projects.Table (For_Project);
Libgnarl_Needed : Yes_No_Unknown := Data.Libgnarl_Needed; Libgnarl_Needed : Yes_No_Unknown := Data.Libgnarl_Needed;
...@@ -338,8 +318,12 @@ package body MLib.Prj is ...@@ -338,8 +318,12 @@ package body MLib.Prj is
Libdecgnat_Needed : Boolean := False; Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with libdecgnat -- On OpenVMS, set to True if library needs to be linked with libdecgnat
Gtrasymobj_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with
-- g-trasym.obj.
Object_Directory_Path : constant String := Object_Directory_Path : constant String :=
Get_Name_String (Data.Display_Object_Dir); Get_Name_String (Data.Display_Object_Dir);
Standalone : constant Boolean := Data.Standalone_Library; Standalone : constant Boolean := Data.Standalone_Library;
...@@ -362,6 +346,8 @@ package body MLib.Prj is ...@@ -362,6 +346,8 @@ package body MLib.Prj is
In_Main_Object_Directory : Boolean := True; In_Main_Object_Directory : Boolean := True;
There_Are_Foreign_Sources : Boolean;
Rpath : String_Access := null; Rpath : String_Access := null;
-- Allocated only if Path Option is supported -- Allocated only if Path Option is supported
...@@ -379,7 +365,8 @@ package body MLib.Prj is ...@@ -379,7 +365,8 @@ package body MLib.Prj is
-- Store the ALI file name of a source of the library (the first found) -- Store the ALI file name of a source of the library (the first found)
procedure Add_ALI_For (Source : File_Name_Type); procedure Add_ALI_For (Source : File_Name_Type);
-- Add the name of the ALI file corresponding to Source to the arguments -- Add the name of the ALI file corresponding to Source to the
-- Arguments.
procedure Add_Rpath (Path : String); procedure Add_Rpath (Path : String);
-- Add a path name to Rpath -- Add a path name to Rpath
...@@ -553,7 +540,7 @@ package body MLib.Prj is ...@@ -553,7 +540,7 @@ package body MLib.Prj is
ALI.ALIs.Table (Id).Last_Sdep ALI.ALIs.Table (Id).Last_Sdep
loop loop
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
Libgnarl_Needed := Yes; Libgnarl_Needed := Yes;
if Main_Project then if Main_Project then
In_Tree.Projects.Table (For_Project).Libgnarl_Needed := In_Tree.Projects.Table (For_Project).Libgnarl_Needed :=
...@@ -806,10 +793,8 @@ package body MLib.Prj is ...@@ -806,10 +793,8 @@ package body MLib.Prj is
Process_Project (For_Project); Process_Project (For_Project);
-- Add the -L and -l switches and, if the Rpath option is supported, -- Add the -L and -l switches and, if the Rpath option is supported,
-- add the directory to the Rpath. -- add the directory to the Rpath. As the library projects are in the
-- wrong order, process from the last to the first.
-- As the library projects are in the wrong order, process from the
-- last to the first.
for Index in reverse 1 .. Library_Projs.Last loop for Index in reverse 1 .. Library_Projs.Last loop
Current := Library_Projs.Table (Index); Current := Library_Projs.Table (Index);
...@@ -846,7 +831,7 @@ package body MLib.Prj is ...@@ -846,7 +831,7 @@ package body MLib.Prj is
end if; end if;
-- If this is the first time Build_Library is called, get the Name_Id -- If this is the first time Build_Library is called, get the Name_Id
-- values of "s-osinte.ads", "dec.ads", and "g-trasym.ads". -- of "s-osinte.ads".
if S_Osinte_Ads = No_File then if S_Osinte_Ads = No_File then
Name_Len := 0; Name_Len := 0;
...@@ -988,12 +973,13 @@ package body MLib.Prj is ...@@ -988,12 +973,13 @@ package body MLib.Prj is
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit.File_Names (Body_Part).Path)); (Unit.File_Names
(Body_Part).Path));
-- Add the ALI file only if it is not a subunit -- Add the ALI file only if it is not a subunit
if if not
not Sinput.P.Source_File_Is_Subunit (Src_Ind) Sinput.P.Source_File_Is_Subunit (Src_Ind)
then then
Add_ALI_For Add_ALI_For
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Body_Part).Name);
...@@ -1075,8 +1061,6 @@ package body MLib.Prj is ...@@ -1075,8 +1061,6 @@ package body MLib.Prj is
Display (Gnatbind); Display (Gnatbind);
-- Check the size of the arguments
Size := 0; Size := 0;
for J in 1 .. Argument_Number loop for J in 1 .. Argument_Number loop
Size := Size + Arguments (J)'Length + 1; Size := Size + Arguments (J)'Length + 1;
...@@ -1240,8 +1224,8 @@ package body MLib.Prj is ...@@ -1240,8 +1224,8 @@ package body MLib.Prj is
-- Read it -- Read it
A := Scan_ALI A :=
(First_ALI, T, Ignore_ED => False, Err => False); Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
if A /= No_ALI_Id then if A /= No_ALI_Id then
for Index in for Index in
...@@ -1272,7 +1256,7 @@ package body MLib.Prj is ...@@ -1272,7 +1256,7 @@ package body MLib.Prj is
-- generated file. -- generated file.
Display (Gcc); Display (Gcc);
GNAT.OS_Lib.Spawn Spawn
(Gcc_Path.all, Arguments (1 .. Argument_Number), Success); (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
if not Success then if not Success then
...@@ -1290,6 +1274,7 @@ package body MLib.Prj is ...@@ -1290,6 +1274,7 @@ package body MLib.Prj is
-- Build the library only if Link is True -- Build the library only if Link is True
if Link then if Link then
-- If attribute Library_GCC was specified, get the driver name -- If attribute Library_GCC was specified, get the driver name
Library_GCC := Library_GCC :=
...@@ -1307,13 +1292,13 @@ package body MLib.Prj is ...@@ -1307,13 +1292,13 @@ package body MLib.Prj is
if not Library_Options.Default then if not Library_Options.Default then
declare declare
Current : String_List_Id := Library_Options.Values; Current : String_List_Id;
Element : String_Element; Element : String_Element;
begin begin
Current := Library_Options.Values;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Element := In_Tree.String_Elements.Table (Current);
In_Tree.String_Elements.Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Name_Len /= 0 then if Name_Len /= 0 then
...@@ -1327,10 +1312,9 @@ package body MLib.Prj is ...@@ -1327,10 +1312,9 @@ package body MLib.Prj is
end; end;
end if; end if;
Lib_Dirpath := Lib_Dirpath :=
new String'(Get_Name_String (Data.Display_Library_Dir)); new String'(Get_Name_String (Data.Display_Library_Dir));
Lib_Filename := Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
new String'(Get_Name_String (Data.Library_Name));
case Data.Library_Kind is case Data.Library_Kind is
when Static => when Static =>
...@@ -1350,7 +1334,7 @@ package body MLib.Prj is ...@@ -1350,7 +1334,7 @@ package body MLib.Prj is
-- Get the library version, if any -- Get the library version, if any
if Data.Lib_Internal_Name /= No_File then if Data.Lib_Internal_Name /= No_Name then
Lib_Version := Lib_Version :=
new String'(Get_Name_String (Data.Lib_Internal_Name)); new String'(Get_Name_String (Data.Lib_Internal_Name));
end if; end if;
...@@ -1358,12 +1342,13 @@ package body MLib.Prj is ...@@ -1358,12 +1342,13 @@ package body MLib.Prj is
-- Add the objects found in the object directory and the object -- Add the objects found in the object directory and the object
-- directories of the extended files, if any, except for generated -- directories of the extended files, if any, except for generated
-- object files (b~.. or B__..) from extended projects. -- object files (b~.. or B__..) from extended projects.
-- When there are one or more extended files, only add an object file -- When there are one or more extended files, only add an object file
-- if no object file with the same name have already been added. -- if no object file with the same name have already been added.
In_Main_Object_Directory := True; In_Main_Object_Directory := True;
There_Are_Foreign_Sources := Data.Other_Sources_Present;
loop loop
declare declare
Object_Dir_Path : constant String := Object_Dir_Path : constant String :=
...@@ -1404,7 +1389,7 @@ package body MLib.Prj is ...@@ -1404,7 +1389,7 @@ package body MLib.Prj is
if In_Main_Object_Directory if In_Main_Object_Directory
or else Last < 5 or else Last < 5
or else C_Filename (1 .. B_Start'Length) /= or else C_Filename (1 .. B_Start'Length) /=
B_Start.all B_Start.all
then then
Name_Len := Last; Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name_Buffer (1 .. Name_Len) :=
...@@ -1412,39 +1397,112 @@ package body MLib.Prj is ...@@ -1412,39 +1397,112 @@ package body MLib.Prj is
Id := Name_Find; Id := Name_Find;
if not Objects_Htable.Get (Id) then if not Objects_Htable.Get (Id) then
-- Record this object file
Objects_Htable.Set (Id, True);
Objects.Increment_Last;
Objects.Table (Objects.Last) :=
new String'(Object_Path);
declare declare
ALI_File : constant String := ALI_File : constant String :=
Ext_To
(Filename (1 .. Last), "ali");
ALI_Path : constant String :=
Ext_To (Object_Path, "ali"); Ext_To (Object_Path, "ali");
Add_It : Boolean :=
There_Are_Foreign_Sources
or else
(Last > 5
and then
C_Filename
(1 .. B_Start'Length) =
B_Start.all);
Fname : File_Name_Type;
Proj : Project_Id;
begin begin
if Is_Regular_File (ALI_File) then if Is_Regular_File (ALI_Path) then
-- If there is an ALI file, check if the
-- object file should be added to the
-- library. If there are foreign sources
-- we put all object files in the library.
if not Add_It then
for Index in
1 .. Unit_Table.Last (In_Tree.Units)
loop
if In_Tree.Units.Table
(Index).File_Names
(Body_Part).Name /= No_File
then
Proj :=
In_Tree.Units.Table (Index).
File_Names
(Body_Part).Project;
Fname :=
In_Tree.Units.Table (Index).
File_Names (Body_Part).Name;
elsif
In_Tree.Units.Table
(Index).File_Names
(Specification).Name /= No_File
then
Proj :=
In_Tree.Units.Table
(Index).File_Names
(Specification).Project;
Fname :=
In_Tree.Units.Table
(Index).File_Names
(Specification).Name;
else
Proj := No_Project;
end if;
Add_It := Proj /= No_Project;
-- If the source is in the project
-- or a project it extends, we may
-- put it in the library.
if Add_It then
Add_It := Check_Project (Proj);
end if;
-- But we don't, if the ALI file
-- does not correspond to the unit.
if Add_It then
declare
F : constant String :=
Ext_To
(Get_Name_String
(Fname), "ali");
begin
Add_It := F = ALI_File;
end;
end if;
exit when Add_It;
end loop;
end if;
-- Record the ALI file if Add_It then
Objects_Htable.Set (Id, True);
Objects.Append
(new String'(Object_Path));
ALIs.Increment_Last; -- Record the ALI file
ALIs.Table (ALIs.Last) :=
new String'(ALI_File);
-- Find out if for this ALI file, libgnarl ALIs.Append (new String'(ALI_Path));
-- or libdecgnat or g-trasym.obj (on
-- OpenVMS) is necessary.
Check_Libs (ALI_File, True); -- Find out if for this ALI file,
-- libgnarl or libdecgnat or
-- g-trasym.obj (on OpenVMS) is
-- necessary.
else Check_Libs (ALI_Path, True);
-- Object file is a foreign object file end if;
Foreigns.Increment_Last; elsif There_Are_Foreign_Sources then
Foreigns.Table (Foreigns.Last) := Objects.Append (new String'(Object_Path));
new String'(Object_Path);
end if; end if;
end; end;
end if; end if;
...@@ -1518,9 +1576,6 @@ package body MLib.Prj is ...@@ -1518,9 +1576,6 @@ package body MLib.Prj is
else else
Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl")); Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
end if; end if;
else
In_Tree.Projects.Table (For_Project).Libgnarl_Needed := No;
end if; end if;
if Gtrasymobj_Needed then if Gtrasymobj_Needed then
...@@ -1568,18 +1623,14 @@ package body MLib.Prj is ...@@ -1568,18 +1623,14 @@ package body MLib.Prj is
new Argument_List' new Argument_List'
(Argument_List (Objects.Table (1 .. Objects.Last))); (Argument_List (Objects.Table (1 .. Objects.Last)));
Foreign_Objects :=
new Argument_List'(Argument_List
(Foreigns.Table (1 .. Foreigns.Last)));
Ali_Files := Ali_Files :=
new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last))); new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
Options := Options :=
new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last))); new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
-- We fail if there are no object to put in the library (Ada or -- We fail if there are no object to put in the library
-- foreign objects). -- (Ada or foreign objects).
if Object_Files'Length = 0 then if Object_Files'Length = 0 then
Com.Fail ("no object files for library """ & Com.Fail ("no object files for library """ &
...@@ -1682,11 +1733,10 @@ package body MLib.Prj is ...@@ -1682,11 +1733,10 @@ package body MLib.Prj is
Data := In_Tree.Projects.Table (For_Project); Data := In_Tree.Projects.Table (For_Project);
declare declare
Iface : String_List_Id; Iface : String_List_Id := Data.Lib_Interface_ALIs;
ALI : File_Name_Type; ALI : File_Name_Type;
begin begin
Iface := Data.Lib_Interface_ALIs;
while Iface /= Nil_String loop while Iface /= Nil_String loop
ALI := ALI :=
File_Name_Type File_Name_Type
...@@ -1719,15 +1769,20 @@ package body MLib.Prj is ...@@ -1719,15 +1769,20 @@ package body MLib.Prj is
declare declare
Current_Dir : constant String := Get_Current_Dir; Current_Dir : constant String := Get_Current_Dir;
DLL_Name : aliased constant String := Dir : Dir_Type;
Lib_Filename.all & "." & DLL_Ext;
Name : String (1 .. 200);
Last : Natural;
Disregard : Boolean;
DLL_Name : aliased constant String :=
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased constant String := Archive_Name : aliased constant String :=
Lib_Filename.all & "." & Archive_Ext; Lib_Filename.all & "." & Archive_Ext;
Dir : Dir_Type;
Name : String (1 .. 200); Delete : Boolean := False;
Last : Natural;
Disregard : Boolean;
Delete : Boolean := False;
begin begin
-- Clean the library directory: remove any file with the name of -- Clean the library directory: remove any file with the name of
...@@ -1810,7 +1865,8 @@ package body MLib.Prj is ...@@ -1810,7 +1865,8 @@ package body MLib.Prj is
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Name); (Unit.File_Names (Specification).Name);
Name_Len := Name_Len - Name_Len :=
Name_Len -
File_Extension File_Extension
(Name (1 .. Name_Len))'Length; (Name (1 .. Name_Len))'Length;
...@@ -1844,10 +1900,7 @@ package body MLib.Prj is ...@@ -1844,10 +1900,7 @@ package body MLib.Prj is
when Dynamic | Relocatable => when Dynamic | Relocatable =>
Build_Dynamic_Library Build_Dynamic_Library
(Ofiles => Object_Files.all, (Ofiles => Object_Files.all,
Foreign => Foreign_Objects.all,
Afiles => Ali_Files.all,
Options => Options.all, Options => Options.all,
Options_2 => No_Argument_List,
Interfaces => Arguments (1 .. Argument_Number), Interfaces => Arguments (1 .. Argument_Number),
Lib_Filename => Lib_Filename.all, Lib_Filename => Lib_Filename.all,
Lib_Dir => Lib_Dirpath.all, Lib_Dir => Lib_Dirpath.all,
...@@ -1859,7 +1912,6 @@ package body MLib.Prj is ...@@ -1859,7 +1912,6 @@ package body MLib.Prj is
when Static => when Static =>
MLib.Build_Library MLib.Build_Library
(Object_Files.all, (Object_Files.all,
Ali_Files.all,
Lib_Filename.all, Lib_Filename.all,
Lib_Dirpath.all); Lib_Dirpath.all);
...@@ -1867,19 +1919,18 @@ package body MLib.Prj is ...@@ -1867,19 +1919,18 @@ package body MLib.Prj is
null; null;
end case; end case;
-- We need to copy the ALI files from the object directory to -- We need to copy the ALI files from the object directory to the
-- the library ALI directory, so that the linker find them there, -- library ALI directory, so that the linker find them there, and
-- and does not need to look in the object directory where it -- does not need to look in the object directory where it would also
-- would also find the object files; and we don't want that: -- find the object files; and we don't want that: we want the linker
-- we want the linker to use the library. -- to use the library.
-- Copy the ALI files and make the copies read-only. For interfaces, -- Copy the ALI files and make the copies read-only. For interfaces,
-- mark the copies as interfaces. -- mark the copies as interfaces.
Copy_ALI_Files Copy_ALI_Files
(Files => Ali_Files.all, (Files => Ali_Files.all,
To => In_Tree.Projects.Table To => In_Tree.Projects.Table (For_Project).Library_ALI_Dir,
(For_Project).Display_Library_ALI_Dir,
Interfaces => Arguments (1 .. Argument_Number)); Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified -- Copy interface sources if Library_Src_Dir specified
...@@ -1905,11 +1956,13 @@ package body MLib.Prj is ...@@ -1905,11 +1956,13 @@ package body MLib.Prj is
end; end;
declare declare
Dir : Dir_Type; Dir : Dir_Type;
Delete : Boolean := False; Delete : Boolean := False;
Unit : Unit_Data; Unit : Unit_Data;
Name : String (1 .. 200);
Last : Natural; Name : String (1 .. 200);
Last : Natural;
Disregard : Boolean; Disregard : Boolean;
begin begin
...@@ -1919,50 +1972,45 @@ package body MLib.Prj is ...@@ -1919,50 +1972,45 @@ package body MLib.Prj is
Read (Dir, Name, Last); Read (Dir, Name, Last);
exit when Last = 0; exit when Last = 0;
declare if Is_Regular_File (Name (1 .. Last)) then
Filename : constant String := Name (1 .. Last); Canonical_Case_File_Name (Name (1 .. Last));
Delete := False;
begin -- Compare with source file names of the project
if Is_Regular_File (Filename) then
Canonical_Case_File_Name (Name (1 .. Last));
Delete := False;
-- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project, In_Tree) =
For_Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
if Ultimate_Extension_Of for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
(Unit.File_Names Unit := In_Tree.Units.Table (Index);
(Specification).Project, In_Tree) = For_Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
end loop;
end if;
if Delete then if Ultimate_Extension_Of
Set_Writable (Filename); (Unit.File_Names (Body_Part).Project, In_Tree) =
Delete_File (Filename, Disregard); For_Project
end if; and then
end; Get_Name_String
(Unit.File_Names (Body_Part).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
if Ultimate_Extension_Of
(Unit.File_Names (Specification).Project, In_Tree) =
For_Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
end loop;
end if;
if Delete then
Set_Writable (Name (1 .. Last));
Delete_File (Name (1 .. Last), Disregard);
end if;
end loop; end loop;
Close (Dir); Close (Dir);
...@@ -2011,8 +2059,7 @@ package body MLib.Prj is ...@@ -2011,8 +2059,7 @@ package body MLib.Prj is
------------------- -------------------
procedure Check_Library procedure Check_Library
(For_Project : Project_Id; (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
In_Tree : Project_Tree_Ref)
is is
Data : constant Project_Data := Data : constant Project_Data :=
In_Tree.Projects.Table (For_Project); In_Tree.Projects.Table (For_Project);
...@@ -2026,7 +2073,7 @@ package body MLib.Prj is ...@@ -2026,7 +2073,7 @@ package body MLib.Prj is
if Data.Library then if Data.Library then
declare declare
Lib_Name : constant File_Name_Type := Lib_Name : constant File_Name_Type :=
Library_File_Name_For (For_Project, In_Tree); Library_File_Name_For (For_Project, In_Tree);
begin begin
Change_Dir (Get_Name_String (Data.Library_Dir)); Change_Dir (Get_Name_String (Data.Library_Dir));
Lib_TS := File_Stamp (Lib_Name); Lib_TS := File_Stamp (Lib_Name);
...@@ -2171,9 +2218,10 @@ package body MLib.Prj is ...@@ -2171,9 +2218,10 @@ package body MLib.Prj is
(Extending : Project_Id; (Extending : Project_Id;
Extended : Project_Id) return Boolean Extended : Project_Id) return Boolean
is is
Ext : Project_Id := Extending; Ext : Project_Id;
begin begin
Ext := Extending;
while Ext /= No_Project loop while Ext /= No_Project loop
if Ext = Extended then if Ext = Extended then
return True; return True;
...@@ -2451,7 +2499,6 @@ package body MLib.Prj is ...@@ -2451,7 +2499,6 @@ package body MLib.Prj is
begin begin
Objects.Init; Objects.Init;
Objects_Htable.Reset; Objects_Htable.Reset;
Foreigns.Init;
ALIs.Init; ALIs.Init;
Opts.Init; Opts.Init;
Processed_Projects.Reset; Processed_Projects.Reset;
......
gcc/ada/mlib-tgt-aix.adb
...@@ -42,10 +42,7 @@ package body MLib.Tgt.Specific is ...@@ -42,10 +42,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -56,6 +53,8 @@ package body MLib.Tgt.Specific is ...@@ -56,6 +53,8 @@ package body MLib.Tgt.Specific is
function DLL_Ext return String; function DLL_Ext return String;
function Library_Major_Minor_Id_Supported return Boolean;
function Support_For_Libraries return Library_Support; function Support_For_Libraries return Library_Support;
-- Local variables -- Local variables
...@@ -90,10 +89,7 @@ package body MLib.Tgt.Specific is ...@@ -90,10 +89,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -102,8 +98,6 @@ package body MLib.Tgt.Specific is ...@@ -102,8 +98,6 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Lib_Version); pragma Unreferenced (Lib_Version);
...@@ -178,7 +172,7 @@ package body MLib.Tgt.Specific is ...@@ -178,7 +172,7 @@ package body MLib.Tgt.Specific is
Objects => Ofiles, Objects => Ofiles,
Options => Options & Bexpall_Option, Options => Options & Bexpall_Option,
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Options_2 & Thread_Opts.all); Options_2 => Thread_Opts.all);
end Build_Dynamic_Library; end Build_Dynamic_Library;
------------- -------------
...@@ -190,6 +184,15 @@ package body MLib.Tgt.Specific is ...@@ -190,6 +184,15 @@ package body MLib.Tgt.Specific is
return "a"; return "a";
end DLL_Ext; end DLL_Ext;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return False;
end Library_Major_Minor_Id_Supported;
--------------------------- ---------------------------
-- Support_For_Libraries -- -- Support_For_Libraries --
--------------------------- ---------------------------
...@@ -202,6 +205,8 @@ package body MLib.Tgt.Specific is ...@@ -202,6 +205,8 @@ package body MLib.Tgt.Specific is
begin begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access; DLL_Ext_Ptr := DLL_Ext'Access;
Library_Major_Minor_Id_Supported_Ptr :=
Library_Major_Minor_Id_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access; Support_For_Libraries_Ptr := Support_For_Libraries'Access;
end MLib.Tgt.Specific; end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-darwin.adb
...@@ -33,8 +33,6 @@ with MLib.Utl; ...@@ -33,8 +33,6 @@ with MLib.Utl;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
-- Non default subprograms -- Non default subprograms
...@@ -43,10 +41,7 @@ package body MLib.Tgt.Specific is ...@@ -43,10 +41,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -70,8 +65,8 @@ package body MLib.Tgt.Specific is ...@@ -70,8 +65,8 @@ package body MLib.Tgt.Specific is
Shared_Libgcc : aliased String := "-shared-libgcc"; Shared_Libgcc : aliased String := "-shared-libgcc";
Shared_Options : constant Argument_List := Shared_Options : constant Argument_List :=
(1 => Flat_Namespace'Access, (1 => Flat_Namespace'Access,
2 => Shared_Libgcc'Access); 2 => Shared_Libgcc'Access);
----------------------------- -----------------------------
-- Archive_Indexer_Options -- -- Archive_Indexer_Options --
...@@ -88,10 +83,7 @@ package body MLib.Tgt.Specific is ...@@ -88,10 +83,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -100,15 +92,15 @@ package body MLib.Tgt.Specific is ...@@ -100,15 +92,15 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
Fil.Append_To (Lib_Filename, DLL_Ext);
Lib_Path : constant String :=
Lib_Dir & Directory_Separator & Lib_File;
Symbolic_Link_Needed : Boolean := False; Symbolic_Link_Needed : Boolean := False;
...@@ -126,55 +118,38 @@ package body MLib.Tgt.Specific is ...@@ -126,55 +118,38 @@ package body MLib.Tgt.Specific is
Objects => Ofiles, Objects => Ofiles,
Options => Options & Shared_Options, Options => Options & Shared_Options,
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Options_2); Options_2 => No_Argument_List);
else else
declare
if Is_Absolute_Path (Lib_Version) then Maj_Version : constant String :=
Utl.Gcc Major_Id_Name (Lib_File, Lib_Version);
(Output_File => Lib_Version, begin
Objects => Ofiles, if Is_Absolute_Path (Lib_Version) then
Options => Options & Shared_Options, Utl.Gcc
Driver_Name => Driver_Name, (Output_File => Lib_Version,
Options_2 => Options_2); Objects => Ofiles,
Symbolic_Link_Needed := Lib_Version /= Lib_File; Options => Options & Shared_Options,
Driver_Name => Driver_Name,
else Options_2 => No_Argument_List);
Utl.Gcc Symbolic_Link_Needed := Lib_Version /= Lib_File;
(Output_File => Lib_Dir & Directory_Separator & Lib_Version,
Objects => Ofiles, else
Options => Options & Shared_Options, Utl.Gcc
Driver_Name => Driver_Name, (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
Options_2 => Options_2); Objects => Ofiles,
Symbolic_Link_Needed := Options => Options & Shared_Options,
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; Driver_Name => Driver_Name,
end if; Options_2 => No_Argument_List);
Symbolic_Link_Needed :=
if Symbolic_Link_Needed then Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
declare end if;
Success : Boolean;
Oldpath : String (1 .. Lib_Version'Length + 1); if Symbolic_Link_Needed then
Newpath : String (1 .. Lib_File'Length + 1); Create_Sym_Links
(Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
Result : Integer; end if;
pragma Unreferenced (Result); end;
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 .. Lib_File'Length) := Lib_File;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_File, Success);
Result := Symlink (Oldpath'Address, Newpath'Address);
end;
end if;
end if; end if;
end Build_Dynamic_Library; end Build_Dynamic_Library;
......
gcc/ada/mlib-tgt-hpux.adb
...@@ -31,7 +31,6 @@ with MLib.Fil; ...@@ -31,7 +31,6 @@ with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is ...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is ...@@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -73,15 +66,15 @@ package body MLib.Tgt.Specific is ...@@ -73,15 +66,15 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
Lib_Path : constant String :=
Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access; Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False; Symbolic_Link_Needed : Boolean := False;
...@@ -96,65 +89,54 @@ package body MLib.Tgt.Specific is ...@@ -96,65 +89,54 @@ package body MLib.Tgt.Specific is
begin begin
if Opt.Verbose_Mode then if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library "); Write_Str ("building relocatable shared library ");
Write_Line (Lib_File); Write_Line (Lib_Path);
end if; end if;
if Lib_Version = "" then if Lib_Version = "" then
MLib.Utl.Gcc MLib.Utl.Gcc
(Output_File => Lib_File, (Output_File => Lib_Path,
Objects => Ofiles, Objects => Ofiles,
Options => Common_Options, Options => Common_Options,
Options_2 => Options_2, Options_2 => No_Argument_List,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
else else
Version_Arg := new String'("-Wl,+h," & Lib_Version); declare
Maj_Version : constant String :=
if Is_Absolute_Path (Lib_Version) then Major_Id_Name (Lib_File, Lib_Version);
MLib.Utl.Gcc begin
(Output_File => Lib_Version, if Maj_Version'Length /= 0 then
Objects => Ofiles, Version_Arg := new String'("-Wl,+h," & Maj_Version);
Options => Common_Options & Version_Arg,
Options_2 => Options_2, else
Driver_Name => Driver_Name); Version_Arg := new String'("-Wl,+h," & Lib_Version);
Symbolic_Link_Needed := Lib_Version /= Lib_File; end if;
else if Is_Absolute_Path (Lib_Version) then
MLib.Utl.Gcc MLib.Utl.Gcc
(Output_File => Lib_Dir & Directory_Separator & Lib_Version, (Output_File => Lib_Version,
Objects => Ofiles, Objects => Ofiles,
Options => Common_Options & Version_Arg, Options => Common_Options & Version_Arg,
Options_2 => Options_2, Options_2 => No_Argument_List,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
Symbolic_Link_Needed := Symbolic_Link_Needed := Lib_Version /= Lib_Path;
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
end if; else
MLib.Utl.Gcc
if Symbolic_Link_Needed then (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
declare Objects => Ofiles,
Success : Boolean; Options => Common_Options & Version_Arg,
Oldpath : String (1 .. Lib_Version'Length + 1); Options_2 => No_Argument_List,
Newpath : String (1 .. Lib_File'Length + 1); Driver_Name => Driver_Name);
Symbolic_Link_Needed :=
Result : Integer; Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
pragma Unreferenced (Result); end if;
function Symlink if Symbolic_Link_Needed then
(Oldpath : System.Address; Create_Sym_Links
Newpath : System.Address) return Integer; (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
pragma Import (C, Symlink, "__gnat_symlink"); end if;
end;
begin
Oldpath (1 .. Lib_Version'Length) := Lib_Version;
Oldpath (Oldpath'Last) := ASCII.NUL;
Newpath (1 .. Lib_File'Length) := Lib_File;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_File, Success);
Result := Symlink (Oldpath'Address, Newpath'Address);
end;
end if;
end if; end if;
end Build_Dynamic_Library; end Build_Dynamic_Library;
......
gcc/ada/mlib-tgt-irix.adb
...@@ -31,7 +31,6 @@ with MLib.Fil; ...@@ -31,7 +31,6 @@ with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is ...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is ...@@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is ...@@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & "lib" & MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
Lib_Path : constant String :=
Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access; Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False; Symbolic_Link_Needed : Boolean := False;
...@@ -89,7 +82,7 @@ package body MLib.Tgt.Specific is ...@@ -89,7 +82,7 @@ package body MLib.Tgt.Specific is
-- After moving -lxxx to Options_2, N_Options up to index Options_Last -- After moving -lxxx to Options_2, N_Options up to index Options_Last
-- will contain the Options to pass to MLib.Utl.Gcc. -- will contain the Options to pass to MLib.Utl.Gcc.
Real_Options_2 : Argument_List (1 .. Options'Length + Options_2'Length); Real_Options_2 : Argument_List (1 .. Options'Length);
Real_Options_2_Last : Natural := 0; Real_Options_2_Last : Natural := 0;
-- Real_Options_2 up to index Real_Options_2_Last will contain the -- Real_Options_2 up to index Real_Options_2_Last will contain the
-- Options_2 to pass to MLib.Utl.Gcc. -- Options_2 to pass to MLib.Utl.Gcc.
...@@ -97,7 +90,7 @@ package body MLib.Tgt.Specific is ...@@ -97,7 +90,7 @@ package body MLib.Tgt.Specific is
begin begin
if Opt.Verbose_Mode then if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library "); Write_Str ("building relocatable shared library ");
Write_Line (Lib_File); Write_Line (Lib_Path);
end if; end if;
-- Move all -lxxx to Options_2 -- Move all -lxxx to Options_2
...@@ -125,72 +118,53 @@ package body MLib.Tgt.Specific is ...@@ -125,72 +118,53 @@ package body MLib.Tgt.Specific is
end loop; end loop;
end; end;
-- Add to Real_Options_2 the argument Options_2
Real_Options_2
(Real_Options_2_Last + 1 .. Real_Options_2_Last + Options_2'Length) :=
Options_2;
Real_Options_2_Last := Real_Options_2_Last + Options_2'Length;
if Lib_Version = "" then if Lib_Version = "" then
MLib.Utl.Gcc MLib.Utl.Gcc
(Output_File => Lib_File, (Output_File => Lib_Path,
Objects => Ofiles, Objects => Ofiles,
Options => N_Options (N_Options'First .. Options_Last), Options => N_Options (N_Options'First .. Options_Last),
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
else else
Version_Arg := new String'("-Wl,-soname," & Lib_Version); declare
Maj_Version : constant String :=
if Is_Absolute_Path (Lib_Version) then Major_Id_Name (Lib_File, Lib_Version);
MLib.Utl.Gcc begin
(Output_File => Lib_Version, if Maj_Version'Length /= 0 then
Objects => Ofiles, Version_Arg := new String'("-Wl,-soname," & Maj_Version);
Options => N_Options (N_Options'First .. Options_Last) &
Version_Arg, else
Driver_Name => Driver_Name, Version_Arg := new String'("-Wl,-soname," & Lib_Version);
Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); end if;
Symbolic_Link_Needed := Lib_Version /= Lib_File;
if Is_Absolute_Path (Lib_Version) then
else MLib.Utl.Gcc
MLib.Utl.Gcc (Output_File => Lib_Version,
(Output_File => Lib_Dir & Directory_Separator & Lib_Version, Objects => Ofiles,
Objects => Ofiles, Options => N_Options (N_Options'First .. Options_Last) &
Options => N_Options (N_Options'First .. Options_Last) & Version_Arg,
Version_Arg, Driver_Name => Driver_Name,
Driver_Name => Driver_Name, Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); Symbolic_Link_Needed := Lib_Version /= Lib_Path;
Symbolic_Link_Needed :=
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; else
end if; MLib.Utl.Gcc
(Output_File => Lib_Dir & Directory_Separator & Lib_Version,
if Symbolic_Link_Needed then Objects => Ofiles,
declare Options => N_Options (N_Options'First .. Options_Last) &
Success : Boolean; Version_Arg,
Oldpath : String (1 .. Lib_Version'Length + 1); Driver_Name => Driver_Name,
Newpath : String (1 .. Lib_File'Length + 1); Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
Symbolic_Link_Needed :=
Result : Integer; Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
pragma Unreferenced (Result); end if;
function Symlink if Symbolic_Link_Needed then
(Oldpath : System.Address; Create_Sym_Links
Newpath : System.Address) (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
return Integer; end if;
pragma Import (C, Symlink, "__gnat_symlink"); end;
begin
Oldpath (1 .. Lib_Version'Length) := Lib_Version;
Oldpath (Oldpath'Last) := ASCII.NUL;
Newpath (1 .. Lib_File'Length) := Lib_File;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_File, Success);
Result := Symlink (Oldpath'Address, Newpath'Address);
end;
end if;
end if; end if;
end Build_Dynamic_Library; end Build_Dynamic_Library;
......
gcc/ada/mlib-tgt-linux.adb
...@@ -31,7 +31,6 @@ with MLib.Fil; ...@@ -31,7 +31,6 @@ with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is ...@@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is ...@@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -73,8 +66,6 @@ package body MLib.Tgt.Specific is ...@@ -73,8 +66,6 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
...@@ -101,56 +92,15 @@ package body MLib.Tgt.Specific is ...@@ -101,56 +92,15 @@ package body MLib.Tgt.Specific is
Objects => Ofiles, Objects => Ofiles,
Options => Options, Options => Options,
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Options_2); Options_2 => No_Argument_List);
else else
declare declare
Maj_Version : constant String := Lib_Version; Maj_Version : constant String :=
Last_Maj : Positive := Maj_Version'Last; Major_Id_Name (Lib_File, Lib_Version);
Last : Positive;
Ok_Maj : Boolean := False;
begin begin
while Last_Maj > Maj_Version'First loop if Maj_Version'Length /= 0 then
if Maj_Version (Last_Maj) in '0' .. '9' then Version_Arg := new String'("-Wl,-soname," & Maj_Version);
Last_Maj := Last_Maj - 1;
else
Ok_Maj := Last_Maj /= Maj_Version'Last and then
Maj_Version (Last_Maj) = '.';
if Ok_Maj then
Last_Maj := Last_Maj - 1;
end if;
exit;
end if;
end loop;
if Ok_Maj then
Last := Last_Maj;
while Last > Maj_Version'First loop
if Maj_Version (Last) in '0' .. '9' then
Last := Last - 1;
else
Ok_Maj := Last /= Last_Maj and then
Maj_Version (Last) = '.';
if Ok_Maj then
Last := Last - 1;
Ok_Maj := Maj_Version (1 .. Last) = Lib_File;
end if;
exit;
end if;
end loop;
end if;
if Ok_Maj then
Version_Arg := new String'("-Wl,-soname," &
Maj_Version (1 .. Last_Maj));
else else
Version_Arg := new String'("-Wl,-soname," & Lib_Version); Version_Arg := new String'("-Wl,-soname," & Lib_Version);
...@@ -162,7 +112,7 @@ package body MLib.Tgt.Specific is ...@@ -162,7 +112,7 @@ package body MLib.Tgt.Specific is
Objects => Ofiles, Objects => Ofiles,
Options => Options & Version_Arg, Options => Options & Version_Arg,
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Options_2); Options_2 => No_Argument_List);
Symbolic_Link_Needed := Lib_Version /= Lib_Path; Symbolic_Link_Needed := Lib_Version /= Lib_Path;
else else
...@@ -171,65 +121,14 @@ package body MLib.Tgt.Specific is ...@@ -171,65 +121,14 @@ package body MLib.Tgt.Specific is
Objects => Ofiles, Objects => Ofiles,
Options => Options & Version_Arg, Options => Options & Version_Arg,
Driver_Name => Driver_Name, Driver_Name => Driver_Name,
Options_2 => Options_2); Options_2 => No_Argument_List);
Symbolic_Link_Needed := Symbolic_Link_Needed :=
Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
end if; end if;
if Symbolic_Link_Needed then if Symbolic_Link_Needed then
declare Create_Sym_Links
Success : Boolean; (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
Oldpath : String (1 .. Lib_Version'Length + 1);
Newpath : String (1 .. Lib_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 .. Lib_Path'Length) := Lib_Path;
Newpath (Newpath'Last) := ASCII.NUL;
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 if;
end; end;
end if; end if;
......
gcc/ada/mlib-tgt-lynxos.adb
...@@ -33,10 +33,7 @@ package body MLib.Tgt.Specific is ...@@ -33,10 +33,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -51,6 +48,8 @@ package body MLib.Tgt.Specific is ...@@ -51,6 +48,8 @@ package body MLib.Tgt.Specific is
function PIC_Option return String; function PIC_Option return String;
function Library_Major_Minor_Id_Supported return Boolean;
function Standalone_Library_Auto_Init_Is_Supported return Boolean; function Standalone_Library_Auto_Init_Is_Supported return Boolean;
function Support_For_Libraries return Library_Support; function Support_For_Libraries return Library_Support;
...@@ -61,10 +60,7 @@ package body MLib.Tgt.Specific is ...@@ -61,10 +60,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -74,10 +70,7 @@ package body MLib.Tgt.Specific is ...@@ -74,10 +70,7 @@ package body MLib.Tgt.Specific is
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Ofiles); pragma Unreferenced (Ofiles);
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Options); pragma Unreferenced (Options);
pragma Unreferenced (Options_2);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Filename); pragma Unreferenced (Lib_Filename);
pragma Unreferenced (Lib_Dir); pragma Unreferenced (Lib_Dir);
...@@ -108,6 +101,15 @@ package body MLib.Tgt.Specific is ...@@ -108,6 +101,15 @@ package body MLib.Tgt.Specific is
return ""; return "";
end Dynamic_Option; end Dynamic_Option;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return False;
end Library_Major_Minor_Id_Supported;
---------------- ----------------
-- PIC_Option -- -- PIC_Option --
---------------- ----------------
...@@ -139,6 +141,8 @@ begin ...@@ -139,6 +141,8 @@ begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access; DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access; Dynamic_Option_Ptr := Dynamic_Option'Access;
Library_Major_Minor_Id_Supported_Ptr :=
Library_Major_Minor_Id_Supported'Access;
PIC_Option_Ptr := PIC_Option'Access; PIC_Option_Ptr := PIC_Option'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr := Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access; Standalone_Library_Auto_Init_Is_Supported'Access;
......
gcc/ada/mlib-tgt-mingw.adb
...@@ -43,10 +43,7 @@ package body MLib.Tgt.Specific is ...@@ -43,10 +43,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -61,6 +58,8 @@ package body MLib.Tgt.Specific is ...@@ -61,6 +58,8 @@ package body MLib.Tgt.Specific is
function Is_Archive_Ext (Ext : String) return Boolean; function Is_Archive_Ext (Ext : String) return Boolean;
function Library_Major_Minor_Id_Supported return Boolean;
function PIC_Option return String; function PIC_Option return String;
No_Argument_List : constant String_List := (1 .. 0 => null); No_Argument_List : constant String_List := (1 .. 0 => null);
...@@ -72,10 +71,7 @@ package body MLib.Tgt.Specific is ...@@ -72,10 +71,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -84,8 +80,6 @@ package body MLib.Tgt.Specific is ...@@ -84,8 +80,6 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Version); pragma Unreferenced (Lib_Version);
...@@ -93,7 +87,7 @@ package body MLib.Tgt.Specific is ...@@ -93,7 +87,7 @@ package body MLib.Tgt.Specific is
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & Lib_Dir & Directory_Separator &
Files.Append_To (Lib_Filename, DLL_Ext); DLL_Prefix & Files.Append_To (Lib_Filename, DLL_Ext);
-- Start of processing for Build_Dynamic_Library -- Start of processing for Build_Dynamic_Library
...@@ -107,7 +101,7 @@ package body MLib.Tgt.Specific is ...@@ -107,7 +101,7 @@ package body MLib.Tgt.Specific is
(Output_File => Lib_File, (Output_File => Lib_File,
Objects => Ofiles, Objects => Ofiles,
Options => No_Argument_List, Options => No_Argument_List,
Options_2 => Options & Options_2, Options_2 => Options,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
end Build_Dynamic_Library; end Build_Dynamic_Library;
...@@ -126,7 +120,7 @@ package body MLib.Tgt.Specific is ...@@ -126,7 +120,7 @@ package body MLib.Tgt.Specific is
function DLL_Prefix return String is function DLL_Prefix return String is
begin begin
return ""; return "lib";
end DLL_Prefix; end DLL_Prefix;
-------------------- --------------------
...@@ -138,6 +132,15 @@ package body MLib.Tgt.Specific is ...@@ -138,6 +132,15 @@ package body MLib.Tgt.Specific is
return Ext = ".a" or else Ext = ".dll"; return Ext = ".a" or else Ext = ".dll";
end Is_Archive_Ext; end Is_Archive_Ext;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return False;
end Library_Major_Minor_Id_Supported;
---------------- ----------------
-- PIC_Option -- -- PIC_Option --
---------------- ----------------
...@@ -149,8 +152,10 @@ package body MLib.Tgt.Specific is ...@@ -149,8 +152,10 @@ package body MLib.Tgt.Specific is
begin begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access; DLL_Ext_Ptr := DLL_Ext'Access;
DLL_Prefix_Ptr := DLL_Prefix'Access; DLL_Prefix_Ptr := DLL_Prefix'Access;
Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access; PIC_Option_Ptr := PIC_Option'Access;
Library_Major_Minor_Id_Supported_Ptr :=
Library_Major_Minor_Id_Supported'Access;
end MLib.Tgt.Specific; end MLib.Tgt.Specific;
gcc/ada/mlib-tgt-solaris.adb
...@@ -31,7 +31,6 @@ with MLib.Fil; ...@@ -31,7 +31,6 @@ with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is ...@@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is ...@@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is ...@@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
Fil.Append_To (Lib_Filename, DLL_Ext);
Lib_Path : constant String :=
Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access; Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False; Symbolic_Link_Needed : Boolean := False;
...@@ -87,66 +80,54 @@ package body MLib.Tgt.Specific is ...@@ -87,66 +80,54 @@ package body MLib.Tgt.Specific is
begin begin
if Opt.Verbose_Mode then if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library "); Write_Str ("building relocatable shared library ");
Write_Line (Lib_File); Write_Line (Lib_Path);
end if; end if;
if Lib_Version = "" then if Lib_Version = "" then
Utl.Gcc Utl.Gcc
(Output_File => Lib_File, (Output_File => Lib_Path,
Objects => Ofiles, Objects => Ofiles,
Options => Options, Options => Options,
Options_2 => Options_2, Options_2 => No_Argument_List,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
else else
Version_Arg := new String'("-Wl,-h," & Lib_Version); declare
Maj_Version : constant String :=
if Is_Absolute_Path (Lib_Version) then Major_Id_Name (Lib_File, Lib_Version);
Utl.Gcc begin
(Output_File => Lib_Version, if Maj_Version'Length /= 0 then
Objects => Ofiles, Version_Arg := new String'("-Wl,-h," & Maj_Version);
Options => Options & Version_Arg,
Options_2 => Options_2, else
Driver_Name => Driver_Name); Version_Arg := new String'("-Wl,-h," & Lib_Version);
Symbolic_Link_Needed := Lib_Version /= Lib_File; end if;
else if Is_Absolute_Path (Lib_Version) then
Utl.Gcc Utl.Gcc
(Output_File => Lib_Dir & Directory_Separator & Lib_Version, (Output_File => Lib_Version,
Objects => Ofiles, Objects => Ofiles,
Options => Options & Version_Arg, Options => Options & Version_Arg,
Options_2 => Options_2, Options_2 => No_Argument_List,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
Symbolic_Link_Needed := Symbolic_Link_Needed := Lib_Version /= Lib_Path;
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
end if; else
Utl.Gcc
if Symbolic_Link_Needed then (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
declare Objects => Ofiles,
Success : Boolean; Options => Options & Version_Arg,
Oldpath : String (1 .. Lib_Version'Length + 1); Options_2 => No_Argument_List,
Newpath : String (1 .. Lib_File'Length + 1); Driver_Name => Driver_Name);
Symbolic_Link_Needed :=
Result : Integer; Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
pragma Unreferenced (Result); end if;
function Symlink if Symbolic_Link_Needed then
(Oldpath : System.Address; Create_Sym_Links
Newpath : System.Address) (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
return Integer; end if;
pragma Import (C, Symlink, "__gnat_symlink"); end;
begin
Oldpath (1 .. Lib_Version'Length) := Lib_Version;
Oldpath (Oldpath'Last) := ASCII.NUL;
Newpath (1 .. Lib_File'Length) := Lib_File;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_File, Success);
Result := Symlink (Oldpath'Address, Newpath'Address);
end;
end if;
end if; end if;
end Build_Dynamic_Library; end Build_Dynamic_Library;
......
gcc/ada/mlib-tgt-tru64.adb
...@@ -31,7 +31,6 @@ with MLib.Fil; ...@@ -31,7 +31,6 @@ with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
with System;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is ...@@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -67,10 +63,7 @@ package body MLib.Tgt.Specific is ...@@ -67,10 +63,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -79,16 +72,16 @@ package body MLib.Tgt.Specific is ...@@ -79,16 +72,16 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data); pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init); pragma Unreferenced (Auto_Init);
-- Initialization is done through the contructor mechanism -- Initialization is done through the contructor mechanism
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
Fil.Append_To (Lib_Filename, DLL_Ext);
Lib_Path : constant String :=
Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access; Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False; Symbolic_Link_Needed : Boolean := False;
...@@ -96,70 +89,58 @@ package body MLib.Tgt.Specific is ...@@ -96,70 +89,58 @@ package body MLib.Tgt.Specific is
begin begin
if Opt.Verbose_Mode then if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library "); Write_Str ("building relocatable shared library ");
Write_Line (Lib_File); Write_Line (Lib_Path);
end if; end if;
-- If specified, add automatic elaboration/finalization -- If specified, add automatic elaboration/finalization
if Lib_Version = "" then if Lib_Version = "" then
Utl.Gcc Utl.Gcc
(Output_File => Lib_File, (Output_File => Lib_Path,
Objects => Ofiles, Objects => Ofiles,
Options => Options & Expect_Unresolved'Access, Options => Options & Expect_Unresolved'Access,
Options_2 => Options_2, Options_2 => No_Argument_List,
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
else else
Version_Arg := new String'("-Wl,-soname," & Lib_Version); declare
Maj_Version : constant String :=
if Is_Absolute_Path (Lib_Version) then Major_Id_Name (Lib_File, Lib_Version);
Utl.Gcc begin
(Output_File => Lib_Version, if Maj_Version'Length /= 0 then
Objects => Ofiles, Version_Arg := new String'("-Wl,-soname," & Maj_Version);
Options =>
Options & Version_Arg & Expect_Unresolved'Access, else
Options_2 => Options_2, Version_Arg := new String'("-Wl,-soname," & Lib_Version);
Driver_Name => Driver_Name); end if;
Symbolic_Link_Needed := Lib_Version /= Lib_File;
if Is_Absolute_Path (Lib_Version) then
else Utl.Gcc
Utl.Gcc (Output_File => Lib_Version,
(Output_File => Lib_Dir & Directory_Separator & Lib_Version, Objects => Ofiles,
Objects => Ofiles, Options =>
Options => Options & Version_Arg & Expect_Unresolved'Access,
Options & Version_Arg & Expect_Unresolved'Access, Options_2 => No_Argument_List,
Options_2 => Options_2, Driver_Name => Driver_Name);
Driver_Name => Driver_Name); Symbolic_Link_Needed := Lib_Version /= Lib_Path;
Symbolic_Link_Needed :=
Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; else
end if; Utl.Gcc
(Output_File => Lib_Dir & Directory_Separator & Lib_Version,
if Symbolic_Link_Needed then Objects => Ofiles,
declare Options =>
Success : Boolean; Options & Version_Arg & Expect_Unresolved'Access,
Oldpath : String (1 .. Lib_Version'Length + 1); Options_2 => No_Argument_List,
Newpath : String (1 .. Lib_File'Length + 1); Driver_Name => Driver_Name);
Symbolic_Link_Needed :=
Result : Integer; Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
pragma Unreferenced (Result); end if;
function Symlink if Symbolic_Link_Needed then
(Oldpath : System.Address; Create_Sym_Links
Newpath : System.Address) (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
return Integer; end if;
pragma Import (C, Symlink, "__gnat_symlink"); end;
begin
Oldpath (1 .. Lib_Version'Length) := Lib_Version;
Oldpath (Oldpath'Last) := ASCII.NUL;
Newpath (1 .. Lib_File'Length) := Lib_File;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_File, Success);
Result := Symlink (Oldpath'Address, Newpath'Address);
end;
end if;
end if; end if;
end Build_Dynamic_Library; end Build_Dynamic_Library;
......
gcc/ada/mlib-tgt-vms-alpha.adb
...@@ -36,8 +36,8 @@ with MLib.Tgt.VMS; ...@@ -36,8 +36,8 @@ with MLib.Tgt.VMS;
pragma Warnings (Off, MLib.Tgt.VMS); pragma Warnings (Off, MLib.Tgt.VMS);
-- MLib.Tgt.VMS is with'ed only for elaboration purposes -- MLib.Tgt.VMS is with'ed only for elaboration purposes
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
...@@ -51,10 +51,7 @@ package body MLib.Tgt.Specific is ...@@ -51,10 +51,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is ...@@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is ...@@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & Lib_Dir & Directory_Separator & "lib" &
...@@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is ...@@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is
function Option_File_Name return String is function Option_File_Name return String is
begin begin
if Symbol_Data.Symbol_File = No_Name then if Symbol_Data.Symbol_File = No_Path then
return "symvec.opt"; return "symvec.opt";
else else
Get_Name_String (Symbol_Data.Symbol_File); Get_Name_String (Symbol_Data.Symbol_File);
...@@ -386,7 +378,7 @@ package body MLib.Tgt.Specific is ...@@ -386,7 +378,7 @@ package body MLib.Tgt.Specific is
-- Reference Symbol File -- Reference Symbol File
if Symbol_Data.Reference /= No_Name then if Symbol_Data.Reference /= No_Path then
Last_Argument := Last_Argument + 1; Last_Argument := Last_Argument + 1;
Arguments (Last_Argument) := new String'("-r"); Arguments (Last_Argument) := new String'("-r");
Last_Argument := Last_Argument + 1; Last_Argument := Last_Argument + 1;
...@@ -477,7 +469,7 @@ package body MLib.Tgt.Specific is ...@@ -477,7 +469,7 @@ package body MLib.Tgt.Specific is
Options => VMS_Options, Options => VMS_Options,
Options_2 => Shared_Libgcc_Switch & Options_2 => Shared_Libgcc_Switch &
Opts (Opts'First .. Last_Opt) & Opts (Opts'First .. Last_Opt) &
Opts2 (Opts2'First .. Last_Opt2) & Options_2, Opts2 (Opts2'First .. Last_Opt2),
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
-- The auto-init object file need to be deleted, so that it will not -- The auto-init object file need to be deleted, so that it will not
......
gcc/ada/mlib-tgt-vms-ia64.adb
...@@ -36,8 +36,8 @@ with MLib.Tgt.VMS; ...@@ -36,8 +36,8 @@ with MLib.Tgt.VMS;
pragma Warnings (Off, MLib.Tgt.VMS); pragma Warnings (Off, MLib.Tgt.VMS);
-- MLib.Tgt.VMS is with'ed only for elaboration purposes -- MLib.Tgt.VMS is with'ed only for elaboration purposes
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
...@@ -47,14 +47,11 @@ with System.CRTL; use System.CRTL; ...@@ -47,14 +47,11 @@ with System.CRTL; use System.CRTL;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
-- Non default subprogram. See comment in mlib-tgt.ads -- Non default subprogram. See comment in mlib-tgt.ads.
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is ...@@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is ...@@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
Lib_File : constant String := Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" & Lib_Dir & Directory_Separator & "lib" &
...@@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is ...@@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is
function Option_File_Name return String is function Option_File_Name return String is
begin begin
if Symbol_Data.Symbol_File = No_Name then if Symbol_Data.Symbol_File = No_Path then
return "symvec.opt"; return "symvec.opt";
else else
Get_Name_String (Symbol_Data.Symbol_File); Get_Name_String (Symbol_Data.Symbol_File);
...@@ -420,7 +412,7 @@ package body MLib.Tgt.Specific is ...@@ -420,7 +412,7 @@ package body MLib.Tgt.Specific is
-- Reference Symbol File -- Reference Symbol File
if Symbol_Data.Reference /= No_Name then if Symbol_Data.Reference /= No_Path then
Last_Argument := Last_Argument + 1; Last_Argument := Last_Argument + 1;
Arguments (Last_Argument) := new String'("-r"); Arguments (Last_Argument) := new String'("-r");
Last_Argument := Last_Argument + 1; Last_Argument := Last_Argument + 1;
...@@ -510,7 +502,7 @@ package body MLib.Tgt.Specific is ...@@ -510,7 +502,7 @@ package body MLib.Tgt.Specific is
Options => VMS_Options, Options => VMS_Options,
Options_2 => Shared_Libgcc_Switch & Options_2 => Shared_Libgcc_Switch &
Opts (Opts'First .. Last_Opt) & Opts (Opts'First .. Last_Opt) &
Opts2 (Opts2'First .. Last_Opt2) & Options_2, Opts2 (Opts2'First .. Last_Opt2),
Driver_Name => Driver_Name); Driver_Name => Driver_Name);
-- The auto-init object file need to be deleted, so that it will not -- The auto-init object file need to be deleted, so that it will not
......
gcc/ada/mlib-tgt-vms.adb
...@@ -44,6 +44,8 @@ package body MLib.Tgt.VMS is ...@@ -44,6 +44,8 @@ package body MLib.Tgt.VMS is
function Object_Ext return String; function Object_Ext return String;
function Library_Major_Minor_Id_Supported return Boolean;
function PIC_Option return String; function PIC_Option return String;
----------------- -----------------
...@@ -110,6 +112,15 @@ package body MLib.Tgt.VMS is ...@@ -110,6 +112,15 @@ package body MLib.Tgt.VMS is
end if; end if;
end Libgnat; end Libgnat;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return False;
end Library_Major_Minor_Id_Supported;
---------------- ----------------
-- Object_Ext -- -- Object_Ext --
---------------- ----------------
...@@ -139,4 +150,7 @@ begin ...@@ -139,4 +150,7 @@ begin
Libgnat_Ptr := Libgnat'Access; Libgnat_Ptr := Libgnat'Access;
Object_Ext_Ptr := Object_Ext'Access; Object_Ext_Ptr := Object_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access; PIC_Option_Ptr := PIC_Option'Access;
Library_Major_Minor_Id_Supported_Ptr :=
Library_Major_Minor_Id_Supported'Access;
end MLib.Tgt.VMS; end MLib.Tgt.VMS;
gcc/ada/mlib-tgt-vxworks.adb
...@@ -28,7 +28,6 @@ ...@@ -28,7 +28,6 @@
-- This is the VxWorks version of the body -- This is the VxWorks version of the body
with Sdefault; with Sdefault;
with Types; use Types;
package body MLib.Tgt.Specific is package body MLib.Tgt.Specific is
...@@ -48,10 +47,7 @@ package body MLib.Tgt.Specific is ...@@ -48,10 +47,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -64,6 +60,8 @@ package body MLib.Tgt.Specific is ...@@ -64,6 +60,8 @@ package body MLib.Tgt.Specific is
function Dynamic_Option return String; function Dynamic_Option return String;
function Library_Major_Minor_Id_Supported return Boolean;
function PIC_Option return String; function PIC_Option return String;
function Standalone_Library_Auto_Init_Is_Supported return Boolean; function Standalone_Library_Auto_Init_Is_Supported return Boolean;
...@@ -94,10 +92,7 @@ package body MLib.Tgt.Specific is ...@@ -94,10 +92,7 @@ package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -107,10 +102,7 @@ package body MLib.Tgt.Specific is ...@@ -107,10 +102,7 @@ package body MLib.Tgt.Specific is
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
pragma Unreferenced (Ofiles); pragma Unreferenced (Ofiles);
pragma Unreferenced (Foreign);
pragma Unreferenced (Afiles);
pragma Unreferenced (Options); pragma Unreferenced (Options);
pragma Unreferenced (Options_2);
pragma Unreferenced (Interfaces); pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Filename); pragma Unreferenced (Lib_Filename);
pragma Unreferenced (Lib_Dir); pragma Unreferenced (Lib_Dir);
...@@ -146,7 +138,7 @@ package body MLib.Tgt.Specific is ...@@ -146,7 +138,7 @@ package body MLib.Tgt.Specific is
----------------------------- -----------------------------
function Get_Target_Suffix return String is function Get_Target_Suffix return String is
Target_Name : constant String_Ptr := Sdefault.Target_Name; Target_Name : constant String := Sdefault.Target_Name.all;
Index : Positive := Target_Name'First; Index : Positive := Target_Name'First;
begin begin
...@@ -175,6 +167,15 @@ package body MLib.Tgt.Specific is ...@@ -175,6 +167,15 @@ package body MLib.Tgt.Specific is
end if; end if;
end Get_Target_Suffix; end Get_Target_Suffix;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return False;
end Library_Major_Minor_Id_Supported;
---------------- ----------------
-- PIC_Option -- -- PIC_Option --
---------------- ----------------
...@@ -209,6 +210,8 @@ begin ...@@ -209,6 +210,8 @@ begin
DLL_Ext_Ptr := DLL_Ext'Access; DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access; Dynamic_Option_Ptr := Dynamic_Option'Access;
PIC_Option_Ptr := PIC_Option'Access; PIC_Option_Ptr := PIC_Option'Access;
Library_Major_Minor_Id_Supported_Ptr :=
Library_Major_Minor_Id_Supported'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr := Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access; Standalone_Library_Auto_Init_Is_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access; Support_For_Libraries_Ptr := Support_For_Libraries'Access;
......
gcc/ada/mlib-tgt.adb
...@@ -151,25 +151,19 @@ package body MLib.Tgt is ...@@ -151,25 +151,19 @@ package body MLib.Tgt is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
Symbol_Data : Symbol_Record; Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name; Driver_Name : Name_Id := No_Name;
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False) Auto_Init : Boolean := False)
is is
begin begin
Build_Dynamic_Library_Ptr Build_Dynamic_Library_Ptr
(Ofiles, (Ofiles,
Foreign,
Afiles,
Options, Options,
Options_2,
Interfaces, Interfaces,
Lib_Filename, Lib_Filename,
Lib_Dir, Lib_Dir,
...@@ -404,7 +398,9 @@ package body MLib.Tgt is ...@@ -404,7 +398,9 @@ package body MLib.Tgt is
(In_Tree.Projects.Table (Project).Library_Name); (In_Tree.Projects.Table (Project).Library_Name);
begin begin
if In_Tree.Projects.Table (Project).Library_Kind = Static then if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3; Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib"; Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext)); Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
...@@ -419,6 +415,24 @@ package body MLib.Tgt is ...@@ -419,6 +415,24 @@ package body MLib.Tgt is
end if; end if;
end Library_File_Name_For_Default; end Library_File_Name_For_Default;
--------------------------------------
-- Library_Major_Minor_Id_Supported --
--------------------------------------
function Library_Major_Minor_Id_Supported return Boolean is
begin
return Library_Major_Minor_Id_Supported_Ptr.all;
end Library_Major_Minor_Id_Supported;
----------------------------------------------
-- Library_Major_Minor_Id_Supported_Default --
----------------------------------------------
function Library_Major_Minor_Id_Supported_Default return Boolean is
begin
return True;
end Library_Major_Minor_Id_Supported_Default;
---------------- ----------------
-- Object_Ext -- -- Object_Ext --
---------------- ----------------
...@@ -490,5 +504,4 @@ package body MLib.Tgt is ...@@ -490,5 +504,4 @@ package body MLib.Tgt is
begin begin
return Full; return Full;
end Support_For_Libraries_Default; end Support_For_Libraries_Default;
end MLib.Tgt; end MLib.Tgt;
gcc/ada/mlib-tgt.ads
...@@ -36,14 +36,6 @@ with Prj; use Prj; ...@@ -36,14 +36,6 @@ with Prj; use Prj;
package MLib.Tgt is package MLib.Tgt is
type Library_Support is (None, Static_Only, Full);
-- Support for Library Project File.
-- - None: Library Project Files are not supported at all
-- - Static_Only: Library Project Files are only supported for static
-- libraries.
-- - Full: Library Project Files are supported for static and dynamic
-- (shared) libraries.
function Support_For_Libraries return Library_Support; function Support_For_Libraries return Library_Support;
-- Indicates how building libraries by gnatmake is supported by the GNAT -- Indicates how building libraries by gnatmake is supported by the GNAT
-- implementation for the platform. -- implementation for the platform.
...@@ -113,29 +105,20 @@ package MLib.Tgt is ...@@ -113,29 +105,20 @@ package MLib.Tgt is
procedure Build_Dynamic_Library procedure Build_Dynamic_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
Symbol_Data : Symbol_Record; Symbol_Data : Symbol_Record;
Driver_Name : Name_Id := No_Name; Driver_Name : Name_Id := No_Name;
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False); Auto_Init : Boolean := False);
-- Build a dynamic/relocatable library -- Build a dynamic/relocatable library
-- --
-- Ofiles is the list of all object files in the library -- Ofiles is the list of all object files in the library
-- --
-- Foreign is the list of non Ada object files (also included in Ofiles) -- Options is a list of options to be passed to the tool
-- -- (gcc or other) that effectively builds the dynamic library.
-- Afiles is the list of ALI files for the Ada object files
--
-- Options and Options_2 are lists of options to be passed to the tool
-- (gcc or other) that effectively builds the dynamic library. Options
-- are passed before the object files, Options_2 are passed after the
-- object files.
-- --
-- Interfaces is the list of ALI files for the interfaces of a SAL. -- Interfaces is the list of ALI files for the interfaces of a SAL.
-- It is empty if the library is not a SAL. -- It is empty if the library is not a SAL.
...@@ -155,9 +138,9 @@ package MLib.Tgt is ...@@ -155,9 +138,9 @@ package MLib.Tgt is
-- Symbol_Data is used for some patforms, including VMS, to generate -- Symbol_Data is used for some patforms, including VMS, to generate
-- the symbols to be exported by the library. -- the symbols to be exported by the library.
-- --
-- Note: Depending on the OS, some of the parameters may not be taken -- Note: Depending on the OS, some of the parameters may not be taken into
-- into account. For example, on Linux, Foreign, Afiles Lib_Address and -- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init
-- Relocatable are ignored. -- are ignored.
function Library_Exists_For function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean; (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
...@@ -170,7 +153,16 @@ package MLib.Tgt is ...@@ -170,7 +153,16 @@ package MLib.Tgt is
-- Returns the file name of the library file of a library project. -- Returns the file name of the library file of a library project.
-- This function can only be called for library projects. -- This function can only be called for library projects.
function Library_Major_Minor_Id_Supported return Boolean;
-- Indicates if major and minor ids are supported for libraries.
-- If they are supported, then a Library_Version such as libtoto.so.1.2
-- will have a major id of 1 and a minor id of 2. Then litoto.so,
-- libtoto.so.1 and libtoto.so.1.2 will be created, all three designating
-- the same file.
private private
No_Argument_List : constant Argument_List := (1 .. 0 => null);
-- Access to subprogram types for indirection -- Access to subprogram types for indirection
type String_Function is access function return String; type String_Function is access function return String;
...@@ -179,10 +171,7 @@ private ...@@ -179,10 +171,7 @@ private
return String_List_Access; return String_List_Access;
type Build_Dynamic_Library_Function is access procedure type Build_Dynamic_Library_Function is access procedure
(Ofiles : Argument_List; (Ofiles : Argument_List;
Foreign : Argument_List;
Afiles : Argument_List;
Options : Argument_List; Options : Argument_List;
Options_2 : Argument_List;
Interfaces : Argument_List; Interfaces : Argument_List;
Lib_Filename : String; Lib_Filename : String;
Lib_Dir : String; Lib_Dir : String;
...@@ -190,16 +179,12 @@ private ...@@ -190,16 +179,12 @@ private
Driver_Name : Name_Id := No_Name; Driver_Name : Name_Id := No_Name;
Lib_Version : String := ""; Lib_Version : String := "";
Auto_Init : Boolean := False); Auto_Init : Boolean := False);
type Library_Exists_For_Function is access function type Library_Exists_For_Function is access function
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean; (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
type Library_File_Name_For_Function is access function type Library_File_Name_For_Function is access function
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type; In_Tree : Project_Tree_Ref) return File_Name_Type;
type Boolean_Function is access function return Boolean; type Boolean_Function is access function return Boolean;
type Library_Support_Function is access function return Library_Support; type Library_Support_Function is access function return Library_Support;
function Archive_Builder_Default return String; function Archive_Builder_Default return String;
...@@ -210,10 +195,8 @@ private ...@@ -210,10 +195,8 @@ private
Archive_Builder_Options_Default'Access; Archive_Builder_Options_Default'Access;
function Archive_Builder_Append_Options_Default return String_List_Access; function Archive_Builder_Append_Options_Default return String_List_Access;
Archive_Builder_Append_Options_Ptr : String_List_Access_Function :=
Archive_Builder_Append_Options_Ptr : Archive_Builder_Append_Options_Default'Access;
String_List_Access_Function :=
Archive_Builder_Append_Options_Default'Access;
function Archive_Ext_Default return String; function Archive_Ext_Default return String;
Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access; Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access;
...@@ -276,4 +259,8 @@ private ...@@ -276,4 +259,8 @@ private
function Support_For_Libraries_Default return Library_Support; function Support_For_Libraries_Default return Library_Support;
Support_For_Libraries_Ptr : Library_Support_Function := Support_For_Libraries_Ptr : Library_Support_Function :=
Support_For_Libraries_Default'Access; Support_For_Libraries_Default'Access;
function Library_Major_Minor_Id_Supported_Default return Boolean;
Library_Major_Minor_Id_Supported_Ptr : Boolean_Function :=
Library_Major_Minor_Id_Supported_Default'Access;
end MLib.Tgt; end MLib.Tgt;
gcc/ada/mlib.adb
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C.Strings; with Interfaces.C.Strings;
with System;
with Hostparm; with Hostparm;
with Opt; with Opt;
...@@ -45,12 +46,9 @@ package body MLib is ...@@ -45,12 +46,9 @@ package body MLib is
procedure Build_Library procedure Build_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Afiles : Argument_List;
Output_File : String; Output_File : String;
Output_Dir : String) Output_Dir : String)
is is
pragma Warnings (Off, Afiles);
begin begin
if Opt.Verbose_Mode and not Opt.Quiet_Output then if Opt.Verbose_Mode and not Opt.Quiet_Output then
Write_Line ("building a library..."); Write_Line ("building a library...");
...@@ -123,6 +121,8 @@ package body MLib is ...@@ -123,6 +121,8 @@ package body MLib is
end if; end if;
end Verbose_Copy; end Verbose_Copy;
-- Start of processing for Copy_ALI_Files
begin begin
if Interfaces'Length = 0 then if Interfaces'Length = 0 then
...@@ -152,6 +152,7 @@ package body MLib is ...@@ -152,6 +152,7 @@ package body MLib is
declare declare
File_Name : String := Base_Name (Files (Index).all); File_Name : String := Base_Name (Files (Index).all);
begin begin
Canonical_Case_File_Name (File_Name); Canonical_Case_File_Name (File_Name);
...@@ -214,9 +215,9 @@ package body MLib is ...@@ -214,9 +215,9 @@ package body MLib is
end loop; end loop;
-- We are done with the input file, so we close it -- We are done with the input file, so we close it
-- ignoring any bad status.
Close (FD, Status); Close (FD, Status);
-- We simply ignore any bad status
P_Line_Found := False; P_Line_Found := False;
...@@ -274,11 +275,10 @@ package body MLib is ...@@ -274,11 +275,10 @@ package body MLib is
end if; end if;
end; end;
else -- This is not an interface ALI
-- This is not an interface ALI
else
Success := True; Success := True;
end if; end if;
end; end;
...@@ -289,6 +289,76 @@ package body MLib is ...@@ -289,6 +289,76 @@ package body MLib is
end if; end if;
end Copy_ALI_Files; end Copy_ALI_Files;
----------------------
-- Create_Sym_Links --
----------------------
procedure Create_Sym_Links
(Lib_Path : String;
Lib_Version : String;
Lib_Dir : String;
Maj_Version : String)
is
function Symlink
(Oldpath : System.Address;
Newpath : System.Address) return Integer;
pragma Import (C, Symlink, "__gnat_symlink");
Success : Boolean;
Version_Path : String_Access;
Result : Integer;
pragma Unreferenced (Result);
begin
if Is_Absolute_Path (Lib_Version) then
Version_Path := new String (1 .. Lib_Version'Length + 1);
Version_Path (1 .. Lib_Version'Length) := Lib_Version;
else
Version_Path :=
new String (1 .. Lib_Dir'Length + 1 + Lib_Version'Length + 1);
Version_Path (1 .. Version_Path'Last - 1) :=
Lib_Dir & Directory_Separator & Lib_Version;
end if;
Version_Path (Version_Path'Last) := ASCII.NUL;
if Maj_Version'Length = 0 then
declare
Newpath : String (1 .. Lib_Path'Length + 1);
begin
Newpath (1 .. Lib_Path'Length) := Lib_Path;
Newpath (Newpath'Last) := ASCII.NUL;
Delete_File (Lib_Path, Success);
Result := Symlink (Version_Path (1)'Address, Newpath'Address);
end;
else
declare
Newpath1 : String (1 .. Lib_Path'Length + 1);
Maj_Path : constant String :=
Lib_Dir & Directory_Separator & Maj_Version;
Newpath2 : String (1 .. Maj_Path'Length + 1);
begin
Newpath1 (1 .. Lib_Path'Length) := Lib_Path;
Newpath1 (Newpath1'Last) := ASCII.NUL;
Newpath2 (1 .. Maj_Path'Length) := Maj_Path;
Newpath2 (Newpath2'Last) := ASCII.NUL;
Delete_File (Maj_Path, Success);
Result := Symlink (Version_Path (1)'Address, Newpath2'Address);
Delete_File (Lib_Path, Success);
Result := Symlink (Newpath2'Address, Newpath1'Address);
end;
end if;
end Create_Sym_Links;
-------------------------------- --------------------------------
-- Linker_Library_Path_Option -- -- Linker_Library_Path_Option --
-------------------------------- --------------------------------
...@@ -311,6 +381,66 @@ package body MLib is ...@@ -311,6 +381,66 @@ package body MLib is
end if; end if;
end Linker_Library_Path_Option; end Linker_Library_Path_Option;
-------------------
-- Major_Id_Name --
-------------------
function Major_Id_Name
(Lib_Filename : String;
Lib_Version : String)
return String
is
Maj_Version : constant String := Lib_Version;
Last_Maj : Positive;
Last : Positive;
Ok_Maj : Boolean := False;
begin
Last_Maj := Maj_Version'Last;
while Last_Maj > Maj_Version'First loop
if Maj_Version (Last_Maj) in '0' .. '9' then
Last_Maj := Last_Maj - 1;
else
Ok_Maj := Last_Maj /= Maj_Version'Last and then
Maj_Version (Last_Maj) = '.';
if Ok_Maj then
Last_Maj := Last_Maj - 1;
end if;
exit;
end if;
end loop;
if Ok_Maj then
Last := Last_Maj;
while Last > Maj_Version'First loop
if Maj_Version (Last) in '0' .. '9' then
Last := Last - 1;
else
Ok_Maj := Last /= Last_Maj and then
Maj_Version (Last) = '.';
if Ok_Maj then
Last := Last - 1;
Ok_Maj :=
Maj_Version (Maj_Version'First .. Last) = Lib_Filename;
end if;
exit;
end if;
end loop;
end if;
if Ok_Maj then
return Maj_Version (Maj_Version'First .. Last_Maj);
else
return "";
end if;
end Major_Id_Name;
-- Package elaboration -- Package elaboration
begin begin
......
gcc/ada/mlib.ads
...@@ -34,6 +34,9 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; ...@@ -34,6 +34,9 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package MLib is package MLib is
No_Argument_List : aliased String_List := (1 .. 0 => null);
No_Argument : constant String_List_Access := No_Argument_List'Access;
Max_Characters_In_Library_Name : constant := 20; Max_Characters_In_Library_Name : constant := 20;
-- Maximum number of characters in a library name. -- Maximum number of characters in a library name.
-- Used by Check_Library_Name below. -- Used by Check_Library_Name below.
...@@ -54,7 +57,6 @@ package MLib is ...@@ -54,7 +57,6 @@ package MLib is
procedure Build_Library procedure Build_Library
(Ofiles : Argument_List; (Ofiles : Argument_List;
Afiles : Argument_List;
Output_File : String; Output_File : String;
Output_Dir : String); Output_Dir : String);
-- Build a static library from a set of object files -- Build a static library from a set of object files
...@@ -66,11 +68,24 @@ package MLib is ...@@ -66,11 +68,24 @@ package MLib is
-- Copy all ALI files Files to directory To. -- Copy all ALI files Files to directory To.
-- Mark Interfaces ALI files as interfaces, if any. -- Mark Interfaces ALI files as interfaces, if any.
procedure Create_Sym_Links
(Lib_Path : String;
Lib_Version : String;
Lib_Dir : String;
Maj_Version : String);
function Linker_Library_Path_Option return String_Access; function Linker_Library_Path_Option return String_Access;
-- Linker option to specify to the linker the library directory path. -- Linker option to specify to the linker the library directory path.
-- If non null, the library directory path is to be appended. -- If non null, the library directory path is to be appended.
-- Should be deallocated by the caller, when no longer needed. -- Should be deallocated by the caller, when no longer needed.
function Major_Id_Name
(Lib_Filename : String;
Lib_Version : String) return String;
-- Returns the major id library file name, if it exists.
-- For example, if Lib_Filename is "libtoto.so" and Lib_Version is
-- "libtoto.so.1.2", then "libtoto.so.1" is returned.
private private
Preserve : Attribute := Time_Stamps; Preserve : Attribute := Time_Stamps;
......
gcc/ada/sinput-p.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,7 +32,8 @@ package body Sinput.P is ...@@ -32,7 +32,8 @@ package body Sinput.P is
First : Boolean := True; First : Boolean := True;
-- Flag used when Load_Project_File is called the first time, -- Flag used when Load_Project_File is called the first time,
-- to set Main_Source_File. -- to set Main_Source_File.
-- The flag is reset to False at the first call to Load_Project_File -- The flag is reset to False at the first call to Load_Project_File.
-- Calling Reset_First sets it back to True.
----------------------- -----------------------
-- Load_Project_File -- -- Load_Project_File --
...@@ -52,6 +53,15 @@ package body Sinput.P is ...@@ -52,6 +53,15 @@ package body Sinput.P is
return X; return X;
end Load_Project_File; end Load_Project_File;
-----------------
-- Reset_First --
-----------------
procedure Reset_First is
begin
First := True;
end Reset_First;
-------------------------------- --------------------------------
-- Restore_Project_Scan_State -- -- Restore_Project_Scan_State --
-------------------------------- --------------------------------
......
gcc/ada/sinput-p.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,11 @@ package Sinput.P is ...@@ -36,6 +36,11 @@ package Sinput.P is
-- Load into memory the source of a project source file. -- Load into memory the source of a project source file.
-- Initialize the Scans state. -- Initialize the Scans state.
procedure Reset_First;
-- Indicate that the next project loaded should be considered as the first
-- one, so that Sinput.Main_Source_File is set for this project file. This
-- is to get the correct number of lines when error finalization is called.
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean; function Source_File_Is_Subunit (X : Source_File_Index) return Boolean;
-- This function determines if a source file represents a subunit. It -- This function determines if a source file represents a subunit. It
-- works by scanning for the first compilation unit token, and returning -- works by scanning for the first compilation unit token, and returning
......
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