File Coverage

blib/lib/Math/BigInt.pm

Criterion	Covered	Total	%
statement	1549	2178	71.1
branch	1213	2036	59.5
condition	634	1050	60.3
subroutine	181	235	77.0
pod	135	136	99.2
total	3712	5635	65.8

# -*- coding: utf-8-unix -*-

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

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

use 5.006001;
use strict;
use warnings;

use Carp          qw< carp croak >;
use Scalar::Util  qw< blessed refaddr >;

our $VERSION = '1.999842';
$VERSION =~ tr/_//d;

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

# 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]) -> bblsft($_[0])
                              : $_[0] -> copy() -> bblsft($_[1]); },

  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bbrsft($_[0])
                              : $_[0] -> copy() -> bbrsft($_[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] -> bblsft($_[1]); },

  '>>='   =>      sub { $_[0] -> bbrsft($_[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 is 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', or 'common'.
our $round_mode = 'even';
our $accuracy   = undef;
our $precision  = undef;
our $div_scale  = 40;
our $upgrade    = undef;                    # default is no upgrade
our $downgrade  = undef;                    # default is no downgrade

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

our $_trap_nan = 0;                         # are NaNs ok? set w/ config()
our $_trap_inf = 0;                         # are infs ok? set w/ config()

my $nan = 'NaN';                        # constants for easier life

# Module to do the low level math.

my $DEFAULT_LIB = 'Math::BigInt::Calc';
my $LIB;

# Has import() been called yet? Needed to make "require" work.

my $IMPORT = 0;

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

our $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
    *is_pos = \&is_positive;
    *is_neg = \&is_negative;
    *as_number = \&as_int;
}

###############################################################################
# Configuration methods
###############################################################################

sub round_mode {
    my $self = shift;
    my $class = ref($self) || $self || __PACKAGE__;

    if (@_) {                           # setter
        my $m = shift;
        croak("The value for 'round_mode' must be defined")
          unless defined $m;
        croak("Unknown round mode '$m'")
          unless $m =~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/;
        no strict 'refs';
        ${"${class}::round_mode"} = $m;
    }

    else {                              # getter
        no strict 'refs';
        my $m = ${"${class}::round_mode"};
        defined($m) ? $m : $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 {
    my $self = shift;
    my $class = ref($self) || $self || __PACKAGE__;

    if (@_) {                           # setter
        my $ds = shift;
        croak("The value for 'div_scale' must be defined") unless defined $ds;
        # It is not documented what div_scale <= 0 means, but Astro::Units sets
        # div_scale to 0 and fails its tests if this is not supported.
        #croak("The value for 'div_scale' must be positive") unless $ds > 0;
        $ds = $ds -> numify() if defined(blessed($ds));
        no strict 'refs';
        ${"${class}::div_scale"} = $ds;
    }

    else {                              # getter
        no strict 'refs';
        my $ds = ${"${class}::div_scale"};
        defined($ds) ? $ds : $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';
    if (@_ > 0) {
        my $a = shift;
        if (defined $a) {
            $a = $a -> can('numify') ? $a -> numify() : 0 + "$a" if ref($a);
            # also croak on non-numerical
            croak "accuracy must be a number, not '$a'"
              unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
            croak "accuracy must be an integer, not '$a'"
              if $a != int $a;
            croak "accuracy must be greater than zero, not '$a'"
              if $a <= 0;
        }

        if (ref($x)) {
            # Set instance variable.
            $x = $x->bround($a) if defined $a;
            $x->{_a} = $a;      # set/overwrite, even if not rounded
            $x->{_p} = undef;   # clear P
            # Why return class variable here? Fixme!
            $a = ${"${class}::accuracy"} unless defined $a;
        } else {
            # Set class variable.
            ${"${class}::accuracy"}  = $a;      # set global A
            ${"${class}::precision"} = undef;   # clear global P
        }

        return $a;              # shortcut
    }

    # Return instance variable.
    return $x->{_a} if ref($x);

    # Return class variable.
    return ${"${class}::accuracy"};
}

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;
        if (defined $p) {
            $p = $p -> can('numify') ? $p -> numify() : 0 + "$p" if ref($p);
            croak "precision must be a number, not '$p'"
              unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
            croak "precision must be an integer, not '$p'"
              if $p != int $p;
        }

        if (ref($x)) {
            # Set instance variable.
            $x = $x->bfround($p) if defined $p;
            $x->{_p} = $p;      # set/overwrite, even if not rounded
            $x->{_a} = undef;   # clear A
            # Why return class variable here? Fixme!
            $p = ${"${class}::precision"} unless defined $p;
        } else {
            # Set class variable.
            ${"${class}::precision"} = $p;      # set global P
            ${"${class}::accuracy"}  = undef;   # clear global A
        }

        return $p;              # shortcut
    }

    # Return instance variable.
    return $x->{_p} if ref($x);

    # Return class variable.
    return ${"${class}::precision"};
}

sub config {
    # return (or set) configuration data.
    my $class = shift || __PACKAGE__;

    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/
                               accuracy precision
                               round_mode div_scale
                               upgrade downgrade
                               trap_inf trap_nan
                           /)
        {
            $set_args->{$key} = $args->{$key} if exists $args->{$key};
            delete $args->{$key};
        }
        if (keys %$args > 0) {
            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         => $LIB,
               lib_version => ${"${LIB}::VERSION"},
               class       => $class,
               trap_nan    => ${"${class}::_trap_nan"},
               trap_inf    => ${"${class}::_trap_inf"},
               version     => ${"${class}::VERSION"},
              };
    foreach my $key (qw/
                           accuracy precision
                           round_mode div_scale
                           upgrade downgrade
                       /)
    {
        $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);
}

###############################################################################
# Constructor methods
###############################################################################

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;

    # Make "require" work.

    $class -> import() if $IMPORT == 0;

    # Calling new() with no input arguments has been discouraged for more than
    # 10 years, but people apparently still use it, so we still support it.

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

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

    if (!defined($wanted)) {
        #carp("Use of uninitialized value in new()")
        #  if warnings::enabled("uninitialized");
        return $class -> bzero(@r);
    }

    if (!ref($wanted) && $wanted eq "") {
        #carp(q|Argument "" isn't numeric in new()|)
        #  if warnings::enabled("numeric");
        #return $class -> bzero(@r);
        return $class -> bnan(@r);
    }

    # Initialize a new object.

    $self = bless {}, $class;

    # Math::BigInt or subclass

    if (defined(blessed($wanted)) && $wanted -> isa(__PACKAGE__)) {

        # Don't copy the accuracy and precision, because a new object should get
        # them from the global configuration.

        $self -> {sign}  = $wanted -> {sign};
        $self -> {value} = $LIB -> _copy($wanted -> {value});
        $self = $self->round(@r)
          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

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

    if ($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} = $LIB->_new($abs);
        $self = $self->round(@r);
        return $self;
    }

    # Handle Infs.

    if ($wanted =~ / ^
                     \s*
                     ( [+-]? )
                     inf (?: inity )?
                     \s*
                     \z
                   /ix)
    {
        my $sgn = $1 || '+';
        return $class -> binf($sgn, @r);
    }

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

    if ($wanted =~ / ^
                     \s*
                     ( [+-]? )
                     nan
                     \s*
                     \z
                   /ix)
    {
        return $class -> bnan(@r);
    }

    my @parts;

    if (
        # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
        # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Xx]/ and
        @parts = $class -> _hex_str_to_flt_lib_parts($wanted)

          or

        # Handle octal numbers. We auto-detect octal numbers if they have a
        # "0o", "0O", "o", "O" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Oo]/ and
        @parts = $class -> _oct_str_to_flt_lib_parts($wanted)

          or

        # Handle binary numbers. We auto-detect binary numbers if they have a
        # "0b", "0B", "b", or "B" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Bb]/ and
        @parts = $class -> _bin_str_to_flt_lib_parts($wanted)

          or

        # At this point, what is left are decimal numbers that aren't handled
        # above and octal floating point numbers that don't have any of the
        # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number.

        @parts = $class -> _dec_str_to_flt_lib_parts($wanted)
          or

        # See if it is an octal floating point number. The extra check is
        # included because _oct_str_to_flt_lib_parts() accepts octal numbers
        # that don't have a prefix (this is needed to make it work with, e.g.,
        # from_oct() that don't require a prefix). However, Perl requires a
        # prefix for octal floating point literals. For example, "1p+0" is not
        # valid, but "01p+0" and "0__1p+0" are.

        $wanted =~ /^\s*[+-]?0_*\d/ and
        @parts = $class -> _oct_str_to_flt_lib_parts($wanted))
    {
        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            $self -> {sign}  = $parts[0];
            $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
            $self = $self->round(@r)
              unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
            return $self;
        }

        # The value is not an integer, so upgrade if upgrading is enabled.

        return $upgrade -> new($wanted, @r) if defined $upgrade;
    }

    # If we get here, the value is neither a valid decimal, binary, octal, or
    # hexadecimal number. It is not explicit an Inf or a NaN either.

    return $class -> bnan(@r);
}

# Create a Math::BigInt from a decimal string. This is an equivalent to
# from_hex(), from_oct(), and from_bin(). It is like new() except that it does
# not accept anything but a string representing a finite decimal number.

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_dec');

    my $str = shift;
    my @r   = @_;

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

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

    if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            $self -> {sign}  = $parts[0];
            $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
            return $self -> round(@r);
        }

        # The value is not an integer, so upgrade if upgrading is enabled.

        return $upgrade -> new($str, @r) if defined $upgrade;
    }

    return $self -> bnan(@r);
}

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_hex');

    my $str = shift;
    my @r   = @_;

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

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

    if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            $self -> {sign}  = $parts[0];
            $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
            return $self -> round(@r);
        }

        # The value is not an integer, so upgrade if upgrading is enabled.

        return $upgrade -> new($str, @r) if defined $upgrade;
    }

    return $self -> bnan(@r);
}

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_oct');

    my $str = shift;
    my @r   = @_;

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

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

    if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            $self -> {sign}  = $parts[0];
            $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
            return $self -> round(@r);
        }

        # The value is not an integer, so upgrade if upgrading is enabled.

        return $upgrade -> new($str, @r) if defined $upgrade;
    }

    return $self -> bnan(@r);
}

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_bin');

    my $str = shift;
    my @r   = @_;

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

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

    if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            $self -> {sign}  = $parts[0];
            $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
            return $self -> round(@r);
        }

        # The value is not an integer, so upgrade if upgrading is enabled.

        return $upgrade -> new($str, @r) if defined $upgrade;
    }

    return $self -> bnan(@r);
}

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_bytes');

    croak("from_bytes() requires a newer version of the $LIB library.")
        unless $LIB->can('_from_bytes');

    my $str = shift;
    my @r = @_;

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

    $self = $class -> bzero(@r) unless $selfref;
    $self -> {sign}  = '+';
    $self -> {value} = $LIB -> _from_bytes($str);
    return $self -> round(@r);
}

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_base');

    my ($str, $base, $cs, @r) = @_;     # $cs is the collation sequence

    $base = $class->new($base) unless ref($base);

    croak("the base must be a finite integer >= 2")
      if $base < 2 || ! $base -> is_int();

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

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

    # If no collating sequence is given, pass some of the conversions to
    # methods optimized for those cases.

    unless (defined $cs) {
        return $self -> from_bin($str, @r) if $base == 2;
        return $self -> from_oct($str, @r) if $base == 8;
        return $self -> from_hex($str, @r) if $base == 16;
        if ($base == 10) {
            my $tmp = $class -> from_dec($str, @r);
            $self -> {value} = $tmp -> {value};
            $self -> {sign}  = '+';
            return $self -> bround(@r);
        }
    }

    croak("from_base() requires a newer version of the $LIB library.")
      unless $LIB->can('_from_base');

    $self -> {sign}  = '+';
    $self -> {value}
      = $LIB->_from_base($str, $base -> {value}, defined($cs) ? $cs : ());
    return $self -> bround(@r);
}

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('from_base_num');

    # Make sure we have an array of non-negative, finite, numerical objects.

    my $nums = shift;
    $nums = [ @$nums ];         # create new reference

    for my $i (0 .. $#$nums) {
        # Make sure we have an object.
        $nums -> [$i] = $class -> new($nums -> [$i])
          unless defined(blessed($nums -> [$i]))
                   && $nums -> [$i] -> isa(__PACKAGE__);
        # Make sure we have a finite, non-negative integer.
        croak "the elements must be finite non-negative integers"
          if $nums -> [$i] -> is_neg() || ! $nums -> [$i] -> is_int();
    }

    my $base = shift;
    $base = $class -> new($base)
      unless defined(blessed($base)) && $base -> isa(__PACKAGE__);

    my @r = @_;

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

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

    croak("from_base_num() requires a newer version of the $LIB library.")
      unless $LIB->can('_from_base_num');

    $self -> {sign}  = '+';
    $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ],
                                           $base -> {value});

    return $self -> round(@r);
}

