#line 1 "Math/BigInt.pm"
package Math::BigInt;

#
# "Mike had an infinite amount to do and a negative amount of time in which
# to do it." - Before and After
#

# The following hash values are used:
#   value: unsigned int with actual value (as a Math::BigInt::Calc or similar)
#   sign : +,-,NaN,+inf,-inf
#   _a   : accuracy
#   _p   : precision
#   _f   : flags, used by MBF to flag parts of a float as untouchable

# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
# underlying lib might change the reference!

use 5.006001;
use strict;
use warnings;

use Carp ();

our $VERSION = '1.999722';
$VERSION = eval $VERSION;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(objectify bgcd blcm);

# _trap_inf and _trap_nan are internal and should never be accessed from the
# outside
our ($round_mode, $accuracy, $precision, $div_scale, $rnd_mode,
     $upgrade, $downgrade, $_trap_nan, $_trap_inf);

my $class = "Math::BigInt";

# Inside overload, the first arg is always an object. If the original code had
# it reversed (like $x = 2 * $y), then the third parameter is true.
# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
# no difference, but in some cases it does.

# For overloaded ops with only one argument we simple use $_[0]->copy() to
# preserve the argument.

# Thus inheritance of overload operators becomes possible and transparent for
# our subclasses without the need to repeat the entire overload section there.

use overload

  # overload key: with_assign

  '+'     =>      sub { $_[0] -> copy() -> badd($_[1]); },

  '-'     =>      sub { my $c = $_[0] -> copy;
                        $_[2] ? $c -> bneg() -> badd( $_[1])
                              : $c -> bsub($_[1]); },

  '*'     =>      sub { $_[0] -> copy() -> bmul($_[1]); },

  '/'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
                              : $_[0] -> copy -> bdiv($_[1]); },


  '%'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
                              : $_[0] -> copy -> bmod($_[1]); },

  '**'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
                              : $_[0] -> copy -> bpow($_[1]); },

  '<<'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
                              : $_[0] -> copy -> blsft($_[1]); },

  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
                              : $_[0] -> copy -> brsft($_[1]); },

  # overload key: assign

  '+='    =>      sub { $_[0]->badd($_[1]); },

  '-='    =>      sub { $_[0]->bsub($_[1]); },

  '*='    =>      sub { $_[0]->bmul($_[1]); },

  '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },

  '%='    =>      sub { $_[0]->bmod($_[1]); },

  '**='   =>      sub { $_[0]->bpow($_[1]); },


  '<<='   =>      sub { $_[0]->blsft($_[1]); },

  '>>='   =>      sub { $_[0]->brsft($_[1]); },

#  'x='    =>      sub { },

#  '.='    =>      sub { },

  # overload key: num_comparison

  '<'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
                              : $_[0] -> blt($_[1]); },

  '<='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
                              : $_[0] -> ble($_[1]); },

  '>'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
                              : $_[0] -> bgt($_[1]); },

  '>='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
                              : $_[0] -> bge($_[1]); },

  '=='    =>      sub { $_[0] -> beq($_[1]); },

  '!='    =>      sub { $_[0] -> bne($_[1]); },

  # overload key: 3way_comparison

  '<=>'   =>      sub { my $cmp = $_[0] -> bcmp($_[1]);
                        defined($cmp) && $_[2] ? -$cmp : $cmp; },

  'cmp'   =>      sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
                              : $_[0] -> bstr() cmp "$_[1]"; },

  # overload key: str_comparison

#  'lt'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
#                              : $_[0] -> bstrlt($_[1]); },
#
#  'le'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
#                              : $_[0] -> bstrle($_[1]); },
#
#  'gt'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
#                              : $_[0] -> bstrgt($_[1]); },
#
#  'ge'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
#                              : $_[0] -> bstrge($_[1]); },
#
#  'eq'    =>      sub { $_[0] -> bstreq($_[1]); },
#
#  'ne'    =>      sub { $_[0] -> bstrne($_[1]); },

  # overload key: binary

  '&'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
                              : $_[0] -> copy -> band($_[1]); },

  '&='    =>      sub { $_[0] -> band($_[1]); },

  '|'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
                              : $_[0] -> copy -> bior($_[1]); },

  '|='    =>      sub { $_[0] -> bior($_[1]); },

  '^'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
                              : $_[0] -> copy -> bxor($_[1]); },

  '^='    =>      sub { $_[0] -> bxor($_[1]); },

#  '&.'    =>      sub { },

#  '&.='   =>      sub { },

#  '|.'    =>      sub { },

#  '|.='   =>      sub { },

#  '^.'    =>      sub { },

#  '^.='   =>      sub { },

  # overload key: unary

  'neg'   =>      sub { $_[0] -> copy() -> bneg(); },

#  '!'     =>      sub { },

  '~'     =>      sub { $_[0] -> copy() -> bnot(); },

#  '~.'    =>      sub { },

  # overload key: mutators

  '++'    =>      sub { $_[0] -> binc() },

  '--'    =>      sub { $_[0] -> bdec() },

  # overload key: func

  'atan2' =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
                              : $_[0] -> copy() -> batan2($_[1]); },

  'cos'   =>      sub { $_[0] -> copy -> bcos(); },

  'sin'   =>      sub { $_[0] -> copy -> bsin(); },

  'exp'   =>      sub { $_[0] -> copy() -> bexp($_[1]); },

  'abs'   =>      sub { $_[0] -> copy() -> babs(); },

  'log'   =>      sub { $_[0] -> copy() -> blog(); },

  'sqrt'  =>      sub { $_[0] -> copy() -> bsqrt(); },

  'int'   =>      sub { $_[0] -> copy() -> bint(); },

  # overload key: conversion

  'bool'  =>      sub { $_[0] -> is_zero() ? '' : 1; },

  '""'    =>      sub { $_[0] -> bstr(); },

  '0+'    =>      sub { $_[0] -> numify(); },

  '='     =>      sub { $_[0]->copy(); },

  ;

##############################################################################
# global constants, flags and accessory

# These vars are public, but their direct usage is not recommended, use the
# accessor methods instead

$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
$accuracy   = undef;
$precision  = undef;
$div_scale  = 40;

$upgrade = undef;                       # default is no upgrade
$downgrade = undef;                     # default is no downgrade

# These are internally, and not to be used from the outside at all

$_trap_nan = 0;                         # are NaNs ok? set w/ config()
$_trap_inf = 0;                         # are infs ok? set w/ config()
my $nan = 'NaN';                        # constants for easier life

my $CALC = 'Math::BigInt::Calc';        # module to do the low level math
                                        # default is Calc.pm
my $IMPORT = 0;                         # was import() called yet?
                                        # used to make require work
my %WARN;                               # warn only once for low-level libs
my %CAN;                                # cache for $CALC->can(...)
my %CALLBACKS;                          # callbacks to notify on lib loads
my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math

##############################################################################
# the old code had $rnd_mode, so we need to support it, too

$rnd_mode   = 'even';
sub TIESCALAR  { my ($class) = @_; bless \$round_mode, $class; }
sub FETCH      { return $round_mode; }
sub STORE      { $rnd_mode = $_[0]->round_mode($_[1]); }

BEGIN
  {
  # tie to enable $rnd_mode to work transparently
  tie $rnd_mode, 'Math::BigInt';

  # set up some handy alias names
  *as_int = \&as_number;
  *is_pos = \&is_positive;
  *is_neg = \&is_negative;
  }

##############################################################################

sub round_mode
  {
  no strict 'refs';
  # make Class->round_mode() work
  my $self = shift;
  my $class = ref($self) || $self || __PACKAGE__;
  if (defined $_[0])
    {
    my $m = shift;
    if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
      {
          Carp::croak("Unknown round mode '$m'");
      }
    return ${"${class}::round_mode"} = $m;
    }
  ${"${class}::round_mode"};
  }

sub upgrade
  {
  no strict 'refs';
  # make Class->upgrade() work
  my $self = shift;
  my $class = ref($self) || $self || __PACKAGE__;
  # need to set new value?
  if (@_ > 0)
    {
    return ${"${class}::upgrade"} = $_[0];
    }
  ${"${class}::upgrade"};
  }

sub downgrade
  {
  no strict 'refs';
  # make Class->downgrade() work
  my $self = shift;
  my $class = ref($self) || $self || __PACKAGE__;
  # need to set new value?
  if (@_ > 0)
    {
    return ${"${class}::downgrade"} = $_[0];
    }
  ${"${class}::downgrade"};
  }

sub div_scale
  {
  no strict 'refs';
  # make Class->div_scale() work
  my $self = shift;
  my $class = ref($self) || $self || __PACKAGE__;
  if (defined $_[0])
    {
    if ($_[0] < 0)
      {
      Carp::croak('div_scale must be greater than zero');
      }
    ${"${class}::div_scale"} = $_[0];
    }
  ${"${class}::div_scale"};
  }

sub accuracy
  {
  # $x->accuracy($a);           ref($x) $a
  # $x->accuracy();             ref($x)
  # Class->accuracy();          class
  # Class->accuracy($a);        class $a

  my $x = shift;
  my $class = ref($x) || $x || __PACKAGE__;

  no strict 'refs';
  # need to set new value?
  if (@_ > 0)
    {
    my $a = shift;
    # convert objects to scalars to avoid deep recursion. If object doesn't
    # have numify(), then hopefully it will have overloading for int() and
    # boolean test without wandering into a deep recursion path...
    $a = $a->numify() if ref($a) && $a->can('numify');

    if (defined $a)
      {
      # also croak on non-numerical
      if (!$a || $a <= 0)
        {
        Carp::croak('Argument to accuracy must be greater than zero');
        }
      if (int($a) != $a)
        {
        Carp::croak('Argument to accuracy must be an integer');
        }
      }
    if (ref($x))
      {
      # $object->accuracy() or fallback to global
      $x->bround($a) if $a;             # not for undef, 0
      $x->{_a} = $a;                    # set/overwrite, even if not rounded
      delete $x->{_p};                  # clear P
      $a = ${"${class}::accuracy"} unless defined $a;   # proper return value
      }
    else
      {
      ${"${class}::accuracy"} = $a;     # set global A
      ${"${class}::precision"} = undef; # clear global P
      }
    return $a;                          # shortcut
    }

  my $a;
  # $object->accuracy() or fallback to global
  $a = $x->{_a} if ref($x);
  # but don't return global undef, when $x's accuracy is 0!
  $a = ${"${class}::accuracy"} if !defined $a;
  $a;
  }

sub precision
  {
  # $x->precision($p);          ref($x) $p
  # $x->precision();            ref($x)
  # Class->precision();         class
  # Class->precision($p);       class $p

  my $x = shift;
  my $class = ref($x) || $x || __PACKAGE__;

  no strict 'refs';
  if (@_ > 0)
    {
    my $p = shift;
    # convert objects to scalars to avoid deep recursion. If object doesn't
    # have numify(), then hopefully it will have overloading for int() and
    # boolean test without wandering into a deep recursion path...
    $p = $p->numify() if ref($p) && $p->can('numify');
    if ((defined $p) && (int($p) != $p))
      {
      Carp::croak('Argument to precision must be an integer');
      }
    if (ref($x))
      {
      # $object->precision() or fallback to global
      $x->bfround($p) if $p;            # not for undef, 0
      $x->{_p} = $p;                    # set/overwrite, even if not rounded
      delete $x->{_a};                  # clear A
      $p = ${"${class}::precision"} unless defined $p;  # proper return value
      }
    else
      {
      ${"${class}::precision"} = $p;    # set global P
      ${"${class}::accuracy"} = undef;  # clear global A
      }
    return $p;                          # shortcut
    }

  my $p;
  # $object->precision() or fallback to global
  $p = $x->{_p} if ref($x);
  # but don't return global undef, when $x's precision is 0!
  $p = ${"${class}::precision"} if !defined $p;
  $p;
  }

