Remove GOOPS random state
[bpt/guile.git] / libguile / bytevectors.c
index 064c427..41d5b6c 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2015 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
@@ -43,9 +43,6 @@
 
 #ifdef HAVE_LIMITS_H
 # include <limits.h>
-#else
-/* Assuming 32-bit longs.  */
-# define ULONG_MAX 4294967295UL
 #endif
 
 #include <string.h>
@@ -332,10 +329,16 @@ scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
   SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv))
-    new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
-                                     c_len + SCM_BYTEVECTOR_HEADER_BYTES,
-                                     c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
-                                     SCM_GC_BYTEVECTOR));
+    {
+      signed char *c_bv;
+
+      c_bv = scm_gc_realloc (SCM2PTR (bv),
+                            c_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                            c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                            SCM_GC_BYTEVECTOR);
+      new_bv = PTR2SCM (c_bv);
+      SCM_BYTEVECTOR_SET_CONTENTS (new_bv, c_bv + SCM_BYTEVECTOR_HEADER_BYTES);
+    }
   else
     {
       signed char *c_bv;
@@ -474,10 +477,10 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
 #define FUNC_NAME s_scm_make_bytevector
 {
   SCM bv;
-  unsigned c_len;
-  signed char c_fill = '\0';
+  size_t c_len;
+  scm_t_uint8 c_fill = 0;
 
-  SCM_VALIDATE_UINT_COPY (1, len, c_len);
+  SCM_VALIDATE_SIZE_COPY (1, len, c_len);
   if (!scm_is_eq (fill, SCM_UNDEFINED))
     {
       int value;
@@ -485,16 +488,16 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       value = scm_to_int (fill);
       if (SCM_UNLIKELY ((value < -128) || (value > 255)))
        scm_out_of_range (FUNC_NAME, fill);
-      c_fill = (signed char) value;
+      c_fill = (scm_t_uint8) value;
     }
 
   bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (!scm_is_eq (fill, SCM_UNDEFINED))
     {
-      unsigned i;
-      signed char *contents;
+      size_t i;
+      scm_t_uint8 *contents;
 
-      contents = SCM_BYTEVECTOR_CONTENTS (bv);
+      contents = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
       for (i = 0; i < c_len; i++)
        contents[i] = c_fill;
     }
@@ -521,7 +524,7 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
 #define FUNC_NAME s_scm_bytevector_eq_p
 {
   SCM result = SCM_BOOL_F;
-  unsigned c_len1, c_len2;
+  size_t c_len1, c_len2;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv1);
   SCM_VALIDATE_BYTEVECTOR (2, bv2);
@@ -549,14 +552,19 @@ SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
            "Fill bytevector @var{bv} with @var{fill}, a byte.")
 #define FUNC_NAME s_scm_bytevector_fill_x
 {
-  unsigned c_len, i;
-  signed char *c_bv, c_fill;
+  size_t c_len, i;
+  scm_t_uint8 *c_bv, c_fill;
+  int value;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv);
-  c_fill = scm_to_int8 (fill);
+
+  value = scm_to_int (fill);
+  if (SCM_UNLIKELY ((value < -128) || (value > 255)))
+    scm_out_of_range (FUNC_NAME, fill);
+  c_fill = (scm_t_uint8) value;
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; i++)
     c_bv[i] = c_fill;
