1.0.4.6:
[sbcl.git] / src / compiler / float-tran.lisp
index 8a3a055..1cb39f6 100644 (file)
                 '(,fun num (or state *random-state*)))))
   (frob %random-single-float single-float)
   (frob %random-double-float double-float))
-
-;;; Mersenne Twister RNG
-;;;
-;;; FIXME: It's unpleasant to have RANDOM functionality scattered
-;;; 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 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 ((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
 
 ;;; defined range. Quite useful if we want to convert some type of
 ;;; bounded integer into a float.
 (macrolet
-    ((frob (fun type)
+    ((frob (fun type most-negative most-positive)
        (let ((aux-name (symbolicate fun "-DERIVE-TYPE-AUX")))
          `(progn
-           (defun ,aux-name (num)
-             ;; When converting a number to a float, the limits are
-             ;; the same.
-             (let* ((lo (bound-func (lambda (x)
-                                      (coerce x ',type))
-                                    (numeric-type-low num)))
-                    (hi (bound-func (lambda (x)
-                                      (coerce x ',type))
-                                    (numeric-type-high num))))
-               (specifier-type `(,',type ,(or lo '*) ,(or hi '*)))))
-
-           (defoptimizer (,fun derive-type) ((num))
-             (one-arg-derive-type num #',aux-name #',fun))))))
-  (frob %single-float single-float)
-  (frob %double-float double-float))
+            (defun ,aux-name (num)
+              ;; When converting a number to a float, the limits are
+              ;; the same.
+              (let* ((lo (bound-func (lambda (x)
+                                       (if (< x ,most-negative)
+                                           ,most-negative
+                                           (coerce x ',type)))
+                                     (numeric-type-low num)))
+                     (hi (bound-func (lambda (x)
+                                       (if (< ,most-positive x )
+                                           ,most-positive
+                                           (coerce x ',type)))
+                                     (numeric-type-high num))))
+                (specifier-type `(,',type ,(or lo '*) ,(or hi '*)))))
+
+            (defoptimizer (,fun derive-type) ((num))
+              (one-arg-derive-type num #',aux-name #',fun))))))
+  (frob %single-float single-float
+        most-negative-single-float most-positive-single-float)
+  (frob %double-float double-float
+        most-negative-double-float most-positive-double-float))
 ) ; PROGN
 \f
 ;;;; float contagion