conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixed endianness error in bytevector-native-[us]32-native-set!.

This commit is contained in:
Abdulaziz Ghuloum 2008-09-23 08:02:47 -04:00
parent 61ecbe0dd1
commit 9f53841fb9
5 changed files with 13 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lab/ypsilon-ffi/core.ikarus.ss
View File

@ -170,17 +170,6 @@
(make-cstring p))))) (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) (define (bytevector->blob bv)
(let ([n (bytevector-length bv)]) (let ([n (bytevector-length bv)])
(let ([p (malloc n)]) (let ([p (malloc n)])
@ -191,6 +180,7 @@
p))) p)))
(define (object->long x) (define (object->long x)
(cond (cond
[(integer? x) x] [(integer? x) x]

3
lab/ypsilon-ffi/gears.scm
View File

@ -23,8 +23,7 @@
(bytevector-ieee-single-native-set! bv (* n 4) value)))) (bytevector-ieee-single-native-set! bv (* n 4) value))))
(let ((bv (make-bytevector (* (length lst) 4)))) (let ((bv (make-bytevector (* (length lst) 4))))
(let loop ((i 0) (lst lst)) (let loop ((i 0) (lst lst))
(cond ((null? lst) (cond ((null? lst) bv)
(u8-list->bytevector (reverse (bytevector->u8-list bv))))
(else (else
(f32set! bv i (car lst)) (f32set! bv i (car lst))
(loop (+ i 1) (cdr lst))))))) (loop (+ i 1) (cdr lst)))))))

14
lab/ypsilon-ffi/glut-demo.scm
View File

@ -102,20 +102,6 @@
(lambda (state) (lambda (state)
(format #t "visibility callback ~s ~%" 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 (define f32vector
(lambda lst (lambda lst
(define-syntax f32set! (define-syntax f32set!

16
scheme/ikarus.bytevectors.ss
View File

@ -375,11 +375,11 @@
($fx< i ($fx- ($bytevector-length x) 3))) ($fx< i ($fx- ($bytevector-length x) 3)))
(begin (begin
(let ([b (sra n 16)]) (let ([b (sra n 16)])
($bytevector-set! x i ($fxsra b 8)) ($bytevector-set! x ($fx+ i 3) ($fxsra b 8))
($bytevector-set! x ($fx+ i 1) b)) ($bytevector-set! x ($fx+ i 2) b))
(let ([b (bitwise-and n #xFFFF)]) (let ([b (bitwise-and n #xFFFF)])
($bytevector-set! x ($fx+ i 2) ($fxsra b 8)) ($bytevector-set! x ($fx+ i 1) ($fxsra b 8))
($bytevector-set! x ($fx+ i 3) b))) ($bytevector-set! x i b)))
(die 'bytevector-u32-native-set! "invalid index" i)) (die 'bytevector-u32-native-set! "invalid index" i))
(die 'bytevector-u32-native-set! "invalid value" n)) (die 'bytevector-u32-native-set! "invalid value" n))
(die 'bytevector-u32-native-set! "not a bytevector" x)))) (die 'bytevector-u32-native-set! "not a bytevector" x))))
@ -399,11 +399,11 @@
($fx< i ($fx- ($bytevector-length x) 3))) ($fx< i ($fx- ($bytevector-length x) 3)))
(begin (begin
(let ([b (sra n 16)]) (let ([b (sra n 16)])
($bytevector-set! x i ($fxsra b 8)) ($bytevector-set! x ($fx+ i 3) ($fxsra b 8))
($bytevector-set! x ($fx+ i 1) b)) ($bytevector-set! x ($fx+ i 2) b))
(let ([b (bitwise-and n #xFFFF)]) (let ([b (bitwise-and n #xFFFF)])
($bytevector-set! x ($fx+ i 2) ($fxsra b 8)) ($bytevector-set! x ($fx+ i 1) ($fxsra b 8))
($bytevector-set! x ($fx+ i 3) b))) ($bytevector-set! x i b)))
(die 'bytevector-s32-native-set! "invalid index" i)) (die 'bytevector-s32-native-set! "invalid index" i))
(die 'bytevector-s32-native-set! "invalid value" n)) (die 'bytevector-s32-native-set! "invalid value" n))
(die 'bytevector-s32-native-set! "not a bytevector" x)))) (die 'bytevector-s32-native-set! "not a bytevector" x))))

2
scheme/last-revision
View File

@ -1 +1 @@
1606 1607