move srfi-1 and srfi-60 C impl to libguile, without public C api

* libguile/srfi-1.c:
* libguile/srfi-1.h:
* libguile/srfi-60.c:
* libguile/srfi-60.h:
* libguile/ChangeLog-srfi: Move here, from the srfi/ dir. The C API is
  internal. Add API to register the extensions, called by init.c.

* libguile/init.c: Verily, register srfi extensions.

* libguile/Makefile.am: Add srfi files.

* module/srfi/srfi-1.scm:
* module/srfi/srfi-60.scm: Update load-extension invocation.

* Makefile.am:
* configure.ac: Remove srfi/ dir.

* test-suite/standalone/Makefile.am:
* test-suite/standalone/test-srfi-1.c: Remove srfi-1 C test, we don't
  support this API any more.

1 files changed, 438 insertions, 0 deletions

diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c
new file mode 100644
index 000000000..264f4cbd5
--- /dev/null
+++ b/libguile/srfi-60.c
@@ -0,0 +1,438 @@
+/* srfi-60.c --- Integers as Bits
+ *
+ * Copyright (C) 2005, 2006, 2008, 2010 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/eq.h"
+
+#include "libguile/validate.h"
+#include "libguile/numbers.h"
+
+#include "libguile/srfi-60.h"
+
+
+SCM_DEFINE (scm_srfi60_log2_binary_factors, "log2-binary-factors", 1, 0, 0,
+            (SCM n),
+	    "Return a count of how many factors of 2 are present in @var{n}.\n"
+	    "This is also the bit index of the lowest 1 bit in @var{n}.  If\n"
+	    "@var{n} is 0, the return is @math{-1}.\n"
+	    "\n"
+	    "@example\n"
+	    "(log2-binary-factors 6) @result{} 1\n"
+	    "(log2-binary-factors -8) @result{} 3\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_log2_binary_factors
+{
+  SCM ret = SCM_EOL;
+
+  if (SCM_I_INUMP (n))
+    {
+      long nn = SCM_I_INUM (n);
+      if (nn == 0)
+        return SCM_I_MAKINUM (-1);
+      nn = nn ^ (nn-1);  /* 1 bits for each low 0 and lowest 1 */
+      return scm_logcount (SCM_I_MAKINUM (nn >> 1));
+    }
+  else if (SCM_BIGP (n))
+    {
+      /* no need for scm_remember_upto_here_1 here, mpz_scan1 doesn't do
+         anything that could result in a gc */
+      return SCM_I_MAKINUM (mpz_scan1 (SCM_I_BIG_MPZ (n), 0L));
+    }
+  else
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
+            (SCM index, SCM n, SCM bit),
+	    "Return @var{n} with the bit at @var{index} set according to\n"
+	    "@var{newbit}.  @var{newbit} should be @code{#t} to set the bit\n"
+	    "to 1, or @code{#f} to set it to 0.  Bits other than at\n"
+	    "@var{index} are unchanged in the return.\n"
+	    "\n"
+	    "@example\n"
+	    "(copy-bit 1 #b0101 #t) @result{} 7\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_copy_bit
+{
+  SCM r;
+  unsigned long ii;
+  int bb;
+
+  ii = scm_to_ulong (index);
+  bb = scm_to_bool (bit);
+
+  if (SCM_I_INUMP (n))
+    {
+      long nn = SCM_I_INUM (n);
+
+      /* can't set high bit ii==SCM_LONG_BIT-1, that would change the sign,
+         which is not what's wanted */
+      if (ii < SCM_LONG_BIT-1)
+        {
+          nn &= ~(1L << ii);  /* zap bit at index */
+          nn |= ((long) bb << ii);   /* insert desired bit */
+          return scm_from_long (nn);
+        }
+      else
+        {
+          /* bits at ii==SCM_LONG_BIT-1 and above are all copies of the sign
+             bit, if this is already the desired "bit" value then no need to
+             make a new bignum value */
+          if (bb == (nn < 0))
+            return n;
+
+          r = scm_i_long2big (nn);
+          goto big;
+        }
+    }
+  else if (SCM_BIGP (n))
+    {
+      /* if the bit is already what's wanted then no need to make a new
+         bignum */
+      if (bb == mpz_tstbit (SCM_I_BIG_MPZ (n), ii))
+        return n;
+
+      r = scm_i_clonebig (n, 1);
+    big:
+      if (bb)
+        mpz_setbit (SCM_I_BIG_MPZ (r), ii);
+      else
+        mpz_clrbit (SCM_I_BIG_MPZ (r), ii);
+
+      /* changing a high bit might put the result into range of a fixnum */
+      return scm_i_normbig (r);
+    }
+  else
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
+            (SCM n, SCM count, SCM start, SCM end),
+	    "Return @var{n} with the bit field from @var{start} (inclusive)\n"
+	    "to @var{end} (exclusive) rotated upwards by @var{count} bits.\n"
+	    "\n"
+	    "@var{count} can be positive or negative, and it can be more\n"
+	    "than the field width (it'll be reduced modulo the width).\n"
+	    "\n"
+	    "@example\n"
+	    "(rotate-bit-field #b0110 2 1 4) @result{} #b1010\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_rotate_bit_field
+{
+  unsigned long ss = scm_to_ulong (start);
+  unsigned long ee = scm_to_ulong (end);
+  unsigned long ww, cc;
+
+  SCM_ASSERT_RANGE (3, end, (ee >= ss));
+  ww = ee - ss;
+
+  cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
+
+  if (SCM_I_INUMP (n))
+    {
+      long nn = SCM_I_INUM (n);
+
+      if (ee <= SCM_LONG_BIT-1)
+        {
+          /* all within a long */
+          long below = nn & ((1L << ss) - 1);  /* before start */
+          long above = nn & (-1L << ee);       /* above end */
+          long fmask = (-1L << ss) & ((1L << ee) - 1);  /* field mask */
+          long ff = nn & fmask;                /* field */
+
+          return scm_from_long (above
+                                | ((ff << cc) & fmask)
+                                | ((ff >> (ww-cc)) & fmask)
+                                | below);
+        }
+      else
+        {
+          /* either no movement, or a field of only 0 or 1 bits, result
+             unchanged, avoid creating a bignum */
+          if (cc == 0 || ww <= 1)
+            return n;
+
+          n = scm_i_long2big (nn);
+          goto big;
+        }
+    }
+  else if (SCM_BIGP (n))
+    {
+      mpz_t tmp;
+      SCM r;
+
+      /* either no movement, or in a field of only 0 or 1 bits, result
+         unchanged, avoid creating a new bignum */
+      if (cc == 0 || ww <= 1)
+        return n;
+
+    big:
+      r = scm_i_ulong2big (0);
+      mpz_init (tmp);
+
+      /* portion above end */
+      mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (n), ee);
+      mpz_mul_2exp (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), ee);
+
+      /* field high part, width-count bits from start go to start+count */
+      mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ss);
+      mpz_fdiv_r_2exp (tmp, tmp, ww - cc);
+      mpz_mul_2exp (tmp, tmp, ss + cc);
+      mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+
+      /* field high part, count bits from end-count go to start */
+      mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ee - cc);
+      mpz_fdiv_r_2exp (tmp, tmp, cc);
+      mpz_mul_2exp (tmp, tmp, ss);
+      mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+
+      /* portion below start */
+      mpz_fdiv_r_2exp (tmp, SCM_I_BIG_MPZ (n), ss);
+      mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+
+      mpz_clear (tmp);
+
+      /* bits moved around might leave us in range of an inum */
+      return scm_i_normbig (r);
+    }
+  else
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0,
+            (SCM n, SCM start, SCM end),
+	    "Return @var{n} with the bits between @var{start} (inclusive) to\n"
+	    "@var{end} (exclusive) reversed.\n"
+	    "\n"
+	    "@example\n"
+	    "(reverse-bit-field #b101001 2 4) @result{} #b100101\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_reverse_bit_field
+{
+  long ss = scm_to_long (start);
+  long ee = scm_to_long (end);
+  long swaps = (ee - ss) / 2;  /* number of swaps */
+  SCM b;
+
+  if (SCM_I_INUMP (n))
+    {
+      long nn = SCM_I_INUM (n);
+
+      if (ee <= SCM_LONG_BIT-1)
+        {
+          /* all within a long */
+          long smask = 1L << ss;
+          long emask = 1L << (ee-1);
+          for ( ; swaps > 0; swaps--)
+            {
+              long sbit = nn & smask;
+              long ebit = nn & emask;
+              nn ^= sbit ^ (ebit ? smask : 0)  /* zap sbit, put ebit value */
+                ^   ebit ^ (sbit ? emask : 0); /* zap ebit, put sbit value */
+
+              smask <<= 1;
+              emask >>= 1;
+            }
+          return scm_from_long (nn);
+        }
+      else
+        {
+          /* avoid creating a new bignum if reversing only 0 or 1 bits */
+          if (ee - ss <= 1)
+            return n;
+
+          b = scm_i_long2big (nn);
+          goto big;
+        }
+    }
+  else if (SCM_BIGP (n))
+    {
+      /* avoid creating a new bignum if reversing only 0 or 1 bits */
+      if (ee - ss <= 1)
+        return n;
+
+      b = scm_i_clonebig (n, 1);
+    big:
+
+      ee--;
+      for ( ; swaps > 0; swaps--)
+        {
+          int sbit = mpz_tstbit (SCM_I_BIG_MPZ (b), ss);
+          int ebit = mpz_tstbit (SCM_I_BIG_MPZ (b), ee);
+          if (sbit ^ ebit)
+            {
+              /* the two bits are different, flip them */
+              if (sbit)
+                {
+                  mpz_clrbit (SCM_I_BIG_MPZ (b), ss);
+                  mpz_setbit (SCM_I_BIG_MPZ (b), ee);
+                }
+              else
+                {
+                  mpz_setbit (SCM_I_BIG_MPZ (b), ss);
+                  mpz_clrbit (SCM_I_BIG_MPZ (b), ee);
+                }
+            }
+          ss++;
+          ee--;
+        }
+      /* swapping zero bits into the high might make us fit a fixnum */
+      return scm_i_normbig (b);
+    }
+  else
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0,
+            (SCM n, SCM len),
+	    "Return bits from @var{n} in the form of a list of @code{#t} for\n"
+	    "1 and @code{#f} for 0.  The least significant @var{len} bits\n"
+	    "are returned, and the first list element is the most\n"
+	    "significant of those bits.  If @var{len} is not given, the\n"
+	    "default is @code{(integer-length @var{n})} (@pxref{Bitwise\n"
+	    "Operations}).\n"
+	    "\n"
+	    "@example\n"
+	    "(integer->list 6)   @result{} (#t #t #f)\n"
+	    "(integer->list 1 4) @result{} (#f #f #f #t)\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_integer_to_list
+{
+  SCM ret = SCM_EOL;
+  unsigned long ll, i;
+
+  if (SCM_UNBNDP (len))
+    len = scm_integer_length (n);
+  ll = scm_to_ulong (len);
+
+  if (SCM_I_INUMP (n))
+    {
+      long nn = SCM_I_INUM (n);
+      for (i = 0; i < ll; i++)
+        {
+          unsigned long shift =
+	    (i < ((unsigned long) SCM_LONG_BIT-1)) 
+	    ? i : ((unsigned long) SCM_LONG_BIT-1);
+          int bit = (nn >> shift) & 1;
+          ret = scm_cons (scm_from_bool (bit), ret);
+        }
+    }
+  else if (SCM_BIGP (n))
+    {
+      for (i = 0; i < ll; i++)
+        ret = scm_cons (scm_from_bool (mpz_tstbit (SCM_I_BIG_MPZ (n), i)),
+                        ret);
+      scm_remember_upto_here_1 (n);
+    }
+  else
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_srfi60_list_to_integer, "list->integer", 1, 0, 0,
+            (SCM lst),
+	    "Return an integer formed bitwise from the given @var{lst} list\n"
+	    "of booleans.  Each boolean is @code{#t} for a 1 and @code{#f}\n"
+	    "for a 0.  The first element becomes the most significant bit in\n"
+	    "the return.\n"
+	    "\n"
+	    "@example\n"
+	    "(list->integer '(#t #f #t #f)) @result{} 10\n"
+	    "@end example")
+#define FUNC_NAME s_scm_srfi60_list_to_integer
+{
+  long len;
+
+  /* strip high zero bits from lst; after this the length tells us whether
+     an inum or bignum is required */
+  while (scm_is_pair (lst) && scm_is_false (SCM_CAR (lst)))
+    lst = SCM_CDR (lst);
+
+  SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, len);
+
+  if (len <= SCM_I_FIXNUM_BIT - 1)
+    {
+      /* fits an inum (a positive inum) */
+      long n = 0;
+      while (scm_is_pair (lst))
+        {
+          n <<= 1;
+          if (! scm_is_false (SCM_CAR (lst)))
+            n++;
+          lst = SCM_CDR (lst);
+        }
+      return SCM_I_MAKINUM (n);
+    }
+  else
+    {
+      /* need a bignum */
+      SCM n = scm_i_ulong2big (0);
+      while (scm_is_pair (lst))
+        {
+          len--;
+          if (! scm_is_false (SCM_CAR (lst)))
+            mpz_setbit (SCM_I_BIG_MPZ (n), len);
+          lst = SCM_CDR (lst);
+        }
+      return n;
+    }
+}
+#undef FUNC_NAME
+
+
+/* note: don't put "scm_srfi60_list_to_integer" arg on its own line, a
+   newline breaks the snarfer */
+SCM_REGISTER_PROC (s_srfi60_booleans_to_integer, "booleans->integer", 0, 0, 1, scm_srfi60_list_to_integer);
+
+
+void
+scm_register_srfi_60 (void)
+{
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_srfi_60",
+                            (scm_t_extension_init_func)scm_init_srfi_60, NULL);
+}
+
+void
+scm_init_srfi_60 (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/srfi-60.x"
+#endif
+}