OSDN Git Service

* gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / utils.c
index 86575b5..f35e9c7 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
 #include "ada-tree.h"
 #include "gigi.h"
 
-#ifndef MAX_FIXED_MODE_SIZE
-#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
-#endif
-
 #ifndef MAX_BITS_PER_WORD
 #define MAX_BITS_PER_WORD  BITS_PER_WORD
 #endif
@@ -564,19 +560,18 @@ record_builtin_type (const char *name, tree type)
     debug_hooks->type_decl (type_decl, false);
 }
 \f
-/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
+/* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
    finish constructing the record or union type.  If REP_LEVEL is zero, this
    record has no representation clause and so will be entirely laid out here.
    If REP_LEVEL is one, this record has a representation clause and has been
    laid out already; only set the sizes and alignment.  If REP_LEVEL is two,
    this record is derived from a parent record and thus inherits its layout;
-   only make a pass on the fields to finalize them.  If DO_NOT_FINALIZE is
-   true, the record type is expected to be modified afterwards so it will
-   not be sent to the back-end for finalization.  */
+   only make a pass on the fields to finalize them.  DEBUG_INFO_P is true if
+   we need to write debug information about this type.  */
 
 void
-finish_record_type (tree record_type, tree fieldlist, int rep_level,
-                   bool do_not_finalize)
+finish_record_type (tree record_type, tree field_list, int rep_level,
+                   bool debug_info_p)
 {
   enum tree_code code = TREE_CODE (record_type);
   tree name = TYPE_NAME (record_type);
@@ -587,7 +582,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
   bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
-  TYPE_FIELDS (record_type) = fieldlist;
+  TYPE_FIELDS (record_type) = field_list;
 
   /* Always attach the TYPE_STUB_DECL for a record type.  It is required to
      generate debug info and have a parallel type.  */
@@ -600,10 +595,10 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
   if (rep_level > 0)
     {
       TYPE_ALIGN (record_type) = MAX (BITS_PER_UNIT, TYPE_ALIGN (record_type));
-      SET_TYPE_MODE (record_type, BLKmode);
 
       if (!had_size_unit)
        TYPE_SIZE_UNIT (record_type) = size_zero_node;
+
       if (!had_size)
        TYPE_SIZE (record_type) = bitsize_zero_node;
 
@@ -631,9 +626,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
      handled yet, and adjust DECL_NONADDRESSABLE_P accordingly.  */
 
   if (code == QUAL_UNION_TYPE)
-    fieldlist = nreverse (fieldlist);
+    field_list = nreverse (field_list);
 
-  for (field = fieldlist; field; field = TREE_CHAIN (field))
+  for (field = field_list; field; field = TREE_CHAIN (field))
     {
       tree type = TREE_TYPE (field);
       tree pos = bit_position (field);
@@ -737,7 +732,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
     }
 
   if (code == QUAL_UNION_TYPE)
-    nreverse (fieldlist);
+    nreverse (field_list);
 
   if (rep_level < 2)
     {
@@ -768,24 +763,24 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
        }
     }
 
-  if (!do_not_finalize)
+  if (debug_info_p)
     rest_of_record_type_compilation (record_type);
 }
 
