mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-25 22:20:28 +02:00
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.
This commit is contained in:
Andy Wingo
parent
b2637c985c
commit
ff1feca9bd
7 changed files with 27 additions and 20 deletions
|
|
@ -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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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>",
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue