X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86-64%2Farith.lisp;h=684d16e150d79b2938b5b6283e5f003facc4b213;hb=7acdf15e27993655c9249f79d36fe2117843dbdf;hp=b6a1934371472d09b31b1ece949b6cf0afe3888d;hpb=2973941cf214a5ea274cd0381a651ce0e1a7fab2;p=sbcl.git

diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp
index b6a1934..684d16e 100644
--- a/src/assembly/x86-64/arith.lisp
+++ b/src/assembly/x86-64/arith.lisp
@@ -40,12 +40,12 @@
                 (inst ret)
 
                 DO-STATIC-FUN
+                ;; Same as: (inst enter (* n-word-bytes 1))
                 (inst push rbp-tn)
-                (inst lea rbp-tn (make-ea :qword
-                                          :base rsp-tn
-                                          :disp (* 2 n-word-bytes)))
-                (inst sub rsp-tn (fixnumize 1))
-                (inst push (make-ea :qword :base rbp-tn :disp (- n-word-bytes)))
+                (inst mov rbp-tn rsp-tn)
+                (inst sub rsp-tn (* n-word-bytes 1))
+                (inst push (make-ea :qword :base rbp-tn
+                            :disp (frame-byte-offset return-pc-save-offset)))
                 (inst mov rcx (fixnumize 2)) ; arg count
                 (inst jmp
                       (make-ea :qword
@@ -53,12 +53,16 @@
                                         (static-fun-offset
                                          ',(symbolicate "TWO-ARG-" fun))))))))
 
+  #.`
   (define-generic-arith-routine (+ 10)
     (move res x)
     (inst add res y)
     (inst jmp :no OKAY)
-    (inst rcr res 1)                  ; carry has correct sign
-    (inst sar res 2)                  ; remove type bits
+    ;; Unbox the overflowed result, recovering the correct sign from
+    ;; the carry flag, then re-box as a bignum.
+    (inst rcr res 1)
+    ,@(when (> n-fixnum-tag-bits 1)   ; don't shift by 0
+            '((inst sar res (1- n-fixnum-tag-bits))))
 
     (move rcx res)
 
@@ -67,13 +71,17 @@
 
     OKAY)
 
+  #.`
   (define-generic-arith-routine (- 10)
     (move res x)
     (inst sub res y)
     (inst jmp :no OKAY)
+    ;; Unbox the overflowed result, recovering the correct sign from
+    ;; the carry flag, then re-box as a bignum.
     (inst cmc)                        ; carry has correct sign now
     (inst rcr res 1)
-    (inst sar res 2)                  ; remove type bits
+    ,@(when (> n-fixnum-tag-bits 1)   ; don't shift by 0
+            '((inst sar res (1- n-fixnum-tag-bits))))
 
     (move rcx res)
 
@@ -127,9 +135,10 @@
   (inst jmp :z FIXNUM)
 
   (inst push rbp-tn)
-  (inst lea rbp-tn (make-ea :qword :base rsp-tn :disp (* 2 n-word-bytes)))
-  (inst sub rsp-tn (fixnumize 1))
-  (inst push (make-ea :qword :base rbp-tn :disp (- n-word-bytes)))
+  (inst mov rbp-tn rsp-tn)
+  (inst sub rsp-tn (* n-word-bytes 1))
+  (inst push (make-ea :qword :base rbp-tn
+                      :disp (frame-byte-offset return-pc-save-offset)))
   (inst mov rcx (fixnumize 1))    ; arg count
   (inst jmp (make-ea :qword
                      :disp (+ nil-value (static-fun-offset '%negate))))
@@ -167,13 +176,18 @@
                 (inst ret)
 
                 DO-STATIC-FUN
-                (move rcx rsp-tn)
-                (inst sub rsp-tn (fixnumize 3))
-                (inst mov (make-ea :qword
-                                   :base rcx
-                                   :disp (frame-byte-offset ocfp-save-offset))
+                (inst sub rsp-tn (* n-word-bytes 3))
+                (inst mov (make-ea :qword :base rsp-tn
+                                   :disp (frame-byte-offset
+                                          (+ sp->fp-offset
+                                             -3
+                                             ocfp-save-offset)))
                       rbp-tn)
-                (move rbp-tn rcx)
+                (inst lea rbp-tn (make-ea :qword :base rsp-tn
+                                          :disp (frame-byte-offset
+                                          (+ sp->fp-offset
+                                             -3
+                                             ocfp-save-offset))))
                 (inst mov rcx (fixnumize 2))
                 (inst call (make-ea :qword
                                     :disp (+ nil-value
@@ -232,13 +246,18 @@
   (inst ret)
 
   DO-STATIC-FUN
-  (move rcx rsp-tn)
-  (inst sub rsp-tn (fixnumize 3))
-  (inst mov (make-ea :qword
-                     :base rcx
-                     :disp (frame-byte-offset ocfp-save-offset))
+  (inst sub rsp-tn (* n-word-bytes 3))
+  (inst mov (make-ea :qword :base rsp-tn
+                     :disp (frame-byte-offset
+                            (+ sp->fp-offset
+                               -3
+                               ocfp-save-offset)))
         rbp-tn)
-  (move rbp-tn rcx)
+  (inst lea rbp-tn (make-ea :qword :base rsp-tn
+                            :disp (frame-byte-offset
+                                   (+ sp->fp-offset
+                                      -3
+                                      ocfp-save-offset))))
   (inst mov rcx (fixnumize 2))
   (inst call (make-ea :qword
                       :disp (+ nil-value (static-fun-offset 'eql))))
@@ -289,13 +308,19 @@
   (inst ret)
 
   DO-STATIC-FUN
-  (move rcx rsp-tn)
-  (inst sub rsp-tn (fixnumize 3))
-  (inst mov (make-ea :qword
-                     :base rcx
-                     :disp (frame-byte-offset ocfp-save-offset))
+  (inst sub rsp-tn (* n-word-bytes 3))
+  (inst mov (make-ea :qword :base rsp-tn
+                     :disp (frame-byte-offset
+                            (+ sp->fp-offset
+                               -3
+                               ocfp-save-offset)))
         rbp-tn)
-  (move rbp-tn rcx)
+  (inst lea rbp-tn (make-ea :qword :base rsp-tn
+                            :disp (frame-byte-offset
+                                   (+ sp->fp-offset
+                                      -3
+                                      ocfp-save-offset))))
+
   (inst mov rcx (fixnumize 2))
   (inst call (make-ea :qword
                       :disp (+ nil-value (static-fun-offset 'two-arg-=))))