-/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all
-   the debug information associated with it.  It need not be invoked
-   directly in most cases since finish_record_type takes care of doing
-   so, unless explicitly requested not to through DO_NOT_FINALIZE.  */
+/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information
+   associated with it.  It need not be invoked directly in most cases since
+   finish_record_type takes care of doing so, but this can be necessary if
+   a parallel type is to be attached to the record type.  */
 
 void
 rest_of_record_type_compilation (tree record_type)
 {
-  tree fieldlist = TYPE_FIELDS (record_type);
+  tree field_list = 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))
+  for (field = field_list; field; field = TREE_CHAIN (field))
     {
       /* We need to make an XVE/XVU record if any field has variable size,
         whether or not the record does.  For example, if we have a union,
@@ -1100,58 +1095,54 @@ split_plus (tree in, tree *pvar)
     return bitsize_zero_node;
 }
 \f
-/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
-   subprogram. If it is void_type_node, then we are dealing with a procedure,
-   otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
-   PARM_DECL nodes that are the subprogram arguments.  CICO_LIST is the
-   copy-in/copy-out list to be stored into TYPE_CICO_LIST.
-   RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
-   object.  RETURNS_BY_REF is true if the function returns by reference.
-   RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
-   first parameter) the address of the place to copy its result.  */
+/* Return a FUNCTION_TYPE node.  RETURN_TYPE is the type returned by the
+   subprogram.  If it is VOID_TYPE, then we are dealing with a procedure,
+   otherwise we are dealing with a function.  PARAM_DECL_LIST is a list of
+   PARM_DECL nodes that are the subprogram parameters.  CICO_LIST is the
+   copy-in/copy-out list to be stored into the TYPE_CICO_LIST field.
+   RETURN_UNCONSTRAINED_P is true if the function returns an unconstrained
+   object.  RETURN_BY_DIRECT_REF_P is true if the function returns by direct
+   reference.  RETURN_BY_INVISI_REF_P is true if the function returns by
+   invisible reference.  */
 
 tree
 create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
-                     bool returns_unconstrained, bool returns_by_ref,
-                     bool returns_by_target_ptr)
+                    bool return_unconstrained_p, bool return_by_direct_ref_p,
+                    bool return_by_invisi_ref_p)
 {
   /* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
-     the subprogram formal parameters. This list is generated by traversing the
-     input list of PARM_DECL nodes.  */
-  tree param_type_list = NULL;
-  tree param_decl;
-  tree type;
+     the subprogram formal parameters.  This list is generated by traversing
+     the input list of PARM_DECL nodes.  */
+  tree param_type_list = NULL_TREE;
+  tree t, type;
 
-  for (param_decl = param_decl_list; param_decl;
-       param_decl = TREE_CHAIN (param_decl))
-    param_type_list = tree_cons (NULL_TREE, TREE_TYPE (param_decl),
-                                param_type_list);
+  for (t = param_decl_list; t; t = TREE_CHAIN (t))
+    param_type_list = tree_cons (NULL_TREE, TREE_TYPE (t), param_type_list);
 
   /* The list of the function parameter types has to be terminated by the void
      type to signal to the back-end that we are not dealing with a variable
-     parameter subprogram, but that the subprogram has a fixed number of
-     parameters.  */
+     parameter subprogram, but that it has a fixed number of parameters.  */
   param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list);
 
-  /* The list of argument types has been created in reverse
-     so nreverse it.   */
+  /* The list of argument types has been created in reverse so reverse it.  */
   param_type_list = nreverse (param_type_list);
 
   type = build_function_type (return_type, param_type_list);
 
-  /* TYPE may have been shared since GCC hashes types.  If it has a CICO_LIST
-     or the new type should, make a copy of TYPE.  Likewise for
-     RETURNS_UNCONSTRAINED and RETURNS_BY_REF.  */
-  if (TYPE_CI_CO_LIST (type) || cico_list
-      || TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained
-      || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref
-      || TYPE_RETURNS_BY_TARGET_PTR_P (type) != returns_by_target_ptr)
-    type = copy_type (type);
+  /* TYPE may have been shared since GCC hashes types.  If it has a different
+     CICO_LIST, make a copy.  Likewise for the various flags.  */
+  if (TYPE_CI_CO_LIST (type) != cico_list
+      || TYPE_RETURN_UNCONSTRAINED_P (type) != return_unconstrained_p
+      || TYPE_RETURN_BY_DIRECT_REF_P (type) != return_by_direct_ref_p
+      || TREE_ADDRESSABLE (type) != return_by_invisi_ref_p)
+    {
+      type = copy_type (type);
+      TYPE_CI_CO_LIST (type) = cico_list;
+      TYPE_RETURN_UNCONSTRAINED_P (type) = return_unconstrained_p;
+      TYPE_RETURN_BY_DIRECT_REF_P (type) = return_by_direct_ref_p;
+      TREE_ADDRESSABLE (type) = return_by_invisi_ref_p;
+    }
 
