Skip to content

R
riscv-gcc-1
Commit b3520ca0 by Arnaud Charlet
Options

[multiple changes] 

2009-04-24  Tristan Gingold  <gingold@adacore.com>

	* s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the
	mach thread id.

2009-04-24  Emmanuel Briot  <briot@adacore.com>

	* prj-env.adb, prj-env.ads (Body_Path_Name_Of, Spec_Path_Name_Of,
	Path_Name_Of_Library_Unit_Body): rEmove unused subprograms.
	(For_All_Imported_Projects): new procedure
	(For_All_Source_Dirs, For_All_Object_Dirs): Rewritten based on the
	above rather than duplicating code.

From-SVN: r146692
parent 5d07d0cf
Showing with 116 additions and 437 deletions
gcc/ada/ChangeLog
2009-04-24 Tristan Gingold <gingold@adacore.com>
* s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the
mach thread id.
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-env.adb, prj-env.ads (Body_Path_Name_Of, Spec_Path_Name_Of,
Path_Name_Of_Library_Unit_Body): rEmove unused subprograms.
(For_All_Imported_Projects): new procedure
(For_All_Source_Dirs, For_All_Object_Dirs): Rewritten based on the
above rather than duplicating code.
2009-04-24 Emmanuel Briot <briot@adacore.com> 2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb * prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb
......
gcc/ada/prj-env.adb
...@@ -60,22 +60,20 @@ package body Prj.Env is ...@@ -60,22 +60,20 @@ package body Prj.Env is
Default_Naming : constant Naming_Id := Naming_Table.First; Default_Naming : constant Naming_Id := Naming_Table.First;
Fill_Mapping_File : Boolean := True; Fill_Mapping_File : Boolean := True;
package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Project_Id,
Hash => Hash,
Equal => "=");
-- A table that associates a project to a boolean. This is used to detect
-- whether a project was already processed for instance.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
function Body_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the body of a unit.
-- Compute it first, if necessary.
function Spec_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the spec of a unit.
-- Compute it first, if necessary.
procedure Add_To_Path procedure Add_To_Path
(Source_Dirs : String_List_Id; (Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
...@@ -504,69 +502,6 @@ package body Prj.Env is ...@@ -504,69 +502,6 @@ package body Prj.Env is
end loop; end loop;
end Add_To_Source_Path; end Add_To_Source_Path;
-----------------------
-- Body_Path_Name_Of --
-----------------------
function Body_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String
is
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
-- If we don't know the path name of the body of this unit,
-- we compute it, and we store it.
if Data.File_Names (Body_Part).Path = No_Path_Information then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
(Data.File_Names (Body_Part).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
-- By default, put the file name
Data.File_Names (Body_Part).Path.Name :=
Path_Name_Type (Data.File_Names (Body_Part).Name);
-- For each source directory
while Current_Source /= Nil_String loop
Path :=
Locate_Regular_File
(Namet.Get_Name_String
(Data.File_Names (Body_Part).Name),
Namet.Get_Name_String
(In_Tree.String_Elements.Table
(Current_Source).Value));
-- If the file is in this directory, then we store the path,
-- and we are done.
if Path /= null then
Name_Len := Path'Length;
Name_Buffer (1 .. Name_Len) := Path.all;
Data.File_Names (Body_Part).Path.Name := Name_Enter;
exit;
else
Current_Source :=
In_Tree.String_Elements.Table
(Current_Source).Next;
end if;
end loop;
In_Tree.Units.Table (Unit) := Data;
end;
end if;
-- Returned the stored value
return Namet.Get_Name_String (Data.File_Names (Body_Part).Path.Name);
end Body_Path_Name_Of;
------------------------ ------------------------
-- Contains_ALI_Files -- -- Contains_ALI_Files --
------------------------ ------------------------
...@@ -1527,104 +1462,80 @@ package body Prj.Env is ...@@ -1527,104 +1462,80 @@ package body Prj.Env is
return ""; return "";
end File_Name_Of_Library_Unit_Body; end File_Name_Of_Library_Unit_Body;
------------------------- -------------------------------
-- For_All_Object_Dirs -- -- For_All_Imported_Projects --
------------------------- -------------------------------
procedure For_All_Object_Dirs procedure For_All_Imported_Projects
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
Seen : Project_List := Empty_Project_List; use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Add (Project : Project_Id); procedure Recurse (Prj : Project_Id);
-- Process a project. Remember the processes visited to avoid processing -- Process Prj recursively
-- a project twice. Recursively process an eventual extended project,
-- and all imported projects.
--------- -------------
-- Add -- -- Recurse --
--------- -------------
procedure Add (Project : Project_Id) is procedure Recurse (Prj : Project_Id) is
Data : constant Project_Data := Data : Project_Data renames In_Tree.Projects.Table (Prj);
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects; List : Project_List := Data.Imported_Projects;
begin begin
-- If the list of visited project is empty, then if not Get (Seen, Prj) then
-- for sure we never visited this project. Set (Seen, Prj, True);
if Seen = Empty_Project_List then Action (Prj);
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
Seen := Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
else -- If we are extending a project, visit it
-- Check if the project is in the list
declare if Data.Extends /= No_Project then
Current : Project_List := Seen; Recurse (Data.Extends);
end if;
begin -- And visit all imported projects
loop
-- If it is, then there is nothing else to do
if In_Tree.Project_Lists.Table while List /= Empty_Project_List loop
(Current).Project = Project Recurse (In_Tree.Project_Lists.Table (List).Project);
then List := In_Tree.Project_Lists.Table (List).Next;
return; end loop;
end if; end if;
end Recurse;
exit when begin
In_Tree.Project_Lists.Table (Current).Next = Recurse (Project);
Empty_Project_List; Reset (Seen);
Current := end For_All_Imported_Projects;
In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it -------------------------
-- to the list. -- For_All_Object_Dirs --
-------------------------
Project_List_Table.Increment_Last procedure For_All_Object_Dirs
(In_Tree.Project_Lists); (Project : Project_Id;
In_Tree.Project_Lists.Table (Current).Next := In_Tree : Project_Tree_Ref)
Project_List_Table.Last (In_Tree.Project_Lists); is
In_Tree.Project_Lists.Table procedure For_Project (Prj : Project_Id);
(Project_List_Table.Last -- Get all object directories of Prj
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
-- If there is an object directory, call Action with its name -----------------
-- For_Project --
-----------------
procedure For_Project (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
begin
if Data.Object_Directory /= No_Path_Information then if Data.Object_Directory /= No_Path_Information then
Get_Name_String (Data.Object_Directory.Display_Name); Get_Name_String (Data.Object_Directory.Display_Name);
Action (Name_Buffer (1 .. Name_Len)); Action (Name_Buffer (1 .. Name_Len));
end if; end if;
end For_Project;
-- If we are extending a project, visit it procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project);
if Data.Extends /= No_Project then
Add (Data.Extends);
end if;
-- And visit all imported projects
while List /= Empty_Project_List loop
Add (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
-- Start of processing for For_All_Object_Dirs
begin begin
-- Visit this project, and its imported projects, recursively Get_Object_Dirs (Project, In_Tree);
Add (Project);
end For_All_Object_Dirs; end For_All_Object_Dirs;
------------------------- -------------------------
...@@ -1635,110 +1546,33 @@ package body Prj.Env is ...@@ -1635,110 +1546,33 @@ package body Prj.Env is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
Seen : Project_List := Empty_Project_List; procedure For_Project (Prj : Project_Id);
-- Get all object directories of Prj
procedure Add (Project : Project_Id); -----------------
-- Process a project. Remember the processes visited to avoid processing -- For_Project --
-- a project twice. Recursively process an eventual extended project, -----------------
-- and all imported projects.
---------
-- Add --
---------
procedure Add (Project : Project_Id) is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
procedure For_Project (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
begin begin
-- If the list of visited project is empty, then for sure we never -- If there are Ada sources, call action with the name of every
-- visited this project. -- source directory.
if Seen = Empty_Project_List then if In_Tree.Projects.Table (Project).Ada_Sources_Present then
Project_List_Table.Increment_Last while Current /= Nil_String loop
(In_Tree.Project_Lists); The_String := In_Tree.String_Elements.Table (Current);
Seen := Project_List_Table.Last Action (Get_Name_String (The_String.Display_Value));
(In_Tree.Project_Lists); Current := The_String.Next;
In_Tree.Project_Lists.Table (Seen) := end loop;
(Project => Project, Next => Empty_Project_List);
else
-- Check if the project is in the list
declare
Current : Project_List := Seen;
begin
loop
-- If it is, then there is nothing else to do
if In_Tree.Project_Lists.Table
(Current).Project = Project
then
return;
end if;
exit when
In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List;
Current :=
In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it to the list
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
declare
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
begin
-- If there are Ada sources, call action with the name of every
-- source directory.
if
In_Tree.Projects.Table (Project).Ada_Sources /= Nil_String
then
while Current /= Nil_String loop
The_String :=
In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
end if;
end;
-- If we are extending a project, visit it
if Data.Extends /= No_Project then
Add (Data.Extends);
end if; end if;
end For_Project;
-- And visit all imported projects procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project);
while List /= Empty_Project_List loop
Add (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
-- Start of processing for For_All_Source_Dirs
begin begin
-- Visit this project, and its imported projects recursively Get_Source_Dirs (Project, In_Tree);
Add (Project);
end For_All_Source_Dirs; end For_All_Source_Dirs;
------------------- -------------------
...@@ -1839,139 +1673,6 @@ package body Prj.Env is ...@@ -1839,139 +1673,6 @@ package body Prj.Env is
Current_Object_Path_File := No_Path; Current_Object_Path_File := No_Path;
end Initialize; end Initialize;
------------------------------------
-- Path_Name_Of_Library_Unit_Body --
------------------------------------
-- Could use some comments in the body here ???
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String
is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
Original_Name : String := Name;
Extended_Spec_Name : String :=
Name &
Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
Name &
Body_Suffix_Of (In_Tree, "ada", Data.Naming);
First : Unit_Index := Unit_Table.First;
Current : Unit_Index;
Unit : Unit_Data;
begin
Canonical_Case_File_Name (Original_Name);
Canonical_Case_File_Name (Extended_Spec_Name);
Canonical_Case_File_Name (Extended_Body_Name);
if Current_Verbosity = High then
Write_Str ("Looking for path name of """);
Write_Str (Name);
Write_Char ('"');
Write_Eol;
Write_Str (" Extended Spec Name = """);
Write_Str (Extended_Spec_Name);
Write_Char ('"');
Write_Eol;
Write_Str (" Extended Body Name = """);
Write_Str (Extended_Body_Name);
Write_Char ('"');
Write_Eol;
end if;
while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project
loop
First := First + 1;
end loop;
Current := First;
while Current <= Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Current);
if Unit.File_Names (Body_Part).Project = Project
and then Unit.File_Names (Body_Part).Name /= No_File
then
declare
Current_Name : constant String :=
Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
begin
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Current_Name);
Write_Char ('"');
Write_Eol;
end if;
if Current_Name = Original_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Body_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Body_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Body_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
Write_Line (" not good");
end if;
end if;
end;
elsif Unit.File_Names (Specification).Name /= No_File then
declare
Current_Name : constant String :=
Namet.Get_Name_String
(Unit.File_Names (Specification).Name);
begin
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Current_Name);
Write_Char ('"');
Write_Eol;
end if;
if Current_Name = Original_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Spec_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Spec_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Spec_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
Write_Line (" not good");
end if;
end if;
end;
end if;
Current := Current + 1;
end loop;
return "";
end Path_Name_Of_Library_Unit_Body;
------------------- -------------------
-- Print_Sources -- -- Print_Sources --
------------------- -------------------
...@@ -2455,54 +2156,6 @@ package body Prj.Env is ...@@ -2455,54 +2156,6 @@ package body Prj.Env is
end if; end if;
end Set_Path_File_Var; end Set_Path_File_Var;
-----------------------
-- Spec_Path_Name_Of --
-----------------------
function Spec_Path_Name_Of
(Unit : Unit_Index; In_Tree : Project_Tree_Ref) return String
is
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
if Data.File_Names (Specification).Path.Name = No_Path then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
(Data.File_Names (Specification).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
Data.File_Names (Specification).Path.Name :=
Path_Name_Type (Data.File_Names (Specification).Name);
while Current_Source /= Nil_String loop
Path := Locate_Regular_File
(Namet.Get_Name_String
(Data.File_Names (Specification).Name),
Namet.Get_Name_String
(In_Tree.String_Elements.Table
(Current_Source).Value));
if Path /= null then
Name_Len := Path'Length;
Name_Buffer (1 .. Name_Len) := Path.all;
Data.File_Names (Specification).Path.Name := Name_Enter;
exit;
else
Current_Source :=
In_Tree.String_Elements.Table
(Current_Source).Next;
end if;
end loop;
In_Tree.Units.Table (Unit) := Data;
end;
end if;
return Namet.Get_Name_String (Data.File_Names (Specification).Path.Name);
end Spec_Path_Name_Of;
--------------------------- ---------------------------
-- Ultimate_Extension_Of -- -- Ultimate_Extension_Of --
--------------------------- ---------------------------
......
gcc/ada/prj-env.ads
...@@ -118,12 +118,6 @@ package Prj.Env is ...@@ -118,12 +118,6 @@ package Prj.Env is
procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref); procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
-- Delete all temporary path files that have been created by Set_Ada_Paths -- Delete all temporary path files that have been created by Set_Ada_Paths
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path of a library unit
function File_Name_Of_Library_Unit_Body function File_Name_Of_Library_Unit_Body
(Name : String; (Name : String;
Project : Project_Id; Project : Project_Id;
...@@ -167,6 +161,8 @@ package Prj.Env is ...@@ -167,6 +161,8 @@ package Prj.Env is
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including those -- Iterate through all the source directories of a project, including those
-- of imported or modified projects. -- of imported or modified projects.
-- Only returns those directories that potentially contain Ada sources (ie
-- ignore projects that have no Ada sources
generic generic
with procedure Action (Path : String); with procedure Action (Path : String);
...@@ -176,4 +172,11 @@ package Prj.Env is ...@@ -176,4 +172,11 @@ package Prj.Env is
-- Iterate through all the object directories of a project, including -- Iterate through all the object directories of a project, including
-- those of imported or modified projects. -- those of imported or modified projects.
generic
with procedure Action (Project : Project_Id);
procedure For_All_Imported_Projects
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Execute Action for Project and all imported or extended projects
end Prj.Env; end Prj.Env;
gcc/ada/s-osinte-darwin.adb
...@@ -149,6 +149,18 @@ package body System.OS_Interface is ...@@ -149,6 +149,18 @@ package body System.OS_Interface is
return 0; return 0;
end sched_yield; end sched_yield;
--------------
-- lwp_self --
--------------
function lwp_self return Address is
function pthread_mach_thread_np (thread : pthread_t) return Address;
pragma Import (C, pthread_mach_thread_np, "pthread_mach_thread_np");
begin
return pthread_mach_thread_np (pthread_self);
end lwp_self;
------------------ ------------------
-- pthread_init -- -- pthread_init --
------------------ ------------------
......
gcc/ada/s-osinte-darwin.ads
...@@ -236,10 +236,8 @@ package System.OS_Interface is ...@@ -236,10 +236,8 @@ package System.OS_Interface is
--------- ---------
function lwp_self return System.Address; function lwp_self return System.Address;
pragma Import (C, lwp_self, "pthread_self"); -- Return the mach thread bound to the current thread. The value is not
-- lwp_self does not exist on this thread library, revert to pthread_self -- used by the run-time library but made available to debuggers.
-- which is the closest approximation (with getpid). This function is
-- needed to share 7staprop.adb across POSIX-like targets.
------------- -------------
-- Threads -- -- Threads --
......
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