[Chicken-hackers] [PATCH] use consistent naming for allocating unsafe SRFI-4 accessors

[Felix]

The attached patch changes some internal SRFI-4 accessors to use the
correct naming scheme ("C_a_u_i_..." for allocating, unsafe inline 
functions). Also, a bug in the length-check for "f64vector-ref" is
fixed.


cheers,
felix

>From 500bd81977e46a880cd6fc352b773b2946c25163 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Wed, 11 Jan 2012 14:47:12 +0100
Subject: [PATCH] use correct naming for unsafe allocating XXXvector accessors 
that allocate; also fixed bug in f64vector getter

---
 c-platform.scm |    8 ++++----
 chicken.h      |   11 +++++++----
 srfi-4.scm     |   10 +++++-----
 3 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/c-platform.scm b/c-platform.scm
index 52b2161..a633530 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 fdf4b72..aaf9841 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1319,10 +1319,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)
@@ -1455,8 +1458,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 cdbe388..8b3def2 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)"))
 
-- 
1.6.0.4