0.pre7.76:

[sbcl.git] / src / code / target-random.lisp

diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp
index 42e1a58..af1e45f 100644 (file)
--- a/src/code/target-random.lisp
+++ b/src/code/target-random.lisp
@@ -15,9 +15,6 @@
 ;;;; files for more information.
 
 (in-package "SB!KERNEL")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; RANDOM-STATEs
 
@@ -60,25 +57,34 @@
 
 (defun make-random-state (&optional state)
   #!+sb-doc
-  "Make a random state object. If State is not supplied, return a copy
-  of the default random state. If State is a random state, then return a
-  copy of it. If state is T then return a random state generated from
+  "Make a random state object. If STATE is not supplied, return a copy
+  of the default random state. If STATE is a random state, then return a
+  copy of it. If STATE is T then return a random state generated from
   the universal time."
+  (/show0 "entering !RANDOM-COLD-INIT")
   (flet ((copy-random-state (state)
+          (/show0 "entering COPY-RANDOM-STATE")
           (let ((state (random-state-state state))
                 (new-state
                  (make-array 627 :element-type '(unsigned-byte 32))))
+            (/show0 "made NEW-STATE, about to DOTIMES")
             (dotimes (i 627)
               (setf (aref new-state i) (aref state i)))
+            (/show0 "falling through to %MAKE-RANDOM-STATE")
             (%make-random-state :state new-state))))
-    (cond ((not state) (copy-random-state *random-state*))
-         ((random-state-p state) (copy-random-state state))
-         ((eq state t)
-          (%make-random-state :state (init-random-state
-                                      (logand (get-universal-time)
-                                              #xffffffff))))
-         ;; FIXME: should be TYPE-ERROR?
-         (t (error "Argument is not a RANDOM-STATE, T or NIL: ~S" state)))))
+    (/show0 "at head of ETYPECASE in MAKE-RANDOM-STATE")
+    (etypecase state
+      (null
+       (/show0 "NULL case")
+       (copy-random-state *random-state*))
+      (random-state
+       (/show0 "RANDOM-STATE-P clause")
+       (copy-random-state state))
+      ((member t)
+       (/show0 "T clause")
+       (%make-random-state :state (init-random-state
+                                  (logand (get-universal-time)
+                                          #xffffffff)))))))
 \f
 ;;;; random entries
 
@@ -185,7 +191,7 @@
      (- (sb!impl::make-double-float
         (dpb (ash (random-chunk state)
                   (- sb!vm:double-float-digits random-chunk-length
-                     sb!vm:word-bits))
+                     sb!vm:n-word-bits))
              sb!vm:double-float-significand-byte
              (sb!impl::double-float-high-bits 1d0))
         (random-chunk state))
@@ -201,7 +207,7 @@
        (- (sb!impl::make-double-float
           (dpb (ash (sb!vm::random-mt19937 state-vector)
                     (- sb!vm:double-float-digits random-chunk-length
-                       sb!vm:word-bits))
+                       sb!vm:n-word-bits))
                sb!vm:double-float-significand-byte
                (sb!impl::double-float-high-bits 1d0))
           (sb!vm::random-mt19937 state-vector))
@@ -252,25 +258,23 @@
       (declare (fixnum count)))))
 
 (defun random (arg &optional (state *random-state*))
-  #!+sb-doc
-  "Generate a uniformly distributed pseudo-random number between zero
-  and Arg. State, if supplied, is the random state to use."
   (declare (inline %random-single-float %random-double-float
                   #!+long-float %long-float))
   (cond
-    ((and (fixnump arg) (<= arg random-fixnum-max) #!+high-security (> arg 0))
+    ((and (fixnump arg) (<= arg random-fixnum-max) (> arg 0))
      (rem (random-chunk state) arg))
-    ((and (typep arg 'single-float) #!+high-security (> arg 0.0S0))
+    ((and (typep arg 'single-float) (> arg 0.0S0))
      (%random-single-float arg state))
-    ((and (typep arg 'double-float) #!+high-security (> arg 0.0D0))
+    ((and (typep arg 'double-float) (> arg 0.0D0))
      (%random-double-float arg state))
     #!+long-float
-    ((and (typep arg 'long-float) #!+high-security (> arg 0.0L0))
+    ((and (typep arg 'long-float) (> arg 0.0L0))
      (%random-long-float arg state))
-    ((and (integerp arg) #!+high-security (> arg 0))
+    ((and (integerp arg) (> arg 0))
      (%random-integer arg state))
     (t
      (error 'simple-type-error
            :expected-type '(or (integer 1) (float (0))) :datum arg
-           :format-control "Argument is not a positive integer or a positive float: ~S"
+           :format-control "~@<Argument is neither a positive integer nor a ~
+                             positive float: ~2I~_~S~:>"
            :format-arguments (list arg)))))