-  TYPE_CI_CO_LIST (type) = cico_list;
-  TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
-  TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
-  TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
   return type;
 }
 \f
@@ -1162,6 +1153,23 @@ copy_type (tree type)
 {
   tree new_type = copy_node (type);
 
+  /* Unshare the language-specific data.  */
+  if (TYPE_LANG_SPECIFIC (type))
+    {
+      TYPE_LANG_SPECIFIC (new_type) = NULL;
+      SET_TYPE_LANG_SPECIFIC (new_type, GET_TYPE_LANG_SPECIFIC (type));
+    }
+
+  /* And the contents of the language-specific slot if needed.  */
+  if ((INTEGRAL_TYPE_P (type) || TREE_CODE (type) == REAL_TYPE)
+      && TYPE_RM_VALUES (type))
+    {
+      TYPE_RM_VALUES (new_type) = NULL_TREE;
+      SET_TYPE_RM_SIZE (new_type, TYPE_RM_SIZE (type));
+      SET_TYPE_RM_MIN_VALUE (new_type, TYPE_RM_MIN_VALUE (type));
+      SET_TYPE_RM_MAX_VALUE (new_type, TYPE_RM_MAX_VALUE (type));
+    }
+
   /* copy_node clears this field instead of copying it, because it is
      aliased with TREE_CHAIN.  */
   TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type);
@@ -1373,24 +1381,26 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
   /* At the global level, an initializer requiring code to be generated
      produces elaboration statements.  Check that such statements are allowed,
      that is, not violating a No_Elaboration_Code restriction.  */
-  if (global_bindings_p () && var_init != 0 && ! init_const)
+  if (global_bindings_p () && var_init != 0 && !init_const)
     Check_Elaboration_Code_Allowed (gnat_node);
 
+  DECL_INITIAL  (var_decl) = var_init;
+  TREE_READONLY (var_decl) = const_flag;
+  DECL_EXTERNAL (var_decl) = extern_flag;
+  TREE_PUBLIC   (var_decl) = public_flag || extern_flag;
+  TREE_CONSTANT (var_decl) = constant_p;
+  TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
+    = TYPE_VOLATILE (type);
+
   /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
      try to fiddle with DECL_COMMON.  However, on platforms that don't
      support global BSS sections, uninitialized global variables would
      go in DATA instead, thus increasing the size of the executable.  */
   if (!flag_no_common
       && TREE_CODE (var_decl) == VAR_DECL
+      && TREE_PUBLIC (var_decl)
       && !have_global_bss_p ())
     DECL_COMMON (var_decl) = 1;
