Index: elhash.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/elhash.c,v
retrieving revision 1.14.2.31
diff -u -r1.14.2.31 elhash.c
--- elhash.c	2000/11/06 05:43:11	1.14.2.31
+++ elhash.c	2000/12/31 14:09:17
@@ -434,36 +434,54 @@
 }
 
 Lisp_Object
-make_general_lisp_hash_table (enum hash_table_test test,
-			      size_t size,
-			      double rehash_size,
-			      double rehash_threshold,
-			      enum hash_table_weakness weakness)
+make_standard_lisp_hash_table (enum hash_table_test test,
+			       size_t size,
+			       double rehash_size,
+			       double rehash_threshold,
+			       enum hash_table_weakness weakness)
 {
-  Lisp_Object hash_table;
-  Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
+  hash_table_hash_function_t hash_function =  0;
+  hash_table_test_function_t test_function = 0;
 
   switch (test)
     {
     case HASH_TABLE_EQ:
-      ht->test_function = 0;
-      ht->hash_function = 0;
+      test_function = 0;
+      hash_function = 0;
       break;
 
     case HASH_TABLE_EQL:
-      ht->test_function = lisp_object_eql_equal;
-      ht->hash_function = lisp_object_eql_hash;
+      test_function = lisp_object_eql_equal;
+      hash_function = lisp_object_eql_hash;
       break;
 
     case HASH_TABLE_EQUAL:
-      ht->test_function = lisp_object_equal_equal;
-      ht->hash_function = lisp_object_equal_hash;
+      test_function = lisp_object_equal_equal;
+      hash_function = lisp_object_equal_hash;
       break;
 
     default:
       abort ();
     }
 
+  return make_general_lisp_hash_table (hash_function, test_function,
+				       size, rehash_size, rehash_threshold,
+				       weakness);
+}
+
+Lisp_Object
+make_general_lisp_hash_table (hash_table_hash_function_t hash_function,
+			      hash_table_test_function_t test_function,
+			      size_t size,
+			      double rehash_size,
+			      double rehash_threshold,
+			      enum hash_table_weakness weakness)
+{
+  Lisp_Object hash_table;
+  Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table);
+
+  ht->test_function = test_function;
+  ht->hash_function = hash_function;
   ht->weakness = weakness;
 
   ht->rehash_size =
@@ -505,7 +523,7 @@
 		      enum hash_table_weakness weakness,
 		      enum hash_table_test test)
 {
-  return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness);
+  return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness);
 }
 
 /* Pretty reading of hash tables.
@@ -722,7 +740,7 @@
     }
 
   /* Create the hash table.  */
-  hash_table = make_general_lisp_hash_table
+  hash_table = make_standard_lisp_hash_table
     (decode_hash_table_test (test),
      decode_hash_table_size (size),
      decode_hash_table_rehash_size (rehash_size),
@@ -872,7 +890,7 @@
   VALIDATE_VAR (rehash_threshold);
   VALIDATE_VAR (weakness);
 
-  return make_general_lisp_hash_table
+  return make_standard_lisp_hash_table
     (decode_hash_table_test (test),
      decode_hash_table_size (size),
      decode_hash_table_rehash_size (rehash_size),
@@ -1303,6 +1321,24 @@
 		  MARK_OBJ (e->key);
 		  MARK_OBJ (e->value);
 		}
+	  break;
+
+	  /* We seem to be sprouting new weakness types at an alarming
+	     rate. At least this is not externally visible - and in
+	     fact all of these KEY_CAR_* types are only used by the
+	     glyph code. */
+	case HASH_TABLE_KEY_CAR_VALUE_WEAK:
+	  for (; e < sentinel; e++)
+	    if (!HENTRY_CLEAR_P (e))
+	      {
+		if (!CONSP (e->key) || marked_p (XCAR (e->key)))
+		  {
+		    MARK_OBJ (e->key);
+		    MARK_OBJ (e->value);
+		  }
+		else if (marked_p (e->value))
+		  MARK_OBJ (e->key);
+	      }
 	  break;
 
 	case HASH_TABLE_VALUE_CAR_WEAK:
Index: elhash.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/elhash.h,v
retrieving revision 1.6.2.8
diff -u -r1.6.2.8 elhash.h
--- elhash.h	2000/05/30 11:14:56	1.6.2.8
+++ elhash.h	2000/12/31 14:09:17
@@ -41,6 +41,7 @@
   HASH_TABLE_KEY_VALUE_WEAK,
   HASH_TABLE_KEY_CAR_WEAK,
   HASH_TABLE_VALUE_CAR_WEAK,
+  HASH_TABLE_KEY_CAR_VALUE_WEAK,
   HASH_TABLE_WEAK
 };
 
