Andy Piper <andy(a)xemacs.org> writes:
> Maybe we need a new kind of weak hashtable - where the pair get removed
> only if both the key and the value are unmarked.
Ok.. I did the put "Fcons(instance,Qnil)" in the cache thing..
No crashes thus far
korteweg:/scratch/xemacs/xemacs-20/src> cvs diff glyphs.c window.c redisplay-output.c lisp.h alloc.c eval.c
Index: glyphs.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/glyphs.c,v
retrieving revision 1.23.2.72
diff -u -r1.23.2.72 glyphs.c
--- glyphs.c 2000/05/23 10:53:41 1.23.2.72
+++ glyphs.c 2000/05/26 20:57:49
＠＠ -73,6 +73,7 ＠＠
Lisp_Object Vimage_instance_type_list;
Lisp_Object Vglyph_type_list;
+
int disable_animated_pixmaps;
DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
＠＠ -562,7 +563,7 ＠＠
{
Lisp_Object window;
VOID_TO_LISP (window, flag_closure);
- assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window));
+ assert (EQ (XIMAGE_INSTANCE_DOMAIN (XCAR (value)), window));
}
return 0;
＠＠ -592,6 +593,71 ＠＠
check_window_subwindow_cache
(XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance)));
}
+
+int inhibit_sledge_hammer_check = 0;
+
+static int found_in_cache = 0;
+
+static int
+find_instance_mapper (Lisp_Object key, Lisp_Object value,
+ void *flag_closure)
+{
+ /* This function can GC */
+ /* value can be nil; we cache failures as well as successes */
+ if (!NILP (value))
+ {
+ Lisp_Object instance;
+
+ VOID_TO_LISP (instance, flag_closure);
+ if (EQ (XCAR (value), instance))
+ {
+ found_in_cache = 1;
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+static void
+check_image_instance_in_window_cache (Lisp_Object instance)
+{
+ struct window *w;
+
+ if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance)))
+ {
+ w = XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance));
+
+ assert (!NILP (w->subwindow_instance_cache));
+
+ found_in_cache = 0;
+
+ elisp_maphash (find_instance_mapper,
+ w->subwindow_instance_cache,
+ LISP_TO_VOID (instance));
+
+ assert (found_in_cache);
+ }
+}
+
+void
+check_subwindow_instance_caches (void)
+{
+ Lisp_Object frmcons, devcons, concons;
+
+ if (inhibit_sledge_hammer_check)
+ return;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ Lisp_Object rest;
+
+ LIST_LOOP (rest, XWEAK_LIST_LIST
+ (FRAME_SUBWINDOW_CACHE (XFRAME (XCAR (frmcons)))))
+ check_image_instance_in_window_cache (XCAR (XCAR (rest)));
+ }
+}
+
#endif
/* Determine what kind of domain governs the image instance.
＠＠ -2953,7 +3019,7 ＠＠
static Lisp_Object
image_instantiate_cache_result (Lisp_Object locative)
{
- /* locative = (instance instantiator . subtable)
+ /* locative = ((instance . nil) instantiator . subtable)
So we are using the instantiator as the key and the instance as
the value. Since the hashtable is key-weak this means that the
＠＠ -2967,10 +3033,23 ＠＠
return Qnil;
}
+/* The hashvalue is one of
+ - Qnil
+ - (instance . Qnil) */
+static Lisp_Object
+gethashcar (Lisp_Object key, Lisp_Object table)
+{
+ Lisp_Object result = Fgethash (key, table, Qunbound);
+ if (CONSP (result))
+ return XCAR (result);
+ else
+ return result;
+}
+
+
/* Given a specification for an image, return an instance of
the image which matches the given instantiator and which can be
displayed in the given domain. */
-
static Lisp_Object
image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
Lisp_Object domain, Lisp_Object instantiator,
＠＠ -3038,10 +3117,9 ＠＠
/* First look in the device cache. */
if (DEVICEP (governing_domain))
{
- subtable = Fgethash (make_int (dest_mask),
+ subtable = gethashcar (make_int (dest_mask),
XDEVICE (governing_domain)->
- image_instance_cache,
- Qunbound);
+ image_instance_cache);
if (UNBOUNDP (subtable))
{
/* For the image instance cache, we do comparisons with
＠＠ -3066,14 +3144,14 ＠＠
: HASH_TABLE_KEY_WEAK,
pointerp ? HASH_TABLE_EQUAL
: HASH_TABLE_EQ);
- Fputhash (make_int (dest_mask), subtable,
+ Fputhash (make_int (dest_mask), Fcons (subtable, Qnil),
XDEVICE (governing_domain)->image_instance_cache);
instance = Qunbound;
}
else
{
- instance = Fgethash (pointerp ? ls3 : instantiator,
- subtable, Qunbound);
+ instance = gethashcar (pointerp ? ls3 : instantiator,
+ subtable);
}
}
else if (WINDOWP (governing_domain))
＠＠ -3081,9 +3159,8 ＠＠
/* Subwindows have a per-window cache and have to be treated
differently. */
instance =
- Fgethash (instantiator,
- XWINDOW (governing_domain)->subwindow_instance_cache,
- Qunbound);
+ gethashcar (instantiator,
+ XWINDOW (governing_domain)->subwindow_instance_cache);
}
else
abort (); /* We're not allowed anything else currently. */
＠＠ -3092,6 +3169,7 ＠＠
one. */
if (UNBOUNDP (instance))
{
+ Lisp_Object instance_cons;
Lisp_Object locative =
noseeum_cons (Qnil,
noseeum_cons (pointerp ? ls3 : instantiator,
＠＠ -3113,10 +3191,14 ＠＠
pointer_fg, pointer_bg,
dest_mask, glyph);
+ /* Create a private object to share between the window and
+ frame cache */
+ instance_cons = Fcons(instance, Qnil);
+
/* We need a per-frame cache for redisplay. */
- cache_subwindow_instance_in_frame_maybe (instance);
+ cache_subwindow_instance_in_frame_maybe (instance_cons);
- Fsetcar (locative, instance);
+ Fsetcar (locative, instance_cons);
#ifdef ERROR_CHECK_GLYPHS
if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
& (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
＠＠ -3127,10 +3209,10 ＠＠
#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 : instantiator),
+ assert (EQ (gethashcar ((pointerp ? ls3 : instantiator),
XWINDOW (governing_domain)
- ->subwindow_instance_cache,
- Qunbound), instance));
+ ->subwindow_instance_cache),
+ instance));
#endif
}
else
＠＠ -3144,6 +3226,7 ＠＠
& (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
DOMAIN_FRAME (domain)));
+ check_subwindow_instance_caches();
#endif
ERROR_CHECK_IMAGE_INSTANCE (instance);
return instance;
＠＠ -4147,15 +4230,15 ＠＠
doing it every time something gets mapped, and deleted instances will be
removed automatically. */
static void
-cache_subwindow_instance_in_frame_maybe (Lisp_Object instance)
+cache_subwindow_instance_in_frame_maybe (Lisp_Object instance_cons)
{
- Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance);
+ Lisp_Image_Instance* ii = XIMAGE_INSTANCE (XCAR (instance_cons));
if (image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
& (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))
{
struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii));
XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
- = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
+ = Fcons (instance_cons, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
}
}
＠＠ -4171,10 +4254,11 ＠＠
LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
{
- Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
+ Lisp_Object instance = XCAR (XCAR (rest));
+ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (instance);
/* Make sure that the subwindow is unmapped so that window
deletion will not try and do it again. */
- unmap_subwindow (XCAR (rest));
+ unmap_subwindow (instance);
finalize_image_instance (ii, 0);
}
}
＠＠ -4187,12 +4271,13 ＠＠
LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
{
- Lisp_Object value = XCAR (rest);
+
+ Lisp_Object item = XCAR (rest);
/* Make sure that the subwindow is unmapped so that window
deletion will not try and do it again. */
- unmap_subwindow (value);
+ unmap_subwindow (XCAR (item));
XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
- = delq_no_quit (value, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
+ = delq_no_quit (item, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
}
}
＠＠ -4290,7 +4375,7 ＠＠
LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
{
- Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
+ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (XCAR (rest)));
if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)
&&
＠＠ -4404,7 +4489,7 ＠＠
/* If we get called we know something has changed. */
LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
{
- Lisp_Object widget = XCAR (rest);
+ Lisp_Object widget = XCAR (XCAR (rest));
if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget)
&&
Index: window.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/window.c,v
retrieving revision 1.41.2.52
diff -u -r1.41.2.52 window.c
--- window.c 2000/05/11 10:29:37 1.41.2.52
+++ window.c 2000/05/26 20:58:18
＠＠ -1603,9 +1603,10 ＠＠
(window))
{
struct window *w = decode_window (window);
+ struct frame *f = XFRAME (w->frame);
- int left = w->pixel_left;
- int top = w->pixel_top;
+ int left = w->pixel_left - FRAME_LEFT_BORDER_END (f) - FRAME_LEFT_GUTTER_BOUNDS(f);
+ int top = w->pixel_top - FRAME_TOP_BORDER_END (f) - FRAME_TOP_GUTTER_BOUNDS(f);;
return list4 (make_int (left),
make_int (top),
＠＠ -1878,8 +1879,8 ＠＠
/* value can be nil; we cache failures as well as successes */
if (!NILP (value))
{
- struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value));
- unmap_subwindow (value);
+ struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (XCAR (value)));
+ unmap_subwindow (XCAR (value));
/* In case GC doesn't catch up fast enough, remove from the frame
cache also. Otherwise code that checks the sanity of the instance
will fail. */
＠＠ -1941,6 +1942,8 ＠＠
they don't sit around consuming excess space. They will be
reinitialized by the window-configuration code as necessary. */
finalize_window ((void *) w, 0);
+
+ check_subwindow_instance_caches();
}
DEFUN ("delete-window", Fdelete_window, 0, 2, "", /*
＠＠ -3539,6 +3542,8 ＠＠
p->pointm[CMOTION_DISP] = Qnil;
p->sb_point = Qnil;
p->buffer = Qnil;
+
+ check_subwindow_instance_caches();
}
DEFUN ("split-window", Fsplit_window, 0, 3, "", /*
＠＠ -5218,7 +5223,16 ＠＠
/* Force subwindows to be reinstantiated. They are all going
anyway and if we don't do this GC may not happen between now
- and the next time we check their integrity. */
+ and the next time we check their integrity.
+
+ #### JV: I don't understand this comment. Trying to be smart like
+ this and trying to do redisplay's work can cause problems
+ (See also comment in unmap_subwindow). In fact I don't follow
+ "all are going anyway" at all. Most calls of
+ Fset_windows_configuration
+ happen as part of save-window-excursion and have no redisplay
+ during the existance of the new state.
+ */
reset_frame_subwindow_instance_cache (f);
#if 0
＠＠ -5601,6 +5615,8 ＠＠
UNGCPRO;
+ check_subwindow_instance_caches();
+
return Qnil;
}
Index: redisplay-output.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/redisplay-output.c,v
retrieving revision 1.11.2.39
diff -u -r1.11.2.39 redisplay-output.c
--- redisplay-output.c 2000/05/22 09:52:57 1.11.2.39
+++ redisplay-output.c 2000/05/26 20:58:30
＠＠ -1168,7 +1168,7 ＠＠
LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
{
- Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
+ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (XCAR (rest)));
if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)
&&
＠＠ -1184,7 +1184,7 ＠＠
&&
!EQ (XCAR (rest), ignored_window))
{
- unmap_subwindow (XCAR (rest));
+ unmap_subwindow (XCAR (XCAR (rest)));
}
}
}
Index: lisp.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/lisp.h,v
retrieving revision 1.38.2.64
diff -u -r1.38.2.64 lisp.h
--- lisp.h 2000/05/21 01:40:39 1.38.2.64
+++ lisp.h 2000/05/26 20:58:44
＠＠ -2351,6 +2351,9 ＠＠
/* Defined in glyphs.c */
Error_behavior decode_error_behavior_flag (Lisp_Object);
Lisp_Object encode_error_behavior_flag (Error_behavior);
+#ifdef ERROR_CHECK_GLYPHS
+void check_subwindow_instance_caches (void);
+#endif
/* Defined in indent.c */
int bi_spaces_at_point (struct buffer *, Bytind);
Index: alloc.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/alloc.c,v
retrieving revision 1.42.2.61
diff -u -r1.42.2.61 alloc.c
--- alloc.c 2000/05/01 11:00:02 1.42.2.61
+++ alloc.c 2000/05/26 20:59:04
＠＠ -3353,6 +3353,8 ＠＠
f = XFRAME (frame);
}
+ check_subwindow_instance_caches();
+
pre_gc_cursor = Qnil;
cursor_changed = 0;
＠＠ -3561,6 +3563,8 ＠＠
/* now stop inhibiting GC */
unbind_to (speccount, Qnil);
+
+ check_subwindow_instance_caches();
if (!breathing_space)
{
Index: eval.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/eval.c,v
retrieving revision 1.27.2.24
diff -u -r1.27.2.24 eval.c
--- eval.c 2000/05/17 07:35:45 1.27.2.24
+++ eval.c 2000/05/26 20:59:28
＠＠ -2939,6 +2939,10 ＠＠
UNGCPRO;
}
+#ifdef ERROR_CHECK_GLYPHS
+ check_subwindow_instance_caches ();
+#endif
+
if (++lisp_eval_depth > max_lisp_eval_depth)
{
if (max_lisp_eval_depth < 100)
＠＠ -3162,6 +3166,8 ＠＠
/* Callers should gcpro lexpr args */
garbage_collect_1 ();
+ check_subwindow_instance_caches();
+
if (++lisp_eval_depth > max_lisp_eval_depth)
{
if (max_lisp_eval_depth < 100)
