(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:
;;;
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)))))))
\f
;;;; random entries
(defun random-chunk (state)
(declare (type random-state state))
(sb!vm::random-mt19937 (random-state-state state)))
+
+#!-sb-fluid (declaim (inline big-random-chunk))
+(defun big-random-chunk (state)
+ (declare (type random-state state))
+ (logand (1- (expt 2 64))
+ (logior (ash (random-chunk state) 32)
+ (random-chunk state))))
\f
;;; Handle the single or double float case of RANDOM. We generate a
;;; float between 0.0 and 1.0 by clobbering the significand of 1.0
(* arg
(- (sb!impl::make-double-float
(dpb (ash (random-chunk state)
- (- sb!vm:double-float-digits random-chunk-length
- sb!vm:word-bits))
+ (- sb!vm:double-float-digits random-chunk-length 32))
sb!vm:double-float-significand-byte
(sb!impl::double-float-high-bits 1d0))
(random-chunk state))
(- (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)))
\f
;;;; random integers
(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 "~@<Argument is neither a positive integer nor a ~
+ positive float: ~2I~_~S~:>"
:format-arguments (list arg)))))
projects / sbcl.git / blobdiff