summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDmitry Antipov <dmantipov@yandex.ru>2013-01-14 13:55:21 +0400
committerDmitry Antipov <dmantipov@yandex.ru>2013-01-14 13:55:21 +0400
commit73ebd38f16c4799b657e501f188e9f3a3eca7805 (patch)
tree2584576d6931b14b336ac4ed3eb9eb513892da2c /src
parentd6d02e06ee135655b604a12b0c53987988277a16 (diff)
downloademacs-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/ChangeLog24
-rw-r--r--src/alloc.c59
-rw-r--r--src/dired.c2
-rw-r--r--src/editfns.c51
-rw-r--r--src/fileio.c2
-rw-r--r--src/font.c2
-rw-r--r--src/ftfont.c22
-rw-r--r--src/gtkutil.c3
-rw-r--r--src/keymap.c4
-rw-r--r--src/lisp.h48
-rw-r--r--src/lread.c2
-rw-r--r--src/nsmenu.m3
-rw-r--r--src/nsterm.h4
-rw-r--r--src/print.c73
-rw-r--r--src/xfns.c3
-rw-r--r--src/xmenu.c17
-rw-r--r--src/xselect.c2
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)