From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Andrea Corallo Newsgroups: gmane.emacs.bugs Subject: bug#41242: Port feature/native-comp to Windows - Improve handling of native compilation... Date: Sat, 23 May 2020 22:58:50 +0000 Message-ID: References: Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="101192"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) Cc: 41242@debbugs.gnu.org To: Nicolas =?UTF-8?Q?B=C3=A9rtolo?= Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun May 24 00:59:11 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jcd6k-000QEH-Nd for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 24 May 2020 00:59:10 +0200 Original-Received: from localhost ([::1]:41406 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jcd6j-0002i2-Pc for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 23 May 2020 18:59:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:43894) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jcd6c-0002hM-PO for bug-gnu-emacs@gnu.org; Sat, 23 May 2020 18:59:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:52704) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jcd6c-0005QB-GF for bug-gnu-emacs@gnu.org; Sat, 23 May 2020 18:59:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jcd6c-0008Cx-G0 for bug-gnu-emacs@gnu.org; Sat, 23 May 2020 18:59:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Andrea Corallo Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 23 May 2020 22:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41242 X-GNU-PR-Package: emacs Original-Received: via spool by 41242-submit@debbugs.gnu.org id=B41242.159027473531539 (code B ref 41242); Sat, 23 May 2020 22:59:02 +0000 Original-Received: (at 41242) by debbugs.gnu.org; 23 May 2020 22:58:55 +0000 Original-Received: from localhost ([127.0.0.1]:36017 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jcd6U-0008Cc-KL for submit@debbugs.gnu.org; Sat, 23 May 2020 18:58:55 -0400 Original-Received: from mx.sdf.org ([205.166.94.20]:64192) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jcd6S-0008CT-2g for 41242@debbugs.gnu.org; Sat, 23 May 2020 18:58:53 -0400 Original-Received: from sdf.org (ma.sdf.org [205.166.94.33]) by mx.sdf.org (8.15.2/8.14.5) with ESMTPS id 04NMwo23019830 (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256 bits) verified NO); Sat, 23 May 2020 22:58:51 GMT Original-Received: (from akrl@localhost) by sdf.org (8.15.2/8.12.8/Submit) id 04NMwo67004327; Sat, 23 May 2020 22:58:50 GMT In-Reply-To: ("Nicolas =?UTF-8?Q?B=C3=A9rtolo?="'s message of "Wed, 13 May 2020 16:26:57 -0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:180863 Archived-At: 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