summaryrefslogtreecommitdiff
path: root/libguile/srfi-4.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-11-09 16:13:58 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-11-09 16:13:58 +0000
commit811eb6d0eeac0b437cdc161fbe8e14ca525e39c4 (patch)
tree90fda7cb6bfff1e54e7adb059b91cbb0ed9d30d1 /libguile/srfi-4.c
parent1d227e527a06234a8f1255ccb7ebcff83137934c (diff)
downloadguile-811eb6d0eeac0b437cdc161fbe8e14ca525e39c4.tar.gz
(scm_c_uniform_vector_ref, scm_c_uniform_vector_set_x): New.
(scm_i_uniform_vector_creator): Removed. (scm_i_generalized_vector_creator): New. (scm_uniform_vector_length, scm_uniform_element_size): Do not handle generalized vectors, only uniform numeric vectors. (alloc_uvec): Do length check here... (make_uvec): ...but not here. (coerce_to_uvec): Use new generalized vector functions to handle all kinds of vectors in one go.
Diffstat (limited to 'libguile/srfi-4.c')
-rw-r--r--libguile/srfi-4.c92
1 files changed, 54 insertions, 38 deletions
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index be3982aa0..bf756f859 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -243,7 +243,10 @@ take_uvec (int type, const void *base, size_t len)
static SCM
alloc_uvec (int type, size_t len)
{
- void *base = scm_gc_malloc (len * uvec_sizes[type], uvec_names[type]);
+ void *base;
+ if (len > SCM_I_SIZE_MAX / uvec_sizes[type])
+ scm_out_of_range (NULL, scm_from_size_t (len));
+ base = scm_gc_malloc (len * uvec_sizes[type], uvec_names[type]);
return take_uvec (type, base, len);
}
@@ -326,8 +329,7 @@ uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
static SCM_C_INLINE SCM
make_uvec (int type, SCM len, SCM fill)
{
- size_t c_len = scm_to_unsigned_integer (len, 0,
- SCM_I_SIZE_MAX / uvec_sizes[type]);
+ size_t c_len = scm_to_size_t (len);
SCM uvec = alloc_uvec (type, c_len);
if (!SCM_UNBNDP (fill))
{
@@ -416,29 +418,17 @@ coerce_to_uvec (int type, SCM obj)
return obj;
else if (scm_is_pair (obj))
return list_to_uvec (type, obj);
- else if (scm_is_true (scm_vector_p (obj)))
- {
- SCM len = scm_vector_length (obj);
- SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
- size_t clen = scm_to_size_t (len), i;
- void *base = SCM_UVEC_BASE (uvec);
- for (i = 0; i < clen; i++)
- uvec_fast_set_x (type, base, i, SCM_VECTOR_REF (obj, i));
- return uvec;
- }
- else if (scm_is_uniform_vector (obj))
+ else if (scm_is_generalized_vector (obj))
{
- SCM len = scm_uniform_vector_length (obj);
- SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
- size_t clen = scm_to_size_t (len), i;
+ size_t len = scm_c_generalized_vector_length (obj), i;
+ SCM uvec = alloc_uvec (type, len);
void *base = SCM_UVEC_BASE (uvec);
- for (i = 0; i < clen; i++)
- uvec_fast_set_x (type, base, i,
- scm_uniform_vector_ref (obj, scm_from_size_t (i)));
+ for (i = 0; i < len; i++)
+ uvec_fast_set_x (type, base, i, scm_c_generalized_vector_ref (obj, i));
return uvec;
}
else
- scm_wrong_type_arg_msg (NULL, 0, obj, "list, vector, or uniform vector");
+ scm_wrong_type_arg_msg (NULL, 0, obj, "list or generalized vector");
}
static SCM *uvec_proc_vars[12] = {
@@ -457,9 +447,18 @@ static SCM *uvec_proc_vars[12] = {
};
SCM
-scm_i_uniform_vector_creator (SCM uvec)
+scm_i_generalized_vector_creator (SCM v)
{
- return *(uvec_proc_vars[SCM_UVEC_TYPE(uvec)]);
+ if (scm_is_vector (v))
+ return scm_i_proc_make_vector;
+ else if (scm_is_string (v))
+ return scm_i_proc_make_string;
+ else if (scm_is_bitvector (v))
+ return scm_i_proc_make_bitvector;
+ else if (scm_is_uniform_vector (v))
+ return *(uvec_proc_vars[SCM_UVEC_TYPE(v)]);
+ else
+ return SCM_BOOL_F;
}
int
@@ -517,6 +516,20 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
}
#undef FUNC_NAME
+SCM
+scm_c_uniform_vector_ref (SCM v, size_t idx)
+{
+ if (scm_is_uniform_vector (v))
+ {
+ if (idx < SCM_UVEC_LENGTH (v))
+ return uvec_fast_ref (SCM_UVEC_TYPE (v), SCM_UVEC_BASE (v), idx);
+ else
+ scm_out_of_range (NULL, scm_from_size_t (idx));
+ }
+ else
+ scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+}
+
SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
(SCM v, SCM idx, SCM val),
"Set the element at index @var{idx} of the\n"
@@ -539,10 +552,24 @@ SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
}
#undef FUNC_NAME
+void
+scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+{
+ if (scm_is_uniform_vector (v))
+ {
+ if (idx < SCM_UVEC_LENGTH (v))
+ uvec_fast_set_x (SCM_UVEC_TYPE (v), SCM_UVEC_BASE (v), idx, val);
+ else
+ scm_out_of_range (NULL, scm_from_size_t (idx));
+ }
+ else
+ scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+}
+
SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
(SCM uvec),
"Convert the homogeneous numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_uniform_vector_to_list
+#define FUNC_NAME s_scm_uniform_vector_to_list
{
if (scm_is_uniform_vector (uvec))
return uvec_to_list (SCM_UVEC_TYPE (uvec), uvec);
@@ -567,7 +594,7 @@ scm_uniform_vector_release (SCM uvec)
when uniform vectors need to be locked when giving away a pointer
to their elements.
- Also, a call to scm_uniform_vector acts like
+ Also, a call to scm_uniform_vector_release acts like
scm_remember_upto_here, which is needed in any case.
*/
}
@@ -595,27 +622,16 @@ scm_uniform_element_size (SCM obj)
{
if (scm_is_uniform_vector (obj))
return scm_uniform_vector_element_size (obj);
- else if (SCM_BITVECTOR_P (obj))
- return sizeof (long);
else
return 0;
}
SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
(SCM v),
- "Return the number of elements in @var{uve}.")
+ "Return the number of elements in the uniform vector @var{v}.")
#define FUNC_NAME s_scm_uniform_vector_length
{
- if (scm_is_uniform_vector (v))
- return scm_from_size_t (SCM_UVEC_LENGTH (v));
- else if (scm_is_string (v))
- return scm_string_length (v);
- else if (scm_is_true (scm_vector_p (v)))
- return scm_vector_length (v);
- else if (SCM_BITVECTOR_P (v))
- return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
- else
- scm_wrong_type_arg (NULL, 0, v);
+ return scm_from_size_t (scm_c_uniform_vector_length (v));
}
#undef FUNC_NAME