X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86-64%2Farith.lisp;h=684d16e150d79b2938b5b6283e5f003facc4b213;hb=04c2366ba81081d3f19d8818f7366e280f11e7f2;hp=fc05cbe1fa9adb84842066bddb3e32c16234d129;hpb=952d16ab5880823c1864eb9105bb269e2e00760d;p=sbcl.git

diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp
index fc05cbe..684d16e 100644
--- a/src/assembly/x86-64/arith.lisp
+++ b/src/assembly/x86-64/arith.lisp
@@ -40,10 +40,10 @@
                 (inst ret)
 
                 DO-STATIC-FUN
-                ;; Same as: (inst enter (fixnumize 1))
+                ;; Same as: (inst enter (* n-word-bytes 1))
                 (inst push rbp-tn)
                 (inst mov rbp-tn rsp-tn)
-                (inst sub rsp-tn (fixnumize 1))
+                (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
@@ -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)
 
@@ -128,7 +136,7 @@
 
   (inst push rbp-tn)
   (inst mov rbp-tn rsp-tn)
-  (inst sub rsp-tn (fixnumize 1))
+  (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
@@ -168,7 +176,7 @@
                 (inst ret)
 
                 DO-STATIC-FUN
-                (inst sub rsp-tn (fixnumize 3))
+                (inst sub rsp-tn (* n-word-bytes 3))
                 (inst mov (make-ea :qword :base rsp-tn
                                    :disp (frame-byte-offset
                                           (+ sp->fp-offset
@@ -238,7 +246,7 @@
   (inst ret)
 
   DO-STATIC-FUN
-  (inst sub rsp-tn (fixnumize 3))
+  (inst sub rsp-tn (* n-word-bytes 3))
   (inst mov (make-ea :qword :base rsp-tn
                      :disp (frame-byte-offset
                             (+ sp->fp-offset
@@ -300,7 +308,7 @@
   (inst ret)
 
   DO-STATIC-FUN
-  (inst sub rsp-tn (fixnumize 3))
+  (inst sub rsp-tn (* n-word-bytes 3))
   (inst mov (make-ea :qword :base rsp-tn
                      :disp (frame-byte-offset
                             (+ sp->fp-offset