Changeset 15650

Timestamp:

Feb 2, 2013, 9:34:46 PM (8 years ago)

Author:

gb

Message:

Propagate r15649 to 1.9

Location:

release/1.9/source

Files:

• level-0/l0-numbers.lisp (modified) (2 diffs)
• level-1/l1-numbers.lisp (modified) (5 diffs)

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

@@ -1181 +1181 @@
          (bignum (if (eq number target::target-most-negative-fixnum)
                    (with-small-bignum-buffers ((bn number))
-                     (bignum-truncate bn divisor))
+                     (multiple-value-bind (q r) (bignum-truncate bn divisor)
+                       (if (eq r bn)
+                         (values q number)
+                         (values q r))))
                    (values 0 number)))
          (double-float (truncate-rat-dfloat number divisor))
@@ -1557 +1560 @@
      (number-case divisor
        (fixnum (nth-value 1 (%fixnum-truncate number divisor)))
-       (bignum number)
+       (bignum
+        (if (and (eql number target::target-most-negative-fixnum)
+                 (eql divisor (- target::target-most-negative-fixnum)))
+          0
+          number))
        (t (nth-value 1 (truncate number divisor)))))
     (bignum

release/1.9/source/level-1/l1-numbers.lisp

@@ -762 +762 @@
   (with-stack-double-floats ((temp))
     #+arm-target (%set-fpscr-status 0)
-    #+linux-target
-    (progn
-      (%get-errno)                      ;clear errno
-      (#_feclearexcept #$FE_ALL_EXCEPT))
     #-freebsdx8632-target
     (%setf-double-float TEMP (#_exp n))
@@ -772 +768 @@
     (%df-check-exception-1 'exp n (%ffi-exception-status))
     #+linux-target
-    (and (eql (- #$ERANGE) (%get-errno))
-         (#_fetestexcept #$FE_OVERFLOW)
+    (and (infinity-p TEMP)
+         (not (infinity-p n))
          (get-fpu-mode :overflow)
          (error 'floating-point-overflow
@@ -785 +781 @@
   (target::with-stack-short-floats ((temp))
     #+arm-target (%set-fpscr-status 0)
-    #+linux-target
-    (progn
-      (%get-errno)                      ;clear errno
-      (#_feclearexcept #$FE_ALL_EXCEPT))
     #-freebsdx8632-target
     (%setf-short-float TEMP (#_expf n))
@@ -795 +787 @@
     (%sf-check-exception-1 'exp n (%ffi-exception-status))
     #+linux-target
-    (and (eql (- #$ERANGE) (%get-errno))
-         (#_fetestexcept #$FE_OVERFLOW)
+    (and (infinity-p TEMP)
+         (not (infinity-p n))
          (get-fpu-mode :overflow)
          (error 'floating-point-overflow
@@ -814 +806 @@
 (defun %single-float-exp (n)
   (declare (single-float n))
-  #+linux-target
-  (progn
-    (%get-errno)                      ;clear errno
-    (#_feclearexcept #$FE_ALL_EXCEPT))
   (let* ((result (#_expf n)))
     (%sf-check-exception-1 'exp n (%ffi-exception-status))
     #+linux-target
-    (and (eql (- #$ERANGE) (%get-errno))
-         (#_fetestexcept #$FE_OVERFLOW)
+    (and (infinity-p result)
+         (not (infinity-p n))
          (get-fpu-mode :overflow)
          (error 'floating-point-overflow