[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp a71f54e 1/4: Rework eln deletion strategy for new el
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp a71f54e 1/4: Rework eln deletion strategy for new eln-cache folder structure |
|
Date: |
Mon, 7 Sep 2020 12:23:25 -0400 (EDT) |
branch: feature/native-comp
commit a71f54eff80cb7d7b36326849eea878073963594
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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 84b5a8b..129a4de 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 c349b5d..c20659a 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 6701bf0..bde0a16 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 3a56f5f..68a0ead 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 9270f8b..5c7bed6 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 8e52da7..07e40fd 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 9c615a9..da5e7a1 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 ());