my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.67';
+$VERSION = '1.72';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify bgcd blcm);
-use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
-use vars qw/$upgrade $downgrade/;
-# the following are internal and should never be accessed from the outside
-use vars qw/$_trap_nan $_trap_inf/;
+# _trap_inf and _trap_nan are internal and should never be accessed from the
+# outside
+use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
+ $upgrade $downgrade $_trap_nan $_trap_inf/;
use strict;
# Inside overload, the first arg is always an object. If the original code had
"$_[1]" cmp $_[0]->bstr() :
$_[0]->bstr() cmp "$_[1]" },
-#'cos' => sub {
-# require Math::Big;
-# return Math::Big::cos($_[0], ref($_[0])->accuracy());
-# },
-
# make cos()/sin()/exp() "work" with BigInt's or subclasses
'cos' => sub { cos($_[0]->numify()) },
'sin' => sub { sin($_[0]->numify()) },
'bool' => sub {
# this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
# v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
- my $t = !$_[0]->is_zero();
- undef $t if $t == 0;
+ my $t = undef;
+ $t = 1 if !$_[0]->is_zero();
$t;
},
# these are internally, and not to be used from the outside
-use constant MB_NEVER_ROUND => 0x0001;
+sub MB_NEVER_ROUND () { 0x0001; }
$_trap_nan = 0; # are NaNs ok? set w/ config()
$_trap_inf = 0; # are infs ok? set w/ config()
my $CALC = 'Math::BigInt::Calc'; # module to do the low level math
# default is Calc.pm
-my %CAN; # cache for $CALC->can(...)
my $IMPORT = 0; # was import() called yet?
# used to make require work
+my %WARN; # warn only once for low-level libs
+my %CAN; # cache for $CALC->can(...)
+my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
sub FETCH { return $round_mode; }
sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
-BEGIN { tie $rnd_mode, 'Math::BigInt'; }
+BEGIN
+ {
+ # tie to enable $rnd_mode to work transparently
+ tie $rnd_mode, 'Math::BigInt';
+
+ # set up some handy alias names
+ *as_int = \&as_number;
+ *is_pos = \&is_positive;
+ *is_neg = \&is_negative;
+ }
##############################################################################
if (ref($x))
{
# $object->accuracy() or fallback to global
- $x->bround($a) if $a; # not for undef, 0
- $x->{_a} = $a; # set/overwrite, even if not rounded
- $x->{_p} = undef; # clear P
+ $x->bround($a) if $a; # not for undef, 0
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ delete $x->{_p}; # clear P
$a = ${"${class}::accuracy"} unless defined $a; # proper return value
}
else
{
- # set global
- ${"${class}::accuracy"} = $a;
- ${"${class}::precision"} = undef; # clear P
+ ${"${class}::accuracy"} = $a; # set global A
+ ${"${class}::precision"} = undef; # clear global P
}
- return $a; # shortcut
+ return $a; # shortcut
}
my $r;
if (ref($x))
{
# $object->precision() or fallback to global
- $x->bfround($p) if $p; # not for undef, 0
- $x->{_p} = $p; # set/overwrite, even if not rounded
- $x->{_a} = undef; # clear A
+ $x->bfround($p) if $p; # not for undef, 0
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ delete $x->{_a}; # clear A
$p = ${"${class}::precision"} unless defined $p; # proper return value
}
else
{
- # set global
- ${"${class}::precision"} = $p;
- ${"${class}::accuracy"} = undef; # clear A
+ ${"${class}::precision"} = $p; # set global P
+ ${"${class}::accuracy"} = undef; # clear global A
}
- return $p; # shortcut
+ return $p; # shortcut
}
my $r;
return unless ref($x); # only for objects
my $self = {}; bless $self,$c;
- my $r;
- foreach my $k (keys %$x)
- {
- if ($k eq 'value')
- {
- $self->{value} = $CALC->_copy($x->{value}); next;
- }
- if (!($r = ref($x->{$k})))
- {
- $self->{$k} = $x->{$k}; next;
- }
- if ($r eq 'SCALAR')
- {
- $self->{$k} = \${$x->{$k}};
- }
- elsif ($r eq 'ARRAY')
- {
- $self->{$k} = [ @{$x->{$k}} ];
- }
- elsif ($r eq 'HASH')
- {
- # only one level deep!
- foreach my $h (keys %{$x->{$k}})
- {
- $self->{$k}->{$h} = $x->{$k}->{$h};
- }
- }
- else # normal ref
- {
- my $xk = $x->{$k};
- if ($xk->can('copy'))
- {
- $self->{$k} = $xk->copy();
- }
- else
- {
- $self->{$k} = $xk->new($xk);
- }
- }
- }
+
+ $self->{sign} = $x->{sign};
+ $self->{value} = $CALC->_copy($x->{value});
+ $self->{_a} = $x->{_a} if defined $x->{_a};
+ $self->{_p} = $x->{_p} if defined $x->{_p};
$self;
}
if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
{
$self->{sign} = $1 || '+';
- my $ref = \$wanted;
+
if ($wanted =~ /^[+-]/)
{
# remove sign without touching wanted to make it work with constants
- my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
+ my $t = $wanted; $t =~ s/^[+-]//;
+ $self->{value} = $CALC->_new($t);
+ }
+ else
+ {
+ $self->{value} = $CALC->_new($wanted);
}
- # force to string version (otherwise Pari is unhappy about overflowed
- # constants, for instance)
- # not good, BigInt shouldn't need to know about alternative libs:
- # $ref = \"$$ref" if $CALC eq 'Math::BigInt::Pari';
- $self->{value} = $CALC->_new($ref);
no strict 'refs';
if ( (defined $a) || (defined $p)
|| (defined ${"${class}::precision"})
return $self;
}
# split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
- my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
+ my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
if (!ref $mis)
{
if ($_trap_nan)
}
}
$self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
+ $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
# if any of the globals is set, use them to round and store them inside $self
# do not round for new($x,undef,undef) since that is used by MBF to signal
# no rounding
}
$self->{sign} = $nan;
delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
- return $self;
+ $self;
}
sub binf
$sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
$self->{sign} = $sign;
($self->{_a},$self->{_p}) = @_; # take over requested rounding
- return $self;
+ $self;
}
sub bzero
return 'inf'; # +inf
}
my ($m,$e) = $x->parts();
- my $sign = 'e+'; # e can only be positive
- return $m->bstr().$sign.$e->bstr();
+ #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
+ # 'e+' because E can only be positive in BigInt
+ $m->bstr() . 'e+' . $CALC->_str($e->{value});
}
sub bstr
return 'inf'; # +inf
}
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
- return $es.${$CALC->_str($x->{value})};
+ $es.$CALC->_str($x->{value});
}
sub numify
sub sign
{
# return the sign of the number: +/-/-inf/+inf/NaN
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x->{sign};
}
$r = ${"$c\::round_mode"} unless defined $r;
if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
{
-
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
# now round, by calling either fround or ffround:
{
# (numstr or BINT) return BINT
# Normalize number -- no-op here
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x;
}
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swaped (lib returns 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swaped acmp (lib returns 0,1,-1)
}
sub bacmp
# 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
+ return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
+ return -1;
}
$CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
}
return $x;
}
- my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
+ my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
if ($sx eq $sy)
{
$x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
- $x->{sign} = $sx;
}
else
{
else # a < 0
{
$x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
- $x->{sign} = $sx;
}
}
$x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
return $x if $x->modify('bsub');
-# upgrade done by badd():
-# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
-# ((!$x->isa($self)) || (!$y->isa($self)));
+ return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
if ($y->is_zero())
{
return $x;
}
+ require Scalar::Util;
+ if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y))
+ {
+ # if we get the same variable twice, the result must be zero (the code
+ # below fails in that case)
+ return $x->bzero(@r) if $x->{sign} =~ /^[+-]$/;
+ return $x->bnan(); # NaN, -inf, +inf
+ }
$y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
$x->badd($y,@r); # badd does not leave internal zeros
$y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
sub bdec
{
# decrement arg by one
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bdec');
- my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
- # <= 0
- if (($x->{sign} eq '-') || $zero)
+ if ($x->{sign} eq '-')
{
+ # < 0
$x->{value} = $CALC->_inc($x->{value});
- $x->{sign} = '-' if $zero; # 0 => 1 => -1
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
- }
- # > 0
- elsif ($x->{sign} eq '+')
+ }
+ else
{
- $x->{value} = $CALC->_dec($x->{value});
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
+ return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf/NaN
+ # >= 0
+ if ($CALC->_is_zero($x->{value}))
+ {
+ # == 0
+ $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
+ }
+ else
+ {
+ # > 0
+ $x->{value} = $CALC->_dec($x->{value});
+ }
}
- # inf, nan handling etc
- $x->badd($self->bone('-'),$a,$p,$r); # badd does round
- }
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
+ }
sub blog
{
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$base,@r) = objectify(2,@_);
+ ($self,$x,$base,@r) = objectify(1,$class,@_);
}
+
+ return $x if $x->modify('blog');
# inf, -inf, NaN, <0 => NaN
return $x->bnan()
- if $x->{sign} ne '+' || $base->{sign} ne '+';
-
- return $upgrade->blog($upgrade->new($x),$base,@r) if
- defined $upgrade && (ref($x) ne $upgrade || ref($base) ne $upgrade);
+ if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
- if ($CAN{log_int})
- {
- my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
- return $x->bnan() unless defined $rc;
- $x->{value} = $rc;
- return $x->round(@r);
- }
-
- return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
+ return $upgrade->blog($upgrade->new($x),$base,@r) if
+ defined $upgrade;
- my $acmp = $x->bacmp($base);
- return $x->bone('+',@r) if $acmp == 0;
- return $x->bzero(@r) if $acmp < 0 || $x->is_one();
-
- # blog($x,$base) ** $base + $y = $x
-
- # this trial multiplication is very fast, even for large counts (like for
- # 2 ** 1024, since this still requires only 1024 very fast steps
- # (multiplication of a large number by a very small number is very fast))
- # See Calc for an even faster algorightmn
- my $x_org = $x->copy(); # preserve orgx
- $x->bzero(); # keep ref to $x
- my $trial = $base->copy();
- while ($trial->bacmp($x_org) <= 0)
- {
- $trial->bmul($base); $x->binc();
- }
+ my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
+ return $x->bnan() unless defined $rc; # not possible to take log?
+ $x->{value} = $rc;
$x->round(@r);
}
}
else
{
- $x = $class->new($y);
+ $x = __PACKAGE__->new($y);
}
- while (@_) { $x = __lcm($x,shift); }
+ my $self = ref($x);
+ while (@_)
+ {
+ my $y = shift; $y = $self->new($y) if !ref ($y);
+ $x = __lcm($x,$y);
+ }
$x;
}
my $y = shift;
$y = __PACKAGE__->new($y) if !ref($y);
my $self = ref($y);
- my $x = $y->copy(); # keep arguments
- if ($CAN{gcd})
- {
- while (@_)
- {
- $y = shift; $y = $self->new($y) if !ref($y);
- next if $y->is_zero();
- return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
- $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
- }
- }
- else
+ my $x = $y->copy()->babs(); # keep arguments
+ return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
+
+ while (@_)
{
- while (@_)
- {
- $y = shift; $y = $self->new($y) if !ref($y);
- $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
- }
+ $y = shift; $y = $self->new($y) if !ref($y);
+ next if $y->is_zero();
+ return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
+ $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
}
- $x->babs();
+ $x;
}
sub bnot
return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
-
- return $upgrade->bmul($x,$y,@r)
- if defined $upgrade && $y->isa($upgrade);
+
+ return $upgrade->bmul($x,$upgrade->new($y),@r)
+ if defined $upgrade && !$y->isa($self);
$r[3] = $y; # no push here
return $x->round(@r);
}
- if ($CAN{mod})
+ # calc new sign and in case $y == +/- 1, return $x
+ $x->{value} = $CALC->_mod($x->{value},$y->{value});
+ if (!$CALC->_is_zero($x->{value}))
{
- # calc new sign and in case $y == +/- 1, return $x
- $x->{value} = $CALC->_mod($x->{value},$y->{value});
- if (!$CALC->_is_zero($x->{value}))
- {
- my $xsign = $x->{sign};
- $x->{sign} = $y->{sign};
- if ($xsign ne $y->{sign})
- {
- my $t = $CALC->_copy($x->{value}); # copy $x
- $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
- }
- }
- else
+ my $xsign = $x->{sign};
+ $x->{sign} = $y->{sign};
+ if ($xsign ne $y->{sign})
{
- $x->{sign} = '+'; # dont leave -0
+ my $t = $CALC->_copy($x->{value}); # copy $x
+ $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
}
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
}
- # disable upgrade temporarily, otherwise endless loop due to bdiv()
- local $upgrade = undef;
- my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
- # modify in place
- foreach (qw/value sign _a _p/)
+ else
{
- $x->{$_} = $rem->{$_};
+ $x->{sign} = '+'; # dont leave -0
}
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
$x;
}
# put least residue into $x if $x was negative, and thus make it positive
$x->bmod($y) if $x->{sign} eq '-';
- if ($CAN{modinv})
- {
- my $sign;
- ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
- $x->bnan() if !defined $x->{value}; # in case no GCD found
- return $x if !defined $sign; # already real result
- $x->{sign} = $sign; # flip/flop see below
- $x->bmod($y); # calc real result
- return $x;
- }
- my ($u, $u1) = ($self->bzero(), $self->bone());
- my ($a, $b) = ($y->copy(), $x->copy());
-
- # first step need always be done since $num (and thus $b) is never 0
- # Note that the loop is aligned so that the check occurs between #2 and #1
- # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
- # a case with 28 loops still gains about 3% with this layout.
- my $q;
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
- # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
- # two values in $u and $u1, we use only $u1 afterwards)
- my $sign = 1; # flip-flop
- while (!$b->is_zero()) # found GCD if $b == 0
- {
- # the original algorithm had:
- # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
- # The following creates exact the same sequence of numbers in $u1,
- # except for the sign ($u1 is now always positive). Since formerly
- # the sign of $u1 was alternating between '-' and '+', the $sign
- # flip-flop will take care of that, so that at the end of the loop
- # we have the real sign of $u1. Keeping numbers positive gains us
- # speed since badd() is faster than bsub() and makes it possible
- # to have the algorithmn in Calc for even more speed.
-
- ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
- $sign = - $sign; # flip sign
-
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
- }
-
- # If the gcd is not 1, then return NaN! It would be pointless to
- # have called bgcd to check this first, because we would then be
- # performing the same Euclidean Algorithm *twice*.
- return $x->bnan() unless $a->is_one();
-
- $u1->bneg() if $sign != 1; # need to flip?
-
- $u1->bmod($y); # calc result
- $x->{value} = $u1->{value}; # and copy over to $x
- $x->{sign} = $u1->{sign}; # to modify in place
+ my $sign;
+ ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
+ return $x->bnan() if !defined $x->{value}; # in case no GCD found
+ return $x if !defined $sign; # already real result
+ $x->{sign} = $sign; # flip/flop see below
+ $x->bmod($y); # calc real result
$x;
}
# check num for valid values (also NaN if there was no inverse but $exp < 0)
return $num->bnan() if $num->{sign} !~ /^[+-]$/;
- if ($CAN{modpow})
- {
- # $mod is positive, sign on $exp is ignored, result also positive
- $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
- return $num;
- }
-
- # in the trivial case,
- return $num->bzero(@r) if $mod->is_one();
- return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
-
- # $num->bmod($mod); # if $x is large, make it smaller first
- my $acc = $num->copy(); # but this is not really faster...
-
- $num->bone(); # keep ref to $num
-
- my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
- my $len = CORE::length($expbin);
- while (--$len >= 0)
- {
- $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
- $acc->bmul($acc)->bmod($mod);
- }
-
+ # $mod is positive, sign on $exp is ignored, result also positive
+ $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
$num;
}
return $x if $x->modify('bfac');
- return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
+ return $x if $x->{sign} eq '+inf'; # inf => inf
+ return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
- if ($CAN{fac})
- {
- $x->{value} = $CALC->_fac($x->{value});
- return $x->round(@r);
- }
-
- return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
-
- my $n = $x->copy();
- $x->bone();
- # seems we need not to temp. clear A/P of $x since the result is the same
- my $f = $self->new(2);
- while ($f->bacmp($n) < 0)
- {
- $x->bmul($f); $f->binc();
- }
- $x->bmul($f,@r); # last step and also round
+ $x->{value} = $CALC->_fac($x->{value});
+ $x->round(@r);
}
sub bpow
$r[3] = $y; # no push!
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bone('+',@r) if $y->is_zero();
- return $x->round(@r) if $x->is_one() || $y->is_one();
- if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
- {
- # if $x == -1 and odd/even y => +1/-1
- return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
- # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
- }
+
+ # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
+
+ my $new_sign = '+';
+ $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+
+ # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
+ return $x->binf()
+ if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
# 1 ** -y => 1 / (1 ** |y|)
# so do test for negative $y after above's clause
- return $x->bnan() if $y->{sign} eq '-';
- return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
-
- if ($CAN{pow})
- {
- $x->{value} = $CALC->_pow($x->{value},$y->{value});
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
- }
+ return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
-# based on the assumption that shifting in base 10 is fast, and that mul
-# works faster if numbers are small: we count trailing zeros (this step is
-# O(1)..O(N), but in case of O(N) we save much more time due to this),
-# stripping them out of the multiplication, and add $count * $y zeros
-# afterwards like this:
-# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
-# creates deep recursion since brsft/blsft use bpow sometimes.
-# 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(@r);
-# }
-
- my $pow2 = $self->bone();
- my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
- my $len = CORE::length($y_bin);
- while (--$len > 0)
- {
- $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
- $x->bmul($x);
- }
- $x->bmul($pow2);
+ $x->{value} = $CALC->_pow($x->{value},$y->{value});
+ $x->{sign} = $new_sign;
+ $x->{sign} = '+' if $CALC->_is_zero($y->{value});
$x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
$x;
}
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
- my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CAN{lsft};
- if (defined $t)
- {
- $x->{value} = $t; return $x->round(@r);
- }
- # fallback
- return $x->bmul( $self->bpow($n, $y, @r), @r );
+ $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n);
+ $x->round(@r);
}
sub brsft
$x->{value} = $res->{value}; # take over value
return $x->round(@r); # we are done now, magic, isn't?
}
+ # x < 0, n == 2, y == 1
$x->bdec(); # n == 2, but $y == 1: this fixes it
}
- my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CAN{rsft};
- if (defined $t)
- {
- $x->{value} = $t;
- return $x->round(@r);
- }
- # fallback
- $x->bdiv($self->bpow($n,$y, @r), @r);
- $x;
+ $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
+ $x->round(@r);
}
sub band
return $x if $x->modify('band');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
- if ($CAN{and} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_and($x->{value},$y->{value});
return $x->round(@r);
$x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
-
- return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # cut the longer string to the length of the shorter one (the result would
- # be 0 due to AND anyway)
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $bx = substr($bx,0,CORE::length($by));
- }
- elsif ($diff < 0)
- {
- $by = substr($by,0,CORE::length($bx));
- }
-
- # and the strings together
- my $r = $bx & $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+
+ require $EMU_LIB;
+ __emu_band($self,$x,$y,$sx,$sy,@r);
}
sub bior
return $x if $x->modify('bior');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
-
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
# the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
# don't use lib for negative values
- if ($CAN{or} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_or($x->{value},$y->{value});
return $x->round(@r);
}
- # if lib can do negatvie values, so use it
+ # if lib can do negative values, let it handle this
if ($CAN{signed_or})
{
$x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # or the strings together
- my $r = $bx | $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # if one of X or Y was negative, we need to decrement result
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_bior($self,$x,$y,$sx,$sy,@r);
}
sub bxor
return $x if $x->modify('bxor');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
-
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
# don't use lib for negative values
- if ($CAN{xor} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_xor($x->{value},$y->{value});
return $x->round(@r);
}
- # if lib can do negatvie values, so use it
+ # if lib can do negative values, let it handle this
if ($CAN{signed_xor})
{
$x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if $x->{sign} ne $y->{sign};
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # xor the strings together
- my $r = $bx ^ $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_bxor($self,$x,$y,$sx,$sy,@r);
}
sub length
{
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
my $e = $CALC->_len($x->{value});
wantarray ? ($e,0) : $e;
sub digit
{
# return the nth decimal digit, negative values count backward, 0 is right
- my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
+ $n = $n->numify() if ref($n);
$CALC->_digit($x->{value},$n||0);
}
sub _trailing_zeros
{
- # return the amount of trailing zeros in $x
+ # return the amount of trailing zeros in $x (as scalar)
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
- return $CALC->_zeros($x->{value}) if $CAN{zeros};
-
- # if not: since we do not know underlying internal representation:
- my $es = "$x"; $es =~ /([0]*)$/;
- return 0 if !defined $1; # no zeros
- CORE::length("$1"); # as string, not as +0!
+ $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
}
sub bsqrt
return $upgrade->bsqrt($x,@r) if defined $upgrade;
- if ($CAN{sqrt})
- {
- $x->{value} = $CALC->_sqrt($x->{value});
- return $x->round(@r);
- }
-
- # this is slow:
- return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1
-
- return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1
- my $y = $x->copy();
- my $l = int($x->length()/2);
-
- $x->bone(); # keep ref($x), but modify it
- $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2))
-
- my $last = $self->bzero();
- my $two = $self->new(2);
- my $lastlast = $self->bzero();
- #my $lastlast = $x+$two;
- while ($last != $x && $lastlast != $x)
- {
- $lastlast = $last; $last = $x->copy();
- $x->badd($y / $x);
- $x->bdiv($two);
- }
- $x->bdec() if $x * $x > $y; # overshot?
+ $x->{value} = $CALC->_sqrt($x->{value});
$x->round(@r);
}
# objectify is costly, so avoid it
if ((!ref($x)) || (ref($x) ne ref($y)))
{
- ($self,$x,$y,@r) = $self->objectify(2,@_);
+ ($self,$x,$y,@r) = objectify(2,$self || $class,@_);
}
return $x if $x->modify('broot');
return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
- if ($CAN{root})
- {
- $x->{value} = $CALC->_root($x->{value},$y->{value});
- return $x->round(@r);
- }
-
- return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root
-
- # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
- return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1
-
- my $num = $x->numify();
-
- if ($num <= 1000000)
- {
- $x = $self->new( int($num ** (1 / $y->numify()) ));
- return $x->round(@r);
- }
-
- # if $n is a power of two, we can repeatedly take sqrt($X) and find the
- # proper result, because sqrt(sqrt($x)) == root($x,4)
- # See Calc.pm for more details
- my $b = $y->as_bin();
- if ($b =~ /0b1(0+)/)
- {
- my $count = CORE::length($1); # 0b100 => len('00') => 2
- my $cnt = $count; # counter for loop
- my $shift = $self->new(6);
- $x->blsft($shift); # add some zeros (even amount)
- while ($cnt-- > 0)
- {
- # 'inflate' $X by adding more zeros
- $x->blsft($shift);
- # calculate sqrt($x), $x is now a bit too big, again. In the next
- # round we make even bigger, again.
- $x->bsqrt($x);
- }
- # $x is still to big, so truncate result
- $x->brsft($shift);
- }
- else
- {
- # Should compute a guess of the result (by rule of thumb), then improve it
- # via Newton's method or something similiar.
- # XXX TODO
- warn ('broot() not fully implemented in BigInt.');
- }
- return $x->round(@r);
+ $x->{value} = $CALC->_root($x->{value},$y->{value});
+ $x->round(@r);
}
sub exponent
if ($x->{sign} !~ /^[+-]$/)
{
- my $s = $x->{sign}; $s =~ s/^[+-]//;
- return $self->new($s); # -inf,+inf => inf
+ my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf
+ return $self->new($s);
}
- my $e = $class->bzero();
- return $e->binc() if $x->is_zero();
- $e += $x->_trailing_zeros();
- $e;
+ return $self->bone() if $x->is_zero();
+
+ $self->new($x->_trailing_zeros());
}
sub mantissa
if ($x->{sign} !~ /^[+-]$/)
{
- return $self->new($x->{sign}); # keep + or - sign
+ # for NaN, +inf, -inf: keep the sign
+ return $self->new($x->{sign});
}
- my $m = $x->copy();
- # that's inefficient
+ my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};
+ # that's a bit inefficient:
my $zeros = $m->_trailing_zeros();
$m->brsft($zeros,10) if $zeros != 0;
$m;
{
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 || $n == 1 => round to integer
- my $x = shift; $x = $class->new($x) unless ref $x;
+ my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
+
my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
- return $x if !defined $scale; # no-op
- return $x if $x->modify('bfround');
+
+ return $x if !defined $scale || $x->modify('bfround'); # no-op
# no-op for BigInts if $n <= 0
- if ($scale <= 0)
- {
- $x->{_a} = undef; # clear an eventual set A
- $x->{_p} = $scale; return $x;
- }
+ $x->bround( $x->length()-$scale, $mode) if $scale > 0;
- $x->bround( $x->length()-$scale, $mode);
- $x->{_a} = undef; # bround sets {_a}
- $x->{_p} = $scale; # so correct it
+ delete $x->{_a}; # delete to save memory
+ $x->{_p} = $scale; # store new _p
$x;
}
sub _scan_for_nonzero
{
- # internal, used by bround()
- my $x = shift;
- my $pad = shift;
- my $xs = shift;
+ # internal, used by bround() to scan for non-zeros after a '5'
+ my ($x,$pad,$xs,$len) = @_;
- my $len = $x->length();
- return 0 if $len == 1; # '5' is trailed by invisible zeros
+ return 0 if $len == 1; # "5" is trailed by invisible zeros
my $follow = $pad - 1;
return 0 if $follow > $len || $follow < 1;
- # since we do not know underlying represention of $x, use decimal string
- my $r = substr ("$x",-$follow);
- $r =~ /[^0]/ ? 1 : 0;
+ # use the string form to check whether only '0's follow or not
+ substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0;
}
sub fround
$pad = $len - $scale;
$pad = abs($scale-1) if $scale < 0;
- # do not use digit(), it is costly for binary => decimal
-
+ # do not use digit(), it is very costly for binary => decimal
+ # getting the entire string is also costly, but we need to do it only once
my $xs = $CALC->_str($x->{value});
my $pl = -$pad-1;
# pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
# pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
- $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
+ $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
$pl++; $pl ++ if $pad >= $len;
- $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
+ $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;
# in case of 01234 we round down, for 6789 up, and only in case 5 we look
# closer at the remaining digits of the original $x, remember decision
($digit_after =~ /[01234]/) || # round down anyway,
# 6789 => round up
($digit_after eq '5') && # not 5000...0000
- ($x->_scan_for_nonzero($pad,$xs) == 0) &&
+ ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
(
($mode eq 'even') && ($digit_round =~ /[24680]/) ||
($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
if (($pad > 0) && ($pad <= $len))
{
- substr($$xs,-$pad,$pad) = '0' x $pad;
- $put_back = 1;
+ substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
+ $put_back = 1; # need to put back
}
elsif ($pad > $len)
{
if ($round_up) # what gave test above?
{
- $put_back = 1;
- $pad = $len, $$xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
+ $put_back = 1; # need to put back
+ $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
# we modify directly the string variant instead of creating a number and
# adding it, since that is faster (we already have the string)
my $c = 0; $pad ++; # for $pad == $len case
while ($pad <= $len)
{
- $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
- substr($$xs,-$pad,1) = $c; $pad++;
+ $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
+ substr($xs,-$pad,1) = $c; $pad++;
last if $c != 0; # no overflow => early out
}
- $$xs = '1'.$$xs if $c == 0;
+ $xs = '1'.$xs if $c == 0;
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed
+ $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0)
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $es = ''; my $s = '';
+ my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
- if ($CAN{as_hex})
- {
- $es = ${$CALC->_as_hex($x->{value})};
- }
- else
- {
- return '0x0' if $x->is_zero();
-
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
- if ($] >= 5.006)
- {
- $x10000 = Math::BigInt->new (0x10000); $h = 'h4';
- }
- else
- {
- $x10000 = Math::BigInt->new (0x1000); $h = 'h3';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($h,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s .= '0x';
- }
- $s . $es;
+ $s . $CALC->_as_hex($x->{value});
}
sub as_bin
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $es = ''; my $s = '';
- $s = $x->{sign} if $x->{sign} eq '-';
- if ($CAN{as_bin})
- {
- $es = ${$CALC->_as_bin($x->{value})};
- }
- else
- {
- return '0b0' if $x->is_zero();
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
- if ($] >= 5.006)
- {
- $x10000 = Math::BigInt->new (0x10000); $b = 'b16';
- }
- else
- {
- $x10000 = Math::BigInt->new (0x1000); $b = 'b12';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($b,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s .= '0b';
- }
- $s . $es;
+ my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
+ return $s . $CALC->_as_bin($x->{value});
}
##############################################################################
{
eval "use $lib qw/@c/;";
}
- $CALC = $lib, last if $@ eq ''; # no error in loading lib?
+ if ($@ eq '')
+ {
+ my $ok = 1;
+ # loaded it ok, see if the api_version() is high enough
+ if ($lib->can('api_version') && $lib->api_version() >= 1.0)
+ {
+ $ok = 0;
+ # api_version matches, check if it really provides anything we need
+ for my $method (qw/
+ one two ten
+ str num
+ add mul div sub dec inc
+ acmp len digit is_one is_zero is_even is_odd
+ is_two is_ten
+ new copy check from_hex from_bin as_hex as_bin zeros
+ rsft lsft xor and or
+ mod sqrt root fac pow modinv modpow log_int gcd
+ /)
+ {
+ if (!$lib->can("_$method"))
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ require Carp;
+ Carp::carp ("$lib is missing method '_$method'");
+ $WARN{$lib} = 1; # still warn about the lib
+ }
+ $ok++; last;
+ }
+ }
+ }
+ if ($ok == 0)
+ {
+ $CALC = $lib;
+ last; # found a usable one, break
+ }
+ else
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ my $ver = eval "\$$lib\::VERSION";
+ require Carp;
+ Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
+ $WARN{$lib} = 2; # never warn again
+ }
+ }
+ }
}
if ($CALC eq '')
{
require Carp;
Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'");
}
- _fill_can_cache();
+ _fill_can_cache(); # for emulating lower math lib functions
}
sub _fill_can_cache
# fill $CAN with the results of $CALC->can(...)
%CAN = ();
- for my $method (qw/gcd mod modinv modpow fac pow lsft rsft
- and signed_and or signed_or xor signed_xor
- from_hex as_hex from_bin as_bin
- zeros sqrt root log_int log
- /)
+ for my $method (qw/ signed_and or signed_or xor signed_xor /)
{
$CAN{$method} = $CALC->can("_$method") ? 1 : 0;
}
my $x = Math::BigInt->bzero();
# strip underscores
- $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
- $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+ $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+ $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
- return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
+ return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
- my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
+ my $sign = '+'; $sign = '-' if $hs =~ /^-/;
- $$hs =~ s/^[+-]//; # strip sign
- if ($CAN{'_from_hex'})
- {
- $x->{value} = $CALC->_from_hex($hs);
- }
- else
- {
- # fallback to pure perl
- my $mul = Math::BigInt->bzero(); $mul++;
- my $x65536 = Math::BigInt->new(65536);
- my $len = CORE::length($$hs)-2;
- $len = int($len/4); # 4-digit parts, w/o '0x'
- my $val; my $i = -4;
- while ($len >= 0)
- {
- $val = substr($$hs,$i,4);
- $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
- $val = hex($val); # hex does not like wrong chars
- $i -= 4; $len --;
- $x += $mul * $val if $val != 0;
- $mul *= $x65536 if $len >= 0; # skip last mul
- }
- }
+ $hs =~ s/^[+-]//; # strip sign
+ $x->{value} = $CALC->_from_hex($hs);
$x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
$x;
}
my $x = Math::BigInt->bzero();
# strip underscores
- $$bs =~ s/([01])_([01])/$1$2/g;
- $$bs =~ s/([01])_([01])/$1$2/g;
- return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
+ $bs =~ s/([01])_([01])/$1$2/g;
+ $bs =~ s/([01])_([01])/$1$2/g;
+ return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/;
- my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
- $$bs =~ s/^[+-]//; # strip sign
- if ($CAN{'_from_bin'})
- {
- $x->{value} = $CALC->_from_bin($bs);
- }
- else
- {
- my $mul = Math::BigInt->bzero(); $mul++;
- my $x256 = Math::BigInt->new(256);
- my $len = CORE::length($$bs)-2;
- $len = int($len/8); # 8-digit parts, w/o '0b'
- my $val; my $i = -8;
- while ($len >= 0)
- {
- $val = substr($$bs,$i,8);
- $val =~ s/^[+-]?0b// if $len == 0; # for last part only
- #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
- # slower:
- # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
- $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
- $i -= 8; $len --;
- $x += $mul * $val if $val != 0;
- $mul *= $x256 if $len >= 0; # skip last mul
- }
- }
+ my $sign = '+'; $sign = '-' if $bs =~ /^\-/;
+ $bs =~ s/^[+-]//; # strip sign
+
+ $x->{value} = $CALC->_from_bin($bs);
$x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
$x;
}
my $x = shift;
# 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*([-]?)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
# shortcut, if nothing to split, return early
- if ($$x =~ /^[+-]?\d+\z/)
+ if ($x =~ /^[+-]?\d+\z/)
{
- $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
- return (\$sign, $x, \'', \'', \0);
+ $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
+ return (\$sign, \$x, \'', \'', \0);
}
# invalid starting char?
- return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
+ return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
- return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
- return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+ return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string
+ return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string
# strip underscores between digits
- $$x =~ s/(\d)_(\d)/$1$2/g;
- $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
+ $x =~ s/(\d)_(\d)/$1$2/g;
+ $x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
# 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 # 0e999
- #return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
-
- my ($m,$e,$last) = split /[Ee]/,$$x;
+ my ($m,$e,$last) = split /[Ee]/,$x;
return if defined $last; # last defined => 1e2E3 or others
$e = '0' if !defined $e || $e eq "";
my $x = shift; my $ty = shift;
return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
- return $x * $ty / bgcd($x,$ty);
- }
-
-sub __gcd
- {
- # (BINT or num_str, BINT or num_str) return BINT
- # does modify both arguments
- # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
- my ($x,$ty) = @_;
-
- return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
-
- while (!$ty->is_zero())
- {
- ($x, $ty) = ($ty,bmod($x,$ty));
- }
- $x;
+ $x * $ty / bgcd($x,$ty);
}
###############################################################################
# this method return 0 if the object can be modified, or 1 for not
-# We use a fast use constant statement here, to avoid costly calls. Subclasses
+# We use a fast constant sub() here, to avoid costly calls. Subclasses
# may override it with special code (f.i. Math::BigInt::Constant does so)
sub modify () { 0; }
use Math::BigInt lib => 'GMP';
+ my $str = '1234567890';
+ my @values = (64,74,18);
+ my $n = 1; my $sign = '-';
+
# Number creation
$x = Math::BigInt->new($str); # defaults to 0
+ $y = $x->copy(); # make a true copy
$nan = Math::BigInt->bnan(); # create a NotANumber
$zero = Math::BigInt->bzero(); # create a +0
$inf = Math::BigInt->binf(); # create a +inf
$x->is_one('-'); # if $x is -1
$x->is_odd(); # if $x is odd
$x->is_even(); # if $x is even
- $x->is_positive(); # if $x >= 0
- $x->is_negative(); # if $x < 0
- $x->is_inf(sign); # if $x is +inf, or -inf (sign is default '+')
+ $x->is_pos(); # if $x >= 0
+ $x->is_neg(); # if $x < 0
+ $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
$x->is_int(); # if $x is an integer (not a float)
# comparing and digit/sign extration
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
$x->round($A,$P,$mode); # round to accuracy or precision using mode $mode
- $x->bround($N); # accuracy: preserve $N digits
- $x->bfround($N); # round to $Nth digit, no-op for BigInts
+ $x->bround($n); # accuracy: preserve $n digits
+ $x->bfround($n); # round to $nth digit, no-op for BigInts
# The following do not modify their arguments in BigInt (are no-ops),
# but do so in BigFloat:
# The following do not modify their arguments:
- bgcd(@values); # greatest common divisor (no OO style)
- blcm(@values); # lowest common multiplicator (no OO style)
+ # greatest common divisor (no OO style)
+ my $gcd = Math::BigInt::bgcd(@values);
+ # lowest common multiplicator (no OO style)
+ my $lcm = Math::BigInt::blcm(@values);
$x->length(); # return number of digits in number
- ($x,$f) = $x->length(); # length of number and length of fraction part,
+ ($xl,$f) = $x->length(); # length of number and length of fraction part,
# latter is always 0 digits long for BigInt's
$x->exponent(); # return exponent as BigInt
$x->mantissa(); # return (signed) mantissa as BigInt
$x->parts(); # return (mantissa,exponent) as BigInt
$x->copy(); # make a true copy of $x (unlike $y = $x;)
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+ $x->as_int(); # return as BigInt (in BigInt: same as copy())
+ $x->numify(); # return as scalar (might overflow!)
# conversation to string (do not modify their argument)
$x->bstr(); # normalized string
$x->bsstr(); # normalized string in scientific notation
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
-
+
# precision and accuracy (see section about rounding for more)
$x->precision(); # return P of $x (or global, if P of $x undef)
if ($x == 0)
-=head2 is_positive()/is_negative()
+=head2 is_pos()/is_neg()
- $x->is_positive(); # true if >= 0
- $x->is_negative(); # true if < 0
+ $x->is_pos(); # true if >= 0
+ $x->is_neg(); # true if < 0
The methods return true if the argument is positive or negative, respectively.
C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
These methods are only testing the sign, and not the value.
+C<is_positive()> and C<is_negative()> are aliase to C<is_pos()> and
+C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were
+introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced
+in v1.68.
+
=head2 is_odd()/is_even()/is_int()
$x->is_odd(); # true if odd, false for even
$x->copy(); # make a true copy of $x (unlike $y = $x;)
-=head2 as_number
+=head2 as_int
+
+ $x->as_int();
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as
+C<copy()>.
+
+C<as_number()> is an alias to this method. C<as_number> was introduced in
+v1.22, while C<as_int()> was only introduced in v1.68.
-=head2 bsrt
+=head2 bstr
+
+ $x->bstr();
- $x->bstr(); # return normalized string
+Returns a normalized string represantation of C<$x>.
=head2 bsstr
=head1 AUTHORS
Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in late 2000, 2001, 2002
-and still at it in 2003.
+Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2003
+and still at it in 2004.
Many people contributed in one or more ways to the final beast, see the file
CREDITS for an (uncomplete) list. If you miss your name, please drop me a
projects / p5sagit/p5-mst-13.2.git / blobdiff