Skip to content

R
riscv-gcc-1
Commit 9af094a1 by Ed Schonberg Committed by Arnaud Charlet
Options

sinfo.ads, sinfo.adb: New attribute Next_Implicit_With... 

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: New attribute Next_Implicit_With, to chain
	with_clauses generated for the same unit through rtsfind, and that
	appear in the context of different units.

	* rtsfind.adb: New attribute First_Implicit_With, component of the
	Unit_Record that stores information about a unit loaded through rtsfind.

From-SVN: r146951
parent 1923a3f9
Showing with 92 additions and 55 deletions
gcc/ada/ChangeLog
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sinfo.ads, sinfo.adb: New attribute Next_Implicit_With, to chain
with_clauses generated for the same unit through rtsfind, and that
appear in the context of different units.
* rtsfind.adb: New attribute First_Implicit_With, component of the
Unit_Record that stores information about a unit loaded through rtsfind.
2009-04-29 Gary Dismukes <dismukes@adacore.com>
* exp_ch3.adb (Stream_Operation_OK): Return True for limited interfaces
......
gcc/ada/rtsfind.adb
......@@ -79,16 +79,18 @@ package body Rtsfind is
-- the latter case it is critical to make a call to Set_RTU_Loaded to
-- ensure that the entry in this table reflects the load.
-- Withed is True if an implicit with_clause has been added from some unit
-- other than the main unit to this unit. Withed_By_Main is the same,
-- except from the main unit.
-- A unit retrieved through rtsfind may end up in the context of several
-- other units, in addition to the main unit. These additional with_clauses
-- are needed to generate a proper traversal order for Inspector. To
-- minimize somewhat the redundancy created by numerous calls to rtsfind
-- from different units, we keep track of the list of implicit with_clauses
-- already created for the current loaded unit.
type RT_Unit_Table_Record is record
Entity : Entity_Id;
Uname : Unit_Name_Type;
Unum : Unit_Number_Type;
Withed : Boolean;
Withed_By_Main : Boolean;
Entity : Entity_Id;
Uname : Unit_Name_Type;
First_Implicit_With : Node_Id;
Unum : Unit_Number_Type;
end record;
RT_Unit_Table : array (RTU_Id) of RT_Unit_Table_Record;
......@@ -118,12 +120,12 @@ package body Rtsfind is
-- When a unit is implicitly loaded as a result of a call to RTE, it is
-- necessary to create one or two implicit with_clauses. We add such
-- with_clauses to the extended main unit if needed, and also to whatever
-- unit first needs them, which is not necessarily the main unit. The
-- former ensures that the object is correctly loaded by the binder. The
-- latter is necessary for SofCheck Inspector.
-- unit needs them, which is not necessarily the main unit. The former
-- ensures that the object is correctly loaded by the binder. The latter
-- is necessary for SofCheck Inspector.
-- The flags Withed and Withed_By_Main in the unit table record are used to
-- avoid duplicates.
-- The field First_Implicit_With in the unit table record are used to
-- avoid creating duplicate with_clauses.
-----------------------
-- Local Subprograms --
......@@ -668,9 +670,8 @@ package body Rtsfind is
-- Otherwise we need to load the unit, First build unit name
-- from the enumeration literal name in type RTU_Id.
U.Uname := Get_Unit_Name (U_Id);
U.Withed := False;
U.Withed_By_Main := False;
U.Uname := Get_Unit_Name (U_Id);
U. First_Implicit_With := Empty;
-- Now do the load call, note that setting Error_Node to Empty is
-- a signal to Load_Unit that we will regard a failure to find the
......@@ -798,9 +799,6 @@ package body Rtsfind is
--------------------
procedure Maybe_Add_With (U : in out RT_Unit_Table_Record) is
Is_Main : constant Boolean :=
In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
begin
-- We do not need to generate a with_clause for a call issued from
-- RTE_Component_Available. However, for Inspector, we need these
......@@ -818,42 +816,37 @@ package body Rtsfind is
return;
end if;
-- If the current unit is the main one, add the with_clause unless it's
-- already been done.
-- Add the with_clause, if not already in the context of the
-- current compilation unit.
if Is_Main then
if U.Withed_By_Main then
return;
else
U.Withed_By_Main := True;
end if;
declare
LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
Clause : Node_Id;
Withn : Node_Id;
-- If the current unit is not the main one, add the with_clause unless
-- it's already been done for some non-main unit.
begin
Clause := U.First_Implicit_With;
while Present (Clause) loop
if Parent (Clause) = Cunit (Current_Sem_Unit) then
return;
end if;
else
if U.Withed then
return;
else
U.Withed := True;
end if;
end if;
Clause := Next_Implicit_With (Clause);
end loop;
-- Here if we've decided to add the with_clause
Withn :=
Make_With_Clause (Standard_Location,
Name =>
Make_Unit_Name
(U, Defining_Unit_Name (Specification (LibUnit))));
declare
LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
Withn : constant Node_Id :=
Make_With_Clause (Standard_Location,
Name =>
Make_Unit_Name
(U, Defining_Unit_Name (Specification (LibUnit))));
Set_Library_Unit (Withn, Cunit (U.Unum));
Set_Corresponding_Spec (Withn, U.Entity);
Set_First_Name (Withn, True);
Set_Implicit_With (Withn, True);
Set_Next_Implicit_With (Withn, U.First_Implicit_With);
begin
Set_Library_Unit (Withn, Cunit (U.Unum));
Set_Corresponding_Spec (Withn, U.Entity);
Set_First_Name (Withn, True);
Set_Implicit_With (Withn, True);
U.First_Implicit_With := Withn;
Mark_Rewrite_Insertion (Withn);
Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
......@@ -1342,14 +1335,14 @@ package body Rtsfind is
-- The RT_Unit_Table entry that may need updating
begin
-- If entry is not set, set it now
-- If entry is not set, set it now, and indicate that it
-- was loaded through an explicit context clause..
if No (U.Entity) then
U := (Entity => E,
Uname => Get_Unit_Name (U_Id),
Unum => Unum,
Withed => False,
Withed_By_Main => False);
U := (Entity => E,
Uname => Get_Unit_Name (U_Id),
Unum => Unum,
First_Implicit_With => Empty);
end if;
return;
......
gcc/ada/sinfo.adb
......@@ -1979,6 +1979,14 @@ package body Sinfo is
return Node2 (N);
end Next_Entity;
function Next_Implicit_With
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_With_Clause);
return Node3 (N);
end Next_Implicit_With;
function Next_Named_Actual
(N : Node_Id) return Node_Id is
begin
......@@ -4759,6 +4767,14 @@ package body Sinfo is
Set_Node2 (N, Val); -- semantic field, no parent set
end Set_Next_Entity;
procedure Set_Next_Implicit_With
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_With_Clause);
Set_Node3 (N, Val); -- semantic field, no parent set
end Set_Next_Implicit_With;
procedure Set_Next_Named_Actual
(N : Node_Id; Val : Node_Id) is
begin
......
gcc/ada/sinfo.ads
......@@ -1364,6 +1364,16 @@ package Sinfo is
-- scope are chained, and this field is used as the forward pointer for
-- this list. See Einfo for further details.
-- Next_Implicit_With (Node3-Sem)
-- Present in N_With_Clause. Part of a chain of with_clauses generated
-- in rtsfind to indicate implicit dependencies on predefined units. Used
-- to prevent multiple with_clauses for the same unit in a given context.
-- A postorder traversal of the tree whose nodes are units and whose
-- links are with_clauses defines the order in which Inspector must
-- examine a compiled unit and its full context. This ordering ensures
-- that any subprogram call is examined after the subprogram declartion
-- has been seen.
-- Next_Named_Actual (Node4-Sem)
-- Present in parameter association node. Set during semantic analysis to
-- point to the next named parameter, where parameters are ordered by
......@@ -5450,6 +5460,7 @@ package Sinfo is
-- N_With_Clause
-- Sloc points to first token of library unit name
-- Name (Node2)
-- Next_Implicit_With (Node3-Sem)
-- Library_Unit (Node4-Sem)
-- Corresponding_Spec (Node5-Sem)
-- First_Name (Flag5) (set to True if first name or only one name)
......@@ -8062,6 +8073,9 @@ package Sinfo is
function Next_Entity
(N : Node_Id) return Node_Id; -- Node2
function Next_Implicit_With
(N : Node_Id) return Node_Id; -- Node3
function Next_Named_Actual
(N : Node_Id) return Node_Id; -- Node4
......@@ -8947,6 +8961,9 @@ package Sinfo is
procedure Set_Next_Entity
(N : Node_Id; Val : Node_Id); -- Node2
procedure Set_Next_Implicit_With
(N : Node_Id; Val : Node_Id); -- Node3
procedure Set_Next_Named_Actual
(N : Node_Id; Val : Node_Id); -- Node4
......@@ -11064,6 +11081,7 @@ package Sinfo is
pragma Inline (Name);
pragma Inline (Names);
pragma Inline (Next_Entity);
pragma Inline (Next_Implicit_With);
pragma Inline (Next_Named_Actual);
pragma Inline (Next_Pragma);
pragma Inline (Next_Rep_Item);
......@@ -11356,6 +11374,7 @@ package Sinfo is
pragma Inline (Set_Name);
pragma Inline (Set_Names);
pragma Inline (Set_Next_Entity);
pragma Inline (Set_Next_Implicit_With);
pragma Inline (Set_Next_Named_Actual);
pragma Inline (Set_Next_Pragma);
pragma Inline (Set_Next_Rep_Item);
......
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