Index: /branches/new-random/level-1/l1-numbers.lisp
===================================================================
--- /branches/new-random/level-1/l1-numbers.lisp	(revision 13312)
+++ /branches/new-random/level-1/l1-numbers.lisp	(revision 13313)
@@ -422,4 +422,5 @@
       nil)))
 
+#-x86-target
 (defun %cons-random-state (seed-1 seed-2)
   #+32-bit-target
@@ -431,4 +432,5 @@
 ;;; 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,9 +440,56 @@
     (%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,5 +507,27 @@
     (%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
