* 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-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <eggert@cs.ucla.edu>
Fix export of symbols to GDB (Bug#12036).
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
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);
-
- 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;
+ /* 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);
+
+ init_marker (XMARKER (marker), buf, charpos, bytepos, 0);
+ return marker;
}
/* Put MARKER back on the free list after using it temporarily. */
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 ();
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;
+ struct Lisp_Excursion *ex = XEXCURSION (obj);
+ struct buffer *b = ex->buffer;
- 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))
+ 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)))
{
- tem = intern ("deactivate-mark-hook");
- Frun_hooks (1, &tem);
+ 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);
+ }
}
- /* 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;
+ xfree (ex);
return Qnil;
}
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:
(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)), \
#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))
#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. */
#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)
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);
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)
{
projects / emacs.git / commitdiff