Improve handling of native compilation units still in use in Windows

When closing emacs will inspect all directories from which it loaded
native compilation units. If it finds a ".eln.old" file it will try to
delete it, if it fails that means that another Emacs instance is using it.

When compiling a file we rename the file that was in the output path
in case it has been loaded into another Emacs instance.

When deleting a package we move any ".eln" or ".eln.old" files in the
package folder that we can't delete to `package-user-dir`. Emacs will
check that directory when closing and delete them.

* lisp/emacs-lisp/comp.el (comp--replace-output-file): Function called
from C code to finish the compilation process. It performs renaming of
the old file if necessary.
* lisp/emacs-lisp/package.el (package--delete-directory): Function to
delete a package directory. It moves native compilation units that it
can't delete to `package-user-dir'.
* src/alloc.c (cleanup_vector): Call dispose_comp_unit().
  (garbage_collect): Call finish_delayed_disposal_of_comp_units().
* src/comp.c: Restore the signal mask using unwind-protect. Store
loaded native compilation units in a hash table for disposal on
close. Store filenames of native compilation units GC'd in a linked
list to finish their disposal when the GC is over.
(clean_comp_unit_directory): Delete all *.eln.old files in a
directory.
(clean_package_user_dir_of_old_comp_units): Delete all *.eln.old files
in `package-user-dir'.
(dispose_all_remaining_comp_units): Dispose of native compilation
units that are still loaded.
(dispose_comp_unit): Close handle and cleanup directory or arrange for
later cleanup if DELAY is true.
(finish_delayed_disposal_of_comp_units): Dispose of native compilation
units that were GC'd.
(register_native_comp_unit): Register native compilation unit for
disposal when Emacs closes.
* src/comp.h: Introduce cfile member in Lisp_Native_Comp_Unit.
Add declarations of functions that: clean directories of unused native
compilation units, handle disposal of native compilation units.
* src/emacs.c (kill-emacs): Dispose all remaining compilation units
right right before calling exit().
* src/eval.c (internal_condition_case_3, internal_condition_case_4):
Add functions.
* src/lisp.h (internal_condition_case_3, internal_condition_case_4):
Add functions.
* src/pdumper.c (dump_do_dump_relocation): Set cfile to a copy of the
Lisp string specifying the file path.

2 files changed, 55 insertions, 1 deletions

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 6c152136fb5..3845827f661 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2277,6 +2277,31 @@ Prepare every function for final compilation and drive the C back-end."
 
 ;; Some entry point support code.
 
+(defun comp--replace-output-file (outfile tmpfile)
+  "Replace OUTFILE with TMPFILE taking the necessary steps when
+dealing with shared libraries that may be loaded into Emacs"
+  (cond ((eq 'windows-nt system-type)
+         (ignore-errors (delete-file outfile))
+         (let ((retry t))
+           (while retry
+             (setf retry nil)
+             (condition-case _
+                 (progn
+                   ;; outfile maybe recreated by another Emacs in
+                   ;; between the following two rename-file calls
+                   (if (file-exists-p outfile)
+                       (rename-file outfile (make-temp-file-internal
+                                             (file-name-sans-extension outfile)
+                                             nil ".eln.old" nil)
+                                    t))
+                   (rename-file tmpfile outfile nil))
+               (file-already-exists (setf retry t))))))
+        ;; Remove the old eln instead of copying the new one into it
+        ;; to get a new inode and prevent crashes in case the old one
+        ;; is currently loaded.
+        (t (delete-file outfile)
+           (rename-file tmpfile outfile))))
+
 (defvar comp-files-queue ()
   "List of Elisp files to be compiled.")
 
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 808e4f34fc5..4288d906ef5 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2204,6 +2204,35 @@ If some packages are not installed propose to install them."
   (equal (cadr (assq (package-desc-name pkg) package-alist))
          pkg))
 
+(defun package--delete-directory (dir)
+  "Delete DIR recursively.
+In Windows move .eln and .eln.old files that can not be deleted
+to `package-user-dir'."
+  (cond ((eq 'windows-nt system-type)
+         (let ((retry t))
+           (while retry
+             (setf retry nil)
+             (condition-case err
+                 (delete-directory dir t)
+               (file-error
+                (cl-destructuring-bind (reason1 reason2 filename) err
+                  (if (and (string= "Removing old name" reason1)
+                           (string= "Permission denied" reason2)
+                           (string-prefix-p (expand-file-name package-user-dir)
+                                            filename)
+                           (or (string-suffix-p ".eln" filename)
+                               (string-suffix-p ".eln.old" filename)))
+                      (progn
+                        (rename-file filename
+                                     (make-temp-file-internal
+                                      (concat package-user-dir
+                                              (file-name-base filename))
+                                      nil ".eln.old" nil)
+                                     t)
+                        (setf retry t))
+                    (signal (car err) (cdr err)))))))))
+        (t (delete-directory dir t))))
+
 (defun package-delete (pkg-desc &optional force nosave)
   "Delete package PKG-DESC.
 
@@ -2256,7 +2285,7 @@ If NOSAVE is non-nil, the package is not removed from
                   (package-desc-name pkg-used-elsewhere-by)))
           (t
            (add-hook 'post-command-hook #'package-menu--post-refresh)
-           (delete-directory dir t)
+           (package--delete-directory dir)
            ;; Remove NAME-VERSION.signed and NAME-readme.txt files.
            ;;
            ;; NAME-readme.txt files are no longer created, but they