From 9f53841fb9fef590b77c4da0753f082c392a967d Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Tue, 23 Sep 2008 08:02:47 -0400
Subject: [PATCH] fixed endianness error in
 bytevector-native-[us]32-native-set!.

---
 lab/ypsilon-ffi/core.ikarus.ss | 12 +-----------
 lab/ypsilon-ffi/gears.scm      |  3 +--
 lab/ypsilon-ffi/glut-demo.scm  | 14 --------------
 scheme/ikarus.bytevectors.ss   | 20 ++++++++++----------
 scheme/last-revision           |  2 +-
 5 files changed, 13 insertions(+), 38 deletions(-)

diff --git a/lab/ypsilon-ffi/core.ikarus.ss b/lab/ypsilon-ffi/core.ikarus.ss
index 891f44e..1347324 100644
--- a/lab/ypsilon-ffi/core.ikarus.ss
+++ b/lab/ypsilon-ffi/core.ikarus.ss
@@ -170,17 +170,6 @@
           (make-cstring p)))))
 
   
-  (define (bytevector->blob bv)
-    (let ([n (bytevector-length bv)])
-      (let ([p (malloc n)])
-        (let f ([i 0] [j (- n 1)])
-          (unless (= i n)
-            (pointer-set-char p i (bytevector-u8-ref bv j))
-            (f (+ i 1) (- j 1))))
-        p)))
-
-
-  #;
   (define (bytevector->blob bv)
     (let ([n (bytevector-length bv)])
       (let ([p (malloc n)])
@@ -191,6 +180,7 @@
         p)))
 
 
+
   (define (object->long x)
     (cond
       [(integer? x) x]
diff --git a/lab/ypsilon-ffi/gears.scm b/lab/ypsilon-ffi/gears.scm
index fb5d0b5..5be3dbf 100755
--- a/lab/ypsilon-ffi/gears.scm
+++ b/lab/ypsilon-ffi/gears.scm
@@ -23,8 +23,7 @@
        (bytevector-ieee-single-native-set! bv (* n 4) value))))
   (let ((bv (make-bytevector (* (length lst) 4))))
     (let loop ((i 0) (lst lst))
-      (cond ((null? lst) 
-             (u8-list->bytevector (reverse (bytevector->u8-list bv))))
+      (cond ((null? lst) bv)
         (else
          (f32set! bv i (car lst))
          (loop (+ i 1) (cdr lst)))))))
diff --git a/lab/ypsilon-ffi/glut-demo.scm b/lab/ypsilon-ffi/glut-demo.scm
index adfdfec..89c079a 100644
--- a/lab/ypsilon-ffi/glut-demo.scm
+++ b/lab/ypsilon-ffi/glut-demo.scm
@@ -102,20 +102,6 @@
     (lambda (state)
       (format #t "visibility callback ~s ~%" state)))
 
-(define (f32vector . lst)
-  (define-syntax f32set!
-    (syntax-rules ()
-      ((_ bv n value)
-       (bytevector-ieee-single-native-set! bv (* n 4) value))))
-  (let ((bv (make-bytevector (* (length lst) 4))))
-    (let loop ((i 0) (lst lst))
-      (cond ((null? lst) 
-             (u8-list->bytevector (rnrs:reverse (bytevector->u8-list bv))))
-        (else
-         (f32set! bv i (car lst))
-         (loop (+ i 1) (cdr lst)))))))
-
-#;
   (define f32vector
     (lambda lst
       (define-syntax f32set!
diff --git a/scheme/ikarus.bytevectors.ss b/scheme/ikarus.bytevectors.ss
index 149b9de..c8dd522 100644
--- a/scheme/ikarus.bytevectors.ss
+++ b/scheme/ikarus.bytevectors.ss
@@ -374,12 +374,12 @@
                        ($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 (bitwise-and n #xFFFF)])
-                      ($bytevector-set! x ($fx+ i 2) ($fxsra b 8))
-                      ($bytevector-set! x ($fx+ i 3) b)))
+                     (let ([b (sra n 16)])
+                       ($bytevector-set! x ($fx+ i 3) ($fxsra b 8))
+                       ($bytevector-set! x ($fx+ i 2) b))
+                     (let ([b (bitwise-and n #xFFFF)])
+                       ($bytevector-set! x ($fx+ i 1) ($fxsra b 8))
+                       ($bytevector-set! x i b)))
                   (die 'bytevector-u32-native-set! "invalid index" i))
               (die 'bytevector-u32-native-set! "invalid value" n))
           (die 'bytevector-u32-native-set! "not a bytevector" x))))
@@ -399,11 +399,11 @@
                        ($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))
+                      ($bytevector-set! x ($fx+ i 3) ($fxsra b 8))
+                      ($bytevector-set! x ($fx+ i 2) b))
                     (let ([b (bitwise-and n #xFFFF)])
-                      ($bytevector-set! x ($fx+ i 2) ($fxsra b 8))
-                      ($bytevector-set! x ($fx+ i 3) b)))
+                      ($bytevector-set! x ($fx+ i 1) ($fxsra b 8))
+                      ($bytevector-set! x i b)))
                   (die 'bytevector-s32-native-set! "invalid index" i))
               (die 'bytevector-s32-native-set! "invalid value" n))
           (die 'bytevector-s32-native-set! "not a bytevector" x))))
diff --git a/scheme/last-revision b/scheme/last-revision
index 1366865..dc41878 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1606
+1607