+2014-01-21 Robert Dewar <dewar@adacore.com>
+
+ * gcc-interface/gigi.h: Get Flags array address.
+ * gcc-interface/trans.c: Acquire Flags array address.
+ * atree.adb: Add support for Flags array and Flag0,1,2,3.
+ * atree.ads: Add support for Flags array and Flag0,1,2,3.
+ * atree.h: Add support for Flags array and Flag0,1,2,3.
+ * back_end.adb: Pass Flags array address to gigi.
+
+2014-01-21 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch8.adb (Attribute_Renaming): Transfer original attribute
+ reference to generated body so that legality checks on stream
+ attributes are properly applied. If type is tagged and already
+ frozen, insert generated body at the point of the renaming
+ declaration.
+
+2014-01-21 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb: Code clean up.
+ * sem_ch8.adb: Minor reformatting
+
2014-01-20 Robert Dewar <dewar@adacore.com>
* checks.adb: Check SPARK_Mode instead of GNATProve_Mode for
and then Src = Nodes.Last
then
New_Id := Src;
+
else
-- We are allocating a new node, or extending a node
-- other than Nodes.Last.
if Present (Src) then
Nodes.Append (Nodes.Table (Src));
+ Flags.Append (Flags.Table (Src));
else
Nodes.Append (Default_Node);
+ Flags.Append (Default_Flags);
end if;
New_Id := Nodes.Last;
if Present (Src) and then Has_Extension (Src) then
for J in 1 .. Num_Extension_Nodes loop
Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+ Flags.Append (Flags.Table (Src + Node_Id (J)));
end loop;
else
for J in 1 .. Num_Extension_Nodes loop
Nodes.Append (Default_Node_Extension);
+ Flags.Append (Default_Flags);
end loop;
end if;
end if;
Nodes.Table (N).Nkind := New_Node_Kind;
Nodes.Table (N).Error_Posted := Save_Posted;
+ Flags.Table (N) := Default_Flags;
+
if New_Node_Kind in N_Subexpr then
Set_Paren_Count (N, Par_Count);
end if;
Nodes.Table (Destination).In_List := Save_In_List;
Nodes.Table (Destination).Link := Save_Link;
+ Flags.Table (Destination) := Flags.Table (Source);
+
-- Specifically set Paren_Count to make sure auxiliary table entry
-- gets correctly made if the parentheses count is at the max value.
Set_Paren_Count (Destination, Paren_Count (Source));
end if;
- -- Deal with copying extension nodes if present
+ -- Deal with copying extension nodes if present. No need to copy flags
+ -- table entries, since they are always zero for extending components.
if Has_Extension (Source) then
pragma Assert (Has_Extension (Destination));
procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is
Temp_Ent : Node_Record;
+ Temp_Flg : Flags_Byte;
begin
pragma Assert (Has_Extension (E1)
Nodes.Table (E1 + 5) := Nodes.Table (E2 + 5);
Nodes.Table (E2 + 5) := Temp_Ent;
+ -- Exchange flag bytes for first component. No need to do the exchange
+ -- for the other components, since the flag bytes are always zero.
+
+ Temp_Flg := Flags.Table (E1);
+ Flags.Table (E1) := Flags.Table (E2);
+ Flags.Table (E2) := Temp_Flg;
+
-- That exchange exchanged the parent pointers as well, which is what
-- we want, but we need to patch up the defining identifier pointers
-- in the parent nodes (the child pointers) to match this switch
Fix_Parent (Field5 (Fix_Node));
end Fix_Parents;
+ -------------------
+ -- Flags_Address --
+ -------------------
+
+ function Flags_Address return System.Address is
+ begin
+ return Flags.Table (First_Node_Id)'Address;
+ end Flags_Address;
+
-----------------------------------
-- Get_Comes_From_Source_Default --
-----------------------------------
begin
Node_Count := 0;
Atree_Private_Part.Nodes.Init;
+ Atree_Private_Part.Flags.Init;
Orig_Nodes.Init;
Paren_Counts.Init;
procedure Lock is
begin
Nodes.Locked := True;
+ Flags.Locked := True;
Orig_Nodes.Locked := True;
Nodes.Release;
+ Flags.Release;
Orig_Nodes.Release;
end Lock;
begin
Tree_Read_Int (Node_Count);
Nodes.Tree_Read;
+ Flags.Tree_Read;
Orig_Nodes.Tree_Read;
Paren_Counts.Tree_Read;
end Tree_Read;
begin
Tree_Write_Int (Node_Count);
Nodes.Tree_Write;
+ Flags.Tree_Write;
Orig_Nodes.Tree_Write;
Paren_Counts.Tree_Write;
end Tree_Write;
return From_Union (Nodes.Table (N + 3).Field8);
end Ureal21;
+ function Flag0 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Flags.Table (N).Flag0;
+ end Flag0;
+
+ function Flag1 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Flags.Table (N).Flag1;
+ end Flag1;
+
+ function Flag2 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Flags.Table (N).Flag2;
+ end Flag2;
+
+ function Flag3 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Flags.Table (N).Flag3;
+ end Flag3;
+
function Flag4 (N : Node_Id) return Boolean is
begin
pragma Assert (N <= Nodes.Last);
Nodes.Table (N + 3).Field8 := To_Union (Val);
end Set_Ureal21;
+ procedure Set_Flag0 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Flags.Table (N).Flag0 := Val;
+ end Set_Flag0;
+
+ procedure Set_Flag1 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Flags.Table (N).Flag1 := Val;
+ end Set_Flag1;
+
+ procedure Set_Flag2 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Flags.Table (N).Flag2 := Val;
+ end Set_Flag2;
+
+ procedure Set_Flag3 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Flags.Table (N).Flag3 := Val;
+ end Set_Flag3;
+
procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (N <= Nodes.Last);
procedure Unlock is
begin
Nodes.Locked := False;
+ Flags.Locked := False;
Orig_Nodes.Locked := False;
end Unlock;
-- it is useful to be able to do untyped traversals, and an internal
-- package in Atree allows for direct untyped accesses in such cases.
- -- Flag4 Fifteen Boolean flags (use depends on Nkind and
- -- Flag5 Ekind, as described for FieldN). Again the access
- -- Flag6 is usually via subprograms in Sinfo and Einfo which
- -- Flag7 provide high-level synonyms for these flags, and
- -- Flag8 contain debugging code that checks that the values
- -- Flag9 in Nkind and Ekind are appropriate for the access.
+ -- Flag0 Nineteen Boolean flags (use depends on Nkind and
+ -- Flag1 Ekind, as described for FieldN). Again the access
+ -- Flag2 is usually via subprograms in Sinfo and Einfo which
+ -- Flag3 provide high-level synonyms for these flags, and
+ -- Flag4 contain debugging code that checks that the values
+ -- Flag5 in Nkind and Ekind are appropriate for the access.
+ -- Flag6
+ -- Flag7
+ -- Flag8
+ -- Flag9
-- Flag10
- -- Flag11 Note that Flag1-3 are missing from this list. For
- -- Flag12 historical reasons, these flag names are unused.
- -- Flag13
+ -- Flag11 Note that Flag0-3 are stored separately in the Flags
+ -- Flag12 table, but that's a detail of the implementation which
+ -- Flag13 is entirely hidden by the funcitonal interface.
-- Flag14
-- Flag15
-- Flag16
function Nodes_Address return System.Address;
-- Return address of Nodes table (used in Back_End for Gigi call)
+ function Flags_Address return System.Address;
+ -- Return address of Flags table (used in Back_End for Gigi call)
+
function Num_Nodes return Nat;
-- Total number of nodes allocated, where an entity counts as a single
-- node. This count is incremented every time a node or entity is
-------------------------------------
-- A subpackage Atree.Unchecked_Access provides routines for reading and
- -- writing the fields defined above (Field1-35, Node1-35, Flag4-317 etc).
+ -- writing the fields defined above (Field1-35, Node1-35, Flag0-317 etc).
-- These unchecked access routines can be used for untyped traversals.
-- In addition they are used in the implementations of the Sinfo and
-- Einfo packages. These packages both provide logical synonyms for
function Ureal21 (N : Node_Id) return Ureal;
pragma Inline (Ureal21);
+ function Flag0 (N : Node_Id) return Boolean;
+ pragma Inline (Flag0);
+
+ function Flag1 (N : Node_Id) return Boolean;
+ pragma Inline (Flag1);
+
+ function Flag2 (N : Node_Id) return Boolean;
+ pragma Inline (Flag2);
+
+ function Flag3 (N : Node_Id) return Boolean;
+ pragma Inline (Flag3);
+
function Flag4 (N : Node_Id) return Boolean;
pragma Inline (Flag4);
procedure Set_Ureal21 (N : Node_Id; Val : Ureal);
pragma Inline (Set_Ureal21);
+ procedure Set_Flag0 (N : Node_Id; Val : Boolean);
+ pragma Inline (Set_Flag0);
+
+ procedure Set_Flag1 (N : Node_Id; Val : Boolean);
+ pragma Inline (Set_Flag1);
+
+ procedure Set_Flag2 (N : Node_Id; Val : Boolean);
+ pragma Inline (Set_Flag2);
+
+ procedure Set_Flag3 (N : Node_Id; Val : Boolean);
+ pragma Inline (Set_Flag3);
+
procedure Set_Flag4 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag4);
-------------------------
-- The nodes of the tree are stored in a table (i.e. an array). In the
- -- case of extended nodes five consecutive components in the array are
+ -- case of extended nodes six consecutive components in the array are
-- used. There are thus two formats for array components. One is used
-- for non-extended nodes, and for the first component of extended
-- nodes. The other is used for the extension parts (second, third,
- -- fourth and fifth components) of an extended node. A variant record
- -- structure is used to distinguish the two formats.
+ -- fourth, fifth, and sixth components) of an extended node. A variant
+ -- record structure is used to distinguish the two formats.
type Node_Record (Is_Extension : Boolean := False) is record
Flag16 : Boolean;
Flag17 : Boolean;
Flag18 : Boolean;
- -- The eighteen flags for a normal node
+ -- Flags 4-18 for a normal node. Note that Flags 0-3 are stored
+ -- separately in the Flags array.
-- The above fields are used as follows in components 2-6 of
-- an extended node entry.
Field12 => Empty_List_Or_Node);
-- The following defines the extendable array used for the nodes table
- -- Nodes with extensions use five consecutive entries in the array
+ -- Nodes with extensions use six consecutive entries in the array
package Nodes is new Table.Table (
Table_Component_Type => Node_Record,
Table_Increment => Alloc.Nodes_Increment,
Table_Name => "Nodes");
+ -- The following is a parallel table to Nodes, which provides 8 more
+ -- bits of space that logically belong to the corresponding node. This
+ -- is currently used to implement Flags 0,1,2,3 for normal nodes, or
+ -- the first component of an extended node (four bits unused). Entries
+ -- for extending components are completely unused.
+
+ type Flags_Byte is record
+ Flag0 : Boolean;
+ Flag1 : Boolean;
+ Flag2 : Boolean;
+ Flag3 : Boolean;
+ Spare0 : Boolean;
+ Spare1 : Boolean;
+ Spare2 : Boolean;
+ Spare3 : Boolean;
+ end record;
+
+ for Flags_Byte'Size use 8;
+ pragma Pack (Flags_Byte);
+
+ Default_Flags : constant Flags_Byte := (others => False);
+ -- Default value used to initialize new entries
+
+ package Flags is new Table.Table (
+ Table_Component_Type => Flags_Byte,
+ Table_Index_Type => Node_Id'Base,
+ Table_Low_Bound => First_Node_Id,
+ Table_Initial => Alloc.Nodes_Initial,
+ Table_Increment => Alloc.Nodes_Increment,
+ Table_Name => "Flags");
+
end Atree_Private_Part;
end Atree;
#define Parent atree__parent
extern Node_Id Parent (Node_Id);
+/* The auxiliary flags array which is allocated in parallel to Nodes */
+
+struct Flags
+{
+ Boolean Flag0 : 1;
+ Boolean Flag1 : 1;
+ Boolean Flag2 : 1;
+ Boolean Flag3 : 1;
+ Boolean Spare0 : 1;
+ Boolean Spare1 : 1;
+ Boolean Spare2 : 1;
+ Boolean Spare3 : 1;
+};
+extern struct Flags *Flags_Ptr;
+
/* Overloaded Functions:
These functions are overloaded in the original Ada source, but there is
#define Convention(N) \
(Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention)
+#define Flag0(N) (Flags_Ptr[(N) - First_Node_Id].Flag0)
+#define Flag1(N) (Flags_Ptr[(N) - First_Node_Id].Flag1)
+#define Flag2(N) (Flags_Ptr[(N) - First_Node_Id].Flag2)
+#define Flag3(N) (Flags_Ptr[(N) - First_Node_Id].Flag3)
+
#define Flag4(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag4)
#define Flag5(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5)
#define Flag6(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6)
max_gnat_node : Int;
number_name : Nat;
nodes_ptr : Address;
+ flags_ptr : Address;
next_node_ptr : Address;
prev_node_ptr : Address;
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
number_name => Name_Entries_Count,
nodes_ptr => Nodes_Address,
+ flags_ptr => Flags_Address,
next_node_ptr => Next_Node_Address,
prev_node_ptr => Prev_Node_Address,
/* This is the main program of the back-end. It sets up all the table
structures and then generates code. */
-extern void gigi (Node_Id gnat_root, int max_gnat_node,
+extern void gigi (Node_Id gnat_root,
+ int max_gnat_node,
int number_name ATTRIBUTE_UNUSED,
- struct Node *nodes_ptr, Node_Id *next_node_ptr,
- Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr,
+ struct Node *nodes_ptr,
+ struct Flags *Flags_Ptr,
+ Node_Id *next_node_ptr,
+ Node_Id *prev_node_ptr,
+ struct Elist_Header *elists_ptr,
struct Elmt_Item *elmts_ptr,
struct String_Entry *strings_ptr,
Char_Code *strings_chars_ptr,
/* Pointers to front-end tables accessed through macros. */
struct Node *Nodes_Ptr;
+struct Flags *Flags_Ptr;
Node_Id *Next_Node_Ptr;
Node_Id *Prev_Node_Ptr;
struct Elist_Header *Elists_Ptr;
structures and then generates code. */
void
-gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
- struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
- struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
- struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
- struct List_Header *list_headers_ptr, Nat number_file,
+gigi (Node_Id gnat_root,
+ int max_gnat_node,
+ int number_name ATTRIBUTE_UNUSED,
+ struct Node *nodes_ptr,
+ struct Flags *flags_ptr,
+ Node_Id *next_node_ptr,
+ Node_Id *prev_node_ptr,
+ struct Elist_Header *elists_ptr,
+ struct Elmt_Item *elmts_ptr,
+ struct String_Entry *strings_ptr,
+ Char_Code *string_chars_ptr,
+ struct List_Header *list_headers_ptr,
+ Nat number_file,
struct File_Info_Type *file_info_ptr,
- Entity_Id standard_boolean, Entity_Id standard_integer,
- Entity_Id standard_character, Entity_Id standard_long_long_float,
- Entity_Id standard_exception_type, Int gigi_operating_mode)
+ Entity_Id standard_boolean,
+ Entity_Id standard_integer,
+ Entity_Id standard_character,
+ Entity_Id standard_long_long_float,
+ Entity_Id standard_exception_type,
+ Int gigi_operating_mode)
{
Node_Id gnat_iter;
Entity_Id gnat_literal;
max_gnat_nodes = max_gnat_node;
Nodes_Ptr = nodes_ptr;
+ Flags_Ptr = flags_ptr;
Next_Node_Ptr = next_node_ptr;
Prev_Node_Ptr = prev_node_ptr;
Elists_Ptr = elists_ptr;
-- package, which is necessary semantically but complicates
-- ASIS tree traversal, so we recover the original entity to
-- expose the renaming. Take into account that the context may
- -- be a nested generic and that the original node may itself
- -- have an associated node that had better be an entity.
+ -- be a nested generic, that the original node may itself have
+ -- an associated node that had better be an entity, and that
+ -- the current node is still a selected component.
if Ekind (E) = E_Package
+ and then Nkind (N) = N_Selected_Component
and then Nkind (Parent (N)) = N_Expanded_Name
and then Present (Original_Node (N2))
and then Is_Entity_Name (Original_Node (N2))
-- a list of expressions corresponding to the subprogram formals.
-- A renaming declaration is not a freeze point, and the analysis of
-- the attribute reference should not freeze the type of the prefix.
+ -- We use the original node in the renaming so that its source location
+ -- is preserved, and checks on stream attributes are properly applied.
else
- Attr_Node :=
- Make_Attribute_Reference (Loc,
- Prefix => Prefix (Nam),
- Attribute_Name => Aname,
- Expressions => Expr_List);
+ Attr_Node := Relocate_Node (Nam);
+ Set_Expressions (Attr_Node, Expr_List);
Set_Must_Not_Freeze (Attr_Node);
Set_Must_Not_Freeze (Prefix (Nam));
Find_Type (Result_Definition (Spec));
Rewrite (Result_Definition (Spec),
- New_Reference_To (
- Base_Type (Entity (Result_Definition (Spec))), Loc));
+ New_Reference_To
+ (Base_Type (Entity (Result_Definition (Spec))), Loc));
Body_Node :=
Make_Subprogram_Body (Loc,
Find_Type (P);
end if;
- if Is_Tagged_Type (Etype (P)) then
+ -- If the target type is not yet frozen, add the body to the
+ -- actions to be elaborated at freeze time.
+
+ if Is_Tagged_Type (Etype (P))
+ and then In_Open_Scopes (Scope (Etype (P)))
+ then
Ensure_Freeze_Node (Etype (P));
Append_Freeze_Action (Etype (P), Body_Node);
else
projects / gcc.git / commitdiff