From: charlet Date: Fri, 24 Apr 2009 10:22:43 +0000 (+0000) Subject: 2009-04-24 Tristan Gingold X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=eea687b44555a61411ecd57ccc5d76f0d1dada57;p=thirdparty%2Fgcc.git 2009-04-24 Tristan Gingold * s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the mach thread id. 2009-04-24 Emmanuel Briot * 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 b00fcef26a23..ce28114bb5d6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2009-04-24 Tristan Gingold + + * s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the + mach thread id. + +2009-04-24 Emmanuel Briot + + * 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 * 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 eef00fe3c9fa..7b9b83e4ae66 100644 --- 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 dbce7b648ca7..989f4e76e3c5 100644 --- 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 904e910e762c..f3b8958119a8 100644 --- 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 27a7860522fa..b62b2c108e6d 100644 --- 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 --