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

gcc/ada/gigi.h

@@ -857,6 +857,9 @@ extern Pos get_target_double_size (void);
 extern Pos get_target_long_double_size (void);
 extern Pos get_target_pointer_size (void);
 extern Pos get_target_maximum_alignment (void);
+extern Pos get_target_default_allocator_alignment (void);
+extern Pos get_target_maximum_default_alignment (void);
+extern Pos get_target_maximum_allowed_alignment (void);
 extern Nat get_float_words_be (void);
 extern Nat get_words_be (void);
 extern Nat get_bytes_be (void);

gcc/ada/lang-specs.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *           Copyright (C) 1992-2004 Free Software Foundation, Inc.         *
+ *           Copyright (C) 1992-2007, Free Software Foundation, Inc.        *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -35,8 +35,14 @@
  %{!S:%{!c:%e-c or -S required for Ada}}\
  gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %{!Q:-quiet} %{nostdinc*}\
     %{nostdlib*}\
-    -dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
-    %{O*} %{W*} %{w} %{p} %{pg:-p} %{a} %{f*} %{d*} %{g*&m*} %1\
+    -dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}} "
+#if defined(TARGET_VXWORKS_RTP)
+   "%{fRTS=rtp:-mrtp} "
+#endif
+#if CONFIG_DUAL_EXCEPTIONS
+   "%{fRTS=sjlj:-fsjlj} "
+#endif
+   "%{O*} %{W*} %{w} %{p} %{pg:-p} %{a} %{f*} %{d*} %{g*&m*} %1\
     %{!S:%{o*:%w%*-gnatO}} \
     %i %{S:%W{o*}%{!o*:-o %b.s}} \
     %{gnatc*|gnats*: -o %j} %{-param*} \

gcc/ada/misc.c

@@ -511,7 +511,9 @@ gnat_init_gcc_eh (void)
      right exception regions.  */
   using_eh_for_cleanups ();
 
-  eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
+  eh_personality_libfunc = init_one_libfunc (USING_SJLJ_EXCEPTIONS
+					     ? "__gnat_eh_personality_sj"
+					     : "__gnat_eh_personality");
   lang_eh_type_covers = gnat_eh_type_covers;
   lang_eh_runtime_type = gnat_eh_runtime_type;
   default_init_unwind_resume_libfunc ();

gcc/ada/raise-gcc.c

