* added bytevector-s8-set! and bytevector-u8-set!.

src/ikarus.bytevectors.ss

@@ -0,0 +1,75 @@
+
+(library (ikarus bytevectors)
+  (export make-bytevector bytevector-length bytevector-s8-ref
+          bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!)
+  (import 
+    (except (ikarus) 
+        make-bytevector bytevector-length bytevector-s8-ref
+        bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!)
+    (ikarus system $fx)
+    (ikarus system $bytevectors))
+
+  (define ($bytevector-fill x i j fill)
+    (cond
+      [($fx= i j) x]
+      [else
+       ($bytevector-set! x i fill)
+       ($bytevector-fill x ($fxadd1 i) j fill)]))
+
+  (define make-bytevector
+    (case-lambda 
+      [(k) 
+       (if (and (fixnum? k) ($fx>= k 0))
+           ($make-bytevector k)
+           (error 'make-bytevector "~s is not a valid size" k))]
+      [(k fill)
+       (if (and (fixnum? fill) ($fx<= -128 fill) ($fx<= fill 255))
+           ($bytevector-fill (make-bytevector k) 0 k fill)
+           (error 'make-bytevector "~s is not a valid fill" fill))]))
+
+  (define bytevector-length
+    (lambda (x)
+      (if (bytevector? x)
+          ($bytevector-length x)
+          (error 'bytevector-length "~s is not a bytevector" x))))
+
+  (define bytevector-s8-ref
+    (lambda (x i)
+      (if (bytevector? x)
+          (if (and (fixnum? i) ($fx<= 0 i) ($fx< i ($bytevector-length x)))
+              ($bytevector-s8-ref x i)
+              (error 'bytevector-s8-ref "invalid index ~s for ~s" i x))
+          (error 'bytevector-s8-ref "~s is not a bytevector" x))))
+
+  (define bytevector-u8-ref
+    (lambda (x i)
+      (if (bytevector? x)
+          (if (and (fixnum? i) ($fx<= 0 i) ($fx< i ($bytevector-length x)))
+              ($bytevector-u8-ref x i)
+              (error 'bytevector-u8-ref "invalid index ~s for ~s" i x))
+          (error 'bytevector-u8-ref "~s is not a bytevector" x))))
+
+
+  (define bytevector-s8-set!
+    (lambda (x i v)
+      (if (bytevector? x)
+          (if (and (fixnum? i) ($fx<= 0 i) ($fx< i ($bytevector-length x)))
+              (if (and (fixnum? v) ($fx<= -128 v) ($fx<= v 127)) 
+                  ($bytevector-set! x i v)
+                  (error 'bytevector-s8-set! "~s is not a byte" v))
+              (error 'bytevector-s8-set! "invalid index ~s for ~s" i x))
+          (error 'bytevector-s8-set! "~s is not a bytevector" x))))
+  
+  (define bytevector-u8-set!
+    (lambda (x i v)
+      (if (bytevector? x)
+          (if (and (fixnum? i) ($fx<= 0 i) ($fx< i ($bytevector-length x)))
+              (if (and (fixnum? v) ($fx<= 0 v) ($fx<= v 255))
+                  ($bytevector-set! x i v)
+                  (error 'bytevector-u8-set! "~s is not an octet" v))
+              (error 'bytevector-u8-set! "invalid index ~s for ~s" i x))
+          (error 'bytevector-u8-set! "~s is not a bytevector" x))))
+  
+  )
+
+

src/ikarus.compiler.ss

@@ -4038,7 +4038,7 @@
                ac))]
      [($set-car! $set-cdr! $vector-set! $string-set! $exit
        $set-symbol-value! $set-symbol-plist! 
-       $code-set!  
+       $code-set! $bytevector-set! 
        $set-code-object! $set-code-object+offset! $set-code-object+offset/rel!
        $record-set!
        $set-port-input-index! $set-port-input-size!

src/makefile.ss

@@ -275,6 +275,8 @@
     [bytevector-length       i]
     [bytevector-s8-ref       i]
     [bytevector-u8-ref       i]
+    [bytevector-s8-set!      i]
+    [bytevector-u8-set!      i]
 
     [for-each                i r]
     [map                     i r]

src/tests/bytevectors.ss

@@ -25,6 +25,15 @@
          (bytevector-u8-ref b1 0)
          (bytevector-s8-ref b2 0)
          (bytevector-u8-ref b2 0)))]
+    [(lambda (x) (equal? x '(-126 130 -10 246)))
+     (let ([b (make-bytevector 16 -127)])
+       (bytevector-s8-set! b 0 -126)
+       (bytevector-u8-set! b 1 246)
+       (list 
+         (bytevector-s8-ref b 0)
+         (bytevector-u8-ref b 0)
+         (bytevector-s8-ref b 1)
+         (bytevector-u8-ref b 1)))]
 
     ))