[RFC, experimental] save_{excursion,restriction}

[RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 328 bytes --]

It's worth trying to redesign save-restriction and save-excursion to avoid
allocating Lisp data. I tried some hacks for save-excursion, and it's quite
surprising: initially, running (while t (scroll-up) (sit-for 0.05)) over
just loaded xdisp.c with font-lock enabled asks for 600 GCs, and with this
patch it's just 350.

Dmitry

[-- Attachment #2: excursion.patch --]
[-- Type: text/plain, Size: 8601 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-07-23 11:15:43 +0000
+++ src/alloc.c	2012-07-23 16:35:09 +0000
@@ -3658,11 +3658,8 @@
 
   val = allocate_misc (Lisp_Misc_Marker);
   p = XMARKER (val);
-  p->buffer = 0;
-  p->bytepos = 0;
-  p->charpos = 0;
+  INIT_MARKER (p, NULL, 0, 0, 0);
   p->next = NULL;
-  p->insertion_type = 0;
   return val;
 }
 
@@ -3683,10 +3680,7 @@
 
   obj = allocate_misc (Lisp_Misc_Marker);
   m = XMARKER (obj);
-  m->buffer = buf;
-  m->charpos = charpos;
-  m->bytepos = bytepos;
-  m->insertion_type = 0;
+  INIT_MARKER (m, buf, charpos, bytepos, 0);
   m->next = BUF_MARKERS (buf);
   BUF_MARKERS (buf) = m;
   return obj;

=== modified file 'src/buffer.c'
--- src/buffer.c	2012-07-23 11:15:43 +0000
+++ src/buffer.c	2012-07-23 16:59:49 +0000
@@ -366,6 +366,7 @@
   *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'.  */
   b->text->inhibit_shrinking = 0;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;
@@ -586,6 +587,7 @@
   b->begv_byte = b->base_buffer->begv_byte;
   b->zv_byte = b->base_buffer->zv_byte;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;
@@ -4875,8 +4877,113 @@
   UNBLOCK_INPUT;
 }
 
-
-\f
+#if 1 /* NEW */
+
+/* Save current buffer state before entering Fsave_excursion.  */
+
+Lisp_Object
+save_excursion_save (void)
+{
+  Lisp_Object buf;
+  struct excursion *ex;
+  struct window *w = XWINDOW (selected_window);
+  struct Lisp_Marker *m = XMARKER (BVAR (current_buffer, mark));
+
+  ex = xmalloc (sizeof *ex);
+  ex->window = w;
+  ex->visible = (XBUFFER (w->buffer) == current_buffer);
+  ex->active = !NILP (BVAR (current_buffer, mark_active));
+
+  /* We do not initialize type and gcmarkbit since this marker
+     is never referenced via Lisp_Object and invisible for GC.  */
+  INIT_MARKER (&ex->point, current_buffer, PT, PT_BYTE, 0);
+  ex->point.type = Lisp_Misc_Marker;
+  ex->point.next = BUF_MARKERS (current_buffer);
+  BUF_MARKERS (current_buffer) = &ex->point;
+
+  /* Likewise.  */
+  INIT_MARKER (&ex->mark, current_buffer, m->charpos, 
+	       m->bytepos, m->insertion_type);
+  ex->mark.type = Lisp_Misc_Marker;
+  ex->mark.next = BUF_MARKERS (current_buffer);
+  BUF_MARKERS (current_buffer) = &ex->mark;
+
+  ex->next = current_buffer->excursions;
+  current_buffer->excursions = ex;
+  XSETBUFFER (buf, current_buffer);
+  return buf;
+}
+
+/* Restore BUFFER's values before leaving Fsave_excursion.  */
+
+Lisp_Object
+save_excursion_restore (Lisp_Object buffer)
+{
+  int active;
+  struct buffer *buf;
+  struct excursion *ex;
+  struct Lisp_Marker *m;
+  ptrdiff_t oldmark, newmark;
+
+  CHECK_BUFFER (buffer);
+  buf = XBUFFER (buffer);
+  eassert (!NILP (BVAR (buf, name)));
+  ex = buf->excursions;
+  eassert (ex != NULL);
+
+  /* Restore current buffer.  */
+  set_buffer_internal (buf);
+
+  /* Restore buffer position.  */
+  if (ex->point.charpos < BEGV)
+    SET_PT_BOTH (BEGV, BEGV_BYTE);
+  else if (ex->point.charpos > ZV)
+    SET_PT_BOTH (ZV, ZV_BYTE);
+  else
+    SET_PT_BOTH (ex->point.charpos, ex->point.bytepos);
+  unchain_marker (&ex->point);
+
+  /* Restore mark.  */
+  m = XMARKER (BVAR (buf, mark));
+  oldmark = m->charpos;
+  if (BEGV <= ex->mark.charpos)
+    attach_marker (m, buf, ex->mark.charpos, ex->mark.bytepos);
+  newmark = ex->mark.charpos;
+  unchain_marker (&ex->mark);
+
+  /* If mark and region was active, restore them.  */
+  active = !NILP (BVAR (buf, mark_active));
+  BVAR (buf, mark_active) = ex->active ? Qt : Qnil;
+
+  /* If mark is active now, and either was not active
+     or was at a different place, run the activate hook.  */
+  if (ex->active && oldmark != newmark)
+    {
+      Lisp_Object tem = intern ("activate-mark-hook");
+      Frun_hooks (1, &tem);
+    }
+  /* If mark has ceased to be active, run deactivate hook.  */
+  else if (active)
+    {
+      Lisp_Object tem = intern ("deactivate-mark-hook");
+      Frun_hooks (1, &tem);
+    }
+
+  /* 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.  */
+  if (ex->visible
+      && ex->window != XWINDOW (selected_window)
+      && EQ (ex->window->buffer, buffer))
+    set_marker_restricted (ex->window->pointm, make_number (PT), buffer);
+
+  buf->excursions = ex->next;
+  xfree (ex);
+  return Qnil;
+}
+
+#endif /* NEW */
+
 /***********************************************************************
 			    Initialization
  ***********************************************************************/

=== modified file 'src/buffer.h'
--- src/buffer.h	2012-07-22 03:44:35 +0000
+++ src/buffer.h	2012-07-23 16:45:26 +0000
@@ -472,6 +472,18 @@
     int inhibit_shrinking;
   };
 
+/* Used to record buffer state for save_excursion.  */
+
+struct excursion
+{
+  struct window *window;
+  unsigned visible : 1;
+  unsigned active : 1;
+  struct Lisp_Marker point;
+  struct Lisp_Marker mark;
+  struct excursion *next;
+};
+
 /* Lisp fields in struct buffer are hidden from most code and accessed
    via the BVAR macro, below.  Only select pieces of code, like the GC,
    are allowed to use BUFFER_INTERNAL_FIELD.  */
@@ -856,6 +868,9 @@
   /* Position where the overlay lists are centered.  */
   ptrdiff_t overlay_center;
 
+  /* List of recorded excursions.  */
+  struct excursion *excursions;
+
   /* Changes in the buffer are recorded here for undo, and t means
      don't record anything.  This information belongs to the base
      buffer of an indirect buffer.  But we can't store it in the
@@ -925,6 +940,8 @@
 extern void set_buffer_temp (struct buffer *);
 extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object);
 extern void record_buffer (Lisp_Object);
+extern Lisp_Object save_excursion_save (void);
+extern Lisp_Object save_excursion_restore (Lisp_Object);
 extern _Noreturn void buffer_slot_type_mismatch (Lisp_Object, int);
 extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t);
 extern void mmap_set_vars (int);

=== modified file 'src/editfns.c'
--- src/editfns.c	2012-07-17 07:43:01 +0000
+++ src/editfns.c	2012-07-23 16:59:27 +0000
@@ -821,7 +821,8 @@
 			      Qnil, Qt, Qnil);
 }
 
-\f
+#if 0 /* OLD */
+
 Lisp_Object
 save_excursion_save (void)
 {
@@ -922,6 +923,8 @@
   return Qnil;
 }
 
+#endif /* OLD */
+
 DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
        doc: /* Save point, mark, and current buffer; execute BODY; restore those things.
 Executes BODY just like `progn'.

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-07-23 11:15:43 +0000
+++ src/lisp.h	2012-07-23 16:44:46 +0000
@@ -1283,6 +1283,12 @@
   ptrdiff_t bytepos;
 };
 
+/* Used to setup base fields of Lisp_Marker.  */
+
+#define INIT_MARKER(mark, buf, cpos, bpos, itype)			\
+  ((mark)->buffer = (buf), (mark)->charpos = (cpos),			\
+   (mark)->bytepos = (bpos), (mark)->insertion_type = (itype), 1)
+
 /* START and END are markers in the overlay's buffer, and
    PLIST is the overlay's property list.  */
 struct Lisp_Overlay
@@ -2825,9 +2831,7 @@
 extern Lisp_Object Qfield;
 extern void insert1 (Lisp_Object);
 extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
-extern Lisp_Object save_excursion_save (void);
 extern Lisp_Object save_restriction_save (void);
-extern Lisp_Object save_excursion_restore (Lisp_Object);
 extern Lisp_Object save_restriction_restore (Lisp_Object);
 extern _Noreturn void time_overflow (void);
 extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, int);
@@ -2869,8 +2873,10 @@
 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
-                                               ptrdiff_t, ptrdiff_t);
+					       ptrdiff_t, ptrdiff_t);
 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void attach_marker (struct Lisp_Marker *, struct buffer *,
+			   ptrdiff_t, ptrdiff_t);
 extern void syms_of_marker (void);
 
 /* Defined in fileio.c */

=== modified file 'src/marker.c'
--- src/marker.c	2012-07-22 05:37:24 +0000
+++ src/marker.c	2012-07-23 16:31:21 +0000
@@ -427,7 +427,7 @@
 
 /* Change M so it points to B at CHARPOS and BYTEPOS.  */
 
