aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/editfns.c27
-rw-r--r--src/eval.c38
-rw-r--r--src/lisp.h9
3 files changed, 45 insertions, 29 deletions
diff --git a/src/editfns.c b/src/editfns.c
index e672c0eb74d..3147f9d1466 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -995,30 +995,24 @@ This function does not move point. */)
995 Qnil, Qt, Qnil); 995 Qnil, Qt, Qnil);
996} 996}
997 997
998/* Save current buffer state for `save-excursion' special form. 998/* Save current buffer state for save-excursion special form. */
999 We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
1000 offload some work from GC. */
1001 999
1002Lisp_Object 1000void
1003save_excursion_save (void) 1001save_excursion_save (union specbinding *pdl)
1004{ 1002{
1005 return make_save_obj_obj_obj_obj 1003 eassert (pdl->unwind_excursion.kind == SPECPDL_UNWIND_EXCURSION);
1006 (Fpoint_marker (), 1004 pdl->unwind_excursion.marker = Fpoint_marker ();
1007 Qnil, 1005 /* Selected window if current buffer is shown in it, nil otherwise. */
1008 /* Selected window if current buffer is shown in it, nil otherwise. */ 1006 pdl->unwind_excursion.window
1009 (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) 1007 = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
1010 ? selected_window : Qnil), 1008 ? selected_window : Qnil);
1011 Qnil);
1012} 1009}
1013 1010
1014/* Restore saved buffer before leaving `save-excursion' special form. */ 1011/* Restore saved buffer before leaving `save-excursion' special form. */
1015 1012
1016void 1013void
1017save_excursion_restore (Lisp_Object info) 1014save_excursion_restore (Lisp_Object marker, Lisp_Object window)
1018{ 1015{
1019 Lisp_Object marker = XSAVE_OBJECT (info, 0);
1020 Lisp_Object window = XSAVE_OBJECT (info, 2);
1021 free_misc (info);
1022 Lisp_Object buffer = Fmarker_buffer (marker); 1016 Lisp_Object buffer = Fmarker_buffer (marker);
1023 /* If we're unwinding to top level, saved buffer may be deleted. This 1017 /* If we're unwinding to top level, saved buffer may be deleted. This
1024 means that all of its markers are unchained and so BUFFER is nil. */ 1018 means that all of its markers are unchained and so BUFFER is nil. */
@@ -1027,6 +1021,7 @@ save_excursion_restore (Lisp_Object info)
1027 1021
1028 Fset_buffer (buffer); 1022 Fset_buffer (buffer);
1029 1023
1024 /* Point marker. */
1030 Fgoto_char (marker); 1025 Fgoto_char (marker);
1031 unchain_marker (XMARKER (marker)); 1026 unchain_marker (XMARKER (marker));
1032 1027
diff --git a/src/eval.c b/src/eval.c
index 5c7cb3196a6..dded16bed55 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -675,6 +675,7 @@ default_toplevel_binding (Lisp_Object symbol)
675 case SPECPDL_UNWIND: 675 case SPECPDL_UNWIND:
676 case SPECPDL_UNWIND_PTR: 676 case SPECPDL_UNWIND_PTR:
677 case SPECPDL_UNWIND_INT: 677 case SPECPDL_UNWIND_INT:
678 case SPECPDL_UNWIND_EXCURSION:
678 case SPECPDL_UNWIND_VOID: 679 case SPECPDL_UNWIND_VOID:
679 case SPECPDL_BACKTRACE: 680 case SPECPDL_BACKTRACE:
680 case SPECPDL_LET_LOCAL: 681 case SPECPDL_LET_LOCAL:
@@ -3427,7 +3428,9 @@ record_unwind_protect_int (void (*function) (int), int arg)
3427void 3428void
3428record_unwind_protect_excursion (void) 3429record_unwind_protect_excursion (void)
3429{ 3430{
3430 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 3431 specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION;
3432 save_excursion_save (specpdl_ptr);
3433 grow_specpdl ();
3431} 3434}
3432 3435
3433void 3436void
@@ -3475,6 +3478,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
3475 case SPECPDL_UNWIND_VOID: 3478 case SPECPDL_UNWIND_VOID:
3476 this_binding->unwind_void.func (); 3479 this_binding->unwind_void.func ();
3477 break; 3480 break;
3481 case SPECPDL_UNWIND_EXCURSION:
3482 save_excursion_restore (this_binding->unwind_excursion.marker,
3483 this_binding->unwind_excursion.window);
3484 break;
3478 case SPECPDL_BACKTRACE: 3485 case SPECPDL_BACKTRACE:
3479 break; 3486 break;
3480 case SPECPDL_LET: 3487 case SPECPDL_LET:
@@ -3749,18 +3756,21 @@ backtrace_eval_unrewind (int distance)
3749 unwind_protect, but the problem is that we don't know how to 3756 unwind_protect, but the problem is that we don't know how to
3750 rewind them afterwards. */ 3757 rewind them afterwards. */
3751 case SPECPDL_UNWIND: 3758 case SPECPDL_UNWIND:
3752 { 3759 if (tmp->unwind.func == set_buffer_if_live)
3753 Lisp_Object oldarg = tmp->unwind.arg; 3760 {
3754 if (tmp->unwind.func == set_buffer_if_live) 3761 Lisp_Object oldarg = tmp->unwind.arg;
3755 tmp->unwind.arg = Fcurrent_buffer (); 3762 tmp->unwind.arg = Fcurrent_buffer ();
3756 else if (tmp->unwind.func == save_excursion_restore) 3763 set_buffer_if_live (oldarg);
3757 tmp->unwind.arg = save_excursion_save (); 3764 }
3758 else 3765 break;
3759 break; 3766 case SPECPDL_UNWIND_EXCURSION:
3760 tmp->unwind.func (oldarg); 3767 {
3761 break; 3768 Lisp_Object marker = tmp->unwind_excursion.marker;
3769 Lisp_Object window = tmp->unwind_excursion.window;
3770 save_excursion_save (tmp);
3771 save_excursion_restore (marker, window);
3762 } 3772 }
3763 3773 break;
3764 case SPECPDL_UNWIND_PTR: 3774 case SPECPDL_UNWIND_PTR:
3765 case SPECPDL_UNWIND_INT: 3775 case SPECPDL_UNWIND_INT:
3766 case SPECPDL_UNWIND_VOID: 3776 case SPECPDL_UNWIND_VOID:
@@ -3895,6 +3905,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
3895 case SPECPDL_UNWIND: 3905 case SPECPDL_UNWIND:
3896 case SPECPDL_UNWIND_PTR: 3906 case SPECPDL_UNWIND_PTR:
3897 case SPECPDL_UNWIND_INT: 3907 case SPECPDL_UNWIND_INT:
3908 case SPECPDL_UNWIND_EXCURSION:
3898 case SPECPDL_UNWIND_VOID: 3909 case SPECPDL_UNWIND_VOID:
3899 case SPECPDL_BACKTRACE: 3910 case SPECPDL_BACKTRACE:
3900 break; 3911 break;
@@ -3924,6 +3935,11 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
3924 mark_object (specpdl_arg (pdl)); 3935 mark_object (specpdl_arg (pdl));
3925 break; 3936 break;
3926 3937
3938 case SPECPDL_UNWIND_EXCURSION:
3939 mark_object (pdl->unwind_excursion.marker);
3940 mark_object (pdl->unwind_excursion.window);
3941 break;
3942
3927 case SPECPDL_BACKTRACE: 3943 case SPECPDL_BACKTRACE:
3928 { 3944 {
3929 ptrdiff_t nargs = backtrace_nargs (pdl); 3945 ptrdiff_t nargs = backtrace_nargs (pdl);
diff --git a/src/lisp.h b/src/lisp.h
index b7e5d9e3761..af3f587222d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3188,6 +3188,7 @@ enum specbind_tag {
3188 SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ 3188 SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
3189 SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ 3189 SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
3190 SPECPDL_UNWIND_INT, /* Likewise, on int. */ 3190 SPECPDL_UNWIND_INT, /* Likewise, on int. */
3191 SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */
3191 SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ 3192 SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
3192 SPECPDL_BACKTRACE, /* An element of the backtrace. */ 3193 SPECPDL_BACKTRACE, /* An element of the backtrace. */
3193 SPECPDL_LET, /* A plain and simple dynamic let-binding. */ 3194 SPECPDL_LET, /* A plain and simple dynamic let-binding. */
@@ -3216,6 +3217,10 @@ union specbinding
3216 } unwind_int; 3217 } unwind_int;
3217 struct { 3218 struct {
3218 ENUM_BF (specbind_tag) kind : CHAR_BIT; 3219 ENUM_BF (specbind_tag) kind : CHAR_BIT;
3220 Lisp_Object marker, window;
3221 } unwind_excursion;
3222 struct {
3223 ENUM_BF (specbind_tag) kind : CHAR_BIT;
3219 void (*func) (void); 3224 void (*func) (void);
3220 } unwind_void; 3225 } unwind_void;
3221 struct { 3226 struct {
@@ -4106,9 +4111,9 @@ extern void mark_threads (void);
4106 4111
4107/* Defined in editfns.c. */ 4112/* Defined in editfns.c. */
4108extern void insert1 (Lisp_Object); 4113extern void insert1 (Lisp_Object);
4109extern Lisp_Object save_excursion_save (void); 4114extern void save_excursion_save (union specbinding *);
4115extern void save_excursion_restore (Lisp_Object, Lisp_Object);
4110extern Lisp_Object save_restriction_save (void); 4116extern Lisp_Object save_restriction_save (void);
4111extern void save_excursion_restore (Lisp_Object);
4112extern void save_restriction_restore (Lisp_Object); 4117extern void save_restriction_restore (Lisp_Object);
4113extern _Noreturn void time_overflow (void); 4118extern _Noreturn void time_overflow (void);
4114extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); 4119extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);