@@ -66,7 +67,14 @@
 typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value,
 				   void* extra_arg);
 
-Lisp_Object make_general_lisp_hash_table (enum hash_table_test test,
+Lisp_Object make_standard_lisp_hash_table (enum hash_table_test test,
+					   size_t size,
+					   double rehash_size,
+					   double rehash_threshold,
+					   enum hash_table_weakness weakness);
+
+Lisp_Object make_general_lisp_hash_table (hash_table_hash_function_t hash_function,
+					  hash_table_test_function_t test_function,
 					  size_t size,
 					  double rehash_size,
 					  double rehash_threshold,
Index: glyphs.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.c,v
retrieving revision 1.23.2.87
diff -u -r1.23.2.87 glyphs.c
--- glyphs.c	2000/12/18 11:13:40	1.23.2.87
+++ glyphs.c	2000/12/31 14:09:29
@@ -382,7 +382,7 @@
 	 skip it. */
       if (!(dest_mask &
 	    IIFORMAT_METH (decode_image_instantiator_format
-			   (XVECTOR_DATA (typevec)[0], ERROR_ME),
+			   (INSTANTIATOR_TYPE (typevec), ERROR_ME),
 			   possible_dest_types, ())))
 	continue;
       if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
@@ -689,7 +689,7 @@
   int governing_domain;
 
   struct image_instantiator_methods *meths =
-    decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
+    decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
 				      ERROR_ME);
   governing_domain = IIFORMAT_METH_OR_GIVEN (meths, governing_domain, (),
 					     GOVERNING_DOMAIN_DEVICE);
@@ -742,7 +742,7 @@
 
     GCPRO1 (instantiator);
 
-    meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
+    meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
 					      ERROR_ME);
     RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
 					    (instantiator, contype, dest_mask),
@@ -765,20 +765,20 @@
   struct gcpro gcpro1;
 
   GCPRO1 (ii);
-  if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0],
+  if (!valid_image_instantiator_format_p (INSTANTIATOR_TYPE (instantiator),
 					  DOMAIN_DEVICE (governing_domain)))
     signal_simple_error
       ("Image instantiator format is invalid in this locale.",
        instantiator);
 
-  meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
+  meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
 					    ERROR_ME);
   MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
 					    pointer_bg, dest_mask, domain));
 
   /* Now do device specific instantiation. */
   device_meths = decode_device_ii_format (DOMAIN_DEVICE (governing_domain),
-					  XVECTOR_DATA (instantiator)[0],
+					  INSTANTIATOR_TYPE (instantiator),
 					  ERROR_ME_NOT);
 
   if (!HAS_IIFORMAT_METH_P (meths, instantiate)
@@ -1469,7 +1469,7 @@
   GCPRO1 (data);
   /* After normalizing the data, it's always either an image instance (which
      we filtered out above) or a vector. */
-  if (EQ (XVECTOR_DATA (data)[0], Qinherit))
+  if (EQ (INSTANTIATOR_TYPE (data), Qinherit))
     signal_simple_error ("Inheritance not allowed here", data);
   governing_domain =
     get_image_instantiator_governing_domain (data, domain);
@@ -3054,6 +3054,44 @@
   mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
 }
 