sub bzero {
    # create/assign '+0'

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is 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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('bzero');

    # Get the rounding parameters, if any.

    my @r = @_;

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

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

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

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method, initialize the new
    # instance with the class variables.

    if (@r) {
        croak "can't specify both accuracy and precision"
          if @r >= 2 && defined($r[0]) && defined($r[1]);
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } elsif (!$selfref) {
        $self->{_a} = $class -> accuracy();
        $self->{_p} = $class -> precision();
    }

    return $self;
}

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

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is 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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('bone');

    my ($sign, @r) = @_;

    # Get the sign.

    if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) {
        $sign = $1;
        shift;
    } else {
        $sign = '+';
    }

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

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

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

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method, initialize the new
    # instance with the class variables.

    if (@r) {
        croak "can't specify both accuracy and precision"
          if @r >= 2 && defined($r[0]) && defined($r[1]);
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } elsif (!$selfref) {
        $self->{_a} = $class -> accuracy();
        $self->{_p} = $class -> precision();
    }

    return $self;
}

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

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is as a method instead";
        unshift @_, __PACKAGE__;
    }

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

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('binf');

    # Get the sign.

    my $sign = '+';     # default is to return positive infinity
    if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) {
        $sign = $1;
        shift;
    }

    # Get the rounding parameters, if any.

    my @r = @_;

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

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

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

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method, initialize the new
    # instance with the class variables.

    if (@r) {
        croak "can't specify both accuracy and precision"
          if @r >= 2 && defined($r[0]) && defined($r[1]);
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } elsif (!$selfref) {
        $self->{_a} = $class -> accuracy();
        $self->{_p} = $class -> precision();
    }

    return $self;
}

sub bnan {
    # create/assign a 'NaN'

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is as a method instead";
        unshift @_, __PACKAGE__;
    }

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

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

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

    # Don't modify constant (read-only) objects.

    return $self if $selfref && $self->modify('bnan');

    # Get the rounding parameters, if any.

    my @r = @_;

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

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

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method, initialize the new
    # instance with the class variables.

    if (@r) {
        croak "can't specify both accuracy and precision"
          if @r >= 2 && defined($r[0]) && defined($r[1]);
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } elsif (!$selfref) {
        $self->{_a} = $class -> accuracy();
        $self->{_p} = $class -> precision();
    }

    return $self;
}

sub bpi {

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is as a method instead";
        unshift @_, __PACKAGE__;
    }

    # Called as                 Argument list
    # ---------                 -------------
    # Math::BigFloat->bpi()     ("Math::BigFloat")
    # Math::BigFloat->bpi(10)   ("Math::BigFloat", 10)
    # $x->bpi()                 ($x)
    # $x->bpi(10)               ($x, 10)
    # Math::BigFloat::bpi()     ()
    # Math::BigFloat::bpi(10)   (10)
    #
    # In ambiguous cases, we favour the OO-style, so the following case
    #
    #   $n = Math::BigFloat->new("10");
    #   $x = Math::BigFloat->bpi($n);
    #
    # which gives an argument list with the single element $n, is resolved as
    #
    #   $n->bpi();

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;
    my @r       = @_;                   # rounding paramters

    if ($selfref) {                     # bpi() called as an instance method
        return $self if $self -> modify('bpi');
    } else {                            # bpi() called as a class method
        $self = bless {}, $class;       # initialize new instance
    }

    return $upgrade -> bpi(@r) if defined $upgrade;

    # hard-wired to "3"
    $self -> {sign}  = '+';
    $self -> {value} = $LIB -> _new("3");
    $self = $self -> round(@r);
    return $self;
}

sub copy {
    my ($x, $class);
    if (ref($_[0])) {           # $y = $x -> copy()
        $x = shift;
        $class = ref($x);
    } else {                    # $y = Math::BigInt -> copy($y)
        $class = shift;
        $x = shift;
    }

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @_;

    my $copy = bless {}, $class;

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

    return $copy;
}

sub as_int {
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # If called as an instance method, and the instance class is something we
    # upgrade to, $x might not be a Math::BigInt, so don't just call copy().

    return $x -> copy() if $x -> isa("Math::BigInt");

    # disable upgrading and downgrading

    my $upg = Math::BigInt -> upgrade();
    my $dng = Math::BigInt -> downgrade();
    Math::BigInt -> upgrade(undef);
    Math::BigInt -> downgrade(undef);

    my $y = Math::BigInt -> new($x);

    # reset upgrading and downgrading

    Math::BigInt -> upgrade($upg);
    Math::BigInt -> downgrade($dng);

    return $y;
}

sub as_float {
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # disable upgrading and downgrading

    require Math::BigFloat;
    my $upg = Math::BigFloat -> upgrade();
    my $dng = Math::BigFloat -> downgrade();
    Math::BigFloat -> upgrade(undef);
    Math::BigFloat -> downgrade(undef);

    my $y = Math::BigFloat -> new($x);

    # reset upgrading and downgrading

    Math::BigFloat -> upgrade($upg);
    Math::BigFloat -> downgrade($dng);

    return $y;
}

sub as_rat {
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # disable upgrading and downgrading

    require Math::BigRat;
    my $upg = Math::BigRat -> upgrade();
    my $dng = Math::BigRat -> downgrade();
    Math::BigRat -> upgrade(undef);
    Math::BigRat -> downgrade(undef);

    my $y = Math::BigRat -> new($x);

    # reset upgrading and downgrading

    Math::BigRat -> upgrade($upg);
    Math::BigRat -> downgrade($dng);

    return $y;
}

###############################################################################
# Boolean methods
###############################################################################

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

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

sub is_one {
    # return true if arg (BINT or num_str) is +1, or -1 if sign is given
    my (undef, $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
    $LIB->_is_one($x->{value});
}

sub is_finite {
    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
    return $x->{sign} eq '+' || $x->{sign} eq '-';
}

sub is_inf {
    # return true if arg (BINT or num_str) is +-inf
    my (undef, $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_nan {
    # return true if arg (BINT or num_str) is NaN
    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);

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

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

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

sub is_non_negative {
    # Return true if argument is non-negative (>= 0).
    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);

    return 1 if $x->{sign} =~ /^\+/;
    return 1 if $x -> is_zero();
    return 0;
}

sub is_non_positive {
    # Return true if argument is non-positive (<= 0).
    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);

    return 1 if $x->{sign} =~ /^\-/;
    return 1 if $x -> is_zero();
    return 0;
}

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

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

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

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

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

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

###############################################################################
# Comparison methods
###############################################################################

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, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
        # handle +-inf and NaN
        return    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 $LIB->_acmp($x->{value}, $y->{value});
    }

    # $x && $y both < 0
    $LIB->_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, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
        # handle +-inf and NaN
        return   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;
    }
    $LIB->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1
}

sub beq {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && !$cmp;
}

sub bne {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && !$cmp ? '' : 1;
}

sub blt {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && $cmp < 0;
}

sub ble {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && $cmp <= 0;
}

sub bgt {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && $cmp > 0;
}

sub bge {
    my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                           ? (undef, @_)
                           : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    my $cmp = $x -> bcmp($y);           # bcmp() upgrades if necessary
    return defined($cmp) && $cmp >= 0;
}

###############################################################################
# Arithmetic methods
###############################################################################

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

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

    return $upgrade -> bneg($x, @r)
      if defined($upgrade) && !$x->isa(__PACKAGE__);

    # Don't negate +0 so we always have the normalized form +0. Does nothing for
    # 'NaN'.
    $x->{sign} =~ tr/+-/-+/
      unless $x->{sign} eq '+' && $LIB->_is_zero($x->{value});

    $x -> round(@r);
}

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

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

    return $upgrade -> babs($x, @r)
      if defined($upgrade) && !$x->isa(__PACKAGE__) && !$x -> isa($upgrade);

    $x->{sign} =~ s/^-/+/;

    $x -> round(@r);
}

sub bsgn {
    # Signum function.
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    return $upgrade -> bsgn($x, @r)
      if defined($upgrade) && !$x->isa(__PACKAGE__) && !$x -> isa($upgrade);

    return $x -> bone("+", @r) if $x -> is_pos();
    return $x -> bone("-", @r) if $x -> is_neg();

    $x -> round(@r);
}

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

    # This method is called from the rounding methods, so if this method
    # supports rounding by calling the rounding methods, we get an infinite
    # recursion.

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    $x;
}

sub binc {
    # increment arg by one
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    return $x->round(@r) if $x -> is_inf() || $x -> is_nan();

    return $upgrade -> binc($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    if ($x->{sign} eq '+') {
        $x->{value} = $LIB->_inc($x->{value});
    } elsif ($x->{sign} eq '-') {
        $x->{value} = $LIB->_dec($x->{value});
        $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # -1 +1 => -0 => +0
    }

    return $x->round(@r);
}

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

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

    return $x->round(@r) if $x -> is_inf() || $x -> is_nan();

    return $upgrade -> bdec($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);;

    if ($x->{sign} eq '-') {
        $x->{value} = $LIB->_inc($x->{value});
    } elsif ($x->{sign} eq '+') {
        if ($LIB->_is_zero($x->{value})) {      # +1 - 1 => +0
            $x->{value} = $LIB->_one();
            $x->{sign} = '-';
        } else {
            $x->{value} = $LIB->_dec($x->{value});
        }
    }

    return $x->round(@r);
}

