diff options
| author | Andrea Corallo | 2020-10-12 22:11:06 +0200 |
|---|---|---|
| committer | Andrea Corallo | 2020-10-14 11:04:36 +0200 |
| commit | 8861ee8b087b4e5d9ac9186a2c2d8e44b07fc186 (patch) | |
| tree | cdee0aeb80bbbc7454bbe6475a743bfd12ee9ae8 | |
| parent | 4bea0c0b1d907d676cc9abc8d7048103c10b8d79 (diff) | |
| download | emacs-8861ee8b087b4e5d9ac9186a2c2d8e44b07fc186.tar.gz emacs-8861ee8b087b4e5d9ac9186a2c2d8e44b07fc186.zip | |
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.
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 47 | ||||
| -rw-r--r-- | src/comp.c | 11 | ||||
| -rw-r--r-- | 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." | |||
| 1480 | (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) | 1480 | (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) |
| 1481 | (args (comp-prepare-args-for-top-level f))) | 1481 | (args (comp-prepare-args-for-top-level f))) |
| 1482 | (cl-assert (and name f)) | 1482 | (cl-assert (and name f)) |
| 1483 | (comp-emit (comp-call (if for-late-load | 1483 | (comp-emit |
| 1484 | 'comp--late-register-subr | 1484 | `(set ,(make-comp-mvar :slot 1) |
| 1485 | 'comp--register-subr) | 1485 | ,(comp-call (if for-late-load |
| 1486 | (make-comp-mvar :constant name) | 1486 | 'comp--late-register-subr |
| 1487 | (car args) | 1487 | 'comp--register-subr) |
| 1488 | (cdr args) | 1488 | (make-comp-mvar :constant name) |
| 1489 | (make-comp-mvar :constant c-name) | 1489 | (car args) |
| 1490 | (make-comp-mvar | 1490 | (cdr args) |
| 1491 | :constant | 1491 | (make-comp-mvar :constant c-name) |
| 1492 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) | 1492 | (make-comp-mvar |
| 1493 | (i (hash-table-count h))) | 1493 | :constant |
| 1494 | (puthash i (comp-func-doc f) h) | 1494 | (let* ((h (comp-ctxt-function-docs comp-ctxt)) |
| 1495 | i)) | 1495 | (i (hash-table-count h))) |
| 1496 | (make-comp-mvar :constant | 1496 | (puthash i (comp-func-doc f) h) |
| 1497 | (comp-func-int-spec f)) | 1497 | i)) |
| 1498 | ;; This is the compilation unit it-self passed as | 1498 | (make-comp-mvar :constant |
| 1499 | ;; parameter. | 1499 | (comp-func-int-spec f)) |
| 1500 | (make-comp-mvar :slot 0))))) | 1500 | ;; This is the compilation unit it-self passed as |
| 1501 | ;; parameter. | ||
| 1502 | (make-comp-mvar :slot 0)))))) | ||
| 1501 | 1503 | ||
| 1502 | (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) | 1504 | (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) |
| 1503 | for-late-load) | 1505 | for-late-load) |
| @@ -1558,7 +1560,12 @@ into the C code forwarding the compilation unit." | |||
| 1558 | "late_top_level_run" | 1560 | "late_top_level_run" |
| 1559 | "top_level_run") | 1561 | "top_level_run") |
| 1560 | :args (make-comp-args :min 1 :max 1) | 1562 | :args (make-comp-args :min 1 :max 1) |
| 1561 | :frame-size 1 | 1563 | ;; Frame is 2 wide: Slot 0 is the |
| 1564 | ;; compilation unit being loaded | ||
| 1565 | ;; (incoming parameter). Slot 1 is | ||
| 1566 | ;; the last function being | ||
| 1567 | ;; registered. | ||
| 1568 | :frame-size 2 | ||
| 1562 | :speed comp-speed)) | 1569 | :speed comp-speed)) |
| 1563 | (comp-func func) | 1570 | (comp-func func) |
| 1564 | (comp-pass (make-comp-limplify | 1571 | (comp-pass (make-comp-limplify |
| @@ -1575,7 +1582,7 @@ into the C code forwarding the compilation unit." | |||
| 1575 | (comp-ctxt-byte-func-to-func-h comp-ctxt)) | 1582 | (comp-ctxt-byte-func-to-func-h comp-ctxt)) |
| 1576 | (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) | 1583 | (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) |
| 1577 | (comp-ctxt-top-level-forms comp-ctxt)) | 1584 | (comp-ctxt-top-level-forms comp-ctxt)) |
| 1578 | (comp-emit `(return ,(make-comp-mvar :constant t))) | 1585 | (comp-emit `(return ,(make-comp-mvar :slot 1))) |
| 1579 | (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) | 1586 | (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) |
| 1580 | (comp-limplify-finalize-function func))) | 1587 | (comp-limplify-finalize-function func))) |
| 1581 | 1588 | ||
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) | |||
| 4768 | XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; | 4768 | XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; |
| 4769 | } | 4769 | } |
| 4770 | 4770 | ||
| 4771 | void | 4771 | Lisp_Object |
| 4772 | load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, | 4772 | load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, |
| 4773 | bool late_load) | 4773 | bool late_load) |
| 4774 | { | 4774 | { |
| 4775 | Lisp_Object res = Qnil; | ||
| 4775 | dynlib_handle_ptr handle = comp_u->handle; | 4776 | dynlib_handle_ptr handle = comp_u->handle; |
| 4776 | Lisp_Object comp_u_lisp_obj; | 4777 | Lisp_Object comp_u_lisp_obj; |
| 4777 | XSETNATIVE_COMP_UNIT (comp_u_lisp_obj, comp_u); | 4778 | 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, | |||
| 4897 | } | 4898 | } |
| 4898 | /* Executing this will perform all the expected environment | 4899 | /* Executing this will perform all the expected environment |
| 4899 | modifications. */ | 4900 | modifications. */ |
| 4900 | top_level_run (comp_u_lisp_obj); | 4901 | res = top_level_run (comp_u_lisp_obj); |
| 4901 | /* Make sure data_ephemeral_vec still exists after top_level_run has run. | 4902 | /* Make sure data_ephemeral_vec still exists after top_level_run has run. |
| 4902 | Guard against sibling call optimization (or any other). */ | 4903 | Guard against sibling call optimization (or any other). */ |
| 4903 | data_ephemeral_vec = data_ephemeral_vec; | 4904 | data_ephemeral_vec = data_ephemeral_vec; |
| @@ -4910,7 +4911,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, | |||
| 4910 | 4911 | ||
| 4911 | register_native_comp_unit (comp_u_lisp_obj); | 4912 | register_native_comp_unit (comp_u_lisp_obj); |
| 4912 | 4913 | ||
| 4913 | return; | 4914 | return res; |
| 4914 | } | 4915 | } |
| 4915 | 4916 | ||
| 4916 | Lisp_Object | 4917 | Lisp_Object |
| @@ -5090,9 +5091,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, | |||
| 5090 | comp_u->data_vec = Qnil; | 5091 | comp_u->data_vec = Qnil; |
| 5091 | comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); | 5092 | comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); |
| 5092 | comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); | 5093 | comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); |
| 5093 | load_comp_unit (comp_u, false, !NILP (late_load)); | 5094 | return load_comp_unit (comp_u, false, !NILP (late_load)); |
| 5094 | |||
| 5095 | return Qt; | ||
| 5096 | } | 5095 | } |
| 5097 | 5096 | ||
| 5098 | #endif /* HAVE_NATIVE_COMP */ | 5097 | #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) | |||
| 75 | 75 | ||
| 76 | extern void hash_native_abi (void); | 76 | extern void hash_native_abi (void); |
| 77 | 77 | ||
| 78 | extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, | 78 | extern Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, |
| 79 | bool loading_dump, bool late_load); | 79 | bool loading_dump, bool late_load); |
| 80 | 80 | ||
| 81 | extern Lisp_Object native_function_doc (Lisp_Object function); | 81 | extern Lisp_Object native_function_doc (Lisp_Object function); |
| 82 | 82 | ||