package body Atree is
+ Ignored_Ghost_Recording_Proc : Ignored_Ghost_Record_Proc := null;
+ -- This soft link captures the procedure invoked during the creation of an
+ -- ignored Ghost node or entity.
+
Locked : Boolean := False;
-- Compiling with assertions enabled, node contents modifications are
-- permitted only when this switch is set to False; compiling without
-----------------
procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind) is
- Save_Sloc : constant Source_Ptr := Sloc (N);
+
+ -- Flags table attributes
+
+ Save_CA : constant Boolean := Flags.Table (N).Check_Actuals;
+ Save_Is_IGN : constant Boolean := Flags.Table (N).Is_Ignored_Ghost_Node;
+
+ -- Nodes table attributes
+
+ Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source;
Save_In_List : constant Boolean := Nodes.Table (N).In_List;
Save_Link : constant Union_Id := Nodes.Table (N).Link;
- Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source;
Save_Posted : constant Boolean := Nodes.Table (N).Error_Posted;
- Par_Count : Nat := 0;
+ Save_Sloc : constant Source_Ptr := Sloc (N);
+
+ Par_Count : Nat := 0;
begin
if Nkind (N) in N_Subexpr then
Nodes.Table (N).Nkind := New_Node_Kind;
Nodes.Table (N).Error_Posted := Save_Posted;
- Flags.Table (N) := Default_Flags;
+ Flags.Table (N) := Default_Flags;
+ Flags.Table (N).Check_Actuals := Save_CA;
+ Flags.Table (N).Is_Ignored_Ghost_Node := Save_Is_IGN;
if New_Node_Kind in N_Subexpr then
Set_Paren_Count (N, Par_Count);
end if;
Set_Is_Ignored_Ghost_Node (N);
+
+ -- Record the ignored Ghost node or entity in order to eliminate it
+ -- from the tree later.
+
+ if Ignored_Ghost_Recording_Proc /= null then
+ Ignored_Ghost_Recording_Proc.all (N);
+ end if;
end if;
end Mark_New_Ghost_Node;
if Source > Empty_Or_Error then
New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source));
- Nodes.Table (New_Id).Link := Empty_List_Or_Node;
Nodes.Table (New_Id).In_List := False;
+ Nodes.Table (New_Id).Link := Empty_List_Or_Node;
-- If the original is marked as a rewrite insertion, then unmark the
-- copy, since we inserted the original, not the copy.
-------------
procedure Rewrite (Old_Node, New_Node : Node_Id) is
- Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- -- This field is always preserved in the new node
- Old_Has_Aspects : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
- -- This field is always preserved in the new node
+ -- Flags table attributes
+
+ Old_CA : constant Boolean := Flags.Table (Old_Node).Check_Actuals;
+ Old_Is_IGN : constant Boolean :=
+ Flags.Table (Old_Node).Is_Ignored_Ghost_Node;
+
+ -- Nodes table attributes
+
+ Old_Error_Posted : constant Boolean :=
+ Nodes.Table (Old_Node).Error_Posted;
+ Old_Has_Aspects : constant Boolean :=
+ Nodes.Table (Old_Node).Has_Aspects;
- Old_Paren_Count : Nat;
Old_Must_Not_Freeze : Boolean;
- -- These fields are preserved in the new node only if the new node
- -- and the old node are both subexpression nodes.
+ Old_Paren_Count : Nat;
+ -- These fields are preserved in the new node only if the new node and
+ -- the old node are both subexpression nodes.
-- Note: it is a violation of abstraction levels for Must_Not_Freeze
-- to be referenced like this. ???
pragma Debug (New_Node_Debugging_Output (New_Node));
if Nkind (Old_Node) in N_Subexpr then
- Old_Paren_Count := Paren_Count (Old_Node);
Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node);
+ Old_Paren_Count := Paren_Count (Old_Node);
else
- Old_Paren_Count := 0;
Old_Must_Not_Freeze := False;
+ Old_Paren_Count := 0;
end if;
-- Allocate a new node, to be used to preserve the original contents
-- Copy substitute node into place, preserving old fields as required
Copy_Node (Source => New_Node, Destination => Old_Node);
- Nodes.Table (Old_Node).Error_Posted := Old_Error_P;
+ Nodes.Table (Old_Node).Error_Posted := Old_Error_Posted;
Nodes.Table (Old_Node).Has_Aspects := Old_Has_Aspects;
+ Flags.Table (Old_Node).Check_Actuals := Old_CA;
+ Flags.Table (Old_Node).Is_Ignored_Ghost_Node := Old_Is_IGN;
+
if Nkind (New_Node) in N_Subexpr then
Set_Paren_Count (Old_Node, Old_Paren_Count);
Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
Nodes.Table (N).Has_Aspects := Val;
end Set_Has_Aspects;
+ --------------------------------------
+ -- Set_Ignored_Ghost_Recording_Proc --
+ --------------------------------------
+
+ procedure Set_Ignored_Ghost_Recording_Proc
+ (Proc : Ignored_Ghost_Record_Proc)
+ is
+ begin
+ pragma Assert (Ignored_Ghost_Recording_Proc = null);
+ Ignored_Ghost_Recording_Proc := Proc;
+ end Set_Ignored_Ghost_Recording_Proc;
+
-------------------------------
-- Set_Is_Ignored_Ghost_Node --
-------------------------------
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
-with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
-- Data strictures --
---------------------
- -- The following table contains the N_Compilation_Unit node for a unit that
- -- is either subject to pragma Ghost with policy Ignore or contains ignored
- -- Ghost code. The table is used in the removal of ignored Ghost code from
- -- units.
+ -- The following table contains all ignored Ghost nodes that must be
+ -- eliminated from the tree by routine Remove_Ignored_Ghost_Code.
- package Ignored_Ghost_Units is new Table.Table (
+ package Ignored_Ghost_Nodes is new Table.Table (
Table_Component_Type => Node_Id,
Table_Index_Type => Int,
Table_Low_Bound => 0,
- Table_Initial => Alloc.Ignored_Ghost_Units_Initial,
- Table_Increment => Alloc.Ignored_Ghost_Units_Increment,
- Table_Name => "Ignored_Ghost_Units");
+ Table_Initial => Alloc.Ignored_Ghost_Nodes_Initial,
+ Table_Increment => Alloc.Ignored_Ghost_Nodes_Increment,
+ Table_Name => "Ignored_Ghost_Nodes");
-----------------------
-- Local subprograms --
-- Convert a Ghost mode denoted by name Mode into its respective enumerated
-- value.
- procedure Propagate_Ignored_Ghost_Code (N : Node_Id);
- -- Signal all enclosing scopes that they now contain at least one ignored
- -- Ghost node denoted by N. Add the compilation unit containing N to table
- -- Ignored_Ghost_Units for post processing.
-
- ----------------------------
- -- Add_Ignored_Ghost_Unit --
- ----------------------------
-
- procedure Add_Ignored_Ghost_Unit (Unit : Node_Id) is
- begin
- pragma Assert (Nkind (Unit) = N_Compilation_Unit);
-
- -- Avoid duplicates in the table as pruning the same unit more than once
- -- is wasteful. Since ignored Ghost code tends to be grouped up, check
- -- the contents of the table in reverse.
-
- for Index in reverse Ignored_Ghost_Units.First ..
- Ignored_Ghost_Units.Last
- loop
- -- If the unit is already present in the table, do not add it again
-
- if Unit = Ignored_Ghost_Units.Table (Index) then
- return;
- end if;
- end loop;
-
- -- If we get here, then this is the first time the unit is being added
-
- Ignored_Ghost_Units.Append (Unit);
- end Add_Ignored_Ghost_Unit;
+ procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id);
+ -- Save ignored Ghost node or entity N in table Ignored_Ghost_Nodes for
+ -- later elimination.
----------------------------
-- Check_Ghost_Completion --
procedure Initialize is
begin
- Ignored_Ghost_Units.Init;
+ Ignored_Ghost_Nodes.Init;
+
+ -- Set the soft link which enables Atree.Mark_New_Ghost_Node to record
+ -- an ignored Ghost node or entity.
+
+ Set_Ignored_Ghost_Recording_Proc (Record_Ignored_Ghost_Node'Access);
end Initialize;
------------------------
---------------------------
function Is_Ignored_Ghost_Unit (N : Node_Id) return Boolean is
+ function Ultimate_Original_Node (Nod : Node_Id) return Node_Id;
+ -- Obtain the original node of arbitrary node Nod following a potential
+ -- chain of rewritings.
+
+ ----------------------------
+ -- Ultimate_Original_Node --
+ ----------------------------
+
+ function Ultimate_Original_Node (Nod : Node_Id) return Node_Id is
+ Res : Node_Id;
+
+ begin
+ Res := Nod;
+ while Original_Node (Res) /= Res loop
+ Res := Original_Node (Res);
+ end loop;
+
+ return Res;
+ end Ultimate_Original_Node;
+
+ -- Start of processing for Is_Ignored_Ghost_Unit
+
begin
-- Inspect the original node of the unit in case removal of ignored
-- Ghost code has already taken place.
return
Nkind (N) = N_Compilation_Unit
and then Is_Ignored_Ghost_Entity
- (Defining_Entity (Original_Node (Unit (N))));
+ (Defining_Entity (Ultimate_Original_Node (Unit (N))));
end Is_Ignored_Ghost_Unit;
-------------------------
procedure Lock is
begin
- Ignored_Ghost_Units.Release;
- Ignored_Ghost_Units.Locked := True;
+ Ignored_Ghost_Nodes.Release;
+ Ignored_Ghost_Nodes.Locked := True;
end Lock;
-----------------------------------
Install_Ghost_Region (Ignore, N);
Set_Is_Ignored_Ghost_Node (N);
- Propagate_Ignored_Ghost_Code (N);
+ Record_Ignored_Ghost_Node (N);
end if;
end if;
end Mark_And_Set_Ghost_Assignment;
Install_Ghost_Region (Ignore, N);
Set_Is_Ignored_Ghost_Node (N);
- Propagate_Ignored_Ghost_Code (N);
+ Record_Ignored_Ghost_Node (N);
end if;
end if;
end Mark_And_Set_Ghost_Procedure_Call;
+ -----------------------
+ -- Mark_Ghost_Clause --
+ -----------------------
+
+ procedure Mark_Ghost_Clause (N : Node_Id) is
+ Nam : Node_Id := Empty;
+
+ begin
+ if Nkind (N) = N_Use_Package_Clause then
+ Nam := Name (N);
+
+ elsif Nkind (N) = N_Use_Type_Clause then
+ Nam := Subtype_Mark (N);
+
+ elsif Nkind (N) = N_With_Clause then
+ Nam := Name (N);
+ end if;
+
+ if Present (Nam)
+ and then Is_Entity_Name (Nam)
+ and then Present (Entity (Nam))
+ and then Is_Ignored_Ghost_Entity (Entity (Nam))
+ then
+ Set_Is_Ignored_Ghost_Node (N);
+ Record_Ignored_Ghost_Node (N);
+ end if;
+ end Mark_Ghost_Clause;
+
------------------------------------
-- Mark_Ghost_Declaration_Or_Body --
------------------------------------
Mark_Formals := True;
Set_Is_Ignored_Ghost_Entity (Id);
Set_Is_Ignored_Ghost_Node (N);
- Propagate_Ignored_Ghost_Code (N);
+ Record_Ignored_Ghost_Node (N);
end if;
-- Mark all formal parameters when the related node denotes a subprogram
end if;
end Mark_Ghost_Declaration_Or_Body;
- -----------------------
- -- Mark_Ghost_Clause --
- -----------------------
-
- procedure Mark_Ghost_Clause (N : Node_Id) is
- Nam : Node_Id := Empty;
-
- begin
- if Nkind (N) = N_Use_Package_Clause then
- Nam := Name (N);
-
- elsif Nkind (N) = N_Use_Type_Clause then
- Nam := Subtype_Mark (N);
-
- elsif Nkind (N) = N_With_Clause then
- Nam := Name (N);
- end if;
-
- if Present (Nam)
- and then Is_Entity_Name (Nam)
- and then Present (Entity (Nam))
- and then Is_Ignored_Ghost_Entity (Entity (Nam))
- then
- Set_Is_Ignored_Ghost_Node (N);
- Propagate_Ignored_Ghost_Code (N);
- end if;
- end Mark_Ghost_Clause;
-
-----------------------
-- Mark_Ghost_Pragma --
-----------------------
elsif Is_Ignored_Ghost_Entity (Id) then
Set_Is_Ignored_Ghost_Pragma (N);
Set_Is_Ignored_Ghost_Node (N);
- Propagate_Ignored_Ghost_Code (N);
+ Record_Ignored_Ghost_Node (N);
end if;
end Mark_Ghost_Pragma;
end if;
end Name_To_Ghost_Mode;
- ----------------------------------
- -- Propagate_Ignored_Ghost_Code --
- ----------------------------------
-
- procedure Propagate_Ignored_Ghost_Code (N : Node_Id) is
- Nod : Node_Id;
- Scop : Entity_Id;
+ -------------------------------
+ -- Record_Ignored_Ghost_Node --
+ -------------------------------
+ procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id) is
begin
- -- Traverse the parent chain looking for blocks, packages, and
- -- subprograms or their respective bodies.
-
- Nod := Parent (N);
- while Present (Nod) loop
- Scop := Empty;
-
- if Nkind (Nod) = N_Block_Statement
- and then Present (Identifier (Nod))
- then
- Scop := Entity (Identifier (Nod));
-
- elsif Nkind_In (Nod, N_Package_Body,
- N_Package_Declaration,
- N_Subprogram_Body,
- N_Subprogram_Declaration)
- then
- Scop := Defining_Entity (Nod);
- end if;
-
- -- The current node denotes a scoping construct
-
- if Present (Scop) then
-
- -- Stop the traversal when the scope already contains ignored
- -- Ghost code as all enclosing scopes have already been marked.
-
- if Contains_Ignored_Ghost_Code (Scop) then
- exit;
-
- -- Otherwise mark this scope and keep climbing
-
- else
- Set_Contains_Ignored_Ghost_Code (Scop);
- end if;
- end if;
-
- Nod := Parent (Nod);
- end loop;
-
- -- The unit containing the ignored Ghost code must be post processed
- -- before invoking the back end.
+ -- Save all "top level" ignored Ghost nodes which can be safely replaced
+ -- with a null statement. Note that there is need to save other kinds of
+ -- nodes because those will always be enclosed by some top level ignored
+ -- Ghost node.
+
+ if Is_Body (N)
+ or else Is_Declaration (N)
+ or else Nkind (N) in N_Generic_Instantiation
+ or else Nkind (N) in N_Push_Pop_xxx_Label
+ or else Nkind (N) in N_Raise_xxx_Error
+ or else Nkind (N) in N_Representation_Clause
+ or else Nkind_In (N, N_Assignment_Statement,
+ N_Call_Marker,
+ N_Freeze_Entity,
+ N_Freeze_Generic_Entity,
+ N_Itype_Reference,
+ N_Pragma,
+ N_Procedure_Call_Statement,
+ N_Use_Package_Clause,
+ N_Use_Type_Clause,
+ N_Variable_Reference_Marker,
+ N_With_Clause)
+ then
+ -- Only ignored Ghost nodes must be recorded in the table
- Add_Ignored_Ghost_Unit (Cunit (Get_Code_Unit (N)));
- end Propagate_Ignored_Ghost_Code;
+ pragma Assert (Is_Ignored_Ghost_Node (N));
+ Ignored_Ghost_Nodes.Append (N);
+ end if;
+ end Record_Ignored_Ghost_Node;
-------------------------------
-- Remove_Ignored_Ghost_Code --
-------------------------------
procedure Remove_Ignored_Ghost_Code is
- procedure Prune_Tree (Root : Node_Id);
- -- Remove all code marked as ignored Ghost from the tree of denoted by
- -- Root.
-
- ----------------
- -- Prune_Tree --
- ----------------
-
- procedure Prune_Tree (Root : Node_Id) is
- procedure Prune (N : Node_Id);
- -- Remove a given node from the tree by rewriting it into null
-
- function Prune_Node (N : Node_Id) return Traverse_Result;
- -- Determine whether node N denotes an ignored Ghost construct. If
- -- this is the case, rewrite N as a null statement. See the body for
- -- special cases.
-
- -----------
- -- Prune --
- -----------
-
- procedure Prune (N : Node_Id) is
- begin
- -- Destroy any aspects that may be associated with the node
-
- if Permits_Aspect_Specifications (N) and then Has_Aspects (N) then
- Remove_Aspects (N);
- end if;
-
- Rewrite (N, Make_Null_Statement (Sloc (N)));
- end Prune;
-
- ----------------
- -- Prune_Node --
- ----------------
-
- function Prune_Node (N : Node_Id) return Traverse_Result is
- Id : Entity_Id;
-
- begin
- -- Do not prune compilation unit nodes because many mechanisms
- -- depend on their presence. Note that context items are still
- -- being processed.
+ procedure Remove_Ignored_Ghost_Node (N : Node_Id);
+ -- Eliminate ignored Ghost node N from the tree
- if Nkind (N) = N_Compilation_Unit then
- return OK;
+ -------------------------------
+ -- Remove_Ignored_Ghost_Node --
+ -------------------------------
- -- The node is either declared as ignored Ghost or is a byproduct
- -- of expansion. Destroy it and stop the traversal on this branch.
-
- elsif Is_Ignored_Ghost_Node (N) then
- Prune (N);
- return Skip;
-
- -- Scoping constructs such as blocks, packages, subprograms and
- -- bodies offer some flexibility with respect to pruning.
-
- elsif Nkind_In (N, N_Block_Statement,
- N_Package_Body,
- N_Package_Declaration,
- N_Subprogram_Body,
- N_Subprogram_Declaration)
- then
- if Nkind (N) = N_Block_Statement then
- Id := Entity (Identifier (N));
- else
- Id := Defining_Entity (N);
- end if;
-
- -- The scoping construct contains both living and ignored Ghost
- -- code, let the traversal prune all relevant nodes.
+ procedure Remove_Ignored_Ghost_Node (N : Node_Id) is
+ begin
+ -- The generation and processing of ignored Ghost nodes may cause the
+ -- same node to be saved multiple times. Reducing the number of saves
+ -- to one involves costly solutions such as a hash table or the use
+ -- of a flag shared by all nodes. To solve this problem, the removal
+ -- machinery allows for multiple saves, but does not eliminate a node
+ -- which has already been eliminated.
- if Contains_Ignored_Ghost_Code (Id) then
- return OK;
+ if Nkind (N) = N_Null_Statement then
+ null;
- -- Otherwise the construct contains only living code and should
- -- not be pruned.
+ -- Otherwise the ignored Ghost node must be eliminated
- else
- return Skip;
- end if;
+ else
+ -- Only ignored Ghost nodes must be eliminated from the tree
- -- Otherwise keep searching for ignored Ghost nodes
+ pragma Assert (Is_Ignored_Ghost_Node (N));
- else
- return OK;
- end if;
- end Prune_Node;
+ -- Eliminate the node by rewriting it into null. Another option
+ -- is to remove it from the tree, however multiple corner cases
+ -- emerge which have be dealt individually.
- procedure Prune_Nodes is new Traverse_Proc (Prune_Node);
+ Rewrite (N, Make_Null_Statement (Sloc (N)));
- -- Start of processing for Prune_Tree
+ -- Eliminate any aspects hanging off the ignored Ghost node
- begin
- Prune_Nodes (Root);
- end Prune_Tree;
+ Remove_Aspects (N);
+ end if;
+ end Remove_Ignored_Ghost_Node;
-- Start of processing for Remove_Ignored_Ghost_Code
begin
- for Index in Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop
- Prune_Tree (Ignored_Ghost_Units.Table (Index));
+ for Index in Ignored_Ghost_Nodes.First .. Ignored_Ghost_Nodes.Last loop
+ Remove_Ignored_Ghost_Node (Ignored_Ghost_Nodes.Table (Index));
end loop;
end Remove_Ignored_Ghost_Code;
projects / gcc.git / commitdiff