From 297cf27846f944fd03dc1c0199d0192aa43084ba Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 27 Nov 2018 02:24:54 +0000 Subject: [PATCH] Implement random-bytevector!. --- src/runtime/random.scm | 68 +++++++++++++++++++---------------- src/runtime/runtime.pkg | 1 + tests/runtime/test-random.scm | 19 ++++++++++ 3 files changed, 58 insertions(+), 30 deletions(-) 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 -- 2.25.1