[multiple changes]

2004-07-13  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* decl.c: (gnat_to_gnu_entity, object case): Convert initializer to
	object type.
	(gnat_to_gnu_entity, case E_Record_Subtype): Properly set
	TYPE_STUB_DECL.

	* misc.c (gnat_types_compatible_p): New function.
	(LANG_HOOKS_TYPES_COMPATIBLE_P): New hook, to use it.
	(LANG_HOOKS_TYPE_MAX_SIZE, gnat_type_max_size): New.

	* trans.c (gigi): Move processing of main N_Compilation_Unit here.
	(gnat_to_gnu, case N_Compilation_Unit): Just handle nested case here.
	(add_stmt): Force walking of sizes and DECL_INITIAL for DECL_EXPR.
	(mark_visited): Don't mark dummy type.
	(tree_transform <N_Procedure_Call_Statement>): Unless this is an In
	parameter, we must remove any LJM building from GNU_NAME.
	(gnat_to_gnu, case N_String_Literal): Fill in indices in CONSTRUCTOR.
	(pos_to_constructor): Use int_const_binop.
	(gnat_to_gnu, case N_Identifier): Don't reference DECL_INITIAL of
	PARM_DECL.

	* utils.c (gnat_init_decl_processing): Don't make two "void" decls.
	(gnat_pushlevel): Set TREE_USE on BLOCK node.
	(gnat_install_builtins): Add __builtin_memset.

2004-07-13  Olivier Hainque  <hainque@act-europe.fr>

	* decl.c (gnat_to_gnu_entity <E_Variable>): If we are making a pointer
	for a renaming, stabilize the initialization expression if we are at a
	local level.  At the local level, uses of the renaming may be performed
	by a direct dereference of the initializing expression, and we don't
	want possible variables there to be evaluated for every use.

	* trans.c (gnat_stabilize_reference, gnat_stabilize_reference_1):
	Propagate TREE_SIDE_EFFECTS and TREE_THIS_VOLATILE to avoid loosing
	them on the way.  Account for the fact that we may introduce side
	effects in the process.

From-SVN: r84647

gcc/ada/ChangeLog

+2004-07-13  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* decl.c: (gnat_to_gnu_entity, object case): Convert initializer to
+	object type.
+	(gnat_to_gnu_entity, case E_Record_Subtype): Properly set
+	TYPE_STUB_DECL.
+
+	* misc.c (gnat_types_compatible_p): New function.
+	(LANG_HOOKS_TYPES_COMPATIBLE_P): New hook, to use it.
+	(LANG_HOOKS_TYPE_MAX_SIZE, gnat_type_max_size): New.
+
+	* trans.c (gigi): Move processing of main N_Compilation_Unit here.
+	(gnat_to_gnu, case N_Compilation_Unit): Just handle nested case here.
+	(add_stmt): Force walking of sizes and DECL_INITIAL for DECL_EXPR.
+	(mark_visited): Don't mark dummy type.
+	(tree_transform <N_Procedure_Call_Statement>): Unless this is an In	
+	parameter, we must remove any LJM building from GNU_NAME.
+	(gnat_to_gnu, case N_String_Literal): Fill in indices in CONSTRUCTOR.
+	(pos_to_constructor): Use int_const_binop.
+	(gnat_to_gnu, case N_Identifier): Don't reference DECL_INITIAL of
+	PARM_DECL.
+
+	* utils.c (gnat_init_decl_processing): Don't make two "void" decls.
+	(gnat_pushlevel): Set TREE_USE on BLOCK node.
+	(gnat_install_builtins): Add __builtin_memset.
+
+2004-07-13  Olivier Hainque  <hainque@act-europe.fr>
+
+	* decl.c (gnat_to_gnu_entity <E_Variable>): If we are making a pointer
+	for a renaming, stabilize the initialization expression if we are at a
+	local level.  At the local level, uses of the renaming may be performed
+	by a direct dereference of the initializing expression, and we don't
+	want possible variables there to be evaluated for every use.
+
+	* trans.c (gnat_stabilize_reference, gnat_stabilize_reference_1):
+	Propagate TREE_SIDE_EFFECTS and TREE_THIS_VOLATILE to avoid loosing
+	them on the way.  Account for the fact that we may introduce side
+	effects in the process.
+
 2004-07-13  Richard Henderson  <rth@redhat.com>
 
 	* misc.c (default_pass_by_ref): Use pass_by_reference.

gcc/ada/decl.c

