Merge commit 'dc65b88d839c326889618112c4870ad3a64e9446'

[bpt/guile.git] / libguile / srfi-4.c

diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index c45519b..d8a264c 100644 (file)
--- 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;