commit f5ee04277135ebaa67579dbbff430101627943a2 (HEAD, refs/remotes/origin/master) Author: Dmitry Gutov Date: Mon Feb 20 00:10:24 2017 +0200 Use revision-completion-table in vc-retrieve-tag * lisp/vc/vc.el (vc-retrieve-tag): Use the revision-completion-table command for completion (bug#25710). diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 64e88de60e..0c8492d021 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2163,18 +2163,22 @@ If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are allowed and simply skipped)." (interactive - (let ((granularity - (vc-call-backend (vc-responsible-backend default-directory) - 'revision-granularity))) + (let* ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity)) + (dir + (if (eq granularity 'repository) + ;; For VC's that do not work at file level, it's pointless + ;; to ask for a directory, branches are created at repository level. + ;; XXX: Either we call expand-file-name here, or use + ;; file-in-directory-p inside vc-resynch-buffers-in-directory. + (expand-file-name (vc-root-dir)) + (read-directory-name "Directory: " default-directory nil t)))) (list - (if (eq granularity 'repository) - ;; For VC's that do not work at file level, it's pointless - ;; to ask for a directory, branches are created at repository level. - ;; XXX: Either we call expand-file-name here, or use - ;; file-in-directory-p inside vc-resynch-buffers-in-directory. - (expand-file-name (vc-root-dir)) - (read-directory-name "Directory: " default-directory default-directory t)) - (read-string "Tag name to retrieve (default latest revisions): ")))) + dir + (vc-read-revision "Tag name to retrieve (default latest revisions): " + (list dir) + (vc-responsible-backend dir))))) (let ((update (yes-or-no-p "Update any affected buffers? ")) (msg (if (or (not name) (string= name "")) (format "Updating %s... " (abbreviate-file-name dir)) commit fb997d30af28da4712ca64876feddbd07db20e13 Author: Stefan Monnier Date: Tue Feb 21 21:44:32 2017 -0500 * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-types): Add `atom' remove entries whose car can't be returned by type-of. (cl--generic-all-builtin-types): New var. (cl-generic-generalizers): Use it to avoid requiring extra entries in cl--generic-typeof-types. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b7695af32f..8517e1ee64 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1144,21 +1144,28 @@ These match if the argument is `eql' to VAL." (defconst cl--generic-typeof-types ;; Hand made from the source code of `type-of'. - '((integer number) (symbol) (string array sequence) (cons list sequence) + '((integer number number-or-marker atom) + (symbol atom) (string array sequence atom) + (cons list sequence) ;; Markers aren't `numberp', yet they are accepted wherever integers are ;; accepted, pretty much. - (marker) (overlay) (float number) (window-configuration) - (process) (window) (subr) (compiled-function) (buffer) - (char-table array sequence) - (bool-vector array sequence) - (frame) (hash-table) (font-spec) (font-entity) (font-object) - (vector array sequence) - ;; Plus, hand made: - (null symbol list sequence) - (list sequence) - (array sequence) - (sequence) - (number))) + (marker number-or-marker atom) + (overlay atom) (float number atom) (window-configuration atom) + (process atom) (window atom) (subr atom) (compiled-function function atom) + (buffer atom) (char-table array sequence atom) + (bool-vector array sequence atom) + (frame atom) (hash-table atom) + (font-spec atom) (font-entity atom) (font-object atom) + (vector array sequence atom) + ;; Plus, really hand made: + (null symbol list sequence atom)) + "Alist of supertypes. +Each element has the form (TYPE . SUPERTYPES) where TYPE is one of +the symbols returned by `type-of', and SUPERTYPES is the list of its +supertypes from the most specific to least specific.") + +(defconst cl--generic-all-builtin-types + (delete-dups (copy-sequence (apply #'append cl--generic-typeof-types)))) (cl-generic-define-generalizer cl--generic-typeof-generalizer ;; FIXME: We could also change `type-of' to return `null' for nil. @@ -1170,9 +1177,9 @@ These match if the argument is `eql' to VAL." "Support for dispatch on builtin types. See the full list and their hierarchy in `cl--generic-typeof-types'." ;; FIXME: Add support for other types accepted by `cl-typep' such - ;; as `character', `atom', `face', `function', ... + ;; as `character', `face', `function', ... (or - (and (assq type cl--generic-typeof-types) + (and (memq type cl--generic-all-builtin-types) (progn ;; FIXME: While this wrinkle in the semantics can be occasionally ;; problematic, this warning is more often annoying than helpful. commit 907bad07f25ca91e72ebb29a468c6b1b8b91fa49 Author: Noam Postavsky Date: Tue Feb 21 21:31:24 2017 -0500 Find macro binding for symbol-bound macros too (Bug#6848) There are 2 ways to bind a macro: with global-set-key or kmacro-bind-to-key. The former binds a key to a symbol, while the latter binds to a lambda. In 2010-03-03 "Fix keyboard macro key lookup (Bug#5481)", `insert-kbd-macro' was fixed to detect the lambda case, but broke the symbol case. * lisp/macros.el (insert-kbd-macro): Also check for bindings of MACRONAME. diff --git a/lisp/macros.el b/lisp/macros.el index c1348295eb..fc65489fe6 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -140,8 +140,9 @@ use this command, and then save the file." (prin1 definition (current-buffer)))) (insert ")\n") (if keys - (let ((keys (where-is-internal (symbol-function macroname) - '(keymap)))) + (let ((keys (or (where-is-internal (symbol-function macroname) + '(keymap)) + (where-is-internal macroname '(keymap))))) (while keys (insert "(global-set-key ") (prin1 (car keys) (current-buffer)) commit 3f1cd957ff319ce4b2ae94d656c9c702fa9ce653 Author: Stefan Monnier Date: Tue Feb 21 21:32:27 2017 -0500 * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Fix last change diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index d9321b1356..b7695af32f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -231,9 +231,9 @@ DEFAULT-BODY, if present, is used as the body of a default method. (defalias ',name (cl-generic-define ',name ',args ',(nreverse options)) ,(help-add-fundoc-usage doc args)) + :autoload-end ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) (nreverse methods))) - :autoload-end ,@(mapcar (lambda (declaration) (let ((f (cdr (assq (car declaration) defun-declarations-alist)))) commit cd191c80344ce444a2845147d7e77e4330f2e993 Author: Juri Linkov Date: Wed Feb 22 02:16:06 2017 +0200 * lisp/isearch.el (lazy-highlight-max-at-a-time): Doc fix (bug#21092). diff --git a/lisp/isearch.el b/lisp/isearch.el index 699d6eaf73..c34739d638 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -341,7 +341,7 @@ If this is nil, extra highlighting can be \"manually\" removed with "Maximum matches to highlight at a time (for `lazy-highlight'). Larger values may reduce Isearch's responsiveness to user input; smaller values make matches highlight slowly. -A value of nil means highlight all matches." +A value of nil means highlight all matches shown on the screen." :type '(choice (const :tag "All" nil) (integer :tag "Some")) :group 'lazy-highlight) commit c5e66afa88d6ff8ad5c42318d85188ed477e7db2 Author: Juri Linkov Date: Wed Feb 22 02:10:36 2017 +0200 * lisp/isearch.el (isearch-lazy-highlight): New choice ‘all-windows’. (isearch-lazy-highlight-update): Check it to decide whether to apply overlays only on the selected window. * lisp/follow.el (follow-mode): Set isearch-lazy-highlight to ‘all-windows’. (Bug#17453, bug#21092) diff --git a/lisp/follow.el b/lisp/follow.el index 3ad4f10890..db3b2821a5 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -427,6 +427,9 @@ Keys specific to Follow mode: (add-hook 'replace-update-post-hook 'follow-post-command-hook nil t) (add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t) + (when isearch-lazy-highlight + (setq-local isearch-lazy-highlight 'all-windows)) + (setq window-group-start-function 'follow-window-start) (setq window-group-end-function 'follow-window-end) (setq set-window-group-start-function 'follow-set-window-start) diff --git a/lisp/isearch.el b/lisp/isearch.el index d0fb15ec64..699d6eaf73 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -285,8 +285,13 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' "Controls the lazy-highlighting during incremental search. When non-nil, all text in the buffer matching the current search string is highlighted lazily (see `lazy-highlight-initial-delay' -and `lazy-highlight-interval')." - :type 'boolean +and `lazy-highlight-interval'). + +When multiple windows display the current buffer, the +highlighting is displayed only on the selected window, unless +this variable is set to the symbol `all-windows'." + :type '(choice boolean + (const :tag "On, and applied to all windows" all-windows)) :group 'lazy-highlight :group 'isearch) @@ -3298,8 +3303,9 @@ Attempt to do the search exactly the way the pending Isearch would." ;; 1000 is higher than ediff's 100+, ;; but lower than isearch main overlay's 1001 (overlay-put ov 'priority 1000) - (overlay-put ov 'face 'lazy-highlight))) - ;(overlay-put ov 'window (selected-window)))) + (overlay-put ov 'face 'lazy-highlight) + (unless (eq isearch-lazy-highlight 'all-windows) + (overlay-put ov 'window (selected-window))))) ;; Remember the current position of point for ;; the next call of `isearch-lazy-highlight-update' ;; when `lazy-highlight-max-at-a-time' is too small. commit 17af43ca76692c7e889c91d3fa9e6690349f0d57 Author: Paul Eggert Date: Tue Feb 21 15:31:29 2017 -0800 Minor weak hash table performance tweaks * src/fns.c (make_hash_table): Omit unnecessary assignment to h->next_weak when the hash table is not weak. (copy_hash_table): Put the copy next to the original in the weak_hash_tables list, as this should have better locality when scanning the weak hash tables. diff --git a/src/fns.c b/src/fns.c index 9668c885ab..0b694529c5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3756,9 +3756,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, eassert (XHASH_TABLE (table) == h); /* Maybe add this hash table to the list of all weak hash tables. */ - if (NILP (h->weak)) - h->next_weak = NULL; - else + if (! NILP (weak)) { h->next_weak = weak_hash_tables; weak_hash_tables = h; @@ -3788,8 +3786,8 @@ copy_hash_table (struct Lisp_Hash_Table *h1) /* Maybe add this hash table to the list of all weak hash tables. */ if (!NILP (h2->weak)) { - h2->next_weak = weak_hash_tables; - weak_hash_tables = h2; + h2->next_weak = h1->next_weak; + h1->next_weak = h2; } return table; commit 83c9c6fc1cc943f239a021b42a8ca9b0e162198c Author: Paul Eggert Date: Tue Feb 21 15:31:29 2017 -0800 Use float instead of Lisp_Object for rehash_size * src/alloc.c (purecopy_hash_table): * src/fns.c (maybe_resize_hash_table, Fmake_hash_table): (Fhash_table_rehash_size): * src/lisp.h (struct Lisp_Hash_Table.rehash_size): The rehash_size member of struct Lisp_Hash_Table is now a float, not a Lisp_Object. * src/alloc.c (purecopy_hash_table): Assign members in order. * src/fns.c (make_hash_table): Use EMACS_INT for size and float for rehash_size, instead of Lisp_Object for both. All callers changed. * src/lisp.h (DEFAULT_REHASH_SIZE): Now float, not double, and 1 smaller. * src/print.c (print_object): Simplify by calling Fhash_table_rehash_size and Fhash_table_rehash_threshold. Avoid unnecessary NILP. diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 4ba3258d18..4d1582055f 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -133,10 +133,10 @@ 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 that much to the nominal size. If +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 that -number. +than 1, and the hash table grows by multiplying the old size by +approximately that number. The default value is 1.5. diff --git a/src/alloc.c b/src/alloc.c index 5da4290701..b44b90e558 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5453,18 +5453,18 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure_test.user_hash_function = purecopy (table->test.user_hash_function); pure_test.user_cmp_function = purecopy (table->test.user_cmp_function); - pure->test = pure_test; pure->header = table->header; pure->weak = purecopy (Qnil); - pure->rehash_size = purecopy (table->rehash_size); pure->hash = purecopy (table->hash); pure->next = purecopy (table->next); - pure->next_free = table->next_free; pure->index = purecopy (table->index); pure->count = table->count; + pure->next_free = table->next_free; pure->pure = table->pure; pure->rehash_threshold = table->rehash_threshold; + pure->rehash_size = table->rehash_size; pure->key_and_value = purecopy (table->key_and_value); + pure->test = pure_test; return pure; } diff --git a/src/category.c b/src/category.c index f5edd20c8a..b633f65532 100644 --- a/src/category.c +++ b/src/category.c @@ -64,9 +64,8 @@ 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, make_number (DEFAULT_HASH_SIZE), - make_float (DEFAULT_REHASH_SIZE), - DEFAULT_REHASH_THRESHOLD, + make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false)); h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); i = hash_lookup (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index 5a66b51651..1b445dcc3b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1013,9 +1013,8 @@ syms_of_module (void) doc: /* Module global reference table. */); Vmodule_refs_hash - = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), - make_float (DEFAULT_REHASH_SIZE), - DEFAULT_REHASH_THRESHOLD, + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, + DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); Funintern (Qmodule_refs_hash, Qnil); diff --git a/src/fns.c b/src/fns.c index 3769c4efb7..9668c885ab 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3684,13 +3684,13 @@ allocate_hash_table (void) `equal' or a symbol denoting a user-defined test named TEST with test and hash functions USER_TEST and USER_HASH. - Give the table initial capacity SIZE, SIZE >= 0, an integer. + Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM. - If REHASH_SIZE is an integer, it must be > 0, and this hash table's - new size when it becomes full is computed by adding REHASH_SIZE to - its old size. If REHASH_SIZE is a float, it must be > 1.0, and the - table's new size is computed by multiplying its old size with - REHASH_SIZE. + 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 @@ -3704,34 +3704,31 @@ allocate_hash_table (void) changed after purecopy. */ Lisp_Object -make_hash_table (struct hash_table_test test, - Lisp_Object size, Lisp_Object rehash_size, - float rehash_threshold, Lisp_Object weak, - bool pure) +make_hash_table (struct hash_table_test test, EMACS_INT size, + float rehash_size, float rehash_threshold, + Lisp_Object weak, bool pure) { struct Lisp_Hash_Table *h; Lisp_Object table; - EMACS_INT index_size, sz; + EMACS_INT index_size; ptrdiff_t i; double index_float; /* Preconditions. */ eassert (SYMBOLP (test.name)); - eassert (INTEGERP (size) && XINT (size) >= 0); - eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) - || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size))); + eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); + eassert (rehash_size <= -1 || 0 < rehash_size); eassert (0 < rehash_threshold && rehash_threshold <= 1); - if (XFASTINT (size) == 0) - size = make_number (1); + if (size == 0) + size = 1; - sz = XFASTINT (size); double threshold = rehash_threshold; - index_float = sz / threshold; + index_float = size / threshold; index_size = (index_float < INDEX_SIZE_BOUND + 1 ? next_almost_prime (index_float) : INDEX_SIZE_BOUND + 1); - if (INDEX_SIZE_BOUND < max (index_size, 2 * sz)) + if (INDEX_SIZE_BOUND < max (index_size, 2 * size)) error ("Hash table too large"); /* Allocate a table and initialize it. */ @@ -3743,14 +3740,14 @@ make_hash_table (struct hash_table_test test, h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; - h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil); - h->hash = Fmake_vector (size, Qnil); - h->next = Fmake_vector (size, make_number (-1)); + h->key_and_value = Fmake_vector (make_number (2 * size), Qnil); + h->hash = Fmake_vector (make_number (size), Qnil); + h->next = Fmake_vector (make_number (size), make_number (-1)); h->index = Fmake_vector (make_number (index_size), make_number (-1)); h->pure = pure; /* Set up the free list. */ - for (i = 0; i < sz - 1; ++i) + for (i = 0; i < size - 1; ++i) set_hash_next_slot (h, i, i + 1); h->next_free = 0; @@ -3810,22 +3807,21 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) ptrdiff_t old_size = HASH_TABLE_SIZE (h); EMACS_INT new_size, index_size, nsize; ptrdiff_t i; + double rehash_size = h->rehash_size; double index_float; - if (INTEGERP (h->rehash_size)) - new_size = old_size + XFASTINT (h->rehash_size); + if (rehash_size < 0) + new_size = old_size - rehash_size; else { - double float_new_size = old_size * XFLOAT_DATA (h->rehash_size); + double float_new_size = old_size * (rehash_size + 1); if (float_new_size < INDEX_SIZE_BOUND + 1) - { - new_size = float_new_size; - if (new_size <= old_size) - new_size = old_size + 1; - } + new_size = float_new_size; else new_size = INDEX_SIZE_BOUND + 1; } + if (new_size <= old_size) + new_size = old_size + 1; double threshold = h->rehash_threshold; index_float = new_size / threshold; index_size = (index_float < INDEX_SIZE_BOUND + 1 @@ -4408,7 +4404,7 @@ in an error. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object test, size, rehash_size, weak; + Lisp_Object test, weak; bool pure; struct hash_table_test testdesc; ptrdiff_t i; @@ -4448,18 +4444,26 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) pure = i && !NILP (args[i]); /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); - size = i ? args[i] : Qnil; - if (NILP (size)) - size = make_number (DEFAULT_HASH_SIZE); - else if (!INTEGERP (size) || XINT (size) < 0) - signal_error ("Invalid hash table size", size); + Lisp_Object size_arg = i ? args[i] : Qnil; + EMACS_INT size; + if (NILP (size_arg)) + size = DEFAULT_HASH_SIZE; + else if (NATNUMP (size_arg)) + size = XFASTINT (size_arg); + 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); - rehash_size = i ? args[i] : make_float (DEFAULT_REHASH_SIZE); - if (! ((INTEGERP (rehash_size) && 0 < XINT (rehash_size)) - || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)))) - signal_error ("Invalid hash table rehash size", rehash_size); + if (!i) + rehash_size = DEFAULT_REHASH_SIZE; + else if (INTEGERP (args[i]) && 0 < XINT (args[i])) + rehash_size = - XINT (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); @@ -4513,7 +4517,14 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, doc: /* Return the current rehash size of TABLE. */) (Lisp_Object table) { - return check_hash_table (table)->rehash_size; + double rehash_size = check_hash_table (table)->rehash_size; + if (rehash_size < 0) + { + EMACS_INT s = -rehash_size; + return make_number (min (s, MOST_POSITIVE_FIXNUM)); + } + else + return make_float (rehash_size + 1); } diff --git a/src/image.c b/src/image.c index 0a6bbd17d8..fc396c7353 100644 --- a/src/image.c +++ b/src/image.c @@ -4017,9 +4017,8 @@ 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, make_number (DEFAULT_HASH_SIZE), - make_float (DEFAULT_REHASH_SIZE), - DEFAULT_REHASH_THRESHOLD, + return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); } diff --git a/src/lisp.h b/src/lisp.h index 027fd07d72..e048011a86 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1969,11 +1969,6 @@ struct Lisp_Hash_Table weakness of the table. */ Lisp_Object weak; - /* When the table is resized, and this is an integer, compute the - new size by adding this to the old size. If a float, compute the - new size by multiplying the old size with this factor. */ - Lisp_Object rehash_size; - /* Vector of hash codes. If hash[I] is nil, this means that the I-th entry is unused. */ Lisp_Object hash; @@ -2008,6 +2003,13 @@ struct Lisp_Hash_Table 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. This is gc_marked specially if the table is weak. */ @@ -2076,9 +2078,9 @@ enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; static float const DEFAULT_REHASH_THRESHOLD = 0.8125; -/* Default factor by which to increase the size of a hash table. */ +/* Default factor by which to increase the size of a hash table, minus 1. */ -static double const DEFAULT_REHASH_SIZE = 1.5; +static float const DEFAULT_REHASH_SIZE = 1.5 - 1; /* Combine two integers X and Y for hashing. The result might not fit into a Lisp integer. */ @@ -3347,10 +3349,8 @@ extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); -Lisp_Object make_hash_table (struct hash_table_test test, - Lisp_Object size, Lisp_Object rehash_size, - float rehash_threshold, Lisp_Object weak, - bool pure); +Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, + Lisp_Object, bool); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); diff --git a/src/print.c b/src/print.c index 3a36a4eb54..8c4bb24555 100644 --- a/src/print.c +++ b/src/print.c @@ -1806,14 +1806,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_object (h->weak, printcharfun, escapeflag); } - if (!NILP (h->rehash_size)) - { - print_c_string (" rehash-size ", printcharfun); - print_object (h->rehash_size, 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 (make_float (h->rehash_threshold), + print_object (Fhash_table_rehash_threshold (obj), printcharfun, escapeflag); if (h->pure) diff --git a/src/profiler.c b/src/profiler.c index 08ef6ee962..6dc0d8ce72 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -44,9 +44,8 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth) a special way. This is OK as long as the object is not exposed to Elisp, i.e. until it is returned by *-profiler-log, after which it can't be used any more. */ - Lisp_Object log = make_hash_table (hashtest_profiler, - make_number (heap_size), - make_float (DEFAULT_REHASH_SIZE), + Lisp_Object log = make_hash_table (hashtest_profiler, heap_size, + DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); struct Lisp_Hash_Table *h = XHASH_TABLE (log); diff --git a/src/xterm.c b/src/xterm.c index b04c6999b3..52bc8f9eca 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -12874,8 +12874,8 @@ keysyms. The default is nil, which is the same as `super'. */); 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, make_number (900), - make_float (DEFAULT_REHASH_SIZE), + Vx_keysym_table = make_hash_table (hashtest_eql, 900, + DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); commit 5cbdaa98f975c870c4afa24346630a18b55f27ab Author: Paul Eggert Date: Tue Feb 21 15:31:29 2017 -0800 Use ptrdiff_t instead of Lisp_Object for collision * src/alloc.c (purecopy_hash_table): Assign, don’t purecopy. * src/fns.c (set_hash_next_slot, set_hash_index_slot): Hash index arg is now ptrdiff_t index (or -1 if empty), not Lisp_Object integer (or Qnil if empty). All callers changed. (larger_vecalloc): New static function. (larger_vector): Use it. (HASH_NEXT, HASH_INDEX): Move here from lisp.h. Return ptrdiff_t index (or -1) not Lisp_Object integer (or Qnil). All callers changed. * src/fns.c (make_hash_table, maybe_resize_hash_table, hash_lookup) (hash_put, hash_remove_from_table, hash_clear, sweep_weak_table): * src/profiler.c (evict_lower_half, record_backtrace): -1, not nil, is now the convention for end of collision list. * src/fns.c (maybe_resize_hash_table): Avoid double-initialization of the free list. Reallocate H->next last, in case other reallocations exhaust memory. * src/lisp.h (struct Lisp_Hash_Table): ‘next_free’ is now ptrdiff_t, not Lisp_Object. Adjust commentary for ‘next’ and ‘index’, which no longer contain nil. (HASH_NEXT, HASH_INDEX): Move to src/fns.c. diff --git a/src/alloc.c b/src/alloc.c index b579e7ed1a..5da4290701 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5459,7 +5459,7 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure->rehash_size = purecopy (table->rehash_size); pure->hash = purecopy (table->hash); pure->next = purecopy (table->next); - pure->next_free = purecopy (table->next_free); + pure->next_free = table->next_free; pure->index = purecopy (table->index); pure->count = table->count; pure->pure = table->pure; diff --git a/src/fns.c b/src/fns.c index 2a6653144b..3769c4efb7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3437,9 +3437,9 @@ set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next) h->next = next; } static void -set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->next, idx, val); + gc_aset (h->next, idx, make_number (val)); } static void set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash) @@ -3457,9 +3457,9 @@ set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index) h->index = index; } static void -set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->index, idx, val); + gc_aset (h->index, idx, make_number (val)); } /* If OBJ is a Lisp hash table, return a pointer to its struct @@ -3513,11 +3513,11 @@ get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used) /* Return a Lisp vector which has the same contents as VEC but has at least INCR_MIN more entries, where INCR_MIN is positive. If NITEMS_MAX is not -1, do not grow the vector to be any larger - than NITEMS_MAX. Entries in the resulting - vector that are not copied from VEC are set to nil. */ + than NITEMS_MAX. New entries in the resulting vector are + uninitialized. */ -Lisp_Object -larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) +static Lisp_Object +larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) { struct Lisp_Vector *v; ptrdiff_t incr, incr_max, old_size, new_size; @@ -3534,16 +3534,46 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) new_size = old_size + incr; v = allocate_vector (new_size); memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); - memclear (v->contents + old_size, incr * word_size); XSETVECTOR (vec, v); return vec; } +/* Likewise, except set new entries in the resulting vector to nil. */ + +Lisp_Object +larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) +{ + ptrdiff_t old_size = ASIZE (vec); + Lisp_Object v = larger_vecalloc (vec, incr_min, nitems_max); + ptrdiff_t new_size = ASIZE (v); + memclear (XVECTOR (v)->contents + old_size, + (new_size - old_size) * word_size); + return v; +} + /*********************************************************************** Low-level Functions ***********************************************************************/ +/* Return the index of the next entry in H following the one at IDX, + or -1 if none. */ + +static ptrdiff_t +HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return XINT (AREF (h->next, idx)); +} + +/* Return the index of the element in hash table H that is the start + of the collision list at index IDX, or -1 if the list is empty. */ + +static ptrdiff_t +HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) +{ + return XINT (AREF (h->index, idx)); +} + /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code HASH2 in hash table H using `eql'. Value is true if KEY1 and KEY2 are the same. */ @@ -3715,14 +3745,14 @@ make_hash_table (struct hash_table_test test, h->count = 0; h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil); h->hash = Fmake_vector (size, Qnil); - h->next = Fmake_vector (size, Qnil); - h->index = Fmake_vector (make_number (index_size), Qnil); + h->next = Fmake_vector (size, make_number (-1)); + h->index = Fmake_vector (make_number (index_size), make_number (-1)); h->pure = pure; /* Set up the free list. */ for (i = 0; i < sz - 1; ++i) - set_hash_next_slot (h, i, make_number (i + 1)); - h->next_free = make_number (0); + set_hash_next_slot (h, i, i + 1); + h->next_free = 0; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); @@ -3775,7 +3805,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) static void maybe_resize_hash_table (struct Lisp_Hash_Table *h) { - if (NILP (h->next_free)) + if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); EMACS_INT new_size, index_size, nsize; @@ -3813,29 +3843,32 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) set_hash_key_and_value (h, larger_vector (h->key_and_value, 2 * (new_size - old_size), -1)); - set_hash_next (h, larger_vector (h->next, new_size - old_size, -1)); set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1)); - set_hash_index (h, Fmake_vector (make_number (index_size), Qnil)); + set_hash_index (h, Fmake_vector (make_number (index_size), + make_number (-1))); + set_hash_next (h, larger_vecalloc (h->next, new_size - old_size, -1)); /* Update the free list. Do it so that new entries are added at the end of the free list. This makes some operations like maphash faster. */ for (i = old_size; i < new_size - 1; ++i) - set_hash_next_slot (h, i, make_number (i + 1)); + set_hash_next_slot (h, i, i + 1); + set_hash_next_slot (h, i, -1); - if (!NILP (h->next_free)) + if (h->next_free < 0) + h->next_free = old_size; + else { - Lisp_Object last, next; - - last = h->next_free; - while (next = HASH_NEXT (h, XFASTINT (last)), - !NILP (next)) - last = next; - - set_hash_next_slot (h, XFASTINT (last), make_number (old_size)); + ptrdiff_t last = h->next_free; + while (true) + { + ptrdiff_t next = HASH_NEXT (h, last); + if (next < 0) + break; + last = next; + } + set_hash_next_slot (h, last, old_size); } - else - XSETFASTINT (h->next_free, old_size); /* Rehash. */ for (i = 0; i < old_size; ++i) @@ -3844,7 +3877,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) EMACS_UINT hash_code = XUINT (HASH_HASH (h, i)); ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, make_number (i)); + set_hash_index_slot (h, start_of_bucket, i); } } } @@ -3858,8 +3891,7 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) { EMACS_UINT hash_code; - ptrdiff_t start_of_bucket; - Lisp_Object idx; + ptrdiff_t start_of_bucket, i; hash_code = h->test.hashfn (&h->test, key); eassert ((hash_code & ~INTMASK) == 0); @@ -3867,20 +3899,15 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) *hash = hash_code; start_of_bucket = hash_code % ASIZE (h->index); - idx = HASH_INDEX (h, start_of_bucket); - while (!NILP (idx)) - { - ptrdiff_t i = XFASTINT (idx); - if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn - && hash_code == XUINT (HASH_HASH (h, i)) - && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) - break; - idx = HASH_NEXT (h, i); - } + 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 + && hash_code == XUINT (HASH_HASH (h, i)) + && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) + break; - return NILP (idx) ? -1 : XFASTINT (idx); + return i; } @@ -3901,7 +3928,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, h->count++; /* Store key/value in the key_and_value vector. */ - i = XFASTINT (h->next_free); + i = h->next_free; h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); set_hash_value_slot (h, i, value); @@ -3912,7 +3939,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Add new entry to its collision chain. */ start_of_bucket = hash % ASIZE (h->index); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, make_number (i)); + set_hash_index_slot (h, start_of_bucket, i); return i; } @@ -3922,30 +3949,25 @@ 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) { - EMACS_UINT hash_code; - ptrdiff_t start_of_bucket; - Lisp_Object idx, prev; - - hash_code = h->test.hashfn (&h->test, key); + EMACS_UINT hash_code = h->test.hashfn (&h->test, key); eassert ((hash_code & ~INTMASK) == 0); - start_of_bucket = hash_code % ASIZE (h->index); - idx = HASH_INDEX (h, start_of_bucket); - prev = Qnil; + ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); + ptrdiff_t prev = -1; - while (!NILP (idx)) + for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); + 0 <= i; + i = HASH_NEXT (h, i)) { - ptrdiff_t i = XFASTINT (idx); - if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn && hash_code == XUINT (HASH_HASH (h, i)) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) { /* Take entry out of collision chain. */ - if (NILP (prev)) + if (prev < 0) set_hash_index_slot (h, start_of_bucket, HASH_NEXT (h, i)); else - set_hash_next_slot (h, XFASTINT (prev), HASH_NEXT (h, i)); + set_hash_next_slot (h, prev, HASH_NEXT (h, i)); /* Clear slots in key_and_value and add the slots to the free list. */ @@ -3953,16 +3975,13 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) set_hash_value_slot (h, i, Qnil); set_hash_hash_slot (h, i, Qnil); set_hash_next_slot (h, i, h->next_free); - h->next_free = make_number (i); + h->next_free = i; h->count--; eassert (h->count >= 0); break; } - else - { - prev = idx; - idx = HASH_NEXT (h, i); - } + + prev = i; } } @@ -3978,16 +3997,16 @@ hash_clear (struct Lisp_Hash_Table *h) for (i = 0; i < size; ++i) { - set_hash_next_slot (h, i, i < size - 1 ? make_number (i + 1) : Qnil); + set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); set_hash_key_slot (h, i, Qnil); set_hash_value_slot (h, i, Qnil); set_hash_hash_slot (h, i, Qnil); } for (i = 0; i < ASIZE (h->index); ++i) - ASET (h->index, i, Qnil); + ASET (h->index, i, make_number (-1)); - h->next_free = make_number (0); + h->next_free = 0; h->count = 0; } } @@ -4011,14 +4030,12 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) for (ptrdiff_t bucket = 0; bucket < n; ++bucket) { - Lisp_Object idx, next, prev; - /* Follow collision chain, removing entries that don't survive this garbage collection. */ - prev = Qnil; - for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next) + ptrdiff_t prev = -1; + ptrdiff_t next; + for (ptrdiff_t i = HASH_INDEX (h, bucket); 0 <= i; i = next) { - ptrdiff_t i = XFASTINT (idx); 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; @@ -4041,14 +4058,14 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) if (remove_p) { /* Take out of collision chain. */ - if (NILP (prev)) + if (prev < 0) set_hash_index_slot (h, bucket, next); else - set_hash_next_slot (h, XFASTINT (prev), next); + set_hash_next_slot (h, prev, next); /* Add to free list. */ set_hash_next_slot (h, i, h->next_free); - h->next_free = idx; + h->next_free = i; /* Clear key, value, and hash. */ set_hash_key_slot (h, i, Qnil); @@ -4059,7 +4076,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) } else { - prev = idx; + prev = i; } } else diff --git a/src/lisp.h b/src/lisp.h index 6e0252621a..027fd07d72 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1980,13 +1980,12 @@ struct Lisp_Hash_Table /* 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. */ + next[I] is the index of the next entry in the collision chain, + or -1 if there is such entry. */ Lisp_Object next; - /* Index of first free entry in free list. */ - Lisp_Object next_free; - - /* Bucket vector. A non-nil entry is the index of the first item in + /* 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; @@ -1998,6 +1997,9 @@ struct Lisp_Hash_Table /* Number of key/value entries in the table. */ ptrdiff_t count; + /* Index of first free entry in free list, or -1 if none. */ + ptrdiff_t next_free; + /* True if the table can be purecopied. The table cannot be changed afterwards. */ bool pure; @@ -2050,14 +2052,6 @@ HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx) return AREF (h->key_and_value, 2 * idx + 1); } -/* Value is the index of the next entry following the one at IDX - in hash table H. */ -INLINE Lisp_Object -HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) -{ - return AREF (h->next, idx); -} - /* Value is the hash code computed for entry IDX in hash table H. */ INLINE Lisp_Object HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) @@ -2065,14 +2059,6 @@ HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx) return AREF (h->hash, idx); } -/* Value is the index of the element in hash table H that is the - start of the collision list at index IDX in the index vector of H. */ -INLINE Lisp_Object -HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) -{ - return AREF (h->index, idx); -} - /* Value is the size of hash table H. */ INLINE ptrdiff_t HASH_TABLE_SIZE (struct Lisp_Hash_Table *h) diff --git a/src/profiler.c b/src/profiler.c index edc28fc842..08ef6ee962 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -119,7 +119,7 @@ static void evict_lower_half (log_t *log) XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ Fremhash (key, tmp); } - eassert (EQ (log->next_free, make_number (i))); + eassert (log->next_free == i); eassert (VECTORP (key)); for (ptrdiff_t j = 0; j < ASIZE (key); j++) @@ -139,11 +139,11 @@ record_backtrace (log_t *log, EMACS_INT count) Lisp_Object backtrace; ptrdiff_t index; - if (!INTEGERP (log->next_free)) + if (log->next_free < 0) /* FIXME: transfer the evicted counts to a special entry rather than dropping them on the floor. */ evict_lower_half (log); - index = XINT (log->next_free); + index = log->next_free; /* Get a "working memory" vector. */ backtrace = HASH_KEY (log, index); @@ -163,8 +163,8 @@ record_backtrace (log_t *log, EMACS_INT count) } else { /* BEWARE! hash_put in general can allocate memory. - But currently it only does that if log->next_free is nil. */ - eassert (!NILP (log->next_free)); + But currently it only does that if log->next_free is -1. */ + eassert (0 <= log->next_free); ptrdiff_t j = hash_put (log, backtrace, make_number (count), hash); /* Let's make sure we've put `backtrace' right where it already was to start with. */ commit 7207b63c8e290ddec33908ce8d38be5793388318 Author: Paul Eggert Date: Tue Feb 21 15:31:29 2017 -0800 Hash table threshold is now float, not double Change default from 0.8 to 0.8125 so it fits in float without rounding glitches. * doc/lispref/hash.texi (Creating Hash): * doc/lispref/objects.texi (Hash Table Type): * etc/NEWS: Document change. * src/fns.c (make_hash_table, maybe_resize_hash_table) (Fmake_hash_table): Threshold is now float, not double. Be consistent about how this is rounded. * src/lisp.h (struct Lisp_Hash_Table.rehash_threshold): Change back to float, now that the other code rounds consistently. (DEFAULT_REHASH_THRESHOLD): Now float 0.8125 instead of double 0.8. diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 725d19c3bd..4ba3258d18 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -144,8 +144,9 @@ The default value is 1.5. 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 this fraction -of the nominal size. The default for @var{threshold} is 0.8. +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. @end table @end defun diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index fbb66582f2..56049af60a 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1251,7 +1251,7 @@ and contents, like this: @example (make-hash-table) @result{} #s(hash-table size 65 test eql rehash-size 1.5 - rehash-threshold 0.8 data ()) + rehash-threshold 0.8125 data ()) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 143e4655de..9355dff7a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -904,6 +904,10 @@ consistency with the new functions. For compatibility, 'sxhash' remains as an alias to 'sxhash-equal'. +++ +** 'make-hash-table' now defaults to a rehash threshold of 0.8125 +instead of 0.8, to avoid rounding glitches. + ++++ ** New function 'add-variable-watcher' can be used to call a function when a symbol's value is changed. This is used to implement the new debugger command 'debug-on-variable-change'. diff --git a/src/fns.c b/src/fns.c index 3fed92dfec..2a6653144b 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3663,8 +3663,8 @@ allocate_hash_table (void) REHASH_SIZE. REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will - be resized when the ratio of (number of entries in the table) / - (table size) is >= REHASH_THRESHOLD. + 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'. @@ -3676,7 +3676,7 @@ allocate_hash_table (void) Lisp_Object make_hash_table (struct hash_table_test test, Lisp_Object size, Lisp_Object rehash_size, - double rehash_threshold, Lisp_Object weak, + float rehash_threshold, Lisp_Object weak, bool pure) { struct Lisp_Hash_Table *h; @@ -3690,13 +3690,14 @@ make_hash_table (struct hash_table_test test, eassert (INTEGERP (size) && XINT (size) >= 0); eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size))); - eassert (0 < rehash_threshold && rehash_threshold <= 1.0); + eassert (0 < rehash_threshold && rehash_threshold <= 1); if (XFASTINT (size) == 0) size = make_number (1); sz = XFASTINT (size); - index_float = sz / rehash_threshold; + double threshold = rehash_threshold; + index_float = sz / threshold; index_size = (index_float < INDEX_SIZE_BOUND + 1 ? next_almost_prime (index_float) : INDEX_SIZE_BOUND + 1); @@ -3795,7 +3796,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) else new_size = INDEX_SIZE_BOUND + 1; } - index_float = new_size / h->rehash_threshold; + double threshold = h->rehash_threshold; + index_float = new_size / threshold; index_size = (index_float < INDEX_SIZE_BOUND + 1 ? next_almost_prime (index_float) : INDEX_SIZE_BOUND + 1); @@ -4370,8 +4372,8 @@ 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 (number of entries / table size) -is greater than or equal to THRESHOLD. Default is 0.8. +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 @@ -4390,7 +4392,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object test, size, rehash_size, weak; - double rehash_threshold; bool pure; struct hash_table_test testdesc; ptrdiff_t i; @@ -4445,8 +4446,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:rehash-threshold THRESHOLD'. */ i = get_key_arg (QCrehash_threshold, nargs, args, used); - rehash_threshold = (!i ? DEFAULT_REHASH_THRESHOLD - : FLOATP (args[i]) ? XFLOAT_DATA (args[i]) : 0); + 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]); diff --git a/src/lisp.h b/src/lisp.h index be42b3354e..6e0252621a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2004,7 +2004,7 @@ struct Lisp_Hash_Table /* Resize hash table when number of entries / table size is >= this ratio. */ - double rehash_threshold; + float rehash_threshold; /* 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. @@ -2088,7 +2088,7 @@ enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; value gives the ratio of current entries in the hash table and the size of the hash table. */ -static double const DEFAULT_REHASH_THRESHOLD = 0.8; +static float const DEFAULT_REHASH_THRESHOLD = 0.8125; /* Default factor by which to increase the size of a hash table. */ @@ -3363,7 +3363,7 @@ EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test test, Lisp_Object size, Lisp_Object rehash_size, - double rehash_threshold, Lisp_Object weak, + float rehash_threshold, Lisp_Object weak, bool pure); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, commit f2191691d4e814d38369053cdec428ee2142ab18 Author: Juri Linkov Date: Wed Feb 22 01:22:18 2017 +0200 Avoid flicker in lazy-highlight by doing all updates without redisplay. * lisp/isearch.el (lazy-highlight-max-at-a-time): Change default value from 20 to nil to not trigger redisplay between updating iterations. (lazy-highlight-cleanup): New arg ‘procrastinate’ to not remove overlays when non-nil. (isearch-lazy-highlight-new-loop): Call lazy-highlight-cleanup with non-nil second arg when the search string is not empty. Run timer with isearch-lazy-highlight-start instead of isearch-lazy-highlight-update. (isearch-lazy-highlight-start): New function. (Bug#25751) diff --git a/lisp/isearch.el b/lisp/isearch.el index 526243554b..d0fb15ec64 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -332,7 +332,7 @@ If this is nil, extra highlighting can be \"manually\" removed with 'lazy-highlight-max-at-a-time "22.1") -(defcustom lazy-highlight-max-at-a-time 20 +(defcustom lazy-highlight-max-at-a-time nil ; 20 (bug#25751) "Maximum matches to highlight at a time (for `lazy-highlight'). Larger values may reduce Isearch's responsiveness to user input; smaller values make matches highlight slowly. @@ -3122,17 +3122,18 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-forward nil) (defvar isearch-lazy-highlight-error nil) -(defun lazy-highlight-cleanup (&optional force) +(defun lazy-highlight-cleanup (&optional force procrastinate) "Stop lazy highlighting and remove extra highlighting from current buffer. -FORCE non-nil means do it whether or not `lazy-highlight-cleanup' -is nil. This function is called when exiting an incremental search if +FORCE non-nil means do it whether or not `lazy-highlight-cleanup' is nil. +PROCRASTINATE non-nil means postpone cleanup to a later time. +This function is called when exiting an incremental search if `lazy-highlight-cleanup' is non-nil." (interactive '(t)) - (if (or force lazy-highlight-cleanup) - (while isearch-lazy-highlight-overlays - (delete-overlay (car isearch-lazy-highlight-overlays)) - (setq isearch-lazy-highlight-overlays - (cdr isearch-lazy-highlight-overlays)))) + (when (and (or force lazy-highlight-cleanup) (not procrastinate)) + (while isearch-lazy-highlight-overlays + (delete-overlay (car isearch-lazy-highlight-overlays)) + (setq isearch-lazy-highlight-overlays + (cdr isearch-lazy-highlight-overlays)))) (when isearch-lazy-highlight-timer (cancel-timer isearch-lazy-highlight-timer) (setq isearch-lazy-highlight-timer nil))) @@ -3173,7 +3174,7 @@ by other Emacs features." (not (equal isearch-error isearch-lazy-highlight-error)))) ;; something important did indeed change - (lazy-highlight-cleanup t) ;kill old loop & remove overlays + (lazy-highlight-cleanup t (not (equal isearch-string ""))) ;stop old timer (setq isearch-lazy-highlight-error isearch-error) ;; It used to check for `(not isearch-error)' here, but actually ;; lazy-highlighting might find matches to highlight even when @@ -3204,7 +3205,7 @@ by other Emacs features." (unless (equal isearch-string "") (setq isearch-lazy-highlight-timer (run-with-idle-timer lazy-highlight-initial-delay nil - 'isearch-lazy-highlight-update))))) + 'isearch-lazy-highlight-start))))) (defun isearch-lazy-highlight-search () "Search ahead for the next or previous match, for lazy highlighting. @@ -3249,6 +3250,11 @@ Attempt to do the search exactly the way the pending Isearch would." success) (error nil))) +(defun isearch-lazy-highlight-start () + "Start a new lazy-highlight updating loop." + (lazy-highlight-cleanup t) ;remove old overlays + (isearch-lazy-highlight-update)) + (defun isearch-lazy-highlight-update () "Update highlighting of other matches for current search." (let ((max lazy-highlight-max-at-a-time) commit 217eaf6932f68049e8f7f207b153c09ca85c7032 Author: Glenn Morris Date: Tue Feb 21 15:11:56 2017 -0500 ; * lisp/custom.el: Comments. diff --git a/lisp/custom.el b/lisp/custom.el index 030478ab17..ecfa34db5b 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -765,9 +765,16 @@ Use the :set function to do so. This is useful for customizable options that are defined before their standard value can really be computed. E.g. dumped variables whose default depends on run-time information." ;; If it has never been set at all, defvar it so as to mark it - ;; special, etc (bug#25770). + ;; special, etc (bug#25770). This means we are initializing + ;; the variable, and normally any :set function would not apply. + ;; For custom-initialize-delay, however, it is documented that "the + ;; (delayed) initialization is performed with the :set function". + ;; This is needed by eg global-font-lock-mode, which uses + ;; custom-initialize-delay but needs the :set function custom-set-minor-mode + ;; to also run during initialization. So, long story short, we + ;; always do the funcall step, even if symbol was not bound before. (or (default-boundp symbol) - (eval `(defvar ,symbol nil))) + (eval `(defvar ,symbol nil))) ; reset below, so any value is fine (funcall (or (get symbol 'custom-set) 'set-default) symbol (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) commit bac7de05e26dff44cd15d26f7f37fad1f8ce154b Author: Stefan Monnier Date: Tue Feb 21 13:51:12 2017 -0500 * lisp/emacs-lisp/autoload.el (make-autoload): Support cl-defgeneric * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Tweak for autoloading. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1b7ff36f42..d1f3c359f3 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -164,7 +164,7 @@ expression, in which case we want to handle forms differently." ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode - define-inline cl-defun cl-defmacro)) + define-inline cl-defun cl-defmacro cl-defgeneric)) (macrop car) (setq expand (let ((load-file-name file)) (macroexpand form))) (memq (car expand) '(progn prog1 defalias))) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 6cc70c4c2f..d9321b1356 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -233,6 +233,7 @@ DEFAULT-BODY, if present, is used as the body of a default method. ,(help-add-fundoc-usage doc args)) ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) (nreverse methods))) + :autoload-end ,@(mapcar (lambda (declaration) (let ((f (cdr (assq (car declaration) defun-declarations-alist)))) @@ -1215,9 +1216,5 @@ Used internally for the (major-mode MODE) context specializers." (progn (cl-assert (null modes)) mode) `(derived-mode ,mode . ,modes)))) -;; Local variables: -;; generated-autoload-file: "cl-loaddefs.el" -;; End: - (provide 'cl-generic) ;;; cl-generic.el ends here commit e785c74d3a8860e11474cd645179b32ab16e91b8 Author: Stefan Monnier Date: Tue Feb 21 13:48:30 2017 -0500 * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Fix duplication which resulted in incomplete list of parents in one copy of the cl-structure-class class. diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 0b07941000..bba7b83a79 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -151,7 +151,20 @@ (add-to-list 'current-load-list `(define-type . ,name)) (cl--struct-register-child parent-class tag) (unless (eq named t) - (eval `(defconst ,tag ',class) t) + ;; We used to use `defconst' instead of `set' but that + ;; has a side-effect of purecopying during the dump, so that the + ;; class object stored in the tag ends up being a *copy* of the + ;; one stored in the `cl--class' property! We could have fixed + ;; this needless duplication by using the purecopied object, but + ;; that then breaks down a bit later when we modify the + ;; cl-structure-class class object to close the recursion + ;; between cl-structure-object and cl-structure-class (because + ;; modifying purecopied objects is not allowed. Since this is + ;; done during dumping, we could relax this rule and allow the + ;; modification, but it's cumbersome). + ;; So in the end, it's easier to just avoid the duplication by + ;; avoiding the use of the purespace here. + (set tag class) ;; In the cl-generic support, we need to be able to check ;; if a vector is a cl-struct object, without knowing its particular type. ;; So we use the (otherwise) unused function slots of the tag symbol commit 20dda6be76236253f689037a31dcc82cc9673bd4 Author: Glenn Morris Date: Tue Feb 21 12:59:56 2017 -0500 Tweak recent custom-reevaluate-setting change * lisp/custom.el (custom-reevaluate-setting): Tweak previous change to avoid font-lock init issues. diff --git a/lisp/custom.el b/lisp/custom.el index 7eaff450c5..030478ab17 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -764,17 +764,13 @@ Return non-nil if the `customized-value' property actually changed." Use the :set function to do so. This is useful for customizable options that are defined before their standard value can really be computed. E.g. dumped variables whose default depends on run-time information." - (let ((val (car (or (get symbol 'saved-value) - (get symbol 'standard-value))))) - (if (default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) symbol (eval val)) - ;; If it has never been set at all, defvar it so as to mark it - ;; special, etc (bug#25770). This ignores any :set function, - ;; but that is not supposed to be used for initialization anyway. - ;; Or we could move this branch to the start, then unconditionally - ;; call the custom-set branch. - (eval `(defvar ,symbol ,val))))) - + ;; If it has never been set at all, defvar it so as to mark it + ;; special, etc (bug#25770). + (or (default-boundp symbol) + (eval `(defvar ,symbol nil))) + (funcall (or (get symbol 'custom-set) 'set-default) + symbol + (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) ;;; Custom Themes