Changeset 7395 for branches

Timestamp:

Oct 12, 2007, 2:27:23 AM (17 years ago)

Author:

Gary Byers

Message:

64/32-bit random-state changes.

File:

• branches/working-0710/ccl/level-0/l0-numbers.lisp (modified) (7 diffs)

branches/working-0710/ccl/level-0/l0-numbers.lisp

@@ -1715 +1715 @@
 
 (defun init-random-state-seeds ()
-  (let* ((ticks (ldb (byte 32 0) (+ (mixup-hash-code (%current-tcr))
-                                    (primary-ip-interface-address)
-                                    (mixup-hash-code
-                                     (logand (get-internal-real-time)
-                                             (1- most-positive-fixnum))))))
-         (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks)))
+  (let* ((ticks (ldb (byte 32 0) (get-internal-real-time)))
+         (high (ldb (byte 16 16) ticks)) 
          (low (ldb (byte 16 0) ticks)))
     (declare (fixnum high low))
@@ -1726 +1722 @@
 
 
+#+32-bit-target
 (defun random (number &optional (state *random-state*))
   (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
@@ -1733 +1730 @@
         (if (< number 65536)
           (fast-mod (%next-random-seed state) number)
-          (%bignum-random number state))))
+          (let* ((n 0)
+                 (nhalf (ash (+ 15 (integer-length number)) -4)))
+            (declare (fixnum n nhalf))
+            (dotimes (i nhalf (fast-mod n number))
+              (setq n (logior (the fixnum (ash n 16))
+                              (the fixnum (%next-random-seed state)))))))))
      ((and (typep number 'double-float) (> (the double-float number) 0.0))
       (%float-random number state))
@@ -1742 +1744 @@
      (t (report-bad-arg number '(or (integer (0)) (float (0.0)))))))
 
+#+64-bit-target
+(defun random (number &optional (state *random-state*))
+  (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
+  (cond
+    ((and (fixnump number) (> (the fixnum number) 0))
+     (locally (declare (fixnum number))
+       (let* ((n 0)
+              (n32 (ash (+ 31 (integer-length number)) -5)))
+         (declare (fixnum n n32))
+         (dotimes (i n32 (fast-mod n number))
+           (setq n (logior (the fixnum (ash n 16))
+                           (the fixnum (%next-random-seed state))))))))
+    ((and (typep number 'double-float) (> (the double-float number) 0.0))
+     (%float-random number state))
+    ((and (typep number 'short-float) (> (the short-float number) 0.0s0))
+     (%float-random number state))
+    ((and (bignump number) (> number 0))
+     (%bignum-random number state))
+    (t (report-bad-arg number '(or (integer (0)) (float (0.0)))))))
+
 
 #|
@@ -1784 +1806 @@
 
 #+64-bit-target
-(defun %next-random-pair (high low)
-  (declare (type (unsigned-byte 16) high low))
-  (let* ((n0
-          (%i* 48271
-             (the  (unsigned-byte 31)
-               (logior (the (unsigned-byte 31)
-                         (ash (ldb (byte 15 0) high) 16))
-                       (the (unsigned-byte 16)
-                         (ldb (byte 16 0) low))))))
-         (n (fast-mod n0 (1- (expt 2 31)))))
+(defun %next-random-seed (state)
+  (let* ((n (the fixnum (* (the fixnum (random.seed-1 state)) 48271))))
     (declare (fixnum n))
-    (values (ldb (byte 15 16) n)
-            (ldb (byte 16 0) n))))
-
+    (setf (random.seed-1 state) (fast-mod n (1- (expt 2 31))))
+    (logand n (1- (ash 1 32)))))
+
+#+32-bit-target
 (defun %next-random-seed (state)
   (multiple-value-bind (high low) (%next-random-pair (%svref state 1)
@@ -1807 +1822 @@
     (logior high (the fixnum (logand low (ash 1 15))))))
 
-
+#+32-bit-target
 (defun %bignum-random (number state)
   (let* ((bits (+ (integer-length number) 8))
@@ -1836 +1851 @@
 
 (defun %float-random (number state)
-  (if (zerop number)
-    number
-    (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
-      (declare (dynamic-extent ratio))
-      (* number ratio))))
+  (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
+    (declare (dynamic-extent ratio))
+    (* number ratio)))
 
 (eval-when (:compile-toplevel :execute)