>From 004bb9bd0c3ecf351df38c544d3a4d7438deac75 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Thu, 23 Feb 2012 21:24:33 +0100 Subject: [PATCH 2/2] use correct naming for unsafe allocating XXXvector accessors that allocate; also fixed bug in f64vector getter --- NEWS | 3 +++ c-platform.scm | 8 ++++---- chicken.h | 29 +++++++++++++++++++++++++---- srfi-4.scm | 10 +++++----- 4 files changed, 37 insertions(+), 13 deletions(-) diff --git a/NEWS b/NEWS index 6dc3ab7..aab6bc5 100644 --- a/NEWS +++ b/NEWS @@ -28,6 +28,9 @@ and "-heap-shrinkage" - the assembly-language stub routine for the implementation of "apply" was broken for Sparc64 systems - has been disabled for this platform + - deprecated C_a_i_[us]32vector_ref and C_a_i_f{32,64}vector_ref C + in favor of C_a_u_i_[us]32vector_ref C_a_u_i_f{32,64}vector_ref + which is consistent with other unsafe procedure names. - Core libraries - added a setter procedure to "signal-handler" ("posix" unit) 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 c0ee2e5..84554be 100644 --- a/chicken.h +++ b/chicken.h @@ -1325,10 +1325,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) @@ -1461,8 +1464,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) @@ -1893,6 +1896,7 @@ C_fctexport void C_default_5fstub_toplevel(C_word c,C_word d,C_word k) C_noret; /* Inline functions: */ + C_inline C_word C_permanentp(C_word x) { return C_mk_bool(!C_immediatep(x) && !C_in_stackp(x) && !C_in_heapp(x)); @@ -2848,6 +2852,23 @@ C_path_to_executable(C_char *fname) } #endif +/* DEPRECATED functions/macros: */ +C_deprecated C_inline C_word C_a_i_u32vector_ref(C_word **ptr, C_word c, C_word x, C_word i) +{ + return C_a_u_i_u32vector_ref(ptr, c, x, i); +} +C_deprecated C_inline C_word C_a_i_s32vector_ref(C_word **ptr, C_word c, C_word x, C_word i) +{ + return C_a_u_i_s32vector_ref(ptr, c, x, i); +} +C_deprecated C_inline C_word C_a_i_f32vector_ref(C_word **ptr, C_word n, C_word b, C_word i) +{ + return C_a_u_i_f32vector_ref(ptr, n, b, i); +} +C_deprecated C_inline C_word C_a_i_f64vector_ref(C_word **ptr, C_word n, C_word b, C_word i) +{ + return C_a_u_i_f64vector_ref(ptr, n, b, i); +} C_END_C_DECLS 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.7.9.1