From: charlet Date: Fri, 24 Apr 2009 14:35:21 +0000 (+0000) Subject: 2009-04-24 Emmanuel Briot X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=448545d4cb3b7de4837201b32876908a2fb8e9be;p=thirdparty%2Fgcc.git 2009-04-24 Emmanuel Briot * prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-env.adb (Project_List_Table, Project_Element): removed. Lists of projects are now implemented via standard malloc rather than through the table. 2009-04-24 Thomas Quinot * sem_ch12.adb: Minor reformatting * g-trasym.adb: Minor reformatting * exp_ch6.adb: Minor reformatting 2009-04-24 Robert Dewar * layout.adb (Layout_Type): For packed array type, copy unset size/alignment fields from the referenced Packed_Array_Type. 2009-04-24 Bob Duff * lib-load.adb (Make_Instance_Unit): Revert previous change, no longer needed after sem_ch12 changes. * sem.adb (Walk_Library_Items): Include with's in some debugging printouts. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146727 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 97f8b84482a8..872fc8f195de 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2009-04-24 Emmanuel Briot + + * prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb, + prj-nmsc.adb, prj-env.adb (Project_List_Table, Project_Element): + removed. Lists of projects are now implemented via standard malloc + rather than through the table. + +2009-04-24 Thomas Quinot + + * sem_ch12.adb: Minor reformatting + + * g-trasym.adb: Minor reformatting + + * exp_ch6.adb: Minor reformatting + +2009-04-24 Robert Dewar + + * layout.adb (Layout_Type): For packed array type, copy unset + size/alignment fields from the referenced Packed_Array_Type. + +2009-04-24 Bob Duff + + * lib-load.adb (Make_Instance_Unit): Revert previous change, no + longer needed after sem_ch12 changes. + + * sem.adb (Walk_Library_Items): Include with's in some debugging + printouts. + 2009-04-24 Emmanuel Briot * prj.ads, prj-nmsc.adb (Unit_Project): removed, since in fact we were diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index ff59a467ffaf..756fa990272a 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1079,30 +1079,29 @@ package body Clean is if All_Projects then declare Imported : Project_List := Data.Imported_Projects; - Element : Project_Element; Process : Boolean; begin -- For each imported project, call Clean_Project if the project -- has not been processed already. - while Imported /= Empty_Project_List loop - Element := Project_Tree.Project_Lists.Table (Imported); - Imported := Element.Next; + while Imported /= null loop Process := True; for J in Processed_Projects.First .. Processed_Projects.Last loop - if Element.Project = Processed_Projects.Table (J) then + if Imported.Project = Processed_Projects.Table (J) then Process := False; exit; end if; end loop; if Process then - Clean_Project (Element.Project); + Clean_Project (Imported.Project); end if; + + Imported := Imported.Next; end loop; -- If this project extends another project, call Clean_Project for diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 200693bd7d66..2ea49a3c4af9 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2100,11 +2100,11 @@ package body Exp_Ch6 is Act_Prev := Expression (Act_Prev); end loop; - -- If the expression is a conversion of a dereference, - -- this is internally generated code that manipulates - -- addresses, e.g. when building interface tables. No - -- check should occur in this case, and the discriminated - -- object is not directly a hand. + -- If the expression is a conversion of a dereference, this + -- is internally generated code that manipulates addresses, + -- e.g. when building interface tables. No check should + -- occur in this case, and the discriminated object is not + -- directly a hand. if not Comes_From_Source (Actual) and then Nkind (Actual) = N_Unchecked_Type_Conversion @@ -2893,9 +2893,9 @@ package body Exp_Ch6 is then -- We perform two simple optimization on calls: - -- a) replace calls to null procedures unconditionally, + -- a) replace calls to null procedures unconditionally; - -- b) For To_Address, just do an unchecked conversion. Not only is + -- b) for To_Address, just do an unchecked conversion. Not only is -- this efficient, but it also avoids order of elaboration problems -- when address clauses are inlined (address expression elaborated -- at the wrong point). diff --git a/gcc/ada/g-trasym.adb b/gcc/ada/g-trasym.adb index a402d57be8b6..105001ddc1d2 100644 --- a/gcc/ada/g-trasym.adb +++ b/gcc/ada/g-trasym.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2008, AdaCore -- +-- Copyright (C) 1999-2009, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -74,7 +74,7 @@ package body GNAT.Traceback.Symbolic is buf : System.Address; len : System.Address); pragma Import (C, convert_addresses, "convert_addresses"); - -- This is the procedure version of the Ada aware addr2line. It places + -- This is the procedure version of the Ada-aware addr2line. It places -- in BUF a string representing the symbolic translation of the N_ADDRS -- raw addresses provided in ADDRS, looked up in debug information from -- FILENAME. LEN points to an integer which contains the size of the @@ -100,8 +100,8 @@ package body GNAT.Traceback.Symbolic is use type System.Address; begin - -- The symbolic translation of an empty set of addresses is the - -- the empty string. + -- The symbolic translation of an empty set of addresses is an empty + -- string. if Traceback'Length = 0 then return ""; @@ -111,8 +111,8 @@ package body GNAT.Traceback.Symbolic is -- libaddr2line service to symbolize it all. -- Compute, cache and provide the absolute path to our executable file - -- name as the binary file where the relevant debug information is to - -- be found. If the executable file name resolution fails, we have no + -- name as the binary file where the relevant debug information is to be + -- found. If the executable file name resolution fails, we have no -- sensible basis to invoke the symbolizer at all. -- Protect all this against concurrent accesses explicitly, as the diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 4e721539d87d..6cce7b91e606 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2501,6 +2501,29 @@ package body Layout is -- Non-elementary (composite) types else + -- For packed arrays, take size and alignment values from the packed + -- array type if a packed array type has been created and the fields + -- are not currently set. + + if Is_Array_Type (E) and then Present (Packed_Array_Type (E)) then + declare + PAT : constant Entity_Id := Packed_Array_Type (E); + + begin + if Unknown_Esize (E) then + Set_Esize (E, Esize (PAT)); + end if; + + if Unknown_RM_Size (E) then + Set_RM_Size (E, RM_Size (PAT)); + end if; + + if Unknown_Alignment (E) then + Set_Alignment (E, Alignment (PAT)); + end if; + end; + end if; + -- If RM_Size is known, set Esize if not known if Known_RM_Size (E) and then Unknown_Esize (E) then @@ -2678,7 +2701,6 @@ package body Layout is procedure Rewrite_Integer (N : Node_Id; V : Uint) is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); - begin Rewrite (N, Make_Integer_Literal (Loc, Intval => V)); Set_Etype (N, Typ); diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 43a39dc8a1ea..1d0c2d4e79da 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -812,16 +812,7 @@ package body Lib.Load is -- units table when first loaded as a declaration. Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N)); - - -- The correct Cunit is the spec -- Library_Unit (N). But that causes - -- gnatmake to fail in certain cases, so this is under control of - -- Inspector_Mode for now. ??? - - if Inspector_Mode then - Units.Table (Units.Last).Cunit := Library_Unit (N); - else - Units.Table (Units.Last).Cunit := N; - end if; + Units.Table (Units.Last).Cunit := Library_Unit (N); end if; end Make_Instance_Unit; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 21dac167187a..c3db62f4c430 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -5797,7 +5797,6 @@ package body Make is then declare List : Project_List; - Element : Project_Element; Proj2 : Project_Id; Rebuild : Boolean := False; @@ -5808,10 +5807,8 @@ package body Make is begin List := Project_Tree.Projects.Table (Proj1). All_Imported_Projects; - while List /= Empty_Project_List loop - Element := - Project_Tree.Project_Lists.Table (List); - Proj2 := Element.Project; + while List /= null loop + Proj2 := List.Project; if Project_Tree.Projects.Table (Proj2).Library @@ -5828,7 +5825,7 @@ package body Make is end if; end if; - List := Element.Next; + List := List.Next; end loop; if Rebuild then @@ -7555,9 +7552,9 @@ package body Make is -- Visit each imported project - while List /= Empty_Project_List loop - Proj := Project_Tree.Project_Lists.Table (List).Project; - List := Project_Tree.Project_Lists.Table (List).Next; + while List /= null loop + Proj := List.Project; + List := List.Next; Recurse (Prj => Proj, Depth => Depth + 1); end loop; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 8b67c044cbeb..042cd65b5c46 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -680,7 +680,6 @@ package body MLib.Prj is procedure Process_Project (Project : Project_Id) is Data : Project_Data := In_Tree.Projects.Table (Project); Imported : Project_List := Data.Imported_Projects; - Element : Project_Element; begin -- Nothing to do if process has already been processed @@ -692,15 +691,12 @@ package body MLib.Prj is -- We first process the imported projects to guarantee that -- we have a proper reverse order for the libraries. - while Imported /= Empty_Project_List loop - Element := - In_Tree.Project_Lists.Table (Imported); - - if Element.Project /= No_Project then - Process_Project (Element.Project); + while Imported /= null loop + if Imported.Project /= No_Project then + Process_Project (Imported.Project); end if; - Imported := Element.Next; + Imported := Imported.Next; end loop; -- If it is a library project, add it to Library_Projs diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index decd68832e05..5c0a11b180fa 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -401,7 +401,7 @@ package body Prj.Env is Current_Unit : Unit_Index := Unit_Table.First; - First_Project : Project_List := Empty_Project_List; + First_Project : Project_List; Current_Project : Project_List; Current_Naming : Naming_Id; @@ -449,24 +449,18 @@ package body Prj.Env is -- Is this project in the list of the visited project? Current_Project := First_Project; - while Current_Project /= Empty_Project_List - and then In_Tree.Project_Lists.Table - (Current_Project).Project /= Project + while Current_Project /= null + and then Current_Project.Project /= Project loop - Current_Project := - In_Tree.Project_Lists.Table (Current_Project).Next; + Current_Project := Current_Project.Next; end loop; -- If it is not, put it in the list, and visit it - if Current_Project = Empty_Project_List then - Project_List_Table.Increment_Last - (In_Tree.Project_Lists); - In_Tree.Project_Lists.Table - (Project_List_Table.Last (In_Tree.Project_Lists)) := - (Project => Project, Next => First_Project); - First_Project := - Project_List_Table.Last (In_Tree.Project_Lists); + if Current_Project = null then + First_Project := new Project_List_Element' + (Project => Project, + Next => First_Project); -- Is the naming scheme of this project one that we know? @@ -557,12 +551,9 @@ package body Prj.Env is Current : Project_List := Data.Imported_Projects; begin - while Current /= Empty_Project_List loop - Check - (In_Tree.Project_Lists.Table - (Current).Project); - Current := In_Tree.Project_Lists.Table - (Current).Next; + while Current /= null loop + Check (Current.Project); + Current := Current.Next; end loop; end; end if; @@ -898,7 +889,6 @@ package body Prj.Env is procedure Recursive_Flag (Prj : Project_Id) is Imported : Project_List; - Proj : Project_Id; begin -- Nothing to do for non existent project or project that has already @@ -908,10 +898,9 @@ package body Prj.Env is Present (Prj) := True; Imported := In_Tree.Projects.Table (Prj).Imported_Projects; - while Imported /= Empty_Project_List loop - Proj := In_Tree.Project_Lists.Table (Imported).Project; - Imported := In_Tree.Project_Lists.Table (Imported).Next; - Recursive_Flag (Proj); + while Imported /= null loop + Recursive_Flag (Imported.Project); + Imported := Imported.Next; end loop; Recursive_Flag (In_Tree.Projects.Table (Prj).Extends); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 2cc5fc5fc67c..9b68755add61 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -356,7 +356,6 @@ package body Prj.Nmsc is procedure Find_Ada_Sources (Project : Project_Id; In_Tree : Project_Tree_Ref; - Data : in out Project_Data; Explicit_Sources_Only : Boolean); -- Find all Ada sources by traversing all source directories. -- If Explicit_Sources_Only is True, then the sources found must belong to @@ -554,7 +553,7 @@ package body Prj.Nmsc is Path_Name : Path_Name_Type; Project : Project_Id; In_Tree : Project_Tree_Ref; - Data : in out Project_Data; + Units : in out Files_Htable.Instance; Ada_Language : Language_Ptr; Location : Source_Ptr; Source_Recorded : in out Boolean); @@ -3393,7 +3392,7 @@ package body Prj.Nmsc is Prj.Util.Value_Of (Snames.Name_Library_Kind, Attributes, In_Tree); - Imported_Project_List : Project_List := Empty_Project_List; + Imported_Project_List : Project_List; Continuation : String_Access := No_Continuation_String'Access; @@ -4040,14 +4039,11 @@ package body Prj.Nmsc is Check_Library (Data.Extends, Extends => True); Imported_Project_List := Data.Imported_Projects; - while Imported_Project_List /= Empty_Project_List loop + while Imported_Project_List /= null loop Check_Library - (In_Tree.Project_Lists.Table - (Imported_Project_List).Project, + (Imported_Project_List.Project, Extends => False); - Imported_Project_List := - In_Tree.Project_Lists.Table - (Imported_Project_List).Next; + Imported_Project_List := Imported_Project_List.Next; end loop; end if; end if; @@ -7040,8 +7036,7 @@ package body Prj.Nmsc is if Get_Mode = Ada_Only then Find_Ada_Sources - (Project, In_Tree, Data, - Explicit_Sources_Only => Has_Explicit_Sources); + (Project, In_Tree, Explicit_Sources_Only => Has_Explicit_Sources); else Search_Directories @@ -7137,17 +7132,20 @@ package body Prj.Nmsc is procedure Find_Ada_Sources (Project : Project_Id; In_Tree : Project_Tree_Ref; - Data : in out Project_Data; Explicit_Sources_Only : Boolean) is + Data : Project_Data renames In_Tree.Projects.Table (Project); Source_Dir : String_List_Id; Element : String_Element; Dir : Dir_Type; Dir_Has_Source : Boolean := False; NL : Name_Location; Ada_Language : Language_Ptr; + Units : Files_Htable.Instance; begin + Files_Htable.Reset (Units); + if Current_Verbosity = High then Write_Line ("Looking for Ada sources:"); end if; @@ -7251,7 +7249,7 @@ package body Prj.Nmsc is Path_Name => Path_Name, Project => Project, In_Tree => In_Tree, - Data => Data, + Units => Units, Ada_Language => Ada_Language, Location => Location, Source_Recorded => Dir_Has_Source); @@ -7277,6 +7275,8 @@ package body Prj.Nmsc is if Current_Verbosity = High then Write_Line ("End looking for sources"); end if; + + Files_Htable.Reset (Units); end Find_Ada_Sources; ------------------------------- @@ -8184,11 +8184,12 @@ package body Prj.Nmsc is Path_Name : Path_Name_Type; Project : Project_Id; In_Tree : Project_Tree_Ref; - Data : in out Project_Data; + Units : in out Files_Htable.Instance; Ada_Language : Language_Ptr; Location : Source_Ptr; Source_Recorded : in out Boolean) is + Data : Project_Data renames In_Tree.Projects.Table (Project); Canonical_File : File_Name_Type; Canonical_Path : Path_Name_Type; @@ -8252,7 +8253,7 @@ package body Prj.Nmsc is -- Record the file name in the hash table Files_Htable - Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project); + Files_Htable.Set (Units, Canonical_File, Project); UData.File_Names (Unit_Kind) := (Name => Canonical_File, @@ -8312,7 +8313,7 @@ package body Prj.Nmsc is -- another project. If it is, report error but note we do that -- only for the first unit in the source file. - Unit_Prj := Files_Htable.Get (In_Tree.Files_HT, Canonical_File); + Unit_Prj := Files_Htable.Get (Units, Canonical_File); if not File_Recorded and then Unit_Prj /= No_Project @@ -8329,7 +8330,7 @@ package body Prj.Nmsc is The_Unit := Unit_Table.Last (In_Tree.Units); Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit); - Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project); + Files_Htable.Set (Units, Canonical_File, Project); UData.Name := Unit_Name; UData.File_Names (Unit_Kind) := diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 078c592d7f1b..2c1c6794ffe0 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -1150,8 +1150,8 @@ package body Prj.Proc is Temp_Result := No_Project; List := Data.Imported_Projects; - while List /= Empty_Project_List loop - Result := In_Tree.Project_Lists.Table (List).Project; + while List /= null loop + Result := List.Project; -- If the project is directly imported, then returns its ID @@ -1177,7 +1177,7 @@ package body Prj.Proc is end loop; end; - List := In_Tree.Project_Lists.Table (List).Next; + List := List.Next; end loop; pragma Assert (Temp_Result /= No_Project, "project not found"); @@ -2531,26 +2531,22 @@ package body Prj.Proc is From_Project_Node_Tree => From_Project_Node_Tree, Extended_By => No_Project); - -- Add this project to our list of imported projects - - Project_List_Table.Increment_Last (In_Tree.Project_Lists); - - In_Tree.Project_Lists.Table - (Project_List_Table.Last (In_Tree.Project_Lists)) := - (Project => New_Project, Next => Empty_Project_List); - -- Imported is the id of the last imported project. If -- it is nil, then this imported project is our first. - if Imported = Empty_Project_List then + if Imported = null then In_Tree.Projects.Table (Project).Imported_Projects := - Project_List_Table.Last (In_Tree.Project_Lists); + new Project_List_Element' + (Project => New_Project, + Next => null); + Imported := + In_Tree.Projects.Table (Project).Imported_Projects; else - In_Tree.Project_Lists.Table (Imported).Next := - Project_List_Table.Last (In_Tree.Project_Lists); + Imported.Next := new Project_List_Element' + (Project => New_Project, + Next => null); + Imported := Imported.Next; end if; - - Imported := Project_List_Table.Last (In_Tree.Project_Lists); end if; With_Clause := @@ -2567,7 +2563,7 @@ package body Prj.Proc is else declare Processed_Data : Project_Data := Empty_Project (In_Tree); - Imported : Project_List := Empty_Project_List; + Imported : Project_List; Declaration_Node : Project_Node_Id := Empty_Node; Tref : Source_Buffer_Ptr; Name : constant Name_Id := diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 2cebd1aa8ffc..d6a98b45550c 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -118,8 +118,8 @@ package body Prj is Naming => Std_Naming_Data, Languages => No_Language_Index, Decl => No_Declarations, - Imported_Projects => Empty_Project_List, - All_Imported_Projects => Empty_Project_List, + Imported_Projects => null, + All_Imported_Projects => null, Ada_Include_Path => null, Ada_Objects_Path => null, Objects_Path => null, @@ -143,11 +143,12 @@ package body Prj is -- Table to store the path name of all the created temporary files, so that -- they can be deleted at the end, or when the program is interrupted. - procedure Free (Project : in out Project_Data); + procedure Free (Project : in out Project_Data; Reset_Only : Boolean); -- Free memory allocated for Project procedure Free_List (Languages : in out Language_Ptr); procedure Free_List (Source : in out Source_Id); + procedure Free_List (List : in out Project_List); -- Free memory allocated for the list of languages or sources procedure Language_Changed (Iter : in out Source_Iterator); @@ -532,9 +533,9 @@ package body Prj is -- Visited all imported projects List := Data.Imported_Projects; - while List /= Empty_Project_List loop - Recursive_Check (In_Tree.Project_Lists.Table (List).Project); - List := In_Tree.Project_Lists.Table (List).Next; + while List /= null loop + Recursive_Check (List.Project); + List := List.Next; end loop; if Imported_First then @@ -821,12 +822,19 @@ package body Prj is -- Free -- ---------- - procedure Free (Project : in out Project_Data) is + procedure Free (Project : in out Project_Data; Reset_Only : Boolean) is begin Free (Project.Include_Path); Free (Project.Ada_Include_Path); Free (Project.Objects_Path); Free (Project.Ada_Objects_Path); + + Free_List (Project.Imported_Projects); + Free_List (Project.All_Imported_Projects); + + if not Reset_Only then + Free_List (Project.Languages); + end if; end Free; --------------- @@ -849,6 +857,22 @@ package body Prj is -- Free_List -- --------------- + procedure Free_List (List : in out Project_List) is + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Project_List_Element, Project_List); + Tmp : Project_List; + begin + while List /= null loop + Tmp := List.Next; + Unchecked_Free (List); + List := Tmp; + end loop; + end Free_List; + + --------------- + -- Free_List -- + --------------- + procedure Free_List (Languages : in out Language_Ptr) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Language_Data, Language_Ptr); @@ -878,19 +902,16 @@ package body Prj is Array_Element_Table.Free (Tree.Array_Elements); Array_Table.Free (Tree.Arrays); Package_Table.Free (Tree.Packages); - Project_List_Table.Free (Tree.Project_Lists); Alternate_Language_Table.Free (Tree.Alt_Langs); Unit_Table.Free (Tree.Units); Units_Htable.Reset (Tree.Units_HT); - Files_Htable.Reset (Tree.Files_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); for P in Project_Table.First .. Project_Table.Last (Tree.Projects) loop - Free_List (Tree.Projects.Table (P).Languages); - Free (Tree.Projects.Table (P)); + Free (Tree.Projects.Table (P), Reset_Only => False); end loop; Project_Table.Free (Tree.Projects); @@ -923,11 +944,9 @@ package body Prj is Array_Element_Table.Init (Tree.Array_Elements); Array_Table.Init (Tree.Arrays); Package_Table.Init (Tree.Packages); - Project_List_Table.Init (Tree.Project_Lists); Alternate_Language_Table.Init (Tree.Alt_Langs); Unit_Table.Init (Tree.Units); Units_Htable.Reset (Tree.Units_HT); - Files_Htable.Reset (Tree.Files_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); @@ -935,7 +954,7 @@ package body Prj is for P in Project_Table.First .. Project_Table.Last (Tree.Projects) loop - Free (Tree.Projects.Table (P)); + Free (Tree.Projects.Table (P), Reset_Only => True); end loop; end if; @@ -1366,51 +1385,19 @@ package body Prj is procedure Compute_All_Imported_Projects (Project : Project_Id; In_Tree : Project_Tree_Ref) is - procedure Add_To_List (Prj : Project_Id); - -- Add a project to the list All_Imported_Projects of project Project + Data : Project_Data renames In_Tree.Projects.Table (Project); procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean); -- Recursively add the projects imported by project Project, but not -- those that are extended. - ----------------- - -- Add_To_List -- - ----------------- - - procedure Add_To_List (Prj : Project_Id) is - Element : constant Project_Element := - (Prj, - In_Tree.Projects.Table (Project).All_Imported_Projects); - List : Project_List; - - begin - -- Check that the project is not already in the list. We know the one - -- passed to Recursive_Add have never been visited before, but the - -- one passed it are the extended projects. - - List := In_Tree.Projects.Table (Project).All_Imported_Projects; - while List /= Empty_Project_List loop - if In_Tree.Project_Lists.Table (List).Project = Prj then - return; - end if; - List := In_Tree.Project_Lists.Table (List).Next; - end loop; - - -- Add it to the list - - Project_List_Table.Increment_Last (In_Tree.Project_Lists); - List := Project_List_Table.Last (In_Tree.Project_Lists); - In_Tree.Project_Lists.Table (List) := Element; - In_Tree.Projects.Table (Project).All_Imported_Projects := List; - end Add_To_List; - ------------------- -- Recursive_Add -- ------------------- procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is pragma Unreferenced (Dummy); - + List : Project_List; Prj2 : Project_Id; begin @@ -1418,7 +1405,25 @@ package body Prj is if Project /= Prj then Prj2 := Ultimate_Extending_Project_Of (Prj, In_Tree); - Add_To_List (Prj2); + + -- Check that the project is not already in the list. We know the + -- one passed to Recursive_Add have never been visited before, but + -- the one passed it are the extended projects. + + List := Data.All_Imported_Projects; + while List /= null loop + if List.Project = Prj2 then + return; + end if; + List := List.Next; + end loop; + + -- Add it to the list + + Data.All_Imported_Projects := + new Project_List_Element' + (Project => Prj2, + Next => Data.All_Imported_Projects); end if; end Recursive_Add; @@ -1427,8 +1432,7 @@ package body Prj is Dummy : Boolean := False; begin - In_Tree.Projects.Table (Project).All_Imported_Projects := - Empty_Project_List; + Free_List (Data.All_Imported_Projects); For_All_Projects (Project, In_Tree, Dummy); end Compute_All_Imported_Projects; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 29a9d31bd92c..5d04a61bc934 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -941,24 +941,13 @@ package Prj is -- Returns True if Left and Right are the same naming scheme -- not considering Specs and Bodies. - type Project_List is new Nat; - Empty_Project_List : constant Project_List := 0; - -- A list of project files - - type Project_Element is record + type Project_List_Element; + type Project_List is access Project_List_Element; + type Project_List_Element is record Project : Project_Id := No_Project; - Next : Project_List := Empty_Project_List; + Next : Project_List := null; end record; - -- Element in a list of project files. Next is the id of the next - -- project file in the list. - - package Project_List_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Project_Element, - Table_Index_Type => Project_List, - Table_Low_Bound => 1, - Table_Initial => 100, - Table_Increment => 100); - -- The table that contains the lists of project files + -- A list of projects type Response_File_Format is (None, @@ -1181,10 +1170,10 @@ package Prj is -- The declarations (variables, attributes and packages) of this project -- file. - Imported_Projects : Project_List := Empty_Project_List; + Imported_Projects : Project_List; -- The list of all directly imported projects, if any - All_Imported_Projects : Project_List := Empty_Project_List; + All_Imported_Projects : Project_List; -- The list of all projects imported directly or indirectly, if any ----------------- @@ -1449,12 +1438,10 @@ package Prj is Array_Elements : Array_Element_Table.Instance; Arrays : Array_Table.Instance; Packages : Package_Table.Instance; - Project_Lists : Project_List_Table.Instance; Projects : Project_Table.Instance; Alt_Langs : Alternate_Language_Table.Instance; Units : Unit_Table.Instance; Units_HT : Units_Htable.Instance; - Files_HT : Files_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance; Unit_Sources_HT : Unit_Sources_Htable.Instance; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 8563938ebe8e..2f8192b20cb4 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1615,7 +1615,7 @@ package body Sem is begin if Debug_Unit_Walk then - Write_Unit_Info (Unit_Num, Item); + Write_Unit_Info (Unit_Num, Item, Withs => True); end if; -- Main unit should come last @@ -1810,7 +1810,8 @@ package body Sem is for Unit_Num in Done'Range loop if not Done (Unit_Num) then - Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num))); + Write_Unit_Info + (Unit_Num, Unit (Cunit (Unit_Num)), Withs => True); end if; end loop; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3b5a5d513686..697c31333349 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -889,8 +889,8 @@ package body Sem_Ch12 is Actual_Types : constant Elist_Id := New_Elmt_List; Assoc : constant List_Id := New_List; Default_Actuals : constant Elist_Id := New_Elmt_List; - Gen_Unit : constant Entity_Id - := Defining_Entity (Parent (F_Copy)); + Gen_Unit : constant Entity_Id := + Defining_Entity (Parent (F_Copy)); Actuals : List_Id; Actual : Node_Id; @@ -903,7 +903,7 @@ package body Sem_Ch12 is First_Named : Node_Id := Empty; Default_Formals : constant List_Id := New_List; - -- If an Other_Choice is present, some of the formals may be defaulted. + -- If an Others_Choice is present, some of the formals may be defaulted. -- To simplify the treatment of visibility in an instance, we introduce -- individual defaults for each such formal. These defaults are -- appended to the list of associations and replace the Others_Choice. @@ -970,9 +970,7 @@ package body Sem_Ch12 is -- End of list of purely positional parameters - if No (Actual) - or else Nkind (Actual) = N_Others_Choice - then + if No (Actual) or else Nkind (Actual) = N_Others_Choice then Found_Assoc := Empty; Act := Empty; @@ -1055,8 +1053,8 @@ package body Sem_Ch12 is Id : Entity_Id; begin - -- Append copy of formal declaration to associations, and create - -- new defining identifier for it. + -- Append copy of formal declaration to associations, and create new + -- defining identifier for it. Decl := New_Copy_Tree (F); Id := Make_Defining_Identifier (Sloc (F_Id), Chars => Chars (F_Id)); @@ -4376,7 +4374,7 @@ package body Sem_Ch12 is -- The new compilation unit is linked to its body, but both share the -- same file, so we do not set Body_Required on the new unit so as not -- to create a spurious dependency on a non-existent body in the ali. - -- This simplifies codepeer unit traversal. + -- This simplifies Codepeer unit traversal. -- We use the original instantiation compilation unit as the resulting -- compilation unit of the instance, since this is the main unit. @@ -4393,7 +4391,7 @@ package body Sem_Ch12 is Set_Private_Present (Decl_Cunit, Private_Present (Body_Cunit)); - -- If the instance is not the main unit, its context, categorization, + -- If the instance is not the main unit, its context, categorization -- and elaboration entity are not relevant to the compilation. if Body_Cunit /= Cunit (Main_Unit) then @@ -11363,8 +11361,8 @@ package body Sem_Ch12 is -- the time the instantiations will be analyzed. procedure Reset_Entity (N : Node_Id); - -- Save semantic information on global entity, so that it is not - -- resolved again at instantiation time. + -- Save semantic information on global entity so that it is not resolved + -- again at instantiation time. procedure Save_Entity_Descendants (N : Node_Id); -- Apply Save_Global_References to the two syntactic descendants of @@ -11416,9 +11414,9 @@ package body Sem_Ch12 is function Is_Instance_Node (Decl : Node_Id) return Boolean is begin - return (Nkind (Decl) in N_Generic_Instantiation - or else - Nkind (Original_Node (Decl)) = N_Formal_Package_Declaration); + return Nkind (Decl) in N_Generic_Instantiation + or else + Nkind (Original_Node (Decl)) = N_Formal_Package_Declaration; end Is_Instance_Node; -- Start of processing for Is_Global @@ -11460,15 +11458,15 @@ package body Sem_Ch12 is procedure Reset_Entity (N : Node_Id) is procedure Set_Global_Type (N : Node_Id; N2 : Node_Id); - -- If the type of N2 is global to the generic unit. Save - -- the type in the generic node. + -- If the type of N2 is global to the generic unit. Save the type in + -- the generic node. + -- What does this comment mean??? function Top_Ancestor (E : Entity_Id) return Entity_Id; - -- Find the ultimate ancestor of the current unit. If it is - -- not a generic unit, then the name of the current unit - -- in the prefix of an expanded name must be replaced with - -- its generic homonym to ensure that it will be properly - -- resolved in an instance. + -- Find the ultimate ancestor of the current unit. If it is not a + -- generic unit, then the name of the current unit in the prefix of + -- an expanded name must be replaced with its generic homonym to + -- ensure that it will be properly resolved in an instance. --------------------- -- Set_Global_Type -- @@ -11483,10 +11481,10 @@ package body Sem_Ch12 is if Entity (N) /= N2 and then Has_Private_View (Entity (N)) then - -- If the entity of N is not the associated node, this is - -- a nested generic and it has an associated node as well, - -- whose type is already the full view (see below). Indicate - -- that the original node has a private view. + -- If the entity of N is not the associated node, this is a + -- nested generic and it has an associated node as well, whose + -- type is already the full view (see below). Indicate that the + -- original node has a private view. Set_Has_Private_View (N); end if; @@ -11500,14 +11498,14 @@ package body Sem_Ch12 is Set_Has_Private_View (N); end if; - -- If it is a derivation of a private type in a context where - -- no full view is needed, nothing to do either. + -- If it is a derivation of a private type in a context where no + -- full view is needed, nothing to do either. elsif No (Full_View (Typ)) and then Typ /= Etype (Typ) then null; - -- Otherwise mark the type for flipping and use the full_view - -- when available. + -- Otherwise mark the type for flipping and use the full view when + -- available. else Set_Has_Private_View (N); @@ -11581,8 +11579,7 @@ package body Sem_Ch12 is -- is because in an instantiation Par.P.Q will not resolve to the -- name of the instance, whose enclosing scope is not necessarily -- Par. We use the generic homonym rather that the name of the - -- generic itself, because it may be hidden by a local - -- declaration. + -- generic itself because it may be hidden by a local declaration. elsif In_Open_Scopes (Entity (Parent (N2))) and then not @@ -11609,7 +11606,7 @@ package body Sem_Ch12 is -- A selected component may denote a static constant that has been -- folded. If the static constant is global to the generic, capture - -- its value. Otherwise the folding will happen in any instantiation, + -- its value. Otherwise the folding will happen in any instantiation. elsif Nkind (Parent (N)) = N_Selected_Component and then Nkind_In (Parent (N2), N_Integer_Literal, N_Real_Literal) @@ -11861,13 +11858,13 @@ package body Sem_Ch12 is -- Save_References -- --------------------- - -- This is the recursive procedure that does the work, once the - -- enclosing generic scope has been established. We have to treat - -- specially a number of node rewritings that are required by semantic - -- processing and which change the kind of nodes in the generic copy: - -- typically constant-folding, replacing an operator node by a string - -- literal, or a selected component by an expanded name. In each of - -- those cases, the transformation is propagated to the generic unit. + -- This is the recursive procedure that does the work once the enclosing + -- generic scope has been established. We have to treat specially a + -- number of node rewritings that are required by semantic processing + -- and which change the kind of nodes in the generic copy: typically + -- constant-folding, replacing an operator node by a string literal, or + -- a selected component by an expanded name. In each of those cases, the + -- transformation is propagated to the generic unit. procedure Save_References (N : Node_Id) is begin @@ -11948,7 +11945,7 @@ package body Sem_Ch12 is and then Ekind (Entity (N2)) = E_Enumeration_Literal then -- Same if call was folded into a literal, but in this case - -- retain the entity to avoid spurious ambiguities if id is + -- retain the entity to avoid spurious ambiguities if it is -- overloaded at the point of instantiation or inlining. Rewrite (N, New_Copy (N2));