OSDN Git Service

* gimple.c (walk_gimple_op) <GIMPLE_ASSIGN>: Do not request a pure
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 13 Apr 2010 07:08:24 +0000 (07:08 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 00:58:51 +0000 (09:58 +0900)
rvalue on the RHS if the LHS is of a non-renamable type.
* tree-ssa-ccp.c (maybe_fold_offset_to_component_ref): Fold result.
ada/
* gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete.
(DECL_CONST_ADDRESS_P): New macro.
(SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise.
(SAME_FIELD_P): Likewise.
* gcc-interface/decl.c (constructor_address_p): New static function.
(gnat_to_gnu_entity) <object>: Set DECL_CONST_ADDRESS_P according to
the return value of above function.
(gnat_to_gnu_entity) <E_Record_Type>: Force BLKmode for all types
passed by reference.
<E_Record_Subtype>: Likewise.
Set TREE_ADDRESSABLE on the type if it passed by reference.
(make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD.
(create_field_decl_from): Likewise.
(substitute_in_type): Likewise.
(purpose_member_field): Use SAME_FIELD_P.
* gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE.
* gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT
parameter and adjust recursive calls.
<N_Explicit_Dereference>: New case.
<N_Object_Declaration>: Return 1 if the object is of a class-wide type.
Adjust calls to lvalue_required_p.  Do not return the initializer of a
DECL_CONST_ADDRESS_P constant if an lvalue is required for it.
(call_to_gnu): Delay issuing error message for a misaligned actual and
avoid the associated back-end assertion.  Test TREE_ADDRESSABLE.
(gnat_gimplify_expr) <ADDR_EXPR>: Handle non-static constructors.
* gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the
type is passed by reference.
(convert) <CONSTRUCTOR>: Convert in-place in more cases.
* gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P.
(build_simple_component_ref): Use SAME_FIELD_P.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158254 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ChangeLog
gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c
gcc/tree-ssa-ccp.c

index 3e197ab..c011b80 100644 (file)
@@ -1,3 +1,9 @@
+2010-04-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gimple.c (walk_gimple_op) <GIMPLE_ASSIGN>: Do not request a pure
+       rvalue on the RHS if the LHS is of a non-renamable type.
+       * tree-ssa-ccp.c (maybe_fold_offset_to_component_ref): Fold result.
+
 2010-04-13  Matthias Klose  <doko@ubuntu.com>
 
        * gcc.c (cc1_options): Handle -iplugindir before processing
index 22a68c4..233c8b9 100644 (file)
@@ -1,3 +1,36 @@
+2010-04-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete.
+       (DECL_CONST_ADDRESS_P): New macro.
+       (SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise.
+       (SAME_FIELD_P): Likewise.
+       * gcc-interface/decl.c (constructor_address_p): New static function.
+       (gnat_to_gnu_entity) <object>: Set DECL_CONST_ADDRESS_P according to
+       the return value of above function.
+       (gnat_to_gnu_entity) <E_Record_Type>: Force BLKmode for all types
+       passed by reference.
+       <E_Record_Subtype>: Likewise.
+       Set TREE_ADDRESSABLE on the type if it passed by reference.
+       (make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD.
+       (create_field_decl_from): Likewise.
+       (substitute_in_type): Likewise.
+       (purpose_member_field): Use SAME_FIELD_P.
+       * gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE.
+       * gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT
+       parameter and adjust recursive calls.
+       <N_Explicit_Dereference>: New case.
+       <N_Object_Declaration>: Return 1 if the object is of a class-wide type.
+       Adjust calls to lvalue_required_p.  Do not return the initializer of a
+       DECL_CONST_ADDRESS_P constant if an lvalue is required for it.
+       (call_to_gnu): Delay issuing error message for a misaligned actual and
+       avoid the associated back-end assertion.  Test TREE_ADDRESSABLE.
+       (gnat_gimplify_expr) <ADDR_EXPR>: Handle non-static constructors.
+       * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the
+       type is passed by reference.
+       (convert) <CONSTRUCTOR>: Convert in-place in more cases.
+       * gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P.
+       (build_simple_component_ref): Use SAME_FIELD_P.
+
 2010-04-12  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable.
index dd76891..a333170 100644 (file)
@@ -138,6 +138,7 @@ static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
 static bool cannot_be_superflat_p (Node_Id);
+static bool constructor_address_p (tree);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
                                  bool, bool, bool, bool, bool);
 static Uint annotate_value (tree);
@@ -1376,6 +1377,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            DECL_IGNORED_P (gnu_decl) = 1;
          }
 
+       /* If this is a constant, even if we don't need a true variable, we
+          may need to avoid returning the initializer in every case.  That
+          can happen for the address of a (constant) constructor because,
+          upon dereferencing it, the constructor will be reinjected in the
+          tree, which may not be valid in every case; see lvalue_required_p
+          for more details.  */
+       if (TREE_CODE (gnu_decl) == CONST_DECL)
+         DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr);
+
        /* If this is declared in a block that contains a block with an
           exception handler, we must force this variable in memory to
           suppress an invalid optimization.  */
@@ -2892,10 +2902,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                              false, all_rep, is_unchecked_union,
                              debug_info_p, false);
 
-       /* If it is a tagged record force the type to BLKmode to insure that
-          these objects will always be put in memory.  Likewise for limited
-          record types.  */
-       if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
+       /* If it is passed by reference, force BLKmode to ensure that objects
++         of this type will always be put in memory.  */
+       if (Is_By_Reference_Type (gnat_entity))
          SET_TYPE_MODE (gnu_type, BLKmode);
 
        /* We used to remove the associations of the discriminants and _Parent
@@ -3216,8 +3225,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              finish_record_type (gnu_type, gnu_field_list, 2, false);
 
              /* See the E_Record_Type case for the rationale.  */
-             if (Is_Tagged_Type (gnat_entity)
-                 || Is_Limited_Record (gnat_entity))
+             if (Is_By_Reference_Type (gnat_entity))
                SET_TYPE_MODE (gnu_type, BLKmode);
              else
                compute_record_mode (gnu_type);
@@ -4388,8 +4396,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          || Is_Class_Wide_Equivalent_Type (gnat_entity))
        TYPE_ALIGN_OK (gnu_type) = 1;
 
