X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcall.lisp;h=bc1e06ed6d03a4f7607b7735ab6b84db606790ca;hb=34ef6951cd7243a4eaccf2efb10e6b3d2908e12b;hp=fa0c1630d7a7bdfcd90d7584645291424caa12f4;hpb=66955b341a6d13dc2c2efde8739308b7cfc7e164;p=sbcl.git

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