From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 7 Nov 2018 05:33:52 +0000 (+0000)
Subject: New procedure (bytevector-zero-explicit! <bv> [<start> [<end>]]).
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~116^2~34
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a603570afea9bba562a47f25c41558e85cf02982;p=mit-scheme.git

New procedure (bytevector-zero-explicit! <bv> [<start> [<end>]]).

Intended to zero the memory backing a bytevector even if the values
will never be used again and an aggressively optimizing compiler can
prove that.

Doesn't actually work (GC can move stuff without zeroing it) but it
may help to have it in order to tag where it _would_ be needed if we
could make it work in the future.
---

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 6ab44e1fd..23080deb6 100644
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -79,6 +79,10 @@ USA.
    (if (default-object? start) 0 start)
    (if (default-object? end) (bytevector-length bytevector) end)))
 
+(define (bytevector-zero-explicit! bytevector #!optional start end)
+  ;; Don't let any compiler optimize this away.
+  ((identity-procedure bytevector-fill!) bytevector 0 start end))
+
 (define (bytevector-copy bytevector #!optional start end)
   ((ucode-primitive bytevector-copy 3)
    bytevector
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index fdd05d79f..cd40c1ba0 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1178,6 +1178,7 @@ USA.
 	  bytevector-u32le-set!
 	  bytevector-u8-ref
 	  bytevector-u8-set!
+	  bytevector-zero-explicit!
 	  bytevector=?
 	  bytevector?
 	  exact-nonnegative-integer->bytevector
diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm
index 0226880f6..e78c70c1c 100644
--- a/tests/runtime/test-bytevector.scm
+++ b/tests/runtime/test-bytevector.scm
@@ -180,6 +180,27 @@ USA.
        (lambda ()
 	 (bytevector-fill! (make-bytevector n) 51 -1 n))))))
 
+(define-test 'bytevector-zero-explicit!
+  ;; Can't really test what we want here -- that the bytevector is
+  ;; zero'd in memory even if the compiler can prove its value is not
+  ;; used afterward.  Worse, we can't even really guarantee this,
+  ;; because the GC might have copied it already and we have no way to
+  ;; zero the original.
+  (lambda ()
+    (let ((bv (make-bytevector 3 #xff)))
+      (bytevector-zero-explicit! bv 1 2)
+      (assert-= (bytevector-u8-ref bv 0) #xff)
+      (assert-= (bytevector-u8-ref bv 1) 0)
+      (assert-= (bytevector-u8-ref bv 2) #xff)
+      (bytevector-zero-explicit! bv 1)
+      (assert-= (bytevector-u8-ref bv 0) #xff)
+      (assert-= (bytevector-u8-ref bv 1) 0)
+      (assert-= (bytevector-u8-ref bv 2) 0)
+      (bytevector-zero-explicit! bv 0)
+      (assert-= (bytevector-u8-ref bv 0) 0)
+      (assert-= (bytevector-u8-ref bv 1) 0)
+      (assert-= (bytevector-u8-ref bv 2) 0))))
+
 (define (test-bytevector-properties v bytes)
   (assert-true (bytevector? v))
   (assert-= (bytevector-length v) (length bytes))