1.0.4.8:

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

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 1cb39f6..a4672e5 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -43,6 +43,59 @@
                 '(,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