-      if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
-       TYPE_BY_REFERENCE_P (gnu_type) = 1;
+      /* If the type is passed by reference, objects of this type must be
+        fully addressable and cannot be copied.  */
+      if (Is_By_Reference_Type (gnat_entity))
+       TREE_ADDRESSABLE (gnu_type) = 1;
 
       /* ??? Don't set the size for a String_Literal since it is either
         confirming or we don't handle it properly (if the low bound is
@@ -5397,6 +5407,20 @@ cannot_be_superflat_p (Node_Id gnat_range)
 
   return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0);
 }
+
+/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR.  */
+
+static bool
+constructor_address_p (tree gnu_expr)
+{
+  while (TREE_CODE (gnu_expr) == NOP_EXPR
+        || TREE_CODE (gnu_expr) == CONVERT_EXPR
+        || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR)
+    gnu_expr = TREE_OPERAND (gnu_expr, 0);
+
+  return (TREE_CODE (gnu_expr) == ADDR_EXPR
+         && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
+}
 \f
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */
@@ -6033,10 +6057,7 @@ make_packable_type (tree type, bool in_record)
                                     !DECL_NONADDRESSABLE_P (old_field));
 
       DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
-      SET_DECL_ORIGINAL_FIELD
-       (new_field, (DECL_ORIGINAL_FIELD (old_field)
-                    ? DECL_ORIGINAL_FIELD (old_field) : old_field));
-
+      SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
       if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
        DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
 
@@ -7253,9 +7274,8 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
                   UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
 }
 
