Commit 980f94b7 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] New ignored Ghost code removal mechanism

This patch reimplements the mechanism which removes ignored Ghost code from the
tree.

The previous mechanism proved to be unreliable because it assumed that no new
scoping constructs would be created after some ignored Ghost code had already
notified its enclosing scoping constructs that they contain such code. The
assumption can be broken by having a call to an ignored Ghost procedure within
the extended return statement of a function. The procedure call would signal
the enclosing function that it contains ignored Ghost code, however the return
statement would introduce an extra block, effectively hiding the procedure call
from the ignored Ghost code elimination pass.

The new mechanism implemented in this patch forgoes directed tree pruning in
favor of storing the actual ignored Ghost code, and later directly eliminating
it from the tree.

For this approach to operate efficiently, only "top level" ignored Ghost
constructs are stored. The top level constructs are essentially nodes which can
appear within a declarative or statement list and be safely rewritten into null
statements. This ensures that only "root" ignored Ghost construct need to be
processed, as opposed to all ignored Ghost nodes within a subtree.

The approach has one drawback however. Due to the generation and analysis of
ignored Ghost code, a construct may be recorded multiple times (usually twice).
The mechanism simply deals with this artefact instead of employing expensive
solutions such as hash tables or a common flag shared by all nodes to eliminate
the duplicates.

------------
-- Source --
------------

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is
   procedure Ghost_Proc with Ghost;
   procedure Ghost_Proc is
   begin
      Put_Line ("ERROR: Ghost_Proc called");
   end Ghost_Proc;

   function Func return Integer is
   begin
      return Res : Integer := 123 do
         Ghost_Proc;
      end return;
   end Func;

   Val : Integer with Ghost;

begin
   Val := Func;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c -gnatDG main.adb
$ grep -c "ghost" main.adb.dg
0