sub config
  {
  # return (or set) configuration data as hash ref
  my $class = shift || 'Math::BigInt';

  no strict 'refs';
  if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH')))
    {
    # try to set given options as arguments from hash

    my $args = $_[0];
    if (ref($args) ne 'HASH')
      {
      $args = { @_ };
      }
    # these values can be "set"
    my $set_args = {};
    foreach my $key (
     qw/trap_inf trap_nan
        upgrade downgrade precision accuracy round_mode div_scale/
     )
      {
      $set_args->{$key} = $args->{$key} if exists $args->{$key};
      delete $args->{$key};
      }
    if (keys %$args > 0)
      {
      Carp::croak("Illegal key(s) '",
       join("','",keys %$args),"' passed to $class\->config()");
      }
    foreach my $key (keys %$set_args)
      {
      if ($key =~ /^trap_(inf|nan)\z/)
        {
        ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
        next;
        }
      # use a call instead of just setting the $variable to check argument
      $class->$key($set_args->{$key});
      }
    }

  # now return actual configuration

  my $cfg = {
    lib => $CALC,
    lib_version => ${"${CALC}::VERSION"},
    class => $class,
    trap_nan => ${"${class}::_trap_nan"},
    trap_inf => ${"${class}::_trap_inf"},
    version => ${"${class}::VERSION"},
    };
  foreach my $key (qw/
     upgrade downgrade precision accuracy round_mode div_scale
     /)
    {
    $cfg->{$key} = ${"${class}::$key"};
    };
  if (@_ == 1 && (ref($_[0]) ne 'HASH'))
    {
    # calls of the style config('lib') return just this value
    return $cfg->{$_[0]};
    }
  $cfg;
  }

sub _scale_a
  {
  # select accuracy parameter based on precedence,
  # used by bround() and bfround(), may return undef for scale (means no op)
  my ($x,$scale,$mode) = @_;

  $scale = $x->{_a} unless defined $scale;

  no strict 'refs';
  my $class = ref($x);

  $scale = ${ $class . '::accuracy' } unless defined $scale;
  $mode = ${ $class . '::round_mode' } unless defined $mode;

  if (defined $scale)
    {
    $scale = $scale->can('numify') ? $scale->numify()
                                   : "$scale" if ref($scale);
    $scale = int($scale);
    }

  ($scale,$mode);
  }

sub _scale_p
  {
  # select precision parameter based on precedence,
  # used by bround() and bfround(), may return undef for scale (means no op)
  my ($x,$scale,$mode) = @_;

  $scale = $x->{_p} unless defined $scale;

  no strict 'refs';
  my $class = ref($x);

  $scale = ${ $class . '::precision' } unless defined $scale;
  $mode = ${ $class . '::round_mode' } unless defined $mode;

  if (defined $scale)
    {
    $scale = $scale->can('numify') ? $scale->numify()
                                   : "$scale" if ref($scale);
    $scale = int($scale);
    }

  ($scale,$mode);
  }

##############################################################################
# constructors

sub copy {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # If called as a class method, the object to copy is the next argument.

    $self = shift() unless $selfref;

    my $copy = bless {}, $class;

    $copy->{sign}  = $self->{sign};
    $copy->{value} = $CALC->_copy($self->{value});
    $copy->{_a}    = $self->{_a} if exists $self->{_a};
    $copy->{_p}    = $self->{_p} if exists $self->{_p};

    return $copy;
}

sub new {
    # Create a new Math::BigInt object from a string or another Math::BigInt
    # object. See hash keys documented at top.

    # The argument could be an object, so avoid ||, && etc. on it. This would
    # cause costly overloaded code to be called. The only allowed ops are ref()
    # and defined.

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # The POD says:
    #
    # "Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('')
    # results in 'NaN'. This might change in the future, so use always the
    # following explicit forms to get a zero or NaN:
    #     $zero = Math::BigInt->bzero();
    #     $nan = Math::BigInt->bnan();
    #
    # But although this use has been discouraged for more than 10 years, people
    # apparently still use it, so we still support it.

    return $self->bzero() unless @_;

    my ($wanted, $a, $p, $r) = @_;

    # Always return a new object, so it called as an instance method, copy the
    # invocand, and if called as a class method, initialize a new object.

    $self = $selfref ? $self -> copy()
                     : bless {}, $class;

    unless (defined $wanted) {
        #Carp::carp("Use of uninitialized value in new()");
        return $self->bzero($a, $p, $r);
    }

    if (ref($wanted) && $wanted->isa($class)) {         # MBI or subclass
        # Using "$copy = $wanted -> copy()" here fails some tests. Fixme!
        my $copy = $class -> copy($wanted);
        if ($selfref) {
            %$self = %$copy;
        } else {
            $self = $copy;
        }
        return $self;
    }

    $class->import() if $IMPORT == 0;           # make require work

    # Shortcut for non-zero scalar integers with no non-zero exponent.

    if (!ref($wanted) &&
        $wanted =~ / ^
                     ([+-]?)            # optional sign
                     ([1-9][0-9]*)      # non-zero significand
                     (\.0*)?            # ... with optional zero fraction
                     ([Ee][+-]?0+)?     # optional zero exponent
                     \z
                   /x)
    {
        my $sgn = $1;
        my $abs = $2;
        $self->{sign} = $sgn || '+';
        $self->{value} = $CALC->_new($abs);

        no strict 'refs';
        if (defined($a) || defined($p)
            || defined(${"${class}::precision"})
            || defined(${"${class}::accuracy"}))
        {
            $self->round($a, $p, $r)
              unless @_ >= 3 && !defined $a && !defined $p;
        }

        return $self;
    }

    # Handle Infs.

    if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
        my $sgn = $1 || '+';
        $self->{sign} = $sgn . 'inf';   # set a default sign for bstr()
        return $class->binf($sgn);
    }

    # Handle explicit NaNs (not the ones returned due to invalid input).

    if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
        $self = $class -> bnan();
        $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
        return $self;
    }

    # Handle hexadecimal numbers.

    if ($wanted =~ /^\s*[+-]?0[Xx]/) {
        $self = $class -> from_hex($wanted);
        $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
        return $self;
    }

    # Handle binary numbers.

    if ($wanted =~ /^\s*[+-]?0[Bb]/) {
        $self = $class -> from_bin($wanted);
        $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
        return $self;
    }

    # Split string into mantissa, exponent, integer, fraction, value, and sign.
    my ($mis, $miv, $mfv, $es, $ev) = _split($wanted);
    if (!ref $mis) {
        if ($_trap_nan) {
            Carp::croak("$wanted is not a number in $class");
        }
        $self->{value} = $CALC->_zero();
        $self->{sign} = $nan;
        return $self;
    }

    if (!ref $miv) {
        # _from_hex or _from_bin
        $self->{value} = $mis->{value};
        $self->{sign} = $mis->{sign};
        return $self;   # throw away $mis
    }

    # Make integer from mantissa by adjusting exponent, then convert to a
    # Math::BigInt.
    $self->{sign} = $$mis;           # store sign
    $self->{value} = $CALC->_zero(); # for all the NaN cases
    my $e = int("$$es$$ev");         # exponent (avoid recursion)
    if ($e > 0) {
        my $diff = $e - CORE::length($$mfv);
        if ($diff < 0) {         # Not integer
            if ($_trap_nan) {
                Carp::croak("$wanted not an integer in $class");
            }
            #print "NOI 1\n";
            return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
            $self->{sign} = $nan;
        } else {                 # diff >= 0
            # adjust fraction and add it to value
            #print "diff > 0 $$miv\n";
            $$miv = $$miv . ($$mfv . '0' x $diff);
        }
    }

    else {
        if ($$mfv ne '') {       # e <= 0
            # fraction and negative/zero E => NOI
            if ($_trap_nan) {
                Carp::croak("$wanted not an integer in $class");
            }
            #print "NOI 2 \$\$mfv '$$mfv'\n";
            return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
            $self->{sign} = $nan;
        } elsif ($e < 0) {
            # xE-y, and empty mfv
            # Split the mantissa at the decimal point. E.g., if
            # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123.

            my $frac = substr($$miv, $e); # $frac is fraction part
            substr($$miv, $e) = "";       # $$miv is now integer part

            if ($frac =~ /[^0]/) {
                if ($_trap_nan) {
                    Carp::croak("$wanted not an integer in $class");
                }
                #print "NOI 3\n";
                return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
                $self->{sign} = $nan;
            }
        }
    }

    unless ($self->{sign} eq $nan) {
        $self->{sign} = '+' if $$miv eq '0';            # normalize -0 => +0
        $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
    }

    # If any of the globals are set, use them to round, and store them inside
    # $self. Do not round for new($x, undef, undef) since that is used by MBF
    # to signal no rounding.

    $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
    $self;
}

sub bnan {
    # create/assign a 'NaN'

    if (@_ == 0) {
        Carp::carp("Using bnan() as a function is deprecated;",
                   " use bnan() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref($self);
    my $class   = $selfref || $self;

    {
        no strict 'refs';
        if (${"${class}::_trap_nan"}) {
            Carp::croak("Tried to create NaN in $class->bnan()");
        }
    }

    $self->import() if $IMPORT == 0;            # make require work
    return if $self->modify('bnan');

    $self = bless {}, $class unless $selfref;

    $self -> {sign}  = $nan;
    $self -> {value} = $CALC -> _zero();

    return $self;
}

sub binf {
    # create/assign a '+inf' or '-inf'

    if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
                    $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
    {
        Carp::carp("Using binf() as a function is deprecated;",
                   " use binf() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    {
        no strict 'refs';
        if (${"${class}::_trap_inf"}) {
            Carp::croak("Tried to create +-inf in $class->binf()");
        }
    }

    $self->import() if $IMPORT == 0;            # make require work
    return if $self->modify('binf');

    my $sign = shift;
    $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";

    $self = bless {}, $class unless $selfref;

    $self -> {sign}  = $sign . 'inf';
    $self -> {value} = $CALC -> _zero();

    return $self;
}

sub bzero {
    # create/assign '+0'

    if (@_ == 0) {
        Carp::carp("Using bzero() as a function is deprecated;",
                   " use bzero() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self->import() if $IMPORT == 0;            # make require work
    return if $self->modify('bzero');

    $self = bless {}, $class unless $selfref;

    $self->{sign} = '+';
    $self->{value} = $CALC->_zero();

    if (@_ > 0) {
        if (@_ > 3) {
            # call like: $x->bzero($a, $p, $r, $y, ...);
            ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_);
        } else {
            # call like: $x->bzero($a, $p, $r);
            $self->{_a} = $_[0]
              if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a});
            $self->{_p} = $_[1]
              if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p});
        }
    }

    return $self;
}

sub bone {
    # Create or assign '+1' (or -1 if given sign '-').

    if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
        Carp::carp("Using bone() as a function is deprecated;",
                   " use bone() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self->import() if $IMPORT == 0;            # make require work
    return if $self->modify('bzero');

    my $sign = shift;
    $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";

    $self = bless {}, $class unless $selfref;

    $self->{sign}  = $sign;
    $self->{value} = $CALC->_one();

    if (@_ > 0) {
        if (@_ > 3) {
            # call like: $x->bone($sign, $a, $p, $r, $y, ...);
            ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
        } else {
            # call like: $x->bone($sign, $a, $p, $r);
            $self->{_a} = $_[0]
              if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a});
            $self->{_p} = $_[1]
              if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p});
        }
    }

    return $self;
}

##############################################################################
# string conversion

sub bsstr
  {
  # (ref to BFLOAT or num_str ) return num_str
  # Convert number from internal format to scientific string format.
  # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)
    {
    return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
    return 'inf';                                       # +inf
    }
  my ($m,$e) = $x->parts();
  #$m->bstr() . 'e+' . $e->bstr();      # e can only be positive in BigInt
  # 'e+' because E can only be positive in BigInt
  $m->bstr() . 'e+' . $CALC->_str($e->{value});
  }

sub bstr
  {
  # make a string from bigint object
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)
    {
    return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
    return 'inf';                                       # +inf
    }
  my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
  $es.$CALC->_str($x->{value});
  }

sub numify
  {
  # Make a Perl scalar number from a Math::BigInt object.
  my $x = shift; $x = $class->new($x) unless ref $x;

  if ($x -> is_nan()) {
      require Math::Complex;
      my $inf = Math::Complex::Inf();
      return $inf - $inf;
  }

  if ($x -> is_inf()) {
      require Math::Complex;
      my $inf = Math::Complex::Inf();
      return $x -> is_negative() ? -$inf : $inf;
  }

  my $num = 0 + $CALC->_num($x->{value});
  return $x->{sign} eq '-' ? -$num : $num;
  }

