Implement bytevector-fill! and change arg order to match R7Rs.

diff --git a/src/microcode/bytevector.c b/src/microcode/bytevector.c
index 8b1eb5122405252d34d18c27270ef2d510b8f4ce..cf103da2985c0a956bfa4dbffa62675d5233abd7 100644 (file)
--- a/src/microcode/bytevector.c
+++ b/src/microcode/bytevector.c
@@ -127,9 +127,9 @@ DEFINE_PRIMITIVE ("bytevector-fill!", Prim_bytevector_fill, 4, 4, 0)
   {
     unsigned long length;
     uint8_t * v = (arg_bytevector (1, (&length)));
-    unsigned long end = (arg_ulong_index_integer (3, (length + 1)));
-    unsigned long start = (arg_ulong_index_integer (2, (end + 1)));
-    uint8_t value = (arg_byte (4));
+    uint8_t value = (arg_byte (2));
+    unsigned long end = (arg_ulong_index_integer (4, (length + 1)));
+    unsigned long start = (arg_ulong_index_integer (3, (end + 1)));
     memset ((v + start), value, (end - start));
   }
   PRIMITIVE_RETURN (UNSPECIFIC);

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index f01d322a51490d6c3cb21e632dd6b0c9b5601f30..5fdd04ee3cc026641b15c5db2bf5e1c823f77885 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -35,7 +35,6 @@ USA.
 
 (define-primitives
   (allocate-bytevector 1)
-  (bytevector-fill! 4)
   (bytevector-length 1)
   (bytevector-u8-ref 2)
   (bytevector-u8-set! 3)
@@ -49,7 +48,7 @@ USA.
 (define (make-bytevector k #!optional byte)
   (let ((bytevector (allocate-bytevector k)))
     (if (not (default-object? byte))
-       (bytevector-fill! bytevector 0 k byte))
+       (bytevector-fill! bytevector byte 0 k))
     bytevector))
 
 (define (bytevector . bytes)
@@ -72,6 +71,13 @@ USA.
       (bytevector-copy! bytevector index (car bytevectors)))
     bytevector))
 
+(define (bytevector-fill! bytevector fill #!optional start end)
+  ((ucode-primitive bytevector-fill! 4)
+   bytevector
+   fill
+   (if (default-object? start) 0 start)
+   (if (default-object? end) (bytevector-length bytevector) 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 c106c2a8644016d28f8ae72f3570be6d89593cc8..5cf6b9366c7bb5f6ead9f3a2b47a650d406fb28f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1125,6 +1125,7 @@ USA.
          bytevector-append
          bytevector-copy
          bytevector-copy!
+         bytevector-fill!
          bytevector-length
          bytevector-u8-ref
          bytevector-u8-set!

diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm
index 0fe5de2bc7e7fce0dc3c9fffce2c6798accfe758..cda1d3db316ff42202dc21dcc62be3b7e1847a49 100644 (file)
--- a/tests/runtime/test-bytevector.scm
+++ b/tests/runtime/test-bytevector.scm
@@ -153,6 +153,32 @@ USA.
           (v (apply bytevector bytes)))
       (bytevector-copy! v 5 v 3 7)
       (assert-equal v (bytevector 15 14 13 12 11 12 11 10 9 6 5 4 3 2 1 0)))))
+\f
+(define-test 'bytevector-fill!
+  (lambda ()
+    (do ((n 0 (+ n 1)))
+       ((not (< n 16)))
+      (let ((bytes (reverse (iota n))))
+       (do ((end 0 (+ end 1)))
+           ((> end n))
+         (do ((start 0 (+ start 1)))
+             ((> start end))
+           (let ((v (apply bytevector bytes)))
+             (bytevector-fill! v 51 start end)
+             (assert-equal v
+                           (apply bytevector
+                                  (append (sublist bytes 0 start)
+                                          (make-list (- end start) 51)
+                                          (sublist bytes end n))))))))
+      (assert-range-error
+       (lambda ()
+        (bytevector-fill! (make-bytevector n) 51 0 (+ n 1))))
+         (assert-range-error
+          (lambda ()
+            (bytevector-fill! (make-bytevector n) 51 n (+ n 1))))
+         (assert-range-error
+          (lambda ()
+            (bytevector-fill! (make-bytevector n) 51 -1 n))))))
 
 (define (test-bytevector-properties v bytes)
   (assert-true (bytevector? v))