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