* demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/test.pl: Add

	get_d_2exp.
	* demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/GMP/Rand.pm,
	demos/perl/test.pl: Add gmp_urandomb_ui, gmp_urandomm_ui.
	(GMP::Rand::randstate): Accept a randstate object to copy.
	* demos/perl/GMP.xs, demos/perl/GMP.pm, demos/perl/GMP/Mpz.pm,
	demos/perl/test.pl: Add combit, rootrem.

3 files changed, 266 insertions, 69 deletions

diff --git a/demos/perl/GMP.pm b/demos/perl/GMP.pm
index 3d53cb8f8..05626714f 100644
--- a/demos/perl/GMP.pm
+++ b/demos/perl/GMP.pm
@@ -1,6 +1,6 @@
 # GMP perl module
 
-# Copyright 2001, 2002 Free Software Foundation, Inc.
+# Copyright 2001, 2002, 2003 Free Software Foundation, Inc.
 #
 # This file is part of the GNU MP Library.
 #
@@ -32,8 +32,9 @@ require DynaLoader;
 
 @EXPORT = qw();
 @EXPORT_OK = qw(version);
-%EXPORT_TAGS = ('all' => [qw(get_d get_si get_str integer_p printf sgn
-                             sprintf)],
+%EXPORT_TAGS = ('all' => [qw(
+                             get_d get_d_2exp get_si get_str integer_p
+                             printf sgn sprintf)],
 		'constants' => [()]);
 Exporter::export_ok_tags('all');
 
@@ -174,12 +175,12 @@ corresponding GMP mpz functions,
 
 =item
 
-bin, cdiv, cdiv_2exp, clrbit, congruent_p, congruent_2exp_p, divexact,
-divisible_p, divisible_2exp_p, even_p, fac, fdiv, fdiv_2exp, fib, fib2, gcd,
-gcdext, hamdist, invert, jacobi, kronecker, lcm, lucnum, lucnum2, mod,
-mpz_export, mpz_import, nextprime, odd_p, perfect_power_p, perfect_square_p,
-popcount, powm, probab_prime_p, realloc, remove, root, roote, scan0, scan1,
-setbit, sizeinbase, sqrtrem, tdiv, tdiv_2exp, tstbit
+bin, cdiv, cdiv_2exp, clrbit, combit, congruent_p, congruent_2exp_p,
+divexact, divisible_p, divisible_2exp_p, even_p, fac, fdiv, fdiv_2exp, fib,
+fib2, gcd, gcdext, hamdist, invert, jacobi, kronecker, lcm, lucnum, lucnum2,
+mod, mpz_export, mpz_import, nextprime, odd_p, perfect_power_p,
+perfect_square_p, popcount, powm, probab_prime_p, realloc, remove, root,
+roote, scan0, scan1, setbit, sizeinbase, sqrtrem, tdiv, tdiv_2exp, tstbit
 
 =back
 
@@ -205,16 +206,16 @@ functions.  The string input for C<mpz_import> is interpreted as byte data
 and must be a multiple of size bytes.  C<mpz_export> conversely returns a
 string of byte data, which will be a multiple of size bytes.
 
-C<invert> returns the inverse, or undef if it doesn't exist.
-C<remove> returns a remainder/multiplicty pair.  C<root> returns the
-nth root, and C<roote> returns a root/bool pair, the bool indicating
-whether the root is exact.  C<sqrtrem> returns a root/remainder pair.
+C<invert> returns the inverse, or undef if it doesn't exist.  C<remove>
+returns a remainder/multiplicty pair.  C<root> returns the nth root, and
+C<roote> returns a root/bool pair, the bool indicating whether the root is
+exact.  C<sqrtrem> and C<rootrem> return a root/remainder pair.
 
-C<clrbit> and C<setbit> expect a variable which they can modify, it doesn't
-make sense to pass a literal constant.  Only the given variable is modified,
-if other variables are referencing the same mpz object then a new copy is
-made of it.  If the variable isn't an mpz it will be coerced to one.  For
-instance,
+C<clrbit>, C<combit> and C<setbit> expect a variable which they can modify,
+it doesn't make sense to pass a literal constant.  Only the given variable
+is modified, if other variables are referencing the same mpz object then a
+new copy is made of it.  If the variable isn't an mpz it will be coerced to
+one.  For instance,
 
     use GMP::Mpz qw(setbit);
     setbit (123, 0);  # wrong, don't pass a constant
@@ -345,25 +346,30 @@ The following functions are available in the GMP class,
 
 =item
 
-fits_slong_p, get_d, get_si, get_str, integer_p, printf, sgn, sprintf,
-version
+fits_slong_p, get_d, get_d_2exp, get_si, get_str, integer_p, printf, sgn,
+sprintf, version
 
 =back
 
-C<get_str> accepts an integer, string, float, mpz, mpq or mpf.  The base is
-specified by an optional second parameter, or defaults to decimal.  A
-negative base means upper case, as per the C functions.  For integer,
-integer string, mpz or mpq operands a string is returned.  For example,
+C<get_d_2exp> accepts any integer, string, float, mpz, mpq or mpf operands
+and returns a float and an integer exponent,
+
+    ($dbl, $exp) = get_d_2exp (mpf ("3.0"));
+    # dbl is 0.75, exp is 2
+
+C<get_str> takes an optional second argument which is the base, defaulting
+to decimal.  A negative base means upper case, as per the C functions.  For
+integer, -integer string, mpz or mpq operands a string is returned.
 
     use GMP qw(:all);
     use GMP::Mpq qw(:all);
     print get_str(mpq(-5,8)),"\n";      # -5/8
     print get_str(255,16),"\n";         # ff
 
-For float, float strings or mpf operands C<get_str> accepts an optional
-third parameter being how many digits to produce, which defaults to 0
-meaning all digits.  No more digits than can be accurately represented by
-the float precision are ever produced though.  A string/exponent pair is
+For float, float strings or mpf operands, C<get_str> accepts an optional
+third parameter being how many digits to produce, defaulting to 0 which
+means all digits.  (Only as many digits as can be accurately represented by
+the float precision are ever produced though.)  A string/exponent pair is
 returned, as per the C mpf_get_str function.  For example,
 
     use GMP qw(:all);
@@ -424,12 +430,14 @@ generation.  C<randstate> creates a new object, for example,
     $r = randstate('lc_2exp_size', 64);
     $r = randstate('lc_2exp', 43840821, 1, 32);
     $r = randstate('mt');
+    $r = randstate($another_r);
 
 With no parameters this corresponds to the C function
 C<gmp_randinit_default>, and is a compromise between speed and randomness.
 'lc_2exp_size' corresponds to C<gmp_randinit_lc_2exp_size>, 'lc_2exp'
 corresponds to C<gmp_randinit_lc_2exp>, and 'mt' corresponds to
-C<gmp_randinit_mt>.
+C<gmp_randinit_mt>.  Or when passed another randstate object, a copy of that
+object is made.
 
 'lc_2exp_size' can fail if the requested size is bigger than the internal
 table provides for, in which case undef is returned.  The maximum size
@@ -447,7 +455,8 @@ Random numbers can be generated with the following functions,
 
 =item
 
-mpf_urandomb, mpz_rrandomb, mpz_urandomb, mpz_urandomm
+mpf_urandomb, mpz_rrandomb, mpz_urandomb, mpz_urandomm,
+gmp_urandomb_ui, gmp_urandomm_ui
 
 =back
 
@@ -456,10 +465,11 @@ corresponding GMP function.  For example,
 
     use GMP::Rand (:all);
     $r = randstate();
-    $a = mpz_urandomb($r,256);         # uniform, 256 bits
-    $b = mpz_urandomm($r,mpz(3)**100); # uniform, 0 to 3**100-1
-    $c = mpz_rrandomb($r,1024);        # special, 1024 bits
-    $f = mpf_urandomb($r,128);         # uniform, 128 bits, 0<=$f<1
+    $a = mpz_urandomb($r,256);         # uniform mpz, 256 bits
+    $b = mpz_urandomm($r,mpz(3)**100); # uniform mpz, 0 to 3**100-1
+    $c = mpz_rrandomb($r,1024);        # special mpz, 1024 bits
+    $f = mpf_urandomb($r,128);         # uniform mpf, 128 bits, 0<=$f<1
+    $f = gmp_urandomm_ui($r,56);       # uniform int, 0 to 55
 
 =head2 Coercion
 
diff --git a/demos/perl/GMP.xs b/demos/perl/GMP.xs
index 234b92908..46bc4d75d 100644
--- a/demos/perl/GMP.xs
+++ b/demos/perl/GMP.xs
@@ -1,6 +1,6 @@
 /* GMP module external subroutines.
 
-Copyright 2001, 2002 Free Software Foundation, Inc.
+Copyright 2001, 2002, 2003 Free Software Foundation, Inc.
 
 This file is part of the GNU MP Library.
 
@@ -839,6 +839,60 @@ OUTPUT:
     RETVAL
 
 
+void
+get_d_2exp (sv)
+    SV *sv
+PREINIT:
+    double ret;
+    long   exp;
+PPCODE:
+    if (SvIOK(sv))
+      {
+        ret = (double) SvIVX(sv);
+        goto use_frexp;
+      }
+    else if (SvNOK(sv))
+      {
+        int i_exp;
+        ret = SvNVX(sv);
+      use_frexp:
+        ret = frexp (ret, &i_exp);
+        exp = i_exp;
+      }
+    else if (SvPOKorp(sv))
+      {
+        /* put strings through mpf to give full exp range */
+        tmp_mpf_set_prec (tmp_mpf_0, DBL_MANT_DIG);
+        my_mpf_set_svstr (tmp_mpf_0->m, sv);
+        ret = mpf_get_d_2exp (&exp, tmp_mpf_0->m);
+      }
+    else if (SvROK(sv))
+      {
+        if (sv_derived_from (sv, mpz_class))
+          ret = mpz_get_d_2exp (&exp, SvMPZ(sv)->m);
+        else if (sv_derived_from (sv, mpq_class))
+          {
+            tmp_mpf_set_prec (tmp_mpf_0, DBL_MANT_DIG);
+            mpf_set_q (tmp_mpf_0->m, SvMPQ(sv)->m);
+            ret = mpf_get_d_2exp (&exp, tmp_mpf_0->m);
+          }
+        else if (sv_derived_from (sv, mpf_class))
+          {
+            ret = mpf_get_d_2exp (&exp, SvMPF(sv));
+            printf ("exp %d\n", exp);
+          }
+        else
+          goto invalid;
+      }
+    else
+      {
+      invalid:
+        croak ("GMP::get_d_2exp invalid argument");
+      }
+    PUSHs (sv_2mortal (newSVnv (ret)));
+    PUSHs (sv_2mortal (newSViv (exp)));
+
+
 long
 get_si (sv)
     SV *sv
