X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-random.lisp;h=af1e45fe88c11ee4535a16d30a475f9ace68ad23;hb=c25e4572f5505236faf126f38a74f32a80bf1e8c;hp=e82f7a0137ba18afcce0103fa205f2f92ecb453f;hpb=95a6db7329b91dd90d165dd4057b9b5098d34aa2;p=sbcl.git diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp index e82f7a0..af1e45f 100644 --- a/src/code/target-random.lisp +++ b/src/code/target-random.lisp @@ -61,21 +61,30 @@ 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))))))) ;;;; random entries @@ -182,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)) @@ -198,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)) @@ -249,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 "~@" :format-arguments (list arg)))))