diff --git a/libguile/array-handle.h b/libguile/array-handle.h index fa2449dea..94f368977 100644 --- a/libguile/array-handle.h +++ b/libguile/array-handle.h @@ -32,8 +32,8 @@ struct scm_t_array_handle; -typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t); -typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM); +typedef SCM (*scm_i_t_array_ref) (SCM, size_t); +typedef void (*scm_i_t_array_set) (SCM, size_t, SCM); typedef struct { @@ -135,7 +135,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) /* catch overflow */ scm_out_of_range (NULL, scm_from_ssize_t (p)); /* perhaps should catch overflow here too */ - return h->impl->vref (h, h->base + p); + return h->impl->vref (h->array, h->base + p); } SCM_INLINE_IMPLEMENTATION void @@ -145,7 +145,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) /* catch overflow */ scm_out_of_range (NULL, scm_from_ssize_t (p)); /* perhaps should catch overflow here too */ - h->impl->vset (h, h->base + p, v); + h->impl->vset (h->array, h->base + p, v); } #endif diff --git a/libguile/array-map.c b/libguile/array-map.c index 971df1bfd..b2c5f4bed 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -57,7 +57,7 @@ AREF (SCM v, size_t pos) SCM ret; scm_array_get_handle (v, &h); pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc; - ret = h.impl->vref (&h, pos); + ret = h.impl->vref (h.array, pos); scm_array_handle_release (&h); return ret; } @@ -68,7 +68,7 @@ ASET (SCM v, size_t pos, SCM val) scm_t_array_handle h; scm_array_get_handle (v, &h); pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc; - h.impl->vset (&h, pos, val); + h.impl->vset (h.array, pos, val); scm_array_handle_release (&h); } @@ -323,7 +323,7 @@ rafill (SCM dst, SCM fill) inc = SCM_I_ARRAY_DIMS (dst)->inc; for (; n-- > 0; i += inc) - h.impl->vset (&h, i, fill); + h.impl->vset (SCM_I_ARRAY_V (dst), i, fill); scm_array_handle_release (&h); return 1; @@ -359,7 +359,7 @@ racp (SCM src, SCM dst) inc_d = SCM_I_ARRAY_DIMS (dst)->inc; for (; n-- > 0; i_s += inc_s, i_d += inc_d) - h_d.impl->vset (&h_d, i_d, h_s.impl->vref (&h_s, i_s)); + h_d.impl->vset (SCM_I_ARRAY_V (dst), i_d, h_s.impl->vref (SCM_I_ARRAY_V (src), i_s)); scm_array_handle_release (&h_d); scm_array_handle_release (&h_s); @@ -661,7 +661,7 @@ ramap (SCM ra0, SCM proc, SCM ras) i0end = i0 + n*inc0; if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0) - h0.impl->vset (&h0, i0, scm_call_0 (proc)); + h0.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_call_0 (proc)); else { SCM ra1 = SCM_CAR (ras); @@ -674,7 +674,7 @@ ramap (SCM ra0, SCM proc, SCM ras) ras = SCM_CDR (ras); if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0, i1 += inc1) - h0.impl->vset (&h0, i0, scm_call_1 (proc, h1.impl->vref (&h1, i1))); + h0.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_call_1 (proc, h1.impl->vref (SCM_I_ARRAY_V (ra1), i1))); else { ras = scm_vector (ras); @@ -684,7 +684,7 @@ ramap (SCM ra0, SCM proc, SCM ras) unsigned long k; for (k = scm_c_vector_length (ras); k--;) args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); - h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1, i1), args)); + h0.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_apply_1 (proc, h1.impl->vref (SCM_I_ARRAY_V (ra1), i1), args)); } } scm_array_handle_release (&h1); @@ -734,7 +734,7 @@ rafe (SCM ra0, SCM proc, SCM ras) i0end = i0 + n*inc0; if (scm_is_null (ras)) for (; i0 < i0end; i0 += inc0) - scm_call_1 (proc, h0.impl->vref (&h0, i0)); + scm_call_1 (proc, h0.impl->vref (SCM_I_ARRAY_V (ra0), i0)); else { ras = scm_vector (ras); @@ -744,7 +744,7 @@ rafe (SCM ra0, SCM proc, SCM ras) unsigned long k; for (k = scm_c_vector_length (ras); k--;) args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); - scm_apply_1 (proc, h0.impl->vref (&h0, i0), args); + scm_apply_1 (proc, h0.impl->vref (SCM_I_ARRAY_V (ra0), i0), args); } } scm_array_handle_release (&h0); diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 2d36110d4..3a88731b2 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -845,24 +845,25 @@ scm_istr2bve (SCM str) goto exit; } } - + exit: scm_array_handle_release (&handle); scm_remember_upto_here_1 (str); return res; } -/* FIXME: h->array should be h->vector */ +/* FIXME: We know that bitvector is such, so can skip the checks in + scm_c_bitvector_... */ static SCM -bitvector_handle_ref (scm_t_array_handle *h, size_t pos) +bitvector_handle_ref (SCM bitvector, size_t pos) { - return scm_c_bitvector_ref (h->array, pos); + return scm_c_bitvector_ref (bitvector, pos); } static void -bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val) +bitvector_handle_set (SCM bitvector, size_t pos, SCM val) { - scm_c_bitvector_set_x (h->array, pos, val); + scm_c_bitvector_set_x (bitvector, pos, val); } static void diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index f197be342..ccb438cea 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -402,31 +402,6 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value) } #undef FUNC_NAME - - -int -scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED) -{ - ssize_t ubnd, inc, i; - scm_t_array_handle h; - - scm_array_get_handle (bv, &h); - - scm_putc_unlocked ('#', port); - scm_write (scm_array_handle_element_type (&h), port); - scm_putc_unlocked ('(', port); - for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc; - i <= ubnd; i += inc) - { - if (i > 0) - scm_putc_unlocked (' ', port); - scm_write (scm_array_handle_ref (&h, i), port); - } - scm_putc_unlocked (')', port); - - return 1; -} - /* General operations. */ @@ -2149,15 +2124,17 @@ bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = }; static SCM -bv_handle_ref (scm_t_array_handle *h, size_t index) +bv_handle_ref (SCM bv, size_t index) { SCM byte_index; scm_t_bytevector_ref_fn ref_fn; - ref_fn = bytevector_ref_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (h->array)]; + assert (SCM_BYTEVECTOR_P (bv)); + + ref_fn = bytevector_ref_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)]; byte_index = - scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (h->array)); - return ref_fn (h->array, byte_index); + scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bv)); + return ref_fn (bv, byte_index); } /* Template for native modification of complex numbers of type TYPE. */ @@ -2212,15 +2189,15 @@ const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1 }; static void -bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val) +bv_handle_set_x (SCM bytevector, size_t index, SCM val) { SCM byte_index; scm_t_bytevector_set_fn set_fn; - set_fn = bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (h->array)]; + set_fn = bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bytevector)]; byte_index = - scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (h->array)); - set_fn (h->array, byte_index, val); + scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bytevector)); + set_fn (bytevector, byte_index, val); } static void @@ -2237,6 +2214,25 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h) h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v); } + +int +scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED) +{ + size_t len, i; + + scm_putc_unlocked ('#', port); + scm_write (scm_i_array_element_types[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)], port); + scm_putc_unlocked ('(', port); + for (i = 0, len = SCM_BYTEVECTOR_TYPED_LENGTH (bv); i < len; ++i) + { + if (i > 0) + scm_putc_unlocked (' ', port); + scm_write (bv_handle_ref (bv, i), port); + } + scm_putc_unlocked (')', port); + return 1; +} + /* Initialization. */ diff --git a/libguile/strings.c b/libguile/strings.c index 9aa6a2180..3952b205d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -2459,17 +2459,19 @@ scm_i_get_substring_spec (size_t len, else *cend = scm_to_unsigned_integer (end, *cstart, len); } - + +/* FIXME: We know that bitvector is such, so can skip the checks in + scm_c_string_... */ static SCM -string_handle_ref (scm_t_array_handle *h, size_t index) +string_handle_ref (SCM string, size_t index) { - return scm_c_string_ref (h->array, index); + return scm_c_string_ref (string, index); } static void -string_handle_set (scm_t_array_handle *h, size_t index, SCM val) +string_handle_set (SCM string, size_t index, SCM val) { - scm_c_string_set_x (h->array, index, val); + scm_c_string_set_x (string, index, val); } static void diff --git a/libguile/uniform.c b/libguile/uniform.c index e6fcb531a..f12b5eaec 100644 --- a/libguile/uniform.c +++ b/libguile/uniform.c @@ -182,8 +182,9 @@ scm_c_uniform_vector_ref (SCM v, size_t pos) if (!scm_is_uniform_vector (v)) scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); + /* need the handle for bitvectors only */ scm_array_get_handle (v, &h); - ret = h.impl->vref (&h, pos); + ret = h.impl->vref (h.array, pos); scm_array_handle_release (&h); return ret; @@ -207,8 +208,9 @@ scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val) if (!scm_is_uniform_vector (v)) scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); + /* need the handle for bitvectors only */ scm_array_get_handle (v, &h); - h.impl->vset (&h, pos, val); + h.impl->vset (h.array, pos, val); scm_array_handle_release (&h); } diff --git a/libguile/vectors.c b/libguile/vectors.c index 74d8a7ccb..19a0392b2 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -434,19 +434,19 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, static SCM -vector_handle_ref (scm_t_array_handle *h, size_t idx) +vector_handle_ref (SCM vector, size_t idx) { - if (idx >= SCM_I_VECTOR_LENGTH (h->array)) + if (idx >= SCM_I_VECTOR_LENGTH (vector)) scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx)); - return SCM_I_VECTOR_WELTS(h->array)[idx]; + return SCM_I_VECTOR_WELTS(vector)[idx]; } static void -vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val) +vector_handle_set (SCM vector, size_t idx, SCM val) { - if (idx >= SCM_I_VECTOR_LENGTH (h->array)) + if (idx >= SCM_I_VECTOR_LENGTH (vector)) scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx)); - SCM_I_VECTOR_WELTS(h->array)[idx] = val; + SCM_I_VECTOR_WELTS(vector)[idx] = val; } static void