1.0.27.17: faster local calls on x86/x86-64

Instead of JMPing to TARGET, CALL a trampoline that saves the return
pc and jumps. Although this is an incredibly stupid trick, the paired
CALL/RET instructions are a big win.

diff --git a/NEWS b/NEWS
index 6f89262..6dc7d63 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,7 @@ changes in sbcl-1.0.28 relative to 1.0.27:
     potentially-invalid effective methods in its cache.
   * improvement: on x86/x86-64 Lisp call frames now have the same layout as C
     frames, allowing for instance more reliable backtraces.
+  * optimization: faster local calls on x86/x86-64
 
 changes in sbcl-1.0.27 relative to 1.0.26:
   * new port: support added for x86-64 OpenBSD. (thanks to Josh Elsasser)

diff --git a/doc/internals/calling-convention.texinfo b/doc/internals/calling-convention.texinfo
index 5fcb529..f390521 100644 (file)
--- a/doc/internals/calling-convention.texinfo
+++ b/doc/internals/calling-convention.texinfo
@@ -212,9 +212,11 @@ the case of an entry point for a full call).
 @comment  node-name,  next,  previous,  up
 @section Additional Notes
 
-The low-hanging fruit here is going to be changing every call and
-return to use @code{CALL} and @code{RETURN} instructions instead of
-@code{JMP} instructions.
+The low-hanging fruit is going to be changing every call and return to
+use @code{CALL} and @code{RETURN} instructions instead of @code{JMP}
+instructions which is partly done on x86oids: a trampoline is
+@code{CALL}ed and that @code{JMP}s to the target which is sufficient
+to negate (most of?) the penalty.
 
 A more involved change would be to reduce the number of argument
 passing registers from three to two, which may be beneficial in terms

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index 28da0dd..b57642a 100644 (file)
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -464,6 +464,17 @@
                (= (tn-offset return-pc) return-pc-save-offset))
     (error "return-pc not on stack in standard save location?")))
 
+;;; Instead of JMPing to TARGET, CALL a trampoline that saves the
+;;; return pc and jumps. Although this is an incredibly stupid trick
+;;; the paired CALL/RET instructions are a big win.
+(defun make-local-call (target)
+  (let ((tramp (gen-label)))
+    (inst call tramp)
+    (assemble (*elsewhere*)
+      (emit-label tramp)
+      (popw rbp-tn (frame-word-offset return-pc-save-offset))
+      (inst jmp target))))
+
 ;;; Non-TR local call for a fixed number of values passed according to
 ;;; the unknown values convention.
 ;;;
@@ -487,39 +498,18 @@
   (:args (fp)
          (nfp)
          (args :more t))
-  (:temporary (:sc unsigned-reg) return-label)
   (:results (values :more t))
   (:save-p t)
   (:move-args :local-call)
   (:info arg-locs callee target nvals)
   (:vop-var vop)
-  (:ignore nfp arg-locs args #+nil callee)
+  (:ignore nfp arg-locs args callee)
   (:node-var node)
   (:generator 5
     (trace-table-entry trace-table-call-site)
     (move rbp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-      #+nil
-      (format t "*call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         (unless (= (tn-offset ret-tn) return-pc-save-offset)
-           (error "ret-tn ~A in wrong stack slot" ret-tn))
-         #+nil (format t "*call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         (inst lea return-label (make-fixup nil :code-object RETURN))
-         (storew return-label rbp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "ret-tn ~A in sap-reg" ret-tn))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (default-unknown-values vop values nvals node)
     (trace-table-entry trace-table-normal)))
 
@@ -530,37 +520,17 @@
   (:args (fp)
          (nfp)
          (args :more t))
-  (:temporary (:sc unsigned-reg) return-label)
   (:save-p t)
   (:move-args :local-call)
   (:info save callee target)
