Skip to content

R
riscv-gcc-1
Commit 3563739b by Arnaud Charlet
Options

[multiple changes] 

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

	* 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  <quinot@adacore.com>

	* sem_ch12.adb: Minor reformatting

	* g-trasym.adb: Minor reformatting

	* exp_ch6.adb: Minor reformatting

2009-04-24  Robert Dewar  <dewar@adacore.com>

	* layout.adb (Layout_Type): For packed array type, copy unset
	size/alignment fields from the referenced Packed_Array_Type.

2009-04-24  Bob Duff  <duff@adacore.com>

	* 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.

From-SVN: r146727
parent 806b956f
Showing with 229 additions and 221 deletions
gcc/ada/ChangeLog
2009-04-24 Emmanuel Briot <briot@adacore.com>
* 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 <quinot@adacore.com>
* sem_ch12.adb: Minor reformatting
* g-trasym.adb: Minor reformatting
* exp_ch6.adb: Minor reformatting
2009-04-24 Robert Dewar <dewar@adacore.com>
* layout.adb (Layout_Type): For packed array type, copy unset
size/alignment fields from the referenced Packed_Array_Type.
2009-04-24 Bob Duff <duff@adacore.com>
* 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 <briot@adacore.com>
* prj.ads, prj-nmsc.adb (Unit_Project): removed, since in fact we were
only ever using the Project field.
......
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
......
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).
......
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
......
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);
......
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;
......
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;
......
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
......
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);
......
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) :=
......
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 :=
......
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;
......
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;
......
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;
......
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));
......
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