-  DECL_INITIAL  (var_decl) = var_init;
-  TREE_READONLY (var_decl) = const_flag;
-  DECL_EXTERNAL (var_decl) = extern_flag;
-  TREE_PUBLIC   (var_decl) = public_flag || extern_flag;
-  TREE_CONSTANT (var_decl) = constant_p;
-  TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
-    = TYPE_VOLATILE (type);
 
   /* If it's public and not external, always allocate storage for it.
      At the global binding level we need to allocate static storage for the
@@ -1408,10 +1418,12 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
           != null_pointer_node)
     DECL_IGNORED_P (var_decl) = 1;
 
-  if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
-    SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
-
-  process_attributes (var_decl, attr_list);
+  if (TREE_CODE (var_decl) == VAR_DECL)
+    {
+      if (asm_name)
+       SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+      process_attributes (var_decl, attr_list);
+    }
 
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (var_decl, gnat_node);
@@ -1457,13 +1469,13 @@ aggregate_type_contains_array_p (tree type)
     }
 }
 
-/* Return a FIELD_DECL node.  FIELD_NAME the field name, FIELD_TYPE is its
-   type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
-   this field is in a record type with a "pragma pack".  If SIZE is nonzero
-   it is the specified size for this field.  If POS is nonzero, it is the bit
-   position.  If ADDRESSABLE is nonzero, it means we are allowed to take
-   the address of this field for aliasing purposes. If it is negative, we
-   should not make a bitfield, which is used by make_aligning_type.   */
+/* Return a FIELD_DECL node.  FIELD_NAME is the field's name, FIELD_TYPE is
+   its type and RECORD_TYPE is the type of the enclosing record.  PACKED is
+   1 if the enclosing record is packed, -1 if it has Component_Alignment of
+   Storage_Unit.  If SIZE is nonzero, it is the specified size of the field.
+   If POS is nonzero, it is the bit position.  If ADDRESSABLE is nonzero, it
+   means we are allowed to take the address of the field; if it is negative,
+   we should not make a bitfield, which is used by make_aligning_type.  */
 
 tree
 create_field_decl (tree field_name, tree field_type, tree record_type,
@@ -1497,12 +1509,8 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
   else if (packed == 1)
     {
       size = rm_size (field_type);
-
-      /* For a constant size larger than MAX_FIXED_MODE_SIZE, round up to
-         byte.  */
-      if (TREE_CODE (size) == INTEGER_CST
-          && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0)
-        size = round_up (size, BITS_PER_UNIT);
+      if (TYPE_MODE (field_type) == BLKmode)
+       size = round_up (size, BITS_PER_UNIT);
     }
 
   /* If we may, according to ADDRESSABLE, make a bitfield if a size is
@@ -1816,9 +1824,10 @@ create_subprog_decl (tree subprog_name, tree asm_name,
                     bool public_flag, bool extern_flag,
                      struct attrib *attr_list, Node_Id gnat_node)
 {
-  tree return_type  = TREE_TYPE (subprog_type);
-  tree subprog_decl = build_decl (input_location,
-                                 FUNCTION_DECL, subprog_name, subprog_type);
+  tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name,
+                                 subprog_type);
+  tree result_decl = build_decl (input_location, RESULT_DECL, NULL_TREE,
+                                TREE_TYPE (subprog_type));
 
   /* If this is a non-inline function nested inside an inlined external
      function, we cannot honor both requests without cloning the nested
@@ -1839,23 +1848,11 @@ create_subprog_decl (tree subprog_name, tree asm_name,
   TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
   DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
   DECL_ARGUMENTS (subprog_decl) = param_decl_list;
-  DECL_RESULT (subprog_decl)    = build_decl (input_location,
-                                             RESULT_DECL, 0, return_type);
-  DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
-  DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
-
-  /* TREE_ADDRESSABLE is set on the result type to request the use of the
-     target by-reference return mechanism.  This is not supported all the
-     way down to RTL expansion with GCC 4, which ICEs on temporary creation
-     attempts with such a type and expects DECL_BY_REFERENCE to be set on
-     the RESULT_DECL instead - see gnat_genericize for more details.  */
-  if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
-    {
-      tree result_decl = DECL_RESULT (subprog_decl);
 
-      TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
-      DECL_BY_REFERENCE (result_decl) = 1;
-    }
+  DECL_ARTIFICIAL (result_decl) = 1;
+  DECL_IGNORED_P (result_decl) = 1;
+  DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (subprog_type);
+  DECL_RESULT (subprog_decl) = result_decl;
 
   if (asm_name)
     {
@@ -1866,9 +1863,9 @@ create_subprog_decl (tree subprog_name, tree asm_name,
         to be declared as the "main" function literally by default.  Ada
         program entry points are typically declared with a different name
         within the binder generated file, exported as 'main' to satisfy the
-        system expectations.  Redirect main_identifier_node in this case.  */
+        system expectations.  Force main_identifier_node in this case.  */
       if (asm_name == main_identifier_node)
-       main_identifier_node = DECL_NAME (subprog_decl);
+       DECL_NAME (subprog_decl) = main_identifier_node;
     }
 
   process_attributes (subprog_decl, attr_list);
@@ -1909,163 +1906,6 @@ begin_subprog_body (tree subprog_decl)
   get_pending_sizes ();
 }
 
-
-/* Helper for the genericization callback.  Return a dereference of VAL
-   if it is of a reference type.  */
-
-static tree
-convert_from_reference (tree val)
-{
-  tree value_type, ref;
-
-  if (TREE_CODE (TREE_TYPE (val)) != REFERENCE_TYPE)
-    return val;
-
-  value_type =  TREE_TYPE (TREE_TYPE (val));
-  ref = build1 (INDIRECT_REF, value_type, val);
-
-  /* See if what we reference is CONST or VOLATILE, which requires
-     looking into array types to get to the component type.  */
-
-  while (TREE_CODE (value_type) == ARRAY_TYPE)
-    value_type = TREE_TYPE (value_type);
-
-  TREE_READONLY (ref)
-    = (TYPE_QUALS (value_type) & TYPE_QUAL_CONST);
-  TREE_THIS_VOLATILE (ref)
-    = (TYPE_QUALS (value_type) & TYPE_QUAL_VOLATILE);
-
-  TREE_SIDE_EFFECTS (ref)
-    = (TREE_THIS_VOLATILE (ref) || TREE_SIDE_EFFECTS (val));
-
-  return ref;
-}
-
-/* Helper for the genericization callback.  Returns true if T denotes
-   a RESULT_DECL with DECL_BY_REFERENCE set.  */
-
-static inline bool
-is_byref_result (tree t)
-{
-  return (TREE_CODE (t) == RESULT_DECL && DECL_BY_REFERENCE (t));
-}
-
-
-/* Tree walking callback for gnat_genericize. Currently ...
-
-   o Adjust references to the function's DECL_RESULT if it is marked
-     DECL_BY_REFERENCE and so has had its type turned into a reference
-     type at the end of the function compilation.  */
-
-static tree
-gnat_genericize_r (tree *stmt_p, int *walk_subtrees, void *data)
-{
-  /* This implementation is modeled after what the C++ front-end is
-     doing, basis of the downstream passes behavior.  */
-
-  tree stmt = *stmt_p;
-  struct pointer_set_t *p_set = (struct pointer_set_t*) data;
-
-  /* If we have a direct mention of the result decl, dereference.  */
-  if (is_byref_result (stmt))
-    {
-      *stmt_p = convert_from_reference (stmt);
-      *walk_subtrees = 0;
-      return NULL;
-    }
-
-  /* Otherwise, no need to walk the same tree twice.  */
-  if (pointer_set_contains (p_set, stmt))
-    {
-      *walk_subtrees = 0;
-      return NULL_TREE;
-    }
-
-  /* If we are taking the address of what now is a reference, just get the
-     reference value.  */
-  if (TREE_CODE (stmt) == ADDR_EXPR
-      && is_byref_result (TREE_OPERAND (stmt, 0)))
-    {
-      *stmt_p = convert (TREE_TYPE (stmt), TREE_OPERAND (stmt, 0));
-      *walk_subtrees = 0;
-    }
-
-  /* Don't dereference an by-reference RESULT_DECL inside a RETURN_EXPR.  */
-  else if (TREE_CODE (stmt) == RETURN_EXPR
-           && TREE_OPERAND (stmt, 0)
-          && is_byref_result (TREE_OPERAND (stmt, 0)))
-    *walk_subtrees = 0;
-
-  /* Don't look inside trees that cannot embed references of interest.  */
-  else if (IS_TYPE_OR_DECL_P (stmt))
-    *walk_subtrees = 0;
-
-  pointer_set_insert (p_set, *stmt_p);
-
-  return NULL;
-}
-
-/* Perform lowering of Ada trees to GENERIC. In particular:
-
-   o Turn a DECL_BY_REFERENCE RESULT_DECL into a real by-reference decl
-     and adjust all the references to this decl accordingly.  */
-
-static void
-gnat_genericize (tree fndecl)
-{
-  /* Prior to GCC 4, an explicit By_Reference result mechanism for a function
-     was handled by simply setting TREE_ADDRESSABLE on the result type.
-     Everything required to actually pass by invisible ref using the target
-     mechanism (e.g. extra parameter) was handled at RTL expansion time.
-
-     This doesn't work with GCC 4 any more for several reasons.  First, the
-     gimplification process might need the creation of temporaries of this
-     type, and the gimplifier ICEs on such attempts.  Second, the middle-end
-     now relies on a different attribute for such cases (DECL_BY_REFERENCE on
-     RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to
-     be explicitly accounted for by the front-end in the function body.
-
-     We achieve the complete transformation in two steps:
-
-     1/ create_subprog_decl performs early attribute tweaks: it clears
-        TREE_ADDRESSABLE from the result type and sets DECL_BY_REFERENCE on
-        the result decl.  The former ensures that the bit isn't set in the GCC
-        tree saved for the function, so prevents ICEs on temporary creation.
-        The latter we use here to trigger the rest of the processing.
-
-     2/ This function performs the type transformation on the result decl
-        and adjusts all the references to this decl from the function body
-       accordingly.
-
-     Clearing TREE_ADDRESSABLE from the type differs from the C++ front-end
-     strategy, which escapes the gimplifier temporary creation issues by
-     creating it's own temporaries using TARGET_EXPR nodes.  Our way relies
-     on simple specific support code in aggregate_value_p to look at the
-     target function result decl explicitly.  */
-
-  struct pointer_set_t *p_set;
-  tree decl_result = DECL_RESULT (fndecl);
-
-  if (!DECL_BY_REFERENCE (decl_result))
-    return;
-
-  /* Make the DECL_RESULT explicitly by-reference and adjust all the
-     occurrences in the function body using the common tree-walking facility.
-     We want to see every occurrence of the result decl to adjust the
-     referencing tree, so need to use our own pointer set to control which
-     trees should be visited again or not.  */
-
-  p_set = pointer_set_create ();
-
-  TREE_TYPE (decl_result) = build_reference_type (TREE_TYPE (decl_result));
-  TREE_ADDRESSABLE (decl_result) = 0;
-  relayout_decl (decl_result);
-
-  walk_tree (&DECL_SAVED_TREE (fndecl), gnat_genericize_r, p_set, NULL);
-
-  pointer_set_destroy (p_set);
-}
-
 /* Finish the definition of the current subprogram BODY and finalize it.  */
 
 void
@@ -2099,9 +1939,6 @@ end_subprog_body (tree body)
   if (type_annotate_only)
     return;
 
-  /* Perform the required pre-gimplification transformations on the tree.  */
-  gnat_genericize (fndecl);
-
   /* Dump functions before gimplification.  */
   dump_function (TDI_original, fndecl);
 
@@ -2185,16 +2022,28 @@ gnat_type_for_mode (enum machine_mode mode, int unsignedp)
 {
   if (mode == BLKmode)
     return NULL_TREE;
-  else if (mode == VOIDmode)
+
+  if (mode == VOIDmode)
     return void_type_node;
-  else if (COMPLEX_MODE_P (mode))
+
+  if (COMPLEX_MODE_P (mode))
     return NULL_TREE;
-  else if (SCALAR_FLOAT_MODE_P (mode))
+
+  if (SCALAR_FLOAT_MODE_P (mode))
     return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
-  else if (SCALAR_INT_MODE_P (mode))
+
+  if (SCALAR_INT_MODE_P (mode))
     return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
-  else
-    return NULL_TREE;
+
+  if (VECTOR_MODE_P (mode))
+    {
+      enum machine_mode inner_mode = GET_MODE_INNER (mode);
+      tree inner_type = gnat_type_for_mode (inner_mode, unsignedp);
+      if (inner_type)
+       return build_vector_type_for_mode (inner_type, mode);
+    }
+
+  return NULL_TREE;
 }
 
 /* Return the unsigned version of a TYPE_NODE, a scalar type.  */
@@ -2795,7 +2644,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     }
 
   TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
