langhooks-def.h (LANG_HOOKS_HASH_TYPES): New macro and hook.

	* langhooks-def.h (LANG_HOOKS_HASH_TYPES): New macro and hook.
	* langhooks.h (struct lang_hooks_for_types): New field hash_types.
	* tree.c (debug_no_type_hash): Deleted.
	(type_hash_canon): Abort if passed a variant.
	Check lang_hooks.types.hash_types.
	(build_type_no_quals): Copy mode of POINTER_TYPE and REFERENCE_TYPE.
	(build_array_type): Remove unnecessary allocation of pointer type.
	(build_complex_type): Properly qualify resulting type.

	* ada/decl.c (debug_no_type_hash): Remove.
	(gnat_to_gnu_entity, case E_Array_Type): Don't set and clear it.
	* ada/misc.c (LANG_HOOK_HASH_TYPE): Redefine.

From-SVN: r79684

gcc/ChangeLog

+2004-03-19  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* langhooks-def.h (LANG_HOOKS_HASH_TYPES): New macro and hook.
+	* langhooks.h (struct lang_hooks_for_types): New field hash_types.
+	* tree.c (debug_no_type_hash): Deleted.
+	(type_hash_canon): Abort if passed a variant.
+	Check lang_hooks.types.hash_types.
+	(build_type_no_quals): Copy mode of POINTER_TYPE and REFERENCE_TYPE.
+	(build_array_type): Remove unnecessary allocation of pointer type.
+	(build_complex_type): Properly qualify resulting type.
+
 2004-03-19  Paolo Bonzini  <bonzini@gnu.org>
 
 	* config/rs6000/rs6000.c (rs6000_init_builtins): Fix typo.

gcc/ada/ChangeLog

+2004-03-19 Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* decl.c (debug_no_type_hash): Remove.
+	(gnat_to_gnu_entity, case E_Array_Type): Don't set and clear it.
+	* misc.c (LANG_HOOK_HASH_TYPE): Redefine.
+
 2004-03-19  Laurent GUERBY <laurent@guerby.net>
 
 	* sem_prag.adb (Suppress_Unsuppress_Echeck): use loop instead of 

gcc/ada/decl.c

@@ -52,9 +52,6 @@
 #include "ada-tree.h"
 #include "gigi.h"
 
-/* Setting this to 1 suppresses hashing of types.  */
-extern int debug_no_type_hash;
-
 /* Provide default values for the macros controlling stack checking.
    This is copied from GCC's expr.h.  */
 
@@ -1942,11 +1939,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				     convert (bitsizetype, gnu_max_size),
 				     TYPE_SIZE (gnu_type));
 
-	  /* We don't want any array types shared for two reasons: first,
-	     we want to keep differently-named types distinct; second,
-	     setting TYPE_MULTI_ARRAY_TYPE of one type can clobber
-	     another.  */
-	  debug_no_type_hash = 1;
 	  for (index = array_dim - 1; index >= 0; index --)
 	    {
 	      gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
@@ -2019,7 +2011,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      finish_record_type (gnu_bound_rec_type, gnu_field_list, 0, 0);
 	    }
 
-	  debug_no_type_hash = 0;
 	  TYPE_CONVENTION_FORTRAN_P (gnu_type)
 	    = (Convention (gnat_entity) == Convention_Fortran);
 	  TYPE_PACKED_ARRAY_TYPE_P (gnu_type)

gcc/ada/misc.c

@@ -101,7 +101,7 @@ static rtx gnat_expand_expr		(tree, rtx, enum machine_mode, int,
 static void internal_error_function	(const char *, va_list *);
 static void gnat_adjust_rli		(record_layout_info);
 
-/* Structure giving our language-specific hooks.  */
+/* Definitions for our language-specific hooks.  */
 
 #undef  LANG_HOOKS_NAME
 #define LANG_HOOKS_NAME			"GNU Ada"
@@ -118,7 +118,9 @@ static void gnat_adjust_rli		(record_layout_info);
 #undef LANG_HOOKS_PARSE_FILE
 #define LANG_HOOKS_PARSE_FILE		gnat_parse_file
 #undef LANG_HOOKS_HONOR_READONLY
-#define LANG_HOOKS_HONOR_READONLY	1
+#define LANG_HOOKS_HONOR_READONLY	true
+#undef LANG_HOOKS_HASH_TYPES
+#define LANG_HOOKS_HASH_TYPES		false
 #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
 #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
 #undef LANG_HOOKS_GET_ALIAS_SET

gcc/langhooks-def.h

@@ -222,6 +222,7 @@ extern tree lhd_make_node (enum tree_code);
 #define LANG_HOOKS_INCOMPLETE_TYPE_ERROR lhd_incomplete_type_error
 #define LANG_HOOKS_TYPE_PROMOTES_TO lhd_type_promotes_to
 #define LANG_HOOKS_REGISTER_BUILTIN_TYPE lhd_register_builtin_type
+#define LANG_HOOKS_HASH_TYPES		true
 
 #define LANG_HOOKS_FOR_TYPES_INITIALIZER { \
   LANG_HOOKS_MAKE_TYPE, \
@@ -232,7 +233,8 @@ extern tree lhd_make_node (enum tree_code);
   LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE, \
   LANG_HOOKS_TYPE_PROMOTES_TO, \
   LANG_HOOKS_REGISTER_BUILTIN_TYPE, \
-  LANG_HOOKS_INCOMPLETE_TYPE_ERROR \
+  LANG_HOOKS_INCOMPLETE_TYPE_ERROR, \
+  LANG_HOOKS_HASH_TYPES \
 }
 
 /* Declaration hooks.  */

