bug#66117: 30.0.50; `find-buffer-visiting' is slow when opening large number of buffers

[Ihor Radchenko]

Eli Zaretskii <eliz@gnu.org> writes:

> My advice is to have a prototype working, then time it on local
> filesystems.

See the attached patch.

I used the following simplified reproducer that does not involve loading
Org (which skews the relative numbers as Org loading is relatively slow):

(dotimes (i 1000) (with-temp-file (format "/tmp/test/%d.txt" i) (insert "* This 
is test")))
(dolist (file (directory-files "/tmp/test/" t "txt"))
  (find-file-noselect file))

Without the patch (cpu-profiler-without-patch): 4.3 sec
With the patch    (cpu-profiler-w-patch      ): 2.5 sec

> ... Optimizing for networked filesystems is the next step,
> assuming it is needed.  Please keep in mind that the current code does
> that as well, only from Lisp: the call to file-attributes calls
> 'stat', then conses the 11-member list that is the return value.  So
> the C implementation cannot possibly be worse.

I left the `file-attributes' call in Elisp. Looking at the
cpu-profiler-w-patch, `find-buffer-visiting' is no longer the main
contributor to CPU time. I am not sure if we really need to squeeze the
performance yet further from `find-buffer-visiting' - `file-attributes'
is taking pretty much no time:

(reverse call-tree)
         924  36%   Automatic GC
         173   6% + inhibit-local-variables-p
         172   6% + locate-dominating-file
         139   5% + abbreviate-file-name
         113   4% + dir-locals--all-files
         109   4% + file-truename
          92   3% + find-buffer-visiting 
...
           6   0% + file-attributes 

comapare with cpu-profiler-without-patch:

(reverse call-tree)
        1714  39% + find-buffer-visiting
        1131  26%   Automatic GC
         202   4% + locate-dominating-file
         147   3% + abbreviate-file-name
         140   3% + inhibit-local-variables-p
         104   2% + dir-locals--all-files
          98   2% + uniquify-rationalize-file-buffer-names
          91   2% + file-truename

>From 3b6a9eec3ccc9ff69dbce10d207bddb3e7611606 Mon Sep 17 00:00:00 2001
Message-ID: 
<3b6a9eec3ccc9ff69dbce10d207bddb3e7611606.1696755521.git.yantar92@posteo.net>
From: Ihor Radchenko <yantar92@posteo.net>
Date: Sun, 8 Oct 2023 11:48:42 +0300
Subject: [PATCH] Improve performance of `find-buffer-visiting' (bug#66117)

* src/buffer.c (Fget_truename_buffer): Expose `get_truename_buffer' to
Elisp.
(Ffind_buffer): New subr searching for a live buffer with a given
value of buffer-local variable.
(syms_of_buffer): Register the new added subroutines.
* src/filelock.c (lock_file): Use the new `Fget_truename_buffer' name.
* src/lisp.h:
* test/manual/etags/c-src/emacs/src/lisp.h: Remove no-longer-necessary
extern declarations for `get_truename_buffer'.
* lisp/files.el (find-buffer-visiting): Refactor, using subroutines to
search for buffers instead of slow manual Elisp iterations.
---
 lisp/files.el                            | 54 ++++++++++--------------
 src/buffer.c                             | 25 ++++++++++-
 src/filelock.c                           |  2 +-
 src/lisp.h                               |  1 -
 test/manual/etags/c-src/emacs/src/lisp.h |  1 -
 5 files changed, 47 insertions(+), 36 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 884c6b74247..dde1a2cc136 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2183,37 +2183,29 @@ find-buffer-visiting
 the only argument, but not with the buffer as the current buffer.
 
 If there is no such live buffer, return nil."
-  (let ((predicate (or predicate #'identity))
-        (truename (abbreviate-file-name (file-truename filename))))
-    (or (let ((buf (get-file-buffer filename)))
-          (when (and buf (funcall predicate buf)) buf))
-        (let ((list (buffer-list)) found)
-          (while (and (not found) list)
-            (with-current-buffer (car list)
-              (if (and buffer-file-name
-                       (string= buffer-file-truename truename)
-                       (funcall predicate (current-buffer)))
-                  (setq found (car list))))
-            (setq list (cdr list)))
-          found)
-        (let* ((attributes (file-attributes truename))
-               (number (file-attribute-file-identifier attributes))
-               (list (buffer-list)) found)
-          (and buffer-file-numbers-unique
-               (car-safe number)       ;Make sure the inode is not just nil.
-               (while (and (not found) list)
-                 (with-current-buffer (car list)
-                   (if (and buffer-file-name
-                            (equal buffer-file-number number)
-                            ;; Verify this buffer's file number
-                            ;; still belongs to its file.
-                            (file-exists-p buffer-file-name)
-                            (equal (file-attributes buffer-file-truename)
-                                   attributes)
-                            (funcall predicate (current-buffer)))
-                       (setq found (car list))))
-                 (setq list (cdr list))))
-          found))))
+  (or (let ((buf (get-file-buffer filename)))
+        (when (and buf (or (not predicate) (funcall predicate buf))) buf))
+      (let ((truename (abbreviate-file-name (file-truename filename))))
+        (or
+         (let ((buf (get-truename-buffer truename)))
+           (when (and buf (buffer-local-value 'buffer-file-name buf)
+                      (or (not predicate) (funcall predicate buf)))
+             buf))
+         (let* ((attributes (file-attributes truename))
+                (number (file-attribute-file-identifier attributes)))
+           (and buffer-file-numbers-unique
+                (car-safe number)       ;Make sure the inode is not just nil.
+                (let ((buf (find-buffer 'buffer-file-number number)))
+                  (when (and buf (buffer-local-value 'buffer-file-name buf)
+                             ;; Verify this buffer's file number
+                             ;; still belongs to its file.
+                             (file-exists-p buffer-file-name)
+                             (equal (file-attributes buffer-file-truename)
+                                    attributes)
+                             (or (not predicate)
+                                 (funcall predicate (current-buffer))))
+                    buf))))))))
+
 
 (defcustom find-file-wildcards t
   "Non-nil means file-visiting commands should handle wildcards.
diff --git a/src/buffer.c b/src/buffer.c
index a7299f4a49e..12f226d8249 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -519,8 +519,11 @@ DEFUN ("get-file-buffer", Fget_file_buffer, 
Sget_file_buffer, 1, 1, 0,
   return Qnil;
 }
 
-Lisp_Object
-get_truename_buffer (register Lisp_Object filename)
+DEFUN ("get-truename-buffer", Fget_truename_buffer, Sget_truename_buffer, 1, 
1, 0,
+       doc: /* Return the buffer with `file-truename' equal to FILENAME (a 
string).
+If there is no such live buffer, return nil.
+See also `find-buffer-visiting'.  */)
+  (register Lisp_Object filename)
 {
   register Lisp_Object tail, buf;
 
@@ -533,6 +536,22 @@ get_truename_buffer (register Lisp_Object filename)
   return Qnil;
 }
 
+DEFUN ("find-buffer", Ffind_buffer, Sfind_buffer, 2, 2, 0,
+       doc: /* Return the buffer with buffer-local VARIABLE equal to VALUE.
+              If there is no such live buffer, return nil.
+See also `find-buffer-visiting'.  */)
+  (Lisp_Object variable, Lisp_Object value)
+{
+  register Lisp_Object tail, buf;
+
+  FOR_EACH_LIVE_BUFFER (tail, buf)
+    {
+      if (!NILP (Fequal (value, Fbuffer_local_value(variable, buf))))
+       return buf;
+    }
+  return Qnil;
+}
+
 /* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does
    not have buffer hooks inhibited.  */
 
@@ -6010,6 +6029,8 @@ Functions (implicitly) running this hook are 
`get-buffer-create',
   defsubr (&Sbuffer_list);
   defsubr (&Sget_buffer);
   defsubr (&Sget_file_buffer);
+  defsubr (&Sget_truename_buffer);
+  defsubr (&Sfind_buffer);
   defsubr (&Sget_buffer_create);
   defsubr (&Smake_indirect_buffer);
   defsubr (&Sgenerate_new_buffer_name);
diff --git a/src/filelock.c b/src/filelock.c
index c2b306ab47d..9ce51c724b1 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -563,7 +563,7 @@ lock_file (Lisp_Object fn)
 
   /* See if this file is visited and has changed on disk since it was
      visited.  */
-  Lisp_Object subject_buf = get_truename_buffer (fn);
+  Lisp_Object subject_buf = Fget_truename_buffer (fn);
   if (!NILP (subject_buf)
       && NILP (Fverify_visited_file_modtime (subject_buf))
       && !NILP (Ffile_exists_p (fn))
diff --git a/src/lisp.h b/src/lisp.h
index 39aa51531fe..544b1691556 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4715,7 +4715,6 @@ XMODULE_FUNCTION (Lisp_Object o)
                                          Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern bool overlay_touches_p (ptrdiff_t);
 extern Lisp_Object other_buffer_safely (Lisp_Object);
-extern Lisp_Object get_truename_buffer (Lisp_Object);
 extern void init_buffer_once (void);
 extern void init_buffer (void);
 extern void syms_of_buffer (void);
diff --git a/test/manual/etags/c-src/emacs/src/lisp.h 
b/test/manual/etags/c-src/emacs/src/lisp.h
index aa8dc8c9a66..19463828270 100644
--- a/test/manual/etags/c-src/emacs/src/lisp.h
+++ b/test/manual/etags/c-src/emacs/src/lisp.h
@@ -4075,7 +4075,6 @@ intern_c_string (const char *str)
                                          Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern bool overlay_touches_p (ptrdiff_t);
 extern Lisp_Object other_buffer_safely (Lisp_Object);
-extern Lisp_Object get_truename_buffer (Lisp_Object);
 extern void init_buffer_once (void);
 extern void init_buffer (int);
 extern void syms_of_buffer (void);
-- 
2.42.0

cpu-profiler-without-patch
Description: Binary data

cpu-profiler-w-patch
Description: Binary data

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>