===================================================================
@@ -38,14 +38,15 @@ pragma Style_Checks (All_Checks);
with Debug; use Debug;
with Nlists; use Nlists;
-with Opt; use Opt;
with Output; use Output;
with Sinput; use Sinput;
-with SCIL_LL; use SCIL_LL;
with Tree_IO; use Tree_IO;
package body Atree is
+ Reporting_Proc : Report_Proc := null;
+ -- Record argument to last call to Set_Reporting_Proc
+
---------------
-- Debugging --
---------------
@@ -534,10 +535,10 @@ package body Atree is
Orig_Nodes.Set_Last (Nodes.Last);
Allocate_List_Tables (Nodes.Last);
- -- Update the SCIL_Node field (if available)
+ -- Invoke the reporting procedure (if available)
- if Generate_SCIL then
- Set_SCIL_Node (New_Id, Get_SCIL_Node (Src));
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => New_Id, Source => Src);
end if;
return New_Id;
@@ -925,6 +926,16 @@ package body Atree is
return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6);
end Ekind_In;
+ ------------------------
+ -- Set_Reporting_Proc --
+ ------------------------
+
+ procedure Set_Reporting_Proc (P : Report_Proc) is
+ begin
+ pragma Assert (Reporting_Proc = null);
+ Reporting_Proc := P;
+ end Set_Reporting_Proc;
+
------------------
-- Error_Posted --
------------------
@@ -1580,10 +1591,10 @@ package body Atree is
Orig_Nodes.Table (Old_Node) := Old_Node;
- -- Update the SCIL_Node field (if available)
+ -- Invoke the reporting procedure (if available)
- if Generate_SCIL then
- Set_SCIL_Node (Old_Node, Get_SCIL_Node (New_Node));
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
end if;
end Replace;
@@ -1644,10 +1655,10 @@ package body Atree is
Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
- -- Update the SCIL_Node field (if available)
+ -- Invoke the reporting procedure (if available)
- if Generate_SCIL then
- Set_SCIL_Node (Old_Node, Get_SCIL_Node (New_Node));
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
end if;
end Rewrite;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- 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- --
@@ -461,6 +461,12 @@ package Atree is
-- function is used only by Sinfo.CN to change nodes into their
-- corresponding entities.
+ type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
+
+ procedure Set_Reporting_Proc (P : Report_Proc);
+ -- Register a procedure that is invoked when a node is allocated, replaced
+ -- or rewritten.
+
type Traverse_Result is (Abandon, OK, OK_Orig, Skip);
-- This is the type of the result returned by the Process function passed
-- to Traverse_Func and Traverse_Proc. See below for details.
===================================================================
@@ -37,6 +37,10 @@ with Table;
package body SCIL_LL is
+ procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id);
+ -- Copy the SCIL field from Source to Target (it is used as the argument
+ -- for a call to Set_Reporting_Proc in package atree).
+
function SCIL_Nodes_Table_Size return Pos;
-- Used to initialize the table of SCIL nodes because we do not want
-- to consume memory for this table if it is not required.
@@ -64,6 +68,15 @@ package body SCIL_LL is
-- This table records the value of attribute SCIL_Node of all the
-- tree nodes.
+ --------------------
+ -- Copy_SCIL_Node --
+ --------------------
+
+ procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
+ begin
+ Set_SCIL_Node (Target, Get_SCIL_Node (Source));
+ end Copy_SCIL_Node;
+
----------------
-- Initialize --
----------------
@@ -71,6 +84,7 @@ package body SCIL_LL is
procedure Initialize is
begin
SCIL_Nodes.Init;
+ Set_Reporting_Proc (Copy_SCIL_Node'Access);
end Initialize;
-------------------