-  finish_record_type (record_type, field_list, 0, true);
+  finish_record_type (record_type, field_list, 0, false);
   return record_type;
 }
 
@@ -3109,7 +2958,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     }
 
   TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
-  finish_record_type (record64_type, field_list64, 0, true);
+  finish_record_type (record64_type, field_list64, 0, false);
   return record64_type;
 }
 
@@ -3521,7 +3370,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
   finish_record_type (type,
                      chainon (chainon (NULL_TREE, template_field),
                               array_field),
-                     0, false);
+                     0, true);
 
   return type;
 }
@@ -3738,7 +3587,7 @@ convert_to_fat_pointer (tree type, tree expr)
     {
       tree fields = TYPE_FIELDS (TREE_TYPE (etype));
 
-      expr = save_expr (expr);
+      expr = protect_multiple_eval (expr);
       if (TREE_CODE (expr) == ADDR_EXPR)
        expr = TREE_OPERAND (expr, 0);
       else
@@ -3856,12 +3705,17 @@ convert (tree type, tree expr)
                     == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type))))))
        return convert (type, TREE_OPERAND (expr, 0));
 
-      /* If the result type is a padded type with a self-referentially-sized
-        field and the expression type is a record, do this as an unchecked
-        conversion.  */
+      /* If the inner type is of self-referential size and the expression type
+        is a record, do this as an unchecked conversion.  But first pad the
+        expression if possible to have the same size on both sides.  */
       if (TREE_CODE (etype) == RECORD_TYPE
          && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
-       return unchecked_convert (type, expr, false);
+       {
+         if (TREE_CONSTANT (TYPE_SIZE (etype)))
+           expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
+                           false, false, false, true), expr);
+         return unchecked_convert (type, expr, false);
+       }
 
       /* If we are converting between array types with variable size, do the
         final conversion as an unchecked conversion, again to avoid the need
@@ -4027,7 +3881,8 @@ convert (tree type, tree expr)
              /* If packing has made this field a bitfield and the input
                 value couldn't be emitted statically any more, we need to
                 clear TREE_CONSTANT on our output.  */