-/* Return first element of field list whose TREE_PURPOSE is ELEM or whose
-   DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM.  Return NULL_TREE if there
-   is no such element in the list.  */
+/* Return first element of field list whose TREE_PURPOSE is the same as ELEM.
+   Return NULL_TREE if there is no such element in the list.  */
 
 static tree
 purpose_member_field (const_tree elem, tree list)
@@ -7263,7 +7283,7 @@ purpose_member_field (const_tree elem, tree list)
   while (list)
     {
       tree field = TREE_PURPOSE (list);
-      if (elem == field || elem == DECL_ORIGINAL_FIELD (field))
+      if (SAME_FIELD_P (field, elem))
        return list;
       list = TREE_CHAIN (list);
     }
@@ -8035,8 +8055,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type,
     }
 
   DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
-  t = DECL_ORIGINAL_FIELD (old_field);
-  SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field);
+  SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
   DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field);
   TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field);
 
@@ -8372,9 +8391,7 @@ substitute_in_type (tree t, tree f, tree r)
              }
 
            DECL_CONTEXT (new_field) = nt;
-           SET_DECL_ORIGINAL_FIELD (new_field,
-                                    (DECL_ORIGINAL_FIELD (field)
-                                     ? DECL_ORIGINAL_FIELD (field) : field));
+           SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field);
 
            TREE_CHAIN (new_field) = TYPE_FIELDS (nt);
            TYPE_FIELDS (nt) = new_field;
index 42e07b5..97ac2f3 100644 (file)
@@ -215,7 +215,7 @@ static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
 static void set_expr_location_from_node (tree, Node_Id);
-static int lvalue_required_p (Node_Id, tree, bool, bool);
+static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
 
 /* Hooks for debug info back-ends, only supported and used in a restricted set
    of configurations.  */
@@ -703,8 +703,9 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
 /* Return a positive value if an lvalue is required for GNAT_NODE.  GNU_TYPE
    is the type that will be used for GNAT_NODE in the translated GNU tree.
    CONSTANT indicates whether the underlying object represented by GNAT_NODE
-   is constant in the Ada sense, ALIASED whether it is aliased (but the latter
-   doesn't affect the outcome if CONSTANT is not true).
+   is constant in the Ada sense.  If it is, ADDRESS_OF_CONSTANT indicates
+   whether its value is the address of a constant and ALIASED whether it is
+   aliased.  If it isn't, ADDRESS_OF_CONSTANT and ALIASED are ignored.
 
    The function climbs up the GNAT tree starting from the node and returns 1
    upon encountering a node that effectively requires an lvalue downstream.
@@ -713,7 +714,7 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
 
 static int
 lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
-                  bool aliased)
+                  bool address_of_constant, bool aliased)
 {
   Node_Id gnat_parent = Parent (gnat_node), gnat_temp;
 
@@ -753,11 +754,13 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
        return 0;
 
       aliased |= Has_Aliased_Components (Etype (gnat_node));
-      return lvalue_required_p (gnat_parent, gnu_type, constant, aliased);
+      return lvalue_required_p (gnat_parent, gnu_type, constant,
+                               address_of_constant, aliased);
 
     case N_Selected_Component:
       aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent)));
-      return lvalue_required_p (gnat_parent, gnu_type, constant, aliased);
+      return lvalue_required_p (gnat_parent, gnu_type, constant,
+                               address_of_constant, aliased);
 
     case N_Object_Renaming_Declaration:
       /* We need to make a real renaming only if the constant object is
@@ -775,8 +778,14 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
     case N_Object_Declaration:
       /* We cannot use a constructor if this is an atomic object because
         the actual assignment might end up being done component-wise.  */
