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