summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-01-09 17:52:46 +0100
committerAndy Wingo <wingo@pobox.com>2012-01-09 17:56:21 +0100
commitff1feca9bd6d23b248f4e3eb768a08f7c3aabc1d (patch)
treef3e817ce8858172c04e793187f8412bad283b368
parentb2637c985ce93bc15e0378b8120d04a98ebdd212 (diff)
downloadguile-ff1feca9bd6d23b248f4e3eb768a08f7c3aabc1d.tar.gz
allocate a tc7 to bitvectors
* libguile/tags.h (scm_tc7_bitvector): Allocate a tc7 to bitvectors. * libguile/print.c (iprin1): * libguile/goops.c: * libguile/evalext.c (scm_self_evaluating_p): * libguile/eq.c (scm_equal_p): Add cases for bitvectors. * libguile/bitvectors.h: Declare internal print and equal? helpers. * libguile/bitvectors.c: Use a tc7 instead of a smob type.
-rw-r--r--libguile/bitvectors.c32
-rw-r--r--libguile/bitvectors.h2
-rw-r--r--libguile/eq.c2
-rw-r--r--libguile/evalext.c1
-rw-r--r--libguile/goops.c5
-rw-r--r--libguile/print.c3
-rw-r--r--libguile/tags.h2
7 files changed, 27 insertions, 20 deletions
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index c569ebfe1..b0c21f50d 100644
--- 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, 2010, 2011 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,7 +27,6 @@
#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"
@@ -39,14 +38,12 @@
* but alack, all we have is this crufty C.
*/
-static scm_t_bits scm_tc16_bitvector;
+#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))
-#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 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;
@@ -64,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;
@@ -113,7 +110,7 @@ scm_c_make_bitvector (size_t len, SCM fill)
bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
"bitvector");
- SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+ res = scm_double_cell (scm_tc7_bitvector, (scm_t_bits)bits, len, 0);
if (!SCM_UNBNDP (fill))
scm_bitvector_fill_x (res, fill);
@@ -145,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);
}
@@ -880,8 +878,8 @@ bitvector_get_handle (SCM bv, scm_t_array_handle *h)
h->elements = h->writable_elements = BITVECTOR_BITS (bv);
}
-SCM_ARRAY_IMPLEMENTATION (SCM_SMOB_TYPE_BITS (scm_tc16_bitvector),
- SCM_SMOB_TYPE_MASK,
+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)
@@ -889,10 +887,6 @@ 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_print (scm_tc16_bitvector, bitvector_print);
- scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
-
#include "libguile/bitvectors.x"
}
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index b6cf38357..6b25327a8 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -70,6 +70,8 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
size_t *lenp,
ssize_t *incp);
+SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate);
+SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
SCM_INTERNAL void scm_init_bitvectors (void);
#endif /* SCM_BITVECTORS_H */
diff --git a/libguile/eq.c b/libguile/eq.c
index d286d5c72..02ce0a9b5 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -358,6 +358,8 @@ scm_equal_p (SCM x, SCM y)
return scm_bytevector_eq_p (x, y);
case scm_tc7_array:
return scm_array_equal_p (x, y);
+ case scm_tc7_bitvector:
+ return scm_i_bitvector_equal_p (x, y);
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_i_vector_equal_p (x, y);
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 2dfaa1363..c1d46b56d 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -88,6 +88,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
case scm_tc7_program:
case scm_tc7_bytevector:
case scm_tc7_array:
+ case scm_tc7_bitvector:
case scm_tcs_struct:
return SCM_BOOL_T;
default:
diff --git a/libguile/goops.c b/libguile/goops.c
index e951309d0..2f9cf30b9 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -169,6 +169,7 @@ static SCM class_vm_cont;
static SCM class_bytevector;
static SCM class_uvec;
static SCM class_array;
+static SCM class_bitvector;
static SCM vtable_class_map = SCM_BOOL_F;
static scm_i_pthread_mutex_t vtable_class_map_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
@@ -291,6 +292,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return class_uvec;
case scm_tc7_array:
return class_array;
+ case scm_tc7_bitvector:
+ return class_bitvector;
case scm_tc7_string:
return scm_class_string;
case scm_tc7_number:
@@ -2528,6 +2531,8 @@ create_standard_classes (void)
scm_class_class, class_bytevector, SCM_EOL);
make_stdcls (&class_array, "<array>",
scm_class_class, scm_class_top, SCM_EOL);
+ make_stdcls (&class_bitvector, "<bitvector>",
+ scm_class_class, scm_class_top, SCM_EOL);
make_stdcls (&scm_class_number, "<number>",
scm_class_class, scm_class_top, SCM_EOL);
make_stdcls (&scm_class_complex, "<complex>",
diff --git a/libguile/print.c b/libguile/print.c
index e0a6daa52..f144a6491 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -653,6 +653,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_bytevector:
scm_i_print_bytevector (exp, port, pstate);
break;
+ case scm_tc7_bitvector:
+ scm_i_print_bitvector (exp, port, pstate);
+ break;
case scm_tc7_wvect:
ENTER_NESTED_DATA (pstate, exp, circref);
if (SCM_IS_WHVEC (exp))
diff --git a/libguile/tags.h b/libguile/tags.h
index 37fcb8063..a3032bfa9 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -425,7 +425,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_unused_19 69
#define scm_tc7_program 79
#define scm_tc7_array 85
-#define scm_tc7_unused_10 87
+#define scm_tc7_bitvector 87
#define scm_tc7_unused_20 93
#define scm_tc7_unused_11 95
#define scm_tc7_unused_12 101