>From 834105816586831a11d5313f512f64364d4966b8 Mon Sep 17 00:00:00 2001
From: Paul Eggert <address@hidden>
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