From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Fri, 16 Aug 2019 08:38:51 +0000 (+0200)
Subject: optimize self calls
X-Git-Tag: emacs-28.0.90~2727^2~1273
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=24fe275711aa0964051f3b95c9bc9b4a3e524826;p=emacs.git

optimize self calls
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index a95cd56eae4..1c2ac4c6e4a 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -463,6 +463,38 @@ If NEGATED non nil negate the tested condition."
            for m-test = (make-comp-mvar :constant test)
            do (comp-emit-cond-jump var m-test 0 target-label nil)))
 
+(defun comp-emit-funcall (narg)
+  "Avoid Ffuncall trampoline if possibile.
+NARG is the number of Ffuncall arguments."
+  (comp-stack-adjust (- narg))
+  (let* ((callee (comp-slot))
+         (callee-sym-name (comp-mvar-constant callee))
+         (optimize nil)
+         (callref nil))
+    (and (comp-mvar-const-vld callee)
+         (or (and (>= comp-speed 2)
+                  (eq callee-sym-name (comp-func-symbol-name comp-func))
+                  (setq optimize t)
+                  (setq callref (comp-nargs-p (comp-func-args comp-func))))
+             ;; (and (>= comp-speed 3)
+             ;;      (symbol-function callee-sym-name)
+             ;;      (subrp (symbol-function callee-sym-name))
+             ;;      (setq optimize t)
+             ;;      (setq callref (eq 'many
+             ;;                        (cdr (subr-arity
+             ;;                              (symbol-function callee-sym-name)))))
+             ;;      (setf callee-sym-name ))
+             ))
+    (if optimize
+        (if callref
+            (comp-emit-set-call `(callref ,callee-sym-name
+                                          ,narg ,(1+ (comp-sp))))
+          (comp-emit-set-call `(call ,callee-sym-name
+                                     ,@(cl-loop for i from (1+ (comp-sp))
+                                                repeat narg
+                                                collect (comp-slot-n i)))))
+      (comp-emit-set-call `(callref Ffuncall ,(1+ narg) ,(comp-sp))))))
+
 (defmacro comp-op-case (&rest cases)
   "Expand CASES into the corresponding pcase.
 This is responsible for generating the proper stack adjustment when known and
@@ -529,8 +561,7 @@ the annotation emission."
                          ,(make-comp-mvar :constant arg)
                          ,(comp-slot-next))))
       (byte-call
-       (comp-stack-adjust (- arg))
-       (comp-emit-set-call `(callref Ffuncall ,(1+ arg) ,(comp-sp))))
+       (comp-emit-funcall arg))
       (byte-unbind
        (comp-emit `(call helper_unbind_n
                          ,(make-comp-mvar :constant arg))))
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index e7b370c9321..55797f1352e 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -29,6 +29,8 @@
 (require 'comp)
 ;; (require 'cl-lib)
 
+(setq comp-speed 3)
+
 (defun comp-test-apply (func &rest args)
   (unless (subrp (symbol-function func))
     (native-compile func))