[Emacs-diffs] master d98670e 08/10: Avoid allocating Lisp_Save_Value for arrays

[Paul Eggert]

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

    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 e5fc6eb..1d3ec4f 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 dded16b..952a0ec 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 af3f587..f02b50b 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)