Merge branch 'master' into wip-manual-2

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

diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index a5da47c..67f5abd 100644 (file)
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -32,7 +32,7 @@
 #include "libguile/array-handle.h"
 #include "libguile/bitvectors.h"
 #include "libguile/arrays.h"
-#include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/srfi-4.h"
 
 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
@@ -45,15 +45,6 @@ static scm_t_bits scm_tc16_bitvector;
 #define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
 #define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
 
-static size_t
-bitvector_free (SCM vec)
-{
-  scm_gc_free (BITVECTOR_BITS (vec),
-              sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
-              "bitvector");
-  return 0;
-}
-
 static int
 bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
 {
@@ -120,8 +111,8 @@ scm_c_make_bitvector (size_t len, SCM fill)
   scm_t_uint32 *bits;
   SCM res;
 
-  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
-                       "bitvector");
+  bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
+                                   "bitvector");
   SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
 
   if (!SCM_UNBNDP (fill))
@@ -861,11 +852,42 @@ scm_istr2bve (SCM str)
   return res;
 }
 
+/* FIXME: h->array should be h->vector */
+static SCM
+bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_bitvector_ref (h->array, pos);
+}
+
+static void
+bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_bitvector_set_x (h->array, pos, val);
+}
+
+static void
+bitvector_get_handle (SCM bv, scm_t_array_handle *h)
+{
+  h->array = bv;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT;
+  h->elements = h->writable_elements = BITVECTOR_BITS (bv);
+}
+
+SCM_ARRAY_IMPLEMENTATION (SCM_SMOB_TYPE_BITS (scm_tc16_bitvector),
+                          SCM_SMOB_TYPE_MASK,
+                          bitvector_handle_ref, bitvector_handle_set,
+                          bitvector_get_handle)
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
+
 void
 scm_init_bitvectors ()
 {
   scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
-  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
   scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
   scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);