@@ -540,7 +540,7 @@ get_region_description_for (_Unwind_Context *uw_context,
                             region_descriptor *region)
 {
   const unsigned char * p;
-  _uleb128_t tmp;
+  _Unwind_Word tmp;
   unsigned char lpbase_encoding;
 
   /* Get the base address of the lsda information. If the provided context
@@ -705,7 +705,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
     }
   else
     {
-      _uleb128_t cs_lp, cs_action;
+      _Unwind_Word cs_lp, cs_action;
 
       /* Let the caller know there may be an action to take, but let it
 	 determine the kind.  */
@@ -765,7 +765,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
   while (p < region->action_table)
     {
       _Unwind_Ptr cs_start, cs_len, cs_lp;
-      _uleb128_t cs_action;
+      _Unwind_Word cs_action;
 
       /* Note that all call-site encodings are "absolute" displacements.  */
       p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
@@ -913,7 +913,7 @@ get_action_description_for (_Unwind_Context *uw_context,
     {
       const unsigned char * p = action->table_entry;
 
-      _sleb128_t ar_filter, ar_disp;
+      _Unwind_Sword ar_filter, ar_disp;
 
       action->kind = nothing;
 
@@ -1004,6 +1004,12 @@ extern void __gnat_notify_unhandled_exception (void);
 /* Below is the eh personality routine per se. We currently assume that only
    GNU-Ada exceptions are met.  */
 
+#ifdef __USING_SJLJ_EXCEPTIONS__
+#define PERSONALITY_FUNCTION    __gnat_eh_personality_sj
+#else
+#define PERSONALITY_FUNCTION    __gnat_eh_personality
+#endif
+
 /* Major tweak for ia64-vms : the CHF propagation phase calls this personality
    routine with sigargs/mechargs arguments and has very specific expectations
    on possible return values.
@@ -1036,11 +1042,11 @@ typedef _Unwind_Action phases_arg_t;
 #endif
 
 _Unwind_Reason_Code
-__gnat_eh_personality (version_arg_t version_arg,
-                       phases_arg_t phases_arg,
-                       _Unwind_Exception_Class uw_exception_class,
-                       _Unwind_Exception *uw_exception,
-                       _Unwind_Context *uw_context)
+PERSONALITY_FUNCTION (version_arg_t version_arg,
+                      phases_arg_t phases_arg,
+                      _Unwind_Exception_Class uw_exception_class,
+                      _Unwind_Exception *uw_exception,
+                      _Unwind_Context *uw_context)
 {
   /* Fetch the version and phases args with their nominal ABI types for later
      use. This is a noop everywhere except on ia64-vms when called from the

gcc/ada/targtyps.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                                  Body                                    *
  *                                                                          *
- *          Copyright (C) 1992-2006, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2007, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -142,12 +142,63 @@ get_target_pointer_size (void)
   return POINTER_SIZE;
 }
 
+/* Alignment related values, mapped to attributes for functional and
+   documentation purposes.  */
+
+/* Standard'Maximum_Default_Alignment.  Maximum alignment that the compiler
+   might choose by default for a type or object.
+
+   Stricter alignment requests trigger gigi's aligning_type circuitry for
+   stack objects or objects allocated by the default allocator.  */
+
 Pos
-get_target_maximum_alignment (void)
+get_target_maximum_default_alignment (void)
 {
   return BIGGEST_ALIGNMENT / BITS_PER_UNIT;
 }
 
+/* Standard'Default_Allocator_Alignment.  Alignment guaranteed to be honored
+   by the default allocator (System.Memory.Alloc or malloc if we have no
+   run-time library at hand).
+
+   Stricter alignment requests trigger gigi's aligning_type circuitry for
+   objects allocated by the default allocator.  */
+
+#ifndef MALLOC_ALIGNMENT
+#define MALLOC_ALIGNMENT BIGGEST_ALIGNMENT
+#endif
+
+Pos
+get_target_default_allocator_alignment (void)
+{
+  /* ??? Need a way to get info about __gnat_malloc from here (whether
+     it is handy and what alignment it honors).  */
+
+  return MALLOC_ALIGNMENT / BITS_PER_UNIT;
+}
+
+/* Standard'Maximum_Allowed_Alignment.  Maximum alignment that we may
+   accept for any type or object.  */
+
+#ifndef MAX_OFILE_ALIGNMENT
+#define MAX_OFILE_ALIGNMENT BIGGEST_ALIGNMENT
+#endif
+
+Pos
+get_target_maximum_allowed_alignment (void)
+{
+  return MAX_OFILE_ALIGNMENT / BITS_PER_UNIT;
+}
+
+/* Standard'Maximum_Alignment.  The single attribute initially made
+   available, now a synonym of Standard'Maximum_Default_Alignment.  */
+
+Pos
+get_target_maximum_alignment (void)
+{
+  return get_target_maximum_default_alignment ();
+}
+
 #ifndef FLOAT_WORDS_BIG_ENDIAN
 #define FLOAT_WORDS_BIG_ENDIAN WORDS_BIG_ENDIAN
 #endif

gcc/ada/utils.c

@@ -156,11 +156,6 @@ static GTY(()) VEC(tree,gc) *builtin_decls;
 /* An array of global renaming pointers.  */
 static GTY(()) VEC(tree,gc) *global_renaming_pointers;
 
-/* Arrays of functions called automatically at the beginning and
-   end of execution, on targets without .ctors/.dtors sections.  */
-static GTY(()) VEC(tree,gc) *static_ctors;
-static GTY(()) VEC(tree,gc) *static_dtors;
-
 /* A chain of unused BLOCK nodes. */
 static GTY((deletable)) tree free_block_chain;
 
@@ -168,7 +163,6 @@ static void gnat_install_builtins (void);
 static tree merge_sizes (tree, tree, tree, bool, bool);
 static tree compute_related_constant (tree, tree);
 static tree split_plus (tree, tree *);
-static bool value_zerop (tree);
 static void gnat_gimplify_function (tree);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
@@ -505,17 +499,14 @@ gnat_init_decl_processing (void)
   build_common_tree_nodes_2 (0);
 
   /* Give names and make TYPE_DECLs for common types.  */
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
-		 Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
-			     integer_type_node),
-		 Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
-			     char_type_node),
-		 Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
-			     long_integer_type_node),
-		 Empty);
+  create_type_decl (get_identifier (SIZE_TYPE), sizetype,
+		    NULL, false, true, Empty);
+  create_type_decl (get_identifier ("integer"), integer_type_node,
+		    NULL, false, true, Empty);
+  create_type_decl (get_identifier ("unsigned char"), char_type_node,
+		    NULL, false, true, Empty);
+  create_type_decl (get_identifier ("long integer"), long_integer_type_node,
+		    NULL, false, true, Empty);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 
@@ -778,7 +769,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
 
   TYPE_FIELDS (record_type) = fieldlist;
   TYPE_STUB_DECL (record_type)