#sub bstrcmp {
#    my $self    = shift;
#    my $selfref = ref $self;
#    my $class   = $selfref || $self;
#
#    croak 'bstrcmp() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstreq() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstrne() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstrlt() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstrle() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstrgt() is an instance method, not a class method'
#        unless $selfref;
#    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;
#
#    croak 'bstrge() is an instance method, not a class method'
#        unless $selfref;
#    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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

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

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

    # Inf and NaN handling
    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
        # NaN first
        return $x->bnan(@r) 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->round(@r) if $x->{sign} eq $y->{sign};
            return $x->bnan(@r);
        }
        # ±Inf + something => ±Inf
        # something + ±Inf => ±Inf
        if ($y->{sign} =~ /^[+-]inf$/) {
            $x->{sign} = $y->{sign};
        }
        return $x -> round(@r);
    }

    ($x->{value}, $x->{sign})
      = $LIB -> _sadd($x->{value}, $x->{sign}, $y->{value}, $y->{sign});
    $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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

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

    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(@r);    # NaN, -inf, +inf
    }

    $x = $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 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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

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

    # inf handling
    if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
        return $x->bnan(@r) 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(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
        return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
        return $x->binf('-', @r);
    }

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

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

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

    $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
    $x->{sign} = '+' if $LIB->_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)
      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
      ? (ref($_[0]), @_)
      : objectify(3, @_);

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

    # x, y, and z are finite numbers

    if ($x->{sign} =~ /^[+-]$/ &&
        $y->{sign} =~ /^[+-]$/ &&
        $z->{sign} =~ /^[+-]$/)
    {
        return $upgrade->bmuladd($x, $y, $z, @r)
          if defined($upgrade) && (!$x->isa(__PACKAGE__) ||
                                   !$y->isa(__PACKAGE__) ||
                                   !$z->isa(__PACKAGE__));

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

        my $zs = $z->{sign};
        my $zv = $z->{value};
        $zv = $LIB -> _copy($zv) if refaddr($x) eq refaddr($z);

        $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
        $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
        $x->{sign} = '+' if $LIB->_is_zero($x->{value});    # no -0

        ($x->{value}, $x->{sign})
          = $LIB -> _sadd($x->{value}, $x->{sign}, $zv, $zs);
        return $x->round(@r);
    }

    # At least one of x, y, and z is a NaN

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

    # At least one of x, y, and z is an Inf

    if ($x->{sign} eq "-inf") {

        if ($y -> is_neg()) {               # x = -inf, y < 0
            if ($z->{sign} eq "-inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("+", @r);
            }
        } elsif ($y -> is_zero()) {         # x = -inf, y = 0
            return $x->bnan(@r);
        } else {                            # x = -inf, y > 0
            if ($z->{sign} eq "+inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("-", @r);
            }
        }

    } elsif ($x->{sign} eq "+inf") {

        if ($y -> is_neg()) {               # x = +inf, y < 0
            if ($z->{sign} eq "+inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("-", @r);
            }
        } elsif ($y -> is_zero()) {         # x = +inf, y = 0
            return $x->bnan(@r);
        } else {                            # x = +inf, y > 0
            if ($z->{sign} eq "-inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("+", @r);
            }
        }

    } elsif ($x -> is_neg()) {

        if ($y->{sign} eq "-inf") {         # -inf < x < 0, y = -inf
            if ($z->{sign} eq "-inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("+", @r);
            }
        } elsif ($y->{sign} eq "+inf") {    # -inf < x < 0, y = +inf
            if ($z->{sign} eq "+inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("-", @r);
            }
        } else {                            # -inf < x < 0, -inf < y < +inf
            if ($z->{sign} eq "-inf") {
                return $x->binf("-", @r);
            } elsif ($z->{sign} eq "+inf") {
                return $x->binf("+", @r);
            }
        }

    } elsif ($x -> is_zero()) {

        if ($y->{sign} eq "-inf") {         # x = 0, y = -inf
            return $x->bnan(@r);
        } elsif ($y->{sign} eq "+inf") {    # x = 0, y = +inf
            return $x->bnan(@r);
        } else {                            # x = 0, -inf < y < +inf
            if ($z->{sign} eq "-inf") {
                return $x->binf("-", @r);
            } elsif ($z->{sign} eq "+inf") {
                return $x->binf("+", @r);
            }
        }

    } elsif ($x -> is_pos()) {

        if ($y->{sign} eq "-inf") {         # 0 < x < +inf, y = -inf
            if ($z->{sign} eq "+inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("-", @r);
            }
        } elsif ($y->{sign} eq "+inf") {    # 0 < x < +inf, y = +inf
            if ($z->{sign} eq "-inf") {
                return $x->bnan(@r);
            } else {
                return $x->binf("+", @r);
            }
        } else {                            # 0 < x < +inf, -inf < y < +inf
            if ($z->{sign} eq "-inf") {
                return $x->binf("-", @r);
            } elsif ($z->{sign} eq "+inf") {
                return $x->binf("+", @r);
            }
        }
    }

    die;
}

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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : 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(@r), $class -> bnan(@r))
                          : $x -> bnan(@r);
    }

    # 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() -> round(@r);
        }
        if ($x -> is_zero()) {
            $x = $x -> bnan(@r);
        } else {
            $x = $x -> binf($x -> {sign}, @r);
        }
        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(@r) if $wantarray;
        if ($y -> is_inf()) {
            $x = $x -> bnan(@r);
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $x = $x -> binf($sign, @r);
        }
        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() -> round(@r) if $wantarray;
            $x = $x -> bzero(@r);
        } else {
            $rem = $class -> binf($y -> {sign}, @r) if $wantarray;
            $x = $x -> bone('-', @r);
        }
        return $wantarray ? ($x, $rem) : $x;
    }

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

    # Division might return a non-integer result, so upgrade unconditionally, if
    # upgrading is enabled.

    return $upgrade -> bdiv($x, $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 = $x -> bone();
    } else {
        ($x -> {value}, $rem -> {value}) =
          $LIB -> _div($x -> {value}, $y -> {value});

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

    $x = $x -> round(@r);

    if ($wantarray) {
        unless ($LIB -> _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 = $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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : 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(@r), $class -> bnan(@r))
                          : $x -> bnan(@r);
    }

    # 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(@r);
        }
        if ($x -> is_zero()) {
            $x = $x -> bnan(@r);
        } else {
            $x = $x -> binf($x -> {sign}, @r);
        }
        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(@r) if $wantarray;
        if ($y -> is_inf()) {
            $x = $x -> bnan(@r);
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $x = $x -> binf($sign,@r );
        }
        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() -> round(@r) if $wantarray;
        $x = $x -> bzero(@r);
        return $wantarray ? ($x, $rem) : $x;
    }

    # Division might return a non-integer result, so upgrade unconditionally, if
    # upgrading is enabled.

    return $upgrade -> btdiv($x, $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 = $x -> bone(@r);
    } else {
        ($x -> {value}, $rem -> {value}) =
          $LIB -> _div($x -> {value}, $y -> {value});

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

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

    return $x;
}

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

    # Set up parameters.
    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : 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(@r);
    }

    # Modulo zero. See documentation for bdiv().

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

    # Numerator (dividend) is +/-inf.

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

    # Denominator (divisor) is +/-inf.

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

    return $upgrade -> bmod($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

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

    $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value});
    if ($LIB -> _is_zero($x -> {value})) {
        $x -> {sign} = '+';     # do not leave -0
    } else {
        $x -> {value} = $LIB -> _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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

    # At least one argument is NaN.

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

    # Modulo zero. See documentation for btdiv().

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

    # Numerator (dividend) is +/-inf.

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

    # Denominator (divisor) is +/-inf.

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

    return $upgrade -> btmod($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

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

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

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

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

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) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

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

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

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

    return $x->bnan(@r) 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(@r) if ($y->is_one('+') ||
                             $y->is_one('-'));

    return $upgrade -> bmodinv($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

    # 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
    # $LIB->_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 = $x->bmod($y);
    return $x->bnan(@r) 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}) = $LIB->_modinv($x->{value}, $y->{value});
    return $x->bnan(@r) 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 = $x -> bneg() if $y->{sign} eq '-';

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

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

    $x -> round(@r);
}

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)
      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
      ? (ref($_[0]), @_)
      : 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 = $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(@r) 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(@r);
        } else {
            return $num -> copy(@r);
        }
    }

    return $upgrade -> bmodinv($num, $exp, $mod, @r)
      if defined($upgrade) && (!$num -> isa(__PACKAGE__) ||
                               !$exp -> isa(__PACKAGE__) ||
                               !$mod -> ($class));

    # 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 = $LIB->_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 ($LIB->_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 = $LIB->_copy($mod->{value});
                $value = $LIB->_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 = $LIB->_copy($mod->{value});
                $value = $LIB->_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 -> 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]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

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

    # $x and/or $y is a NaN
    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();

    # $x and/or $y is a +/-Inf
    if ($x -> is_inf("-")) {
        return $x -> bzero(@r)      if $y -> is_negative();
        return $x -> bnan(@r)       if $y -> is_zero();
        return $x -> round(@r)      if $y -> is_odd();
        return $x -> bneg(@r);
    } elsif ($x -> is_inf("+")) {
        return $x -> bzero(@r)      if $y -> is_negative();
        return $x -> bnan(@r)       if $y -> is_zero();
        return $x -> round(@r);
    } elsif ($y -> is_inf("-")) {
        return $x -> bnan(@r)       if $x -> is_one("-");
        return $x -> binf("+", @r)  if $x -> is_zero();
        return $x -> bone(@r)       if $x -> is_one("+");
        return $x -> bzero(@r);
    } elsif ($y -> is_inf("+")) {
        return $x -> bnan(@r)       if $x -> is_one("-");
        return $x -> bzero(@r)      if $x -> is_zero();
        return $x -> bone(@r)       if $x -> is_one("+");
        return $x -> binf("+", @r);
    }

    if ($x -> is_zero()) {
        return $x -> bone(@r) if $y -> is_zero();
        return $x -> binf(@r) if $y -> is_negative();
        return $x -> round(@r);
    }

    if ($x -> is_one("+")) {
        return $x -> round(@r);
    }

    if ($x -> is_one("-")) {
        return $x -> round(@r) if $y -> is_odd();
        return $x -> bneg(@r);
    }

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

    # We don't support finite non-integers, so return zero. The reason for
    # returning zero, not NaN, is that all output is in the open interval (0,1),
    # and truncating that to integer gives zero.

    if ($y->{sign} eq '-' || !$y -> isa(__PACKAGE__)) {
        return $x -> bzero(@r);
    }

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

    $x->{value} = $LIB -> _pow($x->{value}, $y->{value});
    $x->{sign}  = $x -> is_negative() && $y -> is_odd() ? '-' : '+';
    $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.

    my ($class, $x, $base, @r);

    # Only objectify the base if it is defined, since an undefined base, as in
    # $x->blog() or $x->blog(undef) signals that the base is Euler's number =
    # 2.718281828...

    if (!ref($_[0]) && $_[0] =~ /^[a-z]\w*(?:::\w+)*$/i) {
        # E.g., Math::BigInt->blog(256, 2)
        ($class, $x, $base, @r) =
          defined $_[2] ? objectify(2, @_) : objectify(1, @_);
    } else {
        # E.g., $x->blog(2) or the deprecated Math::BigInt::blog(256, 2)
        ($class, $x, $base, @r) =
          defined $_[1] ? objectify(2, @_) : 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(@r) if $x -> is_nan();

    if (defined $base) {
        $base = $class -> new($base)
          unless defined(blessed($base)) && $base -> isa(__PACKAGE__);
        if ($base -> is_nan() || $base -> is_one()) {
            return $x -> bnan(@r);
        } elsif ($base -> is_inf() || $base -> is_zero()) {
            return $x -> bnan(@r) if $x -> is_inf() || $x -> is_zero();
            return $x -> bzero(@r);
        } elsif ($base -> is_negative()) {              # -inf < base < 0
            return $x -> bzero(@r) if $x -> is_one();   #     x = 1
            return $x -> bone('+', @r)  if $x == $base; #     x = base
            # we can't handle these cases, so upgrade, if we can
            return $upgrade -> blog($x, $base, @r) if defined $upgrade;
            return $x -> bnan(@r);
        }
        return $x -> bone(@r) if $x == $base;   # 0 < base && 0 < x < inf
    }

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

    if ($x -> is_inf()) {                       # x = +/-inf
        return $x -> binf('+', @r);
    } elsif ($x -> is_neg()) {                  # -inf < x < 0
        return $upgrade -> blog($x, $base, @r) if defined $upgrade;
        return $x -> bnan(@r);
    } elsif ($x -> is_one()) {                  # x = 1
        return $x -> bzero(@r);
    } elsif ($x -> is_zero()) {                 # x = 0
        return $x -> binf('-', @r);
    }

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

    return $upgrade -> blog($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;

        # disable upgrading and downgrading

        my $upg = Math::BigFloat -> upgrade();
        my $dng = Math::BigFloat -> downgrade();
        Math::BigFloat -> upgrade(undef);
        Math::BigFloat -> downgrade(undef);

        my $u = Math::BigFloat -> blog($x) -> as_int();

        # reset upgrading and downgrading

        Math::BigFloat -> upgrade($upg);
        Math::BigFloat -> downgrade($dng);

        # modify $x in place

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

        return $x -> round(@r);
    }

    my ($rc) = $LIB -> _log_int($x->{value}, $base->{value});
    return $x -> bnan(@r) unless defined $rc;   # not possible to take log?
    $x->{value} = $rc;
    $x = $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(@r)  if $x->{sign} eq 'NaN';
    return $x -> bone(@r)  if $x->is_zero();
    return $x -> round(@r) if $x->{sign} eq '+inf';
    return $x -> bzero(@r) if $x->{sign} eq '-inf';

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

    require Math::BigFloat;
    my $tmp = Math::BigFloat -> bexp($x, @r) -> as_int();
    $x->{value} = $tmp->{value};
    return $x -> round(@r);
}

