dist/Math-BigInt/lib/Math/BigInt.pm

   1 package Math::BigInt;
   2
   3 #
   4 # "Mike had an infinite amount to do and a negative amount of time in which
   5 # to do it." - Before and After
   6 #
   7
   8 # The following hash values are used:
   9 #   value: unsigned int with actual value (as a Math::BigInt::Calc or similar)
  10 #   sign : +,-,NaN,+inf,-inf
  11 #   _a   : accuracy
  12 #   _p   : precision
  13 #   _f   : flags, used by MBF to flag parts of a float as untouchable
  14
  15 # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
  16 # underlying lib might change the reference!
  17
  18 my $class = "Math::BigInt";
  19 use 5.006002;
  20
  21 $VERSION = '1.9994';
  22
  23 @ISA = qw(Exporter);
  24 @EXPORT_OK = qw(objectify bgcd blcm);
  25
  26 # _trap_inf and _trap_nan are internal and should never be accessed from the
  27 # outside
  28 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
  29             $upgrade $downgrade $_trap_nan $_trap_inf/;
  30 use strict;
  31
  32 # Inside overload, the first arg is always an object. If the original code had
  33 # it reversed (like $x = 2 * $y), then the third parameter is true.
  34 # In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
  35 # no difference, but in some cases it does.
  36
  37 # For overloaded ops with only one argument we simple use $_[0]->copy() to
  38 # preserve the argument.
  39
  40 # Thus inheritance of overload operators becomes possible and transparent for
  41 # our subclasses without the need to repeat the entire overload section there.
  42
  43 # We register ops that are not registerable yet, so suppress warnings
  44 { no warnings;
  45 use overload
  46 '='     =>      sub { $_[0]->copy(); },
  47
  48 # some shortcuts for speed (assumes that reversed order of arguments is routed
  49 # to normal '+' and we thus can always modify first arg. If this is changed,
  50 # this breaks and must be adjusted.)
  51 '+='    =>      sub { $_[0]->badd($_[1]); },
  52 '-='    =>      sub { $_[0]->bsub($_[1]); },
  53 '*='    =>      sub { $_[0]->bmul($_[1]); },
  54 '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },
  55 '%='    =>      sub { $_[0]->bmod($_[1]); },
  56 '^='    =>      sub { $_[0]->bxor($_[1]); },
  57 '&='    =>      sub { $_[0]->band($_[1]); },
  58 '|='    =>      sub { $_[0]->bior($_[1]); },
  59
  60 '**='   =>      sub { $_[0]->bpow($_[1]); },
  61 '<<='   =>      sub { $_[0]->blsft($_[1]); },
  62 '>>='   =>      sub { $_[0]->brsft($_[1]); },
  63
  64 # not supported by Perl yet
  65 '..'    =>      \&_pointpoint,
  66
  67 '<=>'   =>      sub { my $rc = $_[2] ?
  68                       ref($_[0])->bcmp($_[1],$_[0]) :
  69                       $_[0]->bcmp($_[1]);
  70                       $rc = 1 unless defined $rc;
  71                       $rc <=> 0;
  72                 },
  73 # we need '>=' to get things like "1 >= NaN" right:
  74 '>='    =>      sub { my $rc = $_[2] ?
  75                       ref($_[0])->bcmp($_[1],$_[0]) :
  76                       $_[0]->bcmp($_[1]);
  77                       # if there was a NaN involved, return false
  78                       return '' unless defined $rc;
  79                       $rc >= 0;
  80                 },
  81 'cmp'   =>      sub {
  82          $_[2] ?
  83                "$_[1]" cmp $_[0]->bstr() :
  84                $_[0]->bstr() cmp "$_[1]" },
  85
  86 'cos'   =>      sub { $_[0]->copy->bcos(); },
  87 'sin'   =>      sub { $_[0]->copy->bsin(); },
  88 'atan2' =>      sub { $_[2] ?
  89                         ref($_[0])->new($_[1])->batan2($_[0]) :
  90                         $_[0]->copy()->batan2($_[1]) },
  91
  92 # are not yet overloadable
  93 #'hex'  =>      sub { print "hex"; $_[0]; },
  94 #'oct'  =>      sub { print "oct"; $_[0]; },
  95
  96 # log(N) is log(N, e), where e is Euler's number
  97 'log'   =>      sub { $_[0]->copy()->blog($_[1], undef); },
  98 'exp'   =>      sub { $_[0]->copy()->bexp($_[1]); },
  99 'int'   =>      sub { $_[0]->copy(); },
 100 'neg'   =>      sub { $_[0]->copy()->bneg(); },
 101 'abs'   =>      sub { $_[0]->copy()->babs(); },
 102 'sqrt'  =>      sub { $_[0]->copy()->bsqrt(); },
 103 '~'     =>      sub { $_[0]->copy()->bnot(); },
 104
 105 # for subtract it's a bit tricky to not modify b: b-a => -a+b
 106 '-'     =>      sub { my $c = $_[0]->copy; $_[2] ?
 107                         $c->bneg()->badd( $_[1]) :
 108                         $c->bsub( $_[1]) },
 109 '+'     =>      sub { $_[0]->copy()->badd($_[1]); },
 110 '*'     =>      sub { $_[0]->copy()->bmul($_[1]); },
 111
 112 '/'     =>      sub {
 113    $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]);
 114   },
 115 '%'     =>      sub {
 116    $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]);
 117   },
 118 '**'    =>      sub {
 119    $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]);
 120   },
 121 '<<'    =>      sub {
 122    $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]);
 123   },
 124 '>>'    =>      sub {
 125    $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]);
 126   },
 127 '&'     =>      sub {
 128    $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]);
 129   },
 130 '|'     =>      sub {
 131    $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]);
 132   },
 133 '^'     =>      sub {
 134    $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]);
 135   },
 136
 137 # can modify arg of ++ and --, so avoid a copy() for speed, but don't
 138 # use $_[0]->bone(), it would modify $_[0] to be 1!
 139 '++'    =>      sub { $_[0]->binc() },
 140 '--'    =>      sub { $_[0]->bdec() },
 141
 142 # if overloaded, O(1) instead of O(N) and twice as fast for small numbers
 143 'bool'  =>      sub {
 144   # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
 145   # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef;                :-(
 146   my $t = undef;
 147   $t = 1 if !$_[0]->is_zero();
 148   $t;
 149   },
 150
 151 # the original qw() does not work with the TIESCALAR below, why?
 152 # Order of arguments insignificant
 153 '""' => sub { $_[0]->bstr(); },
 154 '0+' => sub { $_[0]->numify(); }
 155 ;
 156 } # no warnings scope
 157
 158 ##############################################################################
 159 # global constants, flags and accessory
 160
 161 # These vars are public, but their direct usage is not recommended, use the
 162 # accessor methods instead
 163
 164 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
 165 $accuracy   = undef;
 166 $precision  = undef;
 167 $div_scale  = 40;
 168
 169 $upgrade = undef;                       # default is no upgrade
 170 $downgrade = undef;                     # default is no downgrade
 171
 172 # These are internally, and not to be used from the outside at all
 173
 174 $_trap_nan = 0;                         # are NaNs ok? set w/ config()
 175 $_trap_inf = 0;                         # are infs ok? set w/ config()
 176 my $nan = 'NaN';                        # constants for easier life
 177
 178 my $CALC = 'Math::BigInt::Calc';        # module to do the low level math
 179                                         # default is Calc.pm
 180 my $IMPORT = 0;                         # was import() called yet?
 181                                         # used to make require work
 182 my %WARN;                               # warn only once for low-level libs
 183 my %CAN;                                # cache for $CALC->can(...)
 184 my %CALLBACKS;                          # callbacks to notify on lib loads
 185 my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
 186
 187 ##############################################################################
 188 # the old code had $rnd_mode, so we need to support it, too
 189
 190 $rnd_mode   = 'even';
 191 sub TIESCALAR  { my ($class) = @_; bless \$round_mode, $class; }
 192 sub FETCH      { return $round_mode; }
 193 sub STORE      { $rnd_mode = $_[0]->round_mode($_[1]); }
 194
 195 BEGIN
 196   {
 197   # tie to enable $rnd_mode to work transparently
 198   tie $rnd_mode, 'Math::BigInt';
 199
 200   # set up some handy alias names
 201   *as_int = \&as_number;
 202   *is_pos = \&is_positive;
 203   *is_neg = \&is_negative;
 204   }
 205
 206 ##############################################################################
 207
 208 sub round_mode
 209   {
 210   no strict 'refs';
 211   # make Class->round_mode() work
 212   my $self = shift;
 213   my $class = ref($self) || $self || __PACKAGE__;
 214   if (defined $_[0])
 215     {
 216     my $m = shift;
 217     if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
 218       {
 219       require Carp; Carp::croak ("Unknown round mode '$m'");
 220       }
 221     return ${"${class}::round_mode"} = $m;
 222     }
 223   ${"${class}::round_mode"};
 224   }
 225
 226 sub upgrade
 227   {
 228   no strict 'refs';
 229   # make Class->upgrade() work
 230   my $self = shift;
 231   my $class = ref($self) || $self || __PACKAGE__;
 232   # need to set new value?
 233   if (@_ > 0)
 234     {
 235     return ${"${class}::upgrade"} = $_[0];
 236     }
 237   ${"${class}::upgrade"};
 238   }
 239
 240 sub downgrade
 241   {
 242   no strict 'refs';
 243   # make Class->downgrade() work
 244   my $self = shift;
 245   my $class = ref($self) || $self || __PACKAGE__;
 246   # need to set new value?
 247   if (@_ > 0)
 248     {
 249     return ${"${class}::downgrade"} = $_[0];
 250     }
 251   ${"${class}::downgrade"};
 252   }
 253
 254 sub div_scale
 255   {
 256   no strict 'refs';
 257   # make Class->div_scale() work
 258   my $self = shift;
 259   my $class = ref($self) || $self || __PACKAGE__;
 260   if (defined $_[0])
 261     {
 262     if ($_[0] < 0)
 263       {
 264       require Carp; Carp::croak ('div_scale must be greater than zero');
 265       }
 266     ${"${class}::div_scale"} = $_[0];
 267     }
 268   ${"${class}::div_scale"};
 269   }
 270
 271 sub accuracy
 272   {
 273   # $x->accuracy($a);           ref($x) $a
 274   # $x->accuracy();             ref($x)
 275   # Class->accuracy();          class
 276   # Class->accuracy($a);        class $a
 277
 278   my $x = shift;
 279   my $class = ref($x) || $x || __PACKAGE__;
 280
 281   no strict 'refs';
 282   # need to set new value?
 283   if (@_ > 0)
 284     {
 285     my $a = shift;
 286     # convert objects to scalars to avoid deep recursion. If object doesn't
 287     # have numify(), then hopefully it will have overloading for int() and
 288     # boolean test without wandering into a deep recursion path...
 289     $a = $a->numify() if ref($a) && $a->can('numify');
 290
 291     if (defined $a)
 292       {
 293       # also croak on non-numerical
 294       if (!$a || $a <= 0)
 295         {
 296         require Carp;
 297         Carp::croak ('Argument to accuracy must be greater than zero');
 298         }
 299       if (int($a) != $a)
 300         {
 301         require Carp;
 302         Carp::croak ('Argument to accuracy must be an integer');
 303         }
 304       }
 305     if (ref($x))
 306       {
 307       # $object->accuracy() or fallback to global
 308       $x->bround($a) if $a;             # not for undef, 0
 309       $x->{_a} = $a;                    # set/overwrite, even if not rounded
 310       delete $x->{_p};                  # clear P
 311       $a = ${"${class}::accuracy"} unless defined $a;   # proper return value
 312       }
 313     else
 314       {
 315       ${"${class}::accuracy"} = $a;     # set global A
 316       ${"${class}::precision"} = undef; # clear global P
 317       }
 318     return $a;                          # shortcut
 319     }
 320
 321   my $a;
 322   # $object->accuracy() or fallback to global
 323   $a = $x->{_a} if ref($x);
 324   # but don't return global undef, when $x's accuracy is 0!
 325   $a = ${"${class}::accuracy"} if !defined $a;
 326   $a;
 327   }
 328
 329 sub precision
 330   {
 331   # $x->precision($p);          ref($x) $p
 332   # $x->precision();            ref($x)
 333   # Class->precision();         class
 334   # Class->precision($p);       class $p
 335
 336   my $x = shift;
 337   my $class = ref($x) || $x || __PACKAGE__;
 338
 339   no strict 'refs';
 340   if (@_ > 0)
 341     {
 342     my $p = shift;
 343     # convert objects to scalars to avoid deep recursion. If object doesn't
 344     # have numify(), then hopefully it will have overloading for int() and
 345     # boolean test without wandering into a deep recursion path...
 346     $p = $p->numify() if ref($p) && $p->can('numify');
 347     if ((defined $p) && (int($p) != $p))
 348       {
 349       require Carp; Carp::croak ('Argument to precision must be an integer');
 350       }
 351     if (ref($x))
 352       {
 353       # $object->precision() or fallback to global
 354       $x->bfround($p) if $p;            # not for undef, 0
 355       $x->{_p} = $p;                    # set/overwrite, even if not rounded
 356       delete $x->{_a};                  # clear A
 357       $p = ${"${class}::precision"} unless defined $p;  # proper return value
 358       }
 359     else
 360       {
 361       ${"${class}::precision"} = $p;    # set global P
 362       ${"${class}::accuracy"} = undef;  # clear global A
 363       }
 364     return $p;                          # shortcut
 365     }
 366
 367   my $p;
 368   # $object->precision() or fallback to global
 369   $p = $x->{_p} if ref($x);
 370   # but don't return global undef, when $x's precision is 0!
 371   $p = ${"${class}::precision"} if !defined $p;
 372   $p;
 373   }
 374
 375 sub config
 376   {
 377   # return (or set) configuration data as hash ref
 378   my $class = shift || 'Math::BigInt';
 379
 380   no strict 'refs';
 381   if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH')))
 382     {
 383     # try to set given options as arguments from hash
 384
 385     my $args = $_[0];
 386     if (ref($args) ne 'HASH')
 387       {
 388       $args = { @_ };
 389       }
 390     # these values can be "set"
 391     my $set_args = {};
 392     foreach my $key (
 393      qw/trap_inf trap_nan
 394         upgrade downgrade precision accuracy round_mode div_scale/
 395      )
 396       {
 397       $set_args->{$key} = $args->{$key} if exists $args->{$key};
 398       delete $args->{$key};
 399       }
 400     if (keys %$args > 0)
 401       {
 402       require Carp;
 403       Carp::croak ("Illegal key(s) '",
 404        join("','",keys %$args),"' passed to $class\->config()");
 405       }
 406     foreach my $key (keys %$set_args)
 407       {
 408       if ($key =~ /^trap_(inf|nan)\z/)
 409         {
 410         ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
 411         next;
 412         }
 413       # use a call instead of just setting the $variable to check argument
 414       $class->$key($set_args->{$key});
 415       }
 416     }
 417
 418   # now return actual configuration
 419
 420   my $cfg = {
 421     lib => $CALC,
 422     lib_version => ${"${CALC}::VERSION"},
 423     class => $class,
 424     trap_nan => ${"${class}::_trap_nan"},
 425     trap_inf => ${"${class}::_trap_inf"},
 426     version => ${"${class}::VERSION"},
 427     };
 428   foreach my $key (qw/
 429      upgrade downgrade precision accuracy round_mode div_scale
 430      /)
 431     {
 432     $cfg->{$key} = ${"${class}::$key"};
 433     };
 434   if (@_ == 1 && (ref($_[0]) ne 'HASH'))
 435     {
 436     # calls of the style config('lib') return just this value
 437     return $cfg->{$_[0]};
 438     }
 439   $cfg;
 440   }
 441
 442 sub _scale_a
 443   {
 444   # select accuracy parameter based on precedence,
 445   # used by bround() and bfround(), may return undef for scale (means no op)
 446   my ($x,$scale,$mode) = @_;
 447
 448   $scale = $x->{_a} unless defined $scale;
 449
 450   no strict 'refs';
 451   my $class = ref($x);
 452
 453   $scale = ${ $class . '::accuracy' } unless defined $scale;
 454   $mode = ${ $class . '::round_mode' } unless defined $mode;
 455
 456   if (defined $scale)
 457     {
 458     $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale);
 459     $scale = int($scale);
 460     }
 461
 462   ($scale,$mode);
 463   }
 464
 465 sub _scale_p
 466   {
 467   # select precision parameter based on precedence,
 468   # used by bround() and bfround(), may return undef for scale (means no op)
 469   my ($x,$scale,$mode) = @_;
 470
 471   $scale = $x->{_p} unless defined $scale;
 472
 473   no strict 'refs';
 474   my $class = ref($x);
 475
 476   $scale = ${ $class . '::precision' } unless defined $scale;
 477   $mode = ${ $class . '::round_mode' } unless defined $mode;
 478
 479   if (defined $scale)
 480     {
 481     $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale);
 482     $scale = int($scale);
 483     }
 484
 485   ($scale,$mode);
 486   }
 487
 488 ##############################################################################
 489 # constructors
 490
 491 sub copy
 492   {
 493   # if two arguments, the first one is the class to "swallow" subclasses
 494   if (@_ > 1)
 495     {
 496     my  $self = bless {
 497         sign => $_[1]->{sign},
 498         value => $CALC->_copy($_[1]->{value}),
 499     }, $_[0] if @_ > 1;
 500
 501     $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
 502     $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
 503     return $self;
 504     }
 505
 506   my $self = bless {
 507         sign => $_[0]->{sign},
 508         value => $CALC->_copy($_[0]->{value}),
 509         }, ref($_[0]);
 510
 511   $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
 512   $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
 513   $self;
 514   }
 515
 516 sub new
 517   {
 518   # create a new BigInt object from a string or another BigInt object.
 519   # see hash keys documented at top
 520
 521   # the argument could be an object, so avoid ||, && etc on it, this would
 522   # cause costly overloaded code to be called. The only allowed ops are
 523   # ref() and defined.
 524
 525   my ($class,$wanted,$a,$p,$r) = @_;
 526
 527   # avoid numify-calls by not using || on $wanted!
 528   return $class->bzero($a,$p) if !defined $wanted;      # default to 0
 529   return $class->copy($wanted,$a,$p,$r)
 530    if ref($wanted) && $wanted->isa($class);             # MBI or subclass
 531
 532   $class->import() if $IMPORT == 0;             # make require work
 533
 534   my $self = bless {}, $class;
 535
 536   # shortcut for "normal" numbers
 537   if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
 538     {
 539     $self->{sign} = $1 || '+';
 540
 541     if ($wanted =~ /^[+-]/)
 542      {
 543       # remove sign without touching wanted to make it work with constants
 544       my $t = $wanted; $t =~ s/^[+-]//;
 545       $self->{value} = $CALC->_new($t);
 546       }
 547     else
 548       {
 549       $self->{value} = $CALC->_new($wanted);
 550       }
 551     no strict 'refs';
 552     if ( (defined $a) || (defined $p)
 553         || (defined ${"${class}::precision"})
 554         || (defined ${"${class}::accuracy"})
 555        )
 556       {
 557       $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
 558       }
 559     return $self;
 560     }
 561
 562   # handle '+inf', '-inf' first
 563   if ($wanted =~ /^[+-]?inf\z/)
 564     {
 565     $self->{sign} = $wanted;            # set a default sign for bstr()
 566     return $self->binf($wanted);
 567     }
 568   # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
 569   my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
 570   if (!ref $mis)
 571     {
 572     if ($_trap_nan)
 573       {
 574       require Carp; Carp::croak("$wanted is not a number in $class");
 575       }
 576     $self->{value} = $CALC->_zero();
 577     $self->{sign} = $nan;
 578     return $self;
 579     }
 580   if (!ref $miv)
 581     {
 582     # _from_hex or _from_bin
 583     $self->{value} = $mis->{value};
 584     $self->{sign} = $mis->{sign};
 585     return $self;       # throw away $mis
 586     }
 587   # make integer from mantissa by adjusting exp, then convert to bigint
 588   $self->{sign} = $$mis;                        # store sign
 589   $self->{value} = $CALC->_zero();              # for all the NaN cases
 590   my $e = int("$$es$$ev");                      # exponent (avoid recursion)
 591   if ($e > 0)
 592     {
 593     my $diff = $e - CORE::length($$mfv);
 594     if ($diff < 0)                              # Not integer
 595       {
 596       if ($_trap_nan)
 597         {
 598         require Carp; Carp::croak("$wanted not an integer in $class");
 599         }
 600       #print "NOI 1\n";
 601       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 602       $self->{sign} = $nan;
 603       }
 604     else                                        # diff >= 0
 605       {
 606       # adjust fraction and add it to value
 607       #print "diff > 0 $$miv\n";
 608       $$miv = $$miv . ($$mfv . '0' x $diff);
 609       }
 610     }
 611   else
 612     {
 613     if ($$mfv ne '')                            # e <= 0
 614       {
 615       # fraction and negative/zero E => NOI
 616       if ($_trap_nan)
 617         {
 618         require Carp; Carp::croak("$wanted not an integer in $class");
 619         }
 620       #print "NOI 2 \$\$mfv '$$mfv'\n";
 621       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 622       $self->{sign} = $nan;
 623       }
 624     elsif ($e < 0)
 625       {
 626       # xE-y, and empty mfv
 627       #print "xE-y\n";
 628       $e = abs($e);
 629       if ($$miv !~ s/0{$e}$//)          # can strip so many zero's?
 630         {
 631         if ($_trap_nan)
 632           {
 633           require Carp; Carp::croak("$wanted not an integer in $class");
 634           }
 635         #print "NOI 3\n";
 636         return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 637         $self->{sign} = $nan;
 638         }
 639       }
 640     }
 641   $self->{sign} = '+' if $$miv eq '0';                  # normalize -0 => +0
 642   $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
 643   # if any of the globals is set, use them to round and store them inside $self
 644   # do not round for new($x,undef,undef) since that is used by MBF to signal
 645   # no rounding
 646   $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
 647   $self;
 648   }
 649
 650 sub bnan
 651   {
 652   # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
 653   my $self = shift;
 654   $self = $class if !defined $self;
 655   if (!ref($self))
 656     {
 657     my $c = $self; $self = {}; bless $self, $c;
 658     }
 659   no strict 'refs';
 660   if (${"${class}::_trap_nan"})
 661     {
 662     require Carp;
 663     Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
 664     }
 665   $self->import() if $IMPORT == 0;              # make require work
 666   return if $self->modify('bnan');
 667   if ($self->can('_bnan'))
 668     {
 669     # use subclass to initialize
 670     $self->_bnan();
 671     }
 672   else
 673     {
 674     # otherwise do our own thing
 675     $self->{value} = $CALC->_zero();
 676     }
 677   $self->{sign} = $nan;
 678   delete $self->{_a}; delete $self->{_p};       # rounding NaN is silly
 679   $self;
 680   }
 681
 682 sub binf
 683   {
 684   # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
 685   # the sign is either '+', or if given, used from there
 686   my $self = shift;
 687   my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
 688   $self = $class if !defined $self;
 689   if (!ref($self))
 690     {
 691     my $c = $self; $self = {}; bless $self, $c;
 692     }
 693   no strict 'refs';
 694   if (${"${class}::_trap_inf"})
 695     {
 696     require Carp;
 697     Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
 698     }
 699   $self->import() if $IMPORT == 0;              # make require work
 700   return if $self->modify('binf');
 701   if ($self->can('_binf'))
 702     {
 703     # use subclass to initialize
 704     $self->_binf();
 705     }
 706   else
 707     {
 708     # otherwise do our own thing
 709     $self->{value} = $CALC->_zero();
 710     }
 711   $sign = $sign . 'inf' if $sign !~ /inf$/;     # - => -inf
 712   $self->{sign} = $sign;
 713   ($self->{_a},$self->{_p}) = @_;               # take over requested rounding
 714   $self;
 715   }
 716
 717 sub bzero
 718   {
 719   # create a bigint '+0', if given a BigInt, set it to 0
 720   my $self = shift;
 721   $self = __PACKAGE__ if !defined $self;
 722
 723   if (!ref($self))
 724     {
 725     my $c = $self; $self = {}; bless $self, $c;
 726     }
 727   $self->import() if $IMPORT == 0;              # make require work
 728   return if $self->modify('bzero');
 729
 730   if ($self->can('_bzero'))
 731     {
 732     # use subclass to initialize
 733     $self->_bzero();
 734     }
 735   else
 736     {
 737     # otherwise do our own thing
 738     $self->{value} = $CALC->_zero();
 739     }
 740   $self->{sign} = '+';
 741   if (@_ > 0)
 742     {
 743     if (@_ > 3)
 744       {
 745       # call like: $x->bzero($a,$p,$r,$y);
 746       ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
 747       }
 748     else
 749       {
 750       $self->{_a} = $_[0]
 751        if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
 752       $self->{_p} = $_[1]
 753        if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
 754       }
 755     }
 756   $self;
 757   }
 758
 759 sub bone
 760   {
 761   # create a bigint '+1' (or -1 if given sign '-'),
 762   # if given a BigInt, set it to +1 or -1, respectively
 763   my $self = shift;
 764   my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
 765   $self = $class if !defined $self;
 766
 767   if (!ref($self))
 768     {
 769     my $c = $self; $self = {}; bless $self, $c;
 770     }
 771   $self->import() if $IMPORT == 0;              # make require work
 772   return if $self->modify('bone');
 773
 774   if ($self->can('_bone'))
 775     {
 776     # use subclass to initialize
 777     $self->_bone();
 778     }
 779   else
 780     {
 781     # otherwise do our own thing
 782     $self->{value} = $CALC->_one();
 783     }
 784   $self->{sign} = $sign;
 785   if (@_ > 0)
 786     {
 787     if (@_ > 3)
 788       {
 789       # call like: $x->bone($sign,$a,$p,$r,$y);
 790       ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
 791       }
 792     else
 793       {
 794       # call like: $x->bone($sign,$a,$p,$r);
 795       $self->{_a} = $_[0]
 796        if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
 797       $self->{_p} = $_[1]
 798        if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
 799       }
 800     }
 801   $self;
 802   }
 803
 804 ##############################################################################
 805 # string conversion
 806
 807 sub bsstr
 808   {
 809   # (ref to BFLOAT or num_str ) return num_str
 810   # Convert number from internal format to scientific string format.
 811   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
 812   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 813
 814   if ($x->{sign} !~ /^[+-]$/)
 815     {
 816     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 817     return 'inf';                                       # +inf
 818     }
 819   my ($m,$e) = $x->parts();
 820   #$m->bstr() . 'e+' . $e->bstr();      # e can only be positive in BigInt
 821   # 'e+' because E can only be positive in BigInt
 822   $m->bstr() . 'e+' . $CALC->_str($e->{value});
 823   }
 824
 825 sub bstr
 826   {
 827   # make a string from bigint object
 828   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 829
 830   if ($x->{sign} !~ /^[+-]$/)
 831     {
 832     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 833     return 'inf';                                       # +inf
 834     }
 835   my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
 836   $es.$CALC->_str($x->{value});
 837   }
 838
 839 sub numify
 840   {
 841   # Make a "normal" scalar from a BigInt object
 842   my $x = shift; $x = $class->new($x) unless ref $x;
 843
 844   return $x->bstr() if $x->{sign} !~ /^[+-]$/;
 845   my $num = $CALC->_num($x->{value});
 846   return -$num if $x->{sign} eq '-';
 847   $num;
 848   }
 849
 850 ##############################################################################
 851 # public stuff (usually prefixed with "b")
 852
 853 sub sign
 854   {
 855   # return the sign of the number: +/-/-inf/+inf/NaN
 856   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 857
 858   $x->{sign};
 859   }
 860
 861 sub _find_round_parameters
 862   {
 863   # After any operation or when calling round(), the result is rounded by
 864   # regarding the A & P from arguments, local parameters, or globals.
 865
 866   # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
 867
 868   # This procedure finds the round parameters, but it is for speed reasons
 869   # duplicated in round. Otherwise, it is tested by the testsuite and used
 870   # by fdiv().
 871
 872   # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
 873   # were requested/defined (locally or globally or both)
 874
 875   my ($self,$a,$p,$r,@args) = @_;
 876   # $a accuracy, if given by caller
 877   # $p precision, if given by caller
 878   # $r round_mode, if given by caller
 879   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 880
 881   my $c = ref($self);                           # find out class of argument(s)
 882   no strict 'refs';
 883
 884   # convert to normal scalar for speed and correctness in inner parts
 885   $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
 886   $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
 887
 888   # now pick $a or $p, but only if we have got "arguments"
 889   if (!defined $a)
 890     {
 891     foreach ($self,@args)
 892       {
 893       # take the defined one, or if both defined, the one that is smaller
 894       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
 895       }
 896     }
 897   if (!defined $p)
 898     {
 899     # even if $a is defined, take $p, to signal error for both defined
 900     foreach ($self,@args)
 901       {
 902       # take the defined one, or if both defined, the one that is bigger
 903       # -2 > -3, and 3 > 2
 904       $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
 905       }
 906     }
 907   # if still none defined, use globals (#2)
 908   $a = ${"$c\::accuracy"} unless defined $a;
 909   $p = ${"$c\::precision"} unless defined $p;
 910
 911   # A == 0 is useless, so undef it to signal no rounding
 912   $a = undef if defined $a && $a == 0;
 913
 914   # no rounding today?
 915   return ($self) unless defined $a || defined $p;               # early out
 916
 917   # set A and set P is an fatal error
 918   return ($self->bnan()) if defined $a && defined $p;           # error
 919
 920   $r = ${"$c\::round_mode"} unless defined $r;
 921   if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
 922     {
 923     require Carp; Carp::croak ("Unknown round mode '$r'");
 924     }
 925
 926   $a = int($a) if defined $a;
 927   $p = int($p) if defined $p;
 928
 929   ($self,$a,$p,$r);
 930   }
 931
 932 sub round
 933   {
 934   # Round $self according to given parameters, or given second argument's
 935   # parameters or global defaults
 936
 937   # for speed reasons, _find_round_parameters is embedded here:
 938
 939   my ($self,$a,$p,$r,@args) = @_;
 940   # $a accuracy, if given by caller
 941   # $p precision, if given by caller
 942   # $r round_mode, if given by caller
 943   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 944
 945   my $c = ref($self);                           # find out class of argument(s)
 946   no strict 'refs';
 947
 948   # now pick $a or $p, but only if we have got "arguments"
 949   if (!defined $a)
 950     {
 951     foreach ($self,@args)
 952       {
 953       # take the defined one, or if both defined, the one that is smaller
 954       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
 955       }
 956     }
 957   if (!defined $p)
 958     {
 959     # even if $a is defined, take $p, to signal error for both defined
 960     foreach ($self,@args)
 961       {
 962       # take the defined one, or if both defined, the one that is bigger
 963       # -2 > -3, and 3 > 2
 964       $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
 965       }
 966     }
 967   # if still none defined, use globals (#2)
 968   $a = ${"$c\::accuracy"} unless defined $a;
 969   $p = ${"$c\::precision"} unless defined $p;
 970
 971   # A == 0 is useless, so undef it to signal no rounding
 972   $a = undef if defined $a && $a == 0;
 973
 974   # no rounding today?
 975   return $self unless defined $a || defined $p;         # early out
 976
 977   # set A and set P is an fatal error
 978   return $self->bnan() if defined $a && defined $p;
 979
 980   $r = ${"$c\::round_mode"} unless defined $r;
 981   if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
 982     {
 983     require Carp; Carp::croak ("Unknown round mode '$r'");
 984     }
 985
 986   # now round, by calling either fround or ffround:
 987   if (defined $a)
 988     {
 989     $self->bround(int($a),$r) if !defined $self->{_a} || $self->{_a} >= $a;
 990     }
 991   else # both can't be undefined due to early out
 992     {
 993     $self->bfround(int($p),$r) if !defined $self->{_p} || $self->{_p} <= $p;
 994     }
 995   # bround() or bfround() already called bnorm() if nec.
 996   $self;
 997   }
 998
 999 sub bnorm
1000   {
1001   # (numstr or BINT) return BINT
1002   # Normalize number -- no-op here
1003   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1004   $x;
1005   }
1006
1007 sub babs
1008   {
1009   # (BINT or num_str) return BINT
1010   # make number absolute, or return absolute BINT from string
1011   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1012
1013   return $x if $x->modify('babs');
1014   # post-normalized abs for internal use (does nothing for NaN)
1015   $x->{sign} =~ s/^-/+/;
1016   $x;
1017   }
1018
1019 sub bsgn {
1020     # Signum function.
1021
1022     my $self = shift;
1023
1024     return $self if $self->modify('bsgn');
1025
1026     return $self -> bone("+") if $self -> is_pos();
1027     return $self -> bone("-") if $self -> is_neg();
1028     return $self;               # zero or NaN
1029 }
1030
1031 sub bneg
1032   {
1033   # (BINT or num_str) return BINT
1034   # negate number or make a negated number from string
1035   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1036
1037   return $x if $x->modify('bneg');
1038
1039   # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
1040   $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
1041   $x;
1042   }
1043
1044 sub bcmp
1045   {
1046   # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
1047   # (BINT or num_str, BINT or num_str) return cond_code
1048
1049   # set up parameters
1050   my ($self,$x,$y) = (ref($_[0]),@_);
1051
1052   # objectify is costly, so avoid it
1053   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1054     {
1055     ($self,$x,$y) = objectify(2,@_);
1056     }
1057
1058   return $upgrade->bcmp($x,$y) if defined $upgrade &&
1059     ((!$x->isa($self)) || (!$y->isa($self)));
1060
1061   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1062     {
1063     # handle +-inf and NaN
1064     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1065     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1066     return +1 if $x->{sign} eq '+inf';
1067     return -1 if $x->{sign} eq '-inf';
1068     return -1 if $y->{sign} eq '+inf';
1069     return +1;
1070     }
1071   # check sign for speed first
1072   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
1073   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
1074
1075   # have same sign, so compare absolute values. Don't make tests for zero here
1076   # because it's actually slower than testing in Calc (especially w/ Pari et al)
1077
1078   # post-normalized compare for internal use (honors signs)
1079   if ($x->{sign} eq '+')
1080     {
1081     # $x and $y both > 0
1082     return $CALC->_acmp($x->{value},$y->{value});
1083     }
1084
1085   # $x && $y both < 0
1086   $CALC->_acmp($y->{value},$x->{value});        # swapped acmp (lib returns 0,1,-1)
1087   }
1088
1089 sub bacmp
1090   {
1091   # Compares 2 values, ignoring their signs.
1092   # Returns one of undef, <0, =0, >0. (suitable for sort)
1093   # (BINT, BINT) return cond_code
1094
1095   # set up parameters
1096   my ($self,$x,$y) = (ref($_[0]),@_);
1097   # objectify is costly, so avoid it
1098   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1099     {
1100     ($self,$x,$y) = objectify(2,@_);
1101     }
1102
1103   return $upgrade->bacmp($x,$y) if defined $upgrade &&
1104     ((!$x->isa($self)) || (!$y->isa($self)));
1105
1106   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1107     {
1108     # handle +-inf and NaN
1109     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1110     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1111     return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1112     return -1;
1113     }
1114   $CALC->_acmp($x->{value},$y->{value});        # lib does only 0,1,-1
1115   }
1116
1117 sub badd
1118   {
1119   # add second arg (BINT or string) to first (BINT) (modifies first)
1120   # return result as BINT
1121
1122   # set up parameters
1123   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1124   # objectify is costly, so avoid it
1125   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1126     {
1127     ($self,$x,$y,@r) = objectify(2,@_);
1128     }
1129
1130   return $x if $x->modify('badd');
1131   return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
1132     ((!$x->isa($self)) || (!$y->isa($self)));
1133
1134   $r[3] = $y;                           # no push!
1135   # inf and NaN handling
1136   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1137     {
1138     # NaN first
1139     return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1140     # inf handling
1141     if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1142       {
1143       # +inf++inf or -inf+-inf => same, rest is NaN
1144       return $x if $x->{sign} eq $y->{sign};
1145       return $x->bnan();
1146       }
1147     # +-inf + something => +inf
1148     # something +-inf => +-inf
1149     $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
1150     return $x;
1151     }
1152
1153   my ($sx, $sy) = ( $x->{sign}, $y->{sign} );           # get signs
1154
1155   if ($sx eq $sy)
1156     {
1157     $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
1158     }
1159   else
1160     {
1161     my $a = $CALC->_acmp ($y->{value},$x->{value});     # absolute compare
1162     if ($a > 0)
1163       {
1164       $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
1165       $x->{sign} = $sy;
1166       }
1167     elsif ($a == 0)
1168       {
1169       # speedup, if equal, set result to 0
1170       $x->{value} = $CALC->_zero();
1171       $x->{sign} = '+';
1172       }
1173     else # a < 0
1174       {
1175       $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
1176       }
1177     }
1178   $x->round(@r);
1179   }
1180
1181 sub bsub
1182   {
1183   # (BINT or num_str, BINT or num_str) return BINT
1184   # subtract second arg from first, modify first
1185
1186   # set up parameters
1187   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1188
1189   # objectify is costly, so avoid it
1190   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1191     {
1192     ($self,$x,$y,@r) = objectify(2,@_);
1193     }
1194
1195   return $x if $x->modify('bsub');
1196
1197   return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
1198    ((!$x->isa($self)) || (!$y->isa($self)));
1199
1200   return $x->round(@r) if $y->is_zero();
1201
1202   # To correctly handle the lone special case $x->bsub($x), we note the sign
1203   # of $x, then flip the sign from $y, and if the sign of $x did change, too,
1204   # then we caught the special case:
1205   my $xsign = $x->{sign};
1206   $y->{sign} =~ tr/+\-/-+/;     # does nothing for NaN
1207   if ($xsign ne $x->{sign})
1208     {
1209     # special case of $x->bsub($x) results in 0
1210     return $x->bzero(@r) if $xsign =~ /^[+-]$/;
1211     return $x->bnan();          # NaN, -inf, +inf
1212     }
1213   $x->badd($y,@r);              # badd does not leave internal zeros
1214   $y->{sign} =~ tr/+\-/-+/;     # refix $y (does nothing for NaN)
1215   $x;                           # already rounded by badd() or no round nec.
1216   }
1217
1218 sub binc
1219   {
1220   # increment arg by one
1221   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1222   return $x if $x->modify('binc');
1223
1224   if ($x->{sign} eq '+')
1225     {
1226     $x->{value} = $CALC->_inc($x->{value});
1227     return $x->round($a,$p,$r);
1228     }
1229   elsif ($x->{sign} eq '-')
1230     {
1231     $x->{value} = $CALC->_dec($x->{value});
1232     $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1233     return $x->round($a,$p,$r);
1234     }
1235   # inf, nan handling etc
1236   $x->badd($self->bone(),$a,$p,$r);             # badd does round
1237   }
1238
1239 sub bdec
1240   {
1241   # decrement arg by one
1242   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1243   return $x if $x->modify('bdec');
1244
1245   if ($x->{sign} eq '-')
1246     {
1247     # x already < 0
1248     $x->{value} = $CALC->_inc($x->{value});
1249     }
1250   else
1251     {
1252     return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+';      # inf or NaN
1253     # >= 0
1254     if ($CALC->_is_zero($x->{value}))
1255       {
1256       # == 0
1257       $x->{value} = $CALC->_one(); $x->{sign} = '-';            # 0 => -1
1258       }
1259     else
1260       {
1261       # > 0
1262       $x->{value} = $CALC->_dec($x->{value});
1263       }
1264     }
1265   $x->round(@r);
1266   }
1267
1268 sub blog
1269   {
1270   # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base
1271   # $base of $x)
1272
1273   # set up parameters
1274   my ($self,$x,$base,@r) = (undef,@_);
1275   # objectify is costly, so avoid it
1276   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1277     {
1278     ($self,$x,$base,@r) = objectify(2,@_);
1279     }
1280
1281   return $x if $x->modify('blog');
1282
1283   $base = $self->new($base) if defined $base && !ref $base;
1284
1285   # inf, -inf, NaN, <0 => NaN
1286   return $x->bnan()
1287    if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
1288
1289   return $upgrade->blog($upgrade->new($x),$base,@r) if
1290     defined $upgrade;
1291
1292   # fix for bug #24969:
1293   # the default base is e (Euler's number) which is not an integer
1294   if (!defined $base)
1295     {
1296     require Math::BigFloat;
1297     my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
1298     # modify $x in place
1299     $x->{value} = $u->{value};
1300     $x->{sign} = $u->{sign};
1301     return $x;
1302     }
1303
1304   my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
1305   return $x->bnan() unless defined $rc;         # not possible to take log?
1306   $x->{value} = $rc;
1307   $x->round(@r);
1308   }
1309
1310 sub bnok
1311   {
1312   # Calculate n over k (binomial coefficient or "choose" function) as integer.
1313   # set up parameters
1314   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1315
1316   # objectify is costly, so avoid it
1317   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1318     {
1319     ($self,$x,$y,@r) = objectify(2,@_);
1320     }
1321
1322   return $x if $x->modify('bnok');
1323   return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
1324   return $x->binf() if $x->{sign} eq '+inf';
1325
1326   # k > n or k < 0 => 0
1327   my $cmp = $x->bacmp($y);
1328   return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/;
1329   # k == n => 1
1330   return $x->bone(@r) if $cmp == 0;
1331
1332   if ($CALC->can('_nok'))
1333     {
1334     $x->{value} = $CALC->_nok($x->{value},$y->{value});
1335     }
1336   else
1337     {
1338     # ( 7 )       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
1339     # ( - ) = --------- =  --------------- = --------- = 5 * - * -
1340     # ( 3 )   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3
1341
1342     if (!$y->is_zero())
1343       {
1344       my $z = $x - $y;
1345       $z->binc();
1346       my $r = $z->copy(); $z->binc();
1347       my $d = $self->new(2);
1348       while ($z->bacmp($x) <= 0)                # f <= x ?
1349         {
1350         $r->bmul($z); $r->bdiv($d);
1351         $z->binc(); $d->binc();
1352         }
1353       $x->{value} = $r->{value}; $x->{sign} = '+';
1354       }
1355     else { $x->bone(); }
1356     }
1357   $x->round(@r);
1358   }
1359
1360 sub bexp
1361   {
1362   # Calculate e ** $x (Euler's number to the power of X), truncated to
1363   # an integer value.
1364   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1365   return $x if $x->modify('bexp');
1366
1367   # inf, -inf, NaN, <0 => NaN
1368   return $x->bnan() if $x->{sign} eq 'NaN';
1369   return $x->bone() if $x->is_zero();
1370   return $x if $x->{sign} eq '+inf';
1371   return $x->bzero() if $x->{sign} eq '-inf';
1372
1373   my $u;
1374   {
1375     # run through Math::BigFloat unless told otherwise
1376     require Math::BigFloat unless defined $upgrade;
1377     local $upgrade = 'Math::BigFloat' unless defined $upgrade;
1378     # calculate result, truncate it to integer
1379     $u = $upgrade->bexp($upgrade->new($x),@r);
1380   }
1381
1382   if (!defined $upgrade)
1383     {
1384     $u = $u->as_int();
1385     # modify $x in place
1386     $x->{value} = $u->{value};
1387     $x->round(@r);
1388     }
1389   else { $x = $u; }
1390   }
1391
1392 sub blcm
1393   {
1394   # (BINT or num_str, BINT or num_str) return BINT
1395   # does not modify arguments, but returns new object
1396   # Lowest Common Multiple
1397
1398   my $y = shift; my ($x);
1399   if (ref($y))
1400     {
1401     $x = $y->copy();
1402     }
1403   else
1404     {
1405     $x = $class->new($y);
1406     }
1407   my $self = ref($x);
1408   while (@_)
1409     {
1410     my $y = shift; $y = $self->new($y) if !ref ($y);
1411     $x = __lcm($x,$y);
1412     }
1413   $x;
1414   }
1415
1416 sub bgcd
1417   {
1418   # (BINT or num_str, BINT or num_str) return BINT
1419   # does not modify arguments, but returns new object
1420   # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)
1421
1422   my $y = shift;
1423   $y = $class->new($y) if !ref($y);
1424   my $self = ref($y);
1425   my $x = $y->copy()->babs();                   # keep arguments
1426   return $x->bnan() if $x->{sign} !~ /^[+-]$/;  # x NaN?
1427
1428   while (@_)
1429     {
1430     $y = shift; $y = $self->new($y) if !ref($y);
1431     return $x->bnan() if $y->{sign} !~ /^[+-]$/;        # y NaN?
1432     $x->{value} = $CALC->_gcd($x->{value},$y->{value});
1433     last if $CALC->_is_one($x->{value});
1434     }
1435   $x;
1436   }
1437
1438 sub bnot
1439   {
1440   # (num_str or BINT) return BINT
1441   # represent ~x as twos-complement number
1442   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1443   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1444
1445   return $x if $x->modify('bnot');
1446   $x->binc()->bneg();                   # binc already does round
1447   }
1448
1449 ##############################################################################
1450 # is_foo test routines
1451 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1452
1453 sub is_zero
1454   {
1455   # return true if arg (BINT or num_str) is zero (array '+', '0')
1456   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1457
1458   return 0 if $x->{sign} !~ /^\+$/;                     # -, NaN & +-inf aren't
1459   $CALC->_is_zero($x->{value});
1460   }
1461
1462 sub is_nan
1463   {
1464   # return true if arg (BINT or num_str) is NaN
1465   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1466
1467   $x->{sign} eq $nan ? 1 : 0;
1468   }
1469
1470 sub is_inf
1471   {
1472   # return true if arg (BINT or num_str) is +-inf
1473   my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1474
1475   if (defined $sign)
1476     {
1477     $sign = '[+-]inf' if $sign eq '';   # +- doesn't matter, only that's inf
1478     $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/;     # extract '+' or '-'
1479     return $x->{sign} =~ /^$sign$/ ? 1 : 0;
1480     }
1481   $x->{sign} =~ /^[+-]inf$/ ? 1 : 0;            # only +-inf is infinity
1482   }
1483
1484 sub is_one
1485   {
1486   # return true if arg (BINT or num_str) is +1, or -1 if sign is given
1487   my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1488
1489   $sign = '+' if !defined $sign || $sign ne '-';
1490
1491   return 0 if $x->{sign} ne $sign;      # -1 != +1, NaN, +-inf aren't either
1492   $CALC->_is_one($x->{value});
1493   }
1494
1495 sub is_odd
1496   {
1497   # return true when arg (BINT or num_str) is odd, false for even
1498   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1499
1500   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
1501   $CALC->_is_odd($x->{value});
1502   }
1503
1504 sub is_even
1505   {
1506   # return true when arg (BINT or num_str) is even, false for odd
1507   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1508
1509   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
1510   $CALC->_is_even($x->{value});
1511   }
1512
1513 sub is_positive
1514   {
1515   # return true when arg (BINT or num_str) is positive (> 0)
1516   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1517
1518   return 1 if $x->{sign} eq '+inf';                     # +inf is positive
1519
1520   # 0+ is neither positive nor negative
1521   ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
1522   }
1523
1524 sub is_negative
1525   {
1526   # return true when arg (BINT or num_str) is negative (< 0)
1527   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1528
1529   $x->{sign} =~ /^-/ ? 1 : 0;           # -inf is negative, but NaN is not
1530   }
1531
1532 sub is_int
1533   {
1534   # return true when arg (BINT or num_str) is an integer
1535   # always true for BigInt, but different for BigFloats
1536   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1537
1538   $x->{sign} =~ /^[+-]$/ ? 1 : 0;               # inf/-inf/NaN aren't
1539   }
1540
1541 ###############################################################################
1542
1543 sub bmul
1544   {
1545   # multiply the first number by the second number
1546   # (BINT or num_str, BINT or num_str) return BINT
1547
1548   # set up parameters
1549   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1550   # objectify is costly, so avoid it
1551   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1552     {
1553     ($self,$x,$y,@r) = objectify(2,@_);
1554     }
1555
1556   return $x if $x->modify('bmul');
1557
1558   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1559
1560   # inf handling
1561   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1562     {
1563     return $x->bnan() if $x->is_zero() || $y->is_zero();
1564     # result will always be +-inf:
1565     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1566     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1567     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1568     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1569     return $x->binf('-');
1570     }
1571
1572   return $upgrade->bmul($x,$upgrade->new($y),@r)
1573    if defined $upgrade && !$y->isa($self);
1574
1575   $r[3] = $y;                           # no push here
1576
1577   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1578
1579   $x->{value} = $CALC->_mul($x->{value},$y->{value});   # do actual math
1580   $x->{sign} = '+' if $CALC->_is_zero($x->{value});     # no -0
1581
1582   $x->round(@r);
1583   }
1584
1585 sub bmuladd
1586   {
1587   # multiply two numbers and then add the third to the result
1588   # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
1589
1590   # set up parameters
1591   my ($self,$x,$y,$z,@r) = objectify(3,@_);
1592
1593   return $x if $x->modify('bmuladd');
1594
1595   return $x->bnan() if  ($x->{sign} eq $nan) ||
1596                         ($y->{sign} eq $nan) ||
1597                         ($z->{sign} eq $nan);
1598
1599   # inf handling of x and y
1600   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1601     {
1602     return $x->bnan() if $x->is_zero() || $y->is_zero();
1603     # result will always be +-inf:
1604     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1605     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1606     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1607     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1608     return $x->binf('-');
1609     }
1610   # inf handling x*y and z
1611   if (($z->{sign} =~ /^[+-]inf$/))
1612     {
1613     # something +-inf => +-inf
1614     $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
1615     }
1616
1617   return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r)
1618    if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self));
1619
1620   # TODO: what if $y and $z have A or P set?
1621   $r[3] = $z;                           # no push here
1622
1623   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1624
1625   $x->{value} = $CALC->_mul($x->{value},$y->{value});   # do actual math
1626   $x->{sign} = '+' if $CALC->_is_zero($x->{value});     # no -0
1627
1628   my ($sx, $sz) = ( $x->{sign}, $z->{sign} );           # get signs
1629
1630   if ($sx eq $sz)
1631     {
1632     $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
1633     }
1634   else
1635     {
1636     my $a = $CALC->_acmp ($z->{value},$x->{value});     # absolute compare
1637     if ($a > 0)
1638       {
1639       $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
1640       $x->{sign} = $sz;
1641       }
1642     elsif ($a == 0)
1643       {
1644       # speedup, if equal, set result to 0
1645       $x->{value} = $CALC->_zero();
1646       $x->{sign} = '+';
1647       }
1648     else # a < 0
1649       {
1650       $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub
1651       }
1652     }
1653   $x->round(@r);
1654   }
1655
1656 sub _div_inf
1657   {
1658   # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1659   my ($self,$x,$y) = @_;
1660
1661   # NaN if x == NaN or y == NaN or x==y==0
1662   return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1663    if (($x->is_nan() || $y->is_nan())   ||
1664        ($x->is_zero() && $y->is_zero()));
1665
1666   # +-inf / +-inf == NaN, remainder also NaN
1667   if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1668     {
1669     return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
1670     }
1671   # x / +-inf => 0, remainder x (works even if x == 0)
1672   if ($y->{sign} =~ /^[+-]inf$/)
1673     {
1674     my $t = $x->copy();         # bzero clobbers up $x
1675     return wantarray ? ($x->bzero(),$t) : $x->bzero()
1676     }
1677
1678   # 5 / 0 => +inf, -6 / 0 => -inf
1679   # +inf / 0 = inf, inf,  and -inf / 0 => -inf, -inf
1680   # exception:   -8 / 0 has remainder -8, not 8
1681   # exception: -inf / 0 has remainder -inf, not inf
1682   if ($y->is_zero())
1683     {
1684     # +-inf / 0 => special case for -inf
1685     return wantarray ?  ($x,$x->copy()) : $x if $x->is_inf();
1686     if (!$x->is_zero() && !$x->is_inf())
1687       {
1688       my $t = $x->copy();               # binf clobbers up $x
1689       return wantarray ?
1690        ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1691       }
1692     }
1693
1694   # last case: +-inf / ordinary number
1695   my $sign = '+inf';
1696   $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1697   $x->{sign} = $sign;
1698   return wantarray ? ($x,$self->bzero()) : $x;
1699   }
1700
1701 sub bdiv
1702   {
1703   # (dividend: BINT or num_str, divisor: BINT or num_str) return
1704   # (BINT,BINT) (quo,rem) or BINT (only rem)
1705
1706   # set up parameters
1707   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1708   # objectify is costly, so avoid it
1709   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1710     {
1711     ($self,$x,$y,@r) = objectify(2,@_);
1712     }
1713
1714   return $x if $x->modify('bdiv');
1715
1716   return $self->_div_inf($x,$y)
1717    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
1718
1719   return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1720    if defined $upgrade;
1721
1722   $r[3] = $y;                                   # no push!
1723
1724   # calc new sign and in case $y == +/- 1, return $x
1725   my $xsign = $x->{sign};                               # keep
1726   $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1727
1728   if (wantarray)
1729     {
1730     my $rem = $self->bzero();
1731     ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1732     $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1733     $rem->{_a} = $x->{_a};
1734     $rem->{_p} = $x->{_p};
1735     $x->round(@r);
1736     if (! $CALC->_is_zero($rem->{value}))
1737       {
1738       $rem->{sign} = $y->{sign};
1739       $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
1740       }
1741     else
1742       {
1743       $rem->{sign} = '+';                       # do not leave -0
1744       }
1745     $rem->round(@r);
1746     return ($x,$rem);
1747     }
1748
1749   $x->{value} = $CALC->_div($x->{value},$y->{value});
1750   $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1751
1752   $x->round(@r);
1753   }
1754
1755 ###############################################################################
1756 # modulus functions
1757
1758 sub bmod
1759   {
1760   # modulus (or remainder)
1761   # (BINT or num_str, BINT or num_str) return BINT
1762
1763   # set up parameters
1764   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1765   # objectify is costly, so avoid it
1766   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1767     {
1768     ($self,$x,$y,@r) = objectify(2,@_);
1769     }
1770
1771   return $x if $x->modify('bmod');
1772   $r[3] = $y;                                   # no push!
1773   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1774     {
1775     my ($d,$r) = $self->_div_inf($x,$y);
1776     $x->{sign} = $r->{sign};
1777     $x->{value} = $r->{value};
1778     return $x->round(@r);
1779     }
1780
1781   # calc new sign and in case $y == +/- 1, return $x
1782   $x->{value} = $CALC->_mod($x->{value},$y->{value});
1783   if (!$CALC->_is_zero($x->{value}))
1784     {
1785     $x->{value} = $CALC->_sub($y->{value},$x->{value},1)        # $y-$x
1786       if ($x->{sign} ne $y->{sign});
1787     $x->{sign} = $y->{sign};
1788     }
1789    else
1790     {
1791     $x->{sign} = '+';                           # do not leave -0
1792     }
1793   $x->round(@r);
1794   }
1795
1796 sub bmodinv
1797   {
1798   # Return modular multiplicative inverse: z is the modular inverse of x (mod
1799   # y) if and only if x*z (mod y) = 1 (mod y). If the modulus y is larger than
1800   # one, x and z are relative primes (i.e., their greatest common divisor is
1801   # one).
1802   #
1803   # If no modular multiplicative inverse exists, NaN is returned.
1804
1805   # set up parameters
1806   my ($self,$x,$y,@r) = (undef,@_);
1807   # objectify is costly, so avoid it
1808   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1809     {
1810     ($self,$x,$y,@r) = objectify(2,@_);
1811     }
1812
1813   return $x if $x->modify('bmodinv');
1814
1815   # Return NaN if one or both arguments is +inf, -inf, or nan.
1816
1817   return $x->bnan() if ($y->{sign} !~ /^[+-]$/ ||
1818                         $x->{sign} !~ /^[+-]$/);
1819
1820   # Return NaN if $y is zero; 1 % 0 makes no sense.
1821
1822   return $x->bnan() if $y->is_zero();
1823
1824   # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite
1825   # integers $x.
1826
1827   return $x->bzero() if ($y->is_one() ||
1828                          $y->is_one('-'));
1829
1830   # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when
1831   # $x = 0 is when $y = 1 or $y = -1, but that was covered above.
1832   #
1833   # Note that computing $x modulo $y here affects the value we'll feed to
1834   # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x =
1835   # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and
1836   # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7.
1837   # The value if $x is affected only when $x and $y have opposite signs.
1838
1839   $x->bmod($y);
1840   return $x->bnan() if $x->is_zero();
1841
1842   # Compute the modular multiplicative inverse of the absolute values. We'll
1843   # correct for the signs of $x and $y later. Return NaN if no GCD is found.
1844
1845   ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value});
1846   return $x->bnan() if !defined $x->{value};
1847
1848   # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions
1849   # <= 1.32 return undef rather than a "+" for the sign.
1850
1851   $x->{sign} = '+' unless defined $x->{sign};
1852
1853   # When one or both arguments are negative, we have the following
1854   # relations.  If x and y are positive:
1855   #
1856   #   modinv(-x, -y) = -modinv(x, y)
1857   #   modinv(-x,  y) = y - modinv(x, y)  = -modinv(x, y) (mod y)
1858   #   modinv( x, -y) = modinv(x, y) - y  =  modinv(x, y) (mod -y)
1859
1860   # We must swap the sign of the result if the original $x is negative.
1861   # However, we must compensate for ignoring the signs when computing the
1862   # inverse modulo. The net effect is that we must swap the sign of the
1863   # result if $y is negative.
1864
1865   $x -> bneg() if $y->{sign} eq '-';
1866
1867   # Compute $x modulo $y again after correcting the sign.
1868
1869   $x -> bmod($y) if $x->{sign} ne $y->{sign};
1870
1871   return $x;
1872   }
1873
1874 sub bmodpow
1875   {
1876   # Modular exponentiation. Raises a very large number to a very large exponent
1877   # in a given very large modulus quickly, thanks to binary exponentiation.
1878   # Supports negative exponents.
1879   my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
1880
1881   return $num if $num->modify('bmodpow');
1882
1883   # When the exponent 'e' is negative, use the following relation, which is
1884   # based on finding the multiplicative inverse 'd' of 'b' modulo 'm':
1885   #
1886   #    b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m)
1887
1888   $num->bmodinv($mod) if ($exp->{sign} eq '-');
1889
1890   # Check for valid input. All operands must be finite, and the modulus must be
1891   # non-zero.
1892
1893   return $num->bnan() if ($num->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
1894                           $exp->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
1895                           $mod->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
1896                           $mod->is_zero());
1897
1898   # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
1899   # value is zero, the output is also zero, regardless of the signs on 'a' and
1900   # 'm'.
1901
1902   my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value});
1903   my $sign  = '+';
1904
1905   # If the resulting value is non-zero, we have four special cases, depending
1906   # on the signs on 'a' and 'm'.
1907
1908   unless ($CALC->_is_zero($value)) {
1909
1910       # There is a negative sign on 'a' (= $num**$exp) only if the number we
1911       # are exponentiating ($num) is negative and the exponent ($exp) is odd.
1912
1913       if ($num->{sign} eq '-' && $exp->is_odd()) {
1914
1915           # When both the number 'a' and the modulus 'm' have a negative sign,
1916           # use this relation:
1917           #
1918           #    -a (mod -m) = -(a (mod m))
1919
1920           if ($mod->{sign} eq '-') {
1921               $sign = '-';
1922           }
1923
1924           # When only the number 'a' has a negative sign, use this relation:
1925           #
1926           #    -a (mod m) = m - (a (mod m))
1927
1928           else {
1929               # Use copy of $mod since _sub() modifies the first argument.
1930               my $mod = $CALC->_copy($mod->{value});
1931               $value = $CALC->_sub($mod, $value);
1932               $sign  = '+';
1933           }
1934
1935       } else {
1936
1937           # When only the modulus 'm' has a negative sign, use this relation:
1938           #
1939           #    a (mod -m) = (a (mod m)) - m
1940           #               = -(m - (a (mod m)))
1941
1942           if ($mod->{sign} eq '-') {
1943               # Use copy of $mod since _sub() modifies the first argument.
1944               my $mod = $CALC->_copy($mod->{value});
1945               $value = $CALC->_sub($mod, $value);
1946               $sign  = '-';
1947           }
1948
1949           # When neither the number 'a' nor the modulus 'm' have a negative
1950           # sign, directly return the already computed value.
1951           #
1952           #    (a (mod m))
1953
1954       }
1955
1956   }
1957
1958   $num->{value} = $value;
1959   $num->{sign}  = $sign;
1960
1961   return $num;
1962   }
1963
1964 ###############################################################################
1965
1966 sub bfac
1967   {
1968   # (BINT or num_str, BINT or num_str) return BINT
1969   # compute factorial number from $x, modify $x in place
1970   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1971
1972   return $x if $x->modify('bfac') || $x->{sign} eq '+inf';      # inf => inf
1973   return $x->bnan() if $x->{sign} ne '+';                       # NaN, <0 etc => NaN
1974
1975   $x->{value} = $CALC->_fac($x->{value});
1976   $x->round(@r);
1977   }
1978
1979 sub bpow
1980   {
1981   # (BINT or num_str, BINT or num_str) return BINT
1982   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1983   # modifies first argument
1984
1985   # set up parameters
1986   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1987   # objectify is costly, so avoid it
1988   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1989     {
1990     ($self,$x,$y,@r) = objectify(2,@_);
1991     }
1992
1993   return $x if $x->modify('bpow');
1994
1995   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1996
1997   # inf handling
1998   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1999     {
2000     if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
2001       {
2002       # +-inf ** +-inf
2003       return $x->bnan();
2004       }
2005     # +-inf ** Y
2006     if ($x->{sign} =~ /^[+-]inf/)
2007       {
2008       # +inf ** 0 => NaN
2009       return $x->bnan() if $y->is_zero();
2010       # -inf ** -1 => 1/inf => 0
2011       return $x->bzero() if $y->is_one('-') && $x->is_negative();
2012
2013       # +inf ** Y => inf
2014       return $x if $x->{sign} eq '+inf';
2015
2016       # -inf ** Y => -inf if Y is odd
2017       return $x if $y->is_odd();
2018       return $x->babs();
2019       }
2020     # X ** +-inf
2021
2022     # 1 ** +inf => 1
2023     return $x if $x->is_one();
2024
2025     # 0 ** inf => 0
2026     return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;
2027
2028     # 0 ** -inf => inf
2029     return $x->binf() if $x->is_zero();
2030
2031     # -1 ** -inf => NaN
2032     return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;
2033
2034     # -X ** -inf => 0
2035     return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;
2036
2037     # -1 ** inf => NaN
2038     return $x->bnan() if $x->{sign} eq '-';
2039
2040     # X ** inf => inf
2041     return $x->binf() if $y->{sign} =~ /^[+]/;
2042     # X ** -inf => 0
2043     return $x->bzero();
2044     }
2045
2046   return $upgrade->bpow($upgrade->new($x),$y,@r)
2047    if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-');
2048
2049   $r[3] = $y;                                   # no push!
2050
2051   # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
2052
2053   my $new_sign = '+';
2054   $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
2055
2056   # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
2057   return $x->binf()
2058     if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
2059   # 1 ** -y => 1 / (1 ** |y|)
2060   # so do test for negative $y after above's clause
2061   return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
2062
2063   $x->{value} = $CALC->_pow($x->{value},$y->{value});
2064   $x->{sign} = $new_sign;
2065   $x->{sign} = '+' if $CALC->_is_zero($y->{value});
2066   $x->round(@r);
2067   }
2068
2069 sub blsft
2070   {
2071   # (BINT or num_str, BINT or num_str) return BINT
2072   # compute x << y, base n, y >= 0
2073
2074   # set up parameters
2075   my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
2076   # objectify is costly, so avoid it
2077   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2078     {
2079     ($self,$x,$y,$n,@r) = objectify(2,@_);
2080     }
2081
2082   return $x if $x->modify('blsft');
2083   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
2084   return $x->round(@r) if $y->is_zero();
2085
2086   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
2087
2088   $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n);
2089   $x->round(@r);
2090   }
2091
2092 sub brsft
2093   {
2094   # (BINT or num_str, BINT or num_str) return BINT
2095   # compute x >> y, base n, y >= 0
2096
2097   # set up parameters
2098   my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
2099   # objectify is costly, so avoid it
2100   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2101     {
2102     ($self,$x,$y,$n,@r) = objectify(2,@_);
2103     }
2104
2105   return $x if $x->modify('brsft');
2106   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
2107   return $x->round(@r) if $y->is_zero();
2108   return $x->bzero(@r) if $x->is_zero();                # 0 => 0
2109
2110   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
2111
2112    # this only works for negative numbers when shifting in base 2
2113   if (($x->{sign} eq '-') && ($n == 2))
2114     {
2115     return $x->round(@r) if $x->is_one('-');    # -1 => -1
2116     if (!$y->is_one())
2117       {
2118       # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
2119       # but perhaps there is a better emulation for two's complement shift...
2120       # if $y != 1, we must simulate it by doing:
2121       # convert to bin, flip all bits, shift, and be done
2122       $x->binc();                       # -3 => -2
2123       my $bin = $x->as_bin();
2124       $bin =~ s/^-0b//;                 # strip '-0b' prefix
2125       $bin =~ tr/10/01/;                # flip bits
2126       # now shift
2127       if ($y >= CORE::length($bin))
2128         {
2129         $bin = '0';                     # shifting to far right creates -1
2130                                         # 0, because later increment makes
2131                                         # that 1, attached '-' makes it '-1'
2132                                         # because -1 >> x == -1 !
2133         }
2134       else
2135         {
2136         $bin =~ s/.{$y}$//;             # cut off at the right side
2137         $bin = '1' . $bin;              # extend left side by one dummy '1'
2138         $bin =~ tr/10/01/;              # flip bits back
2139         }
2140       my $res = $self->new('0b'.$bin);  # add prefix and convert back
2141       $res->binc();                     # remember to increment
2142       $x->{value} = $res->{value};      # take over value
2143       return $x->round(@r);             # we are done now, magic, isn't?
2144       }
2145     # x < 0, n == 2, y == 1
2146     $x->bdec();                         # n == 2, but $y == 1: this fixes it
2147     }
2148
2149   $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
2150   $x->round(@r);
2151   }
2152
2153 sub band
2154   {
2155   #(BINT or num_str, BINT or num_str) return BINT
2156   # compute x & y
2157
2158   # set up parameters
2159   my ($self,$x,$y,@r) = (ref($_[0]),@_);
2160   # objectify is costly, so avoid it
2161   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2162     {
2163     ($self,$x,$y,@r) = objectify(2,@_);
2164     }
2165
2166   return $x if $x->modify('band');
2167
2168   $r[3] = $y;                           # no push!
2169
2170   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
2171
2172   my $sx = $x->{sign} eq '+' ? 1 : -1;
2173   my $sy = $y->{sign} eq '+' ? 1 : -1;
2174
2175   if ($sx == 1 && $sy == 1)
2176     {
2177     $x->{value} = $CALC->_and($x->{value},$y->{value});
2178     return $x->round(@r);
2179     }
2180
2181   if ($CAN{signed_and})
2182     {
2183     $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
2184     return $x->round(@r);
2185     }
2186
2187   require $EMU_LIB;
2188   __emu_band($self,$x,$y,$sx,$sy,@r);
2189   }
2190
2191 sub bior
2192   {
2193   #(BINT or num_str, BINT or num_str) return BINT
2194   # compute x | y
2195
2196   # set up parameters
2197   my ($self,$x,$y,@r) = (ref($_[0]),@_);
2198   # objectify is costly, so avoid it
2199   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2200     {
2201     ($self,$x,$y,@r) = objectify(2,@_);
2202     }
2203
2204   return $x if $x->modify('bior');
2205   $r[3] = $y;                           # no push!
2206
2207   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
2208
2209   my $sx = $x->{sign} eq '+' ? 1 : -1;
2210   my $sy = $y->{sign} eq '+' ? 1 : -1;
2211
2212   # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
2213
2214   # don't use lib for negative values
2215   if ($sx == 1 && $sy == 1)
2216     {
2217     $x->{value} = $CALC->_or($x->{value},$y->{value});
2218     return $x->round(@r);
2219     }
2220
2221   # if lib can do negative values, let it handle this
2222   if ($CAN{signed_or})
2223     {
2224     $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
2225     return $x->round(@r);
2226     }
2227
2228   require $EMU_LIB;
2229   __emu_bior($self,$x,$y,$sx,$sy,@r);
2230   }
2231
2232 sub bxor
2233   {
2234   #(BINT or num_str, BINT or num_str) return BINT
2235   # compute x ^ y
2236
2237   # set up parameters
2238   my ($self,$x,$y,@r) = (ref($_[0]),@_);
2239   # objectify is costly, so avoid it
2240   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2241     {
2242     ($self,$x,$y,@r) = objectify(2,@_);
2243     }
2244
2245   return $x if $x->modify('bxor');
2246   $r[3] = $y;                           # no push!
2247
2248   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
2249
2250   my $sx = $x->{sign} eq '+' ? 1 : -1;
2251   my $sy = $y->{sign} eq '+' ? 1 : -1;
2252
2253   # don't use lib for negative values
2254   if ($sx == 1 && $sy == 1)
2255     {
2256     $x->{value} = $CALC->_xor($x->{value},$y->{value});
2257     return $x->round(@r);
2258     }
2259
2260   # if lib can do negative values, let it handle this
2261   if ($CAN{signed_xor})
2262     {
2263     $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
2264     return $x->round(@r);
2265     }
2266
2267   require $EMU_LIB;
2268   __emu_bxor($self,$x,$y,$sx,$sy,@r);
2269   }
2270
2271 sub length
2272   {
2273   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
2274
2275   my $e = $CALC->_len($x->{value});
2276   wantarray ? ($e,0) : $e;
2277   }
2278
2279 sub digit
2280   {
2281   # return the nth decimal digit, negative values count backward, 0 is right
2282   my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2283
2284   $n = $n->numify() if ref($n);
2285   $CALC->_digit($x->{value},$n||0);
2286   }
2287
2288 sub _trailing_zeros
2289   {
2290   # return the amount of trailing zeros in $x (as scalar)
2291   my $x = shift;
2292   $x = $class->new($x) unless ref $x;
2293
2294   return 0 if $x->{sign} !~ /^[+-]$/;   # NaN, inf, -inf etc
2295
2296   $CALC->_zeros($x->{value});           # must handle odd values, 0 etc
2297   }
2298
2299 sub bsqrt
2300   {
2301   # calculate square root of $x
2302   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2303
2304   return $x if $x->modify('bsqrt');
2305
2306   return $x->bnan() if $x->{sign} !~ /^\+/;     # -x or -inf or NaN => NaN
2307   return $x if $x->{sign} eq '+inf';            # sqrt(+inf) == inf
2308
2309   return $upgrade->bsqrt($x,@r) if defined $upgrade;
2310
2311   $x->{value} = $CALC->_sqrt($x->{value});
2312   $x->round(@r);
2313   }
2314
2315 sub broot
2316   {
2317   # calculate $y'th root of $x
2318
2319   # set up parameters
2320   my ($self,$x,$y,@r) = (ref($_[0]),@_);
2321
2322   $y = $self->new(2) unless defined $y;
2323
2324   # objectify is costly, so avoid it
2325   if ((!ref($x)) || (ref($x) ne ref($y)))
2326     {
2327     ($self,$x,$y,@r) = objectify(2,$self || $class,@_);
2328     }
2329
2330   return $x if $x->modify('broot');
2331
2332   # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
2333   return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
2334          $y->{sign} !~ /^\+$/;
2335
2336   return $x->round(@r)
2337     if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
2338
2339   return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
2340
2341   $x->{value} = $CALC->_root($x->{value},$y->{value});
2342   $x->round(@r);
2343   }
2344
2345 sub exponent
2346   {
2347   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
2348   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
2349
2350   if ($x->{sign} !~ /^[+-]$/)
2351     {
2352     my $s = $x->{sign}; $s =~ s/^[+-]//;  # NaN, -inf,+inf => NaN or inf
2353     return $self->new($s);
2354     }
2355   return $self->bone() if $x->is_zero();
2356
2357   # 12300 => 2 trailing zeros => exponent is 2
2358   $self->new( $CALC->_zeros($x->{value}) );
2359   }
2360
2361 sub mantissa
2362   {
2363   # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
2364   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
2365
2366   if ($x->{sign} !~ /^[+-]$/)
2367     {
2368     # for NaN, +inf, -inf: keep the sign
2369     return $self->new($x->{sign});
2370     }
2371   my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};
2372
2373   # that's a bit inefficient:
2374   my $zeros = $CALC->_zeros($m->{value});
2375   $m->brsft($zeros,10) if $zeros != 0;
2376   $m;
2377   }
2378
2379 sub parts
2380   {
2381   # return a copy of both the exponent and the mantissa
2382   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
2383
2384   ($x->mantissa(),$x->exponent());
2385   }
2386
2387 ##############################################################################
2388 # rounding functions
2389
2390 sub bfround
2391   {
2392   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
2393   # $n == 0 || $n == 1 => round to integer
2394   my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
2395
2396   my ($scale,$mode) = $x->_scale_p(@_);
2397
2398   return $x if !defined $scale || $x->modify('bfround');        # no-op
2399
2400   # no-op for BigInts if $n <= 0
2401   $x->bround( $x->length()-$scale, $mode) if $scale > 0;
2402
2403   delete $x->{_a};      # delete to save memory
2404   $x->{_p} = $scale;    # store new _p
2405   $x;
2406   }
2407
2408 sub _scan_for_nonzero
2409   {
2410   # internal, used by bround() to scan for non-zeros after a '5'
2411   my ($x,$pad,$xs,$len) = @_;
2412
2413   return 0 if $len == 1;                # "5" is trailed by invisible zeros
2414   my $follow = $pad - 1;
2415   return 0 if $follow > $len || $follow < 1;
2416
2417   # use the string form to check whether only '0's follow or not
2418   substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0;
2419   }
2420
2421 sub fround
2422   {
2423   # Exists to make life easier for switch between MBF and MBI (should we
2424   # autoload fxxx() like MBF does for bxxx()?)
2425   my $x = shift; $x = $class->new($x) unless ref $x;
2426   $x->bround(@_);
2427   }
2428
2429 sub bround
2430   {
2431   # accuracy: +$n preserve $n digits from left,
2432   #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
2433   # no-op for $n == 0
2434   # and overwrite the rest with 0's, return normalized number
2435   # do not return $x->bnorm(), but $x
2436
2437   my $x = shift; $x = $class->new($x) unless ref $x;
2438   my ($scale,$mode) = $x->_scale_a(@_);
2439   return $x if !defined $scale || $x->modify('bround'); # no-op
2440
2441   if ($x->is_zero() || $scale == 0)
2442     {
2443     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2444     return $x;
2445     }
2446   return $x if $x->{sign} !~ /^[+-]$/;          # inf, NaN
2447
2448   # we have fewer digits than we want to scale to
2449   my $len = $x->length();
2450   # convert $scale to a scalar in case it is an object (put's a limit on the
2451   # number length, but this would already limited by memory constraints), makes
2452   # it faster
2453   $scale = $scale->numify() if ref ($scale);
2454
2455   # scale < 0, but > -len (not >=!)
2456   if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
2457     {
2458     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2459     return $x;
2460     }
2461
2462   # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
2463   my ($pad,$digit_round,$digit_after);
2464   $pad = $len - $scale;
2465   $pad = abs($scale-1) if $scale < 0;
2466
2467   # do not use digit(), it is very costly for binary => decimal
2468   # getting the entire string is also costly, but we need to do it only once
2469   my $xs = $CALC->_str($x->{value});
2470   my $pl = -$pad-1;
2471
2472   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
2473   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
2474   $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
2475   $pl++; $pl ++ if $pad >= $len;
2476   $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;
2477
2478   # in case of 01234 we round down, for 6789 up, and only in case 5 we look
2479   # closer at the remaining digits of the original $x, remember decision
2480   my $round_up = 1;                                     # default round up
2481   $round_up -- if
2482     ($mode eq 'trunc')                          ||      # trunc by round down
2483     ($digit_after =~ /[01234]/)                 ||      # round down anyway,
2484                                                         # 6789 => round up
2485     ($digit_after eq '5')                       &&      # not 5000...0000
2486     ($x->_scan_for_nonzero($pad,$xs,$len) == 0)         &&
2487     (
2488      ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
2489      ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
2490      ($mode eq '+inf') && ($x->{sign} eq '-')   ||
2491      ($mode eq '-inf') && ($x->{sign} eq '+')   ||
2492      ($mode eq 'zero')          # round down if zero, sign adjusted below
2493     );
2494   my $put_back = 0;                                     # not yet modified
2495
2496   if (($pad > 0) && ($pad <= $len))
2497     {
2498     substr($xs,-$pad,$pad) = '0' x $pad;                # replace with '00...'
2499     $put_back = 1;                                      # need to put back
2500     }
2501   elsif ($pad > $len)
2502     {
2503     $x->bzero();                                        # round to '0'
2504     }
2505
2506   if ($round_up)                                        # what gave test above?
2507     {
2508     $put_back = 1;                                      # need to put back
2509     $pad = $len, $xs = '0' x $pad if $scale < 0;        # tlr: whack 0.51=>1.0
2510
2511     # we modify directly the string variant instead of creating a number and
2512     # adding it, since that is faster (we already have the string)
2513     my $c = 0; $pad ++;                         # for $pad == $len case
2514     while ($pad <= $len)
2515       {
2516       $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
2517       substr($xs,-$pad,1) = $c; $pad++;
2518       last if $c != 0;                          # no overflow => early out
2519       }
2520     $xs = '1'.$xs if $c == 0;
2521
2522     }
2523   $x->{value} = $CALC->_new($xs) if $put_back == 1;     # put back, if needed
2524
2525   $x->{_a} = $scale if $scale >= 0;
2526   if ($scale < 0)
2527     {
2528     $x->{_a} = $len+$scale;
2529     $x->{_a} = 0 if $scale < -$len;
2530     }
2531   $x;
2532   }
2533
2534 sub bfloor
2535   {
2536   # round towards minus infinity; no-op since it's already integer
2537   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2538
2539   $x->round(@r);
2540   }
2541
2542 sub bceil
2543   {
2544   # round towards plus infinity; no-op since it's already int
2545   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2546
2547   $x->round(@r);
2548   }
2549
2550 sub bint {
2551     # round towards zero; no-op since it's already integer
2552     my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2553
2554     $x->round(@r);
2555 }
2556
2557 sub as_number
2558   {
2559   # An object might be asked to return itself as bigint on certain overloaded
2560   # operations. This does exactly this, so that sub classes can simple inherit
2561   # it or override with their own integer conversion routine.
2562   $_[0]->copy();
2563   }
2564
2565 sub as_hex
2566   {
2567   # return as hex string, with prefixed 0x
2568   my $x = shift; $x = $class->new($x) if !ref($x);
2569
2570   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
2571
2572   my $s = '';
2573   $s = $x->{sign} if $x->{sign} eq '-';
2574   $s . $CALC->_as_hex($x->{value});
2575   }
2576
2577 sub as_bin
2578   {
2579   # return as binary string, with prefixed 0b
2580   my $x = shift; $x = $class->new($x) if !ref($x);
2581
2582   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
2583
2584   my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
2585   return $s . $CALC->_as_bin($x->{value});
2586   }
2587
2588 sub as_oct
2589   {
2590   # return as octal string, with prefixed 0
2591   my $x = shift; $x = $class->new($x) if !ref($x);
2592
2593   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
2594
2595   my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
2596   return $s . $CALC->_as_oct($x->{value});
2597   }
2598
2599 ##############################################################################
2600 # private stuff (internal use only)
2601
2602 sub objectify {
2603     # Convert strings and "foreign objects" to the objects we want.
2604
2605     # The first argument, $count, is the number of following arguments that
2606     # objectify() looks at and converts to objects. The first is a classname.
2607     # If the given count is 0, all arguments will be used.
2608
2609     # After the count is read, objectify obtains the name of the class to which
2610     # the following arguments are converted. If the second argument is a
2611     # reference, use the reference type as the class name. Otherwise, if it is
2612     # a string that looks like a class name, use that. Otherwise, use $class.
2613
2614     # Caller:                        Gives us:
2615     #
2616     # $x->badd(1);                => ref x, scalar y
2617     # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
2618     # Class->badd(Class->(1),2);  => classname x (scalar), ref x, scalar y
2619     # Math::BigInt::badd(1,2);    => scalar x, scalar y
2620
2621     # A shortcut for the common case $x->unary_op():
2622
2623     return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
2624
2625     # Check the context.
2626
2627     unless (wantarray) {
2628         require Carp;
2629         Carp::croak ("${class}::objectify() needs list context");
2630     }
2631
2632     # Get the number of arguments to objectify.
2633
2634     my $count = shift;
2635     $count ||= @_;
2636
2637     # Initialize the output array.
2638
2639     my @a = @_;
2640
2641     # If the first argument is a reference, use that reference type as our
2642     # class name. Otherwise, if the first argument looks like a class name,
2643     # then use that as our class name. Otherwise, use the default class name.
2644
2645     {
2646         if (ref($a[0])) {               # reference?
2647             unshift @a, ref($a[0]);
2648             last;
2649         }
2650         if ($a[0] =~ /^[A-Z].*::/) {    # string with class name?
2651             last;
2652         }
2653         unshift @a, $class;             # default class name
2654     }
2655
2656     no strict 'refs';
2657
2658     # What we upgrade to, if anything.
2659
2660     my $up = ${"$a[0]::upgrade"};
2661
2662     # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs
2663     # floats.
2664
2665     my $down;
2666     if (defined ${"$a[0]::downgrade"}) {
2667         $down = ${"$a[0]::downgrade"};
2668         ${"$a[0]::downgrade"} = undef;
2669     }
2670
2671     for my $i (1 .. $count) {
2672         my $ref = ref $a[$i];
2673
2674         # If it is an object of the right class, all is fine.
2675
2676         if ($ref eq $a[0]) {
2677             next;
2678         }
2679
2680         # Don't do anything with undefs.
2681
2682         unless (defined($a[$i])) {
2683             next;
2684         }
2685
2686         # Perl scalars are fed to the appropriate constructor.
2687
2688         unless ($ref) {
2689             $a[$i] = $a[0] -> new($a[$i]);
2690             next;
2691         }
2692
2693         # Upgrading is OK, so skip further tests if the argument is upgraded.
2694
2695         if (defined $up && $ref eq $up) {
2696             next;
2697         }
2698
2699         # If we want a Math::BigInt, see if the object can become one.
2700         # Support the old misnomer as_number().
2701
2702         if ($a[0] eq 'Math::BigInt') {
2703             if ($a[$i] -> can('as_int')) {
2704                 $a[$i] = $a[$i] -> as_int();
2705                 next;
2706             }
2707             if ($a[$i] -> can('as_number')) {
2708                 $a[$i] = $a[$i] -> as_number();
2709                 next;
2710             }
2711         }
2712
2713         # If we want a Math::BigFloat, see if the object can become one.
2714
2715         if ($a[0] eq 'Math::BigFloat') {
2716             if ($a[$i] -> can('as_float')) {
2717                 $a[$i] = $a[$i] -> as_float();
2718                 next;
2719             }
2720         }
2721
2722         # Last resort.
2723
2724         $a[$i] = $a[0] -> new($a[$i]);
2725     }
2726
2727     # Reset the downgrading.
2728
2729     ${"$a[0]::downgrade"} = $down;
2730
2731     return @a;
2732 }
2733
2734 sub _register_callback
2735   {
2736   my ($class,$callback) = @_;
2737
2738   if (ref($callback) ne 'CODE')
2739     {
2740     require Carp;
2741     Carp::croak ("$callback is not a coderef");
2742     }
2743   $CALLBACKS{$class} = $callback;
2744   }
2745
2746 sub import
2747   {
2748   my $self = shift;
2749
2750   $IMPORT++;                            # remember we did import()
2751   my @a; my $l = scalar @_;
2752   my $warn_or_die = 0;                  # 0 - no warn, 1 - warn, 2 - die
2753   for ( my $i = 0; $i < $l ; $i++ )
2754     {
2755     if ($_[$i] eq ':constant')
2756       {
2757       # this causes overlord er load to step in
2758       overload::constant
2759         integer => sub { $self->new(shift) },
2760         binary => sub { $self->new(shift) };
2761       }
2762     elsif ($_[$i] eq 'upgrade')
2763       {
2764       # this causes upgrading
2765       $upgrade = $_[$i+1];              # or undef to disable
2766       $i++;
2767       }
2768     elsif ($_[$i] =~ /^(lib|try|only)\z/)
2769       {
2770       # this causes a different low lib to take care...
2771       $CALC = $_[$i+1] || '';
2772       # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
2773       $warn_or_die = 1 if $_[$i] eq 'lib';
2774       $warn_or_die = 2 if $_[$i] eq 'only';
2775       $i++;
2776       }
2777     else
2778       {
2779       push @a, $_[$i];
2780       }
2781     }
2782   # any non :constant stuff is handled by our parent, Exporter
2783   if (@a > 0)
2784     {
2785     require Exporter;
2786
2787     $self->SUPER::import(@a);                   # need it for subclasses
2788     $self->export_to_level(1,$self,@a);         # need it for MBF
2789     }
2790
2791   # try to load core math lib
2792   my @c = split /\s*,\s*/,$CALC;
2793   foreach (@c)
2794     {
2795     $_ =~ tr/a-zA-Z0-9://cd;                    # limit to sane characters
2796     }
2797   push @c, \'Calc'                              # if all fail, try these
2798     if $warn_or_die < 2;                        # but not for "only"
2799   $CALC = '';                                   # signal error
2800   foreach my $l (@c)
2801     {
2802     # fallback libraries are "marked" as \'string', extract string if nec.
2803     my $lib = $l; $lib = $$l if ref($l);
2804
2805     next if ($lib || '') eq '';
2806     $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2807     $lib =~ s/\.pm$//;
2808     if ($] < 5.006)
2809       {
2810       # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
2811       # used in the same script, or eval("") inside import().
2812       my @parts = split /::/, $lib;             # Math::BigInt => Math BigInt
2813       my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
2814       require File::Spec;
2815       $file = File::Spec->catfile (@parts, $file);
2816       eval { require "$file"; $lib->import( @c ); }
2817       }
2818     else
2819       {
2820       eval "use $lib qw/@c/;";
2821       }
2822     if ($@ eq '')
2823       {
2824       my $ok = 1;
2825       # loaded it ok, see if the api_version() is high enough
2826       if ($lib->can('api_version') && $lib->api_version() >= 1.0)
2827         {
2828         $ok = 0;
2829         # api_version matches, check if it really provides anything we need
2830         for my $method (qw/
2831                 one two ten
2832                 str num
2833                 add mul div sub dec inc
2834                 acmp len digit is_one is_zero is_even is_odd
2835                 is_two is_ten
2836                 zeros new copy check
2837                 from_hex from_oct from_bin as_hex as_bin as_oct
2838                 rsft lsft xor and or
2839                 mod sqrt root fac pow modinv modpow log_int gcd
2840          /)
2841           {
2842           if (!$lib->can("_$method"))
2843             {
2844             if (($WARN{$lib}||0) < 2)
2845               {
2846               require Carp;
2847               Carp::carp ("$lib is missing method '_$method'");
2848               $WARN{$lib} = 1;          # still warn about the lib
2849               }
2850             $ok++; last;
2851             }
2852           }
2853         }
2854       if ($ok == 0)
2855         {
2856         $CALC = $lib;
2857         if ($warn_or_die > 0 && ref($l))
2858           {
2859           require Carp;
2860           my $msg = "Math::BigInt: couldn't load specified math lib(s), fallback to $lib";
2861           Carp::carp ($msg) if $warn_or_die == 1;
2862           Carp::croak ($msg) if $warn_or_die == 2;
2863           }
2864         last;                   # found a usable one, break
2865         }
2866       else
2867         {
2868         if (($WARN{$lib}||0) < 2)
2869           {
2870           my $ver = eval "\$$lib\::VERSION" || 'unknown';
2871           require Carp;
2872           Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
2873           $WARN{$lib} = 2;              # never warn again
2874           }
2875         }
2876       }
2877     }
2878   if ($CALC eq '')
2879     {
2880     require Carp;
2881     if ($warn_or_die == 2)
2882       {
2883       Carp::croak ("Couldn't load specified math lib(s) and fallback disallowed");
2884       }
2885     else
2886       {
2887       Carp::croak ("Couldn't load any math lib(s), not even fallback to Calc.pm");
2888       }
2889     }
2890
2891   # notify callbacks
2892   foreach my $class (keys %CALLBACKS)
2893     {
2894     &{$CALLBACKS{$class}}($CALC);
2895     }
2896
2897   # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
2898   # functions
2899
2900   %CAN = ();
2901   for my $method (qw/ signed_and signed_or signed_xor /)
2902     {
2903     $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
2904     }
2905
2906   # import done
2907   }
2908
2909 sub from_hex {
2910     # Create a bigint from a hexadecimal string.
2911
2912     my ($self, $str) = @_;
2913
2914     if ($str =~ s/
2915                      ^
2916                      ( [+-]? )
2917                      (0?x)?
2918                      (
2919                          [0-9a-fA-F]*
2920                          ( _ [0-9a-fA-F]+ )*
2921                      )
2922                      $
2923                  //x)
2924     {
2925         # Get a "clean" version of the string, i.e., non-emtpy and with no
2926         # underscores or invalid characters.
2927
2928         my $sign = $1;
2929         my $chrs = $3;
2930         $chrs =~ tr/_//d;
2931         $chrs = '0' unless CORE::length $chrs;
2932
2933         # Initialize output.
2934
2935         my $x = Math::BigInt->bzero();
2936
2937         # The library method requires a prefix.
2938
2939         $x->{value} = $CALC->_from_hex('0x' . $chrs);
2940
2941         # Place the sign.
2942
2943         if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
2944             $x->{sign} = '-';
2945         }
2946
2947         return $x;
2948     }
2949
2950     # CORE::hex() parses as much as it can, and ignores any trailing garbage.
2951     # For backwards compatibility, we return NaN.
2952
2953     return $self->bnan();
2954 }
2955
2956 sub from_oct {
2957     # Create a bigint from an octal string.
2958
2959     my ($self, $str) = @_;
2960
2961     if ($str =~ s/
2962                      ^
2963                      ( [+-]? )
2964                      (
2965                          [0-7]*
2966                          ( _ [0-7]+ )*
2967                      )
2968                      $
2969                  //x)
2970     {
2971         # Get a "clean" version of the string, i.e., non-emtpy and with no
2972         # underscores or invalid characters.
2973
2974         my $sign = $1;
2975         my $chrs = $2;
2976         $chrs =~ tr/_//d;
2977         $chrs = '0' unless CORE::length $chrs;
2978
2979         # Initialize output.
2980
2981         my $x = Math::BigInt->bzero();
2982
2983         # The library method requires a prefix.
2984
2985         $x->{value} = $CALC->_from_oct('0' . $chrs);
2986
2987         # Place the sign.
2988
2989         if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
2990             $x->{sign} = '-';
2991         }
2992
2993         return $x;
2994     }
2995
2996     # CORE::oct() parses as much as it can, and ignores any trailing garbage.
2997     # For backwards compatibility, we return NaN.
2998
2999     return $self->bnan();
3000 }
3001
3002 sub from_bin {
3003     # Create a bigint from a binary string.
3004
3005     my ($self, $str) = @_;
3006
3007     if ($str =~ s/
3008                      ^
3009                      ( [+-]? )
3010                      (0?b)?
3011                      (
3012                          [01]*
3013                          ( _ [01]+ )*
3014                      )
3015                      $
3016                  //x)
3017     {
3018         # Get a "clean" version of the string, i.e., non-emtpy and with no
3019         # underscores or invalid characters.
3020
3021         my $sign = $1;
3022         my $chrs = $3;
3023         $chrs =~ tr/_//d;
3024         $chrs = '0' unless CORE::length $chrs;
3025
3026         # Initialize output.
3027
3028         my $x = Math::BigInt->bzero();
3029
3030         # The library method requires a prefix.
3031
3032         $x->{value} = $CALC->_from_bin('0b' . $chrs);
3033
3034         # Place the sign.
3035
3036         if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
3037             $x->{sign} = '-';
3038         }
3039
3040         return $x;
3041     }
3042
3043     # For consistency with from_hex() and from_oct(), we return NaN when the
3044     # input is invalid.
3045
3046     return $self->bnan();
3047 }
3048
3049 sub _split
3050   {
3051   # input: num_str; output: undef for invalid or
3052   # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,\$exp_sign,\$exp_value)
3053   # Internal, take apart a string and return the pieces.
3054   # Strip leading/trailing whitespace, leading zeros, underscore and reject
3055   # invalid input.
3056   my $x = shift;
3057
3058   # strip white space at front, also extraneous leading zeros
3059   $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g;   # will not strip '  .2'
3060   $x =~ s/^\s+//;                       # but this will
3061   $x =~ s/\s+$//g;                      # strip white space at end
3062
3063   # shortcut, if nothing to split, return early
3064   if ($x =~ /^[+-]?[0-9]+\z/)
3065     {
3066     $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
3067     return (\$sign, \$x, \'', \'', \0);
3068     }
3069
3070   # invalid starting char?
3071   return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
3072
3073   return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/;        # hex string
3074   return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/;        # binary string
3075
3076   # strip underscores between digits
3077   $x =~ s/([0-9])_([0-9])/$1$2/g;
3078   $x =~ s/([0-9])_([0-9])/$1$2/g;               # do twice for 1_2_3
3079
3080   # some possible inputs:
3081   # 2.1234 # 0.12        # 1          # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
3082   # .2     # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2     # 0e999
3083
3084   my ($m,$e,$last) = split /[Ee]/,$x;
3085   return if defined $last;              # last defined => 1e2E3 or others
3086   $e = '0' if !defined $e || $e eq "";
3087
3088   # sign,value for exponent,mantint,mantfrac
3089   my ($es,$ev,$mis,$miv,$mfv);
3090   # valid exponent?
3091   if ($e =~ /^([+-]?)0*([0-9]+)$/)      # strip leading zeros
3092     {
3093     $es = $1; $ev = $2;
3094     # valid mantissa?
3095     return if $m eq '.' || $m eq '';
3096     my ($mi,$mf,$lastf) = split /\./,$m;
3097     return if defined $lastf;           # lastf defined => 1.2.3 or others
3098     $mi = '0' if !defined $mi;
3099     $mi .= '0' if $mi =~ /^[\-\+]?$/;
3100     $mf = '0' if !defined $mf || $mf eq '';
3101     if ($mi =~ /^([+-]?)0*([0-9]+)$/)           # strip leading zeros
3102       {
3103       $mis = $1||'+'; $miv = $2;
3104       return unless ($mf =~ /^([0-9]*?)0*$/);   # strip trailing zeros
3105       $mfv = $1;
3106       # handle the 0e999 case here
3107       $ev = 0 if $miv eq '0' && $mfv eq '';
3108       return (\$mis,\$miv,\$mfv,\$es,\$ev);
3109       }
3110     }
3111   return; # NaN, not a number
3112   }
3113
3114 ##############################################################################
3115 # internal calculation routines (others are in Math::BigInt::Calc etc)
3116
3117 sub __lcm
3118   {
3119   # (BINT or num_str, BINT or num_str) return BINT
3120   # does modify first argument
3121   # LCM
3122
3123   my ($x,$ty) = @_;
3124   return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
3125   my $method = ref($x) . '::bgcd';
3126   no strict 'refs';
3127   $x * $ty / &$method($x,$ty);
3128   }
3129
3130 ###############################################################################
3131 # trigonometric functions
3132
3133 sub bpi
3134   {
3135   # Calculate PI to N digits. Unless upgrading is in effect, returns the
3136   # result truncated to an integer, that is, always returns '3'.
3137   my ($self,$n) = @_;
3138   if (@_ == 1)
3139     {
3140     # called like Math::BigInt::bpi(10);
3141     $n = $self; $self = $class;
3142     }
3143   $self = ref($self) if ref($self);
3144
3145   return $upgrade->new($n) if defined $upgrade;
3146
3147   # hard-wired to "3"
3148   $self->new(3);
3149   }
3150
3151 sub bcos
3152   {
3153   # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the
3154   # result truncated to an integer.
3155   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3156
3157   return $x if $x->modify('bcos');
3158
3159   return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3160
3161   return $upgrade->new($x)->bcos(@r) if defined $upgrade;
3162
3163   require Math::BigFloat;
3164   # calculate the result and truncate it to integer
3165   my $t = Math::BigFloat->new($x)->bcos(@r)->as_int();
3166
3167   $x->bone() if $t->is_one();
3168   $x->bzero() if $t->is_zero();
3169   $x->round(@r);
3170   }
3171
3172 sub bsin
3173   {
3174   # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
3175   # result truncated to an integer.
3176   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3177
3178   return $x if $x->modify('bsin');
3179
3180   return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3181
3182   return $upgrade->new($x)->bsin(@r) if defined $upgrade;
3183
3184   require Math::BigFloat;
3185   # calculate the result and truncate it to integer
3186   my $t = Math::BigFloat->new($x)->bsin(@r)->as_int();
3187
3188   $x->bone() if $t->is_one();
3189   $x->bzero() if $t->is_zero();
3190   $x->round(@r);
3191   }
3192
3193 sub batan2
3194   {
3195   # calculate arcus tangens of ($y/$x)
3196
3197   # set up parameters
3198   my ($self,$y,$x,@r) = (ref($_[0]),@_);
3199   # objectify is costly, so avoid it
3200   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
3201     {
3202     ($self,$y,$x,@r) = objectify(2,@_);
3203     }
3204
3205   return $y if $y->modify('batan2');
3206
3207   return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
3208
3209   # Y    X
3210   # != 0 -inf result is +- pi
3211   if ($x->is_inf() || $y->is_inf())
3212     {
3213     # upgrade to BigFloat etc.
3214     return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
3215     if ($y->is_inf())
3216       {
3217       if ($x->{sign} eq '-inf')
3218         {
3219         # calculate 3 pi/4 => 2.3.. => 2
3220         $y->bone( substr($y->{sign},0,1) );
3221         $y->bmul($self->new(2));
3222         }
3223       elsif ($x->{sign} eq '+inf')
3224         {
3225         # calculate pi/4 => 0.7 => 0
3226         $y->bzero();
3227         }
3228       else
3229         {
3230         # calculate pi/2 => 1.5 => 1
3231         $y->bone( substr($y->{sign},0,1) );
3232         }
3233       }
3234     else
3235       {
3236       if ($x->{sign} eq '+inf')
3237         {
3238         # calculate pi/4 => 0.7 => 0
3239         $y->bzero();
3240         }
3241       else
3242         {
3243         # PI => 3.1415.. => 3
3244         $y->bone( substr($y->{sign},0,1) );
3245         $y->bmul($self->new(3));
3246         }
3247       }
3248     return $y;
3249     }
3250
3251   return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
3252
3253   require Math::BigFloat;
3254   my $r = Math::BigFloat->new($y)->batan2(Math::BigFloat->new($x),@r)->as_int();
3255
3256   $x->{value} = $r->{value};
3257   $x->{sign} = $r->{sign};
3258
3259   $x;
3260   }
3261
3262 sub batan
3263   {
3264   # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the
3265   # result truncated to an integer.
3266   my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3267
3268   return $x if $x->modify('batan');
3269
3270   return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3271
3272   return $upgrade->new($x)->batan(@r) if defined $upgrade;
3273
3274   # calculate the result and truncate it to integer
3275   my $t = Math::BigFloat->new($x)->batan(@r);
3276
3277   $x->{value} = $CALC->_new( $x->as_int()->bstr() );
3278   $x->round(@r);
3279   }
3280
3281 ###############################################################################
3282 # this method returns 0 if the object can be modified, or 1 if not.
3283 # We use a fast constant sub() here, to avoid costly calls. Subclasses
3284 # may override it with special code (f.i. Math::BigInt::Constant does so)
3285
3286 sub modify () { 0; }
3287
3288 1;
3289 __END__
3290
3291 =pod
3292
3293 =head1 NAME
3294
3295 Math::BigInt - Arbitrary size integer/float math package
3296
3297 =head1 SYNOPSIS
3298
3299   use Math::BigInt;
3300
3301   # or make it faster with huge numbers: install (optional)
3302   # Math::BigInt::GMP and always use (it will fall back to
3303   # pure Perl if the GMP library is not installed):
3304   # (See also the L<MATH LIBRARY> section!)
3305
3306   # will warn if Math::BigInt::GMP cannot be found
3307   use Math::BigInt lib => 'GMP';
3308
3309   # to suppress the warning use this:
3310   # use Math::BigInt try => 'GMP';
3311
3312   # dies if GMP cannot be loaded:
3313   # use Math::BigInt only => 'GMP';
3314
3315   my $str = '1234567890';
3316   my @values = (64,74,18);
3317   my $n = 1; my $sign = '-';
3318
3319   # Number creation
3320   my $x = Math::BigInt->new($str);      # defaults to 0
3321   my $y = $x->copy();                   # make a true copy
3322   my $nan  = Math::BigInt->bnan();      # create a NotANumber
3323   my $zero = Math::BigInt->bzero();     # create a +0
3324   my $inf = Math::BigInt->binf();       # create a +inf
3325   my $inf = Math::BigInt->binf('-');    # create a -inf
3326   my $one = Math::BigInt->bone();       # create a +1
3327   my $mone = Math::BigInt->bone('-');   # create a -1
3328
3329   my $pi = Math::BigInt->bpi();         # returns '3'
3330                                         # see Math::BigFloat::bpi()
3331
3332   $h = Math::BigInt->new('0x123');      # from hexadecimal
3333   $b = Math::BigInt->new('0b101');      # from binary
3334   $o = Math::BigInt->from_oct('0101');  # from octal
3335
3336   # Testing (don't modify their arguments)
3337   # (return true if the condition is met, otherwise false)
3338
3339   $x->is_zero();        # if $x is +0
3340   $x->is_nan();         # if $x is NaN
3341   $x->is_one();         # if $x is +1
3342   $x->is_one('-');      # if $x is -1
3343   $x->is_odd();         # if $x is odd
3344   $x->is_even();        # if $x is even
3345   $x->is_pos();         # if $x > 0
3346   $x->is_neg();         # if $x < 0
3347   $x->is_inf($sign);    # if $x is +inf, or -inf (sign is default '+')
3348   $x->is_int();         # if $x is an integer (not a float)
3349
3350   # comparing and digit/sign extraction
3351   $x->bcmp($y);         # compare numbers (undef,<0,=0,>0)
3352   $x->bacmp($y);        # compare absolutely (undef,<0,=0,>0)
3353   $x->sign();           # return the sign, either +,- or NaN
3354   $x->digit($n);        # return the nth digit, counting from right
3355   $x->digit(-$n);       # return the nth digit, counting from left
3356
3357   # The following all modify their first argument. If you want to pre-
3358   # serve $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for
3359   # why this is necessary when mixing $a = $b assignments with non-over-
3360   # loaded math.
3361
3362   $x->bzero();          # set $x to 0
3363   $x->bnan();           # set $x to NaN
3364   $x->bone();           # set $x to +1
3365   $x->bone('-');        # set $x to -1
3366   $x->binf();           # set $x to inf
3367   $x->binf('-');        # set $x to -inf
3368
3369   $x->bneg();           # negation
3370   $x->babs();           # absolute value
3371   $x->bsgn();           # sign function (-1, 0, 1, or NaN)
3372   $x->bnorm();          # normalize (no-op in BigInt)
3373   $x->bnot();           # two's complement (bit wise not)
3374   $x->binc();           # increment $x by 1
3375   $x->bdec();           # decrement $x by 1
3376
3377   $x->badd($y);         # addition (add $y to $x)
3378   $x->bsub($y);         # subtraction (subtract $y from $x)
3379   $x->bmul($y);         # multiplication (multiply $x by $y)
3380   $x->bdiv($y);         # divide, set $x to quotient
3381                         # return (quo,rem) or quo if scalar
3382
3383   $x->bmuladd($y,$z);   # $x = $x * $y + $z
3384
3385   $x->bmod($y);         # modulus (x % y)
3386   $x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod)
3387   $x->bmodinv($mod);    # modular multiplicative inverse
3388   $x->bpow($y);         # power of arguments (x ** y)
3389   $x->blsft($y);        # left shift in base 2
3390   $x->brsft($y);        # right shift in base 2
3391                         # returns (quo,rem) or quo if in sca-
3392                         # lar context
3393   $x->blsft($y,$n);     # left shift by $y places in base $n
3394   $x->brsft($y,$n);     # right shift by $y places in base $n
3395                         # returns (quo,rem) or quo if in sca-
3396                         # lar context
3397
3398   $x->band($y);         # bitwise and
3399   $x->bior($y);         # bitwise inclusive or
3400   $x->bxor($y);         # bitwise exclusive or
3401   $x->bnot();           # bitwise not (two's complement)
3402
3403   $x->bsqrt();          # calculate square-root
3404   $x->broot($y);        # $y'th root of $x (e.g. $y == 3 => cubic root)
3405   $x->bfac();           # factorial of $x (1*2*3*4*..$x)
3406
3407   $x->bnok($y);         # x over y (binomial coefficient n over k)
3408
3409   $x->blog();           # logarithm of $x to base e (Euler's number)
3410   $x->blog($base);      # logarithm of $x to base $base (f.i. 2)
3411   $x->bexp();           # calculate e ** $x where e is Euler's number
3412
3413   $x->round($A,$P,$mode);  # round to accuracy or precision using
3414                            # mode $mode
3415   $x->bround($n);          # accuracy: preserve $n digits
3416   $x->bfround($n);         # $n > 0: round $nth digits,
3417                            # $n < 0: round to the $nth digit after the
3418                            # dot, no-op for BigInts
3419
3420   # The following do not modify their arguments in BigInt (are no-ops),
3421   # but do so in BigFloat:
3422
3423   $x->bfloor();            # round towards minus infinity
3424   $x->bceil();             # round towards plus infinity
3425   $x->bint();              # round towards zero
3426
3427   # The following do not modify their arguments:
3428
3429   # greatest common divisor (no OO style)
3430   my $gcd = Math::BigInt::bgcd(@values);
3431   # lowest common multiple (no OO style)
3432   my $lcm = Math::BigInt::blcm(@values);
3433
3434   $x->length();            # return number of digits in number
3435   ($xl,$f) = $x->length(); # length of number and length of fraction
3436                            # part, latter is always 0 digits long
3437                            # for BigInts
3438
3439   $x->exponent();         # return exponent as BigInt
3440   $x->mantissa();         # return (signed) mantissa as BigInt
3441   $x->parts();            # return (mantissa,exponent) as BigInt
3442   $x->copy();             # make a true copy of $x (unlike $y = $x;)
3443   $x->as_int();           # return as BigInt (in BigInt: same as copy())
3444   $x->numify();           # return as scalar (might overflow!)
3445
3446   # conversion to string (do not modify their argument)
3447   $x->bstr();         # normalized string (e.g. '3')
3448   $x->bsstr();        # norm. string in scientific notation (e.g. '3E0')
3449   $x->as_hex();       # as signed hexadecimal string with prefixed 0x
3450   $x->as_bin();       # as signed binary string with prefixed 0b
3451   $x->as_oct();       # as signed octal string with prefixed 0
3452
3453
3454   # precision and accuracy (see section about rounding for more)
3455   $x->precision();       # return P of $x (or global, if P of $x undef)
3456   $x->precision($n);     # set P of $x to $n
3457   $x->accuracy();        # return A of $x (or global, if A of $x undef)
3458   $x->accuracy($n);      # set A $x to $n
3459
3460   # Global methods
3461   Math::BigInt->precision();   # get/set global P for all BigInt objects
3462   Math::BigInt->accuracy();    # get/set global A for all BigInt objects
3463   Math::BigInt->round_mode();  # get/set global round mode, one of
3464                                # 'even', 'odd', '+inf', '-inf', 'zero',
3465                                # 'trunc' or 'common'
3466   Math::BigInt->config();      # return hash containing configuration
3467
3468 =head1 DESCRIPTION
3469
3470 All operators (including basic math operations) are overloaded if you
3471 declare your big integers as
3472
3473   $i = new Math::BigInt '123_456_789_123_456_789';
3474
3475 Operations with overloaded operators preserve the arguments which is
3476 exactly what you expect.
3477
3478 =head2 Input
3479
3480 Input values to these routines may be any string, that looks like a number
3481 and results in an integer, including hexadecimal and binary numbers.
3482
3483 Scalars holding numbers may also be passed, but note that non-integer numbers
3484 may already have lost precision due to the conversion to float. Quote
3485 your input if you want BigInt to see all the digits:
3486
3487         $x = Math::BigInt->new(12345678890123456789);   # bad
3488         $x = Math::BigInt->new('12345678901234567890'); # good
3489
3490 You can include one underscore between any two digits.
3491
3492 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
3493 Non-integer values result in NaN.
3494
3495 Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b")
3496 are accepted, too. Please note that octal numbers are not recognized
3497 by new(), so the following will print "123":
3498
3499         perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
3500
3501 To convert an octal number, use from_oct();
3502
3503         perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
3504
3505 Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
3506 results in 'NaN'. This might change in the future, so use always the following
3507 explicit forms to get a zero or NaN:
3508
3509         $zero = Math::BigInt->bzero();
3510         $nan = Math::BigInt->bnan();
3511
3512 C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
3513 are always stored in normalized form. If passed a string, creates a BigInt
3514 object from the input.
3515
3516 =head2 Output
3517
3518 Output values are BigInt objects (normalized), except for the methods which
3519 return a string (see L</SYNOPSIS>).
3520
3521 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
3522 C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>)
3523 return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort.
3524
3525 =head1 METHODS
3526
3527 Each of the methods below (except config(), accuracy() and precision())
3528 accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R>
3529 are C<accuracy>, C<precision> and C<round_mode>. Please see the section about
3530 L</ACCURACY and PRECISION> for more information.
3531
3532 =over
3533
3534 =item config()
3535
3536     use Data::Dumper;
3537
3538     print Dumper ( Math::BigInt->config() );
3539     print Math::BigInt->config()->{lib},"\n";
3540
3541 Returns a hash containing the configuration, e.g. the version number, lib
3542 loaded etc. The following hash keys are currently filled in with the
3543 appropriate information.
3544
3545     key           Description
3546                   Example
3547     ============================================================
3548     lib           Name of the low-level math library
3549                   Math::BigInt::Calc
3550     lib_version   Version of low-level math library (see 'lib')
3551                   0.30
3552     class         The class name of config() you just called
3553                   Math::BigInt
3554     upgrade       To which class math operations might be
3555                   upgraded Math::BigFloat
3556     downgrade     To which class math operations might be
3557                   downgraded undef
3558     precision     Global precision
3559                   undef
3560     accuracy      Global accuracy
3561                   undef
3562     round_mode    Global round mode
3563                   even
3564     version       version number of the class you used
3565                   1.61
3566     div_scale     Fallback accuracy for div
3567                   40
3568     trap_nan      If true, traps creation of NaN via croak()
3569                   1
3570     trap_inf      If true, traps creation of +inf/-inf via croak()
3571                   1
3572
3573 The following values can be set by passing C<config()> a reference to a hash:
3574
3575         trap_inf trap_nan
3576         upgrade downgrade precision accuracy round_mode div_scale
3577
3578 Example:
3579
3580         $new_cfg = Math::BigInt->config(
3581             { trap_inf => 1, precision => 5 }
3582         );
3583
3584 =item accuracy()
3585
3586     $x->accuracy(5);         # local for $x
3587     CLASS->accuracy(5);      # global for all members of CLASS
3588                              # Note: This also applies to new()!
3589
3590     $A = $x->accuracy();     # read out accuracy that affects $x
3591     $A = CLASS->accuracy();  # read out global accuracy
3592
3593 Set or get the global or local accuracy, aka how many significant digits the
3594 results have. If you set a global accuracy, then this also applies to new()!
3595
3596 Warning! The accuracy I<sticks>, e.g. once you created a number under the
3597 influence of C<< CLASS->accuracy($A) >>, all results from math operations with
3598 that number will also be rounded.
3599
3600 In most cases, you should probably round the results explicitly using one of
3601 L</round()>, L</bround()> or L</bfround()> or by passing the desired accuracy
3602 to the math operation as additional parameter:
3603
3604     my $x = Math::BigInt->new(30000);
3605     my $y = Math::BigInt->new(7);
3606     print scalar $x->copy()->bdiv($y, 2);               # print 4300
3607     print scalar $x->copy()->bdiv($y)->bround(2);       # print 4300
3608
3609 Please see the section about L</ACCURACY and PRECISION> for further details.
3610
3611 Value must be greater than zero. Pass an undef value to disable it:
3612
3613     $x->accuracy(undef);
3614     Math::BigInt->accuracy(undef);
3615
3616 Returns the current accuracy. For C<< $x->accuracy() >> it will return either
3617 the local accuracy, or if not defined, the global. This means the return value
3618 represents the accuracy that will be in effect for $x:
3619
3620     $y = Math::BigInt->new(1234567);       # unrounded
3621     print Math::BigInt->accuracy(4),"\n";  # set 4, print 4
3622     $x = Math::BigInt->new(123456);        # $x will be automatic-
3623                                            # ally rounded!
3624     print "$x $y\n";                       # '123500 1234567'
3625     print $x->accuracy(),"\n";             # will be 4
3626     print $y->accuracy(),"\n";             # also 4, since
3627                                            # global is 4
3628     print Math::BigInt->accuracy(5),"\n";  # set to 5, print 5
3629     print $x->accuracy(),"\n";             # still 4
3630     print $y->accuracy(),"\n";             # 5, since global is 5
3631
3632 Note: Works also for subclasses like Math::BigFloat. Each class has it's own
3633 globals separated from Math::BigInt, but it is possible to subclass
3634 Math::BigInt and make the globals of the subclass aliases to the ones from
3635 Math::BigInt.
3636
3637 =item precision()
3638
3639     $x->precision(-2);          # local for $x, round at the second
3640                                 # digit right of the dot
3641     $x->precision(2);           # ditto, round at the second digit
3642                                 # left of the dot
3643
3644     CLASS->precision(5);        # Global for all members of CLASS
3645                                 # This also applies to new()!
3646     CLASS->precision(-5);       # ditto
3647
3648     $P = CLASS->precision();    # read out global precision
3649     $P = $x->precision();       # read out precision that affects $x
3650
3651 Note: You probably want to use L</accuracy()> instead. With L</accuracy()> you
3652 set the number of digits each result should have, with L</precision()> you
3653 set the place where to round!
3654
3655 C<precision()> sets or gets the global or local precision, aka at which digit
3656 before or after the dot to round all results. A set global precision also
3657 applies to all newly created numbers!
3658
3659 In Math::BigInt, passing a negative number precision has no effect since no
3660 numbers have digits after the dot. In L<Math::BigFloat>, it will round all
3661 results to P digits after the dot.
3662
3663 Please see the section about L</ACCURACY and PRECISION> for further details.
3664
3665 Pass an undef value to disable it:
3666
3667     $x->precision(undef);
3668     Math::BigInt->precision(undef);
3669
3670 Returns the current precision. For C<< $x->precision() >> it will return either
3671 the local precision of $x, or if not defined, the global. This means the return
3672 value represents the prevision that will be in effect for $x:
3673
3674     $y = Math::BigInt->new(1234567);        # unrounded
3675     print Math::BigInt->precision(4),"\n";  # set 4, print 4
3676     $x = Math::BigInt->new(123456);  # will be automatically rounded
3677     print $x;                               # print "120000"!
3678
3679 Note: Works also for subclasses like L<Math::BigFloat>. Each class has its
3680 own globals separated from Math::BigInt, but it is possible to subclass
3681 Math::BigInt and make the globals of the subclass aliases to the ones from
3682 Math::BigInt.
3683
3684 =item brsft()
3685
3686     $x->brsft($y,$n);
3687
3688 Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
3689 2, but others work, too.
3690
3691 Right shifting usually amounts to dividing $x by $n ** $y and truncating the
3692 result:
3693
3694
3695     $x = Math::BigInt->new(10);
3696     $x->brsft(1);                       # same as $x >> 1: 5
3697     $x = Math::BigInt->new(1234);
3698     $x->brsft(2,10);                    # result 12
3699
3700 There is one exception, and that is base 2 with negative $x:
3701
3702
3703     $x = Math::BigInt->new(-5);
3704     print $x->brsft(1);
3705
3706 This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
3707 result).
3708
3709 =item new()
3710
3711     $x = Math::BigInt->new($str,$A,$P,$R);
3712
3713 Creates a new BigInt object from a scalar or another BigInt object. The
3714 input is accepted as decimal, hex (with leading '0x') or binary (with leading
3715 '0b').
3716
3717 See L</Input> for more info on accepted input formats.
3718
3719 =item from_oct()
3720
3721     $x = Math::BigInt->from_oct("0775");      # input is octal
3722
3723 Interpret the input as an octal string and return the corresponding value. A
3724 "0" (zero) prefix is optional. A single underscore character may be placed
3725 right after the prefix, if present, or between any two digits. If the input is
3726 invalid, a NaN is returned.
3727
3728 =item from_hex()
3729
3730     $x = Math::BigInt->from_hex("0xcafe");    # input is hexadecimal
3731
3732 Interpret input as a hexadecimal string. A "0x" or "x" prefix is optional. A
3733 single underscore character may be placed right after the prefix, if present,
3734 or between any two digits. If the input is invalid, a NaN is returned.
3735
3736 =item from_bin()
3737
3738     $x = Math::BigInt->from_bin("0b10011");   # input is binary
3739
3740 Interpret the input as a binary string. A "0b" or "b" prefix is optional. A
3741 single underscore character may be placed right after the prefix, if present,
3742 or between any two digits. If the input is invalid, a NaN is returned.
3743
3744 =item bnan()
3745
3746     $x = Math::BigInt->bnan();
3747
3748 Creates a new BigInt object representing NaN (Not A Number).
3749 If used on an object, it will set it to NaN:
3750
3751     $x->bnan();
3752
3753 =item bzero()
3754
3755     $x = Math::BigInt->bzero();
3756
3757 Creates a new BigInt object representing zero.
3758 If used on an object, it will set it to zero:
3759
3760     $x->bzero();
3761
3762 =item binf()
3763
3764     $x = Math::BigInt->binf($sign);
3765
3766 Creates a new BigInt object representing infinity. The optional argument is
3767 either '-' or '+', indicating whether you want infinity or minus infinity.
3768 If used on an object, it will set it to infinity:
3769
3770     $x->binf();
3771     $x->binf('-');
3772
3773 =item bone()
3774
3775     $x = Math::BigInt->binf($sign);
3776
3777 Creates a new BigInt object representing one. The optional argument is
3778 either '-' or '+', indicating whether you want one or minus one.
3779 If used on an object, it will set it to one:
3780
3781     $x->bone();         # +1
3782     $x->bone('-');              # -1
3783
3784 =item is_one()/is_zero()/is_nan()/is_inf()
3785
3786     $x->is_zero();              # true if arg is +0
3787     $x->is_nan();               # true if arg is NaN
3788     $x->is_one();               # true if arg is +1
3789     $x->is_one('-');            # true if arg is -1
3790     $x->is_inf();               # true if +inf
3791     $x->is_inf('-');            # true if -inf (sign is default '+')
3792
3793 These methods all test the BigInt for being one specific value and return
3794 true or false depending on the input. These are faster than doing something
3795 like:
3796
3797     if ($x == 0)
3798
3799 =item is_pos()/is_neg()/is_positive()/is_negative()
3800
3801     $x->is_pos();                       # true if > 0
3802     $x->is_neg();                       # true if < 0
3803
3804 The methods return true if the argument is positive or negative, respectively.
3805 C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
3806 C<-inf> is negative. A C<zero> is neither positive nor negative.
3807
3808 These methods are only testing the sign, and not the value.
3809
3810 C<is_positive()> and C<is_negative()> are aliases to C<is_pos()> and
3811 C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were
3812 introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced
3813 in v1.68.
3814
3815 =item is_odd()/is_even()/is_int()
3816
3817     $x->is_odd();               # true if odd, false for even
3818     $x->is_even();              # true if even, false for odd
3819     $x->is_int();               # true if $x is an integer
3820
3821 The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
3822 C<-inf> are not integers and are neither odd nor even.
3823
3824 In BigInt, all numbers except C<NaN>, C<+inf> and C<-inf> are integers.
3825
3826 =item bcmp()
3827
3828     $x->bcmp($y);
3829
3830 Compares $x with $y and takes the sign into account.
3831 Returns -1, 0, 1 or undef.
3832
3833 =item bacmp()
3834
3835     $x->bacmp($y);
3836
3837 Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef.
3838
3839 =item sign()
3840
3841     $x->sign();
3842
3843 Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
3844
3845 If you want $x to have a certain sign, use one of the following methods:
3846
3847     $x->babs();                 # '+'
3848     $x->babs()->bneg();         # '-'
3849     $x->bnan();                 # 'NaN'
3850     $x->binf();                 # '+inf'
3851     $x->binf('-');              # '-inf'
3852
3853 =item digit()
3854
3855     $x->digit($n);       # return the nth digit, counting from right
3856
3857 If C<$n> is negative, returns the digit counting from left.
3858
3859 =item bneg()
3860
3861     $x->bneg();
3862
3863 Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
3864 and '-inf', respectively. Does nothing for NaN or zero.
3865
3866 =item babs()
3867
3868     $x->babs();
3869
3870 Set the number to its absolute value, e.g. change the sign from '-' to '+'
3871 and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
3872 numbers.
3873
3874 =item bsgn()
3875
3876     $x->bsgn();
3877
3878 Signum function. Set the number to -1, 0, or 1, depending on whether the
3879 number is negative, zero, or positive, respectively. Does not modify NaNs.
3880
3881 =item bnorm()
3882
3883     $x->bnorm();                        # normalize (no-op)
3884
3885 =item bnot()
3886
3887     $x->bnot();
3888
3889 Two's complement (bitwise not). This is equivalent to
3890
3891     $x->binc()->bneg();
3892
3893 but faster.
3894
3895 =item binc()
3896
3897     $x->binc();                 # increment x by 1
3898
3899 =item bdec()
3900
3901     $x->bdec();                 # decrement x by 1
3902
3903 =item badd()
3904
3905     $x->badd($y);               # addition (add $y to $x)
3906
3907 =item bsub()
3908
3909     $x->bsub($y);               # subtraction (subtract $y from $x)
3910
3911 =item bmul()
3912
3913     $x->bmul($y);               # multiplication (multiply $x by $y)
3914
3915 =item bmuladd()
3916
3917     $x->bmuladd($y,$z);
3918
3919 Multiply $x by $y, and then add $z to the result,
3920
3921 This method was added in v1.87 of Math::BigInt (June 2007).
3922
3923 =item bdiv()
3924
3925     $x->bdiv($y);               # divide, set $x to quotient
3926                                 # return (quo,rem) or quo if scalar
3927
3928 =item bmod()
3929
3930     $x->bmod($y);               # modulus (x % y)
3931
3932 =item bmodinv()
3933
3934     $x->bmodinv($mod);          # modular multiplicative inverse
3935
3936 Returns the multiplicative inverse of C<$x> modulo C<$mod>. If
3937
3938     $y = $x -> copy() -> bmodinv($mod)
3939
3940 then C<$y> is the number closest to zero, and with the same sign as C<$mod>,
3941 satisfying
3942
3943     ($x * $y) % $mod = 1 % $mod
3944
3945 If C<$x> and C<$y> are non-zero, they must be relative primes, i.e.,
3946 C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative
3947 inverse exists.
3948
3949 =item bmodpow()
3950
3951     $num->bmodpow($exp,$mod);           # modular exponentiation
3952                                         # ($num**$exp % $mod)
3953
3954 Returns the value of C<$num> taken to the power C<$exp> in the modulus
3955 C<$mod> using binary exponentiation.  C<bmodpow> is far superior to
3956 writing
3957
3958     $num ** $exp % $mod
3959
3960 because it is much faster - it reduces internal variables into
3961 the modulus whenever possible, so it operates on smaller numbers.
3962
3963 C<bmodpow> also supports negative exponents.
3964
3965     bmodpow($num, -1, $mod)
3966
3967 is exactly equivalent to
3968
3969     bmodinv($num, $mod)
3970
3971 =item bpow()
3972
3973     $x->bpow($y);                     # power of arguments (x ** y)
3974
3975 =item blog()
3976
3977     $x->blog($base, $accuracy);   # logarithm of x to the base $base
3978
3979 If C<$base> is not defined, Euler's number (e) is used:
3980
3981     print $x->blog(undef, 100);       # log(x) to 100 digits
3982
3983 =item bexp()
3984
3985     $x->bexp($accuracy);              # calculate e ** X
3986
3987 Calculates the expression C<e ** $x> where C<e> is Euler's number.
3988
3989 This method was added in v1.82 of Math::BigInt (April 2007).
3990
3991 See also L</blog()>.
3992
3993 =item bnok()
3994
3995     $x->bnok($y);         # x over y (binomial coefficient n over k)
3996
3997 Calculates the binomial coefficient n over k, also called the "choose"
3998 function. The result is equivalent to:
3999
4000         ( n )      n!
4001         | - |  = -------
4002         ( k )    k!(n-k)!
4003
4004 This method was added in v1.84 of Math::BigInt (April 2007).
4005
4006 =item bpi()
4007
4008     print Math::BigInt->bpi(100), "\n";         # 3
4009
4010 Returns PI truncated to an integer, with the argument being ignored. This means
4011 under BigInt this always returns C<3>.
4012
4013 If upgrading is in effect, returns PI, rounded to N digits with the
4014 current rounding mode:
4015
4016     use Math::BigFloat;
4017     use Math::BigInt upgrade => Math::BigFloat;
4018     print Math::BigInt->bpi(3), "\n";           # 3.14
4019     print Math::BigInt->bpi(100), "\n";         # 3.1415....
4020
4021 This method was added in v1.87 of Math::BigInt (June 2007).
4022
4023 =item bcos()
4024
4025     my $x = Math::BigInt->new(1);
4026     print $x->bcos(100), "\n";
4027
4028 Calculate the cosinus of $x, modifying $x in place.
4029
4030 In BigInt, unless upgrading is in effect, the result is truncated to an
4031 integer.
4032
4033 This method was added in v1.87 of Math::BigInt (June 2007).
4034
4035 =item bsin()
4036
4037     my $x = Math::BigInt->new(1);
4038     print $x->bsin(100), "\n";
4039
4040 Calculate the sinus of $x, modifying $x in place.
4041
4042 In BigInt, unless upgrading is in effect, the result is truncated to an
4043 integer.
4044
4045 This method was added in v1.87 of Math::BigInt (June 2007).
4046
4047 =item batan2()
4048
4049     my $x = Math::BigInt->new(1);
4050     my $y = Math::BigInt->new(1);
4051     print $y->batan2($x), "\n";
4052
4053 Calculate the arcus tangens of C<$y> divided by C<$x>, modifying $y in place.
4054
4055 In BigInt, unless upgrading is in effect, the result is truncated to an
4056 integer.
4057
4058 This method was added in v1.87 of Math::BigInt (June 2007).
4059
4060 =item batan()
4061
4062     my $x = Math::BigFloat->new(0.5);
4063     print $x->batan(100), "\n";
4064
4065 Calculate the arcus tangens of $x, modifying $x in place.
4066
4067 In BigInt, unless upgrading is in effect, the result is truncated to an
4068 integer.
4069
4070 This method was added in v1.87 of Math::BigInt (June 2007).
4071
4072 =item blsft()
4073
4074     $x->blsft($y);              # left shift in base 2
4075     $x->blsft($y,$n);           # left shift, in base $n (like 10)
4076
4077 =item brsft()
4078
4079     $x->brsft($y);              # right shift in base 2
4080     $x->brsft($y,$n);           # right shift, in base $n (like 10)
4081
4082 =item band()
4083
4084     $x->band($y);               # bitwise and
4085
4086 =item bior()
4087
4088     $x->bior($y);               # bitwise inclusive or
4089
4090 =item bxor()
4091
4092     $x->bxor($y);               # bitwise exclusive or
4093
4094 =item bnot()
4095
4096     $x->bnot();                 # bitwise not (two's complement)
4097
4098 =item bsqrt()
4099
4100     $x->bsqrt();                # calculate square-root
4101
4102 =item broot()
4103
4104     $x->broot($N);
4105
4106 Calculates the N'th root of C<$x>.
4107
4108 =item bfac()
4109
4110     $x->bfac();                 # factorial of $x (1*2*3*4*..$x)
4111
4112 =item round()
4113
4114     $x->round($A,$P,$round_mode);
4115
4116 Round $x to accuracy C<$A> or precision C<$P> using the round mode
4117 C<$round_mode>.
4118
4119 =item bround()
4120
4121     $x->bround($N);               # accuracy: preserve $N digits
4122
4123 =item bfround()
4124
4125     $x->bfround($N);
4126
4127 If N is > 0, rounds to the Nth digit from the left. If N < 0, rounds to
4128 the Nth digit after the dot. Since BigInts are integers, the case N < 0
4129 is a no-op for them.
4130
4131 Examples:
4132
4133         Input           N               Result
4134         ===================================================
4135         123456.123456   3               123500
4136         123456.123456   2               123450
4137         123456.123456   -2              123456.12
4138         123456.123456   -3              123456.123
4139
4140 =item bfloor()
4141
4142     $x->bfloor();
4143
4144 Round $x towards minus infinity (i.e., set $x to the largest integer less than
4145 or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if $x
4146 is not an integer.
4147
4148 =item bceil()
4149
4150     $x->bceil();
4151
4152 Round $x towards plus infinity (i.e., set $x to the smallest integer greater
4153 than or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if
4154 $x is not an integer.
4155
4156 =item bint()
4157
4158     $x->bint();
4159
4160 Round $x towards zero. This is a no-op in BigInt, but changes $x in BigFloat,
4161 if $x is not an integer.
4162
4163 =item bgcd()
4164
4165     bgcd(@values);           # greatest common divisor (no OO style)
4166
4167 =item blcm()
4168
4169     blcm(@values);           # lowest common multiple (no OO style)
4170
4171 =item length()
4172
4173     $x->length();
4174     ($xl,$fl) = $x->length();
4175
4176 Returns the number of digits in the decimal representation of the number.
4177 In list context, returns the length of the integer and fraction part. For
4178 BigInt's, the length of the fraction part will always be 0.
4179
4180 =item exponent()
4181
4182     $x->exponent();
4183
4184 Return the exponent of $x as BigInt.
4185
4186 =item mantissa()
4187
4188     $x->mantissa();
4189
4190 Return the signed mantissa of $x as BigInt.
4191
4192 =item parts()
4193
4194     $x->parts();        # return (mantissa,exponent) as BigInt
4195
4196 =item copy()
4197
4198     $x->copy();         # make a true copy of $x (unlike $y = $x;)
4199
4200 =item as_int()/as_number()
4201
4202     $x->as_int();
4203
4204 Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as
4205 C<copy()>.
4206
4207 C<as_number()> is an alias to this method. C<as_number> was introduced in
4208 v1.22, while C<as_int()> was only introduced in v1.68.
4209
4210 =item bstr()
4211
4212     $x->bstr();
4213
4214 Returns a normalized string representation of C<$x>.
4215
4216 =item bsstr()
4217
4218     $x->bsstr();     # normalized string in scientific notation
4219
4220 =item as_hex()
4221
4222     $x->as_hex();    # as signed hexadecimal string with prefixed 0x
4223
4224 =item as_bin()
4225
4226     $x->as_bin();    # as signed binary string with prefixed 0b
4227
4228 =item as_oct()
4229
4230     $x->as_oct();    # as signed octal string with prefixed 0
4231
4232 =item numify()
4233
4234         print $x->numify();
4235
4236 This returns a normal Perl scalar from $x. It is used automatically
4237 whenever a scalar is needed, for instance in array index operations.
4238
4239 This loses precision, to avoid this use L<as_int()|/"as_int()/as_number()"> instead.
4240
4241 =item modify()
4242
4243     $x->modify('bpowd');
4244
4245 This method returns 0 if the object can be modified with the given
4246 operation, or 1 if not.
4247
4248 This is used for instance by L<Math::BigInt::Constant>.
4249
4250 =item upgrade()/downgrade()
4251
4252 Set/get the class for downgrade/upgrade operations. Thuis is used
4253 for instance by L<bignum>. The defaults are '', thus the following
4254 operation will create a BigInt, not a BigFloat:
4255
4256         my $i = Math::BigInt->new(123);
4257         my $f = Math::BigFloat->new('123.1');
4258
4259         print $i + $f,"\n";                     # print 246
4260
4261 =item div_scale()
4262
4263 Set/get the number of digits for the default precision in divide
4264 operations.
4265
4266 =item round_mode()
4267
4268 Set/get the current round mode.
4269
4270 =back
4271
4272 =head1 ACCURACY and PRECISION
4273
4274 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
4275 accuracy and precision based rounding, both automatically after every
4276 operation, as well as manually.
4277
4278 This section describes the accuracy/precision handling in Math::Big* as it
4279 used to be and as it is now, complete with an explanation of all terms and
4280 abbreviations.
4281
4282 Not yet implemented things (but with correct description) are marked with '!',
4283 things that need to be answered are marked with '?'.
4284
4285 In the next paragraph follows a short description of terms used here (because
4286 these may differ from terms used by others people or documentation).
4287
4288 During the rest of this document, the shortcuts A (for accuracy), P (for
4289 precision), F (fallback) and R (rounding mode) will be used.
4290
4291 =head2 Precision P
4292
4293 A fixed number of digits before (positive) or after (negative)
4294 the decimal point. For example, 123.45 has a precision of -2. 0 means an
4295 integer like 123 (or 120). A precision of 2 means two digits to the left
4296 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
4297 numbers with zeros before the decimal point may have different precisions,
4298 because 1200 can have p = 0, 1 or 2 (depending on what the initial value
4299 was). It could also have p < 0, when the digits after the decimal point
4300 are zero.
4301
4302 The string output (of floating point numbers) will be padded with zeros:
4303
4304         Initial value   P       A       Result          String
4305         ------------------------------------------------------------
4306         1234.01         -3              1000            1000
4307         1234            -2              1200            1200
4308         1234.5          -1              1230            1230
4309         1234.001        1               1234            1234.0
4310         1234.01         0               1234            1234
4311         1234.01         2               1234.01         1234.01
4312         1234.01         5               1234.01         1234.01000
4313
4314 For BigInts, no padding occurs.
4315
4316 =head2 Accuracy A
4317
4318 Number of significant digits. Leading zeros are not counted. A
4319 number may have an accuracy greater than the non-zero digits
4320 when there are zeros in it or trailing zeros. For example, 123.456 has
4321 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
4322
4323 The string output (of floating point numbers) will be padded with zeros:
4324
4325         Initial value   P       A       Result          String
4326         ------------------------------------------------------------
4327         1234.01                 3       1230            1230
4328         1234.01                 6       1234.01         1234.01
4329         1234.1                  8       1234.1          1234.1000
4330
4331 For BigInts, no padding occurs.
4332
4333 =head2 Fallback F
4334
4335 When both A and P are undefined, this is used as a fallback accuracy when
4336 dividing numbers.
4337
4338 =head2 Rounding mode R
4339
4340 When rounding a number, different 'styles' or 'kinds'
4341 of rounding are possible. (Note that random rounding, as in
4342 Math::Round, is not implemented.)
4343
4344 =over
4345
4346 =item 'trunc'
4347
4348 truncation invariably removes all digits following the
4349 rounding place, replacing them with zeros. Thus, 987.65 rounded
4350 to tens (P=1) becomes 980, and rounded to the fourth sigdig
4351 becomes 987.6 (A=4). 123.456 rounded to the second place after the
4352 decimal point (P=-2) becomes 123.46.
4353
4354 All other implemented styles of rounding attempt to round to the
4355 "nearest digit." If the digit D immediately to the right of the
4356 rounding place (skipping the decimal point) is greater than 5, the
4357 number is incremented at the rounding place (possibly causing a
4358 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
4359 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
4360 truncated at the rounding place: e.g. when rounding to units, 0.4
4361 rounds to 0, and -19.4 rounds to -19.
4362
4363 However the results of other styles of rounding differ if the
4364 digit immediately to the right of the rounding place (skipping the
4365 decimal point) is 5 and if there are no digits, or no digits other
4366 than 0, after that 5. In such cases:
4367
4368 =item 'even'
4369
4370 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
4371 if it is not already. E.g., when rounding to the first sigdig, 0.45
4372 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
4373
4374 =item 'odd'
4375
4376 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
4377 it is not already. E.g., when rounding to the first sigdig, 0.45
4378 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
4379
4380 =item '+inf'
4381
4382 round to plus infinity, i.e. always round up. E.g., when
4383 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
4384 and 0.4501 also becomes 0.5.
4385
4386 =item '-inf'
4387
4388 round to minus infinity, i.e. always round down. E.g., when
4389 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
4390 but 0.4501 becomes 0.5.
4391
4392 =item 'zero'
4393
4394 round to zero, i.e. positive numbers down, negative ones up.
4395 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
4396 becomes -0.5, but 0.4501 becomes 0.5.
4397
4398 =item 'common'
4399
4400 round up if the digit immediately to the right of the rounding place
4401 is 5 or greater, otherwise round down. E.g., 0.15 becomes 0.2 and
4402 0.149 becomes 0.1.
4403
4404 =back
4405
4406 The handling of A & P in MBI/MBF (the old core code shipped with Perl
4407 versions <= 5.7.2) is like this:
4408
4409 =over
4410
4411 =item Precision
4412
4413   * ffround($p) is able to r