From: Stefan Monnier <monnier@iro.umontreal.ca>
To: mail@daniel-mendler.de
Cc: 46326@debbugs.gnu.org
Subject: bug#46326: 27.1.50; Excessive memory allocations with minibuffer-with-setup-hook
Date: Fri, 23 Apr 2021 14:26:57 -0400 [thread overview]
Message-ID: <jwvzgxo6g93.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <62c490ed0d8d24d8b259ac1ba55ea79e@mendler.net> (mail@daniel-mendler.de's message of "Fri, 05 Feb 2021 13:51:41 +0100")
> I have an issue on 27.1.50 with excessive memory allocations when using
> minibuffer-with-setup-hook with large closures and :append.
Indeed, we have a problem there. I think it's fairly hard to fix it
for good without introducing incompatibilities, because `add-hook` has
been defined to compare its functions with `equal` "for ever" and
changing it to use `eq` or `function-equal` will inevitably break
code out there in subtle ways.
IOW I think the better fix is to change `minibuffer-with-setup-hook` to
use an indirection via a symbol.
As for reducing the impact of the underlying issue, I see we could
reduce the amount of `equal` tests being performed, by using `eq` for
the lookups in `hook--depth-alist`.
So before we install the "real" solution, could you try the patch below
and report how much it helps (if at all)?
Stefan
diff --git a/lisp/subr.el b/lisp/subr.el
index c2be26a15f5..7b718a48a8d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1830,12 +1834,13 @@ add-hook
(unless (member function hook-value)
(when (stringp function) ;FIXME: Why?
(setq function (purecopy function)))
+ ;; All those `equal' tests performed between functions can end up being
+ ;; costly since those functions may be large recursive and even cyclic
+ ;; structures, so we index `hook--depth-alist' with `eq'. (bug#46326)
(when (or (get hook 'hook--depth-alist) (not (zerop depth)))
;; Note: The main purpose of the above `when' test is to avoid running
;; this `setf' before `gv' is loaded during bootstrap.
- (setf (alist-get function (get hook 'hook--depth-alist)
- 0 'remove #'equal)
- depth))
+ (push (cons function depth) (get hook 'hook--depth-alist)))
(setq hook-value
(if (< 0 depth)
(append hook-value (list function))
@@ -1845,8 +1850,8 @@ add-hook
(setq hook-value
(sort (if (< 0 depth) hook-value (copy-sequence hook-value))
(lambda (f1 f2)
- (< (alist-get f1 depth-alist 0 nil #'equal)
- (alist-get f2 depth-alist 0 nil #'equal))))))))
+ (< (alist-get f1 depth-alist 0 nil #'eq)
+ (alist-get f2 depth-alist 0 nil #'eq))))))))
;; Set the actual variable
(if local
(progn
@@ -1907,11 +1912,20 @@ remove-hook
(not (and (consp (symbol-value hook))
(memq t (symbol-value hook)))))
(setq local t))
- (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook)))
+ (old-fun nil))
;; Remove the function, for both the list and the non-list cases.
(if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
- (if (equal hook-value function) (setq hook-value nil))
- (setq hook-value (delete function (copy-sequence hook-value))))
+ (when (equal hook-value function)
+ (setq old-fun hook-value)
+ (setq hook-value nil))
+ (when (setq old-fun (car (member function hook-value)))
+ (setq hook-value (remq old-fun hook-value))))
+ (when old-fun
+ ;; Remove auxiliary depth info to avoid leaks.
+ (put hook 'hook--depth-alist
+ (delq (assq old-fun (get hook 'hook--depth-alist))
+ (get hook 'hook--depth-alist))))
;; If the function is on the global hook, we need to shadow it locally
;;(when (and local (member function (default-value hook))
;; (not (member (cons 'not function) hook-value)))
next prev parent reply other threads:[~2021-04-23 18:26 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-05 12:51 bug#46326: 27.1.50; Excessive memory allocations with minibuffer-with-setup-hook mail
2021-02-05 14:09 ` Eli Zaretskii
2021-02-05 15:20 ` mail
2021-02-05 15:58 ` Eli Zaretskii
2021-02-05 16:10 ` mail
2021-02-08 9:25 ` jakanakaevangeli
2021-02-09 0:19 ` mail
2021-02-09 22:13 ` jakanakaevangeli
2021-04-23 18:26 ` Stefan Monnier [this message]
2021-04-23 19:28 ` Daniel Mendler
2021-04-23 20:34 ` jakanakaevangeli
2021-04-23 20:52 ` Daniel Mendler
2021-04-23 21:27 ` Stefan Monnier
2021-04-24 6:10 ` Eli Zaretskii
2021-04-24 13:06 ` Stefan Monnier
2022-06-16 13:06 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwvzgxo6g93.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=46326@debbugs.gnu.org \
--cc=mail@daniel-mendler.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.