* bug#31750: simplify and tune Emacs stack-related allocation
@ 2018-06-08 2:27 Paul Eggert
2018-06-08 3:20 ` Daniel Colascione
2018-06-10 3:30 ` Noam Postavsky
0 siblings, 2 replies; 8+ messages in thread
From: Paul Eggert @ 2018-06-08 2:27 UTC (permalink / raw)
To: 31750
[-- Attachment #1: Type: text/plain, Size: 837 bytes --]
While looking into the Emacs garbage collector's stack-overflow problems
I noticed several opportunities for improving performance and
simplifying the code in minor ways. I plan to install the attached
patches to take advantage of these opportunities; although they don't
address stack overflow, they can be thought of as a first, cleanup step
toward addressing stack overflow.
Overall these patches trim about 250 lines from the C source code, and
should improve efficiency by not creating objects on the heap to handle
stack-related events such as implementing save-excursion. This patch
also removes primitives like 'free_misc' that ask for trouble by
second-guessing the garbage collector. I'm filing this as a bug report
in order to give the patches a bit of time to cool before installing.
Comments welcome, as usual.
[-- Attachment #2: 0001-New-mint_ptr-representation-for-C-pointers.patch --]
[-- Type: text/x-patch, Size: 15434 bytes --]
From 20fa8fafae0ca11d0811d452b7b7df7781c7a6b7 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:27 -0700
Subject: [PATCH 01/10] New mint_ptr representation for C pointers
* src/lisp.h (make_mint_ptr, mint_ptrp, xmint_pointer): New functions.
* src/dbusbind.c (xd_lisp_dbus_to_dbus, Fdbus__init_bus):
* src/emacs-module.c (module_free_global_ref, Fmodule_load)
(module_assert_runtime, module_assert_env, value_to_lisp)
(lisp_to_value, initialize_environment)
(finalize_environment, finalize_runtime_unwind)
(mark_modules):
* src/font.c (otf_open, font_put_frame_data)
(font_get_frame_data):
* src/macfont.m (macfont_invalidate_family_cache)
(macfont_get_family_cache_if_present)
(macfont_set_family_cache):
* src/nsterm.h (XNS_SCROLL_BAR):
* src/nsterm.m (ns_set_vertical_scroll_bar)
(ns_set_horizontal_scroll_bar):
* src/w32fns.c (w32_monitor_enum)
(w32_display_monitor_attributes_list):
* src/xterm.c (x_cr_destroy, x_cr_export_frames):
* src/xwidget.c (webkit_javascript_finished_cb)
(save_script_callback, Fxwidget_webkit_execute_script)
(kill_buffer_xwidgets):
Use mint pointers instead of merely save pointers.
---
src/dbusbind.c | 4 ++--
src/emacs-module.c | 24 ++++++++++++------------
src/font.c | 10 +++++-----
src/lisp.h | 36 ++++++++++++++++++++++++++++++++++--
src/macfont.m | 12 ++++++------
src/nsterm.h | 4 ++--
src/nsterm.m | 4 ++--
src/w32fns.c | 4 ++--
src/xterm.c | 4 ++--
src/xwidget.c | 8 ++++----
10 files changed, 71 insertions(+), 39 deletions(-)
diff --git a/src/dbusbind.c b/src/dbusbind.c
index ec3707d18f..71272d37d7 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -944,7 +944,7 @@ xd_get_connection_references (DBusConnection *connection)
static DBusConnection *
xd_lisp_dbus_to_dbus (Lisp_Object bus)
{
- return (DBusConnection *) XSAVE_POINTER (bus, 0);
+ return xmint_pointer (bus);
}
/* Return D-Bus connection address. BUS is either a Lisp symbol,
@@ -1187,7 +1187,7 @@ this connection to those buses. */)
XD_SIGNAL1 (build_string ("Cannot add watch functions"));
/* Add bus to list of registered buses. */
- val = make_save_ptr (connection);
+ val = make_mint_ptr (connection);
xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
/* Cleanup. */
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 956706cf9f..9c2de13d53 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -347,7 +347,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
for (Lisp_Object tail = global_env_private.values; CONSP (tail);
tail = XCDR (tail))
{
- emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
+ emacs_value global = xmint_pointer (XCAR (globals));
if (global == ref)
{
if (NILP (prev))
@@ -735,7 +735,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
rt->private_members = &rt_priv;
rt->get_environment = module_get_environment;
- Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes);
+ Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes);
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_ptr (finalize_runtime_unwind, rt);
@@ -830,7 +830,7 @@ module_assert_runtime (struct emacs_runtime *ert)
ptrdiff_t count = 0;
for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
{
- if (XSAVE_POINTER (XCAR (tail), 0) == ert)
+ if (xmint_pointer (XCAR (tail)) == ert)
return;
++count;
}
@@ -847,7 +847,7 @@ module_assert_env (emacs_env *env)
for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
tail = XCDR (tail))
{
- if (XSAVE_POINTER (XCAR (tail), 0) == env)
+ if (xmint_pointer (XCAR (tail)) == env)
return;
++count;
}
@@ -959,11 +959,11 @@ value_to_lisp (emacs_value v)
for (Lisp_Object environments = Vmodule_environments;
CONSP (environments); environments = XCDR (environments))
{
- emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
+ emacs_env *env = xmint_pointer (XCAR (environments));
for (Lisp_Object values = env->private_members->values;
CONSP (values); values = XCDR (values))
{
- Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0);
+ Lisp_Object *p = xmint_pointer (XCAR (values));
if (p == optr)
return *p;
++num_values;
@@ -1021,7 +1021,7 @@ lisp_to_value (emacs_env *env, Lisp_Object o)
void *vptr = optr;
ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
struct emacs_env_private *priv = env->private_members;
- priv->values = Fcons (make_save_ptr (ret), priv->values);
+ priv->values = Fcons (make_mint_ptr (ret), priv->values);
return ret;
}
@@ -1086,7 +1086,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->vec_get = module_vec_get;
env->vec_size = module_vec_size;
env->should_quit = module_should_quit;
- Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
+ Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
@@ -1095,7 +1095,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
static void
finalize_environment (emacs_env *env)
{
- eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
+ eassert (xmint_pointer (XCAR (Vmodule_environments)) == env);
Vmodule_environments = XCDR (Vmodule_environments);
if (module_assertions)
/* There is always at least the global environment. */
@@ -1109,10 +1109,10 @@ finalize_environment_unwind (void *env)
}
static void
-finalize_runtime_unwind (void* raw_ert)
+finalize_runtime_unwind (void *raw_ert)
{
struct emacs_runtime *ert = raw_ert;
- eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
+ eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert);
Vmodule_runtimes = XCDR (Vmodule_runtimes);
finalize_environment (ert->private_members->env);
}
@@ -1123,7 +1123,7 @@ mark_modules (void)
for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
tail = XCDR (tail))
{
- emacs_env *env = XSAVE_POINTER (XCAR (tail), 0);
+ emacs_env *env = xmint_pointer (XCAR (tail));
struct emacs_env_private *priv = env->private_members;
mark_object (priv->non_local_exit_symbol);
mark_object (priv->non_local_exit_data);
diff --git a/src/font.c b/src/font.c
index 305bb14576..743036fd4d 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1897,11 +1897,11 @@ otf_open (Lisp_Object file)
OTF *otf;
if (! NILP (val))
- otf = XSAVE_POINTER (XCDR (val), 0);
+ otf = xmint_pointer (XCDR (val));
else
{
otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
- val = make_save_ptr (otf);
+ val = make_mint_ptr (otf);
otf_list = Fcons (Fcons (file, val), otf_list);
}
return otf;
@@ -3632,10 +3632,10 @@ font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
else
{
if (NILP (val))
- fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)),
+ fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)),
f->font_data));
else
- XSETCDR (val, make_save_ptr (data));
+ XSETCDR (val, make_mint_ptr (data));
}
}
@@ -3644,7 +3644,7 @@ font_get_frame_data (struct frame *f, Lisp_Object driver)
{
Lisp_Object val = assq_no_quit (driver, f->font_data);
- return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0);
+ return NILP (val) ? NULL : xmint_pointer (XCDR (val));
}
#endif /* HAVE_XFT || HAVE_FREETYPE */
diff --git a/src/lisp.h b/src/lisp.h
index 10012b29db..25ddea7bb7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2502,7 +2502,40 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].funcpointer;
}
-/* Likewise for the saved integer. */
+extern Lisp_Object make_save_ptr (void *);
+
+/* A mint_ptr object OBJ represents a pointer P. OBJ is preferably a
+ Lisp integer I such that XINTPTR (i) == P, as this is more efficient.
+ However, if P would be damaged by being tagged as an integer and
+ then untagged via XINTPTR, then OBJ is a Lisp_Save_Value with
+ pointer component P. C code should never blindly accept a mint_ptr
+ object from Lisp code, as that would allow Lisp code to coin
+ pointers from integers and could lead to crashes. */
+
+INLINE Lisp_Object
+make_mint_ptr (void *a)
+{
+ Lisp_Object val = TAG_PTR (Lisp_Int0, a);
+ return INTEGERP (val) && XINTPTR (val) == a ? val : make_save_ptr (a);
+}
+
+INLINE bool
+mint_ptrp (Lisp_Object x)
+{
+ return (INTEGERP (x)
+ || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER));
+}
+
+INLINE void *
+xmint_pointer (Lisp_Object a)
+{
+ eassert (mint_ptrp (a));
+ if (INTEGERP (a))
+ return XINTPTR (a);
+ return XSAVE_POINTER (a, 0);
+}
+
+/* Get and set the Nth saved integer. */
INLINE ptrdiff_t
XSAVE_INTEGER (Lisp_Object obj, int n)
@@ -3809,7 +3842,6 @@ extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
-extern Lisp_Object make_save_ptr (void *);
extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
extern Lisp_Object make_save_ptr_ptr (void *, void *);
extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
diff --git a/src/macfont.m b/src/macfont.m
index 817071fa44..3b14a89c5c 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -943,8 +943,8 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char,
{
Lisp_Object value = HASH_VALUE (h, i);
- if (SAVE_VALUEP (value))
- CFRelease (XSAVE_POINTER (value, 0));
+ if (mint_ptrp (value))
+ CFRelease (xmint_pointer (value));
}
macfont_family_cache = Qnil;
}
@@ -962,7 +962,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char,
{
Lisp_Object value = HASH_VALUE (h, i);
- *string = SAVE_VALUEP (value) ? XSAVE_POINTER (value, 0) : NULL;
+ *string = mint_ptrp (value) ? xmint_pointer (value) : NULL;
return true;
}
@@ -984,13 +984,13 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char,
h = XHASH_TABLE (macfont_family_cache);
i = hash_lookup (h, symbol, &hash);
- value = string ? make_save_ptr ((void *) CFRetain (string)) : Qnil;
+ value = string ? make_mint_ptr (CFRetain (string)) : Qnil;
if (i >= 0)
{
Lisp_Object old_value = HASH_VALUE (h, i);
- if (SAVE_VALUEP (old_value))
- CFRelease (XSAVE_POINTER (old_value, 0));
+ if (mint_ptrp (old_value))
+ CFRelease (xmint_pointer (old_value));
set_hash_value_slot (h, i, value);
}
else
diff --git a/src/nsterm.h b/src/nsterm.h
index a99b517fd5..23460abc65 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1019,9 +1019,9 @@ struct x_output
#define FRAME_FONT(f) ((f)->output_data.ns->font)
#ifdef __OBJC__
-#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec, 0))
+#define XNS_SCROLL_BAR(vec) ((id) xmint_pointer (vec))
#else
-#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec, 0)
+#define XNS_SCROLL_BAR(vec) xmint_pointer (vec)
#endif
/* Compute pixel height of the frame's titlebar. */
diff --git a/src/nsterm.m b/src/nsterm.m
index c0d2d91fde..f0e6790e99 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4819,7 +4819,7 @@ in certain situations (rapid incoming events).
ns_clear_frame_area (f, left, top, width, height);
bar = [[EmacsScroller alloc] initFrame: r window: win];
- wset_vertical_scroll_bar (window, make_save_ptr (bar));
+ wset_vertical_scroll_bar (window, make_mint_ptr (bar));
update_p = YES;
}
else
@@ -4898,7 +4898,7 @@ in certain situations (rapid incoming events).
ns_clear_frame_area (f, left, top, width, height);
bar = [[EmacsScroller alloc] initFrame: r window: win];
- wset_horizontal_scroll_bar (window, make_save_ptr (bar));
+ wset_horizontal_scroll_bar (window, make_mint_ptr (bar));
update_p = YES;
}
else
diff --git a/src/w32fns.c b/src/w32fns.c
index 5d1c3c84c6..0dabd747a2 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -6296,7 +6296,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
{
Lisp_Object *monitor_list = (Lisp_Object *) dwData;
- *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
+ *monitor_list = Fcons (make_mint_ptr (monitor), *monitor_list);
return TRUE;
}
@@ -6325,7 +6325,7 @@ w32_display_monitor_attributes_list (void)
monitors = xmalloc (n_monitors * sizeof (*monitors));
for (i = 0; i < n_monitors; i++)
{
- monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0);
+ monitors[i] = xmint_pointer (XCAR (monitor_list));
monitor_list = XCDR (monitor_list);
}
diff --git a/src/xterm.c b/src/xterm.c
index eb299c3675..86d6068539 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -546,7 +546,7 @@ x_cr_accumulate_data (void *closure, const unsigned char *data,
static void
x_cr_destroy (Lisp_Object arg)
{
- cairo_t *cr = (cairo_t *) XSAVE_POINTER (arg, 0);
+ cairo_t *cr = xmint_pointer (arg);
block_input ();
cairo_destroy (cr);
@@ -606,7 +606,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
cr = cairo_create (surface);
cairo_surface_destroy (surface);
- record_unwind_protect (x_cr_destroy, make_save_ptr (cr));
+ record_unwind_protect (x_cr_destroy, make_mint_ptr (cr));
while (1)
{
diff --git a/src/xwidget.c b/src/xwidget.c
index 5f2651214e..2a53966ef4 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -374,7 +374,7 @@ webkit_javascript_finished_cb (GObject *webview,
Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx);
ASET (xw->script_callbacks, script_idx, Qnil);
if (!NILP (script_callback))
- xfree (XSAVE_POINTER (XCAR (script_callback), 0));
+ xfree (xmint_pointer (XCAR (script_callback)));
js_result = webkit_web_view_run_javascript_finish
(WEBKIT_WEB_VIEW (webview), result, &error);
@@ -724,7 +724,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun)
break;
}
- ASET (cbs, idx, Fcons (make_save_ptr (xlispstrdup (script)), fun));
+ ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun));
return idx;
}
@@ -750,7 +750,7 @@ argument procedure FUN.*/)
callback function is provided we pass it to the C callback
procedure that retrieves the return value. */
gchar *script_string
- = XSAVE_POINTER (XCAR (AREF (xw->script_callbacks, idx)), 0);
+ = xmint_pointer (XCAR (AREF (xw->script_callbacks, idx)));
webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr),
script_string,
NULL, /* cancelable */
@@ -1227,7 +1227,7 @@ kill_buffer_xwidgets (Lisp_Object buffer)
{
Lisp_Object cb = AREF (xw->script_callbacks, idx);
if (!NILP (cb))
- xfree (XSAVE_POINTER (XCAR (cb), 0));
+ xfree (xmint_pointer (XCAR (cb)));
ASET (xw->script_callbacks, idx, Qnil);
}
}
--
2.17.1
[-- Attachment #3: 0002-Simplify-init_module_assertions.patch --]
[-- Type: text/x-patch, Size: 1048 bytes --]
From dc732f73d02c0dc7fdf1e6c2e23993699c2e0b57 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:27 -0700
Subject: [PATCH 02/10] Simplify init_module_assertions
* src/emacs-module.c (init_module_assertions): Just use NULL
instead of allocating a dummy on the stack and then using
eassert. Practical platforms check for null pointer
dereferencing nowadays, so this is good enough.
---
src/emacs-module.c | 4 +---
1 file changed, 1 insertion(+), 3 deletions(-)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 9c2de13d53..9ecc08e54b 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1172,9 +1172,7 @@ init_module_assertions (bool enable)
{
/* We use a hidden environment for storing the globals. This
environment is never freed. */
- emacs_env env;
- global_env = initialize_environment (&env, &global_env_private);
- eassert (global_env != &env);
+ global_env = initialize_environment (NULL, &global_env_private);
}
}
--
2.17.1
[-- Attachment #4: 0003-Avoid-Lisp_Misc-allocation-if-C-stack-suffices.patch --]
[-- Type: text/x-patch, Size: 3824 bytes --]
From f9e3085864ac6ebc799dd37b36097cb83bc9fd05 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:27 -0700
Subject: [PATCH 03/10] Avoid Lisp_Misc allocation if C stack suffices
* src/fileio.c (union read_non_regular): New type.
(read_non_regular, Finsert_file_contents):
Use it to avoid allocating a Lisp_Misc.
* src/keymap.c (union map_keymap): New type.
(map_keymap_char_table_item, map_keymap_internal):
Use it to avoid allocating a Lisp_Misc.
---
src/fileio.c | 28 +++++++++++++++++-----------
src/keymap.c | 25 ++++++++++++++++++-------
2 files changed, 35 insertions(+), 18 deletions(-)
diff --git a/src/fileio.c b/src/fileio.c
index e8d966e163..89c5a14547 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3365,20 +3365,26 @@ decide_coding_unwind (Lisp_Object unwind_data)
bset_undo_list (current_buffer, undo_list);
}
-/* Read from a non-regular file. STATE is a Lisp_Save_Value
- object where slot 0 is the file descriptor, slot 1 specifies
- an offset to put the read bytes, and slot 2 is the maximum
- amount of bytes to read. Value is the number of bytes read. */
+/* Read from a non-regular file. Return the number of bytes read. */
+
+union read_non_regular
+{
+ struct
+ {
+ int fd;
+ ptrdiff_t inserted, trytry;
+ } s;
+ GCALIGNED_UNION
+};
static Lisp_Object
read_non_regular (Lisp_Object state)
{
- int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
+ union read_non_regular *data = XINTPTR (state);
+ int nbytes = emacs_read_quit (data->s.fd,
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + XSAVE_INTEGER (state, 1)),
- XSAVE_INTEGER (state, 2));
- /* Fast recycle this object for the likely next call. */
- free_misc (state);
+ + data->s.inserted),
+ data->s.trytry);
return make_number (nbytes);
}
@@ -4233,9 +4239,9 @@ by calling `format-decode', which see. */)
/* Read from the file, capturing `quit'. When an
error occurs, end the loop, and arrange for a quit
to be signaled after decoding the text we read. */
+ union read_non_regular data = {{fd, inserted, trytry}};
nbytes = internal_condition_case_1
- (read_non_regular,
- make_save_int_int_int (fd, inserted, trytry),
+ (read_non_regular, make_pointer_integer (&data),
Qerror, read_non_regular_quit);
if (NILP (nbytes))
diff --git a/src/keymap.c b/src/keymap.c
index c8cc933e78..32ee22759d 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -546,19 +546,28 @@ map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, L
(*fun) (key, val, args, data);
}
+union map_keymap
+{
+ struct
+ {
+ map_keymap_function_t fun;
+ Lisp_Object args;
+ void *data;
+ } s;
+ GCALIGNED_UNION
+};
+
static void
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_FUNCPOINTER (args, 0);
/* 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, XSAVE_OBJECT (args, 2), key,
- val, XSAVE_POINTER (args, 1));
+ union map_keymap *md = XINTPTR (args);
+ map_keymap_item (md->s.fun, md->s.args, key, val, md->s.data);
}
}
@@ -594,9 +603,11 @@ map_keymap_internal (Lisp_Object map,
}
}
else if (CHAR_TABLE_P (binding))
- map_char_table (map_keymap_char_table_item, Qnil, binding,
- make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
- args));
+ {
+ union map_keymap mapdata = {{fun, args, data}};
+ map_char_table (map_keymap_char_table_item, Qnil, binding,
+ make_pointer_integer (&mapdata));
+ }
}
return tail;
--
2.17.1
[-- Attachment #5: 0004-Use-record_unwind_protect_ptr-to-avoid-allocation.patch --]
[-- Type: text/x-patch, Size: 3815 bytes --]
From 664c3ebe3a5b056840691c35f17273945400a4b6 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:27 -0700
Subject: [PATCH 04/10] Use record_unwind_protect_ptr to avoid allocation
* src/term.c (struct tty_pop_down_menu): New type.
(tty_pop_down_menu, tty_menu_show): Use it, along with
record_unwind_protect_ptr, to avoid allocating a Lisp_Misc.
* src/xmenu.c (struct pop_down_menu): New type.
(pop_down_menu, x_menu_show): Use it, likewise.
* src/xterm.c (x_cr_destroy, x_cr_export_frames):
Use record_unwind_protect_pointer to avoid possibly allocating
a Lisp_Misc.
---
src/term.c | 20 +++++++++++++-------
| 16 ++++++++++++----
src/xterm.c | 6 ++----
3 files changed, 27 insertions(+), 15 deletions(-)
diff --git a/src/term.c b/src/term.c
index 08d483f4fa..8c5085f016 100644
--- a/src/term.c
+++ b/src/term.c
@@ -3408,15 +3408,20 @@ tty_menu_help_callback (char const *help_string, int pane, int item)
Qnil, menu_object, make_number (item));
}
+struct tty_pop_down_menu
+{
+ tty_menu *menu;
+ struct buffer *buffer;
+};
+
static void
-tty_pop_down_menu (Lisp_Object arg)
+tty_pop_down_menu (void *arg)
{
- tty_menu *menu = XSAVE_POINTER (arg, 0);
- struct buffer *orig_buffer = XSAVE_POINTER (arg, 1);
+ struct tty_pop_down_menu *data = arg;
block_input ();
- tty_menu_destroy (menu);
- set_buffer_internal (orig_buffer);
+ tty_menu_destroy (data->menu);
+ set_buffer_internal (data->buffer);
unblock_input ();
}
@@ -3697,8 +3702,9 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags,
/* We save and restore the current buffer because tty_menu_activate
triggers redisplay, which switches buffers at will. */
- record_unwind_protect (tty_pop_down_menu,
- make_save_ptr_ptr (menu, current_buffer));
+ record_unwind_protect_ptr (tty_pop_down_menu,
+ &((struct tty_pop_down_menu)
+ {menu, current_buffer}));
specbind (Qoverriding_terminal_local_map,
Fsymbol_value (Qtty_menu_navigation_map));
--git a/src/xmenu.c b/src/xmenu.c
index a5865a6ec2..2fbf9e8bf6 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -2033,11 +2033,18 @@ menu_help_callback (char const *help_string, int pane, int item)
Qnil, menu_object, make_number (item));
}
+struct pop_down_menu
+{
+ struct frame *frame;
+ XMenu *menu;
+};
+
static void
-pop_down_menu (Lisp_Object arg)
+pop_down_menu (void *arg)
{
- struct frame *f = XSAVE_POINTER (arg, 0);
- XMenu *menu = XSAVE_POINTER (arg, 1);
+ union pop_down_menu *data = arg;
+ struct frame *f = data->frame;
+ XMenu *menu = data->menu;
block_input ();
#ifndef MSDOS
@@ -2283,7 +2290,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags,
XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
#endif
- record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu));
+ record_unwind_protect_pointer (pop_down_menu,
+ &(struct pop_down_menu) {f, menu});
/* Help display under X won't work because XMenuActivate contains
a loop that doesn't give Emacs a chance to process it. */
diff --git a/src/xterm.c b/src/xterm.c
index 86d6068539..0efced3313 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -544,10 +544,8 @@ x_cr_accumulate_data (void *closure, const unsigned char *data,
}
static void
-x_cr_destroy (Lisp_Object arg)
+x_cr_destroy (void *cr);
{
- cairo_t *cr = xmint_pointer (arg);
-
block_input ();
cairo_destroy (cr);
unblock_input ();
@@ -606,7 +604,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
cr = cairo_create (surface);
cairo_surface_destroy (surface);
- record_unwind_protect (x_cr_destroy, make_mint_ptr (cr));
+ record_unwind_protect_pointer (x_cr_destroy, cr);
while (1)
{
--
2.17.1
[-- Attachment #6: 0005-Avoid-allocating-a-Lisp_Save_Value-in-ftfont.c.patch --]
[-- Type: text/x-patch, Size: 3452 bytes --]
From da5f1e7113ee4143c40050232c618c89b8873dc7 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:28 -0700
Subject: [PATCH 05/10] Avoid allocating a Lisp_Save_Value in ftfont.c
* src/ftfont.c (struct ftfont_cache_data): New member face_refcount.
(ftfont_lookup_cache): Clear it when initializing.
Use make_mint_ptr, since this typically avoids the need to
allocate a Lisp_Save_Value as refcount is now stored elsewhere.
(ftfont_open2, ftfont_close): Manipulate the reference
count in the struct, not in the save object.
---
src/ftfont.c | 26 ++++++++++++--------------
1 file changed, 12 insertions(+), 14 deletions(-)
diff --git a/src/ftfont.c b/src/ftfont.c
index a53467000f..d50fa39fa7 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -345,6 +345,7 @@ struct ftfont_cache_data
{
FT_Face ft_face;
FcCharSet *fc_charset;
+ intptr_t face_refcount;
};
static Lisp_Object
@@ -371,17 +372,15 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
{
if (NILP (ft_face_cache))
ft_face_cache = CALLN (Fmake_hash_table, QCtest, Qequal);
- cache_data = xmalloc (sizeof *cache_data);
- cache_data->ft_face = NULL;
- cache_data->fc_charset = NULL;
- val = make_save_ptr_int (cache_data, 0);
+ cache_data = xzalloc (sizeof *cache_data);
+ val = make_mint_ptr (cache_data);
cache = Fcons (Qnil, val);
Fputhash (key, cache, ft_face_cache);
}
else
{
val = XCDR (cache);
- cache_data = XSAVE_POINTER (val, 0);
+ cache_data = xmint_pointer (val);
}
if (cache_for == FTFONT_CACHE_FOR_ENTITY)
@@ -447,7 +446,7 @@ ftfont_get_fc_charset (Lisp_Object entity)
cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET);
val = XCDR (cache);
- cache_data = XSAVE_POINTER (val, 0);
+ cache_data = xmint_pointer (val);
return cache_data->fc_charset;
}
@@ -1118,9 +1117,9 @@ ftfont_open2 (struct frame *f,
filename = XCAR (val);
idx = XCDR (val);
val = XCDR (cache);
- cache_data = XSAVE_POINTER (XCDR (cache), 0);
+ cache_data = xmint_pointer (XCDR (cache));
ft_face = cache_data->ft_face;
- if (XSAVE_INTEGER (val, 1) > 0)
+ if (cache_data->face_refcount > 0)
{
/* FT_Face in this cache is already used by the different size. */
if (FT_New_Size (ft_face, &ft_size) != 0)
@@ -1136,14 +1135,14 @@ ftfont_open2 (struct frame *f,
size = pixel_size;
if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0)
{
- if (XSAVE_INTEGER (val, 1) == 0)
+ if (cache_data->face_refcount == 0)
{
FT_Done_Face (ft_face);
cache_data->ft_face = NULL;
}
return Qnil;
}
- set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1);
+ cache_data->face_refcount++;
ASET (font_object, FONT_FILE_INDEX, filename);
font = XFONT_OBJECT (font_object);
@@ -1255,11 +1254,10 @@ ftfont_close (struct font *font)
cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE);
eassert (CONSP (cache));
val = XCDR (cache);
- set_save_integer (val, 1, XSAVE_INTEGER (val, 1) - 1);
- if (XSAVE_INTEGER (val, 1) == 0)
+ struct ftfont_cache_data *cache_data = xmint_pointer (val);
+ cache_data->face_refcount--;
+ if (cache_data->face_refcount == 0)
{
- struct ftfont_cache_data *cache_data = XSAVE_POINTER (val, 0);
-
FT_Done_Face (cache_data->ft_face);
#ifdef HAVE_LIBOTF
if (ftfont_info->otf)
--
2.17.1
[-- Attachment #7: 0006-Just-use-cons-in-macfont_descriptor_entity.patch --]
[-- Type: text/x-patch, Size: 2405 bytes --]
From f74afa9af7121de49145dcc2d4d338cad2d5013f Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:28 -0700
Subject: [PATCH 06/10] Just use cons in macfont_descriptor_entity
* src/macfont.m (macfont_descriptor_entity): Use cons instead
of make_save_ptr_int, as this avoids the need for a special
type and function for this one-off.
---
src/macfont.m | 13 ++++++-------
1 file changed, 6 insertions(+), 7 deletions(-)
diff --git a/src/macfont.m b/src/macfont.m
index 3b14a89c5c..8abe203644 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -908,7 +908,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char,
ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra));
name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute);
font_put_extra (entity, QCfont_entity,
- make_save_ptr_int ((void *) name, sym_traits));
+ Fcons (make_mint_ptr (name), make_number (traits)));
if (synth_sym_traits & kCTFontTraitItalic)
FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
make_number (FONT_SLANT_SYNTHETIC_ITALIC));
@@ -2505,7 +2505,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no
{
Lisp_Object val = assq_no_quit (QCfont_entity,
AREF (entity, FONT_EXTRA_INDEX));
- CFStringRef name = XSAVE_POINTER (XCDR (val), 0);
+ CFStringRef name = xmint_pointer (XCAR (XCDR (val)));
block_input ();
CFRelease (name);
@@ -2528,11 +2528,10 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no
val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX));
if (! CONSP (val)
- || XTYPE (XCDR (val)) != Lisp_Misc
- || XMISCTYPE (XCDR (val)) != Lisp_Misc_Save_Value)
+ || ! CONSP (XCDR (val)))
return Qnil;
- font_name = XSAVE_POINTER (XCDR (val), 0);
- sym_traits = XSAVE_INTEGER (XCDR (val), 1);
+ font_name = xmint_pointer (XCAR (XCDR (val)));
+ sym_traits = XINT (XCDR (XCDR (val)));
size = XINT (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
@@ -2711,7 +2710,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no
val = assq_no_quit (QCfont_entity, AREF (font, FONT_EXTRA_INDEX));
val = XCDR (val);
- name = XSAVE_POINTER (val, 0);
+ name = xmint_pointer (XCAR (val));
charset = macfont_get_cf_charset_for_name (name);
}
else
--
2.17.1
[-- Attachment #8: 0007-Avoid-allocating-Lisp_Save_Value-for-excursions.patch --]
[-- Type: text/x-patch, Size: 7206 bytes --]
From 9c6aeca1e58e2664cf8ebde86379d367e4bcdd92 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:28 -0700
Subject: [PATCH 07/10] Avoid allocating Lisp_Save_Value for excursions
* src/editfns.c (save_excursion_save): New arg PDL,
specifying where to save the state. All uses changed.
(save_excursion_restore): Args are now the marker and info
rather than a pointer to a Lisp_Save_Value containing them.
All uses changed.
* src/eval.c (default_toplevel_binding, Fbacktrace__locals):
Treat excursions like other miscellaneous pdl types.
(record_unwind_protect_excursion): Save data directly
into the pdl rather than creating an object on the heap.
This avoids the need to allocate and free an object.
(do_one_unbind, backtrace_eval_unrewind):
Unwind excursions directly.
(mark_specpdl): Mark excursions directly.
* src/lisp.h (SPECPDL_UNWIND_EXCURSION): New constant.
(union specbinding): New member unwind_excursion.
---
src/editfns.c | 27 +++++++++++----------------
src/eval.c | 38 +++++++++++++++++++++++++++-----------
src/lisp.h | 9 +++++++--
3 files changed, 45 insertions(+), 29 deletions(-)
diff --git a/src/editfns.c b/src/editfns.c
index e672c0eb74..3147f9d146 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -995,30 +995,24 @@ This function does not move point. */)
Qnil, Qt, Qnil);
}
-/* Save current buffer state for `save-excursion' special form.
- We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
- offload some work from GC. */
+/* Save current buffer state for save-excursion special form. */
-Lisp_Object
-save_excursion_save (void)
+void
+save_excursion_save (union specbinding *pdl)
{
- return make_save_obj_obj_obj_obj
- (Fpoint_marker (),
- Qnil,
- /* Selected window if current buffer is shown in it, nil otherwise. */
- (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
- ? selected_window : Qnil),
- Qnil);
+ eassert (pdl->unwind_excursion.kind == SPECPDL_UNWIND_EXCURSION);
+ pdl->unwind_excursion.marker = Fpoint_marker ();
+ /* Selected window if current buffer is shown in it, nil otherwise. */
+ pdl->unwind_excursion.window
+ = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
+ ? selected_window : Qnil);
}
/* Restore saved buffer before leaving `save-excursion' special form. */
void
-save_excursion_restore (Lisp_Object info)
+save_excursion_restore (Lisp_Object marker, Lisp_Object window)
{
- Lisp_Object marker = XSAVE_OBJECT (info, 0);
- Lisp_Object window = XSAVE_OBJECT (info, 2);
- free_misc (info);
Lisp_Object buffer = Fmarker_buffer (marker);
/* If we're unwinding to top level, saved buffer may be deleted. This
means that all of its markers are unchained and so BUFFER is nil. */
@@ -1027,6 +1021,7 @@ save_excursion_restore (Lisp_Object info)
Fset_buffer (buffer);
+ /* Point marker. */
Fgoto_char (marker);
unchain_marker (XMARKER (marker));
diff --git a/src/eval.c b/src/eval.c
index 86011a234c..63bddc475e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -665,6 +665,7 @@ default_toplevel_binding (Lisp_Object symbol)
case SPECPDL_UNWIND:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
case SPECPDL_LET_LOCAL:
@@ -3417,7 +3418,9 @@ record_unwind_protect_int (void (*function) (int), int arg)
void
record_unwind_protect_excursion (void)
{
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION;
+ save_excursion_save (specpdl_ptr);
+ grow_specpdl ();
}
void
@@ -3465,6 +3468,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
case SPECPDL_UNWIND_VOID:
this_binding->unwind_void.func ();
break;
+ case SPECPDL_UNWIND_EXCURSION:
+ save_excursion_restore (this_binding->unwind_excursion.marker,
+ this_binding->unwind_excursion.window);
+ break;
case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET:
@@ -3739,18 +3746,21 @@ backtrace_eval_unrewind (int distance)
unwind_protect, but the problem is that we don't know how to
rewind them afterwards. */
case SPECPDL_UNWIND:
- {
- Lisp_Object oldarg = tmp->unwind.arg;
- if (tmp->unwind.func == set_buffer_if_live)
+ if (tmp->unwind.func == set_buffer_if_live)
+ {
+ Lisp_Object oldarg = tmp->unwind.arg;
tmp->unwind.arg = Fcurrent_buffer ();
- else if (tmp->unwind.func == save_excursion_restore)
- tmp->unwind.arg = save_excursion_save ();
- else
- break;
- tmp->unwind.func (oldarg);
- break;
+ set_buffer_if_live (oldarg);
+ }
+ break;
+ case SPECPDL_UNWIND_EXCURSION:
+ {
+ Lisp_Object marker = tmp->unwind_excursion.marker;
+ Lisp_Object window = tmp->unwind_excursion.window;
+ save_excursion_save (tmp);
+ save_excursion_restore (marker, window);
}
-
+ break;
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_VOID:
@@ -3885,6 +3895,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
case SPECPDL_UNWIND:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
break;
@@ -3914,6 +3925,11 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
mark_object (specpdl_arg (pdl));
break;
+ case SPECPDL_UNWIND_EXCURSION:
+ mark_object (pdl->unwind_excursion.marker);
+ mark_object (pdl->unwind_excursion.window);
+ break;
+
case SPECPDL_BACKTRACE:
{
ptrdiff_t nargs = backtrace_nargs (pdl);
diff --git a/src/lisp.h b/src/lisp.h
index 25ddea7bb7..1da34a25fa 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3189,6 +3189,7 @@ enum specbind_tag {
SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
SPECPDL_UNWIND_INT, /* Likewise, on int. */
+ SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */
SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
@@ -3215,6 +3216,10 @@ union specbinding
void (*func) (int);
int arg;
} unwind_int;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ Lisp_Object marker, window;
+ } unwind_excursion;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (void);
@@ -4107,9 +4112,9 @@ extern void mark_threads (void);
/* Defined in editfns.c. */
extern void insert1 (Lisp_Object);
-extern Lisp_Object save_excursion_save (void);
+extern void save_excursion_save (union specbinding *);
+extern void save_excursion_restore (Lisp_Object, Lisp_Object);
extern Lisp_Object save_restriction_save (void);
-extern void save_excursion_restore (Lisp_Object);
extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
--
2.17.1
[-- Attachment #9: 0008-Avoid-allocating-Lisp_Save_Value-for-arrays.patch --]
[-- Type: text/x-patch, Size: 5881 bytes --]
From 834105816586831a11d5313f512f64364d4966b8 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:28 -0700
Subject: [PATCH 08/10] Avoid allocating Lisp_Save_Value for arrays
* src/alloc.c (mark_maybe_objects): New function.
* src/eval.c (default_toplevel_binding)
(backtrace_eval_unrewind, Fbacktrace__locals):
Treat array unwindings like other miscellaneous pdl types.
(record_unwind_protect_array): New function.
(do_one_unbind): Free the array while unwinding.
(mark_specpdl): Mark arrays directly.
* src/lisp.h (SPECPDL_UNWIND_ARRAY): New constant.
(union specbinding): New member unwind_array.
(SAFE_ALLOCA_LISP_EXTRA): Use record_unwind_protect_array
instead of make_save_memory + record_unwind_protect.
---
src/alloc.c | 7 +++++++
src/eval.c | 19 +++++++++++++++++++
src/lisp.h | 14 +++++++++++---
3 files changed, 37 insertions(+), 3 deletions(-)
diff --git a/src/alloc.c b/src/alloc.c
index 4186347440..a68759feb5 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4852,6 +4852,13 @@ mark_maybe_object (Lisp_Object obj)
}
}
+void
+mark_maybe_objects (Lisp_Object *array, ptrdiff_t nelts)
+{
+ for (Lisp_Object *lim = array + nelts; array < lim; array++)
+ mark_maybe_object (*array);
+}
+
/* Return true if P can point to Lisp data, and false otherwise.
Symbols are implemented via offsets not pointers, but the offsets
are also multiples of GCALIGNMENT. */
diff --git a/src/eval.c b/src/eval.c
index 63bddc475e..6a7a72465a 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -663,6 +663,7 @@ default_toplevel_binding (Lisp_Object symbol)
break;
case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_EXCURSION:
@@ -3397,6 +3398,15 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
grow_specpdl ();
}
+void
+record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts)
+{
+ specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY;
+ specpdl_ptr->unwind_array.array = array;
+ specpdl_ptr->unwind_array.nelts = nelts;
+ grow_specpdl ();
+}
+
void
record_unwind_protect_ptr (void (*function) (void *), void *arg)
{
@@ -3459,6 +3469,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
case SPECPDL_UNWIND:
this_binding->unwind.func (this_binding->unwind.arg);
break;
+ case SPECPDL_UNWIND_ARRAY:
+ xfree (this_binding->unwind_array.array);
+ break;
case SPECPDL_UNWIND_PTR:
this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg);
break;
@@ -3761,6 +3774,7 @@ backtrace_eval_unrewind (int distance)
save_excursion_restore (marker, window);
}
break;
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_VOID:
@@ -3893,6 +3907,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
break;
case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_EXCURSION:
@@ -3925,6 +3940,10 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
mark_object (specpdl_arg (pdl));
break;
+ case SPECPDL_UNWIND_ARRAY:
+ mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
+ break;
+
case SPECPDL_UNWIND_EXCURSION:
mark_object (pdl->unwind_excursion.marker);
mark_object (pdl->unwind_excursion.window);
diff --git a/src/lisp.h b/src/lisp.h
index 1da34a25fa..a0211966f7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3187,6 +3187,8 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
enum specbind_tag {
SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
+ SPECPDL_UNWIND_ARRAY, /* Likewise, on an array that needs freeing.
+ Its elements are potential Lisp_Objects. */
SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
SPECPDL_UNWIND_INT, /* Likewise, on int. */
SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */
@@ -3206,6 +3208,12 @@ union specbinding
void (*func) (Lisp_Object);
Lisp_Object arg;
} unwind;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (Lisp_Object);
+ Lisp_Object *array;
+ ptrdiff_t nelts;
+ } unwind_array;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (void *);
@@ -3703,6 +3711,7 @@ extern void refill_memory_reserve (void);
#endif
extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
+extern void mark_maybe_objects (Lisp_Object *, ptrdiff_t);
extern void mark_stack (char *, char *);
extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
extern const char *pending_malloc_warning;
@@ -4017,6 +4026,7 @@ extern struct handler *push_handler (Lisp_Object, enum handlertype);
extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
extern void specbind (Lisp_Object, Lisp_Object);
extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t);
extern void record_unwind_protect_ptr (void (*) (void *), void *);
extern void record_unwind_protect_int (void (*) (int), int);
extern void record_unwind_protect_void (void (*) (void));
@@ -4711,11 +4721,9 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
(buf) = AVAIL_ALLOCA (alloca_nbytes); \
else \
{ \
- Lisp_Object arg_; \
(buf) = xmalloc (alloca_nbytes); \
- arg_ = make_save_memory (buf, nelt); \
+ record_unwind_protect_array (buf, nelt); \
sa_must_free = true; \
- record_unwind_protect (free_save_value, arg_); \
} \
} while (false)
--
2.17.1
[-- Attachment #10: 0009-New-type-Lisp_Misc_Ptr.patch --]
[-- Type: text/x-patch, Size: 6697 bytes --]
From a527e5ddab0a54ada101eac9ffbf35bd0a80539e Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:28 -0700
Subject: [PATCH 09/10] New type Lisp_Misc_Ptr
This is a streamlined version of Lisp_Save_Value, which contains just
a pointer, as that is all Lisp_Save_Values are used for any more.
With the previous changes, these objects are not primarily used as
save values, so just call them "Misc" rather than "Save".
* src/alloc.c (make_misc_ptr): New function.
(mark_object): Mark Lisp_Misc_Ptr too.
* src/lisp.h (Lisp_Misc_Ptr): New constant.
(struct Lisp_Misc_Ptr): New type.
(make_mint_ptr, mint_ptrp, xmint_pointer):
Use Lisp_Misc_Ptr, not Lisp_Save_Value.
(union Lisp_Misc): Add Lisp_Misc_Ptr.
* src/print.c (print_object): Print Lisp_Misc_Ptr.
---
src/alloc.c | 13 +++++++++++++
src/font.h | 2 +-
src/lisp.h | 30 +++++++++++++++++++++---------
src/print.c | 7 +++++++
src/w32font.c | 2 +-
5 files changed, 43 insertions(+), 11 deletions(-)
diff --git a/src/alloc.c b/src/alloc.c
index a68759feb5..62a3a1a09f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3834,6 +3834,15 @@ free_save_value (Lisp_Object save)
free_misc (save);
}
+Lisp_Object
+make_misc_ptr (void *a)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Ptr);
+ struct Lisp_Misc_Ptr *p = XUNTAG (val, Lisp_Misc);
+ p->pointer = a;
+ return val;
+}
+
/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
Lisp_Object
@@ -6697,6 +6706,10 @@ mark_object (Lisp_Object arg)
mark_save_value (XSAVE_VALUE (obj));
break;
+ case Lisp_Misc_Ptr:
+ XMISCANY (obj)->gcmarkbit = true;
+ break;
+
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
break;
diff --git a/src/font.h b/src/font.h
index 469431fee6..8c8eb9582a 100644
--- a/src/font.h
+++ b/src/font.h
@@ -613,7 +613,7 @@ struct font_driver
(symbols). */
Lisp_Object (*list_family) (struct frame *f);
- /* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
+ /* Optional.
Free FONT_EXTRA_INDEX field of FONT_ENTITY. */
void (*free_entity) (Lisp_Object font_entity);
diff --git a/src/lisp.h b/src/lisp.h
index a0211966f7..625d6f13f3 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -514,6 +514,7 @@ enum Lisp_Misc_Type
Lisp_Misc_Overlay,
Lisp_Misc_Save_Value,
Lisp_Misc_Finalizer,
+ Lisp_Misc_Ptr,
#ifdef HAVE_MODULES
Lisp_Misc_User_Ptr,
#endif
@@ -540,10 +541,11 @@ enum Lisp_Fwd_Type
First, there are already a couple of Lisp types that can be used if
your new type does not need to be exposed to Lisp programs nor
- displayed to users. These are Lisp_Save_Value, a Lisp_Misc
+ displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc
subtype; and PVEC_OTHER, a kind of vectorlike object. The former
- is suitable for temporarily stashing away pointers and integers in
- a Lisp object. The latter is useful for vector-like Lisp objects
+ is suitable for stashing a pointer in a Lisp object; the pointer
+ might be to some low-level C object that contains auxiliary
+ information. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
@@ -2502,12 +2504,20 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].funcpointer;
}
-extern Lisp_Object make_save_ptr (void *);
+struct Lisp_Misc_Ptr
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15;
+ void *pointer;
+ };
+
+extern Lisp_Object make_misc_ptr (void *);
/* A mint_ptr object OBJ represents a pointer P. OBJ is preferably a
Lisp integer I such that XINTPTR (i) == P, as this is more efficient.
However, if P would be damaged by being tagged as an integer and
- then untagged via XINTPTR, then OBJ is a Lisp_Save_Value with
+ then untagged via XINTPTR, then OBJ is a Lisp_Misc_Ptr with
pointer component P. C code should never blindly accept a mint_ptr
object from Lisp code, as that would allow Lisp code to coin
pointers from integers and could lead to crashes. */
@@ -2516,14 +2526,13 @@ INLINE Lisp_Object
make_mint_ptr (void *a)
{
Lisp_Object val = TAG_PTR (Lisp_Int0, a);
- return INTEGERP (val) && XINTPTR (val) == a ? val : make_save_ptr (a);
+ return INTEGERP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a);
}
INLINE bool
mint_ptrp (Lisp_Object x)
{
- return (INTEGERP (x)
- || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER));
+ return INTEGERP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr);
}
INLINE void *
@@ -2532,7 +2541,8 @@ xmint_pointer (Lisp_Object a)
eassert (mint_ptrp (a));
if (INTEGERP (a))
return XINTPTR (a);
- return XSAVE_POINTER (a, 0);
+ struct Lisp_Misc_Ptr *p = XUNTAG (a, Lisp_Misc);
+ return p->pointer;
}
/* Get and set the Nth saved integer. */
@@ -2619,6 +2629,7 @@ union Lisp_Misc
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
struct Lisp_Finalizer u_finalizer;
+ struct Lisp_Misc_Ptr u_misc_ptr;
#ifdef HAVE_MODULES
struct Lisp_User_Ptr u_user_ptr;
#endif
@@ -3856,6 +3867,7 @@ extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
+extern Lisp_Object make_save_ptr (void *);
extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
extern Lisp_Object make_save_ptr_ptr (void *, void *);
extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
diff --git a/src/print.c b/src/print.c
index 8394375220..a991f3ffa3 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2167,6 +2167,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_c_string ("#<misc free cell>", printcharfun);
break;
+ case Lisp_Misc_Ptr:
+ {
+ int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj));
+ strout (buf, i, i, printcharfun);
+ }
+ break;
+
case Lisp_Misc_Save_Value:
{
int i;
diff --git a/src/w32font.c b/src/w32font.c
index 9cbc3ee14b..65409b92d2 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -718,7 +718,7 @@ w32font_draw (struct glyph_string *s, int from, int to,
}
/* w32 implementation of free_entity for font backend.
- Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
+ Optional.
Free FONT_EXTRA_INDEX field of FONT_ENTITY.
static void
w32font_free_entity (Lisp_Object entity);
--
2.17.1
[-- Attachment #11: 0010-Remove-Lisp_Misc_Save_Value.patch --]
[-- Type: text/x-patch, Size: 16949 bytes --]
From 8924f58c6d39258855d47d832fab89b041becb45 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 7 Jun 2018 19:12:29 -0700
Subject: [PATCH 10/10] Remove Lisp_Misc_Save_Value
This type and its associated routines are no longer used.
* src/alloc.c (voidfuncptr): Move here from src/lisp.h.
(free_misc, make_save_int_int_int)
(make_save_obj_obj_obj_obj, make_save_ptr)
(make_save_ptr_int, make_save_ptr_ptr)
(make_save_funcptr_ptr_obj, make_save_memory)
(free_save_value, mark_save_value):
Remove.
(mark_object): Remove mention of Lisp_Misc_Save_Value.
* src/lisp.h (Lisp_Misc_Save_Value, SAVE_SLOT_BITS)
(SAVE_VALUE_SLOTS, SAVE_TYPE_BITS, enum Lisp_Save_Type)
(struct Lisp_Save_Value, SAVE_VALUEP, XSAVE_VALUE)
(save_type, XSAVE_POINTER, set_save_pointer)
(XSAVE_FUNCPOINTER, XSAVE_INTEGER, set_save_integer)
(XSAVE_OBJECT): Remove.
(union Lisp_Misc): Remove u_save_value.
(voidfuncptr): Move from here to src/alloc.c.
* src/print.c (print_object):
Remove support for printing Lisp_Misc_Save_Value.
---
src/alloc.c | 153 +--------------------------------------------
src/lisp.h | 176 +---------------------------------------------------
src/print.c | 83 -------------------------
3 files changed, 5 insertions(+), 407 deletions(-)
diff --git a/src/alloc.c b/src/alloc.c
index 62a3a1a09f..c99eabd5ec 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -172,6 +172,7 @@ malloc_initialize_hook (void)
/* Declare the malloc initialization hook, which runs before 'main' starts.
EXTERNALLY_VISIBLE works around Bug#22522. */
+typedef void (*voidfuncptr) (void);
# ifndef __MALLOC_HOOK_VOLATILE
# define __MALLOC_HOOK_VOLATILE
# endif
@@ -3717,123 +3718,6 @@ allocate_misc (enum Lisp_Misc_Type type)
return val;
}
-/* Free a Lisp_Misc object. */
-
-void
-free_misc (Lisp_Object misc)
-{
- XMISCANY (misc)->type = Lisp_Misc_Free;
- XMISC (misc)->u_free.chain = misc_free_list;
- misc_free_list = XMISC (misc);
- consing_since_gc -= sizeof (union Lisp_Misc);
- total_free_markers++;
-}
-
-/* Verify properties of Lisp_Save_Value's representation
- that are assumed here and elsewhere. */
-
-verify (SAVE_UNUSED == 0);
-verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
- >> SAVE_SLOT_BITS)
- == 0);
-
-/* Return Lisp_Save_Value objects for the various combinations
- that callers need. */
-
-Lisp_Object
-make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_INT_INT_INT;
- p->data[0].integer = a;
- p->data[1].integer = b;
- p->data[2].integer = c;
- return val;
-}
-
-Lisp_Object
-make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
- Lisp_Object d)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
- p->data[0].object = a;
- p->data[1].object = b;
- p->data[2].object = c;
- p->data[3].object = d;
- return val;
-}
-
-Lisp_Object
-make_save_ptr (void *a)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_POINTER;
- p->data[0].pointer = a;
- return val;
-}
-
-Lisp_Object
-make_save_ptr_int (void *a, ptrdiff_t b)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_PTR_INT;
- p->data[0].pointer = a;
- p->data[1].integer = b;
- return val;
-}
-
-Lisp_Object
-make_save_ptr_ptr (void *a, void *b)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_PTR_PTR;
- p->data[0].pointer = a;
- p->data[1].pointer = b;
- return val;
-}
-
-Lisp_Object
-make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
- p->data[0].funcpointer = a;
- p->data[1].pointer = b;
- p->data[2].object = c;
- return val;
-}
-
-/* Return a Lisp_Save_Value object that represents an array A
- of N Lisp objects. */
-
-Lisp_Object
-make_save_memory (Lisp_Object *a, ptrdiff_t n)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_MEMORY;
- p->data[0].pointer = a;
- p->data[1].integer = n;
- return val;
-}
-
-/* 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)
-{
- xfree (XSAVE_POINTER (save, 0));
- free_misc (save);
-}
-
Lisp_Object
make_misc_ptr (void *a)
{
@@ -5287,10 +5171,8 @@ valid_pointer_p (void *p)
/* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
- cannot validate OBJ. This function can be quite slow, so its primary
- use is the manual debugging. The only exception is print_object, where
- we use it to check whether the memory referenced by the pointer of
- Lisp_Save_Value object contains valid objects. */
+ cannot validate OBJ. This function can be quite slow, and is used
+ only in debugging. */
int
valid_lisp_object_p (Lisp_Object obj)
@@ -6369,30 +6251,6 @@ mark_localized_symbol (struct Lisp_Symbol *ptr)
mark_object (blv->defcell);
}
-NO_INLINE /* To reduce stack depth in mark_object. */
-static void
-mark_save_value (struct Lisp_Save_Value *ptr)
-{
- /* If `save_type' is zero, `data[0].pointer' is the address
- of a memory area containing `data[1].integer' potential
- Lisp_Objects. */
- if (ptr->save_type == SAVE_TYPE_MEMORY)
- {
- Lisp_Object *p = ptr->data[0].pointer;
- ptrdiff_t nelt;
- for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++)
- mark_maybe_object (*p);
- }
- else
- {
- /* Find Lisp_Objects in `data[N]' slots and mark them. */
- int i;
- for (i = 0; i < SAVE_VALUE_SLOTS; i++)
- if (save_type (ptr, i) == SAVE_OBJECT)
- mark_object (ptr->data[i].object);
- }
-}
-
/* Remove killed buffers or items whose car is a killed buffer from
LIST, and mark other items. Return changed LIST, which is marked. */
@@ -6701,11 +6559,6 @@ mark_object (Lisp_Object arg)
XMISCANY (obj)->gcmarkbit = 1;
break;
- case Lisp_Misc_Save_Value:
- XMISCANY (obj)->gcmarkbit = 1;
- mark_save_value (XSAVE_VALUE (obj));
- break;
-
case Lisp_Misc_Ptr:
XMISCANY (obj)->gcmarkbit = true;
break;
diff --git a/src/lisp.h b/src/lisp.h
index 625d6f13f3..04f9e393d6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -512,7 +512,6 @@ enum Lisp_Misc_Type
Lisp_Misc_Free = 0x5eab,
Lisp_Misc_Marker,
Lisp_Misc_Overlay,
- Lisp_Misc_Save_Value,
Lisp_Misc_Finalizer,
Lisp_Misc_Ptr,
#ifdef HAVE_MODULES
@@ -561,9 +560,8 @@ enum Lisp_Fwd_Type
members that are accessible only from C. A Lisp_Misc object is a
wrapper for a C struct that can contain anything you like.
- Explicit freeing is discouraged for Lisp objects in general. But if
- you really need to exploit this, use Lisp_Misc (check free_misc in
- alloc.c to see why). There is no way to free a vectorlike object.
+ There is no way to explicitly free a Lisp Object; only the garbage
+ collector frees them.
To add a new pseudovector type, extend the pvec_type enumeration;
to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration.
@@ -2370,140 +2368,6 @@ struct Lisp_Overlay
Lisp_Object plist;
};
-/* Number of bits needed to store one of the values
- SAVE_UNUSED..SAVE_OBJECT. */
-enum { SAVE_SLOT_BITS = 3 };
-
-/* Number of slots in a save value where save_type is nonzero. */
-enum { SAVE_VALUE_SLOTS = 4 };
-
-/* Bit-width and values for struct Lisp_Save_Value's save_type member. */
-
-enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 };
-
-/* Types of data which may be saved in a Lisp_Save_Value. */
-
-enum Lisp_Save_Type
- {
- SAVE_UNUSED,
- SAVE_INTEGER,
- SAVE_FUNCPOINTER,
- SAVE_POINTER,
- SAVE_OBJECT,
- SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_INT_INT_INT
- = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)),
- SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
- = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS),
- SAVE_TYPE_FUNCPTR_PTR_OBJ
- = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS),
-
- /* This has an extra bit indicating it's raw memory. */
- SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1))
- };
-
-/* SAVE_SLOT_BITS must be large enough to represent these values. */
-verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER
- | SAVE_POINTER | SAVE_OBJECT)
- >> SAVE_SLOT_BITS)
- == 0);
-
-/* Special object used to hold a different values for later use.
-
- This is mostly used to package C integers and pointers to call
- record_unwind_protect when two or more values need to be saved.
- For example:
-
- ...
- struct my_data *md = get_my_data ();
- ptrdiff_t mi = get_my_integer ();
- record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
- ...
-
- Lisp_Object my_unwind (Lisp_Object arg)
- {
- struct my_data *md = XSAVE_POINTER (arg, 0);
- ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
- ...
- }
-
- If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
- saved objects and raise eassert if type of the saved object doesn't match
- the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
- and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
- slot 0 is a pointer. */
-
-typedef void (*voidfuncptr) (void);
-
-struct Lisp_Save_Value
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- bool_bf gcmarkbit : 1;
- unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
-
- /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
- V's data entries are determined by V->save_type. E.g., if
- V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
- V->data[1] is an integer, and V's other data entries are unused.
-
- If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
- a memory area containing V->data[1].integer potential Lisp_Objects. */
- ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
- union {
- void *pointer;
- voidfuncptr funcpointer;
- ptrdiff_t integer;
- Lisp_Object object;
- } data[SAVE_VALUE_SLOTS];
- };
-
-INLINE bool
-SAVE_VALUEP (Lisp_Object x)
-{
- return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
-}
-
-INLINE struct Lisp_Save_Value *
-XSAVE_VALUE (Lisp_Object a)
-{
- eassert (SAVE_VALUEP (a));
- return XUNTAG (a, Lisp_Misc);
-}
-
-/* Return the type of V's Nth saved value. */
-INLINE int
-save_type (struct Lisp_Save_Value *v, int n)
-{
- eassert (0 <= n && n < SAVE_VALUE_SLOTS);
- return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
-}
-
-/* Get and set the Nth saved pointer. */
-
-INLINE void *
-XSAVE_POINTER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- return XSAVE_VALUE (obj)->data[n].pointer;
-}
-INLINE void
-set_save_pointer (Lisp_Object obj, int n, void *val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- XSAVE_VALUE (obj)->data[n].pointer = val;
-}
-INLINE voidfuncptr
-XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER);
- return XSAVE_VALUE (obj)->data[n].funcpointer;
-}
-
struct Lisp_Misc_Ptr
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */
@@ -2545,30 +2409,6 @@ xmint_pointer (Lisp_Object a)
return p->pointer;
}
-/* Get and set the Nth saved integer. */
-
-INLINE ptrdiff_t
-XSAVE_INTEGER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- return XSAVE_VALUE (obj)->data[n].integer;
-}
-INLINE void
-set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- XSAVE_VALUE (obj)->data[n].integer = val;
-}
-
-/* Extract Nth saved object. */
-
-INLINE Lisp_Object
-XSAVE_OBJECT (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
- return XSAVE_VALUE (obj)->data[n].object;
-}
-
#ifdef HAVE_MODULES
struct Lisp_User_Ptr
{
@@ -2627,7 +2467,6 @@ union Lisp_Misc
struct Lisp_Free u_free;
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
- struct Lisp_Save_Value u_save_value;
struct Lisp_Finalizer u_finalizer;
struct Lisp_Misc_Ptr u_misc_ptr;
#ifdef HAVE_MODULES
@@ -3710,7 +3549,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
/* Defined in alloc.c. */
extern void *my_heap_start (void);
extern void check_pure_size (void);
-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);
@@ -3864,16 +3702,6 @@ extern bool gc_in_progress;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
-extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
-extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-extern Lisp_Object make_save_ptr (void *);
-extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
-extern Lisp_Object make_save_ptr_ptr (void *, void *);
-extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
- Lisp_Object);
-extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
-extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
diff --git a/src/print.c b/src/print.c
index a991f3ffa3..b8af2ca87b 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2174,89 +2174,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
break;
- case Lisp_Misc_Save_Value:
- {
- int i;
- struct Lisp_Save_Value *v = XSAVE_VALUE (obj);
-
- print_c_string ("#<save-value ", printcharfun);
-
- if (v->save_type == SAVE_TYPE_MEMORY)
- {
- ptrdiff_t amount = v->data[1].integer;
-
- /* valid_lisp_object_p is reliable, so try to print up
- to 8 saved objects. This code is rarely used, so
- it's OK that valid_lisp_object_p is slow. */
-
- int limit = min (amount, 8);
- Lisp_Object *area = v->data[0].pointer;
-
- i = sprintf (buf, "with %"pD"d objects", amount);
- strout (buf, i, i, printcharfun);
-
- for (i = 0; i < limit; i++)
- {
- Lisp_Object maybe = area[i];
- int valid = valid_lisp_object_p (maybe);
-
- printchar (' ', printcharfun);
- if (0 < valid)
- print_object (maybe, printcharfun, escapeflag);
- else
- print_c_string (valid < 0 ? "<some>" : "<invalid>",
- printcharfun);
- }
- if (i == limit && i < amount)
- print_c_string (" ...", printcharfun);
- }
- else
- {
- /* Print each slot according to its type. */
- int index;
- for (index = 0; index < SAVE_VALUE_SLOTS; index++)
- {
- if (index)
- printchar (' ', printcharfun);
-
- switch (save_type (v, index))
- {
- case SAVE_UNUSED:
- i = sprintf (buf, "<unused>");
- break;
-
- case SAVE_POINTER:
- i = sprintf (buf, "<pointer %p>",
- v->data[index].pointer);
- break;
-
- case SAVE_FUNCPOINTER:
- i = sprintf (buf, "<funcpointer %p>",
- ((void *) (intptr_t)
- v->data[index].funcpointer));
- break;
-
- case SAVE_INTEGER:
- i = sprintf (buf, "<integer %"pD"d>",
- v->data[index].integer);
- break;
-
- case SAVE_OBJECT:
- print_object (v->data[index].object, printcharfun,
- escapeflag);
- continue;
-
- default:
- emacs_abort ();
- }
-
- strout (buf, i, i, printcharfun);
- }
- }
- printchar ('>', printcharfun);
- }
- break;
-
default:
goto badtype;
}
--
2.17.1
^ permalink raw reply related [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-08 2:27 bug#31750: simplify and tune Emacs stack-related allocation Paul Eggert
@ 2018-06-08 3:20 ` Daniel Colascione
2018-06-08 15:42 ` Paul Eggert
2018-06-10 3:30 ` Noam Postavsky
1 sibling, 1 reply; 8+ messages in thread
From: Daniel Colascione @ 2018-06-08 3:20 UTC (permalink / raw)
To: Paul Eggert, 31750
On 06/07/2018 07:27 PM, Paul Eggert wrote:
> While looking into the Emacs garbage collector's stack-overflow problems
> I noticed several opportunities for improving performance and
> simplifying the code in minor ways. I plan to install the attached
> patches to take advantage of these opportunities; although they don't
> address stack overflow,
One can also dream of the lisp evaluator doing escape analysis and stack
allocation.
> they can be thought of as a first, cleanup step
> toward addressing stack overflow.
Are you thinking along the same lines I was thinking of in my proposal
to address GC safety?
> Overall these patches trim about 250 lines from the C source code, and
> should improve efficiency by not creating objects on the heap to handle
> stack-related events such as implementing save-excursion. This patch
> also removes primitives like 'free_misc' that ask for trouble by
> second-guessing the garbage collector. I'm filing this as a bug report
> in order to give the patches a bit of time to cool before installing.
> Comments welcome, as usual.
>
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-08 3:20 ` Daniel Colascione
@ 2018-06-08 15:42 ` Paul Eggert
0 siblings, 0 replies; 8+ messages in thread
From: Paul Eggert @ 2018-06-08 15:42 UTC (permalink / raw)
To: Daniel Colascione, 31750
Daniel Colascione wrote:
> Are you thinking along the same lines I was thinking of in my proposal to
> address GC safety?
Quite possibly, though I expect my thoughts are along more-gradual and
more-modest lines. Can you remind me what that proposal is, with a bug# or a URL
or something? I remember our discussion in 2016 about signal handling, but I
don't recall exactly what the proposed fixes were, other than to eliminate the
longjmp when the C stack overflows.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-08 2:27 bug#31750: simplify and tune Emacs stack-related allocation Paul Eggert
2018-06-08 3:20 ` Daniel Colascione
@ 2018-06-10 3:30 ` Noam Postavsky
2018-06-10 4:03 ` Paul Eggert
1 sibling, 1 reply; 8+ messages in thread
From: Noam Postavsky @ 2018-06-10 3:30 UTC (permalink / raw)
To: Paul Eggert; +Cc: 31750
Paul Eggert <eggert@cs.ucla.edu> writes:
> Subject: [PATCH 01/10] New mint_ptr representation for C pointers
>
> * src/lisp.h (make_mint_ptr, mint_ptrp, xmint_pointer): New functions.
> Use mint pointers instead of merely save pointers.
I think it would be helpful to add a brief summary of the tradeoffs
between save pointers and mint pointers to the commit message.
> +/* A mint_ptr object OBJ represents a pointer P. OBJ is preferably a
> + Lisp integer I such that XINTPTR (i) == P, as this is more efficient.
^ ^
I guess one of these is in the wrong case.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-10 3:30 ` Noam Postavsky
@ 2018-06-10 4:03 ` Paul Eggert
2018-06-10 15:07 ` Eli Zaretskii
0 siblings, 1 reply; 8+ messages in thread
From: Paul Eggert @ 2018-06-10 4:03 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 31750
Noam Postavsky wrote:
> Paul Eggert <eggert@cs.ucla.edu> writes:
>
>> Subject: [PATCH 01/10] New mint_ptr representation for C pointers
>>
>> * src/lisp.h (make_mint_ptr, mint_ptrp, xmint_pointer): New functions.
>
>> Use mint pointers instead of merely save pointers.
>
> I think it would be helpful to add a brief summary of the tradeoffs
> between save pointers and mint pointers to the commit message.
Thanks for looking at it. Here's a quick attempt at a summary comment for
make_mint_ptr. This wording compares mint_ptr values to Lisp_User_Ptr values,
not to save pointers, in order simplify the later patch that removes save pointers.
/* A mint_ptr object OBJ represents a C-language pointer P efficiently.
Preferably (and typically), OBJ is a Lisp integer I such that
XINTPTR (I) == P, as this represents P within a single Lisp value
without requiring any auxiliary memory. However, if P would be
damaged by being tagged as an integer and then untagged via
XINTPTR, then OBJ is a Lisp_Save_Value with pointer component P.
mint_ptr objects are efficiency hacks that are intended for use
only within C code. C code should never blindly accept a mint_ptr
object from Lisp code, as that would allow Lisp code to coin
pointers from integers and could lead to crashes. A C pointer that
needs to be packaged into a Lisp-visible object can be made part of
a Lisp_Misc type instead; see Lisp_User_Ptr for an example. */
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-10 4:03 ` Paul Eggert
@ 2018-06-10 15:07 ` Eli Zaretskii
2018-06-10 16:12 ` Paul Eggert
2018-06-15 7:46 ` Paul Eggert
0 siblings, 2 replies; 8+ messages in thread
From: Eli Zaretskii @ 2018-06-10 15:07 UTC (permalink / raw)
To: Paul Eggert; +Cc: npostavs, 31750
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sat, 9 Jun 2018 21:03:25 -0700
> Cc: 31750@debbugs.gnu.org
>
> /* A mint_ptr object OBJ represents a C-language pointer P efficiently.
> Preferably (and typically), OBJ is a Lisp integer I such that
> XINTPTR (I) == P, as this represents P within a single Lisp value
> without requiring any auxiliary memory. However, if P would be
> damaged by being tagged as an integer and then untagged via
> XINTPTR, then OBJ is a Lisp_Save_Value with pointer component P.
>
> mint_ptr objects are efficiency hacks that are intended for use
> only within C code. C code should never blindly accept a mint_ptr
> object from Lisp code, as that would allow Lisp code to coin
> pointers from integers and could lead to crashes. A C pointer that
> needs to be packaged into a Lisp-visible object can be made part of
> a Lisp_Misc type instead; see Lisp_User_Ptr for an example. */
I'm not sure I agree with the last part, at least not in such
categorical terms. E.g., w32notify.c does exactly what the above says
not to do, and AFAICT is a very good candidate for using mint_ptr
objects.
OTOH, maybe I do agree, as long as "blindly" is an essential part of
that rule ;-)
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-10 15:07 ` Eli Zaretskii
@ 2018-06-10 16:12 ` Paul Eggert
2018-06-15 7:46 ` Paul Eggert
1 sibling, 0 replies; 8+ messages in thread
From: Paul Eggert @ 2018-06-10 16:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: npostavs, 31750
Eli Zaretskii wrote:
> OTOH, maybe I do agree, as long as "blindly" is an essential part of
> that rule ;-)
Yes, the "blindly" is essential. It's OK to use xmint_ptr on any mint_ptr, so
long as you don't blindly trust the result to be a valid C pointer of the kind
that you want; that is, you have to know that your C code created the mint_ptr
in question and that no Lisp code can have replaced the mint_ptr with some other
object (perhaps also a mint_ptr). This is like XSAVE_POINTER, where you also
have to know that Lisp code has not replaced the Lisp_Save_Value object with
some other object (perhaps also of type Lisp_Save_Value and with a pointer payload).
The main difference is that Lisp code can easily coin a mint_ptr (simply by
using a fixnum) whereas it can't easily coin a Lisp_Save_Value, so there's less
runtime checking to catch bugs in the C code. However, if two or more
Lisp_Save_Value objects are exposed to Lisp code then the Lisp code can pass one
where the other is expected and this can cause the same sort of crash as passing
a fixnum where a mint_ptr is expected, so introducing mint_ptr doesn't make
things that much more dangerous in principle than they were before.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31750: simplify and tune Emacs stack-related allocation
2018-06-10 15:07 ` Eli Zaretskii
2018-06-10 16:12 ` Paul Eggert
@ 2018-06-15 7:46 ` Paul Eggert
1 sibling, 0 replies; 8+ messages in thread
From: Paul Eggert @ 2018-06-15 7:46 UTC (permalink / raw)
To: 31750-done
I installed the patches into master after tweaking the mint_ptr comments a bit,
and am marking this as done.
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2018-06-15 7:46 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-06-08 2:27 bug#31750: simplify and tune Emacs stack-related allocation Paul Eggert
2018-06-08 3:20 ` Daniel Colascione
2018-06-08 15:42 ` Paul Eggert
2018-06-10 3:30 ` Noam Postavsky
2018-06-10 4:03 ` Paul Eggert
2018-06-10 15:07 ` Eli Zaretskii
2018-06-10 16:12 ` Paul Eggert
2018-06-15 7:46 ` Paul Eggert
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).