* 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-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.
#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
/* 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;
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;
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)
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);
}
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:
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 ();
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;
}
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))
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)));
}
/* Mark active. */
- tem = data[3];
+ tem = v->data[3].object;
tem1 = BVAR (current_buffer, mark_active);
bset_mark_active (current_buffer, tem);
/* 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,
out:
- free_save_value (info);
+ free_misc (info);
return Qnil;
}
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;
}
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)
{
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;
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)
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;
}
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)
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;
}
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
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);
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)));
}
}
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
/* 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);
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_); \
} \
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 ();
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)
#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 */
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;
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)
{
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 ('>');
}
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 ();
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;
}
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;
}
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
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)
projects / emacs.git / commitdiff