mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-05 17:20:18 +02:00
Code Activity

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

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

7
libguile/srfi-4.c
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 size_t
scm_uniform_vector_element_size (SCM uvec) scm_uniform_vector_element_size (SCM uvec)
{ {

1
libguile/srfi-4.h
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 void *scm_uniform_vector_elements (SCM uvec);
SCM_API size_t scm_uniform_vector_element_size (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_uniform_vector_release (SCM uvec);
SCM_API void scm_frame_uniform_vector_release (SCM uvec);
/* Specific procedures. /* Specific procedures.
*/ */

46
libguile/unif.c
View file

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