commit c1eb458d6b9f6e1c4fa9ce0ae0c91f0314ca94ac Author: Pip Cet Date: Mon May 25 11:28:38 2026 +0000 Avoid relying on FOR_EACH_TAIL internals in 'Fnthcdr' (bug#81115) The new FOR_EACH_TAIL code detects simple cycles sooner than the old code did, leading to integer overflows. * src/fns.c (Fnthcdr): Avoid integer overflow if cycle is detected early. diff --git a/src/fns.c b/src/fns.c index d692a92580a..4284d82d6a5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1824,7 +1824,10 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); num += iz; } - num += cycle_length - large_num % cycle_length; + if (num < cycle_length) + num += cycle_length; + num -= large_num % cycle_length; + eassume (num >= 0); } num %= cycle_length; commit 0bef3c0e87315708e6d77e2c17e2677ac44fcbea Author: Pip Cet Date: Mon May 25 09:10:23 2026 +0000 Improve FOR_EACH_TAIL (bug#81115) * src/lisp.h (struct for_each_tail_internal): Reduce to two words. (FOR_EACH_TAIL_BASIC): Add compiler hint to indicate that tail is most likely Qnil after the loop and a non-nil non-cons is unlikely. (FOR_EACH_TAIL_STEP_CYCLEP): Rewrite. diff --git a/src/lisp.h b/src/lisp.h index babfe3ee4a5..de94b2fa9d1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5833,7 +5833,8 @@ enum { SMALL_LIST_LEN_MAX = 127 }; set TAIL to the current cons. If the loop exits normally, set TAIL to the terminating non-cons, typically nil. The loop body should not modify the list’s top level structure other than by - perhaps deleting the current cons. */ + perhaps deleting the current cons. In practice, this macro rarely + quits. */ #define FOR_EACH_TAIL(tail) \ FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true) @@ -5847,16 +5848,17 @@ enum { SMALL_LIST_LEN_MAX = 127 }; /* Iterator intended for use only within FOR_EACH_TAIL_INTERNAL. */ struct for_each_tail_internal { + /* The object we're comparing to. */ Lisp_Object tortoise; - intptr_t max, n; - unsigned short int q; + /* How many iterations of the algorithm have happened. */ + ptrdiff_t l; }; /* Like FOR_EACH_TAIL (LIST), except evaluate CYCLE if a cycle is found, and check for quit if CHECK_QUIT. This is an internal macro intended for use only by the above macros. - Use Brent’s teleporting tortoise-hare algorithm. See: + Modifies Brent’s teleporting tortoise-hare algorithm. See: Brent RP. BIT. 1980;20(2):176-184. doi:10.1007/BF01933190 https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf @@ -5871,20 +5873,35 @@ struct for_each_tail_internal FOR_EACH_TAIL_STEP_CYCLEP (tail, check_quit) \ ? (cycle) : (void) 0) -#define FOR_EACH_TAIL_BASIC(tail, stepper) \ - for (struct for_each_tail_internal li = { tail, 2, 0, 2 }; \ - CONSP (tail); stepper) +#define FOR_EACH_TAIL_BASIC(tail, stepper) \ + for (struct for_each_tail_internal li = { tail, 0 }; \ + CONSP (tail) || (likely (NILP (tail)), false); \ + stepper) -/* Step TAIL and return whether a cycle has been detected. - If CHECK_QUIT then check for quit occasionally. */ -#define FOR_EACH_TAIL_STEP_CYCLEP(tail, check_quit) \ - ((tail) = XCDR (tail), \ - ((--li.q != 0 \ - || ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n) \ - || (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH, \ - li.tortoise = (tail), false)) \ - && BASE_EQ (tail, li.tortoise))) +/* How many iterations until we start advancing the tortoise, which is + necessary to detect lists which end in a cycle but whose initial + elements aren't part of the cycle. Also, number of iterations until + we check for quits. Must be a power of two. */ +#define FOR_EACH_TAIL_THRESHOLD 4096 + +static_assert (POWER_OF_2 (FOR_EACH_TAIL_THRESHOLD)); + +/* Step TAIL and return whether a cycle has been detected. If + CHECK_QUIT then check for quit occasionally. We only check for quits + once every 4096 iterations, and we don't advance the tortoise until + that happens for the first time. + + The C comma operator is used here to avoid statement expressions: the + expression evaluates to the value of BASE_EQ (tail, li.tortoise), but + has additional side effects, possibly exiting nonlocally. */ + +#define FOR_EACH_TAIL_STEP_CYCLEP(tail, check_quit) \ + ((tail) = XCDR (tail), \ + (! likely (!BASE_EQ (tail, li.tortoise)) \ + || (! likely (((++li.l) & (FOR_EACH_TAIL_THRESHOLD-1)) != 0) \ + && (((check_quit) ? maybe_quit () : (void) 0, false) \ + || (POWER_OF_2 (li.l) && (li.tortoise = (tail), false)))))) /* Do a `for' loop over alist values. */ commit de67c677fe9ef8215888d5d6fc9e2e93abaf163e Author: Pip Cet Date: Sun May 31 06:27:56 2026 +0000 * src/lisp.h (EQ): Use new 'likely' macro. diff --git a/src/lisp.h b/src/lisp.h index 370c8effa48..babfe3ee4a5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1316,7 +1316,7 @@ EQ (Lisp_Object x, Lisp_Object y) { if (BASE_EQ (x, y)) return true; - else if (!__builtin_expect (symbols_with_pos_enabled, false)) + else if (likely (symbols_with_pos_enabled == false)) return false; else return slow_eq (x, y); commit 0f6c38288807f79c01a659c4187bdc69fa92845f Author: Pip Cet Date: Sun May 31 06:24:58 2026 +0000 Make 'likely' macro available in all of Emacs (bug#81115) * src/android.c (likely): Move ... * src/conf_post.h (likely): ... here. Ensure true values which aren't equal to 1 are still predicted correctly. diff --git a/src/android.c b/src/android.c index 7ff7f26b527..034e1db2dd6 100644 --- a/src/android.c +++ b/src/android.c @@ -6158,8 +6158,6 @@ android_build_jstring (const char *text) if global_foo cannot be allocated, and after the global reference is created. */ -#define likely(cond) __builtin_expect (cond, 1) - /* Check for JNI exceptions and call memory_full in that situation. */ diff --git a/src/conf_post.h b/src/conf_post.h index e0bb753df56..74742ac16dc 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -371,6 +371,11 @@ extern int emacs_setenv_TZ (char const *); # define UNINIT /* empty */ #endif +/* likely (COND) is equivalent to COND ? 1 : 0, but instructs the + compiler to provide static branch prediction hints to the CPU so that + the branch isn't mispredicted. */ +#define likely(cond) __builtin_expect (!!(cond), 1) + /* Emacs needs neither glibc strftime behavior for AM and PM indicators, nor Gnulib strftime support for non-Gregorian calendars. */ #define REQUIRE_GNUISH_STRFTIME_AM_PM false commit 35f69be393fbd5815501770f37ea0d5a4da1bdf5 Merge: 8a00733af5d 0a8a5d4fadb Author: Eli Zaretskii Date: Thu Jun 4 14:48:05 2026 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 8a00733af5d083c79298ddc21d8c02fe296abfd7 Author: Eli Zaretskii Date: Thu Jun 4 14:47:13 2026 +0300 ; Fix last change * lisp/plstore.el (plstore--decode, plstore--encode) (plstore-get, plstore-find): Fix last change. (Bug#81061) diff --git a/lisp/plstore.el b/lisp/plstore.el index 6a1d858f958..c67ca37e716 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -478,7 +478,7 @@ perform a match." (when match (setq plist (cdr entry)) (while plist - (if (plstore--has-secret-keys plstore) + (if (plstore--has-secret-keys plist) (setq decrypt t plist nil)) (setq plist (nthcdr 2 plist))) @@ -503,7 +503,7 @@ Return nil if there is none." plist) (setq plist (cdr entry)) (while plist - (if (plstore--has-secret-keys plstore) + (if (plstore--has-secret-keys plist) (progn (plstore--decrypt plstore) (setq entry (assoc name (plstore--get-merged-alist plstore)) @@ -663,7 +663,7 @@ GnuPG key, silently save with symmetric encryption." ; (FIXME) (let ((merged-plist (cdr (assoc (car entry) merged-alist))) (plist (cdr entry))) (while plist - (if (plstore--has-secret-keys plstore) + (if (plstore--has-secret-keys plist) (setcar (cdr plist) (plist-get merged-plist @@ -691,7 +691,7 @@ some plstore." (error "Invalid plstore format %s" string)) (setq plist (cdr (car pointer))) (while plist - (when (plstore--has-secret-keys plstore) + (when (plstore--has-secret-keys plist) (setq entry (assoc (car (car pointer)) secret-alist)) (unless entry (setq entry (list (car (car pointer))) commit 0a8a5d4fadbe8c053a348e99e87aa0dda058ddef Author: Sean Whitton Date: Thu Jun 4 12:04:13 2026 +0100 Don't query on exit for dir-status-files VC backend processes * lisp/vc/vc-bzr.el (vc-bzr-dir-status-files): * lisp/vc/vc-cvs.el (vc-cvs-dir-status-files): * lisp/vc/vc-git.el (vc-git-dir-status-goto-stage): * lisp/vc/vc-hg.el (vc-hg-dir-status-files): * lisp/vc/vc-svn.el (vc-svn-dir-status-files): Set the query-on-exit flag for the processes populating VC-Dir buffers to nil. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 1be1f6db7f4..7b2bf33fad6 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1032,7 +1032,9 @@ stream. Standard error output is discarded." (defun vc-bzr-dir-status-files (dir files update-function) "Return a list of conses (file . state) for DIR." - (apply #'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) + (set-process-query-on-exit-flag + (apply #'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) + nil) ;; FIXME: Consider `vc-run-delayed-success'. (vc-run-delayed (vc-bzr-after-dir-status update-function diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index eb971754c1c..293ebcca3e2 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1083,9 +1083,11 @@ Query all files in DIR if files is nil." (let ((local (vc-cvs-stay-local-p dir))) (if (and (not files) local (not (eq local 'only-file))) (vc-cvs-dir-status-heuristic dir update-function)) - (vc-cvs-command (current-buffer) 'async - files - "-f" "-n" "-q" "update") + (set-process-query-on-exit-flag + (vc-cvs-command (current-buffer) 'async + files + "-f" "-n" "-q" "update") + nil) ;; FIXME: Consider `vc-run-delayed-success'. (vc-run-delayed (vc-cvs-after-dir-status update-function)))) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6b9530c9570..4021c69ea4f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -724,44 +724,39 @@ or an empty string if none." (defun vc-git-dir-status-goto-stage (git-state) ;; TODO: Look into reimplementing this using `git status --porcelain=v2'. - (let ((files (vc-git-dir-status-state->files git-state)) - (allowed-exit 1)) - (erase-buffer) - (pcase (vc-git-dir-status-state->stage git-state) - ('update-index - (if files - (progn (vc-git-command (current-buffer) 'async files - "add" "--refresh" "--") - ;; git-add exits 128 if some of FILES are untracked; - ;; we can ignore that (bug#79999). - (setq allowed-exit 128)) - (vc-git-command (current-buffer) 'async nil - "update-index" "--refresh"))) - ('ls-files-added - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-c" "-s" "--")) - ('ls-files-up-to-date - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-c" "-s" "--")) - ('ls-files-conflict - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-u" "--")) - ('ls-files-missing - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-d" "--")) - ('ls-files-unknown - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-o" "--exclude-standard" "--")) - ('ls-files-ignored - (vc-git-command (current-buffer) 'async files - "ls-files" "-z" "-o" "-i" "--directory" - "--no-empty-directory" "--exclude-standard" "--")) - ;; --relative added in Git 1.5.5. - ('diff-index - (vc-git-command (current-buffer) 'async files - "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) - (vc-run-delayed-success allowed-exit - (vc-git-after-dir-status-stage git-state)))) + (cl-flet ((git-cmd (&rest args) + (set-process-query-on-exit-flag + (apply #'vc-git-command (current-buffer) 'async args) + nil))) + (let ((files (vc-git-dir-status-state->files git-state)) + (allowed-exit 1)) + (erase-buffer) + (pcase (vc-git-dir-status-state->stage git-state) + ('update-index + (if files + (progn (git-cmd files "add" "--refresh" "--") + ;; git-add exits 128 if some of FILES are untracked; + ;; we can ignore that (bug#79999). + (setq allowed-exit 128)) + (git-cmd nil "update-index" "--refresh"))) + ('ls-files-added + (git-cmd files "ls-files" "-z" "-c" "-s" "--")) + ('ls-files-up-to-date + (git-cmd files "ls-files" "-z" "-c" "-s" "--")) + ('ls-files-conflict + (git-cmd files "ls-files" "-z" "-u" "--")) + ('ls-files-missing + (git-cmd files "ls-files" "-z" "-d" "--")) + ('ls-files-unknown + (git-cmd files "ls-files" "-z" "-o" "--exclude-standard" "--")) + ('ls-files-ignored + (git-cmd files "ls-files" "-z" "-o" "-i" "--directory" + "--no-empty-directory" "--exclude-standard" "--")) + ;; --relative added in Git 1.5.5. + ('diff-index + (git-cmd files "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) + (vc-run-delayed-success allowed-exit + (vc-git-after-dir-status-stage git-state))))) (defun vc-git-dir-status-files (_dir files update-function) "Return a list of (FILE STATE EXTRA) entries for DIR." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index af143a4b1da..c375d14b7e3 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1544,11 +1544,13 @@ REV is the revision to check out into WORKFILE." ;; XXX: We can't pass DIR directly to 'hg status' because that ;; returns all ignored files if FILES is non-nil (bug#22481). (let ((default-directory dir)) - (apply #'vc-hg-command '(t nil) 'async files - "status" (concat "-mardu" (if files "i")) "-C" - (if (version<= "4.2" (vc-hg--program-version)) - '("--config" "commands.status.relative=1") - '("re:" "-I" ".")))) + (set-process-query-on-exit-flag + (apply #'vc-hg-command '(t nil) 'async files + "status" (concat "-mardu" (if files "i")) "-C" + (if (version<= "4.2" (vc-hg--program-version)) + '("--config" "commands.status.relative=1") + '("re:" "-I" "."))) + nil)) (vc-run-delayed-success 0 (vc-hg-after-dir-status update-function))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 12704361430..6e920f7e721 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -227,7 +227,9 @@ A value of `default' means to use the value of `vc-resolve-conflicts'." CALLBACK is called as (CALLBACK RESULT BUFFER), where RESULT is a list of conses (FILE . STATE) for directory DIR." ;; FIXME shouldn't this rather default to all the files in dir? - (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files) + (set-process-query-on-exit-flag + (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files) + nil) ;; FIXME: Consider `vc-run-delayed-success'. (vc-run-delayed (vc-svn-after-dir-status callback t))) commit aa6acc69edb64eb962beb074c065c7b44c194da7 Author: Xiyue Deng Date: Thu Jun 4 00:31:41 2026 -0700 plstore: use 'plstore--has-secret-keys' * lisp/plstore.el (plstore-find, plstore-get, plstore--encode) (plstore--decode): Use 'plstore--has-secret-keys' to replace manual check for existence of secret keys. (Bug#81061) diff --git a/lisp/plstore.el b/lisp/plstore.el index 2fada5a308d..6a1d858f958 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -478,7 +478,7 @@ perform a match." (when match (setq plist (cdr entry)) (while plist - (if (string-match "\\`:secret-" (symbol-name (car plist))) + (if (plstore--has-secret-keys plstore) (setq decrypt t plist nil)) (setq plist (nthcdr 2 plist))) @@ -503,7 +503,7 @@ Return nil if there is none." plist) (setq plist (cdr entry)) (while plist - (if (string-match "\\`:secret-" (symbol-name (car plist))) + (if (plstore--has-secret-keys plstore) (progn (plstore--decrypt plstore) (setq entry (assoc name (plstore--get-merged-alist plstore)) @@ -663,7 +663,7 @@ GnuPG key, silently save with symmetric encryption." ; (FIXME) (let ((merged-plist (cdr (assoc (car entry) merged-alist))) (plist (cdr entry))) (while plist - (if (string-match "\\`:secret-" (symbol-name (car plist))) + (if (plstore--has-secret-keys plstore) (setcar (cdr plist) (plist-get merged-plist @@ -691,7 +691,7 @@ some plstore." (error "Invalid plstore format %s" string)) (setq plist (cdr (car pointer))) (while plist - (when (string-match "\\`:secret-" (symbol-name (car plist))) + (when (plstore--has-secret-keys plstore) (setq entry (assoc (car (car pointer)) secret-alist)) (unless entry (setq entry (list (car (car pointer)))