-static inline void
+void
 attach_marker (struct Lisp_Marker *m, struct buffer *b,
 	       ptrdiff_t charpos, ptrdiff_t bytepos)
 {

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

> It's worth trying to redesign save-restriction and save-excursion to avoid
> allocating Lisp data. I tried some hacks for save-excursion, and it's quite
> surprising: initially, running (while t (scroll-up) (sit-for 0.05)) over
> just loaded xdisp.c with font-lock enabled asks for 600 GCs, and with this
> patch it's just 350.

save-restriction should be fairly rare (and if it's not, that's
something we should fix), but for save-excursion I'm not that surprised.
BTW, could you resend your patch but changing it so the new
save_excursion_save/save_excursion_restore replace the old one directly
in the text, so the patch hunks show what is changed and what
stays unchanged?
Also, you need to mark the `excursions' field during GC.


        Stefan


PS: Another source of slowdown for save-excursion is the unchain_marker call.

Re: [RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 481 bytes --]

On 07/24/2012 03:45 AM, Stefan Monnier wrote:

> BTW, could you resend your patch but changing it so the new
> save_excursion_save/save_excursion_restore replace the old one directly
> in the text, so the patch hunks show what is changed and what
> stays unchanged?
> Also, you need to mark the `excursions' field during GC.

OK.

> PS: Another source of slowdown for save-excursion is the unchain_marker call.

Yes, I believe that markers needs substantial redesign too.

Dmitry


[-- Attachment #2: excursion_2.patch --]
[-- Type: text/plain, Size: 11656 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-07-23 11:15:43 +0000
+++ src/alloc.c	2012-07-24 04:57:58 +0000
@@ -3658,11 +3658,8 @@
 
   val = allocate_misc (Lisp_Misc_Marker);
   p = XMARKER (val);
-  p->buffer = 0;
-  p->bytepos = 0;
-  p->charpos = 0;
+  INIT_MARKER (p, NULL, 0, 0, 0);
   p->next = NULL;
-  p->insertion_type = 0;
   return val;
 }
 
@@ -3683,10 +3680,7 @@
 
   obj = allocate_misc (Lisp_Misc_Marker);
   m = XMARKER (obj);
-  m->buffer = buf;
-  m->charpos = charpos;
-  m->bytepos = bytepos;
-  m->insertion_type = 0;
+  INIT_MARKER (m, buf, charpos, bytepos, 0);
   m->next = BUF_MARKERS (buf);
   BUF_MARKERS (buf) = m;
   return obj;
@@ -5851,6 +5845,8 @@
 static void
 mark_buffer (struct buffer *buffer)
 {
+  struct excursion *ex;
+
   /* This is handled much like other pseudovectors...  */
   mark_vectorlike ((struct Lisp_Vector *) buffer);
 
@@ -5865,6 +5861,11 @@
   mark_overlay (buffer->overlays_before);
   mark_overlay (buffer->overlays_after);
 
+  /* In a struct excursion, markers are allocated in place and
+     invisible for GC, so only the window should be marked.  */
+  for (ex = buffer->excursions; ex; ex = ex->next)
+    mark_vectorlike ((struct Lisp_Vector *) ex->window);
+
   /* If this is an indirect buffer, mark its base buffer.  */
   if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
     mark_buffer (buffer->base_buffer);

=== modified file 'src/buffer.c'
--- src/buffer.c	2012-07-23 11:15:43 +0000
+++ src/buffer.c	2012-07-24 04:35:50 +0000
@@ -366,6 +366,7 @@
   *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'.  */
   b->text->inhibit_shrinking = 0;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;
@@ -586,6 +587,7 @@
   b->begv_byte = b->base_buffer->begv_byte;
   b->zv_byte = b->base_buffer->zv_byte;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;

=== modified file 'src/buffer.h'
--- src/buffer.h	2012-07-22 03:44:35 +0000
+++ src/buffer.h	2012-07-24 05:11:38 +0000
@@ -472,6 +472,30 @@
     int inhibit_shrinking;
   };
 
+/* Used to record buffer state for save-excursion.  */
+
+struct excursion
+{
+  /* Saved value of XWINDOW (selected_window).  */
+  struct window *window;
+
+  /* Non-zero if the window above has displayed this buffer.  */
+  unsigned visible : 1;
+
+  /* Non-zero if this buffer has mark active.  */
+  unsigned active : 1;
+
+  /* Saved point.  */
+  struct Lisp_Marker point;
+
+  /* Saved mark.  May point to [0, 0].  */
+  struct Lisp_Marker mark;
+
+  /* When the calls to save-excursion are nested, this points
+     to an outer save-excursion state, or NULL otherwise.  */
+  struct excursion *next;
+};
+
 /* Lisp fields in struct buffer are hidden from most code and accessed
    via the BVAR macro, below.  Only select pieces of code, like the GC,
    are allowed to use BUFFER_INTERNAL_FIELD.  */
@@ -856,6 +880,9 @@
   /* Position where the overlay lists are centered.  */
   ptrdiff_t overlay_center;
 
+  /* List of recorded excursions.  */
+  struct excursion *excursions;
+
   /* Changes in the buffer are recorded here for undo, and t means
      don't record anything.  This information belongs to the base
      buffer of an indirect buffer.  But we can't store it in the

=== modified file 'src/editfns.c'
--- src/editfns.c	2012-07-17 07:43:01 +0000
+++ src/editfns.c	2012-07-24 05:02:05 +0000
@@ -223,6 +223,19 @@
   return build_marker (current_buffer, PT, PT_BYTE);
 }
 
+/* Fast path to set point at MARK.  */
+
+static inline void
+set_position (struct Lisp_Marker *mark)
+{
+  if (mark->charpos < BEGV)
+    SET_PT_BOTH (BEGV, BEGV_BYTE);
+  else if (mark->charpos > ZV)
+    SET_PT_BOTH (ZV, ZV_BYTE);
+  else
+    SET_PT_BOTH (mark->charpos, mark->bytepos);
+}
+
 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
        doc: /* Set point to POSITION, a number or marker.
 Beginning of buffer is position (point-min), end is (point-max).
@@ -235,14 +248,7 @@
   if (MARKERP (position)
       && current_buffer == XMARKER (position)->buffer)
     {
-      pos = marker_position (position);
-      if (pos < BEGV)
-	SET_PT_BOTH (BEGV, BEGV_BYTE);
-      else if (pos > ZV)
-	SET_PT_BOTH (ZV, ZV_BYTE);
-      else
-	SET_PT_BOTH (pos, marker_byte_position (position));
-
+      set_position (XMARKER (position));
       return position;
     }
 
@@ -821,104 +827,101 @@
 			      Qnil, Qt, Qnil);
 }
 
-\f
+/* Save current buffer state before entering Fsave_excursion.  */
+
 Lisp_Object
 save_excursion_save (void)
 {
-  int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
-		 == current_buffer);
-
-  return Fcons (Fpoint_marker (),
-		Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
-		       Fcons (visible ? Qt : Qnil,
-			      Fcons (BVAR (current_buffer, mark_active),
-				     selected_window))));
+  Lisp_Object buf;
+  struct excursion *ex;
+  struct window *w = XWINDOW (selected_window);
+  struct Lisp_Marker *m = XMARKER (BVAR (current_buffer, mark));
+
+  ex = xmalloc (sizeof *ex);
+  ex->window = w;
+  ex->visible = (XBUFFER (w->buffer) == current_buffer);
+  ex->active = !NILP (BVAR (current_buffer, mark_active));
+
+  /* We do not initialize type and gcmarkbit since this marker
+     is never referenced via Lisp_Object and invisible for GC.  */
+  INIT_MARKER (&ex->point, current_buffer, PT, PT_BYTE, 0);
+  ex->point.type = Lisp_Misc_Marker;
+  ex->point.next = BUF_MARKERS (current_buffer);
+  BUF_MARKERS (current_buffer) = &ex->point;
+
+  /* Likewise.  Note that charpos and bytepos may be zero.  */
+  INIT_MARKER (&ex->mark, current_buffer, m->charpos, 
+	       m->bytepos, m->insertion_type);
+  ex->mark.type = Lisp_Misc_Marker;
+  ex->mark.next = BUF_MARKERS (current_buffer);
+  BUF_MARKERS (current_buffer) = &ex->mark;
+
+  ex->next = current_buffer->excursions;
+  current_buffer->excursions = ex;
+  XSETBUFFER (buf, current_buffer);
+  return buf;
 }
 
+/* Restore BUFFER's values before leaving Fsave_excursion.  */
+
 Lisp_Object
-save_excursion_restore (Lisp_Object info)
+save_excursion_restore (Lisp_Object buffer)
 {
-  Lisp_Object tem, tem1, omark, nmark;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-  int 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.  */
-  if (NILP (tem))
-    return Qnil;
-
-  omark = nmark = Qnil;
-  GCPRO3 (info, omark, nmark);
-
-  Fset_buffer (tem);
-
-  /* Point marker.  */
-  tem = XCAR (info);
-  Fgoto_char (tem);
-  unchain_marker (XMARKER (tem));
-
-  /* Mark marker.  */
-  info = XCDR (info);
-  tem = XCAR (info);
-  omark = Fmarker_position (BVAR (current_buffer, mark));
-  Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
-  nmark = Fmarker_position (tem);
-  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);
-  tem1 = BVAR (current_buffer, mark_active);
-  BVAR (current_buffer, mark_active) = tem;
+  int active;
+  struct buffer *buf;
+  struct excursion *ex;
+  struct Lisp_Marker *m;
+  ptrdiff_t oldmark, newmark;
+
+  CHECK_BUFFER (buffer);
+  buf = XBUFFER (buffer);
+  eassert (!NILP (BVAR (buf, name)));
+  ex = buf->excursions;
+  eassert (ex != NULL);
+
+  /* Restore current buffer.  */
+  set_buffer_internal (buf);
+
+  /* Restore buffer position.  */
+  set_position (&ex->point);
+  unchain_marker (&ex->point);
+
+  /* Restore mark if it was non-zero.  */
+  m = XMARKER (BVAR (buf, mark));
+  oldmark = m->charpos;
+  if (BEGV <= ex->mark.charpos)
+    attach_marker (m, buf, ex->mark.charpos, ex->mark.bytepos);
+  newmark = ex->mark.charpos;
+  unchain_marker (&ex->mark);
+
+  /* If mark and region was active, restore them.  */
+  active = !NILP (BVAR (buf, mark_active));
+  BVAR (buf, mark_active) = ex->active ? Qt : Qnil;
 
   /* If mark is active now, and either was not active
      or was at a different place, run the activate hook.  */
