decl.c (compile_time_known_address_p): Rewrite and move around.

	* decl.c (compile_time_known_address_p): Rewrite and move around.
	(gnat_to_gnu_type): Move around.
	(get_unpadded_type): Likewise.
	* utils.c (update_pointer_to): Use synthetic macro.  Tidy comments.

From-SVN: r145654

gcc/ada/ChangeLog

 2009-04-07  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* decl.c (compile_time_known_address_p): Rewrite and move around.
+	(gnat_to_gnu_type): Move around.
+	(get_unpadded_type): Likewise.
+	* utils.c (update_pointer_to): Use synthetic macro.  Tidy comments.
+
+2009-04-07  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (check_for_eliminated_entity): New function.
 	(Attribute_to_gnu): Invoke it for Access- and Address-like attributes.
 	(call_to_gnu): Invoke it instead of manually checking.

gcc/ada/gcc-interface/decl.c

@@ -139,6 +139,7 @@ static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
 			       bool *);
 static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (Entity_Id, tree);
+static bool compile_time_known_address_p (Node_Id);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
 				  bool, bool, bool, bool);
 static Uint annotate_value (tree);
@@ -152,36 +153,6 @@ static unsigned int ceil_alignment (unsigned HOST_WIDE_INT);
 static void check_ok_for_atomic (tree, Entity_Id, bool);
 static int compatible_signatures_p (tree ftype1, tree ftype2);
 static void rest_of_type_decl_compilation_no_defer (tree);
-
-/* Return true if GNAT_ADDRESS is a compile time known value.
-   In particular catch System'To_Address.  */
-
-static bool
-compile_time_known_address_p (Node_Id gnat_address)
-{
-  return ((Nkind (gnat_address) == N_Unchecked_Type_Conversion
-	   && Compile_Time_Known_Value (Expression (gnat_address)))
-	  || Compile_Time_Known_Value (gnat_address));
-}
-
-/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
-   GCC type corresponding to that entity.  GNAT_ENTITY is assumed to
-   refer to an Ada type.  */
-
-tree
-gnat_to_gnu_type (Entity_Id gnat_entity)
-{
-  tree gnu_decl;
-
-  /* The back end never attempts to annotate generic types */
-  if (Is_Generic_Type (gnat_entity) && type_annotate_only)
-     return void_type_node;
-
-  /* Convert the ada entity type into a GCC TYPE_DECL node.  */
-  gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
-  gcc_assert (TREE_CODE (gnu_decl) == TYPE_DECL);
-  return TREE_TYPE (gnu_decl);
-}
 
 /* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
    entity, this routine returns the equivalent GCC tree for that entity
@@ -4757,6 +4728,38 @@ gnat_to_gnu_field_decl (Entity_Id gnat_entity)
   return gnu_field;
 }
 
+/* Similar, but GNAT_ENTITY is assumed to refer to a GNAT type.  Return
+   the GCC type corresponding to that entity.  */
+
+tree
+gnat_to_gnu_type (Entity_Id gnat_entity)
+{
+  tree gnu_decl;
+
+  /* The back end never attempts to annotate generic types.  */
+  if (Is_Generic_Type (gnat_entity) && type_annotate_only)
+     return void_type_node;
+
+  gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
+  gcc_assert (TREE_CODE (gnu_decl) == TYPE_DECL);
+
+  return TREE_TYPE (gnu_decl);
+}
+
+/* Similar, but GNAT_ENTITY is assumed to refer to a GNAT type.  Return
+   the unpadded version of the GCC type corresponding to that entity.  */
+
+tree
+get_unpadded_type (Entity_Id gnat_entity)
+{
+  tree type = gnat_to_gnu_type (gnat_entity);
+
+  if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+    type = TREE_TYPE (TYPE_FIELDS (type));
+
+  return type;
+}
+
 /* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it.
    Every TYPE_DECL generated for a type definition must be passed
    to this function once everything else has been done for it.  */
@@ -5093,6 +5096,18 @@ array_type_has_nonaliased_component (Entity_Id gnat_type, tree gnu_type)
 
   return type_for_nonaliased_component_p (TREE_TYPE (gnu_type));
 }
+
+/* Return true if GNAT_ADDRESS is a value known at compile-time.  */
+
+static bool
+compile_time_known_address_p (Node_Id gnat_address)
+{
+  /* Catch System'To_Address.  */
+  if (Nkind (gnat_address) == N_Unchecked_Type_Conversion)
+    gnat_address = Expression (gnat_address);
+
+  return Compile_Time_Known_Value (gnat_address);
+}
 
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */
@@ -5440,19 +5455,6 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
       }
 }
 
-/* Get the unpadded version of a GNAT type.  */
-
-tree
-get_unpadded_type (Entity_Id gnat_entity)
-{
-  tree type = gnat_to_gnu_type (gnat_entity);
-
-  if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
-    type = TREE_TYPE (TYPE_FIELDS (type));
-
-  return type;
-}
-
 /* Called when we need to protect a variable object using a save_expr.  */
 
 tree

gcc/ada/gcc-interface/utils.c

@@ -3738,9 +3738,9 @@ shift_unc_components_for_thin_pointers (tree type)
   DECL_FIELD_BIT_OFFSET (array_field) = bitsize_zero_node;
 }
 