gcc/langhooks.h

@@ -151,6 +151,11 @@ struct lang_hooks_for_types
      was used (or 0 if that isn't known) and TYPE is the type that was
      invalid.  */
   void (*incomplete_type_error) (tree value, tree type);
+
+  /* Nonzero if types that are identical are to be hashed so that only
+     one copy is kept.  If a language requires unique types for each
+     user-specified type, such as Ada, this should be set to TRUE.  */
+  bool hash_types;
 };
 
 /* Language hooks related to decls and the symbol table.  */

gcc/tree.c

@@ -3218,24 +3218,24 @@ type_hash_add (hashval_t hashcode, tree type)
 
 /* Given TYPE, and HASHCODE its hash code, return the canonical
    object for an identical type if one already exists.
-   Otherwise, return TYPE, and record it as the canonical object
-   if it is a permanent object.
+   Otherwise, return TYPE, and record it as the canonical object.
 
    To use this function, first create a type of the sort you want.
    Then compute its hash code from the fields of the type that
    make it different from other similar types.
-   Then call this function and use the value.
-   This function frees the type you pass in if it is a duplicate.  */
-
-/* Set to 1 to debug without canonicalization.  Never set by program.  */
-int debug_no_type_hash = 0;
+   Then call this function and use the value.  */
 
 tree
 type_hash_canon (unsigned int hashcode, tree type)
 {
   tree t1;
 
-  if (debug_no_type_hash)
+  /* The hash table only contains main variants, so ensure that's what we're
+     being passed.  */
+  if (TYPE_MAIN_VARIANT (type) != type)
+    abort ();
+
+  if (!lang_hooks.types.hash_types)
     return type;
 
   /* See if the type is in the hash table already.  If so, return it.
@@ -3931,9 +3931,12 @@ build_type_no_quals (tree t)
   switch (TREE_CODE (t))
     {
     case POINTER_TYPE:
-      return build_pointer_type (build_type_no_quals (TREE_TYPE (t)));
+      return build_pointer_type_for_mode (build_type_no_quals (TREE_TYPE (t)),
+					  TYPE_MODE (t));
     case REFERENCE_TYPE:
-      return build_reference_type (build_type_no_quals (TREE_TYPE (t)));
+      return
+	build_reference_type_for_mode (build_type_no_quals (TREE_TYPE (t)),
+				       TYPE_MODE (t));
     default:
       return TYPE_MAIN_VARIANT (t);
     }
@@ -4026,19 +4029,12 @@ build_array_type (tree elt_type, tree index_type)
       elt_type = integer_type_node;
     }
 
-  /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
-  build_pointer_type (elt_type);
-
-  /* Allocate the array after the pointer type,
-     in case we free it in type_hash_canon.  */
   t = make_node (ARRAY_TYPE);
   TREE_TYPE (t) = elt_type;
   TYPE_DOMAIN (t) = index_type;
 
   if (index_type == 0)
-    {
-      return t;
-    }
+    return t;
 
   hashcode = iterative_hash_object (TYPE_HASH (elt_type), hashcode);
   hashcode = iterative_hash_object (TYPE_HASH (index_type), hashcode);
@@ -4087,7 +4083,7 @@ build_function_type (tree value_type, tree arg_types)
   TREE_TYPE (t) = value_type;
   TYPE_ARG_TYPES (t) = arg_types;
 
-  /* If we already have such a type, use the old one and free this one.  */
+  /* If we already have such a type, use the old one.  */
   hashcode = iterative_hash_object (TYPE_HASH (value_type), hashcode);
   hashcode = type_hash_list (arg_types, hashcode);
   t = type_hash_canon (hashcode, t);
@@ -4149,12 +4145,10 @@ build_method_type_directly (tree basetype,
   argtypes = tree_cons (NULL_TREE, ptype, argtypes);
   TYPE_ARG_TYPES (t) = argtypes;
 
-  /* If we already have such a type, use the old one and free this one.
-     Note that it also frees up the above cons cell if found.  */
+  /* If we already have such a type, use the old one.  */
   hashcode = iterative_hash_object (TYPE_HASH (basetype), hashcode);
   hashcode = iterative_hash_object (TYPE_HASH (rettype), hashcode);
   hashcode = type_hash_list (argtypes, hashcode);
-
   t = type_hash_canon (hashcode, t);
 
   if (!COMPLETE_TYPE_P (t))
@@ -4195,7 +4189,7 @@ build_offset_type (tree basetype, tree type)
   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
   TREE_TYPE (t) = type;
 
-  /* If we already have such a type, use the old one and free this one.  */
+  /* If we already have such a type, use the old one.  */
   hashcode = iterative_hash_object (TYPE_HASH (basetype), hashcode);
   hashcode = iterative_hash_object (TYPE_HASH (type), hashcode);
   t = type_hash_canon (hashcode, t);
@@ -4218,9 +4212,8 @@ build_complex_type (tree component_type)
   t = make_node (COMPLEX_TYPE);
 
   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
-  set_type_quals (t, TYPE_QUALS (component_type));
 
-  /* If we already have such a type, use the old one and free this one.  */
+  /* If we already have such a type, use the old one.  */
   hashcode = iterative_hash_object (TYPE_HASH (component_type), 0);
   t = type_hash_canon (hashcode, t);
 
@@ -4262,7 +4255,7 @@ build_complex_type (tree component_type)
 	TYPE_NAME (t) = get_identifier (name);
     }
 
-  return t;
+  return build_qualified_type (t, TYPE_QUALS (component_type));
 }
 
 /* Return OP, stripped of any conversions to wider types as much as is safe.