##############################################################################
# public stuff (usually prefixed with "b")

sub sign
  {
  # return the sign of the number: +/-/-inf/+inf/NaN
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $x->{sign};
  }

sub _find_round_parameters {
    # After any operation or when calling round(), the result is rounded by
    # regarding the A & P from arguments, local parameters, or globals.

    # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!

    # This procedure finds the round parameters, but it is for speed reasons
    # duplicated in round. Otherwise, it is tested by the testsuite and used
    # by bdiv().

    # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
    # were requested/defined (locally or globally or both)

    my ($self, $a, $p, $r, @args) = @_;
    # $a accuracy, if given by caller
    # $p precision, if given by caller
    # $r round_mode, if given by caller
    # @args all 'other' arguments (0 for unary, 1 for binary ops)

    my $class = ref($self);       # find out class of argument(s)
    no strict 'refs';

    # convert to normal scalar for speed and correctness in inner parts
    $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
    $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);

    # now pick $a or $p, but only if we have got "arguments"
    if (!defined $a) {
        foreach ($self, @args) {
            # take the defined one, or if both defined, the one that is smaller
            $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
        }
    }
    if (!defined $p) {
        # even if $a is defined, take $p, to signal error for both defined
        foreach ($self, @args) {
            # take the defined one, or if both defined, the one that is bigger
            # -2 > -3, and 3 > 2
            $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
        }
    }

    # if still none defined, use globals (#2)
    $a = ${"$class\::accuracy"}  unless defined $a;
    $p = ${"$class\::precision"} unless defined $p;

    # A == 0 is useless, so undef it to signal no rounding
    $a = undef if defined $a && $a == 0;

    # no rounding today?
    return ($self) unless defined $a || defined $p; # early out

    # set A and set P is an fatal error
    return ($self->bnan()) if defined $a && defined $p; # error

    $r = ${"$class\::round_mode"} unless defined $r;
    if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
        Carp::croak("Unknown round mode '$r'");
    }

    $a = int($a) if defined $a;
    $p = int($p) if defined $p;

    ($self, $a, $p, $r);
}

sub round {
    # Round $self according to given parameters, or given second argument's
    # parameters or global defaults

    # for speed reasons, _find_round_parameters is embedded here:

    my ($self, $a, $p, $r, @args) = @_;
    # $a accuracy, if given by caller
    # $p precision, if given by caller
    # $r round_mode, if given by caller
    # @args all 'other' arguments (0 for unary, 1 for binary ops)

    my $class = ref($self);       # find out class of argument(s)
    no strict 'refs';

    # now pick $a or $p, but only if we have got "arguments"
    if (!defined $a) {
        foreach ($self, @args) {
            # take the defined one, or if both defined, the one that is smaller
            $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
        }
    }
    if (!defined $p) {
        # even if $a is defined, take $p, to signal error for both defined
        foreach ($self, @args) {
            # take the defined one, or if both defined, the one that is bigger
            # -2 > -3, and 3 > 2
            $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
        }
    }

    # if still none defined, use globals (#2)
    $a = ${"$class\::accuracy"}  unless defined $a;
    $p = ${"$class\::precision"} unless defined $p;

    # A == 0 is useless, so undef it to signal no rounding
    $a = undef if defined $a && $a == 0;

    # no rounding today?
    return $self unless defined $a || defined $p; # early out

    # set A and set P is an fatal error
    return $self->bnan() if defined $a && defined $p;

    $r = ${"$class\::round_mode"} unless defined $r;
    if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
        Carp::croak("Unknown round mode '$r'");
    }

    # now round, by calling either bround or bfround:
    if (defined $a) {
        $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a;
    } else {                  # both can't be undefined due to early out
        $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p;
    }

    # bround() or bfround() already called bnorm() if nec.
    $self;
}

sub bnorm
  {
  # (numstr or BINT) return BINT
  # Normalize number -- no-op here
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  $x;
  }

sub babs
  {
  # (BINT or num_str) return BINT
  # make number absolute, or return absolute BINT from string
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return $x if $x->modify('babs');
  # post-normalized abs for internal use (does nothing for NaN)
  $x->{sign} =~ s/^-/+/;
  $x;
  }

sub bsgn {
    # Signum function.

    my $self = shift;

    return $self if $self->modify('bsgn');

    return $self -> bone("+") if $self -> is_pos();
    return $self -> bone("-") if $self -> is_neg();
    return $self;               # zero or NaN
}

sub bneg
  {
  # (BINT or num_str) return BINT
  # negate number or make a negated number from string
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return $x if $x->modify('bneg');

  # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
  $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
  $x;
  }

sub bcmp
  {
  # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
  # (BINT or num_str, BINT or num_str) return cond_code

  # set up parameters
  my ($class,$x,$y) = (ref($_[0]),@_);

  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y) = objectify(2,@_);
    }

  return $upgrade->bcmp($x,$y) if defined $upgrade &&
    ((!$x->isa($class)) || (!$y->isa($class)));

  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    # handle +-inf and NaN
    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
    return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
    return +1 if $x->{sign} eq '+inf';
    return -1 if $x->{sign} eq '-inf';
    return -1 if $y->{sign} eq '+inf';
    return +1;
    }
  # check sign for speed first
  return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
  return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0

  # have same sign, so compare absolute values.  Don't make tests for zero
  # here because it's actually slower than testing in Calc (especially w/ Pari
  # et al)

  # post-normalized compare for internal use (honors signs)
  if ($x->{sign} eq '+')
    {
    # $x and $y both > 0
    return $CALC->_acmp($x->{value},$y->{value});
    }

  # $x && $y both < 0
  $CALC->_acmp($y->{value},$x->{value});        # swapped acmp (lib returns 0,1,-1)
  }

sub bacmp
  {
  # Compares 2 values, ignoring their signs.
  # Returns one of undef, <0, =0, >0. (suitable for sort)
  # (BINT, BINT) return cond_code

  # set up parameters
  my ($class,$x,$y) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y) = objectify(2,@_);
    }

  return $upgrade->bacmp($x,$y) if defined $upgrade &&
    ((!$x->isa($class)) || (!$y->isa($class)));

  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    # handle +-inf and NaN
    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
    return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
    return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
    return -1;
    }
  $CALC->_acmp($x->{value},$y->{value});        # lib does only 0,1,-1
  }

sub beq {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'beq() is an instance method, not a class method' unless $selfref;
    Carp::croak 'Wrong number of arguments for beq()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && ! $cmp;
}

sub bne {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'bne() is an instance method, not a class method' unless $selfref;
    Carp::croak 'Wrong number of arguments for bne()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && ! $cmp ? '' : 1;
}

sub blt {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'blt() is an instance method, not a class method' unless $selfref;
    Carp::croak 'Wrong number of arguments for blt()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp < 0;
}

sub ble {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'ble() is an instance method, not a class method' unless $selfref;
    Carp::croak 'Wrong number of arguments for ble()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp <= 0;
}

sub bgt {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'bgt() is an instance method, not a class method' unless $selfref;
    Carp::croak 'Wrong number of arguments for bgt()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp > 0;
}

sub bge {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    Carp::croak 'bge() is an instance method, not a class method'
        unless $selfref;
    Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp >= 0;
}

#sub bstrcmp {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrcmp() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1;
#
#    return $self -> bstr() CORE::cmp shift;
#}
#
#sub bstreq {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstreq() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstreq()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && ! $cmp;
#}
#
#sub bstrne {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrne() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrne()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && ! $cmp ? '' : 1;
#}
#
#sub bstrlt {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrlt() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrlt()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && $cmp < 0;
#}
#
#sub bstrle {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrle() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrle()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && $cmp <= 0;
#}
#
#sub bstrgt {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrgt() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrgt()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && $cmp > 0;
#}
#
#sub bstrge {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    Carp::croak 'bstrge() is an instance method, not a class method'
#        unless $selfref;
#    Carp::croak 'Wrong number of arguments for bstrge()' unless @_ == 1;
#
#    my $cmp = $self -> bstrcmp(shift);
#    return defined($cmp) && $cmp >= 0;
#}

sub badd
  {
  # add second arg (BINT or string) to first (BINT) (modifies first)
  # return result as BINT

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('badd');
  return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
    ((!$x->isa($class)) || (!$y->isa($class)));

  $r[3] = $y;                           # no push!
  # inf and NaN handling
  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
    {
    # NaN first
    return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
    # inf handling
    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
      {
      # +inf++inf or -inf+-inf => same, rest is NaN
      return $x if $x->{sign} eq $y->{sign};
      return $x->bnan();
      }
    # +-inf + something => +inf
    # something +-inf => +-inf
    $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
    return $x;
    }

  my ($sx, $sy) = ( $x->{sign}, $y->{sign} );           # get signs

  if ($sx eq $sy)
    {
    $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
    }
  else
    {
    my $a = $CALC->_acmp ($y->{value},$x->{value});     # absolute compare
    if ($a > 0)
      {
      $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
      $x->{sign} = $sy;
      }
    elsif ($a == 0)
      {
      # speedup, if equal, set result to 0
      $x->{value} = $CALC->_zero();
      $x->{sign} = '+';
      }
    else # a < 0
      {
      $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
      }
    }
  $x->round(@r);
  }

sub bsub {
    # (BINT or num_str, BINT or num_str) return BINT
    # subtract second arg from first, modify first

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('bsub');

    return $upgrade -> new($x) -> bsub($upgrade -> new($y), @r)
      if defined $upgrade && ((!$x -> isa($class)) || (!$y -> isa($class)));

    return $x -> round(@r) if $y -> is_zero();

    # To correctly handle the lone special case $x -> bsub($x), we note the
    # sign of $x, then flip the sign from $y, and if the sign of $x did change,
    # too, then we caught the special case:

    my $xsign = $x -> {sign};
    $y -> {sign} =~ tr/+-/-+/;  # does nothing for NaN
    if ($xsign ne $x -> {sign}) {
        # special case of $x -> bsub($x) results in 0
        return $x -> bzero(@r) if $xsign =~ /^[+-]$/;
        return $x -> bnan();    # NaN, -inf, +inf
    }
    $x -> badd($y, @r);         # badd does not leave internal zeros
    $y -> {sign} =~ tr/+-/-+/;  # refix $y (does nothing for NaN)
    $x;                         # already rounded by badd() or no rounding
}

sub binc
  {
  # increment arg by one
  my ($class,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  return $x if $x->modify('binc');

  if ($x->{sign} eq '+')
    {
    $x->{value} = $CALC->_inc($x->{value});
    return $x->round($a,$p,$r);
    }
  elsif ($x->{sign} eq '-')
    {
    $x->{value} = $CALC->_dec($x->{value});
    $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
    return $x->round($a,$p,$r);
    }
  # inf, nan handling etc
  $x->badd($class->bone(),$a,$p,$r);             # badd does round
  }

sub bdec
  {
  # decrement arg by one
  my ($class,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  return $x if $x->modify('bdec');

  if ($x->{sign} eq '-')
    {
    # x already < 0
    $x->{value} = $CALC->_inc($x->{value});
    }
  else
    {
    return $x->badd($class->bone('-'),@r)
        unless $x->{sign} eq '+'; # inf or NaN
    # >= 0
    if ($CALC->_is_zero($x->{value}))
      {
      # == 0
      $x->{value} = $CALC->_one(); $x->{sign} = '-';            # 0 => -1
      }
    else
      {
      # > 0
      $x->{value} = $CALC->_dec($x->{value});
      }
    }
  $x->round(@r);
  }

sub blog
  {
  # Return the logarithm of the operand. If a second operand is defined, that
  # value is used as the base, otherwise the base is assumed to be Euler's
  # constant.

  # Don't objectify the base, since an undefined base, as in $x->blog() or
  # $x->blog(undef) signals that the base is Euler's number.

  # set up parameters
  my ($class,$x,$base,@r) = (undef,@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
      ($class,$x,$base,@r) = objectify(1,@_);
  }

  return $x if $x->modify('blog');

  # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
  # (http://www.wolframalpha.com) as the reference for these cases.

  return $x -> bnan() if $x -> is_nan();

  if (defined $base) {
      $base = $class -> new($base) unless ref $base;
      if ($base -> is_nan() || $base -> is_one()) {
          return $x -> bnan();
      } elsif ($base -> is_inf() || $base -> is_zero()) {
          return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
          return $x -> bzero();
      } elsif ($base -> is_negative()) {            # -inf < base < 0
          return $x -> bzero() if $x -> is_one();   #     x = 1
          return $x -> bone()  if $x == $base;      #     x = base
          return $x -> bnan();                      #     otherwise
      }
      return $x -> bone() if $x == $base;           # 0 < base && 0 < x < inf
  }

  # We now know that the base is either undefined or >= 2 and finite.

  return $x -> binf('+') if $x -> is_inf();         #   x = +/-inf
  return $x -> bnan()    if $x -> is_neg();         #   -inf < x < 0
  return $x -> bzero()   if $x -> is_one();         #   x = 1
  return $x -> binf('-') if $x -> is_zero();        #   x = 0

  # At this point we are done handling all exception cases and trivial cases.

  return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade;

  # fix for bug #24969:
  # the default base is e (Euler's number) which is not an integer
  if (!defined $base)
    {
    require Math::BigFloat;
    my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
    # modify $x in place
    $x->{value} = $u->{value};
    $x->{sign} = $u->{sign};
    return $x;
    }

  my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
  return $x->bnan() unless defined $rc;         # not possible to take log?
  $x->{value} = $rc;
  $x->round(@r);
  }

sub bnok
  {
  # Calculate n over k (binomial coefficient or "choose" function) as integer.
  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);

  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bnok');
  return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
  return $x->binf() if $x->{sign} eq '+inf';

  # k > n or k < 0 => 0
  my $cmp = $x->bacmp($y);
  return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/;
  # k == n => 1
  return $x->bone(@r) if $cmp == 0;

  if ($CALC->can('_nok'))
    {
    $x->{value} = $CALC->_nok($x->{value},$y->{value});
    }
  else
    {
    # ( 7 )       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
    # ( - ) = --------- =  --------------- = --------- = 5 * - * -
    # ( 3 )   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3

    if (!$y->is_zero())
      {
      my $z = $x - $y;
      $z->binc();
      my $r = $z->copy(); $z->binc();
      my $d = $class->new(2);
      while ($z->bacmp($x) <= 0)                # f <= x ?
        {
        $r->bmul($z); $r->bdiv($d);
        $z->binc(); $d->binc();
        }
      $x->{value} = $r->{value}; $x->{sign} = '+';
      }
    else { $x->bone(); }
    }
  $x->round(@r);
  }

sub bexp
  {
  # Calculate e ** $x (Euler's number to the power of X), truncated to
  # an integer value.
  my ($class,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  return $x if $x->modify('bexp');

  # inf, -inf, NaN, <0 => NaN
  return $x->bnan() if $x->{sign} eq 'NaN';
  return $x->bone() if $x->is_zero();
  return $x if $x->{sign} eq '+inf';
  return $x->bzero() if $x->{sign} eq '-inf';

  my $u;
  {
    # run through Math::BigFloat unless told otherwise
    require Math::BigFloat unless defined $upgrade;
    local $upgrade = 'Math::BigFloat' unless defined $upgrade;
    # calculate result, truncate it to integer
    $u = $upgrade->bexp($upgrade->new($x),@r);
  }

  if (!defined $upgrade)
    {
    $u = $u->as_int();
    # modify $x in place
    $x->{value} = $u->{value};
    $x->round(@r);
    }
  else { $x = $u; }
  }

sub blcm
  {
  # (BINT or num_str, BINT or num_str) return BINT
  # does not modify arguments, but returns new object
  # Lowest Common Multiple

  my $y = shift; my ($x);
  if (ref($y))
    {
    $x = $y->copy();
    }
  else
    {
    $x = $class->new($y);
    }
  my $class = ref($x);
  while (@_)
    {
    my $y = shift; $y = $class->new($y) if !ref ($y);
    $x = __lcm($x,$y);
    }
  $x;
  }

sub bgcd
  {
  # (BINT or num_str, BINT or num_str) return BINT
  # does not modify arguments, but returns new object
  # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)

  my $y = shift;
  $y = $class->new($y) if !ref($y);
  my $class = ref($y);
  my $x = $y->copy()->babs();                   # keep arguments
  return $x->bnan() if $x->{sign} !~ /^[+-]$/;  # x NaN?

  while (@_)
    {
    $y = shift; $y = $class->new($y) if !ref($y);
    return $x->bnan() if $y->{sign} !~ /^[+-]$/;        # y NaN?
    $x->{value} = $CALC->_gcd($x->{value},$y->{value});
    last if $CALC->_is_one($x->{value});
    }
  $x;
  }

sub bnot
  {
  # (num_str or BINT) return BINT
  # represent ~x as twos-complement number
  # we don't need $class, so undef instead of ref($_[0]) make it slightly faster
  my ($class,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('bnot');
  $x->binc()->bneg();                   # binc already does round
  }

##############################################################################
# is_foo test routines
# we don't need $class, so undef instead of ref($_[0]) make it slightly faster

sub is_zero
  {
  # return true if arg (BINT or num_str) is zero (array '+', '0')
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return 0 if $x->{sign} !~ /^\+$/;                     # -, NaN & +-inf aren't
  $CALC->_is_zero($x->{value});
  }

sub is_nan
  {
  # return true if arg (BINT or num_str) is NaN
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $x->{sign} eq $nan ? 1 : 0;
  }

sub is_inf
  {
  # return true if arg (BINT or num_str) is +-inf
  my ($class,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  if (defined $sign)
    {
    $sign = '[+-]inf' if $sign eq '';   # +- doesn't matter, only that's inf
    $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/;     # extract '+' or '-'
    return $x->{sign} =~ /^$sign$/ ? 1 : 0;
    }
  $x->{sign} =~ /^[+-]inf$/ ? 1 : 0;            # only +-inf is infinity
  }

sub is_one
  {
  # return true if arg (BINT or num_str) is +1, or -1 if sign is given
  my ($class,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  $sign = '+' if !defined $sign || $sign ne '-';

  return 0 if $x->{sign} ne $sign;      # -1 != +1, NaN, +-inf aren't either
  $CALC->_is_one($x->{value});
  }

sub is_odd
  {
  # return true when arg (BINT or num_str) is odd, false for even
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
  $CALC->_is_odd($x->{value});
  }

sub is_even
  {
  # return true when arg (BINT or num_str) is even, false for odd
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
  $CALC->_is_even($x->{value});
  }

sub is_positive
  {
  # return true when arg (BINT or num_str) is positive (> 0)
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return 1 if $x->{sign} eq '+inf';                     # +inf is positive

  # 0+ is neither positive nor negative
  ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
  }

sub is_negative
  {
  # return true when arg (BINT or num_str) is negative (< 0)
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $x->{sign} =~ /^-/ ? 1 : 0;           # -inf is negative, but NaN is not
  }

sub is_int
  {
  # return true when arg (BINT or num_str) is an integer
  # always true for BigInt, but different for BigFloats
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $x->{sign} =~ /^[+-]$/ ? 1 : 0;               # inf/-inf/NaN aren't
  }

###############################################################################

sub bmul
  {
  # multiply the first number by the second number
  # (BINT or num_str, BINT or num_str) return BINT

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bmul');

  return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));

  # inf handling
  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
    {
    return $x->bnan() if $x->is_zero() || $y->is_zero();
    # result will always be +-inf:
    # +inf * +/+inf => +inf, -inf * -/-inf => +inf
    # +inf * -/-inf => -inf, -inf * +/+inf => -inf
    return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
    return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
    return $x->binf('-');
    }

  return $upgrade->bmul($x,$upgrade->new($y),@r)
   if defined $upgrade && !$y->isa($class);

  $r[3] = $y;                           # no push here

  $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +

  $x->{value} = $CALC->_mul($x->{value},$y->{value});   # do actual math
  $x->{sign} = '+' if $CALC->_is_zero($x->{value});     # no -0

  $x->round(@r);
  }

sub bmuladd
  {
  # multiply two numbers and then add the third to the result
  # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT

  # set up parameters
  my ($class,$x,$y,$z,@r) = objectify(3,@_);

  return $x if $x->modify('bmuladd');

  return $x->bnan() if  ($x->{sign} eq $nan) ||
                        ($y->{sign} eq $nan) ||
                        ($z->{sign} eq $nan);

  # inf handling of x and y
  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
    {
    return $x->bnan() if $x->is_zero() || $y->is_zero();
    # result will always be +-inf:
    # +inf * +/+inf => +inf, -inf * -/-inf => +inf
    # +inf * -/-inf => -inf, -inf * +/+inf => -inf
    return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
    return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
    return $x->binf('-');
    }
  # inf handling x*y and z
  if (($z->{sign} =~ /^[+-]inf$/))
    {
    # something +-inf => +-inf
    $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
    }

  return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r)
   if defined $upgrade && (!$y->isa($class) || !$z->isa($class) || !$x->isa($class));

  # TODO: what if $y and $z have A or P set?
  $r[3] = $z;                           # no push here

  $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +

  $x->{value} = $CALC->_mul($x->{value},$y->{value});   # do actual math
  $x->{sign} = '+' if $CALC->_is_zero($x->{value});     # no -0

  my ($sx, $sz) = ( $x->{sign}, $z->{sign} );           # get signs

  if ($sx eq $sz)
    {
    $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
    }
  else
    {
    my $a = $CALC->_acmp ($z->{value},$x->{value});     # absolute compare
    if ($a > 0)
      {
      $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
      $x->{sign} = $sz;
      }
    elsif ($a == 0)
      {
      # speedup, if equal, set result to 0
      $x->{value} = $CALC->_zero();
      $x->{sign} = '+';
      }
    else # a < 0
      {
      $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub
      }
    }
  $x->round(@r);
  }

sub bdiv {
    # This does floored division, where the quotient is floored, i.e., rounded
    # towards negative infinity. As a consequence, the remainder has the same
    # sign as the divisor.

    # Set up parameters.
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify() is costly, so avoid it if we can.
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('bdiv');

    my $wantarray = wantarray;          # call only once

    # At least one argument is NaN. Return NaN for both quotient and the
    # modulo/remainder.

    if ($x -> is_nan() || $y -> is_nan()) {
        return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
    }

    # Divide by zero and modulo zero.
    #
    # Division: Use the common convention that x / 0 is inf with the same sign
    # as x, except when x = 0, where we return NaN. This is also what earlier
    # versions did.
    #
    # Modulo: In modular arithmetic, the congruence relation z = x (mod y)
    # means that there is some integer k such that z - x = k y. If y = 0, we
    # get z - x = 0 or z = x. This is also what earlier versions did, except
    # that 0 % 0 returned NaN.
    #
    #     inf /    0 =  inf                  inf %    0 =  inf
    #       5 /    0 =  inf                    5 %    0 =    5
    #       0 /    0 =  NaN                    0 %    0 =    0
    #      -5 /    0 = -inf                   -5 %    0 =   -5
    #    -inf /    0 = -inf                 -inf %    0 = -inf

    if ($y -> is_zero()) {
        my $rem;
        if ($wantarray) {
            $rem = $x -> copy();
        }
        if ($x -> is_zero()) {
            $x -> bnan();
        } else {
            $x -> binf($x -> {sign});
        }
        return $wantarray ? ($x, $rem) : $x;
    }

    # Numerator (dividend) is +/-inf, and denominator is finite and non-zero.
    # The divide by zero cases are covered above. In all of the cases listed
    # below we return the same as core Perl.
    #
    #     inf / -inf =  NaN                  inf % -inf =  NaN
    #     inf /   -5 = -inf                  inf %   -5 =  NaN
    #     inf /    5 =  inf                  inf %    5 =  NaN
    #     inf /  inf =  NaN                  inf %  inf =  NaN
    #
    #    -inf / -inf =  NaN                 -inf % -inf =  NaN
    #    -inf /   -5 =  inf                 -inf %   -5 =  NaN
    #    -inf /    5 = -inf                 -inf %    5 =  NaN
    #    -inf /  inf =  NaN                 -inf %  inf =  NaN

    if ($x -> is_inf()) {
        my $rem;
        $rem = $class -> bnan() if $wantarray;
        if ($y -> is_inf()) {
            $x -> bnan();
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $x -> binf($sign);
        }
        return $wantarray ? ($x, $rem) : $x;
    }

    # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf
    # are covered above. In the modulo cases (in the right column) we return
    # the same as core Perl, which does floored division, so for consistency we
    # also do floored division in the division cases (in the left column).
    #
    #      -5 /  inf =   -1                   -5 %  inf =  inf
    #       0 /  inf =    0                    0 %  inf =    0
    #       5 /  inf =    0                    5 %  inf =    5
    #
    #      -5 / -inf =    0                   -5 % -inf =   -5
    #       0 / -inf =    0                    0 % -inf =    0
    #       5 / -inf =   -1                    5 % -inf = -inf

    if ($y -> is_inf()) {
        my $rem;
        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
            $rem = $x -> copy() if $wantarray;
            $x -> bzero();
        } else {
            $rem = $class -> binf($y -> {sign}) if $wantarray;
            $x -> bone('-');
        }
        return $wantarray ? ($x, $rem) : $x;
    }

    # At this point, both the numerator and denominator are finite numbers, and
    # the denominator (divisor) is non-zero.

    return $upgrade -> bdiv($upgrade -> new($x), $upgrade -> new($y), @r)
      if defined $upgrade;

    $r[3] = $y;                                   # no push!

    # Inialize remainder.

    my $rem = $class -> bzero();

    # Are both operands the same object, i.e., like $x -> bdiv($x)? If so,
    # flipping the sign of $y also flips the sign of $x.

    my $xsign = $x -> {sign};
    my $ysign = $y -> {sign};

    $y -> {sign} =~ tr/+-/-+/;            # Flip the sign of $y, and see ...
    my $same = $xsign ne $x -> {sign};    # ... if that changed the sign of $x.
    $y -> {sign} = $ysign;                # Re-insert the original sign.

    if ($same) {
        $x -> bone();
    } else {
        ($x -> {value}, $rem -> {value}) =
          $CALC -> _div($x -> {value}, $y -> {value});

        if ($CALC -> _is_zero($rem -> {value})) {
            if ($xsign eq $ysign || $CALC -> _is_zero($x -> {value})) {
                $x -> {sign} = '+';
            } else {
                $x -> {sign} = '-';
            }
        } else {
            if ($xsign eq $ysign) {
                $x -> {sign} = '+';
            } else {
                if ($xsign eq '+') {
                    $x -> badd(1);
                } else {
                    $x -> bsub(1);
                }
                $x -> {sign} = '-';
            }
        }
    }

    $x -> round(@r);

    if ($wantarray) {
        unless ($CALC -> _is_zero($rem -> {value})) {
            if ($xsign ne $ysign) {
                $rem = $y -> copy() -> babs() -> bsub($rem);
            }
            $rem -> {sign} = $ysign;
        }
        $rem -> {_a} = $x -> {_a};
        $rem -> {_p} = $x -> {_p};
        $rem -> round(@r);
        return ($x, $rem);
    }

    return $x;
}

sub btdiv {
    # This does truncated division, where the quotient is truncted, i.e.,
    # rounded towards zero.
    #
    # ($q, $r) = $x -> btdiv($y) returns $q and $r so that $q is int($x / $y)
    # and $q * $y + $r = $x.

    # Set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it if we can.
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('btdiv');

    my $wantarray = wantarray;          # call only once

    # At least one argument is NaN. Return NaN for both quotient and the
    # modulo/remainder.

    if ($x -> is_nan() || $y -> is_nan()) {
        return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
    }

    # Divide by zero and modulo zero.
    #
    # Division: Use the common convention that x / 0 is inf with the same sign
    # as x, except when x = 0, where we return NaN. This is also what earlier
    # versions did.
    #
    # Modulo: In modular arithmetic, the congruence relation z = x (mod y)
    # means that there is some integer k such that z - x = k y. If y = 0, we
    # get z - x = 0 or z = x. This is also what earlier versions did, except
    # that 0 % 0 returned NaN.
    #
    #     inf / 0 =  inf                     inf % 0 =  inf
    #       5 / 0 =  inf                       5 % 0 =    5
    #       0 / 0 =  NaN                       0 % 0 =    0
    #      -5 / 0 = -inf                      -5 % 0 =   -5
    #    -inf / 0 = -inf                    -inf % 0 = -inf

    if ($y -> is_zero()) {
        my $rem;
        if ($wantarray) {
            $rem = $x -> copy();
        }
        if ($x -> is_zero()) {
            $x -> bnan();
        } else {
            $x -> binf($x -> {sign});
        }
        return $wantarray ? ($x, $rem) : $x;
    }

    # Numerator (dividend) is +/-inf, and denominator is finite and non-zero.
    # The divide by zero cases are covered above. In all of the cases listed
    # below we return the same as core Perl.
    #
    #     inf / -inf =  NaN                  inf % -inf =  NaN
    #     inf /   -5 = -inf                  inf %   -5 =  NaN
    #     inf /    5 =  inf                  inf %    5 =  NaN
    #     inf /  inf =  NaN                  inf %  inf =  NaN
    #
    #    -inf / -inf =  NaN                 -inf % -inf =  NaN
    #    -inf /   -5 =  inf                 -inf %   -5 =  NaN
    #    -inf /    5 = -inf                 -inf %    5 =  NaN
    #    -inf /  inf =  NaN                 -inf %  inf =  NaN

    if ($x -> is_inf()) {
        my $rem;
        $rem = $class -> bnan() if $wantarray;
        if ($y -> is_inf()) {
            $x -> bnan();
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $x -> binf($sign);
        }
        return $wantarray ? ($x, $rem) : $x;
    }

    # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf
    # are covered above. In the modulo cases (in the right column) we return
    # the same as core Perl, which does floored division, so for consistency we
    # also do floored division in the division cases (in the left column).
    #
    #      -5 /  inf =    0                   -5 %  inf =  -5
    #       0 /  inf =    0                    0 %  inf =   0
    #       5 /  inf =    0                    5 %  inf =   5
    #
    #      -5 / -inf =    0                   -5 % -inf =  -5
    #       0 / -inf =    0                    0 % -inf =   0
    #       5 / -inf =    0                    5 % -inf =   5

    if ($y -> is_inf()) {
        my $rem;
        $rem = $x -> copy() if $wantarray;
        $x -> bzero();
        return $wantarray ? ($x, $rem) : $x;
    }

    return $upgrade -> btdiv($upgrade -> new($x), $upgrade -> new($y), @r)
      if defined $upgrade;

    $r[3] = $y;                 # no push!

    # Inialize remainder.

    my $rem = $class -> bzero();

    # Are both operands the same object, i.e., like $x -> bdiv($x)? If so,
    # flipping the sign of $y also flips the sign of $x.

    my $xsign = $x -> {sign};
    my $ysign = $y -> {sign};

    $y -> {sign} =~ tr/+-/-+/;            # Flip the sign of $y, and see ...
    my $same = $xsign ne $x -> {sign};    # ... if that changed the sign of $x.
    $y -> {sign} = $ysign;                # Re-insert the original sign.

    if ($same) {
        $x -> bone();
    } else {
        ($x -> {value}, $rem -> {value}) =
          $CALC -> _div($x -> {value}, $y -> {value});

        $x -> {sign} = $xsign eq $ysign ? '+' : '-';
        $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value});
        $x -> round(@r);
    }

    if (wantarray) {
        $rem -> {sign} = $xsign;
        $rem -> {sign} = '+' if $CALC -> _is_zero($rem -> {value});
        $rem -> {_a} = $x -> {_a};
        $rem -> {_p} = $x -> {_p};
        $rem -> round(@r);
        return ($x, $rem);
    }

    return $x;
}