-  if (! NILP (tem))
+  if (ex->active && oldmark != newmark)
     {
-      if (! EQ (omark, nmark))
-        {
-          tem = intern ("activate-mark-hook");
-          Frun_hooks (1, &tem);
-        }
+      Lisp_Object tem = intern ("activate-mark-hook");
+      Frun_hooks (1, &tem);
     }
   /* If mark has ceased to be active, run deactivate hook.  */
-  else if (! NILP (tem1))
+  else if (active)
     {
-      tem = intern ("deactivate-mark-hook");
+      Lisp_Object tem = intern ("deactivate-mark-hook");
       Frun_hooks (1, &tem);
     }
 
-  /* 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
-      && !EQ (tem, selected_window)
-      && (tem1 = XWINDOW (tem)->buffer,
-	  (/* Window is live...  */
-	   BUFFERP (tem1)
-	   /* ...and it shows the current buffer.  */
-	   && XBUFFER (tem1) == current_buffer)))
-    Fset_window_point (tem, make_number (PT));
+  /* 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.  */
+  if (ex->visible
+      && ex->window != XWINDOW (selected_window)
+      && EQ (ex->window->buffer, buffer))
+    set_marker_restricted (ex->window->pointm, make_number (PT), buffer);
 
-  UNGCPRO;
+  buf->excursions = ex->next;
+  xfree (ex);
   return Qnil;
 }
 

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-07-23 11:15:43 +0000
+++ src/lisp.h	2012-07-24 05:02:53 +0000
@@ -1283,6 +1283,12 @@
   ptrdiff_t bytepos;
 };
 
+/* Used to setup base fields of Lisp_Marker.  */
+
+#define INIT_MARKER(mark, buf, cpos, bpos, itype)			\
+  ((mark)->buffer = (buf), (mark)->charpos = (cpos),			\
+   (mark)->bytepos = (bpos), (mark)->insertion_type = (itype), 1)
+
 /* START and END are markers in the overlay's buffer, and
    PLIST is the overlay's property list.  */
 struct Lisp_Overlay
@@ -2869,8 +2875,10 @@
 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
-                                               ptrdiff_t, ptrdiff_t);
+					       ptrdiff_t, ptrdiff_t);
 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void attach_marker (struct Lisp_Marker *, struct buffer *,
+			   ptrdiff_t, ptrdiff_t);
 extern void syms_of_marker (void);
 
 /* Defined in fileio.c */

=== modified file 'src/marker.c'
--- src/marker.c	2012-07-22 05:37:24 +0000
+++ src/marker.c	2012-07-24 04:33:25 +0000
@@ -427,7 +427,7 @@
 
 /* Change M so it points to B at CHARPOS and BYTEPOS.  */
 
-static inline void
+void
 attach_marker (struct Lisp_Marker *m, struct buffer *b,
 	       ptrdiff_t charpos, ptrdiff_t bytepos)
 {

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

>> PS: Another source of slowdown for save-excursion is the
>> unchain_marker call.
> Yes, I believe that markers needs substantial redesign too.

I'm not sure that's actually needed.  I think only overlays need such
a redesign after which markers won't be used by overlays any more and
they won't be numerous enough to warrant a redesign.

Basically, I think that overlays should live inside the balanced trees
we use for text-properties, using the "Augmented tree" approach of
http://en.wikipedia.org/wiki/Interval_tree.

>  Lisp_Object
>  save_excursion_save (void)
>  {
> -  int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
> -		 == current_buffer);
> -
> -  return Fcons (Fpoint_marker (),
> -		Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
> -		       Fcons (visible ? Qt : Qnil,
> -			      Fcons (BVAR (current_buffer, mark_active),
> -				     selected_window))));
> +  Lisp_Object buf;
> +  struct excursion *ex;
> +  struct window *w = XWINDOW (selected_window);
> +  struct Lisp_Marker *m = XMARKER (BVAR (current_buffer, mark));
> +
> +  ex = xmalloc (sizeof *ex);
> +  ex->window = w;
> +  ex->visible = (XBUFFER (w->buffer) == current_buffer);
> +  ex->active = !NILP (BVAR (current_buffer, mark_active));
> +
> +  /* We do not initialize type and gcmarkbit since this marker
> +     is never referenced via Lisp_Object and invisible for GC.  */
> +  INIT_MARKER (&ex->point, current_buffer, PT, PT_BYTE, 0);
> +  ex->point.type = Lisp_Misc_Marker;
> +  ex->point.next = BUF_MARKERS (current_buffer);
> +  BUF_MARKERS (current_buffer) = &ex->point;

The comment says "We do not initialize type" and then you do
"ex->point.type = Lisp_Misc_Marker;".  That sounds contradictory.

> +  /* Likewise.  Note that charpos and bytepos may be zero.  */
> +  INIT_MARKER (&ex->mark, current_buffer, m->charpos,
> +	       m->bytepos, m->insertion_type);

Better not use current_buffer here, but m->buffer.

> +  ex->mark.type = Lisp_Misc_Marker;
> +  ex->mark.next = BUF_MARKERS (current_buffer);
> +  BUF_MARKERS (current_buffer) = &ex->mark;

Can't you use attach_marker or some such, rather than hand-coding the
insertion of those markers into BUF_MARKERS?

> +  ex->next = current_buffer->excursions;
> +  current_buffer->excursions = ex;
> +  XSETBUFFER (buf, current_buffer);
> +  return buf;
>  }

BTW, why use an extra `excursions' field rather than just use a new
Lisp_Object type for "struct excursion"?
I think that would be cleaner to either make them into
Lisp_Pseudovector or Lisp_Misc.

> -  /* 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.  */

Where did this test go?

> +/* Used to setup base fields of Lisp_Marker.  */
> +
> +#define INIT_MARKER(mark, buf, cpos, bpos, itype)			\
> +  ((mark)->buffer = (buf), (mark)->charpos = (cpos),			\
> +   (mark)->bytepos = (bpos), (mark)->insertion_type = (itype), 1)

Why "1"?


        Stefan

Re: [RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 837 bytes --]

On 07/24/2012 01:37 PM, Stefan Monnier wrote:

> BTW, why use an extra `excursions' field rather than just use a new
> Lisp_Object type for "struct excursion"?
> I think that would be cleaner to either make them into
> Lisp_Pseudovector or Lisp_Misc.

1) "excursion state" is not visible to Lisp programs and so not referenced
via Lisp_Objects, it's just a service thing related to save-excursion
primitive and buffer internals. Just like buffer text for the basic editing
primitives.

2) Lisp_XXX things are designed to be managed by GC, and other use of them
is suspicious and discouraged (embedding Lisp_Markers into struct excursion
is the poor solution in the absence of better alternatives). But, the
main purpose of this design is to avoid any dependency from GC to achieve
the lowest possible overhead of save-excursion.

Dmitry

