Tune SAFE_FREE

On my platform (Fedora 28 x86-64, AMD Phenom II X4 910e) this sped
up a SAFE_FREE-using microbenchmark (string-distance "abc" "abc")
by about 18%, and shrank the Emacs text size by about 0.1%.
* src/callint.c (Fcall_interactively):
* src/callproc.c (call_process):
* src/doc.c (get_doc_string, Fsnarf_documentation):
* src/editfns.c (Freplace_buffer_contents):
* src/emacs-module.c (funcall_module):
* src/eval.c (Flet):
* src/process.c (Fmake_process):
* src/term.c (tty_menu_show):
* src/xdisp.c (safe__call):
* src/xmenu.c (x_menu_show):
Use SAFE_FREE_UNBIND_TO.
* src/data.c (wrong_choice): No need to call SAFE_FREE here.
* src/lisp.h (USE_SAFE_ALLOCA):
* src/regex.c (REGEX_USE_SAFE_ALLOCA):
Do not declare sa_must_free local; no longer needed.
All uses removed.
(SAFE_FREE): Rewrite in terms of safe_free.
(safe_free): New function, optimized to use xfree.
(SAFE_FREE_UNBIND_TO): New macro.
(safe_free_unbind_to): New function.

diff --git a/src/callint.c b/src/callint.c
index fd44494cfee3315fe752dfd3c825149f8290175d..c6e003ed408dd0203723a250612dda9344929ff6 100644 (file)
--- a/src/callint.c
+++ b/src/callint.c
@@ -779,8 +779,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   specbind (Qcommand_debug_status, Qnil);
 
   Lisp_Object val = Ffuncall (nargs, args);
-  SAFE_FREE ();
-  return unbind_to (speccount, val);
+  return SAFE_FREE_UNBIND_TO (speccount, val);
 }
 
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,

diff --git a/src/callproc.c b/src/callproc.c
index 973f324139c7e52a396c2699aa1e35d7d9250586..17eb8132d966275620208cea9a7b15c00dbbebe7 100644 (file)
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -599,7 +599,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
     Lisp_Object volatile coding_systems_volatile = coding_systems;
     Lisp_Object volatile current_dir_volatile = current_dir;
     bool volatile display_p_volatile = display_p;
-    bool volatile sa_must_free_volatile = sa_must_free;
     int volatile fd_error_volatile = fd_error;
     int volatile filefd_volatile = filefd;
     ptrdiff_t volatile count_volatile = count;
@@ -616,7 +615,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
     coding_systems = coding_systems_volatile;
     current_dir = current_dir_volatile;
     display_p = display_p_volatile;
-    sa_must_free = sa_must_free_volatile;
     fd_error = fd_error_volatile;
     filefd = filefd_volatile;
     count = count_volatile;
@@ -885,8 +883,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
      when exiting.  */
   synch_process_pid = 0;
 
-  SAFE_FREE ();
-  unbind_to (count, Qnil);
+  SAFE_FREE_UNBIND_TO (count, Qnil);
 
   if (!wait_ok)
     return build_unibyte_string ("internal error");

diff --git a/src/data.c b/src/data.c
index 49c3dd834ba4ad08f9dc8843e510a32e30bb84a2..605a5f43af7675d8b2ac443bf3c5376ca6e270c9 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1049,7 +1049,10 @@ wrong_choice (Lisp_Object choice, Lisp_Object wrong)
     }
 
   obj = Fconcat (i, args);
-  SAFE_FREE ();
+
+  /* No need to call SAFE_FREE, since signaling does that for us.  */
+  (void) sa_count;
+
   xsignal2 (Qerror, obj, wrong);
 }
 

diff --git a/src/doc.c b/src/doc.c
index 4264ed50640fe54a0b83cccd937fbf17bd76bab9..075154e94bc4e1a01ea317c7458eac1d058e4317 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -86,7 +86,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
   int offset;
   EMACS_INT position;
   Lisp_Object file, tem, pos;
-  ptrdiff_t count;
+  ptrdiff_t count = SPECPDL_INDEX ();
   USE_SAFE_ALLOCA;
 
   if (INTEGERP (filepos))
@@ -148,7 +148,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
          return concat3 (cannot_open, file, quote_nl);
        }
     }
-  count = SPECPDL_INDEX ();
   record_unwind_protect_int (close_file_unwind, fd);
 
   /* Seek only to beginning of disk block.  */
@@ -204,8 +203,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
        }
       p += nread;
     }
-  unbind_to (count, Qnil);
-  SAFE_FREE ();
+  SAFE_FREE_UNBIND_TO (count, Qnil);
 
   /* Sanity checking.  */
   if (CONSP (filepos))