-    = build_decl (TYPE_DECL, NULL_TREE, record_type);
+    = build_decl (TYPE_DECL, TYPE_NAME (record_type), record_type);
 
   /* We don't need both the typedef name and the record name output in
      the debugging information, since they are the same.  */
@@ -947,6 +938,7 @@ rest_of_record_type_compilation (tree record_type)
 {
   tree fieldlist = TYPE_FIELDS (record_type);
   tree field;
+  enum tree_code code = TREE_CODE (record_type);
   bool var_size = false;
 
   for (field = fieldlist; field; field = TREE_CHAIN (field))
@@ -957,7 +949,11 @@ rest_of_record_type_compilation (tree record_type)
 	 same size, in which case we'll use that size.  But the debug
 	 output routines (except Dwarf2) won't be able to output the fields,
 	 so we need to make the special record.  */
-      if (TREE_CODE (DECL_SIZE (field)) != INTEGER_CST)
+      if (TREE_CODE (DECL_SIZE (field)) != INTEGER_CST
+	  /* If a field has a non-constant qualifier, the record will have
+	     variable size too.  */
+	  || (code == QUAL_UNION_TYPE
+	      && TREE_CODE (DECL_QUALIFIER (field)) != INTEGER_CST))
 	{
 	  var_size = true;
 	  break;
@@ -991,7 +987,7 @@ rest_of_record_type_compilation (tree record_type)
       TYPE_NAME (new_record_type) = new_id;
       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
       TYPE_STUB_DECL (new_record_type)
-	= build_decl (TYPE_DECL, NULL_TREE, new_record_type);
+	= build_decl (TYPE_DECL, new_id, new_record_type);
       DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
 	= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
@@ -1483,8 +1479,6 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
   if (TREE_CODE (var_decl) != CONST_DECL)
     rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
   else
-    /* expand CONST_DECLs to set their MODE, ALIGN, SIZE and SIZE_UNIT,
-       which we need for later back-annotations.  */
     expand_decl (var_decl);
 
   return var_decl;
@@ -1631,35 +1625,28 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
       DECL_HAS_REP_P (field_decl) = 1;
     }
 
-  /* If the field type is passed by reference, we will have pointers to the
-     field, so it is addressable. */
-  if (must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
+  /* In addition to what our caller says, claim the field is addressable if we
+     know we might ever attempt to take its address, then mark the decl as
+     nonaddressable accordingly.
+
+     The field may also be "technically" nonaddressable, meaning that even if
+     we attempt to take the field's address we will actually get the address
+     of a copy.  This is the case for true bitfields, but the DECL_BIT_FIELD
+     value we have at this point is not accurate enough, so we don't account
+     for this here and let finish_record_type decide.  */
+
+  /* We will take the address in any argument passing sequence if the field
+     type is passed by reference, and we might need the address for any array
+     type, even if normally passed by-copy, to construct a fat pointer if the
+     field is used as an actual for an unconstrained formal.  */
+  if (TREE_CODE (field_type) == ARRAY_TYPE
+      || must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
     addressable = 1;
 
-  /* Mark the decl as nonaddressable if it is indicated so semantically,
-     meaning we won't ever attempt to take the address of the field.
-
-     It may also be "technically" nonaddressable, meaning that even if we
-     attempt to take the field's address we will actually get the address of a
-     copy. This is the case for true bitfields, but the DECL_BIT_FIELD value
-     we have at this point is not accurate enough, so we don't account for
-     this here and let finish_record_type decide.  */
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
 
   return field_decl;
 }
-
-/* Subroutine of previous function: return nonzero if EXP, ignoring any side
-   effects, has the value of zero.  */
-
-static bool
-value_zerop (tree exp)
-{
-  if (TREE_CODE (exp) == COMPOUND_EXPR)
-    return value_zerop (TREE_OPERAND (exp, 1));
-
-  return integer_zerop (exp);
-}
 
 /* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
    PARAM_TYPE is its type.  READONLY is true if the parameter is
@@ -2142,14 +2129,6 @@ end_subprog_body (tree body)
   if (type_annotate_only)
     return;
 
-  /* If we don't have .ctors/.dtors sections, and this is a static
-     constructor or destructor, it must be recorded now.  */
-  if (DECL_STATIC_CONSTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
-    VEC_safe_push (tree, gc, static_ctors, fndecl);
-
-  if (DECL_STATIC_DESTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
-    VEC_safe_push (tree, gc, static_dtors, fndecl);
-
   /* Perform the required pre-gimplfication transformations on the tree.  */
   gnat_genericize (fndecl);
 
@@ -3474,6 +3453,22 @@ convert (tree type, tree expr)
 	}
       break;
 
+    case CONSTRUCTOR:
+      /* If we are converting a CONSTRUCTOR to another constrained array type
+	 with the same domain, just make a new one in the proper type.  */
+      if (code == ecode && code == ARRAY_TYPE
+	  && TREE_TYPE (type) == TREE_TYPE (etype)
+	  && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
+				 TYPE_MIN_VALUE (TYPE_DOMAIN (etype)))
+	  && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
+				 TYPE_MAX_VALUE (TYPE_DOMAIN (etype))))
+	{
+	  expr = copy_node (expr);
+	  TREE_TYPE (expr) = type;
+	  return expr;
+	}
+      break;
+
     case UNCONSTRAINED_ARRAY_REF:
       /* Convert this to the type of the inner array by getting the address of
 	 the array from the template.  */
@@ -4010,41 +4005,11 @@ tree_code_for_record_type (Entity_Id gnat_type)
   return UNION_TYPE;
 }
 