@@ -574,16 +582,16 @@ SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
            "@var{target_start}.")
 #define FUNC_NAME s_scm_bytevector_copy_x
 {
-  unsigned c_len, c_source_len, c_target_len;
-  unsigned c_source_start, c_target_start;
+  size_t c_len, c_source_len, c_target_len;
+  size_t c_source_start, c_target_start;
   signed char *c_source, *c_target;
 
   SCM_VALIDATE_BYTEVECTOR (1, source);
   SCM_VALIDATE_BYTEVECTOR (3, target);
 
-  c_len = scm_to_uint (len);
-  c_source_start = scm_to_uint (source_start);
-  c_target_start = scm_to_uint (target_start);
+  c_len = scm_to_size_t (len);
+  c_source_start = scm_to_size_t (source_start);
+  c_target_start = scm_to_size_t (target_start);
 
   c_source = SCM_BYTEVECTOR_CONTENTS (source);
   c_target = SCM_BYTEVECTOR_CONTENTS (target);
@@ -609,7 +617,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
 #define FUNC_NAME s_scm_bytevector_copy
 {
   SCM copy;
-  unsigned c_len;
+  size_t c_len;
   signed char *c_bv, *c_copy;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv);
@@ -617,7 +625,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 
-  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
+  copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -714,15 +722,15 @@ SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
 #define FUNC_NAME s_scm_bytevector_to_u8_list
 {
   SCM lst, pair;
-  unsigned c_len, i;
-  unsigned char *c_bv;
+  size_t c_len, i;
+  scm_t_uint8 *c_bv;
 
   SCM_VALIDATE_BYTEVECTOR (1, bv);
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
 
-  lst = scm_make_list (scm_from_uint (c_len), SCM_UNSPECIFIED);
+  lst = scm_make_list (scm_from_size_t (c_len), SCM_UNSPECIFIED);
   for (i = 0, pair = lst;
        i < c_len;
        i++, pair = SCM_CDR (pair))
@@ -740,13 +748,13 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 #define FUNC_NAME s_scm_u8_list_to_bytevector
 {
   SCM bv, item;
-  long c_len, i;
-  unsigned char *c_bv;
+  size_t c_len, i;
+  scm_t_uint8 *c_bv;
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
   bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
     {
@@ -758,7 +766,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 
          c_item = SCM_I_INUM (item);
          if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
-           c_bv[i] = (unsigned char) c_item;
+           c_bv[i] = (scm_t_uint8) c_item;
          else
            goto type_error;
        }
@@ -892,20 +900,20 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
 }
 
 #define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign)                       \
-  unsigned long c_len, c_index, c_size;                                        \
+  size_t c_len, c_index, c_size;                                       \
   char *c_bv;                                                          \
                                                                        \
   SCM_VALIDATE_BYTEVECTOR (1, bv);                                     \
-  c_index = scm_to_ulong (index);                                      \
-  c_size = scm_to_ulong (size);                                                \
+  c_index = scm_to_size_t (index);                                     \
+  c_size = scm_to_size_t (size);                                       \
                                                                        \
   c_len = SCM_BYTEVECTOR_LENGTH (bv);                                  \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                                \
                                                                        \
   /* C_SIZE must have its 3 higher bits set to zero so that            \
-     multiplying it by 8 yields a number that fits in an               \
-     unsigned long.  */                                                        \
-  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))   \
+     multiplying it by 8 yields a number that fits in a                        \
+     size_t.  */                                                       \
+  if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3)))         \
     scm_out_of_range (FUNC_NAME, size);                                        \
   if (SCM_UNLIKELY (c_index + c_size > c_len))                         \
     scm_out_of_range (FUNC_NAME, index);
@@ -1173,18 +1181,18 @@ SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
 
 #define INTEGER_LIST_TO_BYTEVECTOR(_sign)                              \
   SCM bv;                                                              \
-  long c_len;                                                          \
+  size_t c_len;                                                                \
   size_t c_size;                                                       \
   char *c_bv, *c_bv_ptr;                                               \
                                                                        \
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);                           \
   SCM_VALIDATE_SYMBOL (2, endianness);                                 \
-  c_size = scm_to_uint (size);                                         \
+  c_size = scm_to_size_t (size);                                       \
                                                                        \
-  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))   \
+  if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3)))         \
     scm_out_of_range (FUNC_NAME, size);                                        \
                                                                        \
