summaryrefslogtreecommitdiff
path: root/libguile/unif.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/unif.c')
-rw-r--r--libguile/unif.c238
1 files changed, 0 insertions, 238 deletions
diff --git a/libguile/unif.c b/libguile/unif.c
index 6dc3dba8e..de8aba381 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -176,244 +176,6 @@ scm_is_typed_array (SCM obj, SCM type)
return scm_is_eq (type, scm_i_generalized_vector_type (obj));
}
-static SCM
-enclosed_ref (scm_t_array_handle *h, ssize_t pos)
-{
- return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
-}
-
-static SCM
-vector_ref (scm_t_array_handle *h, ssize_t pos)
-{
- return ((const SCM *)h->elements)[pos];
-}
-
-static SCM
-string_ref (scm_t_array_handle *h, ssize_t pos)
-{
- pos += h->base;
- if (SCM_I_ARRAYP (h->array))
- return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
- else
- return scm_c_string_ref (h->array, pos);
-}
-
-static SCM
-bitvector_ref (scm_t_array_handle *h, ssize_t pos)
-{
- pos += scm_array_handle_bit_elements_offset (h);
- return
- scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
-}
-
-static SCM
-bytevector_ref (scm_t_array_handle *h, ssize_t pos)
-{
- return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
-}
-
-static SCM
-memoize_ref (scm_t_array_handle *h, ssize_t pos)
-{
- SCM v = h->array;
-
- if (SCM_I_ENCLOSED_ARRAYP (v))
- {
- h->ref = enclosed_ref;
- return enclosed_ref (h, pos);
- }
-
- if (SCM_I_ARRAYP (v))
- v = SCM_I_ARRAY_V (v);
-
- if (scm_is_vector (v))
- {
- h->elements = scm_array_handle_elements (h);
- h->ref = vector_ref;
- }
- else if (scm_is_uniform_vector (v))
- {
- h->elements = scm_array_handle_uniform_elements (h);
- h->ref = scm_i_uniform_vector_ref_proc (v);
- }
- else if (scm_is_string (v))
- {
- h->ref = string_ref;
- }
- else if (scm_is_bitvector (v))
- {
- h->elements = scm_array_handle_bit_elements (h);
- h->ref = bitvector_ref;
- }
- else if (scm_is_bytevector (v))
- {
- h->elements = scm_array_handle_uniform_elements (h);
- h->ref = bytevector_ref;
- }
- else
- scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
- return h->ref (h, pos);
-}
-
-static void
-enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
-}
-
-static void
-vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- ((SCM *)h->writable_elements)[pos] = val;
-}
-
-static void
-string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- pos += h->base;
- if (SCM_I_ARRAYP (h->array))
- scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
- else
- scm_c_string_set_x (h->array, pos, val);
-}
-
-static void
-bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- scm_t_uint32 mask;
- pos += scm_array_handle_bit_elements_offset (h);
- mask = 1l << (pos % 32);
- if (scm_to_bool (val))
- ((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
- else
- ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
-}
-
-static void
-bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- scm_t_uint8 c_value;
- scm_t_uint8 *elements;
-
- c_value = scm_to_uint8 (val);
- elements = (scm_t_uint8 *) h->elements;
- elements[pos] = (scm_t_uint8) c_value;
-}
-
-static void
-memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
- SCM v = h->array;
-
- if (SCM_I_ENCLOSED_ARRAYP (v))
- {
- h->set = enclosed_set;
- enclosed_set (h, pos, val);
- return;
- }
-
- if (SCM_I_ARRAYP (v))
- v = SCM_I_ARRAY_V (v);
-
- if (scm_is_vector (v))
- {
- h->writable_elements = scm_array_handle_writable_elements (h);
- h->set = vector_set;
- }
- else if (scm_is_uniform_vector (v))
- {
- h->writable_elements = scm_array_handle_uniform_writable_elements (h);
- h->set = scm_i_uniform_vector_set_proc (v);
- }
- else if (scm_is_string (v))
- {
- h->set = string_set;
- }
- else if (scm_is_bitvector (v))
- {
- h->writable_elements = scm_array_handle_bit_writable_elements (h);
- h->set = bitvector_set;
- }
- else if (scm_is_bytevector (v))
- {
- h->elements = scm_array_handle_uniform_writable_elements (h);
- h->set = bytevector_set;
- }
- else
- scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
- h->set (h, pos, val);
-}
-
-void
-scm_array_get_handle (SCM array, scm_t_array_handle *h)
-{
- h->array = array;
- h->ref = memoize_ref;
- h->set = memoize_set;
-
- if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
- {
- h->dims = SCM_I_ARRAY_DIMS (array);
- h->base = SCM_I_ARRAY_BASE (array);
- }
- else if (scm_is_generalized_vector (array))
- {
- h->dim0.lbnd = 0;
- h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
- h->dim0.inc = 1;
- h->dims = &h->dim0;
- h->base = 0;
- }
- else
- scm_wrong_type_arg_msg (NULL, 0, array, "array");
-}
-
-void
-scm_array_handle_release (scm_t_array_handle *h)
-{
- /* Nothing to do here until arrays need to be reserved for real.
- */
-}
-
-size_t
-scm_array_handle_rank (scm_t_array_handle *h)
-{
- if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
- return SCM_I_ARRAY_NDIM (h->array);
- else
- return 1;
-}
-
-scm_t_array_dim *
-scm_array_handle_dims (scm_t_array_handle *h)
-{
- return h->dims;
-}
-
-const SCM *
-scm_array_handle_elements (scm_t_array_handle *h)
-{
- SCM vec = h->array;
- if (SCM_I_ARRAYP (vec))
- vec = SCM_I_ARRAY_V (vec);
- if (SCM_I_IS_VECTOR (vec))
- return SCM_I_VECTOR_ELTS (vec) + h->base;
- scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-SCM *
-scm_array_handle_writable_elements (scm_t_array_handle *h)
-{
- SCM vec = h->array;
- if (SCM_I_ARRAYP (vec))
- vec = SCM_I_ARRAY_V (vec);
- if (SCM_I_IS_VECTOR (vec))
- return SCM_I_VECTOR_WELTS (vec) + h->base;
- scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
/* We keep the old 2-argument C prototype for a while although the old
PROT argument is always ignored now. C code should probably use
scm_is_array or scm_is_typed_array anyway.