fix a number of assuptions that a long could hold an inum

[bpt/guile.git] / libguile / bytevectors.c

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index ac5bc16..31703bf 100644 (file)
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010 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
@@ -131,7 +131,7 @@
   SCM_VALIDATE_SYMBOL (3, endianness);                         \
                                                                \
   {                                                            \
-    _sign long c_value;                                                \
+    scm_t_signed_bits c_value;                                 \
     INT_TYPE (_len, _sign) c_value_short;                      \
                                                                \
     if (SCM_UNLIKELY (!SCM_I_INUMP (value)))                   \
@@ -156,7 +156,7 @@
   INTEGER_ACCESSOR_PROLOGUE (_len, _sign);                     \
                                                                \
   {                                                            \
-    _sign long c_value;                                                \
+    scm_t_signed_bits c_value;                                 \
     INT_TYPE (_len, _sign) c_value_short;                      \
                                                                \
     if (SCM_UNLIKELY (!SCM_I_INUMP (value)))                   \
@@ -275,6 +275,13 @@ scm_c_make_bytevector (size_t len)
   return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
 }
 
+/* Return a new bytevector of size LEN elements.  */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  return make_bytevector (len, element_type);
+}
+
 /* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
    by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
 SCM
@@ -283,6 +290,13 @@ scm_c_take_bytevector (signed char *contents, size_t len)
   return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
 }
 
+SCM
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
+                             scm_t_array_element_type element_type)
+{
+  return make_bytevector_from_buffer (len, contents, element_type);
+}
+
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
    size) and return the new bytevector (possibly different from BV).  */
 SCM
@@ -497,7 +511,8 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
   c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
   c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
 
-  if (c_len1 == c_len2)
+  if (c_len1 == c_len2 && (SCM_BYTEVECTOR_ELEMENT_TYPE (bv1)
+                           == SCM_BYTEVECTOR_ELEMENT_TYPE (bv2)))
     {
       signed char *c_bv1, *c_bv2;
 
@@ -720,7 +735,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 
       if (SCM_LIKELY (SCM_I_INUMP (item)))
        {
-         long c_item;
+         scm_t_signed_bits c_item;
 
          c_item = SCM_I_INUM (item);
          if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
@@ -936,7 +951,7 @@ bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
 #define GENERIC_INTEGER_SET(_sign)                                     \
   if (c_size < 3)                                                      \
     {                                                                  \
-      _sign int c_value;                                               \
+      scm_t_signed_bits c_value;                                       \
                                                                        \
       if (SCM_UNLIKELY (!SCM_I_INUMP (value)))                         \
        goto range_error;                                               \
@@ -2081,7 +2096,7 @@ bytevector_ref_c32 (SCM bv, SCM idx)
 { /* FIXME add some checks */
   const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
   size_t i = scm_to_size_t (idx);
-  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+  return scm_c_make_rectangular (contents[i/4], contents[i/4 + 1]);
 }
 
 static SCM
@@ -2089,7 +2104,7 @@ bytevector_ref_c64 (SCM bv, SCM idx)
 { /* FIXME add some checks */
   const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
   size_t i = scm_to_size_t (idx);
-  return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
 }
 
 typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
@@ -2126,23 +2141,22 @@ bv_handle_ref (scm_t_array_handle *h, size_t index)
   return ref_fn (h->array, byte_index);
 }
 
+/* FIXME add checks!!! */
 static SCM
 bytevector_set_c32 (SCM bv, SCM idx, SCM val)
-{ /* checks are unnecessary here */
-  float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+{ float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
   size_t i = scm_to_size_t (idx);
-  contents[i/8] = scm_c_real_part (val);
-  contents[i/8 + 1] = scm_c_imag_part (val);
+  contents[i/4] = scm_c_real_part (val);
+  contents[i/4 + 1] = scm_c_imag_part (val);
   return SCM_UNSPECIFIED;
 }
 
 static SCM
 bytevector_set_c64 (SCM bv, SCM idx, SCM val)
-{ /* checks are unnecessary here */
-  double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+{ double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
   size_t i = scm_to_size_t (idx);
-  contents[i/16] = scm_c_real_part (val);
-  contents[i/16 + 1] = scm_c_imag_part (val);
+  contents[i/8] = scm_c_real_part (val);
+  contents[i/8 + 1] = scm_c_imag_part (val);
   return SCM_UNSPECIFIED;
 }
 
@@ -2200,7 +2214,7 @@ void
 scm_bootstrap_bytevectors (void)
 {
   /* This must be instantiated here because the generalized-vector API may
-     want to access bytevectors even though `(rnrs bytevector)' hasn't been
+     want to access bytevectors even though `(rnrs bytevectors)' hasn't been
      loaded.  */
   scm_null_bytevector = make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8);
 
@@ -2210,7 +2224,8 @@ scm_bootstrap_bytevectors (void)
   scm_i_native_endianness = scm_from_locale_symbol ("little");
 #endif
 
-  scm_c_register_extension ("libguile", "scm_init_bytevectors",
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_bytevectors",
                            (scm_t_extension_init_func) scm_init_bytevectors,
                            NULL);