mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +02:00
* unif.h, unif.c, inline.h (scm_i_t_array_ref, scm_i_t_array_set):
New. (scm_t_array_handle): Added ref, set, elements and writable_elements for fast inline operation of scm_array_handle_ref and scm_array_handle_set. (scm_array_handle_ref, scm_array_handle_set): Moved to inline.h and replaced with inline code that simply calls the ref/set members of the handle. (enclosed_ref, vector_ref, string_ref, bitvector_ref, memoize_ref, enclosed_set, vector_set, string_set, bitvector_set, memoize_set): New. (scm_array_handle_get): Initialize ref/set fields to memoize_ref and memoize_set. (scm_bitvector_fill_x, scm_bitvector_to_list, scm_bit_count, scm_bit_position, scm_bit_set_star_x, scm_bit_count_star, scm_bit_invert_x): Correctly multiply index with increment in the general case. * unif.c (scm_array_handle_set): Correctly execute only one alternative. D'Oh! (scm_list_to_typed_array, l2ra): Use scm_t_array_handle to fill the array; this covers all cases with much simpler code.
This commit is contained in:
Marius Vollmer
parent
8c8491f56c
commit
9598a4060a
3 changed files with 201 additions and 37 deletions
|
|
@ -34,12 +34,15 @@
|
|||
#include "libguile/pairs.h"
|
||||
#include "libguile/gc.h"
|
||||
#include "libguile/threads.h"
|
||||
#include "libguile/unif.h"
|
||||
|
||||
|
||||
SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
|
||||
SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
|
||||
scm_t_bits ccr, scm_t_bits cdr);
|
||||
|
||||
SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
|
||||
SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
|
||||
|
||||
|
||||
#if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
|
||||
|
|
@ -246,7 +249,35 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
|
|||
return z;
|
||||
}
|
||||
|
||||
#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
|
||||
/* definitely inlining */
|
||||
#ifdef __GNUC__
|
||||
extern
|
||||
#else
|
||||
static
|
||||
#endif
|
||||
SCM_C_INLINE
|
||||
#endif
|
||||
SCM
|
||||
scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
|
||||
{
|
||||
return h->ref (h, p);
|
||||
}
|
||||
|
||||
#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
|
||||
/* definitely inlining */
|
||||
#ifdef __GNUC__
|
||||
extern
|
||||
#else
|
||||
static
|
||||
#endif
|
||||
SCM_C_INLINE
|
||||
#endif
|
||||
void
|
||||
scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
|
||||
{
|
||||
h->set (h, p, v);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
|
|
|||
191
libguile/unif.c
191
libguile/unif.c
|
|
@ -253,10 +253,156 @@ 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_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_ARRAYP (h->array))
|
||||
return scm_c_string_ref (SCM_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
|
||||
memoize_ref (scm_t_array_handle *h, ssize_t pos)
|
||||
{
|
||||
SCM v = h->array;
|
||||
|
||||
if (SCM_ENCLOSED_ARRAYP (v))
|
||||
{
|
||||
h->ref = enclosed_ref;
|
||||
return enclosed_ref (h, pos);
|
||||
}
|
||||
|
||||
if (SCM_ARRAYP (v))
|
||||
v = SCM_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
|
||||
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_ARRAYP (h->array))
|
||||
return scm_c_string_set_x (SCM_ARRAY_V (h->array), pos, val);
|
||||
else
|
||||
return 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->elements)[pos/32] |= mask;
|
||||
else
|
||||
((scm_t_uint32 *)h->elements)[pos/32] &= ~mask;
|
||||
}
|
||||
|
||||
static void
|
||||
memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
|
||||
{
|
||||
SCM v = h->array;
|
||||
|
||||
if (SCM_ENCLOSED_ARRAYP (v))
|
||||
{
|
||||
h->set = enclosed_set;
|
||||
enclosed_set (h, pos, val);
|
||||
return;
|
||||
}
|
||||
|
||||
if (SCM_ARRAYP (v))
|
||||
v = SCM_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
|
||||
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_ARRAYP (array) || SCM_ENCLOSED_ARRAYP (array))
|
||||
{
|
||||
h->dims = SCM_ARRAY_DIMS (array);
|
||||
|
|
@ -296,29 +442,6 @@ scm_array_handle_dims (scm_t_array_handle *h)
|
|||
return h->dims;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos)
|
||||
{
|
||||
pos += h->base;
|
||||
if (SCM_ARRAYP (h->array))
|
||||
return scm_i_cvref (SCM_ARRAY_V (h->array), pos, 0);
|
||||
if (SCM_ENCLOSED_ARRAYP (h->array))
|
||||
return scm_i_cvref (SCM_ARRAY_V (h->array), pos, 1);
|
||||
return scm_c_generalized_vector_ref (h->array, pos);
|
||||
}
|
||||
|
||||
void
|
||||
scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val)
|
||||
{
|
||||
pos += h->base;
|
||||
if (SCM_ARRAYP (h->array))
|
||||
scm_c_generalized_vector_set_x (SCM_ARRAY_V (h->array), pos, val);
|
||||
else if (SCM_ENCLOSED_ARRAYP (h->array))
|
||||
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
|
||||
else
|
||||
scm_c_generalized_vector_set_x (h->array, pos, val);
|
||||
}
|
||||
|
||||
const SCM *
|
||||
scm_array_handle_elements (scm_t_array_handle *h)
|
||||
{
|
||||
|
|
@ -1679,7 +1802,7 @@ SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
|
|||
{
|
||||
size_t i;
|
||||
for (i = 0; i < len; i++)
|
||||
scm_array_handle_set (&handle, i, val);
|
||||
scm_array_handle_set (&handle, i*inc, val);
|
||||
}
|
||||
|
||||
scm_array_handle_release (&handle);
|
||||
|
|
@ -1751,7 +1874,7 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
|
|||
{
|
||||
size_t i;
|
||||
for (i = 0; i < len; i++)
|
||||
res = scm_cons (scm_array_handle_ref (&handle, i), res);
|
||||
res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
|
||||
}
|
||||
|
||||
scm_array_handle_release (&handle);
|
||||
|
|
@ -1814,7 +1937,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
|
|||
{
|
||||
size_t i;
|
||||
for (i = 0; i < len; i++)
|
||||
if (scm_is_true (scm_array_handle_ref (&handle, i)))
|
||||
if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
|
||||
count++;
|
||||
}
|
||||
|
||||
|
|
@ -1895,7 +2018,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
|
|||
size_t i;
|
||||
for (i = first_bit; i < len; i++)
|
||||
{
|
||||
SCM elt = scm_array_handle_ref (&handle, i);
|
||||
SCM elt = scm_array_handle_ref (&handle, i*inc);
|
||||
if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
|
||||
{
|
||||
res = scm_from_size_t (i);
|
||||
|
|
@ -1992,8 +2115,8 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
|
|||
{
|
||||
size_t i;
|
||||
for (i = 0; i < kv_len; i++)
|
||||
if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
|
||||
scm_array_handle_set (&v_handle, i, obj);
|
||||
if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
|
||||
scm_array_handle_set (&v_handle, i*v_inc, obj);
|
||||
}
|
||||
|
||||
scm_array_handle_release (&kv_handle);
|
||||
|
|
@ -2008,7 +2131,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
|
|||
|
||||
kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
|
||||
for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
|
||||
scm_array_handle_set (&v_handle, (size_t) *kv_elts, obj);
|
||||
scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
|
||||
|
||||
scm_array_handle_release (&kv_handle);
|
||||
}
|
||||
|
|
@ -2089,7 +2212,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
|
|||
for (i = 0; i < kv_len; i++)
|
||||
if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
|
||||
{
|
||||
SCM elt = scm_array_handle_ref (&v_handle, i);
|
||||
SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
|
||||
if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
|
||||
count++;
|
||||
}
|
||||
|
|
@ -2108,7 +2231,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
|
|||
kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
|
||||
for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
|
||||
{
|
||||
SCM elt = scm_array_handle_ref (&v_handle, *kv_elts);
|
||||
SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
|
||||
if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
|
||||
count++;
|
||||
}
|
||||
|
|
@ -2151,8 +2274,8 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
|
|||
{
|
||||
size_t i;
|
||||
for (i = 0; i < len; i++)
|
||||
scm_array_handle_set (&handle, i,
|
||||
scm_not (scm_array_handle_ref (&handle, i)));
|
||||
scm_array_handle_set (&handle, i*inc,
|
||||
scm_not (scm_array_handle_ref (&handle, i*inc)));
|
||||
}
|
||||
|
||||
scm_array_handle_release (&handle);
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
#include "libguile/print.h"
|
||||
|
||||
|
||||
|
||||
|
|
@ -95,22 +96,31 @@ SCM_API int scm_is_typed_array (SCM obj, SCM type);
|
|||
|
||||
SCM_API SCM scm_i_read_array (SCM port, int c);
|
||||
|
||||
typedef struct {
|
||||
struct scm_t_array_handle;
|
||||
|
||||
typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
|
||||
typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
|
||||
|
||||
typedef struct scm_t_array_handle {
|
||||
SCM array;
|
||||
size_t base;
|
||||
scm_t_array_dim *dims;
|
||||
scm_t_array_dim dim0;
|
||||
scm_i_t_array_ref ref;
|
||||
scm_i_t_array_set set;
|
||||
const void *elements;
|
||||
void *writable_elements;
|
||||
} scm_t_array_handle;
|
||||
|
||||
SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
|
||||
SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
|
||||
SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
|
||||
SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
|
||||
SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
|
||||
SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
|
||||
SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
|
||||
SCM_API void scm_array_handle_release (scm_t_array_handle *h);
|
||||
|
||||
/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
|
||||
|
||||
|
||||
/** Bit vectors */
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue