bytevectors have "element type" field, e.g. for generalized-vector-ref

Bytevectors have a very close relationship to other forms of uniform
vectors. Often you want to view a u64vector as a series of bytes, for
writing over a socket; or to process an incoming stream using the
convenient and less error-prone s16vector-ref API rather than
bytevector-s16-native-ref.

The essential needs of the representation of a bytevector and an
s64vector are the same, so we take advantage of that and extend the
bytevector implementation to have a "native type" field, which defaults
to VU8.

This commit doesn't actually expose any user-noticeable changes,
however.

* libguile/bytevectors.h (SCM_BYTEVECTOR_ELEMENT_TYPE): New internal
  defines.
  (scm_i_make_typed_bytevector, scm_c_take_typed_bytevector): New
  internal functions.

* libguile/bytevectors.c (SCM_BYTEVECTOR_SET_ELEMENT_TYPE):
  (SCM_BYTEVECTOR_TYPE_SIZE):
  (SCM_BYTEVECTOR_TYPED_LENGTH): New internal macros.
  (make_bytevector, make_bytevector_from_buffer): Take an extra
  argument, the element type. The length argument is interpreted as
  being the number of elements, which corresponds to the number of bytes
  in the default VU8 case. Doing it this way eliminates a class of bugs
  -- e.g. a u32vector of length 3 bytes doesn't make sense. We do have
  to check for another class of bugs: overflow. The length stored on the
  bytevector itself is still the byte length, though.
  (scm_i_make_typed_bytevector):
  (scm_c_take_typed_bytevector): New internal functions.
  (scm_i_shrink_bytevector): Make sure the new size is valid for the
  bytevector's type.
  (scm_i_bytevector_generalized_set_x): Remove this function, the
  array-handle infrastructure takes care of this for us.
  (print_bytevector): Print the bytevector according to its type.
  (scm_make_bytevector, scm_bytevector_copy)
  (scm_uniform_array_to_bytevector)
  (scm_u8_list_to_bytevector, scm_bytevector_to_uint_list): Adapt to
  make_bytevector extra arg.
  (bv_handle_ref, bv_handle_set_x): Adapt to ref and set based on the
  type of the bytevector, e.g. f64 or u8.
  (bytevector_get_handle): Set the typed length of the vector, not the
  byte length.

Conflicts:

	libguile/bytevectors.c

2 files changed, 185 insertions, 47 deletions

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index d2a6402a2..a8155ed2c 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -186,47 +186,75 @@ scm_t_bits scm_tc16_bytevector;
   SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
 #define SCM_BYTEVECTOR_SET_INLINE(bv)                                   \
   SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)                          \
+  SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
+  SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
 
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
 static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, void *contents,
+                             scm_t_array_element_type element_type)
 {
   SCM ret;
-  if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
-    SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, contents);
+  size_t c_len;
+  
+  if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                    || scm_i_array_element_type_sizes[element_type] < 8
+                    || len >= (SCM_I_SIZE_MAX
+                               / (scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+  
+  c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+  if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents);
   else
     {
-      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, NULL);
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
       SCM_BYTEVECTOR_SET_INLINE (ret);
       if (contents)
         {
-          memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, len);
-          scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
+          memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
+          scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
         }
     }
