~ chicken-core (chicken-5) 6bb536cba85f866e684da1056ad475c405c595d0
commit 6bb536cba85f866e684da1056ad475c405c595d0
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Jan 11 14:47:12 2012 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Feb 27 09:54:45 2012 +0100
use correct naming for unsafe allocating XXXvector accessors that allocate; also fixed bug in f64vector getter
diff --git a/c-platform.scm b/c-platform.scm
index 52b2161f..a633530f 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -997,11 +997,11 @@
(rewrite 'u16vector-ref 2 2 "C_u_i_u16vector_ref" #f)
(rewrite 's16vector-ref 2 2 "C_u_i_s16vector_ref" #f)
-(rewrite 'f32vector-ref 16 2 "C_a_i_f32vector_ref" #f words-per-flonum)
-(rewrite 'f64vector-ref 16 2 "C_a_i_f64vector_ref" #f words-per-flonum)
+(rewrite 'f32vector-ref 16 2 "C_a_u_i_f32vector_ref" #f words-per-flonum)
+(rewrite 'f64vector-ref 16 2 "C_a_u_i_f64vector_ref" #f words-per-flonum)
-(rewrite 'u32vector-ref 22 2 "C_a_i_u32vector_ref" #f words-per-flonum "C_u_i_u32vector_ref")
-(rewrite 's32vector-ref 22 2 "C_a_i_s32vector_ref" #f words-per-flonum "C_u_i_s32vector_ref")
+(rewrite 'u32vector-ref 22 2 "C_a_u_i_u32vector_ref" #f words-per-flonum "C_u_i_u32vector_ref")
+(rewrite 's32vector-ref 22 2 "C_a_u_i_s32vector_ref" #f words-per-flonum "C_u_i_s32vector_ref")
(rewrite 'u8vector-set! 2 3 "C_u_i_u8vector_set" #f)
(rewrite 's8vector-set! 2 3 "C_u_i_s8vector_set" #f)
diff --git a/chicken.h b/chicken.h
index 8a548152..98a8ce85 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1315,10 +1315,13 @@ extern double trunc(double);
#define C_u_i_s8vector_ref(x, i) C_fix(((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
#define C_u_i_u16vector_ref(x, i) C_fix(((unsigned short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
#define C_u_i_s16vector_ref(x, i) C_fix(((short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+
+/* these assume fixnum mode */
#define C_u_i_u32vector_ref(x, i) C_fix(((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
#define C_u_i_s32vector_ref(x, i) C_fix(((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
-#define C_a_i_u32vector_ref(ptr, c, x, i) C_unsigned_int_to_num(ptr, ((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
-#define C_a_i_s32vector_ref(ptr, c, x, i) C_int_to_num(ptr, ((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+
+#define C_a_u_i_u32vector_ref(ptr, c, x, i) C_unsigned_int_to_num(ptr, ((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
+#define C_a_u_i_s32vector_ref(ptr, c, x, i) C_int_to_num(ptr, ((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
#define C_u_i_u8vector_set(x, i, v) ((((unsigned char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
#define C_u_i_s8vector_set(x, i, v) ((((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
@@ -1451,8 +1454,8 @@ extern double trunc(double);
#define C_a_i_flonum_floor(ptr, n, x) C_flonum(ptr, C_floor(C_flonum_magnitude(x)))
#define C_a_i_flonum_round(ptr, n, x) C_flonum(ptr, C_round(C_flonum_magnitude(x)))
-#define C_a_i_f32vector_ref(ptr, n, b, i) C_flonum(ptr, ((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
-#define C_a_i_f64vector_ref(ptr, n, b, i) C_flonum(ptr, ((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
+#define C_a_u_i_f32vector_ref(ptr, n, b, i) C_flonum(ptr, ((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
+#define C_a_u_i_f64vector_ref(ptr, n, b, i) C_flonum(ptr, ((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
#define C_u_i_f32vector_set(v, i, x) ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
#define C_u_i_f64vector_set(v, i, x) ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
diff --git a/srfi-4.scm b/srfi-4.scm
index cdbe3886..8b3def28 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -217,7 +217,7 @@ EOF
(##sys#check-structure x 'u32vector 'u32vector-ref)
(let ((len (##core#inline "C_u_i_u32vector_length" x)))
(check-range i 0 len 'u32vector-ref)
- (##core#inline_allocate ("C_a_i_u32vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_u32vector_ref" 4) x i)))
u32vector-set!
"(u32vector-ref v i)"))
@@ -227,7 +227,7 @@ EOF
(##sys#check-structure x 's32vector 's32vector-ref)
(let ((len (##core#inline "C_u_i_s32vector_length" x)))
(check-range i 0 len 's32vector-ref)
- (##core#inline_allocate ("C_a_i_s32vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_s32vector_ref" 4) x i)))
s32vector-set!
"(s32vector-ref v i)"))
@@ -237,7 +237,7 @@ EOF
(##sys#check-structure x 'f32vector 'f32vector-ref)
(let ((len (##core#inline "C_u_i_f32vector_length" x)))
(check-range i 0 len 'f32vector-ref)
- (##core#inline_allocate ("C_a_i_f32vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_f32vector_ref" 4) x i)))
f32vector-set!
"(f32vector-ref v i)"))
@@ -245,9 +245,9 @@ EOF
(getter-with-setter
(lambda (x i)
(##sys#check-structure x 'f64vector 'f64vector-ref)
- (let ((len (##core#inline "C_u_i_8vector_length" x)))
+ (let ((len (##core#inline "C_u_i_f64vector_length" x)))
(check-range i 0 len 'f64vector-ref)
- (##core#inline_allocate ("C_a_i_f64vector_ref" 4) x i)))
+ (##core#inline_allocate ("C_a_u_i_f64vector_ref" 4) x i)))
f64vector-set!
"(f64vector-ref v i)"))
Trap