1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 #include "libguile/_scm.h"
29 #include "libguile/__scm.h"
30 #include "libguile/strings.h"
31 #include "libguile/array-handle.h"
32 #include "libguile/bitvectors.h"
33 #include "libguile/arrays.h"
34 #include "libguile/generalized-vectors.h"
35 #include "libguile/srfi-4.h"
37 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
38 * but alack, all we have is this crufty C.
41 #define IS_BITVECTOR(obj) SCM_TYP16_PREDICATE(scm_tc7_bitvector,(obj))
42 #define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_CELL_WORD_1(obj))
43 #define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_2(obj))
46 scm_i_print_bitvector (SCM vec
, SCM port
, scm_print_state
*pstate
)
48 size_t bit_len
= BITVECTOR_LENGTH (vec
);
49 size_t word_len
= (bit_len
+31)/32;
50 scm_t_uint32
*bits
= BITVECTOR_BITS (vec
);
53 scm_puts_unlocked ("#*", port
);
54 for (i
= 0; i
< word_len
; i
++, bit_len
-= 32)
56 scm_t_uint32 mask
= 1;
57 for (j
= 0; j
< 32 && j
< bit_len
; j
++, mask
<<= 1)
58 scm_putc_unlocked ((bits
[i
] & mask
)? '1' : '0', port
);
65 scm_i_bitvector_equal_p (SCM vec1
, SCM vec2
)
67 size_t bit_len
= BITVECTOR_LENGTH (vec1
);
68 size_t word_len
= (bit_len
+ 31) / 32;
69 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- bit_len
);
70 scm_t_uint32
*bits1
= BITVECTOR_BITS (vec1
);
71 scm_t_uint32
*bits2
= BITVECTOR_BITS (vec2
);
74 if (BITVECTOR_LENGTH (vec2
) != bit_len
)
76 /* avoid underflow in word_len-1 below. */
79 /* compare full words */
80 if (memcmp (bits1
, bits2
, sizeof (scm_t_uint32
) * (word_len
-1)))
82 /* compare partial last words */
83 if ((bits1
[word_len
-1] & last_mask
) != (bits2
[word_len
-1] & last_mask
))
89 scm_is_bitvector (SCM vec
)
91 return IS_BITVECTOR (vec
);
94 SCM_DEFINE (scm_bitvector_p
, "bitvector?", 1, 0, 0,
96 "Return @code{#t} when @var{obj} is a bitvector, else\n"
98 #define FUNC_NAME s_scm_bitvector_p
100 return scm_from_bool (scm_is_bitvector (obj
));
105 scm_c_make_bitvector (size_t len
, SCM fill
)
107 size_t word_len
= (len
+ 31) / 32;
111 bits
= scm_gc_malloc_pointerless (sizeof (scm_t_uint32
) * word_len
,
113 res
= scm_double_cell (scm_tc7_bitvector
, (scm_t_bits
)bits
, len
, 0);
115 if (!SCM_UNBNDP (fill
))
116 scm_bitvector_fill_x (res
, fill
);
118 memset (bits
, 0, sizeof (scm_t_uint32
) * word_len
);
123 SCM_DEFINE (scm_make_bitvector
, "make-bitvector", 1, 1, 0,
125 "Create a new bitvector of length @var{len} and\n"
126 "optionally initialize all elements to @var{fill}.")
127 #define FUNC_NAME s_scm_make_bitvector
129 return scm_c_make_bitvector (scm_to_size_t (len
), fill
);
133 SCM_DEFINE (scm_bitvector
, "bitvector", 0, 0, 1,
135 "Create a new bitvector with the arguments as elements.")
136 #define FUNC_NAME s_scm_bitvector
138 return scm_list_to_bitvector (bits
);
143 scm_c_bitvector_length (SCM vec
)
145 if (!IS_BITVECTOR (vec
))
146 scm_wrong_type_arg_msg (NULL
, 0, vec
, "bitvector");
147 return BITVECTOR_LENGTH (vec
);
150 SCM_DEFINE (scm_bitvector_length
, "bitvector-length", 1, 0, 0,
152 "Return the length of the bitvector @var{vec}.")
153 #define FUNC_NAME s_scm_bitvector_length
155 return scm_from_size_t (scm_c_bitvector_length (vec
));
160 scm_array_handle_bit_elements (scm_t_array_handle
*h
)
162 return scm_array_handle_bit_writable_elements (h
);
166 scm_array_handle_bit_writable_elements (scm_t_array_handle
*h
)
169 if (SCM_I_ARRAYP (vec
))
170 vec
= SCM_I_ARRAY_V (vec
);
171 if (IS_BITVECTOR (vec
))
172 return BITVECTOR_BITS (vec
) + h
->base
/32;
173 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "bit array");
177 scm_array_handle_bit_elements_offset (scm_t_array_handle
*h
)
183 scm_bitvector_elements (SCM vec
,
184 scm_t_array_handle
*h
,
189 return scm_bitvector_writable_elements (vec
, h
, offp
, lenp
, incp
);
194 scm_bitvector_writable_elements (SCM vec
,
195 scm_t_array_handle
*h
,
200 scm_generalized_vector_get_handle (vec
, h
);
203 scm_t_array_dim
*dim
= scm_array_handle_dims (h
);
204 *offp
= scm_array_handle_bit_elements_offset (h
);
205 *lenp
= dim
->ubnd
- dim
->lbnd
+ 1;
208 return scm_array_handle_bit_writable_elements (h
);
212 scm_c_bitvector_ref (SCM vec
, size_t idx
)
214 scm_t_array_handle handle
;
215 const scm_t_uint32
*bits
;
217 if (IS_BITVECTOR (vec
))
219 if (idx
>= BITVECTOR_LENGTH (vec
))
220 scm_out_of_range (NULL
, scm_from_size_t (idx
));
221 bits
= BITVECTOR_BITS(vec
);
222 return scm_from_bool (bits
[idx
/32] & (1L << (idx
%32)));
230 bits
= scm_bitvector_elements (vec
, &handle
, &off
, &len
, &inc
);
232 scm_out_of_range (NULL
, scm_from_size_t (idx
));
234 res
= scm_from_bool (bits
[idx
/32] & (1L << (idx
%32)));
235 scm_array_handle_release (&handle
);
240 SCM_DEFINE (scm_bitvector_ref
, "bitvector-ref", 2, 0, 0,
242 "Return the element at index @var{idx} of the bitvector\n"
244 #define FUNC_NAME s_scm_bitvector_ref
246 return scm_c_bitvector_ref (vec
, scm_to_size_t (idx
));
251 scm_c_bitvector_set_x (SCM vec
, size_t idx
, SCM val
)
253 scm_t_array_handle handle
;
254 scm_t_uint32
*bits
, mask
;
256 if (IS_BITVECTOR (vec
))
258 if (idx
>= BITVECTOR_LENGTH (vec
))
259 scm_out_of_range (NULL
, scm_from_size_t (idx
));
260 bits
= BITVECTOR_BITS(vec
);
267 bits
= scm_bitvector_writable_elements (vec
, &handle
, &off
, &len
, &inc
);
269 scm_out_of_range (NULL
, scm_from_size_t (idx
));
273 mask
= 1L << (idx
%32);
274 if (scm_is_true (val
))
275 bits
[idx
/32] |= mask
;
277 bits
[idx
/32] &= ~mask
;
279 if (!IS_BITVECTOR (vec
))
280 scm_array_handle_release (&handle
);
283 SCM_DEFINE (scm_bitvector_set_x
, "bitvector-set!", 3, 0, 0,
284 (SCM vec
, SCM idx
, SCM val
),
285 "Set the element at index @var{idx} of the bitvector\n"
286 "@var{vec} when @var{val} is true, else clear it.")
287 #define FUNC_NAME s_scm_bitvector_set_x
289 scm_c_bitvector_set_x (vec
, scm_to_size_t (idx
), val
);
290 return SCM_UNSPECIFIED
;
294 SCM_DEFINE (scm_bitvector_fill_x
, "bitvector-fill!", 2, 0, 0,
296 "Set all elements of the bitvector\n"
297 "@var{vec} when @var{val} is true, else clear them.")
298 #define FUNC_NAME s_scm_bitvector_fill_x
300 scm_t_array_handle handle
;
305 bits
= scm_bitvector_writable_elements (vec
, &handle
,
308 if (off
== 0 && inc
== 1 && len
> 0)
312 size_t word_len
= (len
+ 31) / 32;
313 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
315 if (scm_is_true (val
))
317 memset (bits
, 0xFF, sizeof(scm_t_uint32
)*(word_len
-1));
318 bits
[word_len
-1] |= last_mask
;
322 memset (bits
, 0x00, sizeof(scm_t_uint32
)*(word_len
-1));
323 bits
[word_len
-1] &= ~last_mask
;
329 for (i
= 0; i
< len
; i
++)
330 scm_array_handle_set (&handle
, i
*inc
, val
);
333 scm_array_handle_release (&handle
);
335 return SCM_UNSPECIFIED
;
339 SCM_DEFINE (scm_list_to_bitvector
, "list->bitvector", 1, 0, 0,
341 "Return a new bitvector initialized with the elements\n"
343 #define FUNC_NAME s_scm_list_to_bitvector
345 size_t bit_len
= scm_to_size_t (scm_length (list
));
346 SCM vec
= scm_c_make_bitvector (bit_len
, SCM_UNDEFINED
);
347 size_t word_len
= (bit_len
+31)/32;
348 scm_t_array_handle handle
;
349 scm_t_uint32
*bits
= scm_bitvector_writable_elements (vec
, &handle
,
353 for (i
= 0; i
< word_len
&& scm_is_pair (list
); i
++, bit_len
-= 32)
355 scm_t_uint32 mask
= 1;
357 for (j
= 0; j
< 32 && j
< bit_len
;
358 j
++, mask
<<= 1, list
= SCM_CDR (list
))
359 if (scm_is_true (SCM_CAR (list
)))
363 scm_array_handle_release (&handle
);
369 SCM_DEFINE (scm_bitvector_to_list
, "bitvector->list", 1, 0, 0,
371 "Return a new list initialized with the elements\n"
372 "of the bitvector @var{vec}.")
373 #define FUNC_NAME s_scm_bitvector_to_list
375 scm_t_array_handle handle
;
381 bits
= scm_bitvector_writable_elements (vec
, &handle
,
384 if (off
== 0 && inc
== 1)
388 size_t word_len
= (len
+ 31) / 32;
391 for (i
= 0; i
< word_len
; i
++, len
-= 32)
393 scm_t_uint32 mask
= 1;
394 for (j
= 0; j
< 32 && j
< len
; j
++, mask
<<= 1)
395 res
= scm_cons ((bits
[i
] & mask
)? SCM_BOOL_T
: SCM_BOOL_F
, res
);
401 for (i
= 0; i
< len
; i
++)
402 res
= scm_cons (scm_array_handle_ref (&handle
, i
*inc
), res
);
405 scm_array_handle_release (&handle
);
407 return scm_reverse_x (res
, SCM_EOL
);
411 /* From mmix-arith.w by Knuth.
413 Here's a fun way to count the number of bits in a tetrabyte.
415 [This classical trick is called the ``Gillies--Miller method for
416 sideways addition'' in {\sl The Preparation of Programs for an
417 Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
418 edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
419 the tricks used here were suggested by Balbir Singh, Peter
420 Rossmanith, and Stefan Schwoon.]
424 count_ones (scm_t_uint32 x
)
426 x
=x
-((x
>>1)&0x55555555);
427 x
=(x
&0x33333333)+((x
>>2)&0x33333333);
428 x
=(x
+(x
>>4))&0x0f0f0f0f;
430 return (x
+(x
>>16)) & 0xff;
433 SCM_DEFINE (scm_bit_count
, "bit-count", 2, 0, 0,
434 (SCM b
, SCM bitvector
),
435 "Return the number of occurrences of the boolean @var{b} in\n"
437 #define FUNC_NAME s_scm_bit_count
439 scm_t_array_handle handle
;
443 int bit
= scm_to_bool (b
);
446 bits
= scm_bitvector_writable_elements (bitvector
, &handle
,
449 if (off
== 0 && inc
== 1 && len
> 0)
453 size_t word_len
= (len
+ 31) / 32;
454 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
457 for (i
= 0; i
< word_len
-1; i
++)
458 count
+= count_ones (bits
[i
]);
459 count
+= count_ones (bits
[i
] & last_mask
);
464 for (i
= 0; i
< len
; i
++)
465 if (scm_is_true (scm_array_handle_ref (&handle
, i
*inc
)))
469 scm_array_handle_release (&handle
);
471 return scm_from_size_t (bit
? count
: len
-count
);
475 /* returns 32 for x == 0.
478 find_first_one (scm_t_uint32 x
)
481 /* do a binary search in x. */
482 if ((x
& 0xFFFF) == 0)
495 SCM_DEFINE (scm_bit_position
, "bit-position", 3, 0, 0,
496 (SCM item
, SCM v
, SCM k
),
497 "Return the index of the first occurrence of @var{item} in bit\n"
498 "vector @var{v}, starting from @var{k}. If there is no\n"
499 "@var{item} entry between @var{k} and the end of\n"
500 "@var{v}, then return @code{#f}. For example,\n"
503 "(bit-position #t #*000101 0) @result{} 3\n"
504 "(bit-position #f #*0001111 3) @result{} #f\n"
506 #define FUNC_NAME s_scm_bit_position
508 scm_t_array_handle handle
;
509 size_t off
, len
, first_bit
;
511 const scm_t_uint32
*bits
;
512 int bit
= scm_to_bool (item
);
513 SCM res
= SCM_BOOL_F
;
515 bits
= scm_bitvector_elements (v
, &handle
, &off
, &len
, &inc
);
516 first_bit
= scm_to_unsigned_integer (k
, 0, len
);
518 if (off
== 0 && inc
== 1 && len
> 0)
520 size_t i
, word_len
= (len
+ 31) / 32;
521 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
522 size_t first_word
= first_bit
/ 32;
523 scm_t_uint32 first_mask
=
524 ((scm_t_uint32
)-1) << (first_bit
- 32*first_word
);
527 for (i
= first_word
; i
< word_len
; i
++)
529 w
= (bit
? bits
[i
] : ~bits
[i
]);
536 res
= scm_from_size_t (32*i
+ find_first_one (w
));
544 for (i
= first_bit
; i
< len
; i
++)
546 SCM elt
= scm_array_handle_ref (&handle
, i
*inc
);
547 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
549 res
= scm_from_size_t (i
);
555 scm_array_handle_release (&handle
);
561 SCM_DEFINE (scm_bit_set_star_x
, "bit-set*!", 3, 0, 0,
562 (SCM v
, SCM kv
, SCM obj
),
563 "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
564 "selecting the entries to change. The return value is\n"
567 "If @var{kv} is a bit vector, then those entries where it has\n"
568 "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
569 "@var{v} must be at least as long as @var{kv}. When @var{obj}\n"
570 "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n"
571 "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
574 "(define bv #*01000010)\n"
575 "(bit-set*! bv #*10010001 #t)\n"
577 "@result{} #*11010011\n"
580 "If @var{kv} is a u32vector, then its elements are\n"
581 "indices into @var{v} which are set to @var{obj}.\n"
584 "(define bv #*01000010)\n"
585 "(bit-set*! bv #u32(5 2 7) #t)\n"
587 "@result{} #*01100111\n"
589 #define FUNC_NAME s_scm_bit_set_star_x
591 scm_t_array_handle v_handle
;
594 scm_t_uint32
*v_bits
;
597 /* Validate that OBJ is a boolean so this is done even if we don't
600 bit
= scm_to_bool (obj
);
602 v_bits
= scm_bitvector_writable_elements (v
, &v_handle
,
603 &v_off
, &v_len
, &v_inc
);
605 if (scm_is_bitvector (kv
))
607 scm_t_array_handle kv_handle
;
608 size_t kv_off
, kv_len
;
610 const scm_t_uint32
*kv_bits
;
612 kv_bits
= scm_bitvector_elements (kv
, &kv_handle
,
613 &kv_off
, &kv_len
, &kv_inc
);
616 scm_misc_error (NULL
,
617 "bit vectors must have equal length",
620 if (v_off
== 0 && v_inc
== 1 && kv_off
== 0 && kv_inc
== 1 && kv_len
> 0)
622 size_t word_len
= (kv_len
+ 31) / 32;
623 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- kv_len
);
628 for (i
= 0; i
< word_len
-1; i
++)
629 v_bits
[i
] &= ~kv_bits
[i
];
630 v_bits
[i
] &= ~(kv_bits
[i
] & last_mask
);
634 for (i
= 0; i
< word_len
-1; i
++)
635 v_bits
[i
] |= kv_bits
[i
];
636 v_bits
[i
] |= kv_bits
[i
] & last_mask
;
642 for (i
= 0; i
< kv_len
; i
++)
643 if (scm_is_true (scm_array_handle_ref (&kv_handle
, i
*kv_inc
)))
644 scm_array_handle_set (&v_handle
, i
*v_inc
, obj
);
647 scm_array_handle_release (&kv_handle
);
650 else if (scm_is_true (scm_u32vector_p (kv
)))
652 scm_t_array_handle kv_handle
;
655 const scm_t_uint32
*kv_elts
;
657 kv_elts
= scm_u32vector_elements (kv
, &kv_handle
, &kv_len
, &kv_inc
);
658 for (i
= 0; i
< kv_len
; i
++, kv_elts
+= kv_inc
)
659 scm_array_handle_set (&v_handle
, (*kv_elts
)*v_inc
, obj
);
661 scm_array_handle_release (&kv_handle
);
664 scm_wrong_type_arg_msg (NULL
, 0, kv
, "bitvector or u32vector");
666 scm_array_handle_release (&v_handle
);
668 return SCM_UNSPECIFIED
;
673 SCM_DEFINE (scm_bit_count_star
, "bit-count*", 3, 0, 0,
674 (SCM v
, SCM kv
, SCM obj
),
675 "Return a count of how many entries in bit vector @var{v} are\n"
676 "equal to @var{obj}, with @var{kv} selecting the entries to\n"
679 "If @var{kv} is a bit vector, then those entries where it has\n"
680 "@code{#t} are the ones in @var{v} which are considered.\n"
681 "@var{kv} and @var{v} must be the same length.\n"
683 "If @var{kv} is a u32vector, then it contains\n"
684 "the indexes in @var{v} to consider.\n"
689 "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
690 "(bit-count* #*01110111 #u32(7 0 4) #f) @result{} 2\n"
692 #define FUNC_NAME s_scm_bit_count_star
694 scm_t_array_handle v_handle
;
697 const scm_t_uint32
*v_bits
;
701 /* Validate that OBJ is a boolean so this is done even if we don't
704 bit
= scm_to_bool (obj
);
706 v_bits
= scm_bitvector_elements (v
, &v_handle
,
707 &v_off
, &v_len
, &v_inc
);
709 if (scm_is_bitvector (kv
))
711 scm_t_array_handle kv_handle
;
712 size_t kv_off
, kv_len
;
714 const scm_t_uint32
*kv_bits
;
716 kv_bits
= scm_bitvector_elements (v
, &kv_handle
,
717 &kv_off
, &kv_len
, &kv_inc
);
720 scm_misc_error (NULL
,
721 "bit vectors must have equal length",
724 if (v_off
== 0 && v_inc
== 1 && kv_off
== 0 && kv_inc
== 1 && kv_len
> 0)
726 size_t i
, word_len
= (kv_len
+ 31) / 32;
727 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- kv_len
);
728 scm_t_uint32 xor_mask
= bit
? 0 : ((scm_t_uint32
)-1);
730 for (i
= 0; i
< word_len
-1; i
++)
731 count
+= count_ones ((v_bits
[i
]^xor_mask
) & kv_bits
[i
]);
732 count
+= count_ones ((v_bits
[i
]^xor_mask
) & kv_bits
[i
] & last_mask
);
737 for (i
= 0; i
< kv_len
; i
++)
738 if (scm_is_true (scm_array_handle_ref (&kv_handle
, i
)))
740 SCM elt
= scm_array_handle_ref (&v_handle
, i
*v_inc
);
741 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
746 scm_array_handle_release (&kv_handle
);
749 else if (scm_is_true (scm_u32vector_p (kv
)))
751 scm_t_array_handle kv_handle
;
754 const scm_t_uint32
*kv_elts
;
756 kv_elts
= scm_u32vector_elements (kv
, &kv_handle
, &kv_len
, &kv_inc
);
757 for (i
= 0; i
< kv_len
; i
++, kv_elts
+= kv_inc
)
759 SCM elt
= scm_array_handle_ref (&v_handle
, (*kv_elts
)*v_inc
);
760 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
764 scm_array_handle_release (&kv_handle
);
767 scm_wrong_type_arg_msg (NULL
, 0, kv
, "bitvector or u32vector");
769 scm_array_handle_release (&v_handle
);
771 return scm_from_size_t (count
);
775 SCM_DEFINE (scm_bit_invert_x
, "bit-invert!", 1, 0, 0,
777 "Modify the bit vector @var{v} by replacing each element with\n"
779 #define FUNC_NAME s_scm_bit_invert_x
781 scm_t_array_handle handle
;
786 bits
= scm_bitvector_writable_elements (v
, &handle
, &off
, &len
, &inc
);
788 if (off
== 0 && inc
== 1 && len
> 0)
790 size_t word_len
= (len
+ 31) / 32;
791 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
794 for (i
= 0; i
< word_len
-1; i
++)
796 bits
[i
] = bits
[i
] ^ last_mask
;
801 for (i
= 0; i
< len
; i
++)
802 scm_array_handle_set (&handle
, i
*inc
,
803 scm_not (scm_array_handle_ref (&handle
, i
*inc
)));
806 scm_array_handle_release (&handle
);
808 return SCM_UNSPECIFIED
;
814 scm_istr2bve (SCM str
)
816 scm_t_array_handle handle
;
817 size_t len
= scm_i_string_length (str
);
818 SCM vec
= scm_c_make_bitvector (len
, SCM_UNDEFINED
);
826 data
= scm_bitvector_writable_elements (vec
, &handle
, NULL
, NULL
, NULL
);
827 c_str
= scm_i_string_chars (str
);
829 for (k
= 0; k
< (len
+ 31) / 32; k
++)
835 for (mask
= 1L; j
--; mask
<<= 1)
850 scm_array_handle_release (&handle
);
851 scm_remember_upto_here_1 (str
);
855 /* FIXME: h->array should be h->vector */
857 bitvector_handle_ref (scm_t_array_handle
*h
, size_t pos
)
859 return scm_c_bitvector_ref (h
->array
, pos
);
863 bitvector_handle_set (scm_t_array_handle
*h
, size_t pos
, SCM val
)
865 scm_c_bitvector_set_x (h
->array
, pos
, val
);
869 bitvector_get_handle (SCM bv
, scm_t_array_handle
*h
)
875 h
->dim0
.ubnd
= BITVECTOR_LENGTH (bv
) - 1;
877 h
->element_type
= SCM_ARRAY_ELEMENT_TYPE_BIT
;
878 h
->elements
= h
->writable_elements
= BITVECTOR_BITS (bv
);
881 SCM_ARRAY_IMPLEMENTATION (scm_tc7_bitvector
,
883 bitvector_handle_ref
, bitvector_handle_set
,
884 bitvector_get_handle
)
885 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT
, scm_make_bitvector
)
888 scm_init_bitvectors ()
890 #include "libguile/bitvectors.x"