1 /* srfi-60.c --- Integers as Bits
3 * Copyright (C) 2005, 2006, 2008 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
25 #include <srfi/srfi-60.h>
28 SCM_DEFINE (scm_srfi60_log2_binary_factors
, "log2-binary-factors", 1, 0, 0,
30 "Return a count of how many factors of 2 are present in @var{n}.\n"
31 "This is also the bit index of the lowest 1 bit in @var{n}. If\n"
32 "@var{n} is 0, the return is @math{-1}.\n"
35 "(log2-binary-factors 6) @result{} 1\n"
36 "(log2-binary-factors -8) @result{} 3\n"
38 #define FUNC_NAME s_scm_srfi60_log2_binary_factors
44 long nn
= SCM_I_INUM (n
);
46 return SCM_I_MAKINUM (-1);
47 nn
= nn
^ (nn
-1); /* 1 bits for each low 0 and lowest 1 */
48 return scm_logcount (SCM_I_MAKINUM (nn
>> 1));
50 else if (SCM_BIGP (n
))
52 /* no need for scm_remember_upto_here_1 here, mpz_scan1 doesn't do
53 anything that could result in a gc */
54 return SCM_I_MAKINUM (mpz_scan1 (SCM_I_BIG_MPZ (n
), 0L));
57 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
64 SCM_DEFINE (scm_srfi60_copy_bit
, "copy-bit", 3, 0, 0,
65 (SCM index
, SCM n
, SCM bit
),
66 "Return @var{n} with the bit at @var{index} set according to\n"
67 "@var{newbit}. @var{newbit} should be @code{#t} to set the bit\n"
68 "to 1, or @code{#f} to set it to 0. Bits other than at\n"
69 "@var{index} are unchanged in the return.\n"
72 "(copy-bit 1 #b0101 #t) @result{} 7\n"
74 #define FUNC_NAME s_scm_srfi60_copy_bit
80 ii
= scm_to_ulong (index
);
81 bb
= scm_to_bool (bit
);
85 long nn
= SCM_I_INUM (n
);
87 /* can't set high bit ii==SCM_LONG_BIT-1, that would change the sign,
88 which is not what's wanted */
89 if (ii
< SCM_LONG_BIT
-1)
91 nn
&= ~(1L << ii
); /* zap bit at index */
92 nn
|= ((long) bb
<< ii
); /* insert desired bit */
93 return scm_from_long (nn
);
97 /* bits at ii==SCM_LONG_BIT-1 and above are all copies of the sign
98 bit, if this is already the desired "bit" value then no need to
99 make a new bignum value */
103 r
= scm_i_long2big (nn
);
107 else if (SCM_BIGP (n
))
109 /* if the bit is already what's wanted then no need to make a new
111 if (bb
== mpz_tstbit (SCM_I_BIG_MPZ (n
), ii
))
114 r
= scm_i_clonebig (n
, 1);
117 mpz_setbit (SCM_I_BIG_MPZ (r
), ii
);
119 mpz_clrbit (SCM_I_BIG_MPZ (r
), ii
);
121 /* changing a high bit might put the result into range of a fixnum */
122 return scm_i_normbig (r
);
125 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
130 SCM_DEFINE (scm_srfi60_rotate_bit_field
, "rotate-bit-field", 4, 0, 0,
131 (SCM n
, SCM count
, SCM start
, SCM end
),
132 "Return @var{n} with the bit field from @var{start} (inclusive)\n"
133 "to @var{end} (exclusive) rotated upwards by @var{count} bits.\n"
135 "@var{count} can be positive or negative, and it can be more\n"
136 "than the field width (it'll be reduced modulo the width).\n"
139 "(rotate-bit-field #b0110 2 1 4) @result{} #b1010\n"
141 #define FUNC_NAME s_scm_srfi60_rotate_bit_field
143 unsigned long ss
= scm_to_ulong (start
);
144 unsigned long ee
= scm_to_ulong (end
);
145 unsigned long ww
, cc
;
147 SCM_ASSERT_RANGE (3, end
, (ee
>= ss
));
150 cc
= scm_to_ulong (scm_modulo (count
, scm_difference (end
, start
)));
154 long nn
= SCM_I_INUM (n
);
156 if (ee
<= SCM_LONG_BIT
-1)
158 /* all within a long */
159 long below
= nn
& ((1L << ss
) - 1); /* before start */
160 long above
= nn
& (-1L << ee
); /* above end */
161 long fmask
= (-1L << ss
) & ((1L << ee
) - 1); /* field mask */
162 long ff
= nn
& fmask
; /* field */
164 return scm_from_long (above
165 | ((ff
<< cc
) & fmask
)
166 | ((ff
>> (ww
-cc
)) & fmask
)
171 /* either no movement, or a field of only 0 or 1 bits, result
172 unchanged, avoid creating a bignum */
173 if (cc
== 0 || ww
<= 1)
176 n
= scm_i_long2big (nn
);
180 else if (SCM_BIGP (n
))
185 /* either no movement, or in a field of only 0 or 1 bits, result
186 unchanged, avoid creating a new bignum */
187 if (cc
== 0 || ww
<= 1)
191 r
= scm_i_ulong2big (0);
194 /* portion above end */
195 mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (n
), ee
);
196 mpz_mul_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), ee
);
198 /* field high part, width-count bits from start go to start+count */
199 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
200 mpz_fdiv_r_2exp (tmp
, tmp
, ww
- cc
);
201 mpz_mul_2exp (tmp
, tmp
, ss
+ cc
);
202 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
204 /* field high part, count bits from end-count go to start */
205 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ee
- cc
);
206 mpz_fdiv_r_2exp (tmp
, tmp
, cc
);
207 mpz_mul_2exp (tmp
, tmp
, ss
);
208 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
210 /* portion below start */
211 mpz_fdiv_r_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
212 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
216 /* bits moved around might leave us in range of an inum */
217 return scm_i_normbig (r
);
220 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
225 SCM_DEFINE (scm_srfi60_reverse_bit_field
, "reverse-bit-field", 3, 0, 0,
226 (SCM n
, SCM start
, SCM end
),
227 "Return @var{n} with the bits between @var{start} (inclusive) to\n"
228 "@var{end} (exclusive) reversed.\n"
231 "(reverse-bit-field #b101001 2 4) @result{} #b100101\n"
233 #define FUNC_NAME s_scm_srfi60_reverse_bit_field
235 long ss
= scm_to_long (start
);
236 long ee
= scm_to_long (end
);
237 long swaps
= (ee
- ss
) / 2; /* number of swaps */
242 long nn
= SCM_I_INUM (n
);
244 if (ee
<= SCM_LONG_BIT
-1)
246 /* all within a long */
247 long smask
= 1L << ss
;
248 long emask
= 1L << (ee
-1);
249 for ( ; swaps
> 0; swaps
--)
251 long sbit
= nn
& smask
;
252 long ebit
= nn
& emask
;
253 nn
^= sbit
^ (ebit
? smask
: 0) /* zap sbit, put ebit value */
254 ^ ebit
^ (sbit
? emask
: 0); /* zap ebit, put sbit value */
259 return scm_from_long (nn
);
263 /* avoid creating a new bignum if reversing only 0 or 1 bits */
267 b
= scm_i_long2big (nn
);
271 else if (SCM_BIGP (n
))
273 /* avoid creating a new bignum if reversing only 0 or 1 bits */
277 b
= scm_i_clonebig (n
, 1);
281 for ( ; swaps
> 0; swaps
--)
283 int sbit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ss
);
284 int ebit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ee
);
287 /* the two bits are different, flip them */
290 mpz_clrbit (SCM_I_BIG_MPZ (b
), ss
);
291 mpz_setbit (SCM_I_BIG_MPZ (b
), ee
);
295 mpz_setbit (SCM_I_BIG_MPZ (b
), ss
);
296 mpz_clrbit (SCM_I_BIG_MPZ (b
), ee
);
302 /* swapping zero bits into the high might make us fit a fixnum */
303 return scm_i_normbig (b
);
306 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
311 SCM_DEFINE (scm_srfi60_integer_to_list
, "integer->list", 1, 1, 0,
313 "Return bits from @var{n} in the form of a list of @code{#t} for\n"
314 "1 and @code{#f} for 0. The least significant @var{len} bits\n"
315 "are returned, and the first list element is the most\n"
316 "significant of those bits. If @var{len} is not given, the\n"
317 "default is @code{(integer-length @var{n})} (@pxref{Bitwise\n"
321 "(integer->list 6) @result{} (#t #t #f)\n"
322 "(integer->list 1 4) @result{} (#f #f #f #t)\n"
324 #define FUNC_NAME s_scm_srfi60_integer_to_list
329 if (SCM_UNBNDP (len
))
330 len
= scm_integer_length (n
);
331 ll
= scm_to_ulong (len
);
335 long nn
= SCM_I_INUM (n
);
336 for (i
= 0; i
< ll
; i
++)
338 unsigned long shift
=
339 (i
< ((unsigned long) SCM_LONG_BIT
-1))
340 ? i
: ((unsigned long) SCM_LONG_BIT
-1);
341 int bit
= (nn
>> shift
) & 1;
342 ret
= scm_cons (scm_from_bool (bit
), ret
);
345 else if (SCM_BIGP (n
))
347 for (i
= 0; i
< ll
; i
++)
348 ret
= scm_cons (scm_from_bool (mpz_tstbit (SCM_I_BIG_MPZ (n
), i
)),
350 scm_remember_upto_here_1 (n
);
353 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
360 SCM_DEFINE (scm_srfi60_list_to_integer
, "list->integer", 1, 0, 0,
362 "Return an integer formed bitwise from the given @var{lst} list\n"
363 "of booleans. Each boolean is @code{#t} for a 1 and @code{#f}\n"
364 "for a 0. The first element becomes the most significant bit in\n"
368 "(list->integer '(#t #f #t #f)) @result{} 10\n"
370 #define FUNC_NAME s_scm_srfi60_list_to_integer
374 /* strip high zero bits from lst; after this the length tells us whether
375 an inum or bignum is required */
376 while (scm_is_pair (lst
) && scm_is_false (SCM_CAR (lst
)))
379 SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1
, lst
, len
);
381 if (len
<= SCM_I_FIXNUM_BIT
- 1)
383 /* fits an inum (a positive inum) */
385 while (scm_is_pair (lst
))
388 if (! scm_is_false (SCM_CAR (lst
)))
392 return SCM_I_MAKINUM (n
);
397 SCM n
= scm_i_ulong2big (0);
398 while (scm_is_pair (lst
))
401 if (! scm_is_false (SCM_CAR (lst
)))
402 mpz_setbit (SCM_I_BIG_MPZ (n
), len
);
411 /* note: don't put "scm_srfi60_list_to_integer" arg on its own line, a
412 newline breaks the snarfer */
413 SCM_REGISTER_PROC (s_srfi60_booleans_to_integer
, "booleans->integer", 0, 0, 1, scm_srfi60_list_to_integer
);
417 scm_init_srfi_60 (void)
419 #ifndef SCM_MAGIC_SNARFER
420 #include "srfi/srfi-60.x"