@@ -1874,6 +1928,23 @@ PPCODE:
     sv = (exact ? &PL_sv_yes : &PL_sv_no); sv_2mortal(sv); PUSHs(sv);
 
 
+void
+rootrem (z, n)
+    mpz_coerce   z
+    ulong_coerce n
+PREINIT:
+    SV  *sv;
+    mpz root;
+    mpz rem;
+PPCODE:
+    root = new_mpz();
+    rem = new_mpz();
+    mpz_rootrem (root->m, rem->m, z, n);
+    EXTEND (SP, 2);
+    sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, root); PUSHs(sv);
+    sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, rem);  PUSHs(sv);
+
+
 unsigned long
 scan0 (z, start)
     mpz_coerce   z
@@ -1900,15 +1971,16 @@ setbit (z, bit)
     ulong_coerce bit
 ALIAS:
     GMP::Mpz::clrbit = 1
+    GMP::Mpz::combit = 2
 PREINIT:
     static const struct {
       void (*op) (mpz_ptr, unsigned long);
     } table[] = {
       { mpz_setbit }, /* 0 */
       { mpz_clrbit }, /* 1 */
+      { mpz_combit }, /* 2 */
     };
 CODE:
-    TRACE (printf ("%s %s\n", mpz_class, (ix==0 ? "setbit" : "clrbit")));
     assert (SvROK(ST(0)) && SvREFCNT(SvRV(ST(0))) == 1);
     assert_table (ix);
     (*table[ix].op) (z, bit);