###############################################################################
# modulus functions

sub bmod {
    # This is the remainder after floored division.

    # Set up parameters.
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('bmod');
    $r[3] = $y;                 # no push!

    # At least one argument is NaN.

    if ($x -> is_nan() || $y -> is_nan()) {
        return $x -> bnan();
    }

    # Modulo zero. See documentation for bdiv().

    if ($y -> is_zero()) {
        return $x;
    }

    # Numerator (dividend) is +/-inf.

    if ($x -> is_inf()) {
        return $x -> bnan();
    }

    # Denominator (divisor) is +/-inf.

    if ($y -> is_inf()) {
        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
            return $x;
        } else {
            return $x -> binf($y -> sign());
        }
    }

    # Calc new sign and in case $y == +/- 1, return $x.

    $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value});
    if ($CALC -> _is_zero($x -> {value})) {
        $x -> {sign} = '+';     # do not leave -0
    } else {
        $x -> {value} = $CALC -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x
          if ($x -> {sign} ne $y -> {sign});
        $x -> {sign} = $y -> {sign};
    }

    $x -> round(@r);
}

sub btmod {
    # Remainder after truncated division.

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('btmod');

    # At least one argument is NaN.

    if ($x -> is_nan() || $y -> is_nan()) {
        return $x -> bnan();
    }

    # Modulo zero. See documentation for btdiv().

    if ($y -> is_zero()) {
        return $x;
    }

    # Numerator (dividend) is +/-inf.

    if ($x -> is_inf()) {
        return $x -> bnan();
    }

    # Denominator (divisor) is +/-inf.

    if ($y -> is_inf()) {
        return $x;
    }

    return $upgrade -> btmod($upgrade -> new($x), $upgrade -> new($y), @r)
      if defined $upgrade;

    $r[3] = $y;                 # no push!

    my $xsign = $x -> {sign};
    my $ysign = $y -> {sign};

    $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value});

    $x -> {sign} = $xsign;
    $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value});
    $x -> round(@r);
    return $x;
}

sub bmodinv
  {
  # Return modular multiplicative inverse:
  #
  #   z is the modular inverse of x (mod y) if and only if
  #
  #       x*z ≡ 1  (mod y)
  #
  # If the modulus y is larger than one, x and z are relative primes (i.e.,
  # their greatest common divisor is one).
  #
  # If no modular multiplicative inverse exists, NaN is returned.

  # set up parameters
  my ($class,$x,$y,@r) = (undef,@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bmodinv');

  # Return NaN if one or both arguments is +inf, -inf, or nan.

  return $x->bnan() if ($y->{sign} !~ /^[+-]$/ ||
                        $x->{sign} !~ /^[+-]$/);

  # Return NaN if $y is zero; 1 % 0 makes no sense.

  return $x->bnan() if $y->is_zero();

  # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite
  # integers $x.

  return $x->bzero() if ($y->is_one() ||
                         $y->is_one('-'));

  # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when
  # $x = 0 is when $y = 1 or $y = -1, but that was covered above.
  #
  # Note that computing $x modulo $y here affects the value we'll feed to
  # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x =
  # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and
  # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7.
  # The value if $x is affected only when $x and $y have opposite signs.

  $x->bmod($y);
  return $x->bnan() if $x->is_zero();

  # Compute the modular multiplicative inverse of the absolute values. We'll
  # correct for the signs of $x and $y later. Return NaN if no GCD is found.

  ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value});
  return $x->bnan() if !defined $x->{value};

  # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions
  # <= 1.32 return undef rather than a "+" for the sign.

  $x->{sign} = '+' unless defined $x->{sign};

  # When one or both arguments are negative, we have the following
  # relations.  If x and y are positive:
  #
  #   modinv(-x, -y) = -modinv(x, y)
  #   modinv(-x,  y) = y - modinv(x, y)  = -modinv(x, y) (mod y)
  #   modinv( x, -y) = modinv(x, y) - y  =  modinv(x, y) (mod -y)

  # We must swap the sign of the result if the original $x is negative.
  # However, we must compensate for ignoring the signs when computing the
  # inverse modulo. The net effect is that we must swap the sign of the
  # result if $y is negative.

  $x -> bneg() if $y->{sign} eq '-';

  # Compute $x modulo $y again after correcting the sign.

  $x -> bmod($y) if $x->{sign} ne $y->{sign};

  return $x;
  }