+static int
+instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2)
+{
+  if (EQ (obj1, obj2))
+    return 1;
+
+  else if (CONSP (obj1) && CONSP (obj2))
+    {
+      return instantiator_eq_equal (XCAR (obj1), XCAR (obj2))
+	&&
+	instantiator_eq_equal (XCDR (obj1), XCDR (obj2));
+    }
+  return 0;
+}
+
+static hashcode_t
+instantiator_eq_hash (Lisp_Object obj)
+{
+  if (CONSP (obj))
+    {
+      /* no point in worrying about tail recursion, since we're not
+	 going very deep */
+      return HASH2 (instantiator_eq_hash (XCAR (obj)),
+		    instantiator_eq_hash (XCDR (obj)));
+    }
+  return LISP_HASH (obj);
+}
+
+/* We need a special hash table for storing image instances. */
+Lisp_Object
+make_image_instance_cache_hash_table ()
+{
+  return make_general_lisp_hash_table
+    (instantiator_eq_hash, instantiator_eq_equal,
+     30, -1.0, -1.0,
+     HASH_TABLE_KEY_CAR_VALUE_WEAK);
+}
+
 static Lisp_Object
 image_instantiate_cache_result (Lisp_Object locative)
 {
@@ -3110,7 +3148,7 @@
 			       instantiator, domain);
     }
   else if (VECTORP (instantiator)
-	   && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
+	   && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit))
     {
       assert (XVECTOR_LENGTH (instantiator) == 3);
       return (FACE_PROPERTY_INSTANCE
@@ -3121,7 +3159,8 @@
     {
       Lisp_Object instance = Qnil;
       Lisp_Object subtable = Qnil;
-      Lisp_Object ls3 = Qnil;
+      /* #### Should this be GCPRO'd? */
+      Lisp_Object hash_key = Qnil;
       Lisp_Object pointer_fg = Qnil;
       Lisp_Object pointer_bg = Qnil;
       Lisp_Object governing_domain =
@@ -3139,8 +3178,15 @@
 	{
 	  pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
 	  pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
-	  ls3 = list3 (glyph, pointer_fg, pointer_bg);
+	  hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator), 
+			    pointer_fg, pointer_bg);
 	}
+      else
+	/* We cannot simply key on the glyph since fallbacks could use
+	   the same glyph but have a totally different instantiator
+	   type. Thus we key on the glyph and the type (but not any
+	   other parts of the instantiator. */
+	hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator));
 
       /* First look in the device cache. */
       if (DEVICEP (governing_domain))
@@ -3167,20 +3213,15 @@
 		 have to use EQUAL because we massaged the
 		 instantiator into a cons3 also containing the
 		 foreground and background of the pointer face.  */
+	      subtable = make_image_instance_cache_hash_table ();
 
-	      subtable = make_lisp_hash_table
-		(20, pointerp ? HASH_TABLE_KEY_CAR_WEAK
-		 : HASH_TABLE_KEY_WEAK,
-		 pointerp ? HASH_TABLE_EQUAL
-		 : HASH_TABLE_EQ);
 	      Fputhash (make_int (dest_mask), subtable,
 			XDEVICE (governing_domain)->image_instance_cache);
 	      instance = Qunbound;
 	    }
 	  else
 	    {
-	      instance = Fgethash (pointerp ? ls3 : glyph,
-				   subtable, Qunbound);
+	      instance = Fgethash (hash_key, subtable, Qunbound);
 	    }
 	}
       else if (WINDOWP (governing_domain))
@@ -3188,7 +3229,7 @@
 	  /* Subwindows have a per-window cache and have to be treated
 	     differently. */
 	  instance =
-	    Fgethash (pointerp ? ls3 : glyph,
+	    Fgethash (hash_key,
 		      XWINDOW (governing_domain)->subwindow_instance_cache,
 		      Qunbound);
 	}
