From a71f54eff80cb7d7b36326849eea878073963594 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 6 Sep 2020 18:17:00 +0200 Subject: [PATCH] Rework eln deletion strategy for new eln-cache folder structure When recompiling remove the corresponding stale elns found in the `comp-eln-load-path'. When removing a package remove the corresponding elns too. On Windows both of these are performed only when possible, when it's not the file is renamed as .eln.old and a last attempt to remove this is performed closing the Emacs session. When a file being deleted was loaded by multiple Emacs sessions the last one being closed should delete it. * lisp/emacs-lisp/comp.el (comp-clean-up-stale-eln): New function. (comp-delete-or-replace-file): Rename from `comp--replace-output-file' and update so it can be used for replacing or deleting shared libs safetly. * lisp/emacs-lisp/package.el (package--delete-directory): When native compiled just call `comp-clean-up-stale-eln' for each eln file we want to clean-up. * src/alloc.c (cleanup_vector): Call directly the dynlib_close. * src/comp.c (syms_of_comp): Update for comp_u->cfile removal. Make 'all_loaded_comp_units_h' key-value weak as now the key will be the filename. (load_comp_unit): Register the compilation unit only when the load is fully completed. (register_native_comp_unit): Make the key of all_loaded_comp_units_h the load filename. (eln_load_path_final_clean_up): New function. (dispose_comp_unit) (finish_delayed_disposal_of_comp_units) (dispose_all_remaining_comp_units) (clean_package_user_dir_of_old_comp_units): Remove. (Fcomp__compile_ctxt_to_file): Update for `comp--replace-output-file' -> `comp-delete-or-replace-file' rename. * src/comp.h (dispose_comp_unit) (finish_delayed_disposal_of_comp_units) (dispose_all_remaining_comp_units) (clean_package_user_dir_of_old_comp_units): Remove. (eln_load_path_final_clean_up): Add. (struct Lisp_Native_Comp_Unit): Remove cfile field. * src/emacs.c (Fkill_emacs): Call 'eln_load_path_final_clean_up'. * src/pdumper.c (dump_do_dump_relocation): Do not set comp_u->cfile. --- lisp/emacs-lisp/comp.el | 53 ++++++--- lisp/emacs-lisp/package.el | 33 ++---- src/alloc.c | 3 +- src/comp.c | 236 ++++--------------------------------- src/comp.h | 34 +----- src/emacs.c | 6 +- src/pdumper.c | 3 - 7 files changed, 75 insertions(+), 293 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 84b5a8bc873..129a4dedaf9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2505,31 +2505,52 @@ 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. -Takes the necessary steps when dealing with shared libraries that -may be loaded into Emacs" +;;;###autoload +(defun comp-clean-up-stale-eln (file) + "Given FILE remove all the .eln files in `comp-eln-load-path' +sharing the original source filename (including FILE)." + (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos) file) + (cl-loop + with filename-hash = (match-string 1 file) + with regexp = (rx-to-string + `(seq "-" ,filename-hash "-" (1+ hex) ".eln" eos)) + for dir in (butlast comp-eln-load-path) ; Skip last dir. + do (cl-loop + for f in (directory-files (concat dir comp-native-version-dir) t regexp + t) + do (comp-delete-or-replace-file f)))) + +(defun comp-delete-or-replace-file (oldfile &optional newfile) + "Replace OLDFILE with NEWFILE. +When NEWFILE is nil just delete OLDFILE. +Takes the necessary steps when dealing with OLDFILE being a +shared libraries that may be currently loaded by a running Emacs +session." (cond ((eq 'windows-nt system-type) - (ignore-errors (delete-file outfile)) - (let ((retry t)) - (while retry - (setf retry nil) + (ignore-errors (delete-file oldfile)) + (while (condition-case _ (progn - ;; outfile maybe recreated by another Emacs in + ;; oldfile 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) + (if (file-exists-p oldfile) + (rename-file oldfile (make-temp-file-internal + (file-name-sans-extension oldfile) nil ".eln.old" nil) t)) - (rename-file tmpfile outfile nil)) - (file-already-exists (setf retry t)))))) + (when newfile + (rename-file newfile oldfile nil)) + ;; Keep on trying. + nil) + (file-already-exists + ;; Done + 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)))) + (t (delete-file oldfile) + (when newfile + (rename-file newfile oldfile))))) (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 c349b5d49f6..c20659a1ae6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2206,32 +2206,13 @@ If some packages are not installed propose to install them." (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)))) +Clean-up the corresponding .eln files if Emacs is native +compiled." + (when (boundp 'comp-ctxt) + (cl-loop + for file in (directory-files-recursively dir ".el\\'") + do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) + (delete-directory dir t)) (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. diff --git a/src/alloc.c b/src/alloc.c index 6701bf002b7..bde0a16ac15 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3153,7 +3153,8 @@ cleanup_vector (struct Lisp_Vector *vector) { struct Lisp_Native_Comp_Unit *cu = PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); - dispose_comp_unit (cu, true); + eassert (cu->handle); + dynlib_close (cu->handle); } else if (NATIVE_COMP_FLAG && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) diff --git a/src/comp.c b/src/comp.c index 3a56f5f22c6..68a0ead69ae 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4361,7 +4361,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, SSDATA (tmp_file)); - CALL2I (comp--replace-output-file, file_name, tmp_file); + CALL1I (comp-clean-up-stale-eln, file_name); + CALL2I (comp-delete-or-replace-file, file_name, tmp_file); if (!noninteractive) unbind_to (count, Qnil); @@ -4438,220 +4439,44 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) } -/*********************************/ -/* Disposal of compilation units */ -/*********************************/ - -/* - The problem: Windows does not let us delete an .eln file that has - been loaded by a process. This has two implications in Emacs: - - 1) It is not possible to recompile a lisp file if the corresponding - .eln file has been loaded. This is because we'd like to use the same - filename, but we can't delete the old .eln file. - - 2) It is not possible to delete a package using `package-delete' - if an .eln file has been loaded. - - * General idea - - The solution to these two problems is to move the foo.eln file - somewhere else and have the last Emacs instance using it delete it. - To make it easy to find what files need to be removed we use two approaches. - - In the 1) case we rename foo.eln to fooXXXXXX.eln.old in the same - folder. When Emacs is unloading "foo" (either GC'd the native - compilation unit or Emacs is closing (see below)) we delete all the - .eln.old files in the folder where the original foo.eln was stored. - - Ideally we'd figure out the new name of foo.eln and delete it if it - ends in .eln.old. There is no simple API to do this in Windows. - GetModuleFileName () returns the original filename, not the current - one. This forces us to put .eln.old files in an agreed upon path. - We cannot use %TEMP% because it may be in another drive and then the - rename operation would fail. - - In the 2) case we can't use the same folder where the .eln file - resided, as we are trying to completely remove the package. Since we - are removing packages we can safely move the .eln.old file to - `package-user-dir' as we are sure that that would not mean changing - drives. - - * Implementation details - - The concept of disposal of a native compilation unit refers to - unloading the shared library and deleting all the .eln.old files in - the directory. These are two separate steps. We'll call them - early-disposal and late-disposal. - - There are two data structures used: - - - The `all_loaded_comp_units_h` hashtable. - - This hashtable is used like an array of weak references to native - compilation units. This hash table is filled by load_comp_unit () - and dispose_all_remaining_comp_units () iterates over all values - that were not disposed by the GC and performs all disposal steps - when Emacs is closing. - - - The `delayed_comp_unit_disposal_list` list. - - This is were the dispose_comp_unit () function, when called by the - GC sweep stage, stores the original filenames of the disposed native - compilation units. This is an ad-hoc C structure instead of a Lisp - cons because we need to allocate instances of this structure during - the GC. - - The finish_delayed_disposal_of_comp_units () function will iterate - over this list and perform the late-disposal step when Emacs is - closing. - -*/ - -#ifdef WINDOWSNT -#define OLD_ELN_SUFFIX_REGEXP build_string ("\\.eln\\.old\\'") +/* `comp-eln-load-path' clean-up support code. */ static Lisp_Object all_loaded_comp_units_h; -/* We need to allocate instances of this struct during a GC sweep. - This is why it can't be transformed into a simple cons. */ -struct delayed_comp_unit_disposal -{ - struct delayed_comp_unit_disposal *next; - char *filename; -}; - -struct delayed_comp_unit_disposal *delayed_comp_unit_disposal_list; - -static Lisp_Object -return_nil (Lisp_Object arg) -{ - return Qnil; -} - -/* Tries to remove all *.eln.old files in DIRNAME. +/* Windows does not let us delete a .eln file that is currently loaded + by a process. The strategy is to rename .eln files into .old.eln + instead of removing them when this is not possible and clean-up + `comp-eln-load-path' when exiting. Any error is ignored because it may be due to the file being loaded in another Emacs instance. */ -static void -clean_comp_unit_directory (Lisp_Object dirpath) -{ - if (NILP (dirpath)) - return; - Lisp_Object files_in_dir; - files_in_dir = internal_condition_case_4 (Fdirectory_files, dirpath, Qt, - OLD_ELN_SUFFIX_REGEXP, Qnil, Qt, - return_nil); - FOR_EACH_TAIL (files_in_dir) { DeleteFile (SSDATA (XCAR (files_in_dir))); } -} - -/* Tries to remove all *.eln.old files in `package-user-dir'. - - This is called when Emacs is closing to clean any *.eln left from a - deleted package. */ void -clean_package_user_dir_of_old_comp_units (void) +eln_load_path_final_clean_up (void) { - Lisp_Object package_user_dir - = find_symbol_value (intern ("package-user-dir")); - if (EQ (package_user_dir, Qunbound) || !STRINGP (package_user_dir)) - return; - - clean_comp_unit_directory (package_user_dir); -} - -/* This function disposes all compilation units that are still loaded. - - It is important that this function is called only right before - Emacs is closed, otherwise we risk running a subr that is - implemented in an unloaded dynamic library. */ -void -dispose_all_remaining_comp_units (void) -{ - struct Lisp_Hash_Table *h = XHASH_TABLE (all_loaded_comp_units_h); - - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - Lisp_Object k = HASH_KEY (h, i); - if (!EQ (k, Qunbound)) - { - Lisp_Object val = HASH_VALUE (h, i); - struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (val); - dispose_comp_unit (cu, false); - } - } -} - -/* This function finishes the disposal of compilation units that were - passed to `dispose_comp_unit` with DELAY == true. +#ifdef WINDOWSNT + Lisp_Object return_nil (Lisp_Object arg) { return Qnil; } - This function is called when Emacs is idle and when it is about to - close. */ -void -finish_delayed_disposal_of_comp_units (void) -{ - for (struct delayed_comp_unit_disposal *item - = delayed_comp_unit_disposal_list; - delayed_comp_unit_disposal_list; item = delayed_comp_unit_disposal_list) + Lisp_Object dir_tail = Vcomp_eln_load_path; + FOR_EACH_TAIL (dir_tail) { - delayed_comp_unit_disposal_list = item->next; - Lisp_Object dirname = internal_condition_case_1 ( - Ffile_name_directory, build_string (item->filename), Qt, return_nil); - clean_comp_unit_directory (dirname); - xfree (item->filename); - xfree (item); + Lisp_Object files_in_dir = + internal_condition_case_4 (Fdirectory_files, + concat2 (XCAR (dir_tail), + Vcomp_native_version_dir), + Qt, build_string ("\\.eln\\.old\\'"), Qnil, + Qt, return_nil); + FOR_EACH_TAIL (files_in_dir) + Fdelete_file (XCAR (files_in_dir), Qnil); } -} #endif +} /* This function puts the compilation unit in the `all_loaded_comp_units_h` hashmap. */ static void register_native_comp_unit (Lisp_Object comp_u) { -#ifdef WINDOWSNT - /* We have to do this since we can't use `gensym'. This function is - called early when loading a dump file and subr.el may not have - been loaded yet. */ - static intmax_t count; - - Fputhash (make_int (count++), comp_u, all_loaded_comp_units_h); -#endif -} - -/* This function disposes compilation units. It is called during the GC sweep - stage and when Emacs is closing. - - On Windows the the DELAY parameter specifies whether the native - compilation file will be deleted right away (if necessary) or put - on a list. That list will be dealt with by - `finish_delayed_disposal_of_comp_units`. */ -void -dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) -{ - eassert (comp_handle->handle); - dynlib_close (comp_handle->handle); -#ifdef WINDOWSNT - if (!delay) - { - Lisp_Object dirname = internal_condition_case_1 ( - Ffile_name_directory, build_string (comp_handle->cfile), Qt, - return_nil); - if (!NILP (dirname)) - clean_comp_unit_directory (dirname); - xfree (comp_handle->cfile); - comp_handle->cfile = NULL; - } - else - { - struct delayed_comp_unit_disposal *head; - head = xmalloc (sizeof (struct delayed_comp_unit_disposal)); - head->next = delayed_comp_unit_disposal_list; - head->filename = comp_handle->cfile; - comp_handle->cfile = NULL; - delayed_comp_unit_disposal_list = head; - } -#endif + Fputhash (XNATIVE_COMP_UNIT (comp_u)->file, comp_u, all_loaded_comp_units_h); } @@ -4663,7 +4488,6 @@ dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) loaded the compiler and its dependencies. */ static Lisp_Object delayed_sources; - /* Queue an asyncronous compilation for the source file defining FUNCTION_NAME and perform a late load. @@ -4922,12 +4746,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); - - /* If we register them while dumping we will get some entries in - the hash table that will be duplicated when pdumper calls - load_comp_unit. */ - if (!will_dump_p ()) - register_native_comp_unit (comp_u_lisp_obj); } if (!loading_dump) @@ -4968,6 +4786,8 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Clean-up the load ongoing flag in case. */ unbind_to (count, Qnil); + register_native_comp_unit (comp_u_lisp_obj); + return; } @@ -5110,9 +4930,6 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, if (!comp_u->handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; -#ifdef WINDOWSNT - comp_u->cfile = xlispstrdup (file); -#endif comp_u->data_vec = Qnil; comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); @@ -5275,10 +5092,9 @@ native compiled one. */); staticpro (&loadsearch_re_list); loadsearch_re_list = Qnil; -#ifdef WINDOWSNT staticpro (&all_loaded_comp_units_h); - all_loaded_comp_units_h = CALLN (Fmake_hash_table, QCweakness, Qvalue); -#endif + all_loaded_comp_units_h = + CALLN (Fmake_hash_table, QCweakness, Qkey_and_value, QCtest, Qequal); DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt, doc: /* The compiler context. */); diff --git a/src/comp.h b/src/comp.h index 9270f8bf664..5c7bed6a304 100644 --- a/src/comp.h +++ b/src/comp.h @@ -54,13 +54,6 @@ struct Lisp_Native_Comp_Unit bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; -#ifdef WINDOWSNT - /* We need to store a copy of the original file name in memory that - is not subject to GC because the function to dispose native - compilation units is called by the GC. By that time the `file' - string may have been sweeped. */ - char *cfile; -#endif } GCALIGNED_STRUCT; #ifdef HAVE_NATIVE_COMP @@ -92,14 +85,7 @@ extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition); -extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, - bool delay); - -extern void finish_delayed_disposal_of_comp_units (void); - -extern void dispose_all_remaining_comp_units (void); - -extern void clean_package_user_dir_of_old_comp_units (void); +extern void eln_load_path_final_clean_up (void); extern void fixup_eln_load_path (Lisp_Object directory); @@ -112,24 +98,6 @@ maybe_defer_native_compilation (Lisp_Object function_name, extern void syms_of_comp (void); -static inline void -dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle, bool delay) -{ - eassert (false); -} - -static inline void -dispose_all_remaining_comp_units (void) -{} - -static inline void -clean_package_user_dir_of_old_comp_units (void) -{} - -static inline void -finish_delayed_disposal_of_comp_units (void) -{} - #endif /* #ifdef HAVE_NATIVE_COMP */ #endif /* #ifndef COMP_H */ diff --git a/src/emacs.c b/src/emacs.c index 8e52da75926..07e40fdc8bd 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2407,10 +2407,8 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } -#if defined (HAVE_NATIVE_COMP) && defined (WINDOWSNT) - finish_delayed_disposal_of_comp_units (); - dispose_all_remaining_comp_units (); - clean_package_user_dir_of_old_comp_units (); +#ifdef HAVE_NATIVE_COMP + eln_load_path_final_clean_up (); #endif if (FIXNUMP (arg)) diff --git a/src/pdumper.c b/src/pdumper.c index 9c615a9a1a7..da5e7a17363 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5275,9 +5275,6 @@ dump_do_dump_relocation (const uintptr_t dump_base, concat2 (Vinvocation_directory, installation_state == INSTALLED ? XCAR (comp_u->file) : XCDR (comp_u->file)); -#ifdef WINDOWSNT - comp_u->cfile = xlispstrdup (comp_u->file); -#endif comp_u->handle = dynlib_open (SSDATA (comp_u->file)); if (!comp_u->handle) error ("%s", dynlib_error ()); -- 2.39.5