sub bnok {
    # Calculate n over k (binomial coefficient or "choose" function) as
    # integer.

    # Set up parameters.
    my ($class, $n, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_)
                            : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    return $n if $n->modify('bnok');

    # All cases where at least one argument is NaN.

    return $n->bnan(@r) if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN';

    # All cases where at least one argument is +/-inf.

    if ($n -> is_inf()) {
        if ($k -> is_inf()) {                   # bnok(+/-inf,+/-inf)
            return $n -> bnan(@r);
        } elsif ($k -> is_neg()) {              # bnok(+/-inf,k), k < 0
            return $n -> bzero(@r);
        } elsif ($k -> is_zero()) {             # bnok(+/-inf,k), k = 0
            return $n -> bone(@r);
        } else {
            if ($n -> is_inf("+", @r)) {        # bnok(+inf,k), 0 < k < +inf
                return $n -> binf("+");
            } else {                            # bnok(-inf,k), k > 0
                my $sign = $k -> is_even() ? "+" : "-";
                return $n -> binf($sign, @r);
            }
        }
    }

    elsif ($k -> is_inf()) {            # bnok(n,+/-inf), -inf <= n <= inf
        return $n -> bnan(@r);
    }

    # At this point, both n and k are real numbers.

    return $upgrade -> bnok($n, $k, @r)
      if defined($upgrade) && (!$n -> isa(__PACKAGE__) ||
                               !$k -> isa(__PACKAGE__));

    my $sign = 1;

    if ($n >= 0) {
        if ($k < 0 || $k > $n) {
            return $n -> bzero(@r);
        }
    } else {

        if ($k >= 0) {

            # n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k)

            $sign = (-1) ** $k;
            $n = $n -> bneg() -> badd($k) -> bdec();

        } elsif ($k <= $n) {

            # n < 0 and k <= n: bnok(n,k) = (-1)^(n-k) * bnok(-k-1,n-k)

            $sign = (-1) ** ($n - $k);
            my $x0 = $n -> copy();
            $n = $n -> bone() -> badd($k) -> bneg();
            $k = $k -> copy();
            $k = $k -> bneg() -> badd($x0);

        } else {

            # n < 0 and n < k < 0:

            return $n -> bzero(@r);
        }
    }

    $n->{value} = $LIB->_nok($n->{value}, $k->{value});
    $n = $n -> bneg() if $sign == -1;

    $n -> round(@r);
}

sub buparrow {
    my $a = shift;
    my $y = $a -> uparrow(@_);
    $a -> {value} = $y -> {value};
    return $a;
}

sub uparrow {
    # Knuth's up-arrow notation buparrow(a, n, b)
    #
    # The following is a simple, recursive implementation of the up-arrow
    # notation, just to show the idea. Such implementations cause "Deep
    # recursion on subroutine ..." warnings, so we use a faster, non-recursive
    # algorithm below with @_ as a stack.
    #
    #   sub buparrow {
    #       my ($a, $n, $b) = @_;
    #       return $a ** $b if $n == 1;
    #       return $a * $b  if $n == 0;
    #       return 1        if $b == 0;
    #       return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));
    #   }

    my ($a, $b, $n) = @_;
    my $class = ref $a;
    croak("a must be non-negative") if $a < 0;
    croak("n must be non-negative") if $n < 0;
    croak("b must be non-negative") if $b < 0;

    while (@_ >= 3) {

        # return $a ** $b if $n == 1;

        if ($_[-2] == 1) {
            my ($a, $n, $b) = splice @_, -3;
            push @_, $a ** $b;
            next;
        }

        # return $a * $b if $n == 0;

        if ($_[-2] == 0) {
            my ($a, $n, $b) = splice @_, -3;
            push @_, $a * $b;
            next;
        }

        # return 1 if $b == 0;

        if ($_[-1] == 0) {
            splice @_, -3;
            push @_, $class -> bone();
            next;
        }

        # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));

        my ($a, $n, $b) = splice @_, -3;
        push @_, ($a, $n - 1,
                      $a, $n, $b - 1);

    }

    pop @_;
}

sub backermann {
    my $m = shift;
    my $y = $m -> ackermann(@_);
    $m -> {value} = $y -> {value};
    return $m;
}

