0.8.20.27:

[sbcl.git] / src / compiler / float-tran.lisp

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index c18356b..89c60d9 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -50,41 +50,52 @@
 ;;; through the code this way. It would be nice to move this into the
 ;;; same file as the other RANDOM definitions.
 (deftransform random ((num &optional state)
-                     ((integer 1 #.(expt 2 32)) &optional *))
+                     ((integer 1 #.(expt 2 sb!vm::n-word-bits)) &optional *))
   ;; FIXME: I almost conditionalized this as #!+sb-doc. Find some way
   ;; of automatically finding #!+sb-doc in proximity to DEFTRANSFORM
   ;; to let me scan for places that I made this mistake and didn't
   ;; catch myself.
   "use inline (UNSIGNED-BYTE 32) operations"
-  (let ((num-high (numeric-type-high (lvar-type num))))
-    (when (null num-high)
-      (give-up-ir1-transform))
-    (cond ((constant-lvar-p num)
-          ;; Check the worst case sum absolute error for the random number
-          ;; expectations.
-          (let ((rem (rem (expt 2 32) num-high)))
-            (unless (< (/ (* 2 rem (- num-high rem)) num-high (expt 2 32))
-                       (expt 2 (- sb!kernel::random-integer-extra-bits)))
-              (give-up-ir1-transform
-               "The random number expectations are inaccurate."))
-            (if (= num-high (expt 2 32))
-                '(random-chunk (or state *random-state*))
-                #!-x86 '(rem (random-chunk (or state *random-state*)) num)
-                #!+x86
-                ;; Use multiplication, which is faster.
-                '(values (sb!bignum::%multiply
-                          (random-chunk (or state *random-state*))
-                          num)))))
-         ((> num-high random-fixnum-max)
-          (give-up-ir1-transform
-           "The range is too large to ensure an accurate result."))
-         #!+x86
-         ((< num-high (expt 2 32))
-          '(values (sb!bignum::%multiply (random-chunk (or state
-                                                           *random-state*))
-                    num)))
-         (t
-          '(rem (random-chunk (or state *random-state*)) num)))))
+  (let ((type (lvar-type num))
+       (limit (expt 2 sb!vm::n-word-bits))
+       (random-chunk (ecase sb!vm::n-word-bits
+                       (32 'random-chunk)
+                       (64 'sb!kernel::big-random-chunk))))
+    (if (numeric-type-p type)
+        (let ((num-high (numeric-type-high (lvar-type num))))
+          (aver num-high)
+          (cond ((constant-lvar-p num)
+                 ;; Check the worst case sum absolute error for the
+                 ;; random number expectations.
+                 (let ((rem (rem limit num-high)))
+                   (unless (< (/ (* 2 rem (- num-high rem))
+                                 num-high limit)
+                              (expt 2 (- sb!kernel::random-integer-extra-bits)))
+                     (give-up-ir1-transform
+                      "The random number expectations are inaccurate."))
+                   (if (= num-high limit)
+                       `(,random-chunk (or state *random-state*))
+                       #!-(or x86 x86-64)
+                      `(rem (,random-chunk (or state *random-state*)) num)
+                       #!+(or x86 x86-64)
+                       ;; Use multiplication, which is faster.
+                       `(values (sb!bignum::%multiply
+                                 (,random-chunk (or state *random-state*))
+                                 num)))))
+                ((> num-high random-fixnum-max)
+                 (give-up-ir1-transform
+                  "The range is too large to ensure an accurate result."))
+               #!+(or x86 x86-64)
+                ((< num-high limit)
+                 `(values (sb!bignum::%multiply
+                           (,random-chunk (or state *random-state*))
+                           num)))
+                (t
+                 `(rem (,random-chunk (or state *random-state*)) num))))
+        ;; KLUDGE: a relatively conservative treatment, but better
+        ;; than a bug (reported by PFD sbcl-devel towards the end of
+        ;; 2004-11.
+        '(rem (random-chunk (or state *random-state*)) num))))
 \f
 ;;;; float accessors
 
@@ -137,10 +148,10 @@
   (values double-float-significand double-float-int-exponent (integer -1 1))
   (movable foldable flushable))
 
-(defknown scale-single-float (single-float fixnum) single-float
+(defknown scale-single-float (single-float integer) single-float
   (movable foldable flushable))
 
-(defknown scale-double-float (double-float fixnum) double-float
+(defknown scale-double-float (double-float integer) double-float
   (movable foldable flushable))
 
 (deftransform decode-float ((x) (single-float) *)
@@ -1290,6 +1301,7 @@
 ;;;
 ;;; FIXME: ANSI allows any subtype of REAL for the components of COMPLEX.
 ;;; So what if the input type is (COMPLEX (SINGLE-FLOAT 0 1))?
+;;; Or (EQL #C(1 2))?
 (defoptimizer (conjugate derive-type) ((num))
   (lvar-type num))
 
@@ -1396,19 +1408,6 @@
 (macrolet
     ((def (float-type fun)
         `(deftransform %unary-ftruncate ((x) (,float-type))
-          (let ((x-type (lvar-type x))
-                ;; these bounds may look wrong, but in fact they're
-                ;; right: floats within these bounds are those which
-                ;; TRUNCATE to a (SIGNED-BYTE 32).  ROUND would be
-                ;; different.
-                (low-bound (coerce (- (ash 1 31)) ',float-type))
-                (high-bound (coerce (ash 1 31) ',float-type)))
-            (if (csubtypep x-type
-                           (specifier-type
-                            `(,',float-type (,low-bound) (,high-bound))))
-                '(coerce (%unary-truncate x) ',float-type)
-                `(if (< ,low-bound x ,high-bound)
-                     (coerce (%unary-truncate x) ',',float-type)
-                     (,',fun x)))))))
+           '(,fun x))))
   (def single-float %unary-ftruncate/single)
   (def double-float %unary-ftruncate/double))