sub bmodpow
  {
  # Modular exponentiation. Raises a very large number to a very large exponent
  # in a given very large modulus quickly, thanks to binary exponentiation.
  # Supports negative exponents.
  my ($class,$num,$exp,$mod,@r) = objectify(3,@_);

  return $num if $num->modify('bmodpow');

  # When the exponent 'e' is negative, use the following relation, which is
  # based on finding the multiplicative inverse 'd' of 'b' modulo 'm':
  #
  #    b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m)

  $num->bmodinv($mod) if ($exp->{sign} eq '-');

  # Check for valid input. All operands must be finite, and the modulus must be
  # non-zero.

  return $num->bnan() if ($num->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
                          $exp->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
                          $mod->{sign} =~ /NaN|inf/);   # NaN, -inf, +inf

  # Modulo zero. See documentation for Math::BigInt's bmod() method.

  if ($mod -> is_zero()) {
      if ($num -> is_zero()) {
          return $class -> bnan();
      } else {
          return $num -> copy();
      }
  }

  # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
  # value is zero, the output is also zero, regardless of the signs on 'a' and
  # 'm'.

  my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value});
  my $sign  = '+';

  # If the resulting value is non-zero, we have four special cases, depending
  # on the signs on 'a' and 'm'.

  unless ($CALC->_is_zero($value)) {

      # There is a negative sign on 'a' (= $num**$exp) only if the number we
      # are exponentiating ($num) is negative and the exponent ($exp) is odd.

      if ($num->{sign} eq '-' && $exp->is_odd()) {

          # When both the number 'a' and the modulus 'm' have a negative sign,
          # use this relation:
          #
          #    -a (mod -m) = -(a (mod m))

          if ($mod->{sign} eq '-') {
              $sign = '-';
          }

          # When only the number 'a' has a negative sign, use this relation:
          #
          #    -a (mod m) = m - (a (mod m))

          else {
              # Use copy of $mod since _sub() modifies the first argument.
              my $mod = $CALC->_copy($mod->{value});
              $value = $CALC->_sub($mod, $value);
              $sign  = '+';
          }

      } else {

          # When only the modulus 'm' has a negative sign, use this relation:
          #
          #    a (mod -m) = (a (mod m)) - m
          #               = -(m - (a (mod m)))

          if ($mod->{sign} eq '-') {
              # Use copy of $mod since _sub() modifies the first argument.
              my $mod = $CALC->_copy($mod->{value});
              $value = $CALC->_sub($mod, $value);
              $sign  = '-';
          }

          # When neither the number 'a' nor the modulus 'm' have a negative
          # sign, directly return the already computed value.
          #
          #    (a (mod m))

      }

  }

  $num->{value} = $value;
  $num->{sign}  = $sign;

  return $num;
  }

###############################################################################

sub bfac
  {
  # (BINT or num_str, BINT or num_str) return BINT
  # compute factorial number from $x, modify $x in place
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('bfac') || $x->{sign} eq '+inf';      # inf => inf
  return $x->bnan() if $x->{sign} ne '+';                       # NaN, <0 etc => NaN

  $x->{value} = $CALC->_fac($x->{value});
  $x->round(@r);
  }

sub bpow
  {
  # (BINT or num_str, BINT or num_str) return BINT
  # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
  # modifies first argument

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bpow');

  return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;

  # inf handling
  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
    {
    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
      {
      # +-inf ** +-inf
      return $x->bnan();
      }
    # +-inf ** Y
    if ($x->{sign} =~ /^[+-]inf/)
      {
      # +inf ** 0 => NaN
      return $x->bnan() if $y->is_zero();
      # -inf ** -1 => 1/inf => 0
      return $x->bzero() if $y->is_one('-') && $x->is_negative();

      # +inf ** Y => inf
      return $x if $x->{sign} eq '+inf';

      # -inf ** Y => -inf if Y is odd
      return $x if $y->is_odd();
      return $x->babs();
      }
    # X ** +-inf

    # 1 ** +inf => 1
    return $x if $x->is_one();

    # 0 ** inf => 0
    return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;

    # 0 ** -inf => inf
    return $x->binf() if $x->is_zero();

    # -1 ** -inf => NaN
    return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;

    # -X ** -inf => 0
    return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;

    # -1 ** inf => NaN
    return $x->bnan() if $x->{sign} eq '-';

    # X ** inf => inf
    return $x->binf() if $y->{sign} =~ /^[+]/;
    # X ** -inf => 0
    return $x->bzero();
    }

  return $upgrade->bpow($upgrade->new($x),$y,@r)
   if defined $upgrade && (!$y->isa($class) || $y->{sign} eq '-');

  $r[3] = $y;                                   # no push!

  # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu

  my $new_sign = '+';
  $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');

  # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
  return $x->binf()
    if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
  # 1 ** -y => 1 / (1 ** |y|)
  # so do test for negative $y after above's clause
  return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});

  $x->{value} = $CALC->_pow($x->{value},$y->{value});
  $x->{sign} = $new_sign;
  $x->{sign} = '+' if $CALC->_is_zero($y->{value});
  $x->round(@r);
  }

sub blsft {
    # (BINT or num_str, BINT or num_str) return BINT
    # compute x << y, base n, y >= 0

    # set up parameters
    my ($class, $x, $y, $b, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $b, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('blsft');
    return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ ||
                            $y -> {sign} !~ /^[+-]$/);
    return $x -> round(@r) if $y -> is_zero();

    $b = 2 if !defined $b;
    return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';

    $x -> {value} = $CALC -> _lsft($x -> {value}, $y -> {value}, $b);
    $x -> round(@r);
}

sub brsft {
    # (BINT or num_str, BINT or num_str) return BINT
    # compute x >> y, base n, y >= 0

    # set up parameters
    my ($class, $x, $y, $b, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $b, @r) = objectify(2, @_);
    }

    return $x if $x -> modify('brsft');
    return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ || $y -> {sign} !~ /^[+-]$/);
    return $x -> round(@r) if $y -> is_zero();
    return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0

    $b = 2 if !defined $b;
    return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';

    # this only works for negative numbers when shifting in base 2
    if (($x -> {sign} eq '-') && ($b == 2)) {
        return $x -> round(@r) if $x -> is_one('-'); # -1 => -1
        if (!$y -> is_one()) {
            # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et
            # al but perhaps there is a better emulation for two's complement
            # shift...
            # if $y != 1, we must simulate it by doing:
            # convert to bin, flip all bits, shift, and be done
            $x -> binc();           # -3 => -2
            my $bin = $x -> as_bin();
            $bin =~ s/^-0b//;       # strip '-0b' prefix
            $bin =~ tr/10/01/;      # flip bits
            # now shift
            if ($y >= CORE::length($bin)) {
                $bin = '0';         # shifting to far right creates -1
                                    # 0, because later increment makes
                                    # that 1, attached '-' makes it '-1'
                                    # because -1 >> x == -1 !
            } else {
                $bin =~ s/.{$y}$//; # cut off at the right side
                $bin = '1' . $bin;  # extend left side by one dummy '1'
                $bin =~ tr/10/01/;  # flip bits back
            }
            my $res = $class -> new('0b' . $bin); # add prefix and convert back
            $res -> binc();                       # remember to increment
            $x -> {value} = $res -> {value};      # take over value
            return $x -> round(@r); # we are done now, magic, isn't?
        }

        # x < 0, n == 2, y == 1
        $x -> bdec();           # n == 2, but $y == 1: this fixes it
    }

    $x -> {value} = $CALC -> _rsft($x -> {value}, $y -> {value}, $b);
    $x -> round(@r);
}

sub band
  {
  #(BINT or num_str, BINT or num_str) return BINT
  # compute x & y

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('band');

  $r[3] = $y;                           # no push!

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);

  my $sx = $x->{sign} eq '+' ? 1 : -1;
  my $sy = $y->{sign} eq '+' ? 1 : -1;

  if ($sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_and($x->{value},$y->{value});
    return $x->round(@r);
    }

  if ($CAN{signed_and})
    {
    $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
    return $x->round(@r);
    }

  require $EMU_LIB;
  __emu_band($class,$x,$y,$sx,$sy,@r);
  }

sub bior
  {
  #(BINT or num_str, BINT or num_str) return BINT
  # compute x | y

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bior');
  $r[3] = $y;                           # no push!

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);

  my $sx = $x->{sign} eq '+' ? 1 : -1;
  my $sy = $y->{sign} eq '+' ? 1 : -1;

  # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()

  # don't use lib for negative values
  if ($sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_or($x->{value},$y->{value});
    return $x->round(@r);
    }

  # if lib can do negative values, let it handle this
  if ($CAN{signed_or})
    {
    $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
    return $x->round(@r);
    }

  require $EMU_LIB;
  __emu_bior($class,$x,$y,$sx,$sy,@r);
  }

sub bxor
  {
  #(BINT or num_str, BINT or num_str) return BINT
  # compute x ^ y

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$x,$y,@r) = objectify(2,@_);
    }

  return $x if $x->modify('bxor');
  $r[3] = $y;                           # no push!

  return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);

  my $sx = $x->{sign} eq '+' ? 1 : -1;
  my $sy = $y->{sign} eq '+' ? 1 : -1;

  # don't use lib for negative values
  if ($sx == 1 && $sy == 1)
    {
    $x->{value} = $CALC->_xor($x->{value},$y->{value});
    return $x->round(@r);
    }

  # if lib can do negative values, let it handle this
  if ($CAN{signed_xor})
    {
    $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
    return $x->round(@r);
    }

  require $EMU_LIB;
  __emu_bxor($class,$x,$y,$sx,$sy,@r);
  }

sub length
  {
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  my $e = $CALC->_len($x->{value});
  wantarray ? ($e,0) : $e;
  }

sub digit
  {
  # return the nth decimal digit, negative values count backward, 0 is right
  my ($class,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  $n = $n->numify() if ref($n);
  $CALC->_digit($x->{value},$n||0);
  }

sub _trailing_zeros
  {
  # return the amount of trailing zeros in $x (as scalar)
  my $x = shift;
  $x = $class->new($x) unless ref $x;

  return 0 if $x->{sign} !~ /^[+-]$/;   # NaN, inf, -inf etc

  $CALC->_zeros($x->{value});           # must handle odd values, 0 etc
  }

sub bsqrt
  {
  # calculate square root of $x
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('bsqrt');

  return $x->bnan() if $x->{sign} !~ /^\+/;     # -x or -inf or NaN => NaN
  return $x if $x->{sign} eq '+inf';            # sqrt(+inf) == inf

  return $upgrade->bsqrt($x,@r) if defined $upgrade;

  $x->{value} = $CALC->_sqrt($x->{value});
  $x->round(@r);
  }

sub broot
  {
  # calculate $y'th root of $x

  # set up parameters
  my ($class,$x,$y,@r) = (ref($_[0]),@_);

  $y = $class->new(2) unless defined $y;

  # objectify is costly, so avoid it
  if ((!ref($x)) || (ref($x) ne ref($y)))
    {
    ($class,$x,$y,@r) = objectify(2,$class || $class,@_);
    }

  return $x if $x->modify('broot');

  # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
  return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
         $y->{sign} !~ /^\+$/;

  return $x->round(@r)
    if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();

  return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;

  $x->{value} = $CALC->_root($x->{value},$y->{value});
  $x->round(@r);
  }

sub exponent
  {
  # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
  my ($class,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)
    {
    my $s = $x->{sign}; $s =~ s/^[+-]//;  # NaN, -inf,+inf => NaN or inf
    return $class->new($s);
    }
  return $class->bzero() if $x->is_zero();

  # 12300 => 2 trailing zeros => exponent is 2
  $class->new( $CALC->_zeros($x->{value}) );
  }

sub mantissa
  {
  # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
  my ($class,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)
    {
    # for NaN, +inf, -inf: keep the sign
    return $class->new($x->{sign});
    }
  my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};

  # that's a bit inefficient:
  my $zeros = $CALC->_zeros($m->{value});
  $m->brsft($zeros,10) if $zeros != 0;
  $m;
  }

