Implement external representation for random-state objects.

diff --git a/v7/src/runtime/random.scm b/v7/src/runtime/random.scm
index 4f26cbbb10bc8e8782a0253d24dbd163149e7c41..db79b939f014eb291cb241f8ecf35e7be97d8ed6 100644 (file)
--- a/v7/src/runtime/random.scm
+++ b/v7/src/runtime/random.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: random.scm,v 14.29 2003/03/14 20:45:07 cph Exp $
+$Id: random.scm,v 14.30 2003/09/19 00:39:21 cph Exp $
 
 Copyright 1988,1989,1993,1994,1995,1996 Massachusetts Institute of Technology
 Copyright 1998,1999,2000,2001,2003 Massachusetts Institute of Technology
@@ -162,6 +162,51 @@ USA.
            (set! seed n)
            (int:quotient (* (- n 1) b) m-1)))))))
 \f
+(define-integrable ers:tag 'RANDOM-STATE-V1)
+(define-integrable ers:length (fix:+ r 3))
+
+(define (export-random-state state)
+  (if (not (random-state? state))
+      (error:wrong-type-argument state "random state" 'EXPORT-RANDOM-STATE))
+  (let ((v (make-vector ers:length)))
+    (vector-set! v 0 ers:tag)
+    (vector-set! v 1 (random-state-index state))
+    (vector-set! v 2 (inexact->exact (random-state-borrow state)))
+    (let ((v* (random-state-vector state)))
+      (do ((i 0 (fix:+ i 1))
+          (j 3 (fix:+ j 1)))
+         ((fix:= i r))
+       (vector-set! v j (inexact->exact (flo:vector-ref v* i)))))
+    v))
+
+(define (import-random-state v)
+  (let ((lose
+        (lambda ()
+          (error:wrong-type-argument v
+                                     "external random state"
+                                     'IMPORT-RANDOM-STATE))))
+    (if (not (and (vector? v)
+                 (fix:= (vector-length v) ers:length)
+                 (eq? (vector-ref v 0) ers:tag)))
+       (lose))
+    (let ((index (vector-ref v 1))
+         (borrow (vector-ref v 2))
+         (v* (flo:vector-cons r)))
+      (if (not (and (index-fixnum? index)
+                   (fix:< index r)
+                   (index-fixnum? borrow)
+                   (fix:< borrow 2)))
+         (lose))
+      (do ((i 3 (fix:+ i 1))
+          (j 0 (fix:+ j 1)))
+         ((fix:= j r))
+       (let ((n (vector-ref v i)))
+         (if (not (and (exact-nonnegative-integer? n)
+                       (< n b)))
+             (lose))
+         (flo:vector-set! v* j (exact->inexact n))))
+      (%make-random-state index (exact->inexact borrow) v*))))
+\f
 ;;; The RANDOM-STATE data abstraction must be built by hand because
 ;;; the random-number generator is needed in order to build the record
 ;;; abstraction.
@@ -175,7 +220,7 @@ USA.
        (eq? (vector-ref object 0) random-state-tag)))
 
 (define-integrable random-state-tag
-  ((ucode-primitive string->symbol) "#[(runtime random-number)random-state]"))
+  '|#[(runtime random-number)random-state]|)
 
 (define-integrable (random-state-index s) (vector-ref s 1))
 (define-integrable (set-random-state-index! s x) (vector-set! s 1 x))

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 800898051ccbe35d11d01c2325557e9fc6d9ff26..d1f35fe57bcbf631ab30de6c5e5fb9872dfa8ee1 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.456 2003/09/09 03:46:09 cph Exp $
+$Id: runtime.pkg,v 14.457 2003/09/19 00:39:32 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -2653,7 +2653,9 @@ USA.
   (parent (runtime))
   (export ()
          *random-state*
+         export-random-state
          flo:random-unit
+         import-random-state
          make-random-state
          random
          random-byte-vector