[RFC, experimental] save_{excursion,restriction}

[Dmitry Antipov <dmantipov@yandex.ru>]

[-- 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)
 {