diff options
author | Marius Vollmer <mvo@zagadka.de> | 2005-01-02 20:06:08 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2005-01-02 20:06:08 +0000 |
commit | 6e708ef2b1897c3ea4d5ac47720974078d50e9e4 (patch) | |
tree | 3dde367b768213b4693cc586b2adf23074f15667 /libguile/srfi-4.c | |
parent | 9c6e33c62acc203792053b6d5a579bdc22827eec (diff) | |
download | guile-6e708ef2b1897c3ea4d5ac47720974078d50e9e4.tar.gz |
* weaks.c: Use new vector elements API or simple vector
API, as appropriate.
* srfi-4.h, srfi-4.c, srfi-4.i.c (scm_array_handle_uniform_elements,
scm_array_handle_uniform_writable_elements,
scm_uniform_vector_elements, scm_uniform_vector_writable_elements):
(scm_<foo>vector_elements, scm_<foo>vector_writable_elements): Use
scm_t_array_handle, deliver length and increment.
(scm_array_handle_<foo>_elements,
scm_array_handle_<foo>_writable_elements): New.
* unif.h, unif.c (scm_t_array_handle, scm_array_get_handle,
scm_array_handle_rank, scm_array_handle_dims, scm_array_handle_ref
scm_array_handle_set, scm_array_handle_elements
scm_array_handle_writable_elements, scm_vector_get_handle): New.
(scm_make_uve, scm_array_prototype, scm_list_to_uniform_array,
scm_dimensions_to_uniform_array): Deprecated for real. (scm_array_p,
scm_i_array_p): Use latter for SCM_DEFINE since snarfing wont allow a
mismatch between C and Scheme arglists. (scm_make_shared_array,
scm_enclose_array): Correctly use scm_c_generalized_vector_length
instead of scm_uniform_vector_length.
* weaks.h, weaks.c: Use new internal weak vector API from
vectors.h.
* Makefile.am (libguile_la_SOURCES, DOT_X_FILES, DOT_DOC_FILES,
EXTRA_libguile_la_SOURCES): Changed ramap.c and unif.c from being
'extra' to being regular sources.
(noinst_HEADERS): Added quicksort.i.c.
* quicksort.i.c: New file.
* vectors.h, vector.c (SCM_VECTORP, SCM_VECTOR_LENGTH, SCM_VELTS,
SCM_WRITABLE_VELTS, SCM_VECTOR_REF, SCM_VECTOR_SET): Deprecated and
reimplemented. Replaced all uses with scm_vector_elements,
scm_vector_writable_elements, or SCM_SIMPLE_VECTOR_*, as appropriate.
(scm_is_simple_vector, SCM_SIMPLE_VECTOR_LENGTH,
SCM_SIMPLE_VECTOR_REF, SCM_SIMPLE_VECTOR_SET, SCM_SIMPLE_VECTOR_LOC):
New. (SCM_VECTOR_BASE, SCM_SET_VECTOR_BASE, SCM_VECTOR_MAX_LENGTH,
SCM_MAKE_VECTOR_TAG, SCM_SET_VECTOR_LENGTH, SCM_VELTS_AS_STACKITEMS,
SCM_SETVELTS, SCM_GC_WRITABLE_VELTS): Removed. (scm_vector_copy):
New. (scm_vector_elements, scm_vector_writable_elements): Use
scm_t_array_handle, deliver length and increment. Moved to
unif.h. Changed all uses. (scm_vector_release_elements,
scm_vector_release_writable_elements,
(scm_frame_vector_release_elements,
scm_frame_vector_release_writable_elements): Removed.
(SCM_I_IS_VECTOR, SCM_I_VECTOR_ELTS, SCM_I_VECTOR_WELTS,
SCM_I_VECTOR_LENGTH, scm_i_vector_free): New internal API.
(SCM_I_WVECTP SCM_I_WVECT_LENGTH SCM_I_WVECT_VELTS
SCM_I_WVECT_GC_WVELTS SCM_I_WVECT_TYPE SCM_I_WVECT_GC_CHAIN
SCM_I_SET_WVECT_GC_CHAIN, scm_i_allocate_weak_vector): New, for weak
vectors.
Diffstat (limited to 'libguile/srfi-4.c')
-rw-r--r-- | libguile/srfi-4.c | 144 |
1 files changed, 68 insertions, 76 deletions
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index 32b1b23d2..61995c662 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -584,85 +584,68 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, } #undef FUNC_NAME -const void * -scm_uniform_vector_elements (SCM uvec) +size_t +scm_uniform_vector_element_size (SCM uvec) { if (scm_is_uniform_vector (uvec)) - return SCM_UVEC_BASE (uvec); + return uvec_sizes[SCM_UVEC_TYPE (uvec)]; else scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); } - -void -scm_uniform_vector_release_elements (SCM uvec) + +/* return the size of an element in a uniform array or 0 if type not + found. */ +size_t +scm_uniform_element_size (SCM obj) { - /* Nothing to do right now, but this function might come in handy - when uniform vectors need to be locked when giving away a pointer - to their elements. - - Also, a call to scm_uniform_vector_release acts like - scm_remember_upto_here, which is needed in any case. - */ - - scm_remember_upto_here_1 (uvec); + if (scm_is_uniform_vector (obj)) + return scm_uniform_vector_element_size (obj); + else + return 0; } -void -scm_frame_uniform_vector_release_elements (SCM uvec) +const void * +scm_array_handle_uniform_elements (scm_t_array_handle *h) { - scm_frame_unwind_handler_with_scm (scm_uniform_vector_release_elements, uvec, - SCM_F_WIND_EXPLICITLY); + return scm_array_handle_uniform_writable_elements (h); } void * -scm_uniform_vector_writable_elements (SCM uvec) -{ - if (scm_is_uniform_vector (uvec)) - return SCM_UVEC_BASE (uvec); - else - scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); -} - -void -scm_uniform_vector_release_writable_elements (SCM uvec) +scm_array_handle_uniform_writable_elements (scm_t_array_handle *h) { - /* Nothing to do right now, but this function might come in handy - when uniform vectors need to be locked when giving away a pointer - to their elements. - - Also, a call to scm_uniform_vector_release acts like - scm_remember_upto_here, which is needed in any case. - */ - - scm_remember_upto_here_1 (uvec); + SCM vec = h->array; + if (SCM_ARRAYP (vec)) + vec = SCM_ARRAY_V (vec); + if (scm_is_uniform_vector (vec)) + { + size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)]; + char *elts = SCM_UVEC_BASE (vec); + return (void *) (elts + size*h->base); + } + scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); } -void -scm_frame_uniform_vector_release_writable_elements (SCM uvec) +const void * +scm_uniform_vector_elements (SCM uvec, + scm_t_array_handle *h, + size_t *lenp, ssize_t *incp) { - scm_frame_unwind_handler_with_scm - (scm_uniform_vector_release_writable_elements, uvec, - SCM_F_WIND_EXPLICITLY); + return scm_uniform_vector_writable_elements (uvec, h, lenp, incp); } -size_t -scm_uniform_vector_element_size (SCM uvec) -{ - if (scm_is_uniform_vector (uvec)) - return uvec_sizes[SCM_UVEC_TYPE (uvec)]; - else - scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); -} - -/* return the size of an element in a uniform array or 0 if type not - found. */ -size_t -scm_uniform_element_size (SCM obj) +void * +scm_uniform_vector_writable_elements (SCM uvec, + scm_t_array_handle *h, + size_t *lenp, ssize_t *incp) { - if (scm_is_uniform_vector (obj)) - return scm_uniform_vector_element_size (obj); - else - return 0; + scm_vector_get_handle (uvec, h); + if (lenp) + { + scm_t_array_dim *dim = scm_array_handle_dims (h); + *lenp = dim->ubnd - dim->lbnd + 1; + *incp = dim->inc; + } + return scm_array_handle_uniform_writable_elements (h); } SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, @@ -689,12 +672,15 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, "An error is signalled when the last element has only\n" "been partially filled before reaching end-of-file or in\n" "the single call to read(2).\n\n" - "@code{uniform-array-read!} returns the number of elements read.\n" + "@code{uniform-vector-read!} returns the number of elements\n" + "read.\n\n" "@var{port-or-fdes} may be omitted, in which case it defaults\n" "to the value returned by @code{(current-input-port)}.") #define FUNC_NAME s_scm_uniform_vector_read_x { + scm_t_array_handle handle; size_t vlen, sz, ans; + ssize_t inc; size_t cstart, cend; size_t remaining, off; void *base; @@ -706,13 +692,18 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, || (SCM_OPINPORTP (port_or_fd)), port_or_fd, SCM_ARG2, FUNC_NAME); - - scm_frame_begin (0); + if (!scm_is_uniform_vector (uvec)) + scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); - vlen = scm_c_uniform_vector_length (uvec); + base = scm_uniform_vector_writable_elements (uvec, &handle, &vlen, &inc); sz = scm_uniform_vector_element_size (uvec); - base = scm_uniform_vector_writable_elements (uvec); - scm_frame_uniform_vector_release_writable_elements (uvec); + + if (inc != 1) + { + /* XXX - we should of course support non contiguous vectors. */ + scm_misc_error (NULL, "only contiguous vectors are supported: ~a", + scm_list_1 (uvec)); + } cstart = 0; cend = vlen; @@ -740,7 +731,7 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, { size_t to_copy = min (pt->read_end - pt->read_pos, remaining); - + memcpy (base + off, pt->read_pos, to_copy); pt->read_pos += to_copy; remaining -= to_copy; @@ -774,8 +765,6 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, ans = n / sz; } - scm_frame_end (); - return scm_from_size_t (ans); } #undef FUNC_NAME @@ -800,7 +789,9 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, "@code{(current-output-port)}.") #define FUNC_NAME s_scm_uniform_vector_write { + scm_t_array_handle handle; size_t vlen, sz, ans; + ssize_t inc; size_t cstart, cend; size_t amount, off; const void *base; @@ -814,12 +805,15 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, || (SCM_OPOUTPORTP (port_or_fd)), port_or_fd, SCM_ARG2, FUNC_NAME); - scm_frame_begin (0); - - vlen = scm_c_generalized_vector_length (uvec); + base = scm_uniform_vector_elements (uvec, &handle, &vlen, &inc); sz = scm_uniform_vector_element_size (uvec); - base = scm_uniform_vector_elements (uvec); - scm_frame_uniform_vector_release_elements (uvec); + + if (inc != 1) + { + /* XXX - we should of course support non contiguous vectors. */ + scm_misc_error (NULL, "only contiguous vectors are supported: ~a", + scm_list_1 (uvec)); + } cstart = 0; cend = vlen; @@ -849,8 +843,6 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, ans = n / sz; } - scm_frame_end (); - return scm_from_size_t (ans); } #undef FUNC_NAME |