@@ -728,15 +728,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		      (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
 	  gnu_expr = convert (gnu_type, gnu_expr);
 
-	/* See if this is a renaming.  If this is a constant renaming,
-	   treat it as a normal variable whose initial value is what
-	   is being renamed.  We cannot do this if the type is
-	   unconstrained or class-wide.
+	/* See if this is a renaming.  If this is a constant renaming, treat
+	   it as a normal variable whose initial value is what is being
+	   renamed.  We cannot do this if the type is unconstrained or
+	   class-wide.
 
 	   Otherwise, if what we are renaming is a reference, we can simply
-	   return a stabilized version of that reference, after forcing
-	   any SAVE_EXPRs to be evaluated.  But, if this is at global level,
-	   we can only do this if we know no SAVE_EXPRs will be made.
+	   return a stabilized version of that reference, after forcing any
+	   SAVE_EXPRs to be evaluated.  But, if this is at global level, we
+	   can only do this if we know no SAVE_EXPRs will be made.
+
 	   Otherwise, make this into a constant pointer to the object we are
 	   to rename.  */
 
@@ -761,8 +762,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                 && !Is_Array_Type (Etype (gnat_entity)))
 	      ;
 
-	    /* If this is a declaration or reference, we can just use that
-	       declaration or reference as this entity.  */
+	    /* If this is a declaration or reference that we can stabilize,
+	       just use that declaration or reference as this entity unless
+	       the latter has to be materialized.  */
 	    else if ((DECL_P (gnu_expr)
 		      || TREE_CODE_CLASS (TREE_CODE (gnu_expr)) == 'r')
 		     && ! Materialize_Entity (gnat_entity)
@@ -775,12 +777,33 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		saved = 1;
 		break;
 	      }
+	    /* Otherwise, make this into a constant pointer to the object we
+	       are to rename.
+
+	       Stabilize it if we are not at the global level since in this
+	       case the renaming evaluation may directly dereference the
+	       initial value we make here instead of the pointer we will
+	       assign it to.  We don't want variables in the expression to be
+	       evaluated every time the renaming is used, since the value of
+	       these variables may change in between.
+
+	       If we are at the global level and the value is not constant,
+	       create_var_decl generates a mere elaboration assignment and
+	       does not attach the initial expression to the declaration.
+	       There is no possible direct initial-value dereference then.  */
 	    else
 	      {
 		inner_const_flag = TREE_READONLY (gnu_expr);
 		const_flag = 1;
 		gnu_type = build_reference_type (gnu_type);
 		gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr);
+
+		if (! global_bindings_p ())
+		  {
+		    gnu_expr = gnat_stabilize_reference (gnu_expr, 1);
+		    add_stmt (gnu_expr);
+		  }
+
 		gnu_size = 0;
 		used_by_ref = 1;
 	      }
@@ -999,17 +1022,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   with the symbol we need to export in addition.  Don't use the
 	   Interface_Name if there is an address clause (see CD30005).  */
 	if (! Is_VMS_Exception (gnat_entity)
-	    &&
-	    ((Present (Interface_Name (gnat_entity))
-	      && No (Address_Clause (gnat_entity)))
-	     ||
-	     (Is_Public (gnat_entity)
-	      && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity)))))
+	    && ((Present (Interface_Name (gnat_entity))
+		 && No (Address_Clause (gnat_entity)))
+		|| (Is_Public (gnat_entity)
+		    && (! Is_Imported (gnat_entity)
+			|| Is_Exported (gnat_entity)))))
 	  gnu_ext_name = create_concat_name (gnat_entity, 0);
 
 	if (const_flag)
-	  gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
-						      | TYPE_QUAL_CONST));
+	  {
+	    gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type)
+							| TYPE_QUAL_CONST));
+	    if (gnu_expr)
+	      gnu_expr = convert (gnu_type, gnu_expr);
+	  }
 
 	/* If this is constant initialized to a static constant and the
 	   object has an aggregrate type, force it to be statically

gcc/ada/misc.c

@@ -94,6 +94,7 @@ static bool gnat_post_options		(const char **);
 static HOST_WIDE_INT gnat_get_alias_set	(tree);
 static void gnat_print_decl		(FILE *, tree, int);
 static void gnat_print_type		(FILE *, tree, int);
+static int gnat_types_compatible_p	(tree, tree);
 static const char *gnat_printable_name	(tree, int);
 static tree gnat_eh_runtime_type	(tree);
 static int gnat_eh_type_covers		(tree, tree);
@@ -102,6 +103,7 @@ static rtx gnat_expand_expr		(tree, rtx, enum machine_mode, int,
 					 rtx *);
 static void internal_error_function	(const char *, va_list *);
 static void gnat_adjust_rli		(record_layout_info);
+static tree gnat_type_max_size		(tree);
 
 /* Definitions for our language-specific hooks.  */
 
@@ -141,6 +143,10 @@ static void gnat_adjust_rli		(record_layout_info);
 #define LANG_HOOKS_PRINT_DECL		gnat_print_decl
 #undef LANG_HOOKS_PRINT_TYPE
 #define LANG_HOOKS_PRINT_TYPE		gnat_print_type
+#undef LANG_HOOKS_TYPES_COMPATIBLE_P
+#define LANG_HOOKS_TYPES_COMPATIBLE_P	gnat_types_compatible_p
+#undef LANG_HOOKS_TYPE_MAX_SIZE
+#define LANG_HOOKS_TYPE_MAX_SIZE	gnat_type_max_size
 #undef LANG_HOOKS_DECL_PRINTABLE_NAME
 #define LANG_HOOKS_DECL_PRINTABLE_NAME	gnat_printable_name
 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
@@ -555,6 +561,27 @@ gnat_print_type (FILE *file, tree node, int indent)
     }
 }
 
+/* We consider two types compatible if they have the same main variant,
+   but we also consider two array types compatible if they have the same
+   component type and bounds.
+
+   ??? We may also want to generalize to considering lots of integer types
+   compatible, but we need to understand the effects of alias sets first.  */
+
+static int
+gnat_types_compatible_p (tree x, tree y)
+{
+  if (TREE_CODE (x) == ARRAY_TYPE && TREE_CODE (y) == ARRAY_TYPE
+      && gnat_types_compatible_p (TREE_TYPE (x), TREE_TYPE (y))
+      && operand_equal_p (TYPE_MIN_VALUE (TYPE_DOMAIN (x)),
+			  TYPE_MIN_VALUE (TYPE_DOMAIN (y)), 0)
+      && operand_equal_p (TYPE_MAX_VALUE (TYPE_DOMAIN (x)),
+			  TYPE_MAX_VALUE (TYPE_DOMAIN (y)), 0))
+    return 1;
+  else
+    return TYPE_MAIN_VARIANT (x) == TYPE_MAIN_VARIANT (y);
+}
+
 static const char *
 gnat_printable_name (tree decl, int verbosity)
 {
@@ -691,6 +718,15 @@ gnat_get_alias_set (tree type)
   return -1;
 }
 
+/* GNU_TYPE is a type.  Return its maxium size in bytes, if known.  */
+
+static tree
+gnat_type_max_size (gnu_type)
+     tree gnu_type;
+{
+  return max_size (TYPE_SIZE_UNIT (gnu_type), 1);
+}
+
 /* GNU_TYPE is a type. Determine if it should be passed by reference by
    default.  */
 
@@ -709,7 +745,7 @@ default_pass_by_ref (tree gnu_type)
 
   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
     return true;
-  
+
   if (AGGREGATE_TYPE_P (gnu_type)
       && (! host_integerp (TYPE_SIZE (gnu_type), 1)
 	  || 0 < compare_tree_int (TYPE_SIZE (gnu_type),

gcc/ada/utils.c

@@ -230,6 +230,7 @@ gnat_pushlevel ()
     BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
 
   BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
+  TREE_USED (newlevel->block) = 1;
 
   /* Add this level to the front of the chain (stack) of levels that are
      active.  */
@@ -362,7 +363,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 	      && DECL_ARTIFICIAL (TYPE_NAME (TREE_TYPE (decl)))
 	      && ! DECL_ARTIFICIAL (decl))))
     TYPE_NAME (TREE_TYPE (decl)) = decl;
-  
+
   if (TREE_CODE (decl) != CONST_DECL)
     rest_of_decl_compilation (decl, NULL, global_bindings_p (), 0);
 }
@@ -404,9 +405,6 @@ gnat_init_decl_processing (void)
   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
 			     long_integer_type_node),
 		 Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
-			     void_type_node),
-		 Empty);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 
@@ -464,6 +462,13 @@ gnat_install_builtins ()
   gnat_define_builtin ("__builtin_memcmp", ftype, BUILT_IN_MEMCMP,
 		       "memcmp", false);
 
+  tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+  tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
+  tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+  ftype = build_function_type (integer_type_node, tmp);
+  gnat_define_builtin ("__builtin_memset", ftype, BUILT_IN_MEMSET,
+		       "memset", false);
+
   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
   ftype = build_function_type (integer_type_node, tmp);
   gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
@@ -2827,10 +2832,8 @@ convert (tree type, tree expr)
       return expr;
 
     case STRING_CST:
-    case CONSTRUCTOR:
       /* If we are converting a STRING_CST to another constrained array type,
-	 just make a new one in the proper type.  Likewise for
-	 CONSTRUCTOR if the alias sets are the same.  */
+	 just make a new one in the proper type.  */
       if (code == ecode && AGGREGATE_TYPE_P (etype)
 	  && ! (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
 		&& TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
@@ -2843,21 +2846,6 @@ convert (tree type, tree expr)
 	}
       break;
 
-    case COMPONENT_REF:
-      /* If we are converting between two aggregate types of the same
-	 kind, size, mode, and alignment, just make a new COMPONENT_REF.
-	 This avoid unneeded conversions which makes reference computations
-	 more complex.  */
-      if (code == ecode && TYPE_MODE (type) == TYPE_MODE (etype)
-	  && AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)
-	  && TYPE_ALIGN (type) == TYPE_ALIGN (etype)
-	  && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0)
-	  && get_alias_set (type) == get_alias_set (etype))
-	return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0),
-		      TREE_OPERAND (expr, 1), NULL_TREE);
-
-      break;
-
     case UNCONSTRAINED_ARRAY_REF:
       /* Convert this to the type of the inner array by getting the address of
 	 the array from the template.  */