-      return Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
-            && Is_Atomic (Defining_Entity (gnat_parent));
+      return ((Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
+              && Is_Atomic (Defining_Entity (gnat_parent)))
+             /* We don't use a constructor if this is a class-wide object
+                because the effective type of the object is the equivalent
+                type of the class-wide subtype and it smashes most of the
+                data into an array of bytes to which we cannot convert.  */
+             || Ekind ((Etype (Defining_Entity (gnat_parent))))
+                == E_Class_Wide_Subtype);
 
     case N_Assignment_Statement:
       /* We cannot use a constructor if the LHS is an atomic object because
@@ -790,7 +799,17 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
         go through the conversion.  */
       return lvalue_required_p (gnat_parent,
                                get_unpadded_type (Etype (gnat_parent)),
-                               constant, aliased);
+                               constant, address_of_constant, aliased);
+
+   case N_Explicit_Dereference:
+      /* We look through dereferences for address of constant because we need
+        to handle the special cases listed above.  */
+      if (constant && address_of_constant)
+       return lvalue_required_p (gnat_parent,
+                                 get_unpadded_type (Etype (gnat_parent)),
+                                 true, false, true);
+
+      /* ... fall through ... */
 
     default:
       return 0;
@@ -895,12 +914,13 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      statement alternative or a record discriminant.  There is no possible
      volatile-ness short-circuit here since Volatile constants must bei
      imported per C.6.  */
-  if (Ekind (gnat_temp) == E_Constant && Is_Scalar_Type (gnat_temp_type)
+  if (Ekind (gnat_temp) == E_Constant
+      && Is_Scalar_Type (gnat_temp_type)
       && !Is_Imported (gnat_temp)
       && Present (Address_Clause (gnat_temp)))
     {
       require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true,
-                                         Is_Aliased (gnat_temp));
+                                         false, Is_Aliased (gnat_temp));
       use_constant_initializer = !require_lvalue;
     }
 
@@ -999,15 +1019,18 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
                            && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
-
-      /* If there is a (corresponding) variable, we only want to return
-        the constant value if an lvalue is not required.  Evaluate this
-        now if we have not already done so.  */
-      if (!constant_only && require_lvalue < 0)
-       require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true,
-                                           Is_Aliased (gnat_temp));
-
-      if (constant_only || !require_lvalue)
+      bool address_of_constant = (TREE_CODE (gnu_result) == CONST_DECL
+                                 && DECL_CONST_ADDRESS_P (gnu_result));
+
+      /* If there is a (corresponding) variable or this is the address of a
+        constant, we only want to return the initializer if an lvalue isn't
+        required.  Evaluate this now if we have not already done so.  */
+      if ((!constant_only || address_of_constant) && require_lvalue < 0)
+       require_lvalue
+         = lvalue_required_p (gnat_node, gnu_result_type, true,
+                              address_of_constant, Is_Aliased (gnat_temp));
+
+      if ((constant_only && !address_of_constant) || !require_lvalue)
        gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
