|
| From: | Nicolas Bértolo |
| Subject: | bug#41242: Port feature/native-comp to Windows - Improve handling of native compilation... |
| Date: | Sat, 23 May 2020 20:43:06 -0300 |
Hi Nicolas,
following some comments on - Improve handling of native compilation
etc.
Please review all the GNU code-style of this diff. I've annotated some
to be fixed but there are quite a number more of fixes of the same kind
to be done.
> 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.
Please annotate in the changelog the new functions ex:
finish_delayed_disposal_of_comp_units, dispose_all_remaining_comp_units,
register_native_comp_unit are missing.
> * 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.
> diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
> index 012baf2560..1fb4cd98c0 100644
> --- a/lisp/emacs-lisp/comp.el
> +++ b/lisp/emacs-lisp/comp.el
> @@ -2183,6 +2183,31 @@ comp-hint-cons
>
> ;; 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)
Isn't better to just add .old? So we will have cases of foo.eln.old.old
instead of foo.eln.old.eln.old ?
> + 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 95659840ad..c1c54b3c9a 100644
> --- a/lisp/emacs-lisp/package.el
> +++ b/lisp/emacs-lisp/package.el
> @@ -2184,6 +2184,31 @@ 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'."
80 column lines limit. I think also this should be transparent when
native-comp-available-p say native comp is not available (for now
compiler and load machinery are bundled).
> + (cond ((eq 'windows-nt system-type)
> + (let ((retry t))
> + (while retry
> + (setf retry nil)
> + (condition-case err
> + (delete-directory dir t)
> + (file-error
> + (if (and (string= "Removing old name" (cadr err))
> + (string= "Permission denied" (caddr err))
> + (or (string-suffix-p ".eln" (cadddr err))
> + (string-suffix-p ".eln.old" (cadddr err))))
I think would be good to destructure err using something like
cl-destructuring-bind or pcase or even just using a let + some naming to
make this more readable.
> + (progn
> + (rename-file (cadddr err)
> + (make-temp-file-internal
> + (concat package-user-dir
> + (file-name-base (cadddr err)))
> + 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.
>
> @@ -2236,7 +2261,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
> diff --git a/src/alloc.c b/src/alloc.c
> index d6ba4d9790..420168ec4d 100644
> --- a/src/alloc.c
> +++ b/src/alloc.c
> @@ -3119,8 +3119,7 @@ cleanup_vector (struct Lisp_Vector *vector)
> {
> struct Lisp_Native_Comp_Unit *cu =
> PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
> - eassert (cu->handle);
> - dynlib_close (cu->handle);
> + dispose_comp_unit (cu, true);
> }
> }
>
> @@ -6117,6 +6116,8 @@ garbage_collect (void)
> if (tot_after < tot_before)
> malloc_probe (min (tot_before - tot_after, SIZE_MAX));
> }
> +
> + finish_delayed_disposal_of_comp_units ();
Could you describe why we need to call this each garbage collection?
Isn't sufficient to do it when emacs is exiting?
> }
>
> DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
> diff --git a/src/comp.c b/src/comp.c
> index dd45599cc4..77c3006c56 100644
> --- a/src/comp.c
> +++ b/src/comp.c
> @@ -413,6 +413,10 @@ load_gccjit_if_necessary (bool mandatory)
> #define CALL1I(fun, arg) \
> CALLN (Ffuncall, intern_c_string (STR (fun)), arg)
>
> +/* Like call2 but stringify and intern. */
> +#define CALL2I(fun, arg1, arg2) \
> + CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2)
> +
> #define DECL_BLOCK(name, func) \
> gcc_jit_block *(name) = \
> gcc_jit_function_new_block ((func), STR (name))
> @@ -3828,6 +3832,14 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
> return Qt;
> }
>
> +sigset_t oldset;
I think we have all static data at the top.
That said this is unclear to me because in comp--compile-ctxt-to-file
oldset is automatic and shadows this static, so I think we'll save in
the the automatic and later we just restore the (always zeroed) static
one.
> +static void restore_sigmask(void)
^^^
space
> +{
> + pthread_sigmask (SIG_SETMASK, &oldset, 0);
> + unblock_input ();
> +}
> +
> DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
> Scomp__compile_ctxt_to_file,
> 1, 1, 0,
> @@ -3849,6 +3861,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
> CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt));
>
> sigset_t oldset;
> + ptrdiff_t count;
> +
> if (!noninteractive)
> {
> sigset_t blocked;
> @@ -3861,6 +3875,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
> sigaddset (&blocked, SIGIO);
> #endif
> pthread_sigmask (SIG_BLOCK, &blocked, &oldset);
> + count = SPECPDL_INDEX ();
> + record_unwind_protect_void(restore_sigmask);
^^^
space
> }
> emit_ctxt_code ();
>
> @@ -3899,18 +3915,10 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
> GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY,
> SSDATA (tmp_file));
>
> - /* 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. */
> - if (!NILP (Ffile_exists_p (out_file)))
> - Fdelete_file (out_file, Qnil);
> - Frename_file (tmp_file, out_file, Qnil);
> + CALL2I(comp--replace-output-file, out_file, tmp_file);
^^^
space
>
> if (!noninteractive)
> - {
> - pthread_sigmask (SIG_SETMASK, &oldset, 0);
> - unblock_input ();
> - }
> + unbind_to(count, Qnil);
>
> return out_file;
> }
> @@ -3972,6 +3980,138 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code)
> }
>
>
> +/*********************************/
> +/* Disposal of compilation units */
> +/*********************************/
> +
> +#ifdef WINDOWSNT
> +#define OLD_ELN_SUFFIX_REGEXP build_string("\\.eln\\.old$")
I think instead of $ \\' is more correct.
> +static Lisp_Object all_loaded_comp_units;
All hash table in this files are postfixed as _h
> +struct delayed_comp_unit_disposal
> +{
> + struct delayed_comp_unit_disposal * next;
^^^
no space here
> + char * filename;
^^
likewise
> +};
Why an ad-hoc C structure and not a simple cons? I think it would be
simpler and safer to use just a lisp list here. Is it because we need
to add during GC? If yes, comment :)
> +struct delayed_comp_unit_disposal * delayed_comp_unit_disposal_list;
^^
likewise and the followings
> +
> +static Lisp_Object
> +returnQnil (Lisp_Object arg)
No camel case in function names.
> +{
> + return Qnil;
> +}
I think each of the following functions really needs a comment line to
explain the scope of each of them + one preamble comment to explain all
the rename mechanism how is expected to work and the two datastructures
involved.
> +static void
> +clean_comp_unit_directory (Lisp_Object filepath)
> +{
> + if (NILP (filepath))
> + return;
> + Lisp_Object files_in_dir;
> + files_in_dir = internal_condition_case_4(Fdirectory_files, filepath, Qt,
> + OLD_ELN_SUFFIX_REGEXP, Qnil, Qt, returnQnil);
80 columns
> + FOR_EACH_TAIL(files_in_dir)
> + {
> + DeleteFile (SSDATA (XCAR (files_in_dir)));
> + }
> +}
> +
> +void clean_package_user_dir_of_old_comp_units (void)
^^^
new lines
> +{
> + 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);
> +}
> +
> +#endif
> +
> +void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle, bool delay)
^^^
likewise
> +{
> + 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,
> + returnQnil);
> + if (!NILP(dirname))
> + clean_comp_unit_directory (dirname);
I think we need to comment here why when we dispose the compilation unit
we try to clean the full directory.
> + 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;
> + }
> +#else
> + xfree (comp_handle->file);
> +#endif
> +}
Also, wasn't the plan to try to delete the file and in case of failure
to put it in a list? Here when delay is true this goes directly in the
list. Could you explain why and add comment?
> +static void
> +register_native_comp_unit (Lisp_Object comp_u)
> +{
> +#ifdef WINDOWSNT
> + static EMACS_UINT count;
> +
> + if (XFIXNUM(Fhash_table_count(all_loaded_comp_units)) >= MOST_POSITIVE_FIXNUM)
> + return;
> +
> + while (!NILP(Fgethash(make_fixnum(count), all_loaded_comp_units, Qnil)))
> + count = (count + 1) % MOST_POSITIVE_FIXNUM;
Given you are doing all of this just to get a key (we'll not use) I
think would be wise to just create the key using gensym.
> + Fputhash(make_fixnum(count), comp_u, all_loaded_comp_units);
> +#endif
> +}
>
> +void dispose_all_remaining_comp_units (void)
> +{
> +#ifdef WINDOWSNT
> + struct Lisp_Hash_Table *h = XHASH_TABLE (all_loaded_comp_units);
> +
> + 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);
> + }
> + }
> +#endif
> +}
> +
> +void finish_delayed_disposal_of_comp_units (void)
> +{
> +#ifdef WINDOWSNT
> + for (struct delayed_comp_unit_disposal * item = delayed_comp_unit_disposal_list;
> + delayed_comp_unit_disposal_list;
> + item = delayed_comp_unit_disposal_list)
> + {
> + delayed_comp_unit_disposal_list = item->next;
> + Lisp_Object dirname
> + = internal_condition_case_1 (Ffile_name_directory,
> + build_string (item->filename), Qt,
> + returnQnil);
> + clean_comp_unit_directory (dirname);
> + xfree(item->filename);
> + xfree(item);
> + }
> +#endif
> +}
> +
> +
> /***********************************/
> /* Deferred compilation mechanism. */
> /***********************************/
> @@ -4192,6 +4332,12 @@ 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)
> @@ -4349,6 +4495,9 @@ 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 = CALLN (Fmake_hash_table, QCtest, Qeq);
> comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal);
> @@ -4497,6 +4646,11 @@ syms_of_comp (void)
> staticpro (&delayed_sources);
> delayed_sources = Qnil;
>
> +#ifdef WINDOWSNT
> + staticpro (&all_loaded_comp_units);
> + all_loaded_comp_units = CALLN(Fmake_hash_table, QCweakness, Qvalue);
> +#endif
> +
> DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt,
> doc: /* The compiler context. */);
> Vcomp_ctxt = Qnil;
> diff --git a/src/comp.h b/src/comp.h
> index 36e7cdf441..0b790fc7cb 100644
> --- a/src/comp.h
> +++ b/src/comp.h
> @@ -52,7 +52,15 @@ struct Lisp_Native_Comp_Unit
> /* STUFFS WE DO NOT DUMP!! */
> Lisp_Object *data_imp_relocs;
> bool loaded_once;
> +
> 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
> };
>
> #ifdef HAVE_NATIVE_COMP
> @@ -83,6 +91,14 @@ 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);
> #else
>
> static inline void
> @@ -92,6 +108,17 @@ 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)
Newline after ret type for this and the following definitions.
> +{
> + emacs_abort();
> +}
emacs_abort is still not declared here so it does not compile. Maybe we
can just put an eassert (false).
> +static inline void dispose_all_remaining_comp_units (void)
> +{}
> +
> +static inline void clean_package_user_dir_of_old_comp_units (void)
> +{}
> +
Thanks
Andrea
--
akrl@sdf.org
| [Prev in Thread] | Current Thread | [Next in Thread] |