Skip to content

R
riscv-gcc-1
Commit 3e542a58 by Robert Dewar Committed by Geert Bosch
Options

sinfo.ads: Define Associated_Node to overlap Entity field. 

	* sinfo.ads: Define Associated_Node to overlap Entity field. Cleanup.

	* sinfo.ads: Clarify use of Associated_Node (documentation only).

	* sem_ch12.adb: Change Node4 to Associated_Node. Change
	Associated_Node to Get_Associated_Node. Put use of Unchecked_Access
	much more narrowly in places where needed. These are cleanups.

From-SVN: r46549
parent 0bf08bfe
Showing with 185 additions and 114 deletions
gcc/ada/ChangeLog
2001-10-26 Robert Dewar <dewar@gnat.com>
* sinfo.ads: Define Associated_Node to overlap Entity field. Cleanup.
* sinfo.ads: Clarify use of Associated_Node (documentation only).
* sem_ch12.adb: Change Node4 to Associated_Node. Change
Associated_Node to Get_Associated_Node. Put use of Unchecked_Access
much more narrowly in places where needed. These are cleanups.
2001-10-26 Joel Brobecker <brobecke@gnat.com> 2001-10-26 Joel Brobecker <brobecke@gnat.com>
* 5zosinte.ads (null_pthread): new constant. * 5zosinte.ads (null_pthread): new constant.
......
gcc/ada/sem_ch12.adb
...@@ -75,10 +75,6 @@ with GNAT.HTable; ...@@ -75,10 +75,6 @@ with GNAT.HTable;
package body Sem_Ch12 is package body Sem_Ch12 is
use Atree.Unchecked_Access;
-- This package performs untyped traversals of the tree, therefore it
-- needs direct access to the fields of a node.
---------------------------------------------------------- ----------------------------------------------------------
-- Implementation of Generic Analysis and Instantiation -- -- Implementation of Generic Analysis and Instantiation --
----------------------------------------------------------- -----------------------------------------------------------
...@@ -526,21 +522,24 @@ package body Sem_Ch12 is ...@@ -526,21 +522,24 @@ package body Sem_Ch12 is
-- Add the context clause of the unit containing a generic unit to -- Add the context clause of the unit containing a generic unit to
-- an instantiation that is a compilation unit. -- an instantiation that is a compilation unit.
function Associated_Node (N : Node_Id) return Node_Id; function Get_Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed -- In order to propagate semantic information back from the analyzed
-- copy to the original generic, we maintain links between selected nodes -- copy to the original generic, we maintain links between selected nodes
-- in the generic and their corresponding copies. At the end of generic -- in the generic and their corresponding copies. At the end of generic
-- analysis, the routine Save_Global_References traverses the generic -- analysis, the routine Save_Global_References traverses the generic
-- tree, examines the semantic information, and preserves the links to -- tree, examines the semantic information, and preserves the links to
-- those nodes that contain global information. At instantiation, the -- those nodes that contain global information. At instantiation, the
-- information from the associated node is placed on the new copy, so that -- information from the associated node is placed on the new copy, so
-- name resolution is not repeated. -- that name resolution is not repeated.
-- Two kinds of nodes have associated nodes:
-- Three kinds of nodes have associated nodes:
-- a) those that contain entities, that is to say identifiers, expanded_ -- a) those that contain entities, that is to say identifiers,
-- names, and operators. -- expanded_names, and operators (N_Has_Entity)
-- b) aggregates. -- b) aggregates (N_Aggregate and N_Extension_Aggregate)
-- c) selected components (N_Selected_Component)
-- For the first class, the associated node preserves the entity if it is -- For the first class, the associated node preserves the entity if it is
-- global. If the generic contains nested instantiations, the associated_ -- global. If the generic contains nested instantiations, the associated_
...@@ -554,8 +553,13 @@ package body Sem_Ch12 is ...@@ -554,8 +553,13 @@ package body Sem_Ch12 is
-- some of the ancestor types, if their view is private at the point of -- some of the ancestor types, if their view is private at the point of
-- instantiation. -- instantiation.
-- The associated node is stored in Node4, using this field as a free -- Query??? why selected components. What about N_Freeze_Nodes, I assume
-- union in a fashion that should clearly be under control of sinfo ??? -- that the answer is no, which means that the comment above for a) is
-- confusing ???
-- The associated node is stored in the Associated_Node field. Note that
-- this field overlaps Entity, which is fine, because the whole point is
-- that we don't need or want the normal Entity field in this situation.
procedure Move_Freeze_Nodes procedure Move_Freeze_Nodes
(Out_Of : Entity_Id; (Out_Of : Entity_Id;
...@@ -573,12 +577,6 @@ package body Sem_Ch12 is ...@@ -573,12 +577,6 @@ package body Sem_Ch12 is
-- before installing parents of generics, that are not visible for the -- before installing parents of generics, that are not visible for the
-- actuals themselves. -- actuals themselves.
procedure Set_Associated_Node
(Gen_Node : Node_Id;
Copy_Node : Node_Id);
-- Establish the link between an identifier in the generic unit, and the
-- corresponding node in the semantic copy.
procedure Valid_Default_Attribute (Nam : Entity_Id; Def : Node_Id); procedure Valid_Default_Attribute (Nam : Entity_Id; Def : Node_Id);
-- Verify that an attribute that appears as the default for a formal -- Verify that an attribute that appears as the default for a formal
-- subprogram is a function or procedure with the correct profile. -- subprogram is a function or procedure with the correct profile.
...@@ -3238,13 +3236,12 @@ package body Sem_Ch12 is ...@@ -3238,13 +3236,12 @@ package body Sem_Ch12 is
end Analyze_Subprogram_Instantiation; end Analyze_Subprogram_Instantiation;
--------------------- -------------------------
-- Associated_Node -- -- Get_Associated_Node --
--------------------- -------------------------
function Associated_Node (N : Node_Id) return Node_Id is function Get_Associated_Node (N : Node_Id) return Node_Id is
Assoc : Node_Id := Node4 (N); Assoc : Node_Id := Associated_Node (N);
-- ??? what is Node4 being used for here?
begin begin
if Nkind (Assoc) /= Nkind (N) then if Nkind (Assoc) /= Nkind (N) then
...@@ -3256,33 +3253,37 @@ package body Sem_Ch12 is ...@@ -3256,33 +3253,37 @@ package body Sem_Ch12 is
return Assoc; return Assoc;
else else
-- If the node is part of an inner generic, it may itself have been -- If the node is part of an inner generic, it may itself have been
-- remapped into a further generic copy. Node4 is otherwise used for -- remapped into a further generic copy. Associated_Node is otherwise
-- the entity of the node, and will be of a different node kind, or -- used for the entity of the node, and will be of a different node
-- else N has been rewritten as a literal or function call. -- kind, or else N has been rewritten as a literal or function call.
while Present (Node4 (Assoc)) while Present (Associated_Node (Assoc))
and then Nkind (Node4 (Assoc)) = Nkind (Assoc) and then Nkind (Associated_Node (Assoc)) = Nkind (Assoc)
loop loop
Assoc := Node4 (Assoc); Assoc := Associated_Node (Assoc);
end loop; end loop;
-- Follow and additional link in case the final node was rewritten. -- Follow and additional link in case the final node was rewritten.
-- This can only happen with nested generic units. -- This can only happen with nested generic units.
if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op) if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op)
and then Present (Node4 (Assoc)) and then Present (Associated_Node (Assoc))
and then (Nkind (Node4 (Assoc)) = N_Function_Call and then (Nkind (Associated_Node (Assoc)) = N_Function_Call
or else Nkind (Node4 (Assoc)) = N_Explicit_Dereference or else
or else Nkind (Node4 (Assoc)) = N_Integer_Literal Nkind (Associated_Node (Assoc)) = N_Explicit_Dereference
or else Nkind (Node4 (Assoc)) = N_Real_Literal or else
or else Nkind (Node4 (Assoc)) = N_String_Literal) Nkind (Associated_Node (Assoc)) = N_Integer_Literal
or else
Nkind (Associated_Node (Assoc)) = N_Real_Literal
or else
Nkind (Associated_Node (Assoc)) = N_String_Literal)
then then
Assoc := Node4 (Assoc); Assoc := Associated_Node (Assoc);
end if; end if;
return Assoc; return Assoc;
end if; end if;
end Associated_Node; end Get_Associated_Node;
------------------------------------------- -------------------------------------------
-- Build_Instance_Compilation_Unit_Nodes -- -- Build_Instance_Compilation_Unit_Nodes --
...@@ -4041,7 +4042,7 @@ package body Sem_Ch12 is ...@@ -4041,7 +4042,7 @@ package body Sem_Ch12 is
elsif Has_Private_View (N) elsif Has_Private_View (N)
and then not Is_Private_Type (T) and then not Is_Private_Type (T)
and then not Has_Been_Exchanged (T) and then not Has_Been_Exchanged (T)
and then Etype (Associated_Node (N)) /= T and then Etype (Get_Associated_Node (N)) /= T
then then
-- Only the private declaration was visible in the generic. If -- Only the private declaration was visible in the generic. If
-- the type appears in a subtype declaration, the subtype in the -- the type appears in a subtype declaration, the subtype in the
...@@ -4060,7 +4061,7 @@ package body Sem_Ch12 is ...@@ -4060,7 +4061,7 @@ package body Sem_Ch12 is
or else not In_Private_Part (Scope (Base_Type (T))) or else not In_Private_Part (Scope (Base_Type (T)))
then then
Append_Elmt (T, Exchanged_Views); Append_Elmt (T, Exchanged_Views);
Exchange_Declarations (Etype (Associated_Node (N))); Exchange_Declarations (Etype (Get_Associated_Node (N)));
end if; end if;
-- For composite types with inconsistent representation -- For composite types with inconsistent representation
...@@ -4214,6 +4215,11 @@ package body Sem_Ch12 is ...@@ -4214,6 +4215,11 @@ package body Sem_Ch12 is
----------------------- -----------------------
procedure Copy_Descendants is procedure Copy_Descendants is
use Atree.Unchecked_Access;
-- This code section is part of the implementation of an untyped
-- tree traversal, so it needs direct access to node fields.
begin begin
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N))); Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N))); Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
...@@ -4395,13 +4401,13 @@ package body Sem_Ch12 is ...@@ -4395,13 +4401,13 @@ package body Sem_Ch12 is
-- If the associated node is still defined, the entity in -- If the associated node is still defined, the entity in
-- it is global, and must be copied to the instance. -- it is global, and must be copied to the instance.
if Present (Associated_Node (N)) then if Present (Get_Associated_Node (N)) then
if Nkind (Associated_Node (N)) = Nkind (N) then if Nkind (Get_Associated_Node (N)) = Nkind (N) then
Set_Entity (New_N, Entity (Associated_Node (N))); Set_Entity (New_N, Entity (Get_Associated_Node (N)));
Check_Private_View (N); Check_Private_View (N);
elsif Nkind (Associated_Node (N)) = N_Function_Call then elsif Nkind (Get_Associated_Node (N)) = N_Function_Call then
Set_Entity (New_N, Entity (Name (Associated_Node (N)))); Set_Entity (New_N, Entity (Name (Get_Associated_Node (N))));
else else
Set_Entity (New_N, Empty); Set_Entity (New_N, Empty);
...@@ -4584,8 +4590,8 @@ package body Sem_Ch12 is ...@@ -4584,8 +4590,8 @@ package body Sem_Ch12 is
Set_Associated_Node (N, New_N); Set_Associated_Node (N, New_N);
else else
if Present (Associated_Node (N)) if Present (Get_Associated_Node (N))
and then Nkind (Associated_Node (N)) = Nkind (N) and then Nkind (Get_Associated_Node (N)) = Nkind (N)
then then
-- In the generic the aggregate has some composite type. -- In the generic the aggregate has some composite type.
-- If at the point of instantiation the type has a private -- If at the point of instantiation the type has a private
...@@ -4593,7 +4599,7 @@ package body Sem_Ch12 is ...@@ -4593,7 +4599,7 @@ package body Sem_Ch12 is
-- if any). -- if any).
declare declare
T : Entity_Id := (Etype (Associated_Node (New_N))); T : Entity_Id := (Etype (Get_Associated_Node (New_N)));
Rt : Entity_Id; Rt : Entity_Id;
begin begin
...@@ -4626,10 +4632,17 @@ package body Sem_Ch12 is ...@@ -4626,10 +4632,17 @@ package body Sem_Ch12 is
-- Do not copy the associated node, which points to -- Do not copy the associated node, which points to
-- the generic copy of the aggregate. -- the generic copy of the aggregate.
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N))); declare
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N))); use Atree.Unchecked_Access;
Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N))); -- This code section is part of the implementation of an untyped
Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N))); -- tree traversal, so it needs direct access to node fields.
begin
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
end;
-- Allocators do not have an identifier denoting the access type, -- Allocators do not have an identifier denoting the access type,
-- so we must locate it through the expression to check whether -- so we must locate it through the expression to check whether
...@@ -4640,8 +4653,8 @@ package body Sem_Ch12 is ...@@ -4640,8 +4653,8 @@ package body Sem_Ch12 is
and then Instantiating and then Instantiating
then then
declare declare
T : Node_Id := Associated_Node (Subtype_Mark (Expression (N))); T : Node_Id := Get_Associated_Node (Subtype_Mark (Expression (N)));
Acc_T : Entity_Id; Acc_T : Entity_Id;
begin begin
if Present (T) then if Present (T) then
...@@ -8178,6 +8191,12 @@ package body Sem_Ch12 is ...@@ -8178,6 +8191,12 @@ package body Sem_Ch12 is
-- context of the parent, we must preserve the identifier of the parent -- context of the parent, we must preserve the identifier of the parent
-- so that it can be properly resolved in a subsequent instantiation. -- so that it can be properly resolved in a subsequent instantiation.
procedure Save_Global_Operand_Descendants (N : Node_Id);
-- Apply Save_Global_Descendant to the possible operand fields
-- of the node N (Field2 = Left_Opnd, Field3 = Right_Opnd).
--
-- It is uncomfortable for Sem_Ch12 to have this knowledge ???
procedure Save_Global_Descendant (D : Union_Id); procedure Save_Global_Descendant (D : Union_Id);
-- Apply Save_Global_References recursively to the descendents of -- Apply Save_Global_References recursively to the descendents of
-- current node. -- current node.
...@@ -8247,6 +8266,10 @@ package body Sem_Ch12 is ...@@ -8247,6 +8266,10 @@ package body Sem_Ch12 is
-- The type of N2 is global to the generic unit. Save the -- The type of N2 is global to the generic unit. Save the
-- type in the generic node. -- type in the generic node.
---------------------
-- Set_Global_Type --
---------------------
procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is
Typ : constant Entity_Id := Etype (N2); Typ : constant Entity_Id := Etype (N2);
...@@ -8294,7 +8317,7 @@ package body Sem_Ch12 is ...@@ -8294,7 +8317,7 @@ package body Sem_Ch12 is
-- Start of processing for Reset_Entity -- Start of processing for Reset_Entity
begin begin
N2 := Associated_Node (N); N2 := Get_Associated_Node (N);
E := Entity (N2); E := Entity (N2);
if Present (E) then if Present (E) then
...@@ -8334,9 +8357,7 @@ package body Sem_Ch12 is ...@@ -8334,9 +8357,7 @@ package body Sem_Ch12 is
Change_Selected_Component_To_Expanded_Name (Parent (N)); Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Parent (N2)); Set_Associated_Node (Parent (N), Parent (N2));
Set_Global_Type (Parent (N), Parent (N2)); Set_Global_Type (Parent (N), Parent (N2));
Save_Global_Operand_Descendants (N);
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
-- If this is a reference to the current generic entity, -- If this is a reference to the current generic entity,
-- replace it with a simple name. This is to avoid anomalies -- replace it with a simple name. This is to avoid anomalies
...@@ -8375,7 +8396,7 @@ package body Sem_Ch12 is ...@@ -8375,7 +8396,7 @@ package body Sem_Ch12 is
New_Copy (Parent (N2))); New_Copy (Parent (N2)));
Set_Analyzed (Parent (N), False); Set_Analyzed (Parent (N), False);
-- a selected component may be transformed into a parameterless -- A selected component may be transformed into a parameterless
-- function call. If the called entity is global, rewrite the -- function call. If the called entity is global, rewrite the
-- node appropriately, i.e. as an extended name for the global -- node appropriately, i.e. as an extended name for the global
-- entity. -- entity.
...@@ -8387,9 +8408,7 @@ package body Sem_Ch12 is ...@@ -8387,9 +8408,7 @@ package body Sem_Ch12 is
Change_Selected_Component_To_Expanded_Name (Parent (N)); Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Name (Parent (N2))); Set_Associated_Node (Parent (N), Name (Parent (N2)));
Set_Global_Type (Parent (N), Name (Parent (N2))); Set_Global_Type (Parent (N), Name (Parent (N2)));
Save_Global_Operand_Descendants (N);
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
else else
-- Entity is local. Reset in generic unit, so that node -- Entity is local. Reset in generic unit, so that node
...@@ -8568,6 +8587,21 @@ package body Sem_Ch12 is ...@@ -8568,6 +8587,21 @@ package body Sem_Ch12 is
end if; end if;
end Save_Global_Descendant; end Save_Global_Descendant;
-------------------------------------
-- Save_Global_Operand_Descendants --
-------------------------------------
procedure Save_Global_Operand_Descendants (N : Node_Id) is
use Atree.Unchecked_Access;
-- This code section is part of the implementation of an untyped
-- tree traversal, so it needs direct access to node fields.
begin
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
end Save_Global_Operand_Descendants;
--------------------- ---------------------
-- Save_References -- -- Save_References --
--------------------- ---------------------
...@@ -8588,32 +8622,32 @@ package body Sem_Ch12 is ...@@ -8588,32 +8622,32 @@ package body Sem_Ch12 is
elsif (Nkind (N) = N_Character_Literal elsif (Nkind (N) = N_Character_Literal
or else Nkind (N) = N_Operator_Symbol) or else Nkind (N) = N_Operator_Symbol)
then then
if Nkind (N) = Nkind (Associated_Node (N)) then if Nkind (N) = Nkind (Get_Associated_Node (N)) then
Reset_Entity (N); Reset_Entity (N);
elsif Nkind (N) = N_Operator_Symbol elsif Nkind (N) = N_Operator_Symbol
and then Nkind (Associated_Node (N)) = N_String_Literal and then Nkind (Get_Associated_Node (N)) = N_String_Literal
then then
Change_Operator_Symbol_To_String_Literal (N); Change_Operator_Symbol_To_String_Literal (N);
end if; end if;
elsif Nkind (N) in N_Op then elsif Nkind (N) in N_Op then
if Nkind (N) = Nkind (Associated_Node (N)) then if Nkind (N) = Nkind (Get_Associated_Node (N)) then
if Nkind (N) = N_Op_Concat then if Nkind (N) = N_Op_Concat then
Set_Is_Component_Left_Opnd (N, Set_Is_Component_Left_Opnd (N,
Is_Component_Left_Opnd (Associated_Node (N))); Is_Component_Left_Opnd (Get_Associated_Node (N)));
Set_Is_Component_Right_Opnd (N, Set_Is_Component_Right_Opnd (N,
Is_Component_Right_Opnd (Associated_Node (N))); Is_Component_Right_Opnd (Get_Associated_Node (N)));
end if; end if;
Reset_Entity (N); Reset_Entity (N);
else else
-- Node may be transformed into call to a user-defined operator -- Node may be transformed into call to a user-defined operator
N2 := Associated_Node (N); N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2)); E := Entity (Name (N2));
...@@ -8656,24 +8690,23 @@ package body Sem_Ch12 is ...@@ -8656,24 +8690,23 @@ package body Sem_Ch12 is
end if; end if;
end if; end if;
-- Complete the check on operands. -- Complete the check on operands
Save_Global_Descendant (Field2 (N)); Save_Global_Operand_Descendants (N);
Save_Global_Descendant (Field3 (N));
elsif Nkind (N) = N_Identifier then elsif Nkind (N) = N_Identifier then
if Nkind (N) = Nkind (Associated_Node (N)) then if Nkind (N) = Nkind (Get_Associated_Node (N)) then
-- If this is a discriminant reference, always save it. -- If this is a discriminant reference, always save it.
-- It is used in the instance to find the corresponding -- It is used in the instance to find the corresponding
-- discriminant positionally rather than by name. -- discriminant positionally rather than by name.
Set_Original_Discriminant Set_Original_Discriminant
(N, Original_Discriminant (Associated_Node (N))); (N, Original_Discriminant (Get_Associated_Node (N)));
Reset_Entity (N); Reset_Entity (N);
else else
N2 := Associated_Node (N); N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2)); E := Entity (Name (N2));
...@@ -8757,29 +8790,41 @@ package body Sem_Ch12 is ...@@ -8757,29 +8790,41 @@ package body Sem_Ch12 is
elsif Nkind (N) in N_Entity then elsif Nkind (N) in N_Entity then
null; null;
elsif Nkind (N) = N_Aggregate else
or else Nkind (N) = N_Extension_Aggregate declare
then use Atree.Unchecked_Access;
N2 := Associated_Node (N); -- This code section is part of implementing an untyped tree
if No (N2) -- traversal, so it needs direct access to node fields.
or else No (Etype (N2))
or else not Is_Global (Etype (N2))
then
Set_Associated_Node (N, Empty);
end if;
Save_Global_Descendant (Field1 (N)); begin
Save_Global_Descendant (Field2 (N)); if Nkind (N) = N_Aggregate
Save_Global_Descendant (Field3 (N)); or else
Save_Global_Descendant (Field5 (N)); Nkind (N) = N_Extension_Aggregate
then
N2 := Get_Associated_Node (N);
else if No (N2)
Save_Global_Descendant (Field1 (N)); or else No (Etype (N2))
Save_Global_Descendant (Field2 (N)); or else not Is_Global (Etype (N2))
Save_Global_Descendant (Field3 (N)); then
Save_Global_Descendant (Field4 (N)); Set_Associated_Node (N, Empty);
Save_Global_Descendant (Field5 (N)); end if;
Save_Global_Descendant (Field1 (N));
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
Save_Global_Descendant (Field5 (N));
-- All other cases than aggregates
else
Save_Global_Descendant (Field1 (N));
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
Save_Global_Descendant (Field4 (N));
Save_Global_Descendant (Field5 (N));
end if;
end;
end if; end if;
end Save_References; end Save_References;
...@@ -8801,20 +8846,6 @@ package body Sem_Ch12 is ...@@ -8801,20 +8846,6 @@ package body Sem_Ch12 is
Save_References (N); Save_References (N);
end Save_Global_References; end Save_Global_References;
-------------------------
-- Set_Associated_Node --
-------------------------
-- Note from RBKD: the uncommented use of Set_Node4 below is ugly ???
procedure Set_Associated_Node
(Gen_Node : Node_Id;
Copy_Node : Node_Id)
is
begin
Set_Node4 (Gen_Node, Copy_Node);
end Set_Associated_Node;
--------------------- ---------------------
-- Set_Copied_Sloc -- -- Set_Copied_Sloc --
--------------------- ---------------------
......
gcc/ada/sinfo.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- $Revision: 1.1 $ -- $Revision: 1.2 $
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- -- -- --
...@@ -404,6 +404,7 @@ package Sinfo is ...@@ -404,6 +404,7 @@ package Sinfo is
-- Left_Opnd (Node2) left operand expression -- Left_Opnd (Node2) left operand expression
-- Right_Opnd (Node3) right operand expression -- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator -- Entity (Node4-Sem) defining entity for operator
-- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed -- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units. -- Has_Private_View (Flag11-Sem) set in generic units.
...@@ -411,6 +412,7 @@ package Sinfo is ...@@ -411,6 +412,7 @@ package Sinfo is
-- Chars (Name1) Name_Id for the operator -- Chars (Name1) Name_Id for the operator
-- Right_Opnd (Node3) right operand expression -- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator -- Entity (Node4-Sem) defining entity for operator
-- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed -- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units. -- Has_Private_View (Flag11-Sem) set in generic units.
...@@ -566,6 +568,16 @@ package Sinfo is ...@@ -566,6 +568,16 @@ package Sinfo is
-- expression is valid, even where it would normally not be allowed -- expression is valid, even where it would normally not be allowed
-- (e.g. where the type involved is limited). -- (e.g. where the type involved is limited).
-- Associated_Node (Node4-Sem)
-- Present in nodes that can denote an entity: identifiers, character
-- literals and expanded names, operator nodes that carry an entity
-- reference, and also in N_Aggregate, N_Selected_Component, and
-- N_Extension_Aggregate nodes. This field is used during generic
-- processing to relate nodes in the original template to nodes in the
-- generic copy. It overlaps the Entity field, and is used to capture
-- global references in the analyzed copy and place them in the template.
-- see description in Sem_Ch12 for further details on this usage.
-- At_End_Proc (Node1) -- At_End_Proc (Node1)
-- This field is present in an N_Handled_Sequence_Of_Statements node. -- This field is present in an N_Handled_Sequence_Of_Statements node.
-- It contains an identifier reference for the cleanup procedure to -- It contains an identifier reference for the cleanup procedure to
...@@ -849,10 +861,11 @@ package Sinfo is ...@@ -849,10 +861,11 @@ package Sinfo is
-- defining occurrence is in a separately compiled file, and this -- defining occurrence is in a separately compiled file, and this
-- pointer must be set using the library Load procedure. Note that -- pointer must be set using the library Load procedure. Note that
-- during name resolution, the value in Entity may be temporarily -- during name resolution, the value in Entity may be temporarily
-- incorrect (e.g. during overload resolution, Entity is -- incorrect (e.g. during overload resolution, Entity is initially
-- initially set to the first possible correct interpretation, and -- set to the first possible correct interpretation, and then later
-- then later modified if necessary to contain the correct value -- modified if necessary to contain the correct value after resolution).
-- after resolution). -- Note that Associated_Node overlays this field during the processing
-- of generics. See Sem_Ch12 for further details.
-- Etype (Node5-Sem) -- Etype (Node5-Sem)
-- Appears in all expression nodes, all direct names, and all -- Appears in all expression nodes, all direct names, and all
...@@ -1538,6 +1551,7 @@ package Sinfo is ...@@ -1538,6 +1551,7 @@ package Sinfo is
-- Sloc points to identifier -- Sloc points to identifier
-- Chars (Name1) contains the Name_Id for the identifier -- Chars (Name1) contains the Name_Id for the identifier
-- Entity (Node4-Sem) -- Entity (Node4-Sem)
-- Associated_Node (Node4-Sem)
-- Original_Discriminant (Node2-Sem) -- Original_Discriminant (Node2-Sem)
-- Redundant_Use (Flag13-Sem) -- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) (set in generic units) -- Has_Private_View (Flag11-Sem) (set in generic units)
...@@ -1610,6 +1624,7 @@ package Sinfo is ...@@ -1610,6 +1624,7 @@ package Sinfo is
-- Chars (Name1) contains the Name_Id for the identifier -- Chars (Name1) contains the Name_Id for the identifier
-- Char_Literal_Value (Char_Code2) contains the literal value -- Char_Literal_Value (Char_Code2) contains the literal value
-- Entity (Node4-Sem) -- Entity (Node4-Sem)
-- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units. -- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression -- plus fields for expression
...@@ -2721,6 +2736,7 @@ package Sinfo is ...@@ -2721,6 +2736,7 @@ package Sinfo is
-- Sloc points to period -- Sloc points to period
-- Prefix (Node3) -- Prefix (Node3)
-- Selector_Name (Node2) -- Selector_Name (Node2)
-- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem) -- Do_Access_Check (Flag11-Sem)
-- Do_Discriminant_Check (Flag13-Sem) -- Do_Discriminant_Check (Flag13-Sem)
-- plus fields for expression -- plus fields for expression
...@@ -2791,6 +2807,7 @@ package Sinfo is ...@@ -2791,6 +2807,7 @@ package Sinfo is
-- Attribute_Name (Name2) identifier name from attribute designator -- Attribute_Name (Name2) identifier name from attribute designator
-- Expressions (List1) (set to No_List if no associated expressions) -- Expressions (List1) (set to No_List if no associated expressions)
-- Entity (Node4-Sem) used if the attribute yields a type -- Entity (Node4-Sem) used if the attribute yields a type
-- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem) -- Do_Access_Check (Flag11-Sem)
-- Do_Overflow_Check (Flag17-Sem) -- Do_Overflow_Check (Flag17-Sem)
-- Redundant_Use (Flag13-Sem) -- Redundant_Use (Flag13-Sem)
...@@ -2850,6 +2867,7 @@ package Sinfo is ...@@ -2850,6 +2867,7 @@ package Sinfo is
-- Component_Associations (List2) (set to No_List if none) -- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17) -- Null_Record_Present (Flag17)
-- Aggregate_Bounds (Node3-Sem) -- Aggregate_Bounds (Node3-Sem)
-- Associated_Node (Node4-Sem)
-- Static_Processing_OK (Flag4-Sem) -- Static_Processing_OK (Flag4-Sem)
-- Compile_Time_Known_Aggregate (Flag18-Sem) -- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Expansion_Delayed (Flag11-Sem) -- Expansion_Delayed (Flag11-Sem)
...@@ -2932,6 +2950,7 @@ package Sinfo is ...@@ -2932,6 +2950,7 @@ package Sinfo is
-- N_Extension_Aggregate -- N_Extension_Aggregate
-- Sloc points to left parenthesis -- Sloc points to left parenthesis
-- Ancestor_Part (Node3) -- Ancestor_Part (Node3)
-- Associated_Node (Node4-Sem)
-- Expressions (List1) (set to No_List if none or null record case) -- Expressions (List1) (set to No_List if none or null record case)
-- Component_Associations (List2) (set to No_List if none) -- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17) -- Null_Record_Present (Flag17)
...@@ -3779,6 +3798,7 @@ package Sinfo is ...@@ -3779,6 +3798,7 @@ package Sinfo is
-- Strval (Str3) Id of string value. This is used if the operator -- Strval (Str3) Id of string value. This is used if the operator
-- symbol turns out to be a normal string after all. -- symbol turns out to be a normal string after all.
-- Entity (Node4-Sem) -- Entity (Node4-Sem)
-- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units. -- Has_Private_View (Flag11-Sem) set in generic units.
-- Etype (Node5-Sem) -- Etype (Node5-Sem)
...@@ -5887,6 +5907,7 @@ package Sinfo is ...@@ -5887,6 +5907,7 @@ package Sinfo is
-- Prefix (Node3) -- Prefix (Node3)
-- Selector_Name (Node2) -- Selector_Name (Node2)
-- Entity (Node4-Sem) -- Entity (Node4-Sem)
-- Associated_Node (Node4-Sem)
-- Redundant_Use (Flag13-Sem) -- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units. -- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression -- plus fields for expression
...@@ -5942,6 +5963,7 @@ package Sinfo is ...@@ -5942,6 +5963,7 @@ package Sinfo is
-- N_Freeze_Entity -- N_Freeze_Entity
-- Sloc points near freeze point (see above special note) -- Sloc points near freeze point (see above special note)
-- Entity (Node4-Sem) -- Entity (Node4-Sem)
-- Associated_Node (Node4-Sem)
-- Access_Types_To_Process (Elist2-Sem) (set to No_Elist if none) -- Access_Types_To_Process (Elist2-Sem) (set to No_Elist if none)
-- TSS_Elist (Elist3-Sem) (set to No_Elist if no associated TSS's) -- TSS_Elist (Elist3-Sem) (set to No_Elist if no associated TSS's)
-- Actions (List1) (set to No_List if no freeze actions) -- Actions (List1) (set to No_List if no freeze actions)
...@@ -6739,6 +6761,9 @@ package Sinfo is ...@@ -6739,6 +6761,9 @@ package Sinfo is
function Assignment_OK function Assignment_OK
(N : Node_Id) return Boolean; -- Flag15 (N : Node_Id) return Boolean; -- Flag15
function Associated_Node
(N : Node_Id) return Node_Id; -- Node4
function At_End_Proc function At_End_Proc
(N : Node_Id) return Node_Id; -- Node1 (N : Node_Id) return Node_Id; -- Node1
...@@ -7486,6 +7511,9 @@ package Sinfo is ...@@ -7486,6 +7511,9 @@ package Sinfo is
procedure Set_Assignment_OK procedure Set_Assignment_OK
(N : Node_Id; Val : Boolean := True); -- Flag15 (N : Node_Id; Val : Boolean := True); -- Flag15
procedure Set_Associated_Node
(N : Node_Id; Val : Node_Id); -- Node4
procedure Set_Attribute_Name procedure Set_Attribute_Name
(N : Node_Id; Val : Name_Id); -- Name2 (N : Node_Id; Val : Name_Id); -- Name2
...@@ -8215,6 +8243,7 @@ package Sinfo is ...@@ -8215,6 +8243,7 @@ package Sinfo is
pragma Inline (Ancestor_Part); pragma Inline (Ancestor_Part);
pragma Inline (Array_Aggregate); pragma Inline (Array_Aggregate);
pragma Inline (Assignment_OK); pragma Inline (Assignment_OK);
pragma Inline (Associated_Node);
pragma Inline (At_End_Proc); pragma Inline (At_End_Proc);
pragma Inline (Attribute_Name); pragma Inline (Attribute_Name);
pragma Inline (Aux_Decls_Node); pragma Inline (Aux_Decls_Node);
...@@ -8461,6 +8490,7 @@ package Sinfo is ...@@ -8461,6 +8490,7 @@ package Sinfo is
pragma Inline (Set_Ancestor_Part); pragma Inline (Set_Ancestor_Part);
pragma Inline (Set_Array_Aggregate); pragma Inline (Set_Array_Aggregate);
pragma Inline (Set_Assignment_OK); pragma Inline (Set_Assignment_OK);
pragma Inline (Set_Associated_Node);
pragma Inline (Set_At_End_Proc); pragma Inline (Set_At_End_Proc);
pragma Inline (Set_Attribute_Name); pragma Inline (Set_Attribute_Name);
pragma Inline (Set_Aux_Decls_Node); pragma Inline (Set_Aux_Decls_Node);
......
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