From 62c2e5ed3a9c991cef2594b44afc74893f6ce26b Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Mon, 3 Dec 2012 12:06:02 +0400 Subject: [PATCH] * alloc.c (free_save_value): New function. (safe_alloca_unwind): Use it. * lisp.h (free_save_value): New prototype. * editfns.c (save_excursion_save): Use Lisp_Misc_Save_Value. Add comment. (save_excursion_restore): Adjust to match saved data structure. Use free_save_value to offload some work from GC. Drop obsolete #if 0 code. --- src/ChangeLog | 11 ++++++++ src/alloc.c | 20 +++++++++---- src/editfns.c | 77 +++++++++++++++++++++++---------------------------- src/lisp.h | 1 + 4 files changed, 61 insertions(+), 48 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 0808dad2c93..035ef88c485 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2012-12-03 Dmitry Antipov + + * alloc.c (free_save_value): New function. + (safe_alloca_unwind): Use it. + * lisp.h (free_save_value): New prototype. + * editfns.c (save_excursion_save): Use Lisp_Misc_Save_Value. + Add comment. + (save_excursion_restore): Adjust to match saved data structure. + Use free_save_value to offload some work from GC. Drop obsolete + #if 0 code. + 2012-12-03 Chong Yidong * fileio.c (Vauto_save_list_file_name): Doc fix. diff --git a/src/alloc.c b/src/alloc.c index e504b3d93ec..0f105f87207 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -826,12 +826,7 @@ xstrdup (const char *s) Lisp_Object safe_alloca_unwind (Lisp_Object arg) { - register struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - - p->dogc = 0; - xfree (p->pointer); - p->pointer = 0; - free_misc (arg); + free_save_value (arg); return Qnil; } @@ -3365,6 +3360,19 @@ make_save_value (void *pointer, ptrdiff_t integer) return val; } +/* Free a Lisp_Misc_Save_Value object. */ + +void +free_save_value (Lisp_Object save) +{ + register struct Lisp_Save_Value *p = XSAVE_VALUE (save); + + p->dogc = 0; + xfree (p->pointer); + p->pointer = NULL; + free_misc (save); +} + /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ Lisp_Object diff --git a/src/editfns.c b/src/editfns.c index 8122ffdd0d4..390ce21bbca 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -813,38 +813,43 @@ This function does not move point. */) Qnil, Qt, Qnil); } - +/* Save current buffer state for `save-excursion' special form. + We (ab)use Lisp_Misc_Save_Value to allow explicit free and so + offload some work from GC. */ + Lisp_Object save_excursion_save (void) { - bool visible = (XBUFFER (XWINDOW (selected_window)->buffer) - == current_buffer); + Lisp_Object save, *data = xmalloc (word_size * 4); + + data[0] = Fpoint_marker (); /* Do not copy the mark if it points to nowhere. */ - Lisp_Object mark = (XMARKER (BVAR (current_buffer, mark))->buffer - ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) - : Qnil); - - return Fcons (Fpoint_marker (), - Fcons (mark, - Fcons (visible ? Qt : Qnil, - Fcons (BVAR (current_buffer, mark_active), - selected_window)))); + data[1] = (XMARKER (BVAR (current_buffer, mark))->buffer + ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) + : Qnil); + /* Selected window if current buffer is shown in it, nil otherwise. */ + data[2] = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) + ? selected_window : Qnil); + data[3] = BVAR (current_buffer, mark_active); + + save = make_save_value (data, 4); + XSAVE_VALUE (save)->dogc = 1; + return save; } +/* Restore saved buffer before leaving `save-excursion' special form. */ + Lisp_Object save_excursion_restore (Lisp_Object info) { - Lisp_Object tem, tem1, omark, nmark; + Lisp_Object tem, tem1, omark, nmark, *data = XSAVE_VALUE (info)->pointer; struct gcpro gcpro1, gcpro2, gcpro3; - bool visible_p; - tem = Fmarker_buffer (XCAR (info)); - /* If buffer being returned to is now deleted, avoid error */ - /* Otherwise could get error here while unwinding to top level - and crash */ - /* In that case, Fmarker_buffer returns nil now. */ + tem = Fmarker_buffer (data[0]); + /* If we're unwinding to top level, saved buffer may be deleted. This + means that all of its markers are unchained and so tem is nil. */ if (NILP (tem)) - return Qnil; + goto out; omark = nmark = Qnil; GCPRO3 (info, omark, nmark); @@ -852,13 +857,12 @@ save_excursion_restore (Lisp_Object info) Fset_buffer (tem); /* Point marker. */ - tem = XCAR (info); + tem = data[0]; Fgoto_char (tem); unchain_marker (XMARKER (tem)); /* Mark marker. */ - info = XCDR (info); - tem = XCAR (info); + tem = data[1]; omark = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (tem)) unchain_marker (XMARKER (BVAR (current_buffer, mark))); @@ -869,23 +873,8 @@ save_excursion_restore (Lisp_Object info) unchain_marker (XMARKER (tem)); } - /* visible */ - info = XCDR (info); - visible_p = !NILP (XCAR (info)); - -#if 0 /* We used to make the current buffer visible in the selected window - if that was true previously. That avoids some anomalies. - But it creates others, and it wasn't documented, and it is simpler - and cleaner never to alter the window/buffer connections. */ - tem1 = Fcar (tem); - if (!NILP (tem1) - && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) - Fswitch_to_buffer (Fcurrent_buffer (), Qnil); -#endif /* 0 */ - - /* Mark active */ - info = XCDR (info); - tem = XCAR (info); + /* Mark active. */ + tem = data[3]; tem1 = BVAR (current_buffer, mark_active); bset_mark_active (current_buffer, tem); @@ -909,8 +898,8 @@ save_excursion_restore (Lisp_Object info) /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this buffer, restore point in that window. */ - tem = XCDR (info); - if (visible_p + tem = data[2]; + if (WINDOWP (tem) && !EQ (tem, selected_window) && (tem1 = XWINDOW (tem)->buffer, (/* Window is live... */ @@ -920,6 +909,10 @@ save_excursion_restore (Lisp_Object info) Fset_window_point (tem, make_number (PT)); UNGCPRO; + + out: + + free_save_value (info); return Qnil; } diff --git a/src/lisp.h b/src/lisp.h index 419176d06c8..4dae66eec96 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2963,6 +2963,7 @@ extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object make_save_value (void *, ptrdiff_t); +extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_marker (Lisp_Object); extern void free_cons (struct Lisp_Cons *); -- 2.39.5