diff --git a/src/ikarus.boot b/src/ikarus.boot index bf7f8ac..978cfb8 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.bytevectors.ss b/src/ikarus.bytevectors.ss new file mode 100644 index 0000000..3ea4612 --- /dev/null +++ b/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)))) + + ) + + diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 665bd4c..06027ee 100644 --- a/src/ikarus.compiler.ss +++ b/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! diff --git a/src/makefile.ss b/src/makefile.ss index 22f5e25..c3bf15b 100755 --- a/src/makefile.ss +++ b/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] diff --git a/src/tests/bytevectors.ss b/src/tests/bytevectors.ss index 7455997..06e41f6 100644 --- a/src/tests/bytevectors.ss +++ b/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)))] ))