sub parts
  {
  # return a copy of both the exponent and the mantissa
  my ($class,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  ($x->mantissa(),$x->exponent());
  }

##############################################################################
# rounding functions

sub bfround
  {
  # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
  # $n == 0 || $n == 1 => round to integer
  my $x = shift; my $class = ref($x) || $x; $x = $class->new($x) unless ref $x;

  my ($scale,$mode) = $x->_scale_p(@_);

  return $x if !defined $scale || $x->modify('bfround');        # no-op

  # no-op for BigInts if $n <= 0
  $x->bround( $x->length()-$scale, $mode) if $scale > 0;

  delete $x->{_a};      # delete to save memory
  $x->{_p} = $scale;    # store new _p
  $x;
  }

sub _scan_for_nonzero
  {
  # internal, used by bround() to scan for non-zeros after a '5'
  my ($x,$pad,$xs,$len) = @_;

  return 0 if $len == 1;                # "5" is trailed by invisible zeros
  my $follow = $pad - 1;
  return 0 if $follow > $len || $follow < 1;

  # use the string form to check whether only '0's follow or not
  substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0;
  }

sub fround
  {
  # Exists to make life easier for switch between MBF and MBI (should we
  # autoload fxxx() like MBF does for bxxx()?)
  my $x = shift; $x = $class->new($x) unless ref $x;
  $x->bround(@_);
  }

sub bround
  {
  # accuracy: +$n preserve $n digits from left,
  #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
  # no-op for $n == 0
  # and overwrite the rest with 0's, return normalized number
  # do not return $x->bnorm(), but $x

  my $x = shift; $x = $class->new($x) unless ref $x;
  my ($scale,$mode) = $x->_scale_a(@_);
  return $x if !defined $scale || $x->modify('bround'); # no-op

  if ($x->is_zero() || $scale == 0)
    {
    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
    return $x;
    }
  return $x if $x->{sign} !~ /^[+-]$/;          # inf, NaN

  # we have fewer digits than we want to scale to
  my $len = $x->length();
  # convert $scale to a scalar in case it is an object (put's a limit on the
  # number length, but this would already limited by memory constraints), makes
  # it faster
  $scale = $scale->numify() if ref ($scale);

  # scale < 0, but > -len (not >=!)
  if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
    {
    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
    return $x;
    }

  # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
  my ($pad,$digit_round,$digit_after);
  $pad = $len - $scale;
  $pad = abs($scale-1) if $scale < 0;

  # do not use digit(), it is very costly for binary => decimal
  # getting the entire string is also costly, but we need to do it only once
  my $xs = $CALC->_str($x->{value});
  my $pl = -$pad-1;

  # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
  # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
  $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
  $pl++; $pl ++ if $pad >= $len;
  $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;

  # in case of 01234 we round down, for 6789 up, and only in case 5 we look
  # closer at the remaining digits of the original $x, remember decision
  my $round_up = 1;                                     # default round up
  $round_up -- if
    ($mode eq 'trunc')                          ||      # trunc by round down
    ($digit_after =~ /[01234]/)                 ||      # round down anyway,
                                                        # 6789 => round up
    ($digit_after eq '5')                       &&      # not 5000...0000
    ($x->_scan_for_nonzero($pad,$xs,$len) == 0)         &&
    (
     ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
     ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
     ($mode eq '+inf') && ($x->{sign} eq '-')   ||
     ($mode eq '-inf') && ($x->{sign} eq '+')   ||
     ($mode eq 'zero')          # round down if zero, sign adjusted below
    );
  my $put_back = 0;                                     # not yet modified

  if (($pad > 0) && ($pad <= $len))
    {
    substr($xs,-$pad,$pad) = '0' x $pad;                # replace with '00...'
    $put_back = 1;                                      # need to put back
    }
  elsif ($pad > $len)
    {
    $x->bzero();                                        # round to '0'
    }

  if ($round_up)                                        # what gave test above?
    {
    $put_back = 1;                                      # need to put back
    $pad = $len, $xs = '0' x $pad if $scale < 0;        # tlr: whack 0.51=>1.0

    # we modify directly the string variant instead of creating a number and
    # adding it, since that is faster (we already have the string)
    my $c = 0; $pad ++;                         # for $pad == $len case
    while ($pad <= $len)
      {
      $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
      substr($xs,-$pad,1) = $c; $pad++;
      last if $c != 0;                          # no overflow => early out
      }
    $xs = '1'.$xs if $c == 0;

    }
  $x->{value} = $CALC->_new($xs) if $put_back == 1;     # put back, if needed

  $x->{_a} = $scale if $scale >= 0;
  if ($scale < 0)
    {
    $x->{_a} = $len+$scale;
    $x->{_a} = 0 if $scale < -$len;
    }
  $x;
  }

sub bfloor
  {
  # round towards minus infinity; no-op since it's already integer
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  $x->round(@r);
  }

sub bceil
  {
  # round towards plus infinity; no-op since it's already int
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  $x->round(@r);
  }

sub bint {
    # round towards zero; no-op since it's already integer
    my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

    $x->round(@r);
}

sub as_number
  {
  # An object might be asked to return itself as bigint on certain overloaded
  # operations. This does exactly this, so that sub classes can simple inherit
  # it or override with their own integer conversion routine.
  $_[0]->copy();
  }

sub as_hex
  {
  # return as hex string, with prefixed 0x
  my $x = shift; $x = $class->new($x) if !ref($x);

  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc

  my $s = '';
  $s = $x->{sign} if $x->{sign} eq '-';
  $s . $CALC->_as_hex($x->{value});
  }

sub as_bin
  {
  # return as binary string, with prefixed 0b
  my $x = shift; $x = $class->new($x) if !ref($x);

  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc

  my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
  return $s . $CALC->_as_bin($x->{value});
  }

sub as_oct
  {
  # return as octal string, with prefixed 0
  my $x = shift; $x = $class->new($x) if !ref($x);

  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc

  my $oct = $CALC->_as_oct($x->{value});
  return $x->{sign} eq '-' ? "-$oct" : $oct;
  }

##############################################################################
# private stuff (internal use only)

sub objectify {
    # Convert strings and "foreign objects" to the objects we want.

    # The first argument, $count, is the number of following arguments that
    # objectify() looks at and converts to objects. The first is a classname.
    # If the given count is 0, all arguments will be used.

    # After the count is read, objectify obtains the name of the class to which
    # the following arguments are converted. If the second argument is a
    # reference, use the reference type as the class name. Otherwise, if it is
    # a string that looks like a class name, use that. Otherwise, use $class.

    # Caller:                        Gives us:
    #
    # $x->badd(1);                => ref x, scalar y
    # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
    # Class->badd(Class->(1),2);  => classname x (scalar), ref x, scalar y
    # Math::BigInt::badd(1,2);    => scalar x, scalar y

    # A shortcut for the common case $x->unary_op():

    return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);

    # Check the context.

    unless (wantarray) {
        Carp::croak("${class}::objectify() needs list context");
    }

    # Get the number of arguments to objectify.

    my $count = shift;
    $count ||= @_;

    # Initialize the output array.

    my @a = @_;

    # If the first argument is a reference, use that reference type as our
    # class name. Otherwise, if the first argument looks like a class name,
    # then use that as our class name. Otherwise, use the default class name.

    {
        if (ref($a[0])) {               # reference?
            unshift @a, ref($a[0]);
            last;
        }
        if ($a[0] =~ /^[A-Z].*::/) {    # string with class name?
            last;
        }
        unshift @a, $class;             # default class name
    }

    no strict 'refs';

    # What we upgrade to, if anything.

    my $up = ${"$a[0]::upgrade"};

    # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs
    # floats.

    my $down;
    if (defined ${"$a[0]::downgrade"}) {
        $down = ${"$a[0]::downgrade"};
        ${"$a[0]::downgrade"} = undef;
    }

    for my $i (1 .. $count) {
        my $ref = ref $a[$i];

        # Perl scalars are fed to the appropriate constructor.

        unless ($ref) {
            $a[$i] = $a[0] -> new($a[$i]);
            next;
        }

        # If it is an object of the right class, all is fine.

        next if $ref -> isa($a[0]);

        # Upgrading is OK, so skip further tests if the argument is upgraded.

        if (defined $up && $ref -> isa($up)) {
            next;
        }

        # See if we can call one of the as_xxx() methods. We don't know whether
        # the as_xxx() method returns an object or a scalar, so re-check
        # afterwards.

        my $recheck = 0;

        if ($a[0] -> isa('Math::BigInt')) {
            if ($a[$i] -> can('as_int')) {
                $a[$i] = $a[$i] -> as_int();
                $recheck = 1;
            } elsif ($a[$i] -> can('as_number')) {
                $a[$i] = $a[$i] -> as_number();
                $recheck = 1;
            }
        }

        elsif ($a[0] -> isa('Math::BigFloat')) {
            if ($a[$i] -> can('as_float')) {
                $a[$i] = $a[$i] -> as_float();
                $recheck = $1;
            }
        }

        # If we called one of the as_xxx() methods, recheck.

        if ($recheck) {
            $ref = ref($a[$i]);

            # Perl scalars are fed to the appropriate constructor.

            unless ($ref) {
                $a[$i] = $a[0] -> new($a[$i]);
                next;
            }

            # If it is an object of the right class, all is fine.

            next if $ref -> isa($a[0]);
        }

        # Last resort.

        $a[$i] = $a[0] -> new($a[$i]);
    }

    # Reset the downgrading.

    ${"$a[0]::downgrade"} = $down;

    return @a;
}

sub _register_callback
  {
  my ($class,$callback) = @_;

  if (ref($callback) ne 'CODE')
    {
    Carp::croak("$callback is not a coderef");
    }
  $CALLBACKS{$class} = $callback;
  }

sub import
  {
  my $class = shift;

  $IMPORT++;                            # remember we did import()
  my @a; my $l = scalar @_;
  my $warn_or_die = 0;                  # 0 - no warn, 1 - warn, 2 - die
  for ( my $i = 0; $i < $l ; $i++ )
    {
    if ($_[$i] eq ':constant')
      {
      # this causes overlord er load to step in
      overload::constant
        integer => sub { $class->new(shift) },
        binary => sub { $class->new(shift) };
      }
    elsif ($_[$i] eq 'upgrade')
      {
      # this causes upgrading
      $upgrade = $_[$i+1];              # or undef to disable
      $i++;
      }
    elsif ($_[$i] =~ /^(lib|try|only)\z/)
      {
      # this causes a different low lib to take care...
      $CALC = $_[$i+1] || '';
      # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
      $warn_or_die = 1 if $_[$i] eq 'lib';
      $warn_or_die = 2 if $_[$i] eq 'only';
      $i++;
      }
    else
      {
      push @a, $_[$i];
      }
    }
  # any non :constant stuff is handled by our parent, Exporter
  if (@a > 0)
    {
    require Exporter;

    $class->SUPER::import(@a);                   # need it for subclasses
    $class->export_to_level(1,$class,@a);         # need it for MBF
    }

  # try to load core math lib
  my @c = split /\s*,\s*/,$CALC;
  foreach (@c)
    {
    $_ =~ tr/a-zA-Z0-9://cd;                    # limit to sane characters
    }
  push @c, \'Calc'                              # if all fail, try these
    if $warn_or_die < 2;                        # but not for "only"
  $CALC = '';                                   # signal error
  foreach my $l (@c)
    {
    # fallback libraries are "marked" as \'string', extract string if nec.
    my $lib = $l; $lib = $$l if ref($l);

    next if ($lib || '') eq '';
    $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
    $lib =~ s/\.pm$//;
    if ($] < 5.006)
      {
      # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
      # used in the same script, or eval("") inside import().
      my @parts = split /::/, $lib;             # Math::BigInt => Math BigInt
      my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
      require File::Spec;
      $file = File::Spec->catfile (@parts, $file);
      eval { require "$file"; $lib->import( @c ); }
      }
    else
      {
      eval "use $lib qw/@c/;";
      }
    if ($@ eq '')
      {
      my $ok = 1;
      # loaded it ok, see if the api_version() is high enough
      if ($lib->can('api_version') && $lib->api_version() >= 1.0)
        {
        $ok = 0;
        # api_version matches, check if it really provides anything we need
        for my $method (qw/
                one two ten
                str num
                add mul div sub dec inc
                acmp len digit is_one is_zero is_even is_odd
                is_two is_ten
                zeros new copy check
                from_hex from_oct from_bin as_hex as_bin as_oct
                rsft lsft xor and or
                mod sqrt root fac pow modinv modpow log_int gcd
         /)
          {
          if (!$lib->can("_$method"))
            {
            if (($WARN{$lib}||0) < 2)
              {
              Carp::carp("$lib is missing method '_$method'");
              $WARN{$lib} = 1;          # still warn about the lib
              }
            $ok++; last;
            }
          }
        }
      if ($ok == 0)
        {
        $CALC = $lib;
        if ($warn_or_die > 0 && ref($l))
          {
          my $msg =
        "Math::BigInt: couldn't load specified math lib(s), fallback to $lib";
          Carp::carp($msg) if $warn_or_die == 1;
          Carp::croak($msg) if $warn_or_die == 2;
          }
        last;                   # found a usable one, break
        }
      else
        {
        if (($WARN{$lib}||0) < 2)
          {
          my $ver = eval "\$$lib\::VERSION" || 'unknown';
          Carp::carp("Cannot load outdated $lib v$ver, please upgrade");
          $WARN{$lib} = 2;              # never warn again
          }
        }
      }
    }
  if ($CALC eq '')
    {
    if ($warn_or_die == 2)
      {
      Carp::croak(
          "Couldn't load specified math lib(s) and fallback disallowed");
      }
    else
      {
      Carp::croak(
          "Couldn't load any math lib(s), not even fallback to Calc.pm");
      }
    }

  # notify callbacks
  foreach my $class (keys %CALLBACKS)
    {
    &{$CALLBACKS{$class}}($CALC);
    }

  # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
  # functions

  %CAN = ();
  for my $method (qw/ signed_and signed_or signed_xor /)
    {
    $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
    }

  # import done
  }