[-- Attachment #2: excursion_3.patch --]
[-- Type: text/plain, Size: 12882 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-07-23 11:15:43 +0000
+++ src/alloc.c	2012-07-24 10:49:56 +0000
@@ -3654,15 +3654,11 @@
   (void)
 {
   register Lisp_Object val;
-  register struct Lisp_Marker *p;
+  register struct Lisp_Marker *m;
 
   val = allocate_misc (Lisp_Misc_Marker);
-  p = XMARKER (val);
-  p->buffer = 0;
-  p->bytepos = 0;
-  p->charpos = 0;
-  p->next = NULL;
-  p->insertion_type = 0;
+  m = XMARKER (val);
+  INIT_MARKER (m, (struct buffer *) NULL, 0, 0, 0);
   return val;
 }
 
@@ -3675,20 +3671,22 @@
   Lisp_Object obj;
   struct Lisp_Marker *m;
 
+  /* Use Fmake_marker to create marker points to nowhere.  */
+  eassert (buf != NULL);
+
   /* No dead buffers here.  */
   eassert (!NILP (BVAR (buf, name)));
 
-  /* Every character is at least one byte.  */
-  eassert (charpos <= bytepos);
+  /* In a single-byte buffer, two positions must be equal.
+     Otherwise, every character is at least one byte.  */
+  if (BUF_Z (buf) == BUF_Z_BYTE (buf))
+    eassert (charpos == bytepos);
+  else
+    eassert (charpos <= bytepos);
 
   obj = allocate_misc (Lisp_Misc_Marker);
   m = XMARKER (obj);
-  m->buffer = buf;
-  m->charpos = charpos;
-  m->bytepos = bytepos;
-  m->insertion_type = 0;
-  m->next = BUF_MARKERS (buf);
-  BUF_MARKERS (buf) = m;
+  INIT_MARKER (m, buf, charpos, bytepos, 0);
   return obj;
 }
 
@@ -5851,6 +5849,8 @@
 static void
 mark_buffer (struct buffer *buffer)
 {
+  struct excursion *ex;
+
   /* This is handled much like other pseudovectors...  */
   mark_vectorlike ((struct Lisp_Vector *) buffer);
 
@@ -5865,6 +5865,15 @@
   mark_overlay (buffer->overlays_before);
   mark_overlay (buffer->overlays_after);
 
+  /* In a struct excursion, markers are allocated in place and
+     invisible for GC, so only the window should be marked.  */
+  for (ex = buffer->excursions; ex; ex = ex->next)
+    {
+      struct Lisp_Vector *w = (struct Lisp_Vector *) ex->window;
+      if (!VECTOR_MARKED_P (w))
+	mark_vectorlike (w);
+    }
+
   /* If this is an indirect buffer, mark its base buffer.  */
   if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
     mark_buffer (buffer->base_buffer);

=== modified file 'src/buffer.c'
--- src/buffer.c	2012-07-24 06:45:44 +0000
+++ src/buffer.c	2012-07-24 10:01:09 +0000
@@ -366,6 +366,7 @@
   *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'.  */
   b->text->inhibit_shrinking = 0;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;
@@ -578,6 +579,7 @@
   b->begv_byte = b->base_buffer->begv_byte;
   b->zv_byte = b->base_buffer->zv_byte;
 
+  b->excursions = NULL;
   b->newline_cache = 0;
   b->width_run_cache = 0;
   BVAR (b, width_table) = Qnil;

=== modified file 'src/buffer.h'
--- src/buffer.h	2012-07-22 03:44:35 +0000
+++ src/buffer.h	2012-07-24 10:01:50 +0000
@@ -472,6 +472,30 @@
     int inhibit_shrinking;
   };
 
+/* Used to record buffer state for save-excursion.  */
+
+struct excursion
+{
+  /* Saved value of XWINDOW (selected_window).  */
+  struct window *window;
+
+  /* Non-zero if the window above has displayed this buffer.  */
+  unsigned visible : 1;
+
+  /* Non-zero if this buffer has mark active.  */
+  unsigned active : 1;
+
+  /* Saved point.  */
+  struct Lisp_Marker point;
+
+  /* Saved mark.  May point to nowhere.  */
+  struct Lisp_Marker mark;
+
+  /* When the calls to save-excursion are nested, this points
+     to an outer save-excursion state, or NULL otherwise.  */
+  struct excursion *next;
+};
+
 /* Lisp fields in struct buffer are hidden from most code and accessed
    via the BVAR macro, below.  Only select pieces of code, like the GC,
    are allowed to use BUFFER_INTERNAL_FIELD.  */
@@ -856,6 +880,9 @@
   /* Position where the overlay lists are centered.  */
   ptrdiff_t overlay_center;
 
+  /* List of recorded excursions.  */
+  struct excursion *excursions;
+
   /* Changes in the buffer are recorded here for undo, and t means
      don't record anything.  This information belongs to the base
      buffer of an indirect buffer.  But we can't store it in the

=== modified file 'src/editfns.c'
--- src/editfns.c	2012-07-17 07:43:01 +0000
+++ src/editfns.c	2012-07-24 10:59:48 +0000
@@ -223,6 +223,19 @@
   return build_marker (current_buffer, PT, PT_BYTE);
 }
 
+/* Fast path to set point at MARK.  */
+
+static inline void
+set_position (struct Lisp_Marker *mark)
+{
+  if (mark->charpos < BEGV)
+    SET_PT_BOTH (BEGV, BEGV_BYTE);
+  else if (mark->charpos > ZV)
+    SET_PT_BOTH (ZV, ZV_BYTE);
+  else
+    SET_PT_BOTH (mark->charpos, mark->bytepos);
+}
+
 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
        doc: /* Set point to POSITION, a number or marker.
 Beginning of buffer is position (point-min), end is (point-max).
@@ -235,14 +248,7 @@
   if (MARKERP (position)
       && current_buffer == XMARKER (position)->buffer)
     {
-      pos = marker_position (position);
-      if (pos < BEGV)
-	SET_PT_BOTH (BEGV, BEGV_BYTE);
-      else if (pos > ZV)
-	SET_PT_BOTH (ZV, ZV_BYTE);
-      else
-	SET_PT_BOTH (pos, marker_byte_position (position));
-
+      set_position (XMARKER (position));
       return position;
     }
 
@@ -821,104 +827,100 @@
 			      Qnil, Qt, Qnil);
 }
 
-\f
+/* Save current buffer state before entering Fsave_excursion.  */
+
 Lisp_Object
 save_excursion_save (void)
 {
-  int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
-		 == current_buffer);
-
-  return Fcons (Fpoint_marker (),
-		Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
-		       Fcons (visible ? Qt : Qnil,
-			      Fcons (BVAR (current_buffer, mark_active),
-				     selected_window))));
+  Lisp_Object buf;
+  struct excursion *ex;
+  struct window *w = XWINDOW (selected_window);
+  struct Lisp_Marker *m = XMARKER (BVAR (current_buffer, mark));
+
+  ex = xmalloc (sizeof *ex);
+  ex->window = w;
+  ex->visible = (XBUFFER (w->buffer) == current_buffer);
+  ex->active = !NILP (BVAR (current_buffer, mark_active));
+
+  /* We do not initialize type and gcmarkbit since this marker
+     is never referenced via Lisp_Object and invisible for GC.  */
+  INIT_MARKER (&ex->point, current_buffer, PT, PT_BYTE, 0);
+
+  /* Likewise.  Note that charpos and bytepos may be zero.  */
+  INIT_MARKER (&ex->mark, m->buffer, m->charpos, 
+	       m->bytepos, m->insertion_type);
+
+  ex->next = current_buffer->excursions;
+  current_buffer->excursions = ex;
+  XSETBUFFER (buf, current_buffer);
+  return buf;
 }
 
+/* Restore BUFFER's values before leaving Fsave_excursion.  */
+
 Lisp_Object
-save_excursion_restore (Lisp_Object info)
+save_excursion_restore (Lisp_Object buffer)
 {
-  Lisp_Object tem, tem1, omark, nmark;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-  int 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.  */
-  if (NILP (tem))
-    return Qnil;
-
-  omark = nmark = Qnil;
-  GCPRO3 (info, omark, nmark);
-
-  Fset_buffer (tem);
-
-  /* Point marker.  */
-  tem = XCAR (info);
-  Fgoto_char (tem);
-  unchain_marker (XMARKER (tem));
-
-  /* Mark marker.  */
-  info = XCDR (info);
-  tem = XCAR (info);
-  omark = Fmarker_position (BVAR (current_buffer, mark));
-  Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
-  nmark = Fmarker_position (tem);
-  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);
-  tem1 = BVAR (current_buffer, mark_active);
-  BVAR (current_buffer, mark_active) = tem;
-
-  /* If mark is active now, and either was not active
-     or was at a different place, run the activate hook.  */
-  if (! NILP (tem))
-    {
-      if (! EQ (omark, nmark))
-        {
-          tem = intern ("activate-mark-hook");
-          Frun_hooks (1, &tem);
-        }
-    }
-  /* If mark has ceased to be active, run deactivate hook.  */
-  else if (! NILP (tem1))
-    {
-      tem = intern ("deactivate-mark-hook");
-      Frun_hooks (1, &tem);
-    }
-
-  /* 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
-      && !EQ (tem, selected_window)
-      && (tem1 = XWINDOW (tem)->buffer,
-	  (/* Window is live...  */
-	   BUFFERP (tem1)
-	   /* ...and it shows the current buffer.  */
-	   && XBUFFER (tem1) == current_buffer)))
-    Fset_window_point (tem, make_number (PT));
-
-  UNGCPRO;
+  struct buffer *buf;
+  struct excursion *ex;
+
+  CHECK_BUFFER (buffer);
+  buf = XBUFFER (buffer);
+  ex = buf->excursions;
+  eassert (ex != NULL);
+
+  /* Restore buffer state only if the buffer is live.
+     Otherwise, just cancel an excursion state.  */
+  if (!NILP (BVAR (buf, name)))
+    {
+      int active;
+      struct Lisp_Marker *m;
+      ptrdiff_t oldmark, newmark;
+
+      /* Restore current buffer.  */
+      set_buffer_internal (buf);
+
+      /* Restore buffer position.  */
+      set_position (&ex->point);
+      unchain_marker (&ex->point);
+
+      /* Restore mark if it was non-zero.  */
+      m = XMARKER (BVAR (buf, mark));
+      oldmark = m->charpos;
+      if (BEGV <= ex->mark.charpos)
+	attach_marker (m, buf, ex->mark.charpos, ex->mark.bytepos);
+      newmark = ex->mark.charpos;
+      unchain_marker (&ex->mark);
+
+      /* If mark and region was active, restore them.  */
+      active = !NILP (BVAR (buf, mark_active));
+      BVAR (buf, mark_active) = ex->active ? Qt : Qnil;
+
+      /* If mark is active now, and either was not active
+	 or was at a different place, run the activate hook.  */
+      if (ex->active && oldmark != newmark)
+	{
+	  Lisp_Object tem = intern ("activate-mark-hook");
+	  Frun_hooks (1, &tem);
+	}
+      /* If mark has ceased to be active, run deactivate hook.  */
+      else if (active)
+	{
+	  Lisp_Object tem = intern ("deactivate-mark-hook");
+	  Frun_hooks (1, &tem);
+	}
+
+      /* 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.  */
+      if (ex->visible
+	  && ex->window != XWINDOW (selected_window)
+	  && EQ (ex->window->buffer, buffer))
+	set_marker_restricted (ex->window->pointm, make_number (PT), buffer);
+    }
+
+  buf->excursions = ex->next;
+  xfree (ex);
   return Qnil;
 }
 

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-07-24 06:45:44 +0000
+++ src/lisp.h	2012-07-24 10:57:56 +0000
@@ -1283,6 +1283,24 @@
   ptrdiff_t bytepos;
 };
 
