From: Andrea Corallo Date: Sat, 6 Jun 2020 11:30:59 +0000 (+0200) Subject: Change 'direct-call' 'direct-callref' LIMPLE ops sematinc X-Git-Tag: emacs-28.0.90~2727^2~588 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e8ab017b6d45aea2514a49f974e649ad1f7297ad;p=emacs.git Change 'direct-call' 'direct-callref' LIMPLE ops sematinc Is cleaner to have the function c-name as first argument of 'direct-call' 'direct-callref'. This is preparatory to anonymous lambdas optimization. * lisp/emacs-lisp/comp.el (comp-propagate-insn): Use c-name when gathering the comp-func definition for direct calls. (comp-call-optim-form-call): Add put c-name as first argument of direct-call direct-callref when optimizing. * src/comp.c (emit_call): Update logic for having c-name as first arg of direct calls. (emit_call_ref): Rename 'subr_sym' into 'func'. --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 5116f887220..e776b664812 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1888,14 +1888,15 @@ Here goes everything that can be done not iteratively (read once). (pcase insn (`(set ,lval ,rval) (pcase rval - (`(,(or 'call 'direct-call) ,f . ,args) - (setf (comp-mvar-type lval) - (alist-get f comp-known-ret-types)) - (comp-function-call-maybe-remove insn f args)) - (`(,(or 'callref 'direct-callref) ,f . ,args) + (`(,(or 'call 'callref) ,f . ,args) (setf (comp-mvar-type lval) (alist-get f comp-known-ret-types)) (comp-function-call-maybe-remove insn f args)) + (`(,(or 'direct-call 'direct-callref) ,f . ,args) + (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) + (setf (comp-mvar-type lval) + (alist-get f comp-known-ret-types)) + (comp-function-call-maybe-remove insn f args))) (_ (comp-mvar-propagate lval rval)))) (`(phi ,lval . ,rest) @@ -1985,9 +1986,9 @@ Backward propagate array placement properties." (not (memq callee comp-never-optimize-functions))) (let* ((f (symbol-function callee)) (subrp (subrp f)) - (callee-in-unit (gethash (gethash callee - (comp-ctxt-sym-to-c-name-h comp-ctxt)) - (comp-ctxt-funcs-h comp-ctxt)))) + (comp-func-callee (gethash (gethash callee + (comp-ctxt-sym-to-c-name-h comp-ctxt)) + (comp-ctxt-funcs-h comp-ctxt)))) (cond ((and subrp (not (subr-native-elisp-p f))) ;; Trampoline removal. @@ -1995,7 +1996,7 @@ Backward propagate array placement properties." (maxarg (cdr (subr-arity f))) (call-type (if (if subrp (not (numberp maxarg)) - (comp-nargs-p callee-in-unit)) + (comp-nargs-p comp-func-callee)) 'callref 'call)) (args (if (eq call-type 'callref) @@ -2005,14 +2006,14 @@ Backward propagate array placement properties." ;; Intra compilation unit procedure call optimization. ;; Attention speed 3 triggers this for non self calls too!! ((and (>= comp-speed 3) - callee-in-unit) - (let* ((func-args (comp-func-args callee-in-unit)) + comp-func-callee) + (let* ((func-args (comp-func-args comp-func-callee)) (nargs (comp-nargs-p func-args)) (call-type (if nargs 'direct-callref 'direct-call)) (args (if (eq call-type 'direct-callref) args (fill-args args (comp-args-max func-args))))) - `(,call-type ,callee ,@args))) + `(,call-type ,(comp-func-c-name comp-func-callee) ,@args))) ((comp-type-hint-p callee) `(call ,callee ,@args))))))) diff --git a/src/comp.c b/src/comp.c index 45904a3bb1d..9171a6a524b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -860,34 +860,28 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, } /* Emit calls fetching from existing declarations. */ + static gcc_jit_rvalue * -emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs, +emit_call (Lisp_Object func, gcc_jit_type *ret_type, ptrdiff_t nargs, gcc_jit_rvalue **args, bool direct) { - Lisp_Object func; - if (direct) - { - Lisp_Object c_name = - Fgethash (subr_sym, - CALL1I (comp-ctxt-sym-to-c-name-h, Vcomp_ctxt), - Qnil); - func = Fgethash (c_name, comp.exported_funcs_h, Qnil); - } - else - func = Fgethash (subr_sym, comp.imported_funcs_h, Qnil); + Lisp_Object gcc_func = + Fgethash (func, + direct ? comp.exported_funcs_h : comp.imported_funcs_h, + Qnil); - if (NILP (func)) + if (NILP (gcc_func)) xsignal2 (Qnative_ice, build_string ("missing function declaration"), - subr_sym); + func); if (direct) { - emit_comment (format_string ("direct call to subr: %s", - SSDATA (SYMBOL_NAME (subr_sym)))); + emit_comment (format_string ("direct call to: %s", + SSDATA (func))); return gcc_jit_context_new_call (comp.ctxt, NULL, - xmint_pointer (func), + xmint_pointer (gcc_func), nargs, args); } @@ -897,14 +891,14 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs, gcc_jit_rvalue_dereference_field ( gcc_jit_lvalue_as_rvalue (comp.func_relocs), NULL, - (gcc_jit_field *) xmint_pointer (func)); + (gcc_jit_field *) xmint_pointer (gcc_func)); if (!f_ptr) xsignal2 (Qnative_ice, build_string ("missing function relocation"), - subr_sym); + func); emit_comment (format_string ("calling subr: %s", - SSDATA (SYMBOL_NAME (subr_sym)))); + SSDATA (SYMBOL_NAME (func)))); return gcc_jit_context_new_call_through_ptr (comp.ctxt, NULL, gcc_jit_lvalue_as_rvalue (f_ptr), @@ -914,7 +908,7 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs, } static gcc_jit_rvalue * -emit_call_ref (Lisp_Object subr_sym, ptrdiff_t nargs, +emit_call_ref (Lisp_Object func, ptrdiff_t nargs, gcc_jit_lvalue *base_arg, bool direct) { gcc_jit_rvalue *args[] = @@ -922,7 +916,7 @@ emit_call_ref (Lisp_Object subr_sym, ptrdiff_t nargs, comp.ptrdiff_type, nargs), gcc_jit_lvalue_get_address (base_arg, NULL) }; - return emit_call (subr_sym, comp.lisp_obj_type, 2, args, direct); + return emit_call (func, comp.lisp_obj_type, 2, args, direct); } /* Close current basic block emitting a conditional. */