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.

3 files changed, 37 insertions, 3 deletions

diff --git a/src/alloc.c b/src/alloc.c
index e5fc6ebeb1a..1d3ec4fbb8a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4845,6 +4845,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 might point to Lisp data that can be garbage
    collected, and false otherwise (i.e., false if it is easy to see
    that P cannot point to Lisp data that can be garbage collected).
diff --git a/src/eval.c b/src/eval.c
index dded16bed55..952a0ec4b46 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -673,6 +673,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:
@@ -3408,6 +3409,15 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
 }
 
 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)
 {
   specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
@@ -3469,6 +3479,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;
@@ -3771,6 +3784,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:
@@ -3903,6 +3917,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:
@@ -3935,6 +3950,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 af3f587222d..f02b50bad75 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3186,6 +3186,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.  */
@@ -3207,6 +3209,12 @@ union specbinding
     } 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 *);
       void *arg;
     } unwind_ptr;
@@ -3702,6 +3710,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;
@@ -4016,6 +4025,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));
@@ -4710,11 +4720,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)