sub ackermann {
    # Ackermann's function ackermann(m, n)
    #
    # The following is a simple, recursive implementation of the ackermann
    # function, just to show the idea. Such implementations cause "Deep
    # recursion on subroutine ..." warnings, so we use a faster, non-recursive
    # algorithm below with @_ as a stack.
    #
    # sub ackermann {
    #     my ($m, $n) = @_;
    #     return $n + 1                                  if $m == 0;
    #     return ackermann($m - 1, 1)                    if $m > 0 && $n == 0;
    #     return ackermann($m - 1, ackermann($m, $n - 1) if $m > 0 && $n > 0;
    # }

    my ($m, $n) = @_;
    my $class = ref $m;
    croak("m must be non-negative") if $m < 0;
    croak("n must be non-negative") if $n < 0;

    my $two      = $class -> new("2");
    my $three    = $class -> new("3");
    my $thirteen = $class -> new("13");

    $n = pop;
    $n = $class -> new($n) unless ref($n);
    while (@_) {
        my $m = pop;
        if ($m > $three) {
            push @_, (--$m) x $n;
            while (--$m >= $three) {
                push @_, $m;
            }
            $n = $thirteen;
        } elsif ($m == $three) {
            $n = $class -> bone() -> blsft($n + $three) -> bsub($three);
        } elsif ($m == $two) {
            $n = $n -> bmul($two) -> badd($three);
        } elsif ($m >= 0) {
            $n = $n -> badd($m) -> binc();
        } else {
            die "negative m!";
        }
    }
    $n;
}

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

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

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

    return $upgrade -> bsin($x, @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 = $x->bone(@r)  if $t->is_one();
    $x = $x->bzero(@r) if $t->is_zero();
    $x->round(@r);
}

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

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

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

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

    require Math::BigFloat;
    my $tmp = Math::BigFloat -> bcos($x, @r) -> as_int();
    $x->{value} = $tmp->{value};
    return $x -> round(@r);
}

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

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

    return $x -> bnan(@r)  if $x -> is_nan();
    return $x -> bzero(@r) if $x -> is_zero();

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

    return $x -> bone("+", @r) if $x -> bgt("1");
    return $x -> bone("-", @r) if $x -> blt("-1");

    $x -> bzero(@r);
}

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

    my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

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

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

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

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

    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->round(@r);
}

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

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

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

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

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

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

    # set up parameters

    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

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

    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(@r) 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->broot($x, $y, @r) if defined $upgrade;

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

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]) ? (ref($_[0]), @_) : objectify(1, @_);

    return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf

    return $x->bnan(@r) if $x->{sign} ne '+'; # NaN, <0 => NaN

    return $upgrade -> bfac($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

sub bdfac {
    # compute double factorial, modify $x in place
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf

    return $x->bnan(@r) if $x->is_nan() || $x <= -2;
    return $x->bone(@r) if $x <= 1;

    return $upgrade -> bdfac($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    croak("bdfac() requires a newer version of the $LIB library.")
        unless $LIB->can('_dfac');

    $x->{value} = $LIB->_dfac($x->{value});
    $x->round(@r);
}

sub btfac {
    # compute triple factorial, modify $x in place
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    return $x if $x->modify('btfac') || $x->{sign} eq '+inf'; # inf => inf

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

    return $upgrade -> btfac($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    my $k = $class -> new("3");
    return $x->bnan(@r) if $x <= -$k;

    my $one = $class -> bone();
    return $x->bone(@r) if $x <= $one;

    my $f = $x -> copy();
    while ($f -> bsub($k) > $one) {
        $x = $x -> bmul($f);
    }
    $x->round(@r);
}

sub bmfac {
    # compute multi-factorial

    my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

    return $x if $x->modify('bmfac') || $x->{sign} eq '+inf';
    return $x->bnan(@r) if $x->is_nan() || $k->is_nan() || $k < 1 || $x <= -$k;

    return $upgrade -> bmfac($x, $k, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    my $one = $class -> bone();
    return $x->bone(@r) if $x <= $one;

    my $f = $x -> copy();
    while ($f -> bsub($k) > $one) {
        $x = $x -> bmul($f);
    }
    $x->round(@r);
}

sub bfib {
    # compute Fibonacci number(s)
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    croak("bfib() requires a newer version of the $LIB library.")
        unless $LIB->can('_fib');

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

    return $upgrade -> bfib($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # List context.

    if (wantarray) {
        return () if $x -> is_nan();
        croak("bfib() can't return an infinitely long list of numbers")
          if $x -> is_inf();

        # Use the backend library to compute the first $x Fibonacci numbers.

        my @values = $LIB->_fib($x->{value});

        # Make objects out of them. The last element in the array is the
        # invocand.

        for (my $i = 0 ; $i < $#values ; ++ $i) {
            my $fib = $class -> bzero();
            $fib -> {value} = $values[$i];
            $values[$i] = $fib;
        }

        $x -> {value} = $values[-1];
        $values[-1] = $x;

        # If negative, insert sign as appropriate.

        if ($x -> is_neg()) {
            for (my $i = 2 ; $i <= $#values ; $i += 2) {
                $values[$i]{sign} = '-';
            }
        }

        @values = map { $_ -> round(@r) } @values;
        return @values;
    }

    # Scalar context.

    else {
        return $x if $x->modify('bdfac') || $x ->  is_inf('+');
        return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');

        $x->{sign}  = $x -> is_neg() && $x -> is_even() ? '-' : '+';
        $x->{value} = $LIB->_fib($x->{value});
        return $x->round(@r);
    }
}

sub blucas {
    # compute Lucas number(s)
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    croak("blucas() requires a newer version of the $LIB library.")
        unless $LIB->can('_lucas');

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

    return $upgrade -> blucas($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # List context.

    if (wantarray) {
        return () if $x -> is_nan();
        croak("blucas() can't return an infinitely long list of numbers")
            if $x -> is_inf();

        # Use the backend library to compute the first $x Lucas numbers.

        my @values = $LIB->_lucas($x->{value});

        # Make objects out of them. The last element in the array is the
        # invocand.

        for (my $i = 0 ; $i < $#values ; ++ $i) {
            my $lucas =  $class -> bzero();
            $lucas -> {value} = $values[$i];
            $values[$i] = $lucas;
        }

        $x -> {value} = $values[-1];
        $values[-1] = $x;

        # If negative, insert sign as appropriate.

        if ($x -> is_neg()) {
            for (my $i = 2 ; $i <= $#values ; $i += 2) {
                $values[$i]{sign} = '-';
            }
        }

        @values = map { $_ -> round(@r) } @values;
        return @values;
    }

    # Scalar context.

    else {
        return $x if $x ->  is_inf('+');
        return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');

        $x->{sign}  = $x -> is_neg() && $x -> is_even() ? '-' : '+';
        $x->{value} = $LIB->_lucas($x->{value});
        return $x->round(@r);
    }
}

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

    my ($class, $x, $y, $b, @r);

    # Objectify the base only when it is defined, since an undefined base, as
    # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2.

    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
        # E.g., Math::BigInt->blog(256, 5, 2)
        ($class, $x, $y, $b, @r) =
          defined $_[3] ? objectify(3, @_) : objectify(2, @_);
    } else {
        # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2)
        ($class, $x, $y, $b, @r) =
          defined $_[2] ? objectify(3, @_) : objectify(2, @_);
    }

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

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

    return $upgrade -> blsft($x, $y, $b, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__) ||
                               !$b -> isa(__PACKAGE__));

    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # blsft($x, -$y, $b) = brsft($x, $y, $b)

    return $x -> brsft($y -> copy() -> bneg(), $b, @r) if $y -> is_neg();

    return $x -> bmul($b -> bpow($y));

    # Base $b = 1 changes nothing, not even when $b = Inf. Shifting zero places
    # ($y = 0) doesn't change anything either.
    return $x -> bround(@r) if $b -> is_one("+") || $y -> is_zero();

    # Shifting infinitely far to the left.
    if ($y -> is_inf("+")) {
        return $x -> binf("+", @r) if $x -> is_pos();
        return $x -> binf("-", @r) if $x -> is_neg();
        return $x -> bnan(@r);                          # Inf * 0 = NaN
    }

    # At this point we know that $b > 1, so we are essentially computing 0 *
    # Inf = NaN.
    return $x -> bnan(@r) if $x -> is_zero() && $y -> is_inf("+");

    # Handle trivial zero case.
    return $x -> bzero(@r) if $x -> is_zero();

    return $x -> binf("+", @r) if $y -> is_inf("+");
    return $x -> bzero(@r) if $x -> is_zero();

    # While some of the libraries support an arbitrarily large base, not all of
    # them do, so rather than returning an incorrect result in those cases,
    # disallow bases that don't work with all libraries.

    my $uintmax = ~0;
    if ($x -> bcmp($uintmax) > 0) {
        $x = $x -> bmul($b -> bpow($y));
    } else {
        $b = $b -> numify();
        $x -> {value} = $LIB -> _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

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

    # Objectify the base only when it is defined, since an undefined base, as
    # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2.

    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
        # E.g., Math::BigInt->blog(256, 5, 2)
        ($class, $x, $y, $b, @r) =
          defined $_[3] ? objectify(3, @_) : objectify(2, @_);
    } else {
        # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2)
        ($class, $x, $y, $b, @r) =
          defined $_[2] ? objectify(3, @_) : objectify(2, @_);
    }

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

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

    return $upgrade -> brsft($x, $y, $b, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__) ||
                               !$b -> isa(__PACKAGE__));

    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # brsft($x, -$y, $b) = blsft($x, $y, $b)

    return $x -> blsft($y -> copy() -> bneg(), $b, @r) if $y -> is_neg();

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

    # Shifting right by a positive amount might lead to a non-integer result.

    return $upgrade -> brsft($x, $y, $b, @r)
      if defined($upgrade) && $y -> is_pos();

    # This only works for negative numbers when shifting in base 2.
    if ($x -> is_neg() && $b -> bcmp("2") == 0) {
        return $x -> round(@r) if $x -> is_one('-'); # -1 => -1
        # Although this is O(N*N) in Math::BigInt::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 = $x -> binc();                      # -3 => -2
        my $bin = $x -> to_bin();               # convert to string
        $bin =~ s/^-//;                         # strip leading minus
        $bin =~ tr/10/01/;                      # flip bits
        my $nbits = CORE::length($bin);
        return $x -> bone("-", @r) if $y >= $nbits;
        $bin = substr $bin, 0, $nbits - $y;     # keep most significant bits
        $bin = '1' . $bin;                      # prepend one dummy '1'
        $bin =~ tr/10/01/;                      # flip bits back
        my $res = $class -> from_bin($bin);     # convert back from string
        $res = $res -> binc();                  # remember to increment
        $x -> {value} = $res -> {value};        # take over value
        return $x -> round(@r);
    }

    # While some of the libraries support an arbitrarily large base, not all of
    # them do, so rather than returning an incorrect result in those cases, use
    # division.

    my $uintmax = ~0;
    if ($x -> bcmp($uintmax) > 0 || $x -> is_neg()) {
        $x = $x -> bdiv($b -> bpow($y));
    } else {
        $b = $b -> numify();
        $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b);
    }

    return $x -> round(@r);
}

###############################################################################
# Bitwise methods
###############################################################################

# Bitwise left shift.

sub bblsft {
    # We don't call objectify(), because the bitwise methods should not
    # upgrade/downgrade, even when upgrading/downgrading is enabled.

    my ($class, $x, $y, @r);

    # $x -> bblsft($y)

    if (ref($_[0])) {
        ($class, $x, $y, @r) = (ref($_[0]), @_);
        $y = $y -> as_int()
          if ref($y) && !$y -> isa(__PACKAGE__) && $y -> can('as_int');
        $y = $class -> new(int($y)) unless ref($y);
    }

    # $class -> bblsft($x, $y)

    else {
        ($class, $x, $y, @r) = @_;
        for ($x, $y) {
            $_ = $_ -> as_int()
              if ref($_) && !$_ -> isa(__PACKAGE__) && $_ -> can('as_int');
            $_ = $class -> new(int($_)) unless ref($_);
        }
    }

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

    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();

    # bblsft($x, -$y) = bbrsft($x, $y)

    return $x -> bbrsft($y -> copy() -> bneg()) if $y -> is_neg();

    # Shifting infinitely far to the left.

    if ($y -> is_inf("+")) {
        return $x -> binf("+", @r) if $x -> is_pos();
        return $x -> binf("-", @r) if $x -> is_neg();
        return $x -> bnan(@r);
    }

    # These cases change nothing.

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

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

# Bitwise right shift.

sub bbrsft {
    # We don't call objectify(), because the bitwise methods should not
    # upgrade/downgrade, even when upgrading/downgrading is enabled.

    my ($class, $x, $y, @r);

    # $x -> bblsft($y)

    if (ref($_[0])) {
        ($class, $x, $y, @r) = (ref($_[0]), @_);
        $y = $y -> as_int()
          if ref($y) && !$y -> isa(__PACKAGE__) && $y -> can('as_int');
        $y = $class -> new(int($y)) unless ref($y);
    }

    # $class -> bblsft($x, $y)

    else {
        ($class, $x, $y, @r) = @_;
        for ($x, $y) {
            $_ = $_ -> as_int()
              if ref($_) && !$_ -> isa(__PACKAGE__) && $_ -> can('as_int');
            $_ = $class -> new(int($_)) unless ref($_);
        }
    }

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

    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();

    # bbrsft($x, -$y) = bblsft($x, $y)

    return $x -> bblsft($y -> copy() -> bneg()) if $y -> is_neg();

    # Shifting infinitely far to the right.

    if ($y -> is_inf("+")) {
        return $x -> bnan(@r)      if $x -> is_inf();
        return $x -> bone("-", @r) if $x -> is_neg();
        return $x -> bzero(@r);
    }

    # These cases change nothing.

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

    # At this point, $x is either positive or negative, not zero.

    if ($x -> is_pos()) {
        $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, 2);
    } else {
        my $n = $x -> {value};
        my $d = $LIB -> _pow($LIB -> _new("2"), $y -> {value});
        my ($p, $q) = $LIB -> _div($n, $d);
        $p = $LIB -> _inc($p) unless $LIB -> _is_zero($q);
        $x -> {value} = $p;
    }

    $x -> round(@r);
}

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

    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

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

    return $upgrade -> band($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

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

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

    if ($x->{sign} eq '+' && $y->{sign} eq '+') {
        $x->{value} = $LIB->_and($x->{value}, $y->{value});
    } else {
        ($x->{value}, $x->{sign}) = $LIB->_sand($x->{value}, $x->{sign},
                                                $y->{value}, $y->{sign});
    }
    return $x->round(@r);
}

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

    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

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

    return $upgrade -> bior($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

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

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

    if ($x->{sign} eq '+' && $y->{sign} eq '+') {
        $x->{value} = $LIB->_or($x->{value}, $y->{value});
    } else {
        ($x->{value}, $x->{sign}) = $LIB->_sor($x->{value}, $x->{sign},
                                               $y->{value}, $y->{sign});
    }
    return $x->round(@r);
}

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

    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                            ? (ref($_[0]), @_) : objectify(2, @_);

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

    return $upgrade -> bxor($x, $y, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$y -> isa(__PACKAGE__));

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

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

    if ($x->{sign} eq '+' && $y->{sign} eq '+') {
        $x->{value} = $LIB->_xor($x->{value}, $y->{value});
    } else {
        ($x->{value}, $x->{sign}) = $LIB->_sxor($x->{value}, $x->{sign},
                                               $y->{value}, $y->{sign});
    }
    return $x->round(@r);
}

sub bnot {
    # (num_str or BINT) return BINT
    # represent ~x as twos-complement number
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    return $upgrade -> bnot($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    $x -> binc() -> bneg(@r);
}

###############################################################################
# Rounding methods
###############################################################################

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

    my ($class, $self, @args) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    # $x->round(undef, undef) signals no rounding

    if (@args >= 2 && @args <= 3 && !defined($args[0]) && !defined($args[1])) {
        $self->{_a} = undef;
        $self->{_p} = undef;
        return $self;
    }

    my ($a, $p, $r) = splice @args, 0, 3;

    # $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)

    if (defined $a) {
        croak "accuracy must be a number, not '$a'"
          unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
    }

    if (defined $p) {
        croak "precision must be a number, not '$p'"
          unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
    }

    # 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);
        }
    }

    no strict 'refs';

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

    # 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)$/) {
        croak("Unknown round mode '$r'");
    }

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

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

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 ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    my ($scale, $mode) = $x->_scale_a(@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 = $LIB->_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...'
        $xs =~ s/^0+(\d)/$1/;                  # "00000" -> "0"
        $put_back = 1;                         # need to put back
    } elsif ($pad > $len) {
        $x = $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} = $LIB->_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 bfround {
    # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
    # $n == 0 || $n == 1 => round to integer

    my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

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

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

    $x->{_a} = undef;
    $x->{_p} = $scale;          # store new _p
    $x;
}

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 = __PACKAGE__->new($x) unless ref $x;
    $x->bround(@_);
}

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

    return $upgrade -> bfloor($x)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    $x->round(@r);
}

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

    return $upgrade -> bceil($x)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    $x->round(@r);
}

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

    return $upgrade -> bint($x)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    $x->round(@r);
}

###############################################################################
# Other mathematical methods
###############################################################################

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)

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is as a method instead";
        unshift @_, __PACKAGE__;
    }

    my ($class, @args) = objectify(0, @_);

    # Upgrade?

    if (defined $upgrade) {
        my $do_upgrade = 0;
        for my $arg (@args) {
            unless ($arg -> isa(__PACKAGE__)) {
                $do_upgrade = 1;
                last;
            }
        }
        return $upgrade -> bgcd(@args) if $do_upgrade;
    }

    my $x = shift @args;
    $x = defined(blessed($x)) && $x -> isa(__PACKAGE__) ? $x -> copy()
                                                        : $class -> new($x);

    return $class->bnan() if $x->{sign} !~ /^[+-]$/;    # x NaN?

    while (@args) {
        my $y = shift @args;
        $y = $class->new($y)
          unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
        return $class->bnan() if $y->{sign} !~ /^[+-]$/;    # y NaN?
        $x->{value} = $LIB->_gcd($x->{value}, $y->{value});
        last if $LIB->_is_one($x->{value});
    }

    return $x -> babs();
}

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

    # Class::method(...) -> Class->method(...)
    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
    {
        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
        #  " use is as a method instead";
        unshift @_, __PACKAGE__;
    }

    my ($class, @args) = objectify(0, @_);

    # Upgrade?

    if (defined $upgrade) {
        my $do_upgrade = 0;
        for my $arg (@args) {
            unless ($arg -> isa(__PACKAGE__)) {
                $do_upgrade = 1;
                last;
            }
        }
        return $upgrade -> blcm(@args) if $do_upgrade;
    }

    my $x = shift @args;
    $x = defined(blessed($x)) && $x -> isa(__PACKAGE__) ? $x -> copy()
                                                        : $class -> new($x);
    return $class->bnan() if $x->{sign} !~ /^[+-]$/;    # x NaN?

    while (@args) {
        my $y = shift @args;
        $y = $class -> new($y)
          unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
        return $x->bnan() if $y->{sign} !~ /^[+-]$/;     # y not integer
        $x -> {value} = $LIB->_lcm($x -> {value}, $y -> {value});
    }

    return $x -> babs();
}

