Changeset 13535 for release

Timestamp:

Mar 16, 2010, 11:33:28 AM (15 years ago)

Author:

R. Matthew Emerson

Message:

Merge r13529 through r13532 (special-case divisor of -1 in %fixnum-truncate)
from trunk to 1.4 branch. Fixes ticket:666.

Location:

release/1.4/source

Files:

• . (modified) (1 prop)
• compiler (modified) (1 prop)
• level-0/PPC/ppc-numbers.lisp (modified) (5 diffs)
• level-0/X86 (modified) (1 prop)
• level-0/X86/X8632/x8632-numbers.lisp (modified) (2 diffs)
• level-0/X86/x86-numbers.lisp (modified) (3 diffs)
• level-0/l0-numbers.lisp (modified) (3 diffs)
• level-1/l1-init.lisp (modified) (1 diff)
• lisp-kernel (modified) (1 prop)
• scripts (modified) (1 prop)

release/1.4/source/level-0/PPC/ppc-numbers.lisp

@@ -207 +207 @@
 
 
-;;;; maybe this could be smarter but frankly scarlett I dont give a damn
+;;; maybe this could be smarter but frankly scarlett I dont give a damn
+;;; ticket:666 describes one reason to give a damn.
 #+ppc32-target
 (defppclapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
@@ -217 +218 @@
         (boxed-quotient temp1)
         (remainder temp2))
+    (cmpwi divisor '-1)    
     (unbox-fixnum unboxed-dividend dividend)
     (unbox-fixnum unboxed-divisor divisor)
+    (beq @neg)
     (divwo. unboxed-quotient unboxed-dividend unboxed-divisor)          ; set OV if divisor = 0
     (box-fixnum boxed-quotient unboxed-quotient)
@@ -236 +239 @@
     (set-nargs 2)
     (la temp0 8 vsp)
+    (ba .SPvalues)
+    @neg
+    (nego. dividend dividend)
+    (lwz arg_z '*least-positive-bignum* nfn)
+    (bns @ret)
+    (mtxer rzero)
+    (lwz dividend ppc32::symbol.vcell arg_z)
+    @ret
+    (mr temp0 vsp)
+    (vpush dividend)
+    (vpush rzero)
+    (set-nargs 2)
     (ba .SPvalues)))
 
@@ -247 +262 @@
         (boxed-quotient temp1)
         (remainder temp2))
+    (cmpdi divisor '-1)
     (unbox-fixnum unboxed-dividend dividend)
     (unbox-fixnum unboxed-divisor divisor)
+    (beq @neg)
     (divdo. unboxed-quotient unboxed-dividend unboxed-divisor)          ; set OV if divisor = 0
     (box-fixnum boxed-quotient unboxed-quotient)
@@ -266 +283 @@
     (set-nargs 2)
     (la temp0 '2 vsp)
-    (ba .SPvalues)))
+    (ba .SPvalues)
+    @neg
+    (nego. dividend dividend)
+    (ld arg_z '*least-positive-bignum* nfn)
+    (bns @ret)
+    (mtxer rzero)
+    (ld dividend ppc64::symbol.vcell arg_z)
+    @ret
+    (mr temp0 vsp)
+    (vpush dividend)
+    (vpush rzero)
+    (set-nargs 2)
+    (ba .SPvalues)    
+    ))
 
 

release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp

@@ -114 +114 @@
   (single-value-return))
 
