[Emacs-diffs] /srv/bzr/emacs/trunk r109221: Fast save_excursion_save and save_excursion_restore.

[Dmitry Antipov]

------------------------------------------------------------
revno: 109221
committer: Dmitry Antipov <address@hidden>
branch nick: trunk
timestamp: Fri 2012-07-27 06:47:07 +0400
message:
  Fast save_excursion_save and save_excursion_restore.
  * lisp.h (struct Lisp_Excursion): New data type.
  (PVEC_EXCURSION): New pseudovector type.
  (XEXCURSION, XSETEXCURSION, EXCURSIONP): Convenient macros
  to deal with it.  Adjust comments.
  (init_marker, attach_marker): New prototype.
  (unchain_marker): Adjust prototype.
  * marker.c (attach_marker): Change to global.
  (init_marker): New function.
  * alloc.c (Fmake_marker, build_marker): Use it.
  (build_marker): More easserts.
  (mark_object): Handle struct Lisp_Excursion.
  * editfns.c (save_excursion_save, save_excursion_restore):
  Reimplement to use struct Lisp_Excursion.  Add comments.
modified:
  src/ChangeLog
  src/alloc.c
  src/editfns.c
  src/lisp.h
  src/marker.c

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-07-26 19:58:48 +0000
+++ b/src/ChangeLog     2012-07-27 02:47:07 +0000
@@ -1,3 +1,20 @@
+2012-07-27  Dmitry Antipov  <address@hidden>
+
+       Fast save_excursion_save and save_excursion_restore.
+       * lisp.h (struct Lisp_Excursion): New data type.
+       (PVEC_EXCURSION): New pseudovector type.
+       (XEXCURSION, XSETEXCURSION, EXCURSIONP): Convenient macros
+       to deal with it.  Adjust comments.
+       (init_marker, attach_marker): New prototype.
+       (unchain_marker): Adjust prototype.
+       * marker.c (attach_marker): Change to global.
+       (init_marker): New function.
+       * alloc.c (Fmake_marker, build_marker): Use it.
+       (build_marker): More easserts.
+       (mark_object): Handle struct Lisp_Excursion.
+       * editfns.c (save_excursion_save, save_excursion_restore):
+       Reimplement to use struct Lisp_Excursion.  Add comments.
+
 2012-07-26  Paul Eggert  <address@hidden>
 
        Fix export of symbols to GDB (Bug#12036).

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2012-07-26 18:35:50 +0000
+++ b/src/alloc.c       2012-07-27 02:47:07 +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;
+             /* No Lisp_Objects but two special pointers to mark here.  */
+             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'
--- a/src/editfns.c     2012-07-26 05:23:25 +0000
+++ b/src/editfns.c     2012-07-27 02:47:07 +0000
@@ -821,104 +821,104 @@
                              Qnil, Qt, Qnil);
 }
 
-
+/* 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'
--- a/src/lisp.h        2012-07-26 18:35:50 +0000
+++ b/src/lisp.h        2012-07-27 02:47:07 +0000
@@ -379,6 +379,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:
@@ -551,6 +552,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)), \
@@ -603,9 +606,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))
@@ -1522,6 +1528,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.  */
@@ -1704,8 +1737,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)
@@ -2919,11 +2954,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'
--- a/src/marker.c      2012-07-22 05:37:24 +0000
+++ b/src/marker.c      2012-07-27 02:47:07 +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)
 {