X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-random.lisp;h=97acbf8ada59fc87b7287a6d5e2c912974b8b3f7;hb=67dc5cf478dfe5e3f517001febb9a8f7b922eacf;hp=42e1a589c041bf921051ccf3f5d8d43e05aef093;hpb=8fc5fda05f92d69c95b47e4ad7561d91dab18c3e;p=sbcl.git diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp index 42e1a58..97acbf8 100644 --- a/src/code/target-random.lisp +++ b/src/code/target-random.lisp @@ -15,15 +15,24 @@ ;;;; files for more information. (in-package "SB!KERNEL") - -(file-comment - "$Header$") ;;;; RANDOM-STATEs (def!method make-load-form ((random-state random-state) &optional environment) (make-load-form-saving-slots random-state :environment environment)) +(def!method print-object ((state random-state) stream) + (if (and *print-readably* (not *read-eval*)) + (error 'print-not-readable :object state) + (format stream "#S(~S ~S #.~S)" + 'random-state + ':state + `(make-array 627 + :element-type + '(unsigned-byte 32) + :initial-contents + ',(coerce (random-state-state state) 'list))))) + ;;; The state is stored in a (simple-array (unsigned-byte 32) (627)) ;;; wrapped in a random-state structure: ;;; @@ -60,25 +69,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 MAKE-RANDOM-STATE") (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 @@ -185,7 +203,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,41 +219,12 @@ (- (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)) 1d0)))) -#!+long-float -(declaim #!-sb-fluid (inline %random-long-float)) -#!+long-float -(declaim (ftype (function ((long-float (0l0)) random-state) (long-float 0l0)) - %random-long-float)) - -;;; using a faster inline VOP -#!+(and long-float x86) -(defun %random-long-float (arg state) - (declare (type (long-float (0l0)) arg) - (type random-state state)) - (let ((state-vector (random-state-state state))) - (* arg - (- (sb!impl::make-long-float - (sb!impl::long-float-exp-bits 1l0) - (logior (sb!vm::random-mt19937 state-vector) - sb!vm:long-float-hidden-bit) - (sb!vm::random-mt19937 state-vector)) - 1l0)))) - -#!+(and long-float sparc) -(defun %random-long-float (arg state) - (declare (type (long-float (0l0)) arg) - (type random-state state)) - (* arg - (- (sb!impl::make-long-float - (sb!impl::long-float-exp-bits 1l0) ; X needs more work - (random-chunk state) (random-chunk state) (random-chunk state)) - 1l0))) ;;;; random integers @@ -252,25 +241,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)) + #!+long-float %random-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.0f0)) (%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)))))