-             if (!clear_constant && TREE_CONSTANT (expr)
+             if (!clear_constant
+                 && TREE_CONSTANT (expr)
                  && !CONSTRUCTOR_BITFIELD_P (efield)
                  && CONSTRUCTOR_BITFIELD_P (field)
                  && !initializer_constant_valid_for_bitfield_p (value))
@@ -4046,7 +3901,7 @@ convert (tree type, tree expr)
              TREE_TYPE (expr) = type;
              CONSTRUCTOR_ELTS (expr) = v;
              if (clear_constant)
-               TREE_CONSTANT (expr) = TREE_STATIC (expr) = false;
+               TREE_CONSTANT (expr) = TREE_STATIC (expr) = 0;
              return expr;
            }
        }
@@ -4397,8 +4252,7 @@ maybe_unconstrained_array (tree exp)
                              build_component_ref (TREE_OPERAND (exp, 0),
                                                   get_identifier ("P_ARRAY"),
                                                   NULL_TREE, false));
-         TREE_READONLY (new_exp) = TREE_STATIC (new_exp)
-           = TREE_READONLY (exp);
+         TREE_READONLY (new_exp) = TREE_READONLY (exp);
          return new_exp;
        }
 
@@ -4881,7 +4735,7 @@ build_void_list_node (void)
 static tree
 builtin_type_for_size (int size, bool unsignedp)
 {
-  tree type = lang_hooks.types.type_for_size (size, unsignedp);
+  tree type = gnat_type_for_size (size, unsignedp);
   return type ? type : error_mark_node;
 }