# Create a Math::BigInt from a hexadecimal string.

sub from_hex {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my $str = shift;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if ($str =~ s/
                     ^
                     ( [+-]? )
                     (0?x)?
                     (
                         [0-9a-fA-F]*
                         ( _ [0-9a-fA-F]+ )*
                     )
                     $
                 //x)
    {
        # Get a "clean" version of the string, i.e., non-emtpy and with no
        # underscores or invalid characters.

        my $sign = $1;
        my $chrs = $3;
        $chrs =~ tr/_//d;
        $chrs = '0' unless CORE::length $chrs;

        # The library method requires a prefix.

        $self->{value} = $CALC->_from_hex('0x' . $chrs);

        # Place the sign.

        if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
            $self->{sign} = '-';
        }

        return $self;
    }

    # CORE::hex() parses as much as it can, and ignores any trailing garbage.
    # For backwards compatibility, we return NaN.

    return $self->bnan();
}

# Create a Math::BigInt from an octal string.

sub from_oct {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my $str = shift;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if ($str =~ s/
                     ^
                     ( [+-]? )
                     (
                         [0-7]*
                         ( _ [0-7]+ )*
                     )
                     $
                 //x)
    {
        # Get a "clean" version of the string, i.e., non-emtpy and with no
        # underscores or invalid characters.

        my $sign = $1;
        my $chrs = $2;
        $chrs =~ tr/_//d;
        $chrs = '0' unless CORE::length $chrs;

        # The library method requires a prefix.

        $self->{value} = $CALC->_from_oct('0' . $chrs);

        # Place the sign.

        if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
            $self->{sign} = '-';
        }

        return $self;
    }

    # CORE::oct() parses as much as it can, and ignores any trailing garbage.
    # For backwards compatibility, we return NaN.

    return $self->bnan();
}

# Create a Math::BigInt from a binary string.

sub from_bin {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my $str = shift;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if ($str =~ s/
                     ^
                     ( [+-]? )
                     (0?b)?
                     (
                         [01]*
                         ( _ [01]+ )*
                     )
                     $
                 //x)
    {
        # Get a "clean" version of the string, i.e., non-emtpy and with no
        # underscores or invalid characters.

        my $sign = $1;
        my $chrs = $3;
        $chrs =~ tr/_//d;
        $chrs = '0' unless CORE::length $chrs;

        # The library method requires a prefix.

        $self->{value} = $CALC->_from_bin('0b' . $chrs);

        # Place the sign.

        if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
            $self->{sign} = '-';
        }

        return $self;
    }

    # For consistency with from_hex() and from_oct(), we return NaN when the
    # input is invalid.

    return $self->bnan();
}

sub _split_dec_string {
    my $str = shift;

    if ($str =~ s/
                     ^

                     # leading whitespace
                     ( \s* )

                     # optional sign
                     ( [+-]? )

                     # significand
                     (
                         \d+ (?: _ \d+ )*
                         (?:
                             \.
                             (?: \d+ (?: _ \d+ )* )?
                         )?
                     |
                         \.
                         \d+ (?: _ \d+ )*
                     )

                     # optional exponent
                     (?:
                         [Ee]
                         ( [+-]? )
                         ( \d+ (?: _ \d+ )* )
                     )?

                     # trailing stuff
                     ( \D .*? )?

                     \z
                 //x)
    {
        my $leading         = $1;
        my $significand_sgn = $2 || '+';
        my $significand_abs = $3;
        my $exponent_sgn    = $4 || '+';
        my $exponent_abs    = $5 || '0';
        my $trailing        = $6;

        # Remove underscores and leading zeros.

        $significand_abs =~ tr/_//d;
        $exponent_abs    =~ tr/_//d;

        $significand_abs =~ s/^0+(.)/$1/;
        $exponent_abs    =~ s/^0+(.)/$1/;

        # If the significand contains a dot, remove it and adjust the exponent
        # accordingly. E.g., "1234.56789e+3" -> "123456789e-2"

        my $idx = index $significand_abs, '.';
        if ($idx > -1) {
            $significand_abs =~ s/0+\z//;
            substr($significand_abs, $idx, 1) = '';
            my $exponent = $exponent_sgn . $exponent_abs;
            $exponent .= $idx - CORE::length($significand_abs);
            $exponent_abs = abs $exponent;
            $exponent_sgn = $exponent < 0 ? '-' : '+';
        }

        return($leading,
               $significand_sgn, $significand_abs,
               $exponent_sgn, $exponent_abs,
               $trailing);
    }

    return undef;
}

sub _split
  {
  # input: num_str; output: undef for invalid or
  # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,
  # \$exp_sign,\$exp_value)
  # Internal, take apart a string and return the pieces.
  # Strip leading/trailing whitespace, leading zeros, underscore and reject
  # invalid input.
  my $x = shift;

  # strip white space at front, also extraneous leading zeros
  $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g;   # will not strip '  .2'
  $x =~ s/^\s+//;                       # but this will
  $x =~ s/\s+$//g;                      # strip white space at end

  # shortcut, if nothing to split, return early
  if ($x =~ /^[+-]?[0-9]+\z/)
    {
    $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
    return (\$sign, \$x, \'', \'', \0);
    }

  # invalid starting char?
  return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;

  return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/;        # hex string
  return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/;        # binary string

  # strip underscores between digits
  $x =~ s/([0-9])_([0-9])/$1$2/g;
  $x =~ s/([0-9])_([0-9])/$1$2/g;               # do twice for 1_2_3

  # some possible inputs:
  # 2.1234 # 0.12        # 1          # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
  # .2     # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2     # 0e999

  my ($m,$e,$last) = split /[Ee]/,$x;
  return if defined $last;              # last defined => 1e2E3 or others
  $e = '0' if !defined $e || $e eq "";

  # sign,value for exponent,mantint,mantfrac
  my ($es,$ev,$mis,$miv,$mfv);
  # valid exponent?
  if ($e =~ /^([+-]?)0*([0-9]+)$/)      # strip leading zeros
    {
    $es = $1; $ev = $2;
    # valid mantissa?
    return if $m eq '.' || $m eq '';
    my ($mi,$mf,$lastf) = split /\./,$m;
    return if defined $lastf;           # lastf defined => 1.2.3 or others
    $mi = '0' if !defined $mi;
    $mi .= '0' if $mi =~ /^[\-\+]?$/;
    $mf = '0' if !defined $mf || $mf eq '';
    if ($mi =~ /^([+-]?)0*([0-9]+)$/)           # strip leading zeros
      {
      $mis = $1||'+'; $miv = $2;
      return unless ($mf =~ /^([0-9]*?)0*$/);   # strip trailing zeros
      $mfv = $1;
      # handle the 0e999 case here
      $ev = 0 if $miv eq '0' && $mfv eq '';
      return (\$mis,\$miv,\$mfv,\$es,\$ev);
      }
    }
  return; # NaN, not a number
  }

##############################################################################
# internal calculation routines (others are in Math::BigInt::Calc etc)

sub __lcm
  {
  # (BINT or num_str, BINT or num_str) return BINT
  # does modify first argument
  # LCM

  my ($x,$ty) = @_;
  return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
  my $method = ref($x) . '::bgcd';
  no strict 'refs';
  $x * $ty / &$method($x,$ty);
  }

###############################################################################
# trigonometric functions

sub bpi
  {
  # Calculate PI to N digits. Unless upgrading is in effect, returns the
  # result truncated to an integer, that is, always returns '3'.
  my ($self,$n) = @_;
  if (@_ == 1)
    {
    # called like Math::BigInt::bpi(10);
    $n = $self; $self = $class;
    }
  $self = ref($self) if ref($self);

  return $upgrade->new($n) if defined $upgrade;

  # hard-wired to "3"
  $self->new(3);
  }

sub bcos
  {
  # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the
  # result truncated to an integer.
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('bcos');

  return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN

  return $upgrade->new($x)->bcos(@r) if defined $upgrade;

  require Math::BigFloat;
  # calculate the result and truncate it to integer
  my $t = Math::BigFloat->new($x)->bcos(@r)->as_int();

  $x->bone() if $t->is_one();
  $x->bzero() if $t->is_zero();
  $x->round(@r);
  }

sub bsin
  {
  # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
  # result truncated to an integer.
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('bsin');

  return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN

  return $upgrade->new($x)->bsin(@r) if defined $upgrade;

  require Math::BigFloat;
  # calculate the result and truncate it to integer
  my $t = Math::BigFloat->new($x)->bsin(@r)->as_int();

  $x->bone() if $t->is_one();
  $x->bzero() if $t->is_zero();
  $x->round(@r);
  }

sub batan2
  {
  # calculate arcus tangens of ($y/$x)

  # set up parameters
  my ($class,$y,$x,@r) = (ref($_[0]),@_);
  # objectify is costly, so avoid it
  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
    {
    ($class,$y,$x,@r) = objectify(2,@_);
    }

  return $y if $y->modify('batan2');

  return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);

  # Y    X
  # != 0 -inf result is +- pi
  if ($x->is_inf() || $y->is_inf())
    {
    # upgrade to BigFloat etc.
    return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
    if ($y->is_inf())
      {
      if ($x->{sign} eq '-inf')
        {
        # calculate 3 pi/4 => 2.3.. => 2
        $y->bone( substr($y->{sign},0,1) );
        $y->bmul($class->new(2));
        }
      elsif ($x->{sign} eq '+inf')
        {
        # calculate pi/4 => 0.7 => 0
        $y->bzero();
        }
      else
        {
        # calculate pi/2 => 1.5 => 1
        $y->bone( substr($y->{sign},0,1) );
        }
      }
    else
      {
      if ($x->{sign} eq '+inf')
        {
        # calculate pi/4 => 0.7 => 0
        $y->bzero();
        }
      else
        {
        # PI => 3.1415.. => 3
        $y->bone( substr($y->{sign},0,1) );
        $y->bmul($class->new(3));
        }
      }
    return $y;
    }

  return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;

  require Math::BigFloat;
  my $r = Math::BigFloat->new($y)
                        ->batan2(Math::BigFloat->new($x),@r)
                        ->as_int();

  $x->{value} = $r->{value};
  $x->{sign} = $r->{sign};

  $x;
  }

sub batan
  {
  # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the
  # result truncated to an integer.
  my ($class,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);

  return $x if $x->modify('batan');

  return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN

  return $upgrade->new($x)->batan(@r) if defined $upgrade;

  # calculate the result and truncate it to integer
  my $t = Math::BigFloat->new($x)->batan(@r);

  $x->{value} = $CALC->_new( $x->as_int()->bstr() );
  $x->round(@r);
  }

###############################################################################
# this method returns 0 if the object can be modified, or 1 if not.
# We use a fast constant sub() here, to avoid costly calls. Subclasses
# may override it with special code (f.i. Math::BigInt::Constant does so)

sub modify () { 0; }

1;
__END__

#line 6215