@@ -659,8 +657,7 @@ the same file name is found in the `doc-directory'.  */)
       memmove (buf, end, filled);
     }
 
-  SAFE_FREE ();
-  return unbind_to (count, Qnil);
+  return SAFE_FREE_UNBIND_TO (count, Qnil);
 }
 \f
 /* Return true if text quoting style should default to quote `like this'.  */

diff --git a/src/editfns.c b/src/editfns.c
index 7d032a7ca4c90c19db9d9101720a52cb399fd62e..88dfba1f9102317876743d8ad5972b251f41d8dc 100644 (file)
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3198,6 +3198,8 @@ differences between the two buffers.  */)
       return Qnil;
     }
 
+  ptrdiff_t count = SPECPDL_INDEX ();
+
   /* FIXME: It is not documented how to initialize the contents of the
      context structure.  This code cargo-cults from the existing
      caller in src/analyze.c of GNU Diffutils, which appears to
@@ -3231,7 +3233,6 @@ differences between the two buffers.  */)
   eassert (! early_abort);
 
   Fundo_boundary ();
-  ptrdiff_t count = SPECPDL_INDEX ();
   record_unwind_protect_excursion ();
 
   ptrdiff_t i = size_a;
@@ -3279,10 +3280,8 @@ differences between the two buffers.  */)
       --i;
       --j;
     }
-  unbind_to (count, Qnil);
-  SAFE_FREE ();
 
-  return Qnil;
+  return SAFE_FREE_UNBIND_TO (count, Qnil);
 }
 
 static void
@@ -4885,7 +4884,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
       if (buf == initial_buffer)
        {
          buf = xmalloc (bufsize);
-         sa_must_free = true;
          buf_save_value_index = SPECPDL_INDEX ();
          record_unwind_protect_ptr (xfree, buf);
          memcpy (buf, initial_buffer, used);

diff --git a/src/emacs-module.c b/src/emacs-module.c
index 3a246637990e6f47b1e97c594294734129532be8..5b9f6629e76e63d370483e44ccb6994a79976091 100644 (file)
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -786,7 +786,6 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
     }
 
   emacs_value ret = func->subr (env, nargs, args, func->data);
-  SAFE_FREE ();
 
   eassert (&priv == env->private_members);
 
@@ -795,7 +794,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
   maybe_quit ();
 
   module_signal_or_throw (&priv);
-  return unbind_to (count, value_to_lisp (ret));
+  return SAFE_FREE_UNBIND_TO (count, value_to_lisp (ret));
 }
 
 Lisp_Object

diff --git a/src/eval.c b/src/eval.c
index 952a0ec4b46fa30e334ef86149c9fbe7af3a6697..9e0fabdcfba3415e22c3a6f0e024f6dfb144329b 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -981,8 +981,7 @@ usage: (let VARLIST BODY...)  */)
     specbind (Qinternal_interpreter_environment, lexenv);
 
   elt = Fprogn (XCDR (args));
-  SAFE_FREE ();
-  return unbind_to (count, elt);
+  return SAFE_FREE_UNBIND_TO (count, elt);
 }
 
 DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,

diff --git a/src/lisp.h b/src/lisp.h
index 8c884dce150dff36887c4e774fadcc680b5b86de..b544d814d99cf5eef0b06d66bad4c36915fb4394 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4500,7 +4500,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
 
 #define USE_SAFE_ALLOCA                        \
   ptrdiff_t sa_avail = MAX_ALLOCA;     \
-  ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
+  ptrdiff_t sa_count = SPECPDL_INDEX ()
 
 #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size))
 
@@ -4508,7 +4508,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
 
 #define SAFE_ALLOCA(size) ((size) <= sa_avail                          \
                           ? AVAIL_ALLOCA (size)                        \
-                          : (sa_must_free = true, record_xmalloc (size)))
+                          : record_xmalloc (size))
 
 /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
    NITEMS items, each of the same type as *BUF.  MULTIPLIER must
@@ -4521,7 +4521,6 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
     else                                                        \
       {                                                                 \
        (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
-       sa_must_free = true;                                     \
        record_unwind_protect_ptr (xfree, buf);                  \
       }                                                                 \
   } while (false)
@@ -4534,15 +4533,37 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
     memcpy (ptr, SDATA (string), SBYTES (string) + 1); \
   } while (false)
 
-/* SAFE_FREE frees xmalloced memory and enables GC as needed.  */
+/* Free xmalloced memory and enable GC as needed.  */
 
