1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 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/smob.h"
31 #include "libguile/strings.h"
32 #include "libguile/array-handle.h"
33 #include "libguile/bitvectors.h"
34 #include "libguile/arrays.h"
35 #include "libguile/vectors.h"
36 #include "libguile/srfi-4.h"
37 #include "libguile/generalized-vectors.h"
39 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
40 * but alack, all we have is this crufty C.
43 static scm_t_bits scm_tc16_bitvector
;
45 #define IS_BITVECTOR(obj) SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
46 #define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
47 #define BITVECTOR_LENGTH(obj) ((size_t)SCM_SMOB_DATA_2(obj))
50 bitvector_free (SCM vec
)
52 scm_gc_free (BITVECTOR_BITS (vec
),
53 sizeof (scm_t_uint32
) * ((BITVECTOR_LENGTH (vec
)+31)/32),
59 bitvector_print (SCM vec
, SCM port
, scm_print_state
*pstate
)
61 size_t bit_len
= BITVECTOR_LENGTH (vec
);
62 size_t word_len
= (bit_len
+31)/32;
63 scm_t_uint32
*bits
= BITVECTOR_BITS (vec
);
66 scm_puts ("#*", port
);
67 for (i
= 0; i
< word_len
; i
++, bit_len
-= 32)
69 scm_t_uint32 mask
= 1;
70 for (j
= 0; j
< 32 && j
< bit_len
; j
++, mask
<<= 1)
71 scm_putc ((bits
[i
] & mask
)? '1' : '0', port
);
78 bitvector_equalp (SCM vec1
, SCM vec2
)
80 size_t bit_len
= BITVECTOR_LENGTH (vec1
);
81 size_t word_len
= (bit_len
+ 31) / 32;
82 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- bit_len
);
83 scm_t_uint32
*bits1
= BITVECTOR_BITS (vec1
);
84 scm_t_uint32
*bits2
= BITVECTOR_BITS (vec2
);
87 if (BITVECTOR_LENGTH (vec2
) != bit_len
)
89 /* avoid underflow in word_len-1 below. */
92 /* compare full words */
93 if (memcmp (bits1
, bits2
, sizeof (scm_t_uint32
) * (word_len
-1)))
95 /* compare partial last words */
96 if ((bits1
[word_len
-1] & last_mask
) != (bits2
[word_len
-1] & last_mask
))
102 scm_is_bitvector (SCM vec
)
104 return IS_BITVECTOR (vec
);
107 SCM_DEFINE (scm_bitvector_p
, "bitvector?", 1, 0, 0,
109 "Return @code{#t} when @var{obj} is a bitvector, else\n"
111 #define FUNC_NAME s_scm_bitvector_p
113 return scm_from_bool (scm_is_bitvector (obj
));
118 scm_c_make_bitvector (size_t len
, SCM fill
)
120 size_t word_len
= (len
+ 31) / 32;
124 bits
= scm_gc_malloc (sizeof (scm_t_uint32
) * word_len
,
126 SCM_NEWSMOB2 (res
, scm_tc16_bitvector
, bits
, len
);
128 if (!SCM_UNBNDP (fill
))
129 scm_bitvector_fill_x (res
, fill
);
134 SCM_DEFINE (scm_make_bitvector
, "make-bitvector", 1, 1, 0,
136 "Create a new bitvector of length @var{len} and\n"
137 "optionally initialize all elements to @var{fill}.")
138 #define FUNC_NAME s_scm_make_bitvector
140 return scm_c_make_bitvector (scm_to_size_t (len
), fill
);
144 SCM_DEFINE (scm_bitvector
, "bitvector", 0, 0, 1,
146 "Create a new bitvector with the arguments as elements.")
147 #define FUNC_NAME s_scm_bitvector
149 return scm_list_to_bitvector (bits
);
154 scm_c_bitvector_length (SCM vec
)
156 scm_assert_smob_type (scm_tc16_bitvector
, vec
);
157 return BITVECTOR_LENGTH (vec
);
160 SCM_DEFINE (scm_bitvector_length
, "bitvector-length", 1, 0, 0,
162 "Return the length of the bitvector @var{vec}.")
163 #define FUNC_NAME s_scm_bitvector_length
165 return scm_from_size_t (scm_c_bitvector_length (vec
));
170 scm_array_handle_bit_elements (scm_t_array_handle
*h
)
172 return scm_array_handle_bit_writable_elements (h
);
176 scm_array_handle_bit_writable_elements (scm_t_array_handle
*h
)
179 if (SCM_I_ARRAYP (vec
))
180 vec
= SCM_I_ARRAY_V (vec
);
181 if (IS_BITVECTOR (vec
))
182 return BITVECTOR_BITS (vec
) + h
->base
/32;
183 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "bit array");
187 scm_array_handle_bit_elements_offset (scm_t_array_handle
*h
)
193 scm_bitvector_elements (SCM vec
,
194 scm_t_array_handle
*h
,
199 return scm_bitvector_writable_elements (vec
, h
, offp
, lenp
, incp
);
204 scm_bitvector_writable_elements (SCM vec
,
205 scm_t_array_handle
*h
,
210 scm_generalized_vector_get_handle (vec
, h
);
213 scm_t_array_dim
*dim
= scm_array_handle_dims (h
);
214 *offp
= scm_array_handle_bit_elements_offset (h
);
215 *lenp
= dim
->ubnd
- dim
->lbnd
+ 1;
218 return scm_array_handle_bit_writable_elements (h
);
222 scm_c_bitvector_ref (SCM vec
, size_t idx
)
224 scm_t_array_handle handle
;
225 const scm_t_uint32
*bits
;
227 if (IS_BITVECTOR (vec
))
229 if (idx
>= BITVECTOR_LENGTH (vec
))
230 scm_out_of_range (NULL
, scm_from_size_t (idx
));
231 bits
= BITVECTOR_BITS(vec
);
232 return scm_from_bool (bits
[idx
/32] & (1L << (idx
%32)));
240 bits
= scm_bitvector_elements (vec
, &handle
, &off
, &len
, &inc
);
242 scm_out_of_range (NULL
, scm_from_size_t (idx
));
244 res
= scm_from_bool (bits
[idx
/32] & (1L << (idx
%32)));
245 scm_array_handle_release (&handle
);
250 SCM_DEFINE (scm_bitvector_ref
, "bitvector-ref", 2, 0, 0,
252 "Return the element at index @var{idx} of the bitvector\n"
254 #define FUNC_NAME s_scm_bitvector_ref
256 return scm_c_bitvector_ref (vec
, scm_to_size_t (idx
));
261 scm_c_bitvector_set_x (SCM vec
, size_t idx
, SCM val
)
263 scm_t_array_handle handle
;
264 scm_t_uint32
*bits
, mask
;
266 if (IS_BITVECTOR (vec
))
268 if (idx
>= BITVECTOR_LENGTH (vec
))
269 scm_out_of_range (NULL
, scm_from_size_t (idx
));
270 bits
= BITVECTOR_BITS(vec
);
277 bits
= scm_bitvector_writable_elements (vec
, &handle
, &off
, &len
, &inc
);
279 scm_out_of_range (NULL
, scm_from_size_t (idx
));
283 mask
= 1L << (idx
%32);
284 if (scm_is_true (val
))
285 bits
[idx
/32] |= mask
;
287 bits
[idx
/32] &= ~mask
;
289 if (!IS_BITVECTOR (vec
))
290 scm_array_handle_release (&handle
);
293 SCM_DEFINE (scm_bitvector_set_x
, "bitvector-set!", 3, 0, 0,
294 (SCM vec
, SCM idx
, SCM val
),
295 "Set the element at index @var{idx} of the bitvector\n"
296 "@var{vec} when @var{val} is true, else clear it.")
297 #define FUNC_NAME s_scm_bitvector_set_x
299 scm_c_bitvector_set_x (vec
, scm_to_size_t (idx
), val
);
300 return SCM_UNSPECIFIED
;
304 SCM_DEFINE (scm_bitvector_fill_x
, "bitvector-fill!", 2, 0, 0,
306 "Set all elements of the bitvector\n"
307 "@var{vec} when @var{val} is true, else clear them.")
308 #define FUNC_NAME s_scm_bitvector_fill_x
310 scm_t_array_handle handle
;
315 bits
= scm_bitvector_writable_elements (vec
, &handle
,
318 if (off
== 0 && inc
== 1 && len
> 0)
322 size_t word_len
= (len
+ 31) / 32;
323 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
325 if (scm_is_true (val
))
327 memset (bits
, 0xFF, sizeof(scm_t_uint32
)*(word_len
-1));
328 bits
[word_len
-1] |= last_mask
;
332 memset (bits
, 0x00, sizeof(scm_t_uint32
)*(word_len
-1));
333 bits
[word_len
-1] &= ~last_mask
;
339 for (i
= 0; i
< len
; i
++)
340 scm_array_handle_set (&handle
, i
*inc
, val
);
343 scm_array_handle_release (&handle
);
345 return SCM_UNSPECIFIED
;
349 SCM_DEFINE (scm_list_to_bitvector
, "list->bitvector", 1, 0, 0,
351 "Return a new bitvector initialized with the elements\n"
353 #define FUNC_NAME s_scm_list_to_bitvector
355 size_t bit_len
= scm_to_size_t (scm_length (list
));
356 SCM vec
= scm_c_make_bitvector (bit_len
, SCM_UNDEFINED
);
357 size_t word_len
= (bit_len
+31)/32;
358 scm_t_array_handle handle
;
359 scm_t_uint32
*bits
= scm_bitvector_writable_elements (vec
, &handle
,
363 for (i
= 0; i
< word_len
&& scm_is_pair (list
); i
++, bit_len
-= 32)
365 scm_t_uint32 mask
= 1;
367 for (j
= 0; j
< 32 && j
< bit_len
;
368 j
++, mask
<<= 1, list
= SCM_CDR (list
))
369 if (scm_is_true (SCM_CAR (list
)))
373 scm_array_handle_release (&handle
);
379 SCM_DEFINE (scm_bitvector_to_list
, "bitvector->list", 1, 0, 0,
381 "Return a new list initialized with the elements\n"
382 "of the bitvector @var{vec}.")
383 #define FUNC_NAME s_scm_bitvector_to_list
385 scm_t_array_handle handle
;
391 bits
= scm_bitvector_writable_elements (vec
, &handle
,
394 if (off
== 0 && inc
== 1)
398 size_t word_len
= (len
+ 31) / 32;
401 for (i
= 0; i
< word_len
; i
++, len
-= 32)
403 scm_t_uint32 mask
= 1;
404 for (j
= 0; j
< 32 && j
< len
; j
++, mask
<<= 1)
405 res
= scm_cons ((bits
[i
] & mask
)? SCM_BOOL_T
: SCM_BOOL_F
, res
);
411 for (i
= 0; i
< len
; i
++)
412 res
= scm_cons (scm_array_handle_ref (&handle
, i
*inc
), res
);
415 scm_array_handle_release (&handle
);
417 return scm_reverse_x (res
, SCM_EOL
);
421 /* From mmix-arith.w by Knuth.
423 Here's a fun way to count the number of bits in a tetrabyte.
425 [This classical trick is called the ``Gillies--Miller method for
426 sideways addition'' in {\sl The Preparation of Programs for an
427 Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
428 edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
429 the tricks used here were suggested by Balbir Singh, Peter
430 Rossmanith, and Stefan Schwoon.]
434 count_ones (scm_t_uint32 x
)
436 x
=x
-((x
>>1)&0x55555555);
437 x
=(x
&0x33333333)+((x
>>2)&0x33333333);
438 x
=(x
+(x
>>4))&0x0f0f0f0f;
440 return (x
+(x
>>16)) & 0xff;
443 SCM_DEFINE (scm_bit_count
, "bit-count", 2, 0, 0,
444 (SCM b
, SCM bitvector
),
445 "Return the number of occurrences of the boolean @var{b} in\n"
447 #define FUNC_NAME s_scm_bit_count
449 scm_t_array_handle handle
;
453 int bit
= scm_to_bool (b
);
456 bits
= scm_bitvector_writable_elements (bitvector
, &handle
,
459 if (off
== 0 && inc
== 1 && len
> 0)
463 size_t word_len
= (len
+ 31) / 32;
464 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
467 for (i
= 0; i
< word_len
-1; i
++)
468 count
+= count_ones (bits
[i
]);
469 count
+= count_ones (bits
[i
] & last_mask
);
474 for (i
= 0; i
< len
; i
++)
475 if (scm_is_true (scm_array_handle_ref (&handle
, i
*inc
)))
479 scm_array_handle_release (&handle
);
481 return scm_from_size_t (bit
? count
: len
-count
);
485 /* returns 32 for x == 0.
488 find_first_one (scm_t_uint32 x
)
491 /* do a binary search in x. */
492 if ((x
& 0xFFFF) == 0)
505 SCM_DEFINE (scm_bit_position
, "bit-position", 3, 0, 0,
506 (SCM item
, SCM v
, SCM k
),
507 "Return the index of the first occurrance of @var{item} in bit\n"
508 "vector @var{v}, starting from @var{k}. If there is no\n"
509 "@var{item} entry between @var{k} and the end of\n"
510 "@var{bitvector}, then return @code{#f}. For example,\n"
513 "(bit-position #t #*000101 0) @result{} 3\n"
514 "(bit-position #f #*0001111 3) @result{} #f\n"
516 #define FUNC_NAME s_scm_bit_position
518 scm_t_array_handle handle
;
519 size_t off
, len
, first_bit
;
521 const scm_t_uint32
*bits
;
522 int bit
= scm_to_bool (item
);
523 SCM res
= SCM_BOOL_F
;
525 bits
= scm_bitvector_elements (v
, &handle
, &off
, &len
, &inc
);
526 first_bit
= scm_to_unsigned_integer (k
, 0, len
);
528 if (off
== 0 && inc
== 1 && len
> 0)
530 size_t i
, word_len
= (len
+ 31) / 32;
531 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
532 size_t first_word
= first_bit
/ 32;
533 scm_t_uint32 first_mask
=
534 ((scm_t_uint32
)-1) << (first_bit
- 32*first_word
);
537 for (i
= first_word
; i
< word_len
; i
++)
539 w
= (bit
? bits
[i
] : ~bits
[i
]);
546 res
= scm_from_size_t (32*i
+ find_first_one (w
));
554 for (i
= first_bit
; i
< len
; i
++)
556 SCM elt
= scm_array_handle_ref (&handle
, i
*inc
);
557 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
559 res
= scm_from_size_t (i
);
565 scm_array_handle_release (&handle
);
571 SCM_DEFINE (scm_bit_set_star_x
, "bit-set*!", 3, 0, 0,
572 (SCM v
, SCM kv
, SCM obj
),
573 "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
574 "selecting the entries to change. The return value is\n"
577 "If @var{kv} is a bit vector, then those entries where it has\n"
578 "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
579 "@var{kv} and @var{v} must be the same length. When @var{obj}\n"
580 "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n"
581 "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
584 "(define bv #*01000010)\n"
585 "(bit-set*! bv #*10010001 #t)\n"
587 "@result{} #*11010011\n"
590 "If @var{kv} is a u32vector, then its elements are\n"
591 "indices into @var{v} which are set to @var{obj}.\n"
594 "(define bv #*01000010)\n"
595 "(bit-set*! bv #u32(5 2 7) #t)\n"
597 "@result{} #*01100111\n"
599 #define FUNC_NAME s_scm_bit_set_star_x
601 scm_t_array_handle v_handle
;
604 scm_t_uint32
*v_bits
;
607 /* Validate that OBJ is a boolean so this is done even if we don't
610 bit
= scm_to_bool (obj
);
612 v_bits
= scm_bitvector_writable_elements (v
, &v_handle
,
613 &v_off
, &v_len
, &v_inc
);
615 if (scm_is_bitvector (kv
))
617 scm_t_array_handle kv_handle
;
618 size_t kv_off
, kv_len
;
620 const scm_t_uint32
*kv_bits
;
622 kv_bits
= scm_bitvector_elements (v
, &kv_handle
,
623 &kv_off
, &kv_len
, &kv_inc
);
626 scm_misc_error (NULL
,
627 "bit vectors must have equal length",
630 if (v_off
== 0 && v_inc
== 1 && kv_off
== 0 && kv_inc
== 1 && kv_len
> 0)
632 size_t word_len
= (kv_len
+ 31) / 32;
633 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- kv_len
);
638 for (i
= 0; i
< word_len
-1; i
++)
639 v_bits
[i
] &= ~kv_bits
[i
];
640 v_bits
[i
] &= ~(kv_bits
[i
] & last_mask
);
644 for (i
= 0; i
< word_len
-1; i
++)
645 v_bits
[i
] |= kv_bits
[i
];
646 v_bits
[i
] |= kv_bits
[i
] & last_mask
;
652 for (i
= 0; i
< kv_len
; i
++)
653 if (scm_is_true (scm_array_handle_ref (&kv_handle
, i
*kv_inc
)))
654 scm_array_handle_set (&v_handle
, i
*v_inc
, obj
);
657 scm_array_handle_release (&kv_handle
);
660 else if (scm_is_true (scm_u32vector_p (kv
)))
662 scm_t_array_handle kv_handle
;
665 const scm_t_uint32
*kv_elts
;
667 kv_elts
= scm_u32vector_elements (kv
, &kv_handle
, &kv_len
, &kv_inc
);
668 for (i
= 0; i
< kv_len
; i
++, kv_elts
+= kv_inc
)
669 scm_array_handle_set (&v_handle
, (*kv_elts
)*v_inc
, obj
);
671 scm_array_handle_release (&kv_handle
);
674 scm_wrong_type_arg_msg (NULL
, 0, kv
, "bitvector or u32vector");
676 scm_array_handle_release (&v_handle
);
678 return SCM_UNSPECIFIED
;
683 SCM_DEFINE (scm_bit_count_star
, "bit-count*", 3, 0, 0,
684 (SCM v
, SCM kv
, SCM obj
),
685 "Return a count of how many entries in bit vector @var{v} are\n"
686 "equal to @var{obj}, with @var{kv} selecting the entries to\n"
689 "If @var{kv} is a bit vector, then those entries where it has\n"
690 "@code{#t} are the ones in @var{v} which are considered.\n"
691 "@var{kv} and @var{v} must be the same length.\n"
693 "If @var{kv} is a u32vector, then it contains\n"
694 "the indexes in @var{v} to consider.\n"
699 "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
700 "(bit-count* #*01110111 #u32(7 0 4) #f) @result{} 2\n"
702 #define FUNC_NAME s_scm_bit_count_star
704 scm_t_array_handle v_handle
;
707 const scm_t_uint32
*v_bits
;
711 /* Validate that OBJ is a boolean so this is done even if we don't
714 bit
= scm_to_bool (obj
);
716 v_bits
= scm_bitvector_elements (v
, &v_handle
,
717 &v_off
, &v_len
, &v_inc
);
719 if (scm_is_bitvector (kv
))
721 scm_t_array_handle kv_handle
;
722 size_t kv_off
, kv_len
;
724 const scm_t_uint32
*kv_bits
;
726 kv_bits
= scm_bitvector_elements (v
, &kv_handle
,
727 &kv_off
, &kv_len
, &kv_inc
);
730 scm_misc_error (NULL
,
731 "bit vectors must have equal length",
734 if (v_off
== 0 && v_inc
== 1 && kv_off
== 0 && kv_inc
== 1 && kv_len
> 0)
736 size_t i
, word_len
= (kv_len
+ 31) / 32;
737 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- kv_len
);
738 scm_t_uint32 xor_mask
= bit
? 0 : ((scm_t_uint32
)-1);
740 for (i
= 0; i
< word_len
-1; i
++)
741 count
+= count_ones ((v_bits
[i
]^xor_mask
) & kv_bits
[i
]);
742 count
+= count_ones ((v_bits
[i
]^xor_mask
) & kv_bits
[i
] & last_mask
);
747 for (i
= 0; i
< kv_len
; i
++)
748 if (scm_is_true (scm_array_handle_ref (&kv_handle
, i
)))
750 SCM elt
= scm_array_handle_ref (&v_handle
, i
*v_inc
);
751 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
756 scm_array_handle_release (&kv_handle
);
759 else if (scm_is_true (scm_u32vector_p (kv
)))
761 scm_t_array_handle kv_handle
;
764 const scm_t_uint32
*kv_elts
;
766 kv_elts
= scm_u32vector_elements (kv
, &kv_handle
, &kv_len
, &kv_inc
);
767 for (i
= 0; i
< kv_len
; i
++, kv_elts
+= kv_inc
)
769 SCM elt
= scm_array_handle_ref (&v_handle
, (*kv_elts
)*v_inc
);
770 if ((bit
&& scm_is_true (elt
)) || (!bit
&& scm_is_false (elt
)))
774 scm_array_handle_release (&kv_handle
);
777 scm_wrong_type_arg_msg (NULL
, 0, kv
, "bitvector or u32vector");
779 scm_array_handle_release (&v_handle
);
781 return scm_from_size_t (count
);
785 SCM_DEFINE (scm_bit_invert_x
, "bit-invert!", 1, 0, 0,
787 "Modify the bit vector @var{v} by replacing each element with\n"
789 #define FUNC_NAME s_scm_bit_invert_x
791 scm_t_array_handle handle
;
796 bits
= scm_bitvector_writable_elements (v
, &handle
, &off
, &len
, &inc
);
798 if (off
== 0 && inc
== 1 && len
> 0)
800 size_t word_len
= (len
+ 31) / 32;
801 scm_t_uint32 last_mask
= ((scm_t_uint32
)-1) >> (32*word_len
- len
);
804 for (i
= 0; i
< word_len
-1; i
++)
806 bits
[i
] = bits
[i
] ^ last_mask
;
811 for (i
= 0; i
< len
; i
++)
812 scm_array_handle_set (&handle
, i
*inc
,
813 scm_not (scm_array_handle_ref (&handle
, i
*inc
)));
816 scm_array_handle_release (&handle
);
818 return SCM_UNSPECIFIED
;
824 scm_istr2bve (SCM str
)
826 scm_t_array_handle handle
;
827 size_t len
= scm_i_string_length (str
);
828 SCM vec
= scm_c_make_bitvector (len
, SCM_UNDEFINED
);
836 data
= scm_bitvector_writable_elements (vec
, &handle
, NULL
, NULL
, NULL
);
837 c_str
= scm_i_string_chars (str
);
839 for (k
= 0; k
< (len
+ 31) / 32; k
++)
845 for (mask
= 1L; j
--; mask
<<= 1)
860 scm_array_handle_release (&handle
);
861 scm_remember_upto_here_1 (str
);
865 /* FIXME: h->array should be h->vector */
867 bitvector_handle_ref (scm_t_array_handle
*h
, size_t pos
)
869 return scm_c_bitvector_ref (h
->array
, pos
);
873 bitvector_handle_set (scm_t_array_handle
*h
, size_t pos
, SCM val
)
875 scm_c_bitvector_set_x (h
->array
, pos
, val
);
879 bitvector_get_handle (SCM bv
, scm_t_array_handle
*h
)
885 h
->dim0
.ubnd
= BITVECTOR_LENGTH (bv
) - 1;
887 h
->element_type
= SCM_ARRAY_ELEMENT_TYPE_BIT
;
888 h
->elements
= h
->writable_elements
= BITVECTOR_BITS (bv
);
891 SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector
, 0xffff,
892 bitvector_handle_ref
, bitvector_handle_set
,
893 bitvector_get_handle
);
894 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT
, scm_make_bitvector
);
897 scm_init_bitvectors ()
899 scm_tc16_bitvector
= scm_make_smob_type ("bitvector", 0);
900 scm_set_smob_free (scm_tc16_bitvector
, bitvector_free
);
901 scm_set_smob_print (scm_tc16_bitvector
, bitvector_print
);
902 scm_set_smob_equalp (scm_tc16_bitvector
, bitvector_equalp
);
904 #include "libguile/bitvectors.x"