summaryrefslogtreecommitdiff
path: root/libguile/srfi-4.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-02-08 14:56:16 +0100
committerAndy Wingo <wingo@pobox.com>2014-02-08 14:56:16 +0100
commit54f17b7b597a3695a25babac92255ed52fbeec4a (patch)
tree86b06db635fbbabfd00dccfbb7efd10829b94369 /libguile/srfi-4.c
parentc8b7b0dad33d6221682c5f49b7635d8de7e15bab (diff)
parentdc65b88d839c326889618112c4870ad3a64e9446 (diff)
downloadguile-54f17b7b597a3695a25babac92255ed52fbeec4a.tar.gz
Merge commit 'dc65b88d839c326889618112c4870ad3a64e9446'
Conflicts: libguile/srfi-4.c
Diffstat (limited to 'libguile/srfi-4.c')
-rw-r--r--libguile/srfi-4.c68
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;