all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* 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 +++++++++++++-------
 src/xmenu.c | 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));
diff --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
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 external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.