-  (:ignore args save nfp #+nil callee)
+  (:ignore args save nfp callee)
   (:vop-var vop)
   (:node-var node)
   (:generator 20
     (trace-table-entry trace-table-call-site)
     (move rbp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-      #+nil
-      (format t "*multiple-call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         ;; Stack
-         (inst lea return-label (make-fixup nil :code-object RETURN))
-         (storew return-label rbp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "multiple-call-local: return-pc not on stack."))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (note-this-location vop :unknown-return)
     (receive-unknown-values values-start nvals start count node)
     (trace-table-entry trace-table-normal)))
@@ -577,38 +547,17 @@
   (:args (fp)
          (nfp)
          (args :more t))
-  (:temporary (:sc unsigned-reg) return-label)
   (:results (res :more t))
   (:move-args :local-call)
   (:save-p t)
   (:info save callee target)
-  (:ignore args res save nfp #+nil callee)
+  (:ignore args res save nfp callee)
   (:vop-var vop)
   (:generator 5
     (trace-table-entry trace-table-call-site)
     (move rbp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-
-      #+nil
-      (format t "*known-call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         #+nil (format t "*known-call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         ;; Stack
-         (inst lea return-label (make-fixup nil :code-object RETURN))
-         (storew return-label rbp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "known-call-local: return-pc not on stack."))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (note-this-location vop :known-return)
     (trace-table-entry trace-table-normal)))
 \f

diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index 3fec798..bc1e06e 100644 (file)
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/call.lisp
@@ -470,6 +470,17 @@
                (= (tn-offset return-pc) return-pc-save-offset))
     (error "return-pc not on stack in standard save location?")))
 
+;;; Instead of JMPing to TARGET, CALL a trampoline that saves the
+;;; return pc and jumps. Although this is an incredibly stupid trick
+;;; the paired CALL/RET instructions are a big win.
+(defun make-local-call (target)
+  (let ((tramp (gen-label)))
+    (inst call tramp)
+    (assemble (*elsewhere*)
+      (emit-label tramp)
+      (popw ebp-tn (frame-word-offset return-pc-save-offset))
+      (inst jmp target))))
+
 ;;; Non-TR local call for a fixed number of values passed according to
 ;;; the unknown values convention.
 ;;;
@@ -498,33 +509,13 @@
   (:move-args :local-call)
   (:info arg-locs callee target nvals)
   (:vop-var vop)
-  (:ignore nfp arg-locs args #+nil callee)
+  (:ignore nfp arg-locs args callee)
   (:node-var node)
   (:generator 5
     (trace-table-entry trace-table-call-site)
     (move ebp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-      #+nil
-      (format t "*call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         (unless (= (tn-offset ret-tn) return-pc-save-offset)
-           (error "ret-tn ~A in wrong stack slot" ret-tn))
-         #+nil (format t "*call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         (storew (make-fixup nil :code-object RETURN)
-                 ebp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "ret-tn ~A in sap-reg" ret-tn))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (default-unknown-values vop values nvals node)
     (trace-table-entry trace-table-normal)))
 
@@ -538,33 +529,14 @@
   (:save-p t)
   (:move-args :local-call)
   (:info save callee target)
-  (:ignore args save nfp #+nil callee)
+  (:ignore args save nfp callee)
   (:vop-var vop)
   (:node-var node)
   (:generator 20
     (trace-table-entry trace-table-call-site)
     (move ebp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-      #+nil
-      (format t "*multiple-call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         ;; Stack
-         (storew (make-fixup nil :code-object RETURN)
-                 ebp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "multiple-call-local: return-pc not on stack."))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (note-this-location vop :unknown-return)
     (receive-unknown-values values-start nvals start count node)
     (trace-table-entry trace-table-normal)))
@@ -585,33 +557,13 @@
   (:move-args :local-call)
   (:save-p t)
   (:info save callee target)
-  (:ignore args res save nfp #+nil callee)
+  (:ignore args res save nfp callee)
   (:vop-var vop)
   (:generator 5
     (trace-table-entry trace-table-call-site)
     (move ebp-tn fp)
-
-    (let ((ret-tn (callee-return-pc-tn callee)))
-
-      #+nil
-      (format t "*known-call-local ~S; tn-kind ~S; tn-save-tn ~S; its tn-kind ~S~%"
-              ret-tn (sb!c::tn-kind ret-tn) (sb!c::tn-save-tn ret-tn)
-              (sb!c::tn-kind (sb!c::tn-save-tn ret-tn)))
-
-      ;; Is the return-pc on the stack or in a register?
-      (sc-case ret-tn
-        ((sap-stack)
-         #+nil (format t "*known-call-local: ret-tn on stack; offset=~S~%"
-                       (tn-offset ret-tn))
-         ;; Stack
-         (storew (make-fixup nil :code-object RETURN)
-                 ebp-tn (frame-word-offset (tn-offset ret-tn))))
-        (t
-         (error "known-call-local: return-pc not on stack."))))
-
     (note-this-location vop :call-site)
-    (inst jmp target)
-    RETURN
+    (make-local-call target)
     (note-this-location vop :known-return)
     (trace-table-entry trace-table-normal)))
 \f

diff --git a/version.lisp-expr b/version.lisp-expr
index 4c2ca0d..7799e91 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.16"
+"1.0.27.17"