re PR ada/19037 (constant renaming creates new constant)

2007-08-14  Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* targtyps.c (get_target_maximum_default_alignment): New function.
	Maximum alignment
	that the compiler might choose by default for a type or object.
	(get_target_default_allocator_alignment): New function. Alignment known
	to be honored by the target default allocator.
	(get_target_maximum_allowed_alignment): New function. Maximum alignment
	we might accept for any type or object on the target.
	(get_target_maximum_alignment): Now synonym of maximum_default_alignment

	* gigi.h (get_target_maximum_default_alignment): Declare new function.
	(get_target_default_allocator_alignment): Likewise.
	(get_target_maximum_allowed_alignment): Likewise.

	PR ada/19037
	* decl.c (gnat_to_gnu_entity) <object>: Except for the renaming of the
	result of a function call, first try to use a stabilized reference for
	a constant renaming too.
	(validate_alignment): Use target_maximum_allowed_alignment instead of
	MAX_OFILE_ALIGNMENT as the upper bound to what we accept.
	(gnat_to_gnu_entity): Use common nodes directly.
	(gnat_to_gnu_entity) <object>: Pick the values of the type to annotate
	alignment and size for the object.
	(lvalue_required_p): Handle N_Parameter_Association like N_Function_Call
	and N_Procedure_Call_Statement.
	(takes_address): Rename to lvalue_required_p, add third parameter
	'aliased' and adjust recursive calls.
	<N_Indexed_Component>: Update 'aliased' from the array type.
	<N_Selected_Component>: New case.
	<N_Object_Renaming_Declaration>: New Likewise.
	(Identifier_to_gnu): Adjust for above changes.
	(maybe_stabilize_reference) <CONST_DECL>: New case.

	* utils2.c (build_binary_op) <ARRAY_RANGE_REF>: Look through conversion
	between type variants.
	(build_simple_component_ref): Likewise.
	(build_call_alloc_dealloc): Use target_default_allocator_alignment
	instead of BIGGEST_ALIGNMENT as the threshold to trigger the super
	aligning type circuitry for allocations from the default storage pool.
	(build_allocator): Likewise.
	(build_simple_component_ref): Manually fold the reference for a
	constructor if the record type contains a template.

	* utils.c (value_zerop): Delete.
	(gnat_init_decl_processing): Emit debug info for common types.
	(rest_of_record_type_compilation): If a union contains a field
	with a non-constant qualifier, treat it as variable-sized.
	(finish_record_type): Give the stub TYPE_DECL a name.
	(rest_of_record_type_compilation): Likewise.
	(convert) <CONSTRUCTOR>: New case.  Build a new constructor if
	types are equivalent array types.
	(create_field_decl): Claim fields of any ARRAY_TYPE are addressable,
	even if the type is not passed by reference.
	(static_ctors, static_dtors): Delete.
	(end_subprog_body): Do not record constructors and destructors.
	(build_global_cdtor): Delete.
	(gnat_write_global_declarations): Do not call build_global_cdtor.

	* lang-specs.h: If TARGET_VXWORKS_RTP is defined, append -mrtp when
	-fRTS=rtp is specified.
	If CONFIG_DUAL_EXCEPTIONS is 1, append -fsjlj when -fRTS=sjlj is
	specified.

	* misc.c (gnat_init_gcc_eh): Use __gnat_eh_personality_sj for the name
	of the personality function with SJLJ exceptions.

        * raise-gcc.c (PERSONALITY_FUNCTION): Use __gnat_eh_personality_sj for
	the name of the personality function with SJLJ exceptions.

From-SVN: r127422

1 files changed, 62 insertions, 20 deletions

diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c
index 9134f03..dd5a29e 100644
--- a/gcc/ada/utils2.c
+++ b/gcc/ada/utils2.c
@@ -758,8 +758,17 @@ build_binary_op (enum tree_code op_code, tree result_type,
       /* ... fall through ... */
 
     case ARRAY_RANGE_REF:
+      /* First look through conversion between type variants.  Note that
+	 this changes neither the operation type nor the type domain.  */
+      if (TREE_CODE (left_operand) == VIEW_CONVERT_EXPR
+	  && TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (left_operand, 0)))
+	     == TYPE_MAIN_VARIANT (left_type))
+	{
+	  left_operand = TREE_OPERAND (left_operand, 0);
+	  left_type = TREE_TYPE (left_operand);
+	}
 
-      /* First convert the right operand to its base type.  This will
+      /* Then convert the right operand to its base type.  This will
 	 prevent unneeded signedness conversions when sizetype is wider than
 	 integer.  */
       right_operand = convert (right_base_type, right_operand);
@@ -1632,7 +1641,7 @@ build_simple_component_ref (tree record_variable, tree component,
                             tree field, bool no_fold_p)
 {
   tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable));