###############################################################################
# Object property methods
###############################################################################

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    $x->{sign};
}

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

sub bdigitsum {
    # like digitsum(), but assigns the result to the invocand
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    $x -> {value} = $LIB -> _digitsum($x -> {value});
    $x -> {sign}  = '+';
    return $x;
}

sub digitsum {
    # compute sum of decimal digits and return it
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    my $y = $class -> bzero();
    $y -> {value} = $LIB -> _digitsum($x -> {value});
    $y -> round(@r);
}

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Upgrade?

    return $upgrade -> exponent($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

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

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Upgrade?

    return $upgrade -> mantissa($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

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

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Upgrade?

    return $upgrade -> parts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

# Parts used for scientific notation with significand/mantissa and exponent as
# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4"
# (exponent).

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Not-a-number.

    if ($x -> is_nan()) {
        my $mant = $class -> bnan(@r);          # mantissa
        return $mant unless wantarray;          # scalar context
        my $expo = $class -> bnan(@r);          # exponent
        return ($mant, $expo);                  # list context
    }

    # Infinity.

    if ($x -> is_inf()) {
        my $mant = $class -> binf($x->{sign}, @r);  # mantissa
        return $mant unless wantarray;              # scalar context
        my $expo = $class -> binf('+', @r);         # exponent
        return ($mant, $expo);                      # list context
    }

    # Upgrade?

    return $upgrade -> sparts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number.

    my $mant   = $x -> copy();
    my $nzeros = $LIB -> _zeros($mant -> {value});

    $mant -> {value}
      = $LIB -> _rsft($mant -> {value}, $LIB -> _new($nzeros), 10)
        if $nzeros != 0;
    return $mant unless wantarray;

    my $expo = $class -> new($nzeros, @r);
    return ($mant, $expo);
}

# Parts used for normalized notation with significand/mantissa as either 0 or a
# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as
# "1.23456789" and "4".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Not-a-Number and Infinity.

    return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf();

    # Upgrade?

    return $upgrade -> nparts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number.

    my ($mant, $expo) = $x -> sparts(@r);
    if ($mant -> bcmp(0)) {
        my ($ndigtot, $ndigfrac) = $mant -> length();
        my $expo10adj = $ndigtot - $ndigfrac - 1;

        if ($expo10adj > 0) {          # if mantissa is not an integer
            return $upgrade -> nparts($x, @r) if defined $upgrade;
            $mant = $mant -> bnan(@r);
            return $mant unless wantarray;
            $expo = $expo -> badd($expo10adj, @r);
            return ($mant, $expo);
        }
    }

    return $mant unless wantarray;
    return ($mant, $expo);
}

# Parts used for engineering notation with significand/mantissa as either 0 or a
# number in the semi-open interval [1,1000) and the exponent is a multiple of 3.
# E.g., "12345.6789" is returned as "12.3456789" and "3".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Not-a-number and Infinity.

    return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf();

    # Upgrade?

    return $upgrade -> eparts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number.

    my ($mant, $expo) = $x -> sparts(@r);

    if ($mant -> bcmp(0)) {
        my $ndigmant  = $mant -> length();
        $expo = $expo -> badd($ndigmant, @r);

        # $c is the number of digits that will be in the integer part of the
        # final mantissa.

        my $c = $expo -> copy() -> bdec() -> bmod(3) -> binc();
        $expo = $expo -> bsub($c);

        if ($ndigmant > $c) {
            return $upgrade -> eparts($x, @r) if defined $upgrade;
            $mant = $mant -> bnan(@r);
            return $mant unless wantarray;
            return ($mant, $expo);
        }

        $mant = $mant -> blsft($c - $ndigmant, 10, @r);
    }

    return $mant unless wantarray;
    return ($mant, $expo);
}

# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345"
# (integer part) and "0.6789" (fraction part).

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Not-a-number.

    if ($x -> is_nan()) {
        my $int = $class -> bnan(@r);
        return $int unless wantarray;
        my $frc = $class -> bzero(@r);    # or NaN?
        return ($int, $frc);
    }

    # Infinity.

    if ($x -> is_inf()) {
        my $int = $class -> binf($x->{sign}, @r);
        return $int unless wantarray;
        my $frc = $class -> bzero(@r);
        return ($int, $frc);
    }

    # Upgrade?

    return $upgrade -> dparts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number.

    my $int = $x -> copy() -> round(@r);
    return $int unless wantarray;

    my $frc = $class -> bzero(@r);
    return ($int, $frc);
}

# Fractional parts with the numerator and denominator as integers. E.g.,
# "123.4375" is returned as "1975" and "16".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # NaN => NaN/NaN

    if ($x -> is_nan()) {
        return $class -> bnan(@r) unless wantarray;
        return $class -> bnan(@r), $class -> bnan(@r);
    }

    # ±Inf => ±Inf/1

    if ($x -> is_inf()) {
        my $numer = $class -> binf($x->{sign}, @r);
        return $numer unless wantarray;
        my $denom = $class -> bone(@r);
        return $numer, $denom;
    }

    # Upgrade?

    return $upgrade -> fparts($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # N => N/1

    my $numer = $x -> copy() -> round(@r);
    return $numer unless wantarray;
    my $denom = $class -> bone(@r);
    return $numer, $denom;
}

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    return $upgrade -> numerator($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    return $x -> copy() -> round(@r);
}

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    return $upgrade -> denominator($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    return $x -> is_nan() ? $class -> bnan(@r) : $class -> bone(@r);
}

###############################################################################
# String conversion methods
###############################################################################

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    # Upgrade?

    return $upgrade -> bstr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $str = $LIB->_str($x->{value});
    return $x->{sign} eq '-' ? "-$str" : $str;
}

# Scientific notation with significand/mantissa as an integer, e.g., "12345" is
# written as "1.2345e+4".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> bsstr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $expo = $LIB -> _zeros($x->{value});
    my $mant = $LIB -> _str($x->{value});
    $mant = substr($mant, 0, -$expo) if $expo;  # strip trailing zeros

    ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}

# Normalized notation, e.g., "12345" is written as "1.2345e+4".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> bnstr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $expo = $LIB -> _zeros($x->{value});
    my $mant = $LIB -> _str($x->{value});
    $mant = substr($mant, 0, -$expo) if $expo;  # strip trailing zeros

    my $mantlen = CORE::length($mant);
    if ($mantlen > 1) {
        $expo += $mantlen - 1;                  # adjust exponent
        substr $mant, 1, 0, ".";                # insert decimal point
    }

    ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}

# Engineering notation, e.g., "12345" is written as "12.345e+3".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> bestr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $expo = $LIB -> _zeros($x->{value});     # number of trailing zeros
    my $mant = $LIB -> _str($x->{value});       # mantissa as a string
    $mant = substr($mant, 0, -$expo) if $expo;  # strip trailing zeros
    my $mantlen = CORE::length($mant);          # length of mantissa
    $expo += $mantlen;

    my $dotpos = ($expo - 1) % 3 + 1;           # offset of decimal point
    $expo -= $dotpos;

    if ($dotpos < $mantlen) {
        substr $mant, $dotpos, 0, ".";          # insert decimal point
    } elsif ($dotpos > $mantlen) {
        $mant .= "0" x ($dotpos - $mantlen);    # append zeros
    }

    ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}

# Decimal notation, e.g., "12345" (no exponent).

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> bdstr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value});
}

# Fraction notation, e.g., "123.4375" is written as "1975/16", but "123" is
# written as "123", not "123/1".

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

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> bfstr($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value});
}

