diff options
author | Dmitry Antipov <dmantipov@yandex.ru> | 2013-01-14 13:55:21 +0400 |
---|---|---|
committer | Dmitry Antipov <dmantipov@yandex.ru> | 2013-01-14 13:55:21 +0400 |
commit | 73ebd38f16c4799b657e501f188e9f3a3eca7805 (patch) | |
tree | 2584576d6931b14b336ac4ed3eb9eb513892da2c /src | |
parent | d6d02e06ee135655b604a12b0c53987988277a16 (diff) | |
download | emacs-73ebd38f16c4799b657e501f188e9f3a3eca7805.tar.gz |
Make Lisp_Save_Value more versatile storage for up to four objects.
* lisp.h (toplevel): Enumeration to describe types of saved objects.
(struct Lisp_Save_Value): New layout. Adjust comments.
(XSAVE_POINTER): New macro.
(XSAVE_INTEGER): Likewise.
(allocate_misc): Add prototype.
(free_misc): Likewise.
* alloc.c (allocate_misc): Now global.
(free_misc): Likewise. Adjust comment.
(make_save_value): Use new Lisp_Save_Value layout. Adjust comment.
(free_save_value): Likewise.
(mark_object): Likewise.
* editfns.c (save_excursion_save): Pack everything within
Lisp_Save_Value and so avoid xmalloc.
(save_excursion_restore): Adjust to match new layout. Use free_misc
because we do not allocate extra memory any more. Add eassert.
* print.c (print_object): New code to print Lisp_Save_Value. Do not
rely on valid_lisp_object_p if !GC_MARK_STACK. Adjust comments.
* dired.c, fileio.c, font.c, ftfont.c, gtkutil.c, keymap.c,
* lread.c, nsmenu.m, nsterm.h, xfns.c, xmenu.c, xselect.c:
Use XSAVE_POINTER and XSAVE_INTEGER where appropriate.
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 24 | ||||
-rw-r--r-- | src/alloc.c | 59 | ||||
-rw-r--r-- | src/dired.c | 2 | ||||
-rw-r--r-- | src/editfns.c | 51 | ||||
-rw-r--r-- | src/fileio.c | 2 | ||||
-rw-r--r-- | src/font.c | 2 | ||||
-rw-r--r-- | src/ftfont.c | 22 | ||||
-rw-r--r-- | src/gtkutil.c | 3 | ||||
-rw-r--r-- | src/keymap.c | 4 | ||||
-rw-r--r-- | src/lisp.h | 48 | ||||
-rw-r--r-- | src/lread.c | 2 | ||||
-rw-r--r-- | src/nsmenu.m | 3 | ||||
-rw-r--r-- | src/nsterm.h | 4 | ||||
-rw-r--r-- | src/print.c | 73 | ||||
-rw-r--r-- | src/xfns.c | 3 | ||||
-rw-r--r-- | src/xmenu.c | 17 | ||||
-rw-r--r-- | src/xselect.c | 2 |
17 files changed, 217 insertions, 104 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9096b904171..098d3ae027e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,27 @@ +2013-01-14 Dmitry Antipov <dmantipov@yandex.ru> + + Make Lisp_Save_Value more versatile storage for up to four objects. + * lisp.h (toplevel): Enumeration to describe types of saved objects. + (struct Lisp_Save_Value): New layout. Adjust comments. + (XSAVE_POINTER): New macro. + (XSAVE_INTEGER): Likewise. + (allocate_misc): Add prototype. + (free_misc): Likewise. + * alloc.c (allocate_misc): Now global. + (free_misc): Likewise. Adjust comment. + (make_save_value): Use new Lisp_Save_Value layout. Adjust comment. + (free_save_value): Likewise. + (mark_object): Likewise. + * editfns.c (save_excursion_save): Pack everything within + Lisp_Save_Value and so avoid xmalloc. + (save_excursion_restore): Adjust to match new layout. Use free_misc + because we do not allocate extra memory any more. Add eassert. + * print.c (print_object): New code to print Lisp_Save_Value. Do not + rely on valid_lisp_object_p if !GC_MARK_STACK. Adjust comments. + * dired.c, fileio.c, font.c, ftfont.c, gtkutil.c, keymap.c, + * lread.c, nsmenu.m, nsterm.h, xfns.c, xmenu.c, xselect.c: + Use XSAVE_POINTER and XSAVE_INTEGER where appropriate. + 2013-01-13 Jan Djärv <jan.h.d@swipnet.se> * nsfont.m (LCD_SMOOTHING_MARGIN): New define. diff --git a/src/alloc.c b/src/alloc.c index b147aa20723..c50bb0f32c7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -219,7 +219,6 @@ static void refill_memory_reserve (void); #endif static void compact_small_strings (void); static void free_large_strings (void); -static void free_misc (Lisp_Object); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; /* When scanning the C stack for live Lisp objects, Emacs keeps track of @@ -3303,7 +3302,7 @@ static union Lisp_Misc *marker_free_list; /* Return a newly allocated Lisp_Misc object of specified TYPE. */ -static Lisp_Object +Lisp_Object allocate_misc (enum Lisp_Misc_Type type) { Lisp_Object val; @@ -3339,9 +3338,9 @@ allocate_misc (enum Lisp_Misc_Type type) return val; } -/* Free a Lisp_Misc object */ +/* Free a Lisp_Misc object. */ -static void +void free_misc (Lisp_Object misc) { XMISCTYPE (misc) = Lisp_Misc_Free; @@ -3351,9 +3350,10 @@ free_misc (Lisp_Object misc) total_free_markers++; } -/* Return a Lisp_Misc_Save_Value object containing POINTER and - INTEGER. This is used to package C values to call record_unwind_protect. - The unwind function can get the C values back using XSAVE_VALUE. */ +/* Return a Lisp_Save_Value object containing POINTER and INTEGER. + Most code should use this to package C integers and pointers + to call record_unwind_protect. The unwind function can get the + C values back using XSAVE_POINTER and XSAVE_INTEGER. */ Lisp_Object make_save_value (void *pointer, ptrdiff_t integer) @@ -3363,22 +3363,22 @@ make_save_value (void *pointer, ptrdiff_t integer) val = allocate_misc (Lisp_Misc_Save_Value); p = XSAVE_VALUE (val); - p->pointer = pointer; - p->integer = integer; - p->dogc = 0; + p->type0 = SAVE_POINTER; + p->data[0].pointer = pointer; + p->type1 = SAVE_INTEGER; + p->data[1].integer = integer; + p->type2 = p->type3 = SAVE_UNUSED; + p->area = 0; return val; } -/* Free a Lisp_Misc_Save_Value object. */ +/* Free a Lisp_Save_Value object. Do not use this function + if SAVE contains pointer other than returned by xmalloc. */ void free_save_value (Lisp_Object save) { - register struct Lisp_Save_Value *p = XSAVE_VALUE (save); - - p->dogc = 0; - xfree (p->pointer); - p->pointer = NULL; + xfree (XSAVE_POINTER (save)); free_misc (save); } @@ -5935,20 +5935,33 @@ mark_object (Lisp_Object arg) case Lisp_Misc_Save_Value: XMISCANY (obj)->gcmarkbit = 1; -#if GC_MARK_STACK { register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); - /* If DOGC is set, POINTER is the address of a memory - area containing INTEGER potential Lisp_Objects. */ - if (ptr->dogc) + /* If `area' is nonzero, `data[0].pointer' is the address + of a memory area containing `data[1].integer' potential + Lisp_Objects. */ +#if GC_MARK_STACK + if (ptr->area) { - Lisp_Object *p = (Lisp_Object *) ptr->pointer; + Lisp_Object *p = (Lisp_Object *) ptr->data[0].pointer; ptrdiff_t nelt; - for (nelt = ptr->integer; nelt > 0; nelt--, p++) + for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) mark_maybe_object (*p); } + else +#endif /* GC_MARK_STACK */ + { + /* Find Lisp_Objects in `data[N]' slots and mark them. */ + if (ptr->type0 == SAVE_OBJECT) + mark_object (ptr->data[0].object); + if (ptr->type1 == SAVE_OBJECT) + mark_object (ptr->data[1].object); + if (ptr->type2 == SAVE_OBJECT) + mark_object (ptr->data[2].object); + if (ptr->type3 == SAVE_OBJECT) + mark_object (ptr->data[3].object); + } } -#endif break; case Lisp_Misc_Overlay: diff --git a/src/dired.c b/src/dired.c index b4dc702112e..77e89c6e6b3 100644 --- a/src/dired.c +++ b/src/dired.c @@ -78,7 +78,7 @@ directory_files_internal_w32_unwind (Lisp_Object arg) static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { - DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer; + DIR *d = (DIR *) XSAVE_POINTER (dh); block_input (); closedir (d); unblock_input (); diff --git a/src/editfns.c b/src/editfns.c index bf19acb42a8..feac17f64b8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -833,20 +833,30 @@ This function does not move point. */) Lisp_Object save_excursion_save (void) { - Lisp_Object save, *data = xmalloc (word_size * 4); + Lisp_Object save = allocate_misc (Lisp_Misc_Save_Value); + register struct Lisp_Save_Value *v = XSAVE_VALUE (save); + + /* Do not allocate extra space and pack everything in SAVE. */ + v->area = 0; + + v->type0 = SAVE_OBJECT; + v->data[0].object = Fpoint_marker (); - data[0] = Fpoint_marker (); /* Do not copy the mark if it points to nowhere. */ - data[1] = (XMARKER (BVAR (current_buffer, mark))->buffer - ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) - : Qnil); + v->type1 = SAVE_OBJECT; + v->data[1].object = (XMARKER (BVAR (current_buffer, mark))->buffer + ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) + : Qnil); + /* Selected window if current buffer is shown in it, nil otherwise. */ - data[2] = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) - ? selected_window : Qnil); - data[3] = BVAR (current_buffer, mark_active); + v->type2 = SAVE_OBJECT; + v->data[2].object + = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) + ? selected_window : Qnil); + + v->type3 = SAVE_OBJECT; + v->data[3].object = BVAR (current_buffer, mark_active); - save = make_save_value (data, 4); - XSAVE_VALUE (save)->dogc = 1; return save; } @@ -855,10 +865,15 @@ save_excursion_save (void) Lisp_Object save_excursion_restore (Lisp_Object info) { - Lisp_Object tem, tem1, omark, nmark, *data = XSAVE_VALUE (info)->pointer; + Lisp_Object tem, tem1, omark, nmark; struct gcpro gcpro1, gcpro2, gcpro3; + register struct Lisp_Save_Value *v = XSAVE_VALUE (info); + + /* Paranoid. */ + eassert (v->type0 == SAVE_OBJECT && v->type1 == SAVE_OBJECT + && v->type2 == SAVE_OBJECT && v->type3 == SAVE_OBJECT); - tem = Fmarker_buffer (data[0]); + tem = Fmarker_buffer (v->data[0].object); /* If we're unwinding to top level, saved buffer may be deleted. This means that all of its markers are unchained and so tem is nil. */ if (NILP (tem)) @@ -870,12 +885,12 @@ save_excursion_restore (Lisp_Object info) Fset_buffer (tem); /* Point marker. */ - tem = data[0]; + tem = v->data[0].object; Fgoto_char (tem); unchain_marker (XMARKER (tem)); /* Mark marker. */ - tem = data[1]; + tem = v->data[1].object; omark = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (tem)) unchain_marker (XMARKER (BVAR (current_buffer, mark))); @@ -887,7 +902,7 @@ save_excursion_restore (Lisp_Object info) } /* Mark active. */ - tem = data[3]; + tem = v->data[3].object; tem1 = BVAR (current_buffer, mark_active); bset_mark_active (current_buffer, tem); @@ -911,7 +926,7 @@ save_excursion_restore (Lisp_Object info) /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this buffer, restore point in that window. */ - tem = data[2]; + tem = v->data[2].object; if (WINDOWP (tem) && !EQ (tem, selected_window) && (tem1 = XWINDOW (tem)->buffer, @@ -925,7 +940,7 @@ save_excursion_restore (Lisp_Object info) out: - free_save_value (info); + free_misc (info); return Qnil; } @@ -4258,7 +4273,7 @@ usage: (format STRING &rest OBJECTS) */) memcpy (buf, initial_buffer, used); } else - XSAVE_VALUE (buf_save_value)->pointer = buf = xrealloc (buf, bufsize); + XSAVE_POINTER (buf_save_value) = buf = xrealloc (buf, bufsize); p = buf + used; } diff --git a/src/fileio.c b/src/fileio.c index 5e9b36ee44a..67b4b884bc0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5507,7 +5507,7 @@ static Lisp_Object do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ { - FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + FILE *stream = (FILE *) XSAVE_POINTER (arg); auto_saving = 0; if (stream != NULL) { diff --git a/src/font.c b/src/font.c index a3a41006f9b..c4153428147 100644 --- a/src/font.c +++ b/src/font.c @@ -1857,7 +1857,7 @@ otf_open (Lisp_Object file) OTF *otf; if (! NILP (val)) - otf = XSAVE_VALUE (XCDR (val))->pointer; + otf = XSAVE_POINTER (XCDR (val)); else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; diff --git a/src/ftfont.c b/src/ftfont.c index 1ada95d377c..1d7678bfe09 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -393,16 +393,14 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) cache_data = xmalloc (sizeof *cache_data); cache_data->ft_face = NULL; cache_data->fc_charset = NULL; - val = make_save_value (NULL, 0); - XSAVE_VALUE (val)->integer = 0; - XSAVE_VALUE (val)->pointer = cache_data; + val = make_save_value (cache_data, 0); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } else { val = XCDR (cache); - cache_data = XSAVE_VALUE (val)->pointer; + cache_data = XSAVE_POINTER (val); } if (cache_for == FTFONT_CACHE_FOR_ENTITY) @@ -468,7 +466,7 @@ ftfont_get_fc_charset (Lisp_Object entity) cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET); val = XCDR (cache); - cache_data = XSAVE_VALUE (val)->pointer; + cache_data = XSAVE_POINTER (val); return cache_data->fc_charset; } @@ -1200,9 +1198,9 @@ ftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) filename = XCAR (val); idx = XCDR (val); val = XCDR (cache); - cache_data = XSAVE_VALUE (XCDR (cache))->pointer; + cache_data = XSAVE_POINTER (XCDR (cache)); ft_face = cache_data->ft_face; - if (XSAVE_VALUE (val)->integer > 0) + if (XSAVE_INTEGER (val) > 0) { /* FT_Face in this cache is already used by the different size. */ if (FT_New_Size (ft_face, &ft_size) != 0) @@ -1213,13 +1211,13 @@ ftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) return Qnil; } } - XSAVE_VALUE (val)->integer++; + XSAVE_INTEGER (val)++; size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (XSAVE_VALUE (val)->integer == 0) + if (XSAVE_INTEGER (val) == 0) FT_Done_Face (ft_face); return Qnil; } @@ -1328,10 +1326,10 @@ ftfont_close (FRAME_PTR f, struct font *font) cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - (XSAVE_VALUE (val)->integer)--; - if (XSAVE_VALUE (val)->integer == 0) + (XSAVE_INTEGER (val))--; + if (XSAVE_INTEGER (val) == 0) { - struct ftfont_cache_data *cache_data = XSAVE_VALUE (val)->pointer; + struct ftfont_cache_data *cache_data = XSAVE_POINTER (val); FT_Done_Face (cache_data->ft_face); #ifdef HAVE_LIBOTF diff --git a/src/gtkutil.c b/src/gtkutil.c index af845f69e62..3b1bbc73cff 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1650,8 +1650,7 @@ xg_dialog_response_cb (GtkDialog *w, static Lisp_Object pop_down_dialog (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - struct xg_dialog_data *dd = (struct xg_dialog_data *) p->pointer; + struct xg_dialog_data *dd = (struct xg_dialog_data *) XSAVE_POINTER (arg); block_input (); if (dd->w) gtk_widget_destroy (dd->w); diff --git a/src/keymap.c b/src/keymap.c index d1ddd55a358..7b5aa45ebf3 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -566,14 +566,14 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) if (!NILP (val)) { map_keymap_function_t fun - = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; + = (map_keymap_function_t) XSAVE_POINTER (XCAR (args)); args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); map_keymap_item (fun, XCDR (args), key, val, - XSAVE_VALUE (XCAR (args))->pointer); + XSAVE_POINTER (XCAR (args))); } } diff --git a/src/lisp.h b/src/lisp.h index 3b7af46fdde..39e12835d98 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1378,20 +1378,48 @@ struct Lisp_Overlay Lisp_Object plist; }; -/* Hold a C pointer for later use. - This type of object is used in the arg to record_unwind_protect. */ +/* Types of data which may be saved in a Lisp_Save_Value. */ + +enum + { + SAVE_UNUSED, + SAVE_INTEGER, + SAVE_POINTER, + SAVE_OBJECT + }; + +/* Special object used to hold a different values for later use. */ + struct Lisp_Save_Value { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ unsigned gcmarkbit : 1; - int spacer : 14; - /* If DOGC is set, POINTER is the address of a memory - area containing INTEGER potential Lisp_Objects. */ - unsigned int dogc : 1; - void *pointer; - ptrdiff_t integer; + int spacer : 6; + /* If `area' is nonzero, `data[0].pointer' is the address of a memory area + containing `data[1].integer' potential Lisp_Objects. The rest of `data' + fields are unused. */ + unsigned area : 1; + /* If `area' is zero, `data[N]' may hold different objects which type is + encoded in `typeN' fields as described by the anonymous enum above. + E.g. if `type0' is SAVE_INTEGER, `data[0].integer' is in use. */ + unsigned type0 : 2; + unsigned type1 : 2; + unsigned type2 : 2; + unsigned type3 : 2; + union { + void *pointer; + ptrdiff_t integer; + Lisp_Object object; + } data[4]; }; +/* Compatibility macro to set and extract saved pointer. */ + +#define XSAVE_POINTER(obj) XSAVE_VALUE (obj)->data[0].pointer + +/* Likewise for the saved ingeger. */ + +#define XSAVE_INTEGER(obj) XSAVE_VALUE (obj)->data[1].integer /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free @@ -2893,6 +2921,8 @@ extern void memory_warnings (void *, void (*warnfun) (const char *)); /* Defined in alloc.c. */ extern void check_pure_size (void); +extern Lisp_Object allocate_misc (enum Lisp_Misc_Type); +extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); @@ -3695,7 +3725,7 @@ extern void *record_xmalloc (size_t); Lisp_Object arg_; \ buf = xmalloc ((nelt) * word_size); \ arg_ = make_save_value (buf, nelt); \ - XSAVE_VALUE (arg_)->dogc = 1; \ + XSAVE_VALUE (arg_)->area = 1; \ sa_must_free = 1; \ record_unwind_protect (safe_alloca_unwind, arg_); \ } \ diff --git a/src/lread.c b/src/lread.c index 2b96dc16359..35b61cbad4d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1357,7 +1357,7 @@ Return t if the file exists and loads successfully. */) static Lisp_Object load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ { - FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + FILE *stream = (FILE *) XSAVE_POINTER (arg); if (stream != NULL) { block_input (); diff --git a/src/nsmenu.m b/src/nsmenu.m index 39797d414f0..4e81b3201c8 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1347,8 +1347,7 @@ struct Popdown_data static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - struct Popdown_data *unwind_data = (struct Popdown_data *) p->pointer; + struct Popdown_data *unwind_data = (struct Popdown_data *) XSAVE_POINTER (arg); block_input (); if (popup_activated_flag) diff --git a/src/nsterm.h b/src/nsterm.h index e58b8493c94..7732e6d27cc 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -675,9 +675,9 @@ struct x_output #define FRAME_FONT(f) ((f)->output_data.ns->font) #ifdef __OBJC__ -#define XNS_SCROLL_BAR(vec) ((id) XSAVE_VALUE (vec)->pointer) +#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec)) #else -#define XNS_SCROLL_BAR(vec) XSAVE_VALUE (vec)->pointer +#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec) #endif /* Compute pixel size for vertical scroll bars */ diff --git a/src/print.c b/src/print.c index e87bbcce0e7..0ae83cdf6d2 100644 --- a/src/print.c +++ b/src/print.c @@ -2027,8 +2027,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag PRINTCHAR ('>'); break; - /* Remaining cases shouldn't happen in normal usage, but let's print - them anyway for the benefit of the debugger. */ + /* Remaining cases shouldn't happen in normal usage, but let's + print them anyway for the benefit of the debugger. */ + case Lisp_Misc_Free: strout ("#<misc free cell>", -1, -1, printcharfun); break; @@ -2039,20 +2040,28 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag struct Lisp_Save_Value *v = XSAVE_VALUE (obj); strout ("#<save-value ", -1, -1, printcharfun); - if (v->dogc) + + if (v->area) { - int lim = min (v->integer, 8); - - /* Try to print up to 8 objects we have saved. Although - valid_lisp_object_p is slow, this shouldn't be a real - bottleneck because such a saved values are quite rare. */ + ptrdiff_t amount = v->data[1].integer; + +#if GC_MARK_STACK + + /* If GC_MARK_STACK, valid_lisp_object_p is quite reliable, + and so we try to print up to 8 objects we have saved. + Although valid_lisp_object_p is slow, this shouldn't be + a real bottleneck because we do not use this code under + normal circumstances. */ - i = sprintf (buf, "with %"pD"d objects", v->integer); + int limit = min (amount, 8); + Lisp_Object *area = (Lisp_Object *) v->data[0].pointer; + + i = sprintf (buf, "with %"pD"d objects", amount); strout (buf, i, i, printcharfun); - for (i = 0; i < lim; i++) + for (i = 0; i < limit; i++) { - Lisp_Object maybe = ((Lisp_Object *) v->pointer)[i]; + Lisp_Object maybe = area[i]; if (valid_lisp_object_p (maybe) > 0) { @@ -2062,13 +2071,49 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag else strout (" <invalid>", -1, -1, printcharfun); } - if (i == lim && i < v->integer) + if (i == limit && i < amount) strout (" ...", 4, 4, printcharfun); + +#else /* not GC_MARK_STACK */ + + /* If !GC_MARK_STACK, we have no reliable way to find + whether Lisp_Object pointers points to an initialized + objects, and so we do not ever trying to print them. */ + + i = sprintf (buf, "with %"pD"d objects", amount); + strout (buf, i, i, printcharfun); + +#endif /* GC_MARK_STACK */ } else { - i = sprintf (buf, "ptr=%p int=%"pD"d", v->pointer, v->integer); - strout (buf, i, i, printcharfun); + /* Print each `data[N]' slot according to its type. */ + +#define PRINTX(index) \ + do { \ + i = 0; \ + if (v->type ## index == SAVE_UNUSED) \ + i = sprintf (buf, "<unused>"); \ + else if (v->type ## index == SAVE_INTEGER) \ + i = sprintf (buf, "<integer %"pD"d>", v->data[index].integer); \ + else if (v->type ## index == SAVE_POINTER) \ + i = sprintf (buf, "<pointer %p>", v->data[index].pointer); \ + else /* SAVE_OBJECT */ \ + print_object (v->data[index].object, printcharfun, escapeflag); \ + if (i) \ + strout (buf, i, i, printcharfun); \ + } while (0) + + PRINTX (0); + PRINTCHAR (' '); + PRINTX (1); + PRINTCHAR (' '); + PRINTX (2); + PRINTCHAR (' '); + PRINTX (3); + +#undef PRINTX + } PRINTCHAR ('>'); } diff --git a/src/xfns.c b/src/xfns.c index 315d5093716..245ffae3573 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5292,8 +5292,7 @@ file_dialog_unmap_cb (Widget widget, XtPointer client_data, XtPointer call_data) static Lisp_Object clean_up_file_dialog (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - Widget dialog = (Widget) p->pointer; + Widget dialog = (Widget) XSAVE_POINTER (arg); /* Clean up. */ block_input (); diff --git a/src/xmenu.c b/src/xmenu.c index 3d76070c336..cbb5a3dc77e 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1411,11 +1411,9 @@ popup_selection_callback (GtkWidget *widget, gpointer client_data) static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - popup_activated_flag = 0; block_input (); - gtk_widget_destroy (GTK_WIDGET (p->pointer)); + gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg))); unblock_input (); return Qnil; } @@ -1612,11 +1610,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, static Lisp_Object cleanup_widget_value_tree (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - widget_value *wv = p->pointer; - - free_menubar_widget_value_tree (wv); - + free_menubar_widget_value_tree ((widget_value *) XSAVE_POINTER (arg)); return Qnil; } @@ -2242,11 +2236,8 @@ menu_help_callback (char const *help_string, int pane, int item) static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg)); - struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg)); - - FRAME_PTR f = p1->pointer; - XMenu *menu = p2->pointer; + FRAME_PTR f = XSAVE_POINTER (Fcar (arg)); + XMenu *menu = XSAVE_POINTER (Fcdr (arg)); block_input (); #ifndef MSDOS diff --git a/src/xselect.c b/src/xselect.c index f43efab827b..9abfb2931f8 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1120,7 +1120,7 @@ unexpect_property_change (struct prop_location *location) static Lisp_Object wait_for_property_change_unwind (Lisp_Object loc) { - struct prop_location *location = XSAVE_VALUE (loc)->pointer; + struct prop_location *location = XSAVE_POINTER (loc); unexpect_property_change (location); if (location == property_change_reply_object) |