X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcall.lisp;h=5488403af1a4dac876396ad5e868fe7853db34ab;hb=a4882e3023fdd5e777169a4cbede33605281173c;hp=384155b2ae695eb74a6bcf3a67caea34ff24409a;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index 384155b..5488403 100644
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -200,12 +200,11 @@
   (cond
    ((<= nvals 1)
     (note-this-location vop :single-value-return)
-    (inst mov rsp-tn rbx-tn))
+    (inst cmov :c rsp-tn rbx-tn))
    ((<= nvals register-arg-count)
     (let ((regs-defaulted (gen-label)))
       (note-this-location vop :unknown-return)
-      (inst nop)
-      (inst jmp-short regs-defaulted)
+      (inst jmp :c regs-defaulted)
       ;; Default the unsupplied registers.
       (let* ((2nd-tn-ref (tn-ref-across values))
              (2nd-tn (tn-ref-tn 2nd-tn-ref)))
@@ -229,8 +228,7 @@
           (default-stack-slots (gen-label)))
       (note-this-location vop :unknown-return)
       ;; Branch off to the MV case.
-      (inst nop)
-      (inst jmp-short regs-defaulted)
+      (inst jmp :c regs-defaulted)
       ;; Do the single value case.
       ;; Default the register args
       (inst mov rax-tn nil-value)
@@ -385,8 +383,7 @@
   (declare (type tn args nargs start count))
   (let ((variable-values (gen-label))
         (done (gen-label)))
-    (inst nop)
-    (inst jmp-short variable-values)
+    (inst jmp :c variable-values)
 
     (cond ((location= start (first *register-arg-tns*))
            (inst push (first *register-arg-tns*))
@@ -939,21 +936,60 @@
   (:args (old-fp)
          (return-pc)
          (value))
-  (:temporary (:sc unsigned-reg) ofp)
-  (:temporary (:sc unsigned-reg) ret)
   (:ignore value)
   (:generator 6
     (trace-table-entry trace-table-fun-epilogue)
-    (move ret return-pc)
-    ;; Clear the control stack
-    (move ofp old-fp)
-    ;; Adjust the return address for the single value return.
-    (inst add ret 3)
-    ;; Restore the frame pointer.
-    (move rsp-tn rbp-tn)
-    (move rbp-tn ofp)
-    ;; Out of here.
-    (inst jmp ret)))
+    ;; Code structure lifted from known-return.
+    (sc-case return-pc
+      ((sap-reg)
+       ;; return PC in register for some reason (local call?)
+       ;; we jmp to the return pc after fixing the stack and frame.
+       (sc-case old-fp
+         ((control-stack)
+          ;; ofp on stack must be in slot 0 (the traditional storage place).
+          ;; Drop the stack above it and pop it off.
+          (cond ((zerop (tn-offset old-fp))
+                 (inst lea rsp-tn (make-ea :dword :base rbp-tn
+                                           :disp (- (* (1+ ocfp-save-offset)
+                                                       n-word-bytes))))
+                 (inst pop rbp-tn))
+                (t
+                 ;; Should this ever happen, we do the same as above, but
+                 ;; using (tn-offset old-fp) instead of ocfp-save-offset
+                 ;; (which is 0 anyway, see src/compiler/x86/vm.lisp) and
+                 ;; then lea rsp again against itself with a displacement
+                 ;; of (* (tn-offset old-fp) n-word-bytes) to clear the
+                 ;; rest of the stack.
+                 (cerror "Continue anyway"
+                         "VOP return-single doesn't work if old-fp (in slot ~S) is not in slot 0" (tn-offset old-fp)))))
+         ((any-reg descriptor-reg)
+          ;; ofp in reg, drop the stack and load the real fp.
+          (move rsp-tn rbp-tn)
+          (move rbp-tn old-fp)))
+
+       ;; Set single-value-return flag
+       (inst clc)
+       ;; And return
+       (inst jmp return-pc))
+
+      ((sap-stack)
+       ;; Note that this will only work right if, when old-fp is on
+       ;; the stack, it has a lower tn-offset than return-pc. One of
+       ;; the comments in known-return indicate that this is the case
+       ;; (in that it will be in its save location), but we may wish
+       ;; to assert that (in either the weaker or stronger forms).
+       ;; Should this ever not be the case, we should load old-fp
+       ;; into a temp reg while we fix the stack.
+       ;; Drop stack above return-pc
+       (inst lea rsp-tn (make-ea :dword :base rbp-tn
+                                 :disp (- (* (1+ (tn-offset return-pc))
+                                             n-word-bytes))))
+       ;; Set single-value return flag
+       (inst clc)
+       ;; Restore the old frame pointer
+       (move rbp-tn old-fp)
+       ;; And return, dropping the rest of the stack as we go.
+       (inst ret (* (tn-offset return-pc) n-word-bytes))))))
 
 ;;; Do unknown-values return of a fixed (other than 1) number of
 ;;; values. The VALUES are required to be set up in the standard
@@ -1004,6 +1040,8 @@
         (inst mov first nil-value)
         (dolist (tn (cdr arg-tns))
           (inst mov tn first))))
+    ;; Set the multiple value return flag.
+    (inst stc)
     ;; And away we go. Except that return-pc is still on the
     ;; stack and we've changed the stack pointer. So we have to
     ;; tell it to index off of RBX instead of RBP.
@@ -1065,8 +1103,8 @@
         (move old-fp-temp old-fp)
         (move rsp-tn rbp-tn)
         (move rbp-tn old-fp-temp)
-        ;; Fix the return-pc to point at the single-value entry point.
-        (inst add rax 3) ; skip "mov %rbx,%rsp" insn in caller
+        ;; clear the multiple-value return flag
+        (inst clc)
         ;; Out of here.
         (inst jmp rax)