diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/alloc.c | 3 | ||||
| -rw-r--r-- | src/comp.c | 260 | ||||
| -rw-r--r-- | src/comp.h | 34 | ||||
| -rw-r--r-- | src/emacs.c | 4 | ||||
| -rw-r--r-- | src/eval.c | 55 | ||||
| -rw-r--r-- | src/lisp.h | 2 | ||||
| -rw-r--r-- | src/pdumper.c | 3 |
7 files changed, 349 insertions, 12 deletions
diff --git a/src/alloc.c b/src/alloc.c index 76d49d2efd6..b892022125e 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); } } diff --git a/src/comp.c b/src/comp.c index 68ad6d3eb8d..16ad77c74bc 100644 --- a/src/comp.c +++ b/src/comp.c @@ -411,6 +411,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)) @@ -435,6 +439,8 @@ typedef struct { ptrdiff_t size; } f_reloc_t; +sigset_t saved_sigset; + static f_reloc_t freloc; /* C side of the compiler context. */ @@ -3795,6 +3801,13 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt, return Qt; } +static void +restore_sigmask (void) +{ + pthread_sigmask (SIG_SETMASK, &saved_sigset, 0); + unblock_input (); +} + DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, Scomp__compile_ctxt_to_file, 1, 1, 0, @@ -3816,6 +3829,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 = 0; + if (!noninteractive) { sigset_t blocked; @@ -3828,6 +3843,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); } emit_ctxt_code (); @@ -3866,18 +3883,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); if (!noninteractive) - { - pthread_sigmask (SIG_SETMASK, &oldset, 0); - unblock_input (); - } + unbind_to (count, Qnil); return out_file; } @@ -3939,6 +3948,223 @@ 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\\'") + +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. + + * 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) +{ + 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. + * + * 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) + { + 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); + } +} +#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 + Fputhash (CALL1I (gensym, Qnil), 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 +} + + /***********************************/ /* Deferred compilation mechanism. */ /***********************************/ @@ -4159,6 +4385,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) @@ -4316,6 +4548,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); @@ -4464,6 +4699,11 @@ syms_of_comp (void) staticpro (&delayed_sources); delayed_sources = Qnil; +#ifdef WINDOWSNT + staticpro (&all_loaded_comp_units_h); + all_loaded_comp_units_h = 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 36e7cdf4413..b8e40ceb900 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,24 @@ 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) +{ + 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 #endif diff --git a/src/emacs.c b/src/emacs.c index 93a837a44ef..2a7a5257f15 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2398,6 +2398,10 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } + finish_delayed_disposal_of_comp_units (); + dispose_all_remaining_comp_units (); + clean_package_user_dir_of_old_comp_units (); + if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 ? XFIXNUM (arg) | INT_MIN diff --git a/src/eval.c b/src/eval.c index 37d466f69ed..9e86a185908 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1419,6 +1419,61 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), } } +/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as + its arguments. */ + +Lisp_Object +internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, + Lisp_Object), + Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object handlers, + Lisp_Object (*hfun) (Lisp_Object)) +{ + struct handler *c = push_handler (handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) + { + Lisp_Object val = handlerlist->val; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg1, arg2, arg3); + eassert (handlerlist == c); + handlerlist = c->next; + return val; + } +} + +/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as + its arguments. */ + +Lisp_Object +internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object), + Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg3, Lisp_Object arg4, + Lisp_Object handlers, + Lisp_Object (*hfun) (Lisp_Object)) +{ + struct handler *c = push_handler (handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) + { + Lisp_Object val = handlerlist->val; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg1, arg2, arg3, arg4); + eassert (handlerlist == c); + handlerlist = c->next; + return val; + } +} + /* Like internal_condition_case but call BFUN with NARGS as first, and ARGS as second argument. */ diff --git a/src/lisp.h b/src/lisp.h index 4c0057b2552..52242791aa5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4165,6 +4165,8 @@ extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_ extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); +extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); +extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); diff --git a/src/pdumper.c b/src/pdumper.c index a6d12b6ea0c..26480388d59 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5312,6 +5312,9 @@ dump_do_dump_relocation (const uintptr_t dump_base, concat2 (Vinvocation_directory, installation_state == LOCAL_BUILD ? XCDR (comp_u->file) : XCAR (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 ()); |