From 8861ee8b087b4e5d9ac9186a2c2d8e44b07fc186 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 12 Oct 2020 22:11:06 +0200 Subject: [PATCH] Have `native-elisp-load' return the last registerd function * lisp/emacs-lisp/comp.el (comp-emit-for-top-level): Synthesize 'top_level_run' so it returns the last value returned by `comp--register-subr'. * src/comp.c (load_comp_unit): Return what 'top_level_run' returns. (Fnative_elisp_load): Return what 'load_comp_unit' returns. * src/comp.h (load_comp_unit): Update signature. --- lisp/emacs-lisp/comp.el | 47 +++++++++++++++++++++++------------------ src/comp.c | 11 +++++----- src/comp.h | 4 ++-- 3 files changed, 34 insertions(+), 28 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 89b4230dc2c..98f552599e9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1480,24 +1480,26 @@ the annotation emission." (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) (args (comp-prepare-args-for-top-level f))) (cl-assert (and name f)) - (comp-emit (comp-call (if for-late-load - 'comp--late-register-subr - 'comp--register-subr) - (make-comp-mvar :constant name) - (car args) - (cdr args) - (make-comp-mvar :constant c-name) - (make-comp-mvar - :constant - (let* ((h (comp-ctxt-function-docs comp-ctxt)) - (i (hash-table-count h))) - (puthash i (comp-func-doc f) h) - i)) - (make-comp-mvar :constant - (comp-func-int-spec f)) - ;; This is the compilation unit it-self passed as - ;; parameter. - (make-comp-mvar :slot 0))))) + (comp-emit + `(set ,(make-comp-mvar :slot 1) + ,(comp-call (if for-late-load + 'comp--late-register-subr + 'comp--register-subr) + (make-comp-mvar :constant name) + (car args) + (cdr args) + (make-comp-mvar :constant c-name) + (make-comp-mvar + :constant + (let* ((h (comp-ctxt-function-docs comp-ctxt)) + (i (hash-table-count h))) + (puthash i (comp-func-doc f) h) + i)) + (make-comp-mvar :constant + (comp-func-int-spec f)) + ;; This is the compilation unit it-self passed as + ;; parameter. + (make-comp-mvar :slot 0)))))) (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) for-late-load) @@ -1558,7 +1560,12 @@ into the C code forwarding the compilation unit." "late_top_level_run" "top_level_run") :args (make-comp-args :min 1 :max 1) - :frame-size 1 + ;; Frame is 2 wide: Slot 0 is the + ;; compilation unit being loaded + ;; (incoming parameter). Slot 1 is + ;; the last function being + ;; registered. + :frame-size 2 :speed comp-speed)) (comp-func func) (comp-pass (make-comp-limplify @@ -1575,7 +1582,7 @@ into the C code forwarding the compilation unit." (comp-ctxt-byte-func-to-func-h comp-ctxt)) (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) - (comp-emit `(return ,(make-comp-mvar :constant t))) + (comp-emit `(return ,(make-comp-mvar :slot 1))) (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) (comp-limplify-finalize-function func))) diff --git a/src/comp.c b/src/comp.c index 0b5a49fd1f1..f80172e89bf 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4768,10 +4768,11 @@ unset_cu_load_ongoing (Lisp_Object comp_u) XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; } -void +Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load) { + Lisp_Object res = Qnil; dynlib_handle_ptr handle = comp_u->handle; Lisp_Object comp_u_lisp_obj; XSETNATIVE_COMP_UNIT (comp_u_lisp_obj, comp_u); @@ -4897,7 +4898,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, } /* Executing this will perform all the expected environment modifications. */ - top_level_run (comp_u_lisp_obj); + res = top_level_run (comp_u_lisp_obj); /* Make sure data_ephemeral_vec still exists after top_level_run has run. Guard against sibling call optimization (or any other). */ data_ephemeral_vec = data_ephemeral_vec; @@ -4910,7 +4911,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, register_native_comp_unit (comp_u_lisp_obj); - return; + return res; } Lisp_Object @@ -5090,9 +5091,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, 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); - load_comp_unit (comp_u, false, !NILP (late_load)); - - return Qt; + return load_comp_unit (comp_u, false, !NILP (late_load)); } #endif /* HAVE_NATIVE_COMP */ diff --git a/src/comp.h b/src/comp.h index 5c7bed6a304..077250ea869 100644 --- a/src/comp.h +++ b/src/comp.h @@ -75,8 +75,8 @@ XNATIVE_COMP_UNIT (Lisp_Object a) extern void hash_native_abi (void); -extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, - bool loading_dump, bool late_load); +extern Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, + bool loading_dump, bool late_load); extern Lisp_Object native_function_doc (Lisp_Object function); -- 2.39.5