* Added bytevector-u32-native-ref, bytevector-u32-native-set!,

bytevector-s32-native-ref, and bytevector-s32-native-set!

src/ikarus.bytevectors.ss

@@ -4,6 +4,8 @@
           bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
           bytevector-copy! u8-list->bytevector bytevector->u8-list
           bytevector-u16-native-ref bytevector-u16-native-set!
+          bytevector-u32-native-ref bytevector-u32-native-set!
+          bytevector-s32-native-ref bytevector-s32-native-set!
           bytevector-u16-ref bytevector-u16-set!
           bytevector-u32-ref bytevector-u32-set!
           bytevector-s32-ref bytevector-s32-set!
@@ -21,6 +23,8 @@
         bytevector-u8-ref bytevector-u8-set! bytevector-s8-set! 
         bytevector-copy! u8-list->bytevector bytevector->u8-list
         bytevector-u16-native-ref bytevector-u16-native-set!
+        bytevector-u32-native-ref bytevector-u32-native-set!
+        bytevector-s32-native-ref bytevector-s32-native-set!
         bytevector-u16-ref bytevector-u16-set!
         bytevector-u32-ref bytevector-u32-set!
         bytevector-s32-ref bytevector-s32-set!
@@ -123,21 +127,6 @@
               (error 'bytevector-u16-native-ref "invalid index ~s" i))
           (error 'bytevector-u16-native-ref "~s is not a bytevector" x))))
 
-  (define bytevector-u32-native-ref ;;; HARDCODED
-    (lambda (x i) 
-      (if (bytevector? x) 
-          (if (and (fixnum? i)
-                   ($fx<= 0 i)
-                   ($fx< i ($fx- ($bytevector-length x) 3))
-                   ($fxzero? ($fxlogand i 3)))
-              (+ (* ($bytevector-u8-ref x i) #x1000000)
-                 ($fxlogor
-                   ($fxsll ($bytevector-u8-ref x ($fx+ i 1)) 16)
-                   ($fxlogor 
-                     ($fxsll ($bytevector-u8-ref x ($fx+ i 2)) 8)
-                     ($bytevector-u8-ref x ($fx+ i 3)))))
-              (error 'bytevector-u32-native-ref "invalid index ~s" i))
-          (error 'bytevector-u32-native-ref "~s is not a bytevector" x))))
   
   (define bytevector-u16-native-set! ;;; HARDCODED
     (lambda (x i n) 
@@ -156,25 +145,6 @@
               (error 'bytevector-u16-native-set! "invalid value ~s" n))
           (error 'bytevector-u16-native-set! "~s is not a bytevector" x))))
 
-  (define bytevector-u32-native-set! ;;; HARDCODED
-    (lambda (x i n) 
-      (if (bytevector? x) 
-          (if (and (or (fixnum? n) (bignum? n))
-                   (<= 0 n) 
-                   (<= n #xFFFFFFFF))
-              (if (and (fixnum? i)
-                       ($fx<= 0 i)
-                       ($fx< i ($fx- ($bytevector-length x) 3))
-                       ($fxzero? ($fxlogand i 3)))
-                  (begin
-                    ($bytevector-set! x i (quotient n #x1000000)) 
-                    ($bytevector-set! x ($fx+ i 1) (quotient x #x10000))
-                    ($bytevector-set! x ($fx+ i 2) (quotient x #x100))
-                    ($bytevector-set! x ($fx+ i 3) (remainder n #x100)))
-                  (error 'bytevector-u32-native-set! "invalid index ~s" i))
-              (error 'bytevector-u32-native-set! "invalid value ~s" n))
-          (error 'bytevector-u32-native-set! "~s is not a bytevector" x))))
-
   (define bytevector-s16-native-set! ;;; HARDCODED
     (lambda (x i n) 
       (if (bytevector? x) 
@@ -249,6 +219,21 @@
               (error 'bytevector-u32-ref "invalid index ~s" i))
           (error 'bytevector-u32-ref "~s is not a bytevector" x))))
 
+  (define bytevector-u32-native-ref
+    (lambda (x i) 
+      (if (bytevector? x) 
+          (if (and (fixnum? i)
+                   ($fx<= 0 i)
+                   ($fx= 0 ($fxlogand i 3))
+                   ($fx< i ($fx- ($bytevector-length x) 3)))
+              (+ (sll ($bytevector-u8-ref x i) 24)
+                 ($fxlogor
+                   ($fxsll ($bytevector-u8-ref x ($fx+ i 1)) 16)
+                   ($fxlogor 
+                     ($fxsll ($bytevector-u8-ref x ($fx+ i 2)) 8)
+                     ($bytevector-u8-ref x ($fx+ i 3)))))
+              (error 'bytevector-u32-native-ref "invalid index ~s" i))
+          (error 'bytevector-u32-native-ref "~s is not a bytevector" x))))
 
   (define bytevector-s32-ref
     (lambda (x i end) 
@@ -275,6 +260,22 @@
               (error 'bytevector-s32-ref "invalid index ~s" i))
           (error 'bytevector-s32-ref "~s is not a bytevector" x))))
 
+  (define bytevector-s32-native-ref
+    (lambda (x i) 
+      (if (bytevector? x) 
+          (if (and (fixnum? i)
+                   ($fx<= 0 i)
+                   ($fx= 0 ($fxlogand i 3))
+                   ($fx< i ($fx- ($bytevector-length x) 3)))
+              (+ (sll ($bytevector-s8-ref x i) 24)
+                 ($fxlogor
+                   ($fxsll ($bytevector-u8-ref x ($fx+ i 1)) 16)
+                   ($fxlogor 
+                     ($fxsll ($bytevector-u8-ref x ($fx+ i 2)) 8)
+                     ($bytevector-u8-ref x ($fx+ i 3)))))
+              (error 'bytevector-s32-native-ref "invalid index ~s" i))
+          (error 'bytevector-s32-native-ref "~s is not a bytevector" x))))
+
   (define bytevector-u16-set!
     (lambda (x i n end) 
       (if (bytevector? x) 
@@ -328,6 +329,52 @@
               (error 'bytevector-u32-set! "invalid value ~s" n))
           (error 'bytevector-u32-set! "~s is not a bytevector" x))))
 
+  (define bytevector-u32-native-set!
+    (lambda (x i n) 
+      (if (bytevector? x) 
+          (if (if (fixnum? n)
+                  ($fx>= n 0)
+                  (if (bignum? n)
+                      (<= 0 n #xFFFFFFFF)
+                      #f))
+              (if (and (fixnum? i)
+                       ($fx<= 0 i)
+                       ($fx= 0 ($fxlogand i 3))
+                       ($fx< i ($fx- ($bytevector-length x) 3)))
+                  (begin
+                    (let ([b (sra n 16)])
+                      ($bytevector-set! x i ($fxsra b 8))
+                      ($bytevector-set! x ($fx+ i 1) b))
+                    (let ([b (logand n #xFFFF)])
+                      ($bytevector-set! x ($fx+ i 2) ($fxsra b 8))
+                      ($bytevector-set! x ($fx+ i 3) b)))
+                  (error 'bytevector-u32-native-set! "invalid index ~s" i))
+              (error 'bytevector-u32-native-set! "invalid value ~s" n))
+          (error 'bytevector-u32-native-set! "~s is not a bytevector" x))))
+
+
+  (define bytevector-s32-native-set!
+    (lambda (x i n) 
+      (if (bytevector? x) 
+          (if (if (fixnum? n)
+                  #t
+                  (if (bignum? n)
+                      (<= #x-80000000 n #x7FFFFFFF)
+                      #f))
+              (if (and (fixnum? i)
+                       ($fx<= 0 i)
+                       ($fx= 0 ($fxlogand i 3))
+                       ($fx< i ($fx- ($bytevector-length x) 3)))
+                  (begin
+                    (let ([b (sra n 16)])
+                      ($bytevector-set! x i ($fxsra b 8))
+                      ($bytevector-set! x ($fx+ i 1) b))
+                    (let ([b (logand n #xFFFF)])
+                      ($bytevector-set! x ($fx+ i 2) ($fxsra b 8))
+                      ($bytevector-set! x ($fx+ i 3) b)))
+                  (error 'bytevector-s32-native-set! "invalid index ~s" i))
+              (error 'bytevector-s32-native-set! "invalid value ~s" n))
+          (error 'bytevector-s32-native-set! "~s is not a bytevector" x))))
 
   (define bytevector-s32-set!
     (lambda (x i n end) 

src/makefile.ss

@@ -408,12 +408,16 @@
     [bytevector-u32-set!        i]
     [bytevector-s32-ref         i]
     [bytevector-s32-set!        i]
-    [bytevector-u16-native-ref  i]
-    [bytevector-u16-native-set! i]
     [bytevector-s16-ref         i]
     [bytevector-s16-set!        i]
+    [bytevector-u16-native-ref  i]
+    [bytevector-u16-native-set! i]
     [bytevector-s16-native-ref  i]
     [bytevector-s16-native-set! i]
+    [bytevector-u32-native-ref  i]
+    [bytevector-u32-native-set! i]
+    [bytevector-s32-native-ref  i]
+    [bytevector-s32-native-set! i]
     [bytevector->u8-list     i]
     [u8-list->bytevector     i]
     [bytevector-copy!        i]

src/todo-r6rs.ss

@@ -368,8 +368,8 @@
     [bytevector-s16-native-set!                 C bv]
     [bytevector-s16-ref                         C bv]
     [bytevector-s16-set!                        C bv]
-    [bytevector-s32-native-ref                  S bv]
+    [bytevector-s32-native-ref                  C bv]
-    [bytevector-s32-native-set!                 S bv]
+    [bytevector-s32-native-set!                 C bv]
     [bytevector-s32-ref                         C bv]
     [bytevector-s32-set!                        C bv]
     [bytevector-s64-native-ref                  S bv]
@@ -384,8 +384,8 @@
     [bytevector-u16-native-set!                 C bv]
     [bytevector-u16-ref                         C bv]
     [bytevector-u16-set!                        C bv]
-    [bytevector-u32-native-ref                  S bv]
+    [bytevector-u32-native-ref                  C bv]
-    [bytevector-u32-native-set!                 S bv]
+    [bytevector-u32-native-set!                 C bv]
     [bytevector-u32-ref                         C bv]
     [bytevector-u32-set!                        C bv]
     [bytevector-u64-native-ref                  S bv]