@@ -2665,38 +2737,47 @@ CODE:
       }
     else
       {
-        STRLEN      len;
-        const char  *method = SvPV (ST(0), len);
-        assert (len == strlen (method));
-        if (strcmp (method, "lc_2exp") == 0)
-          {
-            if (items != 4)
-              goto invalid;
-            gmp_randinit_lc_2exp (RETVAL,
-                                  coerce_mpz (tmp_mpz_0, ST(1)),
-                                  coerce_ulong (ST(2)),
-                                  coerce_ulong (ST(3)));
-          }
-        else if (strcmp (method, "lc_2exp_size") == 0)
-          {
-            if (items != 2)
-              goto invalid;
-            if (! gmp_randinit_lc_2exp_size (RETVAL, coerce_ulong (ST(1))))
-              {
-                Safefree (RETVAL);
-                XSRETURN_UNDEF;
-              }
-          }
-        else if (strcmp (method, "mt") == 0)
+        if (SvROK (ST(0)) && sv_derived_from (ST(0), rand_class))
           {
             if (items != 1)
               goto invalid;
-            gmp_randinit_mt (RETVAL);
+            gmp_randinit_set (RETVAL, SvRANDSTATE (ST(0)));
           }
         else
           {
-          invalid:
-            croak ("%s new: invalid arguments", rand_class);
+            STRLEN      len;
+            const char  *method = SvPV (ST(0), len);
+            assert (len == strlen (method));
+            if (strcmp (method, "lc_2exp") == 0)
+              {
+                if (items != 4)
+                  goto invalid;
+                gmp_randinit_lc_2exp (RETVAL,
+                                      coerce_mpz (tmp_mpz_0, ST(1)),
+                                      coerce_ulong (ST(2)),
+                                      coerce_ulong (ST(3)));
+              }
+            else if (strcmp (method, "lc_2exp_size") == 0)
+              {
+                if (items != 2)
+                  goto invalid;
+                if (! gmp_randinit_lc_2exp_size (RETVAL, coerce_ulong (ST(1))))
+                  {
+                    Safefree (RETVAL);
+                    XSRETURN_UNDEF;
+                  }
+              }
+            else if (strcmp (method, "mt") == 0)
+              {
+                if (items != 1)
+                  goto invalid;
+                gmp_randinit_mt (RETVAL);
+              }
+            else
+              {
+              invalid:
+                croak ("%s new: invalid arguments", rand_class);
+              }
           }
       }
 OUTPUT:
