This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Use no-copy types in the Ada compiler


With the 4.x series of compilers a notion of no-copy type has been introduced, 
i.e. a type for which the middle-end is not allowed to create copies.  This is 
conveyed by the TREE_ADDRESSABLE flag on _TYPE nodes and there are assertions 
checking it, especially in the gimplifier.  It is currently unused in Ada.

It turns out that this notion can be mapped quite naturally to a certain class 
of Ada types, in particular limited types.  Looking more closely, the exact 
equivalence is to be made with "by reference" types as defined by the Ada RM.

This patch implements the equivalence.  It uncovered a couple of problems in 
the middle-end:
 - the tree-nested.c pass can create copies of TREE_ADDRESSABLE types because 
of a glitch in walk_gimple_op,
 - the gimplifier sometimes creates useless temporaries out of CONSTRUCTORs 
because of lack of folding.

Bootstrapped/regtested on x86_64-suse-linux, the middle-end changes are 
obvious enough I think, so applied on the mainline.


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.
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.


-- 
Eric Botcazou
Index: gimple.c
===================================================================
--- gimple.c	(revision 158148)
+++ gimple.c	(working copy)
@@ -1308,11 +1308,15 @@ walk_gimple_op (gimple stmt, walk_tree_f
   switch (gimple_code (stmt))
     {
     case GIMPLE_ASSIGN:
-      /* Walk the RHS operands.  A formal temporary LHS may use a
-	 COMPONENT_REF RHS.  */
+      /* Walk the RHS operands.  If the LHS is of a non-renamable type or
+         is a register variable, we may use a COMPONENT_REF on the RHS.  */
       if (wi)
-	wi->val_only = !is_gimple_reg (gimple_assign_lhs (stmt))
-                       || !gimple_assign_single_p (stmt);
+	{
+	  tree lhs = gimple_assign_lhs (stmt);
+	  wi->val_only
+	    = (is_gimple_reg_type (TREE_TYPE (lhs)) && !is_gimple_reg (lhs))
+	      || !gimple_assign_single_p (stmt);
+	}
 
       for (i = 1; i < gimple_num_ops (stmt); i++)
 	{
Index: tree-ssa-ccp.c
===================================================================
--- tree-ssa-ccp.c	(revision 158148)
+++ tree-ssa-ccp.c	(working copy)
@@ -1980,7 +1980,7 @@ maybe_fold_offset_to_component_ref (loca
       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 (loca
 
       /* 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 (loca
 
   /* 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,
Index: ada/gcc-interface/utils.c
===================================================================
--- ada/gcc-interface/utils.c	(revision 158216)
+++ ada/gcc-interface/utils.c	(working copy)
@@ -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: ada/gcc-interface/decl.c
===================================================================
--- ada/gcc-interface/decl.c	(revision 158159)
+++ ada/gcc-interface/decl.c	(working copy)
@@ -138,6 +138,7 @@ static bool same_discriminant_p (Entity_
 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_entit
 	    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_entit
 			      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_entit
 	      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_entit
 	  || 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_rang
 
   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);
+}
 
 /* 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_r
 				     !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,
 		   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, t
   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,
     }
 
   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
 	      }
 
 	    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: ada/gcc-interface/utils2.c
===================================================================
--- ada/gcc-interface/utils2.c	(revision 158202)
+++ ada/gcc-interface/utils2.c	(working copy)
@@ -1293,10 +1293,9 @@ build_cond_expr (tree result_type, tree
 
   /* 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_
       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: ada/gcc-interface/trans.c
===================================================================
--- ada/gcc-interface/trans.c	(revision 158216)
+++ ada/gcc-interface/trans.c	(working copy)
@@ -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
 /* 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
 
 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, tr
 	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, tr
     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, tr
 	 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, tr
      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, tr
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
 			    && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
+      bool address_of_constant = (TREE_CODE (gnu_result) == CONST_DECL
+				  && DECL_CONST_ADDRESS_P (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 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 || !require_lvalue)
+      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 *gn
 	{
 	  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 *gn
 	  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
     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))
-	{
-	  tree new_var = create_tmp_var (TREE_TYPE (op), "C");
-	  TREE_ADDRESSABLE (new_var) = 1;
-
-	  TREE_READONLY (new_var) = 1;
-	  TREE_STATIC (new_var) = 1;
-	  DECL_INITIAL (new_var) = op;
+      if (TREE_CODE (op) == CONSTRUCTOR)
+	{
+	  /* 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_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: ada/gcc-interface/ada-tree.h
===================================================================
--- ada/gcc-interface/ada-tree.h	(revision 158148)
+++ ada/gcc-interface/ada-tree.h	(working copy)
@@ -102,9 +102,6 @@ do {							    \
    front-end.  */
 #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
 
-/* Nonzero for composite types if this is a by-reference type.  */
-#define TYPE_BY_REFERENCE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
-
 /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the
    type for an object whose type includes its template in addition to
    its value (only true for RECORD_TYPE).  */
@@ -325,6 +322,10 @@ do {						   \
    been elaborated and TREE_READONLY is not set on it.  */
 #define DECL_READONLY_ONCE_ELAB(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE))
 
+/* Nonzero in a CONST_DECL if its value is (essentially) the address of a
+   constant CONSTRUCTOR.  */
+#define DECL_CONST_ADDRESS_P(NODE) DECL_LANG_FLAG_0 (CONST_DECL_CHECK (NODE))
+
 /* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
    is needed to access the object.  */
 #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
@@ -369,6 +370,20 @@ do {						   \
 #define SET_DECL_ORIGINAL_FIELD(NODE, X) \
   SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
 
+/* Set DECL_ORIGINAL_FIELD of FIELD1 to (that of) FIELD2.  */
+#define SET_DECL_ORIGINAL_FIELD_TO_FIELD(FIELD1, FIELD2)	\
+  SET_DECL_ORIGINAL_FIELD ((FIELD1),				\
+			   DECL_ORIGINAL_FIELD (FIELD2)		\
+			   ? DECL_ORIGINAL_FIELD (FIELD2) : (FIELD2))
+
+/* Return true if FIELD1 and FIELD2 represent the same field.  */
+#define SAME_FIELD_P(FIELD1, FIELD2)					\
+  ((FIELD1) == (FIELD2)							\
+   || DECL_ORIGINAL_FIELD (FIELD1) == (FIELD2)				\
+   || (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2)				\
+   || (DECL_ORIGINAL_FIELD (FIELD1)					\
+       && (DECL_ORIGINAL_FIELD (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2))))
+
 /* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a
    renaming pointer, otherwise 0.  Note that this object is guaranteed to
    be protected against multiple evaluations.  */
Index: ada/gcc-interface/misc.c
===================================================================
--- ada/gcc-interface/misc.c	(revision 158148)
+++ ada/gcc-interface/misc.c	(working copy)
@@ -700,7 +700,7 @@ must_pass_by_ref (tree gnu_type)
      and does not produce compatibility problems with C, since C does
      not have such objects.  */
   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
-	  || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
+	  || TREE_ADDRESSABLE (gnu_type)
 	  || (TYPE_SIZE (gnu_type)
 	      && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]