Changeset 7258

Timestamp:

Sep 19, 2007, 9:48:44 AM (14 years ago)

Author:

gb

Message:

random: do 32-bits at a time on 64-bit lisps, do fixnum random more sanely.
64-bit random state keeps 32-bit seed in seed1 field, seed2 unused.

File:

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

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

@@ -1722 +1722 @@
 
 
+#+32-bit-target
 (defun random (number &optional (state *random-state*))
   (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
@@ -1729 +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))
@@ -1738 +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)))))))
+
 
 #|
@@ -1760 +1786 @@
 
 What makes this generator so simple is that multiplication and addition mod
-2^n-1 is easy.  See Knuth Ch. 4.3.2 (2nd Ed. p 272).
+  2^n-1 is easy.  See Knuth Ch. 4.3.2 (2nd Ed. p 272).
 
     ab mod m = ...
@@ -1780 +1806 @@
 
 #+64-bit-target
-(defun %next-random-pair (high low)
-  (declare (type (unsigned-byte 16) high low))
-  (let* ((n0
-          (%i* 42871
-             (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)
@@ -1803 +1822 @@
     (logior high (the fixnum (logand low (ash 1 15))))))
 
-
+#+32-bit-target
 (defun %bignum-random (number state)
   (let* ((bits (+ (integer-length number) 8))
@@ -1832 +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)