X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-random.lisp;h=3e353829bc960415ee9d6351d5776f49fca8ec80;hb=5e4205cf17c3a04d4a8f6aed55c28b5a338caf47;hp=9937cd7d36b0f60a386c634b96444cec83a6a085;hpb=467a8e5dba8bfa2598ca8e22c1204dc173ce556f;p=sbcl.git

diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp
index 9937cd7..3e35382 100644
--- a/src/code/target-random.lisp
+++ b/src/code/target-random.lisp
@@ -21,6 +21,18 @@
 (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:
 ;;;
@@ -61,7 +73,7 @@
   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")
+  (/show0 "entering MAKE-RANDOM-STATE")
   (flet ((copy-random-state (state)
 	   (/show0 "entering COPY-RANDOM-STATE")
 	   (let ((state (random-state-state state))
@@ -152,6 +164,13 @@
 (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))))
 
 ;;; 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
@@ -190,8 +209,7 @@
   (* 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))
@@ -207,41 +225,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
 
@@ -259,16 +248,16 @@
 
 (defun random (arg &optional (state *random-state*))
   (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) (> arg 0))
      (rem (random-chunk state) arg))
-    ((and (typep arg 'single-float) (> arg 0.0S0))
+    ((and (typep arg 'single-float) (> arg 0.0f0))
      (%random-single-float arg state))
-    ((and (typep arg 'double-float) (> arg 0.0D0))
+    ((and (typep arg 'double-float) (> arg 0.0d0))
      (%random-double-float arg state))
     #!+long-float
-    ((and (typep arg 'long-float) (> arg 0.0L0))
+    ((and (typep arg 'long-float) (> arg 0.0l0))
      (%random-long-float arg state))
     ((and (integerp arg) (> arg 0))
      (%random-integer arg state))