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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146692 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b00fcef26a2398f82cdeafd3d15ace2a8174b8ef..ce28114bb5d6e8aeca5fbf5acbd76d2b3a0ea738 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+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>
 
        * prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb

diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index eef00fe3c9fa5254a2e77a005a132d50501f7c8e..7b9b83e4ae663fcf17aca591d9a07482d2d1e25f 100644 (file)
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -60,22 +60,20 @@ package body Prj.Env is
    Default_Naming    : constant Naming_Id := Naming_Table.First;
    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 --
    -----------------------
 
-   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
      (Source_Dirs : String_List_Id;
       In_Tree     : Project_Tree_Ref);
@@ -504,69 +502,6 @@ package body Prj.Env is
       end loop;
    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 --
    ------------------------
@@ -1527,104 +1462,80 @@ package body Prj.Env is
       return "";
    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;
       In_Tree : Project_Tree_Ref)
    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);
-      --  Process a project. Remember the processes visited to avoid processing
-      --  a project twice. Recursively process an eventual extended project,
-      --  and all imported projects.
+      procedure Recurse (Prj : Project_Id);
+      --  Process Prj recursively
 
-      ---------
-      -- Add --
-      ---------
+      -------------
+      -- Recurse --
+      -------------
 
-      procedure Add (Project : Project_Id) is
-         Data : constant Project_Data :=
-                  In_Tree.Projects.Table (Project);
+      procedure Recurse (Prj : Project_Id) is
+         Data : Project_Data renames In_Tree.Projects.Table (Prj);
          List : Project_List := Data.Imported_Projects;
-
       begin
-         --  If the list of visited project is empty, then
-         --  for sure we never visited this project.
+         if not Get (Seen, Prj) then
+            Set (Seen, Prj, True);
 
-         if Seen = Empty_Project_List then
-            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);
+            Action (Prj);
 
-         else
-            --  Check if the project is in the list
+            --  If we are extending a project, visit it
 
-            declare
-               Current : Project_List := Seen;
+            if Data.Extends /= No_Project then
+               Recurse (Data.Extends);
+            end if;
 
-            begin
-               loop
-                  --  If it is, then there is nothing else to do
+            --  And visit all imported projects
 
-                  if In_Tree.Project_Lists.Table
-                                           (Current).Project = Project
-                  then
-                     return;
-                  end if;
+            while List /= Empty_Project_List loop
+               Recurse (In_Tree.Project_Lists.Table (List).Project);
+               List := In_Tree.Project_Lists.Table (List).Next;
+            end loop;
+         end if;
+      end Recurse;
 
-                  exit when
-                    In_Tree.Project_Lists.Table (Current).Next =
-                      Empty_Project_List;
-                  Current :=
-                    In_Tree.Project_Lists.Table (Current).Next;
-               end loop;
+   begin
+      Recurse (Project);
+      Reset (Seen);
+   end For_All_Imported_Projects;
 
-               --  This project has never been visited, add it
-               --  to the list.
+   -------------------------
+   -- For_All_Object_Dirs --
+   -------------------------
 
-               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;
+   procedure For_All_Object_Dirs
+     (Project : Project_Id;
+      In_Tree : Project_Tree_Ref)
+   is
+      procedure For_Project (Prj : Project_Id);
+      --  Get all object directories of Prj
 
-         --  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
             Get_Name_String (Data.Object_Directory.Display_Name);
             Action (Name_Buffer (1 .. Name_Len));
          end if;
+      end For_Project;
 
-         --  If we are extending a project, visit it
-
-         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
-
+      procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project);
    begin
-      --  Visit this project, and its imported projects, recursively
-
-      Add (Project);
+      Get_Object_Dirs (Project, In_Tree);
    end For_All_Object_Dirs;
 
    -------------------------
@@ -1635,110 +1546,33 @@ package body Prj.Env is
      (Project : Project_Id;
       In_Tree : Project_Tree_Ref)
    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
-      --  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;
+      -----------------
+      -- For_Project --
+      -----------------
 
+      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
-         --  If the list of visited project is empty, then for sure we never
-         --  visited this project.
-
-         if Seen = Empty_Project_List then
-            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
-            --  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);
+         --  If there are Ada sources, call action with the name of every
+         --  source directory.
+
+         if In_Tree.Projects.Table (Project).Ada_Sources_Present 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 For_Project;
 
-         --  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_Source_Dirs
-
+      procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project);
    begin
-      --  Visit this project, and its imported projects recursively
-
-      Add (Project);
+      Get_Source_Dirs (Project, In_Tree);
    end For_All_Source_Dirs;
 
    -------------------
@@ -1839,139 +1673,6 @@ package body Prj.Env is
       Current_Object_Path_File := No_Path;
    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 --
    -------------------
@@ -2455,54 +2156,6 @@ package body Prj.Env is
       end if;
    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 --
    ---------------------------

diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index dbce7b648ca7d8637a6be06f464f7e77bb8c7089..989f4e76e3c5d4b2092ca9d41fc67e0fd5556d2e 100644 (file)
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -118,12 +118,6 @@ package Prj.Env is
    procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
    --  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
      (Name              : String;
       Project           : Project_Id;
@@ -167,6 +161,8 @@ package Prj.Env is
       In_Tree : Project_Tree_Ref);
    --  Iterate through all the source directories of a project, including those
    --  of imported or modified projects.
+   --  Only returns those directories that potentially contain Ada sources (ie
+   --  ignore projects that have no Ada sources
 
    generic
       with procedure Action (Path : String);
@@ -176,4 +172,11 @@ package Prj.Env is
    --  Iterate through all the object directories of a project, including
    --  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;

diff --git a/gcc/ada/s-osinte-darwin.adb b/gcc/ada/s-osinte-darwin.adb
index 904e910e762cbf1b820fa60906988dd8af183e9b..f3b8958119a8efebea5cf9638fab3bda6f56efd1 100644 (file)
--- a/gcc/ada/s-osinte-darwin.adb
+++ b/gcc/ada/s-osinte-darwin.adb
@@ -149,6 +149,18 @@ package body System.OS_Interface is
       return 0;
    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 --
    ------------------

diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads
index 27a7860522fa214a4247f280ee2ffbf8ea477777..b62b2c108e6d977827bdc3e7967ec6a200b8dc34 100644 (file)
--- a/gcc/ada/s-osinte-darwin.ads
+++ b/gcc/ada/s-osinte-darwin.ads
@@ -236,10 +236,8 @@ package System.OS_Interface is
    ---------
 
    function lwp_self return System.Address;
-   pragma Import (C, lwp_self, "pthread_self");
-   --  lwp_self does not exist on this thread library, revert to pthread_self
-   --  which is the closest approximation (with getpid). This function is
-   --  needed to share 7staprop.adb across POSIX-like targets.
+   --  Return the mach thread bound to the current thread.  The value is not
+   --  used by the run-time library but made available to debuggers.
 
    -------------
    -- Threads --