-#define SAFE_FREE()                    \
-  do {                                 \
-    if (sa_must_free) {                        \
-      sa_must_free = false;            \
-      unbind_to (sa_count, Qnil);      \
-    }                                  \
-  } while (false)
+#define SAFE_FREE() safe_free (sa_count)
+
+INLINE void
+safe_free (ptrdiff_t sa_count)
+{
+  while (specpdl_ptr != specpdl + sa_count)
+    {
+      specpdl_ptr--;
+      eassert (specpdl_ptr->kind == SPECPDL_UNWIND_PTR
+              && specpdl_ptr->unwind_ptr.func == xfree);
+      xfree (specpdl_ptr->unwind_ptr.arg);
+    }
+}
+
+/* Pop the specpdl stack back to COUNT, and return VAL.
+   Prefer this to { SAFE_FREE (); unbind_to (COUNT, VAL); }
+   when COUNT predates USE_SAFE_ALLOCA, as it is a bit more efficient
+   and also lets callers intermix SAFE_ALLOCA calls with other calls
+   that grow the specpdl stack.  */
+
+#define SAFE_FREE_UNBIND_TO(count, val) \
+  safe_free_unbind_to (count, sa_count, val)
+
+INLINE Lisp_Object
+safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val)
+{
+  eassert (count <= sa_count);
+  return unbind_to (count, val);
+}
 
 /* Set BUF to point to an allocated array of NELT Lisp_Objects,
    immediately followed by EXTRA spare bytes.  */
@@ -4560,7 +4581,6 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
       {                                                               \
        (buf) = xmalloc (alloca_nbytes);                       \
        record_unwind_protect_array (buf, nelt);               \
-       sa_must_free = true;                                   \
       }                                                               \
   } while (false)
 

diff --git a/src/process.c b/src/process.c
index 6dba218c90726559a71cc04ec0d38749ad9fd19d..279b74bc66ea3cc4a1bbfce657e8800e07d59057 100644 (file)
--- a/src/process.c
+++ b/src/process.c
@@ -1923,8 +1923,7 @@ usage: (make-process &rest ARGS)  */)
   else
     create_pty (proc);
 
-  SAFE_FREE ();
-  return unbind_to (count, proc);
+  return SAFE_FREE_UNBIND_TO (count, proc);
 }
 
 /* If PROC doesn't have its pid set, then an error was signaled and

diff --git a/src/regex.c b/src/regex.c
index b8c6f3f19b26cff59acc8ec6ad1a7d4684f5150d..6ee13c4c99d09a8c6cf1495999dd051c3fa8732b 100644 (file)
--- a/src/regex.c
+++ b/src/regex.c
@@ -455,7 +455,7 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA;
 /* Like USE_SAFE_ALLOCA, but use emacs_re_safe_alloca.  */
 #  define REGEX_USE_SAFE_ALLOCA                                        \
   ptrdiff_t sa_avail = emacs_re_safe_alloca;                           \
-  ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
+  ptrdiff_t sa_count = SPECPDL_INDEX ()
 
 #  define REGEX_SAFE_FREE() SAFE_FREE ()
 #  define REGEX_ALLOCATE SAFE_ALLOCA

diff --git a/src/term.c b/src/term.c
index 85bfa84d937a6fd214a76d8801af0f9b5530cb42..f5fca7f987e90e324e14b8ff09b9564b71966e8c 100644 (file)
--- a/src/term.c
+++ b/src/term.c
@@ -3776,9 +3776,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags,
 
  tty_menu_end:
 
-  SAFE_FREE ();
-  unbind_to (specpdl_count, Qnil);
-  return entry;
+  return SAFE_FREE_UNBIND_TO (specpdl_count, entry);
 }
 
 #endif /* !MSDOS */

diff --git a/src/xdisp.c b/src/xdisp.c
index dcb002055b421393b7b7393eeeefd3fd81f2980f..3406c2fb466931a6d0039c9fb4a510d4e0d804ec 100644 (file)
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2637,8 +2637,7 @@ safe__call (bool inhibit_quit, ptrdiff_t nargs, Lisp_Object func, va_list ap)
         so there is no possibility of wanting to redisplay.  */
       val = internal_condition_case_n (Ffuncall, nargs, args, Qt,
                                       safe_eval_handler);
-      SAFE_FREE ();
-      val = unbind_to (count, val);
+      val = SAFE_FREE_UNBIND_TO (count, val);
     }
 
   return val;

diff --git a/src/xmenu.c b/src/xmenu.c
index 6477d5b0aca29327e86bae3d16632752a8656abe..dc6f33112c51b842cbb2877cb9f1a05c8ff2e39f 100644 (file)
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -2375,8 +2375,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags,
 
  return_entry:
   unblock_input ();
-  SAFE_FREE ();
-  return unbind_to (specpdl_count, entry);
+  return SAFE_FREE_UNBIND_TO (specpdl_count, entry);
 }
 
 #endif /* not USE_X_TOOLKIT */