1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

* srfi-4.h, srfi-4.c (scm_frame_uniform_vector_release): New.

* unif.c (scm_bit_set_star_x, scm_bit_count_star_x): Use it to get
more efficient access to the u32vector.
This commit is contained in:
Marius Vollmer 2004-11-02 20:15:32 +00:00
parent 034486df89
commit d44ff083ea
3 changed files with 35 additions and 19 deletions

View file

@ -569,6 +569,13 @@ scm_uniform_vector_release (SCM uvec)
*/
}
void
scm_frame_uniform_vector_release (SCM uvec)
{
scm_frame_unwind_handler_with_scm (scm_uniform_vector_release, uvec,
SCM_F_WIND_EXPLICITLY);
}
size_t
scm_uniform_vector_element_size (SCM uvec)
{

View file

@ -38,6 +38,7 @@ SCM_API size_t scm_c_uniform_vector_size (SCM v);
SCM_API void *scm_uniform_vector_elements (SCM uvec);
SCM_API size_t scm_uniform_vector_element_size (SCM uvec);
SCM_API void scm_uniform_vector_release (SCM uvec);
SCM_API void scm_frame_uniform_vector_release (SCM uvec);
/* Specific procedures.
*/

View file

@ -48,6 +48,7 @@
#include "libguile/vectors.h"
#include "libguile/list.h"
#include "libguile/deprecation.h"
#include "libguile/dynwind.h"
#include "libguile/validate.h"
#include "libguile/unif.h"
@ -1738,18 +1739,19 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
else if (scm_is_true (scm_u32vector_p (kv)))
{
size_t vlen = SCM_BITVECTOR_LENGTH (v);
size_t ulen = scm_c_uniform_vector_length (kv);
size_t i;
scm_t_uint32 k;
size_t ulen, i;
scm_t_uint32 k, *indices;
scm_frame_begin (0);
ulen = scm_c_uniform_vector_length (kv);
indices = scm_u32vector_elements (kv);
scm_frame_uniform_vector_release (kv);
if (scm_to_bool (obj) == 0)
for (i = 0; i < ulen; i++)
{
/* XXX - poof, there goes the uniform vector efficiency
advantage.
*/
k = scm_to_uint32 (scm_uniform_vector_ref (kv,
scm_from_size_t (i)));
k = indices[i];
if (k >= vlen)
scm_out_of_range (FUNC_NAME, scm_from_uint32 (k));
SCM_BITVEC_CLR(v, k);
@ -1757,12 +1759,13 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
else
for (i = 0; i < ulen; i++)
{
k = scm_to_uint32 (scm_uniform_vector_ref (kv,
scm_from_size_t (i)));
k = indices[i];
if (k >= vlen)
scm_out_of_range (FUNC_NAME, scm_from_uint32 (k));
SCM_BITVEC_SET(v, k);
}
scm_frame_end ();
}
else
scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
@ -1829,30 +1832,35 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
else if (scm_is_true (scm_u32vector_p (kv)))
{
size_t vlen = SCM_BITVECTOR_LENGTH (v);
size_t ulen = scm_c_uniform_vector_length (kv);
size_t i;
scm_t_uint32 k;
size_t ulen, i;
scm_t_uint32 k, *indices;
scm_frame_begin (0);
ulen = scm_c_uniform_vector_length (kv);
indices = scm_u32vector_elements (kv);
scm_frame_uniform_vector_release (kv);
if (scm_to_bool (obj) == 0)
for (i = 0; i < ulen; i++)
{
k = scm_to_uint32 (scm_uniform_vector_ref (kv,
scm_from_size_t (i)));
k = indices[i];
if (k >= vlen)
scm_out_of_range (FUNC_NAME, scm_from_long (k));
scm_out_of_range (FUNC_NAME, scm_from_uint32 (k));
if (!SCM_BITVEC_REF(v, k))
count++;
}
else
for (i = 0; i < ulen; i++)
{
k = scm_to_uint32 (scm_uniform_vector_ref (kv,
scm_from_size_t (i)));
k = indices[i];
if (k >= vlen)
scm_out_of_range (FUNC_NAME, scm_from_long (k));
scm_out_of_range (FUNC_NAME, scm_from_uint32 (k));
if (SCM_BITVEC_REF (v, k))
count++;
}
scm_frame_end ();
}
else
scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");