build: Tell `gen-scmconfig' whether the system has `struct timespec'.

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

diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 95d37a3..0158490 100644 (file)
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012 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
@@ -27,36 +27,23 @@
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
-#include "libguile/smob.h"
 #include "libguile/strings.h"
 #include "libguile/array-handle.h"
 #include "libguile/bitvectors.h"
 #include "libguile/arrays.h"
-#include "libguile/vectors.h"
-#include "libguile/srfi-4.h"
 #include "libguile/generalized-vectors.h"
+#include "libguile/srfi-4.h"
 
 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
  * but alack, all we have is this crufty C.
  */
 
-static scm_t_bits scm_tc16_bitvector;
-
-#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
-#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;
-}
+#define IS_BITVECTOR(obj)       SCM_TYP16_PREDICATE(scm_tc7_bitvector,(obj))
+#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_CELL_WORD_1(obj))
+#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_CELL_WORD_2(obj))
 
-static int
-bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
+int
+scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
 {
   size_t bit_len = BITVECTOR_LENGTH (vec);
   size_t word_len = (bit_len+31)/32;
@@ -74,8 +61,8 @@ bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
   return 1;
 }
 
-static SCM
-bitvector_equalp (SCM vec1, SCM vec2)
+SCM
+scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
 {
   size_t bit_len = BITVECTOR_LENGTH (vec1);
   size_t word_len = (bit_len + 31) / 32;
@@ -121,12 +108,14 @@ 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");
-  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+  bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
+                                   "bitvector");
+  res = scm_double_cell (scm_tc7_bitvector, (scm_t_bits)bits, len, 0);
 
   if (!SCM_UNBNDP (fill))
     scm_bitvector_fill_x (res, fill);
+  else
+    memset (bits, 0, sizeof (scm_t_uint32) * word_len);
       
   return res;
 }
@@ -153,7 +142,8 @@ SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
 size_t
 scm_c_bitvector_length (SCM vec)
 {
-  scm_assert_smob_type (scm_tc16_bitvector, vec);
+  if (!IS_BITVECTOR (vec))
+    scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
   return BITVECTOR_LENGTH (vec);
 }
 
@@ -504,10 +494,10 @@ find_first_one (scm_t_uint32 x)
 
 SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
            (SCM item, SCM v, SCM k),
-           "Return the index of the first occurrance of @var{item} in bit\n"
+           "Return the index of the first occurrence of @var{item} in bit\n"
            "vector @var{v}, starting from @var{k}.  If there is no\n"
            "@var{item} entry between @var{k} and the end of\n"
-           "@var{bitvector}, then return @code{#f}.  For example,\n"
+           "@var{v}, then return @code{#f}.  For example,\n"
            "\n"
            "@example\n"
            "(bit-position #t #*000101 0)  @result{} 3\n"
@@ -576,7 +566,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
            "\n"
            "If @var{kv} is a bit vector, then those entries where it has\n"
            "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
-           "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
+           "@var{v} must be at least as long as @var{kv}.  When @var{obj}\n"
            "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
            "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
            "\n"
@@ -619,10 +609,10 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
       ssize_t kv_inc;
       const scm_t_uint32 *kv_bits;
       
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
+      kv_bits = scm_bitvector_elements (kv, &kv_handle,
                                        &kv_off, &kv_len, &kv_inc);
 
-      if (v_len != kv_len)
+      if (v_len < kv_len)
        scm_misc_error (NULL,
                        "bit vectors must have equal length",
                        SCM_EOL);
@@ -888,19 +878,15 @@ bitvector_get_handle (SCM bv, scm_t_array_handle *h)
   h->elements = h->writable_elements = BITVECTOR_BITS (bv);
 }
 
-SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_bitvector,
+                          0x7f,
                           bitvector_handle_ref, bitvector_handle_set,
-                          bitvector_get_handle);
-SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
+                          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);
-
 #include "libguile/bitvectors.x"
 }