sub to_hex {
    # return as hex string with no prefix

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> to_hex($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $hex = $LIB->_to_hex($x->{value});
    return $x->{sign} eq '-' ? "-$hex" : $hex;
}

sub to_oct {
    # return as octal string with no prefix

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> to_oct($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

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

sub to_bin {
    # return as binary string with no prefix

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    # Inf and NaN

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
        return 'inf';                                   # +inf
    }

    # Upgrade?

    return $upgrade -> to_bin($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    # Finite number

    my $bin = $LIB->_to_bin($x->{value});
    return $x->{sign} eq '-' ? "-$bin" : $bin;
}

sub to_bytes {
    # return a byte string

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    croak("to_bytes() requires a finite, non-negative integer")
        if $x -> is_neg() || ! $x -> is_int();

    return $upgrade -> to_bytes($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    croak("to_bytes() requires a newer version of the $LIB library.")
        unless $LIB->can('_to_bytes');

    return $LIB->_to_bytes($x->{value});
}

sub to_base {
    # return a base anything string

    # $cs is the collation sequence
    my ($class, $x, $base, $cs, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                                    ? (ref($_[0]), @_) : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    croak("the value to convert must be a finite, non-negative integer")
      if $x -> is_neg() || !$x -> is_int();

    croak("the base must be a finite integer >= 2")
      if $base < 2 || ! $base -> is_int();

    # If no collating sequence is given, pass some of the conversions to
    # methods optimized for those cases.

    unless (defined $cs) {
        return    $x -> to_bin() if $base == 2;
        return    $x -> to_oct() if $base == 8;
        return uc $x -> to_hex() if $base == 16;
        return    $x -> bstr()   if $base == 10;
    }

    croak("to_base() requires a newer version of the $LIB library.")
      unless $LIB->can('_to_base');

    return $upgrade -> to_base($x, $base, $cs, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$base -> isa(__PACKAGE__));

    return $LIB->_to_base($x->{value}, $base -> {value},
                          defined($cs) ? $cs : ());
}

sub to_base_num {
    # return a base anything array ref, e.g.,
    # Math::BigInt -> new(255) -> to_base_num(10) returns [2, 5, 5];

    # $cs is the collation sequence
    my ($class, $x, $base, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
                               ? (ref($_[0]), @_) : objectify(2, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    croak("the value to convert must be a finite non-negative integer")
      if $x -> is_neg() || !$x -> is_int();

    croak("the base must be a finite integer >= 2")
      if $base < 2 || ! $base -> is_int();

    croak("to_base() requires a newer version of the $LIB library.")
      unless $LIB->can('_to_base');

    return $upgrade -> to_base_num($x, $base, @r)
      if defined($upgrade) && (!$x -> isa(__PACKAGE__) ||
                               !$base -> isa(__PACKAGE__));

    # Get a reference to an array of library thingies, and replace each element
    # with a Math::BigInt object using that thingy.

    my $vals = $LIB -> _to_base_num($x->{value}, $base -> {value});

    for my $i (0 .. $#$vals) {
        my $x = $class -> bzero();
        $x -> {value} = $vals -> [$i];
        $vals -> [$i] = $x;
    }

    return $vals;
}

sub as_hex {
    # return as hex string, with prefixed 0x

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    return $upgrade -> as_hex($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    my $hex = $LIB->_as_hex($x->{value});
    return $x->{sign} eq '-' ? "-$hex" : $hex;
}

sub as_oct {
    # return as octal string, with prefixed 0

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    return $upgrade -> as_oct($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

sub as_bin {
    # return as binary string, with prefixed 0b

    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

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

    return $upgrade -> as_bin($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

    my $bin = $LIB->_as_bin($x->{value});
    return $x->{sign} eq '-' ? "-$bin" : $bin;
}

*as_bytes = \&to_bytes;

###############################################################################
# Other conversion methods
###############################################################################

sub numify {
    # Make a Perl scalar number from a Math::BigInt object.
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;

    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;
    }

    return $upgrade -> numify($x, @r)
      if defined($upgrade) && !$x -> isa(__PACKAGE__);

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

###############################################################################
# Private methods and functions.
###############################################################################

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(), in which case the argument
    # list is (0, $x) or (1, $x).

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

    # Check the context.

    unless (wantarray) {
        croak(__PACKAGE__ . "::objectify() needs list context");
    }

    # Get the number of arguments to objectify.

    my $count = shift;

    # 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.

    my $class;
    if (ref($a[0])) {                   # reference?
        $class = ref($a[0]);
    } elsif ($a[0] =~ /^[A-Z].*::/) {   # string with class name?
        $class = shift @a;
    } else {
        $class = __PACKAGE__;           # default class name
    }

    $count ||= @a;
    unshift @a, $class;

    no strict 'refs';

    # What we upgrade to, if anything. Note that we need the whole upgrade
    # chain, since there might be multiple levels of upgrading. E.g., class A
    # upgrades to class B, which upgrades to class C. Delay getting the chain
    # until we actually need it.

    my @upg = ();
    my $have_upgrade_chain = 0;

    # 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;
    }

  ARG: 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,
        # but first get the whole upgrade chain if we haven't got it yet.

        unless ($have_upgrade_chain) {
            my $cls = $class;
            my $upg = $cls -> upgrade();
            while (defined $upg) {
                last if $upg eq $cls;
                push @upg, $upg;
                $cls = $upg;
                $upg = $cls -> upgrade();
            }
            $have_upgrade_chain = 1;
        }

        for my $upg (@upg) {
            next ARG if $ref -> isa($upg);
        }

        # 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 import {
    my $class = shift;
    $IMPORT++;                  # remember we did import()
    my @a;                      # unrecognized arguments

    while (@_) {
        my $param = shift;

        # Enable overloading of constants.

        if ($param eq ':constant') {
            overload::constant

                integer => sub {
                    $class -> new(shift);
                },

                float   => sub {
                    $class -> new(shift);
                },

                binary  => sub {
                    # E.g., a literal 0377 shall result in an object whose value
                    # is decimal 255, but new("0377") returns decimal 377.
                    return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
                    $class -> new(shift);
                };
            next;
        }

        # Upgrading.

        if ($param eq 'upgrade') {
            $class -> upgrade(shift);
            next;
        }

        # Downgrading.

        if ($param eq 'downgrade') {
            $class -> downgrade(shift);
            next;
        }

        # Accuracy.

        if ($param eq 'accuracy') {
            $class -> accuracy(shift);
            next;
        }

        # Precision.

        if ($param eq 'precision') {
            $class -> precision(shift);
            next;
        }

        # Rounding mode.

        if ($param eq 'round_mode') {
            $class -> round_mode(shift);
            next;
        }

        # Backend library.

        if ($param =~ /^(lib|try|only)\z/) {
            # try  => 0 (no warn if unavailable module)
            # lib  => 1 (warn on fallback)
            # only => 2 (die on fallback)

            # Get the list of user-specified libraries.

            croak "Library argument for import parameter '$param' is missing"
              unless @_;
            my $libs = shift;
            croak "Library argument for import parameter '$param' is undefined"
              unless defined($libs);

            # Check and clean up the list of user-specified libraries.

            my @libs;
            for my $lib (split /,/, $libs) {
                $lib =~ s/^\s+//;
                $lib =~ s/\s+$//;

                if ($lib =~ /[^a-zA-Z0-9_:]/) {
                    carp "Library name '$lib' contains invalid characters";
                    next;
                }

                if (! CORE::length $lib) {
                    carp "Library name is empty";
                    next;
                }

                $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i;

                # If a library has already been loaded, that is OK only if the
                # requested library is identical to the loaded one.

                if (defined($LIB)) {
                    if ($lib ne $LIB) {
                        #carp "Library '$LIB' has already been loaded, so",
                        #  " ignoring requested library '$lib'";
                    }
                    next;
                }

                push @libs, $lib;
            }

            next if defined $LIB;

            croak "Library list contains no valid libraries" unless @libs;

            # Try to load the specified libraries, if any.

            for (my $i = 0 ; $i <= $#libs ; $i++) {
                my $lib = $libs[$i];
                eval "require $lib";
                unless ($@) {
                    $LIB = $lib;
                    last;
                }
            }

            next if defined $LIB;

            # No library has been loaded, and none of the requested libraries
            # could be loaded, and fallback and the user doesn't allow fallback.

            if ($param eq 'only') {
                croak "Couldn't load the specified math lib(s) ",
                  join(", ", map "'$_'", @libs),
                  ", and fallback to '$DEFAULT_LIB' is not allowed";
            }

            # No library has been loaded, and none of the requested libraries
            # could be loaded, but the user accepts the use of a fallback
            # library, so try to load it.

            eval "require $DEFAULT_LIB";
            if ($@) {
                croak "Couldn't load the specified math lib(s) ",
                  join(", ", map "'$_'", @libs),
                  ", not even the fallback lib '$DEFAULT_LIB'";
            }

            # The fallback library was successfully loaded, but the user
            # might want to know that we are using the fallback.

            if ($param eq 'lib') {
                carp "Couldn't load the specified math lib(s) ",
                  join(", ", map "'$_'", @libs),
                  ", so using fallback lib '$DEFAULT_LIB'";
            }

            next;
        }

        # Unrecognized parameter.

        push @a, $param;
    }

    # Any non-':constant' stuff is handled by our parent, Exporter

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

    # We might not have loaded any backend library yet, either because the user
    # didn't specify any, or because the specified libraries failed to load and
    # the user allows the use of a fallback library.

    unless (defined $LIB) {
        eval "require $DEFAULT_LIB";
        if ($@) {
            croak "No lib specified, and couldn't load the default",
              " lib '$DEFAULT_LIB'";
        }
        $LIB = $DEFAULT_LIB;
    }

    # import done
}

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

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

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

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 _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)$/) {
        croak("Unknown round mode '$r'");
    }

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

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

# Return true if the input is numeric and false if it is a string.

sub _is_numeric {
    shift;              # class name
    my $value = shift;
    no warnings 'numeric';
    # detect numbers
    # string & "" -> ""
    # number & "" -> 0 (with warning)
    # nan and inf can detect as numbers, so check with * 0
    return unless CORE::length((my $dummy = "") & $value);
    return unless 0 + $value eq $value;
    return 1 if $value * 0 == 0;
    return -1;          # Inf/NaN
}

# Trims the sign of the significand, the (absolute value of the) significand,
# the sign of the exponent, and the (absolute value of the) exponent. The
# returned values have no underscores ("_") or unnecessary leading or trailing
# zeros.

sub _trim_split_parts {
    shift;               # class name

    my $sig_sgn = shift() || '+';
    my $sig_str = shift() || '0';
    my $exp_sgn = shift() || '+';
    my $exp_str = shift() || '0';

    $sig_str =~ tr/_//d;                        # "1.0_0_0" -> "1.000"
    $sig_str =~ s/^0+//;                        # "01.000" -> "1.000"
    $sig_str =~ s/\.0*$//                       # "1.000" -> "1"
      || $sig_str =~ s/(\..*[^0])0+$/$1/;       # "1.010" -> "1.01"
    $sig_str = '0' unless CORE::length($sig_str);

    return '+', '0', '+', '0' if $sig_str eq '0';

    $exp_str =~ tr/_//d;                        # "01_234" -> "01234"
    $exp_str =~ s/^0+//;                        # "01234" -> "1234"
    $exp_str = '0' unless CORE::length($exp_str);
    $exp_sgn = '+' if $exp_str eq '0';          # "+3e-0" -> "+3e+0"

    return $sig_sgn, $sig_str, $exp_sgn, $exp_str;
}

# Takes any string representing a valid decimal number and splits it into four
# strings: the sign of the significand, the absolute value of the significand,
# the sign of the exponent, and the absolute value of the exponent. Both the
# significand and the exponent are in base 10.
#
# Perl accepts literals like the following. The value is 100.1.
#
#   1__0__.__0__1__e+0__1__     (prints "Misplaced _ in number")
#   1_0.0_1e+0_1
#
# Strings representing decimal numbers do not allow underscores, so only the
# following is valid
#
#   "10.01e+01"

sub _dec_str_to_dec_str_parts {
    my $class = shift;
    my $str   = shift;

    if ($str =~ /
                    ^

                    # optional leading whitespace
                    \s*

                    # optional sign
                    ( [+-]? )

                    # significand
                    (
                        # integer part and optional fraction part ...
                        \d+ (?: _+ \d+ )* _*
                        (?:
                            \.
                            (?: _* \d+ (?: _+ \d+ )* _* )?
                        )?
                    |
                        # ... or mandatory fraction part
                        \.
                        \d+ (?: _+ \d+ )* _*
                    )

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

                    # optional trailing whitespace
                    \s*

                    $
                /x)
    {
        return $class -> _trim_split_parts($1, $2, $3, $4);
    }

    return;
}

# Takes any string representing a valid hexadecimal number and splits it into
# four strings: the sign of the significand, the absolute value of the
# significand, the sign of the exponent, and the absolute value of the exponent.
# The significand is in base 16, and the exponent is in base 2.
#
# Perl accepts literals like the following. The "x" might be a capital "X". The
# value is 32.0078125.
#
#   0x__1__0__.0__1__p+0__1__   (prints "Misplaced _ in number")
#   0x1_0.0_1p+0_1
#
# The CORE::hex() function does not accept floating point accepts
#
#   "0x_1_0"
#   "x_1_0"
#   "_1_0"

sub _hex_str_to_hex_str_parts {
    my $class = shift;
    my $str   = shift;

    if ($str =~ /
                    ^

                    # optional leading whitespace
                    \s*

                    # optional sign
                    ( [+-]? )

                    # optional hex prefix
                    (?: 0? [Xx] _* )?

                    # significand using the hex digits 0..9 and a..f
                    (
                        # integer part and optional fraction part ...
                        [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _*
                        (?:
                            \.
                            (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )?
                        )?
                    |
                        # ... or mandatory fraction part
                        \.
                        [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _*
                    )

                    # optional exponent (power of 2) using decimal digits
                    (?:
                        [Pp]
                        ( [+-]? )
                        ( \d+ (?: _+ \d+ )* _* )
                    )?

                    # optional trailing whitespace
                    \s*

                    $
                /x)
    {
        return $class -> _trim_split_parts($1, $2, $3, $4);
    }

    return;
}

# Takes any string representing a valid octal number and splits it into four
# strings: the sign of the significand, the absolute value of the significand,
# the sign of the exponent, and the absolute value of the exponent. The
# significand is in base 8, and the exponent is in base 2.

sub _oct_str_to_oct_str_parts {
    my $class = shift;
    my $str   = shift;

    if ($str =~ /
                    ^

                    # optional leading whitespace
                    \s*

                    # optional sign
                    ( [+-]? )

                    # optional octal prefix
                    (?: 0? [Oo] _* )?

                    # significand using the octal digits 0..7
                    (
                        # integer part and optional fraction part ...
                        [0-7]+ (?: _+ [0-7]+ )* _*
                        (?:
                            \.
                            (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )?
                        )?
                    |
                        # ... or mandatory fraction part
                        \.
                        [0-7]+ (?: _+ [0-7]+ )* _*
                    )

                    # optional exponent (power of 2) using decimal digits
                    (?:
                        [Pp]
                        ( [+-]? )
                        ( \d+ (?: _+ \d+ )* _* )
                    )?

                    # optional trailing whitespace
                    \s*

                    $
                /x)
    {
        return $class -> _trim_split_parts($1, $2, $3, $4);
    }

    return;
}

# Takes any string representing a valid binary number and splits it into four
# strings: the sign of the significand, the absolute value of the significand,
# the sign of the exponent, and the absolute value of the exponent. The
# significand is in base 2, and the exponent is in base 2.

sub _bin_str_to_bin_str_parts {
    my $class = shift;
    my $str   = shift;

    if ($str =~ /
                    ^

                    # optional leading whitespace
                    \s*

                    # optional sign
                    ( [+-]? )

                    # optional binary prefix
                    (?: 0? [Bb] _* )?

                    # significand using the binary digits 0 and 1
                    (
                        # integer part and optional fraction part ...
                        [01]+ (?: _+ [01]+ )* _*
                        (?:
                            \.
                            (?: _* [01]+ (?: _+ [01]+ )* _* )?
                        )?
                    |
                        # ... or mandatory fraction part
                        \.
                        [01]+ (?: _+ [01]+ )* _*
                    )

                    # optional exponent (power of 2) using decimal digits
                    (?:
                        [Pp]
                        ( [+-]? )
                        ( \d+ (?: _+ \d+ )* _* )
                    )?

                    # optional trailing whitespace
                    \s*

                    $
                /x)
    {
        return $class -> _trim_split_parts($1, $2, $3, $4);
    }

    return;
}

# Takes any string representing a valid decimal number and splits it into four
# parts: the sign of the significand, the absolute value of the significand as a
# libray thingy, the sign of the exponent, and the absolute value of the
# exponent as a library thingy.

sub _dec_str_parts_to_flt_lib_parts {
    shift;               # class name

    my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_;

    # Handle zero.

    if ($sig_str eq '0') {
        return '+', $LIB -> _zero(), '+', $LIB -> _zero();
    }

    # Absolute value of exponent as library "object".

    my $exp_lib = $LIB -> _new($exp_str);

    # If there is a dot in the significand, remove it so the significand
    # becomes an integer and adjust the exponent accordingly. Also remove
    # leading zeros which might now appear in the significand. E.g.,
    #
    #     12.345e-2  ->  12345e-5
    #     12.345e+2  ->  12345e-1
    #     0.0123e+5  ->  00123e+1  ->  123e+1

    my $idx = index $sig_str, '.';
    if ($idx >= 0) {
        substr($sig_str, $idx, 1) = '';

        # delta = length - index
        my $delta = $LIB -> _new(CORE::length($sig_str));
        $delta = $LIB -> _sub($delta, $LIB -> _new($idx));

        # exponent - delta
        ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+');

        $sig_str =~ s/^0+//;
    }

    # If there are trailing zeros in the significand, remove them and
    # adjust the exponent. E.g.,
    #
    #     12340e-5  ->  1234e-4
    #     12340e-1  ->  1234e0
    #     12340e+3  ->  1234e4

    if ($sig_str =~ s/(0+)\z//) {
        my $len = CORE::length($1);
        ($exp_lib, $exp_sgn) =
          $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+');
    }

    # At this point, the significand is empty or an integer with no trailing
    # zeros. The exponent is in base 10.

    unless (CORE::length $sig_str) {
        return '+', $LIB -> _zero(), '+', $LIB -> _zero();
    }

    # Absolute value of significand as library "object".

    my $sig_lib = $LIB -> _new($sig_str);

    return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib;
}

# Takes any string representing a valid binary number and splits it into four
# parts: the sign of the significand, the absolute value of the significand as a
# libray thingy, the sign of the exponent, and the absolute value of the
# exponent as a library thingy.

sub _bin_str_parts_to_flt_lib_parts {
    shift;               # class name

    my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_;
    my $bpc_lib = $LIB -> _new($bpc);

    # Handle zero.

    if ($sig_str eq '0') {
        return '+', $LIB -> _zero(), '+', $LIB -> _zero();
    }

    # Absolute value of exponent as library "object".

    my $exp_lib = $LIB -> _new($exp_str);

    # If there is a dot in the significand, remove it so the significand
    # becomes an integer and adjust the exponent accordingly. Also remove
    # leading zeros which might now appear in the significand. E.g., with
    # hexadecimal numbers
    #
    #     12.345p-2  ->  12345p-14
    #     12.345p+2  ->  12345p-10
    #     0.0123p+5  ->  00123p-11  ->  123p-11

    my $idx = index $sig_str, '.';
    if ($idx >= 0) {
        substr($sig_str, $idx, 1) = '';

        # delta = (length - index) * bpc
        my $delta = $LIB -> _new(CORE::length($sig_str));
        $delta = $LIB -> _sub($delta, $LIB -> _new($idx));
        $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1;

        # exponent - delta
        ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+');

        $sig_str =~ s/^0+//;
    }

    # If there are trailing zeros in the significand, remove them and
    # adjust the exponent accordingly. E.g., with hexadecimal numbers
    #
    #     12340p-5  ->  1234p-1
    #     12340p-1  ->  1234p+3
    #     12340p+3  ->  1234p+7

    if ($sig_str =~ s/(0+)\z//) {

        # delta = length * bpc
        my $delta = $LIB -> _new(CORE::length($1));
        $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1;

        # exponent + delta
        ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+');
    }

    # At this point, the significand is empty or an integer with no leading
    # or trailing zeros. The exponent is in base 2.

    unless (CORE::length $sig_str) {
        return '+', $LIB -> _zero(), '+', $LIB -> _zero();
    }

    # Absolute value of significand as library "object".

    my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str)
                : $bpc == 3 ? $LIB -> _from_oct('0'  . $sig_str)
                : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str)
                : die "internal error: invalid exponent multiplier";

    # If the exponent (in base 2) is positive or zero ...

    if ($exp_sgn eq '+') {

        if (!$LIB -> _is_zero($exp_lib)) {

            # Multiply significand by 2 raised to the exponent.

            my $p = $LIB -> _pow($LIB -> _two(), $exp_lib);
            $sig_lib = $LIB -> _mul($sig_lib, $p);
            $exp_lib = $LIB -> _zero();
        }
    }

    # ... else if the exponent is negative ...

    else {

        # Rather than dividing the significand by 2 raised to the absolute
        # value of the exponent, multiply the significand by 5 raised to the
        # absolute value of the exponent and let the exponent be in base 10:
        #
        # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b

        my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib);
        $sig_lib = $LIB -> _mul($sig_lib, $p);
    }

    # Adjust for the case when the conversion to decimal introduced trailing
    # zeros in the significand.

    my $n = $LIB -> _zeros($sig_lib);
    if ($n) {
        $n = $LIB -> _new($n);
        $sig_lib = $LIB -> _rsft($sig_lib, $n, 10);
        ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+');
    }

    return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib;
}

# Takes any string representing a valid hexadecimal number and splits it into
# four parts: the sign of the significand, the absolute value of the significand
# as a libray thingy, the sign of the exponent, and the absolute value of the
# exponent as a library thingy.

sub _hex_str_to_flt_lib_parts {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _hex_str_to_hex_str_parts($str)) {
        return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 4);  # 4 bits pr. chr
    }
    return;
}

# Takes any string representing a valid octal number and splits it into four
# parts: the sign of the significand, the absolute value of the significand as a
# libray thingy, the sign of the exponent, and the absolute value of the
# exponent as a library thingy.

sub _oct_str_to_flt_lib_parts {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _oct_str_to_oct_str_parts($str)) {
        return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 3);  # 3 bits pr. chr
    }
    return;
}

# Takes any string representing a valid binary number and splits it into four
# parts: the sign of the significand, the absolute value of the significand as a
# libray thingy, the sign of the exponent, and the absolute value of the
# exponent as a library thingy.

sub _bin_str_to_flt_lib_parts {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _bin_str_to_bin_str_parts($str)) {
        return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 1);  # 1 bit pr. chr
    }
    return;
}

