Subject: bug#70036: 30.0.50; Move file-truename to the C level

From: Theodor Thornhill <[email-masked]>
Date: Wed, 27 Mar 2024 20:08:54 +0100

Hi, all!

During the last couple of weeks I've been studying Eglots performance
and have been noticing a couple of things that I find very
interesting. It seems like `file-truename` is in the hot path due to the
fact that every request to the lsp server has to create the source file
location, and in every response we have to parse the location the
relevant file. `file-truename` is used for this, and its performance
isn't really up to snuff for what it provides, afaict.

Below I've supplied some benchmarks and profile reports along with the
actual patch. Before we discuss the patch itself, I want to get some
answers to the following:

 - Is there a reason that this function should be supplied at the lisp
   level?
 - Does it have to be recursive? It seems to eat up a lot of stack, and
   the comments in the file suggest that has been an issue before.

Firstly, I'll show some benchmarks

```
;; Emacs 29 branch

(benchmark-run 10000
  (file-truename "~/Work/some/long/path/to/parse/that/is/very/deep/deep/deep/super/duper/deep/deep.el"))
;; (1.810892642 1 0.051070616)

;; With new C implementation

(benchmark-run 10000
  (file-truename "~/Work/some/long/path/to/parse/that/is/very/deep/deep/deep/super/duper/deep/deep.el"))
;; (0.018811035 0 0.0)
```

As you can see, the C implementation, though naive for now is two orders
of magnitude faster, and makes a noticeable difference when running an
lsp server in emacs.

As for the patch - it now relies on wordexp to resolve the paths, and I
believe there is no real feature parity with the old variant as for now,
but I haven't seen any issues thus far. If this approach is accepted I
will of course make sure we have feature parity, unless that isn't
wanted.

As for the profiles - it is very clear the performance is better with my
version, as it doesn't really show up in the profiles, but in the
current state `file-truename` seems to eat up around 10-20% of the total
samplings.

And lastly - I've noticed that `redisplay_internal (C function)` shows
up as a _huge_ chunk in emacs 30, but not in emacs 29. Is this a known
issue, or something to look out for? I could open a different bug report
for this if needed.

Below are the profiles and the patch. On my system I needed to `ln -s
lisp/loadup.el .` to make it compile. Not sure if that is due to
differences between old and new `file-truename`, or something else.

Thanks,

Theo

>From 183e636eebd9f1653d0cfdacdeba77d2043954af Mon Sep 17 00:00:00 2001
From: Theodor Thornhill <[email-masked]>
Date: Wed, 27 Mar 2024 19:42:56 +0100
Subject: [PATCH] Move file-truename to the C level

---
 lisp/files.el | 116 +++++---------------------------------------------
 src/fileio.c  |  27 ++++++++++++
 2 files changed, 38 insertions(+), 105 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 766ed573392..6b9846c2ef4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -32,6 +32,8 @@
   (require 'pcase)
   (require 'easy-mmode)) ; For `define-minor-mode'.
 
+(declare-function file-truename "fileio.c")
+
 (defvar font-lock-keywords)
 
 (defgroup backup nil
@@ -1413,111 +1415,15 @@ files--splice-dirname-file
 	unquoted
       (let (file-name-handler-alist) (file-name-quote unquoted)))))
 