+
+
 ;;; We'll get a SIGFPE if divisor is 0.
 (defx8632lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
+  (cmpl ($ '-1) (% divisor))
+  (je @neg)
   (mark-as-imm temp0)
   (mark-as-imm temp1)
@@ -131 +135 @@
   (push (% arg_z))
   (push (% arg_y))
+  (set-nargs 2)
+  (jmp-subprim .SPvalues)
+  @neg
+  (negl (% dividend))
+  (load-constant *least-positive-bignum* arg_z)
+  (cmovol (@ x8632::symbol.vcell (% arg_z)) (% dividend))
+  (movl (% esp) (% temp0))
+  (pushl (% dividend))
+  (pushl ($ 0))
   (set-nargs 2)
   (jmp-subprim .SPvalues))

release/1.4/source/level-0/X86/x86-numbers.lisp

@@ -112 +112 @@
 
 
+
 ;;; We'll get a SIGFPE if divisor is 0.
 ;;; Don't use %rbp.  Trust callback_for_interrupt() to preserve
@@ -117 +118 @@
 (defx86lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
   (save-simple-frame)
+  (cmpq ($ '-1) (% divisor))
+  (je @neg)
   (unbox-fixnum divisor imm0)
   (movq (% imm0) (% imm2))
@@ -129 +132 @@
   (pushq (% arg_y))
   (set-nargs 2)
+  (jmp-subprim .SPvalues)
+  @neg
+  (negq (% dividend))
+  (load-constant *least-positive-bignum* arg_z)
+  (cmovoq (@ x8664::symbol.vcell (% arg_z)) (% dividend))
+  (pop (% rbp))
+  (movq (% rsp) (% temp0))
+  (pushq (% dividend))
+  (pushq ($ 0))
+  (set-nargs 2)
   (jmp-subprim .SPvalues))
+  
 
 (defx86lapfunction called-for-mv-p ()

release/1.4/source/level-0/l0-numbers.lisp

@@ -1140 +1140 @@
          #+32-bit-target
          `(target::with-stack-short-floats ((fnum ,number)
-                                           (f2))
+                                            (f2))
            (let ((res (%unary-truncate (%short-float/-2! fnum ,divisor f2))))
              (values res 
                      (%short-float--2 fnum (%short-float*-2! (%short-float res f2) ,divisor f2)))))
-          #+64-bit-target
+         #+64-bit-target
          `(let* ((temp (%short-float ,number))
                  (res (%unary-truncate (/ (the short-float temp)
@@ -1152 +1152 @@
              (the short-float (* (the short-float (%short-float res))
                                  (the short-float ,divisor)))))))
-         )
+       )
     (number-case number
       (fixnum
-       (if (eql number target::target-most-negative-fixnum)
-         (if (zerop divisor)
-           (error 'division-by-zero :operation 'truncate :operands (list number divisor))
-           (with-small-bignum-buffers ((bn number))
-             (multiple-value-bind (quo rem) (truncate bn divisor)
-               (if (eq quo bn)
-                 (values number rem)
-                 (values quo rem)))))
-         (number-case divisor
-           (fixnum (if (eq divisor 1) (values number 0) (%fixnum-truncate number divisor)))
-           (bignum (values 0 number))
-           (double-float (truncate-rat-dfloat number divisor))
-           (short-float (truncate-rat-sfloat number divisor))
-           (ratio (let ((q (truncate (* number (%denominator divisor)) ; this was wrong
-                                     (%numerator divisor))))
-                    (values q (- number (* q divisor))))))))
+       (number-case divisor
+         (fixnum (if (eq divisor 1) (values number 0) (%fixnum-truncate number divisor)))
+         (bignum (values 0 number))
+         (double-float (truncate-rat-dfloat number divisor))
+         (short-float (truncate-rat-sfloat number divisor))
+         (ratio (let ((q (truncate (* number (%denominator divisor)) ; this was wrong
+                                   (%numerator divisor))))
+                  (values q (- number (* q divisor)))))))
       (bignum (number-case divisor
                 (fixnum (if (eq divisor 1) (values number 0)
@@ -1199 +1191 @@
                                     (/ (the short-float number)
                                        (the short-float divisor)))))
-                            (values res
-                                    (- (the short-float number)
-                                       (* (the short-float (%short-float res))
-                                          (the short-float divisor))))))
+                          (values res
+                                  (- (the short-float number)
+                                     (* (the short-float (%short-float res))
+                                        (the short-float divisor))))))
                        ((fixnum bignum ratio)
                         #+32-bit-target
                         (target::with-stack-short-floats ((fdiv divisor)
-                                                         (f2))
+                                                          (f2))
                           (let ((res (%unary-truncate (%short-float/-2! number fdiv f2))))
                             (values res 

release/1.4/source/level-1/l1-init.lisp

@@ -161 +161 @@
   "the fixnum closest in value to negative infinity")
 
+(defstatic *least-positive-bignum* (1+ target::target-most-positive-fixnum)
+  "used internally; value should be treated as a constant")
+
 
 (defconstant lambda-list-keywords