@@ -2538,29 +2561,6 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
        {
          tree gnu_copy = gnu_name;
 
-         /* If the type is passed by reference, a copy is not allowed.  */
-         if (AGGREGATE_TYPE_P (gnu_formal_type)
-             && TYPE_BY_REFERENCE_P (gnu_formal_type))
-           post_error
-             ("misaligned actual cannot be passed by reference", gnat_actual);
-
-         /* For users of Starlet we issue a warning because the interface
-            apparently assumes that by-ref parameters outlive the procedure
-            invocation.  The code still will not work as intended, but we
-            cannot do much better since low-level parts of the back-end
-            would allocate temporaries at will because of the misalignment
-            if we did not do so here.  */
-         else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
-           {
-             post_error
-               ("?possible violation of implicit assumption", gnat_actual);
-             post_error_ne
-               ("?made by pragma Import_Valued_Procedure on &", gnat_actual,
-                Entity (Name (gnat_node)));
-             post_error_ne ("?because of misalignment of &", gnat_actual,
-                            gnat_formal);
-           }
-
          /* If the actual type of the object is already the nominal type,
             we have nothing to do, except if the size is self-referential
             in which case we'll remove the unpadding below.  */
@@ -2593,6 +2593,33 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
          TREE_SIDE_EFFECTS (gnu_name) = 1;
 
+         /* If the type is passed by reference, a copy is not allowed.  */
+         if (TREE_ADDRESSABLE (gnu_formal_type))
+           {
+             post_error ("misaligned actual cannot be passed by reference",
+                         gnat_actual);
+
+             /* Avoid the back-end assertion on temporary creation.  */
+             gnu_name = TREE_OPERAND (gnu_name, 0);
+           }
+
+         /* For users of Starlet we issue a warning because the interface
+            apparently assumes that by-ref parameters outlive the procedure
+            invocation.  The code still will not work as intended, but we
+            cannot do much better since low-level parts of the back-end
+            would allocate temporaries at will because of the misalignment
+            if we did not do so here.  */
+         else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+           {
+             post_error
+               ("?possible violation of implicit assumption", gnat_actual);
+             post_error_ne
+               ("?made by pragma Import_Valued_Procedure on &", gnat_actual,
+                Entity (Name (gnat_node)));
+             post_error_ne ("?because of misalignment of &", gnat_actual,
+                            gnat_formal);
+           }
+
          /* Set up to move the copy back to the original if needed.  */
          if (Ekind (gnat_formal) != E_In_Parameter)
            {
@@ -5770,21 +5797,41 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
     case ADDR_EXPR:
       op = TREE_OPERAND (expr, 0);
 
-      /* If we are taking the address of a constant CONSTRUCTOR, force it to
-        be put into static memory.  We know it's going to be readonly given
-        the semantics we have and it's required to be in static memory when
-        the reference is in an elaboration procedure.  */
-      if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
+      if (TREE_CODE (op) == CONSTRUCTOR)
        {
-         tree new_var = create_tmp_var (TREE_TYPE (op), "C");
-         TREE_ADDRESSABLE (new_var) = 1;
+         /* If we are taking the address of a constant CONSTRUCTOR, make sure
+            it is put into static memory.  We know it's going to be read-only
+            given the semantics we have and it must be in static memory when
+            the reference is in an elaboration procedure.  */
+         if (TREE_CONSTANT (op))
+           {
+             tree new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
+             TREE_ADDRESSABLE (new_var) = 1;
+             gimple_add_tmp_var (new_var);
 
-         TREE_READONLY (new_var) = 1;
-         TREE_STATIC (new_var) = 1;
-         DECL_INITIAL (new_var) = op;
+             TREE_READONLY (new_var) = 1;
+             TREE_STATIC (new_var) = 1;
+             DECL_INITIAL (new_var) = op;
+
+             TREE_OPERAND (expr, 0) = new_var;
+             recompute_tree_invariant_for_addr_expr (expr);
+           }
+
+         /* Otherwise explicitly create the local temporary.  That's required
+            if the type is passed by reference.  */
+         else
+           {
+             tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
+             TREE_ADDRESSABLE (new_var) = 1;
+             gimple_add_tmp_var (new_var);
+
+             mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
+             gimplify_and_add (mod, pre_p);
+
+             TREE_OPERAND (expr, 0) = new_var;
+             recompute_tree_invariant_for_addr_expr (expr);
+           }
 
-         TREE_OPERAND (expr, 0) = new_var;
-         recompute_tree_invariant_for_addr_expr (expr);
          return GS_ALL_DONE;
        }
 
index cf0ff60..7353bdc 100644 (file)
@@ -294,8 +294,8 @@ make_dummy_type (Entity_Id gnat_type)
   TYPE_DUMMY_P (gnu_type) = 1;
   TYPE_STUB_DECL (gnu_type)
     = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
-  if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_type))
-    TYPE_BY_REFERENCE_P (gnu_type) = 1;
+  if (Is_By_Reference_Type (gnat_type))
+    TREE_ADDRESSABLE (gnu_type) = 1;
 
   SET_DUMMY_NODE (gnat_underlying, gnu_type);
 
