diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-08 19:46:29 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-11 18:50:25 -0700 |
commit | d614e4a8cd2d5fe37b38bb4d8191013a7d917731 (patch) | |
tree | f27e866dc009cba536575c9a30af362296a9b60e | |
parent | d3ec5117da3146573cad5c1f8d01ab2e58f21e92 (diff) | |
download | emacs-d614e4a8cd2d5fe37b38bb4d8191013a7d917731.tar.gz |
Turn misc objects into pseudovectors
Eliminate the category of miscellaneous objects, and turn all
such objects into pseudovectors. The immediate motivation
for this change is to free up an enum Lisp_Type tag value, a
scarce resource that can be better used elsewhere. However,
this change is worthwhile in its own right, as it improves
performance slightly on my platform, 0.3% faster for 'make
compile-always' on Fedora 28, and it simplifies the garbage
collector and interpreter (Bug#32405).
* doc/lispref/internals.texi (Garbage Collection):
* etc/NEWS:
Document change to garbage-collect return value.
* src/alloc.c (total_markers, total_free_markers):
(union aligned_Lisp_Misc, MARKER_BLOCK_SIZE)
(struct marker_block, marker_block, marker_block_index)
(misc_free_list, allocate_misc, live_misc_holding)
(live_misc_p, sweep_misc):
* src/lisp.h (lisp_h_MARKERP, lisp_h_MISCP, MARKERP, MISCP)
(Lisp_Misc, enum Lisp_Misc_Type, Lisp_Misc_Free)
(Lisp_Misc_Marker, Lisp_Misc_Overlay, Lisp_Misc_Finalizer)
(Lisp_Misc_Ptr, Lisp_Misc_User_Ptr, Lisp_Misc_Limit)
(Lisp_Misc_Bignum)
(XSETMISC, struct Lisp_Misc_Any, XMISCANY, XMISCTYPE)
(struct Lisp_Free, union Lisp_Misc, XMISC):
Remove. All uses removed.
(cleanup_vector): Clean up objects that were formerly misc
and are now pseudovectors.
(make_misc_ptr, build_overlay, Fmake_marker, build_marker)
(make_bignum_str, make_number, make_pure_bignum)
(make_user_ptr, Fmake_finalizer):
Build as pseudovectors, not as misc objects.
(mark_finalizer_list, queue_doomed_finalizers)
(compact_undo_list, mark_overlay, mark_object)
(unchain_dead_markers):
Mark as vector-like objects, not as misc objects.
(mark_maybe_object, mark_maybe_pointer, valid_lisp_object_p)
(total_bytes_of_live_objects, survives_gc_p):
* src/fns.c (sxhash):
No need to worry about misc objects.
(garbage_collect_1): Do not generate a 'misc' component.
(syms_of_alloc): No need for 'misc' symbol.
* src/buffer.c (overlays_at, overlays_in, overlay_touches_p)
(overlay_strings, recenter_overlay_lists)
(fix_start_end_in_overlays, fix_overlays_before)
(Foverlay_lists, report_overlay_modification)
(evaporate_overlays):
* src/editfns.c (overlays_around):
* src/data.c (Ftype_of):
* src/fns.c (internal_equal):
* src/lisp.h (mint_ptrp, xmint_pointer, FINALIZERP)
(XFINALIZER, MARKERP, XMARKER, OVERLAYP, XOVERLAY, USER_PTRP)
(XUSER_PTR, BIGNUMP, XBIGNUM):
* src/print.c (print_vectorlike, print_object):
* src/undo.c (record_marker_adjustments):
* src/xdisp.c (load_overlay_strings):
Formerly misc objects are now pseudovectors.
* src/lisp.h (PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER)
(PVEC_BIGNUM, PVEC_MISC_PTR, PVEC_USER_PTR):
New constants, replacing their misc versions. All uses changed.
(struct Lisp_Marker, struct Lisp_Overlay, struct Lisp_Misc_Ptr)
(struct Lisp_Bignum, struct Lisp_User_Ptr, struct Lisp_Finalizer):
Make usable as a pseudovector by using a pseudovector header,
replacing any DIY components, and putting Lisp_Object members
first. All uses changed.
-rw-r--r-- | doc/lispref/internals.texi | 11 | ||||
-rw-r--r-- | etc/NEWS | 4 | ||||
-rw-r--r-- | src/alloc.c | 393 | ||||
-rw-r--r-- | src/buffer.c | 250 | ||||
-rw-r--r-- | src/data.c | 27 | ||||
-rw-r--r-- | src/editfns.c | 31 | ||||
-rw-r--r-- | src/fns.c | 58 | ||||
-rw-r--r-- | src/lisp.h | 218 | ||||
-rw-r--r-- | src/print.c | 165 | ||||
-rw-r--r-- | src/undo.c | 14 | ||||
-rw-r--r-- | src/xdisp.c | 45 |
11 files changed, 400 insertions, 816 deletions
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 65752860bf6..1dc5de0a69b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -318,7 +318,6 @@ future allocations. So an overall result is: @example ((@code{conses} @var{cons-size} @var{used-conses} @var{free-conses}) (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols}) - (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs}) (@code{strings} @var{string-size} @var{used-strings} @var{free-strings}) (@code{string-bytes} @var{byte-size} @var{used-bytes}) (@code{vectors} @var{vector-size} @var{used-vectors}) @@ -334,7 +333,7 @@ Here is an example: @example (garbage-collect) @result{} ((conses 16 49126 8058) (symbols 48 14607 0) - (miscs 40 34 56) (strings 32 2942 2607) + (strings 32 2942 2607) (string-bytes 1 78607) (vectors 16 7247) (vector-slots 8 341609 29474) (floats 8 71 102) (intervals 56 27 26) (buffers 944 8) @@ -371,14 +370,6 @@ Internal size of a miscellaneous entity, i.e., @code{sizeof (union Lisp_Misc)}, which is a size of the largest type enumerated in @code{enum Lisp_Misc_Type}. -@item used-miscs -The number of miscellaneous objects in use. These include markers -and overlays, plus certain objects not visible to users. - -@item free-miscs -The number of miscellaneous objects for which space has been obtained -from the operating system, but that are not currently being used. - @item string-size Internal size of a string header, i.e., @code{sizeof (struct Lisp_String)}. @@ -817,6 +817,10 @@ is backwards-compatible with versions of Emacs in which the old function exists. See the node "Displaying Buffers in Side Windows" in the ELisp manual for more details. +** The 'garbage-collect' function no longer returns a 'misc' component +because garbage collection no longer treats miscellaneous objects +specially; they are now allocated like any other pseudovector. + * Lisp Changes in Emacs 27.1 diff --git a/src/alloc.c b/src/alloc.c index c3e02c20f85..fea0cec383b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -247,8 +247,8 @@ bool gc_in_progress; /* Number of live and free conses etc. */ -static EMACS_INT total_conses, total_markers, total_symbols, total_buffers; -static EMACS_INT total_free_conses, total_free_markers, total_free_symbols; +static EMACS_INT total_conses, total_symbols, total_buffers; +static EMACS_INT total_free_conses, total_free_symbols; static EMACS_INT total_free_floats, total_floats; /* Points to memory space allocated as "spare", to be freed if we run @@ -356,6 +356,7 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size) #endif /* MAX_SAVE_STACK > 0 */ +static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); @@ -3197,7 +3198,12 @@ static void cleanup_vector (struct Lisp_Vector *vector) { detect_suspicious_free (vector); - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)) + + if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM)) + mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value); + 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) { @@ -3220,6 +3226,19 @@ cleanup_vector (struct Lisp_Vector *vector) finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex)); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) 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); + } +#ifdef HAVE_MODULES + 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); + } +#endif } /* Reclaim space used by unmarked vectors. */ @@ -3650,96 +3669,27 @@ Its value is void, and its function definition and property list are nil. */) -/*********************************************************************** - Marker (Misc) Allocation - ***********************************************************************/ - -/* Like union Lisp_Misc, but padded so that its size is a multiple of - the required alignment. */ - -union aligned_Lisp_Misc -{ - union Lisp_Misc m; - unsigned char c[(sizeof (union Lisp_Misc) + LISP_ALIGNMENT - 1) - & -LISP_ALIGNMENT]; -}; - -/* Allocation of markers and other objects that share that structure. - Works like allocation of conses. */ - -#define MARKER_BLOCK_SIZE \ - ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc)) - -struct marker_block -{ - /* Place `markers' first, to preserve alignment. */ - union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE]; - struct marker_block *next; -}; - -static struct marker_block *marker_block; -static int marker_block_index = MARKER_BLOCK_SIZE; - -static union Lisp_Misc *misc_free_list; - -/* Return a newly allocated Lisp_Misc object of specified TYPE. */ - -static Lisp_Object -allocate_misc (enum Lisp_Misc_Type type) -{ - Lisp_Object val; - - MALLOC_BLOCK_INPUT; - - if (misc_free_list) - { - XSETMISC (val, misc_free_list); - misc_free_list = misc_free_list->u_free.chain; - } - else - { - if (marker_block_index == MARKER_BLOCK_SIZE) - { - struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC); - new->next = marker_block; - marker_block = new; - marker_block_index = 0; - total_free_markers += MARKER_BLOCK_SIZE; - } - XSETMISC (val, &marker_block->markers[marker_block_index].m); - marker_block_index++; - } - - MALLOC_UNBLOCK_INPUT; - - --total_free_markers; - consing_since_gc += sizeof (union Lisp_Misc); - misc_objects_consed++; - XMISCANY (val)->type = type; - XMISCANY (val)->gcmarkbit = 0; - return val; -} - Lisp_Object make_misc_ptr (void *a) { - Lisp_Object val = allocate_misc (Lisp_Misc_Ptr); - XUNTAG (val, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer = a; - return val; + struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr, pointer, + PVEC_MISC_PTR); + p->pointer = a; + return make_lisp_ptr (p, Lisp_Vectorlike); } -/* 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) { - register Lisp_Object overlay; - - overlay = allocate_misc (Lisp_Misc_Overlay); + struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next, + PVEC_OVERLAY); + Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike); OVERLAY_START (overlay) = start; OVERLAY_END (overlay) = end; set_overlay_plist (overlay, plist); - XOVERLAY (overlay)->next = NULL; + p->next = NULL; return overlay; } @@ -3747,18 +3697,15 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { - register Lisp_Object val; - register struct Lisp_Marker *p; - - val = allocate_misc (Lisp_Misc_Marker); - p = XMARKER (val); + struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, + PVEC_MARKER); p->buffer = 0; p->bytepos = 0; p->charpos = 0; p->next = NULL; p->insertion_type = 0; p->need_adjustment = 0; - return val; + return make_lisp_ptr (p, Lisp_Vectorlike); } /* Return a newly allocated marker which points into BUF @@ -3767,17 +3714,14 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, Lisp_Object build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) { - Lisp_Object obj; - struct Lisp_Marker *m; - /* No dead buffers here. */ eassert (BUFFER_LIVE_P (buf)); /* Every character is at least one byte. */ eassert (charpos <= bytepos); - obj = allocate_misc (Lisp_Misc_Marker); - m = XMARKER (obj); + struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, + PVEC_MARKER); m->buffer = buf; m->charpos = charpos; m->bytepos = bytepos; @@ -3785,7 +3729,7 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) m->need_adjustment = 0; m->next = BUF_MARKERS (buf); BUF_MARKERS (buf) = m; - return obj; + return make_lisp_ptr (m, Lisp_Vectorlike); } @@ -3793,16 +3737,12 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) Lisp_Object make_bignum_str (const char *num, int base) { - Lisp_Object obj; - struct Lisp_Bignum *b; - int check; - - obj = allocate_misc (Lisp_Misc_Bignum); - b = XBIGNUM (obj); + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); mpz_init (b->value); - check = mpz_set_str (b->value, num, base); + int check = mpz_set_str (b->value, num, base); eassert (check == 0); - return obj; + return make_lisp_ptr (b, Lisp_Vectorlike); } /* Given an mpz_t, make a number. This may return a bignum or a @@ -3811,17 +3751,11 @@ make_bignum_str (const char *num, int base) Lisp_Object make_number (mpz_t value) { - Lisp_Object obj; - struct Lisp_Bignum *b; - if (mpz_fits_slong_p (value)) { long l = mpz_get_si (value); if (!FIXNUM_OVERFLOW_P (l)) - { - XSETINT (obj, l); - return obj; - } + return make_fixnum (l); } /* Check if fixnum can be larger than long. */ @@ -3845,20 +3779,17 @@ make_number (mpz_t value) v = -v; if (!FIXNUM_OVERFLOW_P (v)) - { - XSETINT (obj, v); - return obj; - } + return make_fixnum (v); } } - obj = allocate_misc (Lisp_Misc_Bignum); - b = XBIGNUM (obj); + struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, + PVEC_BIGNUM); /* We could mpz_init + mpz_swap here, to avoid a copy, but the resulting API seemed possibly confusing. */ mpz_init_set (b->value, value); - return obj; + return make_lisp_ptr (b, Lisp_Vectorlike); } void @@ -3934,14 +3865,11 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p) { - Lisp_Object obj; - struct Lisp_User_Ptr *uptr; - - obj = allocate_misc (Lisp_Misc_User_Ptr); - uptr = XUSER_PTR (obj); + struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr, + finalizer, PVEC_USER_PTR); uptr->finalizer = finalizer; uptr->p = p; - return obj; + return make_lisp_ptr (uptr, Lisp_Vectorlike); } #endif @@ -3984,7 +3912,7 @@ mark_finalizer_list (struct Lisp_Finalizer *head) finalizer != head; finalizer = finalizer->next) { - finalizer->base.gcmarkbit = true; + VECTOR_MARK (finalizer); mark_object (finalizer->function); } } @@ -4001,7 +3929,7 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest, while (finalizer != src) { struct Lisp_Finalizer *next = finalizer->next; - if (!finalizer->base.gcmarkbit && !NILP (finalizer->function)) + if (!VECTOR_MARKED_P (finalizer) && !NILP (finalizer->function)) { unchain_finalizer (finalizer); finalizer_insert (dest, finalizer); @@ -4037,7 +3965,6 @@ run_finalizers (struct Lisp_Finalizer *finalizers) while (finalizers->next != finalizers) { finalizer = finalizers->next; - eassert (finalizer->base.type == Lisp_Misc_Finalizer); unchain_finalizer (finalizer); function = finalizer->function; if (!NILP (function)) @@ -4057,12 +3984,12 @@ count as reachable for the purpose of deciding whether to run FUNCTION. FUNCTION will be run once per finalizer object. */) (Lisp_Object function) { - Lisp_Object val = allocate_misc (Lisp_Misc_Finalizer); - struct Lisp_Finalizer *finalizer = XFINALIZER (val); + struct Lisp_Finalizer *finalizer + = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER); finalizer->function = function; finalizer->prev = finalizer->next = NULL; finalizer_insert (&finalizers, finalizer); - return val; + return make_lisp_ptr (finalizer, Lisp_Vectorlike); } @@ -4683,41 +4610,6 @@ live_float_p (struct mem_node *m, void *p) return 0; } - -/* If P is a pointer to a live Lisp Misc on the heap, return the object. - Otherwise, return nil. M is a pointer to the mem_block for P. */ - -static Lisp_Object -live_misc_holding (struct mem_node *m, void *p) -{ - if (m->type == MEM_TYPE_MISC) - { - struct marker_block *b = m->start; - char *cp = p; - ptrdiff_t offset = cp - (char *) &b->markers[0]; - - /* P must point into a Lisp_Misc, not be - one of the unused cells in the current misc block, - and not be on the free-list. */ - if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0] - && (b != marker_block - || offset / sizeof b->markers[0] < marker_block_index)) - { - cp = ptr_bounds_copy (cp, b); - union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0]; - if (s->u_any.type != Lisp_Misc_Free) - return make_lisp_ptr (s, Lisp_Misc); - } - } - return Qnil; -} - -static bool -live_misc_p (struct mem_node *m, void *p) -{ - return !NILP (live_misc_holding (m, p)); -} - /* If P is a pointer to a live vector-like object, return the object. Otherwise, return nil. M is a pointer to the mem_block for P. */ @@ -4836,10 +4728,6 @@ mark_maybe_object (Lisp_Object obj) || EQ (obj, live_buffer_holding (m, po))); break; - case Lisp_Misc: - mark_p = EQ (obj, live_misc_holding (m, po)); - break; - default: break; } @@ -4921,10 +4809,6 @@ mark_maybe_pointer (void *p) obj = live_string_holding (m, p); break; - case MEM_TYPE_MISC: - obj = live_misc_holding (m, p); - break; - case MEM_TYPE_SYMBOL: obj = live_symbol_holding (m, p); break; @@ -5325,9 +5209,6 @@ valid_lisp_object_p (Lisp_Object obj) case MEM_TYPE_STRING: return live_string_p (m, p); - case MEM_TYPE_MISC: - return live_misc_p (m, p); - case MEM_TYPE_SYMBOL: return live_symbol_p (m, p); @@ -5550,14 +5431,13 @@ make_pure_float (double num) static Lisp_Object make_pure_bignum (struct Lisp_Bignum *value) { - Lisp_Object new; size_t i, nlimbs = mpz_size (value->value); size_t nbytes = nlimbs * sizeof (mp_limb_t); mp_limb_t *pure_limbs; mp_size_t new_size; - struct Lisp_Bignum *b = pure_alloc (sizeof (struct Lisp_Bignum), Lisp_Misc); - b->type = Lisp_Misc_Bignum; + struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike); + XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum)); pure_limbs = pure_alloc (nbytes, -1); for (i = 0; i < nlimbs; ++i) @@ -5569,8 +5449,7 @@ make_pure_bignum (struct Lisp_Bignum *value) mpz_roinit_n (b->value, pure_limbs, new_size); - XSETMISC (new, b); - return new; + return make_lisp_ptr (b, Lisp_Vectorlike); } /* Return a vector with room for LEN Lisp_Objects allocated from @@ -5777,7 +5656,6 @@ total_bytes_of_live_objects (void) size_t tot = 0; tot += total_conses * sizeof (struct Lisp_Cons); tot += total_symbols * sizeof (struct Lisp_Symbol); - tot += total_markers * sizeof (union Lisp_Misc); tot += total_string_bytes; tot += total_vector_slots * word_size; tot += total_floats * sizeof (struct Lisp_Float); @@ -5898,7 +5776,7 @@ compact_undo_list (Lisp_Object list) { if (CONSP (XCAR (tail)) && MARKERP (XCAR (XCAR (tail))) - && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) + && !VECTOR_MARKED_P (XMARKER (XCAR (XCAR (tail))))) *prev = XCDR (tail); else prev = xcdr_addr (tail); @@ -6125,9 +6003,6 @@ garbage_collect_1 (void *end) list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)), bounded_number (total_symbols), bounded_number (total_free_symbols)), - list4 (Qmiscs, make_fixnum (sizeof (union Lisp_Misc)), - bounded_number (total_markers), - bounded_number (total_free_markers)), list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)), bounded_number (total_strings), bounded_number (total_free_strings)), @@ -6314,12 +6189,12 @@ mark_compiled (struct Lisp_Vector *ptr) static void mark_overlay (struct Lisp_Overlay *ptr) { - for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) + for (; ptr && !VECTOR_MARKED_P (ptr); ptr = ptr->next) { - ptr->gcmarkbit = 1; + VECTOR_MARK (ptr); /* These two are always markers and can be marked fast. */ - XMARKER (ptr->start)->gcmarkbit = 1; - XMARKER (ptr->end)->gcmarkbit = 1; + VECTOR_MARK (XMARKER (ptr->start)); + VECTOR_MARK (XMARKER (ptr->end)); mark_object (ptr->plist); } } @@ -6620,9 +6495,26 @@ mark_object (Lisp_Object arg) mark_char_table (ptr, (enum pvec_type) pvectype); break; + case PVEC_MARKER: + /* DO NOT mark thru the marker's chain. + The buffer's markers chain does not preserve markers from gc; + instead, markers are removed from the chain when freed by gc. */ case PVEC_BOOL_VECTOR: - /* No Lisp_Objects to mark in a bool vector. */ + case PVEC_MISC_PTR: +#ifdef HAVE_MODULES + case PVEC_USER_PTR: +#endif + /* No Lisp_Objects to mark in these. */ + VECTOR_MARK (ptr); + break; + + case PVEC_OVERLAY: + mark_overlay (XOVERLAY (obj)); + break; + + case PVEC_FINALIZER: VECTOR_MARK (ptr); + mark_object (XFINALIZER (obj)->function); break; case PVEC_SUBR: @@ -6680,49 +6572,9 @@ mark_object (Lisp_Object arg) } break; - case Lisp_Misc: - CHECK_ALLOCATED_AND_LIVE (live_misc_p); - - if (XMISCANY (obj)->gcmarkbit) - break; - - switch (XMISCTYPE (obj)) - { - case Lisp_Misc_Marker: - /* DO NOT mark thru the marker's chain. - The buffer's markers chain does not preserve markers from gc; - instead, markers are removed from the chain when freed by gc. */ - XMISCANY (obj)->gcmarkbit = 1; - break; - - case Lisp_Misc_Ptr: - case Lisp_Misc_Bignum: - XMISCANY (obj)->gcmarkbit = true; - break; - - case Lisp_Misc_Overlay: - mark_overlay (XOVERLAY (obj)); - break; - - case Lisp_Misc_Finalizer: - XMISCANY (obj)->gcmarkbit = true; - mark_object (XFINALIZER (obj)->function); - break; - -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - XMISCANY (obj)->gcmarkbit = true; - break; -#endif - - default: - emacs_abort (); - } - break; - case Lisp_Cons: { - register struct Lisp_Cons *ptr = XCONS (obj); + struct Lisp_Cons *ptr = XCONS (obj); if (CONS_MARKED_P (ptr)) break; CHECK_ALLOCATED_AND_LIVE (live_cons_p); @@ -6799,10 +6651,6 @@ survives_gc_p (Lisp_Object obj) survives_p = XSYMBOL (obj)->u.s.gcmarkbit; break; - case Lisp_Misc: - survives_p = XMISCANY (obj)->gcmarkbit; - break; - case Lisp_String: survives_p = STRING_MARKED_P (XSTRING (obj)); break; @@ -7079,81 +6927,6 @@ sweep_symbols (void) total_free_symbols = num_free; } -NO_INLINE /* For better stack traces. */ -static void -sweep_misc (void) -{ - register struct marker_block *mblk; - struct marker_block **mprev = &marker_block; - register int lim = marker_block_index; - EMACS_INT num_free = 0, num_used = 0; - - /* Put all unmarked misc's on free list. For a marker, first - unchain it from the buffer it points into. */ - - misc_free_list = 0; - - for (mblk = marker_block; mblk; mblk = *mprev) - { - register int i; - int this_free = 0; - - for (i = 0; i < lim; i++) - { - if (!mblk->markers[i].m.u_any.gcmarkbit) - { - if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker) - /* Make sure markers have been unchained from their buffer - in sweep_buffer before we collect them. */ - eassert (!mblk->markers[i].m.u_marker.buffer); - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer) - unchain_finalizer (&mblk->markers[i].m.u_finalizer); -#ifdef HAVE_MODULES - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr) - { - struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr; - if (uptr->finalizer) - uptr->finalizer (uptr->p); - } -#endif - else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum) - mpz_clear (mblk->markers[i].m.u_bignum.value); - /* Set the type of the freed object to Lisp_Misc_Free. - We could leave the type alone, since nobody checks it, - but this might catch bugs faster. */ - mblk->markers[i].m.u_marker.type = Lisp_Misc_Free; - mblk->markers[i].m.u_free.chain = misc_free_list; - misc_free_list = &mblk->markers[i].m; - this_free++; - } - else - { - num_used++; - mblk->markers[i].m.u_any.gcmarkbit = 0; - } - } - lim = MARKER_BLOCK_SIZE; - /* If this block contains only free markers and we have already - seen more than two blocks worth of free markers then deallocate - this block. */ - if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) - { - *mprev = mblk->next; - /* Unhook from the free list. */ - misc_free_list = mblk->markers[0].m.u_free.chain; - lisp_free (mblk); - } - else - { - num_free += this_free; - mprev = &mblk->next; - } - } - - total_markers = num_used; - total_free_markers = num_free; -} - /* Remove BUFFER's markers that are due to be swept. This is needed since we treat BUF_MARKERS and markers's `next' field as weak pointers. */ static void @@ -7162,7 +6935,7 @@ unchain_dead_markers (struct buffer *buffer) struct Lisp_Marker *this, **prev = &BUF_MARKERS (buffer); while ((this = *prev)) - if (this->gcmarkbit) + if (VECTOR_MARKED_P (this)) prev = &this->next; else { @@ -7210,7 +6983,6 @@ gc_sweep (void) sweep_intervals (); sweep_symbols (); sweep_buffers (); - sweep_misc (); sweep_vectors (); check_string_bytes (!noninteractive); } @@ -7585,7 +7357,6 @@ do hash-consing of the objects allocated to pure space. */); DEFSYM (Qconses, "conses"); DEFSYM (Qsymbols, "symbols"); - DEFSYM (Qmiscs, "miscs"); DEFSYM (Qstrings, "strings"); DEFSYM (Qvectors, "vectors"); DEFSYM (Qfloats, "floats"); diff --git a/src/buffer.c b/src/buffer.c index ec6f4647119..878844dd020 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2789,8 +2789,6 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req) { - Lisp_Object overlay, start, end; - struct Lisp_Overlay *tail; ptrdiff_t idx = 0; ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; @@ -2798,22 +2796,20 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, ptrdiff_t prev = BEGV; bool inhibit_storing = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (endpos < pos) { if (prev < endpos) prev = endpos; break; } - startpos = OVERLAY_POSITION (start); + ptrdiff_t startpos = OVERLAY_POSITION (start); /* This one ends at or after POS so its start counts for PREV_PTR if it's before POS. */ if (prev < startpos && startpos < pos) @@ -2846,22 +2842,20 @@ overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr, next = startpos; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (pos < startpos) { if (startpos < next) next = startpos; break; } - endpos = OVERLAY_POSITION (end); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (pos < endpos) { if (idx == len) @@ -2923,8 +2917,6 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr) { - Lisp_Object overlay, ostart, oend; - struct Lisp_Overlay *tail; ptrdiff_t idx = 0; ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; @@ -2933,22 +2925,20 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, bool inhibit_storing = 0; bool end_is_Z = end == Z; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - ostart = OVERLAY_START (overlay); - oend = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (oend); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object ostart = OVERLAY_START (overlay); + Lisp_Object oend = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (oend); if (endpos < beg) { if (prev < endpos) prev = endpos; break; } - startpos = OVERLAY_POSITION (ostart); + ptrdiff_t startpos = OVERLAY_POSITION (ostart); /* Count an interval if it overlaps the range, is empty at the start of the range, or is empty at END provided END denotes the end of the buffer. */ @@ -2980,22 +2970,20 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, next = startpos; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos, endpos; - - XSETMISC (overlay, tail); - - ostart = OVERLAY_START (overlay); - oend = OVERLAY_END (overlay); - startpos = OVERLAY_POSITION (ostart); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object ostart = OVERLAY_START (overlay); + Lisp_Object oend = OVERLAY_END (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (ostart); if (end < startpos) { if (startpos < next) next = startpos; break; } - endpos = OVERLAY_POSITION (oend); + ptrdiff_t endpos = OVERLAY_POSITION (oend); /* Count an interval if it overlaps the range, is empty at the start of the range, or is empty at END provided END denotes the end of the buffer. */ @@ -3097,31 +3085,26 @@ disable_line_numbers_overlay_at_eob (void) bool overlay_touches_p (ptrdiff_t pos) { - Lisp_Object overlay; - struct Lisp_Overlay *tail; - - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t endpos; - - XSETMISC (overlay ,tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos) return 1; } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos; - - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (pos < startpos) break; if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos) @@ -3337,27 +3320,26 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, ptrdiff_t overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) { - Lisp_Object overlay, window, str; - struct Lisp_Overlay *ov; - ptrdiff_t startpos, endpos; bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; - for (ov = current_buffer->overlays_before; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_before; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; 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; + Lisp_Object str; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, @@ -3372,20 +3354,22 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) Foverlay_get (overlay, Qpriority), endpos - startpos); } - for (ov = current_buffer->overlays_after; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_after; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + 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; - window = Foverlay_get (overlay, Qwindow); + 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, @@ -3460,8 +3444,7 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr) void recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) { - Lisp_Object overlay, beg, end; - struct Lisp_Overlay *prev, *tail, *next; + struct Lisp_Overlay *prev, *next; /* See if anything in overlays_before should move to overlays_after. */ @@ -3469,14 +3452,15 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) But we use it for symmetry and in case that should cease to be true with some future change. */ prev = NULL; - for (tail = buf->overlays_before; tail; prev = tail, tail = next) + for (struct Lisp_Overlay *tail = buf->overlays_before; + tail; prev = tail, tail = next) { next = tail->next; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - beg = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); + Lisp_Object beg = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) > pos) { @@ -3495,12 +3479,10 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) for (other = buf->overlays_after; other; other_prev = other, other = other->next) { - Lisp_Object otherbeg, otheroverlay; - - XSETMISC (otheroverlay, other); + Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike); eassert (OVERLAYP (otheroverlay)); - otherbeg = OVERLAY_START (otheroverlay); + Lisp_Object otherbeg = OVERLAY_START (otheroverlay); if (OVERLAY_POSITION (otherbeg) >= where) break; } @@ -3522,14 +3504,15 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) /* See if anything in overlays_after should be in overlays_before. */ prev = NULL; - for (tail = buf->overlays_after; tail; prev = tail, tail = next) + for (struct Lisp_Overlay *tail = buf->overlays_after; + tail; prev = tail, tail = next) { next = tail->next; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - beg = OVERLAY_START (overlay); - end = OVERLAY_END (overlay); + Lisp_Object beg = OVERLAY_START (overlay); + Lisp_Object end = OVERLAY_END (overlay); /* Stop looking, when we know that nothing further can possibly end before POS. */ @@ -3553,12 +3536,10 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) for (other = buf->overlays_before; other; other_prev = other, other = other->next) { - Lisp_Object otherend, otheroverlay; - - XSETMISC (otheroverlay, other); + Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike); eassert (OVERLAYP (otheroverlay)); - otherend = OVERLAY_END (otheroverlay); + Lisp_Object otherend = OVERLAY_END (otheroverlay); if (OVERLAY_POSITION (otherend) <= where) break; } @@ -3613,7 +3594,6 @@ adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length) void fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) { - Lisp_Object overlay; struct Lisp_Overlay *before_list UNINIT; struct Lisp_Overlay *after_list UNINIT; /* These are either nil, indicating that before_list or after_list @@ -3623,8 +3603,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) /* 'Parent', likewise, indicates a cons cell or current_buffer->overlays_before or overlays_after, depending which loop we're in. */ - struct Lisp_Overlay *tail, *parent; - ptrdiff_t startpos, endpos; + struct Lisp_Overlay *parent; /* This algorithm shifts links around instead of consing and GCing. The loop invariant is that before_list (resp. after_list) is a @@ -3633,12 +3612,14 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) (after_list) if it is, is still uninitialized. So it's not a bug that before_list isn't initialized, although it may look strange. */ - for (parent = NULL, tail = current_buffer->overlays_before; tail;) + parent = NULL; + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); /* If the overlay is backwards, make it empty. */ if (endpos < startpos) @@ -3676,17 +3657,18 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) set_buffer_overlays_before (current_buffer, tail->next); else parent->next = tail->next; - tail = tail->next; } else - parent = tail, tail = parent->next; + parent = tail; } - for (parent = NULL, tail = current_buffer->overlays_after; tail;) + parent = NULL; + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); /* If the overlay is backwards, make it empty. */ if (endpos < startpos) @@ -3722,10 +3704,9 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) set_buffer_overlays_after (current_buffer, tail->next); else parent->next = tail->next; - tail = tail->next; } else - parent = tail, tail = parent->next; + parent = tail; } /* Splice the constructed (wrong) lists into the buffer's lists, @@ -3776,7 +3757,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) overlay whose ending marker is after-insertion-marker if disorder exists). */ while (tail - && (XSETMISC (tem, tail), + && (tem = make_lisp_ptr (tail, Lisp_Vectorlike), (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos)) { parent = tail; @@ -3801,7 +3782,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) overlays are in correct order. */ while (tail) { - XSETMISC (tem, tail); + tem = make_lisp_ptr (tail, Lisp_Vectorlike); end = OVERLAY_POSITION (OVERLAY_END (tem)); if (end == pos) @@ -4308,19 +4289,14 @@ The lists you get are copies, so that changing them has no effect. However, the overlays you get are the real objects that the buffer uses. */) (void) { - struct Lisp_Overlay *ol; - Lisp_Object before = Qnil, after = Qnil, tmp; + Lisp_Object before = Qnil, after = Qnil; - for (ol = current_buffer->overlays_before; ol; ol = ol->next) - { - XSETMISC (tmp, ol); - before = Fcons (tmp, before); - } - for (ol = current_buffer->overlays_after; ol; ol = ol->next) - { - XSETMISC (tmp, ol); - after = Fcons (tmp, after); - } + for (struct Lisp_Overlay *ol = current_buffer->overlays_before; + ol; ol = ol->next) + before = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), before); + for (struct Lisp_Overlay *ol = current_buffer->overlays_after; + ol; ol = ol->next) + after = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), after); return Fcons (Fnreverse (before), Fnreverse (after)); } @@ -4439,14 +4415,9 @@ void report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) { - Lisp_Object prop, overlay; - struct Lisp_Overlay *tail; /* True if this change is an insertion. */ bool insertion = (after ? XFIXNAT (arg3) == 0 : EQ (start, end)); - overlay = Qnil; - tail = NULL; - /* We used to run the functions as soon as we found them and only register them in last_overlay_modification_hooks for the purpose of the `after' case. But running elisp code as we traverse the list of overlays is @@ -4460,12 +4431,13 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, /* We are being called before a change. Scan the overlays to find the functions to call. */ last_overlay_modification_hooks_used = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { ptrdiff_t startpos, endpos; Lisp_Object ostart, oend; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); @@ -4476,14 +4448,14 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, if (insertion && (XFIXNAT (start) == startpos || XFIXNAT (end) == startpos)) { - 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)) { - 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); } @@ -4491,18 +4463,19 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, for both insertion and deletion. */ if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { - prop = Foverlay_get (overlay, Qmodification_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { ptrdiff_t startpos, endpos; Lisp_Object ostart, oend; - XSETMISC (overlay, tail); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); @@ -4513,14 +4486,14 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, if (insertion && (XFIXNAT (start) == startpos || XFIXNAT (end) == startpos)) { - 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)) { - 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); } @@ -4528,7 +4501,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, for both insertion and deletion. */ if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos) { - prop = Foverlay_get (overlay, Qmodification_hooks); + Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) add_overlay_mod_hooklist (prop, overlay); } @@ -4596,16 +4569,13 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after, void evaporate_overlays (ptrdiff_t pos) { - Lisp_Object overlay, hit_list; - struct Lisp_Overlay *tail; - - hit_list = Qnil; + Lisp_Object hit_list = Qnil; if (pos <= current_buffer->overlay_center) - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - ptrdiff_t endpos; - XSETMISC (overlay, tail); - endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos @@ -4613,11 +4583,11 @@ evaporate_overlays (ptrdiff_t pos) hit_list = Fcons (overlay, hit_list); } else - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - ptrdiff_t startpos; - XSETMISC (overlay, tail); - startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (startpos > pos) break; if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos diff --git a/src/data.c b/src/data.c index 7d701fde0e2..c8a9c6b3783 100644 --- a/src/data.c +++ b/src/data.c @@ -221,29 +221,17 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Cons: return Qcons; - case Lisp_Misc: - switch (XMISCTYPE (object)) - { - case Lisp_Misc_Marker: - return Qmarker; - case Lisp_Misc_Overlay: - return Qoverlay; - case Lisp_Misc_Finalizer: - return Qfinalizer; -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - return Quser_ptr; -#endif - case Lisp_Misc_Bignum: - return Qinteger; - default: - emacs_abort (); - } - case Lisp_Vectorlike: switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; + case PVEC_BIGNUM: return Qinteger; + case PVEC_MARKER: return Qmarker; + case PVEC_OVERLAY: return Qoverlay; + case PVEC_FINALIZER: return Qfinalizer; +#ifdef HAVE_MODULES + case PVEC_USER_PTR: return Quser_ptr; +#endif case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; @@ -279,6 +267,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_MODULE_FUNCTION: return Qmodule_function; /* "Impossible" cases. */ + case PVEC_MISC_PTR: case PVEC_XWIDGET: case PVEC_OTHER: case PVEC_XWIDGET_VIEW: diff --git a/src/editfns.c b/src/editfns.c index a0a66bd19ab..92566fe3bbe 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -484,21 +484,18 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) static ptrdiff_t overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len) { - Lisp_Object overlay, start, end; - struct Lisp_Overlay *tail; - ptrdiff_t startpos, endpos; ptrdiff_t idx = 0; - for (tail = current_buffer->overlays_before; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_before; + tail; tail = tail->next) { - XSETMISC (overlay, tail); - - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (endpos < pos) break; - start = OVERLAY_START (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object start = OVERLAY_START (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (startpos <= pos) { if (idx < len) @@ -508,16 +505,16 @@ overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len) } } - for (tail = current_buffer->overlays_after; tail; tail = tail->next) + for (struct Lisp_Overlay *tail = current_buffer->overlays_after; + tail; tail = tail->next) { - XSETMISC (overlay, tail); - - start = OVERLAY_START (overlay); - startpos = OVERLAY_POSITION (start); + Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike); + Lisp_Object start = OVERLAY_START (overlay); + ptrdiff_t startpos = OVERLAY_POSITION (start); if (pos < startpos) break; - end = OVERLAY_END (overlay); - endpos = OVERLAY_POSITION (end); + Lisp_Object end = OVERLAY_END (overlay); + ptrdiff_t endpos = OVERLAY_POSITION (end); if (pos <= endpos) { if (idx < len) diff --git a/src/fns.c b/src/fns.c index 825880643ac..ac5edc2cdbd 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2287,7 +2287,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, ht = CALLN (Fmake_hash_table, QCtest, Qeq); switch (XTYPE (o1)) { - case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike: + case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); EMACS_UINT hash; @@ -2344,31 +2344,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, depth++; goto tail_recurse; - case Lisp_Misc: - if (XMISCTYPE (o1) != XMISCTYPE (o2)) - return false; - if (OVERLAYP (o1)) - { - 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)) - return false; - o1 = XOVERLAY (o1)->plist; - o2 = XOVERLAY (o2)->plist; - depth++; - goto tail_recurse; - } - if (MARKERP (o1)) - { - return (XMARKER (o1)->buffer == XMARKER (o2)->buffer - && (XMARKER (o1)->buffer == 0 - || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); - } - if (BIGNUMP (o1)) - return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; - break; - case Lisp_Vectorlike: { register int i; @@ -2378,6 +2353,26 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, same size. */ if (ASIZE (o2) != size) return false; + if (BIGNUMP (o1)) + return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; + if (OVERLAYP (o1)) + { + 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)) + return false; + o1 = XOVERLAY (o1)->plist; + o2 = XOVERLAY (o2)->plist; + depth++; + goto tail_recurse; + } + if (MARKERP (o1)) + { + return (XMARKER (o1)->buffer == XMARKER (o2)->buffer + && (XMARKER (o1)->buffer == 0 + || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); + } /* Boolvectors are compared much like strings. */ if (BOOL_VECTOR_P (o1)) { @@ -4477,13 +4472,6 @@ sxhash (Lisp_Object obj, int depth) hash = XUFIXNUM (obj); break; - case Lisp_Misc: - if (XMISCTYPE (obj) == Lisp_Misc_Bignum) - { - hash = sxhash_bignum (XBIGNUM (obj)); - break; - } - FALLTHROUGH; case Lisp_Symbol: hash = XHASH (obj); break; @@ -4494,7 +4482,9 @@ sxhash (Lisp_Object obj, int depth) /* This can be everything from a vector to an overlay. */ case Lisp_Vectorlike: - if (VECTORP (obj) || RECORDP (obj)) + if (BIGNUMP (obj)) + hash = sxhash_bignum (XBIGNUM (obj)); + else 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 diff --git a/src/lisp.h b/src/lisp.h index 6ca34168928..c080cc6b146 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,8 +365,6 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) #define lisp_h_FIXNUMP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) -#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ @@ -430,8 +428,6 @@ typedef EMACS_INT Lisp_Word; # define EQ(x, y) lisp_h_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) -# define MARKERP(x) lisp_h_MARKERP (x) -# define MISCP(x) lisp_h_MISCP (x) # define NILP(x) lisp_h_NILP (x) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) @@ -482,11 +478,9 @@ enum Lisp_Type /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol = 0, - /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, - whose first member indicates the subtype. */ - Lisp_Misc = 1, + /* Type 1 is currently unused. */ - /* Integer. XFIXNUM (obj) is the integer value. */ + /* Fixnum. XFIXNUM (obj) is the integer value. */ Lisp_Int0 = 2, Lisp_Int1 = USE_LSB_TAG ? 6 : 3, @@ -506,26 +500,6 @@ enum Lisp_Type Lisp_Float = 7 }; -/* This is the set of data types that share a common structure. - The first member of the structure is a type code from this set. - The enum values are arbitrary, but we'll use large numbers to make it - more likely that we'll spot the error if a random word in memory is - mistakenly interpreted as a Lisp_Misc. */ -enum Lisp_Misc_Type - { - Lisp_Misc_Free = 0x5eab, - Lisp_Misc_Marker, - Lisp_Misc_Overlay, - Lisp_Misc_Finalizer, - Lisp_Misc_Ptr, -#ifdef HAVE_MODULES - Lisp_Misc_User_Ptr, -#endif - Lisp_Misc_Bignum, - /* This is not a type code. It is for range checking. */ - Lisp_Misc_Limit - }; - /* These are the types of forwarding objects used in the value slot of symbols for special built-in variables whose value is stored in C variables. */ @@ -539,14 +513,12 @@ enum Lisp_Fwd_Type }; /* If you want to define a new Lisp data type, here are some - instructions. See the thread at - https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html - for more info. + instructions. First, there are already a couple of Lisp types that can be used if your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc - subtype; and PVEC_OTHER, a kind of vectorlike object. The former + displayed to users. These are Lisp_Misc_Ptr and PVEC_OTHER, + which are both vectorlike objects. The former is suitable for stashing a pointer in a Lisp object; the pointer might be to some low-level C object that contains auxiliary information. The latter is useful for vector-like Lisp objects @@ -557,30 +529,14 @@ enum Lisp_Fwd_Type These two types don't look pretty when printed, so they are unsuitable for Lisp objects that can be exposed to users. - To define a new data type, add one more Lisp_Misc subtype or one - more pseudovector subtype. Pseudovectors are more suitable for - objects with several slots that need to support fast random access, - while Lisp_Misc types are for everything else. A pseudovector object - provides one or more slots for Lisp objects, followed by struct - members that are accessible only from C. A Lisp_Misc object is a - wrapper for a C struct that can contain anything you like. + To define a new data type, add a pseudovector subtype by extending + the pvec_type enumeration. A pseudovector provides one or more + slots for Lisp objects, followed by struct members that are + accessible only from C. There is no way to explicitly free a Lisp Object; only the garbage collector frees them. - To add a new pseudovector type, extend the pvec_type enumeration; - to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. - - For a Lisp_Misc, you will also need to add your entry to union - Lisp_Misc, but make sure the first word has the same structure as - the others, starting with a 16-bit member of the Lisp_Misc_Type - enumeration and a 1-bit GC markbit. Also make sure the overall - size of the union is not increased by your addition. The latter - requirement is to keep Lisp_Misc objects small enough, so they - are handled faster: since all Lisp_Misc types use the same space, - enlarging any of them will affect all the rest. If you really - need a larger object, it is best to use Lisp_Vectorlike instead. - For a new pseudovector, it's highly desirable to limit the size of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c). Otherwise you will need to change sweep_vectors (also in alloc.c). @@ -973,6 +929,14 @@ enum pvec_type { PVEC_NORMAL_VECTOR, PVEC_FREE, + PVEC_BIGNUM, + PVEC_MARKER, + PVEC_OVERLAY, + PVEC_FINALIZER, + PVEC_MISC_PTR, +#ifdef HAVE_MODULES + PVEC_USER_PTR, +#endif PVEC_PROCESS, PVEC_FRAME, PVEC_WINDOW, @@ -1173,7 +1137,6 @@ INLINE bool #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) -#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) /* Pseudovector types. */ @@ -2273,46 +2236,10 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } -/* These structures are used for various misc types. */ - -struct Lisp_Misc_Any /* Supertype of all Misc types. */ -{ - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; -}; - -INLINE bool -(MISCP) (Lisp_Object x) -{ - return lisp_h_MISCP (x); -} - -INLINE struct Lisp_Misc_Any * -XMISCANY (Lisp_Object a) -{ - eassert (MISCP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Any); -} - -INLINE enum Lisp_Misc_Type -XMISCTYPE (Lisp_Object a) -{ - return XMISCANY (a)->type; -} - struct Lisp_Marker { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ - bool_bf gcmarkbit : 1; - unsigned spacer : 13; - /* This flag is temporarily used in the functions - decode/encode_coding_object to record that the marker position - must be adjusted after the conversion. */ - bool_bf need_adjustment : 1; - /* True means normal insertion at the marker's position - leaves the marker after the inserted text. */ - bool_bf insertion_type : 1; + union vectorlike_header header; + /* This is the buffer that the marker points into, or 0 if it points nowhere. Note: a chain of markers can contain markers pointing into different buffers (the chain is per buffer_text rather than per buffer, so it's @@ -2325,6 +2252,14 @@ struct Lisp_Marker */ struct buffer *buffer; + /* This flag is temporarily used in the functions + decode/encode_coding_object to record that the marker position + must be adjusted after the conversion. */ + bool_bf need_adjustment : 1; + /* True means normal insertion at the marker's position + leaves the marker after the inserted text. */ + bool_bf insertion_type : 1; + /* The remaining fields are meaningless in a marker that does not point anywhere. */ @@ -2357,20 +2292,16 @@ struct Lisp_Overlay 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; - struct Lisp_Overlay *next; + union vectorlike_header header; Lisp_Object start; Lisp_Object end; Lisp_Object plist; + struct Lisp_Overlay *next; }; struct Lisp_Misc_Ptr { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; + union vectorlike_header header; void *pointer; }; @@ -2388,7 +2319,7 @@ extern Lisp_Object make_misc_ptr (void *); 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 Lisp_Misc object instead; see + object you can put the pointer into a pseudovector instead; see Lisp_User_Ptr for an example. */ INLINE Lisp_Object @@ -2401,7 +2332,7 @@ make_mint_ptr (void *a) INLINE bool mint_ptrp (Lisp_Object x) { - return FIXNUMP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); + return FIXNUMP (x) || PSEUDOVECTORP (x, PVEC_MISC_PTR); } INLINE void * @@ -2410,16 +2341,13 @@ xmint_pointer (Lisp_Object a) eassert (mint_ptrp (a)); if (FIXNUMP (a)) return XFIXNUMPTR (a); - return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer; + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } #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; }; @@ -2428,123 +2356,89 @@ struct Lisp_User_Ptr /* A finalizer sentinel. */ struct Lisp_Finalizer { - struct Lisp_Misc_Any base; - - /* Circular list of all active weak references. */ - struct Lisp_Finalizer *prev; - struct Lisp_Finalizer *next; + union vectorlike_header header; /* Call FUNCTION when the finalizer becomes unreachable, even if FUNCTION contains a reference to the finalizer; i.e., call FUNCTION when it is reachable _only_ through finalizers. */ Lisp_Object function; + + /* Circular list of all active weak references. */ + struct Lisp_Finalizer *prev; + struct Lisp_Finalizer *next; }; INLINE bool FINALIZERP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; + return PSEUDOVECTORP (x, PVEC_FINALIZER); } INLINE struct Lisp_Finalizer * XFINALIZER (Lisp_Object a) { eassert (FINALIZERP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Finalizer); -} - -/* A miscellaneous object, when it's on the free list. */ -struct Lisp_Free - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - union Lisp_Misc *chain; - }; - -struct Lisp_Bignum - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Bignum */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - mpz_t value; - }; - -/* To get the type field of a union Lisp_Misc, use XMISCTYPE. - It uses one of these struct subtypes to get the type field. */ - -union Lisp_Misc - { - struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ - struct Lisp_Free u_free; - struct Lisp_Marker u_marker; - struct Lisp_Overlay u_overlay; - struct Lisp_Finalizer u_finalizer; - struct Lisp_Misc_Ptr u_misc_ptr; -#ifdef HAVE_MODULES - struct Lisp_User_Ptr u_user_ptr; -#endif - struct Lisp_Bignum u_bignum; - }; - -INLINE union Lisp_Misc * -XMISC (Lisp_Object a) -{ - return XUNTAG (a, Lisp_Misc, union Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Finalizer); } INLINE bool -(MARKERP) (Lisp_Object x) +MARKERP (Lisp_Object x) { - return lisp_h_MARKERP (x); + return PSEUDOVECTORP (x, PVEC_MARKER); } INLINE struct Lisp_Marker * XMARKER (Lisp_Object a) { eassert (MARKERP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Marker); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Marker); } INLINE bool OVERLAYP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; + return PSEUDOVECTORP (x, PVEC_OVERLAY); } INLINE struct Lisp_Overlay * XOVERLAY (Lisp_Object a) { eassert (OVERLAYP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Overlay); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } #ifdef HAVE_MODULES INLINE bool USER_PTRP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; + return PSEUDOVECTORP (x, PVEC_USER_PTR); } INLINE struct Lisp_User_Ptr * XUSER_PTR (Lisp_Object a) { eassert (USER_PTRP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_User_Ptr); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr); } #endif +struct Lisp_Bignum +{ + union vectorlike_header header; + mpz_t value; +}; + INLINE bool BIGNUMP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Bignum; + return PSEUDOVECTORP (x, PVEC_BIGNUM); } INLINE struct Lisp_Bignum * XBIGNUM (Lisp_Object a) { eassert (BIGNUMP (a)); - return XUNTAG (a, Lisp_Misc, struct Lisp_Bignum); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum); } INLINE bool diff --git a/src/print.c b/src/print.c index 3819c505b12..824f8d75779 100644 --- a/src/print.c +++ b/src/print.c @@ -1367,6 +1367,76 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) { + case PVEC_BIGNUM: + { + struct Lisp_Bignum *b = XBIGNUM (obj); + char *str = mpz_get_str (NULL, 10, b->value); + record_unwind_protect_ptr (xfree, str); + print_c_string (str, printcharfun); + } + break; + + case PVEC_MARKER: + print_c_string ("#<marker ", printcharfun); + /* Do you think this is necessary? */ + if (XMARKER (obj)->insertion_type != 0) + print_c_string ("(moves after insertion) ", printcharfun); + if (! XMARKER (obj)->buffer) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); + } + printchar ('>', printcharfun); + break; + + case PVEC_OVERLAY: + print_c_string ("#<overlay ", printcharfun); + if (! XMARKER (OVERLAY_START (obj))->buffer) + 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))); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), + printcharfun); + } + printchar ('>', printcharfun); + break; + +#ifdef HAVE_MODULES + case PVEC_USER_PTR: + { + print_c_string ("#<user-ptr ", printcharfun); + int i = sprintf (buf, "ptr=%p finalizer=%p", + XUSER_PTR (obj)->p, + XUSER_PTR (obj)->finalizer); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; +#endif + + case PVEC_FINALIZER: + print_c_string ("#<finalizer", printcharfun); + if (NILP (XFINALIZER (obj)->function)) + print_c_string (" used", printcharfun); + printchar ('>', printcharfun); + break; + + case PVEC_MISC_PTR: + { + /* This shouldn't happen in normal usage, but let's + print it anyway for the benefit of the debugger. */ + int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + case PVEC_PROCESS: if (escapeflag) { @@ -2096,103 +2166,16 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) break; case Lisp_Vectorlike: - if (! print_vectorlike (obj, printcharfun, escapeflag, buf)) - goto badtype; - break; - - case Lisp_Misc: - switch (XMISCTYPE (obj)) - { - case Lisp_Misc_Marker: - print_c_string ("#<marker ", printcharfun); - /* Do you think this is necessary? */ - if (XMARKER (obj)->insertion_type != 0) - print_c_string ("(moves after insertion) ", printcharfun); - if (! XMARKER (obj)->buffer) - print_c_string ("in no buffer", printcharfun); - else - { - int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); - } - printchar ('>', printcharfun); - break; - - case Lisp_Misc_Overlay: - print_c_string ("#<overlay ", printcharfun); - if (! XMARKER (OVERLAY_START (obj))->buffer) - 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))); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), - printcharfun); - } - printchar ('>', printcharfun); - break; - -#ifdef HAVE_MODULES - case Lisp_Misc_User_Ptr: - { - print_c_string ("#<user-ptr ", printcharfun); - int i = sprintf (buf, "ptr=%p finalizer=%p", - XUSER_PTR (obj)->p, - XUSER_PTR (obj)->finalizer); - strout (buf, i, i, printcharfun); - printchar ('>', printcharfun); - break; - } -#endif - - case Lisp_Misc_Finalizer: - print_c_string ("#<finalizer", printcharfun); - if (NILP (XFINALIZER (obj)->function)) - print_c_string (" used", printcharfun); - printchar ('>', printcharfun); - break; - - /* Remaining cases shouldn't happen in normal usage, but let's - print them anyway for the benefit of the debugger. */ - - case Lisp_Misc_Free: - print_c_string ("#<misc free cell>", printcharfun); - break; - - case Lisp_Misc_Ptr: - { - int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj)); - strout (buf, i, i, printcharfun); - } - break; - - case Lisp_Misc_Bignum: - { - struct Lisp_Bignum *b = XBIGNUM (obj); - char *str = mpz_get_str (NULL, 10, b->value); - record_unwind_protect_ptr (xfree, str); - print_c_string (str, printcharfun); - } - break; - - default: - goto badtype; - } - break; - + if (print_vectorlike (obj, printcharfun, escapeflag, buf)) + break; + FALLTHROUGH; default: - badtype: { int len; /* We're in trouble if this happens! Probably should just emacs_abort (). */ print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun); - if (MISCP (obj)) - len = sprintf (buf, "(MISC 0x%04x)", (unsigned) XMISCTYPE (obj)); - else if (VECTORLIKEP (obj)) + if (VECTORLIKEP (obj)) len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj)); else len = sprintf (buf, "(0x%02x)", (unsigned) XTYPE (obj)); diff --git a/src/undo.c b/src/undo.c index e80ec58ab09..1975e387e3f 100644 --- a/src/undo.c +++ b/src/undo.c @@ -126,15 +126,11 @@ record_insert (ptrdiff_t beg, ptrdiff_t length) static void record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) { - Lisp_Object marker; - register struct Lisp_Marker *m; - register ptrdiff_t charpos, adjustment; - - prepare_record(); + prepare_record (); - for (m = BUF_MARKERS (current_buffer); m; m = m->next) + for (struct Lisp_Marker *m = BUF_MARKERS (current_buffer); m; m = m->next) { - charpos = m->charpos; + ptrdiff_t charpos = m->charpos; eassert (charpos <= Z); if (from <= charpos && charpos <= to) @@ -146,11 +142,11 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) insertion_type t markers will automatically move forward upon re-inserting the deleted text, so we have to arrange for them to move backward to the correct position. */ - adjustment = (m->insertion_type ? to : from) - charpos; + ptrdiff_t adjustment = (m->insertion_type ? to : from) - charpos; if (adjustment) { - XSETMISC (marker, m); + Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike); bset_undo_list (current_buffer, Fcons (Fcons (marker, make_fixnum (adjustment)), diff --git a/src/xdisp.c b/src/xdisp.c index 76fde99f323..0835ccafd4d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5819,11 +5819,7 @@ compare_overlay_entries (const void *e1, const void *e2) static void load_overlay_strings (struct it *it, ptrdiff_t charpos) { - Lisp_Object overlay, window, str, invisible; - struct Lisp_Overlay *ov; - ptrdiff_t start, end; - ptrdiff_t n = 0, i, j; - int invis; + ptrdiff_t n = 0; struct overlay_entry entriesbuf[20]; ptrdiff_t size = ARRAYELTS (entriesbuf); struct overlay_entry *entries = entriesbuf; @@ -5859,12 +5855,13 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) while (false) /* Process overlay before the overlay center. */ - for (ov = current_buffer->overlays_before; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_before; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - start = OVERLAY_POSITION (OVERLAY_START (overlay)); - end = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay)); if (end < charpos) break; @@ -5875,17 +5872,18 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) 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; /* 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); + 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)) @@ -5899,12 +5897,13 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) } /* Process overlays after the overlay center. */ - for (ov = current_buffer->overlays_after; ov; ov = ov->next) + for (struct Lisp_Overlay *ov = current_buffer->overlays_after; + ov; ov = ov->next) { - XSETMISC (overlay, ov); + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - start = OVERLAY_POSITION (OVERLAY_START (overlay)); - end = OVERLAY_POSITION (OVERLAY_END (overlay)); + ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay)); if (start > charpos) break; @@ -5915,16 +5914,17 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) 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; /* If the text ``under'' the overlay is invisible, it has a zero dimension, and both before- and after-strings apply. */ - invisible = Foverlay_get (overlay, Qinvisible); - invis = TEXT_PROP_MEANS_INVISIBLE (invisible); + 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)) @@ -5950,12 +5950,11 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) /* IT->current.overlay_string_index is the number of overlay strings that have already been consumed by IT. Copy some of the remaining overlay strings to IT->overlay_strings. */ - i = 0; - j = it->current.overlay_string_index; - while (i < OVERLAY_STRING_CHUNK_SIZE && j < n) + ptrdiff_t j = it->current.overlay_string_index; + for (ptrdiff_t i = 0; i < OVERLAY_STRING_CHUNK_SIZE && j < n; i++, j++) { it->overlay_strings[i] = entries[j].string; - it->string_overlays[i++] = entries[j++].overlay; + it->string_overlays[i] = entries[j].overlay; } CHECK_IT (it); |