# Decimal string is split into the sign of the signficant, the absolute value of
# the significand as library thingy, the sign of the exponent, and the absolute
# value of the exponent as a a library thingy.

sub _dec_str_to_flt_lib_parts {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _dec_str_to_dec_str_parts($str)) {
        return $class -> _dec_str_parts_to_flt_lib_parts(@parts);
    }
    return;
}

# Hexdecimal string to a string using decimal floating point notation.

sub hex_str_to_dec_flt_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_flt_str(@parts);
    }
    return;
}

# Octal string to a string using decimal floating point notation.

sub oct_str_to_dec_flt_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_flt_str(@parts);
    }
    return;
}

# Binary string to a string decimal floating point notation.

sub bin_str_to_dec_flt_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_flt_str(@parts);
    }
    return;
}

# Decimal string to a string using decimal floating point notation.

sub dec_str_to_dec_flt_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_flt_str(@parts);
    }
    return;
}

# Hexdecimal string to decimal notation (no exponent).

sub hex_str_to_dec_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_dec_str(@parts);
    }
    return;
}

# Octal string to decimal notation (no exponent).

sub oct_str_to_dec_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_dec_str(@parts);
    }
    return;
}

# Binary string to decimal notation (no exponent).

sub bin_str_to_dec_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_dec_str(@parts);
    }
    return;
}

# Decimal string to decimal notation (no exponent).

sub dec_str_to_dec_str {
    my $class = shift;
    my $str   = shift;
    if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
        return $class -> _flt_lib_parts_to_dec_str(@parts);
    }
    return;
}

sub _flt_lib_parts_to_flt_str {
    my $class = shift;
    my @parts = @_;
    return $parts[0] . $LIB -> _str($parts[1])
      . 'e' . $parts[2] . $LIB -> _str($parts[3]);
}

sub _flt_lib_parts_to_dec_str {
    my $class = shift;
    my @parts = @_;

    # The number is an integer iff the exponent is non-negative.

    if ($parts[2] eq '+') {
        my $str = $parts[0]
          . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10));
        return $str;
    }

    # If it is not an integer, add a decimal point.

    else {
        my $mant     = $LIB -> _str($parts[1]);
        my $mant_len = CORE::length($mant);
        my $expo     = $LIB -> _num($parts[3]);
        my $len_cmp = $mant_len <=> $expo;
        if ($len_cmp <= 0) {
            return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant;
        } else {
            substr $mant, $mant_len - $expo, 0, '.';
            return $parts[0] . $mant;
        }
    }
}

# Takes four arguments, the sign of the significand, the absolute value of the
# significand as a libray thingy, the sign of the exponent, and the absolute
# value of the exponent as a library thingy, and returns three parts: the sign
# of the rational number, the absolute value of the numerator as a libray
# thingy, and the absolute value of the denominator as a library thingy.
#
# For example, to convert data representing the value "+12e-2", then
#
#   $sm = "+";
#   $m  = $LIB -> _new("12");
#   $se = "-";
#   $e  = $LIB -> _new("2");
#   ($sr, $n, $d) = $class -> _flt_lib_parts_to_rat_lib_parts($sm, $m, $se, $e);
#
# returns data representing the same value written as the fraction "+3/25"
#
#   $sr = "+"
#   $n  = $LIB -> _new("3");
#   $d  = $LIB -> _new("12");

sub _flt_lib_parts_to_rat_lib_parts {
    my $self = shift;
    my ($msgn, $mabs, $esgn, $eabs) = @_;

    if ($esgn eq '-') {                 # "12e-2" -> "12/100" -> "3/25"
        my $num_lib = $LIB -> _copy($mabs);
        my $den_lib = $LIB -> _1ex($LIB -> _num($eabs));
        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($num_lib), $den_lib);
        $num_lib = $LIB -> _div($LIB -> _copy($num_lib), $gcd_lib);
        $den_lib = $LIB -> _div($den_lib, $gcd_lib);
        return $msgn, $num_lib, $den_lib;
    }

    elsif (!$LIB -> _is_zero($eabs)) {  # "12e+2" -> "1200" -> "1200/1"
        return $msgn, $LIB -> _lsft($LIB -> _copy($mabs), $eabs, 10),
                      $LIB -> _one();
    }

    else {                              # "12e+0" -> "12" -> "12/1"
        return $msgn, $mabs, $LIB -> _one();
    }
}

# Add the function _register_callback() to Math::BigInt. It is provided for
# backwards compabibility so that old version of Math::BigRat etc. don't
# complain about missing it.

sub _register_callback { }

###############################################################################
# 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__