X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/b4fa6cc90961c87b28e26b469863f19a1be26ce2..ae7f13be4bda70a6bc4a8478ce043df1a752ee6e:/libguile/arrays.c diff --git a/libguile/arrays.c b/libguile/arrays.c index 83d7db2b9..a771739ad 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005, - * 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -27,6 +27,7 @@ #include #include #include +#include #include "libguile/_scm.h" #include "libguile/__scm.h" @@ -60,21 +61,22 @@ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) -SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, +SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, (SCM ra), "Return the root vector of a shared array.") #define FUNC_NAME s_scm_shared_array_root { - if (SCM_I_ARRAYP (ra)) + if (!scm_is_array (ra)) + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); + else if (SCM_I_ARRAYP (ra)) return SCM_I_ARRAY_V (ra); - else if (scm_is_generalized_vector (ra)) + else return ra; - scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME -SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, +SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, (SCM ra), "Return the root vector index of the first element in the array.") #define FUNC_NAME s_scm_shared_array_offset @@ -195,8 +197,9 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1, scm_make_generalized_vector (type, scm_from_size_t (rlen), fill); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) - if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) + if (0 == s->lbnd) return SCM_I_ARRAY_V (ra); + return ra; } #undef FUNC_NAME @@ -242,8 +245,9 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, } else if (sz < 8) { - /* byte_len ?= ceil (rlen * sz / 8) */ - if (byte_len != (rlen * sz + 7) / 8) + /* Elements of sub-byte size (bitvectors) are addressed in 32-bit + units. */ + if (byte_len != ((rlen * sz + 31) / 32) * 4) SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL); } else @@ -253,7 +257,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, memcpy (elts, bytes, byte_len); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) - if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) + if (0 == s->lbnd) return SCM_I_ARRAY_V (ra); return ra; } @@ -288,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) scm_array_handle_release (&h); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) - if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) + if (0 == s->lbnd) return SCM_I_ARRAY_V (ra); return ra; } @@ -378,7 +382,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, { SCM_I_ARRAY_V (ra) = oldra; old_base = old_min = 0; - old_max = scm_c_generalized_vector_length (oldra) - 1; + old_max = scm_c_array_length (oldra) - 1; } inds = SCM_EOL; @@ -430,7 +434,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) { SCM v = SCM_I_ARRAY_V (ra); - size_t length = scm_c_generalized_vector_length (v); + size_t length = scm_c_array_length (v); if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) return v; if (s->ubnd < s->lbnd) @@ -474,20 +478,22 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME); - if (scm_is_generalized_vector (ra)) + switch (scm_c_array_rank (ra)) { + case 0: + if (!scm_is_null (args)) + SCM_WRONG_NUM_ARGS (); + return ra; + case 1: /* Make sure that we are called with a single zero as - arguments. + arguments. */ if (scm_is_null (args) || !scm_is_null (SCM_CDR (args))) SCM_WRONG_NUM_ARGS (); SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i); SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0); return ra; - } - - if (SCM_I_ARRAYP (ra)) - { + default: vargs = scm_vector (args); if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra)) SCM_WRONG_NUM_ARGS (); @@ -537,8 +543,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, scm_i_ra_set_contp (res); return res; } - - scm_wrong_type_arg_msg (NULL, 0, ra, "array"); } #undef FUNC_NAME @@ -583,14 +587,14 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, return SCM_BOOL_F; } } - + { SCM v = SCM_I_ARRAY_V (ra); - size_t length = scm_c_generalized_vector_length (v); + size_t length = scm_c_array_length (v); if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc) return v; } - + sra = scm_i_make_array (1); SCM_I_ARRAY_DIMS (sra)->lbnd = 0; SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1; @@ -816,15 +820,15 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate) } static SCM -array_handle_ref (scm_t_array_handle *h, size_t pos) +array_handle_ref (scm_t_array_handle *hh, size_t pos) { - return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos); + return scm_c_array_ref_1 (SCM_I_ARRAY_V (hh->array), pos); } static void -array_handle_set (scm_t_array_handle *h, size_t pos, SCM val) +array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val) { - scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val); + scm_c_array_set_1_x (SCM_I_ARRAY_V (hh->array), val, pos); } /* FIXME: should be handle for vect? maybe not, because of dims */ @@ -833,6 +837,7 @@ array_get_handle (SCM array, scm_t_array_handle *h) { scm_t_array_handle vh; scm_array_get_handle (SCM_I_ARRAY_V (array), &vh); + assert (vh.dims[0].inc == 1 && vh.dims[0].lbnd == 0 && vh.base == 0); h->element_type = vh.element_type; h->elements = vh.elements; h->writable_elements = vh.writable_elements;