From: Andrea Corallo Date: Sun, 3 Nov 2019 14:27:57 +0000 (+0100) Subject: rework top level environment modification mechanism X-Git-Tag: emacs-28.0.90~2727^2~1040 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5c188552341204daf53f0ae2aa4e0c73ec4feb1e;p=emacs.git rework top level environment modification mechanism --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a56b22225a6..381d72e3dc3 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -118,8 +118,6 @@ Can be used by code that wants to expand differently in this case.") :documentation "Target output filename for the compilation.") (top-level-forms () :type list :documentation "List of spilled top level forms.") - (exp-funcs () :type list - :documentation "Exported functions list.") (funcs-h (make-hash-table) :type hash-table :documentation "lisp-func-name -> comp-func. This is to build the prev field.") @@ -1029,6 +1027,35 @@ the annotation emission." (comp-log-func func)) func) +(cl-defgeneric comp-emit-for-top-level (form) + "Emit the limple code for top level FORM.") + +(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function)) + (let* ((name (byte-to-native-function-name form)) + (f (gethash name (comp-ctxt-funcs-h comp-ctxt))) + (args (comp-func-args f)) + (c-name (comp-func-c-func-name f)) + (doc (comp-func-doc f))) + (cl-assert (and name f)) + (comp-emit (comp-call '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) + (comp-args-max args) + 'many)) + (make-comp-mvar :constant c-name) + (make-comp-mvar :constant doc))))) + +(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)) + (let* ((form (byte-to-native-top-level-form form)) + (func-name (car form)) + (args (cdr form))) + (if (eq 'unevalled (cdr (subr-arity (symbol-function func-name)))) + (comp-emit (comp-call func-name (make-comp-mvar :constant args))) + (comp-emit (apply #'comp-call func-name + (mapcar (lambda (x) (make-comp-mvar :constant x)) + args)))))) + (defun comp-limplify-top-level () "Create a limple function doing the business for top level forms. This will be called at load-time." @@ -1042,9 +1069,8 @@ This will be called at load-time." :frame (comp-new-frame 0)))) (comp-make-curr-block 'entry (comp-sp)) (comp-emit-annotation "Top level") - (cl-loop for args in (comp-ctxt-top-level-defvars comp-ctxt) - do (comp-emit (comp-call 'defvar (make-comp-mvar :constant args)))) - (comp-emit `(return ,(make-comp-mvar :constant nil))) + (mapc #'comp-emit-for-top-level (comp-ctxt-top-level-forms comp-ctxt)) + (comp-emit `(return ,(make-comp-mvar :constant t))) (comp-limplify-finalize-function func))) (defun comp-addr-to-bb-name (addr) @@ -1659,19 +1685,6 @@ These are substituted with normals 'set'." Prepare every function for final compilation and drive the C back-end." (cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt)) (hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt)))) - (setf (comp-ctxt-exp-funcs comp-ctxt) - (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt) - for f being each hash-value of h - for args = (comp-func-args f) - for doc = (when (> (length (comp-func-byte-func f)) 4) - (aref (comp-func-byte-func f) 4)) - collect (vector (comp-func-symbol-name f) - (comp-func-c-func-name f) - (cons (comp-args-base-min args) - (if (comp-args-p args) - (comp-args-max args) - 'many)) - doc))) (comp--compile-ctxt-to-file name)) (defun comp-final (_) diff --git a/src/comp.c b/src/comp.c index fed599dc511..ba56cc1ab19 100644 --- a/src/comp.c +++ b/src/comp.c @@ -41,7 +41,6 @@ along with GNU Emacs. If not, see . */ #define DATA_RELOC_SYM "d_reloc" #define IMPORTED_FUNC_RELOC_SYM "f_reloc" #define TEXT_DATA_RELOC_SYM "text_data_reloc" -#define TEXT_EXPORTED_FUNC_RELOC_SYM "text_exported_funcs" #define TEXT_IMPORTED_FUNC_RELOC_SYM "text_imported_funcs" #define STR_VALUE(s) #s @@ -1802,9 +1801,6 @@ emit_ctxt_code (void) gcc_jit_struct_as_type (f_reloc_struct), IMPORTED_FUNC_RELOC_SYM); - /* Exported functions info. */ - Lisp_Object func_list = FUNCALL1 (comp-ctxt-exp-funcs, Vcomp_ctxt); - emit_static_object (TEXT_EXPORTED_FUNC_RELOC_SYM, func_list); SAFE_FREE (); } @@ -3127,6 +3123,7 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) /**************************************/ static Lisp_Object Vnative_elisp_refs_hash; +dynlib_handle_ptr load_handle; static void prevent_gc (Lisp_Object obj) @@ -3150,9 +3147,9 @@ static int load_comp_unit (dynlib_handle_ptr handle) { /* Imported data. */ - Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); + Lisp_Object *data_relocs = dynlib_sym (load_handle, DATA_RELOC_SYM); - Lisp_Object d_vec = load_static_obj (handle, TEXT_DATA_RELOC_SYM); + Lisp_Object d_vec = load_static_obj (load_handle, TEXT_DATA_RELOC_SYM); EMACS_UINT d_vec_len = XFIXNUM (Flength (d_vec)); for (EMACS_UINT i = 0; i < d_vec_len; i++) @@ -3163,11 +3160,11 @@ load_comp_unit (dynlib_handle_ptr handle) /* Imported functions. */ Lisp_Object (**f_relocs)(void) = - dynlib_sym (handle, IMPORTED_FUNC_RELOC_SYM); + dynlib_sym (load_handle, IMPORTED_FUNC_RELOC_SYM); Lisp_Object f_vec = - load_static_obj (handle, TEXT_IMPORTED_FUNC_RELOC_SYM); + load_static_obj (load_handle, TEXT_IMPORTED_FUNC_RELOC_SYM); EMACS_UINT f_vec_len = XFIXNUM (Flength (f_vec)); - for (EMACS_UINT i = 0; i < f_vec_len; i++) + for (EMACS_UINT i = 0; i < f_vec_len; i++) { Lisp_Object f_sym = AREF (f_vec, i); char *f_str = SSDATA (SYMBOL_NAME (f_sym)); @@ -3215,53 +3212,52 @@ load_comp_unit (dynlib_handle_ptr handle) } } - /* Exported functions. */ - Lisp_Object func_list = load_static_obj (handle, TEXT_EXPORTED_FUNC_RELOC_SYM); - - while (func_list) - { - Lisp_Object el = XCAR (func_list); - Lisp_Object Qsym = AREF (el, 0); - char *c_func_name = SSDATA (AREF (el, 1)); - Lisp_Object args = AREF (el, 2); - ptrdiff_t minargs = XFIXNUM (XCAR (args)); - ptrdiff_t maxargs = FIXNUMP (XCDR (args)) ? XFIXNUM (XCDR (args)) : MANY; - /* char *doc = SSDATA (AREF (el, 3)); */ - void *func = dynlib_sym (handle, c_func_name); - eassert (func); - - union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr)); - x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS; - x->s.function.a0 = func; - x->s.min_args = minargs; - x->s.max_args = maxargs; - x->s.symbol_name = SSDATA (Fsymbol_name (Qsym)); - x->s.native_elisp = true; - defsubr(x); - - func_list = XCDR (func_list); - } - - /* Finally execute top level forms. */ - void (*top_level_run)(void) = dynlib_sym (handle, "top_level_run"); + /* Executing this will perform all the expected environment modification. */ + void (*top_level_run)(void) = dynlib_sym (load_handle, "top_level_run"); top_level_run (); return 0; } +DEFUN ("comp--register-subr", Fcomp__register_subr, + Scomp__register_subr, + 5, 5, 0, + doc: /* This gets called by 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) +{ + if (!load_handle) + error ("comp--register-subr can only be called during native code load phase."); + + void *func = dynlib_sym (load_handle, SSDATA (c_name)); + eassert (func); + + union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr)); + x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS; + x->s.function.a0 = func; + x->s.min_args = XFIXNUM (minarg); + x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; + x->s.symbol_name = SSDATA (Fsymbol_name (name)); + x->s.native_elisp = true; + defsubr(x); + + return Qnil; +} + /* Load related routines. */ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, doc: /* Load native elisp code FILE. */) (Lisp_Object file) { - dynlib_handle_ptr handle; - CHECK_STRING (file); - handle = dynlib_open (SSDATA (file)); - if (!handle) + load_handle = dynlib_open (SSDATA (file)); + if (!load_handle) xsignal2 (Qcomp_unit_open_failed, file, build_string (dynlib_error ())); - int r = load_comp_unit (handle); + int r = load_comp_unit (load_handle); + + load_handle = NULL; if (r != 0) xsignal2 (Qcomp_unit_init_failed, file, INT_TO_INTEGER (r)); @@ -3332,6 +3328,7 @@ syms_of_comp (void) defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Scomp__register_subr); defsubr (&Snative_elisp_load); staticpro (&comp.exported_funcs_h);