-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
-- file must be properly reflected in the file atree.h which is a C header
-- file containing equivalent definitions for use by gigi.
+with Aspects; use Aspects;
with Debug; use Debug;
with Nlists; use Nlists;
with Output; use Output;
(Src : Node_Id;
With_Extension : Boolean) return Node_Id
is
- New_Id : Node_Id := Src;
- Nod : Node_Record := Default_Node;
- Ext1 : Node_Record := Default_Node_Extension;
- Ext2 : Node_Record := Default_Node_Extension;
- Ext3 : Node_Record := Default_Node_Extension;
- Ext4 : Node_Record := Default_Node_Extension;
+ New_Id : Node_Id;
begin
- if Present (Src) then
- Nod := Nodes.Table (Src);
-
- if Has_Extension (Src) then
- Ext1 := Nodes.Table (Src + 1);
- Ext2 := Nodes.Table (Src + 2);
- Ext3 := Nodes.Table (Src + 3);
- Ext4 := Nodes.Table (Src + 4);
- end if;
- end if;
-
- if not (Present (Src)
- and then not Has_Extension (Src)
- and then With_Extension
- and then Src = Nodes.Last)
+ if Present (Src)
+ and then not Has_Extension (Src)
+ and then With_Extension
+ and then Src = Nodes.Last
then
+ New_Id := Src;
+ else
-- We are allocating a new node, or extending a node
-- other than Nodes.Last.
- Nodes.Append (Nod);
+ if Present (Src) then
+ Nodes.Append (Nodes.Table (Src));
+ else
+ Nodes.Append (Default_Node);
+ end if;
+
New_Id := Nodes.Last;
Orig_Nodes.Append (New_Id);
Node_Count := Node_Count + 1;
-- Set extension nodes if required
if With_Extension then
- Nodes.Append (Ext1);
- Nodes.Append (Ext2);
- Nodes.Append (Ext3);
- Nodes.Append (Ext4);
+ if Present (Src) and then Has_Extension (Src) then
+ for J in 1 .. 4 loop
+ Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+ end loop;
+ else
+ for J in 1 .. 4 loop
+ Nodes.Append (Default_Node_Extension);
+ end loop;
+ end if;
end if;
Orig_Nodes.Set_Last (Nodes.Last);
end Copy_Node;
------------------------
+ -- Copy_Separate_List --
+ ------------------------
+
+ function Copy_Separate_List (Source : List_Id) return List_Id is
+ Result : constant List_Id := New_List;
+ Nod : Node_Id;
+
+ begin
+ Nod := First (Source);
+ while Present (Nod) loop
+ Append (Copy_Separate_Tree (Nod), Result);
+ Next (Nod);
+ end loop;
+
+ return Result;
+ end Copy_Separate_List;
+
+ ------------------------
-- Copy_Separate_Tree --
------------------------
Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
- -- Set Entity field to Empty
- -- Why is this done??? and why is it always right to do it???
+ -- Set Entity field to Empty to ensure that no entity references
+ -- are shared between the two, if the source is already analyzed.
if Nkind (New_Id) in N_Has_Entity
or else Nkind (New_Id) = N_Freeze_Entity
return Default_Node.Comes_From_Source;
end Get_Comes_From_Source_Default;
+ -----------------
+ -- Has_Aspects --
+ -----------------
+
+ function Has_Aspects (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Nodes.Table (N).Has_Aspects;
+ end Has_Aspects;
+
-------------------
-- Has_Extension --
-------------------
begin
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;
- -- If the original is marked as a rewrite insertion, then unmark
- -- the copy, since we inserted the original, not the copy.
+ -- If the original is marked as a rewrite insertion, then unmark the
+ -- copy, since we inserted the original, not the copy.
Nodes.Table (New_Id).Rewrite_Ins := False;
pragma Debug (New_Node_Debugging_Output (New_Id));
+
+ -- Clear Is_Overloaded since we cannot have semantic interpretations
+ -- of this new node.
+
+ if Nkind (Source) in N_Subexpr then
+ Set_Is_Overloaded (New_Id, False);
+ end if;
+
+ -- Always clear Has_Aspects, the caller must take care of copying
+ -- aspects if this is required for the particular situation.
+
+ Set_Has_Aspects (New_Id, False);
end if;
return New_Id;
-------------
procedure Replace (Old_Node, New_Node : Node_Id) is
- Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
+ Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
+ Old_HasA : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
+ Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
begin
pragma Assert
(not Has_Extension (Old_Node)
- and not Has_Extension (New_Node)
- and not Nodes.Table (New_Node).In_List);
+ and not Has_Extension (New_Node)
+ and not Nodes.Table (New_Node).In_List);
- -- Do copy, preserving link and in list status and comes from source
+ -- Do copy, preserving link and in list status and required flags
Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Comes_From_Source := Old_CFS;
Nodes.Table (Old_Node).Error_Posted := Old_Post;
+ Nodes.Table (Old_Node).Has_Aspects := Old_HasA;
-- Fix parents of substituted node, since it has changed identity
procedure Rewrite (Old_Node, New_Node : Node_Id) is
Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- -- This fields is always preserved in the new node
+ -- 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
Old_Paren_Count : Nat;
Old_Must_Not_Freeze : Boolean;
begin
pragma Assert
(not Has_Extension (Old_Node)
- and not Has_Extension (New_Node)
- and not Nodes.Table (New_Node).In_List);
+ and not Has_Extension (New_Node)
+ and not Nodes.Table (New_Node).In_List);
pragma Debug (Rewrite_Debugging_Output (Old_Node, 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);
else
- Old_Paren_Count := 0;
+ Old_Paren_Count := 0;
Old_Must_Not_Freeze := False;
end if;
Sav_Node := New_Copy (Old_Node);
Orig_Nodes.Table (Sav_Node) := Sav_Node;
Orig_Nodes.Table (Old_Node) := Sav_Node;
+
+ -- Both the old and new copies of the node will share the same list
+ -- of aspect specifications if aspect specifications are present.
+
+ if Has_Aspects (Sav_Node) then
+ Set_Has_Aspects (Sav_Node, False);
+ Set_Aspect_Specifications
+ (Sav_Node, Aspect_Specifications (Old_Node));
+ end if;
end if;
-- 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).Has_Aspects := Old_Has_Aspects;
if Nkind (New_Node) in N_Subexpr then
Set_Paren_Count (Old_Node, Old_Paren_Count);
end Set_Error_Posted;
---------------------
+ -- Set_Has_Aspects --
+ ---------------------
+
+ procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Nodes.Table (N).Has_Aspects := Val;
+ end Set_Has_Aspects;
+
+ -----------------------
+ -- Set_Original_Node --
+ -----------------------
+
+ procedure Set_Original_Node (N : Node_Id; Val : Node_Id) is
+ begin
+ Orig_Nodes.Table (N) := Val;
+ end Set_Original_Node;
+
+ ---------------------
-- Set_Paren_Count --
---------------------
return List_Id (Nodes.Table (N + 2).Field7);
end List14;
+ function List25 (N : Node_Id) return List_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return List_Id (Nodes.Table (N + 4).Field7);
+ end List25;
+
function Elist1 (N : Node_Id) return Elist_Id is
pragma Assert (N <= Nodes.Last);
Value : constant Union_Id := Nodes.Table (N).Field1;
end if;
end Elist4;
+ function Elist5 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field5;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist5;
+
function Elist8 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 1).Field8;
end if;
end Elist8;
+ function Elist10 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 1).Field10;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist10;
+
function Elist13 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 2).Field6;
end if;
end Elist23;
+ function Elist24 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 4).Field6;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist24;
+
function Elist25 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 4).Field7;
return From_Union (Nodes.Table (N + 3).Field8);
end Ureal21;
- function Flag3 (N : Node_Id) return Boolean is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Flag3;
- end Flag3;
-
function Flag4 (N : Node_Id) return Boolean is
begin
pragma Assert (N <= Nodes.Last);
function Flag20 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 1).Flag3;
+ return Nodes.Table (N + 1).Has_Aspects;
end Flag20;
function Flag21 (N : Node_Id) return Boolean is
function Flag41 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 2).Flag3;
+ return Nodes.Table (N + 2).Has_Aspects;
end Flag41;
function Flag42 (N : Node_Id) return Boolean is
function Flag130 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 3).Flag3;
+ return Nodes.Table (N + 3).Has_Aspects;
end Flag130;
function Flag131 (N : Node_Id) return Boolean is
function Flag217 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 4).Flag3;
+ return Nodes.Table (N + 4).Has_Aspects;
end Flag217;
function Flag218 (N : Node_Id) return Boolean is
Nodes.Table (N + 2).Field7 := Union_Id (Val);
end Set_List14;
+ procedure Set_List25 (N : Node_Id; Val : List_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field7 := Union_Id (Val);
+ end Set_List25;
+
procedure Set_Elist1 (N : Node_Id; Val : Elist_Id) is
begin
Nodes.Table (N).Field1 := Union_Id (Val);
Nodes.Table (N).Field4 := Union_Id (Val);
end Set_Elist4;
+ procedure Set_Elist5 (N : Node_Id; Val : Elist_Id) is
+ begin
+ Nodes.Table (N).Field5 := Union_Id (Val);
+ end Set_Elist5;
+
procedure Set_Elist8 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 1).Field8 := Union_Id (Val);
end Set_Elist8;
+ procedure Set_Elist10 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 1).Field10 := Union_Id (Val);
+ end Set_Elist10;
+
procedure Set_Elist13 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 3).Field10 := Union_Id (Val);
end Set_Elist23;
+ procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field6 := Union_Id (Val);
+ end Set_Elist24;
+
procedure Set_Elist25 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 3).Field8 := To_Union (Val);
end Set_Ureal21;
- procedure Set_Flag3 (N : Node_Id; Val : Boolean) is
- begin
- pragma Assert (N <= Nodes.Last);
- Nodes.Table (N).Flag3 := Val;
- end Set_Flag3;
-
procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (N <= Nodes.Last);
procedure Set_Flag20 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 1).Flag3 := Val;
+ Nodes.Table (N + 1).Has_Aspects := Val;
end Set_Flag20;
procedure Set_Flag21 (N : Node_Id; Val : Boolean) is
procedure Set_Flag41 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 2).Flag3 := Val;
+ Nodes.Table (N + 2).Has_Aspects := Val;
end Set_Flag41;
procedure Set_Flag42 (N : Node_Id; Val : Boolean) is
procedure Set_Flag130 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 3).Flag3 := Val;
+ Nodes.Table (N + 3).Has_Aspects := Val;
end Set_Flag130;
procedure Set_Flag131 (N : Node_Id; Val : Boolean) is
procedure Set_Flag217 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 4).Flag3 := Val;
+ Nodes.Table (N + 4).Has_Aspects := Val;
end Set_Flag217;
procedure Set_Flag218 (N : Node_Id; Val : Boolean) is
OSDN Git Service