+/* Used to setup base fields of just allocated Lisp_Marker.
+   For other markers, consider using attach_marker instead.  */
+
+#define INIT_MARKER(mark, buf, cpos, bpos, itype) \
+  do {						  \
+    (mark)->buffer = (buf);			  \
+    (mark)->charpos = (cpos);			  \
+    (mark)->bytepos = (bpos);			  \
+    (mark)->insertion_type = (itype);		  \
+    if (buf)					  \
+      {						  \
+	(mark)->next = BUF_MARKERS (buf);	  \
+	BUF_MARKERS (buf) = (mark);		  \
+      }						  \
+    else					  \
+      (mark)->next = NULL;			  \
+  } while (0)
+
 /* START and END are markers in the overlay's buffer, and
    PLIST is the overlay's property list.  */
 struct Lisp_Overlay
@@ -2880,8 +2898,10 @@
 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
-                                               ptrdiff_t, ptrdiff_t);
+					       ptrdiff_t, ptrdiff_t);
 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void attach_marker (struct Lisp_Marker *, struct buffer *,
+			   ptrdiff_t, ptrdiff_t);
 extern void syms_of_marker (void);
 
 /* Defined in fileio.c */

=== modified file 'src/marker.c'
--- src/marker.c	2012-07-22 05:37:24 +0000
+++ src/marker.c	2012-07-24 10:01:09 +0000
@@ -427,7 +427,7 @@
 
 /* Change M so it points to B at CHARPOS and BYTEPOS.  */
 
-static inline void
+void
 attach_marker (struct Lisp_Marker *m, struct buffer *b,
 	       ptrdiff_t charpos, ptrdiff_t bytepos)
 {

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

>> BTW, why use an extra `excursions' field rather than just use a new
>> Lisp_Object type for "struct excursion"?
>> I think that would be cleaner to either make them into
>> Lisp_Pseudovector or Lisp_Misc.
> 1) "excursion state" is not visible to Lisp programs and so not referenced
> via Lisp_Objects, it's just a service thing related to save-excursion
> primitive and buffer internals. Just like buffer text for the basic editing
> primitives.
> 2) Lisp_XXX things are designed to be managed by GC, and other use of them
> is suspicious and discouraged (embedding Lisp_Markers into struct excursion
> is the poor solution in the absence of better alternatives). But, the
> main purpose of this design is to avoid any dependency from GC to achieve
> the lowest possible overhead of save-excursion.

I think you'll be better off making it into a standard Lisp_Object such
as pseudovector or a Lisp_Misc.  The fact that they're only used on the
specpdl and hence managed via xmalloc+xfree shouldn't make them
that special.


        Stefan

Re: [RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 490 bytes --]

On 07/25/2012 02:05 AM, Stefan Monnier wrote:

> I think you'll be better off making it into a standard Lisp_Object such
> as pseudovector or a Lisp_Misc.  The fact that they're only used on the
> specpdl and hence managed via xmalloc+xfree shouldn't make them
> that special.

OK. The only question is: should `excursion' field of struct buffer
be special, like `undo_list', or handled as usual? This patch assumes
first scenario, but it's not a problem to follow the second one.

Dmitry


[-- Attachment #2: excursion_5.patch --]
[-- Type: text/plain, Size: 17412 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-07-23 11:15:43 +0000
+++ src/alloc.c	2012-07-25 09:05:16 +0000
@@ -3653,17 +3653,10 @@
        doc: /* Return a newly allocated marker which does not point at any place.  */)
   (void)
 {
-  register Lisp_Object val;
-  register struct Lisp_Marker *p;
+  register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker);
 
-  val = allocate_misc (Lisp_Misc_Marker);
-  p = XMARKER (val);
-  p->buffer = 0;
-  p->bytepos = 0;
-  p->charpos = 0;
-  p->next = NULL;
-  p->insertion_type = 0;
-  return val;
+  init_marker (XMARKER (marker), NULL, 0, 0, 0);
+  return marker;
 }
 
 /* Return a newly allocated marker which points into BUF
@@ -3672,24 +3665,23 @@
 Lisp_Object
 build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
 {
-  Lisp_Object obj;
-  struct Lisp_Marker *m;
+  register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker);
+
+  /* Use Fmake_marker to create marker points to nowhere.  */
+  eassert (buf != NULL);
 
   /* No dead buffers here.  */
   eassert (!NILP (BVAR (buf, name)));
 
-  /* Every character is at least one byte.  */
-  eassert (charpos <= bytepos);
+  /* In a single-byte buffer, two positions must be equal.
+     Otherwise, every character is at least one byte.  */
+  if (BUF_Z (buf) == BUF_Z_BYTE (buf))
+    eassert (charpos == bytepos);
+  else
+    eassert (charpos <= bytepos);
 
-  obj = allocate_misc (Lisp_Misc_Marker);
-  m = XMARKER (obj);
-  m->buffer = buf;
-  m->charpos = charpos;
-  m->bytepos = bytepos;
-  m->insertion_type = 0;
-  m->next = BUF_MARKERS (buf);
-  BUF_MARKERS (buf) = m;
-  return obj;
+  init_marker (XMARKER (marker), buf, charpos, bytepos, 0);
+  return marker;
 }
 
 /* Put MARKER back on the free list after using it temporarily.  */
@@ -5865,6 +5857,17 @@
   mark_overlay (buffer->overlays_before);
   mark_overlay (buffer->overlays_after);
 
+  /* If we have currently active excursions, mark
+     the window objects referenced from them.  */
+  if (!NILP (BVAR (buffer, excursions)))
+    {
+      struct Lisp_Excursion *e;
+
+      for (e = XEXCURSION (BVAR (buffer, excursions)); e; e = e->next)
+	if (!VECTOR_MARKED_P (e->window))
+	  mark_vectorlike ((struct Lisp_Vector *) e->window);
+    }
+
   /* If this is an indirect buffer, mark its base buffer.  */
   if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
     mark_buffer (buffer->base_buffer);
@@ -6058,6 +6061,8 @@
 	    break;
 
 	  case PVEC_FREE:
+	  case PVEC_EXCURSION:
+	    /* These are too special.  */
 	    abort ();
 
 	  default:

=== modified file 'src/buffer.c'
--- src/buffer.c	2012-07-25 05:09:02 +0000
+++ src/buffer.c	2012-07-25 07:53:00 +0000
@@ -368,6 +368,7 @@
 
   b->newline_cache = 0;
   b->width_run_cache = 0;
+  BVAR (b, excursions) = Qnil;
   BVAR (b, width_table) = Qnil;
   b->prevent_redisplay_optimizations_p = 1;
 
@@ -580,6 +581,7 @@
 
   b->newline_cache = 0;
   b->width_run_cache = 0;
+  BVAR (b, excursions) = Qnil;
   BVAR (b, width_table) = Qnil;
 
   /* Put this on the chain of all buffers including killed ones.  */
@@ -4895,6 +4897,8 @@
   reset_buffer (&buffer_local_symbols);
   reset_buffer_local_variables (&buffer_local_symbols, 1);
   /* Prevent GC from getting confused.  */
+  BVAR (&buffer_defaults, excursions) = Qnil;
+  BVAR (&buffer_local_symbols, excursions) = Qnil;
   buffer_defaults.text = &buffer_defaults.own_text;
   buffer_local_symbols.text = &buffer_local_symbols.own_text;
   /* No one will share the text with these buffers, but let's play it safe.  */

=== modified file 'src/buffer.h'
--- src/buffer.h	2012-07-22 03:44:35 +0000
+++ src/buffer.h	2012-07-25 07:57:08 +0000
@@ -741,8 +741,9 @@
      See `cursor-type' for other values.  */
   Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
 
-  /* No more Lisp_Object beyond this point.  Except undo_list,
-     which is handled specially in Fgarbage_collect .  */
+  /* No more Lisp_Object beyond this point.  Except undo_list and
+     excursions, which are handled specially in Fgarbage_collect
+     and mark_buffer, respectively.  */
 
   /* This structure holds the coordinates of the buffer contents
      in ordinary buffers.  In indirect buffers, this is not used.  */
@@ -856,6 +857,9 @@
   /* Position where the overlay lists are centered.  */
   ptrdiff_t overlay_center;
 
+  /* List of excursions which are in effect for this buffer.  */
+  Lisp_Object BUFFER_INTERNAL_FIELD (excursions);
+
   /* Changes in the buffer are recorded here for undo, and t means
      don't record anything.  This information belongs to the base
      buffer of an indirect buffer.  But we can't store it in the
@@ -1023,8 +1027,9 @@
   offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR))
 
 /* Used to iterate over normal Lisp_Object fields of struct buffer (all
-   Lisp_Objects except undo_list).  If you add, remove, or reorder
-   Lisp_Objects in a struct buffer, make sure that this is still correct.  */
+   Lisp_Objects except excursions and undo_list).  If you add, remove, or
+   reorder Lisp_Objects in a struct buffer, make sure that this is still
+   correct.  */
 
 #define FOR_EACH_PER_BUFFER_OBJECT_AT(offset)				 \
   for (offset = PER_BUFFER_VAR_OFFSET (name);				 \
@@ -1121,3 +1126,22 @@
 
 /* Upcase a character C, or make no change if that cannot be done.  */
 static inline int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); }
+
+/* Initialize just allocated Lisp_Marker.  */
+
+static inline void
+init_marker (struct Lisp_Marker *m, struct buffer *b,
+            ptrdiff_t charpos, ptrdiff_t bytepos, int type)
+{
+  m->buffer = b;
+  m->charpos = charpos;
+  m->bytepos = bytepos;
+  m->insertion_type = type;
+  if (b)
+    {
+      m->next = BUF_MARKERS (b);
+      BUF_MARKERS (b) = m;
+    }
+  else
+    m->next = NULL;
+}

