diff options
-rw-r--r-- | libguile/bitvectors.c | 32 | ||||
-rw-r--r-- | libguile/bitvectors.h | 2 | ||||
-rw-r--r-- | libguile/eq.c | 2 | ||||
-rw-r--r-- | libguile/evalext.c | 1 | ||||
-rw-r--r-- | libguile/goops.c | 5 | ||||
-rw-r--r-- | libguile/print.c | 3 | ||||
-rw-r--r-- | libguile/tags.h | 2 |
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 |