-(defun file-truename (filename &optional counter prev-dirs)
-  "Return the truename of FILENAME.
-If FILENAME is not absolute, first expands it against `default-directory'.
-The truename of a file name is found by chasing symbolic links
-both at the level of the file and at the level of the directories
-containing it, until no links are left at any level.
-
-\(fn FILENAME)"  ;; Don't document the optional arguments.
-  ;; COUNTER and PREV-DIRS are used only in recursive calls.
-  ;; COUNTER can be a cons cell whose car is the count of how many
-  ;; more links to chase before getting an error.
-  ;; PREV-DIRS can be a cons cell whose car is an alist
-  ;; of truenames we've just recently computed.
-  (cond ((or (string= filename "") (string= filename "~"))
-	 (setq filename (expand-file-name filename))
-	 (if (string= filename "")
-	     (setq filename "/")))
-	((and (string= (substring filename 0 1) "~")
-	      (string-match "~[^/]*/?" filename))
-	 (let ((first-part
-		(substring filename 0 (match-end 0)))
-	       (rest (substring filename (match-end 0))))
-	   (setq filename (concat (expand-file-name first-part) rest)))))
-
-  (or counter (setq counter (list 100)))
-  (let (done
-	;; For speed, remove the ange-ftp completion handler from the list.
-	;; We know it's not needed here.
-	;; For even more speed, do this only on the outermost call.
-	(file-name-handler-alist
-	 (if prev-dirs file-name-handler-alist
-	   (let ((tem (copy-sequence file-name-handler-alist)))
-	     (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
-    (or prev-dirs (setq prev-dirs (list nil)))
-
-    ;; [email-masked] - on Windows, there is an issue with
-    ;; case differences being ignored by the OS, and short "8.3 DOS"
-    ;; name aliases existing for all files.  (The short names are not
-    ;; reported by directory-files, but can be used to refer to files.)
-    ;; It seems appropriate for file-truename to resolve these issues in
-    ;; the most natural way, which on Windows is to call the function
-    ;; `w32-long-file-name' - this returns the exact name of a file as
-    ;; it is stored on disk (expanding short name aliases with the full
-    ;; name in the process).
-    (if (eq system-type 'windows-nt)
-	(unless (string-match "[[*?]" filename)
-	  ;; If filename exists, use its long name.  If it doesn't
-	  ;; exist, the recursion below on the directory of filename
-	  ;; will drill down until we find a directory that exists,
-	  ;; and use the long name of that, with the extra
-	  ;; non-existent path components concatenated.
-	  (let ((longname (w32-long-file-name filename)))
-	    (if longname
-		(setq filename longname)))))
-
-    ;; If this file directly leads to a link, process that iteratively
-    ;; so that we don't use lots of stack.
-    (while (not done)
-      (setcar counter (1- (car counter)))
-      (if (< (car counter) 0)
-	  (error "Apparent cycle of symbolic links for %s" filename))
-      (let ((handler (find-file-name-handler filename 'file-truename)))
-	;; For file name that has a special handler, call handler.
-	;; This is so that ange-ftp can save time by doing a no-op.
-	(if handler
-	    (setq filename (funcall handler 'file-truename filename)
-		  done t)
-	  (let ((dir (or (file-name-directory filename) default-directory))
-		target dirfile)
-	    ;; Get the truename of the directory.
-	    (setq dirfile (directory-file-name dir))
-	    ;; If these are equal, we have the (or a) root directory.
-	    (or (string= dir dirfile)
-		(and (file-name-case-insensitive-p dir)
-		     (string-equal-ignore-case dir dirfile))
-		;; If this is the same dir we last got the truename for,
-		;; save time--don't recalculate.
-		(if (assoc dir (car prev-dirs))
-		    (setq dir (cdr (assoc dir (car prev-dirs))))
-		  (let ((old dir)
-			(new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
-		    (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
-		    (setq dir new))))
-	    (if (equal ".." (file-name-nondirectory filename))
-		(setq filename
-		      (directory-file-name (file-name-directory (directory-file-name dir)))
-		      done t)
-	      (if (equal "." (file-name-nondirectory filename))
-		  (setq filename (directory-file-name dir)
-			done t)
-		;; Put it back on the file name.
-		(setq filename (concat dir (file-name-nondirectory filename)))
-		;; Is the file name the name of a link?
-		(setq target (file-symlink-p filename))
-		(if target
-		    ;; Yes => chase that link, then start all over
-		    ;; since the link may point to a directory name that uses links.
-		    ;; We can't safely use expand-file-name here
-		    ;; since target might look like foo/../bar where foo
-		    ;; is itself a link.  Instead, we handle . and .. above.
-		    (setq filename (files--splice-dirname-file dir target)
-			  done nil)
-		  ;; No, we are done!
-		  (setq done t))))))))
-    filename))
+;; (defun file-truename (filename &optional _x _y)
+;;   "Return the truename of FILENAME.
+;; If FILENAME is not absolute, first expands it against `default-directory'.
+;; The truename of a file name is found by chasing symbolic links
+;; both at the level of the file and at the level of the directories
+;; containing it, until no links are left at any level.
+
+;; \(fn FILENAME)"
+;;   (file-truename-c filename))
 
 (defun file-chase-links (filename &optional limit)
   "Chase links in FILENAME until a name that is not a link.
diff --git a/src/fileio.c b/src/fileio.c
index 12da7a9ed3a..05deedead55 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -24,6 +24,8 @@ Copyright (C) 1985-1988, 1993-2024 Free Software Foundation, Inc.
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <unistd.h>
+#include <stdlib.h>
+#include <wordexp.h>
 
 #ifdef DARWIN_OS
 #include <sys/attr.h>
@@ -367,6 +369,30 @@ restore_point_unwind (Lisp_Object location)
   unchain_marker (XMARKER (location));
 }
 
+DEFUN ("file-truename", Ffile_truename, Sfile_truename,
+       1, 3, 0,
+       doc: /* Return the truename of FILENAME.  */)
+  (Lisp_Object filename, Lisp_Object x, Lisp_Object y)
+{
+  Lisp_Object result = filename;
+
+  CHECK_STRING (filename);
+  char *c_filename = SSDATA (filename);
+
+  wordexp_t we;
+  wordexp(c_filename, &we, 0);
+
+  char *truename = realpath(we.we_wordv[0], NULL);
+  wordfree(&we);
+
+  if (!truename)
+    return result;
+
+  result = build_string(truename);
+  free(truename);
+
+  return result;
+}
 
 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
        Sfind_file_name_handler, 2, 2, 0,
@@ -6850,6 +6876,7 @@ do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
   DEFSYM (Qstdout, "stdout");
   DEFSYM (Qstderr, "stderr");
 
+  defsubr (&Sfile_truename);
   defsubr (&Sfind_file_name_handler);
   defsubr (&Sfile_name_directory);
   defsubr (&Sfile_name_nondirectory);
-- 
2.40.1