Implement random-bytevector!.

diff --git a/src/runtime/random.scm b/src/runtime/random.scm
index 3ed4509c28c8bcdea0374c1e9ab6e63d200c9527..7a4e30cc002a763c952470497041dc47e5f120ab 100644 (file)
--- a/src/runtime/random.scm
+++ b/src/runtime/random.scm
@@ -233,44 +233,52 @@ USA.
 
 (define-integrable chacha20-core (ucode-primitive chacha20-core 5))
 
-(define (%random-bytevector-short! bv state)
+(define (%random-bytevector-short! bv start end state)
   (let ((key (random-state-key state))
        (output (allocate-bytevector 64)))
     (chacha20-core output 0 zero16 key chacha-const)
     (bytevector-copy! key 0 output 0 32)
-    (bytevector-copy! bv 0 output 32 (fix:+ 32 (bytevector-length bv)))
+    (bytevector-copy! bv start output 32 (fix:+ 32 (fix:- end start)))
     (bytevector-zero-explicit! output)))
 
+(define (random-bytevector! bv #!optional start end state)
+  (let* ((end (fix:end-index end (bytevector-length bv) 'random-bytevector!))
+         (start (fix:start-index start end 'random-bytevector!))
+         (n (- end start)))
+    (if (fix:< n 32)
+        (with-random-state state 'random-bytevector
+          (lambda (state)
+            ;; Small enough to be serviced in a single request.
+            (%random-bytevector-short! bv start end state)))
+        (let ((key (allocate-bytevector 32))
+              (nonce (make-bytevector 16 0)))
+          ;; Grab a key in a single request; then derive a long byte
+          ;; vector from the key.
+          (with-random-state state 'random-bytevector
+            (lambda (state)
+              (%random-bytevector-short! key 0 32 state)))
+          (let ((n/64 (fix:quotient n 64)))
+            (do ((i 0 (fix:+ i 1)))
+                ((fix:>= i n/64))
+              (chacha20-core bv (fix:+ start (fix:* i 64))
+                             nonce key chacha-const)
+              (let loop ((j 0) (t 1))
+                (if (fix:< j 8)
+                    (let ((t (fix:+ t (bytevector-u8-ref nonce j))))
+                      (bytevector-u8-set! nonce j (fix:and t #xff))
+                      (loop (fix:+ j 1) (fix:lsh t -8))))))
+            (let* ((rem (fix:- n (fix:* n/64 64))))
+              (if (fix:positive? rem)
+                  (let ((output (allocate-bytevector 64)))
+                    (chacha20-core output 0 nonce key chacha-const)
+                    (bytevector-copy! bv (fix:+ start (fix:* n/64 64))
+                                      output 0 rem)
+                    (bytevector-zero-explicit! output))))
+            (bytevector-zero-explicit! key))))))
+
 (define (random-bytevector n #!optional state)
   (let ((bytes (allocate-bytevector n)))
-    (if (fix:< n 32)
-       (with-random-state state 'random-bytevector
-         (lambda (state)
-           ;; Small enough to be serviced in a single request.
-           (%random-bytevector-short! bytes state)))
-       (let ((key (allocate-bytevector 32))
-             (nonce (make-bytevector 16 0)))
-         ;; Grab a key in a single request; then derive a long byte
-         ;; vector from the key.
-         (with-random-state state 'random-bytevector
-           (lambda (state)
-             (%random-bytevector-short! key state)))
-         (let ((n/64 (fix:quotient n 64)))
-           (do ((i 0 (fix:+ i 1)))
-               ((fix:>= i n/64))
-             (chacha20-core bytes (fix:* i 64) nonce key chacha-const)
-             (let loop ((j 0) (t 1))
-               (if (fix:< j 8)
-                   (let ((t (fix:+ t (bytevector-u8-ref nonce j))))
-                     (bytevector-u8-set! nonce j (fix:and t #xff))
-                     (loop (fix:+ j 1) (fix:lsh t -8))))))
-           (let* ((rem (fix:- n (fix:* n/64 64))))
-             (if (fix:positive? rem)
-                 (let ((output (allocate-bytevector 64)))
-                   (chacha20-core output 0 nonce key chacha-const)
-                   (bytevector-copy! bytes (fix:* n/64 64) output 0 rem)
-                   (bytevector-zero-explicit! output))))
-           (bytevector-zero-explicit! key))))
+    (random-bytevector! bytes 0 n state)
     bytes))
 \f
 ;;;; Integers

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index bf4146471f5cded480b0bb08407317b857b9acc0..3eef506f62cce557d27dc9819ebb8b0b7ad5ad31 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3805,6 +3805,7 @@ USA.
          make-random-state
          random
          random-bytevector
+         random-bytevector!
          random-integer
          random-real
          random-source-make-integers

diff --git a/tests/runtime/test-random.scm b/tests/runtime/test-random.scm
index 242380b68a9d170198b7ecff9c7475dbcc2dbe20..7ffc1c1d1605edb467ef158e21f1241a0cdc2ece 100644 (file)
--- a/tests/runtime/test-random.scm
+++ b/tests/runtime/test-random.scm
@@ -121,6 +121,25 @@ USA.
 (define-random-test 'random/rational
   (lambda (state)
     (assert-error (lambda () (random 1/4 state)))))
+
+(define-random-test 'random-bytevector!/short
+  (lambda (state)
+    (let ((bv (make-bytevector 32 0))
+          (state* (make-random-state state)))
+      (random-bytevector! bv 3 20 state)
+      (assert-equal (bytevector-copy bv 0 3) (make-bytevector 3 0))
+      (assert-equal (bytevector-copy bv 3 20) (random-bytevector 17 state*))
+      (assert-equal (bytevector-copy bv 20 32) (make-bytevector  12 0)))))
+
+(define-random-test 'random-bytevector!/long
+  (lambda (state)
+    (let ((bv (make-bytevector 3000 0))
+          (state* (make-random-state state)))
+      (random-bytevector! bv 1000 2000 state)
+      (assert-equal (bytevector-copy bv 0 1000) (make-bytevector 1000 0))
+      (assert-equal (bytevector-copy bv 1000 2000)
+                    (random-bytevector 1000 state*))
+      (assert-equal (bytevector-copy bv 2000 3000) (make-bytevector 1000 0)))))
 \f
 ;;; Stochastic tests