2018-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* alloc.ads: Update the allocation metrics of the ignored Ghost nodes
	table.
	* atree.adb: Add a soft link for a procedure which is invoked whenever
	an ignored Ghost node or entity is created.
	(Change_Node): Preserve relevant attributes which come from the Flags
	table.
	(Mark_New_Ghost_Node): Record a newly created ignored Ghost node or
	entity.
	(Rewrite): Preserve relevant attributes which come from the Flags
	table.
	(Set_Ignored_Ghost_Recording_Proc): New routine.
	* atree.ads: Define an access-to-suprogram type for a soft link which
	records a newly created ignored Ghost node or entity.
	(Set_Ignored_Ghost_Recording_Proc): New routine.
	* ghost.adb: Remove with and use clause for Lib.  Remove table
	Ignored_Ghost_Units.  Add new table Ignored_Ghost_Nodes.
	(Add_Ignored_Ghost_Unit): Removed.
	(Initialize): Initialize the table which stores ignored Ghost nodes.
	Set the soft link which allows Atree.Mark_New_Ghost_Node to record an
	ignored Ghost node.
	(Is_Ignored_Ghost_Unit): Use the ultimate original node when checking
	an eliminated ignored Ghost unit.
	(Lock): Release and lock the table which stores ignored Ghost nodes.
	(Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored
	Ghost nodes.
	(Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate
	ignored Ghost nodes.
	(Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes.
	(Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored
	Ghost nodes.
	(Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes.
	(Propagate_Ignored_Ghost_Code): Removed.
	(Record_Ignored_Ghost_Node): New routine.
	(Remove_Ignored_Ghost_Code): Reimplemented.
	(Remove_Ignored_Ghost_Node): New routine.
	(Ultimate_Original_Node): New routine.
	* ghost.ads (Check_Ghost_Completion): Removed.
	* sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use
	package clause as ignored Ghost if applicable.
	* sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented.

From-SVN: r262775
parent e8427749
2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* alloc.ads: Update the allocation metrics of the ignored Ghost nodes
table.
* atree.adb: Add a soft link for a procedure which is invoked whenever
an ignored Ghost node or entity is created.
(Change_Node): Preserve relevant attributes which come from the Flags
table.
(Mark_New_Ghost_Node): Record a newly created ignored Ghost node or
entity.
(Rewrite): Preserve relevant attributes which come from the Flags
table.
(Set_Ignored_Ghost_Recording_Proc): New routine.
* atree.ads: Define an access-to-suprogram type for a soft link which
records a newly created ignored Ghost node or entity.
(Set_Ignored_Ghost_Recording_Proc): New routine.
* ghost.adb: Remove with and use clause for Lib. Remove table
Ignored_Ghost_Units. Add new table Ignored_Ghost_Nodes.
(Add_Ignored_Ghost_Unit): Removed.
(Initialize): Initialize the table which stores ignored Ghost nodes.
Set the soft link which allows Atree.Mark_New_Ghost_Node to record an
ignored Ghost node.
(Is_Ignored_Ghost_Unit): Use the ultimate original node when checking
an eliminated ignored Ghost unit.
(Lock): Release and lock the table which stores ignored Ghost nodes.
(Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored
Ghost nodes.
(Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate
ignored Ghost nodes.
(Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes.
(Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored
Ghost nodes.
(Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes.
(Propagate_Ignored_Ghost_Code): Removed.
(Record_Ignored_Ghost_Node): New routine.
(Remove_Ignored_Ghost_Code): Reimplemented.
(Remove_Ignored_Ghost_Node): New routine.
(Ultimate_Original_Node): New routine.
* ghost.ads (Check_Ghost_Completion): Removed.
* sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use
package clause as ignored Ghost if applicable.
* sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented.
2018-07-17 Javier Miranda <miranda@adacore.com>
* sem_ch5.adb (Has_Call_Using_Secondary_Stack): Moved to library level
......
......@@ -67,8 +67,8 @@ package Alloc is
In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
In_Out_Warnings_Increment : constant := 100;
Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util
Ignored_Ghost_Units_Increment : constant := 50;
Ignored_Ghost_Nodes_Initial : constant := 100; -- Ghost
Ignored_Ghost_Nodes_Increment : constant := 100;
Inlined_Initial : constant := 100; -- Inline
Inlined_Increment : constant := 100;
......
......@@ -48,6 +48,10 @@ with GNAT.Heap_Sort_G;
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
......@@ -683,12 +687,21 @@ package body Atree is
-----------------
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
......@@ -703,7 +716,9 @@ package body Atree is
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);
......@@ -1606,6 +1621,13 @@ package body Atree is
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;
......@@ -1629,8 +1651,8 @@ package body Atree is
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.
......@@ -2218,16 +2240,24 @@ package body Atree is
-------------
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. ???
......@@ -2244,11 +2274,11 @@ package body Atree is
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
......@@ -2274,9 +2304,12 @@ package body Atree is
-- 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);
......@@ -2369,6 +2402,18 @@ package body Atree is
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 --
-------------------------------
......
......@@ -570,6 +570,13 @@ package Atree is
-- are appropriately updated. This function is used only by Sinfo.CN to
-- change nodes into their corresponding entities.
type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id);
procedure Set_Ignored_Ghost_Recording_Proc
(Proc : Ignored_Ghost_Record_Proc);
-- Register a procedure that is invoked when an ignored Ghost node or
-- entity is created.
type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
procedure Set_Reporting_Proc (Proc : Report_Proc);
......
......@@ -31,10 +31,6 @@ with Types; use Types;
package Ghost is
procedure Add_Ignored_Ghost_Unit (Unit : Node_Id);
-- Add a single ignored Ghost compilation unit to the internal table for
-- post processing.
procedure Check_Ghost_Completion
(Prev_Id : Entity_Id;
Compl_Id : Entity_Id);
......
......@@ -3782,9 +3782,7 @@ package body Sem_Ch8 is
-- Local variables
Ghost_Id : Entity_Id := Empty;
Living_Id : Entity_Id := Empty;
Pack : Entity_Id;
Pack : Entity_Id;
-- Start of processing for Analyze_Use_Package
......@@ -3870,22 +3868,9 @@ package body Sem_Ch8 is
end if;
Use_One_Package (N, Name (N));
-- Capture the first Ghost package and the first living package
if Is_Entity_Name (Name (N)) then
Pack := Entity (Name (N));
if Is_Ghost_Entity (Pack) then
if No (Ghost_Id) then
Ghost_Id := Pack;
end if;
elsif No (Living_Id) then
Living_Id := Pack;
end if;
end if;
end if;
Mark_Ghost_Clause (N);
end Analyze_Use_Package;
----------------------
......
......@@ -13401,12 +13401,7 @@ package body Sem_Util is
function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean is
begin
return Nkind_In (N, N_Entry_Body,
N_Package_Body,
N_Package_Declaration,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body);
return Is_Body (N) or else Nkind (N) = N_Package_Declaration;
end Is_Body_Or_Package_Declaration;
-----------------------
......
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