@@ -3852,11 +3852,14 @@ convert (tree type, tree expr)
          return expr;
        }
 
-      /* Likewise for a conversion between original and packable version, but
-        we have to work harder in order to preserve type consistency.  */
+      /* Likewise for a conversion between original and packable version, or
+        conversion between types of the same size and with the same list of
+        fields, but we have to work harder to preserve type consistency.  */
       if (code == ecode
          && code == RECORD_TYPE
-         && TYPE_NAME (type) == TYPE_NAME (etype))
+         && (TYPE_NAME (type) == TYPE_NAME (etype)
+             || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype))))
+
        {
          VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
          unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
@@ -3871,10 +3874,14 @@ convert (tree type, tree expr)
 
          FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
            {
-             constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
-             /* We expect only simple constructors.  Otherwise, punt.  */
-             if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield)))
+             constructor_elt *elt;
+             /* We expect only simple constructors.  */
+             if (!SAME_FIELD_P (index, efield))
+               break;
+             /* The field must be the same.  */
+             if (!SAME_FIELD_P (efield, field))
                break;
+             elt = VEC_quick_push (constructor_elt, v, NULL);
              elt->index = field;
              elt->value = convert (TREE_TYPE (field), value);
 
index 7d78c25..dbe83ed 100644 (file)
@@ -1293,10 +1293,9 @@ build_cond_expr (tree result_type, tree condition_operand,
 
   /* If the result type is unconstrained, take the address of the operands and
      then dereference the result.  Likewise if the result type is passed by
-     reference because creating a temporary of this type is not allowed.  */
+     reference, but this is natively handled in the gimplifier.  */
   if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
-      || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type))
-      || (AGGREGATE_TYPE_P (result_type) && TYPE_BY_REFERENCE_P (result_type)))
+      || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
     {
       result_type = build_pointer_type (result_type);
       true_operand = build_unary_op (ADDR_EXPR, result_type, true_operand);
@@ -1588,22 +1587,15 @@ build_simple_component_ref (tree record_variable, tree component,
       tree new_field;
 
       /* First loop thru normal components.  */
-
       for (new_field = TYPE_FIELDS (record_type); new_field;
           new_field = TREE_CHAIN (new_field))
-       if (field == new_field
-           || DECL_ORIGINAL_FIELD (new_field) == field
-           || new_field == DECL_ORIGINAL_FIELD (field)
-           || (DECL_ORIGINAL_FIELD (field)
-               && (DECL_ORIGINAL_FIELD (field)
-                   == DECL_ORIGINAL_FIELD (new_field))))
+       if (SAME_FIELD_P (field, new_field))
          break;
 
       /* Next, loop thru DECL_INTERNAL_P components if we haven't found
          the component in the first search. Doing this search in 2 steps
          is required to avoiding hidden homonymous fields in the
          _Parent field.  */
-
       if (!new_field)
        for (new_field = TYPE_FIELDS (record_type); new_field;
             new_field = TREE_CHAIN (new_field))
index f0106eb..e614949 100644 (file)
@@ -1980,7 +1980,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type,
       if (cmp == 0
          && useless_type_conversion_p (orig_type, field_type))
        {
-         t = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
+         t = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
          return t;
        }
 
@@ -2004,7 +2004,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type,
 
       /* If we matched, then set offset to the displacement into
         this field.  */
-      new_base = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
+      new_base = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
       SET_EXPR_LOCATION (new_base, loc);
 
       /* Recurse to possibly find the match.  */
@@ -2027,7 +2027,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type,
 
   /* If we get here, we've got an aggregate field, and a possibly
      nonzero offset into them.  Recurse and hope for a valid match.  */
-  base = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
+  base = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE);
   SET_EXPR_LOCATION (base, loc);
 
   t = maybe_fold_offset_to_array_ref (loc, base, offset, orig_type,