@@ -3201,7 +3242,7 @@
 	{
 	  Lisp_Object locative =
 	    noseeum_cons (Qnil,
-			  noseeum_cons (pointerp ? ls3 : glyph,
+			  noseeum_cons (hash_key,
 					DEVICEP (governing_domain) ? subtable
 					: XWINDOW (governing_domain)
 					->subwindow_instance_cache));
@@ -3234,7 +3275,7 @@
 #ifdef ERROR_CHECK_GLYPHS
 	  if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
 	      & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
-	    assert (EQ (Fgethash ((pointerp ? ls3 : glyph),
+	    assert (EQ (Fgethash (hash_key,
 				  XWINDOW (governing_domain)
 				  ->subwindow_instance_cache,
 				  Qunbound), instance));
@@ -3258,7 +3299,7 @@
 	     possible to make changes that don't get reflected in the
 	     display. */
 	  update_image_instance (instance, instantiator);
-	  free_list (ls3);
+	  free_list (hash_key);
 	}
 
 #ifdef ERROR_CHECK_GLYPHS
Index: glyphs.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.h,v
retrieving revision 1.18.2.60
diff -u -r1.18.2.60 glyphs.h
--- glyphs.h	2000/11/06 05:43:12	1.18.2.60
+++ glyphs.h	2000/12/31 14:09:32
@@ -327,6 +327,8 @@
 #define IIFORMAT_INHERITS_SHARED_DEVMETHOD(type, from, format, m, fromformat) \
   (type##_##format##_image_instantiator_methods->m##_method = from##_##fromformat##_##m)
 
+#define INSTANTIATOR_TYPE(inst) (XVECTOR_DATA ((inst))[0])
+
 struct image_instantiator_methods *
 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
 			 Error_behavior errb);
@@ -374,6 +376,7 @@
 		   int width, int height, int xoffset, int yoffset,
 		   Lisp_Object domain);
 int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w);
+Lisp_Object make_image_instance_cache_hash_table ();
 
 DECLARE_DOESNT_RETURN (incompatible_image_types (Lisp_Object instantiator,
                                                  int given_dest_mask,
Index: window.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/window.c,v
retrieving revision 1.41.2.69
diff -u -r1.41.2.69 window.c
--- window.c	2000/12/20 04:50:48	1.41.2.69
+++ window.c	2000/12/31 14:09:48
@@ -281,9 +281,8 @@
   p->face_cachels     = Dynarr_new (face_cachel);
   p->glyph_cachels    = Dynarr_new (glyph_cachel);
   p->line_start_cache = Dynarr_new (line_start_cache);
-  p->subwindow_instance_cache = make_lisp_hash_table (30,
-						      HASH_TABLE_KEY_VALUE_WEAK,
-						      HASH_TABLE_EQ);
+  p->subwindow_instance_cache = make_image_instance_cache_hash_table ();
+
   p->line_cache_last_updated = Qzero;
   INIT_DISP_VARIABLE (last_point_x, 0);
   INIT_DISP_VARIABLE (last_point_y, 0);
@@ -3604,9 +3603,7 @@
   p->face_cachels     = Dynarr_new (face_cachel);
   p->glyph_cachels    = Dynarr_new (glyph_cachel);
   p->subwindow_instance_cache =
-    make_lisp_hash_table (30,
-			  HASH_TABLE_KEY_VALUE_WEAK,
-			  HASH_TABLE_EQ);
+    make_image_instance_cache_hash_table ();
 
   /* Put new into window structure in place of window */
   replace_window (window, new);
@@ -5478,9 +5475,8 @@
 	     set. */
 	  if (NILP (w->subwindow_instance_cache))
 	    w->subwindow_instance_cache =
-	      make_lisp_hash_table (30,
-				    HASH_TABLE_KEY_VALUE_WEAK,
-				    HASH_TABLE_EQ);
+	      make_image_instance_cache_hash_table ();
+
 	  SET_LAST_MODIFIED (w, 1);
 	  SET_LAST_FACECHANGE (w);
 	  w->config_mark = 0;
