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