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