@@ -2763,3 +2844,23 @@ CODE:
     mpf_urandomb (RETVAL, r, bits);
 OUTPUT:
     RETVAL
+
+
+unsigned long
+gmp_urandomb_ui (r, bits)
+    randstate    r
+    ulong_coerce bits
+ALIAS:
+    GMP::Rand::gmp_urandomm_ui = 1
+PREINIT:
+    static const struct {
+      unsigned long (*fun) (gmp_randstate_t r, unsigned long bits);
+    } table[] = {
+      { gmp_urandomb_ui }, /* 0 */
+      { gmp_urandomm_ui }, /* 1 */
+    };
+CODE:
+    assert_table (ix);
+    RETVAL = (*table[ix].fun) (r, bits);
+OUTPUT:
+    RETVAL
diff --git a/demos/perl/test.pl b/demos/perl/test.pl
index 132271163..007bdc3f4 100644
--- a/demos/perl/test.pl
+++ b/demos/perl/test.pl
@@ -1,6 +1,6 @@
 # GMP perl module tests
 
-# Copyright 2001, 2002 Free Software Foundation, Inc.
+# Copyright 2001, 2002, 2003 Free Software Foundation, Inc.
 #
 # This file is part of the GNU MP Library.
 #
@@ -230,6 +230,25 @@ foreach my $x (-123, -1, 0, 1, 123) {
   }
 }
 
+{ my ($dbl, $exp) = get_d_2exp (0);
+  ok ($dbl == 0); ok ($exp == 0); }
+{ my ($dbl, $exp) = get_d_2exp (1);
+  ok ($dbl == 0.5); ok ($exp == 1); }
+{ my ($dbl, $exp) = get_d_2exp (0.5);
+  ok ($dbl == 0.5); ok ($exp == 0); }
+{ my ($dbl, $exp) = get_d_2exp (0.25);
+  ok ($dbl == 0.5); ok ($exp == -1); }
+{ my ($dbl, $exp) = get_d_2exp ("1.0");
+  ok ($dbl == 0.5); ok ($exp == 1); }
+{ my ($dbl, $exp) = get_d_2exp (mpz ("256"));
+  ok ($dbl == 0.5); ok ($exp == 9); }
+{ my ($dbl, $exp) = get_d_2exp (mpq ("1/16"));
+  ok ($dbl == 0.5); ok ($exp == -3); }
+{ my ($dbl, $exp) = get_d_2exp (mpf ("1.5"));
+  ok ($dbl == 0.75); ok ($exp == 1); }
+{ my ($dbl, $exp) = get_d_2exp (mpf ("3.0"));
+  ok ($dbl == 0.75); ok ($exp == 2); }
+
 foreach my $xpair ([-123,"-7b"], [-1,"-1"], [0,"0"], [1,"1"], [123,"7b"]) {
   my $x = $$xpair[0];
   my $xhex = $$xpair[1];
@@ -428,7 +447,9 @@ ok (bin(3,3) == 1);
   ok ($r == -3);
 }
 
-{
+{ my $a = 3; clrbit ($a, 1); ok ($a == 1); }
+{ my $a = 3; clrbit ($a, 2); ok ($a == 3); }
+{ # mutate only given variable
   my $a = 3;
   my $b = $a;
   ok ($b == 3);
@@ -438,7 +459,23 @@ ok (bin(3,3) == 1);
   $b = $a;
   ok ($b == 2);
 }
-{
+
+{ my $a = 3; combit ($a, 1); ok ($a == 1); }
+{ my $a = 3; combit ($a, 2); ok ($a == 7); }
+{ # mutate only given variable
+  my $a = 3;
+  my $b = $a;
+  ok ($b == 3);
+  combit ($a, 0);
+  ok ($a == 2);
+  ok ($b == 3);
+  $b = $a;
+  ok ($b == 2);
+}
+
+{ my $a = 3; setbit ($a, 1); ok ($a == 3); }
+{ my $a = 3; setbit ($a, 2); ok ($a == 7); }
+{ # mutate only given variable
   my $a = 0;
   my $b = $a;
   ok ($b == 0);
@@ -683,6 +720,17 @@ ok (root(243,5) == 3);
   ok (! $e);
 }
 
+{ my ($root, $rem) = rootrem (mpz(0), 1);
+  ok ($root == 0); ok ($rem == 0); }
+{ my ($root, $rem) = rootrem (mpz(0), 2);
+  ok ($root == 0); ok ($rem == 0); }
+{ my ($root, $rem) = rootrem (mpz(64), 2);
+  ok ($root == 8); ok ($rem == 0); }
+{ my ($root, $rem) = rootrem (mpz(64), 3);
+  ok ($root == 4); ok ($rem == 0); }
+{ my ($root, $rem) = rootrem (mpz(65), 3);
+  ok ($root == 4); ok ($rem == 1); }
+
 {
   my $ulong_max = ~ 0;
   ok (scan0 (0, 0) == 0);
@@ -847,14 +895,52 @@ ok (reldiff (4,2) == 0.5);
 { my $r = randstate('lc_2exp_size', 64);        ok (defined $r); }
 { my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); }
 { my $r = randstate('mt');                      ok (defined $r); }
+
+{ # copying a randstate results in same sequence
+  my $r1 = randstate('lc_2exp_size', 64);
+  $r1->seed(123);
+  my $r2 = randstate($r1);
+  for (1 .. 20) {
+    my $z1 = mpz_urandomb($r1, 20);
+    my $z2 = mpz_urandomb($r2, 20);
+    ok ($z1 == $z2);
+  }
+}
+
+
 {
   my $r = randstate();
   $r->seed(123);
   $r->seed(time());
-  mpf_urandomb($r,1024);
-  mpz_urandomb($r,1024);
-  mpz_rrandomb($r,1024);
-  mpz_urandomm($r,mpz(3)**100);
+
+  {
+    my $f = mpf_urandomb($r,1024);
+    ok (UNIVERSAL::isa($f,"GMP::Mpf"));
+  }
+
+  {
+    my $z = mpz_urandomb($r, 1024);
+    ok (UNIVERSAL::isa($z,"GMP::Mpz"));
+  }
+  {
+    my $z = mpz_rrandomb($r, 1024);
+    ok (UNIVERSAL::isa($z,"GMP::Mpz"));
+  }
+  {
+    my $z = mpz_urandomm($r, mpz(3)**100);
+    ok (UNIVERSAL::isa($z,"GMP::Mpz"));
+  }
+  
+  foreach (1 .. 20) {
+    my $u = gmp_urandomb_ui($r,8);
+    ok ($u >= 0);
+    ok ($u < 256);
+  }
+  foreach (1 .. 20) {
+    my $u = gmp_urandomm_ui($r,8);
+    ok ($u >= 0);
+    ok ($u < 8);
+  }
 }