diff options
author | Andy Wingo <wingo@pobox.com> | 2014-02-08 14:56:16 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-02-08 14:56:16 +0100 |
commit | 54f17b7b597a3695a25babac92255ed52fbeec4a (patch) | |
tree | 86b06db635fbbabfd00dccfbb7efd10829b94369 /libguile/srfi-4.c | |
parent | c8b7b0dad33d6221682c5f49b7635d8de7e15bab (diff) | |
parent | dc65b88d839c326889618112c4870ad3a64e9446 (diff) | |
download | guile-54f17b7b597a3695a25babac92255ed52fbeec4a.tar.gz |
Merge commit 'dc65b88d839c326889618112c4870ad3a64e9446'
Conflicts:
libguile/srfi-4.c
Diffstat (limited to 'libguile/srfi-4.c')
-rw-r--r-- | libguile/srfi-4.c | 68 |
1 files changed, 25 insertions, 43 deletions
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index c45519b1d..d8a264c54 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -1,6 +1,6 @@ /* srfi-4.c --- Uniform numeric vector datatypes. * - * Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011, 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 @@ -137,32 +137,15 @@ scm_t_array_handle *h, \ size_t *lenp, ssize_t *incp) \ { \ - scm_uniform_vector_elements (uvec, h, lenp, incp); \ - if (h->element_type == ETYPE (TAG)) \ - return ((ctype*)h->writable_elements) + h->base*width; \ - /* otherwise... */ \ - else \ - { \ - size_t sfrom, sto, lfrom, lto; \ - if (h->dims != &h->dim0) \ - { \ - h->dim0 = h->dims[0]; \ - h->dims = &h->dim0; \ - } \ - sfrom = scm_i_array_element_type_sizes [h->element_type]; \ - sto = scm_i_array_element_type_sizes [ETYPE (TAG)]; \ - lfrom = h->dim0.ubnd - h->dim0.lbnd + 1; \ - lto = lfrom * sfrom / sto; \ - if (lto * sto != lfrom * sfrom) \ - { \ - scm_array_handle_release (h); \ - scm_wrong_type_arg (#tag"vector-elements", SCM_ARG1, uvec); \ - } \ - h->dim0.ubnd = h->dim0.lbnd + lto; \ - h->base = h->base * sto / sfrom; \ - h->element_type = ETYPE (TAG); \ - return ((ctype*)h->writable_elements) + h->base*width; \ - } \ + if (!scm_is_bytevector (uvec) \ + || (scm_c_bytevector_length (uvec) % width)) \ + scm_wrong_type_arg_msg (NULL, 0, uvec, #tag "vector"); \ + scm_array_get_handle (uvec, h); \ + if (lenp) \ + *lenp = scm_c_bytevector_length (uvec) / width; \ + if (incp) \ + *incp = 1; \ + return ((ctype *)h->writable_elements); \ } @@ -231,13 +214,15 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 2, 1, 0, "Make a srfi-4 vector") #define FUNC_NAME s_scm_make_srfi_4_vector { - int i; - for (i = 0; i <= SCM_ARRAY_ELEMENT_TYPE_LAST; i++) - if (scm_is_eq (type, scm_i_array_element_types[i])) + int c_type; + size_t c_len; + + for (c_type = 0; c_type <= SCM_ARRAY_ELEMENT_TYPE_LAST; c_type++) + if (scm_is_eq (type, scm_i_array_element_types[c_type])) break; - if (i > SCM_ARRAY_ELEMENT_TYPE_LAST) + if (c_type > SCM_ARRAY_ELEMENT_TYPE_LAST) scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "vector type"); - switch (i) + switch (c_type) { case SCM_ARRAY_ELEMENT_TYPE_U8: case SCM_ARRAY_ELEMENT_TYPE_S8: @@ -252,7 +237,10 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 2, 1, 0, case SCM_ARRAY_ELEMENT_TYPE_C32: case SCM_ARRAY_ELEMENT_TYPE_C64: { - SCM ret = scm_i_make_typed_bytevector (scm_to_size_t (len), i); + SCM ret; + + c_len = scm_to_size_t (len); + ret = scm_i_make_typed_bytevector (c_len, c_type); if (SCM_UNBNDP (fill) || scm_is_eq (len, SCM_INUM0)) ; /* pass */ @@ -262,17 +250,11 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 2, 1, 0, else { scm_t_array_handle h; - size_t len; - ssize_t pos, inc; - - scm_uniform_vector_writable_elements (ret, &h, &len, &inc); - - for (pos = 0; pos != h.dims[0].ubnd; pos += inc) - scm_array_handle_set (&h, pos, fill); - - /* Initialize the last element. */ - scm_array_handle_set (&h, pos, fill); + size_t i; + scm_array_get_handle (ret, &h); + for (i = 0; i < c_len; i++) + scm_array_handle_set (&h, i, fill); scm_array_handle_release (&h); } return ret; |