-  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);     \
+  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);    \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                                \
                                                                        \
   for (c_bv_ptr = c_bv;                                                        \
@@ -2081,168 +2089,6 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 #undef FUNC_NAME
 
 \f
-/* Bytevectors as generalized vectors & arrays.  */
-
-#define COMPLEX_ACCESSOR_PROLOGUE(_type)                       \
-  size_t c_len, c_index;                                       \
-  char *c_bv;                                                  \
-                                                               \
-  SCM_VALIDATE_BYTEVECTOR (1, bv);                             \
-  c_index = scm_to_size_t (index);                             \
-                                                               \
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);                          \
-  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                        \
-                                                               \
-  if (SCM_UNLIKELY (c_index + 2 * sizeof (_type) - 1 >= c_len))        \
-    scm_out_of_range (FUNC_NAME, index);
-
-/* Template for native access to complex numbers of type TYPE.  */
-#define COMPLEX_NATIVE_REF(_type)                                      \
-  SCM result;                                                          \
-                                                                       \
-  COMPLEX_ACCESSOR_PROLOGUE (_type);                                   \
-                                                                       \
-  {                                                                    \
-    _type real, imag;                                                  \
-                                                                       \
-    memcpy (&real, &c_bv[c_index], sizeof (_type));                    \
-    memcpy (&imag, &c_bv[c_index + sizeof (_type)], sizeof (_type));   \
-                                                                       \
-    result = scm_c_make_rectangular (real, imag);                      \
-  }                                                                    \
-                                                                       \
-  return result;
-
-static SCM
-bytevector_ref_c32 (SCM bv, SCM index)
-#define FUNC_NAME "bytevector_ref_c32"
-{
-  COMPLEX_NATIVE_REF (float);
-}
-#undef FUNC_NAME
-
-static SCM
-bytevector_ref_c64 (SCM bv, SCM index)
-#define FUNC_NAME "bytevector_ref_c64"
-{
-  COMPLEX_NATIVE_REF (double);
-}
-#undef FUNC_NAME
-
-typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
-
-static const scm_t_bytevector_ref_fn
-bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] =
-{
-  NULL, /* SCM */
-  NULL, /* CHAR */
-  NULL, /* BIT */
-  scm_bytevector_u8_ref, /* VU8 */
-  scm_bytevector_u8_ref, /* U8 */
-  scm_bytevector_s8_ref,
-  scm_bytevector_u16_native_ref,
-  scm_bytevector_s16_native_ref,
-  scm_bytevector_u32_native_ref,
-  scm_bytevector_s32_native_ref,
-  scm_bytevector_u64_native_ref,
-  scm_bytevector_s64_native_ref,
-  scm_bytevector_ieee_single_native_ref,
-  scm_bytevector_ieee_double_native_ref,
-  bytevector_ref_c32,
-  bytevector_ref_c64
-};
-
-static SCM
-bv_handle_ref (scm_t_array_handle *h, size_t index)
-{
-  SCM byte_index;
-  scm_t_bytevector_ref_fn ref_fn;
-  
-  ref_fn = bytevector_ref_fns[h->element_type];
-  byte_index =
-    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
-  return ref_fn (h->array, byte_index);
-}
-
-/* Template for native modification of complex numbers of type TYPE.  */
-#define COMPLEX_NATIVE_SET(_type)                                      \
-  COMPLEX_ACCESSOR_PROLOGUE (_type);                                   \
-                                                                       \
-  {                                                                    \
-    _type real, imag;                                                  \
-    real = scm_c_real_part (value);                                    \
-    imag = scm_c_imag_part (value);                                    \
-                                                                       \
-    memcpy (&c_bv[c_index], &real, sizeof (_type));                    \
-    memcpy (&c_bv[c_index + sizeof (_type)], &imag, sizeof (_type));   \
-  }                                                                    \
-                                                                       \
-  return SCM_UNSPECIFIED;
-
-static SCM
-bytevector_set_c32 (SCM bv, SCM index, SCM value)
-#define FUNC_NAME "bytevector_set_c32"
-{
-  COMPLEX_NATIVE_SET (float);
-}
-#undef FUNC_NAME
-
-static SCM
-bytevector_set_c64 (SCM bv, SCM index, SCM value)
-#define FUNC_NAME "bytevector_set_c64"
-{
-  COMPLEX_NATIVE_SET (double);
-}
-#undef FUNC_NAME
-
-typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
-
-const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
-{
-  NULL, /* SCM */
-  NULL, /* CHAR */
-  NULL, /* BIT */
-  scm_bytevector_u8_set_x, /* VU8 */
-  scm_bytevector_u8_set_x, /* U8 */
-  scm_bytevector_s8_set_x,
-  scm_bytevector_u16_native_set_x,
-  scm_bytevector_s16_native_set_x,
-  scm_bytevector_u32_native_set_x,
-  scm_bytevector_s32_native_set_x,
-  scm_bytevector_u64_native_set_x,
-  scm_bytevector_s64_native_set_x,
-  scm_bytevector_ieee_single_native_set_x,
-  scm_bytevector_ieee_double_native_set_x,
-  bytevector_set_c32,
-  bytevector_set_c64
-};
-
-static void
-bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
-{
-  SCM byte_index;
-  scm_t_bytevector_set_fn set_fn;
-  
-  set_fn = bytevector_set_fns[h->element_type];
-  byte_index =
-    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
-  set_fn (h->array, byte_index, val);
-}
-
-static void
-bytevector_get_handle (SCM v, scm_t_array_handle *h)
-{
-  h->array = v;
-  h->ndims = 1;
-  h->dims = &h->dim0;
-  h->dim0.lbnd = 0;
-  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
-  h->dim0.inc = 1;
-  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
-  h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
-}
-
-\f
 /* Initialization.  */
 
 void
@@ -2264,19 +2110,9 @@ scm_bootstrap_bytevectors (void)
                            (scm_t_extension_init_func) scm_init_bytevectors,
                            NULL);
 
-  {
-    scm_t_array_implementation impl;
-
-    impl.tag = scm_tc7_bytevector;
-    impl.mask = 0x7f;
-    impl.vref = bv_handle_ref;
-    impl.vset = bv_handle_set_x;
-    impl.get_handle = bytevector_get_handle;
-    scm_i_register_array_implementation (&impl);
-    scm_i_register_vector_constructor
-      (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
-       scm_make_bytevector);
-  }
+  scm_i_register_vector_constructor
+    (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
+     scm_make_bytevector);
 }
 
 void