=== modified file 'src/editfns.c'
--- src/editfns.c	2012-07-17 07:43:01 +0000
+++ src/editfns.c	2012-07-25 08:55:53 +0000
@@ -223,6 +223,19 @@
   return build_marker (current_buffer, PT, PT_BYTE);
 }
 
+/* Fast path to set point at MARK.  */
+
+static inline void
+set_position (struct Lisp_Marker *mark)
+{
+  if (mark->charpos < BEGV)
+    SET_PT_BOTH (BEGV, BEGV_BYTE);
+  else if (mark->charpos > ZV)
+    SET_PT_BOTH (ZV, ZV_BYTE);
+  else
+    SET_PT_BOTH (mark->charpos, mark->bytepos);
+}
+
 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
        doc: /* Set point to POSITION, a number or marker.
 Beginning of buffer is position (point-min), end is (point-max).
@@ -235,14 +248,7 @@
   if (MARKERP (position)
       && current_buffer == XMARKER (position)->buffer)
     {
-      pos = marker_position (position);
-      if (pos < BEGV)
-	SET_PT_BOTH (BEGV, BEGV_BYTE);
-      else if (pos > ZV)
-	SET_PT_BOTH (ZV, ZV_BYTE);
-      else
-	SET_PT_BOTH (pos, marker_byte_position (position));
-
+      set_position (XMARKER (position));
       return position;
     }
 
@@ -821,104 +827,113 @@
 			      Qnil, Qt, Qnil);
 }
 
-\f
+/* Record buffer state before entering save-excursion. */
+
 Lisp_Object
 save_excursion_save (void)
 {
-  int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
-		 == current_buffer);
-
-  return Fcons (Fpoint_marker (),
-		Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
-		       Fcons (visible ? Qt : Qnil,
-			      Fcons (BVAR (current_buffer, mark_active),
-				     selected_window))));
+  struct buffer *b = current_buffer;
+  struct window *w = XWINDOW (selected_window);
+  struct Lisp_Excursion *ex = xmalloc (sizeof *ex);
+  struct Lisp_Marker *m = XMARKER (BVAR (b, mark));
+
+  ex->size = 0;
+  ex->window = w;
+  ex->visible = (XBUFFER (w->buffer) == b);
+  ex->active = !NILP (BVAR (b, mark_active));
+
+  /* We do not initialize type and gcmarkbit since this marker
+     is never referenced via Lisp_Object and invisible for GC.  */
+  init_marker (&ex->point, b, PT, PT_BYTE, 0);
+
+  /* Likewise.  Note that charpos and bytepos may be zero.  */
+  init_marker (&ex->mark, m->buffer, m->charpos, 
+              m->bytepos, m->insertion_type);
+
+  /* Make it a pseudovector and link to the
+     chain of currently active excursions.  */
+  XSETTYPED_PVECTYPE (ex, size, PVEC_EXCURSION);
+  if (NILP (BVAR (b, excursions)))
+    {
+      XSETEXCURSION (BVAR (b, excursions), ex);
+      ex->next = NULL;
+    }
+  else
+    {
+      ex->next = XEXCURSION (BVAR (b, excursions));
+      XSETEXCURSION (BVAR (b, excursions), ex);
+    }
+  return Fcurrent_buffer ();
 }
 
+/* Restore buffer state before leaving save-excursion.  */
+
 Lisp_Object
-save_excursion_restore (Lisp_Object info)
+save_excursion_restore (Lisp_Object buffer)
 {
-  Lisp_Object tem, tem1, omark, nmark;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-  int 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.  */
-  if (NILP (tem))
-    return Qnil;
-
-  omark = nmark = Qnil;
-  GCPRO3 (info, omark, nmark);
-
-  Fset_buffer (tem);
-
-  /* Point marker.  */
-  tem = XCAR (info);
-  Fgoto_char (tem);
-  unchain_marker (XMARKER (tem));
-
-  /* Mark marker.  */
-  info = XCDR (info);
-  tem = XCAR (info);
-  omark = Fmarker_position (BVAR (current_buffer, mark));
-  Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
-  nmark = Fmarker_position (tem);
-  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);
-  tem1 = BVAR (current_buffer, mark_active);
-  BVAR (current_buffer, mark_active) = tem;
-
-  /* If mark is active now, and either was not active
-     or was at a different place, run the activate hook.  */
-  if (! NILP (tem))
-    {
-      if (! EQ (omark, nmark))
-        {
-          tem = intern ("activate-mark-hook");
-          Frun_hooks (1, &tem);
-        }
-    }
-  /* If mark has ceased to be active, run deactivate hook.  */
-  else if (! NILP (tem1))
-    {
-      tem = intern ("deactivate-mark-hook");
-      Frun_hooks (1, &tem);
-    }
-
-  /* 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
-      && !EQ (tem, selected_window)
-      && (tem1 = XWINDOW (tem)->buffer,
-	  (/* Window is live...  */
-	   BUFFERP (tem1)
-	   /* ...and it shows the current buffer.  */
-	   && XBUFFER (tem1) == current_buffer)))
-    Fset_window_point (tem, make_number (PT));
-
-  UNGCPRO;
+  struct buffer *b;
+  struct Lisp_Excursion *ex;
+
+  CHECK_BUFFER (buffer);
+  b = XBUFFER (buffer);
+  ex = XEXCURSION (BVAR (b, excursions));
+
+  /* Restore buffer state only if the buffer is live.
+     Otherwise, just cancel an excursion state.  */
+
+  if (!NILP (BVAR (b, name)))
+    {
+      int active;
+      struct Lisp_Marker *m;
+      ptrdiff_t oldmark, newmark;
+
+      /* Restore current buffer.  */
+      set_buffer_internal (b);
+
+      /* Restore buffer position.  */
+      set_position (&ex->point);
+      unchain_marker (&ex->point);
+
+      /* Restore mark if it was non-zero.  */
+      m = XMARKER (BVAR (b, mark));
+      oldmark = m->charpos;
+      if (BEGV <= ex->mark.charpos)
+	attach_marker (m, b, ex->mark.charpos, ex->mark.bytepos);
+      newmark = ex->mark.charpos;
+      unchain_marker (&ex->mark);
+
+      /* If mark and region was active, restore them.  */
+      active = !NILP (BVAR (b, mark_active));
+      BVAR (b, mark_active) = ex->active ? Qt : Qnil;
+
+      /* If mark is active now, and either was not active
+	 or was at a different place, run the activate hook.  */
+      if (ex->active && oldmark != newmark)
+	{
+	  Lisp_Object tem = intern ("activate-mark-hook");
+	  Frun_hooks (1, &tem);
+	}
+      /* If mark has ceased to be active, run deactivate hook.  */
+      else if (active)
+	{
+	  Lisp_Object tem = intern ("deactivate-mark-hook");
+	  Frun_hooks (1, &tem);
+	}
+
+      /* 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.  */
+      if (ex->visible
+	  && ex->window != XWINDOW (selected_window)
+	  && EQ (ex->window->buffer, buffer))
+	set_marker_restricted (ex->window->pointm, make_number (PT), buffer);
+    }
+
+  if (ex->next)
+    XSETEXCURSION (BVAR (b, excursions), ex->next);
+  else
+    BVAR (b, excursions) = Qnil;
+  xfree (ex);
   return Qnil;
 }
 

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-07-24 06:45:44 +0000
+++ src/lisp.h	2012-07-25 08:53:54 +0000
@@ -352,6 +352,7 @@
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
   PVEC_SUBR,
+  PVEC_EXCURSION,
   PVEC_OTHER,
   /* These last 4 are special because we OR them in fns.c:internal_equal,
      so they have to use a disjoint bit pattern:
@@ -507,6 +508,8 @@
 		      (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
 #define XSUBR(a) (eassert (SUBRP (a)), \
 		  (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XEXCURSION(a) (eassert (EXCURSIONP (a)), \
+		       (struct Lisp_Excursion *) XUNTAG (a, Lisp_Vectorlike))
 #define XBUFFER(a) (eassert (BUFFERP (a)), \
 		    (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
 #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
@@ -559,9 +562,12 @@
 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header.  */
+/* These are special because both Lisp_Subr and Lisp_Excursion lacks
+   struct vectorlike_header.  */
 #define XSETSUBR(a, b) \
   XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
+#define XSETEXCURSION(a, b) \
+  XSETTYPED_PSEUDOVECTOR (a, b, XEXCURSION (a)->size, PVEC_EXCURSION)
 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
@@ -1478,6 +1484,34 @@
 #define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
 #endif
 
+/* This structure is used to record buffer state for save-excursion.
+   It's mostly treated as Lisp_Vector but allocated and freed explicitly
+   with xmalloc and xfree, so there is no vectorlike_header here.  */
+
+struct Lisp_Excursion
+{
+  ptrdiff_t size;
+
+  /* Saved value of XWINDOW (selected_window).  */
+  struct window *window;
+
+  /* Non-zero if the window above has displayed the buffer.  */
+  unsigned visible : 1;
+
+  /* Non-zero if this buffer has mark active.  */
+  unsigned active : 1;
+
+  /* Saved point.  */
+  struct Lisp_Marker point;
+
+  /* Saved mark.  May point to nowhere.  */
+  struct Lisp_Marker mark;
+
+  /* When the calls to save-excursion are nested, this points
+     to an outer save-excursion state, or NULL otherwise.  */
+  struct Lisp_Excursion *next;
+};
+
 /* A character, declared with the following typedef, is a member
    of some character set associated with the current buffer.  */
 #ifndef _UCHAR_T  /* Protect against something in ctab.h on AIX.  */
@@ -1660,8 +1694,10 @@
 #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
 #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
 #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header.  */
