* bytevector-sint-set! is completed.

src/ikarus.bytevectors.ss

@@ -408,6 +408,22 @@
          (let ([c ($fx- ($fx+ 255 ($fxsra c 8)) ($bignum-byte-ref n ni))])
            (lbn-neg-copy! x ($fxadd1 xi) n ($fxadd1 ni) xj nj c)
            ($bytevector-set! x xi ($fxlogand c 255)))]))
+    (define (bbn-neg-copy! x xi n ni xj nj c)
+      (cond
+        [($fx= ni nj)
+         (case ($fxsra c 7)
+           [(#x01) ;;; borrow is 0, last byte was negative
+            (bv-neg-zero! x xi xj)]
+           [(#x00) ;;; borrow is 0, last byte was positive
+            (if ($fx< xi xj)
+                (bv-neg-zero! x xi xj)
+                (error 'bytevector-sint-set! "number ~s does not fit" n))]
+           [else (error 'bbn-neg-copy! "BUG: not handled ~s" c)])]
+        [else
+         (let ([c ($fx- ($fx+ 255 ($fxsra c 8)) ($bignum-byte-ref n ni))]
+               [xj ($fxsub1 xj)])
+           (bbn-neg-copy! x xi n ($fxadd1 ni) xj nj c)
+           ($bytevector-set! x xj ($fxlogand c 255)))]))
     (define (lbn-pos-copy! x xi n ni nj xj c)
       (cond
         [($fx= ni nj)
@@ -421,6 +437,20 @@
          (let ([c ($bignum-byte-ref n ni)])
            (lbn-pos-copy! x ($fxadd1 xi) n ($fxadd1 ni) nj xj c)
            ($bytevector-set! x xi ($fxlogand c 255)))]))
+    (define (bbn-pos-copy! x xi n ni nj xj c)
+      (cond
+        [($fx= ni nj)
+         (cond
+           [(or ($fx<= c 127) ($fx< xi xj))
+            ;;; last byte was positive
+            (bv-zero! x xi xj)]
+           [else 
+            (error 'bytevector-sint-set! "number ~s does not fit" n)])]
+        [else
+         (let ([c ($bignum-byte-ref n ni)]
+               [xj ($fxsub1 xj)])
+           (bbn-pos-copy! x xi n ($fxadd1 ni) nj xj c)
+           ($bytevector-set! x xj ($fxlogand c 255)))]))
     (define (bv-neg-zero! x i j)
       (unless ($fx= i j)
         ($bytevector-set! x i 255)
@@ -504,17 +534,18 @@
           [(big)
            (cond
              [(fixnum? n) (bsfx-set! x k n ($fx+ k size) who n)]
-             ;[(bignum? n)
+             [(bignum? n)
-             ; (if ($bignum-positive? n)
+              (if ($bignum-positive? n)
-             ;     (let ([sz ($bignum-size n)])
+                  (let ([sz (bignum-bytes n)])
-             ;       (cond
+                    (cond
-             ;         [($fx<= sz size) 
+                      [($fx<= sz size) 
-             ;          (bbn-copy! x ($fx+ k size) n 0 sz)]
+                       (bbn-pos-copy! x k n 0 size sz 255)]
-             ;         [($fx< sz size)
+                      [else (error who "number ~s does not fit" n)]))
-             ;          (bbn-copy! x ($fx+ k size) n 0 sz)
+                  (let ([sz (bignum-bytes n)])
-             ;          (bv-zero! x k ($fx+ k ($fx- size sz)))]
+                    (cond
-             ;         [else (error who "number ~s does not fit" n)]))
+                      [($fx<= sz size) 
-             ;     (error who "value ~s must be positive" n))]
+                       (bbn-neg-copy! x k n 0 size sz 256)]
+                      [else (error who "number ~s does not fit" n)])))] 
              [else (error who "invalid value argument ~s" n)])]
           [else (error who "invalid endianness ~s" endianness)]))))
   )

src/tests/bytevectors.ss

@@ -146,8 +146,48 @@
     [(lambda (x) (= x #x-100000000))
      (let ([b (make-bytevector 5 38)])
        (bytevector-sint-set! b 0 (- (expt 2 32)) 'little 5)
-       (printf "b=~s\n" b)
        (bytevector-sint-ref b 0 'little 5))]
+    [(lambda (x) (= x #xFFFFFFFF))
+     (let ([b (make-bytevector 4 0)])
+       (bytevector-sint-set! b 0 -1 'big 4)
+       (bytevector-uint-ref b 0 'big 4))]
+    [(lambda (x) (= x #xFFFFFF00))
+     (let ([b (make-bytevector 4 0)])
+       (bytevector-sint-set! b 0 -256 'big 4)
+       (bytevector-uint-ref b 0 'big 4))]
+    [(lambda (x) (= x #xFFFF0000))
+     (let ([b (make-bytevector 4 0)])
+       (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 4)
+       (bytevector-uint-ref b 0 'big 4))]
+    [(lambda (x) (= x #xFFFFFFFFFFFF0000))
+     (let ([b (make-bytevector 8 0)])
+       (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 8)
+       (bytevector-uint-ref b 0 'big 8))]
+    [(lambda (x) (= x #xFFFFFFFF00000000))
+     (let ([b (make-bytevector 8 0)])
+       (bytevector-sint-set! b 0 (- (expt 256 4)) 'big 8)
+       (bytevector-uint-ref b 0 'big 8))]
+    [(lambda (x) (= x #xFF00000000000000))
+     (let ([b (make-bytevector 8 0)])
+       (bytevector-sint-set! b 0 (- (expt 256 7)) 'big 8)
+       (bytevector-uint-ref b 0 'big 8))] 
+    [(lambda (x) (= x (- 1 (expt 2 63))))
+     (let ([b (make-bytevector 8 0)])
+       (bytevector-sint-set! b 0 (- 1 (expt 2 63)) 'big 8)
+       (bytevector-sint-ref b 0 'big 8))]
+    [(lambda (x) (= x #x7FFFFFFF))
+     (let ([b (make-bytevector 4 38)])
+       (bytevector-sint-set! b 0 (sub1 (expt 2 31)) 'big 4)
+       (bytevector-sint-ref b 0 'big 4))]
+    [(lambda (x) (= x #x-80000000))
+     (let ([b (make-bytevector 4 38)])
+       (bytevector-sint-set! b 0 (- (expt 2 31)) 'big 4)
+       (bytevector-sint-ref b 0 'big 4))]
+    [(lambda (x) (= x #x-100000000))
+     (let ([b (make-bytevector 5 38)])
+       (bytevector-sint-set! b 0 (- (expt 2 32)) 'big 5)
+       (bytevector-sint-ref b 0 'big 5))]
+
     ))