bug#41646: Startup in Windows is very slow when load-path contains many

[Lin Sun <sunlin7.mail@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 908 bytes --]

On Mon, Oct 21, 2024 at 2:34 PM Stefan Monnier <monnier@iro.umontreal.ca> wrote:
> BTW, in your patch, you change `locate-file-internal` which seems wrong,
> since that function is not specific to loading ELisp files, it's also
> used for $MANPATH, $PATH, and things like that.

You're right, the change in `locate-file-internal' didn't merge the
original path.
I attached the patch to append the `dirs' with `path' together.

> Similarly, I wasn't able to convince myself that your patch does the
> right thing when `require` or `load` is used such that MUST_SUFFIX is
> not specified.

The `load-hints` just put the matched paths on the top of `load-path`,
still following the `load-path' mechanism, and won't affect any other
features (Or someone already has some code to adjust the `load-path'
orders, can just ignore the `load-hints', everything work like before,
no break changes).

[-- Attachment #2: 0001-New-variable-load-hints-to-speedup-searching-file-fo.patch --]
[-- Type: text/x-patch, Size: 7539 bytes --]

From 65c54e882a0aab28fc5697a64fd1fdf15a266440 Mon Sep 17 00:00:00 2001
From: Lin Sun <sunlin7@hotmail.com>
Date: Wed, 16 Oct 2024 07:31:59 +0000
Subject: [PATCH 1/2] New variable load-hints to speedup searching file for
 (load) function

* lisp/subr.el: (locate-library) support the `load-hints' variable
* src/lread.c: (load) function support the `load-hints' variable
---
 lisp/subr.el |  9 ++---
 src/lread.c  | 99 ++++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 86 insertions(+), 22 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 2eaed682406..3d9599270ed 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3141,10 +3141,11 @@ locate-library
 string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
   (interactive (list (read-library-name) nil nil t))
-  (let ((file (locate-file library
-			   (or path load-path)
-			   (append (unless nosuffix (get-load-suffixes))
-				   load-file-rep-suffixes))))
+  (let ((file (locate-file-internal
+               library (or path load-path)
+               (append (unless nosuffix (get-load-suffixes))
+                       load-file-rep-suffixes)
+               nil (unless path load-hints))))
     (if interactive-call
 	(if file
 	    (message "Library is file %s" (abbreviate-file-name file))
diff --git a/src/lread.c b/src/lread.c
index 95c6891c205..8d558ad8c66 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1271,6 +1271,53 @@ close_file_unwind_android_fd (void *ptr)
 
 #endif
 
+static bool
+complete_filename_p (Lisp_Object pathname)
+{
+  const unsigned char *s = SDATA (pathname);
+  return (IS_DIRECTORY_SEP (s[0])
+	  || (SCHARS (pathname) > 2 && IS_DEVICE_SEP (s[1])
+	      && IS_DIRECTORY_SEP (s[2])));
+}
+
+/* search the file in load hints to get a path list */
+static Lisp_Object
+search_load_hints(Lisp_Object load_hints, Lisp_Object file) {
+  Lisp_Object load_path = Qnil;
+  Lisp_Object tail = load_hints;
+  FOR_EACH_TAIL_SAFE (tail)
+    {
+      bool fullmatch = false;
+      ptrdiff_t len = -1;
+      Lisp_Object row = XCAR (tail);
+      Lisp_Object key = XCAR (row);
+      CHECK_STRING (key);
+
+      if (SBYTES (key) - 1 <= SBYTES (file))
+	{
+	  if (SBYTES (key) >= 1
+	      && SDATA (key)[SBYTES (key) - 1] == '*')
+	    len = SBYTES (key) - 1; /* "file-*" format */
+	  else if (SBYTES (key) == SBYTES (file))
+	    {
+	      len = SBYTES (key);
+	      fullmatch = true;
+	    }
+	}
+
+      if (len >= 0 && 0 == memcmp (SDATA (key), SDATA (file), len))
+	{
+	  if (fullmatch)
+	    {
+	      load_path = CALLN (Fappend, XCDR (row));
+	      break;
+	    }
+	  load_path = CALLN (Fappend, load_path, XCDR (row));
+	}
+    }
+  return load_path;
+}
+
 DEFUN ("load", Fload, Sload, 1, 5, 0,
        doc: /* Execute a file of Lisp code named FILE.
 First try FILE with `.elc' appended, then try with `.el', then try
@@ -1278,7 +1325,9 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 then try FILE unmodified (the exact suffixes in the exact order are
 determined by `load-suffixes').  Environment variable references in
 FILE are replaced with their values by calling `substitute-in-file-name'.
-This function searches the directories in `load-path'.
+This function searches the entry in `load-hints` first, if some entries
+matched, searches in the matched pathes. Otherwise, searches directories
+in `load-path'.
 
 If optional second arg NOERROR is non-nil,
 report no error if FILE doesn't exist.
@@ -1327,7 +1376,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 #endif
   specpdl_ref fd_index UNINIT;
   specpdl_ref count = SPECPDL_INDEX ();
-  Lisp_Object found, efound, hist_file_name;
+  Lisp_Object found, efound, hist_file_name, load_path = Qnil;
   /* True means we printed the ".el is newer" message.  */
   bool newer = 0;
   /* True means we are loading a compiled file.  */
@@ -1409,12 +1458,20 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 	    suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
 	}
 
+      if (! (NILP (Vload_hints) || complete_filename_p (file)))
+	load_path = search_load_hints(Vload_hints, file);
+
+      if (NILP (load_path))
+	load_path = Vload_path;
+      else
+	load_path = CALLN (Fappend, load_path, Vload_path);
+
 #if !defined USE_ANDROID_ASSETS