+/* These are special because both Lisp_Subr and Lisp_Excursion lacks
+   struct vectorlike_header.  */
 #define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
+#define EXCURSIONP(x) TYPED_PSEUDOVECTORP (x, Lisp_Excursion, PVEC_EXCURSION)
 #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
@@ -2880,7 +2916,9 @@
 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
-                                               ptrdiff_t, ptrdiff_t);
+					       ptrdiff_t, ptrdiff_t);
+extern void attach_marker (struct Lisp_Marker *, struct buffer *,
+			   ptrdiff_t, ptrdiff_t);
 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
 extern void syms_of_marker (void);
 

=== modified file 'src/marker.c'
--- src/marker.c	2012-07-22 05:37:24 +0000
+++ src/marker.c	2012-07-25 07:21:28 +0000
@@ -427,7 +427,7 @@
 
 /* Change M so it points to B at CHARPOS and BYTEPOS.  */
 
-static inline void
+void
 attach_marker (struct Lisp_Marker *m, struct buffer *b,
 	       ptrdiff_t charpos, ptrdiff_t bytepos)
 {

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

>> I think you'll be better off making it into a standard Lisp_Object such
>> as pseudovector or a Lisp_Misc.  The fact that they're only used on the
>> specpdl and hence managed via xmalloc+xfree shouldn't make them
>> that special.

> OK. The only question is: should `excursion' field of struct buffer
> be special, like `undo_list', or handled as usual? This patch assumes
> first scenario, but it's not a problem to follow the second one.

If the excursion is made into a Lisp_Object (as a pseudovector of
lisp_misc), then you don't need to have an `excursions' field in
`struct buffer', save_excursion_save can just return the excursion
object (i.e. the PVEC_EXCURSION in your code).


        Stefan

Re: [RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 320 bytes --]

On 07/26/2012 03:44 AM, Stefan Monnier wrote:

> If the excursion is made into a Lisp_Object (as a pseudovector of
> lisp_misc), then you don't need to have an `excursions' field in
> `struct buffer', save_excursion_save can just return the excursion
> object (i.e. the PVEC_EXCURSION in your code).

Argh, yes.

Dmitry

[-- Attachment #2: excursion_5.patch --]
[-- Type: text/plain, Size: 13328 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-07-23 11:15:43 +0000
+++ src/alloc.c	2012-07-26 04:31:29 +0000
@@ -3653,17 +3653,10 @@
        doc: /* Return a newly allocated marker which does not point at any place.  */)
   (void)
 {
-  register Lisp_Object val;
-  register struct Lisp_Marker *p;
+  register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker);
 
-  val = allocate_misc (Lisp_Misc_Marker);
-  p = XMARKER (val);
-  p->buffer = 0;
-  p->bytepos = 0;
-  p->charpos = 0;
-  p->next = NULL;
-  p->insertion_type = 0;
-  return val;
+  init_marker (XMARKER (marker), NULL, 0, 0, 0);
+  return marker;
 }
 
 /* Return a newly allocated marker which points into BUF
@@ -3672,24 +3665,23 @@
 Lisp_Object
 build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
 {
-  Lisp_Object obj;
-  struct Lisp_Marker *m;
+  register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker);
+
+  /* Use Fmake_marker to create marker points to nowhere.  */
+  eassert (buf != NULL);
 
   /* No dead buffers here.  */
   eassert (!NILP (BVAR (buf, name)));
 
-  /* Every character is at least one byte.  */
-  eassert (charpos <= bytepos);
+  /* In a single-byte buffer, two positions must be equal.
+     Otherwise, every character is at least one byte.  */
+  if (BUF_Z (buf) == BUF_Z_BYTE (buf))
+    eassert (charpos == bytepos);
+  else
+    eassert (charpos <= bytepos);
 
-  obj = allocate_misc (Lisp_Misc_Marker);
-  m = XMARKER (obj);
-  m->buffer = buf;
-  m->charpos = charpos;
-  m->bytepos = bytepos;
-  m->insertion_type = 0;
-  m->next = BUF_MARKERS (buf);
-  BUF_MARKERS (buf) = m;
-  return obj;
+  init_marker (XMARKER (marker), buf, charpos, bytepos, 0);
+  return marker;
 }
 
 /* Put MARKER back on the free list after using it temporarily.  */
@@ -6057,6 +6049,19 @@
 	  case PVEC_SUBR:
 	    break;
 
+	  case PVEC_EXCURSION:
+	    {
+	      struct Lisp_Excursion *e = (struct Lisp_Excursion *) ptr;
+
+	      eassert (e->buffer != NULL);
+	      eassert (e->window != NULL);
+	      if (!VECTOR_MARKED_P (e->buffer))
+		mark_buffer (e->buffer);
+	      if (!VECTOR_MARKED_P (e->window))
+		mark_vectorlike ((struct Lisp_Vector *) e->window);
+	    }
+	    break;
+
 	  case PVEC_FREE:
 	    abort ();
 

=== modified file 'src/editfns.c'
--- src/editfns.c	2012-07-17 07:43:01 +0000
+++ src/editfns.c	2012-07-26 04:47:56 +0000
@@ -821,104 +821,104 @@
 			      Qnil, Qt, Qnil);
 }
 
-\f
+/* Record buffer state before entering Fsave_excursion. */
+
 Lisp_Object
 save_excursion_save (void)
 {
-  int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
-		 == current_buffer);
-
-  return Fcons (Fpoint_marker (),
-		Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
-		       Fcons (visible ? Qt : Qnil,
-			      Fcons (BVAR (current_buffer, mark_active),
-				     selected_window))));
+  Lisp_Object excursion;
+  struct buffer *b = current_buffer;
+  struct window *w = XWINDOW (selected_window);
+  struct Lisp_Excursion *ex = xmalloc (sizeof *ex);
+  struct Lisp_Marker *m = XMARKER (BVAR (b, mark));
+
+  ex->size = 0;
+  ex->buffer = b;
+  ex->window = w;
+  ex->visible = (XBUFFER (w->buffer) == b);
+  ex->active = !NILP (BVAR (b, mark_active));
+
+  /* We do not initialize type and gcmarkbit since this marker
+     is never referenced via Lisp_Object and invisible for GC.  */
+  init_marker (&ex->point, b, PT, PT_BYTE, 0);
+
+  /* Likewise.  Note that charpos and bytepos may be zero.  */
+  init_marker (&ex->mark, m->buffer, m->charpos, 
+	       m->bytepos, m->insertion_type);
+
+  /* Make it a pseudovector and return excursion object.  */
+  XSETTYPED_PVECTYPE (ex, size, PVEC_EXCURSION);
+  XSETEXCURSION (excursion, ex);
+  return excursion;
 }
 
+/* Restore buffer state before leaving Fsave_excursion.  */
+
 Lisp_Object
-save_excursion_restore (Lisp_Object info)
+save_excursion_restore (Lisp_Object obj)
 {
-  Lisp_Object tem, tem1, omark, nmark;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-  int 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.  */
-  if (NILP (tem))
-    return Qnil;
-
-  omark = nmark = Qnil;
-  GCPRO3 (info, omark, nmark);
-
-  Fset_buffer (tem);
-
-  /* Point marker.  */
-  tem = XCAR (info);
-  Fgoto_char (tem);
-  unchain_marker (XMARKER (tem));
-
-  /* Mark marker.  */
-  info = XCDR (info);
-  tem = XCAR (info);
-  omark = Fmarker_position (BVAR (current_buffer, mark));
-  Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
-  nmark = Fmarker_position (tem);
-  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);
-  tem1 = BVAR (current_buffer, mark_active);
-  BVAR (current_buffer, mark_active) = tem;
-
-  /* If mark is active now, and either was not active
-     or was at a different place, run the activate hook.  */
-  if (! NILP (tem))
-    {
-      if (! EQ (omark, nmark))
-        {
-          tem = intern ("activate-mark-hook");
-          Frun_hooks (1, &tem);
-        }
-    }
-  /* If mark has ceased to be active, run deactivate hook.  */
-  else if (! NILP (tem1))
-    {
-      tem = intern ("deactivate-mark-hook");
-      Frun_hooks (1, &tem);
-    }
-
-  /* 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
-      && !EQ (tem, selected_window)
-      && (tem1 = XWINDOW (tem)->buffer,
-	  (/* Window is live...  */
-	   BUFFERP (tem1)
-	   /* ...and it shows the current buffer.  */
-	   && XBUFFER (tem1) == current_buffer)))
-    Fset_window_point (tem, make_number (PT));
-
-  UNGCPRO;
+  struct Lisp_Excursion *ex = XEXCURSION (obj);
+  struct buffer *b = ex->buffer;
+
+  eassert (b != NULL);
+  eassert (ex->window != NULL);
+
+  /* Restore buffer state only if the buffer is live.
+     Otherwise, just cancel an excursion state.  */
+
+  if (!NILP (BVAR (b, name)))
+    {
+      int active;
+      struct Lisp_Marker *m;
+      ptrdiff_t oldpos, newpos;
+
+      /* Restore current buffer.  */
+      set_buffer_internal (b);
+
+      /* Restore buffer position.  */
+      SET_PT_BOTH (clip_to_bounds (BEGV, ex->point.charpos, ZV),
+		   clip_to_bounds (BEGV_BYTE, ex->point.bytepos, ZV_BYTE));
+      unchain_marker (&ex->point);
+
+      /* Restore mark if it was non-zero.  */
+      m = XMARKER (BVAR (b, mark));
+      oldpos = m->charpos;
+      if (BEGV <= ex->mark.charpos)
+	attach_marker (m, b, ex->mark.charpos, ex->mark.bytepos);
+      newpos = ex->mark.charpos;
+      unchain_marker (&ex->mark);
+
+      /* If mark and region was active, restore them.  */
+      active = !NILP (BVAR (b, mark_active));
+      BVAR (b, mark_active) = ex->active ? Qt : Qnil;
+
+      /* If mark is active now, and either was not active
+	 or was at a different place, run the activate hook.  */
+      if (ex->active && oldpos != newpos)
+	{
+	  obj = intern ("activate-mark-hook");
+	  Frun_hooks (1, &obj);
+	}
+      /* If mark has ceased to be active, run deactivate hook.  */
+      else if (active)
+	{
+	  obj = intern ("deactivate-mark-hook");
+	  Frun_hooks (1, &obj);
+	}
+
+      /* 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.  */
+      if (ex->visible)
+	{
+	  struct window *w = ex->window;
+
+	  if (w != XWINDOW (selected_window) && XBUFFER (w->buffer) == b)
+	    attach_marker (XMARKER (w->pointm), b, PT, PT_BYTE);
+	}
+    }
+
+  xfree (ex);
   return Qnil;
 }
 

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-07-26 01:27:33 +0000
+++ src/lisp.h	2012-07-26 04:56:42 +0000
@@ -354,6 +354,7 @@
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
   PVEC_SUBR,
+  PVEC_EXCURSION,
   PVEC_OTHER,
   /* These last 4 are special because we OR them in fns.c:internal_equal,
      so they have to use a disjoint bit pattern:
@@ -509,6 +510,8 @@
 		      (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
 #define XSUBR(a) (eassert (SUBRP (a)), \
 		  (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XEXCURSION(a) (eassert (EXCURSIONP (a)), \
+		       (struct Lisp_Excursion *) XUNTAG (a, Lisp_Vectorlike))
 #define XBUFFER(a) (eassert (BUFFERP (a)), \
 		    (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
 #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
@@ -561,9 +564,12 @@
 #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header.  */
+/* These are special because both Lisp_Subr and Lisp_Excursion lacks
+   struct vectorlike_header.  */
 #define XSETSUBR(a, b) \
   XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
+#define XSETEXCURSION(a, b) \
+  XSETTYPED_PSEUDOVECTOR (a, b, XEXCURSION (a)->size, PVEC_EXCURSION)
 #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
@@ -1480,6 +1486,33 @@
 #define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
 #endif
 
+/* This structure is used to record buffer state for Fsave_excursion.
+   It's mostly treated as Lisp_Vector but allocated and freed explicitly
+   with xmalloc and xfree, so there is no vectorlike_header here.  */
+
+struct Lisp_Excursion
+{
+  ptrdiff_t size;
+
+  /* Saved value of XWINDOW (selected_window).  */
+  struct window *window;
+
+  /* Buffer where this excursion is in effect.  */
+  struct buffer *buffer;
+
+  /* Non-zero if the window above has displayed the buffer.  */
+  unsigned visible : 1;
+
+  /* Non-zero if this buffer has the mark active.  */
+  unsigned active : 1;
+
+  /* Saved point.  */
+  struct Lisp_Marker point;
+
+  /* Saved mark.  May point to nowhere.  */
+  struct Lisp_Marker mark;
+};
+
 /* A character, declared with the following typedef, is a member
    of some character set associated with the current buffer.  */
 #ifndef _UCHAR_T  /* Protect against something in ctab.h on AIX.  */
@@ -1662,8 +1695,10 @@
 #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
 #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
 #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header.  */
+/* These are special because both Lisp_Subr and Lisp_Excursion lacks
+   struct vectorlike_header.  */
 #define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
+#define EXCURSIONP(x) TYPED_PSEUDOVECTORP (x, Lisp_Excursion, PVEC_EXCURSION)
 #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
@@ -2877,11 +2912,15 @@
 extern ptrdiff_t charpos_to_bytepos (ptrdiff_t);
 extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
 extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
-extern void unchain_marker (struct Lisp_Marker *marker);
+extern void unchain_marker (struct Lisp_Marker *);
 extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
-                                               ptrdiff_t, ptrdiff_t);
+					       ptrdiff_t, ptrdiff_t);
+extern void init_marker (struct Lisp_Marker *, struct buffer *,
+			 ptrdiff_t, ptrdiff_t, int);
+extern void attach_marker (struct Lisp_Marker *, struct buffer *,
+			   ptrdiff_t, ptrdiff_t);
 extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
 extern void syms_of_marker (void);
 

=== modified file 'src/marker.c'
--- src/marker.c	2012-07-22 05:37:24 +0000
+++ src/marker.c	2012-07-26 04:09:14 +0000
@@ -425,9 +425,28 @@
   return Qnil;
 }
 
+/* Initialize just allocated Lisp_Marker.  */
+
+void
+init_marker (struct Lisp_Marker *m, struct buffer *b,
+	     ptrdiff_t charpos, ptrdiff_t bytepos, int type)
+{
+  m->buffer = b;
+  m->charpos = charpos;
+  m->bytepos = bytepos;
+  m->insertion_type = type;
+  if (b)
+    {
+      m->next = BUF_MARKERS (b);
+      BUF_MARKERS (b) = m;
+    }
+  else
+    m->next = NULL;
+}
+
 /* Change M so it points to B at CHARPOS and BYTEPOS.  */
 
-static inline void
+void
 attach_marker (struct Lisp_Marker *m, struct buffer *b,
 	       ptrdiff_t charpos, ptrdiff_t bytepos)
 {

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

>> If the excursion is made into a Lisp_Object (as a pseudovector of
>> lisp_misc), then you don't need to have an `excursions' field in
>> `struct buffer', save_excursion_save can just return the excursion
>> object (i.e. the PVEC_EXCURSION in your code).

> Argh, yes.

Looks OK, thanks,


        Stefan

Re: [RFC, experimental] save_{excursion,restriction}

[Ivan Andrus]

On Jul 24, 2012, at 1:45 AM, Stefan Monnier wrote:

>> It's worth trying to redesign save-restriction and save-excursion to avoid
>> allocating Lisp data. I tried some hacks for save-excursion, and it's quite
>> surprising: initially, running (while t (scroll-up) (sit-for 0.05)) over
>> just loaded xdisp.c with font-lock enabled asks for 600 GCs, and with this
>> patch it's just 350.
> 
> save-restriction should be fairly rare (and if it's not, that's
> something we should fix), but for save-excursion I'm not that surprised.

Now I'm curious.  Why should save-restriction be rare?  I use it 4 times in my .emacs with widen–I assume there is no way around that.  I use it another 9 times with narrow-to-region so that I can mangle the region and use point-min and point-max.  Would it be better to use markers in this case?  Or perhaps a temp buffer?

It's used it another 2 dozen times in packages that I maintain, I assume for roughly the same reasons.

-Ivan

Re: [RFC, experimental] save_{excursion,restriction}

[Stefan Monnier]

> Now I'm curious.  Why should save-restriction be rare?

I mean "dynamically rare".  I.e. I don't expect it to happen very often
to change the restriction in the inner loops.

> Would it be better to use markers in this case?

In my experience, if markers can be used instead, then yes I do
recommend markers.  They have much fewer interactions with other things.


        Stefan

Re: [RFC, experimental] save_{excursion,restriction}

[Chong Yidong]

Dmitry Antipov <dmantipov@yandex.ru> writes:

> It's worth trying to redesign save-restriction and save-excursion to avoid
> allocating Lisp data. I tried some hacks for save-excursion, and it's quite
> surprising: initially, running (while t (scroll-up) (sit-for 0.05)) over
> just loaded xdisp.c with font-lock enabled asks for 600 GCs, and with this
> patch it's just 350.

With your revision 109221,

emacs -Q
M-x delete-trailing-whitespace RET
M-x garbage-collect RET
---->
Breakpoint 1, abort () at emacs.c:365
365	  kill (getpid (), SIGABRT);
(gdb) bt
#0  abort () at emacs.c:365
#1  0x00000000005eb60b in mark_object (arg=26719011) at alloc.c:6167
#2  0x00000000005eb6da in mark_object (arg=19905638) at alloc.c:6185
#3  0x00000000005eb6da in mark_object (arg=19903334) at alloc.c:6185
#4  0x00000000005e92d8 in mark_maybe_object (obj=19903334) at alloc.c:4532
#5  0x00000000005e9637 in mark_memory (start=0x7fffffffc688, 
    end=0x7fffffffdf78) at alloc.c:4695

Please fix this ASAP or revert (the crashes are frequent and annoying).
Next time, I suggest running with such changes for a few days to weed
out this kind of obvious problem.

Re: [RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov]

On 07/27/2012 07:51 AM, Chong Yidong wrote:

> With your revision 109221,
>
> emacs -Q
> M-x delete-trailing-whitespace RET
> M-x garbage-collect RET
> ---->
> Breakpoint 1, abort () at emacs.c:365
> 365	  kill (getpid (), SIGABRT);
> (gdb) bt
> #0  abort () at emacs.c:365
> #1  0x00000000005eb60b in mark_object (arg=26719011) at alloc.c:6167
> #2  0x00000000005eb6da in mark_object (arg=19905638) at alloc.c:6185
> #3  0x00000000005eb6da in mark_object (arg=19903334) at alloc.c:6185
> #4  0x00000000005e92d8 in mark_maybe_object (obj=19903334) at alloc.c:4532
> #5  0x00000000005e9637 in mark_memory (start=0x7fffffffc688,
>      end=0x7fffffffdf78) at alloc.c:4695
>
> Please fix this ASAP or revert (the crashes are frequent and annoying).
> Next time, I suggest running with such changes for a few days to weed
> out this kind of obvious problem.

OK, reverted in 109226. Note it was running normally for a few hours
for me without any problems. Now I got it reproduced (it looks like
GC misuses some value found on C stack), and I can't say that this
is an obvious problem.

Dmitry