"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Math/BigInt.pm" (7 Mar 2020, 213537 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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