-      fd = openp (Vload_path, file, suffixes, &found, Qnil,
+      fd = openp (load_path, file, suffixes, &found, Qnil,
 		  load_prefer_newer, no_native, NULL);
 #else
       asset = NULL;
-      rc = openp (Vload_path, file, suffixes, &found, Qnil,
+      rc = openp (load_path, file, suffixes, &found, Qnil,
 		  load_prefer_newer, no_native, &asset);
       fd.fd = rc;
       fd.asset = asset;
@@ -1780,16 +1837,7 @@ save_match_data_load (Lisp_Object file, Lisp_Object noerror,
   return unbind_to (count, result);
 }
 \f
-static bool
-complete_filename_p (Lisp_Object pathname)
-{
-  const unsigned char *s = SDATA (pathname);
-  return (IS_DIRECTORY_SEP (s[0])
-	  || (SCHARS (pathname) > 2
-	      && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
-}
-
-DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
+DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 5, 0,
        doc: /* Search for FILENAME through PATH.
 Returns the file's name in absolute form, or nil if not found.
 If SUFFIXES is non-nil, it should be a list of suffixes to append to
@@ -1797,12 +1845,20 @@ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2,
 If non-nil, PREDICATE is used instead of `file-readable-p'.
 PREDICATE can also be an integer to pass to the faccessat(2) function,
 in which case file-name-handlers are ignored.
+LOAD-HINTS is a list same as `load-hints'.
 This function will normally skip directories, so if you want it to find
 directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
-  (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
+  (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate,
+   Lisp_Object load_hints)
 {
-  Lisp_Object file;
-  int fd = openp (path, filename, suffixes, &file, predicate, false, true,
+  Lisp_Object file, dirs = Qnil;
+  if (!NILP(load_hints))
+    dirs = search_load_hints(load_hints, filename);
+  if (NILP(dirs))
+    dirs = path;
+  else
+    dirs = CALLN (Fappend, dirs, path);
+  int fd = openp (dirs, filename, suffixes, &file, predicate, false, true,
 		  NULL);
   if (NILP (predicate) && fd >= 0)
     emacs_close (fd);
@@ -1882,7 +1938,7 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
 		 can't find even central .el files.  */
 	      if (NILP (Flocate_file_internal (build_string ("simple.el"),
 					       Vload_path,
-					       Qnil, Qnil)))
+					       Qnil, Qnil, Qnil)))
 		return;
 	      Vdelayed_warnings_list
 		= Fcons (list2
@@ -5851,6 +5907,13 @@ syms_of_lread (void)
 	       doc: /* Non-nil means read recursive structures using #N= and #N# syntax.  */);
   Vread_circle = Qt;
 
+  DEFVAR_LISP ("load-hints", Vload_hints,
+	       doc: /* A list for name to directory-list to search for files
+to load, before the load-path.  Eache entry is a file name to directory list,
+file name ends with a '*' means prefix matching. Example:
+  '(("name1-*" "/path1" "/path2")).  */);
+  Vload_hints = Qnil;
+
   DEFVAR_LISP ("load-path", Vload_path,
 	       doc: /* List of directories to search for files to load.
 Each element is a string (directory file name) or nil (meaning
-- 
2.34.1


[-- Attachment #3: 0002-lisp-emacs-lisp-package.el-Support-the-load-hints.patch --]
[-- Type: text/x-patch, Size: 4666 bytes --]

From 4efb3b689ef6f97cab82e5b34cf9dabc3f3d7ee0 Mon Sep 17 00:00:00 2001
From: Lin Sun <sunlin7@hotmail.com>
Date: Sat, 19 Oct 2024 06:43:15 +0000
Subject: [PATCH 2/2] * lisp/emacs-lisp/package.el: Support the load-hints

---
 lisp/emacs-lisp/package.el | 79 +++++++++++++++++++++++++++++++-------
 1 file changed, 66 insertions(+), 13 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 90d6150ed0b..1c4d47b71f2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -208,6 +208,22 @@ package-load-list
   :risky t
   :version "24.1")
 
+(defcustom package-enable-load-hints t
+  "Non-nil means enable the `load-hints' for the packages.
+
+The value can be one of:
+
+  t             Add package dir into both `load-hints' and `load-path'.
+
+  `aggressive'  If all files in a package dir were covered by the `load-hints'
+                then will not add the package dir into `load-path'.
+
+  nil           Don't used the `load-hints'."
+  :type '(choice (const :value nil            :tag "Disable")
+                 (const :value t              :tag "Enable(safe)")
+                 (const :value aggressive     :tag "Enable(agressive)"))
+  :version "31.1")
+
 (defcustom package-archives `(("gnu" .
                                ,(format "http%s://elpa.gnu.org/packages/"
                                         (if (gnutls-available-p) "s" "")))
@@ -1095,21 +1111,58 @@ package-generate-autoloads
          ;; We don't need 'em, and this makes the output reproducible.
          (autoload-timestamps nil)
          (backup-inhibited t)
-         (version-control 'never))
+         (version-control 'never)
+         hints-list hints-covered-all)
+    ;; if package-enabled-load-hints is non-nil then collecting loadable
+    ;; files in pkg-dir and generating the load-hints list.
+    (when-let* (package-enable-load-hints
+                (name (symbol-name name))
+                (files (cl-set-difference (directory-files pkg-dir)
+                                          '("." "..") :test #'string=))
+                ;; list of files basename, the load-suffixes was removed
+                (bases
+                 (remove nil
+                         (mapcar
+                          (lambda (f)
+                            (cl-some
+                             (lambda (s)
+                               (if-let* ((n (length s))
+                                         ((length> f n))
+                                         ((string= s (substring f (- n)))))
+                                   (substring f 0 (- n))))
+                             (get-load-suffixes)))
+                          files))))
+      (setq hints-covered-all (length= bases (length files))
+            hints-list
+            (cl-remove-duplicates
+             (mapcar (lambda (s)
+                       (format "(add-to-list 'load-hints '(%S %S))"
+                               (if (string-prefix-p name s)
+                                   (concat name "*")
+                                 s)
+                               pkg-dir))
+                     bases)
+             :test 'string=)))
     (loaddefs-generate
      pkg-dir output-file nil
-     (prin1-to-string
-      '(add-to-list
-        'load-path
-        ;; Add the directory that will contain the autoload file to
-        ;; the load path.  We don't hard-code `pkg-dir', to avoid
-        ;; issues if the package directory is moved around.
-        ;; `loaddefs-generate' has code to do this for us, but it's
-        ;; not currently exposed.  (Bug#63625)
-        (or (and load-file-name
-                 (directory-file-name
-                  (file-name-directory load-file-name)))
-             (car load-path)))))
+     (concat
+      (when hints-list
+        (string-join hints-list "\n"))
+      "\n"
+      (unless (and hints-covered-all
+                   (eq package-enable-load-hints 'aggressive))
+        (prin1-to-string
+         '(add-to-list
+           'load-path
+           ;; Add the directory that will contain the autoload file to
+           ;; the load path.  We don't hard-code `pkg-dir', to avoid
+           ;; issues if the package directory is moved around.
+           ;; `loaddefs-generate' has code to do this for us, but it's
+           ;; not currently exposed.  (Bug#63625)
+           (or (and load-file-name
+                    (directory-file-name
+                     (file-name-directory load-file-name)))
+               (car load-path)))))))
     (let ((buf (find-buffer-visiting output-file)))
       (when buf (kill-buffer buf)))
     auto-name))
-- 
2.34.1