From: Andrea Corallo <acorallo@gnu.org>
Date: Tue, 24 Oct 2023 15:09:38 +0000 (+0200)
Subject: Make eln files re-dumpable (bug#45103)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f7d88f4a0478d89f70243456af8c4d4817d6b251;p=emacs.git

Make eln files re-dumpable (bug#45103)

* lisp/loadup.el (load--bin-dest-dir, load--eln-dest-dir): New
variable.
(load--fixup-all-elns): New function.
* src/pdumper.c (Fdump_emacs_portable): Update to call
'load--fixup-all-elns'.
* src/print.c (print_vectorlike): Improve CU printing.
---

diff --git a/lisp/loadup.el b/lisp/loadup.el
index 35c59dba453..07895228d0d 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -496,23 +496,23 @@ lost after dumping")))
 ;; At this point, we're ready to resume undo recording for scratch.
 (buffer-enable-undo "*scratch*")
 
-(defvar comp-subr-arities-h)
-(when (featurep 'native-compile)
-  ;; Save the arity for all primitives so the compiler can always
-  ;; retrive it even in case of redefinition.
-  (mapatoms (lambda (f)
-              (when (subr-primitive-p (symbol-function f))
-                (puthash f (func-arity f) comp-subr-arities-h))))
-  ;; Fix the compilation unit filename to have it working when
-  ;; installed or if the source directory got moved.  This is set to be
-  ;; a pair in the form of:
-  ;;     (rel-filename-from-install-bin . rel-filename-from-local-bin).
-  (let ((bin-dest-dir (cadr (member "--bin-dest" command-line-args)))
-        (eln-dest-dir (cadr (member "--eln-dest" command-line-args))))
-    (when (and bin-dest-dir eln-dest-dir)
-      (setq eln-dest-dir
-            (concat eln-dest-dir "native-lisp/" comp-native-version-dir "/"))
-      (maphash (lambda (_ cu)
+(defvar load--bin-dest-dir nil
+  "Store the original value passed by \"--bin-dest\" during dump.
+Internal use only.")
+(defvar load--eln-dest-dir nil
+  "Store the original value passed by \"--eln-dest\" during dump.
+Internal use only.")
+
+(defun load--fixup-all-elns ()
+  "Fix all compilation unit filename.
+This to have it working when installed or if Emacs source
+directory got moved.  This is set to be a pair in the form of:
+\(rel-filename-from-install-bin . rel-filename-from-local-bin)."
+  (when (and load--bin-dest-dir load--eln-dest-dir)
+    (setq eln-dest-dir
+          (concat load--eln-dest-dir "native-lisp/" comp-native-version-dir "/"))
+    (maphash (lambda (_ cu)
+               (when (stringp (native-comp-unit-file cu))
                  (let* ((file (native-comp-unit-file cu))
                         (preloaded (equal (substring (file-name-directory file)
                                                      -10 -1)
@@ -529,10 +529,20 @@ lost after dumping")))
                                           (file-name-nondirectory
                                            file)
                                           eln-dest-dir-eff)
-                                         bin-dest-dir)
+                                         load--bin-dest-dir)
                      ;; Relative filename from the built uninstalled binary.
-                     (file-relative-name file invocation-directory)))))
-	       comp-loaded-comp-units-h)))
+                     (file-relative-name file invocation-directory))))))
+	     comp-loaded-comp-units-h)))
+
+(defvar comp-subr-arities-h)
+(when (featurep 'native-compile)
+  ;; Save the arity for all primitives so the compiler can always
+  ;; retrive it even in case of redefinition.
+  (mapatoms (lambda (f)
+              (when (subr-primitive-p (symbol-function f))
+                (puthash f (func-arity f) comp-subr-arities-h))))
+  (setq load--bin-dest-dir (cadr (member "--bin-dest" command-line-args)))
+  (setq load--eln-dest-dir (cadr (member "--eln-dest" command-line-args)))
   ;; Set up the mechanism to allow inhibiting native-comp via
   ;; file-local variables.
   (defvar comp--no-native-compile (make-hash-table :test #'equal)))
diff --git a/src/pdumper.c b/src/pdumper.c
index ce4faefdaea..315a31e2bcb 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -4090,6 +4090,10 @@ types.  */)
   if (!NILP (XCDR (Fall_threads ())))
     error ("No other Lisp threads can be running when this function is called");
 
+#ifdef HAVE_NATIVE_COMP
+  CALLN (Ffuncall, intern_c_string ("load--fixup-all-elns"));
+#endif
+
   check_pure_size ();
 
   /* Clear out any detritus in memory.  */
diff --git a/src/print.c b/src/print.c
index eb20cfb1c47..4eee8319f65 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2008,7 +2008,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
       {
 	struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj);
 	print_c_string ("#<native compilation unit: ", printcharfun);
-	print_string (cu->file, printcharfun);
+	print_object (cu->file, printcharfun, escapeflag);
 	printchar (' ', printcharfun);
 	print_object (cu->optimize_qualities, printcharfun, escapeflag);
 	printchar ('>', printcharfun);