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);
@@ -153,36 +154,6 @@ 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
    (an ..._DECL node) and associates the ..._DECL node with the input GNAT
@@ -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.  */
@@ -5094,6 +5097,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,7 +3756,7 @@ 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;
 
@@ -3768,23 +3768,22 @@ update_pointer_to (tree old_type, tree new_type)
      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;
 
@@ -3808,7 +3807,7 @@ update_pointer_to (tree old_type, tree new_type)
   /* 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;