+  SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
   return ret;
 }
 
 static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
 {
-  if (SCM_UNLIKELY (len == 0))
-    return scm_null_bytevector;
+  size_t c_len;
 
-  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
+  if (SCM_UNLIKELY (len == 0 && element_type == 0))
+    return scm_null_bytevector;
+  else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                         || scm_i_array_element_type_sizes[element_type] < 8
+                         || len >= (SCM_I_SIZE_MAX
+                                    / (scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+
+  c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
+  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
     {
       SCM ret;
-      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, NULL);
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
       SCM_BYTEVECTOR_SET_INLINE (ret);
+      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
       return ret;
     }
   else
     {
-      void *buf = scm_gc_malloc (len, SCM_GC_BYTEVECTOR);
-      return make_bytevector_from_buffer (len, buf);
+      void *buf = scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+      return make_bytevector_from_buffer (len, buf, element_type);
     }
 }
 
@@ -234,7 +262,14 @@ make_bytevector (size_t len)
 SCM
 scm_c_make_bytevector (size_t len)
 {
-  return (make_bytevector (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
@@ -242,7 +277,14 @@ scm_c_make_bytevector (size_t len)
 SCM
 scm_c_take_bytevector (signed char *contents, size_t len)
 {
-  return make_bytevector_from_buffer (len, contents);
+  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
@@ -250,6 +292,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
 SCM
 scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
 {
+  if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+    /* This would be an internal Guile programming error */
+    abort ();
+
   if (!SCM_BYTEVECTOR_INLINE_P (bv))
     {
       size_t c_len;
@@ -336,38 +382,30 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
 }
 #undef FUNC_NAME
 
-/* This procedure is used by `scm_c_generalized_vector_set_x ()'.  */
-void
-scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
-#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
-{
-  scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
-}
-#undef FUNC_NAME
+
+
+
 
 static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  unsigned c_len, i;
-  unsigned char *c_bv;
-
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  ssize_t ubnd, inc, i;
+  scm_t_array_handle h;
+  
+  scm_array_get_handle (bv, &h);
 
-  scm_puts ("#vu8(", port);
-  for (i = 0; i < c_len; i++)
+  scm_putc ('#', port);
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc ('(', port);
+  for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+       i <= ubnd; i += inc)
     {
       if (i > 0)
 	scm_putc (' ', port);
-
-      scm_uintprint (c_bv[i], 10, port);
+      scm_write (scm_array_handle_ref (&h, i), port);
     }
-
   scm_putc (')', port);
 
-  /* Make GCC think we use it.  */
-  scm_remember_upto_here ((SCM) pstate);
-
   return 1;
 }
 
@@ -455,7 +493,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       c_fill = (signed char) value;
     }
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (fill != SCM_UNDEFINED)
     {
       unsigned i;
@@ -581,7 +619,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);
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -611,7 +649,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
   len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
   sz = scm_array_handle_uniform_element_size (&h);
 
-  ret = make_bytevector (len * sz);
+  ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
 
   scm_array_handle_release (&h);
@@ -700,7 +738,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1137,7 +1175,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
   if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
     scm_out_of_range (FUNC_NAME, size);					\
 									\
-  bv = make_bytevector (c_len * c_size);				\
+  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;							\
@@ -2067,16 +2105,109 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 
 /* Bytevectors as generalized vectors & arrays.  */
 
+
+static SCM
+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]);
+}
+
+static SCM
+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]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+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)
 {
-  return SCM_I_MAKINUM (scm_c_bytevector_ref (h->array, 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);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  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);
+  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);
+  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);
+  return SCM_UNSPECIFIED;
+}
+
+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_c_bytevector_set_x (h->array, index, scm_to_uint8 (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
@@ -2086,9 +2217,9 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h)
   h->ndims = 1;
   h->dims = &h->dim0;
   h->dim0.lbnd = 0;
-  h->dim0.ubnd = SCM_BYTEVECTOR_LENGTH (v) - 1;
+  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
   h->dim0.inc = 1;
-  h->element_type = SCM_ARRAY_ELEMENT_TYPE_VU8;
+  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
   h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
 }
 
@@ -2107,7 +2238,8 @@ scm_bootstrap_bytevectors (void)
   scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
 
   scm_null_bytevector =
-    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+    scm_gc_protect_object
+    (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 7296c7a20..e29fe6d11 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -121,10 +121,16 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 #define SCM_F_BYTEVECTOR_INLINE 0x1
 #define SCM_BYTEVECTOR_INLINE_P(_bv)            \
   (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)	\
+  (SCM_SMOB_FLAGS (_bv) >> 8)
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
 
+SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+                                              scm_t_array_element_type);
+
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);