-  tree ref;
+  tree ref, inner_variable;
 
   gcc_assert ((TREE_CODE (record_type) == RECORD_TYPE
 	       || TREE_CODE (record_type) == UNION_TYPE
@@ -1704,9 +1713,16 @@ build_simple_component_ref (tree record_variable, tree component,
       && TREE_OVERFLOW (DECL_FIELD_OFFSET (field)))
     return NULL_TREE;
 
-  /* It would be nice to call "fold" here, but that can lose a type
-     we need to tag a PLACEHOLDER_EXPR with, so we can't do it.  */
-  ref = build3 (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
+  /* Look through conversion between type variants.  Note that this
+     is transparent as far as the field is concerned.  */
+  if (TREE_CODE (record_variable) == VIEW_CONVERT_EXPR
+      && TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (record_variable, 0)))
+	 == record_type)
+    inner_variable = TREE_OPERAND (record_variable, 0);
+  else
+    inner_variable = record_variable;
+
+  ref = build3 (COMPONENT_REF, TREE_TYPE (field), inner_variable, field,
 		NULL_TREE);
 
   if (TREE_READONLY (record_variable) || TREE_READONLY (field))
@@ -1715,7 +1731,25 @@ build_simple_component_ref (tree record_variable, tree component,
       || TYPE_VOLATILE (record_type))
     TREE_THIS_VOLATILE (ref) = 1;
 
-  return no_fold_p ? ref : fold (ref);
+  if (no_fold_p)
+    return ref;
+
+  /* The generic folder may punt in this case because the inner array type
+     can be self-referential, but folding is in fact not problematic.  */
+  else if (TREE_CODE (record_variable) == CONSTRUCTOR
+	   && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (record_variable)))
+    {
+      VEC(constructor_elt,gc) *elts = CONSTRUCTOR_ELTS (record_variable);
+      unsigned HOST_WIDE_INT idx;
+      tree index, value;
+      FOR_EACH_CONSTRUCTOR_ELT (elts, idx, index, value)
+	if (index == field)
+	  return value;
+      return ref;
+    }
+
+  else
+    return fold (ref);
 }
 
 /* Like build_simple_component_ref, except that we give an error if the
@@ -1822,12 +1856,17 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
 
   else if (gnu_obj)
     {
-      /* If the required alignement was greater than what malloc guarantees,
-	 what we have in gnu_obj here is an address dynamically adjusted to
-	 match the requirement (see build_allocator).  What we need to pass
-	 to free is the initial underlying allocator's return value, which
-	 has been stored just in front of the block we have.  */
-      if (align > BIGGEST_ALIGNMENT)
+      /* If the required alignement was greater than what the default
+	 allocator guarantees, what we have in gnu_obj here is an address
+	 dynamically adjusted to match the requirement (see build_allocator).
+	 What we need to pass to free is the initial underlying allocator's
+	 return value, which has been stored just in front of the block we
+	 have.  */
+
+      unsigned int default_allocator_alignment
+	= get_target_default_allocator_alignment () * BITS_PER_UNIT;
+
+      if (align > default_allocator_alignment)
 	{
 	  /* We set GNU_OBJ
 	     as * (void **)((void *)GNU_OBJ - (void *)sizeof(void *))
@@ -1900,6 +1939,8 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 {
   tree size = TYPE_SIZE_UNIT (type);
   tree result;
+  unsigned int default_allocator_alignment
+    = get_target_default_allocator_alignment () * BITS_PER_UNIT;
 
   /* If the initializer, if present, is a NULL_EXPR, just return a new one.  */
   if (init && TREE_CODE (init) == NULL_EXPR)
@@ -1999,25 +2040,26 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
   if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
     size = ssize_int (-1);
 
-  /* If this is a type whose alignment is larger than what the underlying
-     allocator supports and this is in the default storage pool, make an
-     "aligning" record type with room to store a pointer before the field,
-     allocate an object of that type, store the system's allocator return
-     value just in front of the field and return the field's address.  */
+  /* If this is in the default storage pool and the type alignment is larger
+     than what the default allocator supports, make an "aligning" record type
+     with room to store a pointer before the field, allocate an object of that
+     type, store the system's allocator return value just in front of the
+     field and return the field's address.  */
 
-  if (TYPE_ALIGN (type) > BIGGEST_ALIGNMENT && No (gnat_proc))
+  if (No (gnat_proc) && TYPE_ALIGN (type) > default_allocator_alignment)
     {
       /* Construct the aligning type with enough room for a pointer ahead
 	 of the field, then allocate.  */
       tree record_type
 	= make_aligning_type (type, TYPE_ALIGN (type), size,
-			      BIGGEST_ALIGNMENT, POINTER_SIZE / BITS_PER_UNIT);
+			      default_allocator_alignment,
+			      POINTER_SIZE / BITS_PER_UNIT);
 
       tree record, record_addr;
 
       record_addr
 	= build_call_alloc_dealloc (NULL_TREE, TYPE_SIZE_UNIT (record_type),
-				    BIGGEST_ALIGNMENT, Empty, Empty,
+				    default_allocator_alignment, Empty, Empty,
 				    gnat_node);
 
       record_addr