From: Andrea Corallo Date: Sun, 15 Dec 2019 14:31:03 +0000 (+0100) Subject: clean-up old function relocation code X-Git-Tag: emacs-28.0.90~2727^2~916 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ac08a7f26c53d65df7d9c2a5d76300a6a1a8106b;p=emacs.git clean-up old function relocation code --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0f0a90c82fb..7c4cfc95bff 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -153,11 +153,7 @@ This is to build the prev field.") (data-relocs-l () :type list :documentation "Constant objects used by functions.") (data-relocs-idx (make-hash-table :test #'equal) :type hash-table - :documentation "Obj -> position into data-relocs.") - (func-relocs-l () :type list - :documentation "Native functions imported.") - (func-relocs-idx (make-hash-table :test #'equal) :type hash-table - :documentation "Obj -> position into func-relocs.")) + :documentation "Obj -> position into data-relocs.")) (cl-defstruct comp-args-base (min nil :type number @@ -309,15 +305,6 @@ The corresponding index is returned." (push obj (comp-ctxt-data-relocs-l comp-ctxt)) (puthash obj (hash-table-count data-relocs-idx) data-relocs-idx)))) -(defun comp-add-subr-to-relocs (subr-name) - "Keep track of SUBR-NAME into the ctxt relocations. -The corresponding index is returned." - (let ((func-relocs-idx (comp-ctxt-func-relocs-idx comp-ctxt))) - (if-let ((idx (gethash subr-name func-relocs-idx))) - idx - (push subr-name (comp-ctxt-func-relocs-l comp-ctxt)) - (puthash subr-name (hash-table-count func-relocs-idx) func-relocs-idx)))) - (defmacro comp-within-log-buff (&rest body) "Execute BODY while at the end the log-buffer. BODY is evaluate only if `comp-verbose' is > 0." @@ -569,16 +556,14 @@ The basic block is returned regardless it was already declared or not." (car (push (make--comp-block lap-addr sp (comp-new-block-sym)) (comp-limplify-pending-blocks comp-pass)))))) -(defun comp-call (func &rest args) +(defsubst comp-call (func &rest args) "Emit a call for function FUNC with ARGS." - (comp-add-subr-to-relocs func) `(call ,func ,@args)) (defun comp-callref (func nargs stack-off) "Emit a call using narg abi for FUNC. NARGS is the number of arguments. STACK-OFF is the index of the first slot frame involved." - (comp-add-subr-to-relocs func) `(callref ,func ,@(cl-loop repeat nargs for sp from stack-off collect (comp-slot-n sp)))) @@ -1644,7 +1629,6 @@ Return t if something was changed." (args (if (eq call-type 'callref) args (fill-args args maxarg)))) - (comp-add-subr-to-relocs callee) `(,call-type ,callee ,@(clean-args-ref args)))) ;; Intra compilation unit procedure call optimization. ;; Attention speed 3 triggers that for non self calls too!! diff --git a/src/comp.c b/src/comp.c index a233187ccdf..ea37b89f847 100644 --- a/src/comp.c +++ b/src/comp.c @@ -38,9 +38,8 @@ along with GNU Emacs. If not, see . */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" -#define IMPORTED_FUNC_RELOC_SYM "f_reloc" +#define IMPORTED_FUNC_LINK_TABLE "freloc_link_table" #define TEXT_DATA_RELOC_SYM "text_data_reloc" -#define TEXT_IMPORTED_FUNC_RELOC_SYM "text_imported_funcs" #define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed)) #define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug)) @@ -232,21 +231,6 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } -/* Try to return the original subr from `symbol' even if this was advised. */ -static Lisp_Object -symbol_subr (Lisp_Object symbol) -{ - Lisp_Object maybe_subr = Fsymbol_function (symbol); - - if (SUBRP (maybe_subr)) - return maybe_subr; - - if (!NILP (CALL1I (advice--p, maybe_subr))) - maybe_subr = CALL1I (ad-get-orig-definition, symbol); - - return SUBRP (maybe_subr) ? maybe_subr : Qnil; -} - static gcc_jit_field * type_to_cast_field (gcc_jit_type *type) { @@ -430,9 +414,11 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs, else { gcc_jit_lvalue *f_ptr = - gcc_jit_lvalue_access_field (comp.func_relocs, - NULL, - (gcc_jit_field *) xmint_pointer (func)); + gcc_jit_rvalue_dereference_field ( + gcc_jit_lvalue_as_rvalue (comp.func_relocs), + NULL, + (gcc_jit_field *) xmint_pointer (func)); + if (!f_ptr) xsignal2 (Qnative_ice, build_string ("missing function relocation"), @@ -1726,15 +1712,8 @@ declare_runtime_imported_data (void) static Lisp_Object declare_runtime_imported_funcs (void) { - /* For subr imported by the runtime we rely on the standard mechanism in place - for functions imported by lisp code. */ - CALL1I (comp-add-subr-to-relocs, intern_c_string ("1+")); - CALL1I (comp-add-subr-to-relocs, intern_c_string ("1-")); - CALL1I (comp-add-subr-to-relocs, Qplus); - CALL1I (comp-add-subr-to-relocs, Qminus); - CALL1I (comp-add-subr-to-relocs, Qlist); - Lisp_Object field_list = Qnil; + #define ADD_IMPORTED(f_name, ret_type, nargs, args) \ { \ Lisp_Object name = intern_c_string (STR (f_name)); \ @@ -1864,8 +1843,8 @@ emit_ctxt_code (void) comp.ctxt, NULL, GCC_JIT_GLOBAL_EXPORTED, - gcc_jit_struct_as_type (f_reloc_struct), - IMPORTED_FUNC_RELOC_SYM); + gcc_jit_type_get_pointer (gcc_jit_struct_as_type (f_reloc_struct)), + IMPORTED_FUNC_LINK_TABLE); } @@ -3248,13 +3227,13 @@ load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object (**f_relocs)(void) = dynlib_sym (handle, IMPORTED_FUNC_RELOC_SYM); + void **freloc_link_table = dynlib_sym (handle, IMPORTED_FUNC_LINK_TABLE); void (*top_level_run)(void) = dynlib_sym (handle, "top_level_run"); if (!(current_thread_reloc && pure_reloc && data_relocs - && f_relocs + && freloc_link_table && top_level_run)) xsignal1 (Qnative_lisp_file_inconsistent, file); @@ -3272,51 +3251,7 @@ load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) } /* Imported functions. */ - Lisp_Object f_vec = - load_static_obj (handle, TEXT_IMPORTED_FUNC_RELOC_SYM); - EMACS_INT f_vec_len = XFIXNUM (Flength (f_vec)); - for (EMACS_INT i = 0; i < f_vec_len; i++) - { - Lisp_Object f_sym = AREF (f_vec, i); - char *f_str = SSDATA (SYMBOL_NAME (f_sym)); - Lisp_Object subr = Fsymbol_function (f_sym); - if (!NILP (subr)) - { - subr = symbol_subr (f_sym); - if (NILP (subr)) - /* FIXME: This is not robust in case of primitive - redefinition. */ - xsignal2 (Qnative_lisp_wrong_reloc, f_sym, file); - - f_relocs[i] = XSUBR (subr)->function.a0; - } - else if (!strcmp (f_str, "wrong_type_argument")) - f_relocs[i] = (void *) wrong_type_argument; - else if (!strcmp (f_str, "helper_PSEUDOVECTOR_TYPEP_XUNTAG")) - f_relocs[i] = (void *) helper_PSEUDOVECTOR_TYPEP_XUNTAG; - else if (!strcmp (f_str, "pure_write_error")) - f_relocs[i] = (void *) pure_write_error; - else if (!strcmp (f_str, "push_handler")) - f_relocs[i] = (void *) push_handler; - else if (!strcmp (f_str, STR (SETJMP_NAME))) - f_relocs[i] = (void *) SETJMP; - else if (!strcmp (f_str, "record_unwind_protect_excursion")) - f_relocs[i] = (void *) record_unwind_protect_excursion; - else if (!strcmp (f_str, "helper_unbind_n")) - f_relocs[i] = (void *) helper_unbind_n; - else if (!strcmp (f_str, "helper_save_restriction")) - f_relocs[i] = (void *) helper_save_restriction; - else if (!strcmp (f_str, "record_unwind_current_buffer")) - f_relocs[i] = (void *) record_unwind_current_buffer; - else if (!strcmp (f_str, "set_internal")) - f_relocs[i] = (void *) set_internal; - else if (!strcmp (f_str, "helper_unwind_protect")) - f_relocs[i] = (void *) helper_unwind_protect; - else if (!strcmp (f_str, "specbind")) - f_relocs[i] = (void *) specbind; - else - xsignal2 (Qnative_lisp_wrong_reloc, f_sym, file); - } + *freloc_link_table = freloc.link_table; /* Executing this will perform all the expected environment modification. */ top_level_run ();