diff options
Diffstat (limited to 'vendor/gmp-6.3.0/demos/perl')
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP.pm | 671 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP.xs | 3212 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP/Mpf.pm | 106 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP/Mpq.pm | 89 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP/Mpz.pm | 101 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/GMP/Rand.pm | 44 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/INSTALL | 88 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/Makefile.PL | 82 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/sample.pl | 54 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/test.pl | 2179 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/test2.pl | 75 | ||||
| -rw-r--r-- | vendor/gmp-6.3.0/demos/perl/typemap | 108 |
12 files changed, 6809 insertions, 0 deletions
diff --git a/vendor/gmp-6.3.0/demos/perl/GMP.pm b/vendor/gmp-6.3.0/demos/perl/GMP.pm new file mode 100644 index 0000000..46bc707 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP.pm @@ -0,0 +1,671 @@ +# GMP perl module + +# Copyright 2001-2004 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + +# [Note: The above copyright notice is repeated in the documentation section +# below, in order to get it into man pages etc generated by the various pod +# conversions. When changing, be sure to update below too.] + + +# This code is designed to work with perl 5.005, so it and the sub-packages +# aren't as modern as they could be. + +package GMP; + +require Symbol; +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); + +@EXPORT = qw(); +@EXPORT_OK = qw(version); +%EXPORT_TAGS = ('all' => [qw( + get_d get_d_2exp get_si get_str integer_p + printf sgn sprintf)], + 'constants' => [()]); +Exporter::export_ok_tags('all'); + +$VERSION = '2.00'; +bootstrap GMP $VERSION; + + +# The format string is cut up into "%" specifiers so GMP types can be +# passed to GMP::sprintf_internal. Any "*"s are interpolated before +# calling sprintf_internal, which saves worrying about variable +# argument lists there. +# +# Because sprintf_internal is only called after the conversion and +# operand have been checked there won't be any crashes from a bad +# format string. +# +sub sprintf { + my $fmt = shift; + my $out = ''; + my ($pre, $dummy, $pat, $rest); + + while (($pre, $dummy, $pat, $rest) = ($fmt =~ /^((%%|[^%])*)(%[- +#.*hlLqv\d]*[bcdfeEgGinopsuxX])(.*)$/s)) { + + $out .= $pre; + + my $pat2 = $pat; # $pat with "*"s expanded + my @params = (); # arguments per "*"s + while ($pat2 =~ /[*]/) { + my $arg = shift; + $pat2 =~ s/[*]/$arg/; + push @params, $arg; + } + + if (UNIVERSAL::isa($_[0],"GMP::Mpz")) { + if ($pat2 !~ /[dioxX]$/) { + die "GMP::sprintf: unsupported output format for mpz: $pat2\n"; + } + $pat2 =~ s/(.)$/Z$1/; + $out .= sprintf_internal ($pat2, shift); + + } elsif (UNIVERSAL::isa($_[0],"GMP::Mpq")) { + if ($pat2 !~ /[dioxX]$/) { + die "GMP::sprintf: unsupported output format for mpq: $pat2\n"; + } + $pat2 =~ s/(.)$/Q$1/; + $out .= sprintf_internal ($pat2, shift); + + } elsif (UNIVERSAL::isa($_[0],"GMP::Mpf")) { + if ($pat2 !~ /[eEfgG]$/) { + die "GMP::sprintf: unsupported output format for mpf: $pat2\n"; + } + $pat2 =~ s/(.)$/F$1/; + $out .= sprintf_internal ($pat2, shift); + + } elsif ($pat =~ /n$/) { + # do it this way so h, l or V type modifiers are respected, and use a + # dummy variable to avoid a warning about discarding the value + my $dummy = sprintf "%s$pat", $out, $_[0]; + shift; + + } else { + $out .= sprintf $pat, @params, shift; + } + + $fmt = $rest; + } + $out .= $fmt; + return $out; +} + +sub printf { + if (ref($_[0]) eq 'GLOB') { + my $h = Symbol::qualify_to_ref(shift, caller); + print $h GMP::sprintf(@_); + } else { + print STDOUT GMP::sprintf(@_); + } +} + +1; +__END__ + + + +=head1 NAME + +GMP - Perl interface to the GNU Multiple Precision Arithmetic Library + +=head1 SYNOPSIS + + use GMP; + use GMP::Mpz; + use GMP::Mpq; + use GMP::Mpf; + use GMP::Rand; + +=head1 DESCRIPTION + +This module provides access to GNU MP arbitrary precision integers, +rationals and floating point. + +No functions are exported from these packages by default, but can be +selected in the usual way, or the tag :all for everything. + + use GMP::Mpz qw(gcd, lcm); # just these functions + use GMP::Mpq qw(:all); # everything in mpq + +=head2 GMP::Mpz + +This class provides arbitrary precision integers. A new mpz can be +constructed with C<mpz>. The initial value can be an integer, float, +string, mpz, mpq or mpf. Floats, mpq and mpf will be automatically +truncated to an integer. + + use GMP::Mpz qw(:all); + my $a = mpz(123); + my $b = mpz("0xFFFF"); + my $c = mpz(1.5); # truncated + +The following overloaded operators are available, and corresponding +assignment forms like C<+=>, + +=over 4 + +=item + ++ - * / % E<lt>E<lt> E<gt>E<gt> ** & | ^ ! E<lt> E<lt>= == != E<gt> E<gt>= +E<lt>=E<gt> abs not sqrt + +=back + +C</> and C<%> round towards zero (as per the C<tdiv> functions in GMP). + +The following functions are available, behaving the same as the +corresponding GMP mpz functions, + +=over 4 + +=item + +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 + +C<cdiv>, C<fdiv> and C<tdiv> and their C<2exp> variants return a +quotient/remainder pair. C<fib2> returns a pair F[n] and F[n-1], similarly +C<lucnum2>. C<gcd> and C<lcm> accept a variable number of arguments (one or +more). C<gcdext> returns a triplet of gcd and two cofactors, for example + + use GMP::Mpz qw(:all); + $a = 7257; + $b = 10701; + ($g, $x, $y) = gcdext ($a, $b); + print "gcd($a,$b) is $g, and $g == $a*$x + $b*$y\n"; + +C<mpz_import> and C<mpz_export> are so named to avoid the C<import> keyword. +Their parameters are as follows, + + $z = mpz_import ($order, $size, $endian, $nails, $string); + $string = mpz_export ($order, $size, $endian, $nails, $z); + +The order, size, endian and nails parameters are as per the corresponding C +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/multiplicity 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>, 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 + $a = mpz(6); + $b = $a; + setbit ($a, 0); # $a becomes 7, $b stays at 6 + +C<scan0> and C<scan1> return ~0 if no 0 or 1 bit respectively is found. + +=head2 GMP::Mpq + +This class provides rationals with arbitrary precision numerators and +denominators. A new mpq can be constructed with C<mpq>. The initial value +can be an integer, float, string, mpz, mpq or mpf, or a pair of integers or +mpz's. No precision is lost when converting a float or mpf, the exact value +is retained. + + use GMP::Mpq qw(:all); + $a = mpq(); # zero + $b = mpq(0.5); # gives 1/2 + $b = mpq(14); # integer 14 + $b = mpq(3,4); # fraction 3/4 + $b = mpq("7/12"); # fraction 7/12 + $b = mpq("0xFF/0x100"); # fraction 255/256 + +When a fraction is given, it should be in the canonical form specified in +the GMP manual, which is denominator positive, no common factors, and zero +always represented as 0/1. If not then C<canonicalize> can be called to put +it in that form. For example, + + use GMP::Mpq qw(:all); + $q = mpq(21,15); # eek! common factor 3 + canonicalize($q); # get rid of it + +The following overloaded operators are available, and corresponding +assignment forms like C<+=>, + +=over 4 + +=item + ++ - * / E<lt>E<lt> E<gt>E<gt> ** ! E<lt> E<lt>= == != E<gt> E<gt>= +E<lt>=E<gt> abs not + +=back + +The following functions are available, + +=over 4 + +=item + +den, inv, num + +=back + +C<inv> calculates 1/q, as per the corresponding GMP function. C<num> and +C<den> return an mpz copy of the numerator or denominator respectively. In +the future C<num> and C<den> might give lvalues so the original mpq can be +modified through them, but this is not done currently. + +=head2 GMP::Mpf + +This class provides arbitrary precision floating point numbers. The +mantissa is an arbitrary user-selected precision and the exponent is a fixed +size (one machine word). + +A new mpf can be constructed with C<mpf>. The initial value can be an +integer, float, string, mpz, mpq or mpf. The second argument specifies the +desired precision in bits, or if omitted then the default precision is used. + + use GMP::Mpf qw(:all); + $a = mpf(); # zero + $b = mpf(-7.5); # default precision + $c = mpf(1.5, 500); # 500 bits precision + $d = mpf("1.0000000000000001"); + +The following overloaded operators are available, with the corresponding +assignment forms like C<+=>, + +=over 4 + +=item + ++ - * / E<lt>E<lt> E<gt>E<gt> ** ! E<lt> E<lt>= == != E<gt> E<gt>= +E<lt>=E<gt> abs not sqrt + +=back + +The following functions are available, behaving the same as the +corresponding GMP mpf functions, + +=over 4 + +=item + +ceil, floor, get_default_prec, get_prec, mpf_eq, set_default_prec, set_prec, +trunc + +=back + +C<mpf_eq> is so named to avoid clashing with the perl C<eq> operator. + +C<set_prec> expects a variable which it 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 mpf object then a new copy is made of it. +If the variable isn't an mpf it will be coerced to one. + +Results are the same precision as inputs, or if two mpf's are given to a +binary operator then the precision of the first is used. For example, + + use GMP::Mpf qw(mpf); + $a = mpf(2.0, 100); + $b = mpf(2.0, 500); + $c = $a + $b; # gives 100 bits precision + +Mpf to string conversion via "" or the usual string contexts uses C<$#> the +same as normal float to string conversions, or defaults to C<%.g> if C<$#> +is not defined. C<%.g> means all significant digits in the selected +precision. + +=head2 GMP class + +The following functions are available in the GMP class, + +=over 4 + +=item + +fits_slong_p, get_d, get_d_2exp, get_si, get_str, integer_p, printf, sgn, +sprintf, version + +=back + +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, 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); + use GMP::Mpf qw(:all); + ($s, $e) = get_str(111.111111111, 10, 4); + printf ".$se$e\n"; # .1111e3 + ($s, $e) = get_str(1.625, 10); + print "0.$s*10^$e\n"; # 0.1625*10^1 + ($s, $e) = get_str(mpf(2)**20, 16); + printf ".%s@%x\n", $s, $e; # .1@14 + +C<printf> and C<sprintf> allow formatted output of GMP types. mpz and mpq +values can be used with integer conversions (d, o, x, X) and mpf with float +conversions (f, e, E, g, G). All the standard perl printf features are +available too. For example, + + use GMP::Mpz qw(mpz); + use GMP::Mpf qw(mpf); + GMP::printf ("%d %d %s", 123, mpz(2)**128, 'foo'); + GMP::printf STDERR "%.40f", mpf(1.234); + +In perl 5.6.1 it doesn't seem to work to export C<printf>, the plain builtin +C<printf> is reached unless calls are C<&printf()> style. Explicit use of +C<GMP::printf> is suggested. C<sprintf> doesn't suffer this problem. + + use GMP qw(sprintf); + use GMP::Mpq qw(mpq); + $s = sprintf "%x", mpq(15,16); + +C<version> is not exported by default or by tag :all, calling it as +C<GMP::version()> is recommended. It returns the GMP library version +string, which is not to be confused with the module version number. + +The other GMP module functions behave as per the corresponding GMP routines, +and accept any integer, string, float, mpz, mpq or mpf. For example, + + use GMP qw(:all); + use GMP::Mpz qw(mpz); + $z = mpz(123); + print sgn($z); # gives 1 + +Because each of GMP::Mpz, GMP::Mpq and GMP::Mpf is a sub-class of GMP, +C<-E<gt>> style calls work too. + + use GMP qw(:all); + use GMP::Mpq qw(mpf); + $q = mpq(-5,7); + if ($q->integer_p()) # false + ... + +=head2 GMP::Rand + +This class provides objects holding an algorithm and state for random number +generation. C<randstate> creates a new object, for example, + + use GMP::Rand qw(randstate); + $r = randstate(); + $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>. 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 +currently supported is 128. The other forms always succeed. + +A randstate can be seeded with an integer or mpz, using the C<seed> method. +/dev/random might be a good source of randomness, or time() or +Time::HiRes::time() might be adequate, depending on the application. + + $r->seed(time())); + +Random numbers can be generated with the following functions, + +=over 4 + +=item + +mpf_urandomb, mpz_rrandomb, mpz_urandomb, mpz_urandomm, +gmp_urandomb_ui, gmp_urandomm_ui + +=back + +Each constructs a new mpz or mpf and with a distribution per the +corresponding GMP function. For example, + + use GMP::Rand (:all); + $r = randstate(); + $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 + +Arguments to operators and functions are converted as necessary to the +appropriate type. For instance C<**> requires an unsigned integer exponent, +and an mpq argument will be converted, so long as it's an integer in the +appropriate range. + + use GMP::Mpz (mpz); + use GMP::Mpq (mpq); + $p = mpz(3) ** mpq(45); # allowed, 45 is an integer + +It's an error if a conversion to an integer or mpz would cause any +truncation. For example, + + use GMP::Mpz (mpz); + $p = mpz(3) + 1.25; # not allowed + $p = mpz(3) + mpz(1.25); # allowed, explicit truncation + +Comparisons, however, accept any combination of operands and are always done +exactly. For example, + + use GMP::Mpz (mpz); + print mpz(3) < 3.1; # true + +Variables used on the left of an assignment operator like C<+=> are subject +to coercion too. An integer, float or string will change type when an mpz, +mpq or mpf is applied to it. For example, + + use GMP::Mpz (mpz); + $a = 1; + $a += mpz(1234); # $a becomes an mpz + +=head2 Overloading + +The rule for binary operators in the C<overload> mechanism is that if both +operands are class objects then the method from the first is used. This +determines the result type when mixing GMP classes. For example, + + use GMP::Mpz (mpz); + use GMP::Mpq (mpq); + use GMP::Mpf (mpf); + $z = mpz(123); + $q = mpq(3,2); + $f = mpf(1.375) + print $q+$f; # gives an mpq + print $f+$z; # gives an mpf + print $z+$f; # not allowed, would lose precision + +=head2 Constants + +A special tag C<:constants> is recognised in the module exports list. It +doesn't select any functions, but indicates that perl constants should be +GMP objects. This can only be used on one of GMP::Mpz, GMP::Mpq or GMP::Mpf +at any one time, since they apply different rules. + +GMP::Mpz will treat constants as mpz's if they're integers, or ordinary +floats if not. For example, + + use GMP::Mpz qw(:constants); + print 764861287634126387126378128,"\n"; # an mpz + print 1.25,"\n"; # a float + +GMP::Mpq is similar, treating integers as mpq's and leaving floats to the +normal perl handling. Something like 3/4 is read as two integer mpq's and a +division, but that's fine since it gives the intended fraction. + + use GMP::Mpq qw(:constants); + print 3/4,"\n"; # an mpq + print 1.25,"\n"; # a float + +GMP::Mpf will treat all constants as mpf's using the default precision. +BEGIN blocks can be used to set that precision while the code is parsed. +For example, + + use GMP::Mpf qw(:constants); + BEGIN { GMP::Mpf::set_default_prec(256); } + print 1/3; + BEGIN { GMP::Mpf::set_default_prec(64); } + print 5/7; + +A similar special tag :noconstants is recognised to turn off the constants +feature. For example, + + use GMP::Mpz qw(:constants); + print 438249738748174928193,"\n"; # an mpz + use GMP::Mpz qw(:noconstants); + print 438249738748174928193,"\n"; # now a float + +All three 'integer', 'binary' and 'float' constant methods are captured. +'float' is captured even for GMP::Mpz and GMP::Mpq since perl by default +treats integer strings as floats if they don't fit a plain integer. + +=head1 SEE ALSO + +GMP manual, L<perl>, L<overload>. + +=head1 BUGS + +In perl 5.005_03 on i386 FreeBSD, the overloaded constants sometimes provoke +seg faults. Don't know if that's a perl bug or a GMP module bug, though it +does seem to go bad before reaching anything in GMP.xs. + +There's no way to specify an arbitrary base when converting a string to an +mpz (or mpq or mpf), only hex or octal with 0x or 0 (for mpz and mpq, but +not for mpf). + +These modules are not reentrant or thread safe, due to the implementation of +the XSUBs. + +Returning a new object from the various functions is convenient, but +assignment versions could avoid creating new objects. Perhaps they could be +named after the C language functions, eg. mpq_inv($q,$q); + +It'd be good if C<num> and C<den> gave lvalues so the underlying mpq could +be manipulated. + +C<printf> could usefully accept %b for mpz, mpq and mpf, and perhaps %x for +mpf too. + +C<get_str> returning different style values for integer versus float is a +bit unfortunate. With mpz, mpq and mpf objects there's no doubt what it +will do, but on a plain scalar its action depends on whether the scalar was +promoted to a float at any stage, and then on the GMP module rules about +using the integer or float part. + +=head1 INTERNALS + +In usual perl object style, an mpz is a reference to an object blessed into +class C<GMP::Mpz>. The object holds a pointer to the C language C<mpz_t> +structure. Similarly for mpq, mpf and randstate. + +A free list of mpz and mpq values is kept to avoid repeated initializing and +clearing when objects are created and destroyed. This aims to help speed, +but it's not clear whether it's really needed. + +mpf doesn't use a free list because the precision of new objects can be +different each time. + +No interface to C<mpf_set_prec_raw> is provided. It wouldn't be very useful +since there's no way to make an operation store its result in a particular +object. The plain C<set_prec> is useful though, for truncating to a lower +precision, or as a sort of directive that subsequent calculations involving +that variable should use a higher precision. + +The overheads of perl dynamic typing (operator dispatch, operand type +checking or coercion) will mean this interface is slower than using C +directly. + +Some assertion checking is available as a compile-time option. + +=head1 COPYRIGHT + +Copyright 2001-2004 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * 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. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP 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 General Public License +for more details. + +You should have received copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. + +=cut + +# Local variables: +# perl-indent-level: 2 +# fill-column: 76 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/GMP.xs b/vendor/gmp-6.3.0/demos/perl/GMP.xs new file mode 100644 index 0000000..8f5acc9 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP.xs @@ -0,0 +1,3212 @@ +/* GMP module external subroutines. + +Copyright 2001-2003, 2015 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * 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. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP 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 General Public License +for more details. + +You should have received copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. + + +/* Notes: + + Routines are grouped with the alias feature and a table of function + pointers where possible, since each xsub routine ends up with quite a bit + of code size. Different combinations of arguments and return values have + to be separate though. + + The "INTERFACE:" feature isn't available in perl 5.005 and so isn't used. + "ALIAS:" requires a table lookup with CvXSUBANY(cv).any_i32 (which is + "ix") whereas "INTERFACE:" would have CvXSUBANY(cv).any_dptr as the + function pointer immediately. + + Mixed-type swapped-order assignments like "$a = 123; $a += mpz(456);" + invoke the plain overloaded "+", not "+=", which makes life easier. + + mpz_assume etc types are used with the overloaded operators since such + operators are always called with a class object as the first argument, we + don't need an sv_derived_from() lookup to check. There's assert()s in + MPX_ASSUME() for this though. + + The overload_constant routines reached via overload::constant get 4 + arguments in perl 5.6, not the 3 as documented. This is apparently a + bug, using "..." lets us ignore the extra one. + + There's only a few "si" functions in gmp, so usually SvIV values get + handled with an mpz_set_si into a temporary and then a full precision mpz + routine. This is reasonably efficient. + + Argument types are checked, with a view to preserving all bits in the + operand. Perl is a bit looser in its arithmetic, allowing rounding or + truncation to an intended operand type (IV, UV or NV). + + Bugs: + + The memory leak detection attempted in GMP::END() doesn't work when mpz's + are created as constants because END() is called before they're + destroyed. What's the right place to hook such a check? + + See the bugs section of GMP.pm too. */ + + +/* Comment this out to get assertion checking. */ +#define NDEBUG + +/* Change this to "#define TRACE(x) x" for some diagnostics. */ +#define TRACE(x) + + +#include <assert.h> +#include <float.h> + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "patchlevel.h" + +#include "gmp.h" + + +/* Perl 5.005 doesn't have SvIsUV, only 5.6 and up. + Perl 5.8 has SvUOK, but not 5.6, so we don't use that. */ +#ifndef SvIsUV +#define SvIsUV(sv) 0 +#endif +#ifndef SvUVX +#define SvUVX(sv) (croak("GMP: oops, shouldn't be using SvUVX"), 0) +#endif + + +/* Code which doesn't check anything itself, but exists to support other + assert()s. */ +#ifdef NDEBUG +#define assert_support(x) +#else +#define assert_support(x) x +#endif + +/* LONG_MAX + 1 and ULONG_MAX + 1, as a doubles */ +#define LONG_MAX_P1_AS_DOUBLE ((double) ((unsigned long) LONG_MAX + 1)) +#define ULONG_MAX_P1_AS_DOUBLE (2.0 * (double) ((unsigned long) ULONG_MAX/2 + 1)) + +/* Check for perl version "major.minor". + Perl 5.004 doesn't have PERL_REVISION and PERL_VERSION, but that's ok, + we're only interested in tests above that. */ +#if defined (PERL_REVISION) && defined (PERL_VERSION) +#define PERL_GE(major,minor) \ + (PERL_REVISION > (major) \ + || ((major) == PERL_REVISION && PERL_VERSION >= (minor))) +#else +#define PERL_GE(major,minor) (0) +#endif +#define PERL_LT(major,minor) (! PERL_GE(major,minor)) + +/* sv_derived_from etc in 5.005 took "char *" rather than "const char *". + Avoid some compiler warnings by using const only where it works. */ +#if PERL_LT (5,6) +#define classconst +#else +#define classconst const +#endif + +/* In a MINGW or Cygwin DLL build of gmp, the various gmp functions are + given with dllimport directives, which prevents them being used as + initializers for constant data. We give function tables as + "static_functable const ...", which is normally "static const", but for + mingw expands to just "const" making the table an automatic with a + run-time initializer. + + In gcc 3.3.1, the function tables initialized like this end up getting + all the __imp__foo values fetched, even though just one or two will be + used. This is wasteful, but probably not too bad. */ + +#if defined (__MINGW32__) || defined (__CYGWIN__) +#define static_functable +#else +#define static_functable static +#endif + +#define GMP_MALLOC_ID 42 + +static classconst char mpz_class[] = "GMP::Mpz"; +static classconst char mpq_class[] = "GMP::Mpq"; +static classconst char mpf_class[] = "GMP::Mpf"; +static classconst char rand_class[] = "GMP::Rand"; + +static HV *mpz_class_hv; +static HV *mpq_class_hv; +static HV *mpf_class_hv; + +assert_support (static long mpz_count = 0;) +assert_support (static long mpq_count = 0;) +assert_support (static long mpf_count = 0;) +assert_support (static long rand_count = 0;) + +#define TRACE_ACTIVE() \ + assert_support \ + (TRACE (printf (" active %ld mpz, %ld mpq, %ld mpf, %ld randstate\n", \ + mpz_count, mpq_count, mpf_count, rand_count))) + + +/* Each "struct mpz_elem" etc is an mpz_t with a link field tacked on the + end so they can be held on a linked list. */ + +#define CREATE_MPX(type) \ + \ + /* must have mpz_t etc first, for sprintf below */ \ + struct type##_elem { \ + type##_t m; \ + struct type##_elem *next; \ + }; \ + typedef struct type##_elem *type; \ + typedef struct type##_elem *type##_assume; \ + typedef type##_ptr type##_coerce; \ + \ + static type type##_freelist = NULL; \ + \ + static type \ + new_##type (void) \ + { \ + type p; \ + TRACE (printf ("new %s\n", type##_class)); \ + if (type##_freelist != NULL) \ + { \ + p = type##_freelist; \ + type##_freelist = type##_freelist->next; \ + } \ + else \ + { \ + New (GMP_MALLOC_ID, p, 1, struct type##_elem); \ + type##_init (p->m); \ + } \ + TRACE (printf (" p=%p\n", p)); \ + assert_support (type##_count++); \ + TRACE_ACTIVE (); \ + return p; \ + } \ + +CREATE_MPX (mpz) +CREATE_MPX (mpq) + +typedef mpf_ptr mpf; +typedef mpf_ptr mpf_assume; +typedef mpf_ptr mpf_coerce_st0; +typedef mpf_ptr mpf_coerce_def; + + +static mpf +new_mpf (unsigned long prec) +{ + mpf p; + New (GMP_MALLOC_ID, p, 1, __mpf_struct); + mpf_init2 (p, prec); + TRACE (printf (" mpf p=%p\n", p)); + assert_support (mpf_count++); + TRACE_ACTIVE (); + return p; +} + + +/* tmp_mpf_t records an allocated precision with an mpf_t so changes of + precision can be done with just an mpf_set_prec_raw. */ + +struct tmp_mpf_struct { + mpf_t m; + unsigned long allocated_prec; +}; +typedef const struct tmp_mpf_struct *tmp_mpf_srcptr; +typedef struct tmp_mpf_struct *tmp_mpf_ptr; +typedef struct tmp_mpf_struct tmp_mpf_t[1]; + +#define tmp_mpf_init(f) \ + do { \ + mpf_init (f->m); \ + f->allocated_prec = mpf_get_prec (f->m); \ + } while (0) + +static void +tmp_mpf_grow (tmp_mpf_ptr f, unsigned long prec) +{ + mpf_set_prec_raw (f->m, f->allocated_prec); + mpf_set_prec (f->m, prec); + f->allocated_prec = mpf_get_prec (f->m); +} + +#define tmp_mpf_shrink(f) tmp_mpf_grow (f, 1L) + +#define tmp_mpf_set_prec(f,prec) \ + do { \ + if (prec > f->allocated_prec) \ + tmp_mpf_grow (f, prec); \ + else \ + mpf_set_prec_raw (f->m, prec); \ + } while (0) + + +static mpz_t tmp_mpz_0, tmp_mpz_1, tmp_mpz_2; +static mpq_t tmp_mpq_0, tmp_mpq_1; +static tmp_mpf_t tmp_mpf_0, tmp_mpf_1; + +/* for GMP::Mpz::export */ +#define tmp_mpz_4 tmp_mpz_2 + + +#define FREE_MPX_FREELIST(p,type) \ + do { \ + TRACE (printf ("free %s\n", type##_class)); \ + p->next = type##_freelist; \ + type##_freelist = p; \ + assert_support (type##_count--); \ + TRACE_ACTIVE (); \ + assert (type##_count >= 0); \ + } while (0) + +/* this version for comparison, if desired */ +#define FREE_MPX_NOFREELIST(p,type) \ + do { \ + TRACE (printf ("free %s\n", type##_class)); \ + type##_clear (p->m); \ + Safefree (p); \ + assert_support (type##_count--); \ + TRACE_ACTIVE (); \ + assert (type##_count >= 0); \ + } while (0) + +#define free_mpz(z) FREE_MPX_FREELIST (z, mpz) +#define free_mpq(q) FREE_MPX_FREELIST (q, mpq) + + +/* Return a new mortal SV holding the given mpx_ptr pointer. + class_hv should be one of mpz_class_hv etc. */ +#define MPX_NEWMORTAL(mpx_ptr, class_hv) \ + sv_bless (sv_setref_pv (sv_newmortal(), NULL, mpx_ptr), class_hv) + +/* Aliases for use in typemaps */ +typedef char *malloced_string; +typedef const char *const_string; +typedef const char *const_string_assume; +typedef char *string; +typedef SV *order_noswap; +typedef SV *dummy; +typedef SV *SV_copy_0; +typedef unsigned long ulong_coerce; +typedef __gmp_randstate_struct *randstate; +typedef UV gmp_UV; + +#define SvMPX(s,type) ((type) SvIV((SV*) SvRV(s))) +#define SvMPZ(s) SvMPX(s,mpz) +#define SvMPQ(s) SvMPX(s,mpq) +#define SvMPF(s) SvMPX(s,mpf) +#define SvRANDSTATE(s) SvMPX(s,randstate) + +#define MPX_ASSUME(x,sv,type) \ + do { \ + assert (sv_derived_from (sv, type##_class)); \ + x = SvMPX(sv,type); \ + } while (0) + +#define MPZ_ASSUME(z,sv) MPX_ASSUME(z,sv,mpz) +#define MPQ_ASSUME(q,sv) MPX_ASSUME(q,sv,mpq) +#define MPF_ASSUME(f,sv) MPX_ASSUME(f,sv,mpf) + +#define numberof(x) (sizeof (x) / sizeof ((x)[0])) +#define SGN(x) ((x)<0 ? -1 : (x) != 0) +#define ABS(x) ((x)>=0 ? (x) : -(x)) +#define double_integer_p(d) (floor (d) == (d)) + +#define x_mpq_integer_p(q) \ + (mpz_cmp_ui (mpq_denref(q), 1L) == 0) + +#define assert_table(ix) assert (ix >= 0 && ix < numberof (table)) + +#define SV_PTR_SWAP(x,y) \ + do { SV *__tmp = (x); (x) = (y); (y) = __tmp; } while (0) +#define MPF_PTR_SWAP(x,y) \ + do { mpf_ptr __tmp = (x); (x) = (y); (y) = __tmp; } while (0) + + +static void +class_or_croak (SV *sv, classconst char *cl) +{ + if (! sv_derived_from (sv, cl)) + croak("not type %s", cl); +} + + +/* These are macros, wrap them in functions. */ +static int +x_mpz_odd_p (mpz_srcptr z) +{ + return mpz_odd_p (z); +} +static int +x_mpz_even_p (mpz_srcptr z) +{ + return mpz_even_p (z); +} + +static void +x_mpq_pow_ui (mpq_ptr r, mpq_srcptr b, unsigned long e) +{ + mpz_pow_ui (mpq_numref(r), mpq_numref(b), e); + mpz_pow_ui (mpq_denref(r), mpq_denref(b), e); +} + + +static void * +my_gmp_alloc (size_t n) +{ + void *p; + TRACE (printf ("my_gmp_alloc %u\n", n)); + New (GMP_MALLOC_ID, p, n, char); + TRACE (printf (" p=%p\n", p)); + return p; +} + +static void * +my_gmp_realloc (void *p, size_t oldsize, size_t newsize) +{ + TRACE (printf ("my_gmp_realloc %p, %u to %u\n", p, oldsize, newsize)); + Renew (p, newsize, char); + TRACE (printf (" p=%p\n", p)); + return p; +} + +static void +my_gmp_free (void *p, size_t n) +{ + TRACE (printf ("my_gmp_free %p %u\n", p, n)); + Safefree (p); +} + + +#define my_mpx_set_svstr(type) \ + static void \ + my_##type##_set_svstr (type##_ptr x, SV *sv) \ + { \ + const char *str; \ + STRLEN len; \ + TRACE (printf (" my_" #type "_set_svstr\n")); \ + assert (SvPOK(sv) || SvPOKp(sv)); \ + str = SvPV (sv, len); \ + TRACE (printf (" str \"%s\"\n", str)); \ + if (type##_set_str (x, str, 0) != 0) \ + croak ("%s: invalid string: %s", type##_class, str); \ + } + +my_mpx_set_svstr(mpz) +my_mpx_set_svstr(mpq) +my_mpx_set_svstr(mpf) + + +/* very slack */ +static int +x_mpq_cmp_si (mpq_srcptr x, long yn, unsigned long yd) +{ + mpq y; + int ret; + y = new_mpq (); + mpq_set_si (y->m, yn, yd); + ret = mpq_cmp (x, y->m); + free_mpq (y); + return ret; +} + +static int +x_mpq_fits_slong_p (mpq_srcptr q) +{ + return x_mpq_cmp_si (q, LONG_MIN, 1L) >= 0 + && mpq_cmp_ui (q, LONG_MAX, 1L) <= 0; +} + +static int +x_mpz_cmp_q (mpz_ptr x, mpq_srcptr y) +{ + int ret; + mpz_set_ui (mpq_denref(tmp_mpq_0), 1L); + mpz_swap (mpq_numref(tmp_mpq_0), x); + ret = mpq_cmp (tmp_mpq_0, y); + mpz_swap (mpq_numref(tmp_mpq_0), x); + return ret; +} + +static int +x_mpz_cmp_f (mpz_srcptr x, mpf_srcptr y) +{ + tmp_mpf_set_prec (tmp_mpf_0, mpz_sizeinbase (x, 2)); + mpf_set_z (tmp_mpf_0->m, x); + return mpf_cmp (tmp_mpf_0->m, y); +} + + +#define USE_UNKNOWN 0 +#define USE_IVX 1 +#define USE_UVX 2 +#define USE_NVX 3 +#define USE_PVX 4 +#define USE_MPZ 5 +#define USE_MPQ 6 +#define USE_MPF 7 + +/* mg_get is called every time we get a value, even if the private flags are + still set from a previous such call. This is the same as as SvIV and + friends do. + + When POK, we use the PV, even if there's an IV or NV available. This is + because it's hard to be sure there wasn't any rounding in establishing + the IV and/or NV. Cases of overflow, where the PV should definitely be + used, are easy enough to spot, but rounding is hard. So although IV or + NV would be more efficient, we must use the PV to be sure of getting all + the data. Applications should convert once to mpz, mpq or mpf when using + a value repeatedly. + + Zany dual-type scalars like $! where the IV is an error code and the PV + is an error description string won't work with this preference for PV, + but that's too bad. Such scalars should be rare, and unlikely to be used + in bignum calculations. + + When IOK and NOK are both set, we would prefer to use the IV since it can + be converted more efficiently, and because on a 64-bit system the NV may + have less bits than the IV. The following rules are applied, + + - If the NV is not an integer, then we must use that NV, since clearly + the IV was merely established by rounding and is not the full value. + + - In perl prior to 5.8, an NV too big for an IV leaves an overflow value + 0xFFFFFFFF. If the NV is too big to fit an IV then clearly it's the NV + which is the true value and must be used. + + - In perl 5.8 and up, such an overflow doesn't set IOK, so that test is + unnecessary. However when coming from get-magic, IOKp _is_ set, and we + must check for overflow the same as in older perl. + + FIXME: + + We'd like to call mg_get just once, but unfortunately sv_derived_from() + will call it for each of our checks. We could do a string compare like + sv_isa ourselves, but that only tests the exact class, it doesn't + recognise subclassing. There doesn't seem to be a public interface to + the subclassing tests (in the internal isa_lookup() function). */ + +int +use_sv (SV *sv) +{ + double d; + + if (SvGMAGICAL(sv)) + { + mg_get(sv); + + if (SvPOKp(sv)) + return USE_PVX; + + if (SvIOKp(sv)) + { + if (SvIsUV(sv)) + { + if (SvNOKp(sv)) + goto u_or_n; + return USE_UVX; + } + else + { + if (SvNOKp(sv)) + goto i_or_n; + return USE_IVX; + } + } + + if (SvNOKp(sv)) + return USE_NVX; + + goto rok_or_unknown; + } + + if (SvPOK(sv)) + return USE_PVX; + + if (SvIOK(sv)) + { + if (SvIsUV(sv)) + { + if (SvNOK(sv)) + { + if (PERL_LT (5, 8)) + { + u_or_n: + d = SvNVX(sv); + if (d >= ULONG_MAX_P1_AS_DOUBLE || d < 0.0) + return USE_NVX; + } + d = SvNVX(sv); + if (d != floor (d)) + return USE_NVX; + } + return USE_UVX; + } + else + { + if (SvNOK(sv)) + { + if (PERL_LT (5, 8)) + { + i_or_n: + d = SvNVX(sv); + if (d >= LONG_MAX_P1_AS_DOUBLE || d < (double) LONG_MIN) + return USE_NVX; + } + d = SvNVX(sv); + if (d != floor (d)) + return USE_NVX; + } + return USE_IVX; + } + } + + if (SvNOK(sv)) + return USE_NVX; + + rok_or_unknown: + if (SvROK(sv)) + { + if (sv_derived_from (sv, mpz_class)) + return USE_MPZ; + if (sv_derived_from (sv, mpq_class)) + return USE_MPQ; + if (sv_derived_from (sv, mpf_class)) + return USE_MPF; + } + + return USE_UNKNOWN; +} + + +/* Coerce sv to an mpz. Use tmp to hold the converted value if sv isn't + already an mpz (or an mpq of which the numerator can be used). Return + the chosen mpz (tmp or the contents of sv). */ + +static mpz_ptr +coerce_mpz_using (mpz_ptr tmp, SV *sv, int use) +{ + switch (use) { + case USE_IVX: + mpz_set_si (tmp, SvIVX(sv)); + return tmp; + + case USE_UVX: + mpz_set_ui (tmp, SvUVX(sv)); + return tmp; + + case USE_NVX: + { + double d; + d = SvNVX(sv); + if (! double_integer_p (d)) + croak ("cannot coerce non-integer double to mpz"); + mpz_set_d (tmp, d); + return tmp; + } + + case USE_PVX: + my_mpz_set_svstr (tmp, sv); + return tmp; + + case USE_MPZ: + return SvMPZ(sv)->m; + + case USE_MPQ: + { + mpq q = SvMPQ(sv); + if (! x_mpq_integer_p (q->m)) + croak ("cannot coerce non-integer mpq to mpz"); + return mpq_numref(q->m); + } + + case USE_MPF: + { + mpf f = SvMPF(sv); + if (! mpf_integer_p (f)) + croak ("cannot coerce non-integer mpf to mpz"); + mpz_set_f (tmp, f); + return tmp; + } + + default: + croak ("cannot coerce to mpz"); + } +} +static mpz_ptr +coerce_mpz (mpz_ptr tmp, SV *sv) +{ + return coerce_mpz_using (tmp, sv, use_sv (sv)); +} + + +/* Coerce sv to an mpq. If sv is an mpq then just return that, otherwise + use tmp to hold the converted value and return that. */ + +static mpq_ptr +coerce_mpq_using (mpq_ptr tmp, SV *sv, int use) +{ + TRACE (printf ("coerce_mpq_using %p %d\n", tmp, use)); + switch (use) { + case USE_IVX: + mpq_set_si (tmp, SvIVX(sv), 1L); + return tmp; + + case USE_UVX: + mpq_set_ui (tmp, SvUVX(sv), 1L); + return tmp; + + case USE_NVX: + mpq_set_d (tmp, SvNVX(sv)); + return tmp; + + case USE_PVX: + my_mpq_set_svstr (tmp, sv); + return tmp; + + case USE_MPZ: + mpq_set_z (tmp, SvMPZ(sv)->m); + return tmp; + + case USE_MPQ: + return SvMPQ(sv)->m; + + case USE_MPF: + mpq_set_f (tmp, SvMPF(sv)); + return tmp; + + default: + croak ("cannot coerce to mpq"); + } +} +static mpq_ptr +coerce_mpq (mpq_ptr tmp, SV *sv) +{ + return coerce_mpq_using (tmp, sv, use_sv (sv)); +} + + +static void +my_mpf_set_sv_using (mpf_ptr f, SV *sv, int use) +{ + switch (use) { + case USE_IVX: + mpf_set_si (f, SvIVX(sv)); + break; + + case USE_UVX: + mpf_set_ui (f, SvUVX(sv)); + break; + + case USE_NVX: + mpf_set_d (f, SvNVX(sv)); + break; + + case USE_PVX: + my_mpf_set_svstr (f, sv); + break; + + case USE_MPZ: + mpf_set_z (f, SvMPZ(sv)->m); + break; + + case USE_MPQ: + mpf_set_q (f, SvMPQ(sv)->m); + break; + + case USE_MPF: + mpf_set (f, SvMPF(sv)); + break; + + default: + croak ("cannot coerce to mpf"); + } +} + +/* Coerce sv to an mpf. If sv is an mpf then just return that, otherwise + use tmp to hold the converted value (with prec precision). */ +static mpf_ptr +coerce_mpf_using (tmp_mpf_ptr tmp, SV *sv, unsigned long prec, int use) +{ + if (use == USE_MPF) + return SvMPF(sv); + + tmp_mpf_set_prec (tmp, prec); + my_mpf_set_sv_using (tmp->m, sv, use); + return tmp->m; +} +static mpf_ptr +coerce_mpf (tmp_mpf_ptr tmp, SV *sv, unsigned long prec) +{ + return coerce_mpf_using (tmp, sv, prec, use_sv (sv)); +} + + +/* Coerce xv to an mpf and store the pointer in x, ditto for yv to x. If + one of xv or yv is an mpf then use it for the precision, otherwise use + the default precision. */ +unsigned long +coerce_mpf_pair (mpf *xp, SV *xv, mpf *yp, SV *yv) +{ + int x_use = use_sv (xv); + int y_use = use_sv (yv); + unsigned long prec; + mpf x, y; + + if (x_use == USE_MPF) + { + x = SvMPF(xv); + prec = mpf_get_prec (x); + y = coerce_mpf_using (tmp_mpf_0, yv, prec, y_use); + } + else + { + y = coerce_mpf_using (tmp_mpf_0, yv, mpf_get_default_prec(), y_use); + prec = mpf_get_prec (y); + x = coerce_mpf_using (tmp_mpf_1, xv, prec, x_use); + } + *xp = x; + *yp = y; + return prec; +} + + +/* Note that SvUV is not used, since it merely treats the signed IV as if it + was unsigned. We get an IV and check its sign. */ +static unsigned long +coerce_ulong (SV *sv) +{ + long n; + + switch (use_sv (sv)) { + case USE_IVX: + n = SvIVX(sv); + negative_check: + if (n < 0) + goto range_error; + return n; + + case USE_UVX: + return SvUVX(sv); + + case USE_NVX: + { + double d; + d = SvNVX(sv); + if (! double_integer_p (d)) + goto integer_error; + n = SvIV(sv); + } + goto negative_check; + + case USE_PVX: + /* FIXME: Check the string is an integer. */ + n = SvIV(sv); + goto negative_check; + + case USE_MPZ: + { + mpz z = SvMPZ(sv); + if (! mpz_fits_ulong_p (z->m)) + goto range_error; + return mpz_get_ui (z->m); + } + + case USE_MPQ: + { + mpq q = SvMPQ(sv); + if (! x_mpq_integer_p (q->m)) + goto integer_error; + if (! mpz_fits_ulong_p (mpq_numref (q->m))) + goto range_error; + return mpz_get_ui (mpq_numref (q->m)); + } + + case USE_MPF: + { + mpf f = SvMPF(sv); + if (! mpf_integer_p (f)) + goto integer_error; + if (! mpf_fits_ulong_p (f)) + goto range_error; + return mpf_get_ui (f); + } + + default: + croak ("cannot coerce to ulong"); + } + + integer_error: + croak ("not an integer"); + + range_error: + croak ("out of range for ulong"); +} + + +static long +coerce_long (SV *sv) +{ + switch (use_sv (sv)) { + case USE_IVX: + return SvIVX(sv); + + case USE_UVX: + { + UV u = SvUVX(sv); + if (u > (UV) LONG_MAX) + goto range_error; + return u; + } + + case USE_NVX: + { + double d = SvNVX(sv); + if (! double_integer_p (d)) + goto integer_error; + return SvIV(sv); + } + + case USE_PVX: + /* FIXME: Check the string is an integer. */ + return SvIV(sv); + + case USE_MPZ: + { + mpz z = SvMPZ(sv); + if (! mpz_fits_slong_p (z->m)) + goto range_error; + return mpz_get_si (z->m); + } + + case USE_MPQ: + { + mpq q = SvMPQ(sv); + if (! x_mpq_integer_p (q->m)) + goto integer_error; + if (! mpz_fits_slong_p (mpq_numref (q->m))) + goto range_error; + return mpz_get_si (mpq_numref (q->m)); + } + + case USE_MPF: + { + mpf f = SvMPF(sv); + if (! mpf_integer_p (f)) + goto integer_error; + if (! mpf_fits_slong_p (f)) + goto range_error; + return mpf_get_si (f); + } + + default: + croak ("cannot coerce to long"); + } + + integer_error: + croak ("not an integer"); + + range_error: + croak ("out of range for ulong"); +} + + +/* ------------------------------------------------------------------------- */ + +MODULE = GMP PACKAGE = GMP + +BOOT: + TRACE (printf ("GMP boot\n")); + mp_set_memory_functions (my_gmp_alloc, my_gmp_realloc, my_gmp_free); + mpz_init (tmp_mpz_0); + mpz_init (tmp_mpz_1); + mpz_init (tmp_mpz_2); + mpq_init (tmp_mpq_0); + mpq_init (tmp_mpq_1); + tmp_mpf_init (tmp_mpf_0); + tmp_mpf_init (tmp_mpf_1); + mpz_class_hv = gv_stashpv (mpz_class, 1); + mpq_class_hv = gv_stashpv (mpq_class, 1); + mpf_class_hv = gv_stashpv (mpf_class, 1); + + +void +END() +CODE: + TRACE (printf ("GMP end\n")); + TRACE_ACTIVE (); + /* These are not always true, see Bugs at the top of the file. */ + /* assert (mpz_count == 0); */ + /* assert (mpq_count == 0); */ + /* assert (mpf_count == 0); */ + /* assert (rand_count == 0); */ + + +const_string +version() +CODE: + RETVAL = gmp_version; +OUTPUT: + RETVAL + + +bool +fits_slong_p (sv) + SV *sv +CODE: + switch (use_sv (sv)) { + case USE_IVX: + RETVAL = 1; + break; + + case USE_UVX: + { + UV u = SvUVX(sv); + RETVAL = (u <= LONG_MAX); + } + break; + + case USE_NVX: + { + double d = SvNVX(sv); + RETVAL = (d >= (double) LONG_MIN && d < LONG_MAX_P1_AS_DOUBLE); + } + break; + + case USE_PVX: + { + STRLEN len; + const char *str = SvPV (sv, len); + if (mpq_set_str (tmp_mpq_0, str, 0) == 0) + RETVAL = x_mpq_fits_slong_p (tmp_mpq_0); + else + { + /* enough precision for a long */ + tmp_mpf_set_prec (tmp_mpf_0, 2*mp_bits_per_limb); + if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0) + croak ("GMP::fits_slong_p invalid string format"); + RETVAL = mpf_fits_slong_p (tmp_mpf_0->m); + } + } + break; + + case USE_MPZ: + RETVAL = mpz_fits_slong_p (SvMPZ(sv)->m); + break; + + case USE_MPQ: + RETVAL = x_mpq_fits_slong_p (SvMPQ(sv)->m); + break; + + case USE_MPF: + RETVAL = mpf_fits_slong_p (SvMPF(sv)); + break; + + default: + croak ("GMP::fits_slong_p invalid argument"); + } +OUTPUT: + RETVAL + + +double +get_d (sv) + SV *sv +CODE: + switch (use_sv (sv)) { + case USE_IVX: + RETVAL = (double) SvIVX(sv); + break; + + case USE_UVX: + RETVAL = (double) SvUVX(sv); + break; + + case USE_NVX: + RETVAL = SvNVX(sv); + break; + + case USE_PVX: + { + STRLEN len; + RETVAL = atof(SvPV(sv, len)); + } + break; + + case USE_MPZ: + RETVAL = mpz_get_d (SvMPZ(sv)->m); + break; + + case USE_MPQ: + RETVAL = mpq_get_d (SvMPQ(sv)->m); + break; + + case USE_MPF: + RETVAL = mpf_get_d (SvMPF(sv)); + break; + + default: + croak ("GMP::get_d invalid argument"); + } +OUTPUT: + RETVAL + + +void +get_d_2exp (sv) + SV *sv +PREINIT: + double ret; + long exp; +PPCODE: + switch (use_sv (sv)) { + case USE_IVX: + ret = (double) SvIVX(sv); + goto use_frexp; + + case USE_UVX: + ret = (double) SvUVX(sv); + goto use_frexp; + + case USE_NVX: + { + int i_exp; + ret = SvNVX(sv); + use_frexp: + ret = frexp (ret, &i_exp); + exp = i_exp; + } + break; + + case USE_PVX: + /* 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); + break; + + case USE_MPZ: + ret = mpz_get_d_2exp (&exp, SvMPZ(sv)->m); + break; + + case USE_MPQ: + 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); + break; + + case USE_MPF: + ret = mpf_get_d_2exp (&exp, SvMPF(sv)); + break; + + default: + croak ("GMP::get_d_2exp invalid argument"); + } + PUSHs (sv_2mortal (newSVnv (ret))); + PUSHs (sv_2mortal (newSViv (exp))); + + +long +get_si (sv) + SV *sv +CODE: + switch (use_sv (sv)) { + case USE_IVX: + RETVAL = SvIVX(sv); + break; + + case USE_UVX: + RETVAL = SvUVX(sv); + break; + + case USE_NVX: + RETVAL = (long) SvNVX(sv); + break; + + case USE_PVX: + RETVAL = SvIV(sv); + break; + + case USE_MPZ: + RETVAL = mpz_get_si (SvMPZ(sv)->m); + break; + + case USE_MPQ: + mpz_set_q (tmp_mpz_0, SvMPQ(sv)->m); + RETVAL = mpz_get_si (tmp_mpz_0); + break; + + case USE_MPF: + RETVAL = mpf_get_si (SvMPF(sv)); + break; + + default: + croak ("GMP::get_si invalid argument"); + } +OUTPUT: + RETVAL + + +void +get_str (sv, ...) + SV *sv +PREINIT: + char *str; + mp_exp_t exp; + mpz_ptr z; + mpq_ptr q; + mpf f; + int base; + int ndigits; +PPCODE: + TRACE (printf ("GMP::get_str\n")); + + if (items >= 2) + base = coerce_long (ST(1)); + else + base = 10; + TRACE (printf (" base=%d\n", base)); + + if (items >= 3) + ndigits = coerce_long (ST(2)); + else + ndigits = 10; + TRACE (printf (" ndigits=%d\n", ndigits)); + + EXTEND (SP, 2); + + switch (use_sv (sv)) { + case USE_IVX: + mpz_set_si (tmp_mpz_0, SvIVX(sv)); + get_tmp_mpz_0: + z = tmp_mpz_0; + goto get_mpz; + + case USE_UVX: + mpz_set_ui (tmp_mpz_0, SvUVX(sv)); + goto get_tmp_mpz_0; + + case USE_NVX: + /* only digits in the original double, not in the coerced form */ + if (ndigits == 0) + ndigits = DBL_DIG; + mpf_set_d (tmp_mpf_0->m, SvNVX(sv)); + f = tmp_mpf_0->m; + goto get_mpf; + + case USE_PVX: + { + /* get_str on a string is not much more than a base conversion */ + STRLEN len; + str = SvPV (sv, len); + if (mpz_set_str (tmp_mpz_0, str, 0) == 0) + { + z = tmp_mpz_0; + goto get_mpz; + } + else if (mpq_set_str (tmp_mpq_0, str, 0) == 0) + { + q = tmp_mpq_0; + goto get_mpq; + } + else + { + /* FIXME: Would like perhaps a precision equivalent to the + number of significant digits of the string, in its given + base. */ + tmp_mpf_set_prec (tmp_mpf_0, strlen(str)); + if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0) + { + f = tmp_mpf_0->m; + goto get_mpf; + } + else + croak ("GMP::get_str invalid string format"); + } + } + break; + + case USE_MPZ: + z = SvMPZ(sv)->m; + get_mpz: + str = mpz_get_str (NULL, base, z); + push_str: + PUSHs (sv_2mortal (newSVpv (str, 0))); + break; + + case USE_MPQ: + q = SvMPQ(sv)->m; + get_mpq: + str = mpq_get_str (NULL, base, q); + goto push_str; + + case USE_MPF: + f = SvMPF(sv); + get_mpf: + str = mpf_get_str (NULL, &exp, base, 0, f); + PUSHs (sv_2mortal (newSVpv (str, 0))); + PUSHs (sv_2mortal (newSViv (exp))); + break; + + default: + croak ("GMP::get_str invalid argument"); + } + + +bool +integer_p (sv) + SV *sv +CODE: + switch (use_sv (sv)) { + case USE_IVX: + case USE_UVX: + RETVAL = 1; + break; + + case USE_NVX: + RETVAL = double_integer_p (SvNVX(sv)); + break; + + case USE_PVX: + { + /* FIXME: Maybe this should be done by parsing the string, not by an + actual conversion. */ + STRLEN len; + const char *str = SvPV (sv, len); + if (mpq_set_str (tmp_mpq_0, str, 0) == 0) + RETVAL = x_mpq_integer_p (tmp_mpq_0); + else + { + /* enough for all digits of the string */ + tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64); + if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0) + RETVAL = mpf_integer_p (tmp_mpf_0->m); + else + croak ("GMP::integer_p invalid string format"); + } + } + break; + + case USE_MPZ: + RETVAL = 1; + break; + + case USE_MPQ: + RETVAL = x_mpq_integer_p (SvMPQ(sv)->m); + break; + + case USE_MPF: + RETVAL = mpf_integer_p (SvMPF(sv)); + break; + + default: + croak ("GMP::integer_p invalid argument"); + } +OUTPUT: + RETVAL + + +int +sgn (sv) + SV *sv +CODE: + switch (use_sv (sv)) { + case USE_IVX: + RETVAL = SGN (SvIVX(sv)); + break; + + case USE_UVX: + RETVAL = (SvUVX(sv) > 0); + break; + + case USE_NVX: + RETVAL = SGN (SvNVX(sv)); + break; + + case USE_PVX: + { + /* FIXME: Maybe this should be done by parsing the string, not by an + actual conversion. */ + STRLEN len; + const char *str = SvPV (sv, len); + if (mpq_set_str (tmp_mpq_0, str, 0) == 0) + RETVAL = mpq_sgn (tmp_mpq_0); + else + { + /* enough for all digits of the string */ + tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64); + if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0) + RETVAL = mpf_sgn (tmp_mpf_0->m); + else + croak ("GMP::sgn invalid string format"); + } + } + break; + + case USE_MPZ: + RETVAL = mpz_sgn (SvMPZ(sv)->m); + break; + + case USE_MPQ: + RETVAL = mpq_sgn (SvMPQ(sv)->m); + break; + + case USE_MPF: + RETVAL = mpf_sgn (SvMPF(sv)); + break; + + default: + croak ("GMP::sgn invalid argument"); + } +OUTPUT: + RETVAL + + +# currently undocumented +void +shrink () +CODE: +#define x_mpz_shrink(z) \ + mpz_set_ui (z, 0L); _mpz_realloc (z, 1) +#define x_mpq_shrink(q) \ + x_mpz_shrink (mpq_numref(q)); x_mpz_shrink (mpq_denref(q)) + + x_mpz_shrink (tmp_mpz_0); + x_mpz_shrink (tmp_mpz_1); + x_mpz_shrink (tmp_mpz_2); + x_mpq_shrink (tmp_mpq_0); + x_mpq_shrink (tmp_mpq_1); + tmp_mpf_shrink (tmp_mpf_0); + tmp_mpf_shrink (tmp_mpf_1); + + + +malloced_string +sprintf_internal (fmt, sv) + const_string fmt + SV *sv +CODE: + assert (strlen (fmt) >= 3); + assert (SvROK(sv)); + assert ((sv_derived_from (sv, mpz_class) && fmt[strlen(fmt)-2] == 'Z') + || (sv_derived_from (sv, mpq_class) && fmt[strlen(fmt)-2] == 'Q') + || (sv_derived_from (sv, mpf_class) && fmt[strlen(fmt)-2] == 'F')); + TRACE (printf ("GMP::sprintf_internal\n"); + printf (" fmt |%s|\n", fmt); + printf (" sv |%p|\n", SvMPZ(sv))); + + /* cheat a bit here, SvMPZ works for mpq and mpf too */ + gmp_asprintf (&RETVAL, fmt, SvMPZ(sv)); + + TRACE (printf (" result |%s|\n", RETVAL)); +OUTPUT: + RETVAL + + + +#------------------------------------------------------------------------------ + +MODULE = GMP PACKAGE = GMP::Mpz + +mpz +mpz (...) +ALIAS: + GMP::Mpz::new = 1 +PREINIT: + SV *sv; +CODE: + TRACE (printf ("%s new, ix=%ld, items=%d\n", mpz_class, ix, (int) items)); + RETVAL = new_mpz(); + + switch (items) { + case 0: + mpz_set_ui (RETVAL->m, 0L); + break; + + case 1: + sv = ST(0); + TRACE (printf (" use %d\n", use_sv (sv))); + switch (use_sv (sv)) { + case USE_IVX: + mpz_set_si (RETVAL->m, SvIVX(sv)); + break; + + case USE_UVX: + mpz_set_ui (RETVAL->m, SvUVX(sv)); + break; + + case USE_NVX: + mpz_set_d (RETVAL->m, SvNVX(sv)); + break; + + case USE_PVX: + my_mpz_set_svstr (RETVAL->m, sv); + break; + + case USE_MPZ: + mpz_set (RETVAL->m, SvMPZ(sv)->m); + break; + + case USE_MPQ: + mpz_set_q (RETVAL->m, SvMPQ(sv)->m); + break; + + case USE_MPF: + mpz_set_f (RETVAL->m, SvMPF(sv)); + break; + + default: + goto invalid; + } + break; + + default: + invalid: + croak ("%s new: invalid arguments", mpz_class); + } +OUTPUT: + RETVAL + + +void +overload_constant (str, pv, d1, ...) + const_string_assume str + SV *pv + dummy d1 +PREINIT: + mpz z; +PPCODE: + TRACE (printf ("%s constant: %s\n", mpz_class, str)); + z = new_mpz(); + if (mpz_set_str (z->m, str, 0) == 0) + { + PUSHs (MPX_NEWMORTAL (z, mpz_class_hv)); + } + else + { + free_mpz (z); + PUSHs(pv); + } + + +mpz +overload_copy (z, d1, d2) + mpz_assume z + dummy d1 + dummy d2 +CODE: + RETVAL = new_mpz(); + mpz_set (RETVAL->m, z->m); +OUTPUT: + RETVAL + + +void +DESTROY (z) + mpz_assume z +CODE: + TRACE (printf ("%s DESTROY %p\n", mpz_class, z)); + free_mpz (z); + + +malloced_string +overload_string (z, d1, d2) + mpz_assume z + dummy d1 + dummy d2 +CODE: + TRACE (printf ("%s overload_string %p\n", mpz_class, z)); + RETVAL = mpz_get_str (NULL, 10, z->m); +OUTPUT: + RETVAL + + +mpz +overload_add (xv, yv, order) + SV *xv + SV *yv + SV *order +ALIAS: + GMP::Mpz::overload_sub = 1 + GMP::Mpz::overload_mul = 2 + GMP::Mpz::overload_div = 3 + GMP::Mpz::overload_rem = 4 + GMP::Mpz::overload_and = 5 + GMP::Mpz::overload_ior = 6 + GMP::Mpz::overload_xor = 7 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr); + } table[] = { + { mpz_add }, /* 0 */ + { mpz_sub }, /* 1 */ + { mpz_mul }, /* 2 */ + { mpz_tdiv_q }, /* 3 */ + { mpz_tdiv_r }, /* 4 */ + { mpz_and }, /* 5 */ + { mpz_ior }, /* 6 */ + { mpz_xor }, /* 7 */ + }; +CODE: + assert_table (ix); + if (order == &PL_sv_yes) + SV_PTR_SWAP (xv, yv); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, + coerce_mpz (tmp_mpz_0, xv), + coerce_mpz (tmp_mpz_1, yv)); +OUTPUT: + RETVAL + + +void +overload_addeq (x, y, o) + mpz_assume x + mpz_coerce y + order_noswap o +ALIAS: + GMP::Mpz::overload_subeq = 1 + GMP::Mpz::overload_muleq = 2 + GMP::Mpz::overload_diveq = 3 + GMP::Mpz::overload_remeq = 4 + GMP::Mpz::overload_andeq = 5 + GMP::Mpz::overload_ioreq = 6 + GMP::Mpz::overload_xoreq = 7 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr); + } table[] = { + { mpz_add }, /* 0 */ + { mpz_sub }, /* 1 */ + { mpz_mul }, /* 2 */ + { mpz_tdiv_q }, /* 3 */ + { mpz_tdiv_r }, /* 4 */ + { mpz_and }, /* 5 */ + { mpz_ior }, /* 6 */ + { mpz_xor }, /* 7 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (x->m, x->m, y); + XPUSHs (ST(0)); + + +mpz +overload_lshift (zv, nv, order) + SV *zv + SV *nv + SV *order +ALIAS: + GMP::Mpz::overload_rshift = 1 + GMP::Mpz::overload_pow = 2 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, unsigned long); + } table[] = { + { mpz_mul_2exp }, /* 0 */ + { mpz_fdiv_q_2exp }, /* 1 */ + { mpz_pow_ui }, /* 2 */ + }; +CODE: + assert_table (ix); + if (order == &PL_sv_yes) + SV_PTR_SWAP (zv, nv); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, coerce_mpz (RETVAL->m, zv), coerce_ulong (nv)); +OUTPUT: + RETVAL + + +void +overload_lshifteq (z, n, o) + mpz_assume z + ulong_coerce n + order_noswap o +ALIAS: + GMP::Mpz::overload_rshifteq = 1 + GMP::Mpz::overload_poweq = 2 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, unsigned long); + } table[] = { + { mpz_mul_2exp }, /* 0 */ + { mpz_fdiv_q_2exp }, /* 1 */ + { mpz_pow_ui }, /* 2 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (z->m, z->m, n); + XPUSHs(ST(0)); + + +mpz +overload_abs (z, d1, d2) + mpz_assume z + dummy d1 + dummy d2 +ALIAS: + GMP::Mpz::overload_neg = 1 + GMP::Mpz::overload_com = 2 + GMP::Mpz::overload_sqrt = 3 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr w, mpz_srcptr x); + } table[] = { + { mpz_abs }, /* 0 */ + { mpz_neg }, /* 1 */ + { mpz_com }, /* 2 */ + { mpz_sqrt }, /* 3 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, z->m); +OUTPUT: + RETVAL + + +void +overload_inc (z, d1, d2) + mpz_assume z + dummy d1 + dummy d2 +ALIAS: + GMP::Mpz::overload_dec = 1 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr w, mpz_srcptr x, unsigned long y); + } table[] = { + { mpz_add_ui }, /* 0 */ + { mpz_sub_ui }, /* 1 */ + }; +CODE: + assert_table (ix); + (*table[ix].op) (z->m, z->m, 1L); + + +int +overload_spaceship (xv, yv, order) + SV *xv + SV *yv + SV *order +PREINIT: + mpz x; +CODE: + TRACE (printf ("%s overload_spaceship\n", mpz_class)); + MPZ_ASSUME (x, xv); + switch (use_sv (yv)) { + case USE_IVX: + RETVAL = mpz_cmp_si (x->m, SvIVX(yv)); + break; + case USE_UVX: + RETVAL = mpz_cmp_ui (x->m, SvUVX(yv)); + break; + case USE_PVX: + RETVAL = mpz_cmp (x->m, coerce_mpz (tmp_mpz_0, yv)); + break; + case USE_NVX: + RETVAL = mpz_cmp_d (x->m, SvNVX(yv)); + break; + case USE_MPZ: + RETVAL = mpz_cmp (x->m, SvMPZ(yv)->m); + break; + case USE_MPQ: + RETVAL = x_mpz_cmp_q (x->m, SvMPQ(yv)->m); + break; + case USE_MPF: + RETVAL = x_mpz_cmp_f (x->m, SvMPF(yv)); + break; + default: + croak ("%s <=>: invalid operand", mpz_class); + } + RETVAL = SGN (RETVAL); + if (order == &PL_sv_yes) + RETVAL = -RETVAL; +OUTPUT: + RETVAL + + +bool +overload_bool (z, d1, d2) + mpz_assume z + dummy d1 + dummy d2 +ALIAS: + GMP::Mpz::overload_not = 1 +CODE: + RETVAL = (mpz_sgn (z->m) != 0) ^ ix; +OUTPUT: + RETVAL + + +mpz +bin (n, k) + mpz_coerce n + ulong_coerce k +ALIAS: + GMP::Mpz::root = 1 +PREINIT: + /* mpz_root returns an int, hence the cast */ + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, unsigned long); + } table[] = { + { mpz_bin_ui }, /* 0 */ + { (void (*)(mpz_ptr, mpz_srcptr, unsigned long)) mpz_root }, /* 1 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, n, k); +OUTPUT: + RETVAL + + +void +cdiv (a, d) + mpz_coerce a + mpz_coerce d +ALIAS: + GMP::Mpz::fdiv = 1 + GMP::Mpz::tdiv = 2 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr); + } table[] = { + { mpz_cdiv_qr }, /* 0 */ + { mpz_fdiv_qr }, /* 1 */ + { mpz_tdiv_qr }, /* 2 */ + }; + mpz q, r; +PPCODE: + assert_table (ix); + q = new_mpz(); + r = new_mpz(); + (*table[ix].op) (q->m, r->m, a, d); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (q, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (r, mpz_class_hv)); + + +void +cdiv_2exp (a, d) + mpz_coerce a + ulong_coerce d +ALIAS: + GMP::Mpz::fdiv_2exp = 1 + GMP::Mpz::tdiv_2exp = 2 +PREINIT: + static_functable const struct { + void (*q) (mpz_ptr, mpz_srcptr, unsigned long); + void (*r) (mpz_ptr, mpz_srcptr, unsigned long); + } table[] = { + { mpz_cdiv_q_2exp, mpz_cdiv_r_2exp }, /* 0 */ + { mpz_fdiv_q_2exp, mpz_fdiv_r_2exp }, /* 1 */ + { mpz_tdiv_q_2exp, mpz_tdiv_r_2exp }, /* 2 */ + }; + mpz q, r; +PPCODE: + assert_table (ix); + q = new_mpz(); + r = new_mpz(); + (*table[ix].q) (q->m, a, d); + (*table[ix].r) (r->m, a, d); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (q, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (r, mpz_class_hv)); + + +bool +congruent_p (a, c, d) + mpz_coerce a + mpz_coerce c + mpz_coerce d +PREINIT: +CODE: + RETVAL = mpz_congruent_p (a, c, d); +OUTPUT: + RETVAL + + +bool +congruent_2exp_p (a, c, d) + mpz_coerce a + mpz_coerce c + ulong_coerce d +PREINIT: +CODE: + RETVAL = mpz_congruent_2exp_p (a, c, d); +OUTPUT: + RETVAL + + +mpz +divexact (a, d) + mpz_coerce a + mpz_coerce d +ALIAS: + GMP::Mpz::mod = 1 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr); + } table[] = { + { mpz_divexact }, /* 0 */ + { mpz_mod }, /* 1 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, a, d); +OUTPUT: + RETVAL + + +bool +divisible_p (a, d) + mpz_coerce a + mpz_coerce d +CODE: + RETVAL = mpz_divisible_p (a, d); +OUTPUT: + RETVAL + + +bool +divisible_2exp_p (a, d) + mpz_coerce a + ulong_coerce d +CODE: + RETVAL = mpz_divisible_2exp_p (a, d); +OUTPUT: + RETVAL + + +bool +even_p (z) + mpz_coerce z +ALIAS: + GMP::Mpz::odd_p = 1 + GMP::Mpz::perfect_square_p = 2 + GMP::Mpz::perfect_power_p = 3 +PREINIT: + static_functable const struct { + int (*op) (mpz_srcptr z); + } table[] = { + { x_mpz_even_p }, /* 0 */ + { x_mpz_odd_p }, /* 1 */ + { mpz_perfect_square_p }, /* 2 */ + { mpz_perfect_power_p }, /* 3 */ + }; +CODE: + assert_table (ix); + RETVAL = (*table[ix].op) (z); +OUTPUT: + RETVAL + + +mpz +fac (n) + ulong_coerce n +ALIAS: + GMP::Mpz::fib = 1 + GMP::Mpz::lucnum = 2 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr r, unsigned long n); + } table[] = { + { mpz_fac_ui }, /* 0 */ + { mpz_fib_ui }, /* 1 */ + { mpz_lucnum_ui }, /* 2 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + (*table[ix].op) (RETVAL->m, n); +OUTPUT: + RETVAL + + +void +fib2 (n) + ulong_coerce n +ALIAS: + GMP::Mpz::lucnum2 = 1 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr r, mpz_ptr r2, unsigned long n); + } table[] = { + { mpz_fib2_ui }, /* 0 */ + { mpz_lucnum2_ui }, /* 1 */ + }; + mpz r, r2; +PPCODE: + assert_table (ix); + r = new_mpz(); + r2 = new_mpz(); + (*table[ix].op) (r->m, r2->m, n); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (r, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (r2, mpz_class_hv)); + + +mpz +gcd (x, ...) + mpz_coerce x +ALIAS: + GMP::Mpz::lcm = 1 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr w, mpz_srcptr x, mpz_srcptr y); + void (*op_ui) (mpz_ptr w, mpz_srcptr x, unsigned long y); + } table[] = { + /* cast to ignore ulong return from mpz_gcd_ui */ + { mpz_gcd, + (void (*) (mpz_ptr, mpz_srcptr, unsigned long)) mpz_gcd_ui }, /* 0 */ + { mpz_lcm, mpz_lcm_ui }, /* 1 */ + }; + int i; + SV *yv; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + if (items == 1) + mpz_set (RETVAL->m, x); + else + { + for (i = 1; i < items; i++) + { + yv = ST(i); + if (SvIOK(yv)) + (*table[ix].op_ui) (RETVAL->m, x, ABS(SvIVX(yv))); + else + (*table[ix].op) (RETVAL->m, x, coerce_mpz (tmp_mpz_1, yv)); + x = RETVAL->m; + } + } +OUTPUT: + RETVAL + + +void +gcdext (a, b) + mpz_coerce a + mpz_coerce b +PREINIT: + mpz g, x, y; + SV *sv; +PPCODE: + g = new_mpz(); + x = new_mpz(); + y = new_mpz(); + mpz_gcdext (g->m, x->m, y->m, a, b); + EXTEND (SP, 3); + PUSHs (MPX_NEWMORTAL (g, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (x, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (y, mpz_class_hv)); + + +unsigned long +hamdist (x, y) + mpz_coerce x + mpz_coerce y +CODE: + RETVAL = mpz_hamdist (x, y); +OUTPUT: + RETVAL + + +mpz +invert (a, m) + mpz_coerce a + mpz_coerce m +CODE: + RETVAL = new_mpz(); + if (! mpz_invert (RETVAL->m, a, m)) + { + free_mpz (RETVAL); + XSRETURN_UNDEF; + } +OUTPUT: + RETVAL + + +int +jacobi (a, b) + mpz_coerce a + mpz_coerce b +CODE: + RETVAL = mpz_jacobi (a, b); +OUTPUT: + RETVAL + + +int +kronecker (a, b) + SV *a + SV *b +CODE: + if (SvIOK(b)) + RETVAL = mpz_kronecker_si (coerce_mpz(tmp_mpz_0,a), SvIVX(b)); + else if (SvIOK(a)) + RETVAL = mpz_si_kronecker (SvIVX(a), coerce_mpz(tmp_mpz_0,b)); + else + RETVAL = mpz_kronecker (coerce_mpz(tmp_mpz_0,a), + coerce_mpz(tmp_mpz_1,b)); +OUTPUT: + RETVAL + + +void +mpz_export (order, size, endian, nails, z) + int order + size_t size + int endian + size_t nails + mpz_coerce z +PREINIT: + size_t numb, count, bytes, actual_count; + char *data; + SV *sv; +PPCODE: + numb = 8*size - nails; + count = (mpz_sizeinbase (z, 2) + numb-1) / numb; + bytes = count * size; + New (GMP_MALLOC_ID, data, bytes+1, char); + mpz_export (data, &actual_count, order, size, endian, nails, z); + assert (count == actual_count); + data[bytes] = '\0'; + sv = sv_newmortal(); sv_usepvn_mg (sv, data, bytes); PUSHs(sv); + + +mpz +mpz_import (order, size, endian, nails, sv) + int order + size_t size + int endian + size_t nails + SV *sv +PREINIT: + size_t count; + const char *data; + STRLEN len; +CODE: + data = SvPV (sv, len); + if ((len % size) != 0) + croak ("%s mpz_import: string not a multiple of the given size", + mpz_class); + count = len / size; + RETVAL = new_mpz(); + mpz_import (RETVAL->m, count, order, size, endian, nails, data); +OUTPUT: + RETVAL + + +mpz +nextprime (z) + mpz_coerce z +CODE: + RETVAL = new_mpz(); + mpz_nextprime (RETVAL->m, z); +OUTPUT: + RETVAL + + +unsigned long +popcount (x) + mpz_coerce x +CODE: + RETVAL = mpz_popcount (x); +OUTPUT: + RETVAL + + +mpz +powm (b, e, m) + mpz_coerce b + mpz_coerce e + mpz_coerce m +CODE: + RETVAL = new_mpz(); + mpz_powm (RETVAL->m, b, e, m); +OUTPUT: + RETVAL + + +bool +probab_prime_p (z, n) + mpz_coerce z + ulong_coerce n +CODE: + RETVAL = mpz_probab_prime_p (z, n); +OUTPUT: + RETVAL + + +# No attempt to coerce here, only an mpz makes sense. +void +realloc (z, limbs) + mpz z + int limbs +CODE: + _mpz_realloc (z->m, limbs); + + +void +remove (z, f) + mpz_coerce z + mpz_coerce f +PREINIT: + SV *sv; + mpz rem; + unsigned long mult; +PPCODE: + rem = new_mpz(); + mult = mpz_remove (rem->m, z, f); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (rem, mpz_class_hv)); + PUSHs (sv_2mortal (newSViv (mult))); + + +void +roote (z, n) + mpz_coerce z + ulong_coerce n +PREINIT: + SV *sv; + mpz root; + int exact; +PPCODE: + root = new_mpz(); + exact = mpz_root (root->m, z, n); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (root, mpz_class_hv)); + 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); + PUSHs (MPX_NEWMORTAL (root, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (rem, mpz_class_hv)); + + +# In the past scan0 and scan1 were described as returning ULONG_MAX which +# could be obtained in perl with ~0. That wasn't true on 64-bit systems +# (eg. alpha) with perl 5.005, since in that version IV and UV were still +# 32-bits. +# +# We changed in gmp 4.2 to just say ~0 for the not-found return. It's +# likely most people have used ~0 rather than POSIX::ULONG_MAX(), so this +# change should match existing usage. It only actually makes a difference +# in old perl, since recent versions have gone to 64-bits for IV and UV, the +# same as a ulong. +# +# In perl 5.005 we explicitly mask the mpz return down to 32-bits to get ~0. +# UV_MAX is no good, it reflects the size of the UV type (64-bits), rather +# than the size of the values one ought to be storing in an SV (32-bits). + +gmp_UV +scan0 (z, start) + mpz_coerce z + ulong_coerce start +ALIAS: + GMP::Mpz::scan1 = 1 +PREINIT: + static_functable const struct { + unsigned long (*op) (mpz_srcptr, unsigned long); + } table[] = { + { mpz_scan0 }, /* 0 */ + { mpz_scan1 }, /* 1 */ + }; +CODE: + assert_table (ix); + RETVAL = (*table[ix].op) (z, start); + if (PERL_LT (5,6)) + RETVAL &= 0xFFFFFFFF; +OUTPUT: + RETVAL + + +void +setbit (sv, bit) + SV *sv + ulong_coerce bit +ALIAS: + GMP::Mpz::clrbit = 1 + GMP::Mpz::combit = 2 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, unsigned long); + } table[] = { + { mpz_setbit }, /* 0 */ + { mpz_clrbit }, /* 1 */ + { mpz_combit }, /* 2 */ + }; + int use; + mpz z; +CODE: + use = use_sv (sv); + if (use == USE_MPZ && SvREFCNT(SvRV(sv)) == 1 && ! SvSMAGICAL(sv)) + { + /* our operand is a non-magical mpz with a reference count of 1, so + we can just modify it */ + (*table[ix].op) (SvMPZ(sv)->m, bit); + } + else + { + /* otherwise we need to make a new mpz, from whatever we have, and + operate on that, possibly invoking magic when storing back */ + SV *new_sv; + mpz z = new_mpz (); + mpz_ptr coerce_ptr = coerce_mpz_using (z->m, sv, use); + if (coerce_ptr != z->m) + mpz_set (z->m, coerce_ptr); + (*table[ix].op) (z->m, bit); + new_sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, z), + mpz_class_hv); + SvSetMagicSV (sv, new_sv); + } + + +void +sqrtrem (z) + mpz_coerce z +PREINIT: + SV *sv; + mpz root; + mpz rem; +PPCODE: + root = new_mpz(); + rem = new_mpz(); + mpz_sqrtrem (root->m, rem->m, z); + EXTEND (SP, 2); + PUSHs (MPX_NEWMORTAL (root, mpz_class_hv)); + PUSHs (MPX_NEWMORTAL (rem, mpz_class_hv)); + + +size_t +sizeinbase (z, base) + mpz_coerce z + int base +CODE: + RETVAL = mpz_sizeinbase (z, base); +OUTPUT: + RETVAL + + +int +tstbit (z, bit) + mpz_coerce z + ulong_coerce bit +CODE: + RETVAL = mpz_tstbit (z, bit); +OUTPUT: + RETVAL + + + +#------------------------------------------------------------------------------ + +MODULE = GMP PACKAGE = GMP::Mpq + + +mpq +mpq (...) +ALIAS: + GMP::Mpq::new = 1 +CODE: + TRACE (printf ("%s new, ix=%ld, items=%d\n", mpq_class, ix, (int) items)); + RETVAL = new_mpq(); + switch (items) { + case 0: + mpq_set_ui (RETVAL->m, 0L, 1L); + break; + case 1: + { + mpq_ptr rp = RETVAL->m; + mpq_ptr cp = coerce_mpq (rp, ST(0)); + if (cp != rp) + mpq_set (rp, cp); + } + break; + case 2: + { + mpz_ptr rp, cp; + rp = mpq_numref (RETVAL->m); + cp = coerce_mpz (rp, ST(0)); + if (cp != rp) + mpz_set (rp, cp); + rp = mpq_denref (RETVAL->m); + cp = coerce_mpz (rp, ST(1)); + if (cp != rp) + mpz_set (rp, cp); + } + break; + default: + croak ("%s new: invalid arguments", mpq_class); + } +OUTPUT: + RETVAL + + +void +overload_constant (str, pv, d1, ...) + const_string_assume str + SV *pv + dummy d1 +PREINIT: + SV *sv; + mpq q; +PPCODE: + TRACE (printf ("%s constant: %s\n", mpq_class, str)); + q = new_mpq(); + if (mpq_set_str (q->m, str, 0) == 0) + { sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, q), mpq_class_hv); } + else + { free_mpq (q); sv = pv; } + XPUSHs(sv); + + +mpq +overload_copy (q, d1, d2) + mpq_assume q + dummy d1 + dummy d2 +CODE: + RETVAL = new_mpq(); + mpq_set (RETVAL->m, q->m); +OUTPUT: + RETVAL + + +void +DESTROY (q) + mpq_assume q +CODE: + TRACE (printf ("%s DESTROY %p\n", mpq_class, q)); + free_mpq (q); + + +malloced_string +overload_string (q, d1, d2) + mpq_assume q + dummy d1 + dummy d2 +CODE: + TRACE (printf ("%s overload_string %p\n", mpq_class, q)); + RETVAL = mpq_get_str (NULL, 10, q->m); +OUTPUT: + RETVAL + + +mpq +overload_add (xv, yv, order) + SV *xv + SV *yv + SV *order +ALIAS: + GMP::Mpq::overload_sub = 1 + GMP::Mpq::overload_mul = 2 + GMP::Mpq::overload_div = 3 +PREINIT: + static_functable const struct { + void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr); + } table[] = { + { mpq_add }, /* 0 */ + { mpq_sub }, /* 1 */ + { mpq_mul }, /* 2 */ + { mpq_div }, /* 3 */ + }; +CODE: + TRACE (printf ("%s binary\n", mpf_class)); + assert_table (ix); + if (order == &PL_sv_yes) + SV_PTR_SWAP (xv, yv); + RETVAL = new_mpq(); + (*table[ix].op) (RETVAL->m, + coerce_mpq (tmp_mpq_0, xv), + coerce_mpq (tmp_mpq_1, yv)); +OUTPUT: + RETVAL + + +void +overload_addeq (x, y, o) + mpq_assume x + mpq_coerce y + order_noswap o +ALIAS: + GMP::Mpq::overload_subeq = 1 + GMP::Mpq::overload_muleq = 2 + GMP::Mpq::overload_diveq = 3 +PREINIT: + static_functable const struct { + void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr); + } table[] = { + { mpq_add }, /* 0 */ + { mpq_sub }, /* 1 */ + { mpq_mul }, /* 2 */ + { mpq_div }, /* 3 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (x->m, x->m, y); + XPUSHs(ST(0)); + + +mpq +overload_lshift (qv, nv, order) + SV *qv + SV *nv + SV *order +ALIAS: + GMP::Mpq::overload_rshift = 1 + GMP::Mpq::overload_pow = 2 +PREINIT: + static_functable const struct { + void (*op) (mpq_ptr, mpq_srcptr, unsigned long); + } table[] = { + { mpq_mul_2exp }, /* 0 */ + { mpq_div_2exp }, /* 1 */ + { x_mpq_pow_ui }, /* 2 */ + }; +CODE: + assert_table (ix); + if (order == &PL_sv_yes) + SV_PTR_SWAP (qv, nv); + RETVAL = new_mpq(); + (*table[ix].op) (RETVAL->m, coerce_mpq (RETVAL->m, qv), coerce_ulong (nv)); +OUTPUT: + RETVAL + + +void +overload_lshifteq (q, n, o) + mpq_assume q + ulong_coerce n + order_noswap o +ALIAS: + GMP::Mpq::overload_rshifteq = 1 + GMP::Mpq::overload_poweq = 2 +PREINIT: + static_functable const struct { + void (*op) (mpq_ptr, mpq_srcptr, unsigned long); + } table[] = { + { mpq_mul_2exp }, /* 0 */ + { mpq_div_2exp }, /* 1 */ + { x_mpq_pow_ui }, /* 2 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (q->m, q->m, n); + XPUSHs(ST(0)); + + +void +overload_inc (q, d1, d2) + mpq_assume q + dummy d1 + dummy d2 +ALIAS: + GMP::Mpq::overload_dec = 1 +PREINIT: + static_functable const struct { + void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr); + } table[] = { + { mpz_add }, /* 0 */ + { mpz_sub }, /* 1 */ + }; +CODE: + assert_table (ix); + (*table[ix].op) (mpq_numref(q->m), mpq_numref(q->m), mpq_denref(q->m)); + + +mpq +overload_abs (q, d1, d2) + mpq_assume q + dummy d1 + dummy d2 +ALIAS: + GMP::Mpq::overload_neg = 1 +PREINIT: + static_functable const struct { + void (*op) (mpq_ptr w, mpq_srcptr x); + } table[] = { + { mpq_abs }, /* 0 */ + { mpq_neg }, /* 1 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpq(); + (*table[ix].op) (RETVAL->m, q->m); +OUTPUT: + RETVAL + + +int +overload_spaceship (x, y, order) + mpq_assume x + mpq_coerce y + SV *order +CODE: + RETVAL = mpq_cmp (x->m, y); + RETVAL = SGN (RETVAL); + if (order == &PL_sv_yes) + RETVAL = -RETVAL; +OUTPUT: + RETVAL + + +bool +overload_bool (q, d1, d2) + mpq_assume q + dummy d1 + dummy d2 +ALIAS: + GMP::Mpq::overload_not = 1 +CODE: + RETVAL = (mpq_sgn (q->m) != 0) ^ ix; +OUTPUT: + RETVAL + + +bool +overload_eq (x, yv, d) + mpq_assume x + SV *yv + dummy d +ALIAS: + GMP::Mpq::overload_ne = 1 +PREINIT: + int use; +CODE: + use = use_sv (yv); + switch (use) { + case USE_IVX: + case USE_UVX: + case USE_MPZ: + RETVAL = 0; + if (x_mpq_integer_p (x->m)) + { + switch (use) { + case USE_IVX: + RETVAL = (mpz_cmp_si (mpq_numref(x->m), SvIVX(yv)) == 0); + break; + case USE_UVX: + RETVAL = (mpz_cmp_ui (mpq_numref(x->m), SvUVX(yv)) == 0); + break; + case USE_MPZ: + RETVAL = (mpz_cmp (mpq_numref(x->m), SvMPZ(yv)->m) == 0); + break; + } + } + break; + + case USE_MPQ: + RETVAL = (mpq_equal (x->m, SvMPQ(yv)->m) != 0); + break; + + default: + RETVAL = (mpq_equal (x->m, coerce_mpq_using (tmp_mpq_0, yv, use)) != 0); + break; + } + RETVAL ^= ix; +OUTPUT: + RETVAL + + +void +canonicalize (q) + mpq q +CODE: + mpq_canonicalize (q->m); + + +mpq +inv (q) + mpq_coerce q +CODE: + RETVAL = new_mpq(); + mpq_inv (RETVAL->m, q); +OUTPUT: + RETVAL + + +mpz +num (q) + mpq q +ALIAS: + GMP::Mpq::den = 1 +CODE: + RETVAL = new_mpz(); + mpz_set (RETVAL->m, (ix == 0 ? mpq_numref(q->m) : mpq_denref(q->m))); +OUTPUT: + RETVAL + + + +#------------------------------------------------------------------------------ + +MODULE = GMP PACKAGE = GMP::Mpf + + +mpf +mpf (...) +ALIAS: + GMP::Mpf::new = 1 +PREINIT: + unsigned long prec; +CODE: + TRACE (printf ("%s new\n", mpf_class)); + if (items > 2) + croak ("%s new: invalid arguments", mpf_class); + prec = (items == 2 ? coerce_ulong (ST(1)) : mpf_get_default_prec()); + RETVAL = new_mpf (prec); + if (items >= 1) + { + SV *sv = ST(0); + my_mpf_set_sv_using (RETVAL, sv, use_sv(sv)); + } +OUTPUT: + RETVAL + + +mpf +overload_constant (sv, d1, d2, ...) + SV *sv + dummy d1 + dummy d2 +CODE: + assert (SvPOK (sv)); + TRACE (printf ("%s constant: %s\n", mpq_class, SvPVX(sv))); + RETVAL = new_mpf (mpf_get_default_prec()); + my_mpf_set_svstr (RETVAL, sv); +OUTPUT: + RETVAL + + +mpf +overload_copy (f, d1, d2) + mpf_assume f + dummy d1 + dummy d2 +CODE: + TRACE (printf ("%s copy\n", mpf_class)); + RETVAL = new_mpf (mpf_get_prec (f)); + mpf_set (RETVAL, f); +OUTPUT: + RETVAL + + +void +DESTROY (f) + mpf_assume f +CODE: + TRACE (printf ("%s DESTROY %p\n", mpf_class, f)); + mpf_clear (f); + Safefree (f); + assert_support (mpf_count--); + TRACE_ACTIVE (); + + +mpf +overload_add (x, y, order) + mpf_assume x + mpf_coerce_st0 y + SV *order +ALIAS: + GMP::Mpf::overload_sub = 1 + GMP::Mpf::overload_mul = 2 + GMP::Mpf::overload_div = 3 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr); + } table[] = { + { mpf_add }, /* 0 */ + { mpf_sub }, /* 1 */ + { mpf_mul }, /* 2 */ + { mpf_div }, /* 3 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpf (mpf_get_prec (x)); + if (order == &PL_sv_yes) + MPF_PTR_SWAP (x, y); + (*table[ix].op) (RETVAL, x, y); +OUTPUT: + RETVAL + + +void +overload_addeq (x, y, o) + mpf_assume x + mpf_coerce_st0 y + order_noswap o +ALIAS: + GMP::Mpf::overload_subeq = 1 + GMP::Mpf::overload_muleq = 2 + GMP::Mpf::overload_diveq = 3 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr); + } table[] = { + { mpf_add }, /* 0 */ + { mpf_sub }, /* 1 */ + { mpf_mul }, /* 2 */ + { mpf_div }, /* 3 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (x, x, y); + XPUSHs(ST(0)); + + +mpf +overload_lshift (fv, nv, order) + SV *fv + SV *nv + SV *order +ALIAS: + GMP::Mpf::overload_rshift = 1 + GMP::Mpf::overload_pow = 2 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr, mpf_srcptr, unsigned long); + } table[] = { + { mpf_mul_2exp }, /* 0 */ + { mpf_div_2exp }, /* 1 */ + { mpf_pow_ui }, /* 2 */ + }; + mpf f; + unsigned long prec; +CODE: + assert_table (ix); + MPF_ASSUME (f, fv); + prec = mpf_get_prec (f); + if (order == &PL_sv_yes) + SV_PTR_SWAP (fv, nv); + f = coerce_mpf (tmp_mpf_0, fv, prec); + RETVAL = new_mpf (prec); + (*table[ix].op) (RETVAL, f, coerce_ulong (nv)); +OUTPUT: + RETVAL + + +void +overload_lshifteq (f, n, o) + mpf_assume f + ulong_coerce n + order_noswap o +ALIAS: + GMP::Mpf::overload_rshifteq = 1 + GMP::Mpf::overload_poweq = 2 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr, mpf_srcptr, unsigned long); + } table[] = { + { mpf_mul_2exp }, /* 0 */ + { mpf_div_2exp }, /* 1 */ + { mpf_pow_ui }, /* 2 */ + }; +PPCODE: + assert_table (ix); + (*table[ix].op) (f, f, n); + XPUSHs(ST(0)); + + +mpf +overload_abs (f, d1, d2) + mpf_assume f + dummy d1 + dummy d2 +ALIAS: + GMP::Mpf::overload_neg = 1 + GMP::Mpf::overload_sqrt = 2 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr w, mpf_srcptr x); + } table[] = { + { mpf_abs }, /* 0 */ + { mpf_neg }, /* 1 */ + { mpf_sqrt }, /* 2 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpf (mpf_get_prec (f)); + (*table[ix].op) (RETVAL, f); +OUTPUT: + RETVAL + + +void +overload_inc (f, d1, d2) + mpf_assume f + dummy d1 + dummy d2 +ALIAS: + GMP::Mpf::overload_dec = 1 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr w, mpf_srcptr x, unsigned long y); + } table[] = { + { mpf_add_ui }, /* 0 */ + { mpf_sub_ui }, /* 1 */ + }; +CODE: + assert_table (ix); + (*table[ix].op) (f, f, 1L); + + +int +overload_spaceship (xv, yv, order) + SV *xv + SV *yv + SV *order +PREINIT: + mpf x; +CODE: + MPF_ASSUME (x, xv); + switch (use_sv (yv)) { + case USE_IVX: + RETVAL = mpf_cmp_si (x, SvIVX(yv)); + break; + case USE_UVX: + RETVAL = mpf_cmp_ui (x, SvUVX(yv)); + break; + case USE_NVX: + RETVAL = mpf_cmp_d (x, SvNVX(yv)); + break; + case USE_PVX: + { + STRLEN len; + const char *str = SvPV (yv, len); + /* enough for all digits of the string */ + tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64); + if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0) + croak ("%s <=>: invalid string format", mpf_class); + RETVAL = mpf_cmp (x, tmp_mpf_0->m); + } + break; + case USE_MPZ: + RETVAL = - x_mpz_cmp_f (SvMPZ(yv)->m, x); + break; + case USE_MPF: + RETVAL = mpf_cmp (x, SvMPF(yv)); + break; + default: + RETVAL = mpq_cmp (coerce_mpq (tmp_mpq_0, xv), + coerce_mpq (tmp_mpq_1, yv)); + break; + } + RETVAL = SGN (RETVAL); + if (order == &PL_sv_yes) + RETVAL = -RETVAL; +OUTPUT: + RETVAL + + +bool +overload_bool (f, d1, d2) + mpf_assume f + dummy d1 + dummy d2 +ALIAS: + GMP::Mpf::overload_not = 1 +CODE: + RETVAL = (mpf_sgn (f) != 0) ^ ix; +OUTPUT: + RETVAL + + +mpf +ceil (f) + mpf_coerce_def f +ALIAS: + GMP::Mpf::floor = 1 + GMP::Mpf::trunc = 2 +PREINIT: + static_functable const struct { + void (*op) (mpf_ptr w, mpf_srcptr x); + } table[] = { + { mpf_ceil }, /* 0 */ + { mpf_floor }, /* 1 */ + { mpf_trunc }, /* 2 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpf (mpf_get_prec (f)); + (*table[ix].op) (RETVAL, f); +OUTPUT: + RETVAL + + +unsigned long +get_default_prec () +CODE: + RETVAL = mpf_get_default_prec(); +OUTPUT: + RETVAL + + +unsigned long +get_prec (f) + mpf_coerce_def f +CODE: + RETVAL = mpf_get_prec (f); +OUTPUT: + RETVAL + + +bool +mpf_eq (xv, yv, bits) + SV *xv + SV *yv + ulong_coerce bits +PREINIT: + mpf x, y; +CODE: + TRACE (printf ("%s eq\n", mpf_class)); + coerce_mpf_pair (&x,xv, &y,yv); + RETVAL = mpf_eq (x, y, bits); +OUTPUT: + RETVAL + + +mpf +reldiff (xv, yv) + SV *xv + SV *yv +PREINIT: + mpf x, y; + unsigned long prec; +CODE: + TRACE (printf ("%s reldiff\n", mpf_class)); + prec = coerce_mpf_pair (&x,xv, &y,yv); + RETVAL = new_mpf (prec); + mpf_reldiff (RETVAL, x, y); +OUTPUT: + RETVAL + + +void +set_default_prec (prec) + ulong_coerce prec +CODE: + TRACE (printf ("%s set_default_prec %lu\n", mpf_class, prec)); + mpf_set_default_prec (prec); + + +void +set_prec (sv, prec) + SV *sv + ulong_coerce prec +PREINIT: + mpf_ptr old_f, new_f; + int use; +CODE: + TRACE (printf ("%s set_prec to %lu\n", mpf_class, prec)); + use = use_sv (sv); + if (use == USE_MPF) + { + old_f = SvMPF(sv); + if (SvREFCNT(SvRV(sv)) == 1) + mpf_set_prec (old_f, prec); + else + { + TRACE (printf (" fork new mpf\n")); + new_f = new_mpf (prec); + mpf_set (new_f, old_f); + goto setref; + } + } + else + { + TRACE (printf (" coerce to mpf\n")); + new_f = new_mpf (prec); + my_mpf_set_sv_using (new_f, sv, use); + setref: + sv_bless (sv_setref_pv (sv, NULL, new_f), mpf_class_hv); + } + + + +#------------------------------------------------------------------------------ + +MODULE = GMP PACKAGE = GMP::Rand + +randstate +new (...) +ALIAS: + GMP::Rand::randstate = 1 +CODE: + TRACE (printf ("%s new\n", rand_class)); + New (GMP_MALLOC_ID, RETVAL, 1, __gmp_randstate_struct); + TRACE (printf (" RETVAL %p\n", RETVAL)); + assert_support (rand_count++); + TRACE_ACTIVE (); + + if (items == 0) + { + gmp_randinit_default (RETVAL); + } + else + { + if (SvROK (ST(0)) && sv_derived_from (ST(0), rand_class)) + { + if (items != 1) + goto invalid; + gmp_randinit_set (RETVAL, SvRANDSTATE (ST(0))); + } + 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 (items != 1) + goto invalid; + gmp_randinit_mt (RETVAL); + } + else + { + invalid: + croak ("%s new: invalid arguments", rand_class); + } + } + } +OUTPUT: + RETVAL + + +void +DESTROY (r) + randstate r +CODE: + TRACE (printf ("%s DESTROY\n", rand_class)); + gmp_randclear (r); + Safefree (r); + assert_support (rand_count--); + TRACE_ACTIVE (); + + +void +seed (r, z) + randstate r + mpz_coerce z +CODE: + gmp_randseed (r, z); + + +mpz +mpz_urandomb (r, bits) + randstate r + ulong_coerce bits +ALIAS: + GMP::Rand::mpz_rrandomb = 1 +PREINIT: + static_functable const struct { + void (*fun) (mpz_ptr, gmp_randstate_t r, unsigned long bits); + } table[] = { + { mpz_urandomb }, /* 0 */ + { mpz_rrandomb }, /* 1 */ + }; +CODE: + assert_table (ix); + RETVAL = new_mpz(); + (*table[ix].fun) (RETVAL->m, r, bits); +OUTPUT: + RETVAL + + +mpz +mpz_urandomm (r, m) + randstate r + mpz_coerce m +CODE: + RETVAL = new_mpz(); + mpz_urandomm (RETVAL->m, r, m); +OUTPUT: + RETVAL + + +mpf +mpf_urandomb (r, bits) + randstate r + ulong_coerce bits +CODE: + RETVAL = new_mpf (bits); + 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_functable 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/vendor/gmp-6.3.0/demos/perl/GMP/Mpf.pm b/vendor/gmp-6.3.0/demos/perl/GMP/Mpf.pm new file mode 100644 index 0000000..4c0dec6 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP/Mpf.pm @@ -0,0 +1,106 @@ +# GMP mpf module. + +# Copyright 2001, 2003 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +package GMP::Mpf; + +require GMP; +require Exporter; +@ISA = qw(GMP Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(); +%EXPORT_TAGS = ('all' => [qw( + ceil floor get_default_prec get_prec mpf mpf_eq + reldiff set_default_prec set_prec trunc)], + 'constants' => [@EXPORT], + 'noconstants' => [@EXPORT]); +Exporter::export_ok_tags('all'); + +use overload + '+' => \&overload_add, '+=' => \&overload_addeq, + '-' => \&overload_sub, '-=' => \&overload_subeq, + '*' => \&overload_mul, '*=' => \&overload_muleq, + '/' => \&overload_div, '/=' => \&overload_diveq, + '**' => \&overload_pow, '**=' => \&overload_poweq, + '<<' => \&overload_lshift, '<<=' => \&overload_lshifteq, + '>>' => \&overload_rshift, '>>=' => \&overload_rshifteq, + + 'bool' => \&overload_bool, + 'not' => \&overload_not, + '!' => \&overload_not, + '<=>' => \&overload_spaceship, + '++' => \&overload_inc, + '--' => \&overload_dec, + 'abs' => \&overload_abs, + 'neg' => \&overload_neg, + 'sqrt' => \&overload_sqrt, + '=' => \&overload_copy, + '""' => \&overload_string; + +sub import { + foreach (@_) { + if ($_ eq ':constants') { + overload::constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } elsif ($_ eq ':noconstants') { + overload::remove_constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } + } + goto &Exporter::import; +} + + +sub overload_string { + my $fmt; + BEGIN { $^W = 0; } + if (defined ($#)) { + $fmt = $#; + BEGIN { $^W = 1; } + # protect against calling sprintf_internal with a bad format + if ($fmt !~ /^((%%|[^%])*%[-+ .\d]*)([eEfgG](%%|[^%])*)$/) { + die "GMP::Mpf: invalid \$# format: $#\n"; + } + $fmt = $1 . 'F' . $3; + } else { + $fmt = '%.Fg'; + } + GMP::sprintf_internal ($fmt, $_[0]); +} + +1; +__END__ + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/GMP/Mpq.pm b/vendor/gmp-6.3.0/demos/perl/GMP/Mpq.pm new file mode 100644 index 0000000..fe01084 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP/Mpq.pm @@ -0,0 +1,89 @@ +# GMP mpq module. + +# Copyright 2001 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +package GMP::Mpq; + +require GMP; +require Exporter; +@ISA = qw(GMP Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(); +%EXPORT_TAGS = ('all' => [qw(canonicalize den inv mpq num)], + 'constants' => [@EXPORT], + 'noconstants' => [@EXPORT] ); +Exporter::export_ok_tags('all'); + +use overload + '+' => \&overload_add, '+=' => \&overload_addeq, + '-' => \&overload_sub, '-=' => \&overload_subeq, + '*' => \&overload_mul, '*=' => \&overload_muleq, + '/' => \&overload_div, '/=' => \&overload_diveq, + '**' => \&overload_pow, '**=' => \&overload_poweq, + '<<' => \&overload_lshift, '<<=' => \&overload_lshifteq, + '>>' => \&overload_rshift, '>>=' => \&overload_rshifteq, + + 'bool' => \&overload_bool, + 'not' => \&overload_not, + '!' => \&overload_not, + '==' => \&overload_eq, + '!=' => \&overload_ne, + '<=>' => \&overload_spaceship, + '++' => \&overload_inc, + '--' => \&overload_dec, + 'abs' => \&overload_abs, + 'neg' => \&overload_neg, + '=' => \&overload_copy, + '""' => \&overload_string; + +my $constants = { }; + +sub import { + foreach (@_) { + if ($_ eq ':constants') { + overload::constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } elsif ($_ eq ':noconstants') { + overload::remove_constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } + } + goto &Exporter::import; +} + +1; +__END__ + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/GMP/Mpz.pm b/vendor/gmp-6.3.0/demos/perl/GMP/Mpz.pm new file mode 100644 index 0000000..27e6336 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP/Mpz.pm @@ -0,0 +1,101 @@ +# GMP mpz module. + +# Copyright 2001-2003 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +package GMP::Mpz; + +require GMP; +require Exporter; +@ISA = qw(GMP Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(); +%EXPORT_TAGS = ('all' => [qw( + 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 mpz_export + mpz_import nextprime odd_p perfect_power_p + perfect_square_p popcount powm probab_prime_p + realloc remove root roote rootrem scan0 scan1 + setbit sizeinbase sqrtrem tdiv tdiv_2exp + tstbit)], + 'constants' => [@EXPORT], + 'noconstants' => [@EXPORT]); +Exporter::export_ok_tags('all'); + +use overload + '+' => \&overload_add, '+=' => \&overload_addeq, + '-' => \&overload_sub, '-=' => \&overload_subeq, + '*' => \&overload_mul, '*=' => \&overload_muleq, + '/' => \&overload_div, '/=' => \&overload_diveq, + '%' => \&overload_rem, '%=' => \&overload_remeq, + '<<' => \&overload_lshift, '<<=' => \&overload_lshifteq, + '>>' => \&overload_rshift, '>>=' => \&overload_rshifteq, + '**' => \&overload_pow, '**=' => \&overload_poweq, + '&' => \&overload_and, '&=' => \&overload_andeq, + '|' => \&overload_ior, '|=' => \&overload_ioreq, + '^' => \&overload_xor, '^=' => \&overload_xoreq, + + 'bool' => \&overload_bool, + 'not' => \&overload_not, + '!' => \&overload_not, + '~' => \&overload_com, + '<=>' => \&overload_spaceship, + '++' => \&overload_inc, + '--' => \&overload_dec, + '=' => \&overload_copy, + 'abs' => \&overload_abs, + 'neg' => \&overload_neg, + 'sqrt' => \&overload_sqrt, + '""' => \&overload_string; + +sub import { + foreach (@_) { + if ($_ eq ':constants') { + overload::constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } elsif ($_ eq ':noconstants') { + overload::remove_constant ('integer' => \&overload_constant, + 'binary' => \&overload_constant, + 'float' => \&overload_constant); + } + } + goto &Exporter::import; +} + +1; +__END__ + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/GMP/Rand.pm b/vendor/gmp-6.3.0/demos/perl/GMP/Rand.pm new file mode 100644 index 0000000..9f7d763 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/GMP/Rand.pm @@ -0,0 +1,44 @@ +# GMP random numbers module. + +# Copyright 2001, 2003 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +package GMP::Rand; + +require GMP; +require Exporter; +@ISA = qw(GMP Exporter); +@EXPORT = qw(); +%EXPORT_TAGS = ('all' => [qw( + randstate mpf_urandomb mpz_rrandomb + mpz_urandomb mpz_urandomm gmp_urandomb_ui + gmp_urandomm_ui)]); +Exporter::export_ok_tags('all'); +1; +__END__ diff --git a/vendor/gmp-6.3.0/demos/perl/INSTALL b/vendor/gmp-6.3.0/demos/perl/INSTALL new file mode 100644 index 0000000..f3d7c53 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/INSTALL @@ -0,0 +1,88 @@ +Copyright 2001, 2003, 2004 Free Software Foundation, Inc. + +This file is part of the GNU MP Library. + +The GNU MP Library is free software; you can redistribute it and/or modify +it under the terms of either: + + * 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. + +or + + * the GNU General Public License as published by the Free Software + Foundation; either version 2 of the License, or (at your option) any + later version. + +or both in parallel, as here. + +The GNU MP 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 General Public License +for more details. + +You should have received copies of the GNU General Public License and the +GNU Lesser General Public License along with the GNU MP Library. If not, +see https://www.gnu.org/licenses/. + + + + + + GMP PERL MODULE INSTALLATION + + +This module can be compiled within the GMP source directory or moved +elsewhere and compiled. An installed GMP can be used, or a specified +GMP build tree. Both static and shared GMP builds will work. + +The simplest case is when GMP has been installed to a standard system +location + + perl Makefile.PL + make + +If not yet installed then the top-level GMP build directory must be +specified + + perl Makefile.PL GMP_BUILDDIR=/my/gmp/build + make + +In any case, with the module built, the sample program provided can be +run + + perl -Iblib/arch sample.pl + +If you built a shared version of libgmp but haven't yet installed it, +then it might be necessary to add a run-time path to it. For example + + LD_LIBRARY_PATH=/my/gmp/build/.libs perl -Iblib/arch sample.pl + +Documentation is provided in pod format in GMP.pm, and will have been +"man"-ified in the module build + + man -l blib/man3/GMP.3pm +or + man -M`pwd`/blib GMP + +A test script is provided, running a large number of more or less +trivial checks + + make test + +The module and its documentation can be installed in the usual way + + make install + +This will be into /usr/local or wherever the perl Config module +directs, but that can be controlled back at the Makefile.PL stage with +the usual ExtUtils::MakeMaker options. + +Once installed, programs using the GMP module become simply + + perl sample.pl + +And the documentation read directly too + + man GMP diff --git a/vendor/gmp-6.3.0/demos/perl/Makefile.PL b/vendor/gmp-6.3.0/demos/perl/Makefile.PL new file mode 100644 index 0000000..a676710 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/Makefile.PL @@ -0,0 +1,82 @@ +# Makefile for GMP perl module. + +# Copyright 2001, 2003, 2004 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +# Bugs: +# +# When the generated Makefile re-runs "perl Makefile.PL" the GMP_BUILDDIR +# parameter is lost. + + +use ExtUtils::MakeMaker; + + +# Find and remove our parameters +@ARGV = map { + if (/^GMP_BUILDDIR=(.*)/) { + $GMP_BUILDDIR=$1; (); + } else { + $_; + } +} (@ARGV); + +$INC = ""; +$LIBS = "-lgmp"; +$OBJECT = "GMP.o"; + +if (defined $GMP_BUILDDIR) { + if (! -f "$GMP_BUILDDIR/libgmp.la") { + die "$GMP_BUILDDIR doesn't contain libgmp.la\n" . + "if it's really a gmp build directory then go there and run \"make libgmp.la\"\n"; + } + $INC = "-I$GMP_BUILDDIR $INC"; + $LIBS = "-L$GMP_BUILDDIR/.libs $LIBS"; +} + +WriteMakefile( + NAME => 'GMP', + VERSION => '2.00', + LIBS => [$LIBS], + OBJECT => $OBJECT, + INC => $INC, + clean => { FILES => 'test.tmp' }, + PM => { + 'GMP.pm' => '$(INST_LIBDIR)/GMP.pm', + 'GMP/Mpz.pm' => '$(INST_LIBDIR)/GMP/Mpz.pm', + 'GMP/Mpq.pm' => '$(INST_LIBDIR)/GMP/Mpq.pm', + 'GMP/Mpf.pm' => '$(INST_LIBDIR)/GMP/Mpf.pm', + 'GMP/Rand.pm' => '$(INST_LIBDIR)/GMP/Rand.pm', + } + ); + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/sample.pl b/vendor/gmp-6.3.0/demos/perl/sample.pl new file mode 100644 index 0000000..8a10ee1 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/sample.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w + +# Some sample GMP module operations + +# Copyright 2001, 2004 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + +use strict; + + +use GMP; +print "using GMP module $GMP::VERSION and GMP library ",GMP::version(),"\n"; + + +use GMP::Mpz qw(:all); +print "the 200th fibonacci number is ", fib(200), "\n"; +print "next prime after 10**30 is (probably) ", nextprime(mpz(10)**30), "\n"; + + +use GMP::Mpq qw(:constants); +print "the 7th harmonic number is ", 1+1/2+1/3+1/4+1/5+1/6+1/7, "\n"; +use GMP::Mpq qw(:noconstants); + + +use GMP::Mpf qw(mpf); +my $f = mpf(1,180); +$f >>= 180; +$f += 1; +print "a sample mpf is $f\n"; diff --git a/vendor/gmp-6.3.0/demos/perl/test.pl b/vendor/gmp-6.3.0/demos/perl/test.pl new file mode 100644 index 0000000..2b54089 --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/test.pl @@ -0,0 +1,2179 @@ +#!/usr/bin/perl -w + +# GMP perl module tests + +# Copyright 2001-2003 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +# These tests aim to exercise the many possible combinations of operands +# etc, and to run all functions at least once, which if nothing else will +# check everything intended is in the :all list. +# +# Use the following in .emacs to match test failure messages. +# +# ;; perl "Test" module error messages +# (eval-after-load "compile" +# '(add-to-list +# 'compilation-error-regexp-alist +# '("^.*Failed test [0-9]+ in \\([^ ]+\\) at line \\([0-9]+\\)" 1 2))) + + +use strict; +use Test; + +BEGIN { + plan tests => 123, + onfail => sub { print "there were failures\n" }, +} + +use GMP qw(:all); +use GMP::Mpz qw(:all); +use GMP::Mpq qw(:all); +use GMP::Mpf qw(:all); +use GMP::Rand qw(:all); + +use GMP::Mpz qw(:constants); +use GMP::Mpz qw(:noconstants); +use GMP::Mpq qw(:constants); +use GMP::Mpq qw(:noconstants); +use GMP::Mpf qw(:constants); +use GMP::Mpf qw(:noconstants); + +package Mytie; +use Exporter; +use vars qw($val $fetched $stored); +$val = 0; +$fetched = 0; +$stored = 0; +sub TIESCALAR { + my ($class, $newval) = @_; + my $var = 'mytie dummy refed var'; + $val = $newval; + $fetched = 0; + $stored = 0; + return bless \$var, $class; +} +sub FETCH { + my ($self) = @_; + $fetched++; + return $val; +} +sub STORE { + my ($self, $newval) = @_; + $val = $newval; + $stored++; +} +package main; + +# check Mytie does what it should +{ tie my $t, 'Mytie', 123; + ok ($Mytie::val == 123); + $Mytie::val = 456; + ok ($t == 456); + $t = 789; + ok ($Mytie::val == 789); +} + + +# Usage: str(x) +# Return x forced to a string, not a PVIV. +# +sub str { + my $s = "$_[0]" . ""; + return $s; +} + +my $ivnv_2p128 = 65536.0 * 65536.0 * 65536.0 * 65536.0 + * 65536.0 * 65536.0 * 65536.0 * 65536.0; +kill (0, $ivnv_2p128); +my $str_2p128 = '340282366920938463463374607431768211456'; + +my $uv_max = ~ 0; +my $uv_max_str = ~ 0; +$uv_max_str = "$uv_max_str"; +$uv_max_str = "" . "$uv_max_str"; + + +#------------------------------------------------------------------------------ +# GMP::version + +use GMP qw(version); +print '$GMP::VERSION ',$GMP::VERSION,' GMP::version() ',version(),"\n"; + + +#------------------------------------------------------------------------------ +# GMP::Mpz::new + +ok (mpz(0) == 0); +ok (mpz('0') == 0); +ok (mpz(substr('101',1,1)) == 0); +ok (mpz(0.0) == 0); +ok (mpz(mpz(0)) == 0); +ok (mpz(mpq(0)) == 0); +ok (mpz(mpf(0)) == 0); + +{ tie my $t, 'Mytie', 0; + ok (mpz($t) == 0); + ok ($Mytie::fetched > 0); +} +{ tie my $t, 'Mytie', '0'; + ok (mpz($t) == 0); + ok ($Mytie::fetched > 0); +} +{ tie my $t, 'Mytie', substr('101',1,1); ok (mpz($t) == 0); } +{ tie my $t, 'Mytie', 0.0; ok (mpz($t) == 0); } +{ tie my $t, 'Mytie', mpz(0); ok (mpz($t) == 0); } +{ tie my $t, 'Mytie', mpq(0); ok (mpz($t) == 0); } +{ tie my $t, 'Mytie', mpf(0); ok (mpz($t) == 0); } + +ok (mpz(-123) == -123); +ok (mpz('-123') == -123); +ok (mpz(substr('1-1231',1,4)) == -123); +ok (mpz(-123.0) == -123); +ok (mpz(mpz(-123)) == -123); +ok (mpz(mpq(-123)) == -123); +ok (mpz(mpf(-123)) == -123); + +{ tie my $t, 'Mytie', -123; ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', '-123'; ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', -123.0; ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', mpz(-123); ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', mpq(-123); ok (mpz($t) == -123); } +{ tie my $t, 'Mytie', mpf(-123); ok (mpz($t) == -123); } + +ok (mpz($ivnv_2p128) == $str_2p128); +{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpz($t) == $str_2p128); } + +ok (mpz($uv_max) > 0); +ok (mpz($uv_max) == mpz($uv_max_str)); +{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) > 0); } +{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) == mpz($uv_max_str)); } + +{ my $s = '999999999999999999999999999999'; + kill (0, $s); + ok (mpz($s) == '999999999999999999999999999999'); + tie my $t, 'Mytie', $s; + ok (mpz($t) == '999999999999999999999999999999'); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_abs + +ok (abs(mpz(0)) == 0); +ok (abs(mpz(123)) == 123); +ok (abs(mpz(-123)) == 123); + +{ my $x = mpz(-123); $x = abs($x); ok ($x == 123); } +{ my $x = mpz(0); $x = abs($x); ok ($x == 0); } +{ my $x = mpz(123); $x = abs($x); ok ($x == 123); } + +{ tie my $t, 'Mytie', mpz(0); ok (abs($t) == 0); } +{ tie my $t, 'Mytie', mpz(123); ok (abs($t) == 123); } +{ tie my $t, 'Mytie', mpz(-123); ok (abs($t) == 123); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_add + +ok (mpz(0) + 1 == 1); +ok (mpz(-1) + 1 == 0); +ok (1 + mpz(0) == 1); +ok (1 + mpz(-1) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_addeq + +{ my $a = mpz(7); $a += 1; ok ($a == 8); } +{ my $a = mpz(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_and + +ok ((mpz(3) & 1) == 1); +ok ((mpz(3) & 4) == 0); + +{ my $a = mpz(3); $a &= 1; ok ($a == 1); } +{ my $a = mpz(3); $a &= 4; ok ($a == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_bool + +if (mpz(0)) { ok (0); } else { ok (1); } +if (mpz(123)) { ok (1); } else { ok (0); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_com + +ok (~ mpz(0) == -1); +ok (~ mpz(1) == -2); +ok (~ mpz(-2) == 1); +ok (~ mpz(0xFF) == -0x100); +ok (~ mpz(-0x100) == 0xFF); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_dec + +{ my $a = mpz(0); ok ($a-- == 0); ok ($a == -1); } +{ my $a = mpz(0); ok (--$a == -1); } + +{ my $a = mpz(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_div + +ok (mpz(6) / 2 == 3); +ok (mpz(-6) / 2 == -3); +ok (mpz(6) / -2 == -3); +ok (mpz(-6) / -2 == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_diveq + +{ my $a = mpz(21); $a /= 3; ok ($a == 7); } +{ my $a = mpz(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_eq + +{ my $a = mpz(0); + my $b = $a; + $a = mpz(1); + ok ($a == 1); + ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_inc + +{ my $a = mpz(0); ok ($a++ == 0); ok ($a == 1); } +{ my $a = mpz(0); ok (++$a == 1); } + +{ my $a = mpz(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_ior + +ok ((mpz(3) | 1) == 3); +ok ((mpz(3) | 4) == 7); + +{ my $a = mpz(3); $a |= 1; ok ($a == 3); } +{ my $a = mpz(3); $a |= 4; ok ($a == 7); } + +ok ((mpz("0xAA") | mpz("0x55")) == mpz("0xFF")); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_lshift + +{ my $a = mpz(7) << 1; ok ($a == 14); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_lshifteq + +{ my $a = mpz(7); $a <<= 1; ok ($a == 14); } +{ my $a = mpz(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_mul + +ok (mpz(2) * 3 == 6); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_muleq + +{ my $a = mpz(7); $a *= 3; ok ($a == 21); } +{ my $a = mpz(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_neg + +ok (- mpz(0) == 0); +ok (- mpz(123) == -123); +ok (- mpz(-123) == 123); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_not + +if (not mpz(0)) { ok (1); } else { ok (0); } +if (not mpz(123)) { ok (0); } else { ok (1); } + +ok ((! mpz(0)) == 1); +ok ((! mpz(123)) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_pow + +ok (mpz(0) ** 1 == 0); +ok (mpz(1) ** 1 == 1); +ok (mpz(2) ** 0 == 1); +ok (mpz(2) ** 1 == 2); +ok (mpz(2) ** 2 == 4); +ok (mpz(2) ** 3 == 8); +ok (mpz(2) ** 4 == 16); + +ok (mpz(0) ** mpz(1) == 0); +ok (mpz(1) ** mpz(1) == 1); +ok (mpz(2) ** mpz(0) == 1); +ok (mpz(2) ** mpz(1) == 2); +ok (mpz(2) ** mpz(2) == 4); +ok (mpz(2) ** mpz(3) == 8); +ok (mpz(2) ** mpz(4) == 16); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_poweq + +{ my $a = mpz(3); $a **= 4; ok ($a == 81); } +{ my $a = mpz(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_rem + +ok (mpz(-8) % 3 == -2); +ok (mpz(-7) % 3 == -1); +ok (mpz(-6) % 3 == 0); +ok (mpz(6) % 3 == 0); +ok (mpz(7) % 3 == 1); +ok (mpz(8) % 3 == 2); + +{ my $a = mpz(24); $a %= 7; ok ($a == 3); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_rshift + +{ my $a = mpz(32) >> 1; ok ($a == 16); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_rshifteq + +{ my $a = mpz(32); $a >>= 1; ok ($a == 16); } +{ my $a = mpz(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_spaceship + +ok (mpz(0) < 1); +ok (mpz(0) > -1); + +ok (mpz(0) != 1); +ok (mpz(0) != -1); +ok (mpz(1) != 0); +ok (mpz(1) != -1); +ok (mpz(-1) != 0); +ok (mpz(-1) != 1); + +ok (mpz(0) < 1.0); +ok (mpz(0) < '1'); +ok (mpz(0) < substr('-1',1,1)); +ok (mpz(0) < mpz(1)); +ok (mpz(0) < mpq(1)); +ok (mpz(0) < mpf(1)); +ok (mpz(0) < $uv_max); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_sqrt + +ok (sqrt(mpz(0)) == 0); +ok (sqrt(mpz(1)) == 1); +ok (sqrt(mpz(4)) == 2); +ok (sqrt(mpz(81)) == 9); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_string + +{ my $x = mpz(0); ok("$x" eq "0"); } +{ my $x = mpz(123); ok("$x" eq "123"); } +{ my $x = mpz(-123); ok("$x" eq "-123"); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_sub + +ok (mpz(0) - 1 == -1); +ok (mpz(1) - 1 == 0); +ok (1 - mpz(0) == 1); +ok (1 - mpz(1) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_subeq + +{ my $a = mpz(7); $a -= 1; ok ($a == 6); } +{ my $a = mpz(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::overload_xor + +ok ((mpz(3) ^ 1) == 2); +ok ((mpz(3) ^ 4) == 7); + +{ my $a = mpz(3); $a ^= 1; ok ($a == 2); } +{ my $a = mpz(3); $a ^= 4; ok ($a == 7); } + + +#------------------------------------------------------------------------------ +# GMP::Mpz::bin + +ok (bin(2,0) == 1); +ok (bin(2,1) == 2); +ok (bin(2,2) == 1); + +ok (bin(3,0) == 1); +ok (bin(3,1) == 3); +ok (bin(3,2) == 3); +ok (bin(3,3) == 1); + + +#------------------------------------------------------------------------------ +# GMP::Mpz::cdiv + +{ my ($q, $r); + ($q, $r) = cdiv (16, 3); + ok ($q == 6); + ok ($r == -2); + ($q, $r) = cdiv (16, -3); + ok ($q == -5); + ok ($r == 1); + ($q, $r) = cdiv (-16, 3); + ok ($q == -5); + ok ($r == -1); + ($q, $r) = cdiv (-16, -3); + ok ($q == 6); + ok ($r == 2); +} + + +#------------------------------------------------------------------------------ +# GMP::Mpz::cdiv_2exp + +{ my ($q, $r); + ($q, $r) = cdiv_2exp (23, 2); + ok ($q == 6); + ok ($r == -1); + ($q, $r) = cdiv_2exp (-23, 2); + ok ($q == -5); + ok ($r == -3); +} + + +#------------------------------------------------------------------------------ +# GMP::Mpz::clrbit + +{ my $a = mpz(3); clrbit ($a, 1); ok ($a == 1); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } +{ my $a = mpz(3); clrbit ($a, 2); ok ($a == 3); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } + +{ my $a = 3; clrbit ($a, 1); ok ($a == 1); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } +{ my $a = 3; clrbit ($a, 2); ok ($a == 3); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } + +# mutate only given variable +{ my $a = mpz(3); + my $b = $a; + clrbit ($a, 0); + ok ($a == 2); + ok ($b == 3); +} +{ my $a = 3; + my $b = $a; + clrbit ($a, 0); + ok ($a == 2); + ok ($b == 3); +} + +{ tie my $a, 'Mytie', mpz(3); + clrbit ($a, 1); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 1); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} +{ tie my $a, 'Mytie', 3; + clrbit ($a, 1); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 1); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} + +{ my $b = mpz(3); + tie my $a, 'Mytie', $b; + clrbit ($a, 0); + ok ($a == 2); + ok ($b == 3); + ok (tied($a)); +} +{ my $b = 3; + tie my $a, 'Mytie', $b; + clrbit ($a, 0); + ok ($a == 2); + ok ($b == 3); + ok (tied($a)); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::combit + +{ my $a = mpz(3); combit ($a, 1); ok ($a == 1); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } +{ my $a = mpz(3); combit ($a, 2); ok ($a == 7); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } + +{ my $a = 3; combit ($a, 1); ok ($a == 1); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } +{ my $a = 3; combit ($a, 2); ok ($a == 7); + ok (UNIVERSAL::isa($a,"GMP::Mpz")); } + +# mutate only given variable +{ my $a = mpz(3); + my $b = $a; + combit ($a, 0); + ok ($a == 2); + ok ($b == 3); +} +{ my $a = 3; + my $b = $a; + combit ($a, 0); + ok ($a == 2); + ok ($b == 3); +} + +{ tie my $a, 'Mytie', mpz(3); + combit ($a, 2); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 7); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} +{ tie my $a, 'Mytie', 3; + combit ($a, 2); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 7); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} + +{ my $b = mpz(3); + tie my $a, 'Mytie', $b; + combit ($a, 0); + ok ($a == 2); + ok ($b == 3); + ok (tied($a)); +} +{ my $b = 3; + tie my $a, 'Mytie', $b; + combit ($a, 0); + ok ($a == 2); + ok ($b == 3); + ok (tied($a)); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::congruent_p + +ok ( congruent_p (21, 0, 7)); +ok (! congruent_p (21, 1, 7)); +ok ( congruent_p (21, 5, 8)); +ok (! congruent_p (21, 6, 8)); + + +#------------------------------------------------------------------------------ +# GMP::Mpz::congruent_2exp_p + +ok ( congruent_2exp_p (20, 0, 2)); +ok (! congruent_2exp_p (21, 0, 2)); +ok (! congruent_2exp_p (20, 1, 2)); + +#------------------------------------------------------------------------------ +# GMP::Mpz::divexact + +ok (divexact(27,3) == 9); +ok (divexact(27,-3) == -9); +ok (divexact(-27,3) == -9); +ok (divexact(-27,-3) == 9); + +#------------------------------------------------------------------------------ +# GMP::Mpz::divisible_p + +ok ( divisible_p (21, 7)); +ok (! divisible_p (21, 8)); + +#------------------------------------------------------------------------------ +# GMP::Mpz::divisible_2exp_p + +ok ( divisible_2exp_p (20, 2)); +ok (! divisible_2exp_p (21, 2)); + +#------------------------------------------------------------------------------ +# GMP::Mpz::even_p + +ok (! even_p(mpz(-3))); +ok ( even_p(mpz(-2))); +ok (! even_p(mpz(-1))); +ok ( even_p(mpz(0))); +ok (! even_p(mpz(1))); +ok ( even_p(mpz(2))); +ok (! even_p(mpz(3))); + +#------------------------------------------------------------------------------ +# GMP::Mpz::export + +{ my $s = mpz_export (1, 2, 1, 0, "0x61626364"); + ok ($s eq 'abcd'); } +{ my $s = mpz_export (-1, 2, 1, 0, "0x61626364"); + ok ($s eq 'cdab'); } +{ my $s = mpz_export (1, 2, -1, 0, "0x61626364"); + ok ($s eq 'badc'); } +{ my $s = mpz_export (-1, 2, -1, 0, "0x61626364"); + ok ($s eq 'dcba'); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::fac + +ok (fac(0) == 1); +ok (fac(1) == 1); +ok (fac(2) == 2); +ok (fac(3) == 6); +ok (fac(4) == 24); +ok (fac(5) == 120); + +#------------------------------------------------------------------------------ +# GMP::Mpz::fdiv + +{ my ($q, $r); + ($q, $r) = fdiv (16, 3); + ok ($q == 5); + ok ($r == 1); + ($q, $r) = fdiv (16, -3); + ok ($q == -6); + ok ($r == -2); + ($q, $r) = fdiv (-16, 3); + ok ($q == -6); + ok ($r == 2); + ($q, $r) = fdiv (-16, -3); + ok ($q == 5); + ok ($r == -1); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::fdiv_2exp + +{ my ($q, $r); + ($q, $r) = fdiv_2exp (23, 2); + ok ($q == 5); + ok ($r == 3); + ($q, $r) = fdiv_2exp (-23, 2); + ok ($q == -6); + ok ($r == 1); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::fib + +ok (fib(0) == 0); +ok (fib(1) == 1); +ok (fib(2) == 1); +ok (fib(3) == 2); +ok (fib(4) == 3); +ok (fib(5) == 5); +ok (fib(6) == 8); + +#------------------------------------------------------------------------------ +# GMP::Mpz::fib2 + +{ my ($a, $b) = fib2(0); ok($a==0); ok($b==1); } +{ my ($a, $b) = fib2(1); ok($a==1); ok($b==0); } +{ my ($a, $b) = fib2(2); ok($a==1); ok($b==1); } +{ my ($a, $b) = fib2(3); ok($a==2); ok($b==1); } +{ my ($a, $b) = fib2(4); ok($a==3); ok($b==2); } +{ my ($a, $b) = fib2(5); ok($a==5); ok($b==3); } +{ my ($a, $b) = fib2(6); ok($a==8); ok($b==5); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::gcd + +ok (gcd (21) == 21); +ok (gcd (21,15) == 3); +ok (gcd (21,15,30,57) == 3); +ok (gcd (21,-15) == 3); +ok (gcd (-21,15) == 3); +ok (gcd (-21,-15) == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpz::gcdext + +{ + my ($g, $x, $y) = gcdext (3,5); + ok ($g == 1); + ok ($x == 2); + ok ($y == -1); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::hamdist + +ok (hamdist(5,7) == 1); + +#------------------------------------------------------------------------------ +# GMP::Mpz::import + +{ my $z = mpz_import (1, 2, 1, 0, 'abcd'); + ok ($z == 0x61626364); } +{ my $z = mpz_import (-1, 2, 1, 0, 'abcd'); + ok ($z == 0x63646162); } +{ my $z = mpz_import (1, 2, -1, 0, 'abcd'); + ok ($z == 0x62616463); } +{ my $z = mpz_import (-1, 2, -1, 0, 'abcd'); + ok ($z == 0x64636261); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::invert + +ok (invert(1,123) == 1); +ok (invert(6,7) == 6); +ok (! defined invert(2,8)); + +#------------------------------------------------------------------------------ +# GMP::Mpz::jacobi, GMP::Mpz::kronecker + +foreach my $i ([ 1, 19, 1 ], + [ 4, 19, 1 ], + [ 5, 19, 1 ], + [ 6, 19, 1 ], + [ 7, 19, 1 ], + [ 9, 19, 1 ], + [ 11, 19, 1 ], + [ 16, 19, 1 ], + [ 17, 19, 1 ], + [ 2, 19, -1 ], + [ 3, 19, -1 ], + [ 8, 19, -1 ], + [ 10, 19, -1 ], + [ 12, 19, -1 ], + [ 13, 19, -1 ], + [ 14, 19, -1 ], + [ 15, 19, -1 ], + [ 18, 19, -1 ]) { + foreach my $fun (\&jacobi, \&kronecker) { + ok (&$fun ($$i[0], $$i[1]) == $$i[2]); + + ok (&$fun ($$i[0], str($$i[1])) == $$i[2]); + ok (&$fun (str($$i[0]), $$i[1]) == $$i[2]); + ok (&$fun (str($$i[0]), str($$i[1])) == $$i[2]); + + ok (&$fun ($$i[0], mpz($$i[1])) == $$i[2]); + ok (&$fun (mpz($$i[0]), $$i[1]) == $$i[2]); + ok (&$fun (mpz($$i[0]), mpz($$i[1])) == $$i[2]); + } +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::lcm + +ok (lcm (2) == 2); +ok (lcm (0) == 0); +ok (lcm (0,0) == 0); +ok (lcm (0,0,0) == 0); +ok (lcm (0,0,0,0) == 0); +ok (lcm (2,0) == 0); +ok (lcm (-2,0) == 0); +ok (lcm (2,3) == 6); +ok (lcm (2,3,4) == 12); +ok (lcm (2,-3) == 6); +ok (lcm (-2,3) == 6); +ok (lcm (-2,-3) == 6); +ok (lcm (mpz(2)**512,1) == mpz(2)**512); +ok (lcm (mpz(2)**512,-1) == mpz(2)**512); +ok (lcm (-mpz(2)**512,1) == mpz(2)**512); +ok (lcm (-mpz(2)**512,-1) == mpz(2)**512); +ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512); +ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512); +ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512); +ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512); + +#------------------------------------------------------------------------------ +# GMP::Mpz::lucnum + +ok (lucnum(0) == 2); +ok (lucnum(1) == 1); +ok (lucnum(2) == 3); +ok (lucnum(3) == 4); +ok (lucnum(4) == 7); +ok (lucnum(5) == 11); +ok (lucnum(6) == 18); + +#------------------------------------------------------------------------------ +# GMP::Mpz::lucnum2 + +{ my ($a, $b) = lucnum2(0); ok($a==2); ok($b==-1); } +{ my ($a, $b) = lucnum2(1); ok($a==1); ok($b==2); } +{ my ($a, $b) = lucnum2(2); ok($a==3); ok($b==1); } +{ my ($a, $b) = lucnum2(3); ok($a==4); ok($b==3); } +{ my ($a, $b) = lucnum2(4); ok($a==7); ok($b==4); } +{ my ($a, $b) = lucnum2(5); ok($a==11); ok($b==7); } +{ my ($a, $b) = lucnum2(6); ok($a==18); ok($b==11); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::nextprime + +ok (nextprime(2) == 3); +ok (nextprime(3) == 5); +ok (nextprime(5) == 7); +ok (nextprime(7) == 11); +ok (nextprime(11) == 13); + +#------------------------------------------------------------------------------ +# GMP::Mpz::perfect_power_p + +# ok ( perfect_power_p(mpz(-27))); +# ok (! perfect_power_p(mpz(-9))); +# ok (! perfect_power_p(mpz(-1))); +ok ( perfect_power_p(mpz(0))); +ok ( perfect_power_p(mpz(1))); +ok (! perfect_power_p(mpz(2))); +ok (! perfect_power_p(mpz(3))); +ok ( perfect_power_p(mpz(4))); +ok ( perfect_power_p(mpz(9))); +ok ( perfect_power_p(mpz(27))); +ok ( perfect_power_p(mpz(81))); + +#------------------------------------------------------------------------------ +# GMP::Mpz::perfect_square_p + +ok (! perfect_square_p(mpz(-9))); +ok (! perfect_square_p(mpz(-1))); +ok ( perfect_square_p(mpz(0))); +ok ( perfect_square_p(mpz(1))); +ok (! perfect_square_p(mpz(2))); +ok (! perfect_square_p(mpz(3))); +ok ( perfect_square_p(mpz(4))); +ok ( perfect_square_p(mpz(9))); +ok (! perfect_square_p(mpz(27))); +ok ( perfect_square_p(mpz(81))); + +#------------------------------------------------------------------------------ +# GMP::Mpz::popcount + +ok (popcount(7) == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpz::powm + +ok (powm (3,2,8) == 1); + +#------------------------------------------------------------------------------ +# GMP::Mpz::probab_prime_p + +ok ( probab_prime_p(89,1)); +ok (! probab_prime_p(81,1)); + +#------------------------------------------------------------------------------ +# GMP::Mpz::realloc + +{ my $z = mpz(123); + realloc ($z, 512); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::remove + +{ + my ($rem, $mult); + ($rem, $mult) = remove(12,3); + ok ($rem == 4); + ok ($mult == 1); + ($rem, $mult) = remove(12,2); + ok ($rem == 3); + ok ($mult == 2); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::root + +ok (root(0,2) == 0); +ok (root(8,3) == 2); +ok (root(-8,3) == -2); +ok (root(81,4) == 3); +ok (root(243,5) == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpz::roote + +{ my ($r,$e); + ($r, $e) = roote(0,2); + ok ($r == 0); + ok ($e); + ($r, $e) = roote(81,4); + ok ($r == 3); + ok ($e); + ($r, $e) = roote(85,4); + ok ($r == 3); + ok (! $e); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::rootrem + +{ 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); } + +#------------------------------------------------------------------------------ +# GMP::Mpz::scan0 + +ok (scan0 (0, 0) == 0); +ok (scan0 (1, 0) == 1); +ok (scan0 (3, 0) == 2); +ok (scan0 (-1, 0) == ~0); +ok (scan0 (-2, 1) == ~0); + +#------------------------------------------------------------------------------ +# GMP::Mpz::scan1 + +ok (scan1 (1, 0) == 0); +ok (scan1 (2, 0) == 1); +ok (scan1 (4, 0) == 2); +ok (scan1 (0, 0) == ~0); +ok (scan1 (3, 2) == ~0); + +#------------------------------------------------------------------------------ +# GMP::Mpz::setbit + +{ my $a = mpz(3); setbit ($a, 1); ok ($a == 3); } +{ my $a = mpz(3); setbit ($a, 2); ok ($a == 7); } + +{ my $a = 3; setbit ($a, 1); ok ($a == 3); } +{ my $a = 3; setbit ($a, 2); ok ($a == 7); } + +# mutate only given variable +{ my $a = mpz(0); + my $b = $a; + setbit ($a, 0); + ok ($a == 1); + ok ($b == 0); +} +{ my $a = 0; + my $b = $a; + setbit ($a, 0); + ok ($a == 1); + ok ($b == 0); +} + +{ tie my $a, 'Mytie', mpz(3); + setbit ($a, 2); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 7); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} +{ tie my $a, 'Mytie', 3; + setbit ($a, 2); + ok ($Mytie::fetched > 0); # used fetch + ok ($Mytie::stored > 0); # used store + ok ($a == 7); # expected result + ok (UNIVERSAL::isa($a,"GMP::Mpz")); + ok (tied($a)); # still tied +} + +{ my $b = mpz(2); + tie my $a, 'Mytie', $b; + setbit ($a, 0); + ok ($a == 3); + ok ($b == 2); + ok (tied($a)); +} +{ my $b = 2; + tie my $a, 'Mytie', $b; + setbit ($a, 0); + ok ($a == 3); + ok ($b == 2); + ok (tied($a)); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::sizeinbase + +ok (sizeinbase(1,10) == 1); +ok (sizeinbase(100,10) == 3); +ok (sizeinbase(9999,10) == 5); + +#------------------------------------------------------------------------------ +# GMP::Mpz::sqrtrem + +{ + my ($root, $rem) = sqrtrem(mpz(0)); + ok ($root == 0); + ok ($rem == 0); +} +{ + my ($root, $rem) = sqrtrem(mpz(1)); + ok ($root == 1); + ok ($rem == 0); +} +{ + my ($root, $rem) = sqrtrem(mpz(2)); + ok ($root == 1); + ok ($rem == 1); +} +{ + my ($root, $rem) = sqrtrem(mpz(9)); + ok ($root == 3); + ok ($rem == 0); +} +{ + my ($root, $rem) = sqrtrem(mpz(35)); + ok ($root == 5); + ok ($rem == 10); +} +{ + my ($root, $rem) = sqrtrem(mpz(0)); + ok ($root == 0); + ok ($rem == 0); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::tdiv + +{ my ($q, $r); + ($q, $r) = tdiv (16, 3); + ok ($q == 5); + ok ($r == 1); + ($q, $r) = tdiv (16, -3); + ok ($q == -5); + ok ($r == 1); + ($q, $r) = tdiv (-16, 3); + ok ($q == -5); + ok ($r == -1); + ($q, $r) = tdiv (-16, -3); + ok ($q == 5); + ok ($r == -1); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::tdiv_2exp + +{ my ($q, $r); + ($q, $r) = tdiv_2exp (23, 2); + ok ($q == 5); + ok ($r == 3); + ($q, $r) = tdiv_2exp (-23, 2); + ok ($q == -5); + ok ($r == -3); +} + +#------------------------------------------------------------------------------ +# GMP::Mpz::tstbit + +ok (tstbit (6, 0) == 0); +ok (tstbit (6, 1) == 1); +ok (tstbit (6, 2) == 1); +ok (tstbit (6, 3) == 0); + + + + +#------------------------------------------------------------------------------ +# GMP::Mpq + +#------------------------------------------------------------------------------ +# GMP::Mpq::new + +ok (mpq(0) == 0); +ok (mpq('0') == 0); +ok (mpq(substr('101',1,1)) == 0); +ok (mpq(0.0) == 0); +ok (mpq(mpz(0)) == 0); +ok (mpq(mpq(0)) == 0); +ok (mpq(mpf(0)) == 0); + +{ tie my $t, 'Mytie', 0; ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', '0'; ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', substr('101',1,1); ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', 0.0; ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', mpz(0); ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', mpq(0); ok (mpq($t) == 0); } +{ tie my $t, 'Mytie', mpf(0); ok (mpq($t) == 0); } + +ok (mpq(-123) == -123); +ok (mpq('-123') == -123); +ok (mpq(substr('1-1231',1,4)) == -123); +ok (mpq(-123.0) == -123); +ok (mpq(mpz(-123)) == -123); +ok (mpq(mpq(-123)) == -123); +ok (mpq(mpf(-123)) == -123); + +{ tie my $t, 'Mytie', -123; ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', '-123'; ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', -123.0; ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', mpz(-123); ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', mpq(-123); ok (mpq($t) == -123); } +{ tie my $t, 'Mytie', mpf(-123); ok (mpq($t) == -123); } + +ok (mpq($ivnv_2p128) == $str_2p128); +{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpq($t) == $str_2p128); } + +ok (mpq('3/2') == mpq(3,2)); +ok (mpq('3/1') == mpq(3,1)); +ok (mpq('-3/2') == mpq(-3,2)); +ok (mpq('-3/1') == mpq(-3,1)); +ok (mpq('0x3') == mpq(3,1)); +ok (mpq('0b111') == mpq(7,1)); +ok (mpq('0b0') == mpq(0,1)); + +ok (mpq($uv_max) > 0); +ok (mpq($uv_max) == mpq($uv_max_str)); +{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) > 0); } +{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) == mpq($uv_max_str)); } + +{ my $x = 123.5; + kill (0, $x); + ok (mpq($x) == 123.5); + tie my $t, 'Mytie', $x; + ok (mpq($t) == 123.5); +} + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_abs + +ok (abs(mpq(0)) == 0); +ok (abs(mpq(123)) == 123); +ok (abs(mpq(-123)) == 123); + +{ my $x = mpq(-123); $x = abs($x); ok ($x == 123); } +{ my $x = mpq(0); $x = abs($x); ok ($x == 0); } +{ my $x = mpq(123); $x = abs($x); ok ($x == 123); } + +{ tie my $t, 'Mytie', mpq(0); ok (abs($t) == 0); } +{ tie my $t, 'Mytie', mpq(123); ok (abs($t) == 123); } +{ tie my $t, 'Mytie', mpq(-123); ok (abs($t) == 123); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_add + +ok (mpq(0) + 1 == 1); +ok (mpq(-1) + 1 == 0); +ok (1 + mpq(0) == 1); +ok (1 + mpq(-1) == 0); + +ok (mpq(1,2)+mpq(1,3) == mpq(5,6)); +ok (mpq(1,2)+mpq(-1,3) == mpq(1,6)); +ok (mpq(-1,2)+mpq(1,3) == mpq(-1,6)); +ok (mpq(-1,2)+mpq(-1,3) == mpq(-5,6)); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_addeq + +{ my $a = mpq(7); $a += 1; ok ($a == 8); } +{ my $a = mpq(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_bool + +if (mpq(0)) { ok (0); } else { ok (1); } +if (mpq(123)) { ok (1); } else { ok (0); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_dec + +{ my $a = mpq(0); ok ($a-- == 0); ok ($a == -1); } +{ my $a = mpq(0); ok (--$a == -1); } + +{ my $a = mpq(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_div + +ok (mpq(6) / 2 == 3); +ok (mpq(-6) / 2 == -3); +ok (mpq(6) / -2 == -3); +ok (mpq(-6) / -2 == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_diveq + +{ my $a = mpq(21); $a /= 3; ok ($a == 7); } +{ my $a = mpq(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_eq + +{ my $a = mpq(0); + my $b = $a; + $a = mpq(1); + ok ($a == 1); + ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_inc + +{ my $a = mpq(0); ok ($a++ == 0); ok ($a == 1); } +{ my $a = mpq(0); ok (++$a == 1); } + +{ my $a = mpq(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_lshift + +{ my $a = mpq(7) << 1; ok ($a == 14); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_lshifteq + +{ my $a = mpq(7); $a <<= 1; ok ($a == 14); } +{ my $a = mpq(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_mul + +ok (mpq(2) * 3 == 6); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_muleq + +{ my $a = mpq(7); $a *= 3; ok ($a == 21); } +{ my $a = mpq(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_neg + +ok (- mpq(0) == 0); +ok (- mpq(123) == -123); +ok (- mpq(-123) == 123); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_not + +if (not mpq(0)) { ok (1); } else { ok (0); } +if (not mpq(123)) { ok (0); } else { ok (1); } + +ok ((! mpq(0)) == 1); +ok ((! mpq(123)) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_pow + +ok (mpq(0) ** 1 == 0); +ok (mpq(1) ** 1 == 1); +ok (mpq(2) ** 0 == 1); +ok (mpq(2) ** 1 == 2); +ok (mpq(2) ** 2 == 4); +ok (mpq(2) ** 3 == 8); +ok (mpq(2) ** 4 == 16); + +ok (mpq(0) ** mpq(1) == 0); +ok (mpq(1) ** mpq(1) == 1); +ok (mpq(2) ** mpq(0) == 1); +ok (mpq(2) ** mpq(1) == 2); +ok (mpq(2) ** mpq(2) == 4); +ok (mpq(2) ** mpq(3) == 8); +ok (mpq(2) ** mpq(4) == 16); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_poweq + +{ my $a = mpq(3); $a **= 4; ok ($a == 81); } +{ my $a = mpq(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_rshift + +{ my $a = mpq(32) >> 1; ok ($a == 16); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_rshifteq + +{ my $a = mpq(32); $a >>= 1; ok ($a == 16); } +{ my $a = mpq(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_spaceship + +ok (mpq(0) < 1); +ok (mpq(0) > -1); + +ok (mpq(0) != 1); +ok (mpq(0) != -1); +ok (mpq(1) != 0); +ok (mpq(1) != -1); +ok (mpq(-1) != 0); +ok (mpq(-1) != 1); + +ok (mpq(3,2) > 1); +ok (mpq(3,2) < 2); + +ok (mpq(0) < 1.0); +ok (mpq(0) < '1'); +ok (mpq(0) < substr('-1',1,1)); +ok (mpq(0) < mpz(1)); +ok (mpq(0) < mpq(1)); +ok (mpq(0) < mpf(1)); +ok (mpq(0) < $uv_max); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_string + +{ my $x = mpq(0); ok("$x" eq "0"); } +{ my $x = mpq(123); ok("$x" eq "123"); } +{ my $x = mpq(-123); ok("$x" eq "-123"); } + +{ my $q = mpq(5,7); ok("$q" eq "5/7"); } +{ my $q = mpq(-5,7); ok("$q" eq "-5/7"); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_sub + +ok (mpq(0) - 1 == -1); +ok (mpq(1) - 1 == 0); +ok (1 - mpq(0) == 1); +ok (1 - mpq(1) == 0); + +ok (mpq(1,2)-mpq(1,3) == mpq(1,6)); +ok (mpq(1,2)-mpq(-1,3) == mpq(5,6)); +ok (mpq(-1,2)-mpq(1,3) == mpq(-5,6)); +ok (mpq(-1,2)-mpq(-1,3) == mpq(-1,6)); + +#------------------------------------------------------------------------------ +# GMP::Mpq::overload_subeq + +{ my $a = mpq(7); $a -= 1; ok ($a == 6); } +{ my $a = mpq(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::canonicalize + +{ my $q = mpq(21,15); canonicalize($q); + ok (num($q) == 7); + ok (den($q) == 5); +} + +#------------------------------------------------------------------------------ +# GMP::Mpq::den + +{ my $q = mpq(5,9); ok (den($q) == 9); } + +#------------------------------------------------------------------------------ +# GMP::Mpq::num + +{ my $q = mpq(5,9); ok (num($q) == 5); } + + + + +#------------------------------------------------------------------------------ +# GMP::Mpf + +#------------------------------------------------------------------------------ +# GMP::Mpf::new + +ok (mpf(0) == 0); +ok (mpf('0') == 0); +ok (mpf(substr('101',1,1)) == 0); +ok (mpf(0.0) == 0); +ok (mpf(mpz(0)) == 0); +ok (mpf(mpq(0)) == 0); +ok (mpf(mpf(0)) == 0); + +{ tie my $t, 'Mytie', 0; ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', '0'; ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', substr('101',1,1); ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', 0.0; ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', mpz(0); ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', mpq(0); ok (mpf($t) == 0); } +{ tie my $t, 'Mytie', mpf(0); ok (mpf($t) == 0); } + +ok (mpf(-123) == -123); +ok (mpf('-123') == -123); +ok (mpf(substr('1-1231',1,4)) == -123); +ok (mpf(-123.0) == -123); +ok (mpf(mpz(-123)) == -123); +ok (mpf(mpq(-123)) == -123); +ok (mpf(mpf(-123)) == -123); + +{ tie my $t, 'Mytie', -123; ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', '-123'; ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', -123.0; ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', mpz(-123); ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', mpq(-123); ok (mpf($t) == -123); } +{ tie my $t, 'Mytie', mpf(-123); ok (mpf($t) == -123); } + +ok (mpf($ivnv_2p128) == $str_2p128); +{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpf($t) == $str_2p128); } + +ok (mpf(-1.5) == -1.5); +ok (mpf(-1.0) == -1.0); +ok (mpf(-0.5) == -0.5); +ok (mpf(0) == 0); +ok (mpf(0.5) == 0.5); +ok (mpf(1.0) == 1.0); +ok (mpf(1.5) == 1.5); + +ok (mpf("-1.5") == -1.5); +ok (mpf("-1.0") == -1.0); +ok (mpf("-0.5") == -0.5); +ok (mpf("0") == 0); +ok (mpf("0.5") == 0.5); +ok (mpf("1.0") == 1.0); +ok (mpf("1.5") == 1.5); + +ok (mpf($uv_max) > 0); +ok (mpf($uv_max) == mpf($uv_max_str)); +{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) > 0); } +{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) == mpf($uv_max_str)); } + +{ my $x = 123.5; + kill (0, $x); + ok (mpf($x) == 123.5); + tie my $t, 'Mytie', $x; + ok (mpf($t) == 123.5); +} + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_abs + +ok (abs(mpf(0)) == 0); +ok (abs(mpf(123)) == 123); +ok (abs(mpf(-123)) == 123); + +{ my $x = mpf(-123); $x = abs($x); ok ($x == 123); } +{ my $x = mpf(0); $x = abs($x); ok ($x == 0); } +{ my $x = mpf(123); $x = abs($x); ok ($x == 123); } + +{ tie my $t, 'Mytie', mpf(0); ok (abs($t) == 0); } +{ tie my $t, 'Mytie', mpf(123); ok (abs($t) == 123); } +{ tie my $t, 'Mytie', mpf(-123); ok (abs($t) == 123); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_add + +ok (mpf(0) + 1 == 1); +ok (mpf(-1) + 1 == 0); +ok (1 + mpf(0) == 1); +ok (1 + mpf(-1) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_addeq + +{ my $a = mpf(7); $a += 1; ok ($a == 8); } +{ my $a = mpf(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_bool + +if (mpf(0)) { ok (0); } else { ok (1); } +if (mpf(123)) { ok (1); } else { ok (0); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_dec + +{ my $a = mpf(0); ok ($a-- == 0); ok ($a == -1); } +{ my $a = mpf(0); ok (--$a == -1); } + +{ my $a = mpf(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_div + +ok (mpf(6) / 2 == 3); +ok (mpf(-6) / 2 == -3); +ok (mpf(6) / -2 == -3); +ok (mpf(-6) / -2 == 3); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_diveq + +{ my $a = mpf(21); $a /= 3; ok ($a == 7); } +{ my $a = mpf(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_eq + +{ my $a = mpf(0); + my $b = $a; + $a = mpf(1); + ok ($a == 1); + ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_inc + +{ my $a = mpf(0); ok ($a++ == 0); ok ($a == 1); } +{ my $a = mpf(0); ok (++$a == 1); } + +{ my $a = mpf(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_lshift + +{ my $a = mpf(7) << 1; ok ($a == 14); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_lshifteq + +{ my $a = mpf(7); $a <<= 1; ok ($a == 14); } +{ my $a = mpf(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_mul + +ok (mpf(2) * 3 == 6); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_muleq + +{ my $a = mpf(7); $a *= 3; ok ($a == 21); } +{ my $a = mpf(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_neg + +ok (- mpf(0) == 0); +ok (- mpf(123) == -123); +ok (- mpf(-123) == 123); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_not + +if (not mpf(0)) { ok (1); } else { ok (0); } +if (not mpf(123)) { ok (0); } else { ok (1); } + +ok ((! mpf(0)) == 1); +ok ((! mpf(123)) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_pow + +ok (mpf(0) ** 1 == 0); +ok (mpf(1) ** 1 == 1); +ok (mpf(2) ** 0 == 1); +ok (mpf(2) ** 1 == 2); +ok (mpf(2) ** 2 == 4); +ok (mpf(2) ** 3 == 8); +ok (mpf(2) ** 4 == 16); + +ok (mpf(0) ** mpf(1) == 0); +ok (mpf(1) ** mpf(1) == 1); +ok (mpf(2) ** mpf(0) == 1); +ok (mpf(2) ** mpf(1) == 2); +ok (mpf(2) ** mpf(2) == 4); +ok (mpf(2) ** mpf(3) == 8); +ok (mpf(2) ** mpf(4) == 16); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_poweq + +{ my $a = mpf(3); $a **= 4; ok ($a == 81); } +{ my $a = mpf(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_rshift + +{ my $a = mpf(32) >> 1; ok ($a == 16); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_rshifteq + +{ my $a = mpf(32); $a >>= 1; ok ($a == 16); } +{ my $a = mpf(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_sqrt + +ok (sqrt(mpf(0)) == 0); +ok (sqrt(mpf(1)) == 1); +ok (sqrt(mpf(4)) == 2); +ok (sqrt(mpf(81)) == 9); + +ok (sqrt(mpf(0.25)) == 0.5); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_spaceship + +ok (mpf(0) < 1); +ok (mpf(0) > -1); + +ok (mpf(0) != 1); +ok (mpf(0) != -1); +ok (mpf(1) != 0); +ok (mpf(1) != -1); +ok (mpf(-1) != 0); +ok (mpf(-1) != 1); + +ok (mpf(0) < 1.0); +ok (mpf(0) < '1'); +ok (mpf(0) < substr('-1',1,1)); +ok (mpf(0) < mpz(1)); +ok (mpf(0) < mpq(1)); +ok (mpf(0) < mpf(1)); +ok (mpf(0) < $uv_max); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_string + +{ my $x = mpf(0); ok ("$x" eq "0"); } +{ my $x = mpf(123); ok ("$x" eq "123"); } +{ my $x = mpf(-123); ok ("$x" eq "-123"); } + +{ my $f = mpf(0.25); ok ("$f" eq "0.25"); } +{ my $f = mpf(-0.25); ok ("$f" eq "-0.25"); } +{ my $f = mpf(1.25); ok ("$f" eq "1.25"); } +{ my $f = mpf(-1.25); ok ("$f" eq "-1.25"); } +{ my $f = mpf(1000000); ok ("$f" eq "1000000"); } +{ my $f = mpf(-1000000); ok ("$f" eq "-1000000"); } + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_sub + +ok (mpf(0) - 1 == -1); +ok (mpf(1) - 1 == 0); +ok (1 - mpf(0) == 1); +ok (1 - mpf(1) == 0); + +#------------------------------------------------------------------------------ +# GMP::Mpf::overload_subeq + +{ my $a = mpf(7); $a -= 1; ok ($a == 6); } +{ my $a = mpf(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } + + +#------------------------------------------------------------------------------ +# GMP::Mpf::ceil + +ok (ceil (mpf(-7.5)) == -7.0); +ok (ceil (mpf(7.5)) == 8.0); + +#------------------------------------------------------------------------------ +# GMP::Mpf::floor + +ok (floor(mpf(-7.5)) == -8.0); +ok (floor(mpf(7.5)) == 7.0); + +#------------------------------------------------------------------------------ +# GMP::Mpf::mpf_eq + +{ my $old_prec = get_default_prec(); + set_default_prec(128); + + ok ( mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1)); + ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128)); + + set_default_prec($old_prec); +} + +#------------------------------------------------------------------------------ +# GMP::Mpf::get_default_prec + +get_default_prec(); + +#------------------------------------------------------------------------------ +# GMP::Mpf::get_prec + +{ my $x = mpf(1.0, 512); + ok (get_prec ($x) == 512); +} + +#------------------------------------------------------------------------------ +# GMP::Mpf::reldiff + +ok (reldiff (2,4) == 1); +ok (reldiff (4,2) == 0.5); + +#------------------------------------------------------------------------------ +# GMP::Mpf::set_default_prec + +{ my $old_prec = get_default_prec(); + + set_default_prec(512); + ok (get_default_prec () == 512); + + set_default_prec($old_prec); +} + +#------------------------------------------------------------------------------ +# GMP::Mpf::set_prec + +{ my $x = mpf(1.0, 512); + my $y = $x; + set_prec ($x, 1024); + ok (get_prec ($x) == 1024); + ok (get_prec ($y) == 512); +} + +#------------------------------------------------------------------------------ +# GMP::Mpf::trunc + +ok (trunc(mpf(-7.5)) == -7.0); +ok (trunc(mpf(7.5)) == 7.0); + + + +#------------------------------------------------------------------------------ +# GMP::Rand + +#------------------------------------------------------------------------------ +# GMP::Rand::new + +{ my $r = randstate(); ok (defined $r); } +{ my $r = randstate('lc_2exp', 1, 2, 3); ok (defined $r); } +{ 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); + } +} + +#------------------------------------------------------------------------------ +# GMP::Rand::seed + +{ my $r = randstate(); + $r->seed(123); + $r->seed(time()); +} + +#------------------------------------------------------------------------------ +# GMP::Rand::mpf_urandomb + +{ my $r = randstate(); + my $f = mpf_urandomb($r,1024); + ok (UNIVERSAL::isa($f,"GMP::Mpf")); } + +#------------------------------------------------------------------------------ +# GMP::Rand::mpz_urandomb + +{ my $r = randstate(); + my $z = mpz_urandomb($r, 1024); + ok (UNIVERSAL::isa($z,"GMP::Mpz")); } + +#------------------------------------------------------------------------------ +# GMP::Rand::mpz_rrandomb + +{ my $r = randstate(); + my $z = mpz_rrandomb($r, 1024); + ok (UNIVERSAL::isa($z,"GMP::Mpz")); } + +#------------------------------------------------------------------------------ +# GMP::Rand::mpz_urandomm + +{ my $r = randstate(); + my $z = mpz_urandomm($r, mpz(3)**100); + ok (UNIVERSAL::isa($z,"GMP::Mpz")); } + +#------------------------------------------------------------------------------ +# GMP::Rand::mpz_urandomb_ui + +{ my $r = randstate(); + foreach (1 .. 20) { + my $u = gmp_urandomb_ui($r,8); + ok ($u >= 0); + ok ($u < 256); + } +} + +#------------------------------------------------------------------------------ +# GMP::Rand::mpz_urandomm_ui + +{ my $r = randstate(); + foreach (1 .. 20) { + my $u = gmp_urandomm_ui($r,8); + ok ($u >= 0); + ok ($u < 8); + } +} + + + + +#------------------------------------------------------------------------------ +# GMP module + +#------------------------------------------------------------------------------ +# GMP::fits_slong_p + +ok (GMP::fits_slong_p(0)); + +# in perl 5.005 uv_max is only 32-bits on a 64-bit system, so won't exceed a +# long +# ok (! GMP::fits_slong_p($uv_max)); + +ok (GMP::fits_slong_p(0.0)); + +ok (GMP::fits_slong_p('0')); + +ok (GMP::fits_slong_p(substr('999999999999999999999999999999',1,1))); + +ok (! mpz("-9999999999999999999999999999999999999999999")->fits_slong_p()); +ok ( mpz(-123)->fits_slong_p()); +ok ( mpz(0)->fits_slong_p()); +ok ( mpz(123)->fits_slong_p()); +ok (! mpz("9999999999999999999999999999999999999999999")->fits_slong_p()); + +ok (! mpq("-9999999999999999999999999999999999999999999")->fits_slong_p()); +ok ( mpq(-123)->fits_slong_p()); +ok ( mpq(0)->fits_slong_p()); +ok ( mpq(123)->fits_slong_p()); +ok (! mpq("9999999999999999999999999999999999999999999")->fits_slong_p()); + +ok (! mpf("-9999999999999999999999999999999999999999999")->fits_slong_p()); +ok ( mpf(-123)->fits_slong_p()); +ok ( mpf(0)->fits_slong_p()); +ok ( mpf(123)->fits_slong_p()); +ok (! mpf("9999999999999999999999999999999999999999999")->fits_slong_p()); + +#------------------------------------------------------------------------------ +# GMP::get_d + +ok (GMP::get_d(123) == 123.0); + +ok (GMP::get_d($uv_max) > 0); + +ok (GMP::get_d(123.0) == 123.0); + +ok (GMP::get_d('123') == 123.0); + +ok (GMP::get_d(mpz(123)) == 123.0); + +ok (GMP::get_d(mpq(123)) == 123.0); + +ok (GMP::get_d(mpf(123)) == 123.0); + +#------------------------------------------------------------------------------ +# GMP::get_d_2exp + +{ 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 ($uv_max); + ok ($dbl > 0.0); ok ($exp > 0); } + +{ 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); } + +#------------------------------------------------------------------------------ +# GMP::get_str + +ok (get_str(-123) eq '-123'); +ok (get_str('-123') eq '-123'); +ok (get_str(substr('x-123x',1,4)) eq '-123'); +ok (get_str(mpz(-123)) eq '-123'); +ok (get_str(mpq(-123)) eq '-123'); + +ok (get_str(-123,10) eq '-123'); +ok (get_str('-123',10) eq '-123'); +ok (get_str(substr('x-123x',1,4),10) eq '-123'); +ok (get_str(mpz(-123),10) eq '-123'); +ok (get_str(mpq(-123),10) eq '-123'); + +ok (get_str(-123,16) eq '-7b'); +ok (get_str('-123',16) eq '-7b'); +ok (get_str(substr('x-123x',1,4),16) eq '-7b'); +ok (get_str(mpz(-123),16) eq '-7b'); +ok (get_str(mpq(-123),16) eq '-7b'); + +ok (get_str(-123,-16) eq '-7B'); +ok (get_str('-123',-16) eq '-7B'); +ok (get_str(substr('x-123x',1,4),-16) eq '-7B'); +ok (get_str(mpz(-123),-16) eq '-7B'); +ok (get_str(mpq(-123),-16) eq '-7B'); + +# is a float in past versions of perl without UV type +{ my ($str, $exp) = get_str($uv_max); + ok ($str eq $uv_max_str); } + +ok (get_str(mpq(5/8)) eq "5/8"); +ok (get_str(mpq(-5/8)) eq "-5/8"); +ok (get_str(mpq(255/256),16) eq "ff/100"); +ok (get_str(mpq(255/256),-16) eq "FF/100"); +ok (get_str(mpq(-255/256),16) eq "-ff/100"); +ok (get_str(mpq(-255/256),-16) eq "-FF/100"); + +{ my ($s,$e) = get_str(1.5, 10); ok ($s eq '15'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(1.5), 10); ok ($s eq '15'); ok ($e == 1); } + +{ my ($s,$e) = get_str(-1.5, 10); ok ($s eq '-15'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(-1.5), 10); ok ($s eq '-15'); ok ($e == 1); } + +{ my ($s,$e) = get_str(1.5, 16); ok ($s eq '18'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(1.5), 16); ok ($s eq '18'); ok ($e == 1); } + +{ my ($s,$e) = get_str(-1.5, 16); ok ($s eq '-18'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(-1.5), 16); ok ($s eq '-18'); ok ($e == 1); } + +{ my ($s,$e) = get_str(65536.0, 16); ok ($s eq '1'); ok ($e == 5); } +{ my ($s,$e) = get_str(mpf(65536.0), 16); ok ($s eq '1'); ok ($e == 5); } + +{ my ($s,$e) = get_str(1.625, 16); ok ($s eq '1a'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(1.625), 16); ok ($s eq '1a'); ok ($e == 1); } + +{ my ($s,$e) = get_str(1.625, -16); ok ($s eq '1A'); ok ($e == 1); } +{ my ($s,$e) = get_str(mpf(1.625), -16); ok ($s eq '1A'); ok ($e == 1); } + +{ my ($s, $e) = get_str(255.0,16,0); ok ($s eq "ff"); ok ($e == 2); } +{ my ($s, $e) = get_str(mpf(255.0),16,0); ok ($s eq "ff"); ok ($e == 2); } + +{ my ($s, $e) = get_str(255.0,-16,0); ok ($s eq "FF"); ok ($e == 2); } +{ my ($s, $e) = get_str(mpf(255.0),-16,0); ok ($s eq "FF"); ok ($e == 2); } + +#------------------------------------------------------------------------------ +# GMP::get_si + +ok (GMP::get_si(123) == 123.0); + +# better not assume anything about the relatives sizes of long and UV +ok (GMP::get_si($uv_max) != 0); + +ok (GMP::get_si(123.0) == 123.0); + +ok (GMP::get_si('123') == 123.0); + +ok (GMP::get_si(mpz(123)) == 123.0); + +ok (GMP::get_si(mpq(123)) == 123.0); + +ok (GMP::get_si(mpf(123)) == 123.0); + +#------------------------------------------------------------------------------ +# GMP::integer_p + +ok ( GMP::integer_p (0)); +ok ( GMP::integer_p (123)); +ok ( GMP::integer_p (-123)); + +ok ( GMP::integer_p ($uv_max)); + +ok ( GMP::integer_p (0.0)); +ok ( GMP::integer_p (123.0)); +ok ( GMP::integer_p (-123.0)); +ok (! GMP::integer_p (0.5)); +ok (! GMP::integer_p (123.5)); +ok (! GMP::integer_p (-123.5)); + +ok ( GMP::integer_p ('0')); +ok ( GMP::integer_p ('123')); +ok ( GMP::integer_p ('-123')); +ok (! GMP::integer_p ('0.5')); +ok (! GMP::integer_p ('123.5')); +ok (! GMP::integer_p ('-123.5')); +ok (! GMP::integer_p ('5/8')); + +ok ( GMP::integer_p (mpz(1))); + +ok ( GMP::integer_p (mpq(1))); +ok (! GMP::integer_p (mpq(1,2))); + +ok ( GMP::integer_p (mpf(1.0))); +ok (! GMP::integer_p (mpf(1.5))); + +#------------------------------------------------------------------------------ +# GMP::odd_p + +ok (! odd_p(0)); +ok ( odd_p(1)); +ok (! odd_p(2)); + +ok ( odd_p($uv_max)); + +ok ( odd_p(mpz(-3))); +ok (! odd_p(mpz(-2))); +ok ( odd_p(mpz(-1))); +ok (! odd_p(mpz(0))); +ok ( odd_p(mpz(1))); +ok (! odd_p(mpz(2))); +ok ( odd_p(mpz(3))); + +#------------------------------------------------------------------------------ +# GMP::printf + +GMP::printf ("hello world\n"); + +sub via_printf { + my $s; + open TEMP, ">test.tmp" or die; + GMP::printf TEMP @_; + close TEMP or die; + open TEMP, "<test.tmp" or die; + read (TEMP, $s, 1024); + close TEMP or die; + unlink 'test.tmp'; + return $s; +} + +ok (sprintf ("%d", mpz(123)) eq '123'); +ok (sprintf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789'); +ok (sprintf ("%d", mpq(15,16)) eq '15/16'); +ok (sprintf ("%f", mpf(1.5)) eq '1.500000'); +ok (sprintf ("%.2f", mpf(1.5)) eq '1.50'); + +ok (sprintf ("%*d", 6, 123) eq ' 123'); +ok (sprintf ("%*d", 6, mpz(123)) eq ' 123'); +ok (sprintf ("%*d", 6, mpq(15,16)) eq ' 15/16'); + +ok (sprintf ("%x", 123) eq '7b'); +ok (sprintf ("%x", mpz(123)) eq '7b'); +ok (sprintf ("%X", 123) eq '7B'); +ok (sprintf ("%X", mpz(123)) eq '7B'); +ok (sprintf ("%#x", 123) eq '0x7b'); +ok (sprintf ("%#x", mpz(123)) eq '0x7b'); +ok (sprintf ("%#X", 123) eq '0X7B'); +ok (sprintf ("%#X", mpz(123)) eq '0X7B'); + +ok (sprintf ("%x", mpq(15,16)) eq 'f/10'); +ok (sprintf ("%X", mpq(15,16)) eq 'F/10'); +ok (sprintf ("%#x", mpq(15,16)) eq '0xf/0x10'); +ok (sprintf ("%#X", mpq(15,16)) eq '0XF/0X10'); + +ok (sprintf ("%*.*f", 10, 3, 1.25) eq ' 1.250'); +ok (sprintf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500'); + +ok (via_printf ("%d", mpz(123)) eq '123'); +ok (via_printf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789'); +ok (via_printf ("%d", mpq(15,16)) eq '15/16'); +ok (via_printf ("%f", mpf(1.5)) eq '1.500000'); +ok (via_printf ("%.2f", mpf(1.5)) eq '1.50'); + +ok (via_printf ("%*d", 6, 123) eq ' 123'); +ok (via_printf ("%*d", 6, mpz(123)) eq ' 123'); +ok (via_printf ("%*d", 6, mpq(15,16)) eq ' 15/16'); + +ok (via_printf ("%x", 123) eq '7b'); +ok (via_printf ("%x", mpz(123)) eq '7b'); +ok (via_printf ("%X", 123) eq '7B'); +ok (via_printf ("%X", mpz(123)) eq '7B'); +ok (via_printf ("%#x", 123) eq '0x7b'); +ok (via_printf ("%#x", mpz(123)) eq '0x7b'); +ok (via_printf ("%#X", 123) eq '0X7B'); +ok (via_printf ("%#X", mpz(123)) eq '0X7B'); + +ok (via_printf ("%x", mpq(15,16)) eq 'f/10'); +ok (via_printf ("%X", mpq(15,16)) eq 'F/10'); +ok (via_printf ("%#x", mpq(15,16)) eq '0xf/0x10'); +ok (via_printf ("%#X", mpq(15,16)) eq '0XF/0X10'); + +ok (via_printf ("%*.*f", 10, 3, 1.25) eq ' 1.250'); +ok (via_printf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500'); + +#------------------------------------------------------------------------------ +# GMP::sgn + +ok (sgn(-123) == -1); +ok (sgn(0) == 0); +ok (sgn(123) == 1); + +ok (sgn($uv_max) == 1); + +ok (sgn(-123.0) == -1); +ok (sgn(0.0) == 0); +ok (sgn(123.0) == 1); + +ok (sgn('-123') == -1); +ok (sgn('0') == 0); +ok (sgn('123') == 1); +ok (sgn('-123.0') == -1); +ok (sgn('0.0') == 0); +ok (sgn('123.0') == 1); + +ok (sgn(substr('x-123x',1,4)) == -1); +ok (sgn(substr('x0x',1,1)) == 0); +ok (sgn(substr('x123x',1,3)) == 1); + +ok (mpz(-123)->sgn() == -1); +ok (mpz(0) ->sgn() == 0); +ok (mpz(123) ->sgn() == 1); + +ok (mpq(-123)->sgn() == -1); +ok (mpq(0) ->sgn() == 0); +ok (mpq(123) ->sgn() == 1); + +ok (mpf(-123)->sgn() == -1); +ok (mpf(0) ->sgn() == 0); +ok (mpf(123) ->sgn() == 1); + + + +#------------------------------------------------------------------------------ +# overloaded constants + +if ($] > 5.00503) { + if (! do 'test2.pl') { + die "Cannot run test2.pl\n"; + } +} + + + + +#------------------------------------------------------------------------------ +# $# stuff +# +# For some reason "local $#" doesn't leave $# back at its default undefined +# state when exiting the block. + +{ local $# = 'hi %.0f there'; + my $f = mpf(123); + ok ("$f" eq 'hi 123 there'); } + + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/test2.pl b/vendor/gmp-6.3.0/demos/perl/test2.pl new file mode 100644 index 0000000..31a1d6b --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/test2.pl @@ -0,0 +1,75 @@ +# GMP perl module tests (part 2) + +# Copyright 2001 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +# The following uses of :constants seem to provoke segvs in perl 5.005_03, +# so they're kept separate file to be run only on suitable perl versions. + + +use GMP::Mpz qw(:constants); +{ + my $a = 123; + ok (UNIVERSAL::isa ($a, "GMP::Mpz")); +} +use GMP::Mpz qw(:noconstants); + +use GMP::Mpq qw(:constants); +{ + my $a = 123; + ok (UNIVERSAL::isa ($a, "GMP::Mpq")); +} +use GMP::Mpq qw(:noconstants); + +use GMP::Mpf qw(:constants); +{ + my $a = 123; + ok (UNIVERSAL::isa ($a, "GMP::Mpf")); +} +use GMP::Mpf qw(:noconstants); + + +# compiled constants unchanged by clrbit etc when re-executed +foreach (0, 1, 2) { + use GMP::Mpz qw(:constants); + my $a = 15; + my $b = 6; + use GMP::Mpz qw(:noconstants); + clrbit ($a, 0); + ok ($a == 14); + setbit ($b, 0); + ok ($b == 7); +} + +1; + + +# Local variables: +# perl-indent-level: 2 +# End: diff --git a/vendor/gmp-6.3.0/demos/perl/typemap b/vendor/gmp-6.3.0/demos/perl/typemap new file mode 100644 index 0000000..e863a9c --- /dev/null +++ b/vendor/gmp-6.3.0/demos/perl/typemap @@ -0,0 +1,108 @@ +# GMP module external subroutine type mappings. + +# Copyright 2001, 2003 Free Software Foundation, Inc. +# +# This file is part of the GNU MP Library. +# +# The GNU MP Library is free software; you can redistribute it and/or modify +# it under the terms of either: +# +# * 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. +# +# or +# +# * the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# or both in parallel, as here. +# +# The GNU MP 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 General Public License +# for more details. +# +# You should have received copies of the GNU General Public License and the +# GNU Lesser General Public License along with the GNU MP Library. If not, +# see https://www.gnu.org/licenses/. + + +TYPEMAP +const_string T_PV +const_string_assume CONST_STRING_ASSUME +mpz MPZ +mpq MPQ +mpf MPF +mpz_assume MPZ_ASSUME +mpq_assume MPQ_ASSUME +mpf_assume MPF_ASSUME +mpz_coerce MPZ_COERCE +mpq_coerce MPQ_COERCE +mpf_coerce_st0 MPF_COERCE_ST0 +mpf_coerce_def MPF_COERCE_DEF +randstate RANDSTATE +ulong_coerce ULONG_COERCE +malloced_string MALLOCED_STRING +order_noswap ORDER_NOSWAP +dummy DUMMY +# perl 5.005 doesn't have UV in its standard typemap, so use this instead +gmp_UV GMP_UV + + +INPUT +MPZ + class_or_croak ($arg, mpz_class); $var = SvMPZ($arg); +MPQ + class_or_croak ($arg, mpq_class); $var = SvMPQ($arg); +MPF + class_or_croak ($arg, mpf_class); $var = SvMPF($arg); +MPZ_ASSUME + MPZ_ASSUME ($var, $arg) +MPQ_ASSUME + MPQ_ASSUME ($var, $arg) +MPF_ASSUME + MPF_ASSUME ($var, $arg) +MPZ_COERCE + $var = coerce_mpz (tmp_mpz_${(my $stnum=$arg)=~s/[^0-9]//g;\$stnum}, $arg) +MPQ_COERCE + $var = coerce_mpq (tmp_mpq_${(my $stnum=$arg)=~s/[^0-9]//g;\$stnum}, $arg) +MPF_COERCE_ST0 + /* precision follows ST(0) */ + assert (sv_derived_from (ST(0), mpf_class)); + $var = coerce_mpf (tmp_mpf_${(my $stnum=$arg)=~s/[^0-9]//g;\$stnum}, + $arg, mpf_get_prec (SvMPF(ST(0)))) +MPF_COERCE_DEF + /* default precision used */ + $var = coerce_mpf (tmp_mpf_${(my $stnum=$arg)=~s/[^0-9]//g;\$stnum}, + $arg, mpf_get_default_prec()) +RANDSTATE + class_or_croak ($arg, rand_class); $var = SvRANDSTATE($arg); +ULONG_COERCE + $var = coerce_ulong ($arg) +ORDER_NOSWAP + assert ($arg != &PL_sv_yes); +DUMMY + /* dummy $var */ +CONST_STRING_ASSUME + /* No need to check for SvPOKp and use SvPV, this mapping is + only used for overload_constant, which always gets literal + strings. */ + assert (SvPOK ($arg)); + $var = SvPVX ($arg); + + +OUTPUT +MPZ + sv_bless (sv_setref_pv ($arg, NULL, $var), mpz_class_hv); +MPQ + sv_bless (sv_setref_pv ($arg, NULL, $var), mpq_class_hv); +MPF + sv_bless (sv_setref_pv ($arg, NULL, $var), mpf_class_hv); +RANDSTATE + sv_setref_pv ($arg, rand_class, $var); +MALLOCED_STRING + sv_usepvn_mg ($arg, $var, strlen($var)); +GMP_UV + sv_setuv ($arg, (UV) ($var)); |