commit c566ee9d06caa80c120dd8631eb3dee17e152fc9 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sun Jan 14 08:26:27 2024 +0800 Fix bug#65116 * src/xterm.c (xi_focus_handle_for_device): Correct typo. (x_focus_frame): Don't focus frames Emacs believes to be focused if they are frames with independent minibuffer frames. (bug#65116) diff --git a/src/xterm.c b/src/xterm.c index 77d6550c8b9..fe398171754 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13370,13 +13370,12 @@ xi_focus_handle_for_device (struct x_display_info *dpyinfo, frame's user time. */ x_display_set_last_user_time (dpyinfo, event->time, event->send_event, false); - device->focus_frame = NULL; /* So, unfortunately, the X Input Extension is implemented such - that means XI_Leave events will not have their focus field - set if the core focus is transferred to another window after - an entry event that pretends to (or really does) set the + that XI_Leave events will not have their focus field set if + the core focus is transferred to another window after an + entry event that pretends to (or really does) set the implicit focus. In addition, if the core focus is set, but the extension focus on the client pointer is not, all XI_Enter events will have their focus fields set, despite not @@ -28805,6 +28804,33 @@ x_focus_frame (struct frame *f, bool noactivate) friends being set. */ block_input (); +#ifdef HAVE_GTK3 + /* read_minibuf assumes that calling Fx_focus_frame on a frame that + is already selected won't move the focus elsewhere, and thereby + disrupt any focus redirection to e.g. a minibuffer frame that + might be activated between that call being made and the + consequent XI_FocusIn/Out events arriving. This is true whether + the focus is ultimately transferred back to the frame it was + initially on or not. + + GTK 3 moves the keyboard focus to the edit widget's window + whenever it receives a FocusIn event targeting the outer window. + This operation gives rise to a FocusOut event that clears + device->focus_frame, which in turn prompts xi_handle_focus_change + to clear the display's focus frame. The next FocusIn event + destined for the same frame registers as a new focus, which + cancels any focus redirection from that frame. + + To prevent this chain of events from disrupting focus redirection + when the minibuffer is activated twice in rapid succession while + configured to redirect focus to a minibuffer frame, ignore frames + which hold the input focus and are connected to a minibuffer + window. (bug#65116)*/ + + if (f == dpyinfo->x_focus_frame && !FRAME_HAS_MINIBUF_P (f)) + return; +#endif /* HAVE_GTK3 */ + if (FRAME_X_EMBEDDED_P (f)) /* For Xembedded frames, normally the embedder forwards key events. See XEmbed Protocol Specification at commit d2c3a983146b7c0fb0f8b855268effb695d0bbf5 Author: Mattias Engdegård Date: Sat Dec 30 16:00:28 2023 +0100 Hash-table documentation updates (bug#68244) * doc/lispref/hash.texi (Creating Hash, Other Hash): Manual updates for make-hash-table, hash-table-rehash-size and hash-table-rehash-threshold. * doc/lispref/objects.texi (Hash Table Type): Update example. * src/fns.c (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Update doc strings. * etc/NEWS: Announce changes. diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index aeaeab27fc0..3d3fe3e3be2 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -121,32 +121,10 @@ referenced in the hash table are preserved from garbage collection. @item :size @var{size} This specifies a hint for how many associations you plan to store in the hash table. If you know the approximate number, you can make things a -little more efficient by specifying it this way. If you specify too -small a size, the hash table will grow automatically when necessary, but -doing that takes some extra time. - -The default size is 65. - -@item :rehash-size @var{rehash-size} -When you add an association to a hash table and the table is full, -it grows automatically. This value specifies how to make the hash table -larger, at that time. - -If @var{rehash-size} is an integer, it should be positive, and the hash -table grows by adding approximately that much to the nominal size. If -@var{rehash-size} is floating point, it had better be greater -than 1, and the hash table grows by multiplying the old size by -approximately that number. - -The default value is 1.5. - -@item :rehash-threshold @var{threshold} -This specifies the criterion for when the hash table is full (so -it should be made larger). The value, @var{threshold}, should be a -positive floating-point number, no greater than 1. The hash table is -full whenever the actual number of entries exceeds the nominal size -multiplied by an approximation to this value. The default for -@var{threshold} is 0.8125. +little more efficient by specifying it this way but since the hash +table memory is managed automatically, the gain in speed is rarely +significant. + @end table @end defun @@ -159,7 +137,7 @@ the following specifies a hash table containing the keys (a symbol) and @code{300} (a number) respectively. @example -#s(hash-table size 30 data (key1 val1 key2 300)) +#s(hash-table data (key1 val1 key2 300)) @end example Note, however, that when using this in Emacs Lisp code, it's @@ -172,12 +150,11 @@ The printed representation for a hash table consists of @samp{#s} followed by a list beginning with @samp{hash-table}. The rest of the list should consist of zero or more property-value pairs specifying the hash table's properties and initial contents. The properties and -values are read literally. Valid property names are @code{size}, -@code{test}, @code{weakness}, @code{rehash-size}, -@code{rehash-threshold}, and @code{data}. The @code{data} property +values are read literally. Valid property names are @code{test}, +@code{weakness} and @code{data}. The @code{data} property should be a list of key-value pairs for the initial contents; the other properties have the same meanings as the matching -@code{make-hash-table} keywords (@code{:size}, @code{:test}, etc.), +@code{make-hash-table} keywords (@code{:test} and @code{:weakness}), described above. Note that you cannot specify a hash table whose initial contents @@ -377,14 +354,6 @@ This function returns the @var{weak} value that was specified for hash table @var{table}. @end defun -@defun hash-table-rehash-size table -This returns the rehash size of @var{table}. -@end defun - -@defun hash-table-rehash-threshold table -This returns the rehash threshold of @var{table}. -@end defun - @defun hash-table-size table This returns the current allocation size of @var{table}. Since hash table allocation is managed automatically, this is rarely of interest. diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 111beb5e5b0..07ceb0d7a98 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1373,8 +1373,7 @@ and contents, like this: @example (make-hash-table) - @result{} #s(hash-table size 65 test eql rehash-size 1.5 - rehash-threshold 0.8125 data ()) + @result{} #s(hash-table) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 5cf3e821627..da0253e97dc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1806,6 +1806,21 @@ The former macro returns non-nil if a variable has a connection-local binding. The latter macro returns the connection-local value of a variable if any, or its current value. +** Hash tables + ++++ +*** ':rehash-size' and ':rehash-threshold' args no longer have any effect. +These keyword arguments are now ignored by 'make-hash-table'. Emacs +manages the memory for all hash table objects in the same way. +The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold' +remain for compatibility but now always return the old default values. + ++++ +*** The printed representation has been shrunk and simplified. +The 'test' parameter is omitted if it is 'eql' (the default), as is +'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are +always omitted, and ignored if present when the object is read back in. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 260bd2f1acb..8441b228898 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1134,7 +1134,7 @@ Return value is the fall-through block name." (defun comp-jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: - ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24) + ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) ;; (byte-switch) ;; (TAG 126 . 10) (let ((targets (hash-table-values jmp-table))) diff --git a/src/fns.c b/src/fns.c index 70288590e24..2905c3f1b86 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5495,25 +5495,25 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, Shash_table_rehash_size, 1, 1, 0, - doc: /* Return the current rehash size of TABLE. */) + doc: /* Return the rehash size of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal factor by which to increase the size of a hash table. - No longer used; this is for compatibility. */ - return make_float (1.5); + return make_float (1.5); /* The old default rehash-size value. */ } DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, Shash_table_rehash_threshold, 1, 1, 0, - doc: /* Return the current rehash threshold of TABLE. */) + doc: /* Return the rehash threshold of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal threshold for when to resize a hash table. - No longer used; this is for compatibility. */ - return make_float (0.8125); + return make_float (0.8125); /* The old default rehash-threshold value. */ } commit 519c7ca7356fc7f9707b97c143c9495deea5b272 Author: Mattias Engdegård Date: Sat Dec 30 15:54:32 2023 +0100 Don't pretend that hash-table-size is useful * lisp/emacs-lisp/shortdoc.el (hash-table): Remove hash-table-size entry. * doc/lispref/hash.texi (Other Hash): * src/fns.c (Fhash_table_size): Make it clear that hash-table-size is probably not worth using. diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index ff9d1799a60..aeaeab27fc0 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -386,5 +386,6 @@ This returns the rehash threshold of @var{table}. @end defun @defun hash-table-size table -This returns the current nominal size of @var{table}. +This returns the current allocation size of @var{table}. Since hash table +allocation is managed automatically, this is rarely of interest. @end defun diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 17cbf6b2d31..a6a49c72f74 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -572,10 +572,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :result-string "#s(hash-table ...)") (hash-table-count :no-eval (hash-table-count table) - :eg-result 15) - (hash-table-size - :no-eval (hash-table-size table) - :eg-result 65)) + :eg-result 15)) (define-short-documentation-group list "Making Lists" diff --git a/src/fns.c b/src/fns.c index 3765fc74967..70288590e24 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5518,10 +5518,14 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, - doc: /* Return the size of TABLE. -The size can be used as an argument to `make-hash-table' to create -a hash table than can hold as many elements as TABLE holds -without need for resizing. */) + doc: /* Return the current allocation size of TABLE. + +This is probably not the function that you are looking for. To get the +number of entries in a table, use `hash-table-count' instead. + +The returned value is the number of entries that TABLE can currently +hold without growing, but since hash tables grow automatically, this +number is rarely of interest. */) (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); commit 1998039f7a8f2ecc884a6fed85c0cc1ce06f83e2 Author: Mattias Engdegård Date: Wed Nov 22 14:54:34 2023 +0100 Change hash_hash_t to uint32_t This saves a lot of memory and is quite sufficient. Hash functions are adapted to produce a hash_hash_t eventually, which eliminates some useless and information-destroying intermediate hash reduction steps. We still use EMACS_UINT for most of the actual hashing steps before producing the final value; this may be slightly wasteful on 32-bit platforms with 64-bit EMACS_UINT. * src/lisp.h (hash_hash_t): Change to uint32_t. * src/fns.c (reduce_emacs_uint_to_hash_hash): New. (hashfn_eq, hashfn_equal, hashfn_user_defined): Reduce return values to hash_hash_t. (sxhash_string): Remove. Caller changed to hash_string. (sxhash_float, sxhash_list, sxhash_vector, sxhash_bool_vector) (sxhash_bignum): Remove wasteful calls to SXHASH_REDUCE. (hash_hash_to_fixnum): New. (Fsxhash_eq, Fsxhash_eql, Fsxhash_equal) (Fsxhash_equal_including_properties): Convert return values to fixnum. diff --git a/src/fns.c b/src/fns.c index ed7b7bb2024..3765fc74967 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4452,6 +4452,16 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } +/* Reduce an EMACS_UINT hash value to hash_hash_t. */ +static inline hash_hash_t +reduce_emacs_uint_to_hash_hash (EMACS_UINT x) +{ + verify (sizeof x <= 2 * sizeof (hash_hash_t)); + return (sizeof x == sizeof (hash_hash_t) + ? x + : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); +} + /* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ static hash_hash_t @@ -4459,21 +4469,18 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) key = SYMBOL_WITH_POS_SYM (key); - return XHASH (key) ^ XTYPE (key); + return reduce_emacs_uint_to_hash_hash (XHASH (key) ^ XTYPE (key)); } -/* Ignore H and return a hash code for KEY which uses 'equal' to compare keys. - The hash code is at most INTMASK. */ - +/* Ignore H and return a hash code for KEY which uses 'equal' to + compare keys. */ static hash_hash_t hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return sxhash (key); + return reduce_emacs_uint_to_hash_hash (sxhash (key)); } -/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. - The hash code is at most INTMASK. */ - +/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. */ static hash_hash_t hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { @@ -4489,7 +4496,8 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test->user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); + return reduce_emacs_uint_to_hash_hash (FIXNUMP (hash) + ? XUFIXNUM(hash) : sxhash (hash)); } struct hash_table_test const @@ -5061,16 +5069,6 @@ hash_string (char const *ptr, ptrdiff_t len) return hash; } -/* Return a hash for string PTR which has length LEN. The hash - code returned is at most INTMASK. */ - -static EMACS_UINT -sxhash_string (char const *ptr, ptrdiff_t len) -{ - EMACS_UINT hash = hash_string (ptr, len); - return SXHASH_REDUCE (hash); -} - /* Return a hash for the floating point value VAL. */ static EMACS_UINT @@ -5080,7 +5078,7 @@ sxhash_float (double val) union double_and_words u = { .val = val }; for (int i = 0; i < WORDS_PER_DOUBLE; i++) hash = sxhash_combine (hash, u.word[i]); - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for list LIST. DEPTH is the current depth in the @@ -5107,7 +5105,7 @@ sxhash_list (Lisp_Object list, int depth) hash = sxhash_combine (hash, hash2); } - return SXHASH_REDUCE (hash); + return hash; } @@ -5127,7 +5125,7 @@ sxhash_vector (Lisp_Object vec, int depth) hash = sxhash_combine (hash, hash2); } - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for bool-vector VECTOR. */ @@ -5143,7 +5141,7 @@ sxhash_bool_vector (Lisp_Object vec) for (i = 0; i < n; ++i) hash = sxhash_combine (hash, bool_vector_data (vec)[i]); - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for a bignum. */ @@ -5158,19 +5156,18 @@ sxhash_bignum (Lisp_Object bignum) for (i = 0; i < nlimbs; ++i) hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); - return SXHASH_REDUCE (hash); + return hash; } - -/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp - structure. Value is an unsigned integer clipped to INTMASK. */ - EMACS_UINT sxhash (Lisp_Object obj) { return sxhash_obj (obj, 0); } +/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp + structure. */ + static EMACS_UINT sxhash_obj (Lisp_Object obj, int depth) { @@ -5186,7 +5183,7 @@ sxhash_obj (Lisp_Object obj, int depth) return XHASH (obj); case Lisp_String: - return sxhash_string (SSDATA (obj), SBYTES (obj)); + return hash_string (SSDATA (obj), SBYTES (obj)); case Lisp_Vectorlike: { @@ -5213,7 +5210,7 @@ sxhash_obj (Lisp_Object obj, int depth) = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0; EMACS_UINT hash = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos); - return SXHASH_REDUCE (hash); + return hash; } else if (pvec_type == PVEC_BOOL_VECTOR) return sxhash_bool_vector (obj); @@ -5222,7 +5219,7 @@ sxhash_obj (Lisp_Object obj, int 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); + return hash; } else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); @@ -5258,6 +5255,15 @@ collect_interval (INTERVAL interval, Lisp_Object collector) Lisp Interface ***********************************************************************/ +/* Reduce X to a Lisp fixnum. */ +static inline Lisp_Object +hash_hash_to_fixnum (hash_hash_t x) +{ + return make_ufixnum (FIXNUM_BITS < 8 * sizeof x + ? (x ^ x >> (8 * sizeof x - FIXNUM_BITS)) & INTMASK + : x); +} + DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, doc: /* Return an integer hash code for OBJ suitable for `eq'. If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). @@ -5265,7 +5271,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_eq (obj, NULL)); + return hash_hash_to_fixnum (hashfn_eq (obj, NULL)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -5276,7 +5282,7 @@ isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_eql (obj, NULL)); + return hash_hash_to_fixnum (hashfn_eql (obj, NULL)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -5287,7 +5293,7 @@ opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_equal (obj, NULL)); + return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); } DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties, @@ -5302,6 +5308,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) { if (STRINGP (obj)) { + /* FIXME: This is very wasteful. We needn't cons at all. */ Lisp_Object collector = Fcons (Qnil, Qnil); traverse_intervals (string_intervals (obj), 0, collect_interval, collector); @@ -5311,7 +5318,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) sxhash (CDR (collector))))); } - return make_ufixnum (hashfn_equal (obj, NULL)); + return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); } diff --git a/src/lisp.h b/src/lisp.h index 0701028c14c..64492361e64 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2387,7 +2387,7 @@ struct Lisp_Hash_Table; /* The type of a hash value stored in the table. It's unsigned and a subtype of EMACS_UINT. */ -typedef EMACS_UINT hash_hash_t; +typedef uint32_t hash_hash_t; typedef enum { Test_eql, commit 11e467eb6004286765c1d8c408f8d773d9113aca Author: Mattias Engdegård Date: Tue Nov 21 22:12:08 2023 +0100 Use key Qunbound instead of hash value hash_unused for free entries Previously, free hash table entries were indicated by both hash value hash_unused and key Qunbound; we now rely on the latter only. This allows us to change the hash representation to one that does not have an unused value. * src/lisp.h (hash_unused): Remove. All uses adapted to calling hash_unused_entry_key_p on the key instead. The hash values for unused hash table entries are now undefined; all initialisation and assignment to hash_unused has been removed. diff --git a/src/fns.c b/src/fns.c index b68fb393703..ed7b7bb2024 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4577,8 +4577,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - for (ptrdiff_t i = 0; i < size; i++) - h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size - 1; i++) @@ -4682,8 +4680,6 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - for (ptrdiff_t i = old_size; i < new_size; i++) - hash[i] = hash_unused; ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); @@ -4755,8 +4751,6 @@ hash_table_thaw (Lisp_Object hash_table) h->next_free = -1; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - for (ptrdiff_t i = 0; i < size; i++) - h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size; i++) @@ -4831,14 +4825,13 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, hash_hash_t hash) { - eassert (!BASE_EQ (key, Qunbound)); + eassert (!hash_unused_entry_key_p (key)); /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; - eassert (HASH_HASH (h, i) == hash_unused); eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); @@ -4883,7 +4876,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) the free list. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, h->next_free); h->next_free = i; h->count--; @@ -4906,7 +4898,6 @@ hash_clear (struct Lisp_Hash_Table *h) ptrdiff_t size = HASH_TABLE_SIZE (h); for (ptrdiff_t i = 0; i < size; i++) { - set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); @@ -4986,10 +4977,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) set_hash_next_slot (h, i, h->next_free); h->next_free = i; - /* Clear key, value, and hash. */ + /* Clear key and value. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, hash_unused); eassert (h->count != 0); h->count--; diff --git a/src/lisp.h b/src/lisp.h index f27f506b58f..0701028c14c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2425,11 +2425,6 @@ typedef enum { both key and value remain. */ } hash_table_weakness_t; -/* An value that marks an unused hash entry. - Any hash_hash_t value that is not a valid fixnum will do here. */ -enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; -verify (FIXNUM_OVERFLOW_P (hash_unused)); - /* The type of a hash table index, both for table indices and index (hash) indices. It's signed and a subtype of ptrdiff_t. */ typedef int32_t hash_idx_t; @@ -2475,7 +2470,7 @@ struct Lisp_Hash_Table Otherwise it is heap-allocated. */ hash_idx_t *index; - /* Vector of hash codes. The value hash_unused marks an unused table entry. + /* Vector of hash codes. Unused entries have undefined values. This vector is table_size entries long. */ hash_hash_t *hash; diff --git a/src/macfont.m b/src/macfont.m index 48502c2ec00..6f192b00f1b 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -980,7 +980,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ptrdiff_t i, size = HASH_TABLE_SIZE (h); for (i = 0; i < size; ++i) - if (HASH_HASH (h, i) != hash_unused) + if (!hash_unused_entry_key_p (HASH_KEY (h, i))) { Lisp_Object value = HASH_VALUE (h, i); diff --git a/src/pdumper.c b/src/pdumper.c index 38682816f0a..54f0f2bca13 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2676,11 +2676,14 @@ hash_table_contents (struct Lisp_Hash_Table *h) relies on it by expecting hash table indices to stay constant across the dump. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (HASH_HASH (h, i) != hash_unused) - { - key_and_value[n++] = HASH_KEY (h, i); - key_and_value[n++] = HASH_VALUE (h, i); - } + { + Lisp_Object key = HASH_KEY (h, i); + if (!hash_unused_entry_key_p (key)) + { + key_and_value[n++] = key; + key_and_value[n++] = HASH_VALUE (h, i); + } + } return key_and_value; } commit 7ad5d427730fea3865bc678c6673ffd58b6af653 Author: Mattias Engdegård Date: Wed Nov 22 13:47:56 2023 +0100 Don't dump Qunbound The dumper uses a hash table to keep track of dumped objects but as this clashes with the use of Qunbound for marking unused hash table entries, don't dump that value at all. The symbol name is fixed up after loading. An alternative solution would be to use a different unique value for unused entries. * src/pdumper.c (dump_object_needs_dumping_p): Skip Qunbound. (dump_vectorlike_generic): New function. (pdumper_load): Call it. diff --git a/src/fns.c b/src/fns.c index 3acbc7f86a1..b68fb393703 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4831,6 +4831,7 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, hash_hash_t hash) { + eassert (!BASE_EQ (key, Qunbound)); /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; diff --git a/src/pdumper.c b/src/pdumper.c index 13077526776..38682816f0a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1337,7 +1337,9 @@ dump_object_needs_dumping_p (Lisp_Object object) included in the dump despite all references to them being bitwise-invariant. */ return (!dump_object_self_representing_p (object) - || dump_object_emacs_ptr (object)); + || (dump_object_emacs_ptr (object) + /* Don't dump Qunbound -- it's not a legal hash table key. */ + && !BASE_EQ (object, Qunbound))); } static void @@ -2551,6 +2553,19 @@ dump_symbol (struct dump_context *ctx, return offset; } +/* Give Qunbound its name. + All other symbols are dumped and loaded but not Qunbound because it + cannot be used as a key in a hash table. + FIXME: A better solution would be to use a value other than Qunbound + as a marker for unused entries in hash tables. */ +static void +pdumper_init_symbol_unbound (void) +{ + eassert (NILP (SYMBOL_NAME (Qunbound))); + const char *name = "unbound"; + init_symbol (Qunbound, make_pure_c_string (name, strlen (name))); +} + static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) @@ -5749,6 +5764,8 @@ pdumper_load (const char *dump_filename, char *argv0) for (int i = 0; i < nr_dump_hooks; ++i) dump_hooks[i] (); + pdumper_init_symbol_unbound (); + #ifdef HAVE_NATIVE_COMP pdumper_set_emacs_execdir (argv0); #else commit 68f8bc3111424527205ebfe4498e5bebf50f50bf Author: Mattias Engdegård Date: Tue Nov 21 19:26:23 2023 +0100 Change hash_idx_t to int32_t on all platforms * src/lisp.h (hash_idx_t): Change to int32_t. * src/fns.c (hash_index_size): Adapt to new index type. diff --git a/src/fns.c b/src/fns.c index 4a38126d9dc..3acbc7f86a1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4515,7 +4515,8 @@ hash_index_size (ptrdiff_t size) /* An upper bound on the size of a hash table index. It must fit in ptrdiff_t and be a valid Emacs fixnum. */ ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, - PTRDIFF_MAX / sizeof (ptrdiff_t)); + min (TYPE_MAXIMUM (hash_idx_t), + PTRDIFF_MAX / sizeof (ptrdiff_t))); ptrdiff_t index_size = size + (size >> 2); /* 1.25x larger */ if (index_size < upper_bound) index_size = next_almost_prime (index_size); diff --git a/src/lisp.h b/src/lisp.h index 5b70e96d6a1..f27f506b58f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2432,7 +2432,7 @@ verify (FIXNUM_OVERFLOW_P (hash_unused)); /* The type of a hash table index, both for table indices and index (hash) indices. It's signed and a subtype of ptrdiff_t. */ -typedef ptrdiff_t hash_idx_t; +typedef int32_t hash_idx_t; struct Lisp_Hash_Table { commit ed06de52a53135ee42e528496fdddbf3d74b0479 Author: Mattias Engdegård Date: Sat Nov 4 18:21:06 2023 +0100 Faster hash table growth, starting at zero size The algorithms no longer use the rehash_threshold and rehash_size float constants, but vary depending on size. In particular, the table now grows faster, especially from smaller sizes. The default size is now 0, starting empty, which effectively postpones allocation until the first insertion (unless make-hash-table was called with a positive :size); this is a clear gain as long as the table remains empty. The first inserted item will use an initial size of 8 because most tables are small. * src/fns.c (std_rehash_size, std_rehash_threshold): Remove. (hash_index_size): Integer-only computation. (maybe_resize_hash_table): Grow more aggressively. (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Use the constants directly. * src/lisp.h (DEFAULT_HASH_SIZE): New value. diff --git a/src/fns.c b/src/fns.c index 3e650b13c1f..4a38126d9dc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4508,31 +4508,18 @@ allocate_hash_table (void) return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } -/* An upper bound on the size of a hash table index. It must fit in - ptrdiff_t and be a valid Emacs fixnum. This is an upper bound on - VECTOR_ELTS_MAX (see alloc.c) and gets as close as we can without - violating modularity. */ -#define INDEX_SIZE_BOUND \ - ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \ - ((min (PTRDIFF_MAX, SIZE_MAX) \ - - header_size - GCALIGNMENT) \ - / word_size))) - -/* Default factor by which to increase the size of a hash table. */ -static const double std_rehash_size = 1.5; - -/* Resize hash table when number of entries / table size is >= this - ratio. */ -static const double std_rehash_threshold = 0.8125; - +/* Compute the size of the index from the table capacity. */ static ptrdiff_t hash_index_size (ptrdiff_t size) { - double index_float = size * (1.0 / std_rehash_threshold); - ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1 - ? next_almost_prime (index_float) - : INDEX_SIZE_BOUND + 1); - if (INDEX_SIZE_BOUND < index_size) + /* An upper bound on the size of a hash table index. It must fit in + ptrdiff_t and be a valid Emacs fixnum. */ + ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, + PTRDIFF_MAX / sizeof (ptrdiff_t)); + ptrdiff_t index_size = size + (size >> 2); /* 1.25x larger */ + if (index_size < upper_bound) + index_size = next_almost_prime (index_size); + if (index_size > upper_bound) error ("Hash table too large"); return index_size; } @@ -4671,16 +4658,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - /* FIXME: better growth management, ditch std_rehash_size */ - EMACS_INT new_size = old_size * std_rehash_size; - if (new_size < EMACS_INT_MAX) - new_size = max (new_size, 32); /* avoid slow initial growth */ - else - new_size = EMACS_INT_MAX; - if (PTRDIFF_MAX < new_size) - new_size = PTRDIFF_MAX; - if (new_size <= old_size) - new_size = old_size + 1; + ptrdiff_t base_size = min (max (old_size, 8), PTRDIFF_MAX / 2); + /* Grow aggressively at small sizes, then just double. */ + ptrdiff_t new_size = + old_size == 0 + ? 8 + : (base_size <= 64 ? base_size * 4 : base_size * 2); /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ @@ -4738,7 +4721,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pI"d", new_size); + message ("Growing hash table to: %"pD"d", new_size); #endif } } @@ -5403,7 +5386,8 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and `define-hash-table-test'. :size SIZE -- A hint as to how many elements will be put in the table. -Default is 65. +The table will always grow as needed; this argument may help performance +slightly if the size is known in advance but is never required. :weakness WEAK -- WEAK must be one of nil, t, `key', `value', `key-or-value', or `key-and-value'. If WEAK is not nil, the table @@ -5516,7 +5500,9 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, (Lisp_Object table) { CHECK_HASH_TABLE (table); - return make_float (std_rehash_size); + /* Nominal factor by which to increase the size of a hash table. + No longer used; this is for compatibility. */ + return make_float (1.5); } @@ -5526,7 +5512,9 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, (Lisp_Object table) { CHECK_HASH_TABLE (table); - return make_float (std_rehash_threshold); + /* Nominal threshold for when to resize a hash table. + No longer used; this is for compatibility. */ + return make_float (0.8125); } diff --git a/src/lisp.h b/src/lisp.h index 658bcd8b780..5b70e96d6a1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2591,7 +2591,7 @@ void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ -enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; +enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 0 }; /* Combine two integers X and Y for hashing. The result might exceed INTMASK. */ commit 47502c55b0ce2e4cd3f43fefb77d9c2c11ed7c0a Author: Mattias Engdegård Date: Fri Nov 3 16:02:56 2023 +0100 ; Reorder struct Lisp_Hash_Table and struct hash_table_test Mainly for efficiency, to keep frequently used fields together. diff --git a/src/fns.c b/src/fns.c index e491202cf54..3e650b13c1f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4493,12 +4493,12 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) } struct hash_table_test const - hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), 0, hashfn_eq }, - hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql }, - hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal }; + hashtest_eq = { .name = LISPSYM_INITIALLY (Qeq), + .cmpfn = 0, .hashfn = hashfn_eq }, + hashtest_eql = { .name = LISPSYM_INITIALLY (Qeql), + .cmpfn = cmpfn_eql, .hashfn = hashfn_eql }, + hashtest_equal = { .name = LISPSYM_INITIALLY (Qequal), + .cmpfn = cmpfn_equal, .hashfn = hashfn_equal }; /* Allocate basically initialized hash table. */ diff --git a/src/lisp.h b/src/lisp.h index b11237381d9..658bcd8b780 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2397,9 +2397,11 @@ typedef enum { struct hash_table_test { - /* FIXME: reorder for efficiency */ - /* Function used to compare keys; always a bare symbol. */ - Lisp_Object name; + /* C function to compute hash code. */ + hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + + /* C function to compare two keys. */ + Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); /* User-supplied hash function, or nil. */ Lisp_Object user_hash_function; @@ -2407,11 +2409,8 @@ struct hash_table_test /* User-supplied key comparison function, or nil. */ Lisp_Object user_cmp_function; - /* C function to compare two keys. */ - Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); - - /* C function to compute hash code. */ - hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + /* Function used to compare keys; always a bare symbol. */ + Lisp_Object name; }; typedef enum { @@ -2480,6 +2479,16 @@ struct Lisp_Hash_Table This vector is table_size entries long. */ hash_hash_t *hash; + /* Vector of keys and values. The key of item I is found at index + 2 * I, the value is found at index 2 * I + 1. + If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. + This is gc_marked specially if the table is weak. + This vector is 2 * table_size entries long. */ + Lisp_Object *key_and_value; + + /* The comparison and hash functions. */ + const struct hash_table_test *test; + /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, next[I] is the index of the next entry in the collision chain, @@ -2508,16 +2517,6 @@ struct Lisp_Hash_Table immutable for recursive attempts to mutate it. */ bool mutable; - /* Vector of keys and values. The key of item I is found at index - 2 * I, the value is found at index 2 * I + 1. - If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. - This is gc_marked specially if the table is weak. - This vector is 2 * table_size entries long. */ - Lisp_Object *key_and_value; - - /* The comparison and hash functions. */ - const struct hash_table_test *test; - /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage collection --- at other times, it is NULL. */ commit 7d93a0147a14e14d6964bf93ba11cf494b9d49fd Author: Mattias Engdegård Date: Thu Nov 2 17:05:26 2023 +0100 Share hash table test structs This saves several words in the hash table object at the cost of an indirection at runtime. This seems to be a gain in overall performance. FIXME: We cache hash test objects in a rather clumsy way. A better solution is sought. * src/lisp.h (struct Lisp_Hash_Table): Use a pointer to the test struct. All references adapted. * src/alloc.c (garbage_collect): * src/fns.c (struct hash_table_user_test, hash_table_user_tests) (mark_fns, get_hash_table_user_test): New state for caching test structs, and functions managing it. diff --git a/src/alloc.c b/src/alloc.c index 7432163db25..16aaa32e15f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5942,10 +5942,6 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) *pure = *table; pure->mutable = false; - pure->test.name = purecopy (table->test.name); - pure->test.user_hash_function = purecopy (table->test.user_hash_function); - pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); - if (table->table_size > 0) { ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; @@ -6630,6 +6626,7 @@ garbage_collect (void) #ifdef HAVE_NS mark_nsterm (); #endif + mark_fns (); /* Everything is now marked, except for the data in font caches, undo lists, and finalizers. The first two are compacted by @@ -7295,9 +7292,6 @@ process_mark_stack (ptrdiff_t base_sp) { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; set_vector_marked (ptr); - mark_stack_push_value (h->test.name); - mark_stack_push_value (h->test.user_hash_function); - mark_stack_push_value (h->test.user_cmp_function); if (h->weakness == Weak_None) mark_stack_push_values (h->key_and_value, 2 * h->table_size); diff --git a/src/bytecode.c b/src/bytecode.c index a0f02d518b7..ed6e2b34e77 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1743,7 +1743,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ - if (h->count <= 5 && !h->test.cmpfn) + if (h->count <= 5 && !h->test->cmpfn) { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ for (i = h->count; 0 <= --i; ) diff --git a/src/category.c b/src/category.c index 3a406a567a1..498b6a2a1c9 100644 --- a/src/category.c +++ b/src/category.c @@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); + make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index e78391b3a71..00ae33dfa2c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1698,7 +1698,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index c4e7a98a4d3..e491202cf54 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4448,7 +4448,7 @@ static Lisp_Object cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 }; + Lisp_Object args[] = { h->test->user_cmp_function, key1, key2 }; return hash_table_user_defined_call (ARRAYELTS (args), args, h); } @@ -4487,7 +4487,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) static hash_hash_t hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_hash_function, key }; + Lisp_Object args[] = { h->test->user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); } @@ -4557,10 +4557,10 @@ static const hash_idx_t empty_hash_index_vector[] = {-1}; changed after purecopy. */ Lisp_Object -make_hash_table (struct hash_table_test test, EMACS_INT size, +make_hash_table (const struct hash_table_test *test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - eassert (SYMBOLP (test.name)); + eassert (SYMBOLP (test->name)); eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); struct Lisp_Hash_Table *h = allocate_hash_table (); @@ -4763,7 +4763,7 @@ hash_table_thaw (Lisp_Object hash_table) /* Freezing discarded most non-essential information; recompute it. The allocation is minimal with no room for growth. */ - h->test = *hash_table_test_from_std (h->frozen_test); + h->test = hash_table_test_from_std (h->frozen_test); ptrdiff_t size = h->count; h->table_size = size; ptrdiff_t index_size = hash_index_size (size); @@ -4805,9 +4805,9 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h, for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hash == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) return i; return -1; @@ -4884,9 +4884,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) i = HASH_NEXT (h, i)) { if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hashval == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ if (prev < 0) @@ -5339,6 +5339,58 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) return make_ufixnum (hashfn_equal (obj, NULL)); } + +/* This is a cache of hash_table_test structures so that they can be + shared between hash tables using the same test. + FIXME: This way of storing and looking up hash_table_test structs + isn't wonderful. Find a better solution. */ +struct hash_table_user_test +{ + struct hash_table_test test; + struct hash_table_user_test *next; +}; + +static struct hash_table_user_test *hash_table_user_tests = NULL; + +void +mark_fns (void) +{ + for (struct hash_table_user_test *ut = hash_table_user_tests; + ut; ut = ut->next) + { + mark_object (ut->test.name); + mark_object (ut->test.user_cmp_function); + mark_object (ut->test.user_hash_function); + } +} + +static struct hash_table_test * +get_hash_table_user_test (Lisp_Object test) +{ + Lisp_Object prop = Fget (test, Qhash_table_test); + if (!CONSP (prop) || !CONSP (XCDR (prop))) + signal_error ("Invalid hash table test", test); + + Lisp_Object equal_fn = XCAR (prop); + Lisp_Object hash_fn = XCAR (XCDR (prop)); + struct hash_table_user_test *ut = hash_table_user_tests; + while (ut && !(EQ (equal_fn, ut->test.user_cmp_function) + && EQ (hash_fn, ut->test.user_hash_function))) + ut = ut->next; + if (!ut) + { + ut = xmalloc (sizeof *ut); + ut->test.name = test; + ut->test.user_cmp_function = equal_fn; + ut->test.user_hash_function = hash_fn; + ut->test.hashfn = hashfn_user_defined; + ut->test.cmpfn = cmpfn_user_defined; + ut->next = hash_table_user_tests; + hash_table_user_tests = ut; + } + return &ut->test; +} + DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, doc: /* Create and return a new hash table. @@ -5384,25 +5436,15 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object test = i ? args[i] : Qeql; if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) test = SYMBOL_WITH_POS_SYM (test); - struct hash_table_test testdesc; + const struct hash_table_test *testdesc; if (BASE_EQ (test, Qeq)) - testdesc = hashtest_eq; + testdesc = &hashtest_eq; else if (BASE_EQ (test, Qeql)) - testdesc = hashtest_eql; + testdesc = &hashtest_eql; else if (BASE_EQ (test, Qequal)) - testdesc = hashtest_equal; + testdesc = &hashtest_equal; else - { - /* See if it is a user-defined test. */ - Lisp_Object prop = Fget (test, Qhash_table_test); - if (!CONSP (prop) || !CONSP (XCDR (prop))) - signal_error ("Invalid hash table test", test); - testdesc.name = test; - testdesc.user_cmp_function = XCAR (prop); - testdesc.user_hash_function = XCAR (XCDR (prop)); - testdesc.hashfn = hashfn_user_defined; - testdesc.cmpfn = cmpfn_user_defined; - } + testdesc = get_hash_table_user_test (test); /* See if there's a `:purecopy PURECOPY' argument. */ i = get_key_arg (QCpurecopy, nargs, args, used); @@ -5504,7 +5546,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, doc: /* Return the test TABLE uses. */) (Lisp_Object table) { - return check_hash_table (table)->test.name; + return check_hash_table (table)->test->name; } Lisp_Object diff --git a/src/frame.c b/src/frame.c index 08057736272..abd6ef00901 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1040,7 +1040,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); + (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 74d4b6c0bfe..66838adbb2a 100644 --- a/src/image.c +++ b/src/image.c @@ -6069,7 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); + return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 33c1e345f7a..b11237381d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2397,6 +2397,7 @@ typedef enum { struct hash_table_test { + /* FIXME: reorder for efficiency */ /* Function used to compare keys; always a bare symbol. */ Lisp_Object name; @@ -2515,7 +2516,7 @@ struct Lisp_Hash_Table Lisp_Object *key_and_value; /* The comparison and hash functions. */ - struct hash_table_test test; + const struct hash_table_test *test; /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage @@ -2584,7 +2585,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) { - return h->test.hashfn (key, h); + return h->test->hashfn (key, h); } void hash_table_thaw (Lisp_Object hash_table); @@ -4064,7 +4065,7 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, +Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); @@ -4098,6 +4099,7 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val); extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop); extern void syms_of_fns (void); +extern void mark_fns (void); /* Defined in sort.c */ extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index b76fde3f266..2c6a444ec56 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2544,11 +2544,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2792,11 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index 6b053c5b601..13077526776 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2704,7 +2704,8 @@ hash_table_freeze (struct Lisp_Hash_Table *h) h->index = NULL; h->table_size = 0; h->index_size = 0; - h->frozen_test = hash_table_std_test (&h->test); + h->frozen_test = hash_table_std_test (h->test); + h->test = NULL; } static dump_off diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 57ea82daa5e..b731f52983d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7178,7 +7178,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index c27c66ae40a..58a23b79d5d 100644 --- a/src/print.c +++ b/src/print.c @@ -2577,10 +2577,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) #s(hash-table test equal data (k1 v1 k2 v2)) */ print_c_string ("#s(hash-table", printcharfun); - if (!BASE_EQ (h->test.name, Qeql)) + if (!BASE_EQ (h->test->name, Qeql)) { print_c_string (" test ", printcharfun); - print_object (h->test.name, printcharfun, escapeflag); + print_object (h->test->name, printcharfun, escapeflag); } if (h->weakness != Weak_None) diff --git a/src/profiler.c b/src/profiler.c index 06ffecf41e3..5a6a8b48f6b 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -563,7 +563,7 @@ export_log (struct profiler_log *plog) which is more discriminating than the `function-equal' used by the log but close enough, and will never confuse two distinct keys in the log. */ - Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); for (int i = 0; i < log->size; i++) { diff --git a/src/xfaces.c b/src/xfaces.c index c9dd0f90feb..2ca2c30636c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7333,7 +7333,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (hashtest_eq, 33, Weak_None, false); + make_hash_table (&hashtest_eq, 33, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index e4139a79a6e..77d6550c8b9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32554,7 +32554,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, commit 0a998938ca1b7e5e6f09d14b4a62ec7089be2af6 Author: Mattias Engdegård Date: Sun Nov 5 12:10:34 2023 +0100 Use hash_idx_t for storing hash indices Now hash_idx_t is a typedef for ptrdiff_t so there is no actual code change, but this allows us to decouple the index width from the Lisp word size. * src/lisp.h (hash_idx_t): New typedef for ptrdiff_t. (struct Lisp_Hash_Table): Use it for indices and sizes: index, next, table_size, index_size, count and next_free. All uses adapted. diff --git a/src/fns.c b/src/fns.c index 9d802bba0e2..c4e7a98a4d3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4539,7 +4539,7 @@ hash_index_size (ptrdiff_t size) /* Constant hash index vector used when the table size is zero. This avoids allocating it from the heap. */ -static const ptrdiff_t empty_hash_index_vector[] = {-1}; +static const hash_idx_t empty_hash_index_vector[] = {-1}; /* Create and initialize a new hash table. @@ -4578,7 +4578,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->hash = NULL; h->next = NULL; eassert (index_size == 1); - h->index = (ptrdiff_t *)empty_hash_index_vector; + h->index = (hash_idx_t *)empty_hash_index_vector; h->next_free = -1; } else @@ -4684,7 +4684,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ - ptrdiff_t *next = hash_table_alloc_bytes (new_size * sizeof *next); + hash_idx_t *next = hash_table_alloc_bytes (new_size * sizeof *next); for (ptrdiff_t i = old_size; i < new_size - 1; i++) next[i] = i + 1; next[new_size - 1] = -1; @@ -4703,7 +4703,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); - ptrdiff_t *index = hash_table_alloc_bytes (index_size * sizeof *index); + hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); for (ptrdiff_t i = 0; i < index_size; i++) index[i] = -1; diff --git a/src/lisp.h b/src/lisp.h index 02d9c98da22..33c1e345f7a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2430,6 +2430,10 @@ typedef enum { enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; verify (FIXNUM_OVERFLOW_P (hash_unused)); +/* The type of a hash table index, both for table indices and index + (hash) indices. It's signed and a subtype of ptrdiff_t. */ +typedef ptrdiff_t hash_idx_t; + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2459,6 +2463,9 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ + hash_idx_t index_size; /* Size of the index vector. */ + hash_idx_t table_size; /* Size of the next and hash vectors. */ + /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. @@ -2466,10 +2473,7 @@ struct Lisp_Hash_Table If index_size is 1 (and table_size is 0), then this is the constant read-only vector {-1}, shared between all instances. Otherwise it is heap-allocated. */ - ptrdiff_t *index; - ptrdiff_t index_size; /* Size of the index vector. */ - - ptrdiff_t table_size; /* Size of the next and hash vectors. */ + hash_idx_t *index; /* Vector of hash codes. The value hash_unused marks an unused table entry. This vector is table_size entries long. */ @@ -2480,13 +2484,13 @@ struct Lisp_Hash_Table next[I] is the index of the next entry in the collision chain, or -1 if there is no such entry. This vector is table_size entries long. */ - ptrdiff_t *next; + hash_idx_t *next; /* Number of key/value entries in the table. */ - ptrdiff_t count; + hash_idx_t count; /* Index of first free entry in free list, or -1 if none. */ - ptrdiff_t next_free; + hash_idx_t next_free; /* Weakness of the table. */ hash_table_weakness_t weakness : 8; diff --git a/src/pdumper.c b/src/pdumper.c index 5ed91c668df..6b053c5b601 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1226,7 +1226,7 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) 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); + (ptrdiff_t) XHASH_TABLE (dump_queue->link_weights)->count); static const int nr_candidates = 3; struct candidate commit 3b00255a4c70bc1075446c94a8ff65c987ac143f Author: Mattias Engdegård Date: Tue Nov 21 12:27:42 2023 +0100 Inlined and specialised hash table look-up This improves performance in several ways. Separate functions are used depending on whether the caller has a hash value computed or not. * src/fns.c (hash_lookup_with_hash, hash_lookup_get_hash): New. (hash_lookup): Remove hash return argument. All callers adapted. hash_lookup_with_hash hash_hash_t arg diff --git a/src/bytecode.c b/src/bytecode.c index e989e5fadf0..a0f02d518b7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1751,7 +1751,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, break; } else - i = hash_lookup (h, v1, NULL); + i = hash_lookup (h, v1); if (i >= 0) { diff --git a/src/category.c b/src/category.c index e7fbf1ff500..3a406a567a1 100644 --- a/src/category.c +++ b/src/category.c @@ -54,7 +54,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, category_set, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); if (i >= 0) return HASH_KEY (h, i); hash_put (h, category_set, Qnil, hash); diff --git a/src/ccl.c b/src/ccl.c index b4dda404b95..7df50ba7022 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1380,7 +1380,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size eop = (FIXNUM_OVERFLOW_P (reg[RRR]) ? -1 - : hash_lookup (h, make_fixnum (reg[RRR]), NULL)); + : hash_lookup (h, make_fixnum (reg[RRR]))); if (eop >= 0) { Lisp_Object opl; @@ -1409,7 +1409,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size eop = (FIXNUM_OVERFLOW_P (i) ? -1 - : hash_lookup (h, make_fixnum (i), NULL)); + : hash_lookup (h, make_fixnum (i))); if (eop >= 0) { Lisp_Object opl; diff --git a/src/charset.c b/src/charset.c index add3bf846f8..6a74f294ad8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1108,8 +1108,8 @@ usage: (define-charset-internal ...) */) ASET (attrs, charset_plist, args[charset_arg_plist]); hash_hash_t hash_code; - charset.hash_index = hash_lookup (hash_table, args[charset_arg_name], - &hash_code); + charset.hash_index = hash_lookup_get_hash (hash_table, args[charset_arg_name], + &hash_code); if (charset.hash_index >= 0) { new_definition_p = 0; diff --git a/src/charset.h b/src/charset.h index 1743eb4c909..91454d3d73e 100644 --- a/src/charset.h +++ b/src/charset.h @@ -286,7 +286,7 @@ extern int emacs_mule_charset[256]; /* Return an index to Vcharset_hash_table of the charset whose symbol is SYMBOL. */ #define CHARSET_SYMBOL_HASH_INDEX(symbol) \ - hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol, NULL) + hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol) /* Return the attribute vector of CHARSET. */ #define CHARSET_ATTRIBUTES(charset) \ diff --git a/src/coding.h b/src/coding.h index e9b72403c6b..9beb4350bbf 100644 --- a/src/coding.h +++ b/src/coding.h @@ -194,7 +194,7 @@ enum coding_attr_index #define CODING_SYSTEM_ID(coding_system_symbol) \ hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \ - coding_system_symbol, NULL) + coding_system_symbol) /* Return true if CODING_SYSTEM_SYMBOL is a coding system. */ diff --git a/src/composite.c b/src/composite.c index bd69a953e3f..78c884dd72d 100644 --- a/src/composite.c +++ b/src/composite.c @@ -241,7 +241,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, goto invalid_composition; hash_hash_t hash_code; - hash_index = hash_lookup (hash_table, key, &hash_code); + hash_index = hash_lookup_get_hash (hash_table, key, &hash_code); if (hash_index >= 0) { /* We have already registered the same composition. Change PROP @@ -644,7 +644,7 @@ Lisp_Object composition_gstring_lookup_cache (Lisp_Object header) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - ptrdiff_t i = hash_lookup (h, header, NULL); + ptrdiff_t i = hash_lookup (h, header); return (i >= 0 ? HASH_VALUE (h, i) : Qnil); } diff --git a/src/emacs-module.c b/src/emacs-module.c index 728da8c2882..e78391b3a71 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -429,7 +429,7 @@ module_make_global_ref (emacs_env *env, emacs_value value) struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (value); hash_hash_t hashcode; - ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); + ptrdiff_t i = hash_lookup_get_hash (h, new_obj, &hashcode); /* Note: This approach requires the garbage collector to never move objects. */ @@ -468,7 +468,7 @@ module_free_global_ref (emacs_env *env, emacs_value global_value) MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object obj = value_to_lisp (global_value); - ptrdiff_t i = hash_lookup (h, obj, NULL); + ptrdiff_t i = hash_lookup (h, obj); if (module_assertions) { diff --git a/src/fns.c b/src/fns.c index 5a3c51c8412..9d802bba0e2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2731,6 +2731,10 @@ equal_no_quit (Lisp_Object o1, Lisp_Object o2) return internal_equal (o1, o2, EQUAL_NO_QUIT, 0, Qnil); } +static ptrdiff_t hash_lookup_with_hash (struct Lisp_Hash_Table *h, + Lisp_Object key, hash_hash_t hash); + + /* Return true if O1 and O2 are equal. EQUAL_KIND specifies what kind of equality test to use: if it is EQUAL_NO_QUIT, do not check for cycles or large arguments or quits; if EQUAL_PLAIN, do ordinary @@ -2759,8 +2763,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); - hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, o1, &hash); + hash_hash_t hash = hash_from_key (h, o1); + ptrdiff_t i = hash_lookup_with_hash (h, o1, hash); if (i >= 0) { /* `o1' was seen already. */ Lisp_Object o2s = HASH_VALUE (h, i); @@ -4791,27 +4795,40 @@ hash_table_thaw (Lisp_Object hash_table) } } -/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH - the hash code of KEY. Value is the index of the entry in H - matching KEY, or -1 if not found. */ - -ptrdiff_t -hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, hash_hash_t *hash) +/* Look up KEY with hash HASH in table H. + Return entry index or -1 if none. */ +static ptrdiff_t +hash_lookup_with_hash (struct Lisp_Hash_Table *h, + Lisp_Object key, hash_hash_t hash) { - hash_hash_t hash_code = hash_from_key (h, key); - if (hash) - *hash = hash_code; - - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - ptrdiff_t i; - for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) + ptrdiff_t start_of_bucket = hash_index_index (h, hash); + for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); + 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && hash_code == HASH_HASH (h, i) + && hash == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) - break; + return i; - return i; + return -1; +} + +/* Look up KEY in table H. Return entry index or -1 if none. */ +ptrdiff_t +hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key) +{ + return hash_lookup_with_hash (h, key, hash_from_key (h, key)); +} + +/* Look up KEY in hash table H. Return its hash value in *PHASH. + Value is the index of the entry in H matching KEY, or -1 if not found. */ +ptrdiff_t +hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, + hash_hash_t *phash) +{ + EMACS_UINT hash = hash_from_key (h, key); + *phash = hash; + return hash_lookup_with_hash (h, key, hash); } static void @@ -5539,7 +5556,7 @@ If KEY is not found, return DFLT which defaults to nil. */) (Lisp_Object key, Lisp_Object table, Lisp_Object dflt) { struct Lisp_Hash_Table *h = check_hash_table (table); - ptrdiff_t i = hash_lookup (h, key, NULL); + ptrdiff_t i = hash_lookup_with_hash (h, key, hash_from_key (h, key)); return i >= 0 ? HASH_VALUE (h, i) : dflt; } @@ -5553,8 +5570,8 @@ VALUE. In any case, return VALUE. */) struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); - EMACS_UINT hash; - ptrdiff_t i = hash_lookup (h, key, &hash); + EMACS_UINT hash = hash_from_key (h, key); + ptrdiff_t i = hash_lookup_with_hash (h, key, hash); if (i >= 0) set_hash_value_slot (h, i, value); else diff --git a/src/image.c b/src/image.c index 55b027d568b..74d4b6c0bfe 100644 --- a/src/image.c +++ b/src/image.c @@ -6082,7 +6082,7 @@ xpm_put_color_table_h (Lisp_Object color_table, Lisp_Object chars = make_unibyte_string (chars_start, chars_len); hash_hash_t hash_code; - hash_lookup (table, chars, &hash_code); + hash_lookup_get_hash (table, chars, &hash_code); hash_put (table, chars, color, hash_code); } @@ -6093,7 +6093,7 @@ xpm_get_color_table_h (Lisp_Object color_table, { struct Lisp_Hash_Table *table = XHASH_TABLE (color_table); ptrdiff_t i = - hash_lookup (table, make_unibyte_string (chars_start, chars_len), NULL); + hash_lookup (table, make_unibyte_string (chars_start, chars_len)); return i >= 0 ? HASH_VALUE (table, i) : Qnil; } diff --git a/src/json.c b/src/json.c index 1bea4baa8ba..266905f1c34 100644 --- a/src/json.c +++ b/src/json.c @@ -881,7 +881,7 @@ json_to_lisp (json_t *json, const struct json_configuration *conf) { Lisp_Object key = build_string_from_utf8 (key_str); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, key, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, key, &hash); /* Keys in JSON objects are unique, so the key can't be present yet. */ eassert (i < 0); diff --git a/src/lisp.h b/src/lisp.h index 474498094c9..02d9c98da22 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4063,7 +4063,9 @@ EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); -ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, hash_hash_t *); +ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); +ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, + hash_hash_t *phash); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, hash_hash_t); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 9ad4d35c0c2..b76fde3f266 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4256,7 +4256,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) = XHASH_TABLE (read_objects_map); Lisp_Object number = make_fixnum (n); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, number, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, number, &hash); if (i >= 0) /* Not normal, but input could be malformed. */ set_hash_value_slot (h, i, placeholder); @@ -4274,7 +4274,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* #N# -- reference to numbered object */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); - ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL); + ptrdiff_t i = hash_lookup (h, make_fixnum (n)); if (i < 0) invalid_syntax ("#", readcharfun); obj = HASH_VALUE (h, i); @@ -4572,7 +4572,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h2, placeholder, &hash); + ptrdiff_t i = hash_lookup_get_hash (h2, placeholder, &hash); eassert (i < 0); hash_put (h2, placeholder, Qnil, hash); obj = placeholder; @@ -4587,7 +4587,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h2, obj, &hash); + ptrdiff_t i = hash_lookup_get_hash (h2, obj, &hash); eassert (i < 0); hash_put (h2, obj, Qnil, hash); } @@ -4599,7 +4599,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* ...and #n# will use the real value from now on. */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, e->u.numbered.number, + &hash); eassert (i >= 0); set_hash_value_slot (h, i, obj); } @@ -4653,7 +4654,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) by #n=, which means that we can find it as a value in COMPLETED. */ if (EQ (subst->completed, Qt) - || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0) + || hash_lookup (XHASH_TABLE (subst->completed), subtree) >= 0) subst->seen = Fcons (subtree, subst->seen); /* Recurse according to subtree's type. diff --git a/src/macfont.m b/src/macfont.m index dcaa85bea05..48502c2ec00 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -997,7 +997,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, if (HASH_TABLE_P (macfont_family_cache)) { struct Lisp_Hash_Table *h = XHASH_TABLE (macfont_family_cache); - ptrdiff_t i = hash_lookup (h, symbol, NULL); + ptrdiff_t i = hash_lookup (h, symbol); if (i >= 0) { @@ -1024,7 +1024,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, h = XHASH_TABLE (macfont_family_cache); hash_hash_t hash; - i = hash_lookup (h, symbol, &hash); + i = hash_lookup_get_hash (h, symbol, &hash); value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil; if (i >= 0) { diff --git a/src/minibuf.c b/src/minibuf.c index 22bb8fa1d75..8198dc0f360 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2107,7 +2107,7 @@ the values STRING, PREDICATE and `lambda'. */) else if (HASH_TABLE_P (collection)) { struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - i = hash_lookup (h, string, NULL); + i = hash_lookup (h, string); if (i >= 0) { tem = HASH_KEY (h, i); commit a3ae5653cfe1ab2b3eb4c77ce729844ad442b562 Author: Mattias Engdegård Date: Sun Oct 29 11:57:06 2023 +0100 Store hash values as integers instead of Lisp_Object This improves typing, saves pointless tagging and untagging, and prepares for further changes. The new typedef hash_hash_t is an alias for EMACS_UINT, and hash values are still limited to the fixnum range. We now use hash_unused instead of Qnil to mark unused entries. * src/lisp.h (hash_hash_t): New typedef for EMACS_UINT. (hash_unused): New constant. (struct hash_table_test): `hashfn` now returns hash_hash_t. All callers and implementations changed. (struct Lisp_Hash_Table): Retype hash vector to an array of hash_hash_t. All code using it changed accordingly. (HASH_HASH, hash_from_key): * src/fns.c (set_hash_index_slot, hash_index_index) (hash_lookup_with_hash, hash_lookup_get_hash, hash_put): (hash_lookup, hash_put): Retype hash value arguments and return values. All callers adapted. diff --git a/src/category.c b/src/category.c index 583cdb3eebb..e7fbf1ff500 100644 --- a/src/category.c +++ b/src/category.c @@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) (table, 1, make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); if (i >= 0) return HASH_KEY (h, i); diff --git a/src/charset.c b/src/charset.c index 3aa105e57bd..add3bf846f8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -850,7 +850,6 @@ usage: (define-charset-internal ...) */) /* Charset attr vector. */ Lisp_Object attrs; Lisp_Object val; - Lisp_Object hash_code; struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table); int i, j; struct charset charset; @@ -1108,6 +1107,7 @@ usage: (define-charset-internal ...) */) CHECK_LIST (args[charset_arg_plist]); ASET (attrs, charset_plist, args[charset_arg_plist]); + hash_hash_t hash_code; charset.hash_index = hash_lookup (hash_table, args[charset_arg_name], &hash_code); if (charset.hash_index >= 0) diff --git a/src/composite.c b/src/composite.c index ed1aeb380a0..bd69a953e3f 100644 --- a/src/composite.c +++ b/src/composite.c @@ -166,7 +166,7 @@ ptrdiff_t get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, Lisp_Object prop, Lisp_Object string) { - Lisp_Object id, length, components, key, *key_contents, hash_code; + Lisp_Object id, length, components, key, *key_contents; ptrdiff_t glyph_len; struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table); ptrdiff_t hash_index; @@ -240,6 +240,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, else goto invalid_composition; + hash_hash_t hash_code; hash_index = hash_lookup (hash_table, key, &hash_code); if (hash_index >= 0) { @@ -653,7 +654,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); Lisp_Object header = LGSTRING_HEADER (gstring); - Lisp_Object hash = hash_from_key (h, header); + EMACS_UINT hash = hash_from_key (h, header); if (len < 0) { ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring); diff --git a/src/emacs-module.c b/src/emacs-module.c index 60aed68f2cd..728da8c2882 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -427,7 +427,8 @@ module_make_global_ref (emacs_env *env, emacs_value value) { MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object new_obj = value_to_lisp (value), hashcode; + Lisp_Object new_obj = value_to_lisp (value); + hash_hash_t hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); /* Note: This approach requires the garbage collector to never move diff --git a/src/fns.c b/src/fns.c index 3aca588a8a5..5a3c51c8412 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2759,7 +2759,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, o1, &hash); if (i >= 0) { /* `o1' was seen already. */ @@ -4279,7 +4279,7 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) h->next[idx] = val; } static void -set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) { eassert (idx >= 0 && idx < h->table_size); h->hash[idx] = val; @@ -4450,41 +4450,42 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, /* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ -static Lisp_Object +static hash_hash_t hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) key = SYMBOL_WITH_POS_SYM (key); - return make_ufixnum (XHASH (key) ^ XTYPE (key)); + return XHASH (key) ^ XTYPE (key); } /* Ignore H and return a hash code for KEY which uses 'equal' to compare keys. The hash code is at most INTMASK. */ -static Lisp_Object +static hash_hash_t hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return make_ufixnum (sxhash (key)); + return sxhash (key); } /* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. The hash code is at most INTMASK. */ -static Lisp_Object +static hash_hash_t hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { - return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h); + return (FLOATP (key) || BIGNUMP (key) + ? hashfn_equal (key, h) : hashfn_eq (key, h)); } /* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ -static Lisp_Object +static hash_hash_t hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash)); + return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); } struct hash_table_test const @@ -4584,7 +4585,8 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - memclear (h->hash, size * sizeof *h->hash); + for (ptrdiff_t i = 0; i < size; i++) + h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size - 1; i++) @@ -4650,10 +4652,10 @@ copy_hash_table (struct Lisp_Hash_Table *h1) /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t -hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) +hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { eassert (h->index_size > 0); - return XUFIXNUM (hash_code) % h->index_size; + return hash % h->index_size; } /* Resize hash table H if it's too full. If H cannot be resized @@ -4690,9 +4692,10 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) key_and_value[i] = HASH_UNUSED_ENTRY_KEY; - Lisp_Object *hash = hash_table_alloc_bytes (new_size * sizeof *hash); + hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - memclear (hash + old_size, (new_size - old_size) * word_size); + for (ptrdiff_t i = old_size; i < new_size; i++) + hash[i] = hash_unused; ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); @@ -4723,7 +4726,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Rehash: all data occupy entries 0..old_size-1. */ for (ptrdiff_t i = 0; i < old_size; i++) { - Lisp_Object hash_code = HASH_HASH (h, i); + hash_hash_t hash_code = HASH_HASH (h, i); ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); @@ -4764,7 +4767,8 @@ hash_table_thaw (Lisp_Object hash_table) h->next_free = -1; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - memclear (h->hash, size * sizeof *h->hash); + for (ptrdiff_t i = 0; i < size; i++) + h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size; i++) @@ -4779,7 +4783,7 @@ hash_table_thaw (Lisp_Object hash_table) for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object key = HASH_KEY (h, i); - Lisp_Object hash_code = hash_from_key (h, key); + hash_hash_t hash_code = hash_from_key (h, key); ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); @@ -4792,9 +4796,9 @@ hash_table_thaw (Lisp_Object hash_table) matching KEY, or -1 if not found. */ ptrdiff_t -hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) +hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, hash_hash_t *hash) { - Lisp_Object hash_code = hash_from_key (h, key); + hash_hash_t hash_code = hash_from_key (h, key); if (hash) *hash = hash_code; @@ -4803,7 +4807,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && EQ (hash_code, HASH_HASH (h, i)) + && hash_code == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) break; @@ -4824,7 +4828,7 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, - Lisp_Object hash) + hash_hash_t hash) { /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); @@ -4832,7 +4836,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; - eassert (NILP (HASH_HASH (h, i))); + eassert (HASH_HASH (h, i) == hash_unused); eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); @@ -4854,8 +4858,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, void hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { - Lisp_Object hash_code = hash_from_key (h, key); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + hash_hash_t hashval = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hashval); ptrdiff_t prev = -1; for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); @@ -4864,7 +4868,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && EQ (hash_code, HASH_HASH (h, i)) + && hashval == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ @@ -4877,7 +4881,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) the free list. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, h->next_free); h->next_free = i; h->count--; @@ -4898,9 +4902,9 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - memclear (h->hash, size * word_size); for (ptrdiff_t i = 0; i < size; i++) { + set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); @@ -4983,7 +4987,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) /* Clear key, value, and hash. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, hash_unused); eassert (h->count != 0); h->count--; @@ -5269,7 +5273,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_eq (obj, NULL); + return make_ufixnum (hashfn_eq (obj, NULL)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -5280,7 +5284,7 @@ isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_eql (obj, NULL); + return make_ufixnum (hashfn_eql (obj, NULL)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -5291,7 +5295,7 @@ opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_equal (obj, NULL); + return make_ufixnum (hashfn_equal (obj, NULL)); } DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties, @@ -5315,7 +5319,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) sxhash (CDR (collector))))); } - return hashfn_equal (obj, NULL); + return make_ufixnum (hashfn_equal (obj, NULL)); } DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, @@ -5549,7 +5553,7 @@ VALUE. In any case, return VALUE. */) struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); - Lisp_Object hash; + EMACS_UINT hash; ptrdiff_t i = hash_lookup (h, key, &hash); if (i >= 0) set_hash_value_slot (h, i, value); @@ -5650,7 +5654,7 @@ Internal use only. */) { Lisp_Object bucket = Qnil; for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) - bucket = Fcons (Fcons (HASH_KEY (h, j), HASH_HASH (h, j)), + bucket = Fcons (Fcons (HASH_KEY (h, j), make_int (HASH_HASH (h, j))), bucket); if (!NILP (bucket)) ret = Fcons (Fnreverse (bucket), ret); diff --git a/src/image.c b/src/image.c index 9c100213590..55b027d568b 100644 --- a/src/image.c +++ b/src/image.c @@ -6079,8 +6079,9 @@ xpm_put_color_table_h (Lisp_Object color_table, Lisp_Object color) { struct Lisp_Hash_Table *table = XHASH_TABLE (color_table); - Lisp_Object chars = make_unibyte_string (chars_start, chars_len), hash_code; + Lisp_Object chars = make_unibyte_string (chars_start, chars_len); + hash_hash_t hash_code; hash_lookup (table, chars, &hash_code); hash_put (table, chars, color, hash_code); } diff --git a/src/json.c b/src/json.c index d98b312ecc9..1bea4baa8ba 100644 --- a/src/json.c +++ b/src/json.c @@ -879,7 +879,8 @@ json_to_lisp (json_t *json, const struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = build_string_from_utf8 (key_str), hash; + Lisp_Object key = build_string_from_utf8 (key_str); + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, key, &hash); /* Keys in JSON objects are unique, so the key can't be present yet. */ diff --git a/src/lisp.h b/src/lisp.h index dd457392cca..474498094c9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2385,6 +2385,10 @@ INLINE int struct Lisp_Hash_Table; +/* The type of a hash value stored in the table. + It's unsigned and a subtype of EMACS_UINT. */ +typedef EMACS_UINT hash_hash_t; + typedef enum { Test_eql, Test_eq, @@ -2406,7 +2410,7 @@ struct hash_table_test Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); /* C function to compute hash code. */ - Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); }; typedef enum { @@ -2421,6 +2425,11 @@ typedef enum { both key and value remain. */ } hash_table_weakness_t; +/* An value that marks an unused hash entry. + Any hash_hash_t value that is not a valid fixnum will do here. */ +enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; +verify (FIXNUM_OVERFLOW_P (hash_unused)); + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2462,9 +2471,9 @@ struct Lisp_Hash_Table ptrdiff_t table_size; /* Size of the next and hash vectors. */ - /* Vector of hash codes. Each entry is either a fixnum, or nil if unused. + /* Vector of hash codes. The value hash_unused marks an unused table entry. This vector is table_size entries long. */ - Lisp_Object *hash; + hash_hash_t *hash; /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, @@ -2553,7 +2562,7 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) } /* Value is the hash code computed for entry IDX in hash table H. */ -INLINE Lisp_Object +INLINE hash_hash_t HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { eassert (idx >= 0 && idx < h->table_size); @@ -2567,8 +2576,8 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return h->table_size; } -/* Compute hash value for KEY in hash table H. */ -INLINE Lisp_Object +/* Hash value for KEY in hash table H. */ +INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) { return h->test.hashfn (key, h); @@ -4054,9 +4063,9 @@ EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); -ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); +ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, hash_hash_t *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, - Lisp_Object); + hash_hash_t); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, diff --git a/src/lread.c b/src/lread.c index 284536fc81f..9ad4d35c0c2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4255,7 +4255,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); Lisp_Object number = make_fixnum (n); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, number, &hash); if (i >= 0) /* Not normal, but input could be malformed. */ @@ -4571,7 +4571,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h2, placeholder, &hash); eassert (i < 0); hash_put (h2, placeholder, Qnil, hash); @@ -4586,7 +4586,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) { struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h2, obj, &hash); eassert (i < 0); hash_put (h2, obj, Qnil, hash); @@ -4598,7 +4598,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* ...and #n# will use the real value from now on. */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash); eassert (i >= 0); set_hash_value_slot (h, i, obj); diff --git a/src/macfont.m b/src/macfont.m index 8aba440d196..dcaa85bea05 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -980,7 +980,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ptrdiff_t i, size = HASH_TABLE_SIZE (h); for (i = 0; i < size; ++i) - if (!NILP (HASH_HASH (h, i))) + if (HASH_HASH (h, i) != hash_unused) { Lisp_Object value = HASH_VALUE (h, i); @@ -1017,12 +1017,13 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, { struct Lisp_Hash_Table *h; ptrdiff_t i; - Lisp_Object hash, value; + Lisp_Object value; if (!HASH_TABLE_P (macfont_family_cache)) macfont_family_cache = CALLN (Fmake_hash_table, QCtest, Qeq); h = XHASH_TABLE (macfont_family_cache); + hash_hash_t hash; i = hash_lookup (h, symbol, &hash); value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil; if (i >= 0) diff --git a/src/pdumper.c b/src/pdumper.c index 8a93c45e07b..5ed91c668df 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2661,7 +2661,7 @@ hash_table_contents (struct Lisp_Hash_Table *h) relies on it by expecting hash table indices to stay constant across the dump. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (!NILP (HASH_HASH (h, i))) + if (HASH_HASH (h, i) != hash_unused) { key_and_value[n++] = HASH_KEY (h, i); key_and_value[n++] = HASH_VALUE (h, i); commit fa5c07fc87d557e642fc325852e8d0c87a9c176e Author: Mattias Engdegård Date: Fri Oct 27 22:15:09 2023 +0200 Use non-Lisp allocation for internal hash-table vectors Using xmalloc for allocating these arrays is much cheaper than using Lisp vectors since they are no longer marked or swept by the GC, and deallocated much sooner. This makes GC faster and less frequent, and improves temporal locality. Zero-sized tables use NULL for their (0-length) vectors except the index vector which has size 1 and uses a shared constant static vector since it cannot be modified anyway. This makes creation and destruction of zero-sized hash tables very fast; they consume no memory outside the base object. * src/lisp.h (struct Lisp_Hash_Table): Retype the index, next, hash and key_and_value vectors from Lisp_Object to appropriately typed arrays (although hash values are still stored as Lisp fixnums). Add explicit table_size and index_size members. All users updated. * src/alloc.c (gcstat): Add total_hash_table_bytes. (hash_table_allocated_bytes): New. (cleanup_vector): Free hash table vectors when sweeping the object. (hash_table_alloc_bytes, hash_table_free_bytes): New. (sweep_vectors): Update gcstat.total_hash_table_bytes. (total_bytes_of_live_objects): Use it. (purecopy_hash_table): Adapt allocation of hash table vectors. (process_mark_stack): No more Lisp slots in the struct to trace. * src/fns.c (empty_hash_index_vector): New. (allocate_hash_table): Allocate without automatically GCed slots. (alloc_larger_vector): Remove. (make_hash_table, copy_hash_table, maybe_resize_hash_table): Adapt vector allocation and initialisation. * src/pdumper.c (hash_table_freeze, hash_table_thaw, dump_hash_table) (dump_hash_table_contents): Adapt dumping and loading to field changes. diff --git a/src/alloc.c b/src/alloc.c index 636b4972c84..7432163db25 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -359,8 +359,16 @@ static struct gcstat object_ct total_floats, total_free_floats; object_ct total_intervals, total_free_intervals; object_ct total_buffers; + + /* Size of the ancillary arrays of live hash-table objects. + The objects themselves are not included (counted as vectors above). */ + byte_ct total_hash_table_bytes; } gcstat; +/* Total size of ancillary arrays of all allocated hash-table objects, + both dead and alive. This number is always kept up-to-date. */ +static ptrdiff_t hash_table_allocated_bytes = 0; + /* Points to memory space allocated as "spare", to be freed if we run out of memory. We keep one large block, four cons-blocks, and two string blocks. */ @@ -3430,6 +3438,23 @@ cleanup_vector (struct Lisp_Vector *vector) } #endif break; + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); + if (h->table_size > 0) + { + eassert (h->index_size > 1); + xfree (h->index); + xfree (h->key_and_value); + xfree (h->next); + xfree (h->hash); + ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value + + sizeof *h->hash + + sizeof *h->next) + + h->index_size * sizeof *h->index); + hash_table_allocated_bytes -= bytes; + } + } /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -3440,7 +3465,6 @@ cleanup_vector (struct Lisp_Vector *vector) case PVEC_WINDOW: case PVEC_BOOL_VECTOR: case PVEC_BUFFER: - case PVEC_HASH_TABLE: case PVEC_TERMINAL: case PVEC_WINDOW_CONFIGURATION: case PVEC_OTHER: @@ -3554,6 +3578,8 @@ sweep_vectors (void) lisp_free (lv); } } + + gcstat.total_hash_table_bytes = hash_table_allocated_bytes; } /* Maximum number of elements in a vector. This is a macro so that it @@ -5606,6 +5632,28 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } +/* Like xmalloc, but makes allocation count toward the total consing. + Return NULL for a zero-sized allocation. */ +void * +hash_table_alloc_bytes (ptrdiff_t nbytes) +{ + if (nbytes == 0) + return NULL; + tally_consing (nbytes); + hash_table_allocated_bytes += nbytes; + return xmalloc (nbytes); +} + +/* Like xfree, but makes allocation count toward the total consing. */ +void +hash_table_free_bytes (void *p, ptrdiff_t nbytes) +{ + tally_consing (-nbytes); + hash_table_allocated_bytes -= nbytes; + xfree (p); +} + + /*********************************************************************** Pure Storage Management ***********************************************************************/ @@ -5897,10 +5945,28 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure->test.name = purecopy (table->test.name); pure->test.user_hash_function = purecopy (table->test.user_hash_function); pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); - pure->hash = purecopy (table->hash); - pure->next = purecopy (table->next); - pure->index = purecopy (table->index); - pure->key_and_value = purecopy (table->key_and_value); + + if (table->table_size > 0) + { + ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; + pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); + memcpy (pure->hash, table->hash, hash_bytes); + + ptrdiff_t next_bytes = table->table_size * sizeof *table->next; + pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); + memcpy (pure->next, table->next, next_bytes); + + ptrdiff_t nvalues = table->table_size * 2; + ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; + pure->key_and_value = pure_alloc (kv_bytes, + -(int)sizeof *table->key_and_value); + for (ptrdiff_t i = 0; i < nvalues; i++) + pure->key_and_value[i] = purecopy (table->key_and_value[i]); + + ptrdiff_t index_bytes = table->index_size * sizeof *table->index; + pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); + memcpy (pure->index, table->index, index_bytes); + } return pure; } @@ -6084,6 +6150,7 @@ total_bytes_of_live_objects (void) tot += object_bytes (gcstat.total_floats, sizeof (struct Lisp_Float)); tot += object_bytes (gcstat.total_intervals, sizeof (struct interval)); tot += object_bytes (gcstat.total_strings, sizeof (struct Lisp_String)); + tot += gcstat.total_hash_table_bytes; return tot; } @@ -7227,23 +7294,20 @@ process_mark_stack (ptrdiff_t base_sp) case PVEC_HASH_TABLE: { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; - ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; set_vector_marked (ptr); - mark_stack_push_values (ptr->contents, size); mark_stack_push_value (h->test.name); mark_stack_push_value (h->test.user_hash_function); mark_stack_push_value (h->test.user_cmp_function); if (h->weakness == Weak_None) - mark_stack_push_value (h->key_and_value); + mark_stack_push_values (h->key_and_value, + 2 * h->table_size); else { - /* For weak tables, mark only the vector and not its + /* For weak tables, don't mark the contents --- that's what makes it weak. */ eassert (h->next_weak == NULL); h->next_weak = weak_hash_tables; weak_hash_tables = h; - if (!PURE_P (h->key_and_value)) - set_vector_marked (XVECTOR (h->key_and_value)); } break; } diff --git a/src/fns.c b/src/fns.c index a1659884b5e..3aca588a8a5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4275,17 +4275,20 @@ CHECK_HASH_TABLE (Lisp_Object x) static void set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->next, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->table_size); + h->next[idx] = val; } static void set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->hash, idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->hash[idx] = val; } static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->index, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->index_size); + h->index[idx] = val; } /* If OBJ is a Lisp hash table, return a pointer to its struct @@ -4375,7 +4378,8 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) static ptrdiff_t HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->next, idx)); + eassert (idx >= 0 && idx < h->table_size); + return h->next[idx]; } /* Return the index of the element in hash table H that is the start @@ -4384,7 +4388,8 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->index, idx)); + eassert (idx >= 0 && idx < h->index_size); + return h->index[idx]; } /* Restore a hash table's mutability after the critical section exits. */ @@ -4495,8 +4500,7 @@ struct hash_table_test const static struct Lisp_Hash_Table * allocate_hash_table (void) { - return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, - index, PVEC_HASH_TABLE); + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } /* An upper bound on the size of a hash table index. It must fit in @@ -4528,6 +4532,10 @@ hash_index_size (ptrdiff_t size) return index_size; } +/* Constant hash index vector used when the table size is zero. + This avoids allocating it from the heap. */ +static const ptrdiff_t empty_hash_index_vector[] = {-1}; + /* Create and initialize a new hash table. TEST specifies the test the hash table will use to compare keys. @@ -4547,36 +4555,54 @@ Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - struct Lisp_Hash_Table *h; - Lisp_Object table; - ptrdiff_t i; - - /* Preconditions. */ eassert (SYMBOLP (test.name)); - eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); + eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); - /* Allocate a table and initialize it. */ - h = allocate_hash_table (); + struct Lisp_Hash_Table *h = allocate_hash_table (); - /* Initialize hash table slots. */ h->test = test; h->weakness = weak; h->count = 0; - h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (hash_index_size (size), make_fixnum (-1)); + h->table_size = size; + int index_size = hash_index_size (size); + h->index_size = index_size; + + if (size == 0) + { + h->key_and_value = NULL; + h->hash = NULL; + h->next = NULL; + eassert (index_size == 1); + h->index = (ptrdiff_t *)empty_hash_index_vector; + h->next_free = -1; + } + else + { + h->key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *h->key_and_value); + for (ptrdiff_t i = 0; i < 2 * size; i++) + h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; + + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size - 1; i++) + h->next[i] = i + 1; + h->next[size - 1] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; + + h->next_free = 0; + } + h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; - /* Set up the free list. */ - for (i = 0; i < size - 1; ++i) - set_hash_next_slot (h, i, i + 1); - if (size > 0) - set_hash_next_slot (h, size - 1, -1); - h->next_free = size > 0 ? 0 : -1; - + Lisp_Object table; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); eassert (XHASH_TABLE (table) == h); @@ -4597,35 +4623,37 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2 = allocate_hash_table (); *h2 = *h1; h2->mutable = true; - h2->key_and_value = Fcopy_sequence (h1->key_and_value); - h2->hash = Fcopy_sequence (h1->hash); - h2->next = Fcopy_sequence (h1->next); - h2->index = Fcopy_sequence (h1->index); + + if (h1->table_size > 0) + { + ptrdiff_t kv_bytes = 2 * h1->table_size * sizeof *h1->key_and_value; + h2->key_and_value = hash_table_alloc_bytes (kv_bytes); + memcpy (h2->key_and_value, h1->key_and_value, kv_bytes); + + ptrdiff_t hash_bytes = h1->table_size * sizeof *h1->hash; + h2->hash = hash_table_alloc_bytes (hash_bytes); + memcpy (h2->hash, h1->hash, hash_bytes); + + ptrdiff_t next_bytes = h1->table_size * sizeof *h1->next; + h2->next = hash_table_alloc_bytes (next_bytes); + memcpy (h2->next, h1->next, next_bytes); + + ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; + h2->index = hash_table_alloc_bytes (index_bytes); + memcpy (h2->index, h1->index, index_bytes); + } XSET_HASH_TABLE (table, h2); return table; } -/* Allocate a Lisp vector of NEW_SIZE elements. - Copy elements from VEC and leave the rest undefined. */ -static Lisp_Object -alloc_larger_vector (Lisp_Object vec, ptrdiff_t new_size) -{ - eassert (VECTORP (vec)); - ptrdiff_t old_size = ASIZE (vec); - eassert (new_size >= old_size); - struct Lisp_Vector *v = allocate_vector (new_size); - memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); - XSETVECTOR (vec, v); - return vec; -} - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) { - return XUFIXNUM (hash_code) % ASIZE (h->index); + eassert (h->index_size > 0); + return XUFIXNUM (hash_code) % h->index_size; } /* Resize hash table H if it's too full. If H cannot be resized @@ -4650,37 +4678,56 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ - Lisp_Object next = alloc_larger_vector (h->next, new_size); + ptrdiff_t *next = hash_table_alloc_bytes (new_size * sizeof *next); for (ptrdiff_t i = old_size; i < new_size - 1; i++) - ASET (next, i, make_fixnum (i + 1)); - ASET (next, new_size - 1, make_fixnum (-1)); + next[i] = i + 1; + next[new_size - 1] = -1; - /* Build the new&larger key_and_value vector, making sure the new - fields are initialized to `unbound`. */ - Lisp_Object key_and_value - = alloc_larger_vector (h->key_and_value, 2 * new_size); + Lisp_Object *key_and_value + = hash_table_alloc_bytes (2 * new_size * sizeof *key_and_value); + memcpy (key_and_value, h->key_and_value, + 2 * old_size * sizeof *key_and_value); for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) - ASET (key_and_value, i, HASH_UNUSED_ENTRY_KEY); + key_and_value[i] = HASH_UNUSED_ENTRY_KEY; - Lisp_Object hash = alloc_larger_vector (h->hash, new_size); - memclear (XVECTOR (hash)->contents + old_size, - (new_size - old_size) * word_size); + Lisp_Object *hash = hash_table_alloc_bytes (new_size * sizeof *hash); + memcpy (hash, h->hash, old_size * sizeof *hash); + memclear (hash + old_size, (new_size - old_size) * word_size); + + ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); - h->index = make_vector (index_size, make_fixnum (-1)); + ptrdiff_t *index = hash_table_alloc_bytes (index_size * sizeof *index); + for (ptrdiff_t i = 0; i < index_size; i++) + index[i] = -1; + + h->index_size = index_size; + h->table_size = new_size; + h->next_free = old_size; + + if (old_index_size > 1) + hash_table_free_bytes (h->index, old_index_size * sizeof *h->index); + h->index = index; + + hash_table_free_bytes (h->key_and_value, + 2 * old_size * sizeof *h->key_and_value); h->key_and_value = key_and_value; + + hash_table_free_bytes (h->hash, old_size * sizeof *h->hash); h->hash = hash; + + hash_table_free_bytes (h->next, old_size * sizeof *h->next); h->next = next; - h->next_free = old_size; - /* Rehash. */ + h->key_and_value = key_and_value; + + /* Rehash: all data occupy entries 0..old_size-1. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (!NILP (HASH_HASH (h, i))) - { - Lisp_Object hash_code = HASH_HASH (h, i); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, i); - } + { + Lisp_Object hash_code = HASH_HASH (h, i); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index_slot (h, start_of_bucket, i); + } #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) @@ -4710,14 +4757,22 @@ hash_table_thaw (Lisp_Object hash_table) /* Freezing discarded most non-essential information; recompute it. The allocation is minimal with no room for growth. */ h->test = *hash_table_test_from_std (h->frozen_test); - ptrdiff_t size = ASIZE (h->key_and_value) / 2; - h->count = size; + ptrdiff_t size = h->count; + h->table_size = size; ptrdiff_t index_size = hash_index_size (size); + h->index_size = index_size; h->next_free = -1; - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (index_size, make_fixnum (-1)); + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size; i++) + h->next[i] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ @@ -4843,7 +4898,7 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - memclear (xvector_contents (h->hash), size * word_size); + memclear (h->hash, size * word_size); for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); @@ -4851,8 +4906,8 @@ hash_clear (struct Lisp_Hash_Table *h) set_hash_value_slot (h, i, Qnil); } - for (ptrdiff_t i = 0; i < ASIZE (h->index); i++) - ASET (h->index, i, make_fixnum (-1)); + for (ptrdiff_t i = 0; i < h->index_size; i++) + h->index[i] = -1; h->next_free = 0; h->count = 0; @@ -4890,7 +4945,7 @@ keep_entry_p (hash_table_weakness_t weakness, bool sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { - ptrdiff_t n = gc_asize (h->index); + ptrdiff_t n = h->index_size; bool marked = false; for (ptrdiff_t bucket = 0; bucket < n; ++bucket) @@ -4928,8 +4983,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) /* Clear key, value, and hash. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - if (!NILP (h->hash)) - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, Qnil); eassert (h->count != 0); h->count--; @@ -5563,7 +5617,7 @@ DEFUN ("internal--hash-table-histogram", struct Lisp_Hash_Table *h = check_hash_table (hash_table); ptrdiff_t size = HASH_TABLE_SIZE (h); ptrdiff_t *freq = xzalloc (size * sizeof *freq); - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { ptrdiff_t n = 0; @@ -5591,7 +5645,7 @@ Internal use only. */) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); Lisp_Object ret = Qnil; - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { Lisp_Object bucket = Qnil; @@ -5612,8 +5666,7 @@ DEFUN ("internal--hash-table-index-size", (Lisp_Object hash_table) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); - ptrdiff_t index_size = ASIZE (h->index); - return make_int (index_size); + return make_int (h->index_size); } diff --git a/src/lisp.h b/src/lisp.h index f863df6bca0..dd457392cca 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2450,25 +2450,28 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - /* Vector of hash codes, or nil if the table needs rehashing. - If the I-th entry is unused, then hash[I] should be nil. */ - Lisp_Object hash; + /* Bucket vector. An entry of -1 indicates no item is present, + and a nonnegative entry is the index of the first item in + a collision chain. + This vector is index_size entries long. + If index_size is 1 (and table_size is 0), then this is the + constant read-only vector {-1}, shared between all instances. + Otherwise it is heap-allocated. */ + ptrdiff_t *index; + ptrdiff_t index_size; /* Size of the index vector. */ + + ptrdiff_t table_size; /* Size of the next and hash vectors. */ + + /* Vector of hash codes. Each entry is either a fixnum, or nil if unused. + This vector is table_size entries long. */ + Lisp_Object *hash; /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, next[I] is the index of the next entry in the collision chain, - or -1 if there is such entry. */ - Lisp_Object next; - - /* Bucket vector. An entry of -1 indicates no item is present, - and a nonnegative entry is the index of the first item in - a collision chain. This vector's size can be larger than the - hash table size to reduce collisions. */ - Lisp_Object index; - - /* Only the fields above are traced normally by the GC. The ones after - 'index' are special and are either ignored by the GC or traced in - a special way (e.g. because of weakness). */ + or -1 if there is no such entry. + This vector is table_size entries long. */ + ptrdiff_t *next; /* Number of key/value entries in the table. */ ptrdiff_t count; @@ -2494,8 +2497,9 @@ struct Lisp_Hash_Table /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. - This is gc_marked specially if the table is weak. */ - Lisp_Object key_and_value; + This is gc_marked specially if the table is weak. + This vector is 2 * table_size entries long. */ + Lisp_Object *key_and_value; /* The comparison and hash functions. */ struct hash_table_test test; @@ -2506,9 +2510,6 @@ struct Lisp_Hash_Table struct Lisp_Hash_Table *next_weak; } GCALIGNED_STRUCT; -/* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Hash_Table, hash) == header_size); - /* Key value that marks an unused hash table entry. */ #define HASH_UNUSED_ENTRY_KEY Qunbound @@ -2539,28 +2540,31 @@ XHASH_TABLE (Lisp_Object a) INLINE Lisp_Object HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->key_and_value, 2 * idx); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx]; } /* Value is the value part of entry IDX in hash table H. */ INLINE Lisp_Object HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->key_and_value, 2 * idx + 1); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx + 1]; } /* Value is the hash code computed for entry IDX in hash table H. */ INLINE Lisp_Object HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->hash, idx); + eassert (idx >= 0 && idx < h->table_size); + return h->hash[idx]; } /* Value is the size of hash table H. */ INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) { - return ASIZE (h->next); + return h->table_size; } /* Compute hash value for KEY in hash table H. */ @@ -3781,13 +3785,15 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args, INLINE void set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx] = val; } INLINE void set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx + 1, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx + 1] = val;; } /* Use these functions to set Lisp_Object @@ -4458,6 +4464,9 @@ extern void syms_of_alloc (void); extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); +void *hash_table_alloc_bytes (ptrdiff_t nbytes); +void hash_table_free_bytes (void *p, ptrdiff_t nbytes); + /* Defined in gmalloc.c. */ #if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC extern size_t __malloc_extra_blocks; diff --git a/src/pdumper.c b/src/pdumper.c index e4349f0cb17..8a93c45e07b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2648,12 +2648,13 @@ dump_vectorlike_generic (struct dump_context *ctx, /* Return a vector of KEY, VALUE pairs in the given hash table H. No room for growth is included. */ -static Lisp_Object +static Lisp_Object * hash_table_contents (struct Lisp_Hash_Table *h) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); ptrdiff_t size = h->count; - Lisp_Object key_and_value = make_uninit_vector (2 * size); + Lisp_Object *key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *key_and_value); ptrdiff_t n = 0; /* Make sure key_and_value ends up in the same order; charset.c @@ -2662,8 +2663,8 @@ hash_table_contents (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < old_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)); + key_and_value[n++] = HASH_KEY (h, i); + key_and_value[n++] = HASH_VALUE (h, i); } return key_and_value; @@ -2698,14 +2699,37 @@ static void hash_table_freeze (struct Lisp_Hash_Table *h) { h->key_and_value = hash_table_contents (h); - eassert (ASIZE (h->key_and_value) == h->count * 2); - h->next = Qnil; - h->hash = Qnil; - h->index = Qnil; - h->count = 0; + h->next = NULL; + h->hash = NULL; + h->index = NULL; + h->table_size = 0; + h->index_size = 0; h->frozen_test = hash_table_std_test (&h->test); } +static dump_off +dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = 2 * h->count; + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &h->key_and_value[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { @@ -2721,15 +2745,21 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object 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, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, frozen_test); - dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); + if (hash->key_and_value) + dump_field_fixup_later (ctx, out, hash, &hash->key_and_value); eassert (hash->next_weak == NULL); - return finish_dump_pvec (ctx, &out->header); + dump_off offset = finish_dump_pvec (ctx, &out->header); + if (hash->key_and_value) + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Hash_Table, key_and_value), + dump_hash_table_contents (ctx, hash)); + return offset; } static dump_off diff --git a/src/print.c b/src/print.c index cc8df639f4f..c27c66ae40a 100644 --- a/src/print.c +++ b/src/print.c @@ -1455,8 +1455,8 @@ print_preprocess (Lisp_Object obj) if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - obj = h->key_and_value; - continue; + pp_stack_push_values (h->key_and_value, + 2 * h->table_size); } break; } commit 49fd4d120deb0b878ad262aea7d849c7275bc12c Author: Mattias Engdegård Date: Sat Nov 4 15:16:38 2023 +0100 Allow zero hash table size This avoids any extra allocation for such vectors, including empty tables read by the Lisp reader, and provides extra safety essentially for free. * src/fns.c (make_hash_table): Allow tables to be 0-sized. The index will always have at least one entry, to avoid extra look-up costs. * src/alloc.c (process_mark_stack): Don't mark pure objects, because empty vectors are pure. diff --git a/src/alloc.c b/src/alloc.c index 17ed711a318..636b4972c84 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7242,7 +7242,8 @@ process_mark_stack (ptrdiff_t base_sp) eassert (h->next_weak == NULL); h->next_weak = weak_hash_tables; weak_hash_tables = h; - set_vector_marked (XVECTOR (h->key_and_value)); + if (!PURE_P (h->key_and_value)) + set_vector_marked (XVECTOR (h->key_and_value)); } break; } diff --git a/src/fns.c b/src/fns.c index 74fdf29417e..a1659884b5e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4555,9 +4555,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, eassert (SYMBOLP (test.name)); eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); - if (size == 0) - size = 1; - /* Allocate a table and initialize it. */ h = allocate_hash_table (); @@ -4576,7 +4573,9 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Set up the free list. */ for (i = 0; i < size - 1; ++i) set_hash_next_slot (h, i, i + 1); - h->next_free = 0; + if (size > 0) + set_hash_next_slot (h, size - 1, -1); + h->next_free = size > 0 ? 0 : -1; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); diff --git a/src/lisp.h b/src/lisp.h index d9b828b0328..f863df6bca0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2560,9 +2560,7 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) { - ptrdiff_t size = ASIZE (h->next); - eassume (0 < size); - return size; + return ASIZE (h->next); } /* Compute hash value for KEY in hash table H. */ commit d3cefd3e98354929d96c9396e5920e8a123784dc Author: Mattias Engdegård Date: Sat Nov 4 16:34:09 2023 +0100 Leaner hash table dumping and thawing Only dump the actual data, and the test encoded as an enum. This simplifies dumping, makes dump files smaller and saves space at run time. * src/lisp.h (hash_table_std_test_t): New enum. (struct Lisp_Hash_Table): Add frozen_test member, consuming no extra space. * src/fns.c (hashfn_user_defined): Now static. (hash_table_test_from_std): New. (hash_table_rehash): Rename to... (hash_table_thaw): ...this and rewrite. * src/pdumper.c (hash_table_contents): Only include actual data, not unused space. (hash_table_std_test): New. (hash_table_freeze): Set frozen_test from test. (dump_hash_table): Dump frozen_test, not the whole test struct. Don't bother other dumping fields that can be derived. diff --git a/src/fns.c b/src/fns.c index efec74d4959..74fdf29417e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4474,7 +4474,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) /* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ -Lisp_Object +static Lisp_Object hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; @@ -4638,11 +4638,10 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - EMACS_INT new_size; - - double float_new_size = old_size * std_rehash_size; - if (float_new_size < EMACS_INT_MAX) - new_size = float_new_size; + /* FIXME: better growth management, ditch std_rehash_size */ + EMACS_INT new_size = old_size * std_rehash_size; + if (new_size < EMACS_INT_MAX) + new_size = max (new_size, 32); /* avoid slow initial growth */ else new_size = EMACS_INT_MAX; if (PTRDIFF_MAX < new_size) @@ -4691,20 +4690,39 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) } } -/* Recompute the hashes (and hence also the "next" pointers). - Normally there's never a need to recompute hashes. - This is done only on first access to a hash-table loaded from - the "pdump", because the objects' addresses may have changed, thus - affecting their hashes. */ +static const struct hash_table_test * +hash_table_test_from_std (hash_table_std_test_t test) +{ + switch (test) + { + case Test_eq: return &hashtest_eq; + case Test_eql: return &hashtest_eql; + case Test_equal: return &hashtest_equal; + } + emacs_abort(); +} + +/* Rebuild a hash table from its frozen (dumped) form. */ void -hash_table_rehash (Lisp_Object hash) +hash_table_thaw (Lisp_Object hash_table) { - struct Lisp_Hash_Table *h = XHASH_TABLE (hash); - ptrdiff_t i, count = h->count; + struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table); + + /* Freezing discarded most non-essential information; recompute it. + The allocation is minimal with no room for growth. */ + h->test = *hash_table_test_from_std (h->frozen_test); + ptrdiff_t size = ASIZE (h->key_and_value) / 2; + h->count = size; + ptrdiff_t index_size = hash_index_size (size); + h->next_free = -1; + + h->hash = make_nil_vector (size); + h->next = make_vector (size, make_fixnum (-1)); + h->index = make_vector (index_size, make_fixnum (-1)); /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ - for (i = 0; i < count; i++) + for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object key = HASH_KEY (h, i); Lisp_Object hash_code = hash_from_key (h, key); @@ -4712,12 +4730,7 @@ hash_table_rehash (Lisp_Object hash) set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); - eassert (HASH_NEXT (h, i) != i); /* Stop loops. */ } - - ptrdiff_t size = ASIZE (h->next); - for (; i + 1 < size; i++) - set_hash_next_slot (h, i, i + 1); } /* Lookup KEY in hash table H. If HASH is non-null, return in *HASH diff --git a/src/lisp.h b/src/lisp.h index 48e1f943ed8..d9b828b0328 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2385,6 +2385,12 @@ INLINE int struct Lisp_Hash_Table; +typedef enum { + Test_eql, + Test_eq, + Test_equal, +} hash_table_std_test_t; + struct hash_table_test { /* Function used to compare keys; always a bare symbol. */ @@ -2473,6 +2479,9 @@ struct Lisp_Hash_Table /* Weakness of the table. */ hash_table_weakness_t weakness : 8; + /* Hash table test (only used when frozen in dump) */ + hash_table_std_test_t frozen_test : 8; + /* True if the table can be purecopied. The table cannot be changed afterwards. */ bool purecopy; @@ -2563,7 +2572,7 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) return h->test.hashfn (key, h); } -void hash_table_rehash (Lisp_Object); +void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ @@ -4038,7 +4047,6 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); diff --git a/src/pdumper.c b/src/pdumper.c index 8072148c542..e4349f0cb17 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2646,34 +2646,26 @@ dump_vectorlike_generic (struct dump_context *ctx, 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. */ +/* Return a vector of KEY, VALUE pairs in the given hash table H. + No room for growth is included. */ 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); + ptrdiff_t old_size = HASH_TABLE_SIZE (h); + ptrdiff_t size = h->count; 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++) + for (ptrdiff_t i = 0; i < old_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; } @@ -2686,25 +2678,32 @@ dump_hash_table_list (struct dump_context *ctx) return 0; } -static void -hash_table_freeze (struct Lisp_Hash_Table *h) +static hash_table_std_test_t +hash_table_std_test (const struct hash_table_test *t) { - 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); + if (BASE_EQ (t->name, Qeq)) + return Test_eq; + if (BASE_EQ (t->name, Qeql)) + return Test_eql; + if (BASE_EQ (t->name, Qequal)) + return Test_equal; + error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */ } +/* Compact contents and discard inessential information from a hash table, + preparing it for dumping. + See `hash_table_thaw' for the code that restores the object to a usable + state. */ static void -hash_table_thaw (Lisp_Object hash) +hash_table_freeze (struct Lisp_Hash_Table *h) { - 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); + h->key_and_value = hash_table_contents (h); + eassert (ASIZE (h->key_and_value) == h->count * 2); + h->next = Qnil; + h->hash = Qnil; + h->index = Qnil; + h->count = 0; + h->frozen_test = hash_table_std_test (&h->test); } static dump_off @@ -2724,19 +2723,11 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) 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, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); + DUMP_FIELD_COPY (out, hash, frozen_test); 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); } commit c3d0cc50faf588479db62e20ceabe044dd89e244 Author: Mattias Engdegård Date: Thu Oct 26 17:17:01 2023 +0200 Remove rehash-threshold and rehash-size struct members These parameters have no visible semantics and are hardly ever used, so just use the default values for all hash tables. This saves memory, shrinks the external representation, and will improve performance. * src/fns.c (std_rehash_size, std_rehash_threshold): New. (hash_index_size): Use std_rehash_threshold. Remove table argument. All callers updated. (make_hash_table): Remove rehash_size and rehash_threshold args. All callers updated. (maybe_resize_hash_table) (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Use std_rehash_size and std_rehash_threshold. (Fmake_hash_table): Ignore :rehash-size and :rehash-threshold args. * src/lisp.h (struct Lisp_Hash_Table): Remove rehash_size and rehash_threshold fields. (DEFAULT_REHASH_THRESHOLD, DEFAULT_REHASH_SIZE): Remove. * src/lread.c (hash_table_from_plist): Don't read rehash-size or rehash-threshold. (syms_of_lread): Remove unused symbols. * src/print.c (print_object): Don't print rehash-size or rehash-threshold. * src/pdumper.c (dump_hash_table): Don't dump removed fields. diff --git a/src/category.c b/src/category.c index 67429e82571..583cdb3eebb 100644 --- a/src/category.c +++ b/src/category.c @@ -51,9 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false)); + make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index 44c3efd1440..60aed68f2cd 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1697,9 +1697,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 5837795f838..efec74d4959 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4509,11 +4509,17 @@ allocate_hash_table (void) - header_size - GCALIGNMENT) \ / word_size))) +/* Default factor by which to increase the size of a hash table. */ +static const double std_rehash_size = 1.5; + +/* Resize hash table when number of entries / table size is >= this + ratio. */ +static const double std_rehash_threshold = 0.8125; + static ptrdiff_t -hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) +hash_index_size (ptrdiff_t size) { - double threshold = h->rehash_threshold; - double index_float = size / threshold; + double index_float = size * (1.0 / std_rehash_threshold); ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1 ? next_almost_prime (index_float) : INDEX_SIZE_BOUND + 1); @@ -4531,16 +4537,6 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM. - If REHASH_SIZE is equal to a negative integer, this hash table's - new size when it becomes full is computed by subtracting - REHASH_SIZE from its old size. Otherwise it must be positive, and - the table's new size is computed by multiplying its old size by - REHASH_SIZE + 1. - - REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will - be resized when the approximate ratio of table entries to table - size exceeds REHASH_THRESHOLD. - WEAK specifies the weakness of the table. If PURECOPY is non-nil, the table can be copied to pure storage via @@ -4549,7 +4545,6 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, - float rehash_size, float rehash_threshold, hash_table_weakness_t weak, bool purecopy) { struct Lisp_Hash_Table *h; @@ -4559,8 +4554,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Preconditions. */ eassert (SYMBOLP (test.name)); eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); - eassert (rehash_size <= -1 || 0 < rehash_size); - eassert (0 < rehash_threshold && rehash_threshold <= 1); if (size == 0) size = 1; @@ -4571,13 +4564,11 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Initialize hash table slots. */ h->test = test; h->weakness = weak; - h->rehash_threshold = rehash_threshold; - h->rehash_size = rehash_size; h->count = 0; h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); h->hash = make_nil_vector (size); h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (hash_index_size (h, size), make_fixnum (-1)); + h->index = make_vector (hash_index_size (size), make_fixnum (-1)); h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; @@ -4648,18 +4639,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); EMACS_INT new_size; - double rehash_size = h->rehash_size; - if (rehash_size < 0) - new_size = old_size - rehash_size; + double float_new_size = old_size * std_rehash_size; + if (float_new_size < EMACS_INT_MAX) + new_size = float_new_size; else - { - double float_new_size = old_size * (rehash_size + 1); - if (float_new_size < EMACS_INT_MAX) - new_size = float_new_size; - else - new_size = EMACS_INT_MAX; - } + new_size = EMACS_INT_MAX; if (PTRDIFF_MAX < new_size) new_size = PTRDIFF_MAX; if (new_size <= old_size) @@ -4682,7 +4667,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) Lisp_Object hash = alloc_larger_vector (h->hash, new_size); memclear (XVECTOR (hash)->contents + old_size, (new_size - old_size) * word_size); - ptrdiff_t index_size = hash_index_size (h, new_size); + ptrdiff_t index_size = hash_index_size (new_size); h->index = make_vector (index_size, make_fixnum (-1)); h->key_and_value = key_and_value; h->hash = hash; @@ -5281,15 +5266,6 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and :size SIZE -- A hint as to how many elements will be put in the table. Default is 65. -:rehash-size REHASH-SIZE - Indicates how to expand the table when it -fills up. If REHASH-SIZE is an integer, increase the size by that -amount. If it is a float, it must be > 1.0, and the new size is the -old size multiplied by that factor. Default is 1.5. - -:rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0. -Resize the hash table when the ratio (table entries / table size) -exceeds an approximation to THRESHOLD. Default is 0.8125. - :weakness WEAK -- WEAK must be one of nil, t, `key', `value', `key-or-value', or `key-and-value'. If WEAK is not nil, the table returned is a weak table. Key/value pairs are removed from a weak @@ -5303,6 +5279,9 @@ to pure storage when Emacs is being dumped, making the contents of the table read only. Any further changes to purified tables will result in an error. +The keywords arguments :rehash-threshold and :rehash-size are obsolete +and ignored. + usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -5352,26 +5331,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else signal_error ("Invalid hash table size", size_arg); - /* Look for `:rehash-size SIZE'. */ - float rehash_size; - i = get_key_arg (QCrehash_size, nargs, args, used); - if (!i) - rehash_size = DEFAULT_REHASH_SIZE; - else if (FIXNUMP (args[i]) && 0 < XFIXNUM (args[i])) - rehash_size = - XFIXNUM (args[i]); - else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1)) - rehash_size = (float) (XFLOAT_DATA (args[i]) - 1); - else - signal_error ("Invalid hash table rehash size", args[i]); - - /* Look for `:rehash-threshold THRESHOLD'. */ - i = get_key_arg (QCrehash_threshold, nargs, args, used); - float rehash_threshold = (!i ? DEFAULT_REHASH_THRESHOLD - : !FLOATP (args[i]) ? 0 - : (float) XFLOAT_DATA (args[i])); - if (! (0 < rehash_threshold && rehash_threshold <= 1)) - signal_error ("Invalid hash table rehash threshold", args[i]); - /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); Lisp_Object weakness = i ? args[i] : Qnil; @@ -5392,11 +5351,16 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) if (!used[i]) - signal_error ("Invalid argument list", args[i]); + { + /* Ignore obsolete arguments. */ + if (EQ (args[i], QCrehash_threshold) || EQ (args[i], QCrehash_size)) + i++; + else + signal_error ("Invalid argument list", args[i]); + } SAFE_FREE (); - return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak, - purecopy); + return make_hash_table (testdesc, size, weak, purecopy); } @@ -5422,14 +5386,8 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, doc: /* Return the current rehash size of TABLE. */) (Lisp_Object table) { - double rehash_size = check_hash_table (table)->rehash_size; - if (rehash_size < 0) - { - EMACS_INT s = -rehash_size; - return make_fixnum (min (s, MOST_POSITIVE_FIXNUM)); - } - else - return make_float (rehash_size + 1); + CHECK_HASH_TABLE (table); + return make_float (std_rehash_size); } @@ -5438,7 +5396,8 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, doc: /* Return the current rehash threshold of TABLE. */) (Lisp_Object table) { - return make_float (check_hash_table (table)->rehash_threshold); + CHECK_HASH_TABLE (table); + return make_float (std_rehash_threshold); } diff --git a/src/frame.c b/src/frame.c index 41b0f2f5764..08057736272 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1040,8 +1040,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false)); + (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 92e1e0b0be7..9c100213590 100644 --- a/src/image.c +++ b/src/image.c @@ -6069,9 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 480d963e63d..48e1f943ed8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2482,17 +2482,6 @@ struct Lisp_Hash_Table immutable for recursive attempts to mutate it. */ bool mutable; - /* Resize hash table when number of entries / table size is >= this - ratio. */ - float rehash_threshold; - - /* Used when the table is resized. If equal to a negative integer, - the user rehash-size is the integer -REHASH_SIZE, and the new - size is the old size plus -REHASH_SIZE. If positive, the user - rehash-size is the floating-point value REHASH_SIZE + 1, and the - new size is the old size times REHASH_SIZE + 1. */ - float rehash_size; - /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. @@ -2580,16 +2569,6 @@ void hash_table_rehash (Lisp_Object); enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; -/* Default threshold specifying when to resize a hash table. The - value gives the ratio of current entries in the hash table and the - size of the hash table. */ - -static float const DEFAULT_REHASH_THRESHOLD = 0.8125; - -/* Default factor by which to increase the size of a hash table, minus 1. */ - -static float const DEFAULT_REHASH_SIZE = 1.5 - 1; - /* Combine two integers X and Y for hashing. The result might exceed INTMASK. */ @@ -4060,7 +4039,7 @@ extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); -Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, +Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); diff --git a/src/lread.c b/src/lread.c index 6d3c06265e0..284536fc81f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2544,15 +2544,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2796,13 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) @@ -3412,7 +3406,7 @@ read_string_literal (Lisp_Object readcharfun) static Lisp_Object hash_table_from_plist (Lisp_Object plist) { - Lisp_Object params[12]; + Lisp_Object params[4 * 2]; Lisp_Object *par = params; /* This is repetitive but fast and simple. */ @@ -3428,8 +3422,6 @@ hash_table_from_plist (Lisp_Object plist) ADDPARAM (test); ADDPARAM (weakness); - ADDPARAM (rehash_size); - ADDPARAM (rehash_threshold); ADDPARAM (purecopy); Lisp_Object data = plist_get (plist, Qdata); @@ -5998,8 +5990,6 @@ that are loaded before your customizations are read! */); DEFSYM (Qsize, "size"); DEFSYM (Qpurecopy, "purecopy"); DEFSYM (Qweakness, "weakness"); - DEFSYM (Qrehash_size, "rehash-size"); - DEFSYM (Qrehash_threshold, "rehash-threshold"); DEFSYM (Qchar_from_name, "char-from-name"); diff --git a/src/pdumper.c b/src/pdumper.c index 982b991dc63..8072148c542 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2729,8 +2729,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) DUMP_FIELD_COPY (out, hash, weakness); 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, diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b45cf56135d..57ea82daa5e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7178,9 +7178,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index 9c361444458..cc8df639f4f 100644 --- a/src/print.c +++ b/src/print.c @@ -2590,14 +2590,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printcharfun, escapeflag); } - print_c_string (" rehash-size ", printcharfun); - print_object (Fhash_table_rehash_size (obj), - printcharfun, escapeflag); - - print_c_string (" rehash-threshold ", printcharfun); - print_object (Fhash_table_rehash_threshold (obj), - printcharfun, escapeflag); - if (h->purecopy) print_c_string (" purecopy t", printcharfun); diff --git a/src/profiler.c b/src/profiler.c index a75998c7c40..06ffecf41e3 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -564,8 +564,6 @@ export_log (struct profiler_log *plog) the log but close enough, and will never confuse two distinct keys in the log. */ Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); for (int i = 0; i < log->size; i++) { diff --git a/src/xfaces.c b/src/xfaces.c index 7c3dd7ebc15..c9dd0f90feb 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7333,8 +7333,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + make_hash_table (hashtest_eq, 33, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index 98f8c8afb3b..e4139a79a6e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32554,10 +32554,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (hashtest_eql, 900, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, commit c6bdc1ea1dc7f9a0b6d92d443f34c42affde73d1 Author: Mattias Engdegård Date: Thu Oct 26 15:49:32 2023 +0200 Represent hash table weakness as an enum internally This takes less space (saves an entire word) and is more type-safe. No change in behaviour. * src/lisp.h (hash_table_weakness_t): New. (struct Lisp_Hash_Table): Replace Lisp object `weak` with enum `weakness`. * src/fns.c (keep_entry_p, hash_table_weakness_symbol): New. (make_hash_table): Retype argument. All callers updated. (sweep_weak_table, Fmake_hash_table, Fhash_table_weakness): * src/alloc.c (purecopy_hash_table, purecopy, process_mark_stack): * src/pdumper.c (dump_hash_table): * src/print.c (print_object): Use retyped field. diff --git a/src/alloc.c b/src/alloc.c index af9c169a3a0..17ed711a318 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5887,7 +5887,7 @@ make_pure_vector (ptrdiff_t len) static struct Lisp_Hash_Table * purecopy_hash_table (struct Lisp_Hash_Table *table) { - eassert (NILP (table->weak)); + eassert (table->weakness == Weak_None); eassert (table->purecopy); struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); @@ -5960,7 +5960,7 @@ purecopy (Lisp_Object obj) /* Do not purify hash tables which haven't been defined with :purecopy as non-nil or are weak - they aren't guaranteed to not change. */ - if (!NILP (table->weak) || !table->purecopy) + if (table->weakness != Weak_None || !table->purecopy) { /* Instead, add the hash table to the list of pinned objects, so that it will be marked during GC. */ @@ -7233,7 +7233,7 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (h->test.name); mark_stack_push_value (h->test.user_hash_function); mark_stack_push_value (h->test.user_cmp_function); - if (NILP (h->weak)) + if (h->weakness == Weak_None) mark_stack_push_value (h->key_and_value); else { diff --git a/src/category.c b/src/category.c index b539bad31eb..67429e82571 100644 --- a/src/category.c +++ b/src/category.c @@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) (table, 1, make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false)); + Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index 283703b3651..44c3efd1440 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1699,7 +1699,7 @@ syms_of_module (void) Vmodule_refs_hash = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 89434e02ca3..5837795f838 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4541,8 +4541,7 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) be resized when the approximate ratio of table entries to table size exceeds REHASH_THRESHOLD. - WEAK specifies the weakness of the table. If non-nil, it must be - one of the symbols `key', `value', `key-or-value', or `key-and-value'. + WEAK specifies the weakness of the table. If PURECOPY is non-nil, the table can be copied to pure storage via `purecopy' when Emacs is being dumped. Such tables can no longer be @@ -4551,7 +4550,7 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, float rehash_size, float rehash_threshold, - Lisp_Object weak, bool purecopy) + hash_table_weakness_t weak, bool purecopy) { struct Lisp_Hash_Table *h; Lisp_Object table; @@ -4571,7 +4570,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Initialize hash table slots. */ h->test = test; - h->weak = weak; + h->weakness = weak; h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; @@ -4869,6 +4868,23 @@ hash_clear (struct Lisp_Hash_Table *h) Weak Hash Tables ************************************************************************/ +/* Whether to keep an entry whose key and value are known to be retained + if STRONG_KEY and STRONG_VALUE, respectively, are true. */ +static inline bool +keep_entry_p (hash_table_weakness_t weakness, + bool strong_key, bool strong_value) +{ + switch (weakness) + { + case Weak_None: return true; + case Weak_Key: return strong_key; + case Weak_Value: return strong_value; + case Weak_Key_Or_Value: return strong_key || strong_value; + case Weak_Key_And_Value: return strong_key && strong_value; + } + emacs_abort(); +} + /* Sweep weak hash table H. REMOVE_ENTRIES_P means remove entries from the table that don't survive the current GC. !REMOVE_ENTRIES_P means mark entries that are in use. Value is @@ -4890,18 +4906,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i)); bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i)); - bool remove_p; - - if (EQ (h->weak, Qkey)) - remove_p = !key_known_to_survive_p; - else if (EQ (h->weak, Qvalue)) - remove_p = !value_known_to_survive_p; - else if (EQ (h->weak, Qkey_or_value)) - remove_p = !(key_known_to_survive_p || value_known_to_survive_p); - else if (EQ (h->weak, Qkey_and_value)) - remove_p = !(key_known_to_survive_p && value_known_to_survive_p); - else - emacs_abort (); + bool remove_p = !keep_entry_p (h->weakness, + key_known_to_survive_p, + value_known_to_survive_p); next = HASH_NEXT (h, i); @@ -5367,15 +5374,20 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); - Lisp_Object weak = i ? args[i] : Qnil; - if (EQ (weak, Qt)) - weak = Qkey_and_value; - if (!NILP (weak) - && !EQ (weak, Qkey) - && !EQ (weak, Qvalue) - && !EQ (weak, Qkey_or_value) - && !EQ (weak, Qkey_and_value)) - signal_error ("Invalid hash table weakness", weak); + Lisp_Object weakness = i ? args[i] : Qnil; + hash_table_weakness_t weak; + if (NILP (weakness)) + weak = Weak_None; + else if (EQ (weakness, Qkey)) + weak = Weak_Key; + else if (EQ (weakness, Qvalue)) + weak = Weak_Value; + else if (EQ (weakness, Qkey_or_value)) + weak = Weak_Key_Or_Value; + else if (EQ (weakness, Qt) || EQ (weakness, Qkey_and_value)) + weak = Weak_Key_And_Value; + else + signal_error ("Invalid hash table weakness", weakness); /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) @@ -5449,13 +5461,26 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, return check_hash_table (table)->test.name; } +Lisp_Object +hash_table_weakness_symbol (hash_table_weakness_t weak) +{ + switch (weak) + { + case Weak_None: return Qnil; + case Weak_Key: return Qkey; + case Weak_Value: return Qvalue; + case Weak_Key_And_Value: return Qkey_and_value; + case Weak_Key_Or_Value: return Qkey_or_value; + } + emacs_abort (); +} DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness, 1, 1, 0, doc: /* Return the weakness of TABLE. */) (Lisp_Object table) { - return check_hash_table (table)->weak; + return hash_table_weakness_symbol (check_hash_table (table)->weakness); } diff --git a/src/frame.c b/src/frame.c index f5b07e212f2..41b0f2f5764 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1041,7 +1041,7 @@ make_frame (bool mini_p) fset_face_hash_table (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false)); + DEFAULT_REHASH_THRESHOLD, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 252b83da992..92e1e0b0be7 100644 --- a/src/image.c +++ b/src/image.c @@ -6071,7 +6071,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, *get_func = xpm_get_color_table_h; return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index e80a6388657..480d963e63d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2403,6 +2403,18 @@ struct hash_table_test Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); }; +typedef enum { + Weak_None, /* No weak references. */ + Weak_Key, /* Reference to key is weak. */ + Weak_Value, /* Reference to value is weak. */ + Weak_Key_Or_Value, /* References to key or value are weak: + element kept as long as strong reference to + either key or value remains. */ + Weak_Key_And_Value, /* References to key and value are weak: + element kept as long as strong references to + both key and value remain. */ +} hash_table_weakness_t; + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2432,10 +2444,6 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - /* Nil if table is non-weak. Otherwise a symbol describing the - weakness of the table. */ - Lisp_Object weak; - /* Vector of hash codes, or nil if the table needs rehashing. If the I-th entry is unused, then hash[I] should be nil. */ Lisp_Object hash; @@ -2462,6 +2470,9 @@ struct Lisp_Hash_Table /* Index of first free entry in free list, or -1 if none. */ ptrdiff_t next_free; + /* Weakness of the table. */ + hash_table_weakness_t weakness : 8; + /* True if the table can be purecopied. The table cannot be changed afterwards. */ bool purecopy; @@ -2498,7 +2509,7 @@ struct Lisp_Hash_Table } GCALIGNED_STRUCT; /* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); +verify (offsetof (struct Lisp_Hash_Table, hash) == header_size); /* Key value that marks an unused hash table entry. */ #define HASH_UNUSED_ENTRY_KEY Qunbound @@ -4050,7 +4061,8 @@ EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, - Lisp_Object, bool); + hash_table_weakness_t, bool); +Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 18894801376..6d3c06265e0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2546,13 +2546,13 @@ readevalloop (Lisp_Object readcharfun, read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2797,12 +2797,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, || XHASH_TABLE (read_objects_map)->count) read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index c72db7f3ea3..982b991dc63 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2726,6 +2726,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) 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, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, rehash_threshold); diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 2f7a390d22d..b45cf56135d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7179,7 +7179,8 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, + Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index c1c91b2383a..9c361444458 100644 --- a/src/print.c +++ b/src/print.c @@ -2583,10 +2583,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_object (h->test.name, printcharfun, escapeflag); } - if (!NILP (h->weak)) + if (h->weakness != Weak_None) { print_c_string (" weakness ", printcharfun); - print_object (h->weak, printcharfun, escapeflag); + print_object (hash_table_weakness_symbol (h->weakness), + printcharfun, escapeflag); } print_c_string (" rehash-size ", printcharfun); diff --git a/src/profiler.c b/src/profiler.c index 48a042cc8aa..a75998c7c40 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -566,7 +566,7 @@ export_log (struct profiler_log *plog) Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); for (int i = 0; i < log->size; i++) { int count = get_log_count (log, i); diff --git a/src/xfaces.c b/src/xfaces.c index c9ade2769bd..7c3dd7ebc15 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7334,7 +7334,7 @@ only for this purpose. */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index 0cbf32ae1ea..98f8c8afb3b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32557,7 +32557,7 @@ If set to a non-float value, there will be no wait at all. */); Vx_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, commit 3f9c81a87f7bce854489b8232d817b536ccf349b Author: Mattias Engdegård Date: Thu Oct 26 18:36:05 2023 +0200 Don't print or read the hash table size parameter It's not a meaningful part of the external representation. This allows for faster printing and reading, smaller external representation, and less memory consumption. * src/print.c (print_object): Omit size. * src/lread.c (hash_table_from_plist): Take size from the data. diff --git a/src/lread.c b/src/lread.c index e95dafcf222..18894801376 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3426,7 +3426,6 @@ hash_table_from_plist (Lisp_Object plist) } \ } while (0) - ADDPARAM (size); ADDPARAM (test); ADDPARAM (weakness); ADDPARAM (rehash_size); @@ -3434,23 +3433,25 @@ hash_table_from_plist (Lisp_Object plist) ADDPARAM (purecopy); Lisp_Object data = plist_get (plist, Qdata); + if (!(NILP (data) || CONSP (data))) + error ("Hash table data is not a list"); + ptrdiff_t data_len = list_length (data); + if (data_len & 1) + error ("Hash table data length is odd"); + *par++ = QCsize; + *par++ = make_fixnum (data_len / 2); /* Now use params to make a new hash table and fill it. */ Lisp_Object ht = Fmake_hash_table (par - params, params); - Lisp_Object last = data; - FOR_EACH_TAIL_SAFE (data) + while (!NILP (data)) { Lisp_Object key = XCAR (data); data = XCDR (data); - if (!CONSP (data)) - break; Lisp_Object val = XCAR (data); - last = XCDR (data); Fputhash (key, val, ht); + data = XCDR (data); } - if (!NILP (last)) - error ("Hash table data is not a list of even length"); return ht; } diff --git a/src/print.c b/src/print.c index d011962d85b..c1c91b2383a 100644 --- a/src/print.c +++ b/src/print.c @@ -2574,11 +2574,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); /* Implement a readable output, e.g.: - #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ - /* Always print the size. */ - int len = sprintf (buf, "#s(hash-table size %"pD"d", - HASH_TABLE_SIZE (h)); - strout (buf, len, len, printcharfun); + #s(hash-table test equal data (k1 v1 k2 v2)) */ + print_c_string ("#s(hash-table", printcharfun); if (!BASE_EQ (h->test.name, Qeql)) { commit a09619f2598a1658feac6794e85bc61a07c4855f Author: Mattias Engdegård Date: Thu Nov 2 11:10:24 2023 +0100 * src/print.c (print_object): Don't print empty hash-table data Since no data is the default, this preserves bidirectional compatibility. diff --git a/src/print.c b/src/print.c index 0a5f2ee48d4..d011962d85b 100644 --- a/src/print.c +++ b/src/print.c @@ -2603,21 +2603,30 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (h->purecopy) print_c_string (" purecopy t", printcharfun); - print_c_string (" data (", printcharfun); - ptrdiff_t size = h->count; - /* Don't print more elements than the specified maximum. */ - if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) - size = XFIXNAT (Vprint_length); - - print_stack_push ((struct print_stack_entry){ - .type = PE_hash, - .u.hash.obj = obj, - .u.hash.nobjs = size * 2, - .u.hash.idx = 0, - .u.hash.printed = 0, - .u.hash.truncated = (size < h->count), - }); + if (size > 0) + { + print_c_string (" data (", printcharfun); + + /* Don't print more elements than the specified maximum. */ + if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); + + print_stack_push ((struct print_stack_entry){ + .type = PE_hash, + .u.hash.obj = obj, + .u.hash.nobjs = size * 2, + .u.hash.idx = 0, + .u.hash.printed = 0, + .u.hash.truncated = (size < h->count), + }); + } + else + { + /* Empty table: we can omit the data entirely. */ + printchar (')', printcharfun); + --print_depth; /* Done with this. */ + } goto next_obj; } diff --git a/test/src/print-tests.el b/test/src/print-tests.el index aedaa9a4e06..ff3a6fe7483 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -367,13 +367,6 @@ otherwise, use a different charset." (remhash 1 h) (format "%S" h)))) - (should - (string-match - "data ()" - (let ((h (make-hash-table))) - (let ((print-length 0)) - (format "%S" h))))) - (should (string-match "data (99 99)" commit 4ba6954e69528f89dc12bf968dec845601b1b24b Author: Mattias Engdegård Date: Thu Oct 26 18:04:11 2023 +0200 * src/print.c (print_object): Don't print hash table test if `eql`. Since `eql` is the default, this ensures bidirectional compatibility while reducing the size of the external representation. diff --git a/src/print.c b/src/print.c index e22f3b6778c..0a5f2ee48d4 100644 --- a/src/print.c +++ b/src/print.c @@ -2580,7 +2580,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) HASH_TABLE_SIZE (h)); strout (buf, len, len, printcharfun); - if (!NILP (h->test.name)) + if (!BASE_EQ (h->test.name, Qeql)) { print_c_string (" test ", printcharfun); print_object (h->test.name, printcharfun, escapeflag); commit 76904626b36910b511d3b0a3e56cc80af90d9361 Author: Juri Linkov Date: Sat Jan 13 20:16:42 2024 +0200 * lisp/window.el (window-prefix-map): Bind C-x w q to quit-window (bug#13167) diff --git a/lisp/window.el b/lisp/window.el index e100f25526b..23977691f50 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10813,7 +10813,8 @@ Used in `repeat-mode'." "^ f" #'tear-off-window "^ t" #'tab-window-detach "-" #'fit-window-to-buffer - "0" #'delete-windows-on) + "0" #'delete-windows-on + "q" #'quit-window) (define-key ctl-x-map "w" window-prefix-map) (provide 'window) commit aaf3b633978f44a4e0647161e06c7dbb54ad9d5c Author: Xiyue Deng Date: Sat Jan 13 18:08:49 2024 +0100 Fix typo in lispref "Creating Strings" section * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7097de49064..4fe94f78cba 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called a @dfn{array}, meaning that its length is fixed and +sequence called an @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. commit 106cd9aafe8248ef91d7e89161adc5f912ea54eb Author: Eli Zaretskii Date: Sat Jan 13 12:45:10 2024 +0200 ; * lisp/textmodes/page.el (page--what-page): Fix last change. diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 1c7561d71c6..a5de354fc0a 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -165,7 +165,7 @@ The line number is relative to the start of the page." (widen) (save-excursion (let ((count 1) - (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) + (adjust (if (or (bolp) (looking-back page-delimiter nil)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) commit 91b1765cd43439d91487c82347cb00bd5a3179df Merge: fe7d2bb62fb c494a6e879d Author: Eli Zaretskii Date: Sat Jan 13 05:36:16 2024 -0500 Merge from origin/emacs-29 c494a6e879d Improve documentation of 'emacs_function' in modules a08e6423ccc ; * doc/emacs/fixit.texi (Spelling): Fix last change. 418547162d5 Improve documentation of Ispell commands c4b49488455 Don't recommend inverse-video for debugging commit fe7d2bb62fb4a618362ffa787ed1d1a3bda4a4dd Merge: f1736571fa3 26eb9d3a8a6 Author: Eli Zaretskii Date: Sat Jan 13 05:36:16 2024 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 26eb9d3a8a6 Fix typo in lispref "Creating Strings" section commit f1736571fa3f4bc13dbc217f61bdc6e8efdc24b4 Merge: ccc28245c09 99efe5c80f9 Author: Eli Zaretskii Date: Sat Jan 13 05:36:16 2024 -0500 Merge from origin/emacs-29 99efe5c80f9 Fix count of no-op functions (bug#68375) 0c01f97b73c Wrap @pxref of Abbrevs in parentheses (bug#68375) 70a09325d65 ; Fix last change in widget.texi 63411709a8d ; Fix typos 824cf54951c ; * etc/TODO: Add item to make play-sound non-blocking. 4fadbfe300a Add examples to the Widget manual 1bbb610821e Implement missing functions for custom-icon widget 29af214a75a Fix fontification of cgroup2 in fstab (bug#68367) commit ccc28245c090c2d5f93184e8887fede3910b977e Merge: 79a150ffa49 5567ce1a9ff Author: Eli Zaretskii Date: Sat Jan 13 05:36:15 2024 -0500 ; Merge from origin/emacs-29 The following commit was skipped: 5567ce1a9ff Handle package versions that are not version strings commit 79a150ffa492709e04acbb646ff0a050fa90d5c9 Merge: 740953d1a2f d58d0fa52ff Author: Eli Zaretskii Date: Sat Jan 13 05:36:15 2024 -0500 Merge from origin/emacs-29 d58d0fa52ff Introduce 'let' using lexical binding in the Lisp Introdu... 1b123972636 ; Don't record multiple versions of use-package 8729a2a10d9 Fix 'rmail-summary-by-thread' 2a8c00bfc07 * doc/emacs/back.texi: Fix a typo. commit 740953d1a2f4ea4a200637872b9ecb7dfddfdbe4 Author: Lars Brinkhoff Date: Tue Jan 2 09:06:13 2024 +0100 Fix 'what-page' * lisp/textmodes/page.el (page--what-page): Adjust for 1st line on page, and use 'count-lines' again. (Bug#68215) * test/lisp/textmodes/page-tests.el (page-tests-what-page): Update test. diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index e8621ee0383..1c7561d71c6 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -159,21 +159,23 @@ point, respectively." total before after))) (defun page--what-page () - "Return a list of the page and line number of point." + "Return a list of the page and line number of point. +The line number is relative to the start of the page." (save-restriction (widen) (save-excursion (let ((count 1) + (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) (when (= (match-beginning 0) (match-end 0)) (forward-char)) (setq count (1+ count))) - (list count (line-number-at-pos opoint)))))) + (list count (+ adjust (count-lines (point) opoint))))))) (defun what-page () - "Print page and line number of point." + "Display the page number, and the line number within that page." (interactive) (apply #'message (cons "Page %d, line %d" (page--what-page)))) diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index f3a2c5fbe00..617b59a54fb 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -106,10 +106,14 @@ (insert "foo\n \nbar\n \nbaz") (goto-char (point-min)) (should (equal (page--what-page) '(1 1))) + (forward-char) + (should (equal (page--what-page) '(1 1))) (forward-page) + (should (equal (page--what-page) '(2 1))) + (next-line) (should (equal (page--what-page) '(2 2))) (forward-page) - (should (equal (page--what-page) '(3 4))))) + (should (equal (page--what-page) '(3 1))))) ;;; page-tests.el ends here commit c494a6e879dfeecb0cec3e9ae7bc0d3c682a9185 Author: Eli Zaretskii Date: Sat Jan 13 12:01:47 2024 +0200 Improve documentation of 'emacs_function' in modules * doc/lispref/internals.texi (Module Functions): Warn about accessing the ARGS array in module functions. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 41777a7a303..333a5897837 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1371,6 +1371,15 @@ objects between Emacs and the module (@pxref{Module Values}). The provides facilities for conversion between basic C data types and the corresponding @code{emacs_value} objects. +In the module function's body, do @emph{not} attempt to access +elements of the @var{args} array beyond the index +@code{@var{nargs}-1}: memory for the @var{args} array is allocated +exactly to accommodate @var{nargs} values, and accessing beyond that +will most probably crash your module. In particular, if the value of +@var{nargs} passed to the function at run time is zero, it must not +access @var{args} at all, as no memory will have been allocated for it +in that case. + A module function always returns a value. If the function returns normally, the Lisp code which called it will see the Lisp object corresponding to the @code{emacs_value} value the function returned. commit 9b8b352ebc09de3259f655fa4d491507109044b3 Author: Steven Allen Date: Sat Jan 6 09:19:12 2024 -0800 Set the 'name' prop in 'define-advice' In addition to naming the advice function `symbol@name', set the 'name' property to NAME. * lisp/emacs-lisp/nadvice.el (define-advice): set the 'name' property to NAME (requested in Bug#68114). Fixes Bug#68294. * doc/lispref/functions.texi (Advising Named Functions): Document that 'define-advice' installs the advice with the specified name. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 29e9f04a076..29061e6561c 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2066,9 +2066,10 @@ code) obey the advice and other calls (from C code) do not. @defmac define-advice symbol (where lambda-list &optional name depth) &rest body This macro defines a piece of advice and adds it to the function named -@var{symbol}. The advice is an anonymous function if @var{name} is -@code{nil} or a function named @code{symbol@@name}. See -@code{advice-add} for explanation of other arguments. +@var{symbol}. If @var{name} is non-nil, the advice is named +@code{@var{symbol}@@@var{name}} and installed with the name @var{name}; otherwise, +the advice is anonymous. See @code{advice-add} for explanation of +other arguments. @end defmac @defun advice-add symbol where function &optional props diff --git a/etc/NEWS b/etc/NEWS index bce33f96aee..5cf3e821627 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1410,6 +1410,12 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** 'define-advice' now sets the new advice's 'name' property to NAME +Named advice defined with 'define-advice' can now be removed with +'(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL +SYMBOL@NAME)'. + +++ ** New function 'require-with-check' to detect new versions shadowing. This is like 'require', but it checks whether the argument 'feature' diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index de287e43b21..7524ab18e58 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -585,8 +585,8 @@ of the piece of advice." (defmacro define-advice (symbol args &rest body) "Define an advice and add it to function named SYMBOL. See `advice-add' and `add-function' for explanation on the -arguments. Note if NAME is nil the advice is anonymous; -otherwise it is named `SYMBOL@NAME'. +arguments. If NAME is non-nil, the advice is named `SYMBOL@NAME' +and installed with the name NAME; otherwise, the advice is anonymous. \(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) @@ -597,7 +597,9 @@ otherwise it is named `SYMBOL@NAME'. (lambda-list (nth 1 args)) (name (nth 2 args)) (depth (nth 3 args)) - (props (and depth `((depth . ,depth)))) + (props (append + (and depth `((depth . ,depth))) + (and name `((name . ,name))))) (advice (cond ((null name) `(lambda ,lambda-list ,@body)) ((or (stringp name) (symbolp name)) (intern (format "%s@%s" symbol name))) commit f2cc8ee2a1a106f9045447a1a025572d7938647e Author: kobarity Date: Sat Jan 6 22:04:42 2024 +0900 Fix 'python-info-docstring-p' bug in the 2nd line of a buffer * lisp/progmodes/python.el (python-info-docstring-p): Add 'looking-at-p' check when bobp. * test/lisp/progmodes/python-tests.el (python-font-lock-operator-1) (python-font-lock-operator-2): Restoration of ERTs deleted by mistake. (python-font-lock-escape-sequence-bytes-newline) (python-font-lock-escape-sequence-hex-octal) (python-font-lock-escape-sequence-unicode) (python-font-lock-raw-escape-sequence): Change 'font-lock-doc-face' to 'font-lock-string-face' and remove :expected-result :failed. (python-info-docstring-p-8): New test. (Bug#68284) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1148da11a06..a44d4215d7c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -6260,7 +6260,9 @@ point's current `syntax-ppss'." counter))) (python-util-forward-comment -1) (python-nav-beginning-of-statement) - (cond ((bobp)) + (cond ((and (bobp) (save-excursion + (python-util-forward-comment) + (looking-at-p re)))) ((python-info-assignment-statement-p) t) ((python-info-looking-at-beginning-of-defun)) (t nil)))))) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1df0c42a0ce..97ffd5fe20f 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -474,6 +474,28 @@ def f(x: CustomInt) -> CustomInt: (136 . font-lock-operator-face) (137) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-operator-1 () + (python-tests-assert-faces + "1 << 2 ** 3 == +4%-5|~6&7^8%9" + '((1) + (3 . font-lock-operator-face) (5) + (8 . font-lock-operator-face) (10) + (13 . font-lock-operator-face) (15) + (16 . font-lock-operator-face) (17) + (18 . font-lock-operator-face) (20) + (21 . font-lock-operator-face) (23) + (24 . font-lock-operator-face) (25) + (26 . font-lock-operator-face) (27) + (28 . font-lock-operator-face) (29)))) + +(ert-deftest python-font-lock-operator-2 () + "Keyword operators are font-locked as keywords." + (python-tests-assert-faces + "is_ is None" + '((1) + (5 . font-lock-keyword-face) (7) + (8 . font-lock-constant-face)))) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' @@ -585,62 +607,58 @@ u\"\\n\"" (845 . font-lock-string-face) (886)))) (ert-deftest python-font-lock-escape-sequence-bytes-newline () - :expected-result :failed (python-tests-assert-faces "b'\\n' b\"\\n\"" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (5 . font-lock-doc-face) (6) - (8 . font-lock-doc-face) + (5 . font-lock-string-face) (6) + (8 . font-lock-string-face) (9 . font-lock-constant-face) - (11 . font-lock-doc-face)))) + (11 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-hex-octal () - :expected-result :failed (python-tests-assert-faces "b'\\x12 \\777 \\1\\23' '\\x12 \\777 \\1\\23'" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (7 . font-lock-doc-face) + (7 . font-lock-string-face) (8 . font-lock-constant-face) - (12 . font-lock-doc-face) + (12 . font-lock-string-face) (13 . font-lock-constant-face) - (18 . font-lock-doc-face) (19) - (20 . font-lock-doc-face) + (18 . font-lock-string-face) (19) + (20 . font-lock-string-face) (21 . font-lock-constant-face) - (25 . font-lock-doc-face) + (25 . font-lock-string-face) (26 . font-lock-constant-face) - (30 . font-lock-doc-face) + (30 . font-lock-string-face) (31 . font-lock-constant-face) - (36 . font-lock-doc-face)))) + (36 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-unicode () - :expected-result :failed (python-tests-assert-faces "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}' '\\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (2 . font-lock-doc-face) (41) - (42 . font-lock-doc-face) + (2 . font-lock-string-face) (41) + (42 . font-lock-string-face) (43 . font-lock-constant-face) - (49 . font-lock-doc-face) + (49 . font-lock-string-face) (50 . font-lock-constant-face) - (60 . font-lock-doc-face) + (60 . font-lock-string-face) (61 . font-lock-constant-face) - (80 . font-lock-doc-face)))) + (80 . font-lock-string-face)))) (ert-deftest python-font-lock-raw-escape-sequence () - :expected-result :failed (python-tests-assert-faces "rb'\\x12 \123 \\n' r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (3 . font-lock-doc-face) (14) - (16 . font-lock-doc-face)))) + (3 . font-lock-string-face) (14) + (16 . font-lock-string-face)))) ;;; Indentation @@ -6647,6 +6665,15 @@ class Class: (python-tests-look-at "Also not a docstring") (should-not (python-info-docstring-p)))) +(ert-deftest python-info-docstring-p-8 () + "Test string in the 2nd line of a buffer." + (python-tests-with-temp-buffer + "import sys +'''Not a docstring.''' +" + (python-tests-look-at "Not a docstring") + (should-not (python-info-docstring-p)))) + (ert-deftest python-info-triple-quoted-string-p-1 () "Test triple quoted string." (python-tests-with-temp-buffer commit a08e6423ccc94ff51367768c2d13e549204f9f46 Author: Eli Zaretskii Date: Sat Jan 13 11:23:43 2024 +0200 ; * doc/emacs/fixit.texi (Spelling): Fix last change. diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index a972ed698f7..6fa707ba2cc 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -402,7 +402,7 @@ when you started spell-checking. Quit interactive spell-checking and kill the spell-checker subprocess. @item C-r -Enter recursive-edit (@pxref{Recursive Editing}). When you exit +Enter recursive-edit (@pxref{Recursive Edit}). When you exit recursive-edit with @kbd{C-M-c}, the interactive spell-checking will resume. This allows you to consult the buffer text without interrupting the spell-checking. Do @emph{not} modify the buffer in commit 893829021bd50604b035c058814f280c7386aa46 Author: Stefan Kangas Date: Sat Jan 13 10:20:41 2024 +0100 Fix NULL dereference in w32notify.c * src/w32notify.c (start_watching): Return NULL instead of freed pointer. (add_watch): Fix NULL dereference. diff --git a/src/w32notify.c b/src/w32notify.c index 9f8a62a1daa..c93e8796fe2 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -350,6 +350,7 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags) xfree (dirwatch->io_info); xfree (dirwatch->watchee); xfree (dirwatch); + return NULL; } return dirwatch; } @@ -412,10 +413,7 @@ add_watch (const char *parent_dir, const char *file, BOOL subdirs, DWORD flags) return NULL; if ((dirwatch = start_watching (file, hdir, subdirs, flags)) == NULL) - { - CloseHandle (hdir); - dirwatch->dir = NULL; - } + CloseHandle (hdir); return dirwatch; } commit 1bfc7fd33d78ff29ee62f5a6b7d7769c1f8099c8 Author: Stefan Kangas Date: Sat Jan 13 10:18:03 2024 +0100 Prefer AREF in GET_TRANSLATION_TABLE * src/ccl.c (GET_TRANSLATION_TABLE): Prefer using AREF to depending on vector internals. diff --git a/src/ccl.c b/src/ccl.c index 1d3ad010382..b4dda404b95 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -873,7 +873,7 @@ static struct ccl_prog_stack ccl_prog_stack_struct[256]; static inline Lisp_Object GET_TRANSLATION_TABLE (int id) { - return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]); + return XCDR (AREF (Vtranslation_table_vector, id)); } void commit 418547162d5273de5a524fe857081867258cd511 Author: Eli Zaretskii Date: Fri Jan 12 10:03:08 2024 +0200 Improve documentation of Ispell commands * doc/emacs/fixit.texi (Spelling): Document "C-u M-$" and warn against modifications in recursive-edit. (Bug#14192) diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 13c79b237da..a972ed698f7 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -274,6 +274,9 @@ you can control which one is used by customizing the variable @item M-$ Check and correct spelling of the word at point (@code{ispell-word}). If the region is active, do it for all words in the region instead. +@item C-u M-$ +If a previous spelling operation was interrupted, continue that +operation (@code{ispell-continue}). @item M-x ispell Check and correct spelling of all words in the buffer. If the region is active, do it for all words in the region instead. @@ -305,12 +308,16 @@ Enable Flyspell mode for comments and strings only. @kindex M-$ @findex ispell-word +@findex ispell-continue To check the spelling of the word around or before point, and optionally correct it as well, type @kbd{M-$} (@code{ispell-word}). If a region is active, @kbd{M-$} checks the spelling of all words within the region. @xref{Mark}. (When Transient Mark mode is off, @kbd{M-$} always acts on the word around or before point, ignoring the -region; @pxref{Disabled Transient Mark}.) +region; @pxref{Disabled Transient Mark}.) When invoked with a prefix +argument, @kbd{C-u M-$}, this calls @code{ispell-continue}, which +continues the spelling operation, if any, which was interrupted with +@kbd{X} or @kbd{C-g}. @findex ispell @findex ispell-buffer @@ -383,9 +390,9 @@ wildcard. @item C-g @itemx X -Quit interactive spell-checking, leaving point at the word that was -being checked. You can restart checking again afterward with @w{@kbd{C-u -M-$}}. +Interrupt the interactive spell-checking, leaving point at the word +that was being checked. You can restart checking again afterward with +@w{@kbd{C-u M-$}}. @item x Quit interactive spell-checking and move point back to where it was @@ -394,6 +401,19 @@ when you started spell-checking. @item q Quit interactive spell-checking and kill the spell-checker subprocess. +@item C-r +Enter recursive-edit (@pxref{Recursive Editing}). When you exit +recursive-edit with @kbd{C-M-c}, the interactive spell-checking will +resume. This allows you to consult the buffer text without +interrupting the spell-checking. Do @emph{not} modify the buffer in +the recursive editing, and especially don't modify the misspelled +word, as the edits will be undone when you exit recursive-edit. If +you need to edit the misspelled word, use @kbd{r} or @kbd{R} instead, +or use @kbd{X}, edit the buffer, then resume with @w{@kbd{C-u M-$}}. + +@item C-z +Suspend Emacs or iconify the selected frame. + @item ? Show the list of options. @end table commit c4b4948845508d599f6176441a833ae1a2cb6d40 Author: Stefan Kangas Date: Thu Jan 11 22:36:33 2024 +0100 Don't recommend inverse-video for debugging * etc/DEBUG: Don't recommend 'inverse-video', which has been broken for 20 years, give or take. (Bug#11430) diff --git a/etc/DEBUG b/etc/DEBUG index dd699f962ba..9dae54aeabd 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -864,11 +864,6 @@ in your ~/.emacs file. When the problem happens, exit the Emacs that you were running, kill it, and rename the two files. Then you can start another Emacs without clobbering those files, and use it to examine them. -An easy way to see if too much text is being redrawn on a terminal is to -evaluate '(setq inverse-video t)' before you try the operation you think -will cause too much redrawing. This doesn't refresh the screen, so only -newly drawn text is in inverse video. - ** Debugging LessTif If you encounter bugs whereby Emacs built with LessTif grabs all mouse commit 26eb9d3a8a670a1ce2e8b4f0c6418d39329ec41a Author: Xiyue Deng Date: Thu Jan 11 15:18:37 2024 +0100 Fix typo in lispref "Creating Strings" section * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index ff5da15fe54..a364fef3aab 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called a @dfn{array}, meaning that its length is fixed and +sequence called an @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. commit 99efe5c80f9d90de6540ef6f78504c0413947a25 Author: Xiyue Deng Date: Tue Jan 2 16:31:30 2024 -0800 Fix count of no-op functions (bug#68375) It looks like there are actually three kinds of no-op functions. * doc/lispref/functions.texi (Calling Functions): Fix count and plural of no-op functions. Copyright-paperwork-exempt: yes diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index a32b92955c5..eac5b91e76a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -980,8 +980,8 @@ lists) and call them using @code{funcall} or @code{apply}. Functions that accept function arguments are often called @dfn{functionals}. Sometimes, when you call a functional, it is useful to supply a no-op -function as the argument. Here are two different kinds of no-op -function: +function as the argument. Here are three different kinds of no-op +functions: @defun identity argument This function returns @var{argument} and has no side effects. commit 0c01f97b73cffc373944fd2720e42520e86bc2e4 Author: Xiyue Deng Date: Wed Dec 27 12:35:39 2023 -0800 Wrap @pxref of Abbrevs in parentheses (bug#68375) * doc/lispref/symbols.texi (Shorthands): Wrap `@pxref{Abbrevs}' in parentheses. Copyright-paperwork-exempt: yes diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index dccd9694b2e..dfbcf903e7d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -669,7 +669,7 @@ name} (@pxref{Symbol Components}). It is useful to think of shorthands as @emph{abbreviating} the full names of intended symbols. Despite this, do not confuse shorthands with the -Abbrev system @pxref{Abbrevs}. +Abbrev system (@pxref{Abbrevs}). @cindex namespace etiquette Shorthands make Emacs Lisp's @dfn{namespacing etiquette} easier to work commit 70a09325d658b4618856adac82abc5f66a11a22f Author: Eli Zaretskii Date: Thu Jan 11 08:22:14 2024 +0200 ; Fix last change in widget.texi * doc/misc/widget.texi (url-link, toggle, Defining New Widgets): Divide @example's into @group's. (Bug#66229) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index d4f2ba1e76c..cfb9d2211cf 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1498,6 +1498,7 @@ specified. Example: @lisp +@group (widget-create 'url-link :button-prefix "" :button-suffix "" @@ -1515,6 +1516,7 @@ Example: ;; And then call the original function. (widget-url-link-action widget)) "https://www.gnu.org/software/emacs/manual/html_mono/widget.html") +@end group @end lisp @node info-link @@ -2138,6 +2140,7 @@ correspond to a @code{t} or @code{nil} value, respectively. Example: @lisp +@group (widget-insert "Press the button to activate/deactivate the field: ") (widget-create 'toggle :notify (lambda (widget &rest _ignored) @@ -2146,6 +2149,8 @@ Example: :activate :deactivate)))) (widget-insert "\n") +@end group +@group (setq widget-example-field (widget-create 'editable-field :deactivate (lambda (widget) @@ -2154,6 +2159,7 @@ Example: (widget-field-start widget) (widget-get widget :to))))) (widget-apply widget-example-field :deactivate))) +@end group @end lisp @@ -3066,18 +3072,23 @@ The predefined functions @code{widget-types-convert-widget} and Example: @lisp +@group (defvar widget-ranged-integer-map (let ((map (copy-keymap widget-keymap))) (define-key map [up] #'widget-ranged-integer-increase) (define-key map [down] #'widget-ranged-integer-decrease) map)) +@end group +@group (define-widget 'ranged-integer 'integer "A ranged integer widget." :min-value most-negative-fixnum :max-value most-positive-fixnum :keymap widget-ranged-integer-map) +@end group +@group (defun widget-ranged-integer-change (widget how) "Change the value of the ranged-integer WIDGET, according to HOW." (let* ((value (widget-value widget)) @@ -3093,16 +3104,21 @@ Example: (t (error "HOW has a bad value")))) (inhibit-read-only t)) (widget-value-set widget newval))) +@end group +@group (defun widget-ranged-integer-increase (widget) "Increase the value of the ranged-integer WIDGET." (interactive (list (widget-at))) (widget-ranged-integer-change widget 'up)) +@end group +@group (defun widget-ranged-integer-decrease (widget) "Decrease the value of the ranged-integer WIDGET." (interactive (list (widget-at))) (widget-ranged-integer-change widget 'down)) +@end group @end lisp @node Inspecting Widgets commit 63411709a8dbad8b17c7f1e0cfed99f4aeb174a1 Author: Stefan Kangas Date: Thu Jan 11 00:32:15 2024 +0100 ; Fix typos diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 82d89449dd2..d4f2ba1e76c 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1592,7 +1592,7 @@ Example: (widget-create 'variable-link :button-prefix "" :button-suffix "" - :tag "What setting controlls button-prefix?" + :tag "What setting controls button-prefix?" 'widget-button-prefix) @end lisp diff --git a/etc/TODO b/etc/TODO index a672b6b5b72..9b3796515d2 100644 --- a/etc/TODO +++ b/etc/TODO @@ -156,7 +156,7 @@ from. ** Make back_comment use syntax-ppss or equivalent -* Make play-sound asynchronous and non-blocking +** Make play-sound asynchronous and non-blocking ** Consider improving src/sysdep.c's search for a fqdn https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3247291b6ee..9849fde8588 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1107,7 +1107,7 @@ fontified." (defun python--treesit-fontify-union-types (node override start end &optional type-regex &rest _) "Fontify nested union types in the type hints. -For examlpe, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This +For example, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This structure is represented via nesting binary_operator and subscript nodes. This function iterates over all levels and highlight identifier nodes. If TYPE-REGEX is not nil fontify type @@ -1265,7 +1265,7 @@ fontified." (subscript (identifier) @font-lock-type-face) (subscript (attribute attribute: (identifier) @font-lock-type-face))])) - ;; Patern matching: case [str(), pack0.Type0()]. Take only the + ;; Pattern matching: case [str(), pack0.Type0()]. Take only the ;; last identifier. (class_pattern (dotted_name (identifier) @font-lock-type-face :anchor)) commit 824cf54951c076e2b6a0e3a8e6fb1342cf58b8b6 Author: Stefan Kangas Date: Thu Jan 11 00:25:38 2024 +0100 ; * etc/TODO: Add item to make play-sound non-blocking. diff --git a/etc/TODO b/etc/TODO index ee069e3930b..a672b6b5b72 100644 --- a/etc/TODO +++ b/etc/TODO @@ -156,6 +156,8 @@ from. ** Make back_comment use syntax-ppss or equivalent +* Make play-sound asynchronous and non-blocking + ** Consider improving src/sysdep.c's search for a fqdn https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html commit 4fadbfe300a338f8e6e167331bc7ca0bbca26dbc Author: Mauro Aranda Date: Fri Sep 22 20:45:00 2023 -0300 Add examples to the Widget manual * doc/misc/widget.texi (Widget Gallery, Defining New Widgets): Add examples. (Bug#66229) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 93b7606b01e..82d89449dd2 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1384,6 +1384,15 @@ a specific way. If present, @var{value} is used to initialize the @code{:value} property. When created, it inserts the value as a string in the buffer. +@noindent +Example: + +@lisp +(widget-create 'item :tag "Today is" :format "%t: %v\n" + (format-time-string "%d-%m-%Y")) +@end lisp + + By default, it has the following properties: @table @code @@ -1428,6 +1437,20 @@ The @var{value}, if present, is used to initialize the @code{:value} property. The value should be a string, which will be inserted in the buffer. +@noindent +Example: + +@lisp +(widget-create 'link + :button-prefix "" + :button-suffix "" + :tag "Mail yourself" + :action #'(lambda (widget &optional _event) + (compose-mail-other-window (widget-value widget))) + user-mail-address) +@end lisp + + By default, it has the following properties: @table @code @@ -1471,6 +1494,29 @@ A widget to represent a link to a web page. Its super is the It overrides the @code{:action} property to open up the @var{url} specified. +@noindent +Example: + +@lisp +(widget-create 'url-link + :button-prefix "" + :button-suffix "" + ;; Return appropriate face. + :button-face-get (lambda (widget) + (if (widget-get widget :visited) + 'link-visited + 'link)) + :format "%[%t%]" + :tag "Browse this manual" + :action (lambda (widget &optional _event) + (widget-put widget :visited t) + ;; Takes care of redrawing the widget. + (widget-value-set widget (widget-value widget)) + ;; And then call the original function. + (widget-url-link-action widget)) + "https://www.gnu.org/software/emacs/manual/html_mono/widget.html") +@end lisp + @node info-link @subsection The @code{info-link} Widget @findex info-link@r{ widget} @@ -1487,6 +1533,17 @@ A widget to represent a link to an info file. Its super is the It overrides the @code{:action} property, to a function to start the built-in Info reader on @var{address}, when invoked. +@noindent +Example: + +@lisp +(widget-create 'info-link + :button-prefix "" + :button-suffix "" + :tag "Browse this manual" + "(widget) info-link"))) +@end lisp + @node function-link @subsection The @code{function-link} Widget @findex function-link@r{ widget} @@ -1502,6 +1559,17 @@ A widget to represent a link to an Emacs function. Its super is the It overrides the @code{:action} property, to a function to describe @var{function}. +@noindent +Example: + +@lisp +(widget-create 'function-link + :button-prefix "" + :button-suffix "" + :tag "Describe the function that gets called" + #'widget-function-link-action) +@end lisp + @node variable-link @subsection The @code{variable-link} Widget @findex variable-link@r{ widget} @@ -1517,6 +1585,17 @@ A widget to represent a link to an Emacs variable. Its super is the It overrides the @code{:action} property, to a function to describe @var{var}. +@noindent +Example: + +@lisp +(widget-create 'variable-link + :button-prefix "" + :button-suffix "" + :tag "What setting controlls button-prefix?" + 'widget-button-prefix) +@end lisp + @node face-link @subsection The @code{face-link} Widget @findex face-link@r{ widget} @@ -1532,6 +1611,17 @@ A widget to represent a link to an Emacs face. Its super is the It overrides the @code{:action} property, to a function to describe @var{face}. +@noindent +Example: + +@lisp +(widget-create 'face-link + :button-prefix "" + :button-suffix "" + :tag "Which face is this one?" + 'widget-button) +@end lisp + @node file-link @subsection The @code{file-link} Widget @findex file-link@r{ widget} @@ -1547,6 +1637,19 @@ A widget to represent a link to a file. Its super is the It overrides the @code{:action} property, to a function to find the file @var{file}. +@noindent +Example: + +@lisp +(let ((elisp-files (directory-files user-emacs-directory t ".el$"))) + (dolist (file elisp-files) + (widget-create 'file-link + :button-prefix "" + :button-suffix "" + file) + (widget-insert "\n"))) +@end lisp + @node emacs-library-link @subsection The @code{emacs-library-link} Widget @findex emacs-library-link@r{ widget} @@ -1562,6 +1665,17 @@ A widget to represent a link to an Emacs Lisp file. Its super is the It overrides the @code{:action} property, to a function to find the file @var{file}. +@noindent +Example: + +@lisp +(widget-create 'emacs-library-link + :button-prefix "" + :button-suffix "" + :tag "Show yourself, Widget Library!" + "wid-edit.el") +@end lisp + @node emacs-commentary-link @subsection The @code{emacs-commentary-link} Widget @findex emacs-commentary-link@r{ widget} @@ -1577,6 +1691,17 @@ file. Its super is the @code{link} widget. It overrides the @code{:action} property, to a function to find the file @var{file} and put point in the Comment section. +@noindent +Example: + +@lisp +(widget-create 'emacs-commentary-link + :button-prefix "" + :button-suffix "" + :tag "Check our good friend Customize" + "cus-edit.el") +@end lisp + @node push-button @subsection The @code{push-button} Widget @findex push-button@r{ widget} @@ -2009,6 +2134,29 @@ A widget that can toggle between two states. Its super is the The widget has two possible states, @samp{on} and @samp{off}, which correspond to a @code{t} or @code{nil} value, respectively. +@noindent +Example: + +@lisp +(widget-insert "Press the button to activate/deactivate the field: ") +(widget-create 'toggle + :notify (lambda (widget &rest _ignored) + (widget-apply widget-example-field + (if (widget-value widget) + :activate + :deactivate)))) +(widget-insert "\n") +(setq widget-example-field + (widget-create 'editable-field + :deactivate (lambda (widget) + (widget-specify-inactive + widget + (widget-field-start widget) + (widget-get widget :to))))) +(widget-apply widget-example-field :deactivate))) +@end lisp + + It either overrides or adds the following properties: @table @code @@ -2148,6 +2296,21 @@ The @var{type} arguments represent each checklist item. The widget's value will be a list containing the values of all checked @var{type} arguments. +@noindent +Example: + +@lisp +(widget-create 'checklist + :notify (lambda (widget child &optional _event) + (funcall + (widget-value (widget-get-sibling child)) + 'toggle)) + :value (list 'tool-bar-mode 'menu-bar-mode) + '(item :tag "Tool-bar" tool-bar-mode) + '(item :tag "Menu-bar" menu-bar-mode)))) +@end lisp + + It either overrides or adds the following properties: @table @code @@ -2899,6 +3062,49 @@ The predefined functions @code{widget-types-convert-widget} and @code{widget-value-convert-widget} can be used here. @end table +@noindent +Example: + +@lisp +(defvar widget-ranged-integer-map + (let ((map (copy-keymap widget-keymap))) + (define-key map [up] #'widget-ranged-integer-increase) + (define-key map [down] #'widget-ranged-integer-decrease) + map)) + +(define-widget 'ranged-integer 'integer + "A ranged integer widget." + :min-value most-negative-fixnum + :max-value most-positive-fixnum + :keymap widget-ranged-integer-map) + +(defun widget-ranged-integer-change (widget how) + "Change the value of the ranged-integer WIDGET, according to HOW." + (let* ((value (widget-value widget)) + (newval (cond + ((eq how 'up) + (if (< (1+ value) (widget-get widget :max-value)) + (1+ value) + (widget-get widget :max-value))) + ((eq how 'down) + (if (> (1- value) (widget-get widget :min-value)) + (1- value) + (widget-get widget :min-value))) + (t (error "HOW has a bad value")))) + (inhibit-read-only t)) + (widget-value-set widget newval))) + +(defun widget-ranged-integer-increase (widget) + "Increase the value of the ranged-integer WIDGET." + (interactive (list (widget-at))) + (widget-ranged-integer-change widget 'up)) + +(defun widget-ranged-integer-decrease (widget) + "Decrease the value of the ranged-integer WIDGET." + (interactive (list (widget-at))) + (widget-ranged-integer-change widget 'down)) +@end lisp + @node Inspecting Widgets @chapter Inspecting Widgets @cindex widget browser commit 1bbb610821eb143e0828d2541a3f856d29d67b6f Author: Mauro Aranda Date: Sun Nov 5 07:23:55 2023 -0300 Implement missing functions for custom-icon widget * lisp/cus-edit.el (custom-icon-reset-saved, custom-icon-mark-to-save) (custom-icon-state-set-and-redraw, custom-icon-reset-standard) (custom-icon-mark-to-reset-standard): New functions. (custom-icon, custom-icon-extended-menu): Register and add them to the menu. (Bug#66947) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 62564f6dfcb..12eea0fa0e5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -5348,9 +5348,49 @@ The following properties have special meanings for this widget: :hidden-states '(standard) :action #'custom-icon-action :custom-set #'custom-icon-set - :custom-reset-current #'custom-redraw) - ;; Not implemented yet. - ;; :custom-reset-saved 'custom-icon-reset-saved) + :custom-mark-to-save #'custom-icon-mark-to-save + :custom-reset-current #'custom-redraw + :custom-reset-saved #'custom-icon-reset-saved + :custom-state-set-and-redraw #'custom-icon-state-set-and-redraw + :custom-reset-standard #'custom-icon-reset-standard + :custom-mark-to-reset-standard #'custom-icon-mark-to-reset-standard) + +(defun custom-icon-mark-to-save (widget) + "Mark user customization for icon edited by WIDGET to be saved later." + (let* ((icon (widget-value widget)) + (value (custom--icons-widget-value + (car (widget-get widget :children))))) + (custom-push-theme 'theme-icon icon 'user 'set value))) + +(defun custom-icon-reset-saved (widget) + "Restore icon customized by WIDGET to the icon's default attributes. + +If there's a theme value for the icon, resets to that. Otherwise, resets to +its standard value." + (let* ((icon (widget-value widget))) + (custom-push-theme 'theme-icon icon 'user 'reset) + (custom-icon-state-set widget) + (custom-redraw widget))) + +(defun custom-icon-state-set-and-redraw (widget) + "Set state of icon widget WIDGET and redraw it with up-to-date settings." + (custom-icon-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-icon-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + (let* ((icon (widget-value widget)) + (themes (get icon 'theme-icon))) + (dolist (theme themes) + (custom-push-theme 'theme-icon icon (car theme) 'reset)) + (custom-save-all)) + (widget-put widget :custom-state 'unknown) + (custom-redraw widget)) + +(defun custom-icon-mark-to-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + ;; Don't mark for now, there aren't that many icons. + (custom-icon-reset-standard widget)) (defvar custom-icon-extended-menu (let ((map (make-sparse-keymap))) @@ -5369,6 +5409,18 @@ The following properties have special meanings for this widget: :enable (memq (widget-get custom-actioned-widget :custom-state) '(modified changed)))) + (define-key-after map [custom-icon-reset-saved] + '(menu-item "Revert This Session's Customization" + custom-icon-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed rogue)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-icon-reset-standard] + '(menu-item "Erase Customization" custom-icon-reset-standard + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed saved rogue))))) map) "A menu for `custom-icon' widgets. Used in `custom-icon-action' to show a menu to the user.") commit 29af214a75a3d77e603c377e1247a3ca85c130c5 Author: Stephen Berman Date: Wed Jan 10 16:24:53 2024 +0100 Fix fontification of cgroup2 in fstab (bug#68367) * lisp/generic-x.el (etc-fstab-generic-mode): Add cgroup2. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index b4ae0225943..373bfad92dd 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1491,6 +1491,7 @@ like an INI file. You can add this hook to `find-file-hook'." "cd9660" "cfs" "cgroup" + "cgroup2" "cifs" "coda" "coherent" commit 5567ce1a9ff8d893348ac8a3f64953426e2a7c86 Author: Philip Kaludercic Date: Wed Jan 10 09:25:41 2024 +0100 Handle package versions that are not version strings * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore any errors raised by 'version-to-list', thus falling back to the default version list. (Bug#68317) (cherry picked from commit eb913c7501489e1eae475cae843fccdf14cc24d8) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c7769d5430c..608306c8254 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4003,8 +4003,8 @@ invocations." (defun package-menu--version-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the version column. This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0))) - (vB (or (version-to-list (aref (cadr B) 1)) '(0)))) + (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) + (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) (if (version-list-= vA vB) (package-menu--name-predicate A B) (version-list-< vA vB)))) commit d58d0fa52ff22e147b8328759d5f0f762e15bbb5 Author: Jim Porter Date: Wed Oct 25 20:43:57 2023 -0700 Introduce 'let' using lexical binding in the Lisp Introduction * doc/lispintro/emacs-lisp-intro.texi (Prevent confusion): Rework the explanation to discuss how things work under lexical binding. (How let Binds Variables): Describe the differences between lexical and dynamic binding (including how to configure it). (defvar): Mention that 'defvar' declares variables as always dynamically-bound (bug#66756). diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 1e10f62104a..b3fe8ce4589 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -3556,6 +3556,7 @@ and the two are not intended to refer to the same value. The * Parts of let Expression:: * Sample let Expression:: * Uninitialized let Variables:: +* How let Binds Variables:: @end menu @ifnottex @@ -3569,24 +3570,26 @@ and the two are not intended to refer to the same value. The @cindex @samp{variable, local}, defined The @code{let} special form prevents confusion. @code{let} creates a name for a @dfn{local variable} that overshadows any use of the same -name outside the @code{let} expression. This is like understanding -that whenever your host refers to ``the house'', he means his house, not -yours. (Symbols used in argument lists work the same way. +name outside the @code{let} expression (in computer science jargon, we +call this @dfn{binding} the variable). This is like understanding +that in your host's home, whenever he refers to ``the house'', he +means his house, not yours. (The symbols used to name function +arguments are bound as local variables in exactly the same way. @xref{defun, , The @code{defun} Macro}.) -Local variables created by a @code{let} expression retain their value -@emph{only} within the @code{let} expression itself (and within -expressions called within the @code{let} expression); the local -variables have no effect outside the @code{let} expression. - -Another way to think about @code{let} is that it is like a @code{setq} -that is temporary and local. The values set by @code{let} are -automatically undone when the @code{let} is finished. The setting -only affects expressions that are inside the bounds of the @code{let} -expression. In computer science jargon, we would say the binding of -a symbol is visible only in functions called in the @code{let} form; -in Emacs Lisp, the default scoping is dynamic, not lexical. (The -non-default lexical binding is not discussed in this manual.) +Another way to think about @code{let} is that it defines a special +region in your code: within the body of the @code{let} expression, the +variables you've named have their own local meaning. Outside of the +@code{let} body, they have other meanings (or they may not be defined +at all). This means that inside the @code{let} body, calling +@code{setq} for a variable named by the @code{let} expression will set +the value of the @emph{local} variable of that name. However, outside +of the @code{let} body (such as when calling a function that was +defined elsewhere), calling @code{setq} for a variable named by the +@code{let} expression will @emph{not} affect that local +variable.@footnote{This describes the behavior of @code{let} when +using a style called ``lexical binding'' (@pxref{How let Binds +Variables}).} @code{let} can create more than one variable at once. Also, @code{let} gives each variable it creates an initial value, either a @@ -3746,6 +3749,128 @@ number is printed in the message using a @samp{%d} rather than a @samp{%s}.) The four variables as a group are put into a list to delimit them from the body of the @code{let}. +@node How let Binds Variables +@subsection How @code{let} Binds Variables + +Emacs Lisp supports two different ways of binding variable names to +their values. These ways affect the parts of your program where a +particular binding is valid. For historical reasons, Emacs Lisp uses +a form of variable binding called @dfn{dynamic binding} by default. +However, in this manual we discuss the preferred form of binding, +called @dfn{lexical binding}, unless otherwise noted (in the future, +the Emacs maintainers plan to change the default to lexical binding). +If you have programmed in other languages before, you're likely +already familiar with how lexical binding behaves. + +In order to use lexical binding in a program, you should add this to +the first line of your Emacs Lisp file: + +@example +;;; -*- lexical-binding: t -*- +@end example + +For more information about this, @pxref{Selecting Lisp Dialect, , , +elisp, The Emacs Lisp Reference Manual}. + +@menu +* Lexical & Dynamic Binding Differences:: +* Lexical vs. Dynamic Binding Example:: +@end menu + +@node Lexical & Dynamic Binding Differences +@unnumberedsubsubsec Differences Between Lexical and Dynamic Binding + +@cindex Lexical binding +@cindex Binding, lexical +As we discussed before (@pxref{Prevent confusion}), when you create +local variables with @code{let} under lexical binding, those variables +are valid only within the body of the @code{let} expression. In other +parts of your code, they have other meanings, so if you call a +function defined elsewhere within the @code{let} body, that function +would be unable to ``see'' the local variables you've created. (On +the other hand, if you call a function that was defined within a +@code{let} body, that function @emph{would} be able to see---and +modify---the local variables from that @code{let} expression.) + +@cindex Dynamic binding +@cindex Binding, dynamic +Under dynamic binding, the rules are different: instead, when you use +@code{let}, the local variables you've created are valid during +execution of the @code{let} expression. This means that, if your +@code{let} expression calls a function, that function can see these +local variables, regardless of where the function is defined +(including in another file entirely). + +Another way to think about @code{let} when using dynamic binding is +that every variable name has a global ``stack'' of bindings, and +whenever you use that variable's name, it refers to the binding on the +top of the stack. (You can imagine this like a stack of papers on +your desk with the values written on them.) When you bind a variable +dynamically with @code{let}, it puts the new binding you've specified +on the top of the stack, and then executes the @code{let} body. Once +the @code{let} body finishes, it takes that binding off of the stack, +revealing the one it had (if any) before the @code{let} expression. + +@node Lexical vs. Dynamic Binding Example +@unnumberedsubsubsec Example of Lexical vs. Dynamic Binding +In some cases, both lexical and dynamic binding behave identically. +However, in other cases, they can change the meaning of your program. +For example, see what happens in this code under lexical binding: + +@example +;;; -*- lexical-binding: t -*- + +(setq x 0) + +(defun getx () + x) + +(setq x 1) + +(let ((x 2)) + (getx)) + @result{} 1 +@end example + +@noindent +Here, the result of @code{(getx)} is @code{1}. Under lexical binding, +@code{getx} doesn't see the value from our @code{let} expression. +That's because the body of @code{getx} is outside of the body of our +@code{let} expression. Since @code{getx} is defined at the top, +global level of our code (i.e.@: not inside the body of any @code{let} +expression), it looks for and finds @code{x} at the global level as +well. When executing @code{getx}, the current global value of +@code{x} is @code{1}, so that's what @code{getx} returns. + +If we use dynamic binding instead, the behavior is different: + +@example +;;; -*- lexical-binding: nil -*- + +(setq x 0) + +(defun getx () + x) + +(setq x 1) + +(let ((x 2)) + (getx)) + @result{} 2 +@end example + +@noindent +Now, the result of @code{(getx)} is @code{2}! That's because under +dynamic binding, when executing @code{getx}, the current binding for +@code{x} at the top of our stack is the one from our @code{let} +binding. This time, @code{getx} doesn't see the global value for +@code{x}, since its binding is below the one from our @code{let} +expression in the stack of bindings. + +(Some variables are also ``special'', and they are always dynamically +bound even when @code{lexical-binding} is @code{t}. @xref{defvar, , +Initializing a Variable with @code{defvar}}.) + @node if @section The @code{if} Special Form @findex if @@ -9101,12 +9226,14 @@ In Emacs Lisp, a variable such as the @code{kill-ring} is created and given an initial value by using the @code{defvar} special form. The name comes from ``define variable''. -The @code{defvar} special form is similar to @code{setq} in that it sets -the value of a variable. It is unlike @code{setq} in two ways: first, -it only sets the value of the variable if the variable does not already -have a value. If the variable already has a value, @code{defvar} does -not override the existing value. Second, @code{defvar} has a -documentation string. +The @code{defvar} special form is similar to @code{setq} in that it +sets the value of a variable. It is unlike @code{setq} in three ways: +first, it marks the variable as ``special'' so that it is always +dynamically bound, even when @code{lexical-binding} is @code{t} +(@pxref{How let Binds Variables}). Second, it only sets the value of +the variable if the variable does not already have a value. If the +variable already has a value, @code{defvar} does not override the +existing value. Third, @code{defvar} has a documentation string. (There is a related macro, @code{defcustom}, designed for variables that people customize. It has more features than @code{defvar}. commit 1b123972636d717241a38bcd6daa3e3f424fb8b0 Author: Eli Zaretskii Date: Sun Jan 7 17:15:18 2024 +0200 ; Don't record multiple versions of use-package * lisp/use-package/use-package-ensure-system-package.el: Remove Version: header, to avoid confusing loaddefs-gene. (Bug#68304) diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el index 12bf16998a1..3e369d99624 100644 --- a/lisp/use-package/use-package-ensure-system-package.el +++ b/lisp/use-package/use-package-ensure-system-package.el @@ -5,7 +5,6 @@ ;; Author: Justin Talbott ;; Keywords: convenience, tools, extensions ;; URL: https://github.com/waymondo/use-package-ensure-system-package -;; Version: 0.2 ;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4")) ;; Filename: use-package-ensure-system-package.el ;; Package: use-package commit 8729a2a10d9b8d88f6ba33b5ce62f74d89e7788a Author: Eli Zaretskii Date: Sat Jan 6 19:30:16 2024 +0200 Fix 'rmail-summary-by-thread' * lisp/mail/rmailsum.el (rmail-summary-by-thread): Call 'rmail-new-summary' from the original buffer, not from 'rmail-buffer' to avoid failing the logic in 'rmail-new-summary' that decides whether to pop up a new window. Reported by Andrea Monaco . diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 30fe75f7e5c..cccd702dae2 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -436,19 +436,19 @@ headers of the messages." (unless (and rmail-summary-message-parents-vector (= (length rmail-summary-message-parents-vector) (1+ rmail-total-messages))) - (rmail-summary-fill-message-parents-and-descs-vectors)) - (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) - (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) - (rmail-new-summary (format "thread containing message %d" msgnum) - (list 'rmail-summary-by-thread msgnum) - (if (and rmail-summary-progressively-narrow - (rmail-summary--exists-1)) - (lambda (msg _msgnum) - (and (aref rmail-summary-currently-displayed-msgs msg) - (aref enc-msgs msg))) + (rmail-summary-fill-message-parents-and-descs-vectors))) + (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) + (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) + (rmail-new-summary (format "thread containing message %d" msgnum) + (list 'rmail-summary-by-thread msgnum) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg _msgnum) - (aref enc-msgs msg))) - msgnum)))) + (and (aref rmail-summary-currently-displayed-msgs msg) + (aref enc-msgs msg))) + (lambda (msg _msgnum) + (aref enc-msgs msg))) + msgnum))) ;;;###autoload (defun rmail-summary-by-labels (labels) commit 2a8c00bfc073d8c42c5c325289a8eada2ae5b309 Author: Jean-Christophe Helary Date: Sat Jan 6 15:55:58 2024 +0000 * doc/emacs/back.texi: Fix a typo. diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index b8094c6cf36..ff6905d8b02 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -78,7 +78,7 @@ And much more! Emacs comes with an introductory online tutorial available in many languages, and this nineteenth edition of the manual picks up where that tutorial ends. It explains the full range of the power of Emacs, -now up to @strong[version 27.2,} and contains reference material +now up to @strong{version 27.2,} and contains reference material useful to expert users. It also includes appendices with specific material about X and GTK resources, and with details for users of macOS and Microsoft Windows.