-/* Build a global constructor or destructor function.  METHOD_TYPE gives
-   the type of the function and VEC points to the vector of constructor
-   or destructor functions to be invoked.  FIXME: Migrate into cgraph.  */
-
-static void
-build_global_cdtor (int method_type, tree *vec, int len)
-{
-  tree body = NULL_TREE;
-  int i;
-
-  for (i = 0; i < len; i++)
-    {
-      tree fntype = TREE_TYPE (vec[i]);
-      tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), vec[i]);
-      tree fncall = build_call_nary (TREE_TYPE (fntype), fnaddr, 0);
-      append_to_statement_list (fncall, &body);
-    }
-
-  if (body)
-    cgraph_build_static_cdtor (method_type, body, DEFAULT_INIT_PRIORITY);
-}
-
 /* Perform final processing on global variables.  */
 
 void
 gnat_write_global_declarations (void)
 {
-  /* Generate functions to call static constructors and destructors
-     for targets that do not support .ctors/.dtors sections.  These
-     functions have magic names which are detected by collect2.  */
-  build_global_cdtor ('I', VEC_address (tree, static_ctors),
-			   VEC_length (tree, static_ctors));
-  build_global_cdtor ('D', VEC_address (tree, static_dtors),
-			   VEC_length (tree, static_dtors));
-
   /* Proceed to optimize and emit assembly.
      FIXME: shouldn't be the front end's responsibility to call this.  */
   cgraph_optimize ();

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