-/* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE.  In
-   the normal case this is just two adjustments, but we have more to do
-   if NEW is an UNCONSTRAINED_ARRAY_TYPE.  */
+/* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE.
+   In the normal case this is just two adjustments, but we have more to
+   do if NEW_TYPE is an UNCONSTRAINED_ARRAY_TYPE.  */
 
 void
 update_pointer_to (tree old_type, tree new_type)
@@ -3756,35 +3756,34 @@ update_pointer_to (tree old_type, tree new_type)
 	 type = TYPE_NEXT_VARIANT (type))
       update_pointer_to (type, new_type);
 
-  /* If no pointer or reference, we are done.  */
+  /* If no pointers and no references, we are done.  */
   if (!ptr && !ref)
     return;
 
   /* Merge the old type qualifiers in the new type.
 
      Each old variant has qualifiers for specific reasons, and the new
-     designated type as well. Each set of qualifiers represents useful
+     designated type as well.  Each set of qualifiers represents useful
      information grabbed at some point, and merging the two simply unifies
      these inputs into the final type description.
 
      Consider for instance a volatile type frozen after an access to constant
-     type designating it. After the designated type freeze, we get here with a
-     volatile new_type and a dummy old_type with a readonly variant, created
-     when the access type was processed. We shall make a volatile and readonly
+     type designating it; after the designated type's freeze, we get here with
+     a volatile NEW_TYPE and a dummy OLD_TYPE with a readonly variant, created
+     when the access type was processed.  We will make a volatile and readonly
      designated type, because that's what it really is.
 
-     We might also get here for a non-dummy old_type variant with different
-     qualifiers than the new_type ones, for instance in some cases of pointers
+     We might also get here for a non-dummy OLD_TYPE variant with different
+     qualifiers than those of NEW_TYPE, for instance in some cases of pointers
      to private record type elaboration (see the comments around the call to
-     this routine from gnat_to_gnu_entity/E_Access_Type). We have to merge the
-     qualifiers in those cases too, to avoid accidentally discarding the
-     initial set, and will often end up with old_type == new_type then.  */
-  new_type = build_qualified_type (new_type,
-				   TYPE_QUALS (old_type)
-				   | TYPE_QUALS (new_type));
-
-  /* If the new type and the old one are identical, there is nothing to
-     update.  */
+     this routine in gnat_to_gnu_entity <E_Access_Type>).  We have to merge
+     the qualifiers in those cases too, to avoid accidentally discarding the
+     initial set, and will often end up with OLD_TYPE == NEW_TYPE then.  */
+  new_type
+    = build_qualified_type (new_type,
+			    TYPE_QUALS (old_type) | TYPE_QUALS (new_type));
+
+  /* If old type and new type are identical, there is nothing to do.  */
   if (old_type == new_type)
     return;
 
@@ -3805,10 +3804,10 @@ update_pointer_to (tree old_type, tree new_type)
 	  TREE_TYPE (ref1) = new_type;
     }
 
-  /* Now deal with the unconstrained array case. In this case the "pointer"
+  /* Now deal with the unconstrained array case.  In this case the "pointer"
      is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
      Turn them into pointers to the correct types using update_pointer_to.  */
-  else if (TREE_CODE (ptr) != RECORD_TYPE || !TYPE_IS_FAT_POINTER_P (ptr))
+  else if (!TYPE_FAT_POINTER_P (ptr))
     gcc_unreachable ();
 
   else
@@ -3826,26 +3825,25 @@ update_pointer_to (tree old_type, tree new_type)
 	 TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_ptr)))));
 
       /* The references to the template bounds present in the array type
-	 are made through a PLACEHOLDER_EXPR of type new_ptr.  Since we
-	 are updating ptr to make it a full replacement for new_ptr as
-	 pointer to new_type, we must rework the PLACEHOLDER_EXPR so as
-	 to make it of type ptr.  */
+	 are made through a PLACEHOLDER_EXPR of type NEW_PTR.  Since we
+	 are updating PTR to make it a full replacement for NEW_PTR as
+	 pointer to NEW_TYPE, we must rework the PLACEHOLDER_EXPR so as
+	 to make it of type PTR.  */
       new_ref = build3 (COMPONENT_REF, TREE_TYPE (bounds_field),
 			build0 (PLACEHOLDER_EXPR, ptr),
 			bounds_field, NULL_TREE);
 
-      /* Create the new array for the new PLACEHOLDER_EXPR and make
-	 pointers to the dummy array point to it.
+      /* Create the new array for the new PLACEHOLDER_EXPR and make pointers
+	 to the dummy array point to it.
 
-	 ??? This is now the only use of substitute_in_type,
-	 which is a very "heavy" routine to do this, so it
-	 should be replaced at some point.  */
+	 ??? This is now the only use of substitute_in_type, which is a very
+	 "heavy" routine to do this, it should be replaced at some point.  */
       update_pointer_to
 	(TREE_TYPE (TREE_TYPE (array_field)),
 	 substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr))),
 			     TREE_CHAIN (TYPE_FIELDS (new_ptr)), new_ref));
 
-      /* Make ptr the pointer to new_type.  */
+      /* Make PTR the pointer to NEW_TYPE.  */
       TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
 	= TREE_TYPE (new_type) = ptr;