1 /* srfi-60.c --- Integers as Bits
3 * Copyright (C) 2005 Free Software Foundation, Inc.
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Lesser General Public
7 * License as published by the Free Software Foundation; either
8 * version 2.1 of the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Lesser General Public License for more details.
15 * You should have received a copy of the GNU Lesser General Public
16 * License along with this library; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 #include "libguile/private-gc.h" /* for SCM_MIN */
25 SCM_DEFINE (scm_srfi60_log2_binary_factors
, "log2-binary-factors", 1, 0, 0,
27 "Return a count of how many factors of 2 are present in @var{n}.\n"
28 "This is also the bit index of the lowest 1 bit in @var{n}. If\n"
29 "@var{n} is 0, the return is @math{-1}.\n"
32 "(log2-binary-factors 6) @result{} 1\n"
33 "(log2-binary-factors -8) @result{} 3\n"
35 #define FUNC_NAME s_scm_srfi60_log2_binary_factors
41 long nn
= SCM_I_INUM (n
);
43 return SCM_I_MAKINUM (-1);
44 nn
= nn
^ (nn
-1); /* 1 bits for each low 0 and lowest 1 */
45 return scm_logcount (SCM_I_MAKINUM (nn
>> 1));
47 else if (SCM_BIGP (n
))
49 /* no need for scm_remember_upto_here_1 here, mpz_scan1 doesn't do
50 anything that could result in a gc */
51 return SCM_I_MAKINUM (mpz_scan1 (SCM_I_BIG_MPZ (n
), 0L));
54 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
61 SCM_DEFINE (scm_srfi60_copy_bit
, "copy-bit", 3, 0, 0,
62 (SCM index
, SCM n
, SCM bit
),
63 "Return @var{n} with the bit at @var{index} set according to\n"
64 "@var{newbit}. @var{newbit} should be @code{#t} to set the bit\n"
65 "to 1, or @code{#f} to set it to 0. Bits other than at\n"
66 "@var{index} are unchanged in the return.\n"
69 "(copy-bit 1 #b0101 #t) @result{} 7\n"
71 #define FUNC_NAME s_scm_srfi60_copy_bit
77 ii
= scm_to_ulong (index
);
78 bb
= scm_to_bool (bit
);
82 long nn
= SCM_I_INUM (n
);
84 /* can't set high bit ii==SCM_LONG_BIT-1, that would change the sign,
85 which is not what's wanted */
86 if (ii
< SCM_LONG_BIT
-1)
88 nn
&= ~(1L << ii
); /* zap bit at index */
89 nn
|= (bb
<< ii
); /* insert desired bit */
90 return scm_from_long (nn
);
94 /* bits at ii==SCM_LONG_BIT-1 and above are all copies of the sign
95 bit, if this is already the desired "bit" value then no need to
96 make a new bignum value */
100 r
= scm_i_long2big (nn
);
104 else if (SCM_BIGP (n
))
106 /* if the bit is already what's wanted then no need to make a new
108 if (bb
== mpz_tstbit (SCM_I_BIG_MPZ (n
), ii
))
111 r
= scm_i_clonebig (n
, 1);
114 mpz_setbit (SCM_I_BIG_MPZ (r
), ii
);
116 mpz_clrbit (SCM_I_BIG_MPZ (r
), ii
);
118 /* changing a high bit might put the result into range of a fixnum */
119 return scm_i_normbig (r
);
122 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
127 SCM_DEFINE (scm_srfi60_rotate_bit_field
, "rotate-bit-field", 4, 0, 0,
128 (SCM n
, SCM count
, SCM start
, SCM end
),
129 "Return @var{n} with the bit field from @var{start} (inclusive)\n"
130 "to @var{end} (exclusive) rotated upwards by @var{count} bits.\n"
132 "@var{count} can be positive or negative, and it can be more\n"
133 "than the field width (it'll be reduced modulo the width).\n"
136 "(rotate-bit-field #b0110 2 1 4) @result{} #b1010\n"
138 #define FUNC_NAME s_scm_srfi60_rotate_bit_field
140 unsigned long ss
= scm_to_ulong (start
);
141 unsigned long ee
= scm_to_ulong (end
);
142 unsigned long ww
, cc
;
144 SCM_ASSERT_RANGE (3, end
, (ee
>= ss
));
147 cc
= scm_to_ulong (scm_modulo (count
, scm_difference (end
, start
)));
151 long nn
= SCM_I_INUM (n
);
153 if (ee
<= SCM_LONG_BIT
-1)
155 /* all within a long */
156 long below
= nn
& ((1L << ss
) - 1); /* before start */
157 long above
= nn
& (-1L << ee
); /* above end */
158 long fmask
= (-1L << ss
) & ((1L << ee
) - 1); /* field mask */
159 long ff
= nn
& fmask
; /* field */
161 return scm_from_long (above
162 | ((ff
<< cc
) & fmask
)
163 | ((ff
>> (ww
-cc
)) & fmask
)
168 /* either no movement, or a field of only 0 or 1 bits, result
169 unchanged, avoid creating a bignum */
170 if (cc
== 0 || ww
<= 1)
173 n
= scm_i_long2big (nn
);
177 else if (SCM_BIGP (n
))
182 /* either no movement, or in a field of only 0 or 1 bits, result
183 unchanged, avoid creating a new bignum */
184 if (cc
== 0 || ww
<= 1)
188 r
= scm_i_ulong2big (0);
191 /* portion above end */
192 mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (n
), ee
);
193 mpz_mul_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), ee
);
195 /* field high part, width-count bits from start go to start+count */
196 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
197 mpz_fdiv_r_2exp (tmp
, tmp
, ww
- cc
);
198 mpz_mul_2exp (tmp
, tmp
, ss
+ cc
);
199 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
201 /* field high part, count bits from end-count go to start */
202 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ee
- cc
);
203 mpz_fdiv_r_2exp (tmp
, tmp
, cc
);
204 mpz_mul_2exp (tmp
, tmp
, ss
);
205 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
207 /* portion below start */
208 mpz_fdiv_r_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
209 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
213 /* bits moved around might leave us in range of an inum */
214 return scm_i_normbig (r
);
217 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
222 SCM_DEFINE (scm_srfi60_reverse_bit_field
, "reverse-bit-field", 3, 0, 0,
223 (SCM n
, SCM start
, SCM end
),
224 "Return @var{n} with the bits between @var{start} (inclusive) to\n"
225 "@var{end} (exclusive) reversed.\n"
228 "(reverse-bit-field #b101001 2 4) @result{} #b100101\n"
230 #define FUNC_NAME s_scm_srfi60_reverse_bit_field
232 long ss
= scm_to_long (start
);
233 long ee
= scm_to_long (end
);
234 long swaps
= (ee
- ss
) / 2; /* number of swaps */
239 long nn
= SCM_I_INUM (n
);
241 if (ee
<= SCM_LONG_BIT
-1)
243 /* all within a long */
244 long smask
= 1L << ss
;
245 long emask
= 1L << (ee
-1);
246 for ( ; swaps
> 0; swaps
--)
248 long sbit
= nn
& smask
;
249 long ebit
= nn
& emask
;
250 nn
^= sbit
^ (ebit
? smask
: 0) /* zap sbit, put ebit value */
251 ^ ebit
^ (sbit
? emask
: 0); /* zap ebit, put sbit value */
256 return scm_from_long (nn
);
260 /* avoid creating a new bignum if reversing only 0 or 1 bits */
264 b
= scm_i_long2big (nn
);
268 else if (SCM_BIGP (n
))
270 /* avoid creating a new bignum if reversing only 0 or 1 bits */
274 b
= scm_i_clonebig (n
, 1);
278 for ( ; swaps
> 0; swaps
--)
280 int sbit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ss
);
281 int ebit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ee
);
284 /* the two bits are different, flip them */
287 mpz_clrbit (SCM_I_BIG_MPZ (b
), ss
);
288 mpz_setbit (SCM_I_BIG_MPZ (b
), ee
);
292 mpz_setbit (SCM_I_BIG_MPZ (b
), ss
);
293 mpz_clrbit (SCM_I_BIG_MPZ (b
), ee
);
299 /* swapping zero bits into the high might make us fit a fixnum */
300 return scm_i_normbig (b
);
303 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
308 SCM_DEFINE (scm_srfi60_integer_to_list
, "integer->list", 1, 1, 0,
310 "Return bits from @var{n} in the form of a list of @code{#t} for\n"
311 "1 and @code{#f} for 0. The least significant @var{len} bits\n"
312 "are returned, and the first list element is the most\n"
313 "significant of those bits. If @var{len} is not given, the\n"
314 "default is @code{(integer-length @var{n})} (@pxref{Bitwise\n"
318 "(integer->list 6) @result{} (#t #t #f)\n"
319 "(integer->list 1 4) @result{} (#f #f #f #t)\n"
321 #define FUNC_NAME s_scm_srfi60_integer_to_list
326 if (SCM_UNBNDP (len
))
327 len
= scm_integer_length (n
);
328 ll
= scm_to_ulong (len
);
332 long nn
= SCM_I_INUM (n
);
333 for (i
= 0; i
< ll
; i
++)
335 unsigned long shift
= SCM_MIN (i
, (unsigned long) SCM_LONG_BIT
-1);
336 int bit
= (nn
>> shift
) & 1;
337 ret
= scm_cons (scm_from_bool (bit
), ret
);
340 else if (SCM_BIGP (n
))
342 for (i
= 0; i
< ll
; i
++)
343 ret
= scm_cons (scm_from_bool (mpz_tstbit (SCM_I_BIG_MPZ (n
), i
)),
345 scm_remember_upto_here_1 (n
);
348 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
355 SCM_DEFINE (scm_srfi60_list_to_integer
, "list->integer", 1, 0, 0,
357 "Return an integer formed bitwise from the given @var{lst} list\n"
358 "of booleans. Each boolean is @code{#t} for a 1 and @code{#f}\n"
359 "for a 0. The first element becomes the most significant bit in\n"
363 "(list->integer '(#t #f #t #f)) @result{} 10\n"
365 #define FUNC_NAME s_scm_srfi60_list_to_integer
369 /* strip high zero bits from lst; after this the length tells us whether
370 an inum or bignum is required */
371 while (scm_is_pair (lst
) && scm_is_false (SCM_CAR (lst
)))
374 SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1
, lst
, len
);
376 if (len
<= SCM_I_FIXNUM_BIT
- 1)
378 /* fits an inum (a positive inum) */
380 while (scm_is_pair (lst
))
383 if (! scm_is_false (SCM_CAR (lst
)))
387 return SCM_I_MAKINUM (n
);
392 SCM n
= scm_i_ulong2big (0);
393 while (scm_is_pair (lst
))
396 if (! scm_is_false (SCM_CAR (lst
)))
397 mpz_setbit (SCM_I_BIG_MPZ (n
), len
);
406 SCM_REGISTER_PROC (s_srfi60_booleans_to_integer
, "booleans->integer", 0, 0, 1,
407 scm_srfi60_list_to_integer
);
411 scm_init_srfi_60 (void)
413 #ifndef SCM_MAGIC_SNARFER
414 #include "srfi/srfi-60.x"