Changeset 13313

Timestamp:

Dec 21, 2009, 3:54:55 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

Move INIT-RANDOM-STATE-SEEDS here from ccl:level-0;l0-numbers.lisp.

Add functions to create random state objects used by the new random
number generator, namely: %cons-mrg31k3p-state, initialize-mrg31k3p-state,
and random-mrg31k3p-state.

New function INITIAL-RANDOM-STATE, used to return the initial random
state used by a thread.

Updated make-random-state to create random state objects for the
mrg31k3p generator. x86-only for the moment, but PPC will follow
shortly.

New function %random-state-equalp, called from equalp.

File:

• branches/new-random/level-1/l1-numbers.lisp (modified) (4 diffs)

branches/new-random/level-1/l1-numbers.lisp

@@ -422 +422 @@
       nil)))
 
+#-x86-target
 (defun %cons-random-state (seed-1 seed-2)
   #+32-bit-target
@@ -431 +432 @@
 ;;; random associated stuff except for the print-object method which
 ;;; is still in "lib;numbers.lisp"
+#-x86-target
 (defun initialize-random-state (seed-1 seed-2)
   (unless (and (fixnump seed-1) (%i<= 0 seed-1) (%i< seed-1 #x10000))
@@ -438 +440 @@
     (%cons-random-state seed-1 seed-2))
 
+(defun init-random-state-seeds ()
+  (let* ((ticks (ldb (byte 32 0)
+                     (+ (mixup-hash-code (%current-tcr))
+                        (let* ((iface (primary-ip-interface)))
+                          (or (and iface (ip-interface-addr iface))
+                              0))
+                        (mixup-hash-code
+                         (logand (get-internal-real-time)
+                                 (1- target::target-most-positive-fixnum))))))
+         (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks)))
+         (low (ldb (byte 16 0) ticks)))
+    (declare (fixnum high low))
+    (values high low)))
+
+(defun %cons-mrg31k3p-state (x0 x1 x2 x3 x4 x5)
+  (let ((array (make-array 6 :element-type '(unsigned-byte 32)
+                           :initial-contents (list x0 x1 x2 x3 x4 x5))))
+    (%istruct 'random-state array)))
+
+(defun initialize-mrg31k3p-state (x0 x1 x2 x3 x4 x5)
+  (let ((args (list x0 x1 x2 x3 x4 x5)))
+    (declare (dynamic-extent args))
+    (dolist (a args)
+      (unless (and (fixnump a) (%i<= 0 a) (< a mrg31k3p-limit))
+        (report-bad-arg a `(integer 0 (,mrg31k3p-limit)))))
+    (when (and (zerop x0) (zerop x1) (zerop x2))
+      (error "The first three arguments must not all be zero."))
+    (when (and (zerop x3) (zerop x4) (zerop x5))
+      (error "The second three arguments must not all be zero."))
+    (%cons-mrg31k3p-state x0 x1 x2 x3 x4 x5)))
+
+(defun random-mrg31k3p-state ()
+  (loop repeat 6
+        for n = (init-random-state-seeds)
+        ;; The first three seed elements must not be all zero, and
+        ;; likewise for the second three.  Avoid the issue by
+        ;; excluding zero values.
+        collect (1+ (mod n (1- mrg31k3p-limit))) into seed
+        finally (return (apply #'%cons-mrg31k3p-state seed))))
+
+(defun initial-random-state ()
+  #-x86-target
+  (initialize-random-state #xFBF1 9)
+  #+x86-target
+  (initialize-mrg31k3p-state 12345 12345 12345 12345 12345 12345))
+
+#-x86-target
 (defun make-random-state (&optional state)
-  "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."
+  "Make a new 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 randomly
+  initialized random state."
   (let* ((seed-1 0)
          (seed-2 0))
@@ -458 +507 @@
     (%cons-random-state seed-1 seed-2)))
 
+#+x86-target
+(defun make-random-state (&optional state)
+  "Make a new random state object. If STATE is not supplied, return a
+  copy of the current random state. If STATE is a random state, then
+  return a copy of it. If STATE is T then return a randomly
+  initialized random state."
+  (if (eq state t)
+    (random-mrg31k3p-state)
+    (progn
+      (setq state (require-type (or state *random-state*) 'random-state))
+      (let ((seed (coerce (random.mrg31k3p-state state) 'list)))
+        (apply #'%cons-mrg31k3p-state seed)))))
+
 (defun random-state-p (thing) (istruct-typep thing 'random-state))
+
+(defun %random-state-equalp (x y)
+  ;; x and y are both random-state objects
+  #-x86-target
+  (and (= (random.seed-1 x) (random.seed-1 y))
+       #+32-bit-target
+       (= (random.seed-2 x) (random.seed-2 y)))
+  #+x86-target
+  (equalp (random.mrg31k3p-state x) (random.mrg31k3p-state y)))
 
 ;;; transcendental stuff.  Should go in level-0;l0-float