dnl Again, it's best not to use a variable. Though you can add
dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
AC_CONFIG_FILES([test/Makefile])
+ AC_CONFIG_FILES([test/manual/noverlay/Makefile])
fi
+ opt_makefile=test/infra/Makefile
+ if test -f "$srcdir/$opt_makefile.in"; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ dnl Again, it's best not to use a variable. Though you can add
+ dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
+ AC_CONFIG_FILES([test/infra/Makefile])
+ fi
dnl The admin/ directory used to be excluded from tarfiles.
## lastfile must follow all files whose initialized data areas should
## be dumped as pure by dump-emacs.
--base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
-- charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
-- $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
-- emacs.o keyboard.o macros.o keymap.o sysdep.o \
- buffer.o filelock.o insdel.o marker.o \
- bignum.o buffer.o filelock.o insdel.o marker.o \
-- minibuf.o fileio.o dired.o \
- cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
- alloc.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o \
- cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
- alloc.o pdumper.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
-- process.o gnutls.o callproc.o \
- region-cache.o sound.o atimer.o \
- region-cache.o sound.o timefns.o atimer.o \
++base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
++ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
++ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
++ emacs.o keyboard.o macros.o keymap.o sysdep.o \
++ bignum.o buffer.o filelock.o insdel.o marker.o \
++ minibuf.o fileio.o dired.o \
++ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
++ alloc.o pdumper.o data.o doc.o editfns.o callint.o \
++ eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
++ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
++ process.o gnutls.o callproc.o \
++ region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
-- $(XWIDGETS_OBJ) \
-- profiler.o decompress.o \
- thread.o systhread.o \
- itree.o \
- thread.o systhread.o sqlite.o \
-- $(if $(HYBRID_MALLOC),sheap.o) \
-- $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
- obj = $(base_obj) $(NS_OBJC_OBJ)
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
++ $(XWIDGETS_OBJ) \
++ profiler.o decompress.o \
++ thread.o systhread.o sqlite.o \
++ itree.o \
++ $(if $(HYBRID_MALLOC),sheap.o) \
++ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
++ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
+ $(HAIKU_OBJ) $(PGTK_OBJ)
+ doc_obj = $(base_obj) $(NS_OBJC_OBJ)
+ obj = $(doc_obj) $(HAIKU_CXX_OBJ)
## Object files used on some machine or other.
## These go in the DOC file on all machines in case they are needed.
FIRSTFILE_OBJ=@FIRSTFILE_OBJ@
ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj)
-dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \
+ # Must be first, before dep inclusion!
+ ifneq ($(HAVE_BE_APP),yes)
+ all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES)
+ else
+ all: Emacs Emacs.pdmp $(OTHER_FILES)
+ endif
+ ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:)
+ all: ../native-lisp
+ endif
+ .PHONY: all
+
++dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h $(srcdir)/itree.h \
+ $(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h
+ ifeq ($(CHECK_STRUCTS),true)
+ pdumper.o: dmpstruct.h
+ endif
+ dmpstruct.h: $(srcdir)/dmpstruct.awk
+ dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers)
+ $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \
+ $(dmpstruct_headers) > $@
+
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
ifeq ($(AUTO_DEPEND),yes)
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2017 Free Software
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
--Foundation, Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
+ #include "pdumper.h"
#include "termhooks.h" /* For struct terminal. */
+#include "itree.h"
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
cleanup_vector (struct Lisp_Vector *vector)
{
detect_suspicious_free (vector);
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
- && ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
- == FONT_OBJECT_MAX))
- {
- struct font_driver const *drv = ((struct font *) vector)->driver;
- /* The font driver might sometimes be NULL, e.g. if Emacs was
- interrupted before it had time to set it up. */
- if (drv)
+ if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM))
+ mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value);
++ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_OVERLAY))
++ {
++ struct Lisp_Overlay *ol = PSEUDOVEC_STRUCT (vector, Lisp_Overlay);
++ xfree (ol->interval);
++ }
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER))
+ unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer));
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT))
+ {
+ if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX)
{
- /* Attempt to catch subtle bugs like Bug#16140. */
- eassert (valid_font_driver (drv));
- drv->close ((struct font *) vector);
+ struct font *font = PSEUDOVEC_STRUCT (vector, font);
+ struct font_driver const *drv = font->driver;
+
+ /* The font driver might sometimes be NULL, e.g. if Emacs was
+ interrupted before it had time to set it up. */
+ if (drv)
+ {
+ /* Attempt to catch subtle bugs like Bug#16140. */
+ eassert (valid_font_driver (drv));
+ drv->close_font (font);
+ }
}
}
-
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD))
- finalize_one_thread ((struct thread_state *) vector);
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD))
+ finalize_one_thread (PSEUDOVEC_STRUCT (vector, thread_state));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX))
- finalize_one_mutex ((struct Lisp_Mutex *) vector);
+ finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR))
- finalize_one_condvar ((struct Lisp_CondVar *) vector);
+ finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar));
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MARKER))
+ {
+ /* sweep_buffer should already have unchained this from its buffer. */
+ eassert (! PSEUDOVEC_STRUCT (vector, Lisp_Marker)->buffer);
+ }
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_USER_PTR))
+ {
+ struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr);
+ if (uptr->finalizer)
+ uptr->finalizer (uptr->p);
+ }
+ #ifdef HAVE_MODULES
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
+ {
+ ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
+ = (struct Lisp_Module_Function *) vector;
+ module_finalize_function (function);
+ }
+ #endif
+ #ifdef HAVE_NATIVE_COMP
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
+ {
+ struct Lisp_Native_Comp_Unit *cu =
+ PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
+ unload_comp_unit (cu);
+ }
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
+ {
+ struct Lisp_Subr *subr =
+ PSEUDOVEC_STRUCT (vector, Lisp_Subr);
+ if (!NILP (subr->native_comp_u))
+ {
+ /* FIXME Alternative and non invasive solution to this
+ cast? */
+ xfree ((char *)subr->symbol_name);
+ xfree (subr->native_c_name);
+ }
+ }
+ #endif
}
/* Reclaim space used by unmarked vectors. */
return val;
}
- /* Free a Lisp_Save_Value object. Do not use this function
- if SAVE contains pointer other than returned by xmalloc. */
-
- void
- free_save_value (Lisp_Object save)
- {
- xfree (XSAVE_POINTER (save, 0));
- free_misc (save);
- }
-
- /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
+ /* Return a new overlay with specified START, END and PLIST. */
Lisp_Object
-build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+build_overlay (ptrdiff_t begin, ptrdiff_t end,
+ bool front_advance, bool rear_advance,
+ Lisp_Object plist)
{
- Lisp_Object ov = allocate_misc (Lisp_Misc_Overlay);
+ struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist,
+ PVEC_OVERLAY);
+ Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike);
- OVERLAY_START (overlay) = start;
- OVERLAY_END (overlay) = end;
+ struct interval_node *node = xmalloc (sizeof (*node));
-
+ interval_node_init (node, begin, end, front_advance,
- rear_advance, ov);
- XOVERLAY (ov)->interval = node;
- XOVERLAY (ov)->buffer = NULL;
- set_overlay_plist (ov, plist);
- return ov;
++ rear_advance, overlay);
++ p->interval = node;
++ p->buffer = NULL;
+ set_overlay_plist (overlay, plist);
- p->next = NULL;
+ return overlay;
}
DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
}
}
- /* Subroutine of Fgarbage_collect that does most of the work. It is a
- separate function so that we could limit mark_stack in searching
- the stack frames below this function, thus avoiding the rare cases
- where mark_stack finds values that look like live Lisp objects on
- portions of stack that couldn't possibly contain such live objects.
- For more details of this, see the discussion at
- https://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00270.html. */
- static Lisp_Object
- garbage_collect_1 (void *end)
+ static void
+ visit_vectorlike_root (struct gc_root_visitor visitor,
+ struct Lisp_Vector *ptr,
+ enum gc_root_type type)
{
- struct buffer *nextb;
- char stack_top_variable;
+ ptrdiff_t size = ptr->header.size;
ptrdiff_t i;
- bool message_p;
- ptrdiff_t count = SPECPDL_INDEX ();
- struct timespec start;
- Lisp_Object retval = Qnil;
- size_t tot_before = 0;
- /* Can't GC if pure storage overflowed because we can't determine
- if something is a pure object or not. */
- if (pure_bytes_used_before_overflow)
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (i = 0; i < size; i++)
+ visitor.visit (&ptr->contents[i], type, visitor.data);
+ }
+
+ static void
+ visit_buffer_root (struct gc_root_visitor visitor,
+ struct buffer *buffer,
+ enum gc_root_type type)
+ {
+ /* Buffers that are roots don't have intervals, an undo list, or
+ other constructs that real buffers have. */
+ eassert (buffer->base_buffer == NULL);
- eassert (buffer->overlays_before == NULL);
- eassert (buffer->overlays_after == NULL);
++ eassert (buffer->overlays == NULL);
+
+ /* Visit the buffer-locals. */
+ visit_vectorlike_root (visitor, (struct Lisp_Vector *) buffer, type);
+ }
+
+ /* Visit GC roots stored in the Emacs data section. Used by both core
+ GC and by the portable dumping code.
+
+ There are other GC roots of course, but these roots are dynamic
+ runtime data structures that pdump doesn't care about and so we can
+ continue to mark those directly in garbage_collect. */
+ void
+ visit_static_gc_roots (struct gc_root_visitor visitor)
+ {
+ visit_buffer_root (visitor,
+ &buffer_defaults,
+ GC_ROOT_BUFFER_LOCAL_DEFAULT);
+ visit_buffer_root (visitor,
+ &buffer_local_symbols,
+ GC_ROOT_BUFFER_LOCAL_NAME);
+
+ for (int i = 0; i < ARRAYELTS (lispsym); i++)
+ {
+ Lisp_Object sptr = builtin_lisp_symbol (i);
+ visitor.visit (&sptr, GC_ROOT_C_SYMBOL, visitor.data);
+ }
+
+ for (int i = 0; i < staticidx; i++)
+ visitor.visit (staticvec[i], GC_ROOT_STATICPRO, visitor.data);
+ }
+
+ static void
+ mark_object_root_visitor (Lisp_Object const *root_ptr,
+ enum gc_root_type type,
+ void *data)
+ {
+ mark_object (*root_ptr);
+ }
+
+ /* List of weak hash tables we found during marking the Lisp heap.
+ NULL on entry to garbage_collect and after it returns. */
+ static struct Lisp_Hash_Table *weak_hash_tables;
+
+ NO_INLINE /* For better stack traces */
+ static void
+ mark_and_sweep_weak_table_contents (void)
+ {
+ struct Lisp_Hash_Table *h;
+ bool marked;
+
+ /* Mark all keys and values that are in use. Keep on marking until
+ there is no more change. This is necessary for cases like
+ value-weak table A containing an entry X -> Y, where Y is used in a
+ key-weak table B, Z -> Y. If B comes after A in the list of weak
+ tables, X -> Y might be removed from A, although when looking at B
+ one finds that it shouldn't. */
+ do
+ {
+ marked = false;
+ for (h = weak_hash_tables; h; h = h->next_weak)
+ marked |= sweep_weak_table (h, false);
+ }
+ while (marked);
+
+ /* Remove hash table entries that aren't used. */
+ while (weak_hash_tables)
+ {
+ h = weak_hash_tables;
+ weak_hash_tables = h->next_weak;
+ h->next_weak = NULL;
+ sweep_weak_table (h, true);
+ }
+ }
+
+ /* Return the number of bytes to cons between GCs, given THRESHOLD and
+ PERCENTAGE. When calculating a threshold based on PERCENTAGE,
+ assume SINCE_GC bytes have been allocated since the most recent GC.
+ The returned value is positive and no greater than HI_THRESHOLD. */
+ static EMACS_INT
+ consing_threshold (intmax_t threshold, Lisp_Object percentage,
+ intmax_t since_gc)
+ {
+ if (!NILP (Vmemory_full))
+ return memory_full_cons_threshold;
+ else
+ {
+ threshold = max (threshold, GC_DEFAULT_THRESHOLD / 10);
+ if (FLOATP (percentage))
+ {
+ double tot = (XFLOAT_DATA (percentage)
+ * (total_bytes_of_live_objects () + since_gc));
+ if (threshold < tot)
+ {
+ if (tot < HI_THRESHOLD)
+ return tot;
+ else
+ return HI_THRESHOLD;
+ }
+ }
+ return min (threshold, HI_THRESHOLD);
+ }
+ }
+
+ /* Adjust consing_until_gc and gc_threshold, given THRESHOLD and PERCENTAGE.
+ Return the updated consing_until_gc. */
+
+ static EMACS_INT
+ bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
+ {
+ /* Guesstimate that half the bytes allocated since the most
+ recent GC are still in use. */
+ EMACS_INT since_gc = (gc_threshold - consing_until_gc) >> 1;
+ EMACS_INT new_gc_threshold = consing_threshold (threshold, percentage,
+ since_gc);
+ consing_until_gc += new_gc_threshold - gc_threshold;
+ gc_threshold = new_gc_threshold;
+ return consing_until_gc;
+ }
+
+ /* Watch changes to gc-cons-threshold. */
+ static Lisp_Object
+ watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
+ Lisp_Object operation, Lisp_Object where)
+ {
+ intmax_t threshold;
+ if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
return Qnil;
+ bump_consing_until_gc (threshold, Vgc_cons_percentage);
+ return Qnil;
+ }
+
+ /* Watch changes to gc-cons-percentage. */
+ static Lisp_Object
+ watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
+ Lisp_Object operation, Lisp_Object where)
+ {
+ bump_consing_until_gc (gc_cons_threshold, newval);
+ return Qnil;
+ }
+
+ /* It may be time to collect garbage. Recalculate consing_until_gc,
+ since it might depend on current usage, and do the garbage
+ collection if the recalculation says so. */
+ void
+ maybe_garbage_collect (void)
+ {
+ if (bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage) < 0)
+ garbage_collect ();
+ }
+
+ static inline bool mark_stack_empty_p (void);
+
+ /* Subroutine of Fgarbage_collect that does most of the work. */
+ void
+ garbage_collect (void)
+ {
+ Lisp_Object tail, buffer;
+ char stack_top_variable;
+ bool message_p;
+ specpdl_ref count = SPECPDL_INDEX ();
+ struct timespec start;
+
+ eassert (weak_hash_tables == NULL);
+
+ if (garbage_collection_inhibited)
+ return;
+
+ eassert(mark_stack_empty_p ());
/* Record this function, so it appears on the profiler's backtraces. */
record_in_backtrace (QAutomatic_GC, 0, 0);
/* Mark the chain of overlays starting at PTR. */
static void
-mark_overlay (struct Lisp_Overlay *ptr)
+mark_overlay (struct Lisp_Overlay *ov)
{
- ov->gcmarkbit = 1;
- for (; ptr && !vectorlike_marked_p (&ptr->header); ptr = ptr->next)
- {
- set_vectorlike_marked (&ptr->header);
- /* These two are always markers and can be marked fast. */
- set_vectorlike_marked (&XMARKER (ptr->start)->header);
- set_vectorlike_marked (&XMARKER (ptr->end)->header);
- mark_object (ptr->plist);
- }
++ set_vectorlike_marked (&ov->header);
+ mark_object (ov->plist);
}
/* Mark Lisp_Objects and special pointers in BUFFER. */
/* For now, we just don't mark the undo_list. It's done later in
a special way just before the sweep phase, and after stripping
- some of its elements that are not needed any more. */
+ some of its elements that are not needed any more.
+ Note: this later processing is only done for live buffers, so
+ for dead buffers, the undo_list should be nil (set by Fkill_buffer),
+ but just to be on the safe side, we mark it here. */
+ if (!BUFFER_LIVE_P (buffer))
+ mark_object (BVAR (buffer, undo_list));
- mark_overlay (buffer->overlays_before);
- mark_overlay (buffer->overlays_after);
+ struct interval_node *node;
+ buffer_overlay_iter_start (buffer, PTRDIFF_MIN, PTRDIFF_MAX, ITREE_ASCENDING);
+ while ((node = buffer_overlay_iter_next (buffer)))
+ mark_overlay (XOVERLAY (node->data));
+ buffer_overlay_iter_finish (buffer);
/* If this is an indirect buffer, mark its base buffer. */
- if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
+ if (buffer->base_buffer &&
+ !vectorlike_marked_p (&buffer->base_buffer->header))
mark_buffer (buffer->base_buffer);
}
/* Buffer manipulation primitives for GNU Emacs.
- Copyright (C) 1985-1989, 1993-1995, 1997-2017 Free Software Foundation,
-Copyright (C) 1985-1989, 1993-1995, 1997-2022 Free Software Foundation,
--Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "keymap.h"
#include "frame.h"
#include "xwidget.h"
+#include "itree.h"
+ #include "pdumper.h"
#ifdef WINDOWSNT
#include "w32heap.h" /* for mmap_* */
static void alloc_buffer_text (struct buffer *, ptrdiff_t);
static void free_buffer_text (struct buffer *b);
-static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
+static void copy_overlays (struct buffer *, struct buffer *);
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
+ static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym);
static void
CHECK_OVERLAY (Lisp_Object x)
}
-/* Return a list of overlays which is a copy of the overlay list
- LIST, but for buffer B. */
+/* Copy overlays of buffer FROM to buffer TO. */
-static struct Lisp_Overlay *
-copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
+static void
+copy_overlays (struct buffer *from, struct buffer *to)
{
- struct Lisp_Overlay *result = NULL, *tail = NULL;
+ eassert (to && ! to->overlays);
+ struct interval_node *node;
- for (; list; list = list->next)
+ buffer_overlay_iter_start (from, PTRDIFF_MIN, PTRDIFF_MAX, ITREE_ASCENDING);
+ while ((node = buffer_overlay_iter_next (from)))
{
- Lisp_Object overlay, start, end;
- struct Lisp_Marker *m;
-
- eassert (MARKERP (list->start));
- m = XMARKER (list->start);
- start = build_marker (b, m->charpos, m->bytepos);
- XMARKER (start)->insertion_type = m->insertion_type;
-
- eassert (MARKERP (list->end));
- m = XMARKER (list->end);
- end = build_marker (b, m->charpos, m->bytepos);
- XMARKER (end)->insertion_type = m->insertion_type;
-
- overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
- if (tail)
- tail = tail->next = XOVERLAY (overlay);
- else
- result = tail = XOVERLAY (overlay);
+ Lisp_Object ov = node->data;
+ Lisp_Object copy = build_overlay (node->begin, node->end,
+ node->front_advance,
+ node->rear_advance,
+ Fcopy_sequence (OVERLAY_PLIST (ov)));
+ add_buffer_overlay (to, XOVERLAY (copy));
}
-
- return result;
-}
-
-/* Set an appropriate overlay of B. */
-
-static void
-set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
-{
- b->overlays_before = o;
-}
-
-static void
-set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
-{
- b->overlays_after = o;
+ buffer_overlay_iter_finish (from);
}
+ bool
+ valid_per_buffer_idx (int idx)
+ {
+ return 0 <= idx && idx < last_per_buffer_idx;
+ }
+
/* Clone per-buffer values of buffer FROM.
Buffer TO gets the same per-buffer values as FROM, with the
swapfield (bidi_paragraph_cache, struct region_cache *);
current_buffer->prevent_redisplay_optimizations_p = 1;
other_buffer->prevent_redisplay_optimizations_p = 1;
- swapfield (overlays_before, struct Lisp_Overlay *);
- swapfield (overlays_after, struct Lisp_Overlay *);
- swapfield (overlay_center, ptrdiff_t);
+ swapfield (long_line_optimizations_p, bool_bf);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
+ swapfield_ (mark_active, Lisp_Object); /* Belongs with the `mark'. */
swapfield_ (enable_multibyte_characters, Lisp_Object);
swapfield_ (bidi_display_reordering, Lisp_Object);
swapfield_ (bidi_paragraph_direction, Lisp_Object);
/* Do this last, so it can calculate the new correspondences
between chars and bytes. */
+ /* FIXME: Is it worth the trouble, really? Couldn't we just throw
+ away all the text-properties instead of trying to guess how
+ to adjust them? AFAICT the result is not reliable anyway. */
set_intervals_multibyte (1);
+ set_overlays_multibyte (1);
}
if (!EQ (old_undo, Qt))
return Qnil;
}
- /* Make sure no local variables remain set up with buffer B
- for their current values. */
-
- static void
- swap_out_buffer_local_variables (struct buffer *b)
- {
- Lisp_Object oalist, alist, buffer;
-
- XSETBUFFER (buffer, b);
- oalist = BVAR (b, local_var_alist);
-
- for (alist = oalist; CONSP (alist); alist = XCDR (alist))
- {
- Lisp_Object sym = XCAR (XCAR (alist));
- eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
- /* Need not do anything if some other buffer's binding is
- now cached. */
- if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
- {
- /* Symbol is set up for this buffer's old local value:
- swap it out! */
- swap_in_global_binding (XSYMBOL (sym));
- }
- }
- }
-
\f
-/* Find all the overlays in the current buffer that contain position POS.
+/* Find all the overlays in the current buffer that overlap the range
+ [BEG, END).
+
+ If EMPTY is true, include empty overlays in that range and also at
+ END, provided END denotes the position at the end of the buffer.
+
Return the number found, and store them in a vector in *VEC_PTR.
Store in *LEN_PTR the size allocated for the vector.
Store in *NEXT_PTR the next position after POS where an overlay starts,
return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
}
- else if (INTEGERP (tem))
+void
+make_sortvec_item (struct sortvec *item, Lisp_Object overlay)
+{
+ Lisp_Object tem;
+ /* This overlay is good and counts: put it into sortvec. */
+ item->overlay = overlay;
+ item->beg = OVERLAY_START (overlay);
+ item->end = OVERLAY_END (overlay);
+ tem = Foverlay_get (overlay, Qpriority);
+ if (NILP (tem))
+ {
+ item->priority = 0;
+ item->spriority = 0;
+ }
- item->priority = XINT (tem);
++ else if (FIXNUMP (tem))
+ {
- item->priority = INTEGERP (car) ? XINT (car) : 0;
- item->spriority = INTEGERP (cdr) ? XINT (cdr) : 0;
++ item->priority = XFIXNUM (tem);
+ item->spriority = 0;
+ }
+ else if (CONSP (tem))
+ {
+ Lisp_Object car = XCAR (tem);
+ Lisp_Object cdr = XCDR (tem);
++ item->priority = FIXNUMP (car) ? XFIXNUM (car) : 0;
++ item->spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0;
+ }
+}
/* Sort an array of overlays by priority. The array is modified in place.
The return value is the new size; this may be smaller than the original
size if some of the overlays were invalid or were window-specific. */
ptrdiff_t
overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
{
- Lisp_Object overlay, window, str;
- ptrdiff_t obegin, oend;
bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ struct interval_node *node;
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ buffer_overlay_iter_start (current_buffer,
+ pos - 1, pos + 1, ITREE_DESCENDING);
+ while ((node = buffer_overlay_iter_next (current_buffer)))
{
- overlay = node->data;
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
++ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- obegin = node->begin;
- oend = node->end;
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
++ ptrdiff_t startpos = node->begin;
++ ptrdiff_t endpos = node->end;
+
- if (oend != pos && obegin != pos)
+ if (endpos != pos && startpos != pos)
continue;
- window = Foverlay_get (overlay, Qwindow);
+ Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
- if (obegin == pos
+ Lisp_Object str;
+ if (startpos == pos
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
record_overlay_string (&overlay_heads, str,
- (obegin == oend
+ (startpos == endpos
? Foverlay_get (overlay, Qafter_string)
: Qnil),
Foverlay_get (overlay, Qpriority),
&& (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
record_overlay_string (&overlay_tails, str, Qnil,
Foverlay_get (overlay, Qpriority),
- oend - obegin);
+ endpos - startpos);
}
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
+ buffer_overlay_iter_finish (current_buffer);
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (startpos > pos)
- break;
- if (endpos != pos && startpos != pos)
- continue;
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
- Lisp_Object str;
- if (startpos == pos
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
- record_overlay_string (&overlay_heads, str,
- (startpos == endpos
- ? Foverlay_get (overlay, Qafter_string)
- : Qnil),
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- else if (endpos == pos
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
- record_overlay_string (&overlay_tails, str, Qnil,
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- }
if (overlay_tails.used > 1)
qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
cmp_for_strings);
The fifth arg REAR-ADVANCE, if non-nil, makes the marker
for the rear of the overlay advance when text is inserted there
\(which means the text *is* included in the overlay). */)
- (Lisp_Object begin, Lisp_Object end, Lisp_Object buffer,
+ (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
Lisp_Object front_advance, Lisp_Object rear_advance)
{
- Lisp_Object overlay;
+ Lisp_Object ov;
- ptrdiff_t obegin, oend;
struct buffer *b;
if (NILP (buffer))
else
CHECK_BUFFER (buffer);
- if (MARKERP (begin) && !EQ (Fmarker_buffer (begin), buffer))
- signal_error ("Marker points into wrong buffer", begin);
- if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
+ b = XBUFFER (buffer);
+ if (! BUFFER_LIVE_P (b))
+ error ("Attempt to create overlay in a dead buffer");
+
+ if (MARKERP (beg) && !BASE_EQ (Fmarker_buffer (beg), buffer))
+ signal_error ("Marker points into wrong buffer", beg);
+ if (MARKERP (end) && !BASE_EQ (Fmarker_buffer (end), buffer))
signal_error ("Marker points into wrong buffer", end);
- CHECK_NUMBER_COERCE_MARKER (begin);
- CHECK_NUMBER_COERCE_MARKER (end);
+ CHECK_FIXNUM_COERCE_MARKER (beg);
+ CHECK_FIXNUM_COERCE_MARKER (end);
- if (XINT (begin) > XINT (end))
+ if (XFIXNUM (beg) > XFIXNUM (end))
{
Lisp_Object temp;
- temp = begin; begin = end; end = temp;
+ temp = beg; beg = end; end = temp;
}
- obegin = clip_to_bounds (BEG, XINT (begin), b->text->z);
- oend = clip_to_bounds (obegin, XINT (end), b->text->z);
- ov = build_overlay (obegin, oend,
- b = XBUFFER (buffer);
-
- beg = Fset_marker (Fmake_marker (), beg, buffer);
- end = Fset_marker (Fmake_marker (), end, buffer);
-
- if (!NILP (front_advance))
- XMARKER (beg)->insertion_type = 1;
- if (!NILP (rear_advance))
- XMARKER (end)->insertion_type = 1;
-
- overlay = build_overlay (beg, end, Qnil);
-
- /* Put the new overlay on the wrong list. */
- end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < b->overlay_center)
- {
- eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
++ ptrdiff_t obeg = clip_to_bounds (BEG, XFIXNUM (beg), b->text->z);
++ ptrdiff_t oend = clip_to_bounds (obeg, XFIXNUM (end), b->text->z);
++ ov = build_overlay (obeg, oend,
+ ! NILP (front_advance),
+ ! NILP (rear_advance), Qnil);
+ add_buffer_overlay (b, XOVERLAY (ov));
/* We don't need to redisplay the region covered by the overlay, because
the overlay has no properties at the moment. */
bset_redisplay (buf);
- ++BUF_OVERLAY_MODIFF (buf);
+ modiff_incr (&BUF_OVERLAY_MODIFF (buf), 1);
}
-/* Remove OVERLAY from LIST. */
-
-static struct Lisp_Overlay *
-unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
-{
- register struct Lisp_Overlay *tail, **prev = &list;
-
- for (tail = list; tail; prev = &tail->next, tail = *prev)
- if (tail == overlay)
- {
- *prev = overlay->next;
- overlay->next = NULL;
- break;
- }
- return list;
-}
-
-/* Remove OVERLAY from both overlay lists of B. */
-
-static void
-unchain_both (struct buffer *b, Lisp_Object overlay)
-{
- struct Lisp_Overlay *ov = XOVERLAY (overlay);
-
- set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
- set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
- eassert (XOVERLAY (overlay)->next == NULL);
-}
-
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
{
ob = XBUFFER (obuffer);
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- unchain_both (ob, overlay);
+ o_beg = OVERLAY_START (overlay);
+ o_end = OVERLAY_END (overlay);
}
- else
- /* An overlay not associated with any buffer will normally have its
- `next' field set to NULL, but not always: when killing a buffer,
- we just set its overlays_after and overlays_before to NULL without
- manually setting each overlay's `next' field to NULL.
- Let's correct it here, to simplify subsequent assertions.
- FIXME: Maybe the better fix is to change `kill-buffer'!? */
- XOVERLAY (overlay)->next = NULL;
-
- eassert (XOVERLAY (overlay)->next == NULL);
+ if (! EQ (buffer, obuffer))
+ {
+ if (! NILP (obuffer))
+ remove_buffer_overlay (XBUFFER (obuffer), XOVERLAY (overlay));
+ add_buffer_overlay (XBUFFER (buffer), XOVERLAY (overlay));
+ }
/* Set the overlay boundaries, which may clip them. */
- set_overlay_region (XOVERLAY (overlay), XINT (beg), XINT (end));
- Fset_marker (OVERLAY_START (overlay), beg, buffer);
- Fset_marker (OVERLAY_END (overlay), end, buffer);
++ set_overlay_region (XOVERLAY (overlay), XFIXNUM (beg), XFIXNUM (end));
- n_beg = marker_position (OVERLAY_START (overlay));
- n_end = marker_position (OVERLAY_END (overlay));
+ n_beg = OVERLAY_START (overlay);
+ n_end = OVERLAY_END (overlay);
/* If the overlay has changed buffers, do a thorough redisplay. */
- if (!EQ (buffer, obuffer))
+ if (!BASE_EQ (buffer, obuffer))
{
/* Redisplay where the overlay was. */
if (ob)
/* Delete the overlay if it is empty after clipping and has the
evaporate property. */
if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
- return unbind_to (count, Fdelete_overlay (overlay));
+ { /* We used to call `Fdelete_overlay' here, but it causes problems:
+ - At this stage, `overlay' is not included in its buffer's lists
+ of overlays (the data-structure is in an inconsistent state),
+ contrary to `Fdelete_overlay's assumptions.
+ - Most of the work done by Fdelete_overlay has already been done
+ here for other reasons. */
- drop_overlay (XBUFFER (buffer), XOVERLAY (overlay));
++ drop_overlay (XOVERLAY (overlay));
+ return unbind_to (count, overlay);
+ }
- /* Put the overlay into the new buffer's overlay lists, first on the
- wrong list. */
- if (n_end < b->overlay_center)
- {
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
-
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
-
return unbind_to (count, overlay);
}
doc: /* Delete the overlay OVERLAY from its buffer. */)
(Lisp_Object overlay)
{
- Lisp_Object buffer;
struct buffer *b;
- ptrdiff_t count = SPECPDL_INDEX ();
+ specpdl_ref count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return make_number (OVERLAY_START (overlay));
- return (Fmarker_position (OVERLAY_START (overlay)));
++ return make_fixnum (OVERLAY_START (overlay));
}
DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return make_number (OVERLAY_END (overlay));
- return (Fmarker_position (OVERLAY_END (overlay)));
++ return make_fixnum (OVERLAY_END (overlay));
}
DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
- noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, NULL);
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- NULL, NULL, 0);
++ noverlays = overlays_at (XFIXNUM (pos), true, &overlay_vec, &len, NULL);
if (!NILP (sorted))
noverlays = sort_overlays (overlay_vec, noverlays,
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
- noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len, true, NULL);
+ noverlays = overlays_in (XFIXNUM (beg), XFIXNUM (end), 1, &overlay_vec, &len,
- NULL, NULL);
++ true, NULL);
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
the value is (point-max). */)
(Lisp_Object pos)
{
- CHECK_NUMBER_COERCE_MARKER (pos);
- ptrdiff_t i, len, noverlays;
- ptrdiff_t endpos;
- Lisp_Object *overlay_vec;
-
+ CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
- return make_number (ZV);
+ return make_fixnum (ZV);
- return make_number (next_overlay_change (XINT (pos)));
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- endpos gets the position where the next overlay starts. */
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- &endpos, 0, 1);
-
- /* If any of these overlays ends before endpos,
- use its ending point instead. */
- for (i = 0; i < noverlays; i++)
- {
- Lisp_Object oend;
- ptrdiff_t oendpos;
-
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
-
- xfree (overlay_vec);
- return make_fixnum (endpos);
++ return make_fixnum (next_overlay_change (XFIXNUM (pos)));
}
DEFUN ("previous-overlay-change", Fprevious_overlay_change,
the value is (point-min). */)
(Lisp_Object pos)
{
- ptrdiff_t prevpos;
- Lisp_Object *overlay_vec;
- ptrdiff_t len;
- CHECK_NUMBER_COERCE_MARKER (pos);
+ CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
- return make_number (BEGV);
+ return make_fixnum (BEGV);
- return make_number (previous_overlay_change (XINT (pos)));
- /* At beginning of buffer, we know the answer;
- avoid bug subtracting 1 below. */
- if (XFIXNUM (pos) == BEGV)
- return pos;
-
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- prevpos gets the position of the previous change. */
- overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- 0, &prevpos, 1);
-
- xfree (overlay_vec);
- return make_fixnum (prevpos);
++ return make_fixnum (previous_overlay_change (XFIXNUM (pos)));
}
+
\f
/* These functions are for debugging overlays. */
for positions far away from POS). */)
(Lisp_Object pos)
{
- CHECK_NUMBER_COERCE_MARKER (pos);
- ptrdiff_t p;
+ CHECK_FIXNUM_COERCE_MARKER (pos);
-
- p = clip_to_bounds (PTRDIFF_MIN, XFIXNUM (pos), PTRDIFF_MAX);
- recenter_overlay_lists (current_buffer, p);
+ /* Noop */
return Qnil;
}
\f
if (!after)
{
- EMACS_INT begin_arg = XFASTINT (start);
- EMACS_INT end_arg = XFASTINT (end);
+ struct interval_node *node;
++ EMACS_INT begin_arg = XFIXNUM (start);
++ EMACS_INT end_arg = XFIXNUM (end);
/* We are being called before a change.
Scan the overlays to find the functions to call. */
last_overlay_modification_hooks_used = 0;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (start) > endpos)
- break;
- startpos = OVERLAY_POSITION (ostart);
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- /* Test for intersecting intervals. This does the right thing
- for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
- {
- Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- }
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
+ if (! current_buffer->overlays)
+ return;
+ buffer_overlay_iter_start (current_buffer,
+ begin_arg - (insertion ? 1 : 0),
+ end_arg + (insertion ? 1 : 0),
+ ITREE_ASCENDING);
+ while ((node = buffer_overlay_iter_next (current_buffer)))
{
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- startpos = OVERLAY_POSITION (ostart);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (end) < startpos)
- break;
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
+ Lisp_Object overlay = node->data;
+ ptrdiff_t obegin = OVERLAY_START (overlay);
+ ptrdiff_t oend = OVERLAY_END (overlay);
- Lisp_Object prop;
+
+ if (insertion && (begin_arg == obegin
+ || end_arg == obegin))
{
- prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
+ Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
if (!NILP (prop))
add_overlay_mod_hooklist (prop, overlay);
}
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
+ if (insertion && (begin_arg == oend
+ || end_arg == oend))
{
- prop = Foverlay_get (overlay, Qinsert_behind_hooks);
+ Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
if (!NILP (prop))
add_overlay_mod_hooklist (prop, overlay);
}
/* Test for intersecting intervals. This does the right thing
for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
+ if (! insertion || (end_arg > obegin && begin_arg < oend))
{
- prop = Foverlay_get (overlay, Qmodification_hooks);
+ Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
if (!NILP (prop))
add_overlay_mod_hooklist (prop, overlay);
}
Lisp_Object prop_i, overlay_i;
prop_i = copy[i++];
overlay_i = copy[i++];
- call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
+ /* It is possible that the recorded overlay has been deleted
+ (which makes its markers' buffers be nil), or that (due to
+ some bug) it belongs to a different buffer. Only run this
+ hook if the overlay belongs to the current buffer. */
- if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
++ if (OVERLAY_BUFFER (overlay_i) == current_buffer)
+ call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
}
SAFE_FREE ();
defsubr (&Soverlay_put);
defsubr (&Srestore_buffer_modified_p);
- Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
+ DEFSYM (Qautosaved, "autosaved");
- }
+#ifdef ITREE_DEBUG
+ defsubr (&Soverlay_tree);
+#endif
- void
- keys_of_buffer (void)
- {
- initial_define_key (control_x_map, 'b', "switch-to-buffer");
- initial_define_key (control_x_map, 'k', "kill-buffer");
+
+ DEFSYM (Qkill_buffer__possibly_save, "kill-buffer--possibly-save");
+
+ DEFSYM (Qbuffer_stale_function, "buffer-stale-function");
+
+ Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
/* Header file for the buffer manipulation primitives.
- Copyright (C) 1985-1986, 1993-1995, 1997-2017 Free Software Foundation,
-Copyright (C) 1985-1986, 1993-1995, 1997-2022 Free Software Foundation,
--Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Non-zero whenever the narrowing is changed in this buffer. */
bool_bf clip_changed : 1;
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- struct Lisp_Overlay *overlays_before;
-
- /* List of overlays that end after the current center,
- in order of start-position. */
- struct Lisp_Overlay *overlays_after;
-
- /* Position where the overlay lists are centered. */
- ptrdiff_t overlay_center;
+ /* Non-zero for internal or temporary buffers that don't need to
+ run hooks kill-buffer-hook, kill-buffer-query-functions, and
+ buffer-list-update-hook. This is used in coding.c to avoid
+ slowing down en/decoding when a lot of these hooks are
+ defined, as well as by with-temp-buffer, for example. */
+ bool_bf inhibit_buffer_hooks : 1;
+
+ /* Non-zero when the buffer contains long lines and specific
+ display optimizations must be used. */
+ bool_bf long_line_optimizations_p : 1;
+
+ /* The inveral tree containing this buffer's overlays. */
+ struct interval_tree *overlays;
/* Changes in the buffer are recorded here for undo, and t means
don't record anything. This information belongs to the base
/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
If NEXTP is non-NULL, return next overlay there.
- See overlay_at arg CHANGE_REQ for meaning of CHRQ arg. */
+ See overlay_at arg CHANGE_REQ for meaning of CHRQ arg.
+ This macro might evaluate its args multiple times,
+ and it treat some args as lvalues. */
-#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
+#define GET_OVERLAYS_AT(posn, overlays, noverlays, next) \
do { \
ptrdiff_t maxlen = 40; \
SAFE_NALLOCA (overlays, 1, maxlen); \
INLINE bool
buffer_has_overlays (void)
{
- return current_buffer->overlays_before || current_buffer->overlays_after;
+ return current_buffer->overlays
+ && (interval_tree_size (current_buffer->overlays) > 0);
}
+ \f
+ /* Functions for accessing a character or byte,
+ or converting between byte positions and addresses,
+ in a specified buffer. */
/* Return character code of multi-byte form at byte position POS. If POS
doesn't point the head of valid multi-byte form, only the byte at
/* Overlays */
-/* Return the marker that stands for where OV starts in the buffer. */
+INLINE ptrdiff_t
+overlay_start (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return interval_node_begin (ov->buffer->overlays, ov->interval);
+}
-#define OVERLAY_START(OV) XOVERLAY (OV)->start
+INLINE ptrdiff_t
+overlay_end (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return interval_node_end (ov->buffer->overlays, ov->interval);
+}
-/* Return the marker that stands for where OV ends in the buffer. */
+INLINE void
+set_overlay_region (struct Lisp_Overlay *ov, ptrdiff_t begin, ptrdiff_t end)
+{
+ eassert (ov->buffer);
+ begin = clip_to_bounds (BEG, begin, ov->buffer->text->z);
+ end = clip_to_bounds (begin, end, ov->buffer->text->z);
+ interval_node_set_region (ov->buffer->overlays, ov->interval, begin, end);
+}
-#define OVERLAY_END(OV) XOVERLAY (OV)->end
+INLINE void
+maybe_alloc_buffer_overlays (struct buffer *b)
+{
+ if (! b->overlays)
+ b->overlays = interval_tree_create ();
+}
-/* Return the plist of overlay OV. */
+/* FIXME: Actually this does not free any overlay, but the tree
+ only. --ap */
-#define OVERLAY_PLIST(OV) XOVERLAY (OV)->plist
+INLINE void
+free_buffer_overlays (struct buffer *b)
+{
+ eassert (! b->overlays || 0 == interval_tree_size (b->overlays));
+ if (b->overlays)
+ {
+ interval_tree_destroy (b->overlays);
+ b->overlays = NULL;
+ }
+}
+
+INLINE void
+add_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ eassert (! ov->buffer);
+ maybe_alloc_buffer_overlays (b);
+ ov->buffer = b;
+ interval_tree_insert (b->overlays, ov->interval);
+}
+
+INLINE void
+remove_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ eassert (b->overlays);
+ eassert (ov->buffer == b);
+ interval_tree_remove (ov->buffer->overlays, ov->interval);
+ ov->buffer = NULL;
+}
-/* Return the actual buffer position for the marker P.
- We assume you know which buffer it's pointing into. */
+INLINE void
+buffer_overlay_iter_start (struct buffer *b, ptrdiff_t begin, ptrdiff_t end,
+ enum interval_tree_order order)
+{
+ if (b->overlays)
+ interval_tree_iter_start (b->overlays, begin, end, order);
+}
+
+INLINE struct interval_node*
+buffer_overlay_iter_next (struct buffer *b)
+{
+ if (! b->overlays)
+ return NULL;
+ return interval_tree_iter_next (b->overlays);
+}
+
+INLINE void
+buffer_overlay_iter_finish (struct buffer *b)
+{
+ if (b->overlays)
+ interval_tree_iter_finish (b->overlays);
+}
+
+INLINE void
+buffer_overlay_iter_narrow (struct buffer *b, ptrdiff_t begin, ptrdiff_t end)
+{
+ if (b->overlays)
+ interval_tree_iter_narrow (b->overlays, begin, end);
+}
+
+/* Return the start of OV in its buffer, or -1 if OV is not associated
+ with any buffer. */
- #define OVERLAY_START(OV) (overlay_start (XOVERLAY (OV)))
+ INLINE ptrdiff_t
-OVERLAY_POSITION (Lisp_Object p)
++OVERLAY_START (Lisp_Object ov)
++{
++ return overlay_start (XOVERLAY (ov));
++}
+
+/* Return the end of OV in its buffer, or -1. */
+
- #define OVERLAY_END(OV) (overlay_end (XOVERLAY (OV)))
++INLINE ptrdiff_t
++OVERLAY_END (Lisp_Object ov)
++{
++ return overlay_end (XOVERLAY (ov));
++}
+
+/* Return the plist of overlay OV. */
+
- #define OVERLAY_PLIST(OV) (XOVERLAY (OV)->plist)
++INLINE Lisp_Object
++OVERLAY_PLIST (Lisp_Object ov)
++{
++ return XOVERLAY (ov)->plist;
++}
+
+/* Return the buffer of overlay OV. */
+
- #define OVERLAY_BUFFER(OV) (XOVERLAY (OV)->buffer)
++INLINE struct buffer *
++OVERLAY_BUFFER (Lisp_Object ov)
++{
++ return XOVERLAY (ov)->buffer;
++}
+
+/* Return true, if OV's rear-advance is set. */
+
- #define OVERLAY_REAR_ADVANCE_P(OV) (XOVERLAY (OV)->interval->rear_advance)
++INLINE bool
++OVERLAY_REAR_ADVANCE_P (Lisp_Object ov)
+ {
- return marker_position (p);
++ return XOVERLAY (ov)->interval->rear_advance;
++}
+
+/* Return true, if OV's front-advance is set. */
+
- #define OVERLAY_FRONT_ADVANCE_P(OV) (XOVERLAY (OV)->interval->front_advance)
++INLINE bool
++OVERLAY_FRONT_ADVANCE_P (Lisp_Object ov)
++{
++ return XOVERLAY (ov)->interval->front_advance;
+ }
\f
/***********************************************************************
return !uppercasep (c) && upcase (c) != c;
}
+ /* Return a non-outlandish value for the tab width. */
+
+ INLINE int
+ sanitize_tab_width (Lisp_Object width)
+ {
+ return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000
+ ? XFIXNUM (width) : 8);
+ }
+
+ INLINE int
+ SANE_TAB_WIDTH (struct buffer *buf)
+ {
+ return sanitize_tab_width (BVAR (buf, tab_width));
+ }
+
+ /* Return a non-outlandish value for a character width. */
+
+ INLINE int
+ sanitize_char_width (EMACS_INT width)
+ {
+ return 0 <= width && width <= 1000 ? width : 1000;
+ }
+
+ /* Return the width of character C. The width is measured by how many
+ columns C will occupy on the screen when displayed in the current
+ buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
+ CHAR_WIDTH. */
+
+ INLINE int
+ CHARACTER_WIDTH (int c)
+ {
+ return (0x20 <= c && c < 0x7f ? 1
+ : 0x7f < c ? (sanitize_char_width
+ (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
+ : c == '\t' ? SANE_TAB_WIDTH (current_buffer)
+ : c == '\n' ? 0
+ : !NILP (BVAR (current_buffer, ctl_arrow)) ? 2 : 4);
+ }
+
+
+ /* Like fetch_string_char_advance, but fetch character from the current
+ buffer. */
+
+ INLINE int
+ fetch_char_advance (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+ {
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = *chp;
+ b++;
+ }
+ *charidx = c;
+ *byteidx = b;
+ return output;
+ }
+
+
+ /* Like fetch_char_advance, but assumes the current buffer is multibyte. */
+
+ INLINE int
+ fetch_char_advance_no_check (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+ {
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ *charidx = c;
+ *byteidx = b;
+ return output;
+ }
+
+ /* Return the number of bytes in the multibyte character in BUF
+ that starts at position POS_BYTE. This relies on the fact that
+ *GPT_ADDR and *Z_ADDR are always accessible and the values are
+ '\0'. No range checking of POS_BYTE. */
+
+ INLINE int
+ buf_next_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+ {
+ unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte);
+ return BYTES_BY_CHAR_HEAD (*chp);
+ }
+
+ INLINE int
+ next_char_len (ptrdiff_t pos_byte)
+ {
+ return buf_next_char_len (current_buffer, pos_byte);
+ }
+
+ /* Return the number of bytes in the multibyte character in BUF just
+ before POS_BYTE. No range checking of POS_BYTE. */
+
+ INLINE int
+ buf_prev_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+ {
+ unsigned char *chp
+ = (BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE
+ + (pos_byte <= BUF_GPT_BYTE (buf) ? 0 : BUF_GAP_SIZE (buf)));
+ return raw_prev_char_len (chp);
+ }
+
+ INLINE int
+ prev_char_len (ptrdiff_t pos_byte)
+ {
+ return buf_prev_char_len (current_buffer, pos_byte);
+ }
+
+ /* Increment both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+ INLINE void
+ inc_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+ {
+ (*charpos)++;
+ (*bytepos) += (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? next_char_len (*bytepos) : 1);
+ }
+
+ /* Decrement both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+ INLINE void
+ dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+ {
+ (*charpos)--;
+ (*bytepos) -= (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? prev_char_len (*bytepos) : 1);
+ }
+
INLINE_HEADER_END
+int compare_overlays (const void *v1, const void *v2);
+void make_sortvec_item (struct sortvec *item, Lisp_Object overlay);
+
#endif /* EMACS_BUFFER_H */
/* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
- Copyright (C) 1985-1987, 1989, 1993-2017 Free Software Foundation, Inc.
-Copyright (C) 1985-1987, 1989, 1993-2022 Free Software Foundation, Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Random utility Lisp functions.
- Copyright (C) 1985-1987, 1993-1995, 1997-2017 Free Software Foundation,
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
--Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
same size. */
if (ASIZE (o2) != size)
return false;
- /* Boolvectors are compared much like strings. */
- if (BOOL_VECTOR_P (o1))
+
+ /* Compare bignums, overlays, markers, and boolvectors
+ specially, by comparing their values. */
+ if (BIGNUMP (o1))
+ return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
+ if (OVERLAYP (o1))
{
- EMACS_INT size = bool_vector_size (o1);
- if (size != bool_vector_size (o2))
- return false;
- if (memcmp (bool_vector_data (o1), bool_vector_data (o2),
- bool_vector_bytes (size)))
- if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
- equal_kind, depth + 1, ht)
- || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
- equal_kind, depth + 1, ht))
++ if (OVERLAY_BUFFER (o1) != OVERLAY_BUFFER (o2)
++ || OVERLAY_START (o1) != OVERLAY_START (o2)
++ || OVERLAY_END (o1) != OVERLAY_END (o2))
return false;
- return true;
+ o1 = XOVERLAY (o1)->plist;
+ o2 = XOVERLAY (o2)->plist;
+ depth++;
+ goto tail_recurse;
}
- if (WINDOW_CONFIGURATIONP (o1))
+ if (MARKERP (o1))
{
- eassert (equal_kind != EQUAL_NO_QUIT);
- return compare_window_configurations (o1, o2, false);
+ return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
+ && (XMARKER (o1)->buffer == 0
+ || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
+ }
+ if (BOOL_VECTOR_P (o1))
+ {
+ EMACS_INT size = bool_vector_size (o1);
+ return (size == bool_vector_size (o2)
+ && !memcmp (bool_vector_data (o1), bool_vector_data (o2),
+ bool_vector_bytes (size)));
}
/* Aside from them, only true vectors, char-tables, compiled
switch (XTYPE (obj))
{
case_Lisp_Int:
- hash = XUINT (obj);
- break;
+ return XUFIXNUM (obj);
- case Lisp_Misc:
case Lisp_Symbol:
- hash = XHASH (obj);
- break;
+ return XHASH (obj);
case Lisp_String:
- hash = sxhash_string (SSDATA (obj), SBYTES (obj));
- break;
+ return sxhash_string (SSDATA (obj), SBYTES (obj));
- /* This can be everything from a vector to an overlay. */
case Lisp_Vectorlike:
- if (VECTORP (obj) || RECORDP (obj))
- /* According to the CL HyperSpec, two arrays are equal only if
- they are `eq', except for strings and bit-vectors. In
- Emacs, this works differently. We have to compare element
- by element. Same for records. */
- hash = sxhash_vector (obj, depth);
- else if (BOOL_VECTOR_P (obj))
- hash = sxhash_bool_vector (obj);
- else
- /* Others are `equal' if they are `eq', so let's take their
- address as hash. */
- hash = XHASH (obj);
- break;
+ {
+ enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
+ if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
+ {
+ /* According to the CL HyperSpec, two arrays are equal only if
+ they are 'eq', except for strings and bit-vectors. In
+ Emacs, this works differently. We have to compare element
+ by element. Same for pseudovectors that internal_equal
+ examines the Lisp contents of. */
+ return (SUB_CHAR_TABLE_P (obj)
+ /* 'sxhash_vector' can't be applies to a sub-char-table and
+ it's probably not worth looking into them anyway! */
+ ? 42
+ : sxhash_vector (obj, depth));
+ }
++ /* FIXME: Use `switch`. */
+ else if (pvec_type == PVEC_BIGNUM)
+ return sxhash_bignum (obj);
+ else if (pvec_type == PVEC_MARKER)
+ {
+ ptrdiff_t bytepos
+ = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
+ EMACS_UINT hash
+ = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
+ return SXHASH_REDUCE (hash);
+ }
+ else if (pvec_type == PVEC_BOOL_VECTOR)
+ return sxhash_bool_vector (obj);
+ else if (pvec_type == PVEC_OVERLAY)
+ {
- EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
- hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
++ EMACS_UINT hash = OVERLAY_START (obj);
++ hash = sxhash_combine (hash, OVERLAY_END (obj));
+ hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth));
+ return SXHASH_REDUCE (hash);
+ }
+ else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS)
+ return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1);
+ else
+ /* Others are 'equal' if they are 'eq', so take their
+ address as hash. */
+ return XHASH (obj);
+ }
case Lisp_Cons:
- hash = sxhash_list (obj, depth);
- break;
+ return sxhash_list (obj, depth);
case Lisp_Float:
- hash = sxhash_float (XFLOAT_DATA (obj));
- break;
+ return sxhash_float (XFLOAT_DATA (obj));
default:
emacs_abort ();
--- /dev/null
- /* Remove NODE from TREE and return it. NODE must exist in TREE.*/
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017 Andreas Politz (politza@hochschule-trier.de)
+
+This file is not part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <math.h>
+#include "lisp.h"
+#include "itree.h"
+
+/*
+ Intervals of the form [BEGIN, END), are stored as nodes inside a RB
+ tree, sorted by BEGIN . The core operation of this tree (besides
+ insert, remove, etc.) is finding all intervals intersecting with
+ some given interval. In order to perform this operation
+ efficiently, every node stores a third value called LIMIT. (See
+ https://en.wikipedia.org/wiki/Interval_tree#Augmented_tree and its
+ source Introduction to Algorithms (Section 14.3), Cormen et al. .)
+
+ ==== Finding intervals ====
+
+ If we search for all intervals intersecting with (X, Y], we look at
+ some node and test whether
+
+ NODE.BEGIN > Y
+
+ Due to the invariant of the search tree, we know, that we may
+ safely prune NODE's right subtree if this test succeeds, since all
+ intervals begin strictly after Y.
+
+ But we can not make such an assumptions about the left tree, since
+ all we know is that the intervals in this subtree must start before
+ or at NODE.BEGIN. So we can't tell, whether they end before X or
+ not. To solve this problem we add another attribute to each node,
+ called LIMIT.
+
+ The LIMIT of a node is the largest END value occurring in the nodes
+ subtree (including the node itself). Thus, we may look at the left
+ child of some NODE and test whether
+
+ NODE.left.LIMIT < X
+
+ and this tells us, if all intervals in the left subtree of NODE end
+ before X and if they can be pruned.
+
+ Conversely, if this inequality is false, the left subtree must
+ contain at least one intersecting interval, giving a resulting time
+ complexity of O(K*log(N)) for this operation, where K is the size
+ of the result set and N the size of the tree.
+
+ ==== Adjusting intervals ====
+
+ Since this data-structure will be used for overlays in an Emacs
+ buffer, a second core operation implements the ability to insert or
+ delete gaps in resp. from the tree. This models the insertion
+ resp. deletion of text in a buffer and the effects it may have on
+ the positions of overlays.
+
+ Consider this: Something gets inserted at position P into a buffer
+ and assume that all overlays occur strictly after P. Ordinarily,
+ we would have to iterate all overlays and increment their BEGIN and
+ END values accordingly (the insertion of text pushes them back).
+ In order to avoid this, we introduce yet another node attribute,
+ called OFFSET.
+
+ The OFFSET of some some subtree, represented by its root, is the
+ amount of shift that needs to be applied to its BEGIN, END and
+ LIMIT values, in order to get to the real values. Coming back to
+ the example, all we would need to do in this case, is to increment
+ the OFFSET of the tree's root, without any traversal of the tree
+ itself.
+
+ As a consequence, the real values of BEGIN, END and LIMIT of some
+ NODE need to be computed by incrementing them by the sum of NODE's
+ OFFSET and all of its ancestors offsets. Therefore, we store a
+ counter (otick) inside every node and also the tree, by which we
+ remember the fact, that a node's path to the root has no offsets
+ applied (i.e. its values are up to date). This is the case if some
+ node's value differs from the tree's one, the later of which is
+ incremented whenever some node's offset has changed.
+*/
+
+static struct interval_node *interval_tree_validate(struct interval_tree *, struct interval_node *);
+static void interval_generator_ensure_space(struct interval_generator *);
+static bool interval_node_intersects(const struct interval_node *, ptrdiff_t, ptrdiff_t);
+static int interval_tree_max_height(const struct interval_tree *);
+static struct interval_stack *interval_stack_create(intmax_t);
+static void interval_stack_destroy(struct interval_stack *);
+static void interval_stack_clear(struct interval_stack *);
+static void interval_stack_ensure_space(struct interval_stack *, intmax_t);
+static void interval_stack_push(struct interval_stack *, struct interval_node *);
+static void interval_stack_push_flagged(struct interval_stack *, struct interval_node *, bool);
+static struct interval_node *interval_stack_pop(struct interval_stack *);
+static void interval_tree_update_limit(const struct interval_tree *, struct interval_node *);
+static void interval_tree_inherit_offset(const struct interval_tree *, struct interval_node *);
+static void interval_tree_propagate_limit(const struct interval_tree *, struct interval_node *);
+static void interval_tree_rotate_left(struct interval_tree *, struct interval_node *);
+static void interval_tree_rotate_right(struct interval_tree *, struct interval_node *);
+static void interval_tree_insert_fix(struct interval_tree *, struct interval_node *);
+static void interval_tree_remove_fix(struct interval_tree *, struct interval_node *);
+static void interval_tree_transplant(struct interval_tree *, struct interval_node *, struct interval_node *);
+static struct interval_node *interval_tree_subtree_min(const struct interval_tree *, struct interval_node *);
+static struct interval_generator* interval_generator_create (struct interval_tree *);
+static void interval_generator_destroy (struct interval_generator *);
+static void interval_generator_reset (struct interval_generator *,
+ ptrdiff_t, ptrdiff_t,
+ enum interval_tree_order);
+static void
+interval_generator_narrow (struct interval_generator *g,
+ ptrdiff_t begin, ptrdiff_t end);
+static inline struct interval_node*
+interval_generator_next (struct interval_generator *g);
+static inline void interval_tree_iter_ensure_space(struct interval_tree *);
+
+
+
+/* +------------------------------------------------------------------------------------+ */
+
+/* Simple dynamic array. */
+struct interval_stack
+{
+ struct interval_node **nodes;
+ size_t size;
+ size_t length;
+};
+
+/* State used when iterating interval. */
+struct interval_generator
+{
+ struct interval_tree *tree;
+ struct interval_stack *stack;
+ ptrdiff_t begin;
+ ptrdiff_t end;
+ enum interval_tree_order order;
+};
+
+
+\f
+/* +===================================================================================+
+ * | Tree operations
+ * +===================================================================================+ */
+
+/* Initialize an allocated node. */
+
+void
+interval_node_init (struct interval_node *node,
+ ptrdiff_t begin, ptrdiff_t end,
+ bool front_advance, bool rear_advance,
+ Lisp_Object data)
+{
+ node->begin = begin;
+ node->end = max (begin, end);
+ node->front_advance = front_advance;
+ node->rear_advance = rear_advance;
+ node->data = data;
+}
+
+/* Return NODE's begin value, computing it if necessary. */
+
+ptrdiff_t
+interval_node_begin (struct interval_tree *tree,
+ struct interval_node *node)
+{
+ interval_tree_validate (tree, node);
+ return node->begin;
+}
+
+/* Return NODE's end value, computing it if necessary. */
+
+ptrdiff_t
+interval_node_end (struct interval_tree *tree,
+ struct interval_node *node)
+{
+ interval_tree_validate (tree, node);
+ return node->end;
+}
+
+/* Safely modify a node's interval. */
+
+void
+interval_node_set_region (struct interval_tree *tree,
+ struct interval_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ interval_tree_validate (tree, node);
+ if (begin != node->begin)
+ {
+ interval_tree_remove (tree, node);
+ node->begin = min (begin, PTRDIFF_MAX - 1);
+ node->end = max (node->begin, end);
+ interval_tree_insert (tree, node);
+ }
+ else if (end != node->end)
+ {
+ node->end = max (node->begin, end);
+ interval_tree_propagate_limit (tree, node);
+ }
+}
+
+/* Allocate an interval_tree. Free with interval_tree_destroy. */
+
+struct interval_tree*
+interval_tree_create (void)
+{
+ struct interval_tree *tree = xmalloc (sizeof (*tree));
+ interval_tree_clear (tree);
+ tree->iter = interval_generator_create (tree);
+ return tree;
+}
+
+/* Reset the tree TREE to its empty state. */
+
+void
+interval_tree_clear (struct interval_tree *tree)
+{
+ struct interval_node *nil = &tree->nil;
+ nil->left = nil->right = nil->parent = nil;
+ nil->offset = nil->otick = 0;
+ nil->begin = PTRDIFF_MIN;
+ nil->end = PTRDIFF_MIN;
+ nil->limit = PTRDIFF_MIN; /* => max(x, nil.limit) = x */
+ nil->color = ITREE_BLACK;
+ tree->root = nil;
+ tree->otick = 1;
+ tree->size = 0;
+ tree->iter_running = 0;
+}
+
+#ifdef ITREE_TESTING
+/* Initialize a pre-allocated tree (presumably on the stack). */
+
+static void
+interval_tree_init (struct interval_tree *tree)
+{
+ interval_tree_clear (tree);
+ tree->iter = interval_generator_create (tree);
+}
+#endif
+
+/* Release a tree, freeing its allocated memory. */
+void
+interval_tree_destroy (struct interval_tree *tree)
+{
+ if (! tree)
+ return;
+ if (tree->iter)
+ interval_generator_destroy (tree->iter);
+ xfree (tree);
+}
+
+/* Return the number of nodes in TREE. */
+
+intmax_t
+interval_tree_size (struct interval_tree *tree)
+{
+ return tree->size;
+}
+
+/* Insert a NODE into the TREE.
+
+ Note, that inserting a node twice results in undefined behaviour.
+*/
+
+void
+interval_tree_insert (struct interval_tree *tree, struct interval_node *node)
+{
+ eassert (node && node->begin <= node->end && node != &tree->nil);
+
+ struct interval_node *parent = &tree->nil;
+ struct interval_node *child = tree->root;
+ ptrdiff_t offset = 0;
+
+ /* Find the insertion point, accumulate node's offset and update
+ ancestors limit values. */
+ while (child != &tree->nil)
+ {
+ parent = child;
+ offset += child->offset;
+ child->limit = max (child->limit, node->end - offset);
+ /* This suggests that nodes in the right subtree are strictly
+ greater. But this is not true due to later rotations. */
+ child = node->begin <= child->begin ? child->left : child->right;
+ }
+
+ /* Insert the node */
+ if (parent == &tree->nil)
+ tree->root = node;
+ else if (node->begin <= parent->begin)
+ parent->left = node;
+ else
+ parent->right = node;
+
+ /* Init the node */
+ node->parent = parent;
+ node->left = &tree->nil;
+ node->right = &tree->nil;
+ node->color = ITREE_RED;
+ node->offset = 0;
+ node->begin -= offset;
+ node->end -= offset;
+ node->limit = node->end;
+ node->otick = tree->otick - 1;
+
+ /* Fix/update the tree */
+ ++tree->size;
+ interval_tree_insert_fix (tree, node);
+ interval_tree_iter_ensure_space (tree);
+}
+
+/* Return true, if NODE is a member of TREE. */
+
+bool
+interval_tree_contains (struct interval_tree *tree, struct interval_node *node)
+{
+ struct interval_node *other;
+
+ interval_tree_iter_start (tree, node->begin, PTRDIFF_MAX, ITREE_ASCENDING);
+ while ((other = interval_tree_iter_next (tree)))
+ if (other == node)
+ break;
+
+ interval_tree_iter_finish (tree);
+ return other == node;
+}
+
++/* Remove NODE from TREE and return it. NODE must exist in TREE. */
+
+struct interval_node*
+interval_tree_remove (struct interval_tree *tree, struct interval_node *node)
+{
+ eassert (interval_tree_contains (tree, node));
+
+ struct interval_node *broken = NULL;
+
+ interval_tree_inherit_offset (tree, node);
+ if (node->left == &tree->nil || node->right == &tree->nil)
+ {
+ struct interval_node *subst =
+ (node->right == &tree->nil) ? node->left : node->right;
+ if (node->color == ITREE_BLACK)
+ broken = subst;
+ interval_tree_transplant (tree, subst, node);
+ interval_tree_propagate_limit (tree, subst);
+ }
+ else
+ {
+ struct interval_node *min = interval_tree_subtree_min (tree, node->right);
+ struct interval_node *min_right = min->right;
+
+ if (min->color == ITREE_BLACK)
+ broken = min->right;
+ if (min->parent == node)
+ min_right->parent = min; /* set parent, if min_right = nil */
+ else
+ {
+ interval_tree_transplant (tree, min->right, min);
+ min->right = node->right;
+ min->right->parent = min;
+ }
+ interval_tree_inherit_offset (tree, min);
+ interval_tree_transplant (tree, min, node);
+ min->left = node->left;
+ min->left->parent = min;
+ min->color = node->color;
+ interval_tree_propagate_limit (tree, min_right);
+ interval_tree_propagate_limit (tree, min);
+ }
+
+ if (broken)
+ interval_tree_remove_fix (tree, broken);
+
+ node->right = node->left = node->parent = NULL;
+ --tree->size;
+
+ eassert (tree->size == 0 || (tree->size > 0 && tree->root != &tree->nil));
+
+ return node;
+}
+
+static struct interval_node*
+interval_tree_validate (struct interval_tree *tree, struct interval_node *node)
+{
+
+ if (tree->otick == node->otick || node == &tree->nil)
+ return node;
+ if (node != tree->root)
+ interval_tree_validate (tree, node->parent);
+
+ interval_tree_inherit_offset (tree, node);
+ return node;
+}
+
+/* Fill memory pointed at via NODES with all nodes of TREE in the
+ given ORDER.
+
+ The size of NODES must be sufficiently large.
+ */
+
+void
+interval_tree_nodes (struct interval_tree *tree,
+ struct interval_node **nodes,
+ enum interval_tree_order order)
+{
+ struct interval_node *node;
+
+ interval_tree_iter_start (tree, PTRDIFF_MIN, PTRDIFF_MAX, order);
+ while ((node = interval_tree_iter_next (tree)))
+ {
+ *nodes = node;
+ ++nodes;
+ }
+ interval_tree_iter_finish (tree);
+}
+
+/* Start a generator iterating all intervals in [BEGIN,END) in the
+ given ORDER. Only one iterator per tree can be running at any
+ time.
+*/
+
+void
+interval_tree_iter_start (struct interval_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end,
+ enum interval_tree_order order)
+{
+ if (tree->iter_running)
+ emacs_abort ();
+ interval_generator_reset (tree->iter, begin, end, order);
+ tree->iter_running = 1;
+}
+
+/* Limit the search interval of the iterator to the given values. The
+ interval can only shrink, but never grow.*/
+
+inline void
+interval_tree_iter_narrow(struct interval_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ if (! tree->iter_running)
+ emacs_abort ();
+ interval_generator_narrow (tree->iter, begin, end);
+}
+
+/* Stop using the iterator. */
+
+void
+interval_tree_iter_finish (struct interval_tree *tree)
+{
+ if (! tree->iter_running)
+ emacs_abort ();
+ tree->iter_running = 0;
+}
+
+/* Return the next node of the iterator in the order given when it was
+ started; or NULL if there are no more nodes. */
+
+inline struct interval_node*
+interval_tree_iter_next (struct interval_tree *tree)
+{
+ if (! tree->iter_running)
+ emacs_abort ();
+ return interval_generator_next (tree->iter);
+}
+
+/* Ensure that the tree's iterator does not need to allocate space
+ until the tree grows in size. */
+
+static inline void
+interval_tree_iter_ensure_space (struct interval_tree *tree)
+{
+ interval_generator_ensure_space (tree->iter);
+}
+
+static int
+interval_tree_max_height (const struct interval_tree *tree)
+{
+ return 2 * log (tree->size + 1) / log (2) + 0.5;
+}
+
+\f
+/* +===================================================================================+
+ * | Insert/Delete Gaps
+ * +===================================================================================+ */
+
+/* Insert a gap at POS of length LENGTH expanding all intervals
+ intersecting it, while respecting their rear_advance and
+ front_advance setting. */
+
+void
+interval_tree_insert_gap (struct interval_tree *tree, ptrdiff_t pos, ptrdiff_t length)
+{
+ if (length <= 0 || tree->size == 0)
+ return;
+
+ /* FIXME: Don't allocate generator/stack anew every time. */
+
+ /* Nodes with front_advance starting at pos may mess up the tree
+ order, so we need to remove them first. */
+ struct interval_stack *saved = interval_stack_create (0);
+ struct interval_node *node = NULL;
+ interval_tree_iter_start (tree, pos, pos + 1, ITREE_PRE_ORDER);
+ while ((node = interval_tree_iter_next (tree)))
+ {
+ if (node->begin == pos && node->front_advance
+ && (node->begin != node->end || node->rear_advance))
+ interval_stack_push (saved, node);
+ }
+ interval_tree_iter_finish (tree);
+ for (int i = 0; i < saved->length; ++i)
+ interval_tree_remove (tree, saved->nodes[i]);
+
+
+ /* We can't use a generator here, because we can't effectively
+ narrow AND shift some subtree at the same time. */
+ const int size = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ interval_stack_push (stack, tree->root);
+ while ((node = interval_stack_pop (stack)))
+ {
+ /* Process in pre-order. */
+ interval_tree_inherit_offset (tree, node);
+ if (node->right != &tree->nil)
+ {
+ if (node->begin > pos)
+ {
+ /* All nodes in this subtree are shifted by length. */
+ node->right->offset += length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != &tree->nil
+ && pos <= node->left->limit + node->left->offset)
+ interval_stack_push (stack, node->left);
+
+ /* node->begin == pos implies no front-advance. */
+ if (node->begin > pos)
+ node->begin += length;
+ if (node->end > pos || (node->end == pos && node->rear_advance))
+ {
+ node->end += length;
+ interval_tree_propagate_limit (tree, node);
+ }
+ }
+ interval_stack_destroy (stack);
+
+ /* Reinsert nodes starting at POS having front-advance. */
+ while ((node = interval_stack_pop (saved)))
+ {
+ node->begin += length;
+ if (node->end != pos || node->rear_advance)
+ node->end += length;
+ interval_tree_insert (tree, node);
+ }
+
+ interval_stack_destroy (saved);
+}
+
+/* Delete a gap at POS of length LENGTH, contracting all intervals
+ intersecting it. */
+
+void
+interval_tree_delete_gap (struct interval_tree *tree, ptrdiff_t pos, ptrdiff_t length)
+{
+ if (length <= 0 || tree->size == 0)
+ return;
+
+ /* FIXME: Don't allocate stack anew every time. */
+
+ /* Can't use the generator here, because by decrementing begin, we
+ might unintentionally bring shifted nodes back into our search
+ space. */
+ const int size = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ struct interval_node *node;
+
+ interval_stack_push (stack, tree->root);
+ while ((node = interval_stack_pop (stack)))
+ {
+ interval_tree_inherit_offset (tree, node);
+ if (node->right != &tree->nil)
+ {
+ if (node->begin > pos + length)
+ {
+ /* Shift right subtree to the left. */
+ node->right->offset -= length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != &tree->nil
+ && pos <= node->left->limit + node->left->offset)
+ interval_stack_push (stack, node->left);
+
+ if (pos < node->begin)
+ node->begin = max (pos, node->begin - length);
+ if (node->end > pos)
+ {
+ node->end = max (pos , node->end - length);
+ interval_tree_propagate_limit (tree, node);
+ }
+ }
+ interval_stack_destroy (stack);
+}
+
+
+\f
+/* +===================================================================================+
+ * | Generator
+ * +===================================================================================+ */
+
+/* Allocate a new generator for TREE. */
+
+static struct interval_generator*
+interval_generator_create (struct interval_tree *tree)
+{
+ struct interval_generator *g = xmalloc (sizeof *g);
+ const int size = interval_tree_max_height (tree) + 1;
+
+ g->stack = interval_stack_create (size);
+ g->tree = tree;
+ interval_generator_reset (g, 1, 0, 0);
+ return g;
+}
+
+/* Reset generator G such that it iterates over intervals intersecting
+ with [BEGIN, END) in the given ORDER. */
+
+void
+interval_generator_reset (struct interval_generator *g,
+ ptrdiff_t begin, ptrdiff_t end,
+ enum interval_tree_order order)
+{
+ if (! g) return;
+
+ g->begin = begin;
+ g->end = end;
+ g->order = order;
+ interval_stack_clear (g->stack);
+ if (begin <= end && g->tree->size > 0)
+ interval_stack_push_flagged (g->stack, g->tree->root, false);
+}
+
+/* Allocate enough space for the tree of G in its current shape. */
+
+static inline void
+interval_generator_ensure_space (struct interval_generator *g)
+{
+ interval_stack_ensure_space (g->stack, interval_tree_max_height (g->tree) + 1);
+}
+
+/* Return true, if NODE's interval intersects with [BEGIN, END). */
+
+static inline bool
+interval_node_intersects (const struct interval_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ return (begin < node->end && node->begin < end)
+ || (node->begin == node->end && begin == node->begin);
+}
+
+/* Return the next node of G, or NULL if there is none. */
+
+inline struct interval_node*
+interval_generator_next (struct interval_generator *g)
+{
+ if (! g) return NULL;
+
+ struct interval_node * const nil = &g->tree->nil;
+ struct interval_node *node;
+
+ do {
+ node = interval_stack_pop (g->stack);
+
+ while (node && ! node->visited)
+ {
+ struct interval_node * const left = node->left;
+ struct interval_node * const right = node->right;
+
+ interval_tree_inherit_offset (g->tree, node);
+ switch (g->order)
+ {
+ case ITREE_ASCENDING:
+ if (right != nil && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ /* Node's children may still be off-set and we need to add it. */
+ if (left != nil && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ break;
+ case ITREE_DESCENDING:
+ if (left != nil && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ if (right != nil && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ break;
+ case ITREE_PRE_ORDER:
+ if (right != nil && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (left != nil && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ break;
+ }
+ node = interval_stack_pop (g->stack);
+ }
+ /* Node may have been invalidated by interval_generator_narrow
+ after it was pushed: Check if it still intersects. */
+ } while (node && ! interval_node_intersects (node, g->begin, g->end));
+
+ return node;
+}
+
+/* Limit G to the new interval [BEGIN, END), which must be a subset of
+ the current one. I.E. it can't grow on either side. */
+
+static inline void
+interval_generator_narrow (struct interval_generator *g,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ g->begin = max (begin, g->begin);
+ g->end = min (end, g->end);
+}
+
+/* Free the memory allocated for G. */
+
+void
+interval_generator_destroy (struct interval_generator *g)
+{
+ if (! g) return;
+ if (g->stack)
+ interval_stack_destroy (g->stack);
+ xfree (g);
+}
+
+\f
+/* +===================================================================================+
+ * | Stack
+ * +===================================================================================+ */
+
+/* This is just a simple dynamic array with stack semantics. */
+
+static struct interval_stack*
+interval_stack_create (intmax_t initial_size)
+{
+ struct interval_stack *stack = xmalloc (sizeof (struct interval_stack));
+ stack->size = max (0, initial_size);
+ stack->nodes = xmalloc (stack->size * sizeof (struct interval_node*));
+ stack->length = 0;
+ return stack;
+}
+
+static void
+interval_stack_destroy (struct interval_stack *stack)
+{
+ if (! stack)
+ return;
+ if (stack->nodes)
+ xfree (stack->nodes);
+ xfree (stack);
+}
+
+static void
+interval_stack_clear (struct interval_stack *stack)
+{
+ stack->length = 0;
+}
+
+static inline void
+interval_stack_ensure_space (struct interval_stack *stack, intmax_t nelements)
+{
+ if (nelements > stack->size)
+ {
+ stack->size = (nelements + 1) * 2;
+ stack->nodes = xrealloc (stack->nodes, stack->size * sizeof (*stack->nodes));
+ }
+}
+
+static inline void
+interval_stack_push (struct interval_stack *stack, struct interval_node *node)
+{
+ interval_stack_ensure_space (stack, stack->length + 1);
+ stack->nodes[stack->length] = node;
+ stack->length++;
+}
+
+/* Push NODE on the STACK, while settings its visited flag to FLAG. */
+
+static inline void
+interval_stack_push_flagged (struct interval_stack *stack,
+ struct interval_node *node, bool flag)
+{
+ interval_stack_push (stack, node);
+ node->visited = flag;
+}
+
+static inline struct interval_node*
+interval_stack_pop (struct interval_stack *stack)
+{
+ if (stack->length == 0)
+ return NULL;
+ return stack->nodes[--stack->length];
+}
+
+\f
+/* +===================================================================================+
+ * | Internal Functions
+ * +===================================================================================+ */
+
+/* Update NODE's limit attribute according to its children. */
+
+static void
+interval_tree_update_limit (const struct interval_tree *tree,
+ struct interval_node *node)
+{
+ if (node == &tree->nil)
+ return;
+
+ node->limit = max (node->end, max (node->left->limit + node->left->offset,
+ node->right->limit + node->right->offset));
+}
+
+/* Apply NODE's offset to its begin, end and limit values and
+ propagate it to its children.
+
+ Does nothing, if NODE is clean, i.e. NODE.otick = tree.otick .
+*/
+
+static void
+interval_tree_inherit_offset (const struct interval_tree *tree,
+ struct interval_node *node)
+{
+
+ if (node->otick == tree->otick)
+ return;
+
+ node->begin += node->offset;
+ node->end += node->offset;
+ node->limit += node->offset;
+ if (node->left != &tree->nil)
+ node->left->offset += node->offset;
+ if (node->right != &tree->nil)
+ node->right->offset += node->offset;
+ node->offset = 0;
+ if (node == tree->root || node->parent->otick == tree->otick)
+ node->otick = tree->otick;
+}
+
+/* Update limit of NODE and its ancestors. Stop when it becomes
+ stable, i.e. new_limit = old_limit.
+
+ NODE may also be the nil node, in which case its parent is
+ used. (This feature is due to the RB algorithm.)
+*/
+
+static void
+interval_tree_propagate_limit (const struct interval_tree *tree,
+ struct interval_node *node)
+{
+ if (node == &tree->nil)
+ node = node->parent;
+ if (node == &tree->nil)
+ return;
+
+ while (1) {
+ ptrdiff_t newlimit = max (node->end, max (node->left->limit + node->left->offset,
+ node->right->limit + node->right->offset));
+ if (newlimit == node->limit)
+ break;
+ node->limit = newlimit;
+ if (node == tree->root)
+ break;
+ node = node->parent;
+ }
+}
+
+/* Perform the familiar left-rotation on node NODE. */
+
+static void
+interval_tree_rotate_left (struct interval_tree *tree, struct interval_node *node)
+{
+ eassert (node->right != &tree->nil);
+
+ struct interval_node *right = node->right;
+
+ interval_tree_inherit_offset (tree, node);
+ interval_tree_inherit_offset (tree, right);
+
+ /* Turn right's left subtree into node's right subtree. */
+ node->right = right->left;
+ if (right->left != &tree->nil)
+ right->left->parent = node;
+
+ /* right's parent was node's parent. */
+ if (right != &tree->nil)
+ right->parent = node->parent;
+
+ /* Get the parent to point to right instead of node. */
+ if (node != tree->root)
+ {
+ if (node == node->parent->left)
+ node->parent->left = right;
+ else
+ node->parent->right = right;
+ }
+ else
+ tree->root = right;
+
+ /* Put node on right's left. */
+ right->left = node;
+ if (node != &tree->nil)
+ node->parent = right;
+
+ /* Order matters here. */
+ interval_tree_update_limit (tree, node);
+ interval_tree_update_limit (tree, right);
+}
+
+/* Perform the familiar right-rotation on node NODE. */
+
+static void
+interval_tree_rotate_right (struct interval_tree *tree, struct interval_node *node)
+{
+ eassert (tree && node && node->left != &tree->nil);
+
+ struct interval_node *left = node->left;
+
+ interval_tree_inherit_offset (tree, node);
+ interval_tree_inherit_offset (tree, left);
+
+ node->left = left->right;
+ if (left->right != &tree->nil)
+ left->right->parent = node;
+
+ if (left != &tree->nil)
+ left->parent = node->parent;
+ if (node != tree->root)
+ {
+ if (node == node->parent->right)
+ node->parent->right = left;
+ else
+ node->parent->left = left;
+ }
+ else
+ tree->root = left;
+
+ left->right = node;
+ if (node != &tree->nil)
+ node->parent = left;
+
+ interval_tree_update_limit (tree, left);
+ interval_tree_update_limit (tree, node);
+}
+
+/* Repair the tree after an insertion. Part of the RB-Tree
+ algorithm. */
+
+static void
+interval_tree_insert_fix (struct interval_tree *tree, struct interval_node *node)
+{
+ while (node->parent->color == ITREE_RED)
+ {
+ /* NODE is red and its parent is red. This is a violation of
+ red-black tree property #3. */
+
+ if (node->parent == node->parent->parent->left)
+ {
+ /* We're on the left side of our grandparent, and OTHER is
+ our "uncle". */
+ struct interval_node *uncle = node->parent->parent->right;
+
+ if (uncle->color == ITREE_RED) /* case 1.a */
+ {
+ /* Uncle and parent are red but should be black because
+ NODE is red. Change the colors accordingly and
+ proceed with the grandparent. */
+ node->parent->color = ITREE_BLACK;
+ uncle->color = ITREE_BLACK;
+ node->parent->parent->color = ITREE_RED;
+ node = node->parent->parent;
+ }
+ else
+ {
+ /* Parent and uncle have different colors; parent is
+ red, uncle is black. */
+ if (node == node->parent->right) /* case 2.a */
+ {
+ node = node->parent;
+ interval_tree_rotate_left (tree, node);
+ }
+ /* case 3.a */
+ node->parent->color = ITREE_BLACK;
+ node->parent->parent->color = ITREE_RED;
+ interval_tree_rotate_right (tree, node->parent->parent);
+ }
+ }
+ else
+ {
+ /* This is the symmetrical case of above. */
+ struct interval_node *uncle = node->parent->parent->left;
+
+ if (uncle->color == ITREE_RED) /* case 1.b */
+ {
+ node->parent->color = ITREE_BLACK;
+ uncle->color = ITREE_BLACK;
+ node->parent->parent->color = ITREE_RED;
+ node = node->parent->parent;
+ }
+ else
+ {
+ if (node == node->parent->left) /* case 2.b */
+ {
+ node = node->parent;
+ interval_tree_rotate_right (tree, node);
+ }
+ /* case 3.b */
+ node->parent->color = ITREE_BLACK;
+ node->parent->parent->color = ITREE_RED;
+ interval_tree_rotate_left (tree, node->parent->parent);
+ }
+ }
+ }
+
+ /* The root may have been changed to red due to the algorithm. Set
+ it to black so that property #5 is satisfied. */
+ tree->root->color = ITREE_BLACK;
+}
+
+/* Repair the tree after a deletion. Part of the RB-Tree
+ algorithm. */
+
+static void
+interval_tree_remove_fix (struct interval_tree *tree, struct interval_node *node)
+{
+ while (node != tree->root && node->color == ITREE_BLACK)
+ {
+ if (node == node->parent->left)
+ {
+ struct interval_node *other = node->parent->right;
+
+ if (other->color == ITREE_RED) /* case 1.a */
+ {
+ other->color = ITREE_BLACK;
+ node->parent->color = ITREE_RED;
+ interval_tree_rotate_left (tree, node->parent);
+ other = node->parent->right;
+ }
+
+ if (other->left->color == ITREE_BLACK /* 2.a */
+ && other->right->color == ITREE_BLACK)
+ {
+ other->color = ITREE_RED;
+ node = node->parent;
+ }
+ else
+ {
+ if (other->right->color == ITREE_BLACK) /* 3.a */
+ {
+ other->left->color = ITREE_BLACK;
+ other->color = ITREE_RED;
+ interval_tree_rotate_right (tree, other);
+ other = node->parent->right;
+ }
+ other->color = node->parent->color; /* 4.a */
+ node->parent->color = ITREE_BLACK;
+ other->right->color = ITREE_BLACK;
+ interval_tree_rotate_left (tree, node->parent);
+ node = tree->root;
+ }
+ }
+ else
+ {
+ struct interval_node *other = node->parent->left;
+
+ if (other->color == ITREE_RED) /* 1.b */
+ {
+ other->color = ITREE_BLACK;
+ node->parent->color = ITREE_RED;
+ interval_tree_rotate_right (tree, node->parent);
+ other = node->parent->left;
+ }
+
+ if (other->right->color == ITREE_BLACK /* 2.b */
+ && other->left->color == ITREE_BLACK)
+ {
+ other->color = ITREE_RED;
+ node = node->parent;
+ }
+ else
+ {
+ if (other->left->color == ITREE_BLACK) /* 3.b */
+ {
+ other->right->color = ITREE_BLACK;
+ other->color = ITREE_RED;
+ interval_tree_rotate_left (tree, other);
+ other = node->parent->left;
+ }
+
+ other->color = node->parent->color; /* 4.b */
+ node->parent->color = ITREE_BLACK;
+ other->left->color = ITREE_BLACK;
+ interval_tree_rotate_right (tree, node->parent);
+ node = tree->root;
+ }
+ }
+ }
+
+ node->color = ITREE_BLACK;
+}
+
+/* Link node SOURCE in DEST's place. */
+
+static void
+interval_tree_transplant (struct interval_tree *tree, struct interval_node *source,
+ struct interval_node *dest)
+{
+ eassert (tree && source && dest && dest != &tree->nil);
+
+ if (dest == tree->root)
+ tree->root = source;
+ else if (dest == dest->parent->left)
+ dest->parent->left = source;
+ else
+ dest->parent->right = source;
+
+ source->parent = dest->parent;
+}
+
+
+static struct interval_node*
+interval_tree_subtree_min (const struct interval_tree *tree, struct interval_node *node)
+{
+ if (node == &tree->nil)
+ return node;
+ while (node->left != &tree->nil)
+ node = node->left;
+ return node;
+}
+
+\f
+/* +===================================================================================+
+ * | Debugging
+ * +===================================================================================+ */
+
+/* See Foverlay_tree in buffer.c */
--- /dev/null
- void interval_node_init(struct interval_node *, ptrdiff_t, ptrdiff_t, bool, bool, Lisp_Object);
- ptrdiff_t interval_node_begin(struct interval_tree *, struct interval_node *);
- ptrdiff_t interval_node_end(struct interval_tree *, struct interval_node *);
- void interval_node_set_region(struct interval_tree *, struct interval_node *, ptrdiff_t, ptrdiff_t);
- struct interval_tree *interval_tree_create(void);
- void interval_tree_destroy(struct interval_tree *);
- intmax_t interval_tree_size(struct interval_tree *);
- void interval_tree_clear(struct interval_tree *);
- void interval_tree_insert(struct interval_tree *, struct interval_node *);
- bool interval_tree_contains(struct interval_tree *, struct interval_node *);
- struct interval_node *interval_tree_remove(struct interval_tree *, struct interval_node *);
- void interval_tree_iter_start(struct interval_tree *, ptrdiff_t, ptrdiff_t, enum interval_tree_order);
- void interval_tree_iter_narrow(struct interval_tree *, ptrdiff_t, ptrdiff_t);
- void interval_tree_iter_finish(struct interval_tree *);
- struct interval_node *interval_tree_iter_next(struct interval_tree *);
- void interval_tree_insert_gap(struct interval_tree *, ptrdiff_t, ptrdiff_t);
- void interval_tree_delete_gap(struct interval_tree *, ptrdiff_t, ptrdiff_t);
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017 Andreas Politz (politza@hochschule-trier.de)
+
+This file is not part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef ITREE_H
+#define ITREE_H
+#include <config.h>
+#include <stddef.h>
+#include <inttypes.h>
+
+/* The tree and node structs are mainly here, so they can be allocated.
+
+ NOTE: The only time where it is safe to modify node.begin and
+ node.end directly, is while the node is not part of any tree.
+
+ NOTE: It is safe to read node.begin and node.end directly, if the
+ node came from a generator, because it validates the nodes it
+ returns as a side-effect.
+*/
+
+struct interval_node;
+struct interval_node
+{
+ struct interval_node *parent;
+ struct interval_node *left;
+ struct interval_node *right;
+ ptrdiff_t begin; /* The beginning of this interval. */
+ ptrdiff_t end; /* The end of the interval. */
+ ptrdiff_t limit; /* The maximum end in this subtree. */
+ ptrdiff_t offset; /* The amount of shift to apply to this subtree. */
+ uintmax_t otick; /* offset modified tick */
+ Lisp_Object data; /* Exclusively used by the client. */
+ enum { ITREE_RED, ITREE_BLACK } color;
+ bool_bf visited : 1; /* For traversal via generator. */
+ bool_bf rear_advance : 1; /* Same as for marker and overlays. */
+ bool_bf front_advance : 1; /* Same as for marker and overlays. */
+};
+
+struct interval_tree
+{
+ struct interval_node *root;
+ struct interval_node nil; /* The tree's version of NULL. */
+ uintmax_t otick; /* offset tick, compared with node's otick. */
+ intmax_t size; /* Number of nodes in the tree. */
+ struct interval_generator *iter;
+ bool_bf iter_running : 1;
+};
+
+enum interval_tree_order {
+ ITREE_ASCENDING = 0,
+ ITREE_DEFLT_ORDER = 0,
+ ITREE_DESCENDING,
+ ITREE_PRE_ORDER,
+};
+
++void interval_node_init (struct interval_node *, ptrdiff_t, ptrdiff_t, bool, bool, Lisp_Object);
++ptrdiff_t interval_node_begin (struct interval_tree *, struct interval_node *);
++ptrdiff_t interval_node_end (struct interval_tree *, struct interval_node *);
++void interval_node_set_region (struct interval_tree *, struct interval_node *, ptrdiff_t, ptrdiff_t);
++struct interval_tree *interval_tree_create (void);
++void interval_tree_destroy (struct interval_tree *);
++intmax_t interval_tree_size (struct interval_tree *);
++void interval_tree_clear (struct interval_tree *);
++void interval_tree_insert (struct interval_tree *, struct interval_node *);
++bool interval_tree_contains (struct interval_tree *, struct interval_node *);
++struct interval_node *interval_tree_remove (struct interval_tree *, struct interval_node *);
++void interval_tree_iter_start (struct interval_tree *, ptrdiff_t, ptrdiff_t, enum interval_tree_order);
++void interval_tree_iter_narrow (struct interval_tree *, ptrdiff_t, ptrdiff_t);
++void interval_tree_iter_finish (struct interval_tree *);
++struct interval_node *interval_tree_iter_next (struct interval_tree *);
++void interval_tree_insert_gap (struct interval_tree *, ptrdiff_t, ptrdiff_t);
++void interval_tree_delete_gap (struct interval_tree *, ptrdiff_t, ptrdiff_t);
+void interval_tree_nodes (struct interval_tree *tree, struct interval_node **nodes, enum interval_tree_order order);
+#endif
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*-
- Copyright (C) 1985-1987, 1993-1995, 1997-2017 Free Software Foundation,
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
--Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
- next fields of start and end markers (singly linked list of markers).
I.e. 9words plus 2 bits, 3words of which are for external linked lists.
*/
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
- bool_bf gcmarkbit : 1;
- unsigned spacer : 15;
- Lisp_Object plist;
- struct buffer *buffer; /* eassert (live buffer || NULL). */
- struct interval_node *interval;
- };
-
- /* Number of bits needed to store one of the values
- SAVE_UNUSED..SAVE_OBJECT. */
- enum { SAVE_SLOT_BITS = 3 };
-
- /* Number of slots in a save value where save_type is nonzero. */
- enum { SAVE_VALUE_SLOTS = 4 };
-
- /* Bit-width and values for struct Lisp_Save_Value's save_type member. */
-
- enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 };
-
- /* Types of data which may be saved in a Lisp_Save_Value. */
-
- enum Lisp_Save_Type
{
- SAVE_UNUSED,
- SAVE_INTEGER,
- SAVE_FUNCPOINTER,
- SAVE_POINTER,
- SAVE_OBJECT,
- SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_INT_INT_INT
- = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)),
- SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
- = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS),
- SAVE_TYPE_FUNCPTR_PTR_OBJ
- = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS),
-
- /* This has an extra bit indicating it's raw memory. */
- SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1))
- };
-
- /* SAVE_SLOT_BITS must be large enough to represent these values. */
- verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER
- | SAVE_POINTER | SAVE_OBJECT)
- >> SAVE_SLOT_BITS)
- == 0);
-
- /* Special object used to hold a different values for later use.
-
- This is mostly used to package C integers and pointers to call
- record_unwind_protect when two or more values need to be saved.
- For example:
-
- ...
- struct my_data *md = get_my_data ();
- ptrdiff_t mi = get_my_integer ();
- record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
- ...
-
- Lisp_Object my_unwind (Lisp_Object arg)
- {
- struct my_data *md = XSAVE_POINTER (arg, 0);
- ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
- ...
- }
-
- If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
- saved objects and raise eassert if type of the saved object doesn't match
- the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
- and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
- slot 0 is a pointer. */
-
- typedef void (*voidfuncptr) (void);
+ union vectorlike_header header;
- Lisp_Object start;
- Lisp_Object end;
+ Lisp_Object plist;
- struct Lisp_Overlay *next;
++ struct buffer *buffer; /* eassert (live buffer || NULL). */
++ struct interval_node *interval;
+ } GCALIGNED_STRUCT;
- struct Lisp_Save_Value
+ struct Lisp_Misc_Ptr
{
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- bool_bf gcmarkbit : 1;
- unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
-
- /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
- V's data entries are determined by V->save_type. E.g., if
- V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
- V->data[1] is an integer, and V's other data entries are unused.
-
- If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
- a memory area containing V->data[1].integer potential Lisp_Objects. */
- ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
- union {
- void *pointer;
- voidfuncptr funcpointer;
- ptrdiff_t integer;
- Lisp_Object object;
- } data[SAVE_VALUE_SLOTS];
- };
-
- INLINE bool
- SAVE_VALUEP (Lisp_Object x)
- {
- return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
- }
+ union vectorlike_header header;
+ void *pointer;
+ } GCALIGNED_STRUCT;
+
+ extern Lisp_Object make_misc_ptr (void *);
+
+ /* A mint_ptr object OBJ represents a C-language pointer P efficiently.
+ Preferably (and typically), OBJ is a fixnum I such that
+ XFIXNUMPTR (I) == P, as this represents P within a single Lisp value
+ without requiring any auxiliary memory. However, if P would be
+ damaged by being tagged as an integer and then untagged via
+ XFIXNUMPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P.
+
+ mint_ptr objects are efficiency hacks intended for C code.
+ Although xmint_ptr can be given any mint_ptr generated by non-buggy
+ C code, it should not be given a mint_ptr generated from Lisp code
+ as that would allow Lisp code to coin pointers from integers and
+ could lead to crashes. To package a C pointer into a Lisp-visible
+ object you can put the pointer into a pseudovector instead; see
+ Lisp_User_Ptr for an example. */
- INLINE struct Lisp_Save_Value *
- XSAVE_VALUE (Lisp_Object a)
+ INLINE Lisp_Object
+ make_mint_ptr (void *a)
{
- eassert (SAVE_VALUEP (a));
- return XUNTAG (a, Lisp_Misc);
+ Lisp_Object val = TAG_PTR (Lisp_Int0, a);
+ return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a);
}
- /* Return the type of V's Nth saved value. */
- INLINE int
- save_type (struct Lisp_Save_Value *v, int n)
+ INLINE bool
+ mint_ptrp (Lisp_Object x)
{
- eassert (0 <= n && n < SAVE_VALUE_SLOTS);
- return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
+ return FIXNUMP (x) || PSEUDOVECTORP (x, PVEC_MISC_PTR);
}
- /* Get and set the Nth saved pointer. */
-
INLINE void *
- XSAVE_POINTER (Lisp_Object obj, int n)
- {
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- return XSAVE_VALUE (obj)->data[n].pointer;
- }
- INLINE void
- set_save_pointer (Lisp_Object obj, int n, void *val)
- {
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- XSAVE_VALUE (obj)->data[n].pointer = val;
- }
- INLINE voidfuncptr
- XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
- {
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER);
- return XSAVE_VALUE (obj)->data[n].funcpointer;
- }
-
- /* Likewise for the saved integer. */
-
- INLINE ptrdiff_t
- XSAVE_INTEGER (Lisp_Object obj, int n)
+ xmint_pointer (Lisp_Object a)
{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- return XSAVE_VALUE (obj)->data[n].integer;
+ eassert (mint_ptrp (a));
+ if (FIXNUMP (a))
+ return XFIXNUMPTR (a);
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer;
}
- INLINE void
- set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
- {
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- XSAVE_VALUE (obj)->data[n].integer = val;
- }
-
- /* Extract Nth saved object. */
- INLINE Lisp_Object
- XSAVE_OBJECT (Lisp_Object obj, int n)
+ struct Lisp_Sqlite
{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
- return XSAVE_VALUE (obj)->data[n].object;
- }
+ union vectorlike_header header;
+ void *db;
+ void *stmt;
+ char *name;
+ void (*finalizer) (void *);
+ bool eof;
+ bool is_statement;
+ } GCALIGNED_STRUCT;
- #ifdef HAVE_MODULES
struct Lisp_User_Ptr
{
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */
- bool_bf gcmarkbit : 1;
- unsigned spacer : 15;
-
+ union vectorlike_header header;
void (*finalizer) (void *);
void *p;
- };
- #endif
+ } GCALIGNED_STRUCT;
/* A finalizer sentinel. */
struct Lisp_Finalizer
extern bool gc_in_progress;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
- extern ptrdiff_t inhibit_garbage_collection (void);
- extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
- extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
- extern Lisp_Object make_save_ptr (void *);
- extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
- extern Lisp_Object make_save_ptr_ptr (void *, void *);
- extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
- Lisp_Object);
- extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
- extern void free_save_value (Lisp_Object);
+ extern specpdl_ref inhibit_garbage_collection (void);
+ extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object);
-extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
+extern Lisp_Object build_overlay (ptrdiff_t, ptrdiff_t, bool, bool, Lisp_Object);
- extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
extern void init_alloc (void);
--- /dev/null
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882)
+ /* Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+ This file is part of GNU Emacs.
+
+ GNU Emacs is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+ #include <config.h>
+
+ #include <errno.h>
+ #include <fcntl.h>
+ #include <limits.h>
+ #include <math.h>
+ #include <stdarg.h>
+ #include <stdint.h>
+ #include <stdlib.h>
+ #include <sys/mman.h>
+ #include <sys/param.h>
+ #include <sys/stat.h>
+ #include <sys/types.h>
+ #include <unistd.h>
+
+ #include "blockinput.h"
+ #include "buffer.h"
+ #include "charset.h"
+ #include "coding.h"
+ #include "fingerprint.h"
+ #include "frame.h"
+ #include "intervals.h"
+ #include "lisp.h"
+ #include "pdumper.h"
+ #include "window.h"
+ #include "sysstdio.h"
+ #include "systime.h"
+ #include "thread.h"
+ #include "bignum.h"
+
+ #ifdef CHECK_STRUCTS
+ # include "dmpstruct.h"
+ #endif
+
+ /*
+ TODO:
+
+ - Two-pass dumping: first assemble object list, then write all.
+ This way, we can perform arbitrary reordering or maybe use fancy
+ graph algorithms to get better locality.
+
+ - Don't emit relocations that happen to set Emacs memory locations
+ to values they will already have.
+
+ - Nullify frame_and_buffer_state.
+
+ - Preferred base address for relocation-free non-PIC startup.
+
+ - Compressed dump support.
+
+ */
+
+ #ifdef HAVE_PDUMPER
+
+ #if GNUC_PREREQ (4, 7, 0)
+ # pragma GCC diagnostic error "-Wshadow"
+ #endif
+
+ #define VM_POSIX 1
+ #define VM_MS_WINDOWS 2
+
+ #if defined (HAVE_MMAP) && defined (MAP_FIXED)
+ # define VM_SUPPORTED VM_POSIX
+ # if !defined (MAP_POPULATE) && defined (MAP_PREFAULT_READ)
+ # define MAP_POPULATE MAP_PREFAULT_READ
+ # elif !defined (MAP_POPULATE)
+ # define MAP_POPULATE 0
+ # endif
+ #elif defined (WINDOWSNT)
+ /* Use a float infinity, to avoid compiler warnings in comparing vs
+ candidates' score. */
+ # undef INFINITY
+ # define INFINITY __builtin_inff ()
+ # include <windows.h>
+ # define VM_SUPPORTED VM_MS_WINDOWS
+ #else
+ # define VM_SUPPORTED 0
+ #endif
+
+ /* Require an architecture in which pointers, ptrdiff_t and intptr_t
+ are the same size and have the same layout, and where bytes have
+ eight bits --- that is, a general-purpose computer made after 1990.
+ Also require Lisp_Object to be at least as wide as pointers. */
+ verify (sizeof (ptrdiff_t) == sizeof (void *));
+ verify (sizeof (intptr_t) == sizeof (ptrdiff_t));
+ verify (sizeof (void (*) (void)) == sizeof (void *));
+ verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
+ verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
+ verify (CHAR_BIT == 8);
+
+ static size_t
+ divide_round_up (size_t x, size_t y)
+ {
+ return (x + y - 1) / y;
+ }
+
+ static const char dump_magic[16] = {
+ 'D', 'U', 'M', 'P', 'E', 'D',
+ 'G', 'N', 'U',
+ 'E', 'M', 'A', 'C', 'S'
+ };
+
+ static pdumper_hook dump_hooks[24];
+ static int nr_dump_hooks = 0;
+
+ static pdumper_hook dump_late_hooks[24];
+ static int nr_dump_late_hooks = 0;
+
+ static struct
+ {
+ void *mem;
+ int sz;
+ } remembered_data[32];
+ static int nr_remembered_data = 0;
+
+ typedef int_least32_t dump_off;
+ #define DUMP_OFF_MIN INT_LEAST32_MIN
+ #define DUMP_OFF_MAX INT_LEAST32_MAX
+ #define PRIdDUMP_OFF PRIdLEAST32
+
+ enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 };
+
+ static void ATTRIBUTE_FORMAT_PRINTF (1, 2)
+ dump_trace (const char *fmt, ...)
+ {
+ if (0)
+ {
+ va_list args;
+ va_start (args, fmt);
+ vfprintf (stderr, fmt, args);
+ va_end (args);
+ }
+ }
+
+ static ssize_t dump_read_all (int fd, void *buf, size_t bytes_to_read);
+
+ static dump_off
+ ptrdiff_t_to_dump_off (ptrdiff_t value)
+ {
+ eassert (DUMP_OFF_MIN <= value);
+ eassert (value <= DUMP_OFF_MAX);
+ return (dump_off) value;
+ }
+
+ /* Worst-case allocation granularity on any system that might load
+ this dump. */
+ static int
+ dump_get_max_page_size (void)
+ {
+ return 64 * 1024;
+ }
+
+ #define dump_offsetof(type, member) \
+ (ptrdiff_t_to_dump_off (offsetof (type, member)))
+
+ enum dump_reloc_type
+ {
+ /* dump_ptr = dump_ptr + emacs_basis() */
+ RELOC_DUMP_TO_EMACS_PTR_RAW,
+ /* dump_ptr = dump_ptr + dump_base */
+ RELOC_DUMP_TO_DUMP_PTR_RAW,
+ /* dump_mpz = [rebuild bignum] */
+ RELOC_NATIVE_COMP_UNIT,
+ RELOC_NATIVE_SUBR,
+ RELOC_BIGNUM,
+ /* dump_lv = make_lisp_ptr (dump_lv + dump_base,
+ type - RELOC_DUMP_TO_DUMP_LV)
+ (Special case for symbols: make_lisp_symbol)
+ Must be second-last. */
+ RELOC_DUMP_TO_DUMP_LV,
+ /* dump_lv = make_lisp_ptr (dump_lv + emacs_basis(),
+ type - RELOC_DUMP_TO_DUMP_LV)
+ (Special case for symbols: make_lisp_symbol.)
+ Must be last. */
+ RELOC_DUMP_TO_EMACS_LV = RELOC_DUMP_TO_DUMP_LV + 8,
+ };
+
+ enum emacs_reloc_type
+ {
+ /* Copy raw bytes from the dump into Emacs. The length field in
+ the emacs_reloc is the number of bytes to copy. */
+ RELOC_EMACS_COPY_FROM_DUMP,
+ /* Set a piece of memory in Emacs to a value we store directly in
+ this relocation. The length field contains the number of bytes
+ we actually copy into Emacs. */
+ RELOC_EMACS_IMMEDIATE,
+ /* Set an aligned pointer-sized object in Emacs to a pointer into
+ the loaded dump at the given offset. The length field is
+ always the machine word size. */
+ RELOC_EMACS_DUMP_PTR_RAW,
+ /* Set an aligned pointer-sized object in Emacs to point to
+ something also in Emacs. The length field is always
+ the machine word size. */
+ RELOC_EMACS_EMACS_PTR_RAW,
+ /* Set an aligned Lisp_Object in Emacs to point to a value in the
+ dump. The length field is the _tag type_ of the Lisp_Object,
+ not a byte count! */
+ RELOC_EMACS_DUMP_LV,
+ /* Set an aligned Lisp_Object in Emacs to point to a value in the
+ Emacs image. The length field is the _tag type_ of the
+ Lisp_Object, not a byte count! */
+ RELOC_EMACS_EMACS_LV,
+ };
+
+ enum
+ {
+ EMACS_RELOC_TYPE_BITS = 3,
+ EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT
+ - EMACS_RELOC_TYPE_BITS)
+ };
+
+ struct emacs_reloc
+ {
+ ENUM_BF (emacs_reloc_type) type : EMACS_RELOC_TYPE_BITS;
+ dump_off length : EMACS_RELOC_LENGTH_BITS;
+ dump_off emacs_offset;
+ union
+ {
+ dump_off dump_offset;
+ dump_off emacs_offset2;
+ intmax_t immediate;
+ } u;
+ };
+
+ /* Set the type of an Emacs relocation.
+
+ Also make sure that the type fits in the bitfield. */
+ static void
+ emacs_reloc_set_type (struct emacs_reloc *reloc,
+ enum emacs_reloc_type type)
+ {
+ reloc->type = type;
+ eassert (reloc->type == type);
+ }
+
+ struct dump_table_locator
+ {
+ /* Offset in dump, in bytes, of the first entry in the dump
+ table. */
+ dump_off offset;
+ /* Number of entries in the dump table. We need an explicit end
+ indicator (as opposed to a special sentinel) so we can efficiently
+ binary search over the relocation entries. */
+ dump_off nr_entries;
+ };
+
+ enum
+ {
+ DUMP_RELOC_TYPE_BITS = 5,
+ DUMP_RELOC_ALIGNMENT_BITS = 2,
+
+ /* Minimum alignment required by dump file format. */
+ DUMP_RELOCATION_ALIGNMENT = 1 << DUMP_RELOC_ALIGNMENT_BITS,
+
+ /* The alignment granularity (in bytes) for objects we store in the
+ dump. Always suitable for heap objects; may be more aligned. */
+ DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
+
+ DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS
+ };
+
+ verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
+ verify (DUMP_ALIGNMENT >= GCALIGNMENT);
+
+ struct dump_reloc
+ {
+ unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS;
+ ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS;
+ };
+ verify (sizeof (struct dump_reloc) == sizeof (dump_off));
+
+ /* Set the type of a dump relocation.
+
+ Also assert that the type fits in the bitfield. */
+ static void
+ dump_reloc_set_type (struct dump_reloc *reloc, enum dump_reloc_type type)
+ {
+ reloc->type = type;
+ eassert (reloc->type == type);
+ }
+
+ static dump_off
+ dump_reloc_get_offset (struct dump_reloc reloc)
+ {
+ return reloc.raw_offset << DUMP_RELOC_ALIGNMENT_BITS;
+ }
+
+ static void
+ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset)
+ {
+ eassert (offset >= 0);
+ reloc->raw_offset = offset >> DUMP_RELOC_ALIGNMENT_BITS;
+ if (dump_reloc_get_offset (*reloc) != offset)
+ error ("dump relocation out of range");
+ }
+
+ void
+ dump_fingerprint (FILE *output, char const *label,
+ unsigned char const xfingerprint[sizeof fingerprint])
+ {
+ enum { hexbuf_size = 2 * sizeof fingerprint };
+ char hexbuf[hexbuf_size];
+ hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint);
+ fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "",
+ hexbuf_size, hexbuf);
+ }
+
+ /* To be used if some order in the relocation process has to be enforced. */
+ enum reloc_phase
+ {
+ /* First to run. Place every relocation with no dependency here. */
+ EARLY_RELOCS,
+ /* Late and very late relocs are relocated at the very last after
+ all hooks has been run. All lisp machinery is at disposal
+ (memory allocation allowed too). */
+ LATE_RELOCS,
+ VERY_LATE_RELOCS,
+ /* Fake, must be last. */
+ RELOC_NUM_PHASES
+ };
+
+ /* Format of an Emacs dump file. All offsets are relative to
+ the beginning of the file. An Emacs dump file is coupled
+ to exactly the Emacs binary that produced it, so details of
+ alignment and endianness are unimportant.
+
+ An Emacs dump file contains the contents of the Lisp heap.
+ On startup, Emacs can start faster by mapping a dump file into
+ memory and using the objects contained inside it instead of
+ performing initialization from scratch.
+
+ The dump file can be loaded at arbitrary locations in memory, so it
+ includes a table of relocations that let Emacs adjust the pointers
+ embedded in the dump file to account for the location where it was
+ actually loaded.
+
+ Dump files can contain pointers to other objects in the dump file
+ or to parts of the Emacs binary. */
+ struct dump_header
+ {
+ /* File type magic. */
+ char magic[sizeof (dump_magic)];
+
+ /* Associated Emacs binary. */
+ unsigned char fingerprint[sizeof fingerprint];
+
+ /* Relocation table for the dump file; each entry is a
+ struct dump_reloc. */
+ struct dump_table_locator dump_relocs[RELOC_NUM_PHASES];
+
+ /* "Relocation" table we abuse to hold information about the
+ location and type of each lisp object in the dump. We need for
+ pdumper_object_type and ultimately for conservative GC
+ correctness. */
+ struct dump_table_locator object_starts;
+
+ /* Relocation table for Emacs; each entry is a struct
+ emacs_reloc. */
+ struct dump_table_locator emacs_relocs;
+
+ /* Start of sub-region of hot region that we can discard after load
+ completes. The discardable region ends at cold_start.
+
+ This region contains objects that we copy into the Emacs image at
+ dump-load time. */
+ dump_off discardable_start;
+
+ /* Start of the region that does not require relocations and that we
+ expect never to be modified. This region can be memory-mapped
+ directly from the backing dump file with the reasonable
+ expectation of taking few copy-on-write faults.
+
+ For correctness, however, this region must be modifible, since in
+ rare cases it is possible to see modifications to these bytes.
+ For example, this region contains string data, and it's
+ technically possible for someone to ASET a string character
+ (although nobody tends to do that).
+
+ The start of the cold region is always aligned on a page
+ boundary. */
+ dump_off cold_start;
+
+ /* Offset of a vector of the dumped hash tables. */
+ dump_off hash_list;
+ };
+
+ /* Double-ended singly linked list. */
+ struct dump_tailq
+ {
+ Lisp_Object head;
+ Lisp_Object tail;
+ intptr_t length;
+ };
+
+ /* Queue of objects to dump. */
+ struct dump_queue
+ {
+ /* Objects with no link weights at all. Kept in dump order. */
+ struct dump_tailq zero_weight_objects;
+ /* Objects with simple link weight: just one entry of type
+ WEIGHT_NORMAL. Score in this special case is non-decreasing as
+ position increases, so we can avoid the need to rescan a big list
+ for each object by storing these objects in order. */
+ struct dump_tailq one_weight_normal_objects;
+ /* Likewise, for objects with one WEIGHT_STRONG weight. */
+ struct dump_tailq one_weight_strong_objects;
+ /* List of objects with complex link weights --- i.e., not one of
+ the above cases. Order is irrelevant, since we scan the whole
+ list every time. Relatively few objects end up here. */
+ struct dump_tailq fancy_weight_objects;
+ /* Hash table of link weights: maps an object to a list of zero or
+ more (BASIS . WEIGHT) pairs. As a special case, an object with
+ zero weight is marked by Qt in the hash table --- this way, we
+ can distinguish objects we've seen but that have no weight from
+ ones that we haven't seen at all. */
+ Lisp_Object link_weights;
+ /* Hash table mapping object to a sequence number --- used to
+ resolve ties. */
+ Lisp_Object sequence_numbers;
+ dump_off next_sequence_number;
+ };
+
+ enum cold_op
+ {
+ COLD_OP_OBJECT,
+ COLD_OP_STRING,
+ COLD_OP_CHARSET,
+ COLD_OP_BUFFER,
+ COLD_OP_BIGNUM,
+ COLD_OP_NATIVE_SUBR,
+ };
+
+ /* This structure controls what operations we perform inside
+ dump_object. */
+ struct dump_flags
+ {
+ /* Actually write object contents to the dump. Without this flag
+ set, we still scan objects and enqueue pointed-to objects; making
+ this flag false is useful when we want to process an object's
+ referents normally, but dump an object itself separately,
+ later. */
+ bool_bf dump_object_contents : 1;
+ /* Record object starts. We turn this flag off when writing to the
+ discardable section so that we don't trick conservative GC into
+ thinking we have objects there. Ignored (we never record object
+ starts) if dump_object_contents is false. */
+ bool_bf record_object_starts : 1;
+ /* Pack objects tighter than GC memory alignment would normally
+ require. Useful for objects copied into the Emacs image instead
+ of used directly from the loaded dump.
+ */
+ bool_bf pack_objects : 1;
+ /* Sometimes we dump objects that we've already scanned for outbound
+ references to other objects. These objects should not cause new
+ objects to enter the object dumping queue. This flag causes Emacs
+ to assert that no new objects are enqueued while dumping. */
+ bool_bf assert_already_seen : 1;
+ /* Punt on unstable hash tables: defer them to ctx->deferred_hash_tables. */
+ bool_bf defer_hash_tables : 1;
+ /* Punt on symbols: defer them to ctx->deferred_symbols. */
+ bool_bf defer_symbols : 1;
+ /* Punt on cold objects: defer them to ctx->cold_queue. */
+ bool_bf defer_cold_objects : 1;
+ /* Punt on copied objects: defer them to ctx->copied_queue. */
+ bool_bf defer_copied_objects : 1;
+ };
+
+ /* Information we use while we dump. Note that we're not the garbage
+ collector and can operate under looser constraints: specifically,
+ we allocate memory during the dumping process. */
+ struct dump_context
+ {
+ /* Header we'll write to the dump file when done. */
+ struct dump_header header;
+ /* Data that will be written to the dump file. */
+ void *buf;
+ dump_off buf_size;
+ dump_off max_offset;
+
+ Lisp_Object old_purify_flag;
+ Lisp_Object old_post_gc_hook;
+ Lisp_Object old_process_environment;
+
+ #ifdef REL_ALLOC
+ bool blocked_ralloc;
+ #endif
+
+ /* File descriptor for dumpfile; < 0 if closed. */
+ int fd;
+ /* Name of dump file --- used for error reporting. */
+ Lisp_Object dump_filename;
+ /* Current offset in dump file. */
+ dump_off offset;
+
+ /* Starting offset of current object. */
+ dump_off obj_offset;
+
+ /* Flags currently in effect for dumping. */
+ struct dump_flags flags;
+
+ dump_off end_heap;
+
+ /* Hash mapping objects we've already dumped to their offsets. */
+ Lisp_Object objects_dumped;
+
+ /* Hash mapping objects to where we got them. Used for debugging. */
+ Lisp_Object referrers;
+ Lisp_Object current_referrer;
+ bool have_current_referrer;
+
+ /* Queue of objects to dump. */
+ struct dump_queue dump_queue;
+
+ /* Deferred object lists. */
+ Lisp_Object deferred_hash_tables;
+ Lisp_Object deferred_symbols;
+
+ /* Fixups in the dump file. */
+ Lisp_Object fixups;
+
+ /* Hash table of staticpro values: avoids double relocations. */
+ Lisp_Object staticpro_table;
+
+ /* Hash table mapping symbols to their pre-copy-queue fwd or blv
+ structures (which we dump immediately before the start of the
+ discardable section). */
+ Lisp_Object symbol_aux;
+ /* Queue of copied objects for special treatment. */
+ Lisp_Object copied_queue;
+ /* Queue of cold objects to dump. */
+ Lisp_Object cold_queue;
+
+ /* Relocations in the dump. */
+ Lisp_Object dump_relocs[RELOC_NUM_PHASES];
+
+ /* Object starts. */
+ Lisp_Object object_starts;
+
+ /* Relocations in Emacs. */
+ Lisp_Object emacs_relocs;
+
+ /* Hash table mapping bignums to their _data_ blobs, which we store
+ in the cold section. The actual Lisp_Bignum objects are normal
+ heap objects. */
+ Lisp_Object bignum_data;
+
+ /* List of hash tables that have been dumped. */
+ Lisp_Object hash_tables;
+
+ dump_off number_hot_relocations;
+ dump_off number_discardable_relocations;
+ };
+
+ /* These special values for use as offsets in dump_remember_object and
+ dump_recall_object indicate that the corresponding object isn't in
+ the dump yet (and so it has no valid offset), but that it's on one
+ of our to-be-dumped-later object queues (or that we haven't seen it
+ at all). All values must be non-positive, since positive values
+ are physical dump offsets. */
+ enum dump_object_special_offset
+ {
+ DUMP_OBJECT_IS_RUNTIME_MAGIC = -6,
+ DUMP_OBJECT_ON_COPIED_QUEUE = -5,
+ DUMP_OBJECT_ON_HASH_TABLE_QUEUE = -4,
+ DUMP_OBJECT_ON_SYMBOL_QUEUE = -3,
+ DUMP_OBJECT_ON_COLD_QUEUE = -2,
+ DUMP_OBJECT_ON_NORMAL_QUEUE = -1,
+ DUMP_OBJECT_NOT_SEEN = 0,
+ };
+
+ /* Weights for score scores for object non-locality. */
+
+ struct link_weight
+ {
+ /* Wrapped in a struct to break unwanted implicit conversion. */
+ int value;
+ };
+
+ static struct link_weight const
+ WEIGHT_NONE = { .value = 0 },
+ WEIGHT_NORMAL = { .value = 1000 },
+ WEIGHT_STRONG = { .value = 1200 };
+
+ \f
+ /* Dump file creation */
+
+ static void dump_grow_buffer (struct dump_context *ctx)
+ {
+ ctx->buf = xrealloc (ctx->buf, ctx->buf_size = (ctx->buf_size ?
+ (ctx->buf_size * 2)
+ : 8 * 1024 * 1024));
+ }
+
+ static dump_off dump_object (struct dump_context *ctx, Lisp_Object object);
+ static dump_off dump_object_for_offset (struct dump_context *ctx,
+ Lisp_Object object);
+
+ /* Like the Lisp function `push'. Return NEWELT. */
+ static Lisp_Object
+ dump_push (Lisp_Object *where, Lisp_Object newelt)
+ {
+ *where = Fcons (newelt, *where);
+ return newelt;
+ }
+
+ /* Like the Lisp function `pop'. */
+ static Lisp_Object
+ dump_pop (Lisp_Object *where)
+ {
+ Lisp_Object ret = XCAR (*where);
+ *where = XCDR (*where);
+ return ret;
+ }
+
+ static bool
+ dump_tracking_referrers_p (struct dump_context *ctx)
+ {
+ return !NILP (ctx->referrers);
+ }
+
+ static void
+ dump_set_have_current_referrer (struct dump_context *ctx, bool have)
+ {
+ #ifdef ENABLE_CHECKING
+ ctx->have_current_referrer = have;
+ #endif
+ }
+
+ /* Return true if objects should be enqueued in CTX to refer to an
+ object that the caller should store into CTX->current_referrer.
+
+ Until dump_clear_referrer is called, any objects enqueued are being
+ enqueued because the object refers to them. It is not valid to
+ enqueue objects without a referrer set. We check this constraint
+ at runtime.
+
+ It is invalid to call dump_set_referrer twice without an
+ intervening call to dump_clear_referrer. */
+ static bool
+ dump_set_referrer (struct dump_context *ctx)
+ {
+ eassert (!ctx->have_current_referrer);
+ dump_set_have_current_referrer (ctx, true);
+ return dump_tracking_referrers_p (ctx);
+ }
+
+ /* Unset the referrer that dump_set_referrer prepared for. */
+ static void
+ dump_clear_referrer (struct dump_context *ctx)
+ {
+ eassert (ctx->have_current_referrer);
+ dump_set_have_current_referrer (ctx, false);
+ if (dump_tracking_referrers_p (ctx))
+ ctx->current_referrer = Qnil;
+ }
+
+ static Lisp_Object
+ dump_ptr_referrer (const char *label, void const *address)
+ {
+ char buf[128];
+ buf[0] = '\0';
+ sprintf (buf, "%s @ %p", label, address);
+ return build_string (buf);
+ }
+
+ static void
+ print_paths_to_root (struct dump_context *ctx, Lisp_Object object);
+
+ static void dump_remember_cold_op (struct dump_context *ctx,
+ enum cold_op op,
+ Lisp_Object arg);
+
+ static AVOID
+ error_unsupported_dump_object (struct dump_context *ctx,
+ Lisp_Object object,
+ const char *msg)
+ {
+ if (dump_tracking_referrers_p (ctx))
+ print_paths_to_root (ctx, object);
+ error ("unsupported object type in dump: %s", msg);
+ }
+
+ static uintptr_t
+ emacs_basis (void)
+ {
+ return (uintptr_t) &Vpurify_flag;
+ }
+
+ static void *
+ emacs_ptr_at (const ptrdiff_t offset)
+ {
+ /* TODO: assert somehow that the result is actually in the Emacs
+ image. */
+ return (void *) (emacs_basis () + offset);
+ }
+
+ static dump_off
+ emacs_offset (const void *emacs_ptr)
+ {
+ /* TODO: assert that EMACS_PTR is actually in the Emacs image. */
+ eassert (emacs_ptr != NULL);
+ intptr_t emacs_ptr_value = (intptr_t) emacs_ptr;
+ ptrdiff_t emacs_ptr_relative = emacs_ptr_value - (intptr_t) emacs_basis ();
+ return ptrdiff_t_to_dump_off (emacs_ptr_relative);
+ }
+
+ /* Return whether OBJECT is a symbol the storage of which is built
+ into Emacs (and so is invariant across ASLR). */
+ static bool
+ dump_builtin_symbol_p (Lisp_Object object)
+ {
+ return SYMBOLP (object) && c_symbol_p (XSYMBOL (object));
+ }
+
+ /* Return whether OBJECT has the same bit pattern in all Emacs
+ invocations --- i.e., is invariant across a dump. Note that some
+ self-representing objects still need to be dumped!
+ */
+ static bool
+ dump_object_self_representing_p (Lisp_Object object)
+ {
+ return FIXNUMP (object) || dump_builtin_symbol_p (object);
+ }
+
+ static intmax_t
+ intmax_t_from_lisp (Lisp_Object value)
+ {
+ intmax_t n;
+ bool ok = integer_to_intmax (value, &n);
+ eassert (ok);
+ return n;
+ }
+
+ static Lisp_Object
+ intmax_t_to_lisp (intmax_t value)
+ {
+ return INT_TO_INTEGER (value);
+ }
+
+ static dump_off
+ dump_off_from_lisp (Lisp_Object value)
+ {
+ intmax_t n = intmax_t_from_lisp (value);
+ eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
+ return n;
+ }
+
+ static Lisp_Object
+ dump_off_to_lisp (dump_off value)
+ {
+ return INT_TO_INTEGER (value);
+ }
+
+ static void
+ dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
+ {
+ eassert (nbyte == 0 || buf != NULL);
+ eassert (ctx->obj_offset == 0);
+ eassert (ctx->flags.dump_object_contents);
+ while (ctx->offset + nbyte > ctx->buf_size)
+ dump_grow_buffer (ctx);
+ memcpy ((char *)ctx->buf + ctx->offset, buf, nbyte);
+ ctx->offset += nbyte;
+ }
+
+ static Lisp_Object
+ make_eq_hash_table (void)
+ {
+ return CALLN (Fmake_hash_table, QCtest, Qeq);
+ }
+
+ static void
+ dump_tailq_init (struct dump_tailq *tailq)
+ {
+ tailq->head = tailq->tail = Qnil;
+ tailq->length = 0;
+ }
+
+ static intptr_t
+ dump_tailq_length (const struct dump_tailq *tailq)
+ {
+ return tailq->length;
+ }
+
+ static void
+ dump_tailq_prepend (struct dump_tailq *tailq, Lisp_Object value)
+ {
+ Lisp_Object link = Fcons (value, tailq->head);
+ tailq->head = link;
+ if (NILP (tailq->tail))
+ tailq->tail = link;
+ tailq->length += 1;
+ }
+
+ static bool
+ dump_tailq_empty_p (struct dump_tailq *tailq)
+ {
+ return NILP (tailq->head);
+ }
+
+ static Lisp_Object
+ dump_tailq_peek (struct dump_tailq *tailq)
+ {
+ eassert (!dump_tailq_empty_p (tailq));
+ return XCAR (tailq->head);
+ }
+
+ static Lisp_Object
+ dump_tailq_pop (struct dump_tailq *tailq)
+ {
+ eassert (!dump_tailq_empty_p (tailq));
+ eassert (tailq->length > 0);
+ tailq->length -= 1;
+ Lisp_Object value = XCAR (tailq->head);
+ tailq->head = XCDR (tailq->head);
+ if (NILP (tailq->head))
+ tailq->tail = Qnil;
+ return value;
+ }
+
+ static void
+ dump_seek (struct dump_context *ctx, dump_off offset)
+ {
+ if (ctx->max_offset < ctx->offset)
+ ctx->max_offset = ctx->offset;
+ eassert (ctx->obj_offset == 0);
+ ctx->offset = offset;
+ }
+
+ static void
+ dump_write_zero (struct dump_context *ctx, dump_off nbytes)
+ {
+ while (nbytes > 0)
+ {
+ uintmax_t zero = 0;
+ dump_off to_write = sizeof (zero);
+ if (to_write > nbytes)
+ to_write = nbytes;
+ dump_write (ctx, &zero, to_write);
+ nbytes -= to_write;
+ }
+ }
+
+ static void
+ dump_align_output (struct dump_context *ctx, int alignment)
+ {
+ if (ctx->offset % alignment != 0)
+ dump_write_zero (ctx, alignment - (ctx->offset % alignment));
+ }
+
+ static dump_off
+ dump_object_start (struct dump_context *ctx,
+ void *out,
+ dump_off outsz)
+ {
+ /* We dump only one object at a time, so obj_offset should be
+ invalid on entry to this function. */
+ eassert (ctx->obj_offset == 0);
+ int alignment = ctx->flags.pack_objects ? 1 : DUMP_ALIGNMENT;
+ if (ctx->flags.dump_object_contents)
+ dump_align_output (ctx, alignment);
+ ctx->obj_offset = ctx->offset;
+ memset (out, 0, outsz);
+ return ctx->offset;
+ }
+
+ static dump_off
+ dump_object_finish (struct dump_context *ctx,
+ const void *out,
+ dump_off sz)
+ {
+ dump_off offset = ctx->obj_offset;
+ eassert (offset > 0);
+ eassert (offset == ctx->offset); /* No intervening writes. */
+ ctx->obj_offset = 0;
+ if (ctx->flags.dump_object_contents)
+ dump_write (ctx, out, sz);
+ return offset;
+ }
+
+ /* Return offset at which OBJECT has been dumped, or one of the dump_object_special_offset
+ negative values, or DUMP_OBJECT_NOT_SEEN. */
+ static dump_off
+ dump_recall_object (struct dump_context *ctx, Lisp_Object object)
+ {
+ Lisp_Object dumped = ctx->objects_dumped;
+ return dump_off_from_lisp (Fgethash (object, dumped,
+ make_fixnum (DUMP_OBJECT_NOT_SEEN)));
+ }
+
+ static void
+ dump_remember_object (struct dump_context *ctx,
+ Lisp_Object object,
+ dump_off offset)
+ {
+ Fputhash (object,
+ dump_off_to_lisp (offset),
+ ctx->objects_dumped);
+ }
+
+ static void
+ dump_note_reachable (struct dump_context *ctx, Lisp_Object object)
+ {
+ eassert (ctx->have_current_referrer);
+ if (!dump_tracking_referrers_p (ctx))
+ return;
+ Lisp_Object referrer = ctx->current_referrer;
+ Lisp_Object obj_referrers = Fgethash (object, ctx->referrers, Qnil);
+ if (NILP (Fmemq (referrer, obj_referrers)))
+ Fputhash (object, Fcons (referrer, obj_referrers), ctx->referrers);
+ }
+
+ /* If this object lives in the Emacs image and not on the heap, return
+ a pointer to the object data. Otherwise, return NULL. */
+ static void *
+ dump_object_emacs_ptr (Lisp_Object lv)
+ {
+ if (SUBRP (lv) && !SUBR_NATIVE_COMPILEDP (lv))
+ return XSUBR (lv);
+ if (dump_builtin_symbol_p (lv))
+ return XSYMBOL (lv);
+ if (XTYPE (lv) == Lisp_Vectorlike
+ && PSEUDOVECTOR_TYPEP (&XVECTOR (lv)->header, PVEC_THREAD)
+ && main_thread_p (XTHREAD (lv)))
+ return XTHREAD (lv);
+ return NULL;
+ }
+
+ static void
+ dump_queue_init (struct dump_queue *dump_queue)
+ {
+ dump_tailq_init (&dump_queue->zero_weight_objects);
+ dump_tailq_init (&dump_queue->one_weight_normal_objects);
+ dump_tailq_init (&dump_queue->one_weight_strong_objects);
+ dump_tailq_init (&dump_queue->fancy_weight_objects);
+ dump_queue->link_weights = make_eq_hash_table ();
+ dump_queue->sequence_numbers = make_eq_hash_table ();
+ dump_queue->next_sequence_number = 1;
+ }
+
+ static bool
+ dump_queue_empty_p (struct dump_queue *dump_queue)
+ {
+ ptrdiff_t count = XHASH_TABLE (dump_queue->sequence_numbers)->count;
+ bool is_empty = count == 0;
+ eassert (count == XFIXNAT (Fhash_table_count (dump_queue->link_weights)));
+ if (!is_empty)
+ {
+ eassert (!dump_tailq_empty_p (&dump_queue->zero_weight_objects)
+ || !dump_tailq_empty_p (&dump_queue->one_weight_normal_objects)
+ || !dump_tailq_empty_p (&dump_queue->one_weight_strong_objects)
+ || !dump_tailq_empty_p (&dump_queue->fancy_weight_objects));
+ }
+ else
+ {
+ /* If we're empty, we can still have a few stragglers on one of
+ the above queues. */
+ }
+
+ return is_empty;
+ }
+
+ static void
+ dump_queue_push_weight (Lisp_Object *weight_list,
+ dump_off basis,
+ struct link_weight weight)
+ {
+ if (EQ (*weight_list, Qt))
+ *weight_list = Qnil;
+ dump_push (weight_list, Fcons (dump_off_to_lisp (basis),
+ dump_off_to_lisp (weight.value)));
+ }
+
+ static void
+ dump_queue_enqueue (struct dump_queue *dump_queue,
+ Lisp_Object object,
+ dump_off basis,
+ struct link_weight weight)
+ {
+ Lisp_Object weights = Fgethash (object, dump_queue->link_weights, Qnil);
+ Lisp_Object orig_weights = weights;
+ /* N.B. want to find the last item of a given weight in each queue
+ due to prepend use. */
+ bool use_single_queues = true;
+ if (NILP (weights))
+ {
+ /* Object is new. */
+ EMACS_UINT uobj = XLI (object);
+ dump_trace ("new object %0*"pI"x weight=%d\n", EMACS_INT_XDIGITS, uobj,
+ weight.value);
+
+ if (weight.value == WEIGHT_NONE.value)
+ {
+ eassert (weight.value == 0);
+ dump_tailq_prepend (&dump_queue->zero_weight_objects, object);
+ weights = Qt;
+ }
+ else if (!use_single_queues)
+ {
+ dump_tailq_prepend (&dump_queue->fancy_weight_objects, object);
+ dump_queue_push_weight (&weights, basis, weight);
+ }
+ else if (weight.value == WEIGHT_NORMAL.value)
+ {
+ dump_tailq_prepend (&dump_queue->one_weight_normal_objects, object);
+ dump_queue_push_weight (&weights, basis, weight);
+ }
+ else if (weight.value == WEIGHT_STRONG.value)
+ {
+ dump_tailq_prepend (&dump_queue->one_weight_strong_objects, object);
+ dump_queue_push_weight (&weights, basis, weight);
+ }
+ else
+ {
+ emacs_abort ();
+ }
+
+ Fputhash (object,
+ dump_off_to_lisp(dump_queue->next_sequence_number++),
+ dump_queue->sequence_numbers);
+ }
+ else
+ {
+ /* Object was already on the queue. It's okay for an object to
+ be on multiple queues so long as we maintain order
+ invariants: attempting to dump an object multiple times is
+ harmless, and most of the time, an object is only referenced
+ once before being dumped, making this code path uncommon. */
+ if (weight.value != WEIGHT_NONE.value)
+ {
+ if (EQ (weights, Qt))
+ {
+ /* Object previously had a zero weight. Once we
+ incorporate the link weight attached to this call,
+ the object will have a single weight. Put the object
+ on the appropriate single-weight queue. */
+ weights = Qnil;
+ struct dump_tailq *tailq;
+ if (!use_single_queues)
+ tailq = &dump_queue->fancy_weight_objects;
+ else if (weight.value == WEIGHT_NORMAL.value)
+ tailq = &dump_queue->one_weight_normal_objects;
+ else if (weight.value == WEIGHT_STRONG.value)
+ tailq = &dump_queue->one_weight_strong_objects;
+ else
+ emacs_abort ();
+ dump_tailq_prepend (tailq, object);
+ }
+ else if (use_single_queues && NILP (XCDR (weights)))
+ dump_tailq_prepend (&dump_queue->fancy_weight_objects, object);
+ dump_queue_push_weight (&weights, basis, weight);
+ }
+ }
+
+ if (!BASE_EQ (weights, orig_weights))
+ Fputhash (object, weights, dump_queue->link_weights);
+ }
+
+ static float
+ dump_calc_link_score (dump_off basis,
+ dump_off link_basis,
+ dump_off link_weight)
+ {
+ float distance = (float)(basis - link_basis);
+ eassert (distance >= 0);
+ float link_score = powf (distance, -0.2f);
+ return powf (link_score, (float) link_weight / 1000.0f);
+ }
+
+ /* Compute the score for a queued object.
+
+ OBJECT is the object to query, which must currently be queued for
+ dumping. BASIS is the offset at which we would be
+ dumping the object; score is computed relative to BASIS and the
+ various BASIS values supplied to dump_add_link_weight --- the
+ further an object is from its referrers, the greater the
+ score. */
+ static float
+ dump_queue_compute_score (struct dump_queue *dump_queue,
+ Lisp_Object object,
+ dump_off basis)
+ {
+ float score = 0;
+ Lisp_Object object_link_weights =
+ Fgethash (object, dump_queue->link_weights, Qnil);
+ if (EQ (object_link_weights, Qt))
+ object_link_weights = Qnil;
+ while (!NILP (object_link_weights))
+ {
+ Lisp_Object basis_weight_pair = dump_pop (&object_link_weights);
+ dump_off link_basis = dump_off_from_lisp (XCAR (basis_weight_pair));
+ dump_off link_weight = dump_off_from_lisp (XCDR (basis_weight_pair));
+ score += dump_calc_link_score (basis, link_basis, link_weight);
+ }
+ return score;
+ }
+
+ /* Scan the fancy part of the dump queue.
+
+ BASIS is the position at which to evaluate the score function,
+ usually ctx->offset.
+
+ If we have at least one entry in the queue, return the pointer (in
+ the singly-linked list) to the cons containing the object via
+ *OUT_HIGHEST_SCORE_CONS_PTR and return its score.
+
+ If the queue is empty, set *OUT_HIGHEST_SCORE_CONS_PTR to NULL
+ and return negative infinity. */
+ static float
+ dump_queue_scan_fancy (struct dump_queue *dump_queue,
+ dump_off basis,
+ Lisp_Object **out_highest_score_cons_ptr)
+ {
+ Lisp_Object *cons_ptr = &dump_queue->fancy_weight_objects.head;
+ Lisp_Object *highest_score_cons_ptr = NULL;
+ float highest_score = -INFINITY;
+ bool first = true;
+
+ while (!NILP (*cons_ptr))
+ {
+ Lisp_Object queued_object = XCAR (*cons_ptr);
+ float score = dump_queue_compute_score (dump_queue, queued_object, basis);
+ if (first || score >= highest_score)
+ {
+ highest_score_cons_ptr = cons_ptr;
+ highest_score = score;
+ if (first)
+ first = false;
+ }
+ cons_ptr = &XCONS (*cons_ptr)->u.s.u.cdr;
+ }
+
+ *out_highest_score_cons_ptr = highest_score_cons_ptr;
+ return highest_score;
+ }
+
+ /* Return the sequence number of OBJECT.
+
+ Return -1 if object doesn't have a sequence number. This situation
+ can occur when we've double-queued an object. If this happens, we
+ discard the errant object and try again. */
+ static dump_off
+ dump_queue_sequence (struct dump_queue *dump_queue,
+ Lisp_Object object)
+ {
+ Lisp_Object n = Fgethash (object, dump_queue->sequence_numbers, Qnil);
+ return NILP (n) ? -1 : dump_off_from_lisp (n);
+ }
+
+ /* Find score and sequence at head of a one-weight object queue.
+
+ Transparently discard stale objects from head of queue. BASIS
+ is the baseness for score computation.
+
+ We organize these queues so that score is strictly decreasing, so
+ examining the head is sufficient. */
+ static void
+ dump_queue_find_score_of_one_weight_queue (struct dump_queue *dump_queue,
+ dump_off basis,
+ struct dump_tailq *one_weight_queue,
+ float *out_score,
+ int *out_sequence)
+ {
+ /* Transparently discard stale objects from the head of this queue. */
+ do
+ {
+ if (dump_tailq_empty_p (one_weight_queue))
+ {
+ *out_score = -INFINITY;
+ *out_sequence = 0;
+ }
+ else
+ {
+ Lisp_Object head = dump_tailq_peek (one_weight_queue);
+ *out_sequence = dump_queue_sequence (dump_queue, head);
+ if (*out_sequence < 0)
+ dump_tailq_pop (one_weight_queue);
+ else
+ *out_score =
+ dump_queue_compute_score (dump_queue, head, basis);
+ }
+ }
+ while (*out_sequence < 0);
+ }
+
+ /* Pop the next object to dump from the dump queue.
+
+ BASIS is the dump offset at which to evaluate score.
+
+ The object returned is the queued object with the greatest score;
+ by side effect, the object is removed from the dump queue.
+ The dump queue must not be empty. */
+ static Lisp_Object
+ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
+ {
+ eassert (BASE_EQ (Fhash_table_count (dump_queue->sequence_numbers),
+ Fhash_table_count (dump_queue->link_weights)));
+
+ eassert (XFIXNUM (Fhash_table_count (dump_queue->sequence_numbers))
+ <= (dump_tailq_length (&dump_queue->fancy_weight_objects)
+ + dump_tailq_length (&dump_queue->zero_weight_objects)
+ + dump_tailq_length (&dump_queue->one_weight_normal_objects)
+ + dump_tailq_length (&dump_queue->one_weight_strong_objects)));
+
+ dump_trace
+ (("dump_queue_dequeue basis=%"PRIdDUMP_OFF" fancy=%"PRIdPTR
+ " zero=%"PRIdPTR" normal=%"PRIdPTR" strong=%"PRIdPTR" hash=%td\n"),
+ basis,
+ dump_tailq_length (&dump_queue->fancy_weight_objects),
+ dump_tailq_length (&dump_queue->zero_weight_objects),
+ dump_tailq_length (&dump_queue->one_weight_normal_objects),
+ dump_tailq_length (&dump_queue->one_weight_strong_objects),
+ XHASH_TABLE (dump_queue->link_weights)->count);
+
+ static const int nr_candidates = 3;
+ struct candidate
+ {
+ float score;
+ dump_off sequence;
+ } candidates[nr_candidates];
+
+ Lisp_Object *fancy_cons = NULL;
+ candidates[0].sequence = 0;
+ do
+ {
+ if (candidates[0].sequence < 0)
+ *fancy_cons = XCDR (*fancy_cons); /* Discard stale object. */
+ candidates[0].score = dump_queue_scan_fancy (dump_queue, basis,
+ &fancy_cons);
+ candidates[0].sequence =
+ candidates[0].score > -INFINITY
+ ? dump_queue_sequence (dump_queue, XCAR (*fancy_cons))
+ : 0;
+ }
+ while (candidates[0].sequence < 0);
+
+ dump_queue_find_score_of_one_weight_queue
+ (dump_queue, basis,
+ &dump_queue->one_weight_normal_objects,
+ &candidates[1].score,
+ &candidates[1].sequence);
+
+ dump_queue_find_score_of_one_weight_queue
+ (dump_queue, basis,
+ &dump_queue->one_weight_strong_objects,
+ &candidates[2].score,
+ &candidates[2].sequence);
+
+ int best = -1;
+ for (int i = 0; i < nr_candidates; ++i)
+ {
+ eassert (candidates[i].sequence >= 0);
+ if (candidates[i].score > -INFINITY
+ && (best < 0
+ || candidates[i].score > candidates[best].score
+ || (candidates[i].score == candidates[best].score
+ && candidates[i].sequence < candidates[best].sequence)))
+ best = i;
+ }
+
+ Lisp_Object result;
+ const char *src;
+ if (best < 0)
+ {
+ src = "zero";
+ result = dump_tailq_pop (&dump_queue->zero_weight_objects);
+ }
+ else if (best == 0)
+ {
+ src = "fancy";
+ result = dump_tailq_pop (&dump_queue->fancy_weight_objects);
+ }
+ else if (best == 1)
+ {
+ src = "normal";
+ result = dump_tailq_pop (&dump_queue->one_weight_normal_objects);
+ }
+ else if (best == 2)
+ {
+ src = "strong";
+ result = dump_tailq_pop (&dump_queue->one_weight_strong_objects);
+ }
+ else
+ emacs_abort ();
+
+ EMACS_UINT uresult = XLI (result);
+ dump_trace (" result score=%f src=%s object=%0*"pI"x\n",
+ best < 0 ? -1.0 : (double) candidates[best].score,
+ src, EMACS_INT_XDIGITS, uresult);
+
+ {
+ Lisp_Object weights = Fgethash (result, dump_queue->link_weights, Qnil);
+ while (!NILP (weights) && CONSP (weights))
+ {
+ Lisp_Object basis_weight_pair = dump_pop (&weights);
+ dump_off link_basis =
+ dump_off_from_lisp (XCAR (basis_weight_pair));
+ dump_off link_weight =
+ dump_off_from_lisp (XCDR (basis_weight_pair));
+ dump_trace
+ (" link_basis=%d distance=%d weight=%d contrib=%f\n",
+ link_basis,
+ basis - link_basis,
+ link_weight,
+ (double) dump_calc_link_score (basis, link_basis, link_weight));
+ }
+ }
+
+ Fremhash (result, dump_queue->link_weights);
+ Fremhash (result, dump_queue->sequence_numbers);
+ return result;
+ }
+
+ /* Return whether we need to write OBJECT to the dump file. */
+ static bool
+ dump_object_needs_dumping_p (Lisp_Object object)
+ {
+ /* Some objects, like symbols, are self-representing because they
+ have invariant bit patterns, but sometimes these objects have
+ associated data too, and these data-carrying objects need to be
+ included in the dump despite all references to them being
+ bitwise-invariant. */
+ return (!dump_object_self_representing_p (object)
+ || dump_object_emacs_ptr (object));
+ }
+
+ static void
+ dump_enqueue_object (struct dump_context *ctx,
+ Lisp_Object object,
+ struct link_weight weight)
+ {
+ if (dump_object_needs_dumping_p (object))
+ {
+ dump_off state = dump_recall_object (ctx, object);
+ bool already_dumped_object = state > DUMP_OBJECT_NOT_SEEN;
+ if (ctx->flags.assert_already_seen)
+ eassert (already_dumped_object);
+ if (!already_dumped_object)
+ {
+ if (state == DUMP_OBJECT_NOT_SEEN)
+ {
+ state = DUMP_OBJECT_ON_NORMAL_QUEUE;
+ dump_remember_object (ctx, object, state);
+ }
+ /* Note that we call dump_queue_enqueue even if the object
+ is already on the normal queue: multiple enqueue calls
+ can increase the object's weight. */
+ if (state == DUMP_OBJECT_ON_NORMAL_QUEUE)
+ dump_queue_enqueue (&ctx->dump_queue,
+ object,
+ ctx->offset,
+ weight);
+ }
+ }
+ /* Always remember the path to this object. */
+ dump_note_reachable (ctx, object);
+ }
+
+ static void
+ print_paths_to_root_1 (struct dump_context *ctx,
+ Lisp_Object object,
+ int level)
+ {
+ Lisp_Object referrers = Fgethash (object, ctx->referrers, Qnil);
+ while (!NILP (referrers))
+ {
+ Lisp_Object referrer = XCAR (referrers);
+ referrers = XCDR (referrers);
+ Lisp_Object repr = Fprin1_to_string (referrer, Qnil, Qnil);
+ for (int i = 0; i < level; ++i)
+ putc (' ', stderr);
+ fwrite (SDATA (repr), 1, SBYTES (repr), stderr);
+ putc ('\n', stderr);
+ print_paths_to_root_1 (ctx, referrer, level + 1);
+ }
+ }
+
+ static void
+ print_paths_to_root (struct dump_context *ctx, Lisp_Object object)
+ {
+ print_paths_to_root_1 (ctx, object, 0);
+ }
+
+ static void
+ dump_remember_cold_op (struct dump_context *ctx,
+ enum cold_op op,
+ Lisp_Object arg)
+ {
+ if (ctx->flags.dump_object_contents)
+ dump_push (&ctx->cold_queue, Fcons (make_fixnum (op), arg));
+ }
+
+ /* Add a dump relocation that points into Emacs.
+
+ Add a relocation that updates the pointer stored at DUMP_OFFSET to
+ point into the Emacs binary upon dump load. The pointer-sized
+ value at DUMP_OFFSET in the dump file should contain a number
+ relative to emacs_basis(). */
+ static void
+ dump_reloc_dump_to_emacs_ptr_raw (struct dump_context *ctx,
+ dump_off dump_offset)
+ {
+ if (ctx->flags.dump_object_contents)
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
+ list2 (make_fixnum (RELOC_DUMP_TO_EMACS_PTR_RAW),
+ dump_off_to_lisp (dump_offset)));
+ }
+
+ /* Add a dump relocation that points a Lisp_Object back at the dump.
+
+ Add a relocation that updates the Lisp_Object at DUMP_OFFSET in the
+ dump to point to another object in the dump. The Lisp_Object-sized
+ value at DUMP_OFFSET in the dump file should contain the offset of
+ the target object relative to the start of the dump. */
+ static void
+ dump_reloc_dump_to_dump_lv (struct dump_context *ctx,
+ dump_off dump_offset,
+ enum Lisp_Type type)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ int reloc_type;
+ switch (type)
+ {
+ case Lisp_Symbol:
+ case Lisp_String:
+ case Lisp_Vectorlike:
+ case Lisp_Cons:
+ case Lisp_Float:
+ reloc_type = RELOC_DUMP_TO_DUMP_LV + type;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
+ list2 (make_fixnum (reloc_type),
+ dump_off_to_lisp (dump_offset)));
+ }
+
+ /* Add a dump relocation that points a raw pointer back at the dump.
+
+ Add a relocation that updates the raw pointer at DUMP_OFFSET in the
+ dump to point to another object in the dump. The pointer-sized
+ value at DUMP_OFFSET in the dump file should contain the offset of
+ the target object relative to the start of the dump. */
+ static void
+ dump_reloc_dump_to_dump_ptr_raw (struct dump_context *ctx,
+ dump_off dump_offset)
+ {
+ if (ctx->flags.dump_object_contents)
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
+ list2 (make_fixnum (RELOC_DUMP_TO_DUMP_PTR_RAW),
+ dump_off_to_lisp (dump_offset)));
+ }
+
+ /* Add a dump relocation that points to a Lisp object in Emacs.
+
+ Add a relocation that updates the Lisp_Object at DUMP_OFFSET in the
+ dump to point to a lisp object in Emacs. The Lisp_Object-sized
+ value at DUMP_OFFSET in the dump file should contain the offset of
+ the target object relative to emacs_basis(). TYPE is the type of
+ Lisp value. */
+ static void
+ dump_reloc_dump_to_emacs_lv (struct dump_context *ctx,
+ dump_off dump_offset,
+ enum Lisp_Type type)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ int reloc_type;
+ switch (type)
+ {
+ case Lisp_String:
+ case Lisp_Vectorlike:
+ case Lisp_Cons:
+ case Lisp_Float:
+ reloc_type = RELOC_DUMP_TO_EMACS_LV + type;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
+ list2 (make_fixnum (reloc_type),
+ dump_off_to_lisp (dump_offset)));
+ }
+
+ /* Add an Emacs relocation that copies arbitrary bytes from the dump.
+
+ When the dump is loaded, Emacs copies SIZE bytes from OFFSET in
+ dump to LOCATION in the Emacs data section. This copying happens
+ after other relocations, so it's all right to, say, copy a
+ Lisp_Object (since by the time we copy the Lisp_Object, it'll have
+ been adjusted to account for the location of the running Emacs and
+ dump file). */
+ static void
+ dump_emacs_reloc_copy_from_dump (struct dump_context *ctx, dump_off dump_offset,
+ void *emacs_ptr, dump_off size)
+ {
+ eassert (size >= 0);
+ eassert (size < (1 << EMACS_RELOC_LENGTH_BITS));
+
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ if (size == 0)
+ return;
+
+ eassert (dump_offset >= 0);
+ dump_push (&ctx->emacs_relocs,
+ list4 (make_fixnum (RELOC_EMACS_COPY_FROM_DUMP),
+ dump_off_to_lisp (emacs_offset (emacs_ptr)),
+ dump_off_to_lisp (dump_offset),
+ dump_off_to_lisp (size)));
+ }
+
+ /* Add an Emacs relocation that sets values to arbitrary bytes.
+
+ When the dump is loaded, Emacs copies SIZE bytes from the
+ relocation itself to the adjusted location inside Emacs EMACS_PTR.
+ SIZE is the number of bytes to copy. See struct emacs_reloc for
+ the maximum size that this mechanism can support. The value comes
+ from VALUE_PTR.
+ */
+ static void
+ dump_emacs_reloc_immediate (struct dump_context *ctx,
+ const void *emacs_ptr,
+ const void *value_ptr,
+ dump_off size)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ intmax_t value = 0;
+ eassert (size <= sizeof (value));
+ memcpy (&value, value_ptr, size);
+ dump_push (&ctx->emacs_relocs,
+ list4 (make_fixnum (RELOC_EMACS_IMMEDIATE),
+ dump_off_to_lisp (emacs_offset (emacs_ptr)),
+ intmax_t_to_lisp (value),
+ dump_off_to_lisp (size)));
+ }
+
+ #define DEFINE_EMACS_IMMEDIATE_FN(fnname, type) \
+ static void \
+ fnname (struct dump_context *ctx, \
+ const type *emacs_ptr, \
+ type value) \
+ { \
+ dump_emacs_reloc_immediate ( \
+ ctx, emacs_ptr, &value, sizeof (value)); \
+ }
+
+ DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_lv, Lisp_Object)
+ DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_ptrdiff_t, ptrdiff_t)
+ DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_intmax_t, intmax_t)
+ DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_int, int)
+ DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_bool, bool)
+
+ /* Add an emacs relocation that makes a raw pointer in Emacs point
+ into the dump. */
+ static void
+ dump_emacs_reloc_to_dump_ptr_raw (struct dump_context *ctx,
+ const void *emacs_ptr, dump_off dump_offset)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ dump_push (&ctx->emacs_relocs,
+ list3 (make_fixnum (RELOC_EMACS_DUMP_PTR_RAW),
+ dump_off_to_lisp (emacs_offset (emacs_ptr)),
+ dump_off_to_lisp (dump_offset)));
+ }
+
+ /* Add an emacs relocation that points into the dump.
+
+ When the dump is loaded, the Lisp_Object at EMACS_ROOT in Emacs to
+ point to VALUE. VALUE can be any Lisp value; this function
+ automatically queues the value for dumping if necessary. */
+ static void
+ dump_emacs_reloc_to_lv (struct dump_context *ctx,
+ Lisp_Object const *emacs_ptr,
+ Lisp_Object value)
+ {
+ if (dump_object_self_representing_p (value))
+ dump_emacs_reloc_immediate_lv (ctx, emacs_ptr, value);
+ else
+ {
+ if (ctx->flags.dump_object_contents)
+ /* Conditionally use RELOC_EMACS_EMACS_LV or
+ RELOC_EMACS_DUMP_LV depending on where the target object
+ lives. We could just have decode_emacs_reloc pick the
+ right type, but we might as well maintain the invariant
+ that the types on ctx->emacs_relocs correspond to the types
+ of emacs_relocs we actually emit. */
+ dump_push (&ctx->emacs_relocs,
+ list3 (make_fixnum (dump_object_emacs_ptr (value)
+ ? RELOC_EMACS_EMACS_LV
+ : RELOC_EMACS_DUMP_LV),
+ dump_off_to_lisp (emacs_offset (emacs_ptr)),
+ value));
+ dump_enqueue_object (ctx, value, WEIGHT_NONE);
+ }
+ }
+
+ /* Add an emacs relocation that makes a raw pointer in Emacs point
+ back into the Emacs image. */
+ static void
+ dump_emacs_reloc_to_emacs_ptr_raw (struct dump_context *ctx, void *emacs_ptr,
+ void const *target_emacs_ptr)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ dump_push (&ctx->emacs_relocs,
+ list3 (make_fixnum (RELOC_EMACS_EMACS_PTR_RAW),
+ dump_off_to_lisp (emacs_offset (emacs_ptr)),
+ dump_off_to_lisp (emacs_offset (target_emacs_ptr))));
+ }
+
+ /* Add an Emacs relocation that makes a raw pointer in Emacs point to
+ a different part of Emacs. */
+
+ enum dump_fixup_type
+ {
+ DUMP_FIXUP_LISP_OBJECT,
+ DUMP_FIXUP_LISP_OBJECT_RAW,
+ DUMP_FIXUP_PTR_DUMP_RAW,
+ DUMP_FIXUP_BIGNUM_DATA,
+ };
+
+ enum dump_lv_fixup_type
+ {
+ LV_FIXUP_LISP_OBJECT,
+ LV_FIXUP_RAW_POINTER,
+ };
+
+ /* Make something in the dump point to a lisp object.
+
+ CTX is a dump context. DUMP_OFFSET is the location in the dump to
+ fix. VALUE is the object to which the location in the dump
+ should point.
+
+ If FIXUP_SUBTYPE is LV_FIXUP_LISP_OBJECT, we expect a Lisp_Object
+ at DUMP_OFFSET. If it's LV_FIXUP_RAW_POINTER, we expect a pointer.
+ */
+ static void
+ dump_remember_fixup_lv (struct dump_context *ctx,
+ dump_off dump_offset,
+ Lisp_Object value,
+ enum dump_lv_fixup_type fixup_subtype)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ dump_push (&ctx->fixups,
+ list3 (make_fixnum (fixup_subtype == LV_FIXUP_LISP_OBJECT
+ ? DUMP_FIXUP_LISP_OBJECT
+ : DUMP_FIXUP_LISP_OBJECT_RAW),
+ dump_off_to_lisp (dump_offset),
+ value));
+ }
+
+ /* Remember to fix up the dump file such that the pointer-sized value
+ at DUMP_OFFSET points to NEW_DUMP_OFFSET in the dump file and to
+ its absolute address at runtime. */
+ static void
+ dump_remember_fixup_ptr_raw (struct dump_context *ctx,
+ dump_off dump_offset,
+ dump_off new_dump_offset)
+ {
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ /* We should not be generating relocations into the
+ to-be-copied-into-Emacs dump region. */
+ eassert (ctx->header.discardable_start == 0
+ || new_dump_offset < ctx->header.discardable_start
+ || (ctx->header.cold_start != 0
+ && new_dump_offset >= ctx->header.cold_start));
+
+ dump_push (&ctx->fixups,
+ list3 (make_fixnum (DUMP_FIXUP_PTR_DUMP_RAW),
+ dump_off_to_lisp (dump_offset),
+ dump_off_to_lisp (new_dump_offset)));
+ }
+
+ static void
+ dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
+ void *data)
+ {
+ struct dump_context *ctx = data;
+ Lisp_Object value = *root_ptr;
+ if (type == GC_ROOT_C_SYMBOL)
+ {
+ eassert (dump_builtin_symbol_p (value));
+ /* Remember to dump the object itself later along with all the
+ rest of the copied-to-Emacs objects. */
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = build_string ("built-in symbol list");
+ dump_enqueue_object (ctx, value, WEIGHT_NONE);
+ dump_clear_referrer (ctx);
+ }
+ else
+ {
+ if (type == GC_ROOT_STATICPRO)
+ Fputhash (dump_off_to_lisp (emacs_offset (root_ptr)),
+ Qt,
+ ctx->staticpro_table);
+ if (root_ptr != &Vinternal_interpreter_environment)
+ {
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer
+ = dump_ptr_referrer ("emacs root", root_ptr);
+ dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr);
+ dump_clear_referrer (ctx);
+ }
+ }
+ }
+
+ /* Kick off the dump process by queuing up the static GC roots. */
+ static void
+ dump_roots (struct dump_context *ctx)
+ {
+ struct gc_root_visitor visitor = { .visit = dump_root_visitor,
+ .data = ctx };
+ visit_static_gc_roots (visitor);
+ }
+
+ enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
+
+ static dump_off
+ field_relpos (const void *in_start, const void *in_field)
+ {
+ ptrdiff_t in_start_val = (ptrdiff_t) in_start;
+ ptrdiff_t in_field_val = (ptrdiff_t) in_field;
+ eassert (in_start_val <= in_field_val);
+ ptrdiff_t relpos = in_field_val - in_start_val;
+ /* The following assertion attempts to detect bugs whereby IN_START
+ and IN_FIELD don't point to the same object/structure, on the
+ assumption that a too-large difference between them is
+ suspicious. As of Apr 2019 the largest object we dump -- 'struct
+ buffer' -- is slightly smaller than 1KB, and we want to leave
+ some margin for future extensions. If the assertion below is
+ ever violated, make sure the two pointers indeed point into the
+ same object, and if so, enlarge the value of PDUMPER_MAX_OBJECT_SIZE. */
+ eassert (relpos < PDUMPER_MAX_OBJECT_SIZE);
+ return (dump_off) relpos;
+ }
+
+ static void
+ cpyptr (void *out, const void *in)
+ {
+ memcpy (out, in, sizeof (void *));
+ }
+
+ /* Convenience macro for regular assignment. */
+ #define DUMP_FIELD_COPY(out, in, name) \
+ ((out)->name = (in)->name)
+
+ static void
+ dump_field_lv_or_rawptr (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const void *in_field,
+ /* opt */ const enum Lisp_Type *ptr_raw_type,
+ struct link_weight weight)
+ {
+ eassert (ctx->obj_offset > 0);
+
+ Lisp_Object value;
+ dump_off relpos = field_relpos (in_start, in_field);
+ void *out_field = (char *) out + relpos;
+ bool is_ptr_raw = (ptr_raw_type != NULL);
+
+ if (!is_ptr_raw)
+ {
+ memcpy (&value, in_field, sizeof (value));
+ if (dump_object_self_representing_p (value))
+ {
+ memcpy (out_field, &value, sizeof (value));
+ return;
+ }
+ }
+ else
+ {
+ void *ptrval;
+ cpyptr (&ptrval, in_field);
+ if (ptrval == NULL)
+ return; /* Nothing to do. */
+ switch (*ptr_raw_type)
+ {
+ case Lisp_Symbol:
+ value = make_lisp_symbol (ptrval);
+ break;
+ case Lisp_String:
+ case Lisp_Vectorlike:
+ case Lisp_Cons:
+ case Lisp_Float:
+ value = make_lisp_ptr (ptrval, *ptr_raw_type);
+ break;
+ default:
+ emacs_abort ();
+ }
+ }
+
+ /* Now value is the Lisp_Object to which we want to point whether or
+ not the field is a raw pointer (in which case we just synthesized
+ the Lisp_Object ourselves) or a Lisp_Object (in which case we
+ just copied the thing). Add a fixup or relocation. */
+
+ intptr_t out_value;
+ dump_off out_field_offset = ctx->obj_offset + relpos;
+ dump_off target_offset = dump_recall_object (ctx, value);
+ enum { DANGEROUS = false };
+ if (DANGEROUS
+ && target_offset > 0 && dump_object_emacs_ptr (value) == NULL)
+ {
+ /* We've already dumped the referenced object, so we can emit
+ the value and a relocation directly instead of indirecting
+ through a fixup. */
+ out_value = target_offset;
+ if (is_ptr_raw)
+ dump_reloc_dump_to_dump_ptr_raw (ctx, out_field_offset);
+ else
+ dump_reloc_dump_to_dump_lv (ctx, out_field_offset, XTYPE (value));
+ }
+ else
+ {
+ /* We don't know about the target object yet, so add a fixup.
+ When we process the fixup, we'll have dumped the target
+ object. */
+ out_value = (intptr_t) 0xDEADF00D;
+ dump_remember_fixup_lv (ctx,
+ out_field_offset,
+ value,
+ ( is_ptr_raw
+ ? LV_FIXUP_RAW_POINTER
+ : LV_FIXUP_LISP_OBJECT ));
+ dump_enqueue_object (ctx, value, weight);
+ }
+
+ memcpy (out_field, &out_value, sizeof (out_value));
+ }
+
+ /* Set a pointer field on an output object during dump.
+
+ CTX is the dump context. OFFSET is the offset at which the current
+ object starts. OUT is a pointer to the dump output object.
+ IN_START is the start of the current Emacs object. IN_FIELD is a
+ pointer to the field in that object. TYPE is the type of pointer
+ to which IN_FIELD points.
+ */
+ static void
+ dump_field_lv_rawptr (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const void *in_field,
+ enum Lisp_Type type,
+ struct link_weight weight)
+ {
+ dump_field_lv_or_rawptr (ctx, out, in_start, in_field, &type, weight);
+ }
+
+ /* Set a Lisp_Object field on an output object during dump.
+
+ CTX is a dump context. OFFSET is the offset at which the current
+ object starts. OUT is a pointer to the dump output object.
+ IN_START is the start of the current Emacs object. IN_FIELD is a
+ pointer to a Lisp_Object field in that object.
+
+ Arrange for the dump to contain fixups and relocations such that,
+ at load time, the given field of the output object contains a valid
+ Lisp_Object pointing to the same notional object that *IN_FIELD
+ contains now.
+
+ See idomatic usage below. */
+ static void
+ dump_field_lv (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const Lisp_Object *in_field,
+ struct link_weight weight)
+ {
+ dump_field_lv_or_rawptr (ctx, out, in_start, in_field, NULL, weight);
+ }
+
+ /* Note that we're going to add a manual fixup for the given field
+ later. */
+ static void
+ dump_field_fixup_later (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const void *in_field)
+ {
+ /* TODO: more error checking. */
+ (void) field_relpos (in_start, in_field);
+ }
+
+ /* Mark an output object field, which is as wide as a pointer, as being
+ fixed up to point to a specific offset in the dump. */
+ static void
+ dump_field_ptr_to_dump_offset (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const void *in_field,
+ dump_off target_dump_offset)
+ {
+ eassert (ctx->obj_offset > 0);
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ dump_off relpos = field_relpos (in_start, in_field);
+ dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->obj_offset + relpos);
+ intptr_t outval = target_dump_offset;
+ memcpy ((char *) out + relpos, &outval, sizeof (outval));
+ }
+
+ /* Mark a field as pointing to a place inside Emacs.
+
+ CTX is the dump context. OUT points to the out-object for the
+ current dump function. IN_START points to the start of the object
+ being dumped. IN_FIELD points to the field inside the object being
+ dumped that we're dumping. The contents of this field (which
+ should be as wide as a pointer) are the Emacs pointer to dump.
+
+ */
+ static void
+ dump_field_emacs_ptr (struct dump_context *ctx,
+ void *out,
+ const void *in_start,
+ const void *in_field)
+ {
+ eassert (ctx->obj_offset > 0);
+ if (!ctx->flags.dump_object_contents)
+ return;
+
+ dump_off relpos = field_relpos (in_start, in_field);
+ void *abs_emacs_ptr;
+ cpyptr (&abs_emacs_ptr, in_field);
+ intptr_t rel_emacs_ptr = 0;
+ if (abs_emacs_ptr)
+ {
+ rel_emacs_ptr = emacs_offset ((void *)abs_emacs_ptr);
+ dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->obj_offset + relpos);
+ }
+ cpyptr ((char *) out + relpos, &rel_emacs_ptr);
+ }
+
+ static void
+ _dump_object_start_pseudovector (struct dump_context *ctx,
+ union vectorlike_header *out_hdr,
+ const union vectorlike_header *in_hdr)
+ {
+ eassert (in_hdr->size & PSEUDOVECTOR_FLAG);
+ ptrdiff_t vec_size = vectorlike_nbytes (in_hdr);
+ dump_object_start (ctx, out_hdr, (dump_off) vec_size);
+ *out_hdr = *in_hdr;
+ }
+
+ /* Need a macro for alloca. */
+ #define START_DUMP_PVEC(ctx, hdr, type, out) \
+ const union vectorlike_header *_in_hdr = (hdr); \
+ type *out = alloca (vectorlike_nbytes (_in_hdr)); \
+ _dump_object_start_pseudovector (ctx, &out->header, _in_hdr)
+
+ static dump_off
+ finish_dump_pvec (struct dump_context *ctx,
+ union vectorlike_header *out_hdr)
+ {
+ return dump_object_finish (ctx, out_hdr, vectorlike_nbytes (out_hdr));
+ }
+
+ static void
+ dump_pseudovector_lisp_fields (struct dump_context *ctx,
+ union vectorlike_header *out_hdr,
+ const union vectorlike_header *in_hdr)
+ {
+ const struct Lisp_Vector *in = (const struct Lisp_Vector *) in_hdr;
+ struct Lisp_Vector *out = (struct Lisp_Vector *) out_hdr;
+ ptrdiff_t size = in->header.size;
+ eassert (size & PSEUDOVECTOR_FLAG);
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (ptrdiff_t i = 0; i < size; ++i)
+ dump_field_lv (ctx, out, in, &in->contents[i], WEIGHT_STRONG);
+ }
+
+ static dump_off
+ dump_cons (struct dump_context *ctx, const struct Lisp_Cons *cons)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Cons_00EEE63F67)
+ # error "Lisp_Cons changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct Lisp_Cons out;
+ dump_object_start (ctx, &out, sizeof (out));
+ dump_field_lv (ctx, &out, cons, &cons->u.s.car, WEIGHT_STRONG);
+ dump_field_lv (ctx, &out, cons, &cons->u.s.u.cdr, WEIGHT_NORMAL);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_interval_tree (struct dump_context *ctx,
+ INTERVAL tree,
+ dump_off parent_offset)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_interval_1B38941C37)
+ # error "interval changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ /* TODO: output tree breadth-first? */
+ struct interval out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, tree, total_length);
+ DUMP_FIELD_COPY (&out, tree, position);
+ if (tree->left)
+ dump_field_fixup_later (ctx, &out, tree, &tree->left);
+ if (tree->right)
+ dump_field_fixup_later (ctx, &out, tree, &tree->right);
+ if (!tree->up_obj)
+ {
+ eassert (parent_offset != 0);
+ dump_field_ptr_to_dump_offset (ctx, &out, tree, &tree->up.interval,
+ parent_offset);
+ }
+ else
+ dump_field_lv (ctx, &out, tree, &tree->up.obj, WEIGHT_STRONG);
+ DUMP_FIELD_COPY (&out, tree, up_obj);
+ eassert (tree->gcmarkbit == 0);
+ DUMP_FIELD_COPY (&out, tree, write_protect);
+ DUMP_FIELD_COPY (&out, tree, visible);
+ DUMP_FIELD_COPY (&out, tree, front_sticky);
+ DUMP_FIELD_COPY (&out, tree, rear_sticky);
+ dump_field_lv (ctx, &out, tree, &tree->plist, WEIGHT_STRONG);
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (tree->left)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct interval, left),
+ dump_interval_tree (ctx, tree->left, offset));
+ if (tree->right)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct interval, right),
+ dump_interval_tree (ctx, tree->right, offset));
+ return offset;
+ }
+
+ static dump_off
+ dump_string (struct dump_context *ctx, const struct Lisp_String *string)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352)
+ # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ /* If we have text properties, write them _after_ the string so that
+ at runtime, the prefetcher and cache will DTRT. (We access the
+ string before its properties.).
+
+ There's special code to dump string data contiguously later on.
+ we seldom write to string data and never relocate it, so lumping
+ it together at the end of the dump saves on COW faults.
+
+ If, however, the string's size_byte field is -2, the string data
+ is actually a pointer to Emacs data segment, so we can do even
+ better by emitting a relocation instead of bothering to copy the
+ string data. */
+ struct Lisp_String out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, string, u.s.size);
+ DUMP_FIELD_COPY (&out, string, u.s.size_byte);
+ if (string->u.s.intervals)
+ dump_field_fixup_later (ctx, &out, string, &string->u.s.intervals);
+
+ if (string->u.s.size_byte == -2)
+ /* String literal in Emacs rodata. */
+ dump_field_emacs_ptr (ctx, &out, string, &string->u.s.data);
+ else
+ {
+ dump_field_fixup_later (ctx, &out, string, &string->u.s.data);
+ dump_remember_cold_op (ctx,
+ COLD_OP_STRING,
+ make_lisp_ptr ((void *) string, Lisp_String));
+ }
+
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (string->u.s.intervals)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_String, u.s.intervals),
+ dump_interval_tree (ctx, string->u.s.intervals, 0));
+
+ return offset;
+ }
+
+ static dump_off
+ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Marker_642DBAF866)
+ # error "Lisp_Marker changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+
+ START_DUMP_PVEC (ctx, &marker->header, struct Lisp_Marker, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header);
+ DUMP_FIELD_COPY (out, marker, need_adjustment);
+ DUMP_FIELD_COPY (out, marker, insertion_type);
+ if (marker->buffer)
+ {
+ dump_field_lv_rawptr (ctx, out, marker, &marker->buffer,
+ Lisp_Vectorlike, WEIGHT_NORMAL);
+ dump_field_lv_rawptr (ctx, out, marker, &marker->next,
+ Lisp_Vectorlike, WEIGHT_STRONG);
+ DUMP_FIELD_COPY (out, marker, charpos);
+ DUMP_FIELD_COPY (out, marker, bytepos);
+ }
+ return finish_dump_pvec (ctx, &out->header);
+ }
+
++static dump_off
++dump_interval_node (struct dump_context *ctx, struct interval_node *node,
++ dump_off parent_offset)
++{
++#if CHECK_STRUCTS && !defined (HASH_interval_node_5765524F7E)
++# error "interval_node changed. See CHECK_STRUCTS comment in config.h."
++#endif
++ struct interval_node out;
++ dump_object_start (ctx, &out, sizeof (out));
++ if (node->parent)
++ dump_field_fixup_later (ctx, &out, node, &node->parent);
++ if (node->left)
++ dump_field_fixup_later (ctx, &out, node, &node->parent);
++ if (node->right)
++ dump_field_fixup_later (ctx, &out, node, &node->parent);
++ DUMP_FIELD_COPY (&out, node, begin);
++ DUMP_FIELD_COPY (&out, node, end);
++ DUMP_FIELD_COPY (&out, node, limit);
++ DUMP_FIELD_COPY (&out, node, offset);
++ DUMP_FIELD_COPY (&out, node, otick);
++ dump_field_lv (ctx, &out, node, &node->data, WEIGHT_STRONG);
++ DUMP_FIELD_COPY (&out, node, color);
++ DUMP_FIELD_COPY (&out, node, visited);
++ DUMP_FIELD_COPY (&out, node, rear_advance);
++ DUMP_FIELD_COPY (&out, node, front_advance);
++ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
++ if (node->parent)
++ dump_remember_fixup_ptr_raw
++ (ctx,
++ offset + dump_offsetof (struct interval_node, parent),
++ dump_interval_node (ctx, node->parent, offset));
++ if (node->left)
++ dump_remember_fixup_ptr_raw
++ (ctx,
++ offset + dump_offsetof (struct interval_node, left),
++ dump_interval_node (ctx, node->left, offset));
++ if (node->right)
++ dump_remember_fixup_ptr_raw
++ (ctx,
++ offset + dump_offsetof (struct interval_node, right),
++ dump_interval_node (ctx, node->right, offset));
++ return offset;
++}
++
+ static dump_off
+ dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
+ {
- dump_field_lv_rawptr (ctx, out, overlay, &overlay->next,
- Lisp_Vectorlike, WEIGHT_STRONG);
- return finish_dump_pvec (ctx, &out->header);
++#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_1CD4249AEC)
+ # error "Lisp_Overlay changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header);
-#if CHECK_STRUCTS && !defined HASH_buffer_AA373AEE10
++ dump_field_fixup_later (ctx, &out, overlay, &overlay->interval);
++ dump_off offset = finish_dump_pvec (ctx, &out->header);
++ dump_remember_fixup_ptr_raw
++ (ctx,
++ offset + dump_offsetof (struct Lisp_Overlay, interval),
++ dump_interval_node (ctx, overlay->interval, offset));
++ return offset;
+ }
+
+ static void
+ dump_field_finalizer_ref (struct dump_context *ctx,
+ void *out,
+ const struct Lisp_Finalizer *finalizer,
+ struct Lisp_Finalizer *const *field)
+ {
+ if (*field == &finalizers || *field == &doomed_finalizers)
+ dump_field_emacs_ptr (ctx, out, finalizer, field);
+ else
+ dump_field_lv_rawptr (ctx, out, finalizer, field,
+ Lisp_Vectorlike,
+ WEIGHT_NORMAL);
+ }
+
+ static dump_off
+ dump_finalizer (struct dump_context *ctx,
+ const struct Lisp_Finalizer *finalizer)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_D58E647CB8)
+ # error "Lisp_Finalizer changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out);
+ /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the
+ only Lisp field, finalizer->function, manually, so we can give it
+ a low weight. */
+ dump_field_lv (ctx, &out, finalizer, &finalizer->function, WEIGHT_NONE);
+ dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->prev);
+ dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->next);
+ return finish_dump_pvec (ctx, &out->header);
+ }
+
+ struct bignum_reload_info
+ {
+ dump_off data_location;
+ dump_off nlimbs;
+ };
+
+ static dump_off
+ dump_bignum (struct dump_context *ctx, Lisp_Object object)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_661945DE2B)
+ # error "Lisp_Bignum changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ const struct Lisp_Bignum *bignum = XBIGNUM (object);
+ START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
+ verify (sizeof (out->value) >= sizeof (struct bignum_reload_info));
+ dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
+ dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
+ if (ctx->flags.dump_object_contents)
+ {
+ /* Export the bignum into a blob in the cold section. */
+ dump_remember_cold_op (ctx, COLD_OP_BIGNUM, object);
+
+ /* Write the offset of that exported blob here. */
+ dump_off value_offset
+ = (bignum_offset
+ + (dump_off) offsetof (struct Lisp_Bignum, value));
+ dump_push (&ctx->fixups,
+ list3 (make_fixnum (DUMP_FIXUP_BIGNUM_DATA),
+ dump_off_to_lisp (value_offset),
+ object));
+
+ /* When we load the dump, slurp the data blob and turn it into a
+ real bignum. Attach the relocation to the start of the
+ Lisp_Bignum instead of the actual mpz field so that the
+ relocation offset is aligned. The relocation-application
+ code knows to actually advance past the header. */
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
+ list2 (make_fixnum (RELOC_BIGNUM),
+ dump_off_to_lisp (bignum_offset)));
+ }
+
+ return bignum_offset;
+ }
+
+ static dump_off
+ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Float_7E7D284C02)
+ # error "Lisp_Float changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ eassert (ctx->header.cold_start);
+ struct Lisp_Float out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, lfloat, u.data);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd)
+ {
+ #if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387
+ # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar);
+ struct Lisp_Intfwd out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, intfwd, type);
+ dump_field_emacs_ptr (ctx, &out, intfwd, &intfwd->intvar);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC)
+ # error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar);
+ struct Lisp_Boolfwd out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, boolfwd, type);
+ dump_field_emacs_ptr (ctx, &out, boolfwd, &boolfwd->boolvar);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC)
+ # error "Lisp_Objfwd changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)),
+ ctx->staticpro_table,
+ Qnil)))
+ dump_emacs_reloc_to_lv (ctx, objfwd->objvar, *objfwd->objvar);
+ struct Lisp_Objfwd out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, objfwd, type);
+ dump_field_emacs_ptr (ctx, &out, objfwd, &objfwd->objvar);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd_buffer_obj (struct dump_context *ctx,
+ const struct Lisp_Buffer_Objfwd *buffer_objfwd)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_611EBD13FF)
+ # error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct Lisp_Buffer_Objfwd out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, buffer_objfwd, type);
+ DUMP_FIELD_COPY (&out, buffer_objfwd, offset);
+ dump_field_lv (ctx, &out, buffer_objfwd, &buffer_objfwd->predicate,
+ WEIGHT_NORMAL);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd_kboard_obj (struct dump_context *ctx,
+ const struct Lisp_Kboard_Objfwd *kboard_objfwd)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069)
+ # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct Lisp_Kboard_Objfwd out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, kboard_objfwd, type);
+ DUMP_FIELD_COPY (&out, kboard_objfwd, offset);
+ return dump_object_finish (ctx, &out, sizeof (out));
+ }
+
+ static dump_off
+ dump_fwd (struct dump_context *ctx, lispfwd fwd)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E)
+ # error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ void const *p = fwd.fwdptr;
+ dump_off offset;
+
+ switch (XFWDTYPE (fwd))
+ {
+ case Lisp_Fwd_Int:
+ offset = dump_fwd_int (ctx, p);
+ break;
+ case Lisp_Fwd_Bool:
+ offset = dump_fwd_bool (ctx, p);
+ break;
+ case Lisp_Fwd_Obj:
+ offset = dump_fwd_obj (ctx, p);
+ break;
+ case Lisp_Fwd_Buffer_Obj:
+ offset = dump_fwd_buffer_obj (ctx, p);
+ break;
+ case Lisp_Fwd_Kboard_Obj:
+ offset = dump_fwd_kboard_obj (ctx, p);
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ return offset;
+ }
+
+ static dump_off
+ dump_blv (struct dump_context *ctx,
+ const struct Lisp_Buffer_Local_Value *blv)
+ {
+ #if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C
+ # error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct Lisp_Buffer_Local_Value out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, blv, local_if_set);
+ DUMP_FIELD_COPY (&out, blv, found);
+ if (blv->fwd.fwdptr)
+ dump_field_fixup_later (ctx, &out, blv, &blv->fwd.fwdptr);
+ dump_field_lv (ctx, &out, blv, &blv->where, WEIGHT_NORMAL);
+ dump_field_lv (ctx, &out, blv, &blv->defcell, WEIGHT_STRONG);
+ dump_field_lv (ctx, &out, blv, &blv->valcell, WEIGHT_STRONG);
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (blv->fwd.fwdptr)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Buffer_Local_Value, fwd),
+ dump_fwd (ctx, blv->fwd));
+ return offset;
+ }
+
+ static dump_off
+ dump_recall_symbol_aux (struct dump_context *ctx, Lisp_Object symbol)
+ {
+ Lisp_Object symbol_aux = ctx->symbol_aux;
+ if (NILP (symbol_aux))
+ return 0;
+ return dump_off_from_lisp (Fgethash (symbol, symbol_aux, make_fixnum (0)));
+ }
+
+ static void
+ dump_remember_symbol_aux (struct dump_context *ctx,
+ Lisp_Object symbol,
+ dump_off offset)
+ {
+ Fputhash (symbol, dump_off_to_lisp (offset), ctx->symbol_aux);
+ }
+
+ static void
+ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
+ {
+ Lisp_Object symbol_lv = make_lisp_symbol (symbol);
+ eassert (!dump_recall_symbol_aux (ctx, symbol_lv));
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = symbol_lv;
+ switch (symbol->u.s.redirect)
+ {
+ case SYMBOL_LOCALIZED:
+ dump_remember_symbol_aux (ctx, symbol_lv,
+ dump_blv (ctx, symbol->u.s.val.blv));
+ break;
+ case SYMBOL_FORWARDED:
+ dump_remember_symbol_aux (ctx, symbol_lv,
+ dump_fwd (ctx, symbol->u.s.val.fwd));
+ break;
+ default:
+ break;
+ }
+ dump_clear_referrer (ctx);
+ }
+
+ static dump_off
+ dump_symbol (struct dump_context *ctx,
+ Lisp_Object object,
+ dump_off offset)
+ {
+ #if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC
+ # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ #if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113)
+ # error "symbol_redirect changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+
+ if (ctx->flags.defer_symbols)
+ {
+ if (offset != DUMP_OBJECT_ON_SYMBOL_QUEUE)
+ {
+ eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
+ || offset == DUMP_OBJECT_NOT_SEEN);
+ dump_clear_referrer (ctx);
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.dump_object_contents = false;
+ ctx->flags.defer_symbols = false;
+ dump_object (ctx, object);
+ ctx->flags = old_flags;
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = object;
+
+ offset = DUMP_OBJECT_ON_SYMBOL_QUEUE;
+ dump_remember_object (ctx, object, offset);
+ dump_push (&ctx->deferred_symbols, object);
+ }
+ return offset;
+ }
+
+ struct Lisp_Symbol *symbol = XSYMBOL (object);
+ struct Lisp_Symbol out;
+ dump_object_start (ctx, &out, sizeof (out));
+ eassert (symbol->u.s.gcmarkbit == 0);
+ DUMP_FIELD_COPY (&out, symbol, u.s.redirect);
+ DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write);
+ DUMP_FIELD_COPY (&out, symbol, u.s.interned);
+ DUMP_FIELD_COPY (&out, symbol, u.s.declared_special);
+ DUMP_FIELD_COPY (&out, symbol, u.s.pinned);
+ dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG);
+ switch (symbol->u.s.redirect)
+ {
+ case SYMBOL_PLAINVAL:
+ dump_field_lv (ctx, &out, symbol, &symbol->u.s.val.value,
+ WEIGHT_NORMAL);
+ break;
+ case SYMBOL_VARALIAS:
+ dump_field_lv_rawptr (ctx, &out, symbol,
+ &symbol->u.s.val.alias, Lisp_Symbol,
+ WEIGHT_NORMAL);
+ break;
+ case SYMBOL_LOCALIZED:
+ dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.blv);
+ break;
+ case SYMBOL_FORWARDED:
+ dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.fwd);
+ break;
+ default:
+ emacs_abort ();
+ }
+ dump_field_lv (ctx, &out, symbol, &symbol->u.s.function, WEIGHT_NORMAL);
+ dump_field_lv (ctx, &out, symbol, &symbol->u.s.plist, WEIGHT_NORMAL);
+ dump_field_lv_rawptr (ctx, &out, symbol, &symbol->u.s.next, Lisp_Symbol,
+ WEIGHT_STRONG);
+
+ offset = dump_object_finish (ctx, &out, sizeof (out));
+ dump_off aux_offset;
+
+ switch (symbol->u.s.redirect)
+ {
+ case SYMBOL_LOCALIZED:
+ aux_offset = dump_recall_symbol_aux (ctx, make_lisp_symbol (symbol));
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Symbol, u.s.val.blv),
+ (aux_offset
+ ? aux_offset
+ : dump_blv (ctx, symbol->u.s.val.blv)));
+ break;
+ case SYMBOL_FORWARDED:
+ aux_offset = dump_recall_symbol_aux (ctx, make_lisp_symbol (symbol));
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Symbol, u.s.val.fwd),
+ (aux_offset
+ ? aux_offset
+ : dump_fwd (ctx, symbol->u.s.val.fwd)));
+ break;
+ default:
+ break;
+ }
+ return offset;
+ }
+
+ static dump_off
+ dump_vectorlike_generic (struct dump_context *ctx,
+ const union vectorlike_header *header)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_vectorlike_header_00A5A4BFB2)
+ # error "vectorlike_header changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ const struct Lisp_Vector *v = (const struct Lisp_Vector *) header;
+ ptrdiff_t size = header->size;
+ enum pvec_type pvectype = PSEUDOVECTOR_TYPE (v);
+ dump_off offset;
+
+ if (size & PSEUDOVECTOR_FLAG)
+ {
+ /* Assert that the pseudovector contains only Lisp values ---
+ but see the PVEC_SUB_CHAR_TABLE special case below. We allow
+ one extra word of non-lisp data when Lisp_Object is shorter
+ than GCALIGN (e.g., on 32-bit builds) to account for
+ GCALIGN-enforcing struct padding. We can't distinguish
+ between padding and some undumpable data member this way, but
+ we'll count on sizeof(Lisp_Object) >= GCALIGN builds to catch
+ this class of problem.
+ */
+ eassert ((size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_REST_BITS
+ <= (sizeof (Lisp_Object) < GCALIGNMENT));
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ }
+
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off prefix_start_offset = ctx->offset;
+
+ dump_off skip;
+ if (pvectype == PVEC_SUB_CHAR_TABLE)
+ {
+ /* PVEC_SUB_CHAR_TABLE has a special case because it's a
+ variable-length vector (unlike other pseudovectors, which is
+ why we handle it here) and has its non-Lisp data _before_ the
+ variable-length Lisp part. */
+ const struct Lisp_Sub_Char_Table *sct =
+ (const struct Lisp_Sub_Char_Table *) header;
+ struct Lisp_Sub_Char_Table out;
+ /* Don't use sizeof(out), since that incorporates unwanted
+ padding. Instead, use the size through the last non-Lisp
+ field. */
+ size_t sz = (char *)&out.min_char + sizeof (out.min_char) - (char *)&out;
+ eassert (sz < DUMP_OFF_MAX);
+ dump_object_start (ctx, &out, (dump_off) sz);
+ DUMP_FIELD_COPY (&out, sct, header.size);
+ DUMP_FIELD_COPY (&out, sct, depth);
+ DUMP_FIELD_COPY (&out, sct, min_char);
+ offset = dump_object_finish (ctx, &out, (dump_off) sz);
+ skip = SUB_CHAR_TABLE_OFFSET;
+ }
+ else
+ {
+ union vectorlike_header out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, header, size);
+ offset = dump_object_finish (ctx, &out, sizeof (out));
+ skip = 0;
+ }
+
+ /* We may have written a non-Lisp vector prefix above. If we have,
+ pad to the lisp content start with zero, and make sure we didn't
+ scribble beyond that start. */
+ dump_off prefix_size = ctx->offset - prefix_start_offset;
+ eassert (prefix_size > 0);
+ dump_off skip_start = ptrdiff_t_to_dump_off ((char *) &v->contents[skip]
+ - (char *) v);
+ eassert (skip_start >= prefix_size);
+ dump_write_zero (ctx, skip_start - prefix_size);
+
+ /* dump_object_start isn't what records conservative-GC object
+ starts --- dump_object_1 does --- so the hack below of using
+ dump_object_start for each vector word doesn't cause GC problems
+ at runtime. */
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+ for (dump_off i = skip; i < size; ++i)
+ {
+ Lisp_Object out;
+ const Lisp_Object *vslot = &v->contents[i];
+ /* In the wide case, we're always misaligned. */
+ #if INTPTR_MAX == EMACS_INT_MAX
+ eassert (ctx->offset % sizeof (out) == 0);
+ #endif
+ dump_object_start (ctx, &out, sizeof (out));
+ dump_field_lv (ctx, &out, vslot, vslot, WEIGHT_STRONG);
+ dump_object_finish (ctx, &out, sizeof (out));
+ }
+ ctx->flags = old_flags;
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ return offset;
+ }
+
+ /* Return a vector of KEY, VALUE pairs in the given hash table H. The
+ first H->count pairs are valid, and the rest are unbound. */
+ static Lisp_Object
+ hash_table_contents (struct Lisp_Hash_Table *h)
+ {
+ if (h->test.hashfn == hashfn_user_defined)
+ error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
+
+ ptrdiff_t size = HASH_TABLE_SIZE (h);
+ Lisp_Object key_and_value = make_uninit_vector (2 * size);
+ ptrdiff_t n = 0;
+
+ /* Make sure key_and_value ends up in the same order; charset.c
+ relies on it by expecting hash table indices to stay constant
+ across the dump. */
+ for (ptrdiff_t i = 0; i < size; i++)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ ASET (key_and_value, n++, HASH_KEY (h, i));
+ ASET (key_and_value, n++, HASH_VALUE (h, i));
+ }
+
+ while (n < 2 * size)
+ {
+ ASET (key_and_value, n++, Qunbound);
+ ASET (key_and_value, n++, Qnil);
+ }
+
+ return key_and_value;
+ }
+
+ static dump_off
+ dump_hash_table_list (struct dump_context *ctx)
+ {
+ if (!NILP (ctx->hash_tables))
+ return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
+ else
+ return 0;
+ }
+
+ static void
+ hash_table_freeze (struct Lisp_Hash_Table *h)
+ {
+ ptrdiff_t npairs = ASIZE (h->key_and_value) / 2;
+ h->key_and_value = hash_table_contents (h);
+ h->next = h->hash = make_fixnum (npairs);
+ h->index = make_fixnum (ASIZE (h->index));
+ h->next_free = (npairs == h->count ? -1 : h->count);
+ }
+
+ static void
+ hash_table_thaw (Lisp_Object hash)
+ {
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
+ h->hash = make_nil_vector (XFIXNUM (h->hash));
+ h->next = Fmake_vector (h->next, make_fixnum (-1));
+ h->index = Fmake_vector (h->index, make_fixnum (-1));
+
+ hash_table_rehash (hash);
+ }
+
+ static dump_off
+ dump_hash_table (struct dump_context *ctx,
+ Lisp_Object object,
+ dump_off offset)
+ {
+ #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
+ # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
+ struct Lisp_Hash_Table hash_munged = *hash_in;
+ struct Lisp_Hash_Table *hash = &hash_munged;
+
+ hash_table_freeze (hash);
+ dump_push (&ctx->hash_tables, object);
+
+ START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
+ /* TODO: dump the hash bucket vectors synchronously here to keep
+ them as close to the hash table as possible. */
+ DUMP_FIELD_COPY (out, hash, count);
+ DUMP_FIELD_COPY (out, hash, next_free);
+ DUMP_FIELD_COPY (out, hash, purecopy);
+ DUMP_FIELD_COPY (out, hash, mutable);
+ DUMP_FIELD_COPY (out, hash, rehash_threshold);
+ DUMP_FIELD_COPY (out, hash, rehash_size);
+ dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG);
+ dump_field_lv (ctx, out, hash, &hash->test.name, WEIGHT_STRONG);
+ dump_field_lv (ctx, out, hash, &hash->test.user_hash_function,
+ WEIGHT_STRONG);
+ dump_field_lv (ctx, out, hash, &hash->test.user_cmp_function,
+ WEIGHT_STRONG);
+ dump_field_emacs_ptr (ctx, out, hash, &hash->test.cmpfn);
+ dump_field_emacs_ptr (ctx, out, hash, &hash->test.hashfn);
+ eassert (hash->next_weak == NULL);
+ return finish_dump_pvec (ctx, &out->header);
+ }
+
+ static dump_off
+ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
+ {
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_before,
- Lisp_Vectorlike, WEIGHT_NORMAL);
++#if CHECK_STRUCTS && !defined HASH_buffer_F0F08347A5
+ # error "buffer changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct buffer munged_buffer = *in_buffer;
+ struct buffer *buffer = &munged_buffer;
+
+ /* Clear some buffer state for correctness upon load. */
+ if (buffer->base_buffer == NULL)
+ buffer->window_count = 0;
+ else
+ eassert (buffer->window_count == -1);
+ buffer->local_minor_modes_ = Qnil;
+ buffer->last_selected_window_ = Qnil;
+ buffer->display_count_ = make_fixnum (0);
+ buffer->clip_changed = 0;
+ buffer->last_window_start = -1;
+ buffer->point_before_scroll_ = Qnil;
+
+ dump_off base_offset = 0;
+ if (buffer->base_buffer)
+ {
+ eassert (buffer->base_buffer->base_buffer == NULL);
+ base_offset = dump_object_for_offset
+ (ctx,
+ make_lisp_ptr (buffer->base_buffer, Lisp_Vectorlike));
+ }
+
+ eassert ((base_offset == 0 && buffer->text == &in_buffer->own_text)
+ || (base_offset > 0 && buffer->text != &in_buffer->own_text));
+
+ START_DUMP_PVEC (ctx, &buffer->header, struct buffer, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &buffer->header);
+ if (base_offset == 0)
+ base_offset = ctx->obj_offset;
+ eassert (base_offset > 0);
+ if (buffer->base_buffer == NULL)
+ {
+ eassert (base_offset == ctx->obj_offset);
+
+ if (BUFFER_LIVE_P (buffer))
+ {
+ dump_field_fixup_later (ctx, out, buffer, &buffer->own_text.beg);
+ dump_remember_cold_op (ctx, COLD_OP_BUFFER,
+ make_lisp_ptr ((void *) in_buffer,
+ Lisp_Vectorlike));
+ }
+ else
+ eassert (buffer->own_text.beg == NULL);
+
+ DUMP_FIELD_COPY (out, buffer, own_text.gpt);
+ DUMP_FIELD_COPY (out, buffer, own_text.z);
+ DUMP_FIELD_COPY (out, buffer, own_text.gpt_byte);
+ DUMP_FIELD_COPY (out, buffer, own_text.z_byte);
+ DUMP_FIELD_COPY (out, buffer, own_text.gap_size);
+ DUMP_FIELD_COPY (out, buffer, own_text.modiff);
+ DUMP_FIELD_COPY (out, buffer, own_text.chars_modiff);
+ DUMP_FIELD_COPY (out, buffer, own_text.save_modiff);
+ DUMP_FIELD_COPY (out, buffer, own_text.overlay_modiff);
+ DUMP_FIELD_COPY (out, buffer, own_text.compact);
+ DUMP_FIELD_COPY (out, buffer, own_text.beg_unchanged);
+ DUMP_FIELD_COPY (out, buffer, own_text.end_unchanged);
+ DUMP_FIELD_COPY (out, buffer, own_text.unchanged_modified);
+ DUMP_FIELD_COPY (out, buffer, own_text.overlay_unchanged_modified);
+ DUMP_FIELD_COPY (out, buffer, own_text.chars_unchanged_modified);
+ if (buffer->own_text.intervals)
+ dump_field_fixup_later (ctx, out, buffer, &buffer->own_text.intervals);
+ dump_field_lv_rawptr (ctx, out, buffer, &buffer->own_text.markers,
+ Lisp_Vectorlike, WEIGHT_NORMAL);
+ DUMP_FIELD_COPY (out, buffer, own_text.inhibit_shrinking);
+ DUMP_FIELD_COPY (out, buffer, own_text.redisplay);
+ }
+
+ eassert (ctx->obj_offset > 0);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ ctx->obj_offset + dump_offsetof (struct buffer, text),
+ base_offset + dump_offsetof (struct buffer, own_text));
+
+ DUMP_FIELD_COPY (out, buffer, pt);
+ DUMP_FIELD_COPY (out, buffer, pt_byte);
+ DUMP_FIELD_COPY (out, buffer, begv);
+ DUMP_FIELD_COPY (out, buffer, begv_byte);
+ DUMP_FIELD_COPY (out, buffer, zv);
+ DUMP_FIELD_COPY (out, buffer, zv_byte);
+
+ if (buffer->base_buffer)
+ {
+ eassert (ctx->obj_offset != base_offset);
+ dump_field_ptr_to_dump_offset (ctx, out, buffer, &buffer->base_buffer,
+ base_offset);
+ }
+
+ DUMP_FIELD_COPY (out, buffer, indirections);
+ DUMP_FIELD_COPY (out, buffer, window_count);
+
+ memcpy (out->local_flags,
+ &buffer->local_flags,
+ sizeof (out->local_flags));
+ DUMP_FIELD_COPY (out, buffer, modtime);
+ DUMP_FIELD_COPY (out, buffer, modtime_size);
+ DUMP_FIELD_COPY (out, buffer, auto_save_modified);
+ DUMP_FIELD_COPY (out, buffer, display_error_modiff);
+ DUMP_FIELD_COPY (out, buffer, auto_save_failure_time);
+ DUMP_FIELD_COPY (out, buffer, last_window_start);
+
+ /* Not worth serializing these caches. TODO: really? */
+ out->newline_cache = NULL;
+ out->width_run_cache = NULL;
+ out->bidi_paragraph_cache = NULL;
+
+ DUMP_FIELD_COPY (out, buffer, prevent_redisplay_optimizations_p);
+ DUMP_FIELD_COPY (out, buffer, clip_changed);
+ DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks);
+ DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p);
+
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_after,
- Lisp_Vectorlike, WEIGHT_NORMAL);
++ if (buffer->overlays
++ && (buffer->overlays->root != &buffer->overlays->nil))
++ /* We haven't implemented the code to dump overlays. */
++ emacs_abort ();
++ else
++ out->overlays = NULL;
+
- DUMP_FIELD_COPY (out, buffer, overlay_center);
++ /* dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays,
++ ?Lisp_Vectorlike?, WEIGHT_NORMAL); */
+
+ dump_field_lv (ctx, out, buffer, &buffer->undo_list_,
+ WEIGHT_STRONG);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ if (!buffer->base_buffer && buffer->own_text.intervals)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct buffer, own_text.intervals),
+ dump_interval_tree (ctx, buffer->own_text.intervals, 0));
+
+ return offset;
+ }
+
+ static dump_off
+ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Vector_3091289B35)
+ # error "Lisp_Vector changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ /* No relocation needed, so we don't need dump_object_start. */
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ eassert (ctx->offset >= ctx->header.cold_start);
+ dump_off offset = ctx->offset;
+ ptrdiff_t nbytes = vector_nbytes ((struct Lisp_Vector *) v);
+ if (nbytes > DUMP_OFF_MAX)
+ error ("vector too large");
+ dump_write (ctx, v, ptrdiff_t_to_dump_off (nbytes));
+ return offset;
+ }
+
+ static dump_off
+ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_20B7443AD7)
+ # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ struct Lisp_Subr out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, subr, header.size);
+ #ifdef HAVE_NATIVE_COMP
+ bool native_comp = !NILP (subr->native_comp_u);
+ #else
+ bool native_comp = false;
+ #endif
+ if (native_comp)
+ out.function.a0 = NULL;
+ else
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
+ DUMP_FIELD_COPY (&out, subr, min_args);
+ DUMP_FIELD_COPY (&out, subr, max_args);
+ if (native_comp)
+ {
+ dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
+ dump_remember_cold_op (ctx,
+ COLD_OP_NATIVE_SUBR,
+ make_lisp_ptr ((void *) subr, Lisp_Vectorlike));
+ dump_field_lv (ctx, &out, subr, &subr->intspec.native, WEIGHT_NORMAL);
+ dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL);
+ }
+ else
+ {
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec.string);
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes);
+ }
+ DUMP_FIELD_COPY (&out, subr, doc);
+ #ifdef HAVE_NATIVE_COMP
+ dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
+ if (!NILP (subr->native_comp_u))
+ dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name);
+
+ dump_field_lv (ctx, &out, subr, &subr->lambda_list, WEIGHT_NORMAL);
+ dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
+ #endif
+ dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
+ if (native_comp && ctx->flags.dump_object_contents)
+ /* We'll do the final addr relocation during VERY_LATE_RELOCS time
+ after the compilation units has been loaded. */
+ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
+ list2 (make_fixnum (RELOC_NATIVE_SUBR),
+ dump_off_to_lisp (subr_off)));
+ return subr_off;
+ }
+
+ #ifdef HAVE_NATIVE_COMP
+ static dump_off
+ dump_native_comp_unit (struct dump_context *ctx,
+ struct Lisp_Native_Comp_Unit *comp_u)
+ {
+ if (!CONSP (comp_u->file))
+ error ("Trying to dump non fixed-up eln file");
+
+ /* Have function documentation always lazy loaded to optimize load-time. */
+ comp_u->data_fdoc_v = Qnil;
+ START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header);
+ out->handle = NULL;
+
+ dump_off comp_u_off = finish_dump_pvec (ctx, &out->header);
+ if (ctx->flags.dump_object_contents)
+ /* We'll do the real elf load during LATE_RELOCS relocation time. */
+ dump_push (&ctx->dump_relocs[LATE_RELOCS],
+ list2 (make_fixnum (RELOC_NATIVE_COMP_UNIT),
+ dump_off_to_lisp (comp_u_off)));
+ return comp_u_off;
+ }
+ #endif
+
+ static void
+ fill_pseudovec (union vectorlike_header *header, Lisp_Object item)
+ {
+ struct Lisp_Vector *v = (struct Lisp_Vector *) header;
+ eassert (v->header.size & PSEUDOVECTOR_FLAG);
+ ptrdiff_t size = v->header.size & PSEUDOVECTOR_SIZE_MASK;
+ for (ptrdiff_t idx = 0; idx < size; idx++)
+ v->contents[idx] = item;
+ }
+
+ static dump_off
+ dump_nilled_pseudovec (struct dump_context *ctx,
+ const union vectorlike_header *in)
+ {
+ START_DUMP_PVEC (ctx, in, struct Lisp_Vector, out);
+ fill_pseudovec (&out->header, Qnil);
+ return finish_dump_pvec (ctx, &out->header);
+ }
+
+ static dump_off
+ dump_vectorlike (struct dump_context *ctx,
+ Lisp_Object lv,
+ dump_off offset)
+ {
+ #if CHECK_STRUCTS && !defined HASH_pvec_type_AFF6FED5BD
+ # error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ const struct Lisp_Vector *v = XVECTOR (lv);
+ switch (PSEUDOVECTOR_TYPE (v))
+ {
+ case PVEC_FONT:
+ /* There are three kinds of font objects that all use PVEC_FONT,
+ distinguished by their size. Font specs and entities are
+ harmless data carriers that we can dump like other Lisp
+ objects. Fonts themselves are window-system-specific and
+ need to be recreated on each startup. */
+ if ((v->header.size & PSEUDOVECTOR_SIZE_MASK) != FONT_SPEC_MAX
+ && (v->header.size & PSEUDOVECTOR_SIZE_MASK) != FONT_ENTITY_MAX)
+ error_unsupported_dump_object(ctx, lv, "font");
+ FALLTHROUGH;
+ case PVEC_NORMAL_VECTOR:
+ case PVEC_COMPILED:
+ case PVEC_CHAR_TABLE:
+ case PVEC_SUB_CHAR_TABLE:
+ case PVEC_RECORD:
+ offset = dump_vectorlike_generic (ctx, &v->header);
+ break;
+ case PVEC_BOOL_VECTOR:
+ offset = dump_bool_vector(ctx, v);
+ break;
+ case PVEC_HASH_TABLE:
+ offset = dump_hash_table (ctx, lv, offset);
+ break;
+ case PVEC_BUFFER:
+ offset = dump_buffer (ctx, XBUFFER (lv));
+ break;
+ case PVEC_SUBR:
+ offset = dump_subr (ctx, XSUBR (lv));
+ break;
+ case PVEC_FRAME:
+ case PVEC_WINDOW:
+ case PVEC_PROCESS:
+ case PVEC_TERMINAL:
+ offset = dump_nilled_pseudovec (ctx, &v->header);
+ break;
+ case PVEC_MARKER:
+ offset = dump_marker (ctx, XMARKER (lv));
+ break;
+ case PVEC_OVERLAY:
+ offset = dump_overlay (ctx, XOVERLAY (lv));
+ break;
+ case PVEC_FINALIZER:
+ offset = dump_finalizer (ctx, XFINALIZER (lv));
+ break;
+ case PVEC_BIGNUM:
+ offset = dump_bignum (ctx, lv);
+ break;
+ #ifdef HAVE_NATIVE_COMP
+ case PVEC_NATIVE_COMP_UNIT:
+ offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
+ break;
+ #endif
+ case PVEC_WINDOW_CONFIGURATION:
+ error_unsupported_dump_object (ctx, lv, "window configuration");
+ case PVEC_OTHER:
+ error_unsupported_dump_object (ctx, lv, "other?!");
+ case PVEC_XWIDGET:
+ error_unsupported_dump_object (ctx, lv, "xwidget");
+ case PVEC_XWIDGET_VIEW:
+ error_unsupported_dump_object (ctx, lv, "xwidget view");
+ case PVEC_MISC_PTR:
+ case PVEC_USER_PTR:
+ error_unsupported_dump_object (ctx, lv, "smuggled pointers");
+ case PVEC_THREAD:
+ if (main_thread_p (v))
+ {
+ eassert (dump_object_emacs_ptr (lv));
+ return DUMP_OBJECT_IS_RUNTIME_MAGIC;
+ }
+ error_unsupported_dump_object (ctx, lv, "thread");
+ case PVEC_MUTEX:
+ error_unsupported_dump_object (ctx, lv, "mutex");
+ case PVEC_CONDVAR:
+ error_unsupported_dump_object (ctx, lv, "condvar");
+ case PVEC_SQLITE:
+ error_unsupported_dump_object (ctx, lv, "sqlite");
+ case PVEC_MODULE_FUNCTION:
+ error_unsupported_dump_object (ctx, lv, "module function");
+ case PVEC_SYMBOL_WITH_POS:
+ error_unsupported_dump_object (ctx, lv, "symbol with pos");
+ default:
+ error_unsupported_dump_object(ctx, lv, "weird pseudovector");
+ }
+
+ return offset;
+ }
+
+ /* Add an object to the dump.
+
+ CTX is the dump context; OBJECT is the object to add. Normally,
+ return OFFSET, the location (in bytes, from the start of the dump
+ file) where we wrote the object. Valid OFFSETs are always greater
+ than zero.
+
+ If we've already dumped an object, return the location where we put
+ it: dump_object is idempotent.
+
+ The object must refer to an actual pointer-ish object of some sort.
+ Some self-representing objects are immediate values rather than
+ tagged pointers to Lisp heap structures and so have no individual
+ representation in the Lisp heap dump.
+
+ May also return one of the DUMP_OBJECT_ON_*_QUEUE constants if we
+ "dumped" the object by remembering to process it specially later.
+ In this case, we don't have a valid offset.
+ Call dump_object_for_offset if you need a valid offset for
+ an object.
+ */
+ static dump_off
+ dump_object (struct dump_context *ctx, Lisp_Object object)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_Lisp_Type_45F0582FD7)
+ # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ eassert (!EQ (object, dead_object ()));
+
+ dump_off offset = dump_recall_object (ctx, object);
+ if (offset > 0)
+ return offset; /* Object already dumped. */
+
+ bool cold = BOOL_VECTOR_P (object) || FLOATP (object);
+ if (cold && ctx->flags.defer_cold_objects)
+ {
+ if (offset != DUMP_OBJECT_ON_COLD_QUEUE)
+ {
+ eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
+ || offset == DUMP_OBJECT_NOT_SEEN);
+ offset = DUMP_OBJECT_ON_COLD_QUEUE;
+ dump_remember_object (ctx, object, offset);
+ dump_remember_cold_op (ctx, COLD_OP_OBJECT, object);
+ }
+ return offset;
+ }
+
+ void *obj_in_emacs = dump_object_emacs_ptr (object);
+ if (obj_in_emacs && ctx->flags.defer_copied_objects)
+ {
+ if (offset != DUMP_OBJECT_ON_COPIED_QUEUE)
+ {
+ eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
+ || offset == DUMP_OBJECT_NOT_SEEN);
+ /* Even though we're not going to dump this object right
+ away, we still want to scan and enqueue its
+ referents. */
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.dump_object_contents = false;
+ ctx->flags.defer_copied_objects = false;
+ dump_object (ctx, object);
+ ctx->flags = old_flags;
+
+ offset = DUMP_OBJECT_ON_COPIED_QUEUE;
+ dump_remember_object (ctx, object, offset);
+ dump_push (&ctx->copied_queue, object);
+ }
+ return offset;
+ }
+
+ /* Object needs to be dumped. */
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = object;
+ switch (XTYPE (object))
+ {
+ case Lisp_String:
+ offset = dump_string (ctx, XSTRING (object));
+ break;
+ case Lisp_Vectorlike:
+ offset = dump_vectorlike (ctx, object, offset);
+ break;
+ case Lisp_Symbol:
+ offset = dump_symbol (ctx, object, offset);
+ break;
+ case Lisp_Cons:
+ offset = dump_cons (ctx, XCONS (object));
+ break;
+ case Lisp_Float:
+ offset = dump_float (ctx, XFLOAT (object));
+ break;
+ case_Lisp_Int:
+ eassert ("should not be dumping int: is self-representing" && 0);
+ abort ();
+ default:
+ emacs_abort ();
+ }
+ dump_clear_referrer (ctx);
+
+ /* offset can be < 0 if we've deferred an object. */
+ if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN)
+ {
+ eassert (offset % DUMP_ALIGNMENT == 0);
+ dump_remember_object (ctx, object, offset);
+ if (ctx->flags.record_object_starts)
+ {
+ eassert (!ctx->flags.pack_objects);
+ dump_push (&ctx->object_starts,
+ list2 (dump_off_to_lisp (XTYPE (object)),
+ dump_off_to_lisp (offset)));
+ }
+ }
+
+ return offset;
+ }
+
+ /* Like dump_object(), but assert that we get a valid offset. */
+ static dump_off
+ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object)
+ {
+ dump_off offset = dump_object (ctx, object);
+ eassert (offset > 0);
+ return offset;
+ }
+
+ static dump_off
+ dump_charset (struct dump_context *ctx, int cs_i)
+ {
+ #if CHECK_STRUCTS && !defined (HASH_charset_317C49E291)
+ # error "charset changed. See CHECK_STRUCTS comment in config.h."
+ #endif
+ dump_align_output (ctx, alignof (struct charset));
+ const struct charset *cs = charset_table + cs_i;
+ struct charset out;
+ dump_object_start (ctx, &out, sizeof (out));
+ DUMP_FIELD_COPY (&out, cs, id);
+ DUMP_FIELD_COPY (&out, cs, hash_index);
+ DUMP_FIELD_COPY (&out, cs, dimension);
+ memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space));
+ if (cs_i < charset_table_used && cs->code_space_mask)
+ dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask);
+ DUMP_FIELD_COPY (&out, cs, code_linear_p);
+ DUMP_FIELD_COPY (&out, cs, iso_chars_96);
+ DUMP_FIELD_COPY (&out, cs, ascii_compatible_p);
+ DUMP_FIELD_COPY (&out, cs, supplementary_p);
+ DUMP_FIELD_COPY (&out, cs, compact_codes_p);
+ DUMP_FIELD_COPY (&out, cs, unified_p);
+ DUMP_FIELD_COPY (&out, cs, iso_final);
+ DUMP_FIELD_COPY (&out, cs, iso_revision);
+ DUMP_FIELD_COPY (&out, cs, emacs_mule_id);
+ DUMP_FIELD_COPY (&out, cs, method);
+ DUMP_FIELD_COPY (&out, cs, min_code);
+ DUMP_FIELD_COPY (&out, cs, max_code);
+ DUMP_FIELD_COPY (&out, cs, char_index_offset);
+ DUMP_FIELD_COPY (&out, cs, min_char);
+ DUMP_FIELD_COPY (&out, cs, max_char);
+ DUMP_FIELD_COPY (&out, cs, invalid_code);
+ memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map));
+ DUMP_FIELD_COPY (&out, cs, code_offset);
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (cs_i < charset_table_used && cs->code_space_mask)
+ dump_remember_cold_op (ctx, COLD_OP_CHARSET,
+ Fcons (dump_off_to_lisp (cs_i),
+ dump_off_to_lisp (offset)));
+ return offset;
+ }
+
+ static dump_off
+ dump_charset_table (struct dump_context *ctx)
+ {
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off offset = ctx->offset;
+ /* We are dumping the entire table, not just the used slots, because
+ otherwise when we restore from the pdump file, the actual size of
+ the table will be smaller than charset_table_size, and we will
+ crash if/when a new charset is defined. */
+ for (int i = 0; i < charset_table_size; ++i)
+ dump_charset (ctx, i);
+ dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset);
+ ctx->flags = old_flags;
+ return offset;
+ }
+
+ static void
+ dump_finalizer_list_head_ptr (struct dump_context *ctx,
+ struct Lisp_Finalizer **ptr)
+ {
+ struct Lisp_Finalizer *value = *ptr;
+ if (value != &finalizers && value != &doomed_finalizers)
+ dump_emacs_reloc_to_dump_ptr_raw
+ (ctx, ptr,
+ dump_object_for_offset (ctx,
+ make_lisp_ptr (value, Lisp_Vectorlike)));
+ }
+
+ static void
+ dump_metadata_for_pdumper (struct dump_context *ctx)
+ {
+ for (int i = 0; i < nr_dump_hooks; ++i)
+ dump_emacs_reloc_to_emacs_ptr_raw (ctx, &dump_hooks[i],
+ (void const *) dump_hooks[i]);
+ dump_emacs_reloc_immediate_int (ctx, &nr_dump_hooks, nr_dump_hooks);
+
+ for (int i = 0; i < nr_dump_late_hooks; ++i)
+ dump_emacs_reloc_to_emacs_ptr_raw (ctx, &dump_late_hooks[i],
+ (void const *) dump_late_hooks[i]);
+ dump_emacs_reloc_immediate_int (ctx, &nr_dump_late_hooks,
+ nr_dump_late_hooks);
+
+ for (int i = 0; i < nr_remembered_data; ++i)
+ {
+ dump_emacs_reloc_to_emacs_ptr_raw (ctx, &remembered_data[i].mem,
+ remembered_data[i].mem);
+ dump_emacs_reloc_immediate_int (ctx, &remembered_data[i].sz,
+ remembered_data[i].sz);
+ }
+ dump_emacs_reloc_immediate_int (ctx, &nr_remembered_data,
+ nr_remembered_data);
+ }
+
+ /* Sort the list of copied objects in CTX. */
+ static void
+ dump_sort_copied_objects (struct dump_context *ctx)
+ {
+ /* Sort the objects into the order in which they'll appear in the
+ Emacs: this way, on startup, we'll do both the IO from the dump
+ file and the copy into Emacs in-order, where prefetch will be
+ most effective. */
+ ctx->copied_queue =
+ Fsort (Fnreverse (ctx->copied_queue),
+ Qdump_emacs_portable__sort_predicate_copied);
+ }
+
+ /* Dump parts of copied objects we need at runtime. */
+ static void
+ dump_hot_parts_of_discardable_objects (struct dump_context *ctx)
+ {
+ Lisp_Object copied_queue = ctx->copied_queue;
+ while (!NILP (copied_queue))
+ {
+ Lisp_Object copied = dump_pop (&copied_queue);
+ if (SYMBOLP (copied))
+ {
+ eassert (dump_builtin_symbol_p (copied));
+ dump_pre_dump_symbol (ctx, XSYMBOL (copied));
+ }
+ }
+ }
+
+ static void
+ dump_drain_copied_objects (struct dump_context *ctx)
+ {
+ Lisp_Object copied_queue = ctx->copied_queue;
+ ctx->copied_queue = Qnil;
+
+ struct dump_flags old_flags = ctx->flags;
+
+ /* We should have already fully scanned these objects, so assert
+ that we're not adding more entries to the dump queue. */
+ ctx->flags.assert_already_seen = true;
+
+ /* Now we want to actually dump the copied objects, not just record
+ them. */
+ ctx->flags.defer_copied_objects = false;
+
+ /* Objects that we memcpy into Emacs shouldn't get object-start
+ records (which conservative GC looks at): we usually discard this
+ memory after we're finished memcpying, and even if we don't, the
+ "real" objects in this section all live in the Emacs image, not
+ in the dump. */
+ ctx->flags.record_object_starts = false;
+
+ /* Dump the objects and generate a copy relocation for each. Don't
+ bother trying to reduce the number of copy relocations we
+ generate: we'll merge adjacent copy relocations upon output.
+ The overall result is that to the greatest extent possible while
+ maintaining strictly increasing address order, we copy into Emacs
+ in nice big chunks. */
+ while (!NILP (copied_queue))
+ {
+ Lisp_Object copied = dump_pop (&copied_queue);
+ void *optr = dump_object_emacs_ptr (copied);
+ eassert (optr != NULL);
+ /* N.B. start_offset is beyond any padding we insert. */
+ dump_off start_offset = dump_object (ctx, copied);
+ if (start_offset != DUMP_OBJECT_IS_RUNTIME_MAGIC)
+ {
+ dump_off size = ctx->offset - start_offset;
+ dump_emacs_reloc_copy_from_dump (ctx, start_offset, optr, size);
+ }
+ }
+
+ ctx->flags = old_flags;
+ }
+
+ static void
+ dump_cold_string (struct dump_context *ctx, Lisp_Object string)
+ {
+ /* Dump string contents. */
+ dump_off string_offset = dump_recall_object (ctx, string);
+ eassert (string_offset > 0);
+ if (SBYTES (string) > DUMP_OFF_MAX - 1)
+ error ("string too large");
+ dump_off total_size = ptrdiff_t_to_dump_off (SBYTES (string) + 1);
+ eassert (total_size > 0);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ string_offset + dump_offsetof (struct Lisp_String, u.s.data),
+ ctx->offset);
+ dump_write (ctx, XSTRING (string)->u.s.data, total_size);
+ }
+
+ static void
+ dump_cold_charset (struct dump_context *ctx, Lisp_Object data)
+ {
+ /* Dump charset lookup tables. */
+ int cs_i = XFIXNUM (XCAR (data));
+ dump_off cs_dump_offset = dump_off_from_lisp (XCDR (data));
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ cs_dump_offset + dump_offsetof (struct charset, code_space_mask),
+ ctx->offset);
+ struct charset *cs = charset_table + cs_i;
+ dump_write (ctx, cs->code_space_mask, 256);
+ }
+
+ static void
+ dump_cold_buffer (struct dump_context *ctx, Lisp_Object data)
+ {
+ /* Dump buffer text. */
+ dump_off buffer_offset = dump_recall_object (ctx, data);
+ eassert (buffer_offset > 0);
+ struct buffer *b = XBUFFER (data);
+ eassert (b->text == &b->own_text);
+ /* Zero the gap so we don't dump uninitialized bytes. */
+ memset (BUF_GPT_ADDR (b), 0, BUF_GAP_SIZE (b));
+ /* See buffer.c for this calculation. */
+ ptrdiff_t nbytes =
+ BUF_Z_BYTE (b)
+ - BUF_BEG_BYTE (b)
+ + BUF_GAP_SIZE (b)
+ + 1;
+ if (nbytes > DUMP_OFF_MAX)
+ error ("buffer too large");
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ buffer_offset + dump_offsetof (struct buffer, own_text.beg),
+ ctx->offset);
+ dump_write (ctx, b->own_text.beg, ptrdiff_t_to_dump_off (nbytes));
+ }
+
+ static void
+ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
+ {
+ mpz_t const *n = xbignum_val (object);
+ size_t sz_nlimbs = mpz_size (*n);
+ eassert (sz_nlimbs < DUMP_OFF_MAX);
+ dump_align_output (ctx, alignof (mp_limb_t));
+ dump_off nlimbs = (dump_off) sz_nlimbs;
+ Lisp_Object descriptor
+ = list2 (dump_off_to_lisp (ctx->offset),
+ dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
+ Fputhash (object, descriptor, ctx->bignum_data);
+ for (mp_size_t i = 0; i < nlimbs; ++i)
+ {
+ mp_limb_t limb = mpz_getlimbn (*n, i);
+ dump_write (ctx, &limb, sizeof (limb));
+ }
+ }
+
+ #ifdef HAVE_NATIVE_COMP
+ static void
+ dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
+ {
+ /* Dump subr contents. */
+ dump_off subr_offset = dump_recall_object (ctx, subr);
+ eassert (subr_offset > 0);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ subr_offset + dump_offsetof (struct Lisp_Subr, symbol_name),
+ ctx->offset);
+ const char *symbol_name = XSUBR (subr)->symbol_name;
+ dump_write (ctx, symbol_name, 1 + strlen (symbol_name));
+
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name),
+ ctx->offset);
+ const char *c_name = XSUBR (subr)->native_c_name;
+ dump_write (ctx, c_name, 1 + strlen (c_name));
+ }
+ #endif
+
+ static void
+ dump_drain_cold_data (struct dump_context *ctx)
+ {
+ Lisp_Object cold_queue = Fnreverse (ctx->cold_queue);
+ ctx->cold_queue = Qnil;
+
+ struct dump_flags old_flags = ctx->flags;
+
+ /* We should have already scanned all objects to which our cold
+ objects refer, so die if an object points to something we haven't
+ seen. */
+ ctx->flags.assert_already_seen = true;
+
+ /* Actually dump cold objects instead of deferring them. */
+ ctx->flags.defer_cold_objects = false;
+
+ while (!NILP (cold_queue))
+ {
+ Lisp_Object item = dump_pop (&cold_queue);
+ enum cold_op op = (enum cold_op) XFIXNUM (XCAR (item));
+ Lisp_Object data = XCDR (item);
+ switch (op)
+ {
+ case COLD_OP_STRING:
+ dump_cold_string (ctx, data);
+ break;
+ case COLD_OP_CHARSET:
+ dump_cold_charset (ctx, data);
+ break;
+ case COLD_OP_BUFFER:
+ dump_cold_buffer (ctx, data);
+ break;
+ case COLD_OP_OBJECT:
+ /* Objects that we can put in the cold section
+ must not refer to other objects. */
+ eassert (dump_queue_empty_p (&ctx->dump_queue));
+ eassert (ctx->flags.dump_object_contents);
+ dump_object (ctx, data);
+ eassert (dump_queue_empty_p (&ctx->dump_queue));
+ break;
+ case COLD_OP_BIGNUM:
+ dump_cold_bignum (ctx, data);
+ break;
+ #ifdef HAVE_NATIVE_COMP
+ case COLD_OP_NATIVE_SUBR:
+ dump_cold_native_subr (ctx, data);
+ break;
+ #endif
+ default:
+ emacs_abort ();
+ }
+ }
+
+ ctx->flags = old_flags;
+ }
+
+ static void
+ read_ptr_raw_and_lv (const void *mem,
+ enum Lisp_Type type,
+ void **out_ptr,
+ Lisp_Object *out_lv)
+ {
+ memcpy (out_ptr, mem, sizeof (*out_ptr));
+ if (*out_ptr != NULL)
+ {
+ switch (type)
+ {
+ case Lisp_Symbol:
+ *out_lv = make_lisp_symbol (*out_ptr);
+ break;
+ case Lisp_String:
+ case Lisp_Vectorlike:
+ case Lisp_Cons:
+ case Lisp_Float:
+ *out_lv = make_lisp_ptr (*out_ptr, type);
+ break;
+ default:
+ emacs_abort ();
+ }
+ }
+ }
+
+ /* Enqueue for dumping objects referenced by static non-Lisp_Object
+ pointers inside Emacs. */
+ static void
+ dump_drain_user_remembered_data_hot (struct dump_context *ctx)
+ {
+ for (int i = 0; i < nr_remembered_data; ++i)
+ {
+ void *mem = remembered_data[i].mem;
+ int sz = remembered_data[i].sz;
+ if (sz <= 0)
+ {
+ enum Lisp_Type type = -sz;
+ void *value;
+ Lisp_Object lv;
+ read_ptr_raw_and_lv (mem, type, &value, &lv);
+ if (value != NULL)
+ {
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = dump_ptr_referrer ("user data", mem);
+ dump_enqueue_object (ctx, lv, WEIGHT_NONE);
+ dump_clear_referrer (ctx);
+ }
+ }
+ }
+ }
+
+ /* Dump user-specified non-relocated data. */
+ static void
+ dump_drain_user_remembered_data_cold (struct dump_context *ctx)
+ {
+ for (int i = 0; i < nr_remembered_data; ++i)
+ {
+ void *mem = remembered_data[i].mem;
+ int sz = remembered_data[i].sz;
+ if (sz > 0)
+ {
+ /* Scalar: try to inline the value into the relocation if
+ it's small enough; if it's bigger than we can fit in a
+ relocation, we have to copy the data into the dump proper
+ and emit a copy relocation. */
+ if (sz <= sizeof (intmax_t))
+ dump_emacs_reloc_immediate (ctx, mem, mem, sz);
+ else
+ {
+ dump_emacs_reloc_copy_from_dump (ctx, ctx->offset, mem, sz);
+ dump_write (ctx, mem, sz);
+ }
+ }
+ else
+ {
+ /* *mem is a raw pointer to a Lisp object of some sort.
+ The object to which it points should have already been
+ dumped by dump_drain_user_remembered_data_hot. */
+ void *value;
+ Lisp_Object lv;
+ enum Lisp_Type type = -sz;
+ read_ptr_raw_and_lv (mem, type, &value, &lv);
+ if (value == NULL)
+ /* We can't just ignore NULL: the variable might have
+ transitioned from non-NULL to NULL, and we want to
+ record this fact. */
+ dump_emacs_reloc_immediate_ptrdiff_t (ctx, mem, 0);
+ else
+ {
+ if (dump_object_emacs_ptr (lv) != NULL)
+ {
+ /* We have situation like this:
+
+ static Lisp_Symbol *foo;
+ ...
+ foo = XSYMBOL(Qt);
+ ...
+ pdumper_remember_lv_ptr_raw (&foo, Lisp_Symbol);
+
+ Built-in symbols like Qt aren't in the dump!
+ They're actually in Emacs proper. We need a
+ special case to point this value back at Emacs
+ instead of to something in the dump that
+ isn't there.
+
+ An analogous situation applies to subrs, since
+ Lisp_Subr structures always live in Emacs, not
+ the dump.
+ */
+ dump_emacs_reloc_to_emacs_ptr_raw
+ (ctx, mem, dump_object_emacs_ptr (lv));
+ }
+ else
+ {
+ eassert (!dump_object_self_representing_p (lv));
+ dump_off dump_offset = dump_recall_object (ctx, lv);
+ if (dump_offset <= 0)
+ error ("raw-pointer object not dumped?!");
+ dump_emacs_reloc_to_dump_ptr_raw (ctx, mem, dump_offset);
+ }
+ }
+ }
+ }
+ }
+
+ static void
+ dump_unwind_cleanup (void *data)
+ {
+ struct dump_context *ctx = data;
+ if (ctx->fd >= 0)
+ emacs_close (ctx->fd);
+ #ifdef REL_ALLOC
+ if (ctx->blocked_ralloc)
+ r_alloc_inhibit_buffer_relocation (0);
+ #endif
+ Vpurify_flag = ctx->old_purify_flag;
+ Vpost_gc_hook = ctx->old_post_gc_hook;
+ Vprocess_environment = ctx->old_process_environment;
+ }
+
+ /* Check that DUMP_OFFSET is within the heap. */
+ static void
+ dump_check_dump_off (struct dump_context *ctx, dump_off dump_offset)
+ {
+ eassert (dump_offset > 0);
+ eassert (!ctx || dump_offset < ctx->end_heap);
+ }
+
+ static void
+ dump_check_emacs_off (dump_off emacs_off)
+ {
+ eassert (labs (emacs_off) <= 60 * 1024 * 1024);
+ }
+
+ static struct dump_reloc
+ dump_decode_dump_reloc (Lisp_Object lreloc)
+ {
+ struct dump_reloc reloc;
+ dump_reloc_set_type (&reloc,
+ (enum dump_reloc_type) XFIXNUM (dump_pop (&lreloc)));
+ eassert (reloc.type <= RELOC_DUMP_TO_EMACS_LV + Lisp_Float);
+ dump_reloc_set_offset (&reloc, dump_off_from_lisp (dump_pop (&lreloc)));
+ eassert (NILP (lreloc));
+ return reloc;
+ }
+
+ static void
+ dump_emit_dump_reloc (struct dump_context *ctx, Lisp_Object lreloc)
+ {
+ eassert (ctx->flags.pack_objects);
+ struct dump_reloc reloc;
+ dump_object_start (ctx, &reloc, sizeof (reloc));
+ reloc = dump_decode_dump_reloc (lreloc);
+ dump_check_dump_off (ctx, dump_reloc_get_offset (reloc));
+ dump_object_finish (ctx, &reloc, sizeof (reloc));
+ if (dump_reloc_get_offset (reloc) < ctx->header.discardable_start)
+ ctx->number_hot_relocations += 1;
+ else
+ ctx->number_discardable_relocations += 1;
+ }
+
+ #ifdef ENABLE_CHECKING
+ static Lisp_Object
+ dump_check_overlap_dump_reloc (Lisp_Object lreloc_a,
+ Lisp_Object lreloc_b)
+ {
+ struct dump_reloc reloc_a = dump_decode_dump_reloc (lreloc_a);
+ struct dump_reloc reloc_b = dump_decode_dump_reloc (lreloc_b);
+ eassert (dump_reloc_get_offset (reloc_a) < dump_reloc_get_offset (reloc_b));
+ return Qnil;
+ }
+ #endif
+
+ /* Translate a Lisp Emacs-relocation descriptor (a list whose first
+ element is one of the EMACS_RELOC_* values, encoded as a fixnum)
+ into an emacs_reloc structure value suitable for writing to the
+ dump file.
+ */
+ static struct emacs_reloc
+ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
+ {
+ struct emacs_reloc reloc = {0};
+ int type = XFIXNUM (dump_pop (&lreloc));
+ reloc.emacs_offset = dump_off_from_lisp (dump_pop (&lreloc));
+ dump_check_emacs_off (reloc.emacs_offset);
+ switch (type)
+ {
+ case RELOC_EMACS_COPY_FROM_DUMP:
+ {
+ emacs_reloc_set_type (&reloc, type);
+ reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
+ dump_check_dump_off (ctx, reloc.u.dump_offset);
+ dump_off length = dump_off_from_lisp (dump_pop (&lreloc));
+ reloc.length = length;
+ if (reloc.length != length)
+ error ("relocation copy length too large");
+ }
+ break;
+ case RELOC_EMACS_IMMEDIATE:
+ {
+ emacs_reloc_set_type (&reloc, type);
+ intmax_t value = intmax_t_from_lisp (dump_pop (&lreloc));
+ dump_off size = dump_off_from_lisp (dump_pop (&lreloc));
+ reloc.u.immediate = value;
+ reloc.length = size;
+ eassert (reloc.length == size);
+ }
+ break;
+ case RELOC_EMACS_EMACS_PTR_RAW:
+ emacs_reloc_set_type (&reloc, type);
+ reloc.u.emacs_offset2 = dump_off_from_lisp (dump_pop (&lreloc));
+ dump_check_emacs_off (reloc.u.emacs_offset2);
+ break;
+ case RELOC_EMACS_DUMP_PTR_RAW:
+ emacs_reloc_set_type (&reloc, type);
+ reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
+ dump_check_dump_off (ctx, reloc.u.dump_offset);
+ break;
+ case RELOC_EMACS_DUMP_LV:
+ case RELOC_EMACS_EMACS_LV:
+ {
+ emacs_reloc_set_type (&reloc, type);
+ Lisp_Object target_value = dump_pop (&lreloc);
+ /* If the object is self-representing,
+ dump_emacs_reloc_to_lv didn't do its job.
+ dump_emacs_reloc_to_lv should have added a
+ RELOC_EMACS_IMMEDIATE relocation instead. */
+ eassert (!dump_object_self_representing_p (target_value));
+ int tag_type = XTYPE (target_value);
+ reloc.length = tag_type;
+ eassert (reloc.length == tag_type);
+
+ if (type == RELOC_EMACS_EMACS_LV)
+ {
+ void *obj_in_emacs = dump_object_emacs_ptr (target_value);
+ eassert (obj_in_emacs);
+ reloc.u.emacs_offset2 = emacs_offset (obj_in_emacs);
+ }
+ else
+ {
+ eassume (ctx); /* Pacify GCC 9.2.1 -O3 -Wnull-dereference. */
+ eassert (!dump_object_emacs_ptr (target_value));
+ reloc.u.dump_offset = dump_recall_object (ctx, target_value);
+ if (reloc.u.dump_offset <= 0)
+ {
+ Lisp_Object repr = Fprin1_to_string (target_value, Qnil, Qnil);
+ error ("relocation target was not dumped: %s", SDATA (repr));
+ }
+ dump_check_dump_off (ctx, reloc.u.dump_offset);
+ }
+ }
+ break;
+ default:
+ eassume (!"not reached");
+ }
+
+ /* We should have consumed the whole relocation descriptor. */
+ eassert (NILP (lreloc));
+
+ return reloc;
+ }
+
+ static void
+ dump_emit_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
+ {
+ eassert (ctx->flags.pack_objects);
+ struct emacs_reloc reloc;
+ dump_object_start (ctx, &reloc, sizeof (reloc));
+ reloc = decode_emacs_reloc (ctx, lreloc);
+ dump_object_finish (ctx, &reloc, sizeof (reloc));
+ }
+
+ static Lisp_Object
+ dump_merge_emacs_relocs (Lisp_Object lreloc_a, Lisp_Object lreloc_b)
+ {
+ /* Combine copy relocations together if they're copying from
+ adjacent chunks to adjacent chunks. */
+
+ #ifdef ENABLE_CHECKING
+ {
+ dump_off off_a = dump_off_from_lisp (XCAR (XCDR (lreloc_a)));
+ dump_off off_b = dump_off_from_lisp (XCAR (XCDR (lreloc_b)));
+ eassert (off_a <= off_b); /* Catch sort errors. */
+ eassert (off_a < off_b); /* Catch duplicate relocations. */
+ }
+ #endif
+
+ if (XFIXNUM (XCAR (lreloc_a)) != RELOC_EMACS_COPY_FROM_DUMP
+ || XFIXNUM (XCAR (lreloc_b)) != RELOC_EMACS_COPY_FROM_DUMP)
+ return Qnil;
+
+ struct emacs_reloc reloc_a = decode_emacs_reloc (NULL, lreloc_a);
+ struct emacs_reloc reloc_b = decode_emacs_reloc (NULL, lreloc_b);
+
+ eassert (reloc_a.type == RELOC_EMACS_COPY_FROM_DUMP);
+ eassert (reloc_b.type == RELOC_EMACS_COPY_FROM_DUMP);
+
+ if (reloc_a.emacs_offset + reloc_a.length != reloc_b.emacs_offset)
+ return Qnil;
+
+ if (reloc_a.u.dump_offset + reloc_a.length != reloc_b.u.dump_offset)
+ return Qnil;
+
+ dump_off new_length = reloc_a.length + reloc_b.length;
+ reloc_a.length = new_length;
+ if (reloc_a.length != new_length)
+ return Qnil; /* Overflow */
+
+ return list4 (make_fixnum (RELOC_EMACS_COPY_FROM_DUMP),
+ dump_off_to_lisp (reloc_a.emacs_offset),
+ dump_off_to_lisp (reloc_a.u.dump_offset),
+ dump_off_to_lisp (reloc_a.length));
+ }
+
+ typedef void (*drain_reloc_handler) (struct dump_context *, Lisp_Object);
+ typedef Lisp_Object (*drain_reloc_merger) (Lisp_Object a, Lisp_Object b);
+
+ static void
+ drain_reloc_list (struct dump_context *ctx,
+ drain_reloc_handler handler,
+ drain_reloc_merger merger,
+ Lisp_Object *reloc_list,
+ struct dump_table_locator *out_locator)
+ {
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+ Lisp_Object relocs = Fsort (Fnreverse (*reloc_list),
+ Qdump_emacs_portable__sort_predicate);
+ *reloc_list = Qnil;
+ dump_align_output (ctx, max (alignof (struct dump_reloc),
+ alignof (struct emacs_reloc)));
+ struct dump_table_locator locator = {0};
+ locator.offset = ctx->offset;
+ for (; !NILP (relocs); locator.nr_entries += 1)
+ {
+ Lisp_Object reloc = dump_pop (&relocs);
+ Lisp_Object merged;
+ while (merger != NULL
+ && !NILP (relocs)
+ && (merged = merger (reloc, XCAR (relocs)), !NILP (merged)))
+ {
+ reloc = merged;
+ relocs = XCDR (relocs);
+ }
+ handler (ctx, reloc);
+ }
+ *out_locator = locator;
+ ctx->flags = old_flags;
+ }
+
+ static void
+ dump_do_fixup (struct dump_context *ctx,
+ Lisp_Object fixup,
+ Lisp_Object prev_fixup)
+ {
+ enum dump_fixup_type type =
+ (enum dump_fixup_type) XFIXNUM (dump_pop (&fixup));
+ dump_off dump_fixup_offset = dump_off_from_lisp (dump_pop (&fixup));
+ #ifdef ENABLE_CHECKING
+ if (!NILP (prev_fixup))
+ {
+ dump_off prev_dump_fixup_offset =
+ dump_off_from_lisp (XCAR (XCDR (prev_fixup)));
+ eassert (dump_fixup_offset - prev_dump_fixup_offset
+ >= sizeof (void *));
+ }
+ #endif
+ Lisp_Object arg = dump_pop (&fixup);
+ eassert (NILP (fixup));
+ dump_seek (ctx, dump_fixup_offset);
+ intptr_t dump_value;
+ bool do_write = true;
+ switch (type)
+ {
+ case DUMP_FIXUP_LISP_OBJECT:
+ case DUMP_FIXUP_LISP_OBJECT_RAW:
+ /* Dump wants a pointer to a Lisp object.
+ If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in
+ the dump; otherwise, a Lisp_Object. */
+ if (SUBRP (arg) && !SUBR_NATIVE_COMPILEDP (arg))
+ {
+ dump_value = emacs_offset (XSUBR (arg));
+ if (type == DUMP_FIXUP_LISP_OBJECT)
+ dump_reloc_dump_to_emacs_lv (ctx, ctx->offset, XTYPE (arg));
+ else
+ dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->offset);
+ }
+ else if (dump_builtin_symbol_p (arg))
+ {
+ eassert (dump_object_self_representing_p (arg));
+ /* These symbols are part of Emacs, so point there. If we
+ want a Lisp_Object, we're set. If we want a raw pointer,
+ we need to emit a relocation. */
+ if (type == DUMP_FIXUP_LISP_OBJECT)
+ {
+ do_write = false;
+ dump_write (ctx, &arg, sizeof (arg));
+ }
+ else
+ {
+ dump_value = emacs_offset (XSYMBOL (arg));
+ dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->offset);
+ }
+ }
+ else
+ {
+ eassert (dump_object_emacs_ptr (arg) == NULL);
+ dump_value = dump_recall_object (ctx, arg);
+ if (dump_value <= 0)
+ error ("fixup object not dumped");
+ if (type == DUMP_FIXUP_LISP_OBJECT)
+ dump_reloc_dump_to_dump_lv (ctx, ctx->offset, XTYPE (arg));
+ else
+ dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->offset);
+ }
+ break;
+ case DUMP_FIXUP_PTR_DUMP_RAW:
+ /* Dump wants a raw pointer to something that's not a lisp
+ object. It knows the exact location it wants, so just
+ believe it. */
+ dump_value = dump_off_from_lisp (arg);
+ dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->offset);
+ break;
+ case DUMP_FIXUP_BIGNUM_DATA:
+ {
+ eassert (BIGNUMP (arg));
+ arg = Fgethash (arg, ctx->bignum_data, Qnil);
+ if (NILP (arg))
+ error ("bignum not dumped");
+ struct bignum_reload_info reload_info = { 0 };
+ reload_info.data_location = dump_off_from_lisp (dump_pop (&arg));
+ reload_info.nlimbs = dump_off_from_lisp (dump_pop (&arg));
+ eassert (NILP (arg));
+ dump_write (ctx, &reload_info, sizeof (reload_info));
+ do_write = false;
+ break;
+ }
+ default:
+ emacs_abort ();
+ }
+ if (do_write)
+ dump_write (ctx, &dump_value, sizeof (dump_value));
+ }
+
+ static void
+ dump_do_fixups (struct dump_context *ctx)
+ {
+ dump_off saved_offset = ctx->offset;
+ Lisp_Object fixups = Fsort (Fnreverse (ctx->fixups),
+ Qdump_emacs_portable__sort_predicate);
+ Lisp_Object prev_fixup = Qnil;
+ ctx->fixups = Qnil;
+ while (!NILP (fixups))
+ {
+ Lisp_Object fixup = dump_pop (&fixups);
+ dump_do_fixup (ctx, fixup, prev_fixup);
+ prev_fixup = fixup;
+ }
+ dump_seek (ctx, saved_offset);
+ }
+
+ static void
+ dump_drain_normal_queue (struct dump_context *ctx)
+ {
+ while (!dump_queue_empty_p (&ctx->dump_queue))
+ dump_object (ctx, dump_queue_dequeue (&ctx->dump_queue, ctx->offset));
+ }
+
+ static void
+ dump_drain_deferred_hash_tables (struct dump_context *ctx)
+ {
+ struct dump_flags old_flags = ctx->flags;
+
+ /* Now we want to actually write the hash tables. */
+ ctx->flags.defer_hash_tables = false;
+
+ Lisp_Object deferred_hash_tables = Fnreverse (ctx->deferred_hash_tables);
+ ctx->deferred_hash_tables = Qnil;
+ while (!NILP (deferred_hash_tables))
+ dump_object (ctx, dump_pop (&deferred_hash_tables));
+ ctx->flags = old_flags;
+ }
+
+ static void
+ dump_drain_deferred_symbols (struct dump_context *ctx)
+ {
+ struct dump_flags old_flags = ctx->flags;
+
+ /* Now we want to actually write the symbols. */
+ ctx->flags.defer_symbols = false;
+
+ Lisp_Object deferred_symbols = Fnreverse (ctx->deferred_symbols);
+ ctx->deferred_symbols = Qnil;
+ while (!NILP (deferred_symbols))
+ dump_object (ctx, dump_pop (&deferred_symbols));
+ ctx->flags = old_flags;
+ }
+
+ DEFUN ("dump-emacs-portable",
+ Fdump_emacs_portable, Sdump_emacs_portable,
+ 1, 2, 0,
+ doc: /* Dump current state of Emacs into dump file FILENAME.
+ If TRACK-REFERRERS is non-nil, keep additional debugging information
+ that can help track down the provenance of unsupported object
+ types. */)
+ (Lisp_Object filename, Lisp_Object track_referrers)
+ {
+ eassert (initialized);
+
+ if (! noninteractive)
+ error ("Dumping Emacs currently works only in batch mode. "
+ "If you'd like it to work interactively, please consider "
+ "contributing a patch to Emacs.");
+
+ if (will_dump_with_unexec_p ())
+ error ("This Emacs instance was started under the assumption "
+ "that it would be dumped with unexec, not the portable "
+ "dumper. Dumping with the portable dumper may produce "
+ "unexpected results.");
+
+ if (!main_thread_p (current_thread))
+ error ("This function can be called only in the main thread");
+
+ if (!NILP (XCDR (Fall_threads ())))
+ error ("No other Lisp threads can be running when this function is called");
+
+ check_pure_size ();
+
+ /* Clear out any detritus in memory. */
+ do
+ {
+ number_finalizers_run = 0;
+ garbage_collect ();
+ }
+ while (number_finalizers_run);
+
+ specpdl_ref count = SPECPDL_INDEX ();
+
+ /* Bind `command-line-processed' to nil before dumping,
+ so that the dumped Emacs will process its command line
+ and set up to work with X windows if appropriate. */
+ Lisp_Object symbol = intern ("command-line-processed");
+ specbind (symbol, Qnil);
+
+ CHECK_STRING (filename);
+ filename = Fexpand_file_name (filename, Qnil);
+ filename = ENCODE_FILE (filename);
+
+ struct dump_context ctx_buf = {0};
+ struct dump_context *ctx = &ctx_buf;
+ ctx->fd = -1;
+
+ ctx->objects_dumped = make_eq_hash_table ();
+ dump_queue_init (&ctx->dump_queue);
+ ctx->deferred_hash_tables = Qnil;
+ ctx->deferred_symbols = Qnil;
+
+ ctx->fixups = Qnil;
+ ctx->staticpro_table = Fmake_hash_table (0, NULL);
+ ctx->symbol_aux = Qnil;
+ ctx->copied_queue = Qnil;
+ ctx->cold_queue = Qnil;
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ ctx->dump_relocs[i] = Qnil;
+ ctx->object_starts = Qnil;
+ ctx->emacs_relocs = Qnil;
+ ctx->bignum_data = make_eq_hash_table ();
+
+ /* Ordinarily, dump_object should remember where it saw objects and
+ actually write the object contents to the dump file. In special
+ circumstances below, we temporarily change this default
+ behavior. */
+ ctx->flags.dump_object_contents = true;
+ ctx->flags.record_object_starts = true;
+
+ /* We want to consolidate certain object types that we know are very likely
+ to be modified. */
+ ctx->flags.defer_hash_tables = true;
+ /* ctx->flags.defer_symbols = true; XXX */
+
+ /* These objects go into special sections. */
+ ctx->flags.defer_cold_objects = true;
+ ctx->flags.defer_copied_objects = true;
+
+ ctx->current_referrer = Qnil;
+ if (!NILP (track_referrers))
+ ctx->referrers = make_eq_hash_table ();
+
+ ctx->dump_filename = filename;
+
+ record_unwind_protect_ptr (dump_unwind_cleanup, ctx);
+ block_input ();
+
+ #ifdef REL_ALLOC
+ r_alloc_inhibit_buffer_relocation (1);
+ ctx->blocked_ralloc = true;
+ #endif
+
+ ctx->old_purify_flag = Vpurify_flag;
+ Vpurify_flag = Qnil;
+
+ /* Make sure various weird things are less likely to happen. */
+ ctx->old_post_gc_hook = Vpost_gc_hook;
+ Vpost_gc_hook = Qnil;
+
+ /* Reset process-environment -- this is for when they re-dump a
+ pdump-restored emacs, since set_initial_environment wants always
+ to cons it from scratch. */
+ ctx->old_process_environment = Vprocess_environment;
+ Vprocess_environment = Qnil;
+
+ ctx->fd = emacs_open (SSDATA (filename),
+ O_RDWR | O_TRUNC | O_CREAT, 0666);
+ if (ctx->fd < 0)
+ report_file_error ("Opening dump output", filename);
+ verify (sizeof (ctx->header.magic) == sizeof (dump_magic));
+ memcpy (&ctx->header.magic, dump_magic, sizeof (dump_magic));
+ ctx->header.magic[0] = '!'; /* Note that dump is incomplete. */
+
+ verify (sizeof (fingerprint) == sizeof (ctx->header.fingerprint));
+ for (int i = 0; i < sizeof fingerprint; i++)
+ ctx->header.fingerprint[i] = fingerprint[i];
+
+ const dump_off header_start = ctx->offset;
+ dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint);
+ dump_write (ctx, &ctx->header, sizeof (ctx->header));
+ const dump_off header_end = ctx->offset;
+
+ const dump_off hot_start = ctx->offset;
+ /* Start the dump process by processing the static roots and
+ queuing up the objects to which they refer. */
+ dump_roots (ctx);
+
+ dump_charset_table (ctx);
+ dump_finalizer_list_head_ptr (ctx, &finalizers.prev);
+ dump_finalizer_list_head_ptr (ctx, &finalizers.next);
+ dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.prev);
+ dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.next);
+ dump_drain_user_remembered_data_hot (ctx);
+
+ /* We've already remembered all the objects to which GC roots point,
+ but we have to manually save the list of GC roots itself. */
+ dump_metadata_for_pdumper (ctx);
+ for (int i = 0; i < staticidx; ++i)
+ dump_emacs_reloc_to_emacs_ptr_raw (ctx, &staticvec[i], staticvec[i]);
+ dump_emacs_reloc_immediate_int (ctx, &staticidx, staticidx);
+
+ /* Dump until while we keep finding objects to dump. We add new
+ objects to the queue by side effect during dumping.
+ We accumulate some types of objects in special lists to get more
+ locality for these object types at runtime. */
+ do
+ {
+ dump_drain_deferred_hash_tables (ctx);
+ dump_drain_deferred_symbols (ctx);
+ dump_drain_normal_queue (ctx);
+ }
+ while (!dump_queue_empty_p (&ctx->dump_queue)
+ || !NILP (ctx->deferred_hash_tables)
+ || !NILP (ctx->deferred_symbols));
+
+ ctx->header.hash_list = ctx->offset;
+ dump_hash_table_list (ctx);
+
+ do
+ {
+ dump_drain_deferred_hash_tables (ctx);
+ dump_drain_deferred_symbols (ctx);
+ dump_drain_normal_queue (ctx);
+ }
+ while (!dump_queue_empty_p (&ctx->dump_queue)
+ || !NILP (ctx->deferred_hash_tables)
+ || !NILP (ctx->deferred_symbols));
+
+ dump_sort_copied_objects (ctx);
+
+ /* While we copy built-in symbols into the Emacs image, these
+ built-in structures refer to non-Lisp heap objects that must live
+ in the dump; we stick these auxiliary data structures at the end
+ of the hot section and use a special hash table to remember them.
+ The actual symbol dump will pick them up below. */
+ ctx->symbol_aux = make_eq_hash_table ();
+ dump_hot_parts_of_discardable_objects (ctx);
+
+ /* Emacs, after initial dump loading, can forget about the portion
+ of the dump that runs from here to the start of the cold section.
+ This section consists of objects that need to be memcpy()ed into
+ the Emacs data section instead of just used directly.
+
+ We don't need to align hot_end: the loader knows to actually
+ start discarding only at the next page boundary if the loader
+ implements discarding using page manipulation. */
+ const dump_off hot_end = ctx->offset;
+ ctx->header.discardable_start = hot_end;
+
+ dump_drain_copied_objects (ctx);
+ eassert (dump_queue_empty_p (&ctx->dump_queue));
+
+ dump_off discardable_end = ctx->offset;
+ dump_align_output (ctx, dump_get_max_page_size ());
+ ctx->header.cold_start = ctx->offset;
+
+ /* Start the cold section. This section contains bytes that should
+ never change and so can be direct-mapped from the dump without
+ special processing. */
+ dump_drain_cold_data (ctx);
+ /* dump_drain_user_remembered_data_cold needs to be after
+ dump_drain_cold_data in case dump_drain_cold_data dumps a lisp
+ object to which C code points.
+ dump_drain_user_remembered_data_cold assumes that all lisp
+ objects have been dumped. */
+ dump_drain_user_remembered_data_cold (ctx);
+
+ /* After this point, the dump file contains no data that can be part
+ of the Lisp heap. */
+ ctx->end_heap = ctx->offset;
+
+ /* Make remembered modifications to the dump file itself. */
+ dump_do_fixups (ctx);
+
+ drain_reloc_merger emacs_reloc_merger =
+ #ifdef ENABLE_CHECKING
+ dump_check_overlap_dump_reloc
+ #else
+ NULL
+ #endif
+ ;
+
+ /* Emit instructions for Emacs to execute when loading the dump.
+ Note that this relocation information ends up in the cold section
+ of the dump. */
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
+ &ctx->dump_relocs[i], &ctx->header.dump_relocs[i]);
+ dump_off number_hot_relocations = ctx->number_hot_relocations;
+ ctx->number_hot_relocations = 0;
+ dump_off number_discardable_relocations = ctx->number_discardable_relocations;
+ ctx->number_discardable_relocations = 0;
+ drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
+ &ctx->object_starts, &ctx->header.object_starts);
+ drain_reloc_list (ctx, dump_emit_emacs_reloc, dump_merge_emacs_relocs,
+ &ctx->emacs_relocs, &ctx->header.emacs_relocs);
+
+ const dump_off cold_end = ctx->offset;
+
+ eassert (dump_queue_empty_p (&ctx->dump_queue));
+ eassert (NILP (ctx->copied_queue));
+ eassert (NILP (ctx->cold_queue));
+ eassert (NILP (ctx->deferred_symbols));
+ eassert (NILP (ctx->deferred_hash_tables));
+ eassert (NILP (ctx->fixups));
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ eassert (NILP (ctx->dump_relocs[i]));
+ eassert (NILP (ctx->emacs_relocs));
+
+ /* Dump is complete. Go back to the header and write the magic
+ indicating that the dump is complete and can be loaded. */
+ ctx->header.magic[0] = dump_magic[0];
+ dump_seek (ctx, 0);
+ dump_write (ctx, &ctx->header, sizeof (ctx->header));
+ if (emacs_write (ctx->fd, ctx->buf, ctx->max_offset) < ctx->max_offset)
+ report_file_error ("Could not write to dump file", ctx->dump_filename);
+ xfree (ctx->buf);
+ ctx->buf = NULL;
+ ctx->buf_size = 0;
+ ctx->max_offset = 0;
+
+ dump_off
+ header_bytes = header_end - header_start,
+ hot_bytes = hot_end - hot_start,
+ discardable_bytes = discardable_end - ctx->header.discardable_start,
+ cold_bytes = cold_end - ctx->header.cold_start;
+ fprintf (stderr,
+ ("Dump complete\n"
+ "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF
+ " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n"
+ "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"),
+ header_bytes, hot_bytes, discardable_bytes, cold_bytes,
+ number_hot_relocations,
+ number_discardable_relocations);
+
+ unblock_input ();
+ return unbind_to (count, Qnil);
+ }
+
+ DEFUN ("dump-emacs-portable--sort-predicate",
+ Fdump_emacs_portable__sort_predicate,
+ Sdump_emacs_portable__sort_predicate,
+ 2, 2, 0,
+ doc: /* Internal relocation sorting function. */)
+ (Lisp_Object a, Lisp_Object b)
+ {
+ dump_off a_offset = dump_off_from_lisp (XCAR (XCDR (a)));
+ dump_off b_offset = dump_off_from_lisp (XCAR (XCDR (b)));
+ return a_offset < b_offset ? Qt : Qnil;
+ }
+
+ DEFUN ("dump-emacs-portable--sort-predicate-copied",
+ Fdump_emacs_portable__sort_predicate_copied,
+ Sdump_emacs_portable__sort_predicate_copied,
+ 2, 2, 0,
+ doc: /* Internal relocation sorting function. */)
+ (Lisp_Object a, Lisp_Object b)
+ {
+ eassert (dump_object_emacs_ptr (a));
+ eassert (dump_object_emacs_ptr (b));
+ return dump_object_emacs_ptr (a) < dump_object_emacs_ptr (b) ? Qt : Qnil;
+ }
+
+ void
+ pdumper_do_now_and_after_load_impl (pdumper_hook hook)
+ {
+ if (nr_dump_hooks == ARRAYELTS (dump_hooks))
+ fatal ("out of dump hooks: make dump_hooks[] bigger");
+ dump_hooks[nr_dump_hooks++] = hook;
+ hook ();
+ }
+
+ void
+ pdumper_do_now_and_after_late_load_impl (pdumper_hook hook)
+ {
+ if (nr_dump_late_hooks == ARRAYELTS (dump_late_hooks))
+ fatal ("out of dump hooks: make dump_late_hooks[] bigger");
+ dump_late_hooks[nr_dump_late_hooks++] = hook;
+ hook ();
+ }
+
+ static void
+ pdumper_remember_user_data_1 (void *mem, int nbytes)
+ {
+ if (nr_remembered_data == ARRAYELTS (remembered_data))
+ fatal ("out of remembered data slots: make remembered_data[] bigger");
+ remembered_data[nr_remembered_data].mem = mem;
+ remembered_data[nr_remembered_data].sz = nbytes;
+ nr_remembered_data += 1;
+ }
+
+ void
+ pdumper_remember_scalar_impl (void *mem, ptrdiff_t nbytes)
+ {
+ eassert (0 <= nbytes && nbytes <= INT_MAX);
+ if (nbytes > 0)
+ pdumper_remember_user_data_1 (mem, (int) nbytes);
+ }
+
+ void
+ pdumper_remember_lv_ptr_raw_impl (void *ptr, enum Lisp_Type type)
+ {
+ pdumper_remember_user_data_1 (ptr, -type);
+ }
+
+ \f
+ #ifdef HAVE_NATIVE_COMP
+ /* This records the directory where the Emacs executable lives, to be
+ used for locating the native-lisp directory from which we need to
+ load the preloaded *.eln files. See pdumper_set_emacs_execdir
+ below. */
+ static char *emacs_execdir;
+ static ptrdiff_t execdir_size;
+ static ptrdiff_t execdir_len;
+ #endif
+
+ /* Dump runtime */
+ enum dump_memory_protection
+ {
+ DUMP_MEMORY_ACCESS_NONE = 1,
+ DUMP_MEMORY_ACCESS_READ = 2,
+ DUMP_MEMORY_ACCESS_READWRITE = 3,
+ };
+
+ #if VM_SUPPORTED == VM_MS_WINDOWS
+ static void *
+ dump_anonymous_allocate_w32 (void *base,
+ size_t size,
+ enum dump_memory_protection protection)
+ {
+ void *ret;
+ DWORD mem_type;
+ DWORD mem_prot;
+
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_NONE:
+ mem_type = MEM_RESERVE;
+ mem_prot = PAGE_NOACCESS;
+ break;
+ case DUMP_MEMORY_ACCESS_READ:
+ mem_type = MEM_COMMIT;
+ mem_prot = PAGE_READONLY;
+ break;
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ mem_type = MEM_COMMIT;
+ mem_prot = PAGE_READWRITE;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ ret = VirtualAlloc (base, size, mem_type, mem_prot);
+ if (ret == NULL)
+ errno = (base && GetLastError () == ERROR_INVALID_ADDRESS)
+ ? EBUSY
+ : EPERM;
+ return ret;
+ }
+ #endif
+
+ #if VM_SUPPORTED == VM_POSIX
+
+ /* Old versions of macOS only define MAP_ANON, not MAP_ANONYMOUS.
+ FIXME: This probably belongs elsewhere (gnulib/autoconf?) */
+ # ifndef MAP_ANONYMOUS
+ # define MAP_ANONYMOUS MAP_ANON
+ # endif
+
+ static void *
+ dump_anonymous_allocate_posix (void *base,
+ size_t size,
+ enum dump_memory_protection protection)
+ {
+ void *ret;
+ int mem_prot;
+
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_NONE:
+ mem_prot = PROT_NONE;
+ break;
+ case DUMP_MEMORY_ACCESS_READ:
+ mem_prot = PROT_READ;
+ break;
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ mem_prot = PROT_READ | PROT_WRITE;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ int mem_flags = MAP_PRIVATE | MAP_ANONYMOUS;
+ if (mem_prot != PROT_NONE)
+ mem_flags |= MAP_POPULATE;
+ if (base)
+ mem_flags |= MAP_FIXED;
+
+ bool retry;
+ do
+ {
+ retry = false;
+ ret = mmap (base, size, mem_prot, mem_flags, -1, 0);
+ if (ret == MAP_FAILED
+ && errno == EINVAL
+ && (mem_flags & MAP_POPULATE))
+ {
+ /* This system didn't understand MAP_POPULATE, so try
+ again without it. */
+ mem_flags &= ~MAP_POPULATE;
+ retry = true;
+ }
+ }
+ while (retry);
+
+ if (ret == MAP_FAILED)
+ ret = NULL;
+ return ret;
+ }
+ #endif
+
+ /* Perform anonymous memory allocation. */
+ static void *
+ dump_anonymous_allocate (void *base,
+ const size_t size,
+ enum dump_memory_protection protection)
+ {
+ #if VM_SUPPORTED == VM_POSIX
+ return dump_anonymous_allocate_posix (base, size, protection);
+ #elif VM_SUPPORTED == VM_MS_WINDOWS
+ return dump_anonymous_allocate_w32 (base, size, protection);
+ #else
+ errno = ENOSYS;
+ return NULL;
+ #endif
+ }
+
+ /* Undo the effect of dump_reserve_address_space(). */
+ static void
+ dump_anonymous_release (void *addr, size_t size)
+ {
+ eassert (size >= 0);
+ #if VM_SUPPORTED == VM_MS_WINDOWS
+ (void) size;
+ if (!VirtualFree (addr, 0, MEM_RELEASE))
+ emacs_abort ();
+ #elif VM_SUPPORTED == VM_POSIX
+ if (munmap (addr, size) < 0)
+ emacs_abort ();
+ #else
+ (void) addr;
+ (void) size;
+ emacs_abort ();
+ #endif
+ }
+
+ #if VM_SUPPORTED == VM_MS_WINDOWS
+ static void *
+ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size,
+ enum dump_memory_protection protection)
+ {
+ void *ret = NULL;
+ HANDLE section = NULL;
+ HANDLE file;
+
+ uint64_t full_offset = offset;
+ uint32_t offset_high = (uint32_t) (full_offset >> 32);
+ uint32_t offset_low = (uint32_t) (full_offset & 0xffffffff);
+
+ int error;
+ DWORD protect;
+ DWORD map_access;
+
+ file = (HANDLE) _get_osfhandle (fd);
+ if (file == INVALID_HANDLE_VALUE)
+ goto out;
+
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ protect = PAGE_WRITECOPY; /* for Windows 9X */
+ break;
+ default:
+ case DUMP_MEMORY_ACCESS_NONE:
+ case DUMP_MEMORY_ACCESS_READ:
+ protect = PAGE_READONLY;
+ break;
+ }
+
+ section = CreateFileMapping (file,
+ /*lpAttributes=*/NULL,
+ protect,
+ /*dwMaximumSizeHigh=*/0,
+ /*dwMaximumSizeLow=*/0,
+ /*lpName=*/NULL);
+ if (!section)
+ {
+ errno = EINVAL;
+ goto out;
+ }
+
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_NONE:
+ case DUMP_MEMORY_ACCESS_READ:
+ map_access = FILE_MAP_READ;
+ break;
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ map_access = FILE_MAP_COPY;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ ret = MapViewOfFileEx (section,
+ map_access,
+ offset_high,
+ offset_low,
+ size,
+ base);
+
+ error = GetLastError ();
+ if (ret == NULL)
+ errno = (error == ERROR_INVALID_ADDRESS ? EBUSY : EPERM);
+ out:
+ if (section && !CloseHandle (section))
+ emacs_abort ();
+ return ret;
+ }
+ #endif
+
+ #if VM_SUPPORTED == VM_POSIX
+ static void *
+ dump_map_file_posix (void *base, int fd, off_t offset, size_t size,
+ enum dump_memory_protection protection)
+ {
+ void *ret;
+ int mem_prot;
+ int mem_flags;
+
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_NONE:
+ mem_prot = PROT_NONE;
+ mem_flags = MAP_SHARED;
+ break;
+ case DUMP_MEMORY_ACCESS_READ:
+ mem_prot = PROT_READ;
+ mem_flags = MAP_SHARED;
+ break;
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ mem_prot = PROT_READ | PROT_WRITE;
+ mem_flags = MAP_PRIVATE;
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ if (base)
+ mem_flags |= MAP_FIXED;
+
+ ret = mmap (base, size, mem_prot, mem_flags, fd, offset);
+ if (ret == MAP_FAILED)
+ ret = NULL;
+ return ret;
+ }
+ #endif
+
+ /* Map a file into memory. */
+ static void *
+ dump_map_file (void *base, int fd, off_t offset, size_t size,
+ enum dump_memory_protection protection)
+ {
+ #if VM_SUPPORTED == VM_POSIX
+ return dump_map_file_posix (base, fd, offset, size, protection);
+ #elif VM_SUPPORTED == VM_MS_WINDOWS
+ return dump_map_file_w32 (base, fd, offset, size, protection);
+ #else
+ errno = ENOSYS;
+ return NULL;
+ #endif
+ }
+
+ /* Remove a virtual memory mapping.
+
+ On failure, abort Emacs. For maximum platform compatibility, ADDR
+ and SIZE must match the mapping exactly. */
+ static void
+ dump_unmap_file (void *addr, size_t size)
+ {
+ eassert (size >= 0);
+ #if !VM_SUPPORTED
+ (void) addr;
+ (void) size;
+ emacs_abort ();
+ #elif defined (WINDOWSNT)
+ (void) size;
+ if (!UnmapViewOfFile (addr))
+ emacs_abort ();
+ #else
+ if (munmap (addr, size) < 0)
+ emacs_abort ();
+ #endif
+ }
+
+ struct dump_memory_map_spec
+ {
+ int fd; /* File to map; anon zero if negative. */
+ size_t size; /* Number of bytes to map. */
+ off_t offset; /* Offset within fd. */
+ enum dump_memory_protection protection;
+ };
+
+ struct dump_memory_map
+ {
+ struct dump_memory_map_spec spec;
+ void *mapping; /* Actual mapped memory. */
+ void (*release) (struct dump_memory_map *);
+ void *private;
+ };
+
+ /* Mark the pages as unneeded, potentially zeroing them, without
+ releasing the address space reservation. */
+ static void
+ dump_discard_mem (void *mem, size_t size)
+ {
+ #if VM_SUPPORTED == VM_MS_WINDOWS
+ /* Discard COWed pages. */
+ (void) VirtualFree (mem, size, MEM_DECOMMIT);
+ /* Release the commit charge for the mapping. */
+ DWORD old_prot;
+ (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
+ #elif VM_SUPPORTED == VM_POSIX
+ # ifdef HAVE_POSIX_MADVISE
+ /* Discard COWed pages. */
+ (void) posix_madvise (mem, size, POSIX_MADV_DONTNEED);
+ # endif
+ /* Release the commit charge for the mapping. */
+ (void) mprotect (mem, size, PROT_NONE);
+ #endif
+ }
+
+ static void
+ dump_mmap_discard_contents (struct dump_memory_map *map)
+ {
+ if (map->mapping)
+ dump_discard_mem (map->mapping, map->spec.size);
+ }
+
+ static void
+ dump_mmap_reset (struct dump_memory_map *map)
+ {
+ map->mapping = NULL;
+ map->release = NULL;
+ map->private = NULL;
+ }
+
+ static void
+ dump_mmap_release (struct dump_memory_map *map)
+ {
+ if (map->release)
+ map->release (map);
+ dump_mmap_reset (map);
+ }
+
+ /* Allows heap-allocated dump_mmap to "free" maps individually. */
+ struct dump_memory_map_heap_control_block
+ {
+ int refcount;
+ void *mem;
+ };
+
+ static void
+ dump_mm_heap_cb_release (struct dump_memory_map_heap_control_block *cb)
+ {
+ eassert (cb->refcount > 0);
+ if (--cb->refcount == 0)
+ {
+ free (cb->mem);
+ free (cb);
+ }
+ }
+
+ static void
+ dump_mmap_release_heap (struct dump_memory_map *map)
+ {
+ dump_mm_heap_cb_release (map->private);
+ }
+
+ /* Implement dump_mmap using malloc and read. */
+ static bool
+ dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
+ size_t total_size)
+ {
+ bool ret = false;
+
+ /* FIXME: This storage sometimes is never freed.
+ Beware: the simple patch 2019-03-11T15:20:54Z!eggert@cs.ucla.edu
+ is worse, as it sometimes frees this storage twice. */
+ struct dump_memory_map_heap_control_block *cb = calloc (1, sizeof (*cb));
+ if (!cb)
+ goto out;
+ __lsan_ignore_object (cb);
+
+ cb->refcount = 1;
+ cb->mem = malloc (total_size);
+ if (!cb->mem)
+ goto out;
+ char *mem = cb->mem;
+ for (int i = 0; i < nr_maps; ++i)
+ {
+ struct dump_memory_map *map = &maps[i];
+ const struct dump_memory_map_spec spec = map->spec;
+ if (!spec.size)
+ continue;
+ map->mapping = mem;
+ mem += spec.size;
+ map->release = dump_mmap_release_heap;
+ map->private = cb;
+ cb->refcount += 1;
+ if (spec.fd < 0)
+ memset (map->mapping, 0, spec.size);
+ else
+ {
+ if (lseek (spec.fd, spec.offset, SEEK_SET) < 0)
+ goto out;
+ ssize_t nb = dump_read_all (spec.fd,
+ map->mapping,
+ spec.size);
+ if (nb >= 0 && nb != spec.size)
+ errno = EIO;
+ if (nb != spec.size)
+ goto out;
+ }
+ }
+
+ ret = true;
+ out:
+ dump_mm_heap_cb_release (cb);
+ if (!ret)
+ for (int i = 0; i < nr_maps; ++i)
+ dump_mmap_release (&maps[i]);
+ return ret;
+ }
+
+ static void
+ dump_mmap_release_vm (struct dump_memory_map *map)
+ {
+ if (map->spec.fd < 0)
+ dump_anonymous_release (map->mapping, map->spec.size);
+ else
+ dump_unmap_file (map->mapping, map->spec.size);
+ }
+
+ static bool
+ needs_mmap_retry_p (void)
+ {
+ #if defined CYGWIN || VM_SUPPORTED == VM_MS_WINDOWS || defined _AIX
+ return true;
+ #else
+ return false;
+ #endif
+ }
+
+ static bool
+ dump_mmap_contiguous_vm (struct dump_memory_map *maps, int nr_maps,
+ size_t total_size)
+ {
+ bool ret = false;
+ void *resv = NULL;
+ bool retry = false;
+ const bool need_retry = needs_mmap_retry_p ();
+
+ do
+ {
+ if (retry)
+ {
+ eassert (need_retry);
+ retry = false;
+ for (int i = 0; i < nr_maps; ++i)
+ dump_mmap_release (&maps[i]);
+ }
+
+ eassert (resv == NULL);
+ resv = dump_anonymous_allocate (NULL,
+ total_size,
+ DUMP_MEMORY_ACCESS_NONE);
+ if (!resv)
+ goto out;
+
+ char *mem = resv;
+
+ if (need_retry)
+ {
+ /* Windows lacks atomic mapping replace; need to release the
+ reservation so we can allocate within it. Will retry the
+ loop if someone squats on our address space before we can
+ finish allocation. On POSIX systems, we leave the
+ reservation around for atomicity. */
+ dump_anonymous_release (resv, total_size);
+ resv = NULL;
+ }
+
+ for (int i = 0; i < nr_maps; ++i)
+ {
+ struct dump_memory_map *map = &maps[i];
+ const struct dump_memory_map_spec spec = map->spec;
+ if (!spec.size)
+ continue;
+
+ if (spec.fd < 0)
+ map->mapping = dump_anonymous_allocate (mem, spec.size,
+ spec.protection);
+ else
+ map->mapping = dump_map_file (mem, spec.fd, spec.offset,
+ spec.size, spec.protection);
+ mem += spec.size;
+ if (need_retry && map->mapping == NULL
+ && (errno == EBUSY
+ #ifdef CYGWIN
+ || errno == EINVAL
+ #endif
+ ))
+ {
+ retry = true;
+ continue;
+ }
+ if (map->mapping == NULL)
+ goto out;
+ map->release = dump_mmap_release_vm;
+ }
+ }
+ while (retry);
+
+ ret = true;
+ resv = NULL;
+ out:
+ if (resv)
+ dump_anonymous_release (resv, total_size);
+ if (!ret)
+ {
+ for (int i = 0; i < nr_maps; ++i)
+ {
+ if (need_retry)
+ dump_mmap_reset (&maps[i]);
+ else
+ dump_mmap_release (&maps[i]);
+ }
+ }
+ return ret;
+ }
+
+ /* Map a range of addresses into a chunk of contiguous memory.
+
+ Each dump_memory_map structure describes how to fill the
+ corresponding range of memory. On input, all members except MAPPING
+ are valid. On output, MAPPING contains the location of the given
+ chunk of memory. The MAPPING for MAPS[N] is MAPS[N-1].mapping +
+ MAPS[N-1].size.
+
+ Each mapping SIZE must be a multiple of the system page size except
+ for the last mapping.
+
+ Return true on success or false on failure with errno set. */
+ static bool
+ dump_mmap_contiguous (struct dump_memory_map *maps, int nr_maps)
+ {
+ if (!nr_maps)
+ return true;
+
+ size_t total_size = 0;
+ int worst_case_page_size = dump_get_max_page_size ();
+
+ for (int i = 0; i < nr_maps; ++i)
+ {
+ eassert (maps[i].mapping == NULL);
+ eassert (maps[i].release == NULL);
+ eassert (maps[i].private == NULL);
+ if (i != nr_maps - 1)
+ eassert (maps[i].spec.size % worst_case_page_size == 0);
+ total_size += maps[i].spec.size;
+ }
+
+ return (VM_SUPPORTED ? dump_mmap_contiguous_vm : dump_mmap_contiguous_heap)
+ (maps, nr_maps, total_size);
+ }
+
+ typedef uint_fast32_t dump_bitset_word;
+
+ struct dump_bitset
+ {
+ dump_bitset_word *restrict bits;
+ ptrdiff_t number_words;
+ };
+
+ static bool
+ dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
+ {
+ int xword_size = sizeof (bitset[0].bits[0]);
+ int bits_per_word = xword_size * CHAR_BIT;
+ ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
+ dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
+ if (!bits)
+ return false;
+ bitset[0].bits = bits;
+ bitset[0].number_words = bitset[1].number_words = words_needed;
+ bitset[1].bits = memset (bits + words_needed, UCHAR_MAX,
+ words_needed * xword_size);
+ return true;
+ }
+
+ static dump_bitset_word *
+ dump_bitset__bit_slot (const struct dump_bitset *bitset,
+ size_t bit_number)
+ {
+ int xword_size = sizeof (bitset->bits[0]);
+ int bits_per_word = xword_size * CHAR_BIT;
+ ptrdiff_t word_number = bit_number / bits_per_word;
+ eassert (word_number < bitset->number_words);
+ return &bitset->bits[word_number];
+ }
+
+ static bool
+ dump_bitset_bit_set_p (const struct dump_bitset *bitset,
+ size_t bit_number)
+ {
+ unsigned xword_size = sizeof (bitset->bits[0]);
+ unsigned bits_per_word = xword_size * CHAR_BIT;
+ dump_bitset_word bit = 1;
+ bit <<= bit_number % bits_per_word;
+ return *dump_bitset__bit_slot (bitset, bit_number) & bit;
+ }
+
+ static void
+ dump_bitset__set_bit_value (struct dump_bitset *bitset,
+ size_t bit_number,
+ bool bit_is_set)
+ {
+ int xword_size = sizeof (bitset->bits[0]);
+ int bits_per_word = xword_size * CHAR_BIT;
+ dump_bitset_word *slot = dump_bitset__bit_slot (bitset, bit_number);
+ dump_bitset_word bit = 1;
+ bit <<= bit_number % bits_per_word;
+ if (bit_is_set)
+ *slot = *slot | bit;
+ else
+ *slot = *slot & ~bit;
+ }
+
+ static void
+ dump_bitset_set_bit (struct dump_bitset *bitset, size_t bit_number)
+ {
+ dump_bitset__set_bit_value (bitset, bit_number, true);
+ }
+
+ static void
+ dump_bitset_clear (struct dump_bitset *bitset)
+ {
+ /* Skip the memset if bitset->number_words == 0, because then bitset->bits
+ might be NULL and the memset would have undefined behavior. */
+ if (bitset->number_words)
+ memset (bitset->bits, 0, bitset->number_words * sizeof bitset->bits[0]);
+ }
+
+ struct pdumper_loaded_dump_private
+ {
+ /* Copy of the header we read from the dump. */
+ struct dump_header header;
+ /* Mark bits for objects in the dump; used during GC. */
+ struct dump_bitset mark_bits, last_mark_bits;
+ /* Time taken to load the dump. */
+ double load_time;
+ /* Dump file name. */
+ char *dump_filename;
+ };
+
+ struct pdumper_loaded_dump dump_public;
+ static struct pdumper_loaded_dump_private dump_private;
+
+ /* Return a pointer to offset OFFSET within the dump, which begins at
+ DUMP_BASE. DUMP_BASE must be equal to the current dump load
+ location; it's passed as a parameter for efficiency.
+
+ The returned pointer points to the primary memory image of the
+ currently-loaded dump file. The entire dump file is accessible
+ using this function. */
+ static void *
+ dump_ptr (uintptr_t dump_base, dump_off offset)
+ {
+ eassert (dump_base == dump_public.start);
+ eassert (0 <= offset);
+ eassert (dump_public.start + offset < dump_public.end);
+ return (char *)dump_base + offset;
+ }
+
+ /* Read a pointer-sized word of memory at OFFSET within the dump,
+ which begins at DUMP_BASE. DUMP_BASE must be equal to the current
+ dump load location; it's passed as a parameter for efficiency. */
+ static uintptr_t
+ dump_read_word_from_dump (uintptr_t dump_base, dump_off offset)
+ {
+ uintptr_t value;
+ /* The compiler optimizes this memcpy into a read. */
+ memcpy (&value, dump_ptr (dump_base, offset), sizeof (value));
+ return value;
+ }
+
+ /* Write a word to the dump. DUMP_BASE and OFFSET are as for
+ dump_read_word_from_dump; VALUE is the word to write at the given
+ offset. */
+ static void
+ dump_write_word_to_dump (uintptr_t dump_base,
+ dump_off offset,
+ uintptr_t value)
+ {
+ /* The compiler optimizes this memcpy into a write. */
+ memcpy (dump_ptr (dump_base, offset), &value, sizeof (value));
+ }
+
+ /* Write a Lisp_Object to the dump. DUMP_BASE and OFFSET are as for
+ dump_read_word_from_dump; VALUE is the Lisp_Object to write at the
+ given offset. */
+ static void
+ dump_write_lv_to_dump (uintptr_t dump_base,
+ dump_off offset,
+ Lisp_Object value)
+ {
+ /* The compiler optimizes this memcpy into a write. */
+ memcpy (dump_ptr (dump_base, offset), &value, sizeof (value));
+ }
+
+ /* Search for a relocation given a relocation target.
+
+ DUMP is the dump metadata structure. TABLE is the relocation table
+ to search. KEY is the dump offset to find. Return the relocation
+ RELOC such that RELOC.offset is the smallest RELOC.offset that
+ satisfies the constraint KEY <= RELOC.offset --- that is, return
+ the first relocation at KEY or after KEY. Return NULL if no such
+ relocation exists. */
+ static const struct dump_reloc *
+ dump_find_relocation (const struct dump_table_locator *const table,
+ const dump_off key)
+ {
+ const struct dump_reloc *const relocs = dump_ptr (dump_public.start,
+ table->offset);
+ const struct dump_reloc *found = NULL;
+ ptrdiff_t idx_left = 0;
+ ptrdiff_t idx_right = table->nr_entries;
+
+ eassert (key >= 0);
+
+ while (idx_left < idx_right)
+ {
+ const ptrdiff_t idx_mid = idx_left + (idx_right - idx_left) / 2;
+ const struct dump_reloc *mid = &relocs[idx_mid];
+ if (key > dump_reloc_get_offset (*mid))
+ idx_left = idx_mid + 1;
+ else
+ {
+ found = mid;
+ idx_right = idx_mid;
+ if (idx_right <= idx_left
+ || key > dump_reloc_get_offset (relocs[idx_right - 1]))
+ break;
+ }
+ }
+
+ return found;
+ }
+
+ static bool
+ dump_loaded_p (void)
+ {
+ return dump_public.start != 0;
+ }
+
+ bool
+ pdumper_cold_object_p_impl (const void *obj)
+ {
+ eassert (pdumper_object_p (obj));
+ eassert (pdumper_object_p_precise (obj));
+ dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
+ return offset >= dump_private.header.cold_start;
+ }
+
+ int
+ pdumper_find_object_type_impl (const void *obj)
+ {
+ eassert (pdumper_object_p (obj));
+ dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
+ if (offset % DUMP_ALIGNMENT != 0)
+ return PDUMPER_NO_OBJECT;
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ if (offset < dump_private.header.discardable_start
+ && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno))
+ return PDUMPER_NO_OBJECT;
+ const struct dump_reloc *reloc =
+ dump_find_relocation (&dump_private.header.object_starts, offset);
+ return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
+ ? reloc->type
+ : PDUMPER_NO_OBJECT;
+ }
+
+ bool
+ pdumper_marked_p_impl (const void *obj)
+ {
+ eassert (pdumper_object_p (obj));
+ ptrdiff_t offset = (uintptr_t) obj - dump_public.start;
+ eassert (offset % DUMP_ALIGNMENT == 0);
+ eassert (offset < dump_private.header.cold_start);
+ eassert (offset < dump_private.header.discardable_start);
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ return dump_bitset_bit_set_p (&dump_private.mark_bits, bitno);
+ }
+
+ void
+ pdumper_set_marked_impl (const void *obj)
+ {
+ eassert (pdumper_object_p (obj));
+ ptrdiff_t offset = (uintptr_t) obj - dump_public.start;
+ eassert (offset % DUMP_ALIGNMENT == 0);
+ eassert (offset < dump_private.header.cold_start);
+ eassert (offset < dump_private.header.discardable_start);
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno));
+ dump_bitset_set_bit (&dump_private.mark_bits, bitno);
+ }
+
+ void
+ pdumper_clear_marks_impl (void)
+ {
+ dump_bitset_word *swap = dump_private.last_mark_bits.bits;
+ dump_private.last_mark_bits.bits = dump_private.mark_bits.bits;
+ dump_private.mark_bits.bits = swap;
+ dump_bitset_clear (&dump_private.mark_bits);
+ }
+
+ static ssize_t
+ dump_read_all (int fd, void *buf, size_t bytes_to_read)
+ {
+ /* We don't want to use emacs_read, since that relies on the lisp
+ world, and we're not in the lisp world yet. */
+ size_t bytes_read = 0;
+ while (bytes_read < bytes_to_read)
+ {
+ /* Some platforms accept only int-sized values to read.
+ Round this down to a page size (see MAX_RW_COUNT in sysdep.c). */
+ int max_rw_count = INT_MAX >> 18 << 18;
+ int chunk_to_read = min (bytes_to_read - bytes_read, max_rw_count);
+ ssize_t chunk = read (fd, (char *) buf + bytes_read, chunk_to_read);
+ if (chunk < 0)
+ return chunk;
+ if (chunk == 0)
+ break;
+ bytes_read += chunk;
+ }
+
+ return bytes_read;
+ }
+
+ /* Return the number of bytes written when we perform the given
+ relocation. */
+ static int
+ dump_reloc_size (const struct dump_reloc reloc)
+ {
+ if (sizeof (Lisp_Object) == sizeof (void *))
+ return sizeof (Lisp_Object);
+ if (reloc.type == RELOC_DUMP_TO_EMACS_PTR_RAW
+ || reloc.type == RELOC_DUMP_TO_DUMP_PTR_RAW)
+ return sizeof (void *);
+ return sizeof (Lisp_Object);
+ }
+
+ static Lisp_Object
+ dump_make_lv_from_reloc (const uintptr_t dump_base,
+ const struct dump_reloc reloc)
+ {
+ const dump_off reloc_offset = dump_reloc_get_offset (reloc);
+ uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
+ enum Lisp_Type lisp_type;
+
+ if (RELOC_DUMP_TO_DUMP_LV <= reloc.type
+ && reloc.type < RELOC_DUMP_TO_EMACS_LV)
+ {
+ lisp_type = reloc.type - RELOC_DUMP_TO_DUMP_LV;
+ value += dump_base;
+ eassert (pdumper_object_p ((void *) value));
+ }
+ else
+ {
+ eassert (RELOC_DUMP_TO_EMACS_LV <= reloc.type);
+ eassert (reloc.type < RELOC_DUMP_TO_EMACS_LV + 8);
+ lisp_type = reloc.type - RELOC_DUMP_TO_EMACS_LV;
+ value += emacs_basis ();
+ }
+
+ eassert (lisp_type != Lisp_Int0 && lisp_type != Lisp_Int1);
+
+ Lisp_Object lv;
+ if (lisp_type == Lisp_Symbol)
+ lv = make_lisp_symbol ((void *) value);
+ else
+ lv = make_lisp_ptr ((void *) value, lisp_type);
+
+ return lv;
+ }
+
+ /* Actually apply a dump relocation. */
+ static inline void
+ dump_do_dump_relocation (const uintptr_t dump_base,
+ const struct dump_reloc reloc)
+ {
+ const dump_off reloc_offset = dump_reloc_get_offset (reloc);
+
+ /* We should never generate a relocation in the cold section. */
+ eassert (reloc_offset < dump_private.header.cold_start);
+
+ switch (reloc.type)
+ {
+ case RELOC_DUMP_TO_EMACS_PTR_RAW:
+ {
+ uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
+ eassert (dump_reloc_size (reloc) == sizeof (value));
+ value += emacs_basis ();
+ dump_write_word_to_dump (dump_base, reloc_offset, value);
+ break;
+ }
+ case RELOC_DUMP_TO_DUMP_PTR_RAW:
+ {
+ uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
+ eassert (dump_reloc_size (reloc) == sizeof (value));
+ value += dump_base;
+ dump_write_word_to_dump (dump_base, reloc_offset, value);
+ break;
+ }
+ #ifdef HAVE_NATIVE_COMP
+ case RELOC_NATIVE_COMP_UNIT:
+ {
+ static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state;
+ struct Lisp_Native_Comp_Unit *comp_u =
+ dump_ptr (dump_base, reloc_offset);
+ comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq);
+ if (STRINGP (comp_u->file))
+ error ("Trying to load incoherent dumped eln file %s",
+ SSDATA (comp_u->file));
+
+ if (!CONSP (comp_u->file))
+ error ("Incoherent compilation unit for dump was dumped");
+
+ /* emacs_execdir is always unibyte, but the file names in
+ comp_u->file could be multibyte, so we need to encode
+ them. */
+ Lisp_Object cu_file1 = ENCODE_FILE (XCAR (comp_u->file));
+ Lisp_Object cu_file2 = ENCODE_FILE (XCDR (comp_u->file));
+ ptrdiff_t fn1_len = SBYTES (cu_file1), fn2_len = SBYTES (cu_file2);
+ Lisp_Object eln_fname;
+ char *fndata;
+
+ /* Check just once if this is a local build or Emacs was installed. */
+ /* Can't use expand-file-name here, because we are too early
+ in the startup, and we will crash at least on WINDOWSNT. */
+ if (installation_state == UNKNOWN)
+ {
+ eln_fname = make_uninit_string (execdir_len + fn1_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file1), fn1_len);
+ if (file_access_p (fndata, F_OK))
+ installation_state = INSTALLED;
+ else
+ {
+ eln_fname = make_uninit_string (execdir_len + fn2_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file2), fn2_len);
+ installation_state = LOCAL_BUILD;
+ }
+ fixup_eln_load_path (eln_fname);
+ }
+ else
+ {
+ ptrdiff_t fn_len =
+ installation_state == INSTALLED ? fn1_len : fn2_len;
+ Lisp_Object cu_file =
+ installation_state == INSTALLED ? cu_file1 : cu_file2;
+ eln_fname = make_uninit_string (execdir_len + fn_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file), fn_len);
+ }
+
+ /* FIXME: This records the names of the *.eln files in an
+ unexpanded form, with one or more ".." elements (and on
+ Windows with the first part using backslashes). The file
+ names are also unibyte. If we care about this, we need to
+ loop in startup.el over all the preloaded modules and run
+ their file names through expand-file-name and
+ decode-coding-string. */
+ comp_u->file = eln_fname;
+ comp_u->handle = dynlib_open_for_eln (SSDATA (eln_fname));
+ if (!comp_u->handle)
+ {
+ fprintf (stderr, "Error using execdir %s:\n",
+ emacs_execdir);
+ error ("%s", dynlib_error ());
+ }
+ load_comp_unit (comp_u, true, false);
+ break;
+ }
+ case RELOC_NATIVE_SUBR:
+ {
+ /* When resurrecting from a dump given non all the original
+ native compiled subrs may be still around we can't rely on
+ a 'top_level_run' mechanism, we revive them one-by-one
+ here. */
+ struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
+ struct Lisp_Native_Comp_Unit *comp_u =
+ XNATIVE_COMP_UNIT (subr->native_comp_u);
+ if (!comp_u->handle)
+ error ("NULL handle in compilation unit %s", SSDATA (comp_u->file));
+ const char *c_name = subr->native_c_name;
+ eassert (c_name);
+ void *func = dynlib_sym (comp_u->handle, c_name);
+ if (!func)
+ error ("can't find function \"%s\" in compilation unit %s", c_name,
+ SSDATA (comp_u->file));
+ subr->function.a0 = func;
+ Lisp_Object lambda_data_idx =
+ Fgethash (build_string (c_name), comp_u->lambda_c_name_idx_h, Qnil);
+ if (!NILP (lambda_data_idx))
+ {
+ /* This is an anonymous lambda.
+ We must fixup d_reloc_imp so the lambda can be referenced
+ by code. */
+ Lisp_Object tem;
+ XSETSUBR (tem, subr);
+ Lisp_Object *fixup =
+ &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]);
+ eassert (EQ (*fixup, Qlambda_fixup));
+ *fixup = tem;
+ Fputhash (tem, Qt, comp_u->lambda_gc_guard_h);
+ }
+ break;
+ }
+ #endif
+ case RELOC_BIGNUM:
+ {
+ struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
+ struct bignum_reload_info reload_info;
+ verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum)));
+ memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info));
+ const mp_limb_t *limbs =
+ dump_ptr (dump_base, reload_info.data_location);
+ mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
+ break;
+ }
+ default: /* Lisp_Object in the dump; precise type in reloc.type */
+ {
+ Lisp_Object lv = dump_make_lv_from_reloc (dump_base, reloc);
+ eassert (dump_reloc_size (reloc) == sizeof (lv));
+ dump_write_lv_to_dump (dump_base, reloc_offset, lv);
+ break;
+ }
+ }
+ }
+
+ static void
+ dump_do_all_dump_reloc_for_phase (const struct dump_header *const header,
+ const uintptr_t dump_base,
+ const enum reloc_phase phase)
+ {
+ struct dump_reloc *r = dump_ptr (dump_base, header->dump_relocs[phase].offset);
+ dump_off nr_entries = header->dump_relocs[phase].nr_entries;
+ for (dump_off i = 0; i < nr_entries; ++i)
+ dump_do_dump_relocation (dump_base, r[i]);
+ }
+
+ static void
+ dump_do_emacs_relocation (const uintptr_t dump_base,
+ const struct emacs_reloc reloc)
+ {
+ ptrdiff_t pval;
+ Lisp_Object lv;
+
+ switch (reloc.type)
+ {
+ case RELOC_EMACS_COPY_FROM_DUMP:
+ eassume (reloc.length > 0);
+ memcpy (emacs_ptr_at (reloc.emacs_offset),
+ dump_ptr (dump_base, reloc.u.dump_offset),
+ reloc.length);
+ break;
+ case RELOC_EMACS_IMMEDIATE:
+ eassume (reloc.length > 0);
+ eassume (reloc.length <= sizeof (reloc.u.immediate));
+ memcpy (emacs_ptr_at (reloc.emacs_offset),
+ &reloc.u.immediate,
+ reloc.length);
+ break;
+ case RELOC_EMACS_DUMP_PTR_RAW:
+ pval = reloc.u.dump_offset + dump_base;
+ memcpy (emacs_ptr_at (reloc.emacs_offset), &pval, sizeof (pval));
+ break;
+ case RELOC_EMACS_EMACS_PTR_RAW:
+ pval = reloc.u.emacs_offset2 + emacs_basis ();
+ memcpy (emacs_ptr_at (reloc.emacs_offset), &pval, sizeof (pval));
+ break;
+ case RELOC_EMACS_DUMP_LV:
+ case RELOC_EMACS_EMACS_LV:
+ {
+ /* Lisp_Float is the maximum lisp type. */
+ eassume (reloc.length <= Lisp_Float);
+ void *obj_ptr = reloc.type == RELOC_EMACS_DUMP_LV
+ ? dump_ptr (dump_base, reloc.u.dump_offset)
+ : emacs_ptr_at (reloc.u.emacs_offset2);
+ if (reloc.length == Lisp_Symbol)
+ lv = make_lisp_symbol (obj_ptr);
+ else
+ lv = make_lisp_ptr (obj_ptr, reloc.length);
+ memcpy (emacs_ptr_at (reloc.emacs_offset), &lv, sizeof (lv));
+ break;
+ }
+ default:
+ fatal ("unrecognied relocation type %d", (int) reloc.type);
+ }
+ }
+
+ static void
+ dump_do_all_emacs_relocations (const struct dump_header *const header,
+ const uintptr_t dump_base)
+ {
+ const dump_off nr_entries = header->emacs_relocs.nr_entries;
+ struct emacs_reloc *r = dump_ptr (dump_base, header->emacs_relocs.offset);
+ for (dump_off i = 0; i < nr_entries; ++i)
+ dump_do_emacs_relocation (dump_base, r[i]);
+ }
+
+ #ifdef HAVE_NATIVE_COMP
+ /* Compute and record the directory of the Emacs executable given the
+ file name of that executable. */
+ static void
+ pdumper_set_emacs_execdir (char *emacs_executable)
+ {
+ char *p = emacs_executable + strlen (emacs_executable);
+
+ while (p > emacs_executable
+ && !IS_DIRECTORY_SEP (p[-1]))
+ --p;
+ eassert (p > emacs_executable);
+ emacs_execdir = xpalloc (emacs_execdir, &execdir_size,
+ p - emacs_executable + 1 - execdir_size, -1, 1);
+ memcpy (emacs_execdir, emacs_executable, p - emacs_executable);
+ execdir_len = p - emacs_executable;
+ emacs_execdir[execdir_len] = '\0';
+ }
+ #endif
+
+ enum dump_section
+ {
+ DS_HOT,
+ DS_DISCARDABLE,
+ DS_COLD,
+ NUMBER_DUMP_SECTIONS,
+ };
+
+ /* Pointer to a stack variable to avoid having to staticpro it. */
+ static Lisp_Object *pdumper_hashes = &zero_vector;
+
+ /* Load a dump from DUMP_FILENAME. Return an error code.
+
+ N.B. We run very early in initialization, so we can't use lisp,
+ unwinding, xmalloc, and so on. */
+ int
+ pdumper_load (const char *dump_filename, char *argv0)
+ {
+ intptr_t dump_size;
+ struct stat stat;
+ uintptr_t dump_base;
+ int dump_page_size;
+ dump_off adj_discardable_start;
+
+ struct dump_bitset mark_bits[2];
+ size_t mark_bits_needed;
+
+ struct dump_header header_buf = { 0 };
+ struct dump_header *header = &header_buf;
+ struct dump_memory_map sections[NUMBER_DUMP_SECTIONS];
+
+ /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */
+ memset (sections, 0, sizeof sections);
+
+ const struct timespec start_time = current_timespec ();
+ char *dump_filename_copy;
+
+ /* Overwriting an initialized Lisp universe will not go well. */
+ eassert (!initialized);
+
+ /* We can load only one dump. */
+ eassert (!dump_loaded_p ());
+
+ int err;
+ int dump_fd = emacs_open_noquit (dump_filename, O_RDONLY, 0);
+ if (dump_fd < 0)
+ {
+ err = (errno == ENOENT || errno == ENOTDIR
+ ? PDUMPER_LOAD_FILE_NOT_FOUND
+ : PDUMPER_LOAD_ERROR + errno);
+ goto out;
+ }
+
+ err = PDUMPER_LOAD_FILE_NOT_FOUND;
+ if (fstat (dump_fd, &stat) < 0)
+ goto out;
+
+ err = PDUMPER_LOAD_BAD_FILE_TYPE;
+ if (stat.st_size > INTPTR_MAX)
+ goto out;
+ dump_size = (intptr_t) stat.st_size;
+
+ err = PDUMPER_LOAD_BAD_FILE_TYPE;
+ if (dump_size < sizeof (*header))
+ goto out;
+
+ err = PDUMPER_LOAD_BAD_FILE_TYPE;
+ if (dump_read_all (dump_fd,
+ header,
+ sizeof (*header)) < sizeof (*header))
+ goto out;
+
+ if (memcmp (header->magic, dump_magic, sizeof (dump_magic)) != 0)
+ {
+ if (header->magic[0] == '!'
+ && (header->magic[0] = dump_magic[0],
+ memcmp (header->magic, dump_magic, sizeof (dump_magic)) == 0))
+ {
+ err = PDUMPER_LOAD_FAILED_DUMP;
+ goto out;
+ }
+ err = PDUMPER_LOAD_BAD_FILE_TYPE;
+ goto out;
+ }
+
+ err = PDUMPER_LOAD_VERSION_MISMATCH;
+ verify (sizeof (header->fingerprint) == sizeof (fingerprint));
+ unsigned char desired[sizeof fingerprint];
+ for (int i = 0; i < sizeof fingerprint; i++)
+ desired[i] = fingerprint[i];
+ if (memcmp (header->fingerprint, desired, sizeof desired) != 0)
+ {
+ dump_fingerprint (stderr, "desired fingerprint", desired);
+ dump_fingerprint (stderr, "found fingerprint", header->fingerprint);
+ goto out;
+ }
+
+ /* FIXME: The comment at the start of this function says it should
+ not use xmalloc, but xstrdup calls xmalloc. Either fix the
+ comment or fix the following code. */
+ dump_filename_copy = xstrdup (dump_filename);
+
+ err = PDUMPER_LOAD_OOM;
+
+ adj_discardable_start = header->discardable_start;
+ dump_page_size = dump_get_max_page_size ();
+ /* Snap to next page boundary. */
+ adj_discardable_start = ROUNDUP (adj_discardable_start, dump_page_size);
+ eassert (adj_discardable_start % dump_page_size == 0);
+ eassert (adj_discardable_start <= header->cold_start);
+
+ sections[DS_HOT].spec = (struct dump_memory_map_spec)
+ {
+ .fd = dump_fd,
+ .size = adj_discardable_start,
+ .offset = 0,
+ .protection = DUMP_MEMORY_ACCESS_READWRITE,
+ };
+
+ sections[DS_DISCARDABLE].spec = (struct dump_memory_map_spec)
+ {
+ .fd = dump_fd,
+ .size = header->cold_start - adj_discardable_start,
+ .offset = adj_discardable_start,
+ .protection = DUMP_MEMORY_ACCESS_READWRITE,
+ };
+
+ sections[DS_COLD].spec = (struct dump_memory_map_spec)
+ {
+ .fd = dump_fd,
+ .size = dump_size - header->cold_start,
+ .offset = header->cold_start,
+ .protection = DUMP_MEMORY_ACCESS_READWRITE,
+ };
+
+ if (!dump_mmap_contiguous (sections, ARRAYELTS (sections)))
+ goto out;
+
+ err = PDUMPER_LOAD_ERROR;
+ mark_bits_needed =
+ divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
+ if (!dump_bitsets_init (mark_bits, mark_bits_needed))
+ goto out;
+
+ /* Point of no return. */
+ err = PDUMPER_LOAD_SUCCESS;
+ dump_base = (uintptr_t) sections[DS_HOT].mapping;
+ gflags.dumped_with_pdumper_ = true;
+ dump_private.header = *header;
+ dump_private.mark_bits = mark_bits[0];
+ dump_private.last_mark_bits = mark_bits[1];
+ dump_public.start = dump_base;
+ dump_public.end = dump_public.start + dump_size;
+
+ dump_do_all_dump_reloc_for_phase (header, dump_base, EARLY_RELOCS);
+ dump_do_all_emacs_relocations (header, dump_base);
+
+ dump_mmap_discard_contents (§ions[DS_DISCARDABLE]);
+ for (int i = 0; i < ARRAYELTS (sections); ++i)
+ dump_mmap_reset (§ions[i]);
+
+ Lisp_Object hashes = zero_vector;
+ if (header->hash_list)
+ {
+ struct Lisp_Vector *hash_tables =
+ (struct Lisp_Vector *) (dump_base + header->hash_list);
+ hashes = make_lisp_ptr (hash_tables, Lisp_Vectorlike);
+ }
+
+ pdumper_hashes = &hashes;
+ /* Run the functions Emacs registered for doing post-dump-load
+ initialization. */
+ for (int i = 0; i < nr_dump_hooks; ++i)
+ dump_hooks[i] ();
+
+ #ifdef HAVE_NATIVE_COMP
+ pdumper_set_emacs_execdir (argv0);
+ #else
+ (void) argv0;
+ #endif
+
+ dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS);
+ dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS);
+
+ /* Run the functions Emacs registered for doing post-dump-load
+ initialization. */
+ for (int i = 0; i < nr_dump_late_hooks; ++i)
+ dump_late_hooks[i] ();
+
+ initialized = true;
+
+ struct timespec load_timespec =
+ timespec_sub (current_timespec (), start_time);
+ dump_private.load_time = timespectod (load_timespec);
+ dump_private.dump_filename = dump_filename_copy;
+
+ out:
+ for (int i = 0; i < ARRAYELTS (sections); ++i)
+ dump_mmap_release (§ions[i]);
+ if (dump_fd >= 0)
+ emacs_close (dump_fd);
+
+ return err;
+ }
+
+ /* Prepend the Emacs startup directory to dump_filename, if that is
+ relative, so that we could later make it absolute correctly. */
+ void
+ pdumper_record_wd (const char *wd)
+ {
+ if (wd && !file_name_absolute_p (dump_private.dump_filename))
+ {
+ char *dfn = xmalloc (strlen (wd) + 1
+ + strlen (dump_private.dump_filename) + 1);
+ splice_dir_file (dfn, wd, dump_private.dump_filename);
+ xfree (dump_private.dump_filename);
+ dump_private.dump_filename = dfn;
+ }
+ }
+
+ DEFUN ("pdumper-stats", Fpdumper_stats, Spdumper_stats, 0, 0, 0,
+ doc: /* Return statistics about portable dumping used by this session.
+ If this Emacs session was started from a dump file,
+ the return value is an alist of the form:
+
+ ((dumped-with-pdumper . t) (load-time . TIME) (dump-file-name . FILE))
+
+ where TIME is the time in seconds it took to restore Emacs state
+ from the dump file, and FILE is the name of the dump file.
+ Value is nil if this session was not started using a dump file.*/)
+ (void)
+ {
+ if (!dumped_with_pdumper_p ())
+ return Qnil;
+
+ Lisp_Object dump_fn;
+ #ifdef WINDOWSNT
+ char dump_fn_utf8[MAX_UTF8_PATH];
+ if (filename_from_ansi (dump_private.dump_filename, dump_fn_utf8) == 0)
+ dump_fn = DECODE_FILE (build_unibyte_string (dump_fn_utf8));
+ else
+ dump_fn = build_unibyte_string (dump_private.dump_filename);
+ #else
+ dump_fn = DECODE_FILE (build_unibyte_string (dump_private.dump_filename));
+ #endif
+
+ dump_fn = Fexpand_file_name (dump_fn, Qnil);
+
+ return list3 (Fcons (Qdumped_with_pdumper, Qt),
+ Fcons (Qload_time, make_float (dump_private.load_time)),
+ Fcons (Qdump_file_name, dump_fn));
+ }
+
+ static void
+ thaw_hash_tables (void)
+ {
+ Lisp_Object hash_tables = *pdumper_hashes;
+ for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
+ hash_table_thaw (AREF (hash_tables, i));
+ }
+
+ #endif /* HAVE_PDUMPER */
+
+ \f
+ void
+ init_pdumper_once (void)
+ {
+ #ifdef HAVE_PDUMPER
+ pdumper_do_now_and_after_load (thaw_hash_tables);
+ #endif
+ }
+
+ void
+ syms_of_pdumper (void)
+ {
+ #ifdef HAVE_PDUMPER
+ defsubr (&Sdump_emacs_portable);
+ defsubr (&Sdump_emacs_portable__sort_predicate);
+ defsubr (&Sdump_emacs_portable__sort_predicate_copied);
+ DEFSYM (Qdump_emacs_portable__sort_predicate,
+ "dump-emacs-portable--sort-predicate");
+ DEFSYM (Qdump_emacs_portable__sort_predicate_copied,
+ "dump-emacs-portable--sort-predicate-copied");
+ DEFSYM (Qdumped_with_pdumper, "dumped-with-pdumper");
+ DEFSYM (Qload_time, "load-time");
+ DEFSYM (Qdump_file_name, "dump-file-name");
+ DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook");
+ defsubr (&Spdumper_stats);
+ #endif /* HAVE_PDUMPER */
+ }
/* Lisp object printing and output streams.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2017 Free Software
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
--Foundation, Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
}
- if (! XMARKER (OVERLAY_START (obj))->buffer)
+ return true;
+
+ default:
+ break;
+ }
+
+ /* Then do all the pseudovector types that don't have a readable
+ syntax. First check whether this is handled by
+ `print-unreadable-function'. */
+ if (!NILP (Vprint_unreadable_function)
+ && FUNCTIONP (Vprint_unreadable_function))
+ {
+ specpdl_ref count = SPECPDL_INDEX ();
+ /* Bind `print-unreadable-function' to nil to avoid accidental
+ infinite recursion in the function called. */
+ Lisp_Object func = Vprint_unreadable_function;
+ specbind (Qprint_unreadable_function, Qnil);
+
+ /* If we're being called from `prin1-to-string' or the like,
+ we're now in the secret " prin1" buffer. This can lead to
+ problems if, for instance, the callback function switches a
+ window to this buffer -- this will make Emacs segfault. */
+ if (!NILP (Vprint__unreadable_callback_buffer)
+ && !NILP (Fbuffer_live_p (Vprint__unreadable_callback_buffer)))
+ {
+ record_unwind_current_buffer ();
+ set_buffer_internal (XBUFFER (Vprint__unreadable_callback_buffer));
+ }
+ Lisp_Object result = CALLN (Ffuncall, func, obj,
+ escapeflag? Qt: Qnil);
+ unbind_to (count, Qnil);
+
+ if (!NILP (result))
+ {
+ if (STRINGP (result))
+ print_string (result, printcharfun);
+ /* It's handled, so stop processing here. */
+ return true;
+ }
+ }
+
+ /* Not handled; print unreadable object. */
+ switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
+ {
+ case PVEC_MARKER:
+ print_c_string ("#<marker ", printcharfun);
+ /* Do you think this is necessary? */
+ if (XMARKER (obj)->insertion_type != 0)
+ print_c_string ("(moves after insertion) ", printcharfun);
+ if (! XMARKER (obj)->buffer)
+ print_c_string ("in no buffer", printcharfun);
+ else
+ {
+ int len = sprintf (buf, "at %"pD"d in ", marker_position (obj));
+ strout (buf, len, len, printcharfun);
+ print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
+ }
+ printchar ('>', printcharfun);
+ break;
+
+ case PVEC_SYMBOL_WITH_POS:
+ {
+ struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj);
+ if (print_symbols_bare)
+ print_object (sp->sym, printcharfun, escapeflag);
+ else
+ {
+ print_c_string ("#<symbol ", printcharfun);
+ if (BARE_SYMBOL_P (sp->sym))
+ print_object (sp->sym, printcharfun, escapeflag);
+ else
+ print_c_string ("NOT A SYMBOL!!", printcharfun);
+ if (FIXNUMP (sp->pos))
+ {
+ print_c_string (" at ", printcharfun);
+ print_object (sp->pos, printcharfun, escapeflag);
+ }
+ else
+ print_c_string (" NOT A POSITION!!", printcharfun);
+ printchar ('>', printcharfun);
+ }
+ }
+ break;
+
+ case PVEC_OVERLAY:
+ print_c_string ("#<overlay ", printcharfun);
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
++ if (! OVERLAY_BUFFER (obj))
+ print_c_string ("in no buffer", printcharfun);
+ else
+ {
+ int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
- print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
++ OVERLAY_START (obj),
++ OVERLAY_END (obj));
+ strout (buf, len, len, printcharfun);
++ print_string (BVAR (OVERLAY_BUFFER (obj), name),
+ printcharfun);
+ }
+ printchar ('>', printcharfun);
+ break;
+
+ case PVEC_USER_PTR:
+ {
+ print_c_string ("#<user-ptr ", printcharfun);
+ int i = sprintf (buf, "ptr=%p finalizer=%p",
+ XUSER_PTR (obj)->p,
+ (void *) XUSER_PTR (obj)->finalizer);
+ strout (buf, i, i, printcharfun);
+ printchar ('>', printcharfun);
+ }
+ break;
+
+ case PVEC_FINALIZER:
+ print_c_string ("#<finalizer", printcharfun);
+ if (NILP (XFINALIZER (obj)->function))
+ print_c_string (" used", printcharfun);
+ printchar ('>', printcharfun);
+ break;
+
+ case PVEC_MISC_PTR:
+ {
+ /* This shouldn't happen in normal usage, but let's
+ print it anyway for the benefit of the debugger. */
+ int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj));
+ strout (buf, i, i, printcharfun);
+ }
+ break;
+
+ case PVEC_PROCESS:
+ if (escapeflag)
+ {
+ print_c_string ("#<process ", printcharfun);
+ print_string (XPROCESS (obj)->name, printcharfun);
+ printchar ('>', printcharfun);
+ }
+ else
+ print_string (XPROCESS (obj)->name, printcharfun);
break;
case PVEC_SUBR:
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2017 Free Software Foundation,
- Copyright (C) 1993-1995, 1997, 1999-2022 Free Software Foundation,
-- Inc.
++ Copyright (C) 1993-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
}
if (BUFFERP (object))
{
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec;
- struct buffer *obuf = current_buffer;
-
- if (! (BUF_BEGV (XBUFFER (object)) <= pos
- && pos <= BUF_ZV (XBUFFER (object))))
+ struct buffer *b = XBUFFER (object);
+ struct interval_node *node;
+ struct sortvec items[2];
+ struct sortvec *result = NULL;
+ Lisp_Object result_tem = Qnil;
+
- if (XINT (position) < BUF_BEGV (b) || XINT (position) > BUF_ZV (b))
++ if (! (BUF_BEGV (b) <= pos
++ && pos <= BUF_ZV (b)))
xsignal1 (Qargs_out_of_range, position);
- buffer_overlay_iter_start(b, XINT (position), XINT (position) + 1,
- ITREE_ASCENDING);
- set_buffer_temp (XBUFFER (object));
-
- USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
- noverlays = sort_overlays (overlay_vec, noverlays, w);
-
- set_buffer_temp (obuf);
++ buffer_overlay_iter_start (b, pos, pos + 1, ITREE_ASCENDING);
/* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
+ while ((node = buffer_overlay_iter_next (b)))
{
- Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
- if (!NILP (tem))
- {
- if (overlay)
- /* Return the overlay we got the property from. */
- *overlay = overlay_vec[noverlays];
- SAFE_FREE ();
- return tem;
- }
+ Lisp_Object tem = Foverlay_get (node->data, prop);
+ struct sortvec *this;
+
+ if (NILP (tem) || (w && ! overlay_matches_window (w, node->data)))
+ continue;
+
+ this = (result == items ? items + 1 : items);
+ make_sortvec_item (this, node->data);
+ if (! result || (compare_overlays (result, this) < 0))
+ {
+ result = this;
+ result_tem = tem;
+ }
}
- SAFE_FREE ();
+ buffer_overlay_iter_finish (b);
+ if (result)
+ {
+ if (overlay)
+ *overlay = result->overlay;
+ return result_tem;
+ }
}
if (overlay)
/* Display generation from window structure and buffer text.
- Copyright (C) 1985-1988, 1993-1995, 1997-2017 Free Software Foundation,
-Copyright (C) 1985-1988, 1993-1995, 1997-2022 Free Software Foundation,
--Inc.
++Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
} \
while (false)
- /* Process overlay before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ buffer_overlay_iter_start (current_buffer,
+ charpos - 1, charpos + 1, ITREE_DESCENDING);
+ /* Process overlays. */
+ while ((node = buffer_overlay_iter_next (current_buffer)))
{
- overlay = node->data;
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
++ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- start = node->begin;
- end = node->end;
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (end < charpos)
- break;
++ ptrdiff_t start = node->begin;
++ ptrdiff_t end = node->end;
/* Skip this overlay if it doesn't start or end at IT's current
- position. */
+ position. */
if (end != charpos && start != charpos)
- continue;
+ continue;
/* Skip this overlay if it doesn't apply to IT->w. */
- window = Foverlay_get (overlay, Qwindow);
+ Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
+ continue;
/* If the text ``under'' the overlay is invisible, both before-
- and after-strings from this overlay are visible; start and
- end position are indistinguishable. */
- invisible = Foverlay_get (overlay, Qinvisible);
- invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
+ and after-strings from this overlay are visible; start and
+ end position are indistinguishable. */
+ Lisp_Object invisible = Foverlay_get (overlay, Qinvisible);
+ int invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
/* If overlay has a non-empty before-string, record it. */
+ Lisp_Object str;
if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
-
- /* If overlay has a non-empty after-string, record it. */
- if ((end == charpos || (start == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, true);
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (start > charpos)
- break;
-
- /* Skip this overlay if it doesn't start or end at IT's current
- position. */
- if (end != charpos && start != charpos)
- continue;
-
- /* Skip this overlay if it doesn't apply to IT->w. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
-
- /* If the text ``under'' the overlay is invisible, it has a zero
- dimension, and both before- and after-strings apply. */
- Lisp_Object invisible = Foverlay_get (overlay, Qinvisible);
- int invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
-
- /* If overlay has a non-empty before-string, record it. */
- Lisp_Object str;
- if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
+ && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
+ && SCHARS (str))
+ RECORD_OVERLAY_STRING (overlay, str, false);
/* If overlay has a non-empty after-string, record it. */
if ((end == charpos || (start == charpos && invis != 0))
{
ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it);
- DEC_BOTH (cp, bp);
- IT_CHARPOS (*it) = find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it));
+ dec_both (&cp, &bp);
+ SET_WITH_NARROWED_BEGV (it, IT_CHARPOS (*it),
+ find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)),
+ get_closer_narrowed_begv (it->w, IT_CHARPOS (*it)));
+ }
+
+ /* Find in the current buffer the first display or overlay string
+ between STARTPOS and ENDPOS that includes embedded newlines.
+ Consider only overlays that apply to window W.
+ Value is non-zero if such a display/overlay string is found. */
+ static bool
+ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w)
+ {
++ struct interval_node *node;
+ /* Process overlays before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
++ buffer_overlay_iter_start (current_buffer,
++ startpos, endpos, ITREE_DESCENDING);
++ while ((node = buffer_overlay_iter_next (current_buffer)))
+ {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
++ Lisp_Object overlay = node->data;
+ eassert (OVERLAYP (overlay));
+
+ /* Skip this overlay if it doesn't apply to our window. */
+ Lisp_Object window = Foverlay_get (overlay, Qwindow);
+ if (WINDOWP (window) && XWINDOW (window) != w)
+ continue;
+
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_before, once we get
- to an overlay whose end position is before STARTPOS, all the
- rest also end before STARTPOS, and thus are of no concern to us. */
- if (oend < startpos)
- break;
-
- /* Skip overlays that don't overlap the range. */
- if (!((startpos < oend && ostart < endpos)
- || (ostart == oend
- && (startpos == oend || (endpos == ZV && oend == endpos)))))
- continue;
-
- Lisp_Object str;
- str = Foverlay_get (overlay, Qbefore_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- str = Foverlay_get (overlay, Qafter_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- /* Skip this overlay if it doesn't apply to our window. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
-
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_after, once we get
- to an overlay whose start position is after ENDPOS, all the
- rest also start after ENDPOS, and thus are of no concern to us. */
- if (ostart > endpos)
- break;
++ ptrdiff_t ostart = node->begin;
++ ptrdiff_t oend = node->end;
+
+ /* Skip overlays that don't overlap the range. */
+ if (!((startpos < oend && ostart < endpos)
+ || (ostart == oend
+ && (startpos == oend || (endpos == ZV && oend == endpos)))))
+ continue;
+
+ Lisp_Object str;
+ str = Foverlay_get (overlay, Qbefore_string);
+ if (STRINGP (str) && SCHARS (str)
+ && memchr (SDATA (str), '\n', SBYTES (str)))
+ return true;
+ str = Foverlay_get (overlay, Qafter_string);
+ if (STRINGP (str) && SCHARS (str)
+ && memchr (SDATA (str), '\n', SBYTES (str)))
+ return true;
+ }
+
+ /* Check for 'display' properties whose values include strings. */
+ Lisp_Object cpos = make_fixnum (startpos);
+ Lisp_Object limpos = make_fixnum (endpos);
+
+ while ((cpos = Fnext_single_property_change (cpos, Qdisplay, Qnil, limpos),
+ !(NILP (cpos) || XFIXNAT (cpos) >= endpos)))
+ {
+ Lisp_Object spec = Fget_char_property (cpos, Qdisplay, Qnil);
+ Lisp_Object string = string_from_display_spec (spec);
+ if (STRINGP (string)
+ && memchr (SDATA (string), '\n', SBYTES (string)))
+ return true;
+ }
+
+ return false;
}
it2.from_disp_prop_p = false;
if (handle_display_prop (&it2) == HANDLED_RETURN
&& !NILP (val = get_char_property_and_overlay
- (make_number (pos), Qdisplay, Qnil, &overlay))
+ (make_fixnum (pos), Qdisplay, Qnil, &overlay))
&& (OVERLAYP (overlay)
- ? (beg = OVERLAY_POSITION (OVERLAY_START (overlay)))
+ ? (beg = OVERLAY_START (overlay))
: get_property_and_range (pos, Qdisplay, &val, &beg, &end, Qnil)))
{
RESTORE_IT (it, it, it2data);
row->displays_text_p = true;
row->starts_in_middle_of_char_p = it->starts_in_middle_of_char_p;
it->starts_in_middle_of_char_p = false;
+ it->stretch_adjust = 0;
+ it->line_number_produced_p = false;
- /* Arrange the overlays nicely for our purposes. Usually, we call
- display_line on only one line at a time, in which case this
- can't really hurt too much, or we call it on lines which appear
- one after another in the buffer, in which case all calls to
- recenter_overlay_lists but the first will be pretty cheap. */
- recenter_overlay_lists (current_buffer, IT_CHARPOS (*it));
-
/* If we are going to display the cursor's line, account for the
hscroll of that line. We subtract the window's min_hscroll,
because that was already accounted for in init_iterator. */
/* Check mouse-face highlighting. */
if (! same_region
/* If there exists an overlay with mouse-face overlapping
- the one we are currently highlighting, we have to
- check if we enter the overlapping overlay, and then
- highlight only that. */
- || (OVERLAYP (hlinfo->mouse_face_overlay)
- && mouse_face_overlay_overlaps (hlinfo->mouse_face_overlay)))
+ the one we are currently highlighting, we have to check
+ if we enter the overlapping overlay, and then highlight
+ only that. Skip the check when mouse-face highlighting
+ is currently hidden to avoid Bug#30519. */
+ || (!hlinfo->mouse_face_hidden
+ && OVERLAYP (hlinfo->mouse_face_overlay)
+ /* It's possible the overlay was deleted (Bug#35273). */
- && XMARKER (OVERLAY_START (hlinfo->mouse_face_overlay))->buffer
++ && OVERLAY_BUFFER (hlinfo->mouse_face_overlay)
+ && mouse_face_overlay_overlaps (hlinfo->mouse_face_overlay)))
{
/* Find the highest priority overlay with a mouse-face. */
Lisp_Object overlay = Qnil;
so discard the mouse-face text property, if any, and
use the overlay property instead. */
memcpy (attrs, default_face->lface, sizeof attrs);
- merge_face_ref (f, prop, attrs, true, 0);
+ merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
}
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
+ oendpos = OVERLAY_END (overlay_vec[i]);
if (oendpos < endpos)
endpos = oendpos;
}
ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
+
if (!NILP (prop))
- merge_face_ref (f, prop, attrs, true, 0);
+ merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
+ oendpos = OVERLAY_END (overlay_vec[i]);
+ if (oendpos < endpos)
+ endpos = oendpos;
+ }
}
*endptr = endpos;
;;; Code:
(require 'ert)
+(require 'seq)
+ (require 'ert-x)
+ (require 'cl-lib)
+ (require 'let-alist)
+
+ (defun overlay-tests-start-recording-modification-hooks (overlay)
+ "Start recording modification hooks on OVERLAY.
+
+ Always overwrites the `insert-in-front-hooks',
+ `modification-hooks' and `insert-behind-hooks' properties. Any
+ recorded history from a previous call is erased.
+
+ The history is stored in a property on the overlay itself. Call
+ `overlay-tests-get-recorded-modification-hooks' to retrieve the
+ recorded calls conveniently."
+ (dolist (hooks-property '(insert-in-front-hooks
+ modification-hooks
+ insert-behind-hooks))
+ (overlay-put
+ overlay
+ hooks-property
+ (list (lambda (ov &rest args)
+ (message " %S called on %S with args %S" hooks-property ov args)
+ (should inhibit-modification-hooks)
+ (should (eq ov overlay))
+ (push (list hooks-property args)
+ (overlay-get overlay
+ 'recorded-modification-hook-calls)))))
+ (overlay-put overlay 'recorded-modification-hook-calls nil)))
+
+ (defun overlay-tests-get-recorded-modification-hooks (overlay)
+ "Extract the recorded calls made to modification hooks on OVERLAY.
+
+ Must be preceded by a call to
+ `overlay-tests-start-recording-modification-hooks' on OVERLAY.
+
+ Returns a list. Each element of the list represents a recorded
+ call to a particular modification hook.
+
+ Each call is itself a sub-list where the first element is a
+ symbol matching the modification hook property (one of
+ `insert-in-front-hooks', `modification-hooks' or
+ `insert-behind-hooks') and the second element is the list of
+ arguments passed to the hook. The first hook argument, the
+ overlay itself, is omitted to make test result verification
+ easier."
+ (reverse (overlay-get overlay
+ 'recorded-modification-hook-calls)))
+
+ (ert-deftest overlay-modification-hooks ()
+ "Test the basic functionality of overlay modification hooks.
+
+ This exercises hooks registered on the `insert-in-front-hooks',
+ `modification-hooks' and `insert-behind-hooks' overlay
+ properties."
+ ;; This is a data driven test loop. Each test case is described
+ ;; by an alist. The test loop initializes a new temporary buffer
+ ;; for each case, creates an overlay, registers modification hooks
+ ;; on the overlay, modifies the buffer, and then verifies which
+ ;; modification hooks (if any) were called for the overlay, as
+ ;; well as which arguments were passed to the hooks.
+ ;;
+ ;; The following keys are available in the alist:
+ ;;
+ ;; `buffer-text': the initial buffer text of the temporary buffer.
+ ;; Defaults to "1234".
+ ;;
+ ;; `overlay-beg' and `overlay-end': the begin and end positions of
+ ;; the overlay under test. Defaults to 2 and 4 respectively.
+ ;;
+ ;; `insert-at': move to the given position and insert the string
+ ;; "x" into the test case's buffer.
+ ;;
+ ;; `replace': replace the first occurrence of the given string in
+ ;; the test case's buffer with "x". The test will fail if the
+ ;; string is not found.
+ ;;
+ ;; `expected-calls': a description of the expected buffer
+ ;; modification hooks. See
+ ;; `overlay-tests-get-recorded-modification-hooks' for the format.
+ ;; May be omitted, in which case the test will insist that no
+ ;; modification hooks are called.
+ ;;
+ ;; The test will fail itself in the degenerate case where no
+ ;; buffer modifications are requested.
+ (dolist (test-case
+ '(
+ ;; Remember that the default buffer text is "1234" and
+ ;; the default overlay begins at position 2 and ends at
+ ;; position 4. Most of the test cases below assume
+ ;; this.
+
+ ;; TODO: (info "(elisp) Special Properties") says this
+ ;; about `modification-hooks': "Furthermore, insertion
+ ;; will not modify any existing character, so this hook
+ ;; will only be run when removing some characters,
+ ;; replacing them with others, or changing their
+ ;; text-properties." So, why are modification-hooks
+ ;; being called when inserting at position 3 below?
+ ((insert-at . 1))
+ ((insert-at . 2)
+ (expected-calls . ((insert-in-front-hooks (nil 2 2))
+ (insert-in-front-hooks (t 2 3 0)))))
+ ((insert-at . 3)
+ (expected-calls . ((modification-hooks (nil 3 3))
+ (modification-hooks (t 3 4 0)))))
+ ((insert-at . 4)
+ (expected-calls . ((insert-behind-hooks (nil 4 4))
+ (insert-behind-hooks (t 4 5 0)))))
+ ((insert-at . 5))
+
+ ;; Replacing text never calls `insert-in-front-hooks'
+ ;; or `insert-behind-hooks'. It calls
+ ;; `modification-hooks' if the overlay covers any text
+ ;; that has changed.
+ ((replace . "1"))
+ ((replace . "2")
+ (expected-calls . ((modification-hooks (nil 2 3))
+ (modification-hooks (t 2 3 1)))))
+ ((replace . "3")
+ (expected-calls . ((modification-hooks (nil 3 4))
+ (modification-hooks (t 3 4 1)))))
+ ((replace . "4"))
+ ((replace . "12")
+ (expected-calls . ((modification-hooks (nil 1 3))
+ (modification-hooks (t 1 2 2)))))
+ ((replace . "23")
+ (expected-calls . ((modification-hooks (nil 2 4))
+ (modification-hooks (t 2 3 2)))))
+ ((replace . "34")
+ (expected-calls . ((modification-hooks (nil 3 5))
+ (modification-hooks (t 3 4 2)))))
+ ((replace . "123")
+ (expected-calls . ((modification-hooks (nil 1 4))
+ (modification-hooks (t 1 2 3)))))
+ ((replace . "234")
+ (expected-calls . ((modification-hooks (nil 2 5))
+ (modification-hooks (t 2 3 3)))))
+ ((replace . "1234")
+ (expected-calls . ((modification-hooks (nil 1 5))
+ (modification-hooks (t 1 2 4)))))
+
+ ;; Inserting at the position of a zero-length overlay
+ ;; calls both `insert-in-front-hooks' and
+ ;; `insert-behind-hooks'.
+ ((buffer-text . "") (overlay-beg . 1) (overlay-end . 1)
+ (insert-at . 1)
+ (expected-calls . ((insert-in-front-hooks
+ (nil 1 1))
+ (insert-behind-hooks
+ (nil 1 1))
+ (insert-in-front-hooks
+ (t 1 2 0))
+ (insert-behind-hooks
+ (t 1 2 0)))))))
+ (message "BEGIN overlay-modification-hooks test-case %S" test-case)
+
+ ;; All three hooks ignore the overlay's `front-advance' and
+ ;; `rear-advance' option, so test both ways while expecting the same
+ ;; result.
+ (dolist (advance '(nil t))
+ (message " advance is %S" advance)
+ (let-alist test-case
+ (with-temp-buffer
+ ;; Set up the temporary buffer and overlay as specified by
+ ;; the test case.
+ (insert (or .buffer-text "1234"))
+ (let ((overlay (make-overlay
+ (or .overlay-beg 2)
+ (or .overlay-end 4)
+ nil
+ advance advance)))
+ (message " (buffer-string) is %S" (buffer-string))
+ (message " overlay is %S" overlay)
+ (overlay-tests-start-recording-modification-hooks overlay)
+
+ ;; Modify the buffer, possibly inducing calls to the
+ ;; overlay's modification hooks.
+ (should (or .insert-at .replace))
+ (when .insert-at
+ (goto-char .insert-at)
+ (insert "x")
+ (message " inserted \"x\" at %S, buffer-string now %S"
+ .insert-at (buffer-string)))
+ (when .replace
+ (goto-char (point-min))
+ (search-forward .replace)
+ (replace-match "x")
+ (message " replaced %S with \"x\"" .replace))
+
+ ;; Verify that the expected and actual modification hook
+ ;; calls match.
+ (should (equal
+ .expected-calls
+ (overlay-tests-get-recorded-modification-hooks
+ overlay)))))))))
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+
+
+\f
+;; +===================================================================================+
+;; | Autogenerated insert/delete/narrow tests
+;; +===================================================================================+
+
++(when nil ;; Let's comment these out for now.
+
+;; (defun test-overlay-generate-test (name)
+;; (interactive)
+;; (with-temp-buffer
+;; (let ((forms nil)
+;; (buffer-size 64)
+;; (noverlays 16)
+;; (nforms 32)
+;; (dist '(0.5 0.4 0.1)))
+;; (cl-labels ((brand ()
+;; (+ (point-min)
+;; (random (1+ (- (point-max) (point-min)))))))
+;; (cl-macrolet ((push-eval (form)
+;; `(cl-destructuring-bind (&rest args)
+;; (list ,@(cdr form))
+;; (push (cons ',(car form) args) forms)
+;; (apply #',(car form) args))))
+;; (push-eval (insert (make-string buffer-size ?.)))
+;; (dotimes (_ noverlays)
+;; (push-eval (make-overlay (brand) (brand)
+;; nil
+;; (= 0 (random 2))
+;; (= 0 (random 2)))))
+;; (dotimes (_ nforms)
+;; (push-eval (goto-char (brand)))
+;; (pcase (/ (random 100) 100.0)
+;; ((and x (guard (< x (nth 0 dist))))
+;; (push-eval (insert (make-string (random 16) ?.))))
+;; ((and x (guard (< x (+ (nth 0 dist) (nth 1 dist)))))
+;; (push-eval (delete-char (random (1+ (- (point-max) (point)))))))
+;; (_
+;; (push-eval (widen))
+;; (push-eval (narrow-to-region (brand) (brand))))))
+;; `(ert-deftest ,name ()
+;; (with-temp-buffer
+;; ,@(nreverse forms)
+;; (should (equal (test-overlay-regions)
+;; ',(test-overlay-regions))))))))))
+
+;; (defun test-overlay-generate-tests (n)
+;; (let ((namefmt "overlay-autogenerated-test-%d")
+;; (standard-output (current-buffer))
+;; (print-length nil)
+;; (print-level nil)
+;; (print-quoted t))
+;; (dotimes (i n)
+;; (pp (test-overlay-generate-test (intern (format namefmt i))))
+;; (terpri))))
+
+;; (progn (random "4711") (test-overlay-generate-tests 64))
+
+(ert-deftest overlay-autogenerated-test-0 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 63 7 nil t t)
+ (make-overlay 47 9 nil nil nil)
+ (make-overlay 50 43 nil nil nil)
+ (make-overlay 20 53 nil nil t)
+ (make-overlay 62 4 nil nil t)
+ (make-overlay 40 27 nil t t)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 46 38 nil nil nil)
+ (make-overlay 51 28 nil t nil)
+ (make-overlay 12 53 nil t t)
+ (make-overlay 52 60 nil nil nil)
+ (make-overlay 13 47 nil nil nil)
+ (make-overlay 16 31 nil nil nil)
+ (make-overlay 9 48 nil t t)
+ (make-overlay 43 29 nil nil t)
+ (make-overlay 48 13 nil t nil)
+ (goto-char 44)
+ (delete-char 15)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 16)
+ (insert "..............")
+ (goto-char 12)
+ (delete-char 15)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 13)
+ (delete-char 5)
+ (goto-char 8)
+ (insert "...")
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 14)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 30)
+ (insert "..........")
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 34 41)
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 80 66)
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 69)
+ (delete-char 5)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 50 71)
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 54)
+ (insert "...............")
+ (goto-char 84)
+ (insert "....")
+ (goto-char 72)
+ (insert "...........")
+ (goto-char 84)
+ (insert "..........")
+ (goto-char 102)
+ (insert "")
+ (goto-char 80)
+ (delete-char 25)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 99)
+ (7 . 100)
+ (48 . 99)
+ (48 . 99)
+ (48 . 99)
+ (49 . 99)
+ (49 . 99)
+ (51 . 80)
+ (51 . 99)
+ (80 . 99)
+ (80 . 99)
+ (80 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-1 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 17 27 nil nil nil)
+ (make-overlay 13 28 nil nil t)
+ (make-overlay 8 56 nil nil nil)
+ (make-overlay 34 64 nil nil nil)
+ (make-overlay 51 4 nil t t)
+ (make-overlay 1 19 nil nil nil)
+ (make-overlay 53 59 nil nil t)
+ (make-overlay 25 13 nil nil nil)
+ (make-overlay 19 28 nil t nil)
+ (make-overlay 33 23 nil t nil)
+ (make-overlay 10 46 nil t t)
+ (make-overlay 18 39 nil nil nil)
+ (make-overlay 1 49 nil t nil)
+ (make-overlay 57 21 nil t t)
+ (make-overlay 10 58 nil t t)
+ (make-overlay 39 49 nil nil t)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 3)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 14)
+ (goto-char 18)
+ (insert "..........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 49)
+ (delete-char 10)
+ (goto-char 11)
+ (delete-char 12)
+ (goto-char 17)
+ (delete-char 22)
+ (goto-char 8)
+ (insert ".")
+ (goto-char 16)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 22)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 11)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 7)
+ (insert "...............")
+ (goto-char 2)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 13)
+ (insert "..............")
+ (goto-char 17)
+ (delete-char 3)
+ (goto-char 21)
+ (insert "......")
+ (goto-char 15)
+ (delete-char 32)
+ (goto-char 10)
+ (insert "........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 15 20)
+ (goto-char 17)
+ (insert ".............")
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 8)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 21)
+ (insert ".....")
+ (goto-char 31)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 58)
+ (1 . 58))))))
+
+(ert-deftest overlay-autogenerated-test-2 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 59 nil t t)
+ (make-overlay 56 16 nil nil nil)
+ (make-overlay 65 51 nil t nil)
+ (make-overlay 14 24 nil t nil)
+ (make-overlay 28 9 nil t nil)
+ (make-overlay 58 50 nil t t)
+ (make-overlay 13 32 nil t t)
+ (make-overlay 12 21 nil t nil)
+ (make-overlay 60 23 nil t nil)
+ (make-overlay 39 38 nil nil t)
+ (make-overlay 15 64 nil t nil)
+ (make-overlay 17 21 nil nil t)
+ (make-overlay 46 23 nil t t)
+ (make-overlay 19 40 nil t nil)
+ (make-overlay 13 48 nil nil t)
+ (make-overlay 35 11 nil t nil)
+ (goto-char 41)
+ (delete-char 19)
+ (goto-char 45)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 32)
+ (goto-char 19)
+ (insert "")
+ (goto-char 16)
+ (insert "...............")
+ (goto-char 2)
+ (insert "")
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 18)
+ (delete-char 17)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 12)
+ (insert "...")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 15)
+ (insert ".......")
+ (goto-char 43)
+ (insert "......")
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 38)
+ (insert "...............")
+ (goto-char 76)
+ (delete-char 3)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 70)
+ (delete-char 9)
+ (goto-char 36)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 52)
+ (delete-char 14)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 64)
+ (insert "...........")
+ (goto-char 68)
+ (delete-char 21)
+ (goto-char 71)
+ (insert "........")
+ (goto-char 28)
+ (delete-char 43)
+ (goto-char 25)
+ (insert "....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 40)
+ (insert "....")
+ (goto-char 56)
+ (delete-char 2)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 58))))))
+
+(ert-deftest overlay-autogenerated-test-3 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 53 38 nil t nil)
+ (make-overlay 17 40 nil t t)
+ (make-overlay 64 26 nil t t)
+ (make-overlay 48 24 nil t nil)
+ (make-overlay 21 18 nil nil nil)
+ (make-overlay 2 20 nil nil t)
+ (make-overlay 43 26 nil t t)
+ (make-overlay 56 28 nil t nil)
+ (make-overlay 19 51 nil nil nil)
+ (make-overlay 39 61 nil t nil)
+ (make-overlay 59 12 nil t nil)
+ (make-overlay 65 7 nil t nil)
+ (make-overlay 41 7 nil t nil)
+ (make-overlay 62 50 nil t nil)
+ (make-overlay 7 10 nil t t)
+ (make-overlay 45 28 nil t nil)
+ (goto-char 13)
+ (insert "...")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 2 10)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 6)
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 55 70)
+ (goto-char 55)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 12)
+ (goto-char 61)
+ (insert ".....")
+ (goto-char 64)
+ (insert "..............")
+ (goto-char 72)
+ (delete-char 6)
+ (goto-char 63)
+ (delete-char 12)
+ (goto-char 63)
+ (delete-char 2)
+ (goto-char 57)
+ (insert "..............")
+ (goto-char 68)
+ (insert "........")
+ (goto-char 77)
+ (delete-char 6)
+ (goto-char 77)
+ (insert ".............")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 84)
+ (insert "........")
+ (goto-char 74)
+ (delete-char 12)
+ (goto-char 78)
+ (insert "...")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 69)
+ (insert "......")
+ (goto-char 89)
+ (insert ".")
+ (goto-char 56)
+ (insert "....")
+ (goto-char 100)
+ (insert ".............")
+ (goto-char 114)
+ (delete-char 0)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 94 50)
+ (goto-char 55)
+ (insert "............")
+ (goto-char 53)
+ (insert ".............")
+ (goto-char 116)
+ (delete-char 3)
+ (goto-char 81)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 166)
+ (16 . 164)
+ (26 . 164)
+ (31 . 68)
+ (33 . 165)
+ (35 . 52)
+ (35 . 164)
+ (45 . 164)
+ (46 . 164))))))
+
+(ert-deftest overlay-autogenerated-test-4 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 15 nil nil t)
+ (make-overlay 8 13 nil nil nil)
+ (make-overlay 45 49 nil t t)
+ (make-overlay 22 13 nil t t)
+ (make-overlay 34 17 nil nil t)
+ (make-overlay 42 15 nil nil t)
+ (make-overlay 43 28 nil t t)
+ (make-overlay 3 28 nil t nil)
+ (make-overlay 32 61 nil nil t)
+ (make-overlay 30 64 nil t t)
+ (make-overlay 21 39 nil nil t)
+ (make-overlay 32 62 nil t nil)
+ (make-overlay 25 29 nil t nil)
+ (make-overlay 34 43 nil t nil)
+ (make-overlay 9 11 nil t nil)
+ (make-overlay 21 65 nil nil t)
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 25)
+ (insert "..")
+ (goto-char 53)
+ (insert "..")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 42)
+ (delete-char 36)
+ (goto-char 23)
+ (delete-char 12)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 30 32)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 28 27)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (insert ".")
+ (goto-char 28)
+ (insert "......")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 5)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 30)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 15)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 1)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 24 19)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 11 38)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 20 22)
+ (goto-char 20)
+ (delete-char 1)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 36 4)
+ (goto-char 26)
+ (delete-char 9)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((18 . 25)
+ (21 . 21)
+ (21 . 21)
+ (21 . 22)
+ (21 . 22)
+ (21 . 27)
+ (21 . 27)
+ (22 . 25)
+ (22 . 27)
+ (22 . 28)
+ (26 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-5 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 64 1 nil nil nil)
+ (make-overlay 38 43 nil nil nil)
+ (make-overlay 42 19 nil t nil)
+ (make-overlay 22 12 nil nil nil)
+ (make-overlay 12 30 nil t t)
+ (make-overlay 38 46 nil nil nil)
+ (make-overlay 18 23 nil nil nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 52 41 nil nil nil)
+ (make-overlay 12 26 nil nil nil)
+ (make-overlay 39 4 nil nil nil)
+ (make-overlay 20 1 nil nil t)
+ (make-overlay 36 60 nil nil nil)
+ (make-overlay 24 18 nil t nil)
+ (make-overlay 9 50 nil nil nil)
+ (make-overlay 19 17 nil t nil)
+ (goto-char 40)
+ (insert "")
+ (goto-char 64)
+ (insert ".............")
+ (goto-char 32)
+ (delete-char 40)
+ (goto-char 25)
+ (insert "...")
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "...........")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 11 21)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 9 24)
+ (goto-char 24)
+ (insert ".............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 47 45)
+ (goto-char 47)
+ (insert ".")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 30 42)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 34)
+ (insert ".......")
+ (goto-char 42)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 31)
+ (delete-char 6)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 53)
+ (insert "............")
+ (goto-char 41)
+ (delete-char 12)
+ (goto-char 52)
+ (insert ".......")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".......")
+ (goto-char 52)
+ (insert "......")
+ (goto-char 71)
+ (delete-char 10)
+ (goto-char 47)
+ (insert "")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((20 . 89))))))
+
+(ert-deftest overlay-autogenerated-test-6 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 59 nil nil nil)
+ (make-overlay 36 21 nil t t)
+ (make-overlay 60 19 nil t nil)
+ (make-overlay 26 30 nil t nil)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 8 25 nil t t)
+ (make-overlay 57 43 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 15 44 nil t nil)
+ (make-overlay 56 38 nil nil nil)
+ (make-overlay 39 44 nil nil t)
+ (make-overlay 50 6 nil t nil)
+ (make-overlay 6 19 nil t nil)
+ (make-overlay 50 44 nil t t)
+ (make-overlay 34 60 nil nil t)
+ (goto-char 27)
+ (insert "...............")
+ (goto-char 23)
+ (insert "..............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 53 67)
+ (goto-char 60)
+ (delete-char 0)
+ (goto-char 54)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 3)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 58)
+ (insert ".........")
+ (goto-char 76)
+ (insert "...........")
+ (goto-char 57)
+ (insert "....")
+ (goto-char 106)
+ (widen)
+ (narrow-to-region 5 45)
+ (goto-char 31)
+ (delete-char 8)
+ (goto-char 36)
+ (insert "...")
+ (goto-char 6)
+ (insert "........")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 28)
+ (delete-char 6)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 17 25)
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 9)
+ (goto-char 28)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 3)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 68 25)
+ (goto-char 38)
+ (delete-char 22)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 47 96)
+ (goto-char 86)
+ (insert ".")
+ (goto-char 63)
+ (insert "......")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 61 27)
+ (goto-char 43)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 38)
+ (14 . 132)
+ (16 . 43)
+ (38 . 118)
+ (38 . 126)
+ (38 . 142)
+ (44 . 115)
+ (45 . 129))))))
+
+(ert-deftest overlay-autogenerated-test-7 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 13 50 nil t nil)
+ (make-overlay 28 44 nil nil t)
+ (make-overlay 56 27 nil t nil)
+ (make-overlay 8 34 nil nil nil)
+ (make-overlay 22 8 nil nil t)
+ (make-overlay 8 28 nil t nil)
+ (make-overlay 65 31 nil nil t)
+ (make-overlay 44 8 nil nil nil)
+ (make-overlay 52 64 nil nil t)
+ (make-overlay 52 27 nil t t)
+ (make-overlay 47 32 nil nil nil)
+ (make-overlay 18 62 nil nil nil)
+ (make-overlay 18 24 nil t t)
+ (make-overlay 33 46 nil nil t)
+ (make-overlay 20 8 nil t nil)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 2)
+ (delete-char 46)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 2)
+ (delete-char 12)
+ (goto-char 2)
+ (insert "..")
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 2 4)
+ (goto-char 4)
+ (insert "......")
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 4 6)
+ (goto-char 5)
+ (insert "")
+ (goto-char 6)
+ (insert "...............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 7)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 24)
+ (delete-char 1)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 47 38)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 39)
+ (insert ".......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 47)
+ (insert "...........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 59)
+ (delete-char 1)
+ (goto-char 42)
+ (insert "...............")
+ (goto-char 65)
+ (insert "...........")
+ (goto-char 73)
+ (delete-char 13)
+ (goto-char 72)
+ (insert "....")
+ (goto-char 47)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (81 . 81)
+ (81 . 81))))))
+
+(ert-deftest overlay-autogenerated-test-8 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 6 nil t nil)
+ (make-overlay 48 13 nil t nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 63 65 nil nil nil)
+ (make-overlay 42 40 nil t t)
+ (make-overlay 40 6 nil nil t)
+ (make-overlay 37 46 nil t nil)
+ (make-overlay 4 14 nil nil nil)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 14 16 nil nil t)
+ (make-overlay 31 61 nil t nil)
+ (make-overlay 34 3 nil nil nil)
+ (make-overlay 11 16 nil t nil)
+ (make-overlay 19 42 nil nil t)
+ (make-overlay 30 9 nil nil t)
+ (make-overlay 63 52 nil t t)
+ (goto-char 57)
+ (delete-char 2)
+ (goto-char 8)
+ (insert "........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 15)
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 62)
+ (delete-char 21)
+ (goto-char 52)
+ (delete-char 10)
+ (goto-char 10)
+ (insert "............")
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".............")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 1)
+ (insert "...............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 130)
+ (insert "...")
+ (goto-char 69)
+ (insert "..")
+ (goto-char 101)
+ (insert "......")
+ (goto-char 128)
+ (delete-char 13)
+ (goto-char 19)
+ (delete-char 100)
+ (goto-char 22)
+ (insert "..")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 30 16)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 17)
+ (insert "..")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 47)
+ (insert ".")
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 70)
+ (delete-char 1)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((32 . 75)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 60)
+ (33 . 75)
+ (33 . 75)
+ (33 . 75)
+ (60 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-9 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 13 nil nil nil)
+ (make-overlay 29 4 nil nil t)
+ (make-overlay 3 53 nil nil nil)
+ (make-overlay 31 9 nil t t)
+ (make-overlay 48 30 nil nil nil)
+ (make-overlay 43 50 nil nil nil)
+ (make-overlay 7 27 nil nil t)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 42 25 nil nil t)
+ (make-overlay 15 13 nil t t)
+ (make-overlay 39 11 nil t t)
+ (make-overlay 21 62 nil t t)
+ (make-overlay 35 2 nil t nil)
+ (make-overlay 60 53 nil nil t)
+ (make-overlay 64 8 nil nil t)
+ (make-overlay 58 59 nil t t)
+ (goto-char 28)
+ (insert ".............")
+ (goto-char 28)
+ (insert "...............")
+ (goto-char 71)
+ (insert ".......")
+ (goto-char 65)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 12)
+ (goto-char 79)
+ (delete-char 11)
+ (goto-char 65)
+ (widen)
+ (narrow-to-region 12 53)
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 75)
+ (insert "........")
+ (goto-char 85)
+ (insert "............")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 8)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 112)
+ (insert "")
+ (goto-char 61)
+ (insert "..")
+ (goto-char 29)
+ (delete-char 34)
+ (goto-char 52)
+ (delete-char 32)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 69 55)
+ (goto-char 67)
+ (delete-char 2)
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 1)
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 63)
+ (insert ".")
+ (goto-char 56)
+ (insert ".....")
+ (goto-char 67)
+ (insert ".............")
+ (goto-char 76)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 90)
+ (3 . 90)
+ (3 . 90)
+ (3 . 99)
+ (3 . 117)
+ (3 . 117)
+ (3 . 120)
+ (9 . 118)
+ (13 . 102))))))
+
+(ert-deftest overlay-autogenerated-test-10 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 16 60 nil nil nil)
+ (make-overlay 36 53 nil nil nil)
+ (make-overlay 44 39 nil t t)
+ (make-overlay 61 47 nil t t)
+ (make-overlay 58 39 nil nil t)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 65 59 nil t t)
+ (make-overlay 13 57 nil nil t)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 16 19 nil nil nil)
+ (make-overlay 16 1 nil nil t)
+ (make-overlay 28 21 nil t t)
+ (make-overlay 10 62 nil nil nil)
+ (make-overlay 12 18 nil nil t)
+ (make-overlay 15 5 nil nil t)
+ (make-overlay 36 31 nil nil t)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 25)
+ (delete-char 28)
+ (goto-char 30)
+ (delete-char 10)
+ (goto-char 8)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "........")
+ (goto-char 6)
+ (delete-char 2)
+ (goto-char 4)
+ (insert "")
+ (goto-char 21)
+ (insert ".............")
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 1)
+ (delete-char 1)
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 21)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 5)
+ (delete-char 8)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 9)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "")
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 12)
+ (insert "")
+ (goto-char 11)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 1)
+ (delete-char 8)
+ (goto-char 1)
+ (insert "....")
+ (goto-char 1)
+ (insert "..")
+ (goto-char 7)
+ (insert "...")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 9 11)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 12)
+ (1 . 12)
+ (1 . 12)
+ (10 . 10)
+ (10 . 10)
+ (10 . 12))))))
+
+(ert-deftest overlay-autogenerated-test-11 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 33 18 nil nil nil)
+ (make-overlay 56 38 nil t nil)
+ (make-overlay 2 45 nil nil t)
+ (make-overlay 19 55 nil nil t)
+ (make-overlay 28 42 nil t t)
+ (make-overlay 50 29 nil t nil)
+ (make-overlay 40 63 nil nil nil)
+ (make-overlay 13 2 nil nil t)
+ (make-overlay 26 7 nil t t)
+ (make-overlay 22 25 nil nil nil)
+ (make-overlay 14 14 nil t nil)
+ (make-overlay 15 39 nil t t)
+ (make-overlay 51 22 nil t t)
+ (make-overlay 58 5 nil t nil)
+ (make-overlay 16 10 nil nil nil)
+ (make-overlay 32 33 nil t nil)
+ (goto-char 40)
+ (delete-char 20)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "..")
+ (goto-char 45)
+ (insert "...")
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 38)
+ (insert "......")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 99)
+ (widen)
+ (narrow-to-region 37 17)
+ (goto-char 29)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 34 96)
+ (goto-char 44)
+ (delete-char 22)
+ (goto-char 39)
+ (insert "..")
+ (goto-char 53)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 93)
+ (insert ".........")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 27 104)
+ (goto-char 93)
+ (delete-char 11)
+ (goto-char 59)
+ (insert "....")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 70)
+ (insert ".")
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 34)
+ (delete-char 46)
+ (goto-char 49)
+ (insert "......")
+ (goto-char 55)
+ (insert "...")
+ (goto-char 42)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 48)
+ (delete-char 28)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 62)
+ (5 . 62)
+ (9 . 34)
+ (22 . 61)
+ (33 . 55)
+ (33 . 62)
+ (34 . 34)
+ (34 . 62))))))
+
+(ert-deftest overlay-autogenerated-test-12 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 50 nil nil nil)
+ (make-overlay 63 3 nil nil t)
+ (make-overlay 44 20 nil t t)
+ (make-overlay 58 38 nil nil t)
+ (make-overlay 3 17 nil t nil)
+ (make-overlay 31 62 nil t nil)
+ (make-overlay 12 17 nil t nil)
+ (make-overlay 17 52 nil nil nil)
+ (make-overlay 9 35 nil nil nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 53 54 nil nil t)
+ (make-overlay 65 34 nil t nil)
+ (make-overlay 12 33 nil t nil)
+ (make-overlay 54 58 nil nil nil)
+ (make-overlay 42 26 nil t nil)
+ (make-overlay 2 4 nil t nil)
+ (goto-char 4)
+ (delete-char 26)
+ (goto-char 39)
+ (insert ".")
+ (goto-char 2)
+ (delete-char 14)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 19 1)
+ (goto-char 7)
+ (delete-char 9)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 4)
+ (insert "..........")
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 36 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 40)
+ (delete-char 5)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 3)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 9)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 45 15)
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 30)
+ (delete-char 6)
+ (goto-char 21)
+ (delete-char 9)
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 51)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 92)
+ (2 . 92)
+ (2 . 93)
+ (2 . 96)
+ (2 . 97)
+ (2 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-13 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 30 nil t t)
+ (make-overlay 54 37 nil nil t)
+ (make-overlay 16 61 nil nil t)
+ (make-overlay 58 7 nil nil t)
+ (make-overlay 27 39 nil nil t)
+ (make-overlay 39 31 nil nil t)
+ (make-overlay 11 47 nil nil nil)
+ (make-overlay 47 40 nil t t)
+ (make-overlay 27 18 nil nil nil)
+ (make-overlay 33 26 nil nil t)
+ (make-overlay 55 4 nil t t)
+ (make-overlay 62 50 nil t t)
+ (make-overlay 47 65 nil t t)
+ (make-overlay 17 23 nil nil t)
+ (make-overlay 30 31 nil t nil)
+ (make-overlay 10 37 nil t nil)
+ (goto-char 8)
+ (delete-char 6)
+ (goto-char 56)
+ (delete-char 0)
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 4)
+ (delete-char 28)
+ (goto-char 49)
+ (delete-char 4)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 10)
+ (delete-char 37)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 12 3)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 25)
+ (insert ".....")
+ (goto-char 10)
+ (widen)
+ (narrow-to-region 42 18)
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 48)
+ (insert ".......")
+ (goto-char 52)
+ (delete-char 6)
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 27)
+ (delete-char 13)
+ (goto-char 22)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 15)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 12 25)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 2 38)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-14 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 37 nil t nil)
+ (make-overlay 15 44 nil nil nil)
+ (make-overlay 31 34 nil nil t)
+ (make-overlay 35 33 nil t t)
+ (make-overlay 4 27 nil t t)
+ (make-overlay 37 5 nil nil t)
+ (make-overlay 58 19 nil nil t)
+ (make-overlay 57 47 nil nil t)
+ (make-overlay 49 5 nil t t)
+ (make-overlay 21 59 nil t t)
+ (make-overlay 42 33 nil t nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 9 51 nil t nil)
+ (make-overlay 20 24 nil nil t)
+ (make-overlay 21 7 nil t t)
+ (make-overlay 58 52 nil t t)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 55 54)
+ (goto-char 54)
+ (insert ".............")
+ (goto-char 55)
+ (insert "............")
+ (goto-char 66)
+ (delete-char 10)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 82)
+ (delete-char 2)
+ (goto-char 82)
+ (delete-char 0)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 71)
+ (insert "...............")
+ (goto-char 122)
+ (delete-char 0)
+ (goto-char 93)
+ (delete-char 3)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 121)
+ (insert "........")
+ (goto-char 92)
+ (insert "")
+ (goto-char 103)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 13)
+ (goto-char 116)
+ (delete-char 7)
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 60 27)
+ (goto-char 28)
+ (delete-char 16)
+ (goto-char 35)
+ (insert ".......")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 59)
+ (insert "........")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 36)
+ (insert "...........")
+ (goto-char 82)
+ (delete-char 11)
+ (goto-char 67)
+ (insert "..........")
+ (goto-char 46)
+ (delete-char 1)
+ (goto-char 47)
+ (insert "......")
+ (goto-char 69)
+ (delete-char 7)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 28)
+ (5 . 33)
+ (9 . 35)
+ (15 . 28)
+ (19 . 154)
+ (21 . 155)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (31 . 153)
+ (58 . 154))))))
+
+(ert-deftest overlay-autogenerated-test-15 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 19 nil t t)
+ (make-overlay 11 18 nil t nil)
+ (make-overlay 28 51 nil nil t)
+ (make-overlay 29 15 nil t t)
+ (make-overlay 46 57 nil t t)
+ (make-overlay 26 24 nil nil nil)
+ (make-overlay 29 43 nil nil nil)
+ (make-overlay 54 29 nil nil nil)
+ (make-overlay 34 52 nil t nil)
+ (make-overlay 10 32 nil nil nil)
+ (make-overlay 28 34 nil nil t)
+ (make-overlay 11 43 nil nil nil)
+ (make-overlay 18 50 nil t t)
+ (make-overlay 28 39 nil nil nil)
+ (make-overlay 62 62 nil t t)
+ (make-overlay 30 62 nil t nil)
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 6 22)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 29)
+ (insert "..............")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 55)
+ (insert "..........")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 47)
+ (delete-char 49)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 37)
+ (insert ".........")
+ (goto-char 69)
+ (insert ".")
+ (goto-char 36)
+ (insert "............")
+ (goto-char 75)
+ (insert ".............")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 44 21)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 84 28)
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 96 49)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 72)
+ (delete-char 24)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 105 83)
+ (goto-char 96)
+ (widen)
+ (narrow-to-region 109 46)
+ (goto-char 95)
+ (delete-char 4)
+ (goto-char 81)
+ (insert ".")
+ (goto-char 51)
+ (delete-char 8)
+ (goto-char 52)
+ (insert ".")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 50)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 81)
+ (23 . 88)
+ (66 . 99)
+ (69 . 81)
+ (78 . 85)
+ (81 . 106)
+ (84 . 85)
+ (85 . 90)
+ (85 . 95)
+ (85 . 99)
+ (85 . 107)
+ (85 . 110)
+ (86 . 118)
+ (90 . 108))))))
+
+(ert-deftest overlay-autogenerated-test-16 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 55 nil t nil)
+ (make-overlay 45 47 nil nil nil)
+ (make-overlay 23 57 nil t t)
+ (make-overlay 64 55 nil nil nil)
+ (make-overlay 37 26 nil t t)
+ (make-overlay 29 38 nil nil t)
+ (make-overlay 33 3 nil t t)
+ (make-overlay 49 16 nil t nil)
+ (make-overlay 35 56 nil t t)
+ (make-overlay 9 39 nil nil nil)
+ (make-overlay 2 61 nil nil nil)
+ (make-overlay 59 26 nil nil t)
+ (make-overlay 5 50 nil t t)
+ (make-overlay 19 19 nil nil t)
+ (make-overlay 64 21 nil t nil)
+ (make-overlay 21 8 nil nil t)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 29)
+ (insert "............")
+ (goto-char 42)
+ (delete-char 38)
+ (goto-char 24)
+ (insert "")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 8)
+ (goto-char 25)
+ (delete-char 6)
+ (goto-char 8)
+ (delete-char 21)
+ (goto-char 9)
+ (insert "..............")
+ (goto-char 3)
+ (insert "....")
+ (goto-char 8)
+ (delete-char 18)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 5 8)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 5)
+ (insert "")
+ (goto-char 7)
+ (delete-char 8)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 2 2)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 8)
+ (delete-char 2)
+ (goto-char 7)
+ (insert ".......")
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 7)
+ (insert "......")
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 4)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36))))))
+
+(ert-deftest overlay-autogenerated-test-17 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 37 nil t nil)
+ (make-overlay 40 3 nil t t)
+ (make-overlay 61 19 nil t t)
+ (make-overlay 46 9 nil nil t)
+ (make-overlay 64 39 nil nil t)
+ (make-overlay 50 58 nil nil t)
+ (make-overlay 21 30 nil t nil)
+ (make-overlay 44 54 nil t nil)
+ (make-overlay 32 2 nil t nil)
+ (make-overlay 14 9 nil t t)
+ (make-overlay 41 40 nil t nil)
+ (make-overlay 17 26 nil t nil)
+ (make-overlay 57 50 nil t t)
+ (make-overlay 16 65 nil nil t)
+ (make-overlay 13 61 nil t t)
+ (make-overlay 39 64 nil nil t)
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 3)
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 53 48)
+ (goto-char 48)
+ (delete-char 5)
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 59 58)
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 58)
+ (insert "...")
+ (goto-char 60)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 67)
+ (insert ".....")
+ (goto-char 73)
+ (insert "")
+ (goto-char 68)
+ (insert ".....")
+ (goto-char 64)
+ (insert "....")
+ (goto-char 62)
+ (insert "..")
+ (goto-char 91)
+ (insert "..........")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 100)
+ (delete-char 21)
+ (goto-char 74)
+ (insert "...")
+ (goto-char 60)
+ (delete-char 30)
+ (goto-char 64)
+ (widen)
+ (narrow-to-region 71 23)
+ (goto-char 53)
+ (delete-char 11)
+ (goto-char 23)
+ (delete-char 21)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "")
+ (goto-char 35)
+ (insert ".........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 27)
+ (17 . 67)
+ (20 . 71)
+ (23 . 23)
+ (23 . 24)
+ (23 . 67)
+ (23 . 70)
+ (23 . 70)
+ (27 . 41)
+ (28 . 41)
+ (28 . 41))))))
+
+(ert-deftest overlay-autogenerated-test-18 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 43 52 nil nil t)
+ (make-overlay 27 29 nil nil t)
+ (make-overlay 24 18 nil nil nil)
+ (make-overlay 39 52 nil nil nil)
+ (make-overlay 33 62 nil t t)
+ (make-overlay 16 7 nil t nil)
+ (make-overlay 47 39 nil nil t)
+ (make-overlay 59 41 nil nil nil)
+ (make-overlay 22 55 nil nil t)
+ (make-overlay 60 16 nil t t)
+ (make-overlay 55 20 nil nil t)
+ (make-overlay 25 12 nil nil t)
+ (make-overlay 26 2 nil nil t)
+ (make-overlay 17 35 nil nil t)
+ (make-overlay 46 41 nil t nil)
+ (make-overlay 57 53 nil t t)
+ (goto-char 52)
+ (insert "")
+ (goto-char 4)
+ (delete-char 21)
+ (goto-char 17)
+ (insert "")
+ (goto-char 35)
+ (insert "...............")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 9)
+ (insert "........")
+ (goto-char 73)
+ (delete-char 9)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 34 84)
+ (goto-char 81)
+ (insert "...........")
+ (goto-char 48)
+ (insert "...")
+ (goto-char 74)
+ (insert ".......")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 37 105)
+ (goto-char 75)
+ (insert "...............")
+ (goto-char 47)
+ (insert "..........")
+ (goto-char 99)
+ (delete-char 13)
+ (goto-char 105)
+ (delete-char 4)
+ (goto-char 94)
+ (delete-char 5)
+ (goto-char 96)
+ (insert "..............")
+ (goto-char 74)
+ (insert "")
+ (goto-char 121)
+ (insert "...")
+ (goto-char 102)
+ (insert "...")
+ (goto-char 64)
+ (insert "......")
+ (goto-char 67)
+ (insert "...")
+ (goto-char 95)
+ (delete-char 19)
+ (goto-char 37)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 67 96)
+ (goto-char 88)
+ (insert "..........")
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 111)
+ (widen)
+ (narrow-to-region 72 103)
+ (goto-char 101)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 119)
+ (4 . 119)
+ (4 . 162)
+ (35 . 162)
+ (51 . 78)
+ (53 . 162)
+ (55 . 78)
+ (79 . 162))))))
+
+(ert-deftest overlay-autogenerated-test-19 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 19 31 nil t t)
+ (make-overlay 40 5 nil nil nil)
+ (make-overlay 13 41 nil t t)
+ (make-overlay 41 43 nil nil t)
+ (make-overlay 7 60 nil t nil)
+ (make-overlay 40 23 nil t nil)
+ (make-overlay 32 15 nil t t)
+ (make-overlay 12 45 nil nil nil)
+ (make-overlay 18 1 nil nil nil)
+ (make-overlay 58 32 nil t t)
+ (make-overlay 30 3 nil t t)
+ (make-overlay 43 61 nil t nil)
+ (make-overlay 54 57 nil nil t)
+ (make-overlay 34 14 nil t t)
+ (make-overlay 26 49 nil nil t)
+ (make-overlay 54 49 nil nil t)
+ (goto-char 28)
+ (insert "........")
+ (goto-char 32)
+ (insert "...........")
+ (goto-char 78)
+ (delete-char 6)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 30)
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 10)
+ (insert ".")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert "......")
+ (goto-char 17)
+ (insert "..........")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 21)
+ (insert "............")
+ (goto-char 45)
+ (delete-char 7)
+ (goto-char 39)
+ (insert "...............")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 63)
+ (delete-char 1)
+ (goto-char 33)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 36)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 24)
+ (insert "...........")
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 40)
+ (delete-char 13)
+ (goto-char 22)
+ (delete-char 19)
+ (goto-char 10)
+ (delete-char 8)
+ (goto-char 14)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 12)
+ (3 . 40)
+ (5 . 50)
+ (7 . 69)
+ (10 . 42)
+ (10 . 44)
+ (10 . 51)
+ (10 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-20 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 44 42 nil t t)
+ (make-overlay 47 1 nil nil nil)
+ (make-overlay 24 48 nil nil nil)
+ (make-overlay 62 50 nil nil t)
+ (make-overlay 54 38 nil nil nil)
+ (make-overlay 3 9 nil nil nil)
+ (make-overlay 61 28 nil t nil)
+ (make-overlay 33 33 nil nil t)
+ (make-overlay 37 37 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 54 36 nil t nil)
+ (make-overlay 18 58 nil nil t)
+ (make-overlay 55 3 nil nil t)
+ (make-overlay 23 21 nil t t)
+ (make-overlay 47 55 nil t t)
+ (make-overlay 50 12 nil nil nil)
+ (goto-char 11)
+ (delete-char 46)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 11 12)
+ (goto-char 11)
+ (insert "...")
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 14)
+ (insert ".")
+ (goto-char 13)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 11)
+ (insert ".")
+ (goto-char 12)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 42)
+ (delete-char 1)
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 26 42)
+ (goto-char 36)
+ (insert "..........")
+ (goto-char 40)
+ (delete-char 11)
+ (goto-char 26)
+ (delete-char 13)
+ (goto-char 28)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((8 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-21 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 15 nil nil nil)
+ (make-overlay 52 31 nil nil nil)
+ (make-overlay 12 51 nil t t)
+ (make-overlay 42 20 nil nil t)
+ (make-overlay 51 48 nil nil nil)
+ (make-overlay 59 28 nil t t)
+ (make-overlay 51 53 nil t nil)
+ (make-overlay 50 59 nil nil t)
+ (make-overlay 24 40 nil t nil)
+ (make-overlay 51 61 nil nil nil)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 17 nil t t)
+ (make-overlay 26 38 nil t t)
+ (make-overlay 23 36 nil nil nil)
+ (make-overlay 57 50 nil nil nil)
+ (make-overlay 42 15 nil nil t)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 37)
+ (insert ".")
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 21)
+ (delete-char 35)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 2)
+ (goto-char 1)
+ (insert "")
+ (goto-char 5)
+ (insert ".......")
+ (goto-char 8)
+ (insert "....")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 16)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 11)
+ (goto-char 3)
+ (insert "........")
+ (goto-char 38)
+ (insert "............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 56)
+ (delete-char 3)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 16 53)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 18 33)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 11 11)
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 22 69)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 54)
+ (delete-char 22)
+ (goto-char 44)
+ (insert "........")
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 29)
+ (delete-char 22)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33))))))
+
+(ert-deftest overlay-autogenerated-test-22 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 12 14 nil nil t)
+ (make-overlay 54 7 nil nil t)
+ (make-overlay 8 3 nil nil nil)
+ (make-overlay 42 32 nil nil nil)
+ (make-overlay 10 27 nil t t)
+ (make-overlay 50 28 nil t t)
+ (make-overlay 39 35 nil nil nil)
+ (make-overlay 12 4 nil t t)
+ (make-overlay 29 54 nil nil nil)
+ (make-overlay 14 52 nil t t)
+ (make-overlay 9 15 nil t nil)
+ (make-overlay 44 11 nil nil nil)
+ (make-overlay 46 29 nil t t)
+ (make-overlay 40 58 nil t t)
+ (make-overlay 40 61 nil t nil)
+ (make-overlay 13 59 nil nil t)
+ (goto-char 32)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 10)
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 33)
+ (delete-char 32)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 41 46)
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 8 46)
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 23)
+ (insert "...............")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 17)
+ (insert ".........")
+ (goto-char 37)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 7)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 20 54)
+ (goto-char 20)
+ (delete-char 28)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 26)
+ (delete-char 1)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 40 37)
+ (goto-char 37)
+ (insert ".....")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 13 37)
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 20)
+ (insert "")
+ (goto-char 23)
+ (delete-char 7)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 33 33)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((15 . 39)
+ (16 . 38)
+ (16 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-23 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 51 32 nil t t)
+ (make-overlay 13 61 nil t nil)
+ (make-overlay 47 19 nil nil t)
+ (make-overlay 11 30 nil nil nil)
+ (make-overlay 50 26 nil t t)
+ (make-overlay 64 13 nil t t)
+ (make-overlay 29 8 nil t t)
+ (make-overlay 25 42 nil t t)
+ (make-overlay 33 28 nil t t)
+ (make-overlay 54 7 nil nil nil)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 65 50 nil t t)
+ (make-overlay 64 15 nil t nil)
+ (make-overlay 16 35 nil nil nil)
+ (make-overlay 40 36 nil nil t)
+ (make-overlay 31 35 nil t nil)
+ (goto-char 61)
+ (insert "......")
+ (goto-char 55)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..............")
+ (goto-char 56)
+ (insert "............")
+ (goto-char 48)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 54)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 16)
+ (delete-char 12)
+ (goto-char 18)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 7)
+ (goto-char 5)
+ (delete-char 2)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 33)
+ (insert "")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 17 4)
+ (goto-char 13)
+ (insert ".")
+ (goto-char 8)
+ (insert "............")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 32 32)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 33 19)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 26)
+ (insert "")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((38 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-24 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 63 8 nil t t)
+ (make-overlay 10 13 nil nil t)
+ (make-overlay 40 38 nil nil nil)
+ (make-overlay 21 34 nil t t)
+ (make-overlay 55 29 nil nil nil)
+ (make-overlay 36 65 nil t t)
+ (make-overlay 29 12 nil t nil)
+ (make-overlay 41 3 nil nil t)
+ (make-overlay 20 9 nil t t)
+ (make-overlay 52 42 nil t t)
+ (make-overlay 21 56 nil nil t)
+ (make-overlay 25 65 nil nil nil)
+ (make-overlay 38 4 nil t t)
+ (make-overlay 48 23 nil t t)
+ (make-overlay 52 9 nil nil t)
+ (make-overlay 48 19 nil nil nil)
+ (goto-char 43)
+ (delete-char 8)
+ (goto-char 30)
+ (delete-char 16)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 17)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "")
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 18)
+ (insert "........")
+ (goto-char 15)
+ (insert "....")
+ (goto-char 16)
+ (delete-char 14)
+ (goto-char 20)
+ (insert ".")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 14)
+ (goto-char 3)
+ (delete-char 7)
+ (goto-char 3)
+ (delete-char 4)
+ (goto-char 1)
+ (insert "...........")
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 5)
+ (delete-char 7)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 2)
+ (delete-char 4)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 13)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 7)
+ (goto-char 7)
+ (insert "..")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 42)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-25 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 8 nil nil t)
+ (make-overlay 41 16 nil t nil)
+ (make-overlay 3 16 nil nil nil)
+ (make-overlay 26 42 nil nil nil)
+ (make-overlay 32 45 nil nil t)
+ (make-overlay 34 19 nil nil nil)
+ (make-overlay 37 54 nil nil t)
+ (make-overlay 44 34 nil t nil)
+ (make-overlay 49 40 nil t t)
+ (make-overlay 29 34 nil t nil)
+ (make-overlay 54 16 nil t t)
+ (make-overlay 29 4 nil t nil)
+ (make-overlay 44 57 nil nil nil)
+ (make-overlay 5 32 nil nil nil)
+ (make-overlay 12 33 nil nil t)
+ (make-overlay 38 29 nil t nil)
+ (goto-char 12)
+ (delete-char 53)
+ (goto-char 1)
+ (delete-char 6)
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 6 1)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (insert "...............")
+ (goto-char 17)
+ (delete-char 5)
+ (goto-char 7)
+ (insert ".....")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 4)
+ (insert ".....")
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 18 11)
+ (goto-char 15)
+ (delete-char 1)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 3)
+ (goto-char 14)
+ (insert "..")
+ (goto-char 16)
+ (insert "..")
+ (goto-char 15)
+ (delete-char 3)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 14)
+ (insert "..........")
+ (goto-char 19)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 23 40)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 33)
+ (insert "..........")
+ (goto-char 37)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 30 8)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 15)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 10)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 30)
+ (1 . 30)
+ (1 . 30)
+ (2 . 53)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 53)
+ (30 . 53)
+ (30 . 53))))))
+
+(ert-deftest overlay-autogenerated-test-26 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 60 59 nil t nil)
+ (make-overlay 18 11 nil nil t)
+ (make-overlay 4 44 nil nil nil)
+ (make-overlay 7 22 nil nil nil)
+ (make-overlay 54 50 nil t nil)
+ (make-overlay 59 28 nil nil nil)
+ (make-overlay 49 23 nil nil t)
+ (make-overlay 21 5 nil t nil)
+ (make-overlay 17 39 nil t nil)
+ (make-overlay 16 14 nil nil nil)
+ (make-overlay 50 26 nil nil nil)
+ (make-overlay 37 14 nil nil nil)
+ (make-overlay 6 59 nil nil t)
+ (make-overlay 30 17 nil nil t)
+ (make-overlay 17 34 nil nil t)
+ (make-overlay 7 22 nil t nil)
+ (goto-char 35)
+ (delete-char 25)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 3 19)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 64 37)
+ (goto-char 62)
+ (insert ".............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 72 38)
+ (goto-char 66)
+ (insert "")
+ (goto-char 54)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 4)
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 38)
+ (insert "....")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 74 53)
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 53)
+ (insert "..............")
+ (goto-char 72)
+ (insert "............")
+ (goto-char 87)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "............")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 106)
+ (insert "...")
+ (goto-char 95)
+ (widen)
+ (narrow-to-region 77 39)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 101)
+ (insert "")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 79)
+ (delete-char 21)
+ (goto-char 85)
+ (insert "........")
+ (goto-char 52)
+ (delete-char 41)
+ (goto-char 43)
+ (insert ".....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 90)
+ (5 . 57)
+ (6 . 90)
+ (29 . 57)
+ (29 . 57)
+ (33 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-27 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 12 nil t nil)
+ (make-overlay 3 10 nil t t)
+ (make-overlay 11 53 nil t nil)
+ (make-overlay 59 3 nil t nil)
+ (make-overlay 28 19 nil t t)
+ (make-overlay 16 30 nil t t)
+ (make-overlay 39 19 nil t t)
+ (make-overlay 33 50 nil t nil)
+ (make-overlay 36 54 nil nil nil)
+ (make-overlay 42 59 nil nil nil)
+ (make-overlay 30 48 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 63 48 nil t nil)
+ (make-overlay 48 12 nil t t)
+ (make-overlay 64 50 nil nil nil)
+ (make-overlay 7 7 nil nil nil)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 21 54)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 21)
+ (delete-char 2)
+ (goto-char 35)
+ (widen)
+ (narrow-to-region 70 11)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 74)
+ (insert ".")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 77 67)
+ (goto-char 72)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 1)
+ (goto-char 82)
+ (widen)
+ (narrow-to-region 83 86)
+ (goto-char 83)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 0)
+ (goto-char 86)
+ (insert "...........")
+ (goto-char 97)
+ (insert ".......")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 44 68)
+ (goto-char 49)
+ (insert "..")
+ (goto-char 65)
+ (insert ".............")
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 57)
+ (insert "........")
+ (goto-char 55)
+ (delete-char 30)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 44)
+ (insert "")
+ (goto-char 62)
+ (insert "............")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 12 5)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..........")
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 13)
+ (insert "..")
+ (goto-char 32)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 55)
+ (3 . 173)
+ (7 . 7))))))
+
+(ert-deftest overlay-autogenerated-test-28 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 59 48 nil t nil)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 45 35 nil t nil)
+ (make-overlay 13 18 nil t t)
+ (make-overlay 10 7 nil t t)
+ (make-overlay 9 8 nil nil nil)
+ (make-overlay 33 47 nil nil t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 16 59 nil nil t)
+ (make-overlay 43 58 nil nil t)
+ (make-overlay 6 11 nil nil nil)
+ (make-overlay 59 7 nil t nil)
+ (make-overlay 3 57 nil t t)
+ (make-overlay 61 35 nil nil nil)
+ (make-overlay 57 8 nil nil nil)
+ (make-overlay 5 32 nil t nil)
+ (goto-char 18)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 38)
+ (delete-char 26)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 33)
+ (insert "....")
+ (goto-char 23)
+ (delete-char 14)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 30 33)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 30)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 4)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 46)
+ (insert ".........")
+ (goto-char 45)
+ (delete-char 3)
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 32)
+ (insert "..........")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 37)
+ (insert "..")
+ (goto-char 80)
+ (insert ".....")
+ (goto-char 30)
+ (insert ".............")
+ (goto-char 102)
+ (insert "............")
+ (goto-char 113)
+ (insert "")
+ (goto-char 66)
+ (widen)
+ (narrow-to-region 47 38)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 45)
+ (3 . 117)
+ (4 . 121)
+ (7 . 121)
+ (8 . 45)
+ (16 . 121)
+ (28 . 121)
+ (28 . 121)
+ (28 . 121))))))
+
+(ert-deftest overlay-autogenerated-test-29 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 5 63 nil nil t)
+ (make-overlay 20 28 nil t t)
+ (make-overlay 58 53 nil t nil)
+ (make-overlay 4 57 nil t t)
+ (make-overlay 4 16 nil nil nil)
+ (make-overlay 33 26 nil t nil)
+ (make-overlay 9 32 nil t t)
+ (make-overlay 11 8 nil nil nil)
+ (make-overlay 59 35 nil nil t)
+ (make-overlay 15 25 nil t t)
+ (make-overlay 36 16 nil nil nil)
+ (make-overlay 8 37 nil nil nil)
+ (make-overlay 65 63 nil nil t)
+ (make-overlay 3 20 nil nil t)
+ (make-overlay 44 55 nil t t)
+ (make-overlay 45 25 nil t nil)
+ (goto-char 39)
+ (insert "...")
+ (goto-char 22)
+ (insert "........")
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 17)
+ (insert "............")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 79 16)
+ (goto-char 19)
+ (delete-char 11)
+ (goto-char 25)
+ (insert "........")
+ (goto-char 61)
+ (insert "....")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 73 66)
+ (goto-char 71)
+ (insert "............")
+ (goto-char 81)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 74)
+ (insert "............")
+ (goto-char 82)
+ (delete-char 7)
+ (goto-char 78)
+ (delete-char 18)
+ (goto-char 75)
+ (insert ".........")
+ (goto-char 66)
+ (insert ".........")
+ (goto-char 86)
+ (delete-char 12)
+ (goto-char 77)
+ (widen)
+ (narrow-to-region 23 55)
+ (goto-char 43)
+ (insert ".")
+ (goto-char 50)
+ (insert "..")
+ (goto-char 25)
+ (delete-char 18)
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 26)
+ (insert "")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 59)
+ (insert ".")
+ (goto-char 51)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 130)
+ (5 . 136)
+ (8 . 82)
+ (9 . 82)
+ (15 . 25)
+ (16 . 82)
+ (21 . 77)
+ (25 . 105)
+ (75 . 82))))))
+
+(ert-deftest overlay-autogenerated-test-30 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 27 65 nil t t)
+ (make-overlay 39 51 nil t t)
+ (make-overlay 53 2 nil nil nil)
+ (make-overlay 3 17 nil nil t)
+ (make-overlay 35 4 nil nil t)
+ (make-overlay 65 53 nil t nil)
+ (make-overlay 8 21 nil t t)
+ (make-overlay 18 62 nil t t)
+ (make-overlay 42 59 nil nil t)
+ (make-overlay 12 37 nil t t)
+ (make-overlay 64 31 nil t nil)
+ (make-overlay 39 54 nil nil t)
+ (make-overlay 41 24 nil t nil)
+ (make-overlay 10 21 nil nil t)
+ (make-overlay 49 15 nil t nil)
+ (make-overlay 49 63 nil nil t)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 44)
+ (delete-char 29)
+ (goto-char 32)
+ (insert "..")
+ (goto-char 13)
+ (insert ".")
+ (goto-char 42)
+ (insert ".........")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 58)
+ (delete-char 9)
+ (goto-char 63)
+ (insert ".........")
+ (goto-char 49)
+ (insert ".")
+ (goto-char 28)
+ (delete-char 51)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 18)
+ (delete-char 1)
+ (goto-char 4)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 22)
+ (goto-char 12)
+ (insert "")
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 9)
+ (insert "....")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 6)
+ (delete-char 34)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 3 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 2)
+ (insert "..............")
+ (goto-char 15)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 68))))))
+
+(ert-deftest overlay-autogenerated-test-31 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 54 64 nil nil nil)
+ (make-overlay 49 12 nil nil t)
+ (make-overlay 40 12 nil t nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 8 38 nil t nil)
+ (make-overlay 50 22 nil t nil)
+ (make-overlay 65 15 nil nil t)
+ (make-overlay 57 60 nil t t)
+ (make-overlay 35 11 nil nil t)
+ (make-overlay 49 44 nil nil t)
+ (make-overlay 45 31 nil nil t)
+ (make-overlay 51 24 nil t t)
+ (make-overlay 20 14 nil nil nil)
+ (make-overlay 6 18 nil t t)
+ (make-overlay 25 3 nil nil nil)
+ (goto-char 18)
+ (delete-char 10)
+ (goto-char 36)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 2)
+ (delete-char 8)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 15)
+ (delete-char 4)
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 17)
+ (insert "...............")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 32)
+ (insert "........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 18 39)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 39 14)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 25 21)
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 23)
+ (insert ".........")
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 31)
+ (insert ".........")
+ (goto-char 32)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 10 56)
+ (goto-char 10)
+ (insert ".........")
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..")
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 13)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 41)
+ (3 . 117)
+ (6 . 41)
+ (8 . 41)
+ (9 . 41)
+ (10 . 42)
+ (41 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-32 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 35 60 nil nil t)
+ (make-overlay 45 46 nil nil nil)
+ (make-overlay 47 11 nil nil t)
+ (make-overlay 12 51 nil t nil)
+ (make-overlay 61 17 nil t nil)
+ (make-overlay 7 24 nil t nil)
+ (make-overlay 36 37 nil nil t)
+ (make-overlay 5 39 nil t t)
+ (make-overlay 5 40 nil nil t)
+ (make-overlay 38 40 nil t t)
+ (make-overlay 47 45 nil t nil)
+ (make-overlay 61 48 nil nil nil)
+ (make-overlay 23 39 nil t t)
+ (make-overlay 11 52 nil nil nil)
+ (make-overlay 37 35 nil nil nil)
+ (make-overlay 19 20 nil t nil)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 7)
+ (insert "")
+ (goto-char 28)
+ (delete-char 41)
+ (goto-char 3)
+ (delete-char 17)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 7)
+ (insert "")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 16)
+ (insert ".")
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".............")
+ (goto-char 9)
+ (insert ".")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 6)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 5)
+ (insert ".....")
+ (goto-char 12)
+ (insert "")
+ (goto-char 13)
+ (insert ".......")
+ (goto-char 14)
+ (insert "......")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 12)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (18 . 18)
+ (18 . 18)
+ (18 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-33 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 33 nil t nil)
+ (make-overlay 45 54 nil t t)
+ (make-overlay 17 38 nil t nil)
+ (make-overlay 58 46 nil nil t)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 31 63 nil nil t)
+ (make-overlay 37 64 nil t t)
+ (make-overlay 42 19 nil nil nil)
+ (make-overlay 51 60 nil t nil)
+ (make-overlay 47 15 nil t t)
+ (make-overlay 57 47 nil nil nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 44 47 nil t nil)
+ (make-overlay 42 35 nil t nil)
+ (make-overlay 1 65 nil nil t)
+ (make-overlay 29 63 nil t nil)
+ (goto-char 33)
+ (insert "...........")
+ (goto-char 56)
+ (insert ".........")
+ (goto-char 67)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 35)
+ (goto-char 9)
+ (insert "......")
+ (goto-char 43)
+ (delete-char 17)
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 20)
+ (insert "....")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 38 57)
+ (goto-char 51)
+ (insert "")
+ (goto-char 57)
+ (insert ".......")
+ (goto-char 64)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 45)
+ (delete-char 12)
+ (goto-char 43)
+ (insert "......")
+ (goto-char 48)
+ (insert "......")
+ (goto-char 52)
+ (insert "........")
+ (goto-char 57)
+ (delete-char 16)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 31 27)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 37)
+ (insert "..")
+ (goto-char 38)
+ (delete-char 4)
+ (goto-char 38)
+ (insert "..........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 53)
+ (insert "...")
+ (goto-char 51)
+ (insert ".")
+ (goto-char 28)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 93)
+ (25 . 92)
+ (41 . 88)
+ (60 . 88))))))
+
+(ert-deftest overlay-autogenerated-test-34 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 63 nil nil t)
+ (make-overlay 54 30 nil t nil)
+ (make-overlay 21 57 nil t nil)
+ (make-overlay 61 19 nil nil nil)
+ (make-overlay 55 8 nil nil t)
+ (make-overlay 14 51 nil nil nil)
+ (make-overlay 33 13 nil t t)
+ (make-overlay 36 25 nil t t)
+ (make-overlay 22 21 nil nil t)
+ (make-overlay 21 48 nil nil t)
+ (make-overlay 36 7 nil nil t)
+ (make-overlay 2 40 nil nil nil)
+ (make-overlay 21 27 nil nil t)
+ (make-overlay 26 2 nil nil nil)
+ (make-overlay 60 43 nil nil nil)
+ (make-overlay 12 50 nil t t)
+ (goto-char 44)
+ (delete-char 6)
+ (goto-char 5)
+ (insert "..")
+ (goto-char 17)
+ (insert "........")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 29)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 35)
+ (insert ".............")
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 6)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 10)
+ (delete-char 20)
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 31)
+ (delete-char 10)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 27 39)
+ (goto-char 34)
+ (delete-char 5)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..")
+ (goto-char 28)
+ (insert "........")
+ (goto-char 39)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...............")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 56)
+ (delete-char 1)
+ (goto-char 65)
+ (delete-char 3)
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 74)
+ (insert ".....")
+ (goto-char 67)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 80)
+ (6 . 78))))))
+
+(ert-deftest overlay-autogenerated-test-35 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 16 nil nil nil)
+ (make-overlay 19 22 nil t nil)
+ (make-overlay 16 43 nil nil t)
+ (make-overlay 27 5 nil nil nil)
+ (make-overlay 43 34 nil t nil)
+ (make-overlay 47 4 nil nil t)
+ (make-overlay 1 47 nil nil t)
+ (make-overlay 27 35 nil t nil)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 21 19 nil nil nil)
+ (make-overlay 16 38 nil nil t)
+ (make-overlay 33 39 nil t nil)
+ (make-overlay 34 51 nil nil t)
+ (make-overlay 45 36 nil t nil)
+ (make-overlay 42 18 nil t t)
+ (make-overlay 12 30 nil nil nil)
+ (goto-char 18)
+ (insert "")
+ (goto-char 58)
+ (delete-char 3)
+ (goto-char 58)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 48)
+ (delete-char 17)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 45 46)
+ (goto-char 46)
+ (insert "")
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 46)
+ (insert ".....")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 17 26)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 50 41)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 59)
+ (insert "...........")
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 59)
+ (insert "")
+ (goto-char 46)
+ (insert "")
+ (goto-char 54)
+ (delete-char 5)
+ (goto-char 57)
+ (widen)
+ (narrow-to-region 57 31)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 52)
+ (insert "....")
+ (goto-char 44)
+ (insert "..")
+ (goto-char 44)
+ (insert "...............")
+ (goto-char 72)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 6)
+ (goto-char 64)
+ (delete-char 5)
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 44)
+ (delete-char 2)
+ (goto-char 39)
+ (delete-char 12)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 14 47)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 39)
+ (11 . 39)
+ (12 . 39)
+ (19 . 39)
+ (23 . 39)
+ (23 . 39)
+ (23 . 39)
+ (25 . 39)
+ (26 . 28)
+ (26 . 29)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-36 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 38 nil t t)
+ (make-overlay 58 34 nil t nil)
+ (make-overlay 6 33 nil nil t)
+ (make-overlay 63 54 nil nil t)
+ (make-overlay 54 54 nil t t)
+ (make-overlay 21 61 nil nil nil)
+ (make-overlay 64 55 nil nil t)
+ (make-overlay 28 65 nil nil t)
+ (make-overlay 32 51 nil t nil)
+ (make-overlay 36 38 nil nil nil)
+ (make-overlay 35 21 nil nil nil)
+ (make-overlay 65 48 nil nil nil)
+ (make-overlay 32 27 nil nil t)
+ (make-overlay 27 55 nil t t)
+ (make-overlay 30 22 nil t nil)
+ (make-overlay 14 58 nil t nil)
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 11)
+ (widen)
+ (narrow-to-region 64 9)
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 13)
+ (insert "..........")
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 9 5)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 18)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "....")
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 28 1)
+ (goto-char 6)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 8)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 18)
+ (insert "......")
+ (goto-char 5)
+ (delete-char 9)
+ (goto-char 5)
+ (delete-char 20)
+ (goto-char 4)
+ (delete-char 3)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 1)
+ (insert "......")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 39 2)
+ (goto-char 13)
+ (delete-char 12)
+ (goto-char 24)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 20)
+ (9 . 20)
+ (13 . 36)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 29)
+ (20 . 33)
+ (20 . 36)
+ (20 . 39)
+ (20 . 43)
+ (20 . 43))))))
+
+(ert-deftest overlay-autogenerated-test-37 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 26 30 nil nil nil)
+ (make-overlay 55 50 nil nil t)
+ (make-overlay 43 54 nil nil t)
+ (make-overlay 53 48 nil nil nil)
+ (make-overlay 37 51 nil nil t)
+ (make-overlay 15 30 nil nil nil)
+ (make-overlay 2 24 nil t t)
+ (make-overlay 56 61 nil t nil)
+ (make-overlay 65 46 nil t nil)
+ (make-overlay 28 47 nil t nil)
+ (make-overlay 21 24 nil t t)
+ (make-overlay 17 13 nil t t)
+ (make-overlay 7 44 nil t nil)
+ (make-overlay 28 63 nil nil nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 26 44 nil t t)
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (insert ".............")
+ (goto-char 17)
+ (insert "")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 3)
+ (delete-char 47)
+ (goto-char 15)
+ (insert ".............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 7)
+ (delete-char 16)
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 2)
+ (insert "..")
+ (goto-char 18)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 12 10)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "...")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 13)
+ (insert "..")
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 11)
+ (insert ".....")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 6 13)
+ (goto-char 10)
+ (insert "..")
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 36 11)
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 56)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 11)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((44 . 45))))))
+
+(ert-deftest overlay-autogenerated-test-38 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 13 nil t t)
+ (make-overlay 19 28 nil nil t)
+ (make-overlay 47 33 nil nil nil)
+ (make-overlay 8 44 nil t nil)
+ (make-overlay 48 4 nil t nil)
+ (make-overlay 8 20 nil t t)
+ (make-overlay 38 31 nil nil t)
+ (make-overlay 17 65 nil nil t)
+ (make-overlay 49 31 nil nil nil)
+ (make-overlay 39 19 nil nil t)
+ (make-overlay 40 49 nil t t)
+ (make-overlay 24 16 nil t t)
+ (make-overlay 4 41 nil t nil)
+ (make-overlay 61 42 nil t nil)
+ (make-overlay 46 11 nil nil nil)
+ (make-overlay 1 43 nil nil t)
+ (goto-char 62)
+ (delete-char 2)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 30 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 39)
+ (delete-char 5)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 31 9)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 62 30)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 17 48)
+ (goto-char 39)
+ (delete-char 7)
+ (goto-char 24)
+ (delete-char 8)
+ (goto-char 19)
+ (insert "")
+ (goto-char 25)
+ (delete-char 5)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 52 35)
+ (goto-char 49)
+ (delete-char 0)
+ (goto-char 49)
+ (delete-char 3)
+ (goto-char 48)
+ (insert "...........")
+ (goto-char 37)
+ (delete-char 23)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 3)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 35)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 37)
+ (24 . 44)
+ (25 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-39 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 49 nil t t)
+ (make-overlay 27 20 nil t nil)
+ (make-overlay 55 50 nil t nil)
+ (make-overlay 17 5 nil t t)
+ (make-overlay 26 56 nil nil t)
+ (make-overlay 42 11 nil t t)
+ (make-overlay 24 35 nil nil t)
+ (make-overlay 47 45 nil t t)
+ (make-overlay 37 12 nil nil t)
+ (make-overlay 17 25 nil t nil)
+ (make-overlay 32 53 nil nil nil)
+ (make-overlay 20 34 nil nil t)
+ (make-overlay 56 58 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 22 55 nil t t)
+ (make-overlay 55 11 nil t nil)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 30)
+ (insert ".")
+ (goto-char 12)
+ (delete-char 56)
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 6)
+ (insert "....")
+ (goto-char 19)
+ (delete-char 19)
+ (goto-char 19)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 5 6)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 6)
+ (goto-char 2)
+ (insert "..........")
+ (goto-char 2)
+ (delete-char 9)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 4)
+ (delete-char 14)
+ (goto-char 4)
+ (insert ".")
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 13)
+ (insert "......")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 20)
+ (insert "............")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 3 32)
+ (goto-char 18)
+ (insert "..")
+ (goto-char 6)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 9)
+ (delete-char 23)
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-40 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 3 nil t nil)
+ (make-overlay 35 41 nil t t)
+ (make-overlay 4 2 nil t nil)
+ (make-overlay 51 48 nil nil t)
+ (make-overlay 44 57 nil t t)
+ (make-overlay 13 32 nil nil nil)
+ (make-overlay 46 29 nil t nil)
+ (make-overlay 28 13 nil t nil)
+ (make-overlay 10 65 nil t t)
+ (make-overlay 41 48 nil nil t)
+ (make-overlay 36 44 nil nil t)
+ (make-overlay 29 61 nil t nil)
+ (make-overlay 25 24 nil nil t)
+ (make-overlay 22 45 nil nil t)
+ (make-overlay 37 55 nil nil t)
+ (make-overlay 36 39 nil nil nil)
+ (goto-char 16)
+ (delete-char 48)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 30)
+ (insert "........")
+ (goto-char 11)
+ (insert "..........")
+ (goto-char 5)
+ (delete-char 14)
+ (goto-char 19)
+ (insert ".")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 1)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 2)
+ (goto-char 33)
+ (insert "..")
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 30)
+ (delete-char 4)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 40 8)
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 26)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 33)
+ (insert ".")
+ (goto-char 10)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 28 9)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 26)
+ (insert "..")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 40 30)
+ (goto-char 37)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (37 . 37)
+ (37 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-41 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 48 nil nil t)
+ (make-overlay 30 11 nil nil t)
+ (make-overlay 7 12 nil t nil)
+ (make-overlay 65 35 nil t nil)
+ (make-overlay 22 61 nil t nil)
+ (make-overlay 37 42 nil nil nil)
+ (make-overlay 33 38 nil nil t)
+ (make-overlay 48 45 nil t t)
+ (make-overlay 45 62 nil t nil)
+ (make-overlay 63 7 nil nil t)
+ (make-overlay 23 42 nil t nil)
+ (make-overlay 21 4 nil t nil)
+ (make-overlay 64 41 nil t nil)
+ (make-overlay 20 33 nil t t)
+ (make-overlay 41 26 nil t nil)
+ (make-overlay 43 31 nil t t)
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 62)
+ (insert "")
+ (goto-char 24)
+ (delete-char 2)
+ (goto-char 41)
+ (insert "............")
+ (goto-char 2)
+ (insert ".")
+ (goto-char 55)
+ (insert "........")
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 58)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 44 45)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 24 37)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 35)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 35)
+ (insert "......")
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 25)
+ (delete-char 14)
+ (goto-char 28)
+ (insert "")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 17 43)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 48)
+ (insert "............")
+ (goto-char 47)
+ (insert ".........")
+ (goto-char 69)
+ (widen)
+ (narrow-to-region 52 25)
+ (goto-char 26)
+ (insert "......")
+ (goto-char 53)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 38)
+ (8 . 97)
+ (12 . 47)
+ (37 . 47)
+ (39 . 52)
+ (39 . 87)
+ (39 . 95)
+ (46 . 90)
+ (47 . 49)
+ (47 . 90)
+ (47 . 99)
+ (48 . 87))))))
+
+(ert-deftest overlay-autogenerated-test-42 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 23 nil nil nil)
+ (make-overlay 45 51 nil t nil)
+ (make-overlay 34 58 nil t nil)
+ (make-overlay 27 11 nil nil nil)
+ (make-overlay 14 8 nil t t)
+ (make-overlay 64 43 nil t nil)
+ (make-overlay 61 56 nil nil t)
+ (make-overlay 28 14 nil t nil)
+ (make-overlay 21 46 nil t t)
+ (make-overlay 30 34 nil t t)
+ (make-overlay 47 40 nil nil nil)
+ (make-overlay 5 44 nil t t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 65 8 nil nil t)
+ (make-overlay 47 54 nil t t)
+ (make-overlay 37 57 nil t nil)
+ (goto-char 11)
+ (insert "....")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 23)
+ (insert ".............")
+ (goto-char 2)
+ (insert "............")
+ (goto-char 84)
+ (delete-char 1)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 19)
+ (insert "............")
+ (goto-char 69)
+ (delete-char 6)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 104)
+ (insert "")
+ (goto-char 94)
+ (delete-char 11)
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 67)
+ (insert "")
+ (goto-char 53)
+ (delete-char 22)
+ (goto-char 42)
+ (insert ".")
+ (goto-char 38)
+ (delete-char 13)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 71)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 46)
+ (insert "..")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 95 93)
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 97 7)
+ (goto-char 93)
+ (insert "....")
+ (goto-char 85)
+ (insert "...........")
+ (goto-char 69)
+ (delete-char 24)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 7)
+ (delete-char 28)
+ (goto-char 65)
+ (delete-char 8)
+ (goto-char 48)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((31 . 44)
+ (33 . 33)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 82)
+ (40 . 44)
+ (41 . 41)
+ (41 . 41)
+ (41 . 47)
+ (41 . 48)
+ (44 . 45)
+ (44 . 46)
+ (44 . 63)
+ (46 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-43 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 53 nil t nil)
+ (make-overlay 11 50 nil t nil)
+ (make-overlay 1 30 nil nil nil)
+ (make-overlay 54 15 nil t t)
+ (make-overlay 22 30 nil nil nil)
+ (make-overlay 1 33 nil nil nil)
+ (make-overlay 18 15 nil t nil)
+ (make-overlay 43 39 nil nil t)
+ (make-overlay 43 17 nil t nil)
+ (make-overlay 2 29 nil t nil)
+ (make-overlay 57 42 nil t nil)
+ (make-overlay 40 1 nil nil nil)
+ (make-overlay 8 64 nil nil nil)
+ (make-overlay 64 15 nil nil nil)
+ (make-overlay 9 11 nil nil t)
+ (make-overlay 40 21 nil t nil)
+ (goto-char 5)
+ (delete-char 37)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 20)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 24)
+ (delete-char 5)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 20 36)
+ (goto-char 26)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".............")
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 4)
+ (goto-char 27)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 37 20)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 33)
+ (insert "......")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 26)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 50)
+ (insert ".......")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 54 86)
+ (goto-char 64)
+ (insert "...............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 70)
+ (insert "........")
+ (goto-char 58)
+ (insert "..............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 83)
+ (insert "..........")
+ (goto-char 69)
+ (delete-char 75)
+ (goto-char 75)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 75)
+ (5 . 75)
+ (5 . 80)
+ (5 . 80))))))
+
+(ert-deftest overlay-autogenerated-test-44 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 48 nil nil t)
+ (make-overlay 52 38 nil nil nil)
+ (make-overlay 3 63 nil nil nil)
+ (make-overlay 44 15 nil nil t)
+ (make-overlay 27 44 nil nil t)
+ (make-overlay 43 9 nil nil t)
+ (make-overlay 11 27 nil t nil)
+ (make-overlay 36 41 nil nil t)
+ (make-overlay 23 25 nil t t)
+ (make-overlay 19 60 nil t t)
+ (make-overlay 11 55 nil t nil)
+ (make-overlay 59 2 nil t nil)
+ (make-overlay 32 64 nil t nil)
+ (make-overlay 15 8 nil nil nil)
+ (make-overlay 61 15 nil nil nil)
+ (make-overlay 64 30 nil t t)
+ (goto-char 42)
+ (delete-char 20)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 4)
+ (delete-char 30)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 2)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 2)
+ (insert ".....")
+ (goto-char 10)
+ (insert "...........")
+ (goto-char 21)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 16)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 2)
+ (insert "")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 17)
+ (insert "....")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 32 23)
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 35)
+ (delete-char 2)
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 4 14)
+ (goto-char 8)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 44))))))
+
+(ert-deftest overlay-autogenerated-test-45 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 48 nil nil nil)
+ (make-overlay 1 47 nil t nil)
+ (make-overlay 43 4 nil t t)
+ (make-overlay 9 45 nil t t)
+ (make-overlay 1 25 nil t t)
+ (make-overlay 5 46 nil t t)
+ (make-overlay 7 14 nil t nil)
+ (make-overlay 1 53 nil nil t)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 5 31 nil t t)
+ (make-overlay 26 10 nil nil nil)
+ (make-overlay 56 37 nil nil nil)
+ (make-overlay 23 15 nil t nil)
+ (make-overlay 62 30 nil t t)
+ (make-overlay 2 35 nil t t)
+ (make-overlay 46 41 nil nil nil)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 55)
+ (insert "...........")
+ (goto-char 22)
+ (insert "")
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 54 63)
+ (goto-char 56)
+ (insert "......")
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 65)
+ (insert "......")
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 62)
+ (insert ".")
+ (goto-char 74)
+ (insert ".........")
+ (goto-char 76)
+ (delete-char 4)
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 2 46)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 25)
+ (delete-char 21)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 72 61)
+ (goto-char 63)
+ (insert "")
+ (goto-char 65)
+ (delete-char 4)
+ (goto-char 61)
+ (delete-char 5)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 61)
+ (insert "............")
+ (goto-char 72)
+ (insert "..............")
+ (goto-char 62)
+ (delete-char 7)
+ (goto-char 71)
+ (delete-char 5)
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 29 8)
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 27)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 36)
+ (1 . 41)
+ (1 . 47)
+ (2 . 40)
+ (4 . 40)
+ (5 . 40)
+ (5 . 40)
+ (7 . 21)
+ (9 . 40)
+ (10 . 37)
+ (20 . 40)
+ (22 . 27)
+ (22 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-46 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 43 nil nil t)
+ (make-overlay 44 40 nil nil t)
+ (make-overlay 49 14 nil nil t)
+ (make-overlay 6 55 nil nil nil)
+ (make-overlay 13 52 nil t t)
+ (make-overlay 40 54 nil t nil)
+ (make-overlay 51 41 nil nil t)
+ (make-overlay 7 28 nil nil t)
+ (make-overlay 10 47 nil nil t)
+ (make-overlay 63 21 nil t nil)
+ (make-overlay 4 55 nil nil nil)
+ (make-overlay 52 58 nil t nil)
+ (make-overlay 62 11 nil t t)
+ (make-overlay 22 49 nil t nil)
+ (make-overlay 23 65 nil nil nil)
+ (make-overlay 50 33 nil nil t)
+ (goto-char 22)
+ (insert "..............")
+ (goto-char 12)
+ (insert "....")
+ (goto-char 25)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 53)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 7)
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 11 7)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 21)
+ (insert "...")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 1)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (insert "....")
+ (goto-char 37)
+ (delete-char 7)
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 65)
+ (insert ".......")
+ (goto-char 39)
+ (delete-char 26)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 54 32)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 7)
+ (insert "........")
+ (goto-char 13)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 85))))))
+
+(ert-deftest overlay-autogenerated-test-47 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 62 nil t nil)
+ (make-overlay 14 38 nil nil nil)
+ (make-overlay 63 44 nil t t)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 19 39 nil nil nil)
+ (make-overlay 10 49 nil t t)
+ (make-overlay 56 38 nil t t)
+ (make-overlay 23 38 nil nil t)
+ (make-overlay 1 64 nil nil t)
+ (make-overlay 21 3 nil t nil)
+ (make-overlay 1 1 nil nil t)
+ (make-overlay 27 61 nil nil nil)
+ (make-overlay 29 59 nil nil nil)
+ (make-overlay 37 30 nil t nil)
+ (make-overlay 47 21 nil nil t)
+ (make-overlay 34 26 nil t nil)
+ (goto-char 6)
+ (delete-char 44)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "....")
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...")
+ (goto-char 20)
+ (insert "")
+ (goto-char 2)
+ (delete-char 20)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 36)
+ (insert "..............")
+ (goto-char 26)
+ (insert "..............")
+ (goto-char 63)
+ (insert "...........")
+ (goto-char 9)
+ (insert "............")
+ (goto-char 71)
+ (delete-char 17)
+ (goto-char 36)
+ (insert "....")
+ (goto-char 45)
+ (delete-char 31)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 10)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "")
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 23)
+ (insert "......")
+ (goto-char 25)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 10 30)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 17)
+ (insert "..........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 48)
+ (1 . 48)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 48)
+ (32 . 48)
+ (32 . 48))))))
+
+(ert-deftest overlay-autogenerated-test-48 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 11 nil nil nil)
+ (make-overlay 35 29 nil t t)
+ (make-overlay 24 46 nil nil t)
+ (make-overlay 15 43 nil nil t)
+ (make-overlay 51 49 nil t t)
+ (make-overlay 25 43 nil t nil)
+ (make-overlay 23 59 nil nil nil)
+ (make-overlay 10 4 nil t nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 42 43 nil nil t)
+ (make-overlay 20 38 nil t nil)
+ (make-overlay 17 49 nil nil nil)
+ (make-overlay 9 25 nil nil t)
+ (make-overlay 13 19 nil nil nil)
+ (make-overlay 44 31 nil t nil)
+ (make-overlay 12 65 nil nil t)
+ (goto-char 59)
+ (widen)
+ (narrow-to-region 28 14)
+ (goto-char 26)
+ (insert "...")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 23)
+ (insert "...")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 45 67)
+ (goto-char 50)
+ (insert "...............")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 55)
+ (insert ".............")
+ (goto-char 106)
+ (delete-char 0)
+ (goto-char 97)
+ (delete-char 10)
+ (goto-char 67)
+ (delete-char 16)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 71)
+ (insert ".............")
+ (goto-char 110)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 38)
+ (goto-char 61)
+ (delete-char 10)
+ (goto-char 56)
+ (delete-char 5)
+ (goto-char 49)
+ (insert ".......")
+ (goto-char 62)
+ (insert "...")
+ (goto-char 54)
+ (insert "..........")
+ (goto-char 47)
+ (delete-char 10)
+ (goto-char 47)
+ (delete-char 20)
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 70)
+ (delete-char 1)
+ (goto-char 62)
+ (widen)
+ (narrow-to-region 50 64)
+ (goto-char 60)
+ (insert "..")
+ (goto-char 55)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 61)
+ (delete-char 9)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 53)
+ (widen)
+ (narrow-to-region 15 62)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((9 . 28)
+ (12 . 73)
+ (13 . 19)
+ (15 . 70)
+ (17 . 70)
+ (20 . 43)
+ (23 . 70)
+ (27 . 70)
+ (28 . 70)
+ (34 . 40)
+ (36 . 70)
+ (45 . 70))))))
+
+(ert-deftest overlay-autogenerated-test-49 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 10 nil nil t)
+ (make-overlay 53 23 nil t nil)
+ (make-overlay 53 9 nil nil t)
+ (make-overlay 65 64 nil t t)
+ (make-overlay 48 2 nil nil t)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 64 nil nil nil)
+ (make-overlay 26 13 nil t t)
+ (make-overlay 46 26 nil nil t)
+ (make-overlay 28 59 nil t t)
+ (make-overlay 33 52 nil nil nil)
+ (make-overlay 39 8 nil t t)
+ (make-overlay 9 59 nil t t)
+ (make-overlay 50 45 nil nil t)
+ (make-overlay 41 53 nil nil t)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 61)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 10 65)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 77)
+ (delete-char 0)
+ (goto-char 51)
+ (insert "...")
+ (goto-char 75)
+ (insert ".....")
+ (goto-char 77)
+ (delete-char 11)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 24)
+ (widen)
+ (narrow-to-region 33 52)
+ (goto-char 46)
+ (insert "..............")
+ (goto-char 46)
+ (insert "..........")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 46 77)
+ (goto-char 77)
+ (insert "..............")
+ (goto-char 54)
+ (insert ".......")
+ (goto-char 87)
+ (insert ".")
+ (goto-char 70)
+ (delete-char 16)
+ (goto-char 79)
+ (delete-char 0)
+ (goto-char 73)
+ (widen)
+ (narrow-to-region 74 100)
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 80)
+ (delete-char 11)
+ (goto-char 82)
+ (insert "......")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 104)
+ (insert ".....")
+ (goto-char 100)
+ (delete-char 1)
+ (goto-char 90)
+ (insert ".............")
+ (goto-char 99)
+ (insert ".............")
+ (goto-char 124)
+ (insert "..............")
+ (goto-char 114)
+ (insert "....")
+ (goto-char 134)
+ (delete-char 0)
+ (goto-char 89)
+ (delete-char 65)
+ (goto-char 75)
+ (delete-char 16)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 75)
+ (8 . 75)
+ (9 . 76)
+ (9 . 82)
+ (27 . 82)
+ (38 . 76)
+ (41 . 75)
+ (43 . 82)
+ (70 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-50 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 53 nil t t)
+ (make-overlay 65 64 nil nil nil)
+ (make-overlay 3 31 nil nil t)
+ (make-overlay 45 59 nil t nil)
+ (make-overlay 60 37 nil t t)
+ (make-overlay 7 5 nil t t)
+ (make-overlay 37 24 nil nil nil)
+ (make-overlay 45 20 nil nil nil)
+ (make-overlay 33 42 nil nil t)
+ (make-overlay 47 57 nil t nil)
+ (make-overlay 14 49 nil t t)
+ (make-overlay 14 30 nil t nil)
+ (make-overlay 21 40 nil t t)
+ (make-overlay 5 45 nil t t)
+ (make-overlay 59 40 nil t t)
+ (make-overlay 37 52 nil nil nil)
+ (goto-char 48)
+ (insert "")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 31)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 7)
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 51 53)
+ (goto-char 52)
+ (insert ".....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 18 24)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 39 38)
+ (goto-char 38)
+ (insert ".............")
+ (goto-char 41)
+ (insert "......")
+ (goto-char 38)
+ (insert "..............")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 78)
+ (delete-char 5)
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 50)
+ (delete-char 3)
+ (goto-char 85)
+ (widen)
+ (narrow-to-region 86 1)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 94)
+ (insert "......")
+ (goto-char 98)
+ (delete-char 7)
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 79)
+ (insert "............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 14)
+ (delete-char 63)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 34)
+ (insert "...")
+ (goto-char 53)
+ (delete-char 14)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 6 52)
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 1 68)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 14)
+ (9 . 14)
+ (9 . 91)
+ (14 . 14)
+ (14 . 83)
+ (14 . 86)
+ (14 . 88)
+ (14 . 91)
+ (14 . 95)
+ (14 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-51 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 14 5 nil t nil)
+ (make-overlay 62 34 nil nil t)
+ (make-overlay 7 62 nil nil t)
+ (make-overlay 23 12 nil t t)
+ (make-overlay 16 4 nil nil nil)
+ (make-overlay 24 15 nil nil nil)
+ (make-overlay 6 6 nil t t)
+ (make-overlay 25 64 nil t t)
+ (make-overlay 23 6 nil t t)
+ (make-overlay 55 64 nil nil nil)
+ (make-overlay 8 62 nil nil t)
+ (make-overlay 65 65 nil nil nil)
+ (make-overlay 57 51 nil t t)
+ (make-overlay 35 8 nil t nil)
+ (make-overlay 55 13 nil nil t)
+ (make-overlay 60 62 nil nil t)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 66)
+ (insert "............")
+ (goto-char 32)
+ (insert "..")
+ (goto-char 27)
+ (insert ".........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 79)
+ (insert ".")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 49)
+ (insert "...")
+ (goto-char 81)
+ (insert "....")
+ (goto-char 112)
+ (delete-char 0)
+ (goto-char 97)
+ (insert ".....")
+ (goto-char 109)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 33)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 98)
+ (insert "....")
+ (goto-char 22)
+ (delete-char 36)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 42)
+ (delete-char 29)
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 39 41)
+ (goto-char 39)
+ (delete-char 2)
+ (goto-char 39)
+ (insert ".............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 59 20)
+ (goto-char 56)
+ (insert "............")
+ (goto-char 57)
+ (insert ".")
+ (goto-char 37)
+ (delete-char 12)
+ (goto-char 39)
+ (delete-char 11)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 65 26)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 27 55)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 55)
+ (8 . 55)
+ (22 . 29)
+ (23 . 55)
+ (23 . 56)
+ (24 . 31)
+ (29 . 56)
+ (37 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-52 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 32 nil nil nil)
+ (make-overlay 44 54 nil nil t)
+ (make-overlay 27 50 nil nil nil)
+ (make-overlay 55 35 nil nil t)
+ (make-overlay 40 46 nil nil t)
+ (make-overlay 56 63 nil t nil)
+ (make-overlay 29 48 nil nil nil)
+ (make-overlay 45 24 nil t nil)
+ (make-overlay 60 25 nil t nil)
+ (make-overlay 55 41 nil t nil)
+ (make-overlay 55 1 nil nil t)
+ (make-overlay 30 45 nil t t)
+ (make-overlay 26 19 nil nil t)
+ (make-overlay 61 5 nil nil nil)
+ (make-overlay 33 5 nil nil nil)
+ (make-overlay 42 18 nil t nil)
+ (goto-char 55)
+ (insert ".")
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 41)
+ (insert "..........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 58)
+ (insert "...........")
+ (goto-char 24)
+ (delete-char 23)
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 4)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 32)
+ (goto-char 4)
+ (insert "..............")
+ (goto-char 29)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 34)
+ (insert "...........")
+ (goto-char 9)
+ (insert "......")
+ (goto-char 5)
+ (insert "")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 36)
+ (delete-char 5)
+ (goto-char 15)
+ (delete-char 27)
+ (goto-char 15)
+ (delete-char 10)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 10 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 9 10)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 3)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 17))))))
+
+(ert-deftest overlay-autogenerated-test-53 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 10 30 nil nil nil)
+ (make-overlay 11 57 nil t nil)
+ (make-overlay 59 56 nil nil t)
+ (make-overlay 20 37 nil nil t)
+ (make-overlay 41 29 nil nil nil)
+ (make-overlay 31 10 nil nil t)
+ (make-overlay 6 36 nil nil nil)
+ (make-overlay 12 54 nil nil nil)
+ (make-overlay 25 26 nil t t)
+ (make-overlay 21 19 nil nil t)
+ (make-overlay 1 21 nil nil t)
+ (make-overlay 48 51 nil nil nil)
+ (make-overlay 54 55 nil t nil)
+ (make-overlay 64 48 nil t t)
+ (make-overlay 56 25 nil nil t)
+ (make-overlay 12 60 nil t nil)
+ (goto-char 41)
+ (delete-char 1)
+ (goto-char 63)
+ (insert "")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 1)
+ (delete-char 3)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 1)
+ (insert "..........")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 31)
+ (delete-char 15)
+ (goto-char 31)
+ (insert "")
+ (goto-char 27)
+ (insert "......")
+ (goto-char 6)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 23 47)
+ (goto-char 37)
+ (delete-char 2)
+ (goto-char 35)
+ (delete-char 5)
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 30)
+ (insert ".......")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 13 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (insert ".....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 26)
+ (delete-char 0)
+ (goto-char 26)
+ (widen)
+ (narrow-to-region 76 98)
+ (goto-char 88)
+ (insert ".........")
+ (goto-char 92)
+ (insert ".")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 103)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 79)
+ (37 . 103)
+ (61 . 88)
+ (61 . 99)
+ (74 . 121)
+ (75 . 118)
+ (75 . 124)
+ (77 . 79)
+ (78 . 103)
+ (83 . 84)
+ (83 . 120)
+ (87 . 106))))))
+
+(ert-deftest overlay-autogenerated-test-54 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 36 nil t t)
+ (make-overlay 55 49 nil nil t)
+ (make-overlay 12 25 nil nil t)
+ (make-overlay 16 37 nil t t)
+ (make-overlay 42 25 nil t t)
+ (make-overlay 8 41 nil t t)
+ (make-overlay 13 27 nil nil t)
+ (make-overlay 52 22 nil t nil)
+ (make-overlay 36 17 nil t nil)
+ (make-overlay 1 52 nil t nil)
+ (make-overlay 55 5 nil nil t)
+ (make-overlay 50 50 nil t nil)
+ (make-overlay 32 15 nil t nil)
+ (make-overlay 39 26 nil t nil)
+ (make-overlay 26 4 nil nil nil)
+ (make-overlay 38 47 nil t t)
+ (goto-char 23)
+ (insert ".")
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 54)
+ (insert "..............")
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 58)
+ (delete-char 21)
+ (goto-char 45)
+ (delete-char 4)
+ (goto-char 50)
+ (delete-char 4)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 63)
+ (insert "........")
+ (goto-char 83)
+ (insert "....")
+ (goto-char 73)
+ (delete-char 8)
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 19 31)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "............")
+ (goto-char 23)
+ (delete-char 11)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 23)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 35)
+ (delete-char 8)
+ (goto-char 35)
+ (insert ".")
+ (goto-char 20)
+ (insert "......")
+ (goto-char 22)
+ (delete-char 22)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 1 41)
+ (goto-char 13)
+ (insert ".......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 83)
+ (4 . 46)
+ (5 . 97)
+ (8 . 83)
+ (12 . 45)
+ (13 . 47)
+ (22 . 59)
+ (30 . 82)
+ (30 . 83)
+ (41 . 83)
+ (45 . 83)
+ (46 . 83))))))
+
+(ert-deftest overlay-autogenerated-test-55 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 20 nil nil nil)
+ (make-overlay 60 33 nil t nil)
+ (make-overlay 6 27 nil nil nil)
+ (make-overlay 53 31 nil nil t)
+ (make-overlay 30 55 nil t t)
+ (make-overlay 4 64 nil t t)
+ (make-overlay 51 31 nil nil t)
+ (make-overlay 4 65 nil t t)
+ (make-overlay 57 62 nil t t)
+ (make-overlay 28 7 nil nil t)
+ (make-overlay 61 48 nil t nil)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 47 49 nil nil nil)
+ (make-overlay 12 52 nil t nil)
+ (make-overlay 39 57 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (goto-char 8)
+ (insert "..............")
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 10 67)
+ (goto-char 43)
+ (insert ".............")
+ (goto-char 20)
+ (insert "...............")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 47)
+ (goto-char 34)
+ (insert "..............")
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 29 36)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".......")
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 40 19)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 4)
+ (goto-char 33)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 78 70)
+ (goto-char 77)
+ (insert ".........")
+ (goto-char 80)
+ (delete-char 1)
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 70)
+ (insert ".........")
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 74)
+ (delete-char 3)
+ (goto-char 73)
+ (insert "...............")
+ (goto-char 90)
+ (insert "......")
+ (goto-char 94)
+ (insert "..............")
+ (goto-char 101)
+ (insert "........")
+ (goto-char 111)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 132)
+ (4 . 133)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 129)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (89 . 89)
+ (89 . 130))))))
+
+(ert-deftest overlay-autogenerated-test-56 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 7 14 nil nil t)
+ (make-overlay 10 10 nil nil t)
+ (make-overlay 21 23 nil nil t)
+ (make-overlay 4 44 nil t nil)
+ (make-overlay 42 16 nil t t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 15 27 nil nil nil)
+ (make-overlay 31 1 nil t nil)
+ (make-overlay 56 45 nil t t)
+ (make-overlay 46 19 nil t nil)
+ (make-overlay 15 6 nil nil nil)
+ (make-overlay 31 26 nil nil t)
+ (make-overlay 39 41 nil t t)
+ (make-overlay 52 48 nil nil t)
+ (make-overlay 44 2 nil t nil)
+ (make-overlay 60 7 nil nil t)
+ (goto-char 49)
+ (delete-char 11)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...........")
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 1)
+ (insert "......")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 75 33)
+ (goto-char 41)
+ (delete-char 28)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (goto-char 42)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 38)
+ (insert "............")
+ (goto-char 51)
+ (insert ".......")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 55)
+ (insert ".")
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 42)
+ (insert "..")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 81)
+ (delete-char 0)
+ (goto-char 44)
+ (delete-char 36)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 65)
+ (insert "...............")
+ (goto-char 61)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 86)
+ (7 . 97)
+ (8 . 97)
+ (10 . 97)
+ (13 . 97)
+ (32 . 68)
+ (33 . 60)
+ (60 . 97)
+ (60 . 97)
+ (68 . 86))))))
+
+(ert-deftest overlay-autogenerated-test-57 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 31 nil t nil)
+ (make-overlay 39 17 nil t nil)
+ (make-overlay 19 20 nil t t)
+ (make-overlay 18 3 nil nil t)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 38 54 nil nil nil)
+ (make-overlay 30 51 nil nil t)
+ (make-overlay 29 60 nil t t)
+ (make-overlay 57 38 nil nil nil)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 9 44 nil t nil)
+ (make-overlay 30 55 nil t nil)
+ (make-overlay 33 10 nil nil nil)
+ (make-overlay 14 35 nil nil t)
+ (make-overlay 53 50 nil t nil)
+ (make-overlay 25 28 nil nil t)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 64)
+ (insert "........")
+ (goto-char 47)
+ (insert "............")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 1)
+ (goto-char 59)
+ (delete-char 11)
+ (goto-char 64)
+ (delete-char 8)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 2)
+ (delete-char 10)
+ (goto-char 3)
+ (insert "..")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 1)
+ (insert "........")
+ (goto-char 10)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 23)
+ (insert "....")
+ (goto-char 1)
+ (widen)
+ (narrow-to-region 15 23)
+ (goto-char 19)
+ (insert "...")
+ (goto-char 24)
+ (delete-char 0)
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "..........")
+ (goto-char 50)
+ (insert "")
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((10 . 57)
+ (10 . 57)
+ (10 . 57)
+ (10 . 60)
+ (10 . 60)
+ (10 . 61)
+ (10 . 68)
+ (57 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-58 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 16 nil t nil)
+ (make-overlay 57 27 nil nil nil)
+ (make-overlay 15 62 nil nil nil)
+ (make-overlay 32 33 nil nil t)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 41 4 nil nil t)
+ (make-overlay 57 61 nil t nil)
+ (make-overlay 18 43 nil nil t)
+ (make-overlay 64 51 nil t t)
+ (make-overlay 44 26 nil nil nil)
+ (make-overlay 9 13 nil nil t)
+ (make-overlay 41 65 nil nil t)
+ (make-overlay 23 13 nil t t)
+ (make-overlay 26 59 nil t t)
+ (make-overlay 65 65 nil t t)
+ (make-overlay 15 7 nil nil nil)
+ (goto-char 41)
+ (insert "........")
+ (goto-char 35)
+ (delete-char 14)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 23 46)
+ (goto-char 41)
+ (delete-char 5)
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 31)
+ (insert ".")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 29)
+ (insert "")
+ (goto-char 24)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 9)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 20 14)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 31)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "...........")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 16 29)
+ (goto-char 24)
+ (insert "...............")
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 4 22)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 36)
+ (insert "..")
+ (goto-char 10)
+ (delete-char 21)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "...........")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 32)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 92)
+ (7 . 10)
+ (8 . 10)
+ (9 . 10)
+ (10 . 82)
+ (10 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-59 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 46 30 nil t t)
+ (make-overlay 3 26 nil nil nil)
+ (make-overlay 36 28 nil t t)
+ (make-overlay 49 49 nil t t)
+ (make-overlay 27 61 nil t nil)
+ (make-overlay 14 16 nil nil nil)
+ (make-overlay 50 61 nil t nil)
+ (make-overlay 59 63 nil nil nil)
+ (make-overlay 36 34 nil t nil)
+ (make-overlay 35 29 nil nil nil)
+ (make-overlay 5 65 nil nil nil)
+ (make-overlay 20 61 nil nil t)
+ (make-overlay 10 42 nil nil nil)
+ (make-overlay 47 49 nil nil t)
+ (make-overlay 12 4 nil nil nil)
+ (make-overlay 32 24 nil t t)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 61)
+ (insert ".........")
+ (goto-char 36)
+ (insert "........")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 8 55)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 32)
+ (delete-char 15)
+ (goto-char 30)
+ (delete-char 5)
+ (goto-char 31)
+ (insert "......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 34)
+ (insert "............")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 58 31)
+ (goto-char 50)
+ (delete-char 5)
+ (goto-char 53)
+ (insert ".........")
+ (goto-char 56)
+ (insert "...............")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 67)
+ (insert "............")
+ (goto-char 84)
+ (insert "")
+ (goto-char 39)
+ (delete-char 27)
+ (goto-char 39)
+ (delete-char 21)
+ (goto-char 32)
+ (insert "............")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 7 37)
+ (goto-char 11)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 13)
+ (goto-char 15)
+ (insert "....")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 21)
+ (delete-char 6)
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 22)
+ (insert "")
+ (goto-char 27)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 42)
+ (4 . 16)
+ (5 . 83)
+ (13 . 51)
+ (25 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-60 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 32 nil t nil)
+ (make-overlay 32 42 nil t nil)
+ (make-overlay 29 11 nil nil t)
+ (make-overlay 52 22 nil t t)
+ (make-overlay 39 59 nil t nil)
+ (make-overlay 41 30 nil t t)
+ (make-overlay 29 61 nil nil t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 46 17 nil nil t)
+ (make-overlay 35 51 nil t t)
+ (make-overlay 22 13 nil nil t)
+ (make-overlay 52 34 nil nil t)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 8 22 nil nil nil)
+ (make-overlay 4 49 nil nil nil)
+ (make-overlay 52 45 nil t t)
+ (goto-char 48)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 8)
+ (goto-char 14)
+ (insert "...............")
+ (goto-char 40)
+ (delete-char 16)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 10)
+ (insert "........")
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 22)
+ (insert ".")
+ (goto-char 62)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 11)
+ (goto-char 47)
+ (insert "....")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 28)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 13)
+ (goto-char 44)
+ (insert "....")
+ (goto-char 34)
+ (delete-char 14)
+ (goto-char 23)
+ (insert ".....")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 33)
+ (insert ".....")
+ (goto-char 27)
+ (delete-char 3)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 36)
+ (insert ".......")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 35 31)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 24 3)
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 4)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 54)
+ (4 . 54)
+ (9 . 46))))))
+
+(ert-deftest overlay-autogenerated-test-61 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 45 56 nil t nil)
+ (make-overlay 60 45 nil nil nil)
+ (make-overlay 26 8 nil t t)
+ (make-overlay 63 39 nil nil nil)
+ (make-overlay 18 11 nil t nil)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 8 41 nil nil t)
+ (make-overlay 6 51 nil t t)
+ (make-overlay 38 26 nil t t)
+ (make-overlay 7 46 nil t nil)
+ (make-overlay 2 42 nil nil t)
+ (make-overlay 44 64 nil nil nil)
+ (make-overlay 7 62 nil t nil)
+ (make-overlay 8 40 nil nil t)
+ (make-overlay 62 36 nil t t)
+ (make-overlay 61 27 nil nil nil)
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "")
+ (goto-char 55)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 25)
+ (goto-char 37)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 3)
+ (delete-char 26)
+ (goto-char 10)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 0)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 18)
+ (delete-char 3)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 20)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 3)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "......")
+ (goto-char 4)
+ (insert ".......")
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 2)
+ (insert "......")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 15)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 13)
+ (insert "...........")
+ (goto-char 34)
+ (insert "...............")
+ (goto-char 33)
+ (insert "")
+ (goto-char 51)
+ (insert "....")
+ (goto-char 14)
+ (delete-char 36)
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-62 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 36 nil t nil)
+ (make-overlay 38 6 nil t nil)
+ (make-overlay 40 63 nil nil t)
+ (make-overlay 34 23 nil nil nil)
+ (make-overlay 48 46 nil nil nil)
+ (make-overlay 43 57 nil t t)
+ (make-overlay 6 53 nil t t)
+ (make-overlay 37 27 nil t t)
+ (make-overlay 8 39 nil t nil)
+ (make-overlay 62 6 nil nil nil)
+ (make-overlay 51 6 nil t t)
+ (make-overlay 58 11 nil nil t)
+ (make-overlay 19 25 nil t nil)
+ (make-overlay 13 8 nil nil nil)
+ (make-overlay 19 8 nil nil t)
+ (make-overlay 39 5 nil t t)
+ (goto-char 51)
+ (delete-char 5)
+ (goto-char 16)
+ (delete-char 9)
+ (goto-char 18)
+ (insert "")
+ (goto-char 47)
+ (delete-char 4)
+ (goto-char 24)
+ (insert ".........")
+ (goto-char 24)
+ (insert ".....")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 5)
+ (delete-char 6)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 78)
+ (insert "............")
+ (goto-char 67)
+ (insert "")
+ (goto-char 58)
+ (insert "")
+ (goto-char 5)
+ (insert ".")
+ (goto-char 79)
+ (widen)
+ (narrow-to-region 51 55)
+ (goto-char 51)
+ (insert "....")
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 37)
+ (insert "....")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 47)
+ (delete-char 1)
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 37)
+ (insert "........")
+ (goto-char 49)
+ (insert "............")
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 75 111)
+ (goto-char 104)
+ (widen)
+ (narrow-to-region 21 95)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 64 79)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 68)
+ (insert "........")
+ (goto-char 82)
+ (insert "")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 92)
+ (delete-char 2)
+ (goto-char 87)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 145)
+ (5 . 148)
+ (6 . 118)
+ (6 . 119)
+ (6 . 119)
+ (6 . 143)
+ (6 . 143)
+ (24 . 114)
+ (24 . 116)
+ (63 . 117))))))
+
+(ert-deftest overlay-autogenerated-test-63 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 9 49 nil t nil)
+ (make-overlay 9 16 nil nil nil)
+ (make-overlay 64 2 nil t t)
+ (make-overlay 17 31 nil nil t)
+ (make-overlay 24 51 nil nil nil)
+ (make-overlay 27 56 nil t t)
+ (make-overlay 21 4 nil nil nil)
+ (make-overlay 24 29 nil t t)
+ (make-overlay 4 63 nil nil t)
+ (make-overlay 34 49 nil t nil)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 8 50 nil t nil)
+ (make-overlay 49 61 nil t nil)
+ (make-overlay 52 10 nil t t)
+ (make-overlay 64 30 nil t nil)
+ (make-overlay 5 13 nil t nil)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 42)
+ (insert "......")
+ (goto-char 48)
+ (insert "....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 10 5)
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 19)
+ (insert "......")
+ (goto-char 19)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 34)
+ (insert "......")
+ (goto-char 28)
+ (delete-char 20)
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "........")
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 8)
+ (delete-char 17)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 12)
+ (insert ".")
+ (goto-char 14)
+ (delete-char 12)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 34)
+ (insert "")
+ (goto-char 25)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 98)
+ (4 . 37)
+ (4 . 97)
+ (25 . 29)
+ (25 . 32)
+ (25 . 84))))))
+
+(ert-deftest overlay-autogenerated-test-64 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 31 10 nil nil nil)
+ (make-overlay 17 58 nil nil t)
+ (make-overlay 20 21 nil t nil)
+ (make-overlay 3 47 nil t t)
+ (make-overlay 47 43 nil t t)
+ (make-overlay 54 8 nil nil t)
+ (make-overlay 51 26 nil t nil)
+ (make-overlay 60 14 nil t nil)
+ (make-overlay 38 6 nil nil t)
+ (make-overlay 41 9 nil nil nil)
+ (make-overlay 44 38 nil nil t)
+ (make-overlay 55 48 nil nil t)
+ (make-overlay 10 41 nil nil t)
+ (make-overlay 35 49 nil t nil)
+ (make-overlay 50 46 nil nil nil)
+ (make-overlay 28 28 nil t nil)
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 13 7)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 59 51)
+ (goto-char 52)
+ (insert ".........")
+ (goto-char 53)
+ (insert "........")
+ (goto-char 53)
+ (delete-char 4)
+ (goto-char 54)
+ (insert "........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 75)
+ (widen)
+ (goto-char 70)
+ (delete-char 2)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 80)
+ (widen)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 49 63)
+ (goto-char 49)
+ (insert "...")
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 59)
+ (insert "..........")
+ (goto-char 56)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 62)
+ (widen)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 105)
+ (widen)
+ (narrow-to-region 94 109)
+ (goto-char 103)
+ (insert "............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 134)
+ (6 . 125)
+ (38 . 141)
+ (39 . 118)
+ (39 . 128)
+ (39 . 128)
+ (40 . 146)
+ (43 . 145)
+ (101 . 138)
+ (103 . 103))))))
+
++) ;; End of `when nil' for autogenerated insert/delete/narrow tests.
++
+ (ert-deftest buffer-multibyte-overlong-sequences ()
+ (dolist (uni '("\xE0\x80\x80"
+ "\xF0\x80\x80\x80"
+ "\xF8\x8F\xBF\xBF\x80"))
+ (let ((multi (string-to-multibyte uni)))
+ (should
+ (string-equal
+ multi
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert uni)
+ (set-buffer-multibyte t)
+ (buffer-string)))))))
+
+ ;; https://debbugs.gnu.org/33492
+ (ert-deftest buffer-tests-buffer-local-variables-undo ()
+ "Test that `buffer-undo-list' appears in `buffer-local-variables'."
+ (with-temp-buffer
+ (should (assq 'buffer-undo-list (buffer-local-variables)))))
+
+ (ert-deftest buffer-tests-inhibit-buffer-hooks ()
+ "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS."
+ (let* (run-bluh (bluh (lambda () (setq run-bluh t))))
+ (unwind-protect
+ (let* ( run-kbh (kbh (lambda () (setq run-kbh t)))
+ run-kbqf (kbqf (lambda () (setq run-kbqf t))) )
+
+ ;; Inhibited.
+ (add-hook 'buffer-list-update-hook bluh)
+ (with-current-buffer (generate-new-buffer " foo" t)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (with-temp-buffer (ignore))
+ (with-output-to-string (ignore))
+ (should-not run-bluh)
+ (should-not run-kbh)
+ (should-not run-kbqf)
+
+ ;; Not inhibited.
+ (with-current-buffer (generate-new-buffer " foo")
+ (should run-bluh)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (should run-kbh)
+ (should run-kbqf))
+ (remove-hook 'buffer-list-update-hook bluh))))
+
+ (ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
+ "Indirect buffers do not call `get-buffer-create'."
+ (dolist (inhibit '(nil t))
+ (let ((base (get-buffer-create "foo" inhibit)))
+ (unwind-protect
+ (dotimes (_i 11)
+ (let* (flag*
+ (flag (lambda () (prog1 t (setq flag* t))))
+ (indirect (make-indirect-buffer base "foo[indirect]" nil
+ inhibit)))
+ (unwind-protect
+ (progn
+ (with-current-buffer indirect
+ (add-hook 'kill-buffer-query-functions flag nil t))
+ (kill-buffer indirect)
+ (if inhibit
+ (should-not flag*)
+ (should flag*)))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p indirect)
+ (kill-buffer indirect))))))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p base)
+ (kill-buffer base)))))))
+
+ (ert-deftest zero-length-overlays-and-not ()
+ (with-temp-buffer
+ (insert "hello")
+ (let ((long-overlay (make-overlay 2 4))
+ (zero-overlay (make-overlay 3 3)))
+ ;; Exclude.
+ (should (= (length (overlays-at 3)) 1))
+ (should (eq (car (overlays-at 3)) long-overlay))
+ ;; Include.
+ (should (= (length (overlays-in 3 3)) 2))
+ (should (memq long-overlay (overlays-in 3 3)))
+ (should (memq zero-overlay (overlays-in 3 3))))))
+
+ (ert-deftest test-remove-overlays ()
+ (with-temp-buffer
+ (insert "foo")
+ (make-overlay (point) (point))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0)))
+
+ (with-temp-buffer
+ (insert "foo")
+ (goto-char 2)
+ (make-overlay (point) (point))
+ ;; We only count zero-length overlays at the end of the buffer.
+ (should (= (length (overlays-in 1 2)) 0))
+ (narrow-to-region 1 2)
+ ;; We've now narrowed, so the zero-length overlay is at the end of
+ ;; the (accessible part of the) buffer.
+ (should (= (length (overlays-in 1 2)) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))))
+
+ (ert-deftest test-kill-buffer-auto-save-default ()
+ (ert-with-temp-file file
+ (let (auto-save)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (when auto-save
+ (ignore-errors (delete-file auto-save))))))))
+
+ (ert-deftest test-kill-buffer-auto-save-delete ()
+ (ert-with-temp-file file
+ (let (auto-save)
+ (should (file-exists-p file))
+ (setq kill-buffer-delete-auto-save-files t)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should-not (file-exists-p auto-save)))
+ (ignore-errors (delete-file file))
+ (when auto-save
+ (ignore-errors (delete-file auto-save)))))
+ ;; Answer no to deletion.
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (not (string-search "Delete auto-save file" prompt)))))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should not delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (when auto-save
+ (ignore-errors (delete-file auto-save))))))))
+
+ (ert-deftest test-buffer-modifications ()
+ (ert-with-temp-file file
+ (with-current-buffer (find-file file)
+ (auto-save-mode 1)
+ (should-not (buffer-modified-p))
+ (insert "foo")
+ (should (buffer-modified-p))
+ (should-not (eq (buffer-modified-p) 'autosaved))
+ (do-auto-save nil t)
+ (should (eq (buffer-modified-p) 'autosaved))
+ (with-silent-modifications
+ (put-text-property 1 3 'face 'bold))
+ (should (eq (buffer-modified-p) 'autosaved))
+ (save-buffer)
+ (should-not (buffer-modified-p))
+ (with-silent-modifications
+ (put-text-property 1 3 'face 'italic))
+ (should-not (buffer-modified-p)))))
+
+ (ert-deftest test-restore-buffer-modified-p ()
+ (ert-with-temp-file file
+ ;; This avoids the annoying "foo and bar are the same file" on
+ ;; MS-Windows.
+ (setq file (file-truename file))
+ (with-current-buffer (find-file file)
+ (auto-save-mode 1)
+ (should-not (eq (buffer-modified-p) t))
+ (insert "foo")
+ (should (buffer-modified-p))
+ (restore-buffer-modified-p nil)
+ (should-not (buffer-modified-p))
+ (insert "bar")
+ (do-auto-save nil t)
+ (should (eq (buffer-modified-p) 'autosaved))
+ (insert "zot")
+ (restore-buffer-modified-p 'autosaved)
+ (should (eq (buffer-modified-p) 'autosaved))
+
+ ;; Clean up.
+ (when (file-exists-p buffer-auto-save-file-name)
+ (delete-file buffer-auto-save-file-name))))
+
+ (ert-with-temp-file file
+ (setq file (file-truename file))
+ (with-current-buffer (find-file file)
+ (auto-save-mode 1)
+ (should-not (eq (buffer-modified-p) t))
+ (insert "foo")
+ (should (buffer-modified-p))
+ (should-not (eq (buffer-modified-p) 'autosaved))
+ (restore-buffer-modified-p 'autosaved)
+ (should (eq (buffer-modified-p) 'autosaved)))))
+
+ (ert-deftest test-buffer-chars-modified-ticks ()
+ "Test `buffer-chars-modified-tick'."
+ (setq temporary-file-directory (file-truename temporary-file-directory))
+ (let ((text "foobar")
+ f1 f2)
+ (unwind-protect
+ (progn
+ (setq f1 (make-temp-file "buf-modiff-tests")
+ f2 (make-temp-file "buf-modiff-tests"))
+ (with-current-buffer (find-file f1)
+ (should (= (buffer-chars-modified-tick) 1))
+ (should (= (buffer-chars-modified-tick) (buffer-modified-tick)))
+ (write-region text nil f2 nil 'silent)
+ (insert-file-contents f2)
+ (should (= (buffer-chars-modified-tick) (buffer-modified-tick)))
+ (should (> (buffer-chars-modified-tick) 1))))
+ (if f1 (delete-file f1))
+ (if f2 (delete-file f2))
+ )))
+
;;; buffer-tests.el ends here
projects / emacs.git / commitdiff