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.

diff --git a/src/alloc.c b/src/alloc.c
index e5fc6ebeb1a2832142354c885d99280116a8ba23..1d3ec4fbb8aabe39010dc2bff80cb68c6ae49e26 100644 (file)
--- 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 dded16bed5555c0569c651561b54ce89f55283a6..952a0ec4b46fa30e334ef86149c9fbe7af3a6697 100644 (file)
--- 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:
@@ -3407,6 +3408,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)
 {
@@ -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 af3f587222d43e989e87ee93bc65f1d7f0fb4283..f02b50bad753e735299648a7f4faf0f75d8937e6 100644 (file)
--- 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.  */
@@ -3205,6 +3207,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 *);
@@ -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)