[Emacs-diffs] master 76eda95: Tune SAFE_FREE

[Paul Eggert]

branch: master
commit 76eda952b09db6d79342b7ddfcae45c7c836ab62
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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.
---
 src/callint.c      |  3 +--
 src/callproc.c     |  5 +----
 src/data.c         |  5 ++++-
 src/doc.c          |  9 +++------
 src/editfns.c      |  8 +++-----
 src/emacs-module.c |  3 +--
 src/eval.c         |  3 +--
 src/lisp.h         | 44 ++++++++++++++++++++++++++++++++------------
 src/process.c      |  3 +--
 src/regex.c        |  2 +-
 src/term.c         |  4 +---
 src/xdisp.c        |  3 +--
 src/xmenu.c        |  3 +--
 13 files changed, 51 insertions(+), 44 deletions(-)

diff --git a/src/callint.c b/src/callint.c
index fd44494..c6e003e 100644
--- 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 973f324..17eb813 100644
--- 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 49c3dd8..605a5f4 100644
--- 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 4264ed5..075154e 100644
--- 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);
 }
 
 /* Return true if text quoting style should default to quote `like this'.  */
diff --git a/src/editfns.c b/src/editfns.c
index 7d032a7..88dfba1 100644
--- 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 3a24663..5b9f662 100644
--- 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 952a0ec..9e0fabd 100644
--- 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 8c884dc..b544d81 100644
--- 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 6dba218..279b74b 100644
--- 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 b8c6f3f..6ee13c4 100644
--- 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 85bfa84..f5fca7f 100644
--- 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 dcb0020..3406c2f 100644
--- 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 6477d5b..dc6f331 100644
--- 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 */