From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 27 Nov 2018 02:24:54 +0000 (+0000)
Subject: Implement random-bytevector!.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~169
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=297cf27846f944fd03dc1c0199d0192aa43084ba;p=mit-scheme.git

Implement random-bytevector!.
---

diff --git a/src/runtime/random.scm b/src/runtime/random.scm
index 3ed4509c2..7a4e30cc0 100644
--- 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))
 
 ;;;; Integers
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index bf4146471..3eef506f6 100644
--- 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 242380b68..7ffc1c1d1 100644
--- 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)))))
 
 ;;; Stochastic tests