From f8b07ff4f318d799a471c9363903e3929fd5c844 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 23 Mar 2020 15:57:48 +0000 Subject: [PATCH] Guard against function redefinition during deferred load --- lisp/emacs-lisp/comp.el | 10 ++++++++-- src/comp.c | 39 +++++++++++++++++++++++++++++++-------- 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 273b41f5427..c6f2ca13aab 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1160,12 +1160,15 @@ the annotation emission." (cl-defgeneric comp-emit-for-top-level (form for-late-load) "Emit the limple code for top level FORM.") -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function) _) +(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function) + for-late-load) (let* ((name (byte-to-native-function-name form)) (f (gethash name (comp-ctxt-funcs-h comp-ctxt))) (args (comp-func-args f))) (cl-assert (and name f)) - (comp-emit (comp-call 'comp--register-subr + (comp-emit (comp-call (if for-late-load + 'comp--late-register-subr + 'comp--register-subr) (make-comp-mvar :constant name) (make-comp-mvar :constant (comp-args-base-min args)) (make-comp-mvar :constant (if (comp-args-p args) @@ -2186,6 +2189,9 @@ display a message." (save-excursion (goto-char (point-max)) (insert msg "\n"))) + ;; `comp-deferred-pending-h' should be empty at this stage. + ;; Reset it anyway. + (setf comp-deferred-pending-h (make-hash-table :equal #'eq)) (message msg)))) diff --git a/src/comp.c b/src/comp.c index b563f27da8f..3205a29a104 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3401,14 +3401,16 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object src = concat2 (CALL1I (file-name-sans-extension, Vload_file_name), build_pure_c_string (".el")); - if (!NILP (Ffile_exists_p (src))) - { - comp_deferred_compilation = false; - Frequire (intern_c_string ("comp"), Qnil, Qnil); - comp_deferred_compilation = true; - CALLN (Ffuncall, intern_c_string ("native-compile-async"), src, Qnil, - Qlate); - } + if (NILP (Ffile_exists_p (src))) + return; + + /* Really happening. */ + Fputhash (function_name, definition, Vcomp_deferred_pending_h); + comp_deferred_compilation = false; + Frequire (intern_c_string ("comp"), Qnil, Qnil); + comp_deferred_compilation = true; + CALLN (Ffuncall, intern_c_string ("native-compile-async"), src, Qnil, + Qlate); } @@ -3584,6 +3586,21 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, return Qnil; } +DEFUN ("comp--late-register-subr", Fcomp__late_register_subr, + Scomp__late_register_subr, 7, 7, 0, + doc: /* This gets called by late_top_level_run during load + phase to register each exported subr. */) + (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, + Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec, + Lisp_Object comp_u) +{ + if (!NILP (Fequal (Fsymbol_function (name), + Fgethash (name, Vcomp_deferred_pending_h, Qnil)))) + Fcomp__register_subr (name, minarg, maxarg, c_name, doc, intspec, comp_u); + Fremhash (name, Vcomp_deferred_pending_h); + return Qnil; +} + /* Load related routines. */ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, doc: /* Load native elisp code FILE. @@ -3714,6 +3731,7 @@ syms_of_comp (void) defsubr (&Scomp__release_ctxt); defsubr (&Scomp__compile_ctxt_to_file); defsubr (&Scomp__register_subr); + defsubr (&Scomp__late_register_subr); defsubr (&Snative_elisp_load); staticpro (&comp.exported_funcs_h); @@ -3742,6 +3760,11 @@ syms_of_comp (void) DEFVAR_LISP ("comp-native-path-postfix", Vcomp_native_path_postfix, doc: /* Postifix to be added to the .eln compilation path. */); Vcomp_native_path_postfix = Qnil; + + DEFVAR_LISP ("comp-deferred-pending-h", Vcomp_deferred_pending_h, + doc: /* Hash table symbol-name -> function-value. For + internal use during */); + Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq); } #endif /* HAVE_NATIVE_COMP */ -- 2.39.5