From d98670eb04925fdc4a4928a9b0d0858881da418f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH] 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 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: @@ -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 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. */ @@ -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) -- 2.39.2