From: Stefan Monnier Date: Sun, 25 Sep 2022 20:15:16 +0000 (-0400) Subject: Merge 'master' into noverlay X-Git-Tag: emacs-29.0.90~1616^2~406^2~58 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=650c20f1ca4e07591a727e1cfcc74b3363d15985;p=emacs.git Merge 'master' into noverlay --- 650c20f1ca4e07591a727e1cfcc74b3363d15985 diff --cc configure.ac index 76cf5570b52,4590ed3506e..8ba52a492bc --- a/configure.ac +++ b/configure.ac @@@ -5495,8 -6686,14 +6686,15 @@@ if test -f "$srcdir/$opt_makefile.in"; 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. diff --cc src/Makefile.in index 8a8df03e49f,1f941874ea8..059e6c717b4 --- a/src/Makefile.in +++ b/src/Makefile.in @@@ -379,27 -426,28 +426,29 @@@ ALL_CXX_CFLAGS = $(EMACS_CFLAGS) ## 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. @@@ -437,6 -487,27 +488,27 @@@ otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OB FIRSTFILE_OBJ=@FIRSTFILE_OBJ@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) + # 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 \ ++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) diff --cc src/alloc.c index 9f72f914e00,419c5e558b4..20b8981bd66 --- a/src/alloc.c +++ b/src/alloc.c @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -42,8 -44,8 +43,9 @@@ along with GNU Emacs. If not, see 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. */ @@@ -3815,40 -3697,19 +3702,23 @@@ build_symbol_with_pos (Lisp_Object symb 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, @@@ -5900,29 -5916,198 +5925,197 @@@ mark_pinned_symbols (void } } - /* 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); @@@ -6271,23 -6495,16 +6503,10 @@@ mark_char_table (struct Lisp_Vector *pt /* 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. */ @@@ -6304,16 -6521,19 +6523,22 @@@ mark_buffer (struct buffer *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); } diff --cc src/buffer.c index 9ddc9c7e056,d4a0c37bed5..1bb2af98e75 --- a/src/buffer.c +++ b/src/buffer.c @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -44,7 -44,7 +43,8 @@@ along with GNU Emacs. If not, see 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 @@@ -2358,8 -2451,13 +2484,10 @@@ results, see Info node `(elisp)Swappin swapfield (bidi_paragraph_cache, struct region_cache *); current_buffer->prevent_redisplay_optimizations_p = 1; other_buffer->prevent_redisplay_optimizations_p = 1; + swapfield (long_line_optimizations_p, bool_bf); - swapfield (overlays_before, struct Lisp_Overlay *); - swapfield (overlays_after, struct Lisp_Overlay *); - swapfield (overlay_center, ptrdiff_t); 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); @@@ -2689,8 -2781,10 +2813,11 @@@ current buffer is cleared. */ /* 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)) @@@ -2772,39 -2866,8 +2899,13 @@@ the normal hook `change-major-mode-hook 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)); - } - } - } - -/* 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, @@@ -3047,33 -3255,6 +3148,33 @@@ compare_overlays (const void *v1, cons return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1; } +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; + } - else if (INTEGERP (tem)) ++ else if (FIXNUMP (tem)) + { - item->priority = XINT (tem); ++ item->priority = XFIXNUM (tem); + item->spriority = 0; + } + else if (CONSP (tem)) + { + Lisp_Object car = XCAR (tem); + Lisp_Object cdr = XCDR (tem); - item->priority = INTEGERP (car) ? XINT (car) : 0; - item->spriority = INTEGERP (cdr) ? XINT (cdr) : 0; ++ 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. */ @@@ -3215,33 -3425,30 +3316,32 @@@ record_overlay_string (struct sortstrli 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), @@@ -3250,10 -3457,38 +3350,10 @@@ && (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); @@@ -3346,11 -3939,10 +3446,10 @@@ for the front of the overlay advance wh 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)) @@@ -3358,30 -3950,48 +3457,30 @@@ else CHECK_BUFFER (buffer); + b = XBUFFER (buffer); + if (! BUFFER_LIVE_P (b)) + error ("Attempt to create overlay in a dead 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)) + 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. */ @@@ -3405,9 -4015,38 +3504,9 @@@ modify_overlay (struct buffer *buf, ptr 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. @@@ -3454,24 -4093,31 +3553,24 @@@ buffer. */ { 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) @@@ -3494,8 -4140,34 +3593,16 @@@ /* 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); } @@@ -3503,8 -4175,9 +3610,8 @@@ DEFUN ("delete-overlay", Fdelete_overla 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); @@@ -3545,10 -4220,8 +3652,10 @@@ DEFUN ("overlay-start", Foverlay_start (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, @@@ -3556,10 -4229,8 +3663,10 @@@ (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, @@@ -3611,7 -4279,8 +3722,7 @@@ interest. */ /* 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, @@@ -3654,7 -4324,8 +3766,8 @@@ end of the accessible part of the buffe /* 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); @@@ -3670,12 -4341,39 +3783,12 @@@ If there are no overlay boundaries fro 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, @@@ -3685,15 -4383,32 +3798,15 @@@ If there are no overlay boundaries fro 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))); } + /* These functions are for debugging overlays. */ @@@ -3723,8 -4439,11 +3836,8 @@@ That makes overlay lookup faster for po 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; } @@@ -3841,45 -4560,80 +3954,44 @@@ report_overlay_modification (Lisp_Objec if (!after) { + struct interval_node *node; - EMACS_INT begin_arg = XFASTINT (start); - EMACS_INT end_arg = XFASTINT (end); ++ 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); } @@@ -3921,7 -4658,12 +4016,12 @@@ 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 (); @@@ -5675,16 -6515,11 +5900,15 @@@ There is no reason to change that valu 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); } diff --cc src/buffer.h index ef31ad1ed9d,cbdbae798ba..7d6c693b0f2 --- a/src/buffer.h +++ b/src/buffer.h @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -878,8 -686,27 +686,19 @@@ struct buffe /* Non-zero whenever the narrowing is changed in this buffer. */ bool_bf clip_changed : 1; + /* 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; + - /* 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; + /* 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 @@@ -1164,9 -1222,11 +1225,11 @@@ record_unwind_current_buffer (void /* 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); \ @@@ -1210,9 -1272,12 +1273,13 @@@ set_buffer_intervals (struct buffer *b 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); } + + /* 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 @@@ -1251,124 -1390,26 +1392,148 @@@ buffer_window_count (struct buffer *b /* 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; + } /*********************************************************************** @@@ -1507,9 -1550,146 +1674,149 @@@ lowercasep (int c 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 + 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 */ diff --cc src/editfns.c index 8628b1b2d49,b774e79337f..1af6ea1b11d --- a/src/editfns.c +++ b/src/editfns.c @@@ -1,6 -1,6 +1,6 @@@ /* 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. diff --cc src/fns.c index 9f411036825,d2f1aadb65c..7704ca99749 --- a/src/fns.c +++ b/src/fns.c @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -2266,21 -2665,35 +2664,34 @@@ internal_equal (Lisp_Object o1, Lisp_Ob 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 @@@ -4354,41 -4974,62 +4972,63 @@@ sxhash_obj (Lisp_Object obj, int depth 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 (); diff --cc src/itree.c index f43189cabe7,00000000000..adb55fe950b mode 100644,000000..100644 --- a/src/itree.c +++ b/src/itree.c @@@ -1,1164 -1,0 +1,1164 @@@ +/* 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 . */ + +#include +#include +#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; +}; + + + +/* +===================================================================================+ + * | 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.*/ ++/* 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; +} + + +/* +===================================================================================+ + * | 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); +} + + + +/* +===================================================================================+ + * | 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); +} + + +/* +===================================================================================+ + * | 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]; +} + + +/* +===================================================================================+ + * | 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; +} + + +/* +===================================================================================+ + * | Debugging + * +===================================================================================+ */ + +/* See Foverlay_tree in buffer.c */ diff --cc src/itree.h index 2f418f0cf85,00000000000..08b152f92d2 mode 100644,000000..100644 --- a/src/itree.h +++ b/src/itree.h @@@ -1,89 -1,0 +1,89 @@@ +/* 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 . */ + +#ifndef ITREE_H +#define ITREE_H +#include +#include +#include + +/* 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_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 diff --cc src/lisp.h index 222a99950a8,9710dbef8d2..7d838afb5c9 --- a/src/lisp.h +++ b/src/lisp.h @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -2217,184 -2601,76 +2600,75 @@@ struct Lisp_Overla - 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 @@@ -3692,19 -4415,9 +4413,9 @@@ extern struct Lisp_Vector *allocate_pse 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); diff --cc src/pdumper.c index 00000000000,903298f17d2..7618f5d1e87 mode 000000,100644..100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@@ -1,0 -1,5813 +1,5864 @@@ + /* 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 . */ + + #include + + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + + #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 + # 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 }; + + + /* 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) + { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882) ++#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); - dump_field_lv_rawptr (ctx, out, overlay, &overlay->next, - Lisp_Vectorlike, WEIGHT_STRONG); - return finish_dump_pvec (ctx, &out->header); ++ 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) + { -#if CHECK_STRUCTS && !defined HASH_buffer_AA373AEE10 ++#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_before, - 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_lv_rawptr (ctx, out, buffer, &buffer->overlays_after, - Lisp_Vectorlike, WEIGHT_NORMAL); ++ /* dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays, ++ ?Lisp_Vectorlike?, WEIGHT_NORMAL); */ + - DUMP_FIELD_COPY (out, buffer, overlay_center); + 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); + } + + + #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 */ + + + 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 */ + } diff --cc src/print.c index a07baa3067a,1c96ec14b86..65218084a4c --- a/src/print.c +++ b/src/print.c @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -1405,6 -1659,142 +1657,142 @@@ print_vectorlike (Lisp_Object obj, Lisp print_c_string (" ...", printcharfun); printchar ('\"', printcharfun); } + 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 ("#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 ("#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 ("#buffer) ++ if (! OVERLAY_BUFFER (obj)) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "from %"pD"d to %"pD"d in ", - marker_position (OVERLAY_START (obj)), - marker_position (OVERLAY_END (obj))); ++ OVERLAY_START (obj), ++ OVERLAY_END (obj)); + strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), ++ print_string (BVAR (OVERLAY_BUFFER (obj), name), + printcharfun); + } + printchar ('>', printcharfun); + break; + + case PVEC_USER_PTR: + { + print_c_string ("#p, + (void *) XUSER_PTR (obj)->finalizer); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; + + case PVEC_FINALIZER: + print_c_string ("#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, "#", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + + case PVEC_PROCESS: + if (escapeflag) + { + print_c_string ("#name, printcharfun); + printchar ('>', printcharfun); + } + else + print_string (XPROCESS (obj)->name, printcharfun); break; case PVEC_SUBR: diff --cc src/textprop.c index aebb6524e68,c91a2b729c6..c2c3622d05f --- a/src/textprop.c +++ b/src/textprop.c @@@ -1,6 -1,6 +1,5 @@@ /* 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. @@@ -617,42 -634,36 +633,42 @@@ get_char_property_and_overlay (Lisp_Obj } 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) diff --cc src/xdisp.c index f94643b1f7b,ee074c018e5..cee75def804 --- a/src/xdisp.c +++ b/src/xdisp.c @@@ -1,7 -1,7 +1,6 @@@ /* 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. @@@ -5790,38 -6600,81 +6567,39 @@@ load_overlay_strings (struct it *it, pt } \ 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)) @@@ -6195,8 -7065,110 +6991,68 @@@ back_to_previous_line_start (struct it { 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; } @@@ -6390,9 -7392,9 +7276,9 @@@ back_to_previous_visible_line_start (st 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); @@@ -21139,7 -24579,16 +24462,9 @@@ display_line (struct it *it, int cursor 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. */ @@@ -31154,11 -35241,15 +35117,15 @@@ note_mouse_highlight (struct frame *f, /* 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; diff --cc src/xfaces.c index b1788725eb7,5e3a47d7f8b..ed76db9adb7 --- a/src/xfaces.c +++ b/src/xfaces.c @@@ -5983,10 -6604,11 +6602,10 @@@ face_at_buffer_position (struct window 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; } @@@ -5998,13 -6620,16 +6617,14 @@@ 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; diff --cc test/src/buffer-tests.el index 153aea3a20b,558d05de14a..a12d15bc798 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@@ -20,7 -20,201 +20,202 @@@ ;;; 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. @@@ -1273,6464 -1507,245 +1508,6708 @@@ with parameters from the *Messages* buf (ovshould nonempty-eob-end 4 5) (ovshould empty-eob 5 5))))) + + + +;; +===================================================================================+ +;; | 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