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