[multiple changes]

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

From-SVN: r206870

gcc/ada/ChangeLog

+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

gcc/ada/atree.adb

@@ -568,14 +568,17 @@ package body Atree is
         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;
@@ -596,10 +599,12 @@ package body Atree is
          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;
@@ -680,6 +685,8 @@ package body Atree is
       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;
@@ -718,6 +725,8 @@ package body Atree is
       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.
 
@@ -725,7 +734,8 @@ package body Atree is
          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));
@@ -1094,6 +1104,7 @@ package body Atree is
 
    procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is
       Temp_Ent : Node_Record;
+      Temp_Flg : Flags_Byte;
 
    begin
       pragma Assert (Has_Extension (E1)
@@ -1127,6 +1138,13 @@ package body Atree is
       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
@@ -1231,6 +1249,15 @@ package body Atree is
       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 --
    -----------------------------------
@@ -1270,6 +1297,7 @@ package body Atree is
    begin
       Node_Count := 0;
       Atree_Private_Part.Nodes.Init;
+      Atree_Private_Part.Flags.Init;
       Orig_Nodes.Init;
       Paren_Counts.Init;
 
@@ -1320,8 +1348,10 @@ package body Atree is
    procedure Lock is
    begin
       Nodes.Locked := True;
+      Flags.Locked := True;
       Orig_Nodes.Locked := True;
       Nodes.Release;
+      Flags.Release;
       Orig_Nodes.Release;
    end Lock;
 
@@ -2157,6 +2187,7 @@ package body Atree is
    begin
       Tree_Read_Int (Node_Count);
       Nodes.Tree_Read;
+      Flags.Tree_Read;
       Orig_Nodes.Tree_Read;
       Paren_Counts.Tree_Read;
    end Tree_Read;
@@ -2169,6 +2200,7 @@ package body Atree is
    begin
       Tree_Write_Int (Node_Count);
       Nodes.Tree_Write;
+      Flags.Tree_Write;
       Orig_Nodes.Tree_Write;
       Paren_Counts.Tree_Write;
    end Tree_Write;
@@ -3006,6 +3038,30 @@ package body Atree is
          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);
@@ -5563,6 +5619,30 @@ package body Atree is
          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);
@@ -7924,6 +8004,7 @@ package body Atree is
    procedure Unlock is
    begin
       Nodes.Locked := False;
+      Flags.Locked := False;
       Orig_Nodes.Locked := False;
    end Unlock;
 

gcc/ada/atree.ads

@@ -168,16 +168,20 @@ package Atree is
    --   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
@@ -220,6 +224,9 @@ package Atree is
    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
@@ -350,7 +357,7 @@ package Atree 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
@@ -1341,6 +1348,18 @@ package Atree is
       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);
 
@@ -2624,6 +2643,18 @@ package Atree is
       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);
 
@@ -3621,12 +3652,12 @@ package Atree is
       -------------------------
 
       --  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
 
@@ -3680,7 +3711,8 @@ package Atree is
          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.
@@ -3888,7 +3920,7 @@ package Atree is
          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,
@@ -3898,6 +3930,37 @@ package Atree is
         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;

gcc/ada/atree.h

@@ -359,6 +359,21 @@ extern struct Node *Nodes_Ptr;
 #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
@@ -531,6 +546,11 @@ extern Node_Id Current_Error_Node;
 #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)

gcc/ada/back_end.adb

@@ -87,6 +87,7 @@ package body Back_End is
          max_gnat_node                 : Int;
          number_name                   : Nat;
          nodes_ptr                     : Address;
+         flags_ptr                     : Address;
 
          next_node_ptr                 : Address;
          prev_node_ptr                 : Address;
@@ -141,6 +142,7 @@ package body Back_End is
          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,

gcc/ada/gcc-interface/gigi.h

@@ -238,10 +238,14 @@ extern "C" {
 
 /* 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,

gcc/ada/gcc-interface/trans.c

@@ -90,6 +90,7 @@ static location_t block_end_locus_sink;
 
 /* 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;
@@ -273,15 +274,26 @@ static const char *decode_name (const char *) ATTRIBUTE_UNUSED;
    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;
@@ -293,6 +305,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   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;

gcc/ada/sem_ch12.adb

@@ -13060,10 +13060,12 @@ package body Sem_Ch12 is
                --  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))

gcc/ada/sem_ch8.adb

@@ -3437,13 +3437,12 @@ package body Sem_Ch8 is
       --  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));
@@ -3459,8 +3458,8 @@ package body Sem_Ch8 is
 
          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,
@@ -3522,7 +3521,12 @@ package body Sem_Ch8 is
                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