X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcall.lisp;h=b57642ae68bae7d0cbb110aa18b71f69e5da4929;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=be785c1e2fdb7c51fbaed24a5baf68087a369768;hpb=66955b341a6d13dc2c2efde8739308b7cfc7e164;p=sbcl.git

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index be785c1..b57642a 100644
--- 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)))
 
@@ -1224,7 +1173,6 @@
       (inst lea dst (make-ea :qword :base rcx :index rcx))
       (maybe-pseudo-atomic stack-allocate-p
        (allocation dst dst node stack-allocate-p list-pointer-lowtag)
-       (inst shr rcx (1- n-lowtag-bits))
        ;; Set decrement mode (successive args at lower addresses)
        (inst std)
        ;; Set up the result.
@@ -1242,7 +1190,7 @@
        (inst lods rax)
        (storew rax dst 0 list-pointer-lowtag)
        ;; Go back for more.
-       (inst sub rcx 1)
+       (inst sub rcx n-word-bytes)
        (inst jmp :nz loop)
        ;; NIL out the last cons.
        (storew nil-value dst 1 list-pointer-lowtag)