mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-04 16:50:25 +02:00
Code Activity

Add bitvectors-internal.h

Browse source 
* libguile/bitvectors-internal.h: New file.
* libguile/Makefile.am (noinst_HEADERS): Add new file.
* libguile/bitvectors.c: Adapt to add scm_ prefix to the is_bytevector,
bytevector_bits, etc helpers.
* libguile/bitvectors.h (scm_is_bitvector): Define inline.  Remove
internal defines from the header.
* libguile/eq.c:
* libguile/init.c:
* libguile/print.c:
* libguile/array-handle.c: Adapt.
This commit is contained in:
Andy Wingo 2025-06-30 15:20:58 +02:00
parent 62b23a8dc4
commit 30ad63113a
8 changed files with 198 additions and 190 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -506,6 +506,7 @@ uninstall-hook:
## Perhaps we can deal with them normally once the merge seems to be ## Perhaps we can deal with them normally once the merge seems to be
## working. ## working.
noinst_HEADERS = atomic.h \ noinst_HEADERS = atomic.h \
bitvectors-internal.h \
custom-ports.h \ custom-ports.h \
elf.h \ elf.h \
ephemerons.h \ ephemerons.h \

6
libguile/array-handle.c
View file

@ -29,7 +29,7 @@
#include "arrays.h" #include "arrays.h"
#include "arrays-internal.h" #include "arrays-internal.h"
#include "boolean.h" #include "boolean.h"
#include "bitvectors.h" #include "bitvectors-internal.h"
#include "bytevectors.h" #include "bytevectors.h"
#include "bytevectors-internal.h" #include "bytevectors-internal.h"
#include "list.h" #include "list.h"
@ -210,8 +210,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
SCM_ARRAY_ELEMENT_TYPE_BIT, SCM_ARRAY_ELEMENT_TYPE_BIT,
bitvector_ref, bitvector_ref,
bitvector_set_x, bitvector_set_x,
scm_i_bitvector_bits (array), scm_bitvector_bits (scm_to_bitvector (array)),
scm_i_is_mutable_bitvector (array)); scm_is_mutable_bitvector (array));
break; break;
case scm_tc7_bytevector: case scm_tc7_bytevector:
{ {

99
libguile/bitvectors-internal.h Normal file
View file

@ -0,0 +1,99 @@
#ifndef SCM_BITVECTORS_INTERNAL_H
#define SCM_BITVECTORS_INTERNAL_H
/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2014,2018,2020,2025
Free Software Foundation, Inc.
This file is part of Guile.
Guile is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Guile is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public
License along with Guile. If not, see
<https://www.gnu.org/licenses/>. */
#include "libguile/bitvectors.h"
#include "libguile/snarf.h"
struct scm_bitvector
{
scm_t_bits tag_and_flags;
size_t length;
scm_t_bits bits[];
};
#define SCM_F_BITVECTOR_IMMUTABLE (0x80)
static inline int
scm_is_mutable_bitvector (SCM obj)
{
return SCM_NIMP (obj) &&
((SCM_CELL_TYPE (obj) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE))
== scm_tc7_bitvector);
}
static inline struct scm_bitvector*
scm_to_bitvector (SCM obj)
{
if (!scm_is_bitvector (obj))
abort ();
return (struct scm_bitvector*) SCM_UNPACK_POINTER (obj);
}
static inline SCM
scm_from_bitvector (struct scm_bitvector *bv)
{
return SCM_PACK_POINTER (bv);
}
static inline size_t
scm_bitvector_length (struct scm_bitvector *bv)
{
return bv->length;
}
static inline scm_t_bits*
scm_bitvector_bits (struct scm_bitvector *bv)
{
return bv->bits;
}
#define VALIDATE_BITVECTOR(_pos, _obj) \
SCM_ASSERT_TYPE (scm_is_bitvector (_obj), (_obj), (_pos), FUNC_NAME, \
"bitvector")
#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj) \
SCM_ASSERT_TYPE (scm_is_mutable_bitvector (_obj), (_obj), (_pos), \
FUNC_NAME, "mutable bitvector")
static inline size_t
scm_bitvector_word_length (struct scm_bitvector *bv)
{
const size_t bits_per_word = sizeof (scm_t_bits) * 8;
return (bv->length + bits_per_word - 1) / bits_per_word;
}
static inline scm_t_bits
scm_bitvector_last_mask (struct scm_bitvector *bv)
{
const size_t bits_per_word = sizeof (scm_t_bits) * 8;
size_t rem = bv->length % bits_per_word;
return rem ? (((scm_t_bits) 1) << rem) - 1 : -1;
}
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_INTERNAL_H */

263
libguile/bitvectors.c
View file

@ -39,81 +39,9 @@
#include "srfi-4.h" #include "srfi-4.h"
#include "threads-internal.h" #include "threads-internal.h"
#include "bitvectors.h" #include "bitvectors-internal.h"
struct scm_bitvector
{
scm_t_bits tag_and_flags;
size_t length;
scm_t_bits bits[];
};
#define SCM_F_BITVECTOR_IMMUTABLE (0x80)
/* To do in Guile 3.1.x:
- Replace primitives that operator on bitvectors but don't have
bitvector- prefix.
- Add Scheme compiler support for bitvector primitives. */
static inline int
is_bitvector (SCM obj)
{
return SCM_HAS_TYP7 ((obj), scm_tc7_bitvector);
}
static inline int
is_mutable_bitvector (SCM obj)
{
return SCM_NIMP (obj) &&
((SCM_CELL_TYPE (obj) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE))
== scm_tc7_bitvector);
}
static inline struct scm_bitvector*
to_bitvector (SCM obj)
{
if (!is_bitvector (obj))
abort ();
return (struct scm_bitvector*) SCM_UNPACK_POINTER (obj);
}
static inline SCM
from_bitvector (struct scm_bitvector *bv)
{
return SCM_PACK_POINTER (bv);
}
static inline size_t
bitvector_length (struct scm_bitvector *bv)
{
return bv->length;
}
static inline scm_t_bits*
bitvector_bits (struct scm_bitvector *bv)
{
return bv->bits;
}
#define VALIDATE_BITVECTOR(_pos, _obj) \
SCM_ASSERT_TYPE (is_bitvector (_obj), (_obj), (_pos), FUNC_NAME, \
"bitvector")
#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj) \
SCM_ASSERT_TYPE (is_mutable_bitvector (_obj), (_obj), (_pos), \
FUNC_NAME, "mutable bitvector")
scm_t_bits *
scm_i_bitvector_bits (SCM vec)
{
return bitvector_bits (to_bitvector (vec));
}
int
scm_i_is_mutable_bitvector (SCM vec)
{
return is_mutable_bitvector (vec);
}
static const size_t bits_per_word = sizeof (scm_t_bits) * 8; static const size_t bits_per_word = sizeof (scm_t_bits) * 8;
static const size_t static const size_t
@ -122,26 +50,13 @@ bit_count_to_word_count (size_t sz)
return (sz + bits_per_word - 1) / bits_per_word; return (sz + bits_per_word - 1) / bits_per_word;
} }
static const size_t
bitvector_word_length (struct scm_bitvector *bv)
{
return bit_count_to_word_count (bv->length);
}
static const scm_t_bits
bitvector_last_mask (struct scm_bitvector *bv)
{
size_t rem = bv->length % bits_per_word;
return rem ? (((scm_t_bits) 1) << rem) - 1 : -1;
}
int int
scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate) scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
{ {
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
size_t bit_len = bitvector_length (bv); size_t bit_len = scm_bitvector_length (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
size_t i, j; size_t i, j;
scm_puts ("#*", port); scm_puts ("#*", port);
@ -155,16 +70,16 @@ scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
SCM SCM
scm_i_bitvector_equal_p (SCM vec1, SCM vec2) scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
{ {
struct scm_bitvector *bv1 = to_bitvector (vec1); struct scm_bitvector *bv1 = scm_to_bitvector (vec1);
struct scm_bitvector *bv2 = to_bitvector (vec2); struct scm_bitvector *bv2 = scm_to_bitvector (vec2);
size_t bit_len = bitvector_length (bv1); size_t bit_len = scm_bitvector_length (bv1);
size_t word_len = bitvector_word_length (bv1); size_t word_len = scm_bitvector_word_length (bv1);
scm_t_bits last_mask = bitvector_last_mask (bv1); scm_t_bits last_mask = scm_bitvector_last_mask (bv1);
scm_t_bits *bits1 = bitvector_bits (bv1); scm_t_bits *bits1 = scm_bitvector_bits (bv1);
scm_t_bits *bits2 = bitvector_bits (bv2); scm_t_bits *bits2 = scm_bitvector_bits (bv2);
/* compare lengths */ /* compare lengths */
if (bitvector_length (bv2) != bit_len) if (scm_bitvector_length (bv2) != bit_len)
return SCM_BOOL_F; return SCM_BOOL_F;
/* avoid underflow in word_len-1 below. */ /* avoid underflow in word_len-1 below. */
if (bit_len == 0) if (bit_len == 0)
@ -178,12 +93,6 @@ scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
return SCM_BOOL_T; return SCM_BOOL_T;
} }
int
scm_is_bitvector (SCM vec)
{
return is_bitvector (vec);
}
SCM_DEFINE_STATIC (bitvector_p, "bitvector?", 1, 0, 0, SCM_DEFINE_STATIC (bitvector_p, "bitvector?", 1, 0, 0,
(SCM obj), (SCM obj),
"Return @code{#t} when @var{obj} is a bitvector, else\n" "Return @code{#t} when @var{obj} is a bitvector, else\n"
@ -216,7 +125,7 @@ SCM
scm_c_make_bitvector (size_t len, SCM fill) scm_c_make_bitvector (size_t len, SCM fill)
{ {
int c_fill = !SCM_UNBNDP (fill) && scm_is_true (fill); int c_fill = !SCM_UNBNDP (fill) && scm_is_true (fill);
return from_bitvector (make_bitvector (len, c_fill)); return scm_from_bitvector (make_bitvector (len, c_fill));
} }
SCM_DEFINE_STATIC (make_scm_bitvector, "make-bitvector", 1, 1, 0, SCM_DEFINE_STATIC (make_scm_bitvector, "make-bitvector", 1, 1, 0,
@ -241,12 +150,12 @@ SCM_DEFINE_STATIC (bitvector, "bitvector", 0, 0, 1,
size_t size_t
scm_c_bitvector_length (SCM vec) scm_c_bitvector_length (SCM vec)
{ {
if (!is_bitvector (vec)) if (!scm_is_bitvector (vec))
scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector"); scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
return bitvector_length (to_bitvector (vec)); return scm_bitvector_length (scm_to_bitvector (vec));
} }
SCM_DEFINE_STATIC (scm_bitvector_length, "bitvector-length", 1, 0, 0, SCM_DEFINE_STATIC (bitvector_length, "bitvector-length", 1, 0, 0,
(SCM vec), (SCM vec),
"Return the length of the bitvector @var{vec}.") "Return the length of the bitvector @var{vec}.")
#define FUNC_NAME s_bitvector_length #define FUNC_NAME s_bitvector_length
@ -321,11 +230,11 @@ scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-bit-set?" #define FUNC_NAME "bitvector-bit-set?"
{ {
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
if (idx >= bitvector_length (bv)) if (idx >= scm_bitvector_length (bv))
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
const scm_t_bits *bits = bitvector_bits (bv); const scm_t_bits *bits = scm_bitvector_bits (bv);
return (bits[idx/bits_per_word] & (1L << (idx%bits_per_word))) ? 1 : 0; return (bits[idx/bits_per_word] & (1L << (idx%bits_per_word))) ? 1 : 0;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -362,11 +271,11 @@ scm_c_bitvector_set_bit_x (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-set-bit!" #define FUNC_NAME "bitvector-set-bit!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); VALIDATE_MUTABLE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
if (idx >= bitvector_length (bv)) if (idx >= scm_bitvector_length (bv))
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
scm_t_bits mask = 1LL << (idx%bits_per_word); scm_t_bits mask = 1LL << (idx%bits_per_word);
bits[idx/bits_per_word] |= mask; bits[idx/bits_per_word] |= mask;
} }
@ -377,11 +286,11 @@ scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-clear-bit!" #define FUNC_NAME "bitvector-clear-bit!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); VALIDATE_MUTABLE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
if (idx >= bitvector_length (bv)) if (idx >= scm_bitvector_length (bv))
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx)); SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
scm_t_bits mask = 1L << (idx%bits_per_word); scm_t_bits mask = 1L << (idx%bits_per_word);
bits[idx/bits_per_word] &= ~mask; bits[idx/bits_per_word] &= ~mask;
} }
@ -414,14 +323,14 @@ scm_c_bitvector_set_all_bits_x (SCM vec)
#define FUNC_NAME "bitvector-set-all-bits!" #define FUNC_NAME "bitvector-set-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); VALIDATE_MUTABLE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
size_t len = bitvector_length (bv); size_t len = scm_bitvector_length (bv);
if (len > 0) if (len > 0)
{ {
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits last_mask = bitvector_last_mask (bv); scm_t_bits last_mask = scm_bitvector_last_mask (bv);
memset (bits, 0xFF, sizeof(scm_t_bits)*(word_len-1)); memset (bits, 0xFF, sizeof(scm_t_bits)*(word_len-1));
bits[word_len-1] |= last_mask; bits[word_len-1] |= last_mask;
@ -434,14 +343,14 @@ scm_c_bitvector_clear_all_bits_x (SCM vec)
#define FUNC_NAME "bitvector-clear-all-bits!" #define FUNC_NAME "bitvector-clear-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, vec); VALIDATE_MUTABLE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
size_t len = bitvector_length (bv); size_t len = scm_bitvector_length (bv);
if (len > 0) if (len > 0)
{ {
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits last_mask = bitvector_last_mask (bv); scm_t_bits last_mask = scm_bitvector_last_mask (bv);
memset (bits, 0x00, sizeof(scm_t_bits)*(word_len-1)); memset (bits, 0x00, sizeof(scm_t_bits)*(word_len-1));
bits[word_len-1] &= ~last_mask; bits[word_len-1] &= ~last_mask;
@ -473,8 +382,8 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
{ {
size_t bit_len = scm_to_size_t (scm_length (list)); size_t bit_len = scm_to_size_t (scm_length (list));
struct scm_bitvector *bv = make_bitvector (bit_len, 0); struct scm_bitvector *bv = make_bitvector (bit_len, 0);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
size_t i, j; size_t i, j;
for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= bits_per_word) for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= bits_per_word)
@ -486,7 +395,7 @@ SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
bits[i] = word; bits[i] = word;
} }
return from_bitvector (bv); return scm_from_bitvector (bv);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -500,10 +409,10 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
const scm_t_bits *bits = bitvector_bits (bv); const scm_t_bits *bits = scm_bitvector_bits (bv);
size_t len = bitvector_length (bv); size_t len = scm_bitvector_length (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
for (size_t i = 0; i < word_len; i++, len -= bits_per_word) for (size_t i = 0; i < word_len; i++, len -= bits_per_word)
for (size_t j = 0; j < bits_per_word && j < len; j++) for (size_t j = 0; j < bits_per_word && j < len; j++)
@ -542,20 +451,20 @@ scm_c_bitvector_count (SCM vec)
{ {
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
size_t len = bitvector_length (bv); size_t len = scm_bitvector_length (bv);
if (len == 0) if (len == 0)
return 0; return 0;
const scm_t_bits *bits = bitvector_bits (bv); const scm_t_bits *bits = scm_bitvector_bits (bv);
size_t count = 0; size_t count = 0;
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
count += count_ones (bits[i]); count += count_ones (bits[i]);
count += count_ones (bits[i] & bitvector_last_mask (bv)); count += count_ones (bits[i] & scm_bitvector_last_mask (bv));
return count; return count;
} }
@ -600,8 +509,8 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
{ {
VALIDATE_BITVECTOR (1, v); VALIDATE_BITVECTOR (1, v);
struct scm_bitvector *bv = to_bitvector (v); struct scm_bitvector *bv = scm_to_bitvector (v);
size_t len = bitvector_length (bv); size_t len = scm_bitvector_length (bv);
int c_bit = scm_to_bool (bit); int c_bit = scm_to_bool (bit);
size_t first_bit = size_t first_bit =
SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len); SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len);
@ -609,9 +518,9 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
if (first_bit == len) if (first_bit == len)
return SCM_BOOL_F; return SCM_BOOL_F;
const scm_t_bits *bits = bitvector_bits (bv); const scm_t_bits *bits = scm_bitvector_bits (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits last_mask = bitvector_last_mask (bv); scm_t_bits last_mask = scm_bitvector_last_mask (bv);
size_t first_word = first_bit / bits_per_word; size_t first_word = first_bit / bits_per_word;
scm_t_bits first_mask = scm_t_bits first_mask =
((scm_t_bits)-1) << (first_bit - bits_per_word*first_word); ((scm_t_bits)-1) << (first_bit - bits_per_word*first_word);
@ -637,12 +546,12 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
{ {
VALIDATE_MUTABLE_BITVECTOR (1, v); VALIDATE_MUTABLE_BITVECTOR (1, v);
VALIDATE_BITVECTOR (2, bits); VALIDATE_BITVECTOR (2, bits);
struct scm_bitvector *bv = to_bitvector (v); struct scm_bitvector *bv = scm_to_bitvector (v);
struct scm_bitvector *bitsv = to_bitvector (bits); struct scm_bitvector *bitsv = scm_to_bitvector (bits);
size_t v_len = bitvector_length (bv); size_t v_len = scm_bitvector_length (bv);
scm_t_bits *v_bits = bitvector_bits (bv); scm_t_bits *v_bits = scm_bitvector_bits (bv);
size_t kv_len = bitvector_length (bitsv); size_t kv_len = scm_bitvector_length (bitsv);
const scm_t_bits *kv_bits = bitvector_bits (bitsv); const scm_t_bits *kv_bits = scm_bitvector_bits (bitsv);
if (v_len < kv_len) if (v_len < kv_len)
scm_misc_error (NULL, scm_misc_error (NULL,
@ -651,8 +560,8 @@ scm_c_bitvector_set_bits_x (SCM v, SCM bits)
if (kv_len > 0) if (kv_len > 0)
{ {
size_t word_len = bitvector_word_length (bitsv); size_t word_len = scm_bitvector_word_length (bitsv);
scm_t_bits last_mask = bitvector_last_mask (bitsv); scm_t_bits last_mask = scm_bitvector_last_mask (bitsv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
v_bits[i] |= kv_bits[i]; v_bits[i] |= kv_bits[i];
@ -667,12 +576,12 @@ scm_c_bitvector_clear_bits_x (SCM v, SCM bits)
{ {
VALIDATE_MUTABLE_BITVECTOR (1, v); VALIDATE_MUTABLE_BITVECTOR (1, v);
VALIDATE_BITVECTOR (2, bits); VALIDATE_BITVECTOR (2, bits);
struct scm_bitvector *bv = to_bitvector (v); struct scm_bitvector *bv = scm_to_bitvector (v);
struct scm_bitvector *bitsv = to_bitvector (bits); struct scm_bitvector *bitsv = scm_to_bitvector (bits);
size_t v_len = bitvector_length (bv); size_t v_len = scm_bitvector_length (bv);
scm_t_bits *v_bits = bitvector_bits (bv); scm_t_bits *v_bits = scm_bitvector_bits (bv);
size_t kv_len = bitvector_length (bitsv); size_t kv_len = scm_bitvector_length (bitsv);
const scm_t_bits *kv_bits = bitvector_bits (bitsv); const scm_t_bits *kv_bits = scm_bitvector_bits (bitsv);
if (v_len < kv_len) if (v_len < kv_len)
scm_misc_error (NULL, scm_misc_error (NULL,
@ -681,8 +590,8 @@ scm_c_bitvector_clear_bits_x (SCM v, SCM bits)
if (kv_len > 0) if (kv_len > 0)
{ {
size_t word_len = bitvector_word_length (bitsv); size_t word_len = scm_bitvector_word_length (bitsv);
scm_t_bits last_mask = bitvector_last_mask (bitsv); scm_t_bits last_mask = scm_bitvector_last_mask (bitsv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
@ -739,11 +648,11 @@ SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0,
#define FUNC_NAME s_scm_bitvector_copy #define FUNC_NAME s_scm_bitvector_copy
{ {
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
/* cf scm_vector_copy */ /* cf scm_vector_copy */
size_t cstart = 0, cend = bitvector_length (bv); size_t cstart = 0, cend = scm_bitvector_length (bv);
if (!SCM_UNBNDP (start)) if (!SCM_UNBNDP (start))
{ {
cstart = scm_to_size_t (start); cstart = scm_to_size_t (start);
@ -759,8 +668,8 @@ SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0,
size_t len = cend-cstart; size_t len = cend-cstart;
struct scm_bitvector *result = make_bitvector (len, 0); struct scm_bitvector *result = make_bitvector (len, 0);
const scm_t_bits *kv_bits = bitvector_bits (bv); const scm_t_bits *kv_bits = scm_bitvector_bits (bv);
scm_t_bits *v_bits = bitvector_bits (result); scm_t_bits *v_bits = scm_bitvector_bits (result);
if (len > 0) if (len > 0)
{ {
@ -775,7 +684,7 @@ SCM_DEFINE (scm_bitvector_copy, "bitvector-copy", 1, 2, 0,
| (kv_bits[i + wshift + 1] << (bits_per_word-bshift))); | (kv_bits[i + wshift + 1] << (bits_per_word-bshift)));
} }
return from_bitvector (result); return scm_from_bitvector (result);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -785,20 +694,20 @@ scm_c_bitvector_count_bits (SCM vec, SCM bits)
{ {
VALIDATE_BITVECTOR (1, vec); VALIDATE_BITVECTOR (1, vec);
VALIDATE_BITVECTOR (2, bits); VALIDATE_BITVECTOR (2, bits);
struct scm_bitvector *bv = to_bitvector (vec); struct scm_bitvector *bv = scm_to_bitvector (vec);
struct scm_bitvector *bitsv = to_bitvector (bits); struct scm_bitvector *bitsv = scm_to_bitvector (bits);
size_t v_len = bitvector_length (bv); size_t v_len = scm_bitvector_length (bv);
const scm_t_bits *v_bits = bitvector_bits (bv); const scm_t_bits *v_bits = scm_bitvector_bits (bv);
size_t kv_len = bitvector_length (bitsv); size_t kv_len = scm_bitvector_length (bitsv);
const scm_t_bits *kv_bits = bitvector_bits (bitsv); const scm_t_bits *kv_bits = scm_bitvector_bits (bitsv);
if (v_len < kv_len) if (v_len < kv_len)
SCM_MISC_ERROR ("selection bitvector longer than target bitvector", SCM_MISC_ERROR ("selection bitvector longer than target bitvector",
SCM_EOL); SCM_EOL);
size_t i, word_len = bitvector_word_length (bitsv); size_t i, word_len = scm_bitvector_word_length (bitsv);
scm_t_bits last_mask = bitvector_last_mask (bitsv); scm_t_bits last_mask = scm_bitvector_last_mask (bitsv);
size_t count = 0; size_t count = 0;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)
@ -830,11 +739,11 @@ scm_c_bitvector_flip_all_bits_x (SCM v)
#define FUNC_NAME "bitvector-flip-all-bits!" #define FUNC_NAME "bitvector-flip-all-bits!"
{ {
VALIDATE_MUTABLE_BITVECTOR (1, v); VALIDATE_MUTABLE_BITVECTOR (1, v);
struct scm_bitvector *bv = to_bitvector (v); struct scm_bitvector *bv = scm_to_bitvector (v);
scm_t_bits *bits = bitvector_bits (bv); scm_t_bits *bits = scm_bitvector_bits (bv);
size_t word_len = bitvector_word_length (bv); size_t word_len = scm_bitvector_word_length (bv);
scm_t_bits last_mask = bitvector_last_mask (bv); scm_t_bits last_mask = scm_bitvector_last_mask (bv);
size_t i; size_t i;
for (i = 0; i < word_len-1; i++) for (i = 0; i < word_len-1; i++)

13
libguile/bitvectors.h
View file

@ -38,7 +38,12 @@ SCM_API SCM scm_bitvector_copy (SCM vec, SCM start, SCM end);
SCM_API SCM scm_bitvector_position (SCM v, SCM item, SCM start); SCM_API SCM scm_bitvector_position (SCM v, SCM item, SCM start);
SCM_API int scm_is_bitvector (SCM obj); static inline int
scm_is_bitvector (SCM obj)
{
return SCM_HAS_TYP7 ((obj), scm_tc7_bitvector);
}
SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill); SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
SCM_API size_t scm_c_bitvector_length (SCM vec); SCM_API size_t scm_c_bitvector_length (SCM vec);
SCM_API size_t scm_c_bitvector_count (SCM v); SCM_API size_t scm_c_bitvector_count (SCM v);
@ -67,10 +72,4 @@ SCM_API scm_t_bits *scm_bitvector_writable_elements (SCM vec,
size_t *lenp, size_t *lenp,
ssize_t *incp); ssize_t *incp);
SCM_INTERNAL scm_t_bits *scm_i_bitvector_bits (SCM vec);
SCM_INTERNAL int scm_i_is_mutable_bitvector (SCM vec);
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 */ #endif /* SCM_BITVECTORS_H */

2
libguile/eq.c
View file

@ -27,7 +27,7 @@
#include "arrays.h" #include "arrays.h"
#include "async.h" #include "async.h"
#include "bitvectors.h" #include "bitvectors-internal.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors.h" #include "bytevectors.h"
#include "eval.h" #include "eval.h"

2
libguile/init.c
View file

@ -45,7 +45,7 @@
#include "async.h" #include "async.h"
#include "atomic.h" #include "atomic.h"
#include "backtrace.h" #include "backtrace.h"
#include "bitvectors.h" #include "bitvectors-internal.h"
#include "boolean.h" #include "boolean.h"
#include "bytevectors-internal.h" #include "bytevectors-internal.h"
#include "chars.h" #include "chars.h"

2
libguile/print.c
View file

@ -33,7 +33,7 @@
#include "alist.h" #include "alist.h"
#include "arrays-internal.h" #include "arrays-internal.h"
#include "atomic.h" #include "atomic.h"
#include "bitvectors.h" #include "bitvectors-internal.h"
#include "bytevectors-internal.h" #include "bytevectors-internal.h"
#include "boolean.h" #include "boolean.h"
#include "chars.h" #include "chars.h"