summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-08-05 22:46:10 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-08-05 22:46:10 +0000
commit574bacfe464e67c186e160f356e339f5a9faa3e8 (patch)
tree5040680d4df675fff5ca63fc6d2220fb7d720525 /lib
parent6d0cc0d743fcf15e2f42426a114c8bb442562080 (diff)
downloadperl-574bacfe464e67c186e160f356e339f5a9faa3e8.tar.gz
Upgrade to Math::BigInt 1.40.
NOTE: this patch necessitates doing something about infinity handling since the new bigintpm.t tests use infinity, which causes SIGFPEs at least in Tru64. p4raw-id: //depot/perl@11591
Diffstat (limited to 'lib')
-rw-r--r--lib/Math/BigFloat.pm278
-rw-r--r--lib/Math/BigInt.pm664
-rw-r--r--lib/Math/BigInt/Calc.pm303
-rwxr-xr-xlib/Math/BigInt/t/bigfltpm.t203
-rw-r--r--lib/Math/BigInt/t/bigintc.t139
-rwxr-xr-xlib/Math/BigInt/t/bigintpm.t227
-rw-r--r--lib/Math/BigInt/t/mbimbf.t2
7 files changed, 1249 insertions, 567 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 5c1eb33e3e..32f0a21c40 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -11,7 +11,7 @@
package Math::BigFloat;
-$VERSION = 1.16;
+$VERSION = '1.20';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
@@ -22,7 +22,7 @@ use Math::BigInt qw/objectify/;
badd bmul bdiv bmod bnorm bsub
bgcd blcm bround bfround
bpow bnan bzero bfloor bceil
- bacmp bstr binc bdec bint binf
+ bacmp bstr binc bdec binf
is_odd is_even is_nan is_inf is_positive is_negative
is_zero is_one sign
);
@@ -49,7 +49,6 @@ use constant MB_NEVER_ROUND => 0x0001;
my $NaNOK=1;
# constant for easier life
my $nan = 'NaN';
-my $ten = Math::BigInt->new(10); # shortcut for speed
# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
$rnd_mode = 'even';
@@ -57,6 +56,9 @@ $accuracy = undef;
$precision = undef;
$div_scale = 40;
+# in case we call SUPER::->foo() and this wants to call modify()
+# sub modify () { 0; }
+
{
# checks for AUTOLOAD
my %methods = map { $_ => 1 }
@@ -129,19 +131,6 @@ sub new
return $self;
}
-# some shortcuts for easier life
-sub bfloat
- {
- # exportable version of new
- return $class->new(@_);
- }
-
-sub bint
- {
- # exportable version of new
- return $class->new(@_,0)->bround(0,'trunc');
- }
-
sub bnan
{
# create a bigfloat 'NaN', if given a BigFloat, set it to 'NaN'
@@ -151,8 +140,8 @@ sub bnan
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_e} = new Math::BigInt 0;
- $self->{_m} = new Math::BigInt 0;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bzero();
$self->{sign} = $nan;
return $self;
}
@@ -168,12 +157,29 @@ sub binf
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_e} = new Math::BigInt 0;
- $self->{_m} = new Math::BigInt 0;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bzero();
$self->{sign} = $sign.'inf';
return $self;
}
+sub bone
+ {
+ # create a bigfloat '+-1', if given a BigFloat, set it to '+-1'
+ my $self = shift;
+ my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
+
+ $self = $class if !defined $self;
+ if (!ref($self))
+ {
+ my $c = $self; $self = {}; bless $self, $c;
+ }
+ $self->{_m} = Math::BigInt->bone();
+ $self->{_e} = Math::BigInt->bzero();
+ $self->{sign} = $sign;
+ return $self;
+ }
+
sub bzero
{
# create a bigfloat '+0', if given a BigFloat, set it to 0
@@ -183,8 +189,8 @@ sub bzero
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_m} = new Math::BigInt 0;
- $self->{_e} = new Math::BigInt 1;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bone();
$self->{sign} = '+';
return $self;
}
@@ -199,38 +205,66 @@ sub bstr
# internal format is always normalized (no leading zeros, "-0" => "+0")
my ($self,$x) = objectify(1,@_);
- #return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- #return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
- return '0' if $x->is_zero();
-
- my $es = $x->{_m}->bstr();
- if ($x->{_e}->is_zero())
+ #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
+ #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
+ if ($x->{sign} !~ /^[+-]$/)
{
- $es = $x->{sign}.$es if $x->{sign} eq '-';
- return $es;
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- if ($x->{_e}->sign() eq '-')
+ my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
+
+ my $not_zero = !$x->is_zero();
+ if ($not_zero)
{
- if ($x->{_e} <= -CORE::length($es))
- {
- # print "style: 0.xxxx\n";
- my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
- $es = '0.'. ('0' x $r) . $es;
- }
- else
+ $es = $x->{_m}->bstr();
+ $len = CORE::length($es);
+ if (!$x->{_e}->is_zero())
+# {
+# $es = $x->{sign}.$es if $x->{sign} eq '-';
+# }
+# else
{
- # print "insert '.' at $x->{_e} in '$es'\n";
- substr($es,$x->{_e},0) = '.';
+ if ($x->{_e}->sign() eq '-')
+ {
+ $dot = '';
+ if ($x->{_e} <= -$len)
+ {
+ # print "style: 0.xxxx\n";
+ my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
+ $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
+ }
+ else
+ {
+ # print "insert '.' at $x->{_e} in '$es'\n";
+ substr($es,$x->{_e},0) = '.'; $cad = $x->{_e};
+ }
+ }
+ else
+ {
+ # expand with zeros
+ $es .= '0' x $x->{_e}; $len += $x->{_e}; $cad = 0;
+ }
}
+ } # if not zero
+ $es = $x->{sign}.$es if $x->{sign} eq '-';
+ # if set accuracy or precision, pad with zeros
+ if ((defined $x->{_a}) && ($not_zero))
+ {
+ # 123400 => 6, 0.1234 => 4, 0.001234 => 4
+ my $zeros = $x->{_a} - $cad; # cad == 0 => 12340
+ $zeros = $x->{_a} - $len if $cad != $len;
+ #print "acc padd $x->{_a} $zeros (len $len cad $cad)\n";
+ $es .= $dot.'0' x $zeros if $zeros > 0;
}
- else
+ elsif ($x->{_p} || 0 < 0)
{
- # expand with zeros
- $es .= '0' x $x->{_e};
+ # 123400 => 6, 0.1234 => 4, 0.001234 => 6
+ my $zeros = -$x->{_p} + $cad;
+ #print "pre padd $x->{_p} $zeros (len $len cad $cad)\n";
+ $es .= $dot.'0' x $zeros if $zeros > 0;
}
- $es = $x->{sign}.$es if $x->{sign} eq '-';
return $es;
}
@@ -241,9 +275,13 @@ sub bsstr
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
my ($self,$x) = objectify(1,@_);
- return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
+ #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-';
my $sep = 'e'.$sign;
return $x->{_m}->bstr().$sep.$x->{_e}->bstr();
@@ -252,7 +290,7 @@ sub bsstr
sub numify
{
# Make a number from a BigFloat object
- # simple return string and let Perl's atoi() handle the rest
+ # simple return string and let Perl's atoi()/atof() handle the rest
my ($self,$x) = objectify(1,@_);
return $x->bsstr();
}
@@ -269,6 +307,10 @@ sub numify
# {
# $class->SUPER::bneg($class,@_);
# }
+
+# tels 2001-08-04
+# todo: this must be overwritten and return NaN for non-integer values
+# band(), bior(), bxor(), too
#sub bnot
# {
# $class->SUPER::bnot($class,@_);
@@ -292,12 +334,15 @@ sub bcmp
}
# check sign for speed first
- return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
- return 0 if $x->is_zero() && $y->is_zero(); # 0 <=> 0
- return -1 if $x->is_zero() && $y->{sign} eq '+'; # 0 <=> +y
- return 1 if $y->is_zero() && $x->{sign} eq '+'; # +x <=> 0
+ # shortcut
+ my $xz = $x->is_zero();
+ my $yz = $y->is_zero();
+ return 0 if $xz && $yz; # 0 <=> 0
+ return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
+ return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# adjust so that exponents are equal
my $lx = $x->{_m}->length() + $x->{_e};
@@ -343,8 +388,24 @@ sub badd
# return result as BFLOAT
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
-
+ # inf and NaN handling
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # NaN first
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # inf handline
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # + and + => +, - and - => -, + and - => 0, - and + => 0
+ return $x->bzero() if $x->{sign} ne $y->{sign};
+ return $x;
+ }
+ # +-inf + something => +inf
+ # something +-inf => +-inf
+ $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
+ return $x;
+ }
+
# speed: no add for 0+y or x+0
return $x if $y->is_zero(); # x+0
if ($x->is_zero()) # 0+y
@@ -447,8 +508,9 @@ sub is_zero
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
- return ($x->{sign} ne $nan && $x->{_m}->is_zero());
+
+ return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
+ return 0;
}
sub is_one
@@ -491,6 +553,19 @@ sub bmul
# print "mbf bmul $x->{_m}e$x->{_e} $y->{_m}e$y->{_e}\n";
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # handle result = 0
+ return $x->bzero() if $x->is_zero() || $y->is_zero();
+ # inf handling
+ if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # result will always be +-inf:
+ # +inf * +/+inf => +inf, -inf * -/-inf => +inf
+ # +inf * -/-inf => -inf, -inf * +/+inf => -inf
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-');
+ }
+
# aEb * cEd = (a*c)E(b+d)
$x->{_m} = $x->{_m} * $y->{_m};
#print "m: $x->{_m}\n";
@@ -509,19 +584,32 @@ sub bdiv
# (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ # x / +-inf => 0, reminder x
+ return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
+ if $y->{sign} =~ /^[+-]inf$/;
+
+ # NaN if x == NaN or y == NaN or x==y==0
return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if ($x->{sign} eq $nan || $y->is_nan() || $y->is_zero());
+ if (($x->is_nan() || $y->is_nan()) ||
+ ($x->is_zero() && $y->is_zero()));
+
+ # 5 / 0 => +inf, -6 / 0 => -inf
+ return wantarray
+ ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
+ if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
$y = $class->new($y) if ref($y) ne $class; # promote bigints
# print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n";
# we need to limit the accuracy to protect against overflow
my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+ my $fallback = 0;
if (!defined $scale)
{
# simulate old behaviour
$scale = $div_scale+1; # one more for proper riund
- $a = $div_scale; # and round to it
+ $a = $div_scale; # and round to it
+ $fallback = 1; # to clear a/p afterwards
}
my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
$scale = $lx if $lx > $scale;
@@ -555,11 +643,23 @@ sub bdiv
$x->bnorm(); # remove trailing 0's
#print "after div: m: $x->{_m} e: $x->{_e}\n";
$x->round($a,$p,$r); # then round accordingly
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
if (wantarray)
{
my $rem = $x->copy();
$rem->bmod($y,$a,$p,$r);
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
return ($x,$rem);
}
return $x;
@@ -589,11 +689,13 @@ sub bsqrt
# we need to limit the accuracy to protect against overflow
my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+ my $fallback = 0;
if (!defined $scale)
{
# simulate old behaviour
$scale = $div_scale+1; # one more for proper riund
$a = $div_scale; # and round to it
+ $fallback = 1; # to clear a/p afterwards
}
my $lx = $x->{_m}->length();
$scale = $lx if $scale < $lx;
@@ -602,6 +704,7 @@ sub bsqrt
# start with some reasonable guess
#$x *= 10 ** ($len - $org->{_e}); $x /= 2; # !?!?
+ $lx = $lx+$x->{_e};
$lx = 1 if $lx < 1;
my $gs = Math::BigFloat->new('1'. ('0' x $lx));
@@ -622,6 +725,13 @@ sub bsqrt
$gs = $x->copy();
}
$x->round($a,$p,$r);
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
+ $x;
}
sub bpow
@@ -634,7 +744,7 @@ sub bpow
return $x if $x->{sign} =~ /^[+-]inf$/;
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bzero()->binc() if $y->is_zero();
+ return $x->bone() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
my $y1 = $y->as_number(); # make bigint
if ($x == -1)
@@ -643,8 +753,8 @@ sub bpow
return $y1->is_odd() ? $x : $x->babs(1);
}
return $x if $x->is_zero() && $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
- # 0 ** -y => 1 / (0 ** y) => / 0!
- return $x->bnan() if $x->is_zero() && $y->{sign} eq '-';
+ # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
+ return $x->binf() if $x->is_zero() && $y->{sign} eq '-';
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
$y1->babs();
@@ -676,8 +786,9 @@ sub bfround
my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
return $x if !defined $scale; # no-op
+ # never round a 0, +-inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
# print "MBF bfround $x to scale $scale mode $mode\n";
- return $x if $x->is_nan() or $x->is_zero();
if ($scale < 0)
{
@@ -705,10 +816,7 @@ sub bfround
# 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
if ($scale < $zad)
{
- $x->{_m} = Math::BigInt->new(0);
- $x->{_e} = Math::BigInt->new(1);
- $x->{sign} = '+';
- return $x;
+ return $x->bzero();
}
if ($scale == $zad) # for 0.006, scale -2 and trunc
{
@@ -738,10 +846,7 @@ sub bfround
if (($scale > $dbt) && ($dbt < 0))
{
# if not enough digits before dot, round to zero
- $x->{_m} = Math::BigInt->new(0);
- $x->{_e} = Math::BigInt->new(1);
- $x->{sign} = '+';
- return $x;
+ return $x->bzero();
}
if (($scale >= 0) && ($dbt == 0))
{
@@ -762,8 +867,8 @@ sub bfround
$scale = $x->{_m}->length() - $scale;
}
}
- #print "using $scale for $x->{_m} with '$mode'\n";
- # pass sign to bround for '+inf' and '-inf' rounding modes
+ # print "using $scale for $x->{_m} with '$mode'\n";
+ # pass sign to bround for rounding modes '+inf' and '-inf'
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode);
$x->{_m}->{sign} = '+'; # fix sign back
@@ -782,7 +887,8 @@ sub bround
# print "bround $scale $mode\n";
# 0 => return all digits, scale < 0 makes no sense
return $x if ($scale <= 0);
- return $x if $x->is_nan() or $x->is_zero(); # never round a 0
+ # never round a 0, +-inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
# if $e longer than $m, we have 0.0000xxxyyy style number, and must
# subtract the delta from scale, to simulate keeping the zeros
@@ -798,7 +904,7 @@ sub bround
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode); # round mantissa
$x->{_m}->{sign} = '+'; # fix sign back
- return $x->bnorm(); # del trailing zeros gen. by bround()
+ $x->bnorm(); # del trailing zeros gen. by bround()
}
sub bfloor
@@ -951,7 +1057,7 @@ sub bnorm
$x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
}
# for something like 0Ey, set y to 1
- $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
+ $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
$x->{_m}->{_f} = MB_NEVER_ROUND;
$x->{_e}->{_f} = MB_NEVER_ROUND;
return $x; # MBI bnorm is no-op
@@ -1243,22 +1349,7 @@ C<as_number()>:
=head1 EXAMPLES
- use Math::BigFloat qw(bstr bint);
# not ready yet
- $x = bstr("1234") # string "1234"
- $x = "$x"; # same as bstr()
- $x = bneg("1234") # BigFloat "-1234"
- $x = Math::BigFloat->bneg("1234"); # BigFloat "1234"
- $x = Math::BigFloat->babs("-12345"); # BigFloat "12345"
- $x = Math::BigFloat->bnorm("-0 00"); # BigFloat "0"
- $x = bint(1) + bint(2); # BigFloat "3"
- $x = bint(1) + "2"; # ditto (auto-BigFloatify of "2")
- $x = bint(1); # BigFloat "1"
- $x = $x + 5 / 2; # BigFloat "3"
- $x = $x ** 3; # BigFloat "27"
- $x *= 2; # BigFloat "54"
- $x = new Math::BigFloat; # BigFloat "0"
- $x--; # BigFloat "-1"
=head1 Autocreating constants
@@ -1274,11 +1365,6 @@ prints the value of C<2E-100>. Note that without conversion of
constants the expression 2E-100 will be calculated as normal floating point
number.
-=head1 PERFORMANCE
-
-Greatly enhanced ;o)
-SectionNotReadyYet.
-
=head1 BUGS
=over 2
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index ec3f1f9009..42521f606a 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -12,18 +12,21 @@
# _f : flags, used by MBF to flag parts of a float as untouchable
# _cow : copy on write: number of objects that share the data (NRY)
+# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
+# underlying lib might change the reference!
+
package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = 1.36;
+$VERSION = '1.40';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
bgcd blcm
bround
blsft brsft band bior bxor bnot bpow bnan bzero
- bacmp bstr bsstr binc bdec bint binf bfloor bceil
+ bacmp bstr bsstr binc bdec binf bfloor bceil
is_odd is_even is_zero is_one is_nan is_inf sign
is_positive is_negative
length as_number
@@ -91,7 +94,7 @@ use overload
'^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
# can modify arg of ++ and --, so avoid a new-copy for speed, but don't
-# use $_[0]->_one(), it modifies $_[0] to be 1!
+# use $_[0]->__one(), it modifies $_[0] to be 1!
'++' => sub { $_[0]->binc() },
'--' => sub { $_[0]->bdec() },
@@ -276,13 +279,6 @@ sub new
}
# split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
- if (ref $mis && !ref $miv)
- {
- # _from_hex or _from_bin
- $self->{value} = $mis->{value};
- $self->{sign} = $mis->{sign};
- return $self; # throw away $mis
- }
if (!ref $mis)
{
die "$wanted is not a number initialized to $class" if !$NaNOK;
@@ -291,6 +287,13 @@ sub new
$self->{sign} = $nan;
return $self;
}
+ if (!ref $miv)
+ {
+ # _from_hex or _from_bin
+ $self->{value} = $mis->{value};
+ $self->{sign} = $mis->{sign};
+ return $self; # throw away $mis
+ }
# make integer from mantissa by adjusting exp, then convert to bigint
$self->{sign} = $$mis; # store sign
$self->{value} = $CALC->_zero(); # for all the NaN cases
@@ -339,13 +342,6 @@ sub new
return $self;
}
-# some shortcuts for easier life
-sub bint
- {
- # exportable version of new
- return $class->new(@_);
- }
-
sub bnan
{
# create a bigint 'NaN', if given a BigInt, set it to 'NaN'
@@ -383,7 +379,6 @@ sub bzero
# create a bigint '+0', if given a BigInt, set it to 0
my $self = shift;
$self = $class if !defined $self;
- #print "bzero $self\n";
if (!ref($self))
{
@@ -396,6 +391,26 @@ sub bzero
return $self;
}
+sub bone
+ {
+ # create a bigint '+1' (or -1 if given sign '-'),
+ # if given a BigInt, set it to +1 or -1, respecively
+ my $self = shift;
+ my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
+ $self = $class if !defined $self;
+ #print "bone $self\n";
+
+ if (!ref($self))
+ {
+ my $c = $self; $self = {}; bless $self, $c;
+ }
+ return if $self->modify('bone');
+ $self->{value} = $CALC->_one();
+ $self->{sign} = $sign;
+ #print "result: $self\n";
+ return $self;
+ }
+
##############################################################################
# string conversation
@@ -406,9 +421,13 @@ sub bsstr
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
my ($self,$x) = objectify(1,@_);
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my ($m,$e) = $x->parts();
- # can be only '+', so
+ # e can only be positive
my $sign = 'e+';
# MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
return $m->bstr().$sign.$e->bstr();
@@ -418,7 +437,11 @@ sub bstr
{
# make a string from bigint object
my $x = shift; $x = $class->new($x) unless ref $x;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
return $es.${$CALC->_str($x->{value})};
}
@@ -459,16 +482,20 @@ sub round
my $r = shift; # round_mode, if given by caller
my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops)
+ $self = new($self) unless ref($self); # if not object, make one
+ my $c = ref($args[0]); # find out class of argument
+ unshift @args,$self; # add 'first' argument
+
+ no strict 'refs';
+ my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
+ if (!defined $aa)
+ {
+ $z = "$c\::precision"; $ap = $$z;
+ }
+
# leave bigfloat parts alone
return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
- unshift @args,$self; # add 'first' argument
-
- $self = new($self) unless ref($self); # if not object, make one
-
- # find out class of argument to round
- my $c = ref($args[0]);
-
# now pick $a or $p, but only if we have got "arguments"
if ((!defined $a) && (!defined $p) && (@args > 0))
{
@@ -487,12 +514,7 @@ sub round
# if none defined, use globals (#2)
if (!defined $p)
{
- no strict 'refs';
- my $z = "$c\::accuracy"; $a = $$z;
- if (!defined $a)
- {
- $z = "$c\::precision"; $p = $$z;
- }
+ $a = $aa; $p = $ap; # save the check: if !defined $a;
}
} # endif !$a
} # endif !$a || !$P && args > 0
@@ -513,16 +535,13 @@ sub bnorm
{
# (num_str or BINT) return BINT
# Normalize number -- no-op here
- my $self = shift;
-
- return $self;
+ return $_[0];
}
sub babs
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
- #my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
return $x if $x->modify('babs');
# post-normalized abs for internal use (does nothing for NaN)
@@ -534,12 +553,11 @@ sub bneg
{
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my $x = shift; $x = $class->new($x) unless ref $x;
return $x if $x->modify('bneg');
# for +0 dont negate (to have always normalized)
return $x if $x->is_zero();
$x->{sign} =~ tr/+\-/-+/; # does nothing for NaN
- # $x->round($a,$p,$r); # changing this makes $x - $y modify $y!!
$x;
}
@@ -553,12 +571,22 @@ sub bcmp
{
# handle +-inf and NaN
return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/);
+ return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
return +1 if $x->{sign} eq '+inf';
return -1 if $x->{sign} eq '-inf';
return -1 if $y->{sign} eq '+inf';
return +1 if $y->{sign} eq '-inf';
}
+ # check sign for speed first
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
+ return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
+
+ # shortcut
+ my $xz = $x->is_zero();
+ my $yz = $y->is_zero();
+ return 0 if $xz && $yz; # 0 <=> 0
+ return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
+ return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# normal compare now
&cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
}
@@ -569,8 +597,14 @@ sub bacmp
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
my ($self,$x,$y) = objectify(2,@_);
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- #acmp($x->{value},$y->{value}) <=> 0;
+
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # handle +-inf and NaN
+ return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
+ return +1; # inf is always bigger
+ }
$CALC->_acmp($x->{value},$y->{value}) <=> 0;
}
@@ -581,8 +615,25 @@ sub badd
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('badd');
- return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/));
+ # inf and NaN handling
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # NaN first
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # inf handline
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # + and + => +, - and - => -, + and - => 0, - and + => 0
+ return $x->bzero() if $x->{sign} ne $y->{sign};
+ return $x;
+ }
+ # +-inf + something => +inf
+ # something +-inf => +-inf
+ $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
+ return $x;
+ }
+
my @bn = ($a,$p,$r,$y); # make array for round calls
# speed: no add for 0+y or x+0
return $x->round(@bn) if $y->is_zero(); # x+0
@@ -590,28 +641,24 @@ sub badd
{
# make copy, clobbering up x
$x->{value} = $CALC->_copy($y->{value});
- #$x->{value} = [ @{$y->{value}} ];
$x->{sign} = $y->{sign} || $nan;
return $x->round(@bn);
}
- # shortcuts
- my $xv = $x->{value};
- my $yv = $y->{value};
my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
if ($sx eq $sy)
{
- $CALC->_add($xv,$yv); # if same sign, absolute add
+ $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
$x->{sign} = $sx;
}
else
{
- my $a = $CALC->_acmp ($yv,$xv); # absolute compare
+ my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
if ($a > 0)
{
#print "swapped sub (a=$a)\n";
- $CALC->_sub($yv,$xv,1); # absolute sub w/ swapped params
+ $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sy;
}
elsif ($a == 0)
@@ -624,7 +671,7 @@ sub badd
else # a < 0
{
#print "unswapped sub (a=$a)\n";
- $CALC->_sub($xv, $yv); # absolute sub
+ $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
$x->{sign} = $sx;
}
}
@@ -649,7 +696,7 @@ sub binc
my ($self,$x,$a,$p,$r) = objectify(1,@_);
# my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
return $x if $x->modify('binc');
- $x->badd($self->_one())->round($a,$p,$r);
+ $x->badd($self->__one())->round($a,$p,$r);
}
sub bdec
@@ -657,7 +704,7 @@ sub bdec
# decrement arg by one
my ($self,$x,$a,$p,$r) = objectify(1,@_);
return $x if $x->modify('bdec');
- $x->badd($self->_one('-'))->round($a,$p,$r);
+ $x->badd($self->__one('-'))->round($a,$p,$r);
}
sub blcm
@@ -709,7 +756,7 @@ sub bgcd
{
while (@_)
{
- $x = _gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
+ $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
}
}
$x->babs();
@@ -741,10 +788,8 @@ sub is_zero
#my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
- return 0 if $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
return $CALC->_is_zero($x->{value});
- #return (@{$x->{value}} == 1) && ($x->{sign} eq '+')
- # && ($x->{value}->[0] == 0);
}
sub is_nan
@@ -772,13 +817,10 @@ sub is_one
# or -1 if sign is given
#my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
- my $sign = shift || '+';
+ my $sign = shift || ''; $sign = '+' if $sign ne '-';
- # catch also NaN, +inf, -inf
- return 0 if $x->{sign} ne $sign || $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->{sign} ne $sign;
return $CALC->_is_one($x->{value});
- #return (@{$x->{value}} == 1) && ($x->{sign} eq $sign)
- # && ($x->{value}->[0] == 1);
}
sub is_odd
@@ -789,7 +831,6 @@ sub is_odd
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_odd($x->{value});
- #return (($x->{sign} ne $nan) && ($x->{value}->[0] & 1));
}
sub is_even
@@ -800,8 +841,6 @@ sub is_even
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_even($x->{value});
- #return (($x->{sign} ne $nan) && (!($x->{value}->[0] & 1)));
- #return (($x->{sign} !~ /^[+-]$/) && ($CALC->_is_even($x->{value})));
}
sub is_positive
@@ -827,11 +866,23 @@ sub bmul
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('bmul');
- return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/));
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # handle result = 0
+ return $x if $x->is_zero();
+ return $x->bzero() if $y->is_zero();
+ # inf handling
+ if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # result will always be +-inf:
+ # +inf * +/+inf => +inf, -inf * -/-inf => +inf
+ # +inf * -/-inf => -inf, -inf * +/+inf => -inf
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-');
+ }
- return $x->bzero() if $x->is_zero() || $y->is_zero(); # handle result = 0
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
return $x->round($a,$p,$r,$y);
}
@@ -843,14 +894,23 @@ sub bdiv
return $x if $x->modify('bdiv');
- # 5 / 0 => +inf, -6 / 0 => -inf (0 / 0 => 1 or +inf or NaN?)
- #return wantarray
- # ? ($x->binf($x->{sign}),binf($x->{sign})) : $x->binf($x->{sign})
- # if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
+ # x / +-inf => 0, reminder x
+ return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
+ if $y->{sign} =~ /^[+-]inf$/;
- # NaN?
+ # NaN if x == NaN or y == NaN or x==y==0
return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
+ if (($x->is_nan() || $y->is_nan()) ||
+ ($x->is_zero() && $y->is_zero()));
+
+ # 5 / 0 => +inf, -6 / 0 => -inf
+ return wantarray
+ ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
+ if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
+
+ # old code: always NaN if /0
+ #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
+ # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
# 0 / something
return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
@@ -866,7 +926,7 @@ sub bdiv
elsif ($cmp == 0)
{
# shortcut, both are the same, so set to +/- 1
- $x->_one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
+ $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
return $x unless wantarray;
return ($x,$self->bzero());
}
@@ -913,22 +973,23 @@ sub bpow
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->_one() if $y->is_zero();
+ return $x->__one() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
#if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1)
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
# if $x == -1 and odd/even y => +1/-1
return $y->is_odd() ? $x : $x->babs();
- # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; LOL
+ # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
}
- # 1 ** -y => 1 / (1**y), so do test for negative $y after above's clause
+ # 1 ** -y => 1 / (1 ** |y|)
+ # so do test for negative $y after above's clause
return $x->bnan() if $y->{sign} eq '-';
return $x if $x->is_zero(); # 0**y => 0 (if not y <= 0)
if ($CALC->can('_pow'))
{
- $CALC->_pow($x->{value},$y->{value});
+ $x->{value} = $CALC->_pow($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
# based on the assumption that shifting in base 10 is fast, and that mul
@@ -938,17 +999,17 @@ sub bpow
# afterwards like this:
# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
# creates deep recursion?
- #my $zeros = $x->_trailing_zeros();
- #if ($zeros > 0)
- # {
- # $x->brsft($zeros,10); # remove zeros
- # $x->bpow($y); # recursion (will not branch into here again)
- # $zeros = $y * $zeros; # real number of zeros to add
- # $x->blsft($zeros,10);
- # return $x->round($a,$p,$r);
- # }
-
- my $pow2 = $self->_one();
+# my $zeros = $x->_trailing_zeros();
+# if ($zeros > 0)
+# {
+# $x->brsft($zeros,10); # remove zeros
+# $x->bpow($y); # recursion (will not branch into here again)
+# $zeros = $y * $zeros; # real number of zeros to add
+# $x->blsft($zeros,10);
+# return $x->round($a,$p,$r);
+# }
+
+ my $pow2 = $self->__one();
my $y1 = $class->new($y);
my ($res);
while (!$y1->is_one())
@@ -975,47 +1036,15 @@ sub blsft
return $x if $x->modify('blsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- $n = 2 if !defined $n; return $x if $n == 0;
- return $x->bnan() if $n < 0 || $y->{sign} eq '-';
- #if ($n != 10)
- # {
- $x->bmul( $self->bpow($n, $y) );
- # }
- #else
- # {
- # # shortcut (faster) for shifting by 10) since we are in base 10eX
- # # multiples of 5:
- # my $src = scalar @{$x->{value}}; # source
- # my $len = $y->numify(); # shift-len as normal int
- # my $rem = $len % 5; # reminder to shift
- # my $dst = $src + int($len/5); # destination
- #
- # my $v = $x->{value}; # speed-up
- # my $vd; # further speedup
- # #print "src $src:",$v->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n";
- # $v->[$src] = 0; # avoid first ||0 for speed
- # while ($src >= 0)
- # {
- # $vd = $v->[$src]; $vd = '00000'.$vd;
- # #print "s $src d $dst '$vd' ";
- # $vd = substr($vd,-5+$rem,5-$rem);
- # #print "'$vd' ";
- # $vd .= $src > 0 ? substr('00000'.$v->[$src-1],-5,$rem) : '0' x $rem;
- # #print "'$vd' ";
- # $vd = substr($vd,-5,5) if length($vd) > 5;
- # #print "'$vd'\n";
- # $v->[$dst] = int($vd);
- # $dst--; $src--;
- # }
- # # set lowest parts to 0
- # while ($dst >= 0) { $v->[$dst--] = 0; }
- # # fix spurios last zero element
- # splice @$v,-1 if $v->[-1] == 0;
- # #print "elems: "; my $i = 0;
- # #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n";
- # # old way: $x->bmul( $self->bpow($n, $y) );
- # }
- return $x;
+ $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
+
+ my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
+ if (defined $t)
+ {
+ $x->{value} = $t; return $x;
+ }
+ # fallback
+ return $x->bmul( $self->bpow($n, $y) );
}
sub brsft
@@ -1028,48 +1057,14 @@ sub brsft
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
- #if ($n != 10)
- # {
- scalar bdiv($x, $self->bpow($n, $y));
- # }
- #else
- # {
- # # shortcut (faster) for shifting by 10)
- # # multiples of 5:
- # my $dst = 0; # destination
- # my $src = $y->numify(); # as normal int
- # my $rem = $src % 5; # reminder to shift
- # $src = int($src / 5); # source
- # my $len = scalar @{$x->{value}} - $src; # elems to go
- # my $v = $x->{value}; # speed-up
- # if ($rem == 0)
- # {
- # splice (@$v,0,$src); # even faster, 38.4 => 39.3
- # }
- # else
- # {
- # my $vd;
- # $v->[scalar @$v] = 0; # avoid || 0 test inside loop
- # while ($dst < $len)
- # {
- # $vd = '00000'.$v->[$src];
- # #print "$dst $src '$vd' ";
- # $vd = substr($vd,-5,5-$rem);
- # #print "'$vd' ";
- # $src++;
- # $vd = substr('00000'.$v->[$src],-$rem,$rem) . $vd;
- # #print "'$vd1' ";
- # #print "'$vd'\n";
- # $vd = substr($vd,-5,5) if length($vd) > 5;
- # $v->[$dst] = int($vd);
- # $dst++;
- # }
- # splice (@$v,$dst) if $dst > 0; # kill left-over array elems
- # pop @$v if $v->[-1] == 0; # kill last element
- # } # else rem == 0
- # # old way: scalar bdiv($x, $self->bpow($n, $y));
- # }
- return $x;
+
+ my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
+ if (defined $t)
+ {
+ $x->{value} = $t; return $x;
+ }
+ # fallback
+ return scalar bdiv($x, $self->bpow($n, $y));
}
sub band
@@ -1083,28 +1078,34 @@ sub band
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x->bzero() if $y->is_zero();
- if ($CALC->can('_and'))
+ my $sign = 0; # sign of result
+ $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ if ($CALC->can('_and') && $sx == 1 && $sy == 1)
{
- $CALC->_and($x->{value},$y->{value});
+ $x->{value} = $CALC->_and($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
-
+
my $m = new Math::BigInt 1; my ($xr,$yr);
- my $x10000 = new Math::BigInt (0x10000);
- my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ my $x10000 = new Math::BigInt (0x1000);
+ my $y1 = copy(ref($x),$y); # make copy
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() && !$y1->is_zero())
{
($x1, $xr) = bdiv($x1, $x10000);
($y1, $yr) = bdiv($y1, $x10000);
- #print ref($xr), " $xr ", $xr->numify(),"\n";
- #print ref($yr), " $yr ", $yr->numify(),"\n";
- #print "res: ",$yr->numify() & $xr->numify(),"\n";
- my $u = bmul( $class->new( $xr->numify() & $yr->numify() ), $m);
- #print "res: $u\n";
- $x->badd( bmul( $class->new( $xr->numify() & $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
+ $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
@@ -1118,23 +1119,37 @@ sub bior
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x if $y->is_zero();
- if ($CALC->can('_or'))
+
+ my $sign = 0; # sign of result
+ $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ # don't use lib for negative values
+ if ($CALC->can('_or') && $sx == 1 && $sy == 1)
{
- $CALC->_or($x->{value},$y->{value});
+ $x->{value} = $CALC->_or($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
my $m = new Math::BigInt 1; my ($xr,$yr);
my $x10000 = new Math::BigInt (0x10000);
- my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ my $y1 = copy(ref($x),$y); # make copy
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() || !$y1->is_zero())
{
($x1, $xr) = bdiv($x1,$x10000);
($y1, $yr) = bdiv($y1,$x10000);
- $x->badd( bmul( $class->new( $xr->numify() | $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
+ $m));
+# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
@@ -1150,23 +1165,36 @@ sub bxor
return $x if $y->is_zero();
return $x->bzero() if $x == $y; # shortcut
- if ($CALC->can('_xor'))
+ my $sign = 0; # sign of result
+ $sign = 1 if $x->{sign} ne $y->{sign};
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ # don't use lib for negative values
+ if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
{
- $CALC->_xor($x->{value},$y->{value});
+ $x->{value} = $CALC->_xor($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
my $m = new Math::BigInt 1; my ($xr,$yr);
my $x10000 = new Math::BigInt (0x10000);
my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() || !$y1->is_zero())
{
($x1, $xr) = bdiv($x1, $x10000);
($y1, $yr) = bdiv($y1, $x10000);
- $x->badd( bmul( $class->new( $xr->numify() ^ $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
+ $m));
+# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
@@ -1196,7 +1224,7 @@ sub _trailing_zeros
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->is_zero() || $x->is_nan() || $x->is_inf();
+ return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
@@ -1324,7 +1352,7 @@ sub bround
# print "MBI round: $x to $scale $mode\n";
# -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
- return $x if $x->is_nan() || $x->is_zero() || $scale == 0;
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
# we have fewer digits than we want to scale to
my $len = $x->length();
@@ -1397,9 +1425,9 @@ sub bround
}
elsif ($pad > $len)
{
- $x->{value} = $CALC->_zero(); # round to '0'
+ $x->bzero(); # round to '0'
}
- #print "res $$xs\n";
+ # print "res $pad $len $x $$xs\n";
}
# move this later on after the inc of the string
#$x->{value} = $CALC->_new($xs); # put back in
@@ -1442,11 +1470,10 @@ sub bceil
##############################################################################
# private stuff (internal use only)
-sub _one
+sub __one
{
# internal speedup, set argument to 1, or create a +/- 1
my $self = shift;
- #my $x = $self->bzero(); $x->{value} = [ 1 ]; $x->{sign} = shift || '+'; $x;
my $x = $self->bzero(); $x->{value} = $CALC->_one();
$x->{sign} = shift || '+';
return $x;
@@ -1502,7 +1529,7 @@ sub objectify
# Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
# Math::BigInt::badd(1,2); => scalar x, scalar y
# In the last case we check number of arguments to turn it silently into
- # $class,1,2. (We cannot take '1' as class ;o)
+ # $class,1,2. (We can not take '1' as class ;o)
# badd($class,1) is not supported (it should, eventually, try to add undef)
# currently it tries 'Math::BigInt' + 1, which will not work.
@@ -1592,7 +1619,7 @@ sub import
{
# this causes a different low lib to take care...
$CALC = $_[$i+1] || $CALC;
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "cannot modify non-existant..."
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
splice @a, $j, $s; $j -= $s;
}
}
@@ -1601,36 +1628,30 @@ sub import
#$self->SUPER::import(@a); # does not work
$self->export_to_level(1,$self,@a); # need this instead
- # load core math lib
- $CALC = 'Math::BigInt::'.$CALC if $CALC !~ /^Math::BigInt/i;
- my $c = $CALC;
- $c =~ s!::!/!g; # XXX portability, e.g. MacOS?
- $c .= '.pm' if $c !~ /\.pm$/;
- require $c;
+ # try to load core math lib
+ my @c = split /\s*,\s*/,$CALC;
+ push @c,'Calc'; # if all fail, try this
+ foreach my $lib (@c)
+ {
+ $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
+ $lib =~ s/\.pm$//;
+ if ($] < 5.6)
+ {
+ # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+ # used in the same script, or eval inside import().
+ (my $mod = $lib . '.pm') =~ s!::!/!g;
+ # require does not automatically :: => /, so portability problems arise
+ eval { require $mod; $lib->import(); }
+ }
+ else
+ {
+ eval "use $lib;";
+ }
+ $CALC = $lib, last if $@ eq '';
+ }
}
-sub _strip_zeros
- {
- # internal normalization function that strips leading zeros from the array
- # args: ref to array
- my $s = shift;
-
- my $cnt = scalar @$s; # get count of parts
- my $i = $cnt-1;
- #print "strip: cnt $cnt i $i\n";
- # '0', '3', '4', '0', '0',
- # 0 1 2 3 4
- # cnt = 5, i = 4
- # i = 4
- # i = 3
- # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
- # >= 1: skip first part (this can be zero)
- while ($i > 0) { last if $s->[$i] != 0; $i--; }
- $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
- return $s;
- }
-
-sub _from_hex
+sub __from_hex
{
# convert a (ref to) big hex string to BigInt, return undef for error
my $hs = shift;
@@ -1668,7 +1689,7 @@ sub _from_hex
return $x;
}
-sub _from_bin
+sub __from_bin
{
# convert a (ref to) big binary string to BigInt, return undef for error
my $bs = shift;
@@ -1711,22 +1732,31 @@ sub _split
{
# (ref to num_str) return num_str
# internal, take apart a string and return the pieces
+ # strip leading/trailing whitespace, leading zeros, underscore, reject
+ # invalid input
my $x = shift;
- # pre-parse input
- $$x =~ s/^\s+//g; # strip white space at front
+ # strip white space at front, also extranous leading zeros
+ $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
+ $$x =~ s/^\s+//; # but this will
$$x =~ s/\s+$//g; # strip white space at end
- #$$x =~ s/\s+//g; # strip white space (no longer)
- return if $$x eq "";
- return _from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
- return _from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+ # shortcut, if nothing to split, return early
+ if ($$x =~ /^[+-]?\d+$/)
+ {
+ $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
+ return (\$sign, $x, \'', \'', \0);
+ }
- return if $$x !~ /^[\-\+]?\.?[0-9]/;
+ # invalid starting char?
+ return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
$$x =~ s/(\d)_(\d)/$1$2/g; # strip underscores between digits
$$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
+ return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
+ return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+
# some possible inputs:
# 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
# .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
@@ -1809,7 +1839,7 @@ sub _lcm
return $x * $ty / bgcd($x,$ty);
}
-sub _gcd
+sub __gcd
{
# (BINT or num_str, BINT or num_str) return BINT
# does modify first arg
@@ -1844,13 +1874,17 @@ Math::BigInt - Arbitrary size integer math package
use Math::BigInt;
# Number creation
- $x = Math::BigInt->new($str); # defaults to 0
- $nan = Math::BigInt->bnan(); # create a NotANumber
- $zero = Math::BigInt->bzero();# create a "+0"
+ $x = Math::BigInt->new($str); # defaults to 0
+ $nan = Math::BigInt->bnan(); # create a NotANumber
+ $zero = Math::BigInt->bzero(); # create a +0
+ $inf = Math::BigInt->binf(); # create a +inf
+ $inf = Math::BigInt->binf('-'); # create a -inf
+ $one = Math::BigInt->bone(); # create a +1
+ $one = Math::BigInt->bone('-'); # create a -1
# Testing
- $x->is_zero(); # return whether arg is zero or not
- $x->is_nan(); # return whether arg is NaN or not
+ $x->is_zero(); # true if arg is +0
+ $x->is_nan(); # true if arg is NaN
$x->is_one(); # true if arg is +1
$x->is_one('-'); # true if arg is -1
$x->is_odd(); # true if odd, false for even
@@ -1870,6 +1904,8 @@ Math::BigInt - Arbitrary size integer math package
# set
$x->bzero(); # set $x to 0
$x->bnan(); # set $x to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
$x->bneg(); # negation
$x->babs(); # absolute value
@@ -1984,7 +2020,7 @@ Not yet implemented things (but with correct description) are marked with '!',
things that need to be answered are marked with '?'.
In the next paragraph follows a short description of terms used here (because
-these may differ from terms used by other people or documentation).
+these may differ from terms used by others people or documentation).
During the rest of this document, the shortcuts A (for accuracy), P (for
precision), F (fallback) and R (rounding mode) will be used.
@@ -2000,16 +2036,19 @@ because 1200 can have p = 0, 1 or 2 (depending on what the inital value
was). It could also have p < 0, when the digits after the decimal point
are zero.
- !The string output of such a number should be padded with zeros:
- !
- ! Initial value P Result String
- ! 1234.01 -3 1000 1000
- ! 1234 -2 1200 1200
- ! 1234.5 -1 1230 1230
- ! 1234.001 1 1234 1234.0
- ! 1234.01 0 1234 1234
- ! 1234.01 2 1234.01 1234.01
- ! 1234.01 5 1234.01 1234.01000
+The string output (of floating point numbers) will be padded with zeros:
+
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 -3 1000 1000
+ 1234 -2 1200 1200
+ 1234.5 -1 1230 1230
+ 1234.001 1 1234 1234.0
+ 1234.01 0 1234 1234
+ 1234.01 2 1234.01 1234.01
+ 1234.01 5 1234.01 1234.01000
+
+For BigInts, no padding occurs.
=head2 Accuracy A
@@ -2018,9 +2057,20 @@ number may have an accuracy greater than the non-zero digits
when there are zeros in it or trailing zeros. For example, 123.456 has
A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
+The string output (of floating point numbers) will be padded with zeros:
+
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 3 1230 1230
+ 1234.01 6 1234.01 1234.01
+ 1234.1 8 1234.1 1234.1000
+
+For BigInts, no padding occurs.
+
=head2 Fallback F
-When both A and P are undefined, this is used as a fallback accuracy.
+When both A and P are undefined, this is used as a fallback accuracy when
+dividing numbers.
=head2 Rounding mode R
@@ -2165,9 +2215,9 @@ This is how it works now:
operation according to the rules below
* Negative P is ignored in Math::BigInt, since BigInts never have digits
after the decimal point
- !* Math::BigFloat uses Math::BigInts internally, but setting A or P inside
- ! Math::BigInt as globals should not tamper with the parts of a BigFloat.
- ! Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
+ * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
+ Math::BigInt as globals should not tamper with the parts of a BigFloat.
+ Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
=item Precedence
@@ -2191,7 +2241,7 @@ This is how it works now:
* fdiv will calculate 1 more digit than required (determined by
A, P or F), and, if F is not used, round the result
(this will still fail in the case of a result like 0.12345000000001 with A
- or P of 5, but this cannot be helped - or can it?)
+ or P of 5, but this can not be helped - or can it?)
* Thus you can have the math done by on Math::Big* class in three modes:
+ never round (this is the default):
This is done by setting A and P to undef. No math operation
@@ -2289,28 +2339,41 @@ This is how it works now:
=head1 INTERNALS
-The actual numbers are stored as unsigned big integers, and math with them is
-done (by default) by a module called Math::BigInt::Calc. This is equivalent to:
+The actual numbers are stored as unsigned big integers (with seperate sign).
+You should neither care about nor depend on the internal representation; it
+might change without notice. Use only method calls like C<< $x->sign(); >>
+instead relying on the internal hash keys like in C<< $x->{sign}; >>.
+
+=head2 MATH LIBRARY
- use Math::BigInt lib => 'calc';
+Math with the numbers is done (by default) by a module called
+Math::BigInt::Calc. This is equivalent to saying:
+
+ use Math::BigInt lib => 'Calc';
You can change this by using:
use Math::BigInt lib => 'BitVect';
-('Math::BitInt::BitVect' works, too.)
+The following would first try to find Math::BigInt::Foo, then
+Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
-Calc.pm uses as internal format an array of elements of base 100000 digits
-with the least significant digit first, BitVect.pm uses a bit vector of base 2,
-most significant bit first.
+ use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
-The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to
-represent the result when input arguments are not numbers. '+inf' and
-'-inf' represent infinity.
+Calc.pm uses as internal format an array of elements of some decimal base
+(usually 1e5, but this might change to 1e7) with the least significant digit
+first, while BitVect.pm uses a bit vector of base 2, most significant bit
+first. Other modules might use even different means of representing the
+numbers. See the respective module documentation for further details.
-You should neither care about nor depend on the internal representation; it
-might change without notice. Use only method calls like C<< $x->sign(); >>
-instead of relying on the internal hash keys like in C<< $x->{sign}; >>.
+=head2 SIGN
+
+The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
+
+A sign of 'NaN' is used to represent the result when input arguments are not
+numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
+minus infinity. You will get '+inf' when dividing a positive number by 0, and
+'-inf' when dividing any negative number by 0.
=head2 mantissa(), exponent() and parts()
@@ -2325,9 +2388,10 @@ that:
C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
in one go. Both the returned mantissa and exponent have a sign.
-Currently, for BigInts C<$e> will be always 0, except for NaN where it will be
-NaN and for $x == 0, then it will be 1 (to be compatible with Math::BigFloat's
-internal representation of a zero as C<0E1>).
+Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
+where it will be NaN; and for $x == 0, where it will be 1
+(to be compatible with Math::BigFloat's internal representation of a zero as
+C<0E1>).
C<$m> will always be a copy of the original number. The relation between $e
and $m might change in the future, but will always be equivalent in a
@@ -2335,7 +2399,10 @@ numerical sense, e.g. $m might get minimized.
=head1 EXAMPLES
- use Math::BigInt qw(bstr bint);
+ use Math::BigInt qw(bstr);
+
+ sub bint { Math::BigInt->new(shift); }
+
$x = bstr("1234") # string "1234"
$x = "$x"; # same as bstr()
$x = bneg("1234") # Bigint "-1234"
@@ -2421,37 +2488,47 @@ operations may be slower for small numbers, but are significantly faster for
big numbers. Other operations are now constant (O(1), like bneg(), babs()
etc), instead of O(N) and thus nearly always take much less time.
-For more benchmark results see http://bloodgate.com/perl/benchmarks.html
+If you find the Calc module to slow, try to install any of the replacement
+modules and see if they help you.
-=head2 Replacing the math library
+=head2 Alternative math libraries
You can use an alternative library to drive Math::BigInt via:
use Math::BigInt lib => 'Module';
-The default is called Math::BigInt::Calc and is a pure-perl base 100,000
-math package that consists of the standard routine present in earlier versions
-of Math::BigInt.
+The default is called Math::BigInt::Calc and is a pure-perl implementation
+that consists mainly of the standard routine present in earlier versions of
+Math::BigInt.
There are also Math::BigInt::Scalar (primarily for testing) and
-Math::BigInt::BitVect; these and others can be found via
-L<http://search.cpan.org/>:
+Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
+All these can be found via L<http://search.cpan.org/>:
use Math::BigInt lib => 'BitVect';
my $x = Math::BigInt->new(2);
print $x ** (1024*1024);
+For more benchmark results see http://bloodgate.com/perl/benchmarks.html
+
=head1 BUGS
=over 2
-=item :constant and eval()
+=item Out of Memory!
Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
C<eval()> in your code will crash with "Out of memory". This is probably an
overload/exporter bug. You can workaround by not having C<eval()>
-and ':constant' at the same time or upgrade your Perl.
+and ':constant' at the same time or upgrade your Perl to a newer version.
+
+=item Fails to load Calc on Perl prior 5.6.0
+
+Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
+will fall back to eval { require ... } when loading the math lib on Perls
+prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
+filesystems using a different seperator.
=back
@@ -2511,6 +2588,9 @@ as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
$y = Math::BigInt->new($y);
ok ($x,$y); # okay
+There is not yet a way to get a number automatically represented in exactly
+the way Perl represents it.
+
=item int()
C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
@@ -2528,6 +2608,8 @@ In all Perl versions you can use C<as_number()> for the same effect:
This also works for other subclasses, like Math::String.
+It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
+
=item bdiv
The following will probably not do what you expect:
@@ -2548,8 +2630,8 @@ real-valued quotient of the two operands, and the remainder (when it is
nonzero) always has the same sign as the second operand; so, for
example,
- 1 / 4 => ( 0, 1)
- 1 / -4 => (-1,-3)
+ 1 / 4 => ( 0, 1)
+ 1 / -4 => (-1,-3)
-3 / 4 => (-1, 1)
-3 / -4 => ( 0,-3)
@@ -2591,7 +2673,7 @@ See also the documentation for overload.pm regarding C<=>.
=item bpow
C<bpow()> (and the rounding functions) now modifies the first argument and
-return it, unlike the old code which left it alone and only returned the
+returns it, unlike the old code which left it alone and only returned the
result. This is to be consistent with C<badd()> etc. The first three will
modify $x, the last one won't:
@@ -2703,6 +2785,8 @@ the same terms as Perl itself.
L<Math::BigFloat> and L<Math::Big>.
+L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
+
=head1 AUTHORS
Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index 23ff06329d..c42fc4043d 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -2,7 +2,7 @@ package Math::BigInt::Calc;
use 5.005;
use strict;
-use warnings;
+# use warnings; # dont use warnings for older Perls
require Exporter;
@@ -17,8 +17,9 @@ use vars qw/ @ISA @EXPORT $VERSION/;
_is_zero _is_one
_is_even _is_odd
_check _zero _one _copy _zeros
+ _rsft _lsft
);
-$VERSION = '0.06';
+$VERSION = '0.09';
# Package to store unsigned big integers in decimal and do math with them
@@ -39,10 +40,37 @@ $VERSION = '0.06';
# constants for easier life
my $nan = 'NaN';
-my $BASE_LEN = 5;
+
+my $BASE_LEN = 7;
my $BASE = int("1e".$BASE_LEN); # var for trying to change it to 1e7
-my $RBASE = 1e-5; # see USE_MUL
-my $class = 'Math::BigInt::Calc';
+my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+
+BEGIN
+ {
+ # Daniel Pfeiffer: determine largest group of digits that is precisely
+ # multipliable with itself plus carry
+ my ($e, $num) = 4;
+ do {
+ $num = ('9' x ++$e) + 0;
+ $num *= $num + 1;
+ } until ($num == $num - 1 or $num - 1 == $num - 2);
+ $BASE_LEN = $e-1;
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ }
+
+# for quering and setting, to debug/benchmark things
+sub _base_len
+ {
+ my $b = shift;
+ if (defined $b)
+ {
+ $BASE_LEN = $b;
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ }
+ $BASE_LEN;
+ }
##############################################################################
# create objects from various representations
@@ -52,12 +80,12 @@ sub _new
# (string) return ref to num_array
# Convert a number from string format to internal base 100000 format.
# Assumes normalized value as input.
- shift @_ if $_[0] eq $class;
- my $d = shift;
+ my $d = $_[1];
# print "_new $d $$d\n";
my $il = CORE::length($$d)-1;
# these leaves '00000' instead of int 0 and will be corrected after any op
- return [ reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $$d)) ];
+ return [ reverse(unpack("a" . ($il % $BASE_LEN+1)
+ . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
}
sub _zero
@@ -74,9 +102,7 @@ sub _one
sub _copy
{
- shift @_ if $_[0] eq $class;
- my $x = shift;
- return [ @$x ];
+ return [ @{$_[1]} ];
}
##############################################################################
@@ -87,8 +113,7 @@ sub _str
# (ref to BINT) return num_str
# Convert number from internal base 100000 format to string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
- shift @_ if $_[0] eq $class;
- my $ar = shift;
+ my $ar = $_[1];
my $ret = "";
my $l = scalar @$ar; # number of parts
return $nan if $l < 1; # should not happen
@@ -96,10 +121,11 @@ sub _str
# leading zero parts in internal representation)
$l --; $ret .= $ar->[$l]; $l--;
# Interestingly, the pre-padd method uses more time
- # the old grep variant takes longer (14 to 10 sec)
+ # the old grep variant takes longer (14 to 10 sec)
+ my $z = '0' x ($BASE_LEN-1);
while ($l >= 0)
{
- $ret .= substr('0000'.$ar->[$l],-5); # fastest way I could think of
+ $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
$l--;
}
return \$ret;
@@ -108,8 +134,7 @@ sub _str
sub _num
{
# Make a number (scalar int/float) from a BigInt object
- shift @_ if $_[0] eq $class;
- my $x = shift;
+ my $x = $_[1];
return $x->[0] if scalar @$x == 1; # below $BASE
my $fac = 1;
my $num = 0;
@@ -126,13 +151,12 @@ sub _num
sub _add
{
# (ref to int_num_array, ref to int_num_array)
- # routine to add two base 1e5 numbers
+ # routine to add two base 1eX numbers
# stolen from Knuth Vol 2 Algorithm A pg 231
# there are separate routines to add and sub as per Knuth pg 233
# This routine clobbers up array x, but not y.
- shift @_ if $_[0] eq $class;
- my ($x,$y) = @_;
+ my ($c,$x,$y) = @_;
# for each in Y, add Y to X and carry. If after that, something is left in
# X, foreach in X add carry to X and then return X, carry
@@ -155,10 +179,9 @@ sub _add
sub _sub
{
# (ref to int_num_array, ref to int_num_array)
- # subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+ # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
# subtract Y from X (X is always greater/equal!) by modifying x in place
- shift @_ if $_[0] eq $class;
- my ($sx,$sy,$s) = @_;
+ my ($c,$sx,$sy,$s) = @_;
my $car = 0; my $i; my $j = 0;
if (!$s)
@@ -198,41 +221,39 @@ sub _mul
# (BINT, BINT) return nothing
# multiply two numbers in internal representation
# modifies first arg, second need not be different from first
- shift @_ if $_[0] eq $class;
- my ($xv,$yv) = @_;
+ my ($c,$xv,$yv) = @_;
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
# since multiplying $x with $x fails, make copy in this case
- $yv = [@$xv] if "$xv" eq "$yv";
- # looping through @$y if $xi == 0 is silly! optimize it!
+ $yv = [@$xv] if "$xv" eq "$yv"; # same references?
for $xi (@$xv)
{
$car = 0; $cty = 0;
+
+ # slow variant
+# for $yi (@$yv)
+# {
+# $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+# $prod[$cty++] =
+# $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL
+# }
+# $prod[$cty] += $car if $car; # need really to check for 0?
+# $xi = shift @prod;
+
+ # faster variant
+ # looping through this if $xi == 0 is silly - so optimize it away!
+ $xi = (shift @prod || 0), next if $xi == 0;
for $yi (@$yv)
{
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+## this is actually a tad slower
+## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here
$prod[$cty++] =
- $prod - ($car = int($prod * 1e-5)) * $BASE; # see USE_MUL
+ $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL
}
$prod[$cty] += $car if $car; # need really to check for 0?
$xi = shift @prod;
}
-# for $xi (@$xv)
-# {
-# $car = 0; $cty = 0;
-# # looping through this if $xi == 0 is silly! optimize it!
-# if (($xi||0) != 0)
-# {
-# for $yi (@$yv)
-# {
-# $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here
-# $prod[$cty++] =
-# $prod - ($car = int($prod * 1e-5)) * $BASE; # see USE_MUL
-# }
-# }
-# $prod[$cty] += $car if $car; # need really to check for 0?
-# $xi = shift @prod;
-# }
push @$xv, @prod;
__strip_zeros($xv);
# normalize (handled last to save check for $y->is_zero()
@@ -244,8 +265,7 @@ sub _div
# ref to array, ref to array, modify first array and return remainder if
# in list context
# no longer handles sign
- shift @_ if $_[0] eq $class;
- my ($x,$yorg) = @_;
+ my ($c,$x,$yorg) = @_;
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
my (@d,$tmp,$q,$u2,$u1,$u0);
@@ -280,7 +300,7 @@ sub _div
#warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
# if $v1 == 0;
$q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
- --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*$BASE+$u2);
+ --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
if ($q)
{
($car, $bar) = (0,0);
@@ -288,14 +308,14 @@ sub _div
{
$prd = $q * $y->[$yi] + $car;
$prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL
- $x->[$xi] += 1e5 if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+ $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
}
if ($x->[-1] < $car + $bar)
{
$car = 0; --$q;
for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
{
- $x->[$xi] -= 1e5
+ $x->[$xi] -= $BASE
if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE));
}
}
@@ -330,6 +350,98 @@ sub _div
}
##############################################################################
+# shifts
+
+sub _rsft
+ {
+ my ($c,$x,$y,$n) = @_;
+
+ if ($n != 10)
+ {
+ return; # we cant do this here, due to now _pow, so signal failure
+ }
+ else
+ {
+ # shortcut (faster) for shifting by 10)
+ # multiples of $BASE_LEN
+ my $dst = 0; # destination
+ my $src = _num($c,$y); # as normal int
+ my $rem = $src % $BASE_LEN; # reminder to shift
+ $src = int($src / $BASE_LEN); # source
+ if ($rem == 0)
+ {
+ splice (@$x,0,$src); # even faster, 38.4 => 39.3
+ }
+ else
+ {
+ my $len = scalar @$x - $src; # elems to go
+ my $vd; my $z = '0'x $BASE_LEN;
+ $x->[scalar @$x] = 0; # avoid || 0 test inside loop
+ while ($dst < $len)
+ {
+ $vd = $z.$x->[$src];
+ #print "$dst $src '$vd' ";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
+ #print "'$vd' ";
+ $src++;
+ $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
+ #print "'$vd1' ";
+ #print "'$vd'\n";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+ $x->[$dst] = int($vd);
+ $dst++;
+ }
+ splice (@$x,$dst) if $dst > 0; # kill left-over array elems
+ pop @$x if $x->[-1] == 0; # kill last element if 0
+ } # else rem == 0
+ }
+ $x;
+ }
+
+sub _lsft
+ {
+ my ($c,$x,$y,$n) = @_;
+
+ if ($n != 10)
+ {
+ return; # we cant do this here, due to now _pow, so signal failure
+ }
+ else
+ {
+ # shortcut (faster) for shifting by 10) since we are in base 10eX
+ # multiples of $BASE_LEN:
+ my $src = scalar @$x; # source
+ my $len = _num($c,$y); # shift-len as normal int
+ my $rem = $len % $BASE_LEN; # reminder to shift
+ my $dst = $src + int($len/$BASE_LEN); # destination
+ my $vd; # further speedup
+ #print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n";
+ $x->[$src] = 0; # avoid first ||0 for speed
+ my $z = '0' x $BASE_LEN;
+ while ($src >= 0)
+ {
+ $vd = $x->[$src]; $vd = $z.$vd;
+ #print "s $src d $dst '$vd' ";
+ $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
+ #print "'$vd' ";
+ $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
+ #print "'$vd' ";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+ #print "'$vd'\n";
+ $x->[$dst] = int($vd);
+ $dst--; $src--;
+ }
+ # set lowest parts to 0
+ while ($dst >= 0) { $x->[$dst--] = 0; }
+ # fix spurios last zero element
+ splice @$x,-1 if $x->[-1] == 0;
+ #print "elems: "; my $i = 0;
+ #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n";
+ }
+ $x;
+ }
+
+##############################################################################
# testing
sub _acmp
@@ -338,15 +450,16 @@ sub _acmp
# ref to array, ref to array, return <0, 0, >0
# arrays must have at least one entry; this is not checked for
- shift @_ if $_[0] eq $class;
- my ($cx, $cy) = @_;
+ my ($c,$cx, $cy) = @_;
#print "$cx $cy\n";
my ($i,$a,$x,$y,$k);
# calculate length based on digits, not parts
- $x = _len($cx); $y = _len($cy);
+ $x = _len('',$cx); $y = _len('',$cy);
# print "length: ",($x-$y),"\n";
- return $x-$y if ($x - $y); # if different in length
+ my $lxy = $x - $y; # if different in length
+ return -1 if $lxy < 0;
+ return 1 if $lxy > 0;
#print "full compare\n";
$i = 0; $a = 0;
# first way takes 5.49 sec instead of 4.87, but has the early out advantage
@@ -359,7 +472,9 @@ sub _acmp
# print "$cx->[$j] $cy->[$j] $a",$cx->[$j]-$cy->[$j],"\n";
last if ($a = $cx->[$j] - $cy->[$j]); $j--;
}
- return $a;
+ return 1 if $a > 0;
+ return -1 if $a < 0;
+ return 0; # equal
# while it early aborts, it is even slower than the manual variant
#grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
# grep way, go trough all (bad for early ne)
@@ -372,28 +487,25 @@ sub _len
# computer number of digits in bigint, minus the sign
# int() because add/sub sometimes leaves strings (like '00005') instead of
# int ('5') in this place, causing length to fail
- shift @_ if $_[0] eq $class;
- my $cx = shift;
+ my $cx = $_[1];
- return (@$cx-1)*5+length(int($cx->[-1]));
+ return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
}
sub _digit
{
# return the nth digit, negative values count backward
# zero is rightmost, so _digit(123,0) will give 3
- shift @_ if $_[0] eq $class;
- my $x = shift;
- my $n = shift || 0;
+ my ($c,$x,$n) = @_;
- my $len = _len($x);
+ my $len = _len('',$x);
$n = $len+$n if $n < 0; # -1 last, -2 second-to-last
$n = abs($n); # if negative was too big
$len--; $n = $len if $n > $len; # n to big?
- my $elem = int($n / 5); # which array element
- my $digit = $n % 5; # which digit in this element
+ my $elem = int($n / $BASE_LEN); # which array element
+ my $digit = $n % $BASE_LEN; # which digit in this element
$elem = '0000'.@$x[$elem]; # get element padded with 0's
return substr($elem,-$digit-1,1);
}
@@ -403,20 +515,19 @@ sub _zeros
# return amount of trailing zeros in decimal
# check each array elem in _m for having 0 at end as long as elem == 0
# Upon finding a elem != 0, stop
- shift @_ if $_[0] eq $class;
- my $x = shift;
+ my $x = $_[1];
my $zeros = 0; my $elem;
foreach my $e (@$x)
{
if ($e != 0)
{
- $elem = "$e"; # preserve x
- $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
- $zeros *= 5; # elems * 5
- $zeros += CORE::length($elem); # count trailing zeros
- last; # early out
+ $elem = "$e"; # preserve x
+ $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
+ $zeros *= $BASE_LEN; # elems * 5
+ $zeros += CORE::length($elem); # count trailing zeros
+ last; # early out
}
- $zeros ++; # real else branch: 50% slower!
+ $zeros ++; # real else branch: 50% slower!
}
return $zeros;
}
@@ -427,32 +538,28 @@ sub _zeros
sub _is_zero
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
}
sub _is_even
{
# return true if arg (BINT or num_str) is even
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (!($x->[0] & 1)) <=> 0;
}
sub _is_odd
{
# return true if arg (BINT or num_str) is even
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (($x->[0] & 1)) <=> 0;
}
sub _is_one
{
# return true if arg (BINT or num_str) is one (array '+', '1')
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
}
@@ -460,8 +567,6 @@ sub __strip_zeros
{
# internal normalization function that strips leading zeros from the array
# args: ref to array
- #trace(@_);
- shift @_ if $_[0] eq $class;
my $s = shift;
my $cnt = scalar @$s; # get count of parts
@@ -485,9 +590,8 @@ sub __strip_zeros
sub _check
{
# no checks yet, pull it out from the test suite
- shift @_ if $_[0] eq $class;
+ my $x = $_[1];
- my ($x) = shift;
return "$x is not a reference" if !ref($x);
# are all parts are valid?
@@ -529,7 +633,7 @@ was rewritten to use library modules for core math routines. Any
module which follows the same API as this can be used instead by
using the following call:
- use Math::BigInt Calc => BigNum;
+ use Math::BigInt lib => BigNum;
=head1 EXPORT
@@ -601,8 +705,32 @@ Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
or '0b1101').
Testing of input parameter validity is done by the caller, so you need not
-worry about underflow (C<_sub()>, C<_dec()>) nor about division by zero or
-similar cases.
+worry about underflow (f.i. in C<_sub()>, C<_dec()>) nor about division by
+zero or similar cases.
+
+The first parameter can be modified, that includes the possibility that you
+return a reference to a completely different object instead. Although keeping
+the reference the same is prefered.
+
+Return values are always references to objects or strings. Exceptions are
+C<_lsft()> and C<_rsft()>, which return undef if they can not shift the
+argument. This is used to delegate shifting of bases different than 10 back
+to BigInt, which will use some generic code to calculate the result.
+
+=head1 WRAP YOUR OWN
+
+If you want to port your own favourite c-lib for big numbers to the
+Math::BigInt interface, you can take any of the already existing modules as
+a rough guideline. You should really wrap up the latest BigInt and BigFloat
+testsuites with your module, and replace the following line:
+
+ use Math::BigInt;
+
+by
+
+ use Math::BigInt lib => 'yourlib';
+
+This way you ensure that your library really works 100% within Math::BigInt.
=head1 LICENSE
@@ -617,6 +745,7 @@ Seperated from BigInt and shaped API with the help of John Peacock.
=head1 SEE ALSO
-L<Math::BigInt>, L<Math::BigFloat>.
+L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect> and
+L<Math::BigInt::Pari>.
=cut
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index e8a1cc2462..a30563d21e 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -8,11 +8,11 @@ BEGIN
$| = 1;
unshift @INC, '../lib'; # for running manually
# chdir 't' if -d 't';
- plan tests => 945;
+ plan tests => 1158;
}
-use Math::BigFloat;
use Math::BigInt;
+use Math::BigFloat;
my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
while (<DATA>)
@@ -47,10 +47,21 @@ while (<DATA>)
$try .= "\$x;";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
+ } elsif ($f eq "bnan") {
+ $try .= "\$x->bnan();";
+ } elsif ($f eq "numify") {
+ $try .= "\$x->numify();";
+ } elsif ($f eq "bone") {
+ $try .= "\$x->bone('$args[1]');";
+ } elsif ($f eq "bstr") {
+ $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
+ $try .= '$x->bstr();';
} elsif ($f eq "bsstr") {
- $try .= "\$x->bsstr();";
+ $try .= '$x->bsstr();';
+ } elsif ($f eq "parts") {
+ $try .= '($a,$b) = $x->parts(); "$a $b";';
} elsif ($f eq "fneg") {
- $try .= "-\$x;";
+ $try .= '$x->bneg();';
} elsif ($f eq "bfloor") {
$try .= "\$x->bfloor();";
} elsif ($f eq "bceil") {
@@ -59,6 +70,10 @@ while (<DATA>)
$try .= "\$x->is_zero()+0;";
} elsif ($f eq "is_one") {
$try .= "\$x->is_one()+0;";
+ } elsif ($f eq "is_positive") {
+ $try .= "\$x->is_positive()+0;";
+ } elsif ($f eq "is_negative") {
+ $try .= "\$x->is_negative()+0;";
} elsif ($f eq "is_odd") {
$try .= "\$x->is_odd()+0;";
} elsif ($f eq "is_even") {
@@ -66,7 +81,11 @@ while (<DATA>)
} elsif ($f eq "as_number") {
$try .= "\$x->as_number();";
} elsif ($f eq "fabs") {
- $try .= "abs \$x;";
+ $try .= '$x->babs();';
+ } elsif ($f eq "finc") {
+ $try .= '++$x;';
+ } elsif ($f eq "fdec") {
+ $try .= '--$x;';
}elsif ($f eq "fround") {
$try .= "$setup; \$x->fround($args[1]);";
} elsif ($f eq "ffround") {
@@ -153,15 +172,48 @@ __END__
-123.456:-123
-200:-200
&binf
-1:+:+inf
+1:+:inf
2:-:-inf
-3:abc:+inf
-&bsstr
-+inf:+inf
+3:abc:inf
+&numify
+0:0e+1
++1:1e+0
+1234:1234e+0
+NaN:NaN
++inf:inf
-inf:-inf
+&bnan
abc:NaN
+2:NaN
+-2:NaN
+0:NaN
+&bone
+2:+:1
+-2:-:-1
+-2:+:1
+2:-:-1
+0::1
+-2::1
+abc::1
+2:abc:1
+&bsstr
++inf:inf
+-inf:-inf
+abcbsstr:NaN
+1234.567:1234567e-3
+&bstr
++inf:::inf
+-inf:::-inf
+abcbsstr:::NaN
+1234.567:9::1234.56700
+1234.567::-6:1234.567000
+12345:5::12345
+0.001234:6::0.00123400
+0.001234::-8:0.00123400
+0:4::0
+0::-4:0.0000
&fnorm
-+inf:+inf
++inf:inf
-inf:-inf
+infinity:NaN
+-inf:NaN
@@ -201,6 +253,14 @@ abc:NaN
-123456E-2:-1234.56
1e1:10
2e-11:0.00000000002
+# excercise _split
+ .02e-1:0.002
+ 000001:1
+ -00001:-1
+ -1:-1
+ 000.01:0.01
+ -000.0023:-0.0023
+ 1.1e1:11
-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
&fpow
@@ -215,12 +275,14 @@ abc:NaN
128:-2:0.00006103515625
abc:123.456:NaN
123.456:abc:NaN
-+inf:123.45:+inf
++inf:123.45:inf
-inf:123.45:-inf
-+inf:-123.45:+inf
++inf:-123.45:inf
-inf:-123.45:-inf
&fneg
-abc:NaN
+fnegNaN:NaN
++inf:-inf
+-inf:inf
+0:0
+1:-1
-1:1
@@ -229,7 +291,9 @@ abc:NaN
+123.456789:-123.456789
-123456.789:123456.789
&fabs
-abc:NaN
+fabsNaN:NaN
++inf:inf
+-inf:inf
+0:0
+1:1
-1:1
@@ -239,6 +303,10 @@ abc:NaN
-123456.789:123456.789
&fround
$rnd_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNfround:5:NaN
+10123456789:5:10123000000
-10123456789:5:-10123000000
+10123456789.123:5:10123000000
@@ -294,6 +362,10 @@ $rnd_mode = "even"
-60123456789.0123:5:-60123000000
&ffround
$rnd_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNffround:5:NaN
+1.23:-1:1.2
+1.234:-1:1.2
+1.2345:-1:1.2
@@ -424,9 +496,9 @@ $rnd_mode = "even"
0.01234567:-9:0.01234567
0.01234567:-12:0.01234567
&fcmp
-abc:abc:
-abc:+0:
-+0:abc:
+fcmpNaN:fcmpNaN:
+fcmpNaN:+0:
++0:fcmpNaN:
+0:+0:0
-1:+0:-1
+0:-1:1
@@ -482,15 +554,43 @@ abc:+0:
+inf:-54321.12345:1
+inf:+inf:0
-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
# return undef
+inf:NaN:
-NaN:+inf:
+NaN:inf:
-inf:NaN:
NaN:-inf:
+&fdec
+fdecNaN:NaN
++inf:inf
+-inf:-inf
++0:-1
++1:0
+-1:-2
+1.23:0.23
+-1.23:-2.23
+&finc
+fincNaN:NaN
++inf:inf
+-inf:-inf
++0:1
++1:2
+-1:0
+1.23:2.23
+-1.23:-0.23
&fadd
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:0
+-inf:+inf:0
++inf:+inf:inf
+-inf:-inf:-inf
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:1
@@ -530,6 +630,14 @@ abc:+0:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:0
+-inf:-inf:0
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:-1
@@ -568,6 +676,22 @@ abc:+0:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:NaNmul:NaN
++inf:NaNmul:NaN
+NaNmul:+inf:NaN
+NaNmul:-inf:NaN
++inf:+inf:inf
++inf:-inf:-inf
++inf:-inf:-inf
++inf:+inf:inf
++inf:123.34:inf
++inf:-123.34:-inf
+-inf:123.34:-inf
+-inf:-123.34:inf
+123.34:+inf:inf
+-123.34:+inf:-inf
+123.34:-inf:-inf
+-123.34:-inf:inf
+0:+0:0
+0:+1:0
+1:+0:0
@@ -604,17 +728,23 @@ $div_scale = 40; $Math::BigFloat::rnd_mode = 'even'
abc:abc:NaN
abc:+1:abc:NaN
+1:abc:NaN
+-1:abc:NaN
+0:abc:NaN
+0:+0:NaN
+0:+1:0
-+1:+0:NaN
++1:+0:inf
++3214:+0:inf
+0:-1:0
--1:+0:NaN
+-1:+0:-inf
+-3214:+0:-inf
+1:+1:1
-1:-1:1
+1:-1:-1
-1:+1:-1
+1:+2:0.5
+2:+1:2
+123:+inf:0
+123:-inf:0
+10:+5:2
+100:+4:25
+1000:+8:125
@@ -683,7 +813,7 @@ $div_scale = 40
-16:NaN
-123.45:NaN
nanfsqrt:NaN
-+inf:+inf
++inf:inf
-inf:NaN
+1:1
+2:1.41421356237309504880168872420969807857
@@ -721,12 +851,39 @@ abc:0
-inf:0
123.456:0
-123.456:0
+&is_positive
+0:1
+1:1
+-1:0
+-123:0
+NaN:0
+-inf:0
++inf:1
+&is_negative
+0:0
+1:0
+-1:1
+-123:1
+NaN:0
+-inf:1
++inf:0
+&parts
+0:0 1
+1:1 0
+123:123 0
+-123:-123 0
+-1200:-12 2
&is_zero
NaNzero:0
++inf:0
+-inf:0
0:1
-1:0
1:0
&is_one
+NaNone:0
++inf:0
+-inf:0
0:0
2:0
1:1
@@ -735,7 +892,7 @@ NaNzero:0
&bfloor
0:0
abc:NaN
-+inf:+inf
++inf:inf
-inf:-inf
1:1
-51:-51
@@ -744,7 +901,7 @@ abc:NaN
&bceil
0:0
abc:NaN
-+inf:+inf
++inf:inf
-inf:-inf
1:1
-51:-51
diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t
index cb880bab68..9c82d65e0d 100644
--- a/lib/Math/BigInt/t/bigintc.t
+++ b/lib/Math/BigInt/t/bigintc.t
@@ -8,66 +8,121 @@ BEGIN
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 29;
+ plan tests => 52;
}
-# testing of Math::BigInt::Calc, primarily for interface/api and not for the
+# testing of Math::BigInt::BitVect, primarily for interface/api and not for the
# math functionality
use Math::BigInt::Calc;
-my $s123 = \'123'; my $s321 = \'321';
+my $C = 'Math::BigInt::Calc'; # pass classname to sub's
+
# _new and _str
-my $x = _new($s123); my $u = _str($x);
-ok ($$u,123); ok ($x->[0],123); ok (@$x,1);
-my $y = _new($s321);
+my $x = _new($C,\"123"); my $y = _new($C,\"321");
+ok (ref($x),'ARRAY'); ok (${_str($C,$x)},123); ok (${_str($C,$y)},321);
# _add, _sub, _mul, _div
-ok (${_str(_add($x,$y))},444);
-ok (${_str(_sub($x,$y))},123);
-ok (${_str(_mul($x,$y))},39483);
-ok (${_str(_div($x,$y))},123);
-
-# division with reminder
-my $z = _new(\"111");
- _mul($x,$y);
-ok (${_str($x)},39483);
-_add($x,$z);
-ok (${_str($x)},39594);
-my ($re,$rr) = _div($x,$y);
+ok (${_str($C,_add($C,$x,$y))},444);
+ok (${_str($C,_sub($C,$x,$y))},123);
+ok (${_str($C,_mul($C,$x,$y))},39483);
+ok (${_str($C,_div($C,$x,$y))},123);
-ok (${_str($re)},123); ok (${_str($rr)},111);
+ok (${_str($C,_mul($C,$x,$y))},39483);
+ok (${_str($C,$x)},39483);
+ok (${_str($C,$y)},321);
+my $z = _new($C,\"2");
+ok (${_str($C,_add($C,$x,$z))},39485);
+my ($re,$rr) = _div($C,$x,$y);
-# _copy
-$x = _new(\"12356");
-ok (${_str(_copy($x))},12356);
-
-# digit
-$x = _new(\"123456789");
-ok (_digit($x,0),9);
-ok (_digit($x,1),8);
-ok (_digit($x,2),7);
-ok (_digit($x,-1),1);
-ok (_digit($x,-2),2);
-ok (_digit($x,-3),3);
+ok (${_str($C,$re)},123); ok (${_str($C,$rr)},2);
# is_zero, _is_one, _one, _zero
-$x = _new(\"12356");
-ok (_is_zero($x),0);
-ok (_is_one($x),0);
+ok (_is_zero($C,$x),0);
+ok (_is_one($C,$x),0);
-# _zeros
-$x = _new(\"1256000000"); ok (_zeros($x),6);
-$x = _new(\"152"); ok (_zeros($x),0);
-$x = _new(\"123000"); ok (_zeros($x),3);
+ok (_is_one($C,_one()),1); ok (_is_one($C,_zero()),0);
+ok (_is_zero($C,_zero()),1); ok (_is_zero($C,_one()),0);
+
+# is_odd, is_even
+ok (_is_odd($C,_one()),1); ok (_is_odd($C,_zero()),0);
+ok (_is_even($C,_one()),0); ok (_is_even($C,_zero()),1);
-ok (_is_one(_one()),1); ok (_is_one(_zero()),0);
-ok (_is_zero(_zero()),1); ok (_is_zero(_one()),0);
+# _digit
+$x = _new($C,\"123456789");
+ok (_digit($C,$x,0),9);
+ok (_digit($C,$x,1),8);
+ok (_digit($C,$x,2),7);
+ok (_digit($C,$x,-1),1);
+ok (_digit($C,$x,-2),2);
+ok (_digit($C,$x,-3),3);
+
+# _copy
+$x = _new($C,\"12356");
+ok (${_str($C,_copy($C,$x))},12356);
+
+# _zeros
+$x = _new($C,\"1256000000"); ok (_zeros($C,$x),6);
+$x = _new($C,\"152"); ok (_zeros($C,$x),0);
+$x = _new($C,\"123000"); ok (_zeros($C,$x),3);
+
+# _lsft, _rsft
+$x = _new($C,\"10"); $y = _new($C,\"3");
+ok (${_str($C,_lsft($C,$x,$y,10))},10000);
+$x = _new($C,\"20"); $y = _new($C,\"3");
+ok (${_str($C,_lsft($C,$x,$y,10))},20000);
+$x = _new($C,\"128"); $y = _new($C,\"4");
+if (!defined _lsft($C,$x,$y,2))
+ {
+ ok (1,1)
+ }
+else
+ {
+ ok ('_lsft','undef');
+ }
+$x = _new($C,\"1000"); $y = _new($C,\"3");
+ok (${_str($C,_rsft($C,$x,$y,10))},1);
+$x = _new($C,\"20000"); $y = _new($C,\"3");
+ok (${_str($C,_rsft($C,$x,$y,10))},20);
+$x = _new($C,\"256"); $y = _new($C,\"4");
+if (!defined _rsft($C,$x,$y,2))
+ {
+ ok (1,1)
+ }
+else
+ {
+ ok ('_rsft','undef');
+ }
-ok (_check($x),0);
-ok (_check(123),'123 is not a reference');
+# _acmp
+$x = _new($C,\"123456789");
+$y = _new($C,\"987654321");
+ok (_acmp($C,$x,$y),-1);
+ok (_acmp($C,$y,$x),1);
+ok (_acmp($C,$x,$x),0);
+ok (_acmp($C,$y,$y),0);
+
+# _div
+$x = _new($C,\"3333"); $y = _new($C,\"1111");
+ok (${_str($C, scalar _div($C,$x,$y))},3);
+$x = _new($C,\"33333"); $y = _new($C,\"1111"); ($x,$y) = _div($C,$x,$y);
+ok (${_str($C,$x)},30); ok (${_str($C,$y)},3);
+$x = _new($C,\"123"); $y = _new($C,\"1111");
+($x,$y) = _div($C,$x,$y); ok (${_str($C,$x)},0); ok (${_str($C,$y)},123);
+
+# _num
+$x = _new($C,\"12345"); $x = _num($C,$x); ok (ref($x)||'',''); ok ($x,12345);
+
+# should not happen:
+# $x = _new($C,\"-2"); $y = _new($C,\"4"); ok (_acmp($C,$x,$y),-1);
+
+# _check
+$x = _new($C,\"123456789");
+ok (_check($C,$x),0);
+ok (_check($C,123),'123 is not a reference');
# done
1;
+
diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
index f2663de26d..9e84e20ee6 100755
--- a/lib/Math/BigInt/t/bigintpm.t
+++ b/lib/Math/BigInt/t/bigintpm.t
@@ -8,9 +8,9 @@ BEGIN
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 1222;
+ plan tests => 1424;
}
-my $version = '1.36'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.40'; # for $VERSION tests, match current release (by hand!)
##############################################################################
# for testing inheritance of _swap
@@ -18,6 +18,7 @@ my $version = '1.36'; # for $VERSION tests, match current release (by hand!)
package Math::Foo;
use Math::BigInt;
+#use Math::BigInt lib => 'BitVect'; # for testing
use vars qw/@ISA/;
@ISA = (qw/Math::BigInt/);
@@ -46,9 +47,8 @@ package main;
use Math::BigInt;
#use Math::BigInt lib => 'BitVect'; # for testing
-#use Math::BigInt lib => 'Small'; # for testing
-my $CALC = Math::BigInt::_core_lib();
+my $CALC = Math::BigInt::_core_lib(); ok ($CALC,'Math::BigInt::Calc');
my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode);
@@ -81,10 +81,18 @@ while (<DATA>)
$try .= '$x->is_odd()+0;';
} elsif ($f eq "is_even") {
$try .= '$x->is_even()+0;';
+ } elsif ($f eq "is_negative") {
+ $try .= '$x->is_negative()+0;';
+ } elsif ($f eq "is_positive") {
+ $try .= '$x->is_positive()+0;';
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]')+0;";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
+ } elsif ($f eq "bone") {
+ $try .= "\$x->bone('$args[1]');";
+ } elsif ($f eq "bnan") {
+ $try .= "\$x->bnan();";
} elsif ($f eq "bfloor") {
$try .= '$x->bfloor();';
} elsif ($f eq "bceil") {
@@ -92,9 +100,9 @@ while (<DATA>)
} elsif ($f eq "bsstr") {
$try .= '$x->bsstr();';
} elsif ($f eq "bneg") {
- $try .= '-$x;';
+ $try .= '$x->bneg();';
} elsif ($f eq "babs") {
- $try .= 'abs $x;';
+ $try .= '$x->babs();';
} elsif ($f eq "binc") {
$try .= '++$x;';
} elsif ($f eq "bdec") {
@@ -130,6 +138,8 @@ while (<DATA>)
$try .= "\$x * \$y;";
}elsif ($f eq "bdiv"){
$try .= "\$x / \$y;";
+ }elsif ($f eq "bdiv-list"){
+ $try .= 'join (",",$x->bdiv($y));';
}elsif ($f eq "bmod"){
$try .= "\$x % \$y;";
}elsif ($f eq "bgcd")
@@ -199,7 +209,7 @@ while (<DATA>)
} # endwhile data tests
close DATA;
-# XXX Tels 06/29/2001 following tests never fail or do not work :(
+# XXX Tels 06/29/2001 following tests never fail or do not work :( !?
# test whether use Math::BigInt qw/version/ works
$try = "use Math::BigInt ($version.'1');";
@@ -214,21 +224,27 @@ $ans1 = eval $try;
ok ( $ans1, "1427247692705959881058285969449495136382746624");
# test wether Math::BigInt::Small via use works (w/ dff. spellings of calc)
-#$try = "use Math::BigInt ($version,'CALC','Small');";
+#$try = "use Math::BigInt ($version,'lib','Small');";
#$try .= ' $x = 2**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, "1024");
-#$try = "use Math::BigInt ($version,'cAlC','Math::BigInt::Small');";
+#$try = "use Math::BigInt ($version,'LiB','Math::BigInt::Small');";
#$try .= ' $x = 2**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, "1024");
# test wether calc => undef (array element not existing) works
-#$try = "use Math::BigInt ($version,'CALC');";
+#$try = "use Math::BigInt ($version,'LIB');";
#$try = "require Math::BigInt; Math::BigInt::import($version,'CALC');";
#$try .= ' $x = Math::BigInt->new(2)**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, 1024);
+# test whether fallback to calc works
+$try = "use Math::BigInt ($version,'lib','foo, bar , ');";
+$try .= ' Math::BigInt::_core_lib();';
+$ans1 = eval $try;
+ok ( $ans1, "Math::BigInt::Calc");
+
# test some more
@a = ();
for (my $i = 1; $i < 10; $i++)
@@ -237,11 +253,16 @@ for (my $i = 1; $i < 10; $i++)
}
ok "@a", "1 2 3 4 5 6 7 8 9";
-# test whether selfmultiplication works correctly (result is 2**64)
+# test whether self-multiplication works correctly (result is 2**64)
$try = '$x = new Math::BigInt "+4294967296";';
$try .= '$a = $x->bmul($x);';
$ans1 = eval $try;
print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64);
+# test self-pow
+$try = '$x = Math::BigInt->new(10);';
+$try .= '$a = $x->bpow($x);';
+$ans1 = eval $try;
+print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(10) ** 10);
# test whether op destroys args or not (should better not)
@@ -343,6 +364,9 @@ $ans = eval $try;
print "# For '$try'\n" if (!ok "$ans" , "ok" );
###############################################################################
+# the followin tests only make sense with Math::BigInt::Calc
+
+###############################################################################
# check proper length of internal arrays
$x = Math::BigInt->new(99999); is_valid($x);
@@ -350,8 +374,7 @@ $x += 1; ok ($x,100000); is_valid($x);
$x -= 1; ok ($x,99999); is_valid($x);
###############################################################################
-# check numify, these tests only make sense with Math::BigInt::Calc, since
-# only this uses $BASE
+# check numify
my $BASE = int(1e5); # should access Math::BigInt::Calc::BASE
$x = Math::BigInt->new($BASE-1); ok ($x->numify(),$BASE-1);
@@ -380,6 +403,25 @@ ok ($z, 100000);
ok ($x, 23456);
###############################################################################
+# bug in shortcut in mul()
+
+# construct a number with a zero-hole of BASE_LEN
+my $bl = Math::BigInt::Calc::_base_len();
+$x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
+$y = '1' x (2*$bl);
+#print "$x * $y\n";
+$x = Math::BigInt->new($x)->bmul($y);
+# result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl
+$y = ''; my $d = '';
+for (my $i = 1; $i <= $bl; $i++)
+ {
+ $y .= $i; $d = $i.$d;
+ }
+#print "$y $d\n";
+$y .= $bl x (3*$bl-1) . $d . '0' x $bl;
+ok ($x,$y);
+
+###############################################################################
# bug with rest "-0" in div, causing further div()s to fail
$x = Math::BigInt->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
@@ -477,6 +519,12 @@ ok ($x,-3);
ok (ref($x),'Math::Foo');
###############################################################################
+# test whether +inf eq inf
+
+$y = 1e1000000; # create inf, since bareword inf does not work
+$x = Math::BigInt->new('+inf'); ok ($x,$y);
+
+###############################################################################
# all tests done
###############################################################################
@@ -516,6 +564,20 @@ sub is_valid
}
__END__
+&is_negative
+0:0
+-1:1
+1:0
++inf:0
+-inf:1
+NaNneg:0
+&is_positive
+0:1
+-1:0
+1:1
++inf:1
+-inf:0
+NaNneg:0
&is_odd
abc:0
0:0
@@ -548,6 +610,24 @@ abc:0
+987654321:+123456789:1
-987654321:+123456789:1
-123:+4567889:-1
+# NaNs
+acmpNaN:123:
+123:acmpNaN:
+acmpNaN:acmpNaN:
+# infinity
++inf:+inf:0
+-inf:-inf:0
++inf:-inf:0
+-inf:+inf:0
++inf:123:1
+-inf:123:1
++inf:-123:1
+-inf:-123:1
+# return undef
++inf:NaN:
+NaN:inf:
+-inf:NaN:
+NaN:-inf:
&bnorm
123:123
# binary input
@@ -561,6 +641,8 @@ abc:0
0b011:3
0b101:5
0b1000000000000000000000000000000:1073741824
+0b_101:NaN
+0b1_0_1:5
# hex input
-0x0:0
0xabcdefgh:NaN
@@ -569,8 +651,10 @@ abc:0
-0xABCDEF:-11259375
-0x1234:-4660
0x12345678:305419896
+0x1_2_3_4_56_78:305419896
+0x_123:NaN
# inf input
-+inf:+inf
++inf:inf
-inf:-inf
0inf:NaN
# normal input
@@ -621,10 +705,22 @@ E23:NaN
-1010E-2:NaN
-1.01E+1:NaN
-1.01E-1:NaN
+1234.00:1234
+&bnan
+1:NaN
+2:NaN
+abc:NaN
+&bone
+2:+:+1
+2:-:-1
+boneNaN:-:-1
+boneNaN:+:+1
+2:abc:+1
+3::+1
&binf
-1:+:+inf
+1:+:inf
2:-:-inf
-3:abc:+inf
+3:abc:inf
&is_inf
+inf::1
-inf::1
@@ -677,6 +773,9 @@ abc:abc:NaN
100:1e+2
abc:NaN
&bneg
+bnegNaN:NaN
++inf:-inf
+-inf:inf
abd:NaN
+0:+0
+1:-1
@@ -684,16 +783,18 @@ abd:NaN
+123456789:-123456789
-123456789:+123456789
&babs
-abc:NaN
+babsNaN:NaN
++inf:inf
+-inf:inf
+0:+0
+1:+1
-1:+1
+123456789:+123456789
-123456789:+123456789
&bcmp
-abc:abc:
-abc:+0:
-+0:abc:
+bcmpNaN:bcmpNaN:
+bcmpNaN:+0:
++0:bcmpNaN:
+0:+0:0
-1:+0:-1
+0:-1:1
@@ -723,18 +824,24 @@ abc:+0:
+inf:-5432112345:1
+inf:+inf:0
-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
# return undef
+inf:NaN:
-NaN:+inf:
+NaN:inf:
-inf:NaN:
NaN:-inf:
&binc
abc:NaN
++inf:inf
+-inf:-inf
+0:+1
+1:+2
-1:+0
&bdec
abc:NaN
++inf:inf
+-inf:-inf
+0:-1
+1:+0
-1:-2
@@ -742,6 +849,14 @@ abc:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:0
+-inf:+inf:0
++inf:+inf:inf
+-inf:-inf:-inf
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:+0
+1:+0:+1
+0:+1:+1
@@ -780,6 +895,10 @@ abc:+0:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:0
+-inf:-inf:0
+0:+0:+0
+1:+0:+1
+0:+1:-1
@@ -818,6 +937,14 @@ abc:+0:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+NaNmul:+inf:NaN
+NaNmul:-inf:NaN
+-inf:NaNmul:NaN
++inf:NaNmul:NaN
++inf:+inf:inf
++inf:-inf:-inf
+-inf:+inf:-inf
+-inf:-inf:inf
+0:+0:+0
+0:+1:+0
+1:+0:+0
@@ -850,18 +977,23 @@ abc:+0:NaN
+25:+25:+625
+12345:+12345:+152399025
+99999:+11111:+1111088889
+&bdiv-list
+100:20:5,0
+4095:4095:1,0
+-4095:-4095:1,0
+4095:-4095:-1,0
+-4095:4095:-1,0
&bdiv
abc:abc:NaN
abc:+1:abc:NaN
-# really?
-#+5:0:+inf
-#-5:0:-inf
+1:abc:NaN
+0:+0:NaN
++5:0:inf
+-5:0:-inf
++1:+0:inf
+0:+1:+0
-+1:+0:NaN
+0:-1:+0
--1:+0:NaN
+-1:+0:-inf
+1:+1:+1
-1:-1:+1
+1:-1:-1
@@ -900,6 +1032,8 @@ abc:+1:abc:NaN
1:-3:-1
-5:3:-2
4:-3:-2
+123:+inf:0
+123:-inf:0
&bmod
abc:abc:NaN
abc:+1:abc:NaN
@@ -948,6 +1082,7 @@ abc:+1:abc:NaN
-2:-3:-2
4:-3:-2
1:-3:-2
+4095:4095:0
&bgcd
abc:abc:NaN
abc:+0:NaN
@@ -983,6 +1118,12 @@ abc:0:NaN
+281474976710656:+0:+0
+281474976710656:+1:+0
+281474976710656:+281474976710656:+281474976710656
+-2:-3:-4
+-1:-1:-1
+-6:-6:-6
+-7:-4:-8
+-7:4:0
+-4:7:4
&bior
abc:abc:NaN
abc:0:NaN
@@ -992,6 +1133,11 @@ abc:0:NaN
+281474976710656:+0:+281474976710656
+281474976710656:+1:+281474976710657
+281474976710656:+281474976710656:+281474976710656
+-2:-3:-1
+-1:-1:-1
+-6:-6:-6
+-7:4:-3
+-4:7:-1
&bxor
abc:abc:NaN
abc:0:NaN
@@ -1001,11 +1147,21 @@ abc:0:NaN
+281474976710656:+0:+281474976710656
+281474976710656:+1:+281474976710657
+281474976710656:+281474976710656:+0
+-2:-3:3
+-1:-1:0
+-6:-6:0
+-7:4:-3
+-4:7:-5
+4:-7:-3
+-4:-7:5
&bnot
abc:NaN
+0:-1
+8:-9
+281474976710656:-281474976710657
+-1:0
+-2:1
+-12:11
&digit
0:0:0
12:0:2
@@ -1075,9 +1231,9 @@ abc:12:NaN
-2:-1:NaN
2:-2:NaN
-2:-2:NaN
-+inf:1234500012:+inf
++inf:1234500012:inf
-inf:1234500012:-inf
-+inf:-12345000123:+inf
++inf:-12345000123:inf
-inf:-12345000123:-inf
# 1 ** -x => 1 / (1 ** x)
-1:0:1
@@ -1124,6 +1280,10 @@ abc:12:NaN
Nan:NaN
&bround
$round_mode('trunc')
+0:12:0
+NaNbround:12:NaN
++inf:12:inf
+-inf:12:-inf
1234:0:1234
1234:2:1200
123456:4:123400
@@ -1201,11 +1361,16 @@ $round_mode('even')
&is_zero
0:1
NaNzero:0
++inf:0
+-inf:0
123:0
-1:0
1:0
&is_one
0:0
+NaNone:0
++inf:0
+-inf:0
1:1
2:0
-1:0
@@ -1213,12 +1378,18 @@ NaNzero:0
# floor and ceil tests are pretty pointless in integer space...but play safe
&bfloor
0:0
+NaNfloor:NaN
++inf:inf
+-inf:-inf
-1:-1
-2:-2
2:2
3:3
abc:NaN
&bceil
+NaNceil:NaN
++inf:inf
+-inf:-inf
0:0
-1:-1
-2:-2
diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
index 3948102f0e..51cf41b212 100644
--- a/lib/Math/BigInt/t/mbimbf.t
+++ b/lib/Math/BigInt/t/mbimbf.t
@@ -157,7 +157,7 @@ $z = $y - $x; ok ($z,530.9);
$z = $y * $x; ok ($z,80780);
$z = $x ** 2; ok ($z,15241);
$z = $x * $x; ok ($z,15241);
-# not yet: $z = -$x; ok ($z,-123.46); ok ($x,123.456);
+# not: $z = -$x; ok ($z,-123.46); ok ($x,123.456);
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
$x = Math::BigFloat->new(123456); $x->{_a} = 4;
$z = $x->copy; $z++; ok ($z,123500);