1 /* srfi-60.c --- Integers as Bits
3 * Copyright (C) 2005, 2006, 2008, 2010 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 License
7 * as published by the Free Software Foundation; either version 3 of
8 * the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful, but
11 * 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
27 #include "libguile/_scm.h"
28 #include "libguile/eq.h"
30 #include "libguile/validate.h"
31 #include "libguile/numbers.h"
33 #include "libguile/srfi-60.h"
36 SCM_DEFINE (scm_srfi60_log2_binary_factors
, "log2-binary-factors", 1, 0, 0,
38 "Return a count of how many factors of 2 are present in @var{n}.\n"
39 "This is also the bit index of the lowest 1 bit in @var{n}. If\n"
40 "@var{n} is 0, the return is @math{-1}.\n"
43 "(log2-binary-factors 6) @result{} 1\n"
44 "(log2-binary-factors -8) @result{} 3\n"
46 #define FUNC_NAME s_scm_srfi60_log2_binary_factors
52 long nn
= SCM_I_INUM (n
);
54 return SCM_I_MAKINUM (-1);
55 nn
= nn
^ (nn
-1); /* 1 bits for each low 0 and lowest 1 */
56 return scm_logcount (SCM_I_MAKINUM (nn
>> 1));
58 else if (SCM_BIGP (n
))
60 /* no need for scm_remember_upto_here_1 here, mpz_scan1 doesn't do
61 anything that could result in a gc */
62 return SCM_I_MAKINUM (mpz_scan1 (SCM_I_BIG_MPZ (n
), 0L));
65 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
72 SCM_DEFINE (scm_srfi60_copy_bit
, "copy-bit", 3, 0, 0,
73 (SCM index
, SCM n
, SCM bit
),
74 "Return @var{n} with the bit at @var{index} set according to\n"
75 "@var{newbit}. @var{newbit} should be @code{#t} to set the bit\n"
76 "to 1, or @code{#f} to set it to 0. Bits other than at\n"
77 "@var{index} are unchanged in the return.\n"
80 "(copy-bit 1 #b0101 #t) @result{} 7\n"
82 #define FUNC_NAME s_scm_srfi60_copy_bit
88 ii
= scm_to_ulong (index
);
89 bb
= scm_to_bool (bit
);
93 long nn
= SCM_I_INUM (n
);
95 /* can't set high bit ii==SCM_LONG_BIT-1, that would change the sign,
96 which is not what's wanted */
97 if (ii
< SCM_LONG_BIT
-1)
99 nn
&= ~(1L << ii
); /* zap bit at index */
100 nn
|= ((long) bb
<< ii
); /* insert desired bit */
101 return scm_from_long (nn
);
105 /* bits at ii==SCM_LONG_BIT-1 and above are all copies of the sign
106 bit, if this is already the desired "bit" value then no need to
107 make a new bignum value */
111 r
= scm_i_long2big (nn
);
115 else if (SCM_BIGP (n
))
117 /* if the bit is already what's wanted then no need to make a new
119 if (bb
== mpz_tstbit (SCM_I_BIG_MPZ (n
), ii
))
122 r
= scm_i_clonebig (n
, 1);
125 mpz_setbit (SCM_I_BIG_MPZ (r
), ii
);
127 mpz_clrbit (SCM_I_BIG_MPZ (r
), ii
);
129 /* changing a high bit might put the result into range of a fixnum */
130 return scm_i_normbig (r
);
133 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
138 SCM_DEFINE (scm_srfi60_rotate_bit_field
, "rotate-bit-field", 4, 0, 0,
139 (SCM n
, SCM count
, SCM start
, SCM end
),
140 "Return @var{n} with the bit field from @var{start} (inclusive)\n"
141 "to @var{end} (exclusive) rotated upwards by @var{count} bits.\n"
143 "@var{count} can be positive or negative, and it can be more\n"
144 "than the field width (it'll be reduced modulo the width).\n"
147 "(rotate-bit-field #b0110 2 1 4) @result{} #b1010\n"
149 #define FUNC_NAME s_scm_srfi60_rotate_bit_field
151 unsigned long ss
= scm_to_ulong (start
);
152 unsigned long ee
= scm_to_ulong (end
);
153 unsigned long ww
, cc
;
155 SCM_ASSERT_RANGE (3, end
, (ee
>= ss
));
158 cc
= scm_to_ulong (scm_modulo (count
, scm_difference (end
, start
)));
162 long nn
= SCM_I_INUM (n
);
164 if (ee
<= SCM_LONG_BIT
-1)
166 /* all within a long */
167 long below
= nn
& ((1L << ss
) - 1); /* before start */
168 long above
= nn
& (-1L << ee
); /* above end */
169 long fmask
= (-1L << ss
) & ((1L << ee
) - 1); /* field mask */
170 long ff
= nn
& fmask
; /* field */
172 return scm_from_long (above
173 | ((ff
<< cc
) & fmask
)
174 | ((ff
>> (ww
-cc
)) & fmask
)
179 /* either no movement, or a field of only 0 or 1 bits, result
180 unchanged, avoid creating a bignum */
181 if (cc
== 0 || ww
<= 1)
184 n
= scm_i_long2big (nn
);
188 else if (SCM_BIGP (n
))
193 /* either no movement, or in a field of only 0 or 1 bits, result
194 unchanged, avoid creating a new bignum */
195 if (cc
== 0 || ww
<= 1)
199 r
= scm_i_ulong2big (0);
202 /* portion above end */
203 mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (n
), ee
);
204 mpz_mul_2exp (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), ee
);
206 /* field high part, width-count bits from start go to start+count */
207 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
208 mpz_fdiv_r_2exp (tmp
, tmp
, ww
- cc
);
209 mpz_mul_2exp (tmp
, tmp
, ss
+ cc
);
210 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
212 /* field high part, count bits from end-count go to start */
213 mpz_fdiv_q_2exp (tmp
, SCM_I_BIG_MPZ (n
), ee
- cc
);
214 mpz_fdiv_r_2exp (tmp
, tmp
, cc
);
215 mpz_mul_2exp (tmp
, tmp
, ss
);
216 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
218 /* portion below start */
219 mpz_fdiv_r_2exp (tmp
, SCM_I_BIG_MPZ (n
), ss
);
220 mpz_ior (SCM_I_BIG_MPZ (r
), SCM_I_BIG_MPZ (r
), tmp
);
224 /* bits moved around might leave us in range of an inum */
225 return scm_i_normbig (r
);
228 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
233 SCM_DEFINE (scm_srfi60_reverse_bit_field
, "reverse-bit-field", 3, 0, 0,
234 (SCM n
, SCM start
, SCM end
),
235 "Return @var{n} with the bits between @var{start} (inclusive) to\n"
236 "@var{end} (exclusive) reversed.\n"
239 "(reverse-bit-field #b101001 2 4) @result{} #b100101\n"
241 #define FUNC_NAME s_scm_srfi60_reverse_bit_field
243 long ss
= scm_to_long (start
);
244 long ee
= scm_to_long (end
);
245 long swaps
= (ee
- ss
) / 2; /* number of swaps */
250 long nn
= SCM_I_INUM (n
);
252 if (ee
<= SCM_LONG_BIT
-1)
254 /* all within a long */
255 long smask
= 1L << ss
;
256 long emask
= 1L << (ee
-1);
257 for ( ; swaps
> 0; swaps
--)
259 long sbit
= nn
& smask
;
260 long ebit
= nn
& emask
;
261 nn
^= sbit
^ (ebit
? smask
: 0) /* zap sbit, put ebit value */
262 ^ ebit
^ (sbit
? emask
: 0); /* zap ebit, put sbit value */
267 return scm_from_long (nn
);
271 /* avoid creating a new bignum if reversing only 0 or 1 bits */
275 b
= scm_i_long2big (nn
);
279 else if (SCM_BIGP (n
))
281 /* avoid creating a new bignum if reversing only 0 or 1 bits */
285 b
= scm_i_clonebig (n
, 1);
289 for ( ; swaps
> 0; swaps
--)
291 int sbit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ss
);
292 int ebit
= mpz_tstbit (SCM_I_BIG_MPZ (b
), ee
);
295 /* the two bits are different, flip them */
298 mpz_clrbit (SCM_I_BIG_MPZ (b
), ss
);
299 mpz_setbit (SCM_I_BIG_MPZ (b
), ee
);
303 mpz_setbit (SCM_I_BIG_MPZ (b
), ss
);
304 mpz_clrbit (SCM_I_BIG_MPZ (b
), ee
);
310 /* swapping zero bits into the high might make us fit a fixnum */
311 return scm_i_normbig (b
);
314 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
319 SCM_DEFINE (scm_srfi60_integer_to_list
, "integer->list", 1, 1, 0,
321 "Return bits from @var{n} in the form of a list of @code{#t} for\n"
322 "1 and @code{#f} for 0. The least significant @var{len} bits\n"
323 "are returned, and the first list element is the most\n"
324 "significant of those bits. If @var{len} is not given, the\n"
325 "default is @code{(integer-length @var{n})} (@pxref{Bitwise\n"
329 "(integer->list 6) @result{} (#t #t #f)\n"
330 "(integer->list 1 4) @result{} (#f #f #f #t)\n"
332 #define FUNC_NAME s_scm_srfi60_integer_to_list
337 if (SCM_UNBNDP (len
))
338 len
= scm_integer_length (n
);
339 ll
= scm_to_ulong (len
);
343 long nn
= SCM_I_INUM (n
);
344 for (i
= 0; i
< ll
; i
++)
346 unsigned long shift
=
347 (i
< ((unsigned long) SCM_LONG_BIT
-1))
348 ? i
: ((unsigned long) SCM_LONG_BIT
-1);
349 int bit
= (nn
>> shift
) & 1;
350 ret
= scm_cons (scm_from_bool (bit
), ret
);
353 else if (SCM_BIGP (n
))
355 for (i
= 0; i
< ll
; i
++)
356 ret
= scm_cons (scm_from_bool (mpz_tstbit (SCM_I_BIG_MPZ (n
), i
)),
358 scm_remember_upto_here_1 (n
);
361 SCM_WRONG_TYPE_ARG (SCM_ARG1
, n
);
368 SCM_DEFINE (scm_srfi60_list_to_integer
, "list->integer", 1, 0, 0,
370 "Return an integer formed bitwise from the given @var{lst} list\n"
371 "of booleans. Each boolean is @code{#t} for a 1 and @code{#f}\n"
372 "for a 0. The first element becomes the most significant bit in\n"
376 "(list->integer '(#t #f #t #f)) @result{} 10\n"
378 #define FUNC_NAME s_scm_srfi60_list_to_integer
382 /* strip high zero bits from lst; after this the length tells us whether
383 an inum or bignum is required */
384 while (scm_is_pair (lst
) && scm_is_false (SCM_CAR (lst
)))
387 SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1
, lst
, len
);
389 if (len
<= SCM_I_FIXNUM_BIT
- 1)
391 /* fits an inum (a positive inum) */
393 while (scm_is_pair (lst
))
396 if (! scm_is_false (SCM_CAR (lst
)))
400 return SCM_I_MAKINUM (n
);
405 SCM n
= scm_i_ulong2big (0);
406 while (scm_is_pair (lst
))
409 if (! scm_is_false (SCM_CAR (lst
)))
410 mpz_setbit (SCM_I_BIG_MPZ (n
), len
);
419 /* note: don't put "scm_srfi60_list_to_integer" arg on its own line, a
420 newline breaks the snarfer */
421 SCM_REGISTER_PROC (s_srfi60_booleans_to_integer
, "booleans->integer", 0, 0, 1, scm_srfi60_list_to_integer
);
425 scm_register_srfi_60 (void)
427 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
429 (scm_t_extension_init_func
)scm_init_srfi_60
, NULL
);
433 scm_init_srfi_60 (void)
435 #ifndef SCM_MAGIC_SNARFER
436 #include "libguile/srfi-60.x"