"Fossies" - the Fresh Open Source Software Archive

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


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

    1 package Math::BigInt::Calc;
    2 
    3 use 5.006001;
    4 use strict;
    5 use warnings;
    6 
    7 use Carp qw< carp croak >;
    8 use Math::BigInt::Lib;
    9 
   10 our $VERSION = '1.999816';
   11 
   12 our @ISA = ('Math::BigInt::Lib');
   13 
   14 # Package to store unsigned big integers in decimal and do math with them
   15 
   16 # Internally the numbers are stored in an array with at least 1 element, no
   17 # leading zero parts (except the first) and in base 1eX where X is determined
   18 # automatically at loading time to be the maximum possible value
   19 
   20 # todo:
   21 # - fully remove funky $# stuff in div() (maybe - that code scares me...)
   22 
   23 # USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
   24 # instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
   25 # BS2000, some Crays need USE_DIV instead.
   26 # The BEGIN block is used to determine which of the two variants gives the
   27 # correct result.
   28 
   29 # Beware of things like:
   30 # $i = $i * $y + $car; $car = int($i / $BASE); $i = $i % $BASE;
   31 # This works on x86, but fails on ARM (SA1100, iPAQ) due to who knows what
   32 # reasons. So, use this instead (slower, but correct):
   33 # $i = $i * $y + $car; $car = int($i / $BASE); $i -= $BASE * $car;
   34 
   35 ##############################################################################
   36 # global constants, flags and accessory
   37 
   38 # announce that we are compatible with MBI v1.83 and up
   39 sub api_version () { 2; }
   40 
   41 # constants for easier life
   42 my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL);
   43 my ($AND_BITS, $XOR_BITS, $OR_BITS);
   44 my ($AND_MASK, $XOR_MASK, $OR_MASK);
   45 
   46 sub _base_len {
   47     # Set/get the BASE_LEN and assorted other, related values.
   48     # Used only by the testsuite, the set variant is used only by the BEGIN
   49     # block below:
   50 
   51     my ($class, $b, $int) = @_;
   52     if (defined $b) {
   53         # avoid redefinitions
   54         undef &_mul;
   55         undef &_div;
   56 
   57         if ($] >= 5.008 && $int && $b > 7) {
   58             $BASE_LEN = $b;
   59             *_mul = \&_mul_use_div_64;
   60             *_div = \&_div_use_div_64;
   61             $BASE = int("1e" . $BASE_LEN);
   62             $MAX_VAL = $BASE-1;
   63             return $BASE_LEN unless wantarray;
   64             return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL);
   65         }
   66 
   67         # find whether we can use mul or div in mul()/div()
   68         $BASE_LEN = $b + 1;
   69         my $caught = 0;
   70         while (--$BASE_LEN > 5) {
   71             $BASE = int("1e" . $BASE_LEN);
   72             $RBASE = abs('1e-' . $BASE_LEN); # see USE_MUL
   73             $caught = 0;
   74             $caught += 1 if (int($BASE * $RBASE) != 1); # should be 1
   75             $caught += 2 if (int($BASE / $BASE) != 1);  # should be 1
   76             last if $caught != 3;
   77         }
   78         $BASE = int("1e" . $BASE_LEN);
   79         $RBASE = abs('1e-' . $BASE_LEN); # see USE_MUL
   80         $MAX_VAL = $BASE-1;
   81 
   82         # ($caught & 1) != 0 => cannot use MUL
   83         # ($caught & 2) != 0 => cannot use DIV
   84         if ($caught == 2)       # 2
   85         {
   86             # must USE_MUL since we cannot use DIV
   87             *_mul = \&_mul_use_mul;
   88             *_div = \&_div_use_mul;
   89         } else                  # 0 or 1
   90         {
   91             # can USE_DIV instead
   92             *_mul = \&_mul_use_div;
   93             *_div = \&_div_use_div;
   94         }
   95     }
   96     return $BASE_LEN unless wantarray;
   97     return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL);
   98 }
   99 
  100 sub _new {
  101     # Given a string representing an integer, returns a reference to an array
  102     # of integers, where each integer represents a chunk of the original input
  103     # integer.
  104 
  105     my ($class, $str) = @_;
  106     #unless ($str =~ /^([1-9]\d*|0)\z/) {
  107     #    croak("Invalid input string '$str'");
  108     #}
  109 
  110     my $input_len = length($str) - 1;
  111 
  112     # Shortcut for small numbers.
  113     return bless [ $str ], $class if $input_len < $BASE_LEN;
  114 
  115     my $format = "a" . (($input_len % $BASE_LEN) + 1);
  116     $format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN)
  117                           : "(a$BASE_LEN)*";
  118 
  119     my $self = [ reverse(map { 0 + $_ } unpack($format, $str)) ];
  120     return bless $self, $class;
  121 }
  122 
  123 BEGIN {
  124     # from Daniel Pfeiffer: determine largest group of digits that is precisely
  125     # multipliable with itself plus carry
  126     # Test now changed to expect the proper pattern, not a result off by 1 or 2
  127     my ($e, $num) = 3;          # lowest value we will use is 3+1-1 = 3
  128     do {
  129         $num = '9' x ++$e;
  130         $num *= $num + 1;
  131     } while $num =~ /9{$e}0{$e}/; # must be a certain pattern
  132     $e--;                         # last test failed, so retract one step
  133     # the limits below brush the problems with the test above under the rug:
  134     # the test should be able to find the proper $e automatically
  135     $e = 5 if $^O =~ /^uts/;    # UTS get's some special treatment
  136     $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work
  137                                 # there, but we play safe)
  138 
  139     my $int = 0;
  140     if ($e > 7) {
  141         use integer;
  142         my $e1 = 7;
  143         $num = 7;
  144         do {
  145             $num = ('9' x ++$e1) + 0;
  146             $num *= $num + 1;
  147         } while ("$num" =~ /9{$e1}0{$e1}/); # must be a certain pattern
  148         $e1--;                  # last test failed, so retract one step
  149         if ($e1 > 7) {
  150             $int = 1;
  151             $e = $e1;
  152         }
  153     }
  154 
  155     __PACKAGE__ -> _base_len($e, $int);        # set and store
  156 
  157     use integer;
  158     # find out how many bits _and, _or and _xor can take (old default = 16)
  159     # I don't think anybody has yet 128 bit scalars, so let's play safe.
  160     local $^W = 0;              # don't warn about 'nonportable number'
  161     $AND_BITS = 15;
  162     $XOR_BITS = 15;
  163     $OR_BITS  = 15;
  164 
  165     # find max bits, we will not go higher than numberofbits that fit into $BASE
  166     # to make _and etc simpler (and faster for smaller, slower for large numbers)
  167     my $max = 16;
  168     while (2 ** $max < $BASE) {
  169         $max++;
  170     }
  171     {
  172         no integer;
  173         $max = 16 if $] < 5.006; # older Perls might not take >16 too well
  174     }
  175     my ($x, $y, $z);
  176 
  177     do {
  178         $AND_BITS++;
  179         $x = CORE::oct('0b' . '1' x $AND_BITS);
  180         $y = $x & $x;
  181         $z = (2 ** $AND_BITS) - 1;
  182     } while ($AND_BITS < $max && $x == $z && $y == $x);
  183     $AND_BITS --;               # retreat one step
  184 
  185     do {
  186         $XOR_BITS++;
  187         $x = CORE::oct('0b' . '1' x $XOR_BITS);
  188         $y = $x ^ 0;
  189         $z = (2 ** $XOR_BITS) - 1;
  190     } while ($XOR_BITS < $max && $x == $z && $y == $x);
  191     $XOR_BITS --;               # retreat one step
  192 
  193     do {
  194         $OR_BITS++;
  195         $x = CORE::oct('0b' . '1' x $OR_BITS);
  196         $y = $x | $x;
  197         $z = (2 ** $OR_BITS) -  1;
  198     } while ($OR_BITS < $max && $x == $z && $y == $x);
  199     $OR_BITS--;                # retreat one step
  200 
  201     $AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS ));
  202     $XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS ));
  203     $OR_MASK  = __PACKAGE__->_new(( 2 ** $OR_BITS  ));
  204 
  205     # We can compute the approximate length no faster than the real length:
  206     *_alen = \&_len;
  207 }
  208 
  209 ###############################################################################
  210 
  211 sub _zero {
  212     # create a zero
  213     my $class = shift;
  214     return bless [ 0 ], $class;
  215 }
  216 
  217 sub _one {
  218     # create a one
  219     my $class = shift;
  220     return bless [ 1 ], $class;
  221 }
  222 
  223 sub _two {
  224     # create a two
  225     my $class = shift;
  226     return bless [ 2 ], $class;
  227 }
  228 
  229 sub _ten {
  230     # create a 10
  231     my $class = shift;
  232     bless [ 10 ], $class;
  233 }
  234 
  235 sub _1ex {
  236     # create a 1Ex
  237     my $class = shift;
  238 
  239     my $rem   = $_[0] % $BASE_LEN;      # remainder
  240     my $parts = $_[0] / $BASE_LEN;      # parts
  241 
  242     # 000000, 000000, 100
  243     bless [ (0) x $parts, '1' . ('0' x $rem) ], $class;
  244 }
  245 
  246 sub _copy {
  247     # make a true copy
  248     my $class = shift;
  249     return bless [ @{ $_[0] } ], $class;
  250 }
  251 
  252 # catch and throw away
  253 sub import { }
  254 
  255 ##############################################################################
  256 # convert back to string and number
  257 
  258 sub _str {
  259     # Convert number from internal base 1eN format to string format. Internal
  260     # format is always normalized, i.e., no leading zeros.
  261 
  262     my $ary = $_[1];
  263     my $idx = $#$ary;           # index of last element
  264 
  265     if ($idx < 0) {             # should not happen
  266         croak("$_[1] has no elements");
  267     }
  268 
  269     # Handle first one differently, since it should not have any leading zeros.
  270     my $ret = int($ary->[$idx]);
  271     if ($idx > 0) {
  272         # Interestingly, the pre-padd method uses more time.
  273         # The old grep variant takes longer (14 vs. 10 sec).
  274         my $z = '0' x ($BASE_LEN - 1);
  275         while (--$idx >= 0) {
  276             $ret .= substr($z . $ary->[$idx], -$BASE_LEN);
  277         }
  278     }
  279     $ret;
  280 }
  281 
  282 sub _num {
  283     # Make a Perl scalar number (int/float) from a BigInt object.
  284     my $x = $_[1];
  285 
  286     return $x->[0] if @$x == 1;         # below $BASE
  287 
  288     # Start with the most significant element and work towards the least
  289     # significant element. Avoid multiplying "inf" (which happens if the number
  290     # overflows) with "0" (if there are zero elements in $x) since this gives
  291     # "nan" which propagates to the output.
  292 
  293     my $num = 0;
  294     for (my $i = $#$x ; $i >= 0 ; --$i) {
  295         $num *= $BASE;
  296         $num += $x -> [$i];
  297     }
  298     return $num;
  299 }
  300 
  301 ##############################################################################
  302 # actual math code
  303 
  304 sub _add {
  305     # (ref to int_num_array, ref to int_num_array)
  306     #
  307     # Routine to add two base 1eX numbers stolen from Knuth Vol 2 Algorithm A
  308     # pg 231. There are separate routines to add and sub as per Knuth pg 233.
  309     # This routine modifies array x, but not y.
  310 
  311     my ($c, $x, $y) = @_;
  312 
  313     # $x + 0 => $x
  314 
  315     return $x if @$y == 1 && $y->[0] == 0;
  316 
  317     # 0 + $y => $y->copy
  318 
  319     if (@$x == 1 && $x->[0] == 0) {
  320         @$x = @$y;
  321         return $x;
  322     }
  323 
  324     # For each in Y, add Y to X and carry. If after that, something is left in
  325     # X, foreach in X add carry to X and then return X, carry. Trades one
  326     # "$j++" for having to shift arrays.
  327     my $i;
  328     my $car = 0;
  329     my $j = 0;
  330     for $i (@$y) {
  331         $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
  332         $j++;
  333     }
  334     while ($car != 0) {
  335         $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0;
  336         $j++;
  337     }
  338     $x;
  339 }
  340 
  341 sub _inc {
  342     # (ref to int_num_array, ref to int_num_array)
  343     # Add 1 to $x, modify $x in place
  344     my ($c, $x) = @_;
  345 
  346     for my $i (@$x) {
  347         return $x if ($i += 1) < $BASE; # early out
  348         $i = 0;                         # overflow, next
  349     }
  350     push @$x, 1 if $x->[-1] == 0;       # last overflowed, so extend
  351     $x;
  352 }
  353 
  354 sub _dec {
  355     # (ref to int_num_array, ref to int_num_array)
  356     # Sub 1 from $x, modify $x in place
  357     my ($c, $x) = @_;
  358 
  359     my $MAX = $BASE - 1;                # since MAX_VAL based on BASE
  360     for my $i (@$x) {
  361         last if ($i -= 1) >= 0;         # early out
  362         $i = $MAX;                      # underflow, next
  363     }
  364     pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0)
  365     $x;
  366 }
  367 
  368 sub _sub {
  369     # (ref to int_num_array, ref to int_num_array, swap)
  370     #
  371     # Subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
  372     # subtract Y from X by modifying x in place
  373     my ($c, $sx, $sy, $s) = @_;
  374 
  375     my $car = 0;
  376     my $i;
  377     my $j = 0;
  378     if (!$s) {
  379         for $i (@$sx) {
  380             last unless defined $sy->[$j] || $car;
  381             $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0);
  382             $j++;
  383         }
  384         # might leave leading zeros, so fix that
  385         return __strip_zeros($sx);
  386     }
  387     for $i (@$sx) {
  388         # We can't do an early out if $x < $y, since we need to copy the high
  389         # chunks from $y. Found by Bob Mathews.
  390         #last unless defined $sy->[$j] || $car;
  391         $sy->[$j] += $BASE
  392           if $car = ($sy->[$j] = $i - ($sy->[$j] || 0) - $car) < 0;
  393         $j++;
  394     }
  395     # might leave leading zeros, so fix that
  396     __strip_zeros($sy);
  397 }
  398 
  399 sub _mul_use_mul {
  400     # (ref to int_num_array, ref to int_num_array)
  401     # multiply two numbers in internal representation
  402     # modifies first arg, second need not be different from first
  403     my ($c, $xv, $yv) = @_;
  404 
  405     if (@$yv == 1) {
  406         # shortcut for two very short numbers (improved by Nathan Zook)
  407         # works also if xv and yv are the same reference, and handles also $x == 0
  408         if (@$xv == 1) {
  409             if (($xv->[0] *= $yv->[0]) >= $BASE) {
  410                 $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE;
  411             }
  412             ;
  413             return $xv;
  414         }
  415         # $x * 0 => 0
  416         if ($yv->[0] == 0) {
  417             @$xv = (0);
  418             return $xv;
  419         }
  420         # multiply a large number a by a single element one, so speed up
  421         my $y = $yv->[0];
  422         my $car = 0;
  423         foreach my $i (@$xv) {
  424             $i = $i * $y + $car;
  425             $car = int($i * $RBASE);
  426             $i -= $car * $BASE;
  427         }
  428         push @$xv, $car if $car != 0;
  429         return $xv;
  430     }
  431     # shortcut for result $x == 0 => result = 0
  432     return $xv if @$xv == 1 && $xv->[0] == 0;
  433 
  434     # since multiplying $x with $x fails, make copy in this case
  435     $yv = [ @$xv ] if $xv == $yv; # same references?
  436 
  437     my @prod = ();
  438     my ($prod, $car, $cty, $xi, $yi);
  439 
  440     for $xi (@$xv) {
  441         $car = 0;
  442         $cty = 0;
  443 
  444         # slow variant
  445         #    for $yi (@$yv)
  446         #      {
  447         #      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
  448         #      $prod[$cty++] =
  449         #       $prod - ($car = int($prod * RBASE)) * $BASE;  # see USE_MUL
  450         #      }
  451         #    $prod[$cty] += $car if $car; # need really to check for 0?
  452         #    $xi = shift @prod;
  453 
  454         # faster variant
  455         # looping through this if $xi == 0 is silly - so optimize it away!
  456         $xi = (shift @prod || 0), next if $xi == 0;
  457         for $yi (@$yv) {
  458             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
  459             ##     this is actually a tad slower
  460             ##        $prod = $prod[$cty]; $prod += ($car + $xi * $yi);     # no ||0 here
  461             $prod[$cty++] =
  462               $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL
  463         }
  464         $prod[$cty] += $car if $car; # need really to check for 0?
  465         $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
  466     }
  467     push @$xv, @prod;
  468     # can't have leading zeros
  469     #  __strip_zeros($xv);
  470     $xv;
  471 }
  472 
  473 sub _mul_use_div_64 {
  474     # (ref to int_num_array, ref to int_num_array)
  475     # multiply two numbers in internal representation
  476     # modifies first arg, second need not be different from first
  477     # works for 64 bit integer with "use integer"
  478     my ($c, $xv, $yv) = @_;
  479 
  480     use integer;
  481     if (@$yv == 1) {
  482         # shortcut for two small numbers, also handles $x == 0
  483         if (@$xv == 1) {
  484             # shortcut for two very short numbers (improved by Nathan Zook)
  485             # works also if xv and yv are the same reference, and handles also $x == 0
  486             if (($xv->[0] *= $yv->[0]) >= $BASE) {
  487                 $xv->[0] =
  488                   $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE;
  489             }
  490             return $xv;
  491         }
  492         # $x * 0 => 0
  493         if ($yv->[0] == 0) {
  494             @$xv = (0);
  495             return $xv;
  496         }
  497         # multiply a large number a by a single element one, so speed up
  498         my $y = $yv->[0];
  499         my $car = 0;
  500         foreach my $i (@$xv) {
  501             #$i = $i * $y + $car; $car = $i / $BASE; $i -= $car * $BASE;
  502             $i = $i * $y + $car;
  503             $i -= ($car = $i / $BASE) * $BASE;
  504         }
  505         push @$xv, $car if $car != 0;
  506         return $xv;
  507     }
  508     # shortcut for result $x == 0 => result = 0
  509     return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
  510 
  511     # since multiplying $x with $x fails, make copy in this case
  512     $yv = $c->_copy($xv) if $xv == $yv; # same references?
  513 
  514     my @prod = ();
  515     my ($prod, $car, $cty, $xi, $yi);
  516     for $xi (@$xv) {
  517         $car = 0;
  518         $cty = 0;
  519         # looping through this if $xi == 0 is silly - so optimize it away!
  520         $xi = (shift @prod || 0), next if $xi == 0;
  521         for $yi (@$yv) {
  522             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
  523             $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE;
  524         }
  525         $prod[$cty] += $car if $car; # need really to check for 0?
  526         $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
  527     }
  528     push @$xv, @prod;
  529     $xv;
  530 }
  531 
  532 sub _mul_use_div {
  533     # (ref to int_num_array, ref to int_num_array)
  534     # multiply two numbers in internal representation
  535     # modifies first arg, second need not be different from first
  536     my ($c, $xv, $yv) = @_;
  537 
  538     if (@$yv == 1) {
  539         # shortcut for two small numbers, also handles $x == 0
  540         if (@$xv == 1) {
  541             # shortcut for two very short numbers (improved by Nathan Zook)
  542             # works also if xv and yv are the same reference, and handles also $x == 0
  543             if (($xv->[0] *= $yv->[0]) >= $BASE) {
  544                 $xv->[0] =
  545                   $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE;
  546             }
  547             ;
  548             return $xv;
  549         }
  550         # $x * 0 => 0
  551         if ($yv->[0] == 0) {
  552             @$xv = (0);
  553             return $xv;
  554         }
  555         # multiply a large number a by a single element one, so speed up
  556         my $y = $yv->[0];
  557         my $car = 0;
  558         foreach my $i (@$xv) {
  559             $i = $i * $y + $car;
  560             $car = int($i / $BASE);
  561             $i -= $car * $BASE;
  562             # This (together with use integer;) does not work on 32-bit Perls
  563             #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE;
  564         }
  565         push @$xv, $car if $car != 0;
  566         return $xv;
  567     }
  568     # shortcut for result $x == 0 => result = 0
  569     return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
  570 
  571     # since multiplying $x with $x fails, make copy in this case
  572     $yv = $c->_copy($xv) if $xv == $yv; # same references?
  573 
  574     my @prod = ();
  575     my ($prod, $car, $cty, $xi, $yi);
  576     for $xi (@$xv) {
  577         $car = 0;
  578         $cty = 0;
  579         # looping through this if $xi == 0 is silly - so optimize it away!
  580         $xi = (shift @prod || 0), next if $xi == 0;
  581         for $yi (@$yv) {
  582             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
  583             $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE;
  584         }
  585         $prod[$cty] += $car if $car; # need really to check for 0?
  586         $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
  587     }
  588     push @$xv, @prod;
  589     # can't have leading zeros
  590     #  __strip_zeros($xv);
  591     $xv;
  592 }
  593 
  594 sub _div_use_mul {
  595     # ref to array, ref to array, modify first array and return remainder if
  596     # in list context
  597 
  598     # see comments in _div_use_div() for more explanations
  599 
  600     my ($c, $x, $yorg) = @_;
  601 
  602     # the general div algorithm here is about O(N*N) and thus quite slow, so
  603     # we first check for some special cases and use shortcuts to handle them.
  604 
  605     # This works, because we store the numbers in a chunked format where each
  606     # element contains 5..7 digits (depending on system).
  607 
  608     # if both numbers have only one element:
  609     if (@$x == 1 && @$yorg == 1) {
  610         # shortcut, $yorg and $x are two small numbers
  611         if (wantarray) {
  612             my $rem = [ $x->[0] % $yorg->[0] ];
  613             bless $rem, $c;
  614             $x->[0] = int($x->[0] / $yorg->[0]);
  615             return ($x, $rem);
  616         } else {
  617             $x->[0] = int($x->[0] / $yorg->[0]);
  618             return $x;
  619         }
  620     }
  621 
  622     # if x has more than one, but y has only one element:
  623     if (@$yorg == 1) {
  624         my $rem;
  625         $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;
  626 
  627         # shortcut, $y is < $BASE
  628         my $j = @$x;
  629         my $r = 0;
  630         my $y = $yorg->[0];
  631         my $b;
  632         while ($j-- > 0) {
  633             $b = $r * $BASE + $x->[$j];
  634             $x->[$j] = int($b/$y);
  635             $r = $b % $y;
  636         }
  637         pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
  638         return ($x, $rem) if wantarray;
  639         return $x;
  640     }
  641 
  642     # now x and y have more than one element
  643 
  644     # check whether y has more elements than x, if yet, the result will be 0
  645     if (@$yorg > @$x) {
  646         my $rem;
  647         $rem = $c->_copy($x) if wantarray;    # make copy
  648         @$x = 0;                        # set to 0
  649         return ($x, $rem) if wantarray; # including remainder?
  650         return $x;                      # only x, which is [0] now
  651     }
  652     # check whether the numbers have the same number of elements, in that case
  653     # the result will fit into one element and can be computed efficiently
  654     if (@$yorg == @$x) {
  655 
  656         # if $yorg has more digits than $x (it's leading element is longer than
  657         # the one from $x), the result will also be 0:
  658         if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
  659             my $rem = $c->_copy($x) if wantarray;        # make copy
  660             @$x = 0;                            # set to 0
  661             return ($x, $rem) if wantarray;     # including remainder?
  662             return $x;
  663         }
  664         # now calculate $x / $yorg
  665         if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
  666             # same length, so make full compare
  667 
  668             my $a = 0;
  669             my $j = @$x - 1;
  670             # manual way (abort if unequal, good for early ne)
  671             while ($j >= 0) {
  672                 last if ($a = $x->[$j] - $yorg->[$j]);
  673                 $j--;
  674             }
  675             # $a contains the result of the compare between X and Y
  676             # a < 0: x < y, a == 0: x == y, a > 0: x > y
  677             if ($a <= 0) {
  678                 # a = 0 => x == y => rem 0
  679                 # a < 0 => x < y => rem = x
  680                 my $rem = $a == 0 ? $c->_zero() : $c->_copy($x);
  681                 @$x = 0;             # if $a < 0
  682                 $x->[0] = 1 if $a == 0;  # $x == $y
  683                 return ($x, $rem) if wantarray;
  684                 return $x;
  685             }
  686             # $x >= $y, so proceed normally
  687         }
  688     }
  689 
  690     # all other cases:
  691 
  692     my $y = $c->_copy($yorg);         # always make copy to preserve
  693 
  694     my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
  695 
  696     $car = $bar = $prd = 0;
  697     if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
  698         for $xi (@$x) {
  699             $xi = $xi * $dd + $car;
  700             $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL
  701         }
  702         push(@$x, $car);
  703         $car = 0;
  704         for $yi (@$y) {
  705             $yi = $yi * $dd + $car;
  706             $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL
  707         }
  708     } else {
  709         push(@$x, 0);
  710     }
  711     @q = ();
  712     ($v2, $v1) = @$y[-2, -1];
  713     $v2 = 0 unless $v2;
  714     while ($#$x > $#$y) {
  715         ($u2, $u1, $u0) = @$x[-3 .. -1];
  716         $u2 = 0 unless $u2;
  717         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
  718         # if $v1 == 0;
  719         $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
  720         --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
  721         if ($q) {
  722             ($car, $bar) = (0, 0);
  723             for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
  724                 $prd = $q * $y->[$yi] + $car;
  725                 $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL
  726                 $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
  727             }
  728             if ($x->[-1] < $car + $bar) {
  729                 $car = 0;
  730                 --$q;
  731                 for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
  732                     $x->[$xi] -= $BASE
  733                       if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
  734                 }
  735             }
  736         }
  737         pop(@$x);
  738         unshift(@q, $q);
  739     }
  740     if (wantarray) {
  741         my $d = bless [], $c;
  742         if ($dd != 1) {
  743             $car = 0;
  744             for $xi (reverse @$x) {
  745                 $prd = $car * $BASE + $xi;
  746                 $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL
  747                 unshift(@$d, $tmp);
  748             }
  749         } else {
  750             @$d = @$x;
  751         }
  752         @$x = @q;
  753         __strip_zeros($x);
  754         __strip_zeros($d);
  755         return ($x, $d);
  756     }
  757     @$x = @q;
  758     __strip_zeros($x);
  759     $x;
  760 }
  761 
  762 sub _div_use_div_64 {
  763     # ref to array, ref to array, modify first array and return remainder if
  764     # in list context
  765     # This version works on 64 bit integers
  766     my ($c, $x, $yorg) = @_;
  767 
  768     use integer;
  769     # the general div algorithm here is about O(N*N) and thus quite slow, so
  770     # we first check for some special cases and use shortcuts to handle them.
  771 
  772     # This works, because we store the numbers in a chunked format where each
  773     # element contains 5..7 digits (depending on system).
  774 
  775     # if both numbers have only one element:
  776     if (@$x == 1 && @$yorg == 1) {
  777         # shortcut, $yorg and $x are two small numbers
  778         if (wantarray) {
  779             my $rem = [ $x->[0] % $yorg->[0] ];
  780             bless $rem, $c;
  781             $x->[0] = int($x->[0] / $yorg->[0]);
  782             return ($x, $rem);
  783         } else {
  784             $x->[0] = int($x->[0] / $yorg->[0]);
  785             return $x;
  786         }
  787     }
  788     # if x has more than one, but y has only one element:
  789     if (@$yorg == 1) {
  790         my $rem;
  791         $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;
  792 
  793         # shortcut, $y is < $BASE
  794         my $j = @$x;
  795         my $r = 0;
  796         my $y = $yorg->[0];
  797         my $b;
  798         while ($j-- > 0) {
  799             $b = $r * $BASE + $x->[$j];
  800             $x->[$j] = int($b/$y);
  801             $r = $b % $y;
  802         }
  803         pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
  804         return ($x, $rem) if wantarray;
  805         return $x;
  806     }
  807     # now x and y have more than one element
  808 
  809     # check whether y has more elements than x, if yet, the result will be 0
  810     if (@$yorg > @$x) {
  811         my $rem;
  812         $rem = $c->_copy($x) if wantarray;    # make copy
  813         @$x = 0;                        # set to 0
  814         return ($x, $rem) if wantarray; # including remainder?
  815         return $x;                      # only x, which is [0] now
  816     }
  817     # check whether the numbers have the same number of elements, in that case
  818     # the result will fit into one element and can be computed efficiently
  819     if (@$yorg == @$x) {
  820         my $rem;
  821         # if $yorg has more digits than $x (it's leading element is longer than
  822         # the one from $x), the result will also be 0:
  823         if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
  824             $rem = $c->_copy($x) if wantarray;     # make copy
  825             @$x = 0;                          # set to 0
  826             return ($x, $rem) if wantarray; # including remainder?
  827             return $x;
  828         }
  829         # now calculate $x / $yorg
  830 
  831         if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
  832             # same length, so make full compare
  833 
  834             my $a = 0;
  835             my $j = @$x - 1;
  836             # manual way (abort if unequal, good for early ne)
  837             while ($j >= 0) {
  838                 last if ($a = $x->[$j] - $yorg->[$j]);
  839                 $j--;
  840             }
  841             # $a contains the result of the compare between X and Y
  842             # a < 0: x < y, a == 0: x == y, a > 0: x > y
  843             if ($a <= 0) {
  844                 $rem = $c->_zero();                  # a = 0 => x == y => rem 0
  845                 $rem = $c->_copy($x) if $a != 0;       # a < 0 => x < y => rem = x
  846                 @$x = 0;                       # if $a < 0
  847                 $x->[0] = 1 if $a == 0;        # $x == $y
  848                 return ($x, $rem) if wantarray; # including remainder?
  849                 return $x;
  850             }
  851             # $x >= $y, so proceed normally
  852         }
  853     }
  854 
  855     # all other cases:
  856 
  857     my $y = $c->_copy($yorg);         # always make copy to preserve
  858 
  859     my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
  860 
  861     $car = $bar = $prd = 0;
  862     if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
  863         for $xi (@$x) {
  864             $xi = $xi * $dd + $car;
  865             $xi -= ($car = int($xi / $BASE)) * $BASE;
  866         }
  867         push(@$x, $car);
  868         $car = 0;
  869         for $yi (@$y) {
  870             $yi = $yi * $dd + $car;
  871             $yi -= ($car = int($yi / $BASE)) * $BASE;
  872         }
  873     } else {
  874         push(@$x, 0);
  875     }
  876 
  877     # @q will accumulate the final result, $q contains the current computed
  878     # part of the final result
  879 
  880     @q = ();
  881     ($v2, $v1) = @$y[-2, -1];
  882     $v2 = 0 unless $v2;
  883     while ($#$x > $#$y) {
  884         ($u2, $u1, $u0) = @$x[-3..-1];
  885         $u2 = 0 unless $u2;
  886         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
  887         # if $v1 == 0;
  888         $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
  889         --$q while ($v2 * $q > ($u0 * $BASE +$ u1- $q*$v1) * $BASE + $u2);
  890         if ($q) {
  891             ($car, $bar) = (0, 0);
  892             for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
  893                 $prd = $q * $y->[$yi] + $car;
  894                 $prd -= ($car = int($prd / $BASE)) * $BASE;
  895                 $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
  896             }
  897             if ($x->[-1] < $car + $bar) {
  898                 $car = 0;
  899                 --$q;
  900                 for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
  901                     $x->[$xi] -= $BASE
  902                       if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
  903                 }
  904             }
  905         }
  906         pop(@$x);
  907         unshift(@q, $q);
  908     }
  909     if (wantarray) {
  910         my $d = bless [], $c;
  911         if ($dd != 1) {
  912             $car = 0;
  913             for $xi (reverse @$x) {
  914                 $prd = $car * $BASE + $xi;
  915                 $car = $prd - ($tmp = int($prd / $dd)) * $dd;
  916                 unshift(@$d, $tmp);
  917             }
  918         } else {
  919             @$d = @$x;
  920         }
  921         @$x = @q;
  922         __strip_zeros($x);
  923         __strip_zeros($d);
  924         return ($x, $d);
  925     }
  926     @$x = @q;
  927     __strip_zeros($x);
  928     $x;
  929 }
  930 
  931 sub _div_use_div {
  932     # ref to array, ref to array, modify first array and return remainder if
  933     # in list context
  934     my ($c, $x, $yorg) = @_;
  935 
  936     # the general div algorithm here is about O(N*N) and thus quite slow, so
  937     # we first check for some special cases and use shortcuts to handle them.
  938 
  939     # This works, because we store the numbers in a chunked format where each
  940     # element contains 5..7 digits (depending on system).
  941 
  942     # if both numbers have only one element:
  943     if (@$x == 1 && @$yorg == 1) {
  944         # shortcut, $yorg and $x are two small numbers
  945         if (wantarray) {
  946             my $rem = [ $x->[0] % $yorg->[0] ];
  947             bless $rem, $c;
  948             $x->[0] = int($x->[0] / $yorg->[0]);
  949             return ($x, $rem);
  950         } else {
  951             $x->[0] = int($x->[0] / $yorg->[0]);
  952             return $x;
  953         }
  954     }
  955     # if x has more than one, but y has only one element:
  956     if (@$yorg == 1) {
  957         my $rem;
  958         $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;
  959 
  960         # shortcut, $y is < $BASE
  961         my $j = @$x;
  962         my $r = 0;
  963         my $y = $yorg->[0];
  964         my $b;
  965         while ($j-- > 0) {
  966             $b = $r * $BASE + $x->[$j];
  967             $x->[$j] = int($b/$y);
  968             $r = $b % $y;
  969         }
  970         pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
  971         return ($x, $rem) if wantarray;
  972         return $x;
  973     }
  974     # now x and y have more than one element
  975 
  976     # check whether y has more elements than x, if yet, the result will be 0
  977     if (@$yorg > @$x) {
  978         my $rem;
  979         $rem = $c->_copy($x) if wantarray;    # make copy
  980         @$x = 0;                        # set to 0
  981         return ($x, $rem) if wantarray; # including remainder?
  982         return $x;                      # only x, which is [0] now
  983     }
  984     # check whether the numbers have the same number of elements, in that case
  985     # the result will fit into one element and can be computed efficiently
  986     if (@$yorg == @$x) {
  987         my $rem;
  988         # if $yorg has more digits than $x (it's leading element is longer than
  989         # the one from $x), the result will also be 0:
  990         if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
  991             $rem = $c->_copy($x) if wantarray;        # make copy
  992             @$x = 0;                            # set to 0
  993             return ($x, $rem) if wantarray;     # including remainder?
  994             return $x;
  995         }
  996         # now calculate $x / $yorg
  997 
  998         if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
  999             # same length, so make full compare
 1000 
 1001             my $a = 0;
 1002             my $j = @$x - 1;
 1003             # manual way (abort if unequal, good for early ne)
 1004             while ($j >= 0) {
 1005                 last if ($a = $x->[$j] - $yorg->[$j]);
 1006                 $j--;
 1007             }
 1008             # $a contains the result of the compare between X and Y
 1009             # a < 0: x < y, a == 0: x == y, a > 0: x > y
 1010             if ($a <= 0) {
 1011                 $rem = $c->_zero();                   # a = 0 => x == y => rem 0
 1012                 $rem = $c->_copy($x) if $a != 0;      # a < 0 => x < y => rem = x
 1013                 @$x = 0;
 1014                 $x->[0] = 0;                    # if $a < 0
 1015                 $x->[0] = 1 if $a == 0;         # $x == $y
 1016                 return ($x, $rem) if wantarray; # including remainder?
 1017                 return $x;
 1018             }
 1019             # $x >= $y, so proceed normally
 1020 
 1021         }
 1022     }
 1023 
 1024     # all other cases:
 1025 
 1026     my $y = $c->_copy($yorg);         # always make copy to preserve
 1027 
 1028     my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0);
 1029 
 1030     $car = $bar = $prd = 0;
 1031     if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
 1032         for $xi (@$x) {
 1033             $xi = $xi * $dd + $car;
 1034             $xi -= ($car = int($xi / $BASE)) * $BASE;
 1035         }
 1036         push(@$x, $car);
 1037         $car = 0;
 1038         for $yi (@$y) {
 1039             $yi = $yi * $dd + $car;
 1040             $yi -= ($car = int($yi / $BASE)) * $BASE;
 1041         }
 1042     } else {
 1043         push(@$x, 0);
 1044     }
 1045 
 1046     # @q will accumulate the final result, $q contains the current computed
 1047     # part of the final result
 1048 
 1049     @q = ();
 1050     ($v2, $v1) = @$y[-2, -1];
 1051     $v2 = 0 unless $v2;
 1052     while ($#$x > $#$y) {
 1053         ($u2, $u1, $u0) = @$x[-3..-1];
 1054         $u2 = 0 unless $u2;
 1055         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
 1056         # if $v1 == 0;
 1057         $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
 1058         --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
 1059         if ($q) {
 1060             ($car, $bar) = (0, 0);
 1061             for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
 1062                 $prd = $q * $y->[$yi] + $car;
 1063                 $prd -= ($car = int($prd / $BASE)) * $BASE;
 1064                 $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
 1065             }
 1066             if ($x->[-1] < $car + $bar) {
 1067                 $car = 0;
 1068                 --$q;
 1069                 for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
 1070                     $x->[$xi] -= $BASE
 1071                       if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
 1072                 }
 1073             }
 1074         }
 1075         pop(@$x);
 1076         unshift(@q, $q);
 1077     }
 1078     if (wantarray) {
 1079         my $d = bless [], $c;
 1080         if ($dd != 1) {
 1081             $car = 0;
 1082             for $xi (reverse @$x) {
 1083                 $prd = $car * $BASE + $xi;
 1084                 $car = $prd - ($tmp = int($prd / $dd)) * $dd;
 1085                 unshift(@$d, $tmp);
 1086             }
 1087         } else {
 1088             @$d = @$x;
 1089         }
 1090         @$x = @q;
 1091         __strip_zeros($x);
 1092         __strip_zeros($d);
 1093         return ($x, $d);
 1094     }
 1095     @$x = @q;
 1096     __strip_zeros($x);
 1097     $x;
 1098 }
 1099 
 1100 ##############################################################################
 1101 # testing
 1102 
 1103 sub _acmp {
 1104     # Internal absolute post-normalized compare (ignore signs)
 1105     # ref to array, ref to array, return <0, 0, >0
 1106     # Arrays must have at least one entry; this is not checked for.
 1107     my ($c, $cx, $cy) = @_;
 1108 
 1109     # shortcut for short numbers
 1110     return (($cx->[0] <=> $cy->[0]) <=> 0)
 1111       if @$cx == 1 && @$cy == 1;
 1112 
 1113     # fast comp based on number of array elements (aka pseudo-length)
 1114     my $lxy = (@$cx - @$cy)
 1115       # or length of first element if same number of elements (aka difference 0)
 1116       ||
 1117         # need int() here because sometimes the last element is '00018' vs '18'
 1118         (length(int($cx->[-1])) - length(int($cy->[-1])));
 1119 
 1120     return -1 if $lxy < 0;      # already differs, ret
 1121     return  1 if $lxy > 0;      # ditto
 1122 
 1123     # manual way (abort if unequal, good for early ne)
 1124     my $a;
 1125     my $j = @$cx;
 1126     while (--$j >= 0) {
 1127         last if $a = $cx->[$j] - $cy->[$j];
 1128     }
 1129     $a <=> 0;
 1130 }
 1131 
 1132 sub _len {
 1133     # compute number of digits in base 10
 1134 
 1135     # int() because add/sub sometimes leaves strings (like '00005') instead of
 1136     # '5' in this place, thus causing length() to report wrong length
 1137     my $cx = $_[1];
 1138 
 1139     (@$cx - 1) * $BASE_LEN + length(int($cx->[-1]));
 1140 }
 1141 
 1142 sub _digit {
 1143     # Return the nth digit. Zero is rightmost, so _digit(123, 0) gives 3.
 1144     # Negative values count from the left, so _digit(123, -1) gives 1.
 1145     my ($c, $x, $n) = @_;
 1146 
 1147     my $len = _len('', $x);
 1148 
 1149     $n += $len if $n < 0;               # -1 last, -2 second-to-last
 1150 
 1151     # Math::BigInt::Calc returns 0 if N is out of range, but this is not done
 1152     # by the other backend libraries.
 1153 
 1154     return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range
 1155 
 1156     my $elem = int($n / $BASE_LEN);     # index of array element
 1157     my $digit = $n % $BASE_LEN;         # index of digit within the element
 1158     substr("0" x $BASE_LEN . "$x->[$elem]", -1 - $digit, 1);
 1159 }
 1160 
 1161 sub _zeros {
 1162     # Return number of trailing zeros in decimal.
 1163     # Check each array element for having 0 at end as long as elem == 0
 1164     # Upon finding a elem != 0, stop.
 1165 
 1166     my $x = $_[1];
 1167 
 1168     return 0 if @$x == 1 && $x->[0] == 0;
 1169 
 1170     my $zeros = 0;
 1171     foreach my $elem (@$x) {
 1172         if ($elem != 0) {
 1173             $elem =~ /[^0](0*)\z/;
 1174             $zeros += length($1);       # count trailing zeros
 1175             last;                       # early out
 1176         }
 1177         $zeros += $BASE_LEN;
 1178     }
 1179     $zeros;
 1180 }
 1181 
 1182 ##############################################################################
 1183 # _is_* routines
 1184 
 1185 sub _is_zero {
 1186     # return true if arg is zero
 1187     @{$_[1]} == 1 && $_[1]->[0] == 0 ? 1 : 0;
 1188 }
 1189 
 1190 sub _is_even {
 1191     # return true if arg is even
 1192     $_[1]->[0] & 1 ? 0 : 1;
 1193 }
 1194 
 1195 sub _is_odd {
 1196     # return true if arg is odd
 1197     $_[1]->[0] & 1 ? 1 : 0;
 1198 }
 1199 
 1200 sub _is_one {
 1201     # return true if arg is one
 1202     @{$_[1]} == 1 && $_[1]->[0] == 1 ? 1 : 0;
 1203 }
 1204 
 1205 sub _is_two {
 1206     # return true if arg is two
 1207     @{$_[1]} == 1 && $_[1]->[0] == 2 ? 1 : 0;
 1208 }
 1209 
 1210 sub _is_ten {
 1211     # return true if arg is ten
 1212     @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0;
 1213 }
 1214 
 1215 sub __strip_zeros {
 1216     # Internal normalization function that strips leading zeros from the array.
 1217     # Args: ref to array
 1218     my $x = shift;
 1219 
 1220     push @$x, 0 if @$x == 0;    # div might return empty results, so fix it
 1221     return $x if @$x == 1;      # early out
 1222 
 1223     #print "strip: cnt $cnt i $i\n";
 1224     # '0', '3', '4', '0', '0',
 1225     #  0    1    2    3    4
 1226     # cnt = 5, i = 4
 1227     # i = 4
 1228     # i = 3
 1229     # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
 1230     # >= 1: skip first part (this can be zero)
 1231 
 1232     my $i = $#$x;
 1233     while ($i > 0) {
 1234         last if $x->[$i] != 0;
 1235         $i--;
 1236     }
 1237     $i++;
 1238     splice(@$x, $i) if $i < @$x;
 1239     $x;
 1240 }
 1241 
 1242 ###############################################################################
 1243 # check routine to test internal state for corruptions
 1244 
 1245 sub _check {
 1246     # used by the test suite
 1247     my ($class, $x) = @_;
 1248 
 1249     my $msg = $class -> SUPER::_check($x);
 1250     return $msg if $msg;
 1251 
 1252     my $n;
 1253     eval { $n = @$x };
 1254     return "Not an array reference" unless $@ eq '';
 1255 
 1256     return "Reference to an empty array" unless $n > 0;
 1257 
 1258     # The following fails with Math::BigInt::FastCalc because a
 1259     # Math::BigInt::FastCalc "object" is an unblessed array ref.
 1260     #
 1261     #return 0 unless ref($x) eq $class;
 1262 
 1263     for (my $i = 0 ; $i <= $#$x ; ++ $i) {
 1264         my $e = $x -> [$i];
 1265 
 1266         return "Element at index $i is undefined"
 1267           unless defined $e;
 1268 
 1269         return "Element at index $i is a '" . ref($e) .
 1270           "', which is not a scalar"
 1271           unless ref($e) eq "";
 1272 
 1273         # It would be better to use the regex /^([1-9]\d*|0)\z/, but that fails
 1274         # in Math::BigInt::FastCalc, because it sometimes creates array
 1275         # elements like "000000".
 1276         return "Element at index $i is '$e', which does not look like an" .
 1277           " normal integer" unless $e =~ /^\d+\z/;
 1278 
 1279         return "Element at index $i is '$e', which is not smaller than" .
 1280           " the base '$BASE'" if $e >= $BASE;
 1281 
 1282         return "Element at index $i (last element) is zero"
 1283           if $#$x > 0 && $i == $#$x && $e == 0;
 1284     }
 1285 
 1286     return 0;
 1287 }
 1288 
 1289 ###############################################################################
 1290 
 1291 sub _mod {
 1292     # if possible, use mod shortcut
 1293     my ($c, $x, $yo) = @_;
 1294 
 1295     # slow way since $y too big
 1296     if (@$yo > 1) {
 1297         my ($xo, $rem) = $c->_div($x, $yo);
 1298         @$x = @$rem;
 1299         return $x;
 1300     }
 1301 
 1302     my $y = $yo->[0];
 1303 
 1304     # if both are single element arrays
 1305     if (@$x == 1) {
 1306         $x->[0] %= $y;
 1307         return $x;
 1308     }
 1309 
 1310     # if @$x has more than one element, but @$y is a single element
 1311     my $b = $BASE % $y;
 1312     if ($b == 0) {
 1313         # when BASE % Y == 0 then (B * BASE) % Y == 0
 1314         # (B * BASE) % $y + A % Y => A % Y
 1315         # so need to consider only last element: O(1)
 1316         $x->[0] %= $y;
 1317     } elsif ($b == 1) {
 1318         # else need to go through all elements in @$x: O(N), but loop is a bit
 1319         # simplified
 1320         my $r = 0;
 1321         foreach (@$x) {
 1322             $r = ($r + $_) % $y; # not much faster, but heh...
 1323             #$r += $_ % $y; $r %= $y;
 1324         }
 1325         $r = 0 if $r == $y;
 1326         $x->[0] = $r;
 1327     } else {
 1328         # else need to go through all elements in @$x: O(N)
 1329         my $r = 0;
 1330         my $bm = 1;
 1331         foreach (@$x) {
 1332             $r = ($_ * $bm + $r) % $y;
 1333             $bm = ($bm * $b) % $y;
 1334 
 1335             #$r += ($_ % $y) * $bm;
 1336             #$bm *= $b;
 1337             #$bm %= $y;
 1338             #$r %= $y;
 1339         }
 1340         $r = 0 if $r == $y;
 1341         $x->[0] = $r;
 1342     }
 1343     @$x = $x->[0];              # keep one element of @$x
 1344     return $x;
 1345 }
 1346 
 1347 ##############################################################################
 1348 # shifts
 1349 
 1350 sub _rsft {
 1351     my ($c, $x, $y, $n) = @_;
 1352 
 1353     if ($n != 10) {
 1354         $n = $c->_new($n);
 1355         return scalar $c->_div($x, $c->_pow($n, $y));
 1356     }
 1357 
 1358     # shortcut (faster) for shifting by 10)
 1359     # multiples of $BASE_LEN
 1360     my $dst = 0;                # destination
 1361     my $src = $c->_num($y);     # as normal int
 1362     my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1]));
 1363     if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) {
 1364         # 12345 67890 shifted right by more than 10 digits => 0
 1365         splice(@$x, 1);         # leave only one element
 1366         $x->[0] = 0;            # set to zero
 1367         return $x;
 1368     }
 1369     my $rem = $src % $BASE_LEN;   # remainder to shift
 1370     $src = int($src / $BASE_LEN); # source
 1371     if ($rem == 0) {
 1372         splice(@$x, 0, $src);   # even faster, 38.4 => 39.3
 1373     } else {
 1374         my $len = @$x - $src;   # elems to go
 1375         my $vd;
 1376         my $z = '0' x $BASE_LEN;
 1377         $x->[ @$x ] = 0;          # avoid || 0 test inside loop
 1378         while ($dst < $len) {
 1379             $vd = $z . $x->[$src];
 1380             $vd = substr($vd, -$BASE_LEN, $BASE_LEN - $rem);
 1381             $src++;
 1382             $vd = substr($z . $x->[$src], -$rem, $rem) . $vd;
 1383             $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
 1384             $x->[$dst] = int($vd);
 1385             $dst++;
 1386         }
 1387         splice(@$x, $dst) if $dst > 0;       # kill left-over array elems
 1388         pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0
 1389     }                                        # else rem == 0
 1390     $x;
 1391 }
 1392 
 1393 sub _lsft {
 1394     my ($c, $x, $n, $b) = @_;
 1395 
 1396     return $x if $c->_is_zero($x);
 1397 
 1398     # Handle the special case when the base is a power of 10. Don't check
 1399     # whether log($b)/log(10) is an integer, because log(1000)/log(10) is not
 1400     # exactly 3.
 1401 
 1402     my $log10 = sprintf "%.0f", log($b) / log(10);
 1403     if ($b == 10 ** $log10) {
 1404         $b = 10;
 1405         $n = $c->_mul($n, $c->_new($log10));
 1406 
 1407         # shortcut (faster) for shifting by 10) since we are in base 10eX
 1408         # multiples of $BASE_LEN:
 1409         my $src = @$x;                      # source
 1410         my $len = $c->_num($n);             # shift-len as normal int
 1411         my $rem = $len % $BASE_LEN;         # remainder to shift
 1412         my $dst = $src + int($len / $BASE_LEN); # destination
 1413         my $vd;                                 # further speedup
 1414         $x->[$src] = 0;                         # avoid first ||0 for speed
 1415         my $z = '0' x $BASE_LEN;
 1416         while ($src >= 0) {
 1417             $vd = $x->[$src];
 1418             $vd = $z . $vd;
 1419             $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem);
 1420             $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem)
 1421               : '0' x $rem;
 1422             $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
 1423             $x->[$dst] = int($vd);
 1424             $dst--;
 1425             $src--;
 1426         }
 1427         # set lowest parts to 0
 1428         while ($dst >= 0) {
 1429             $x->[$dst--] = 0;
 1430         }
 1431         # fix spurious last zero element
 1432         splice @$x, -1 if $x->[-1] == 0;
 1433         return $x;
 1434     } else {
 1435         $b = $c->_new($b);
 1436         #print $c->_str($b);
 1437         return $c->_mul($x, $c->_pow($b, $n));
 1438     }
 1439 }
 1440 
 1441 sub _pow {
 1442     # power of $x to $y
 1443     # ref to array, ref to array, return ref to array
 1444     my ($c, $cx, $cy) = @_;
 1445 
 1446     if (@$cy == 1 && $cy->[0] == 0) {
 1447         splice(@$cx, 1);
 1448         $cx->[0] = 1;           # y == 0 => x => 1
 1449         return $cx;
 1450     }
 1451 
 1452     if ((@$cx == 1 && $cx->[0] == 1) || #    x == 1
 1453         (@$cy == 1 && $cy->[0] == 1))   # or y == 1
 1454     {
 1455         return $cx;
 1456     }
 1457 
 1458     if (@$cx == 1 && $cx->[0] == 0) {
 1459         splice (@$cx, 1);
 1460         $cx->[0] = 0;           # 0 ** y => 0 (if not y <= 0)
 1461         return $cx;
 1462     }
 1463 
 1464     my $pow2 = $c->_one();
 1465 
 1466     my $y_bin = $c->_as_bin($cy);
 1467     $y_bin =~ s/^0b//;
 1468     my $len = length($y_bin);
 1469     while (--$len > 0) {
 1470         $c->_mul($pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd?
 1471         $c->_mul($cx, $cx);
 1472     }
 1473 
 1474     $c->_mul($cx, $pow2);
 1475     $cx;
 1476 }
 1477 
 1478 sub _nok {
 1479     # Return binomial coefficient (n over k).
 1480     # Given refs to arrays, return ref to array.
 1481     # First input argument is modified.
 1482 
 1483     my ($c, $n, $k) = @_;
 1484 
 1485     # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
 1486     # nok(n, n-k), to minimize the number if iterations in the loop.
 1487 
 1488     {
 1489         my $twok = $c->_mul($c->_two(), $c->_copy($k)); # 2 * k
 1490         if ($c->_acmp($twok, $n) > 0) {               # if 2*k > n
 1491             $k = $c->_sub($c->_copy($n), $k);         # k = n - k
 1492         }
 1493     }
 1494 
 1495     # Example:
 1496     #
 1497     # / 7 \       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
 1498     # |   | = --------- =  --------------- = --------- = 5 * - * -
 1499     # \ 3 /   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3
 1500 
 1501     if ($c->_is_zero($k)) {
 1502         @$n = 1;
 1503     } else {
 1504 
 1505         # Make a copy of the original n, since we'll be modifying n in-place.
 1506 
 1507         my $n_orig = $c->_copy($n);
 1508 
 1509         # n = 5, f = 6, d = 2 (cf. example above)
 1510 
 1511         $c->_sub($n, $k);
 1512         $c->_inc($n);
 1513 
 1514         my $f = $c->_copy($n);
 1515         $c->_inc($f);
 1516 
 1517         my $d = $c->_two();
 1518 
 1519         # while f <= n (the original n, that is) ...
 1520 
 1521         while ($c->_acmp($f, $n_orig) <= 0) {
 1522 
 1523             # n = (n * f / d) == 5 * 6 / 2 (cf. example above)
 1524 
 1525             $c->_mul($n, $f);
 1526             $c->_div($n, $d);
 1527 
 1528             # f = 7, d = 3 (cf. example above)
 1529 
 1530             $c->_inc($f);
 1531             $c->_inc($d);
 1532         }
 1533 
 1534     }
 1535 
 1536     return $n;
 1537 }
 1538 
 1539 my @factorials = (
 1540                   1,
 1541                   1,
 1542                   2,
 1543                   2*3,
 1544                   2*3*4,
 1545                   2*3*4*5,
 1546                   2*3*4*5*6,
 1547                   2*3*4*5*6*7,
 1548                  );
 1549 
 1550 sub _fac {
 1551     # factorial of $x
 1552     # ref to array, return ref to array
 1553     my ($c, $cx) = @_;
 1554 
 1555     if ((@$cx == 1) && ($cx->[0] <= 7)) {
 1556         $cx->[0] = $factorials[$cx->[0]]; # 0 => 1, 1 => 1, 2 => 2 etc.
 1557         return $cx;
 1558     }
 1559 
 1560     if ((@$cx == 1) &&          # we do this only if $x >= 12 and $x <= 7000
 1561         ($cx->[0] >= 12 && $cx->[0] < 7000)) {
 1562 
 1563         # Calculate (k-j) * (k-j+1) ... k .. (k+j-1) * (k + j)
 1564         # See http://blogten.blogspot.com/2007/01/calculating-n.html
 1565         # The above series can be expressed as factors:
 1566         #   k * k - (j - i) * 2
 1567         # We cache k*k, and calculate (j * j) as the sum of the first j odd integers
 1568 
 1569         # This will not work when N exceeds the storage of a Perl scalar, however,
 1570         # in this case the algorithm would be way too slow to terminate, anyway.
 1571 
 1572         # As soon as the last element of $cx is 0, we split it up and remember
 1573         # how many zeors we got so far. The reason is that n! will accumulate
 1574         # zeros at the end rather fast.
 1575         my $zero_elements = 0;
 1576 
 1577         # If n is even, set n = n -1
 1578         my $k = $c->_num($cx);
 1579         my $even = 1;
 1580         if (($k & 1) == 0) {
 1581             $even = $k;
 1582             $k --;
 1583         }
 1584         # set k to the center point
 1585         $k = ($k + 1) / 2;
 1586         #  print "k $k even: $even\n";
 1587         # now calculate k * k
 1588         my $k2 = $k * $k;
 1589         my $odd = 1;
 1590         my $sum = 1;
 1591         my $i = $k - 1;
 1592         # keep reference to x
 1593         my $new_x = $c->_new($k * $even);
 1594         @$cx = @$new_x;
 1595         if ($cx->[0] == 0) {
 1596             $zero_elements ++;
 1597             shift @$cx;
 1598         }
 1599         #  print STDERR "x = ", $c->_str($cx), "\n";
 1600         my $BASE2 = int(sqrt($BASE))-1;
 1601         my $j = 1;
 1602         while ($j <= $i) {
 1603             my $m = ($k2 - $sum);
 1604             $odd += 2;
 1605             $sum += $odd;
 1606             $j++;
 1607             while ($j <= $i && ($m < $BASE2) && (($k2 - $sum) < $BASE2)) {
 1608                 $m *= ($k2 - $sum);
 1609                 $odd += 2;
 1610                 $sum += $odd;
 1611                 $j++;
 1612                 #      print STDERR "\n k2 $k2 m $m sum $sum odd $odd\n"; sleep(1);
 1613             }
 1614             if ($m < $BASE) {
 1615                 $c->_mul($cx, [$m]);
 1616             } else {
 1617                 $c->_mul($cx, $c->_new($m));
 1618             }
 1619             if ($cx->[0] == 0) {
 1620                 $zero_elements ++;
 1621                 shift @$cx;
 1622             }
 1623             #    print STDERR "Calculate $k2 - $sum = $m (x = ", $c->_str($cx), ")\n";
 1624         }
 1625         # multiply in the zeros again
 1626         unshift @$cx, (0) x $zero_elements;
 1627         return $cx;
 1628     }
 1629 
 1630     # go forward until $base is exceeded limit is either $x steps (steps == 100
 1631     # means a result always too high) or $base.
 1632     my $steps = 100;
 1633     $steps = $cx->[0] if @$cx == 1;
 1634     my $r = 2;
 1635     my $cf = 3;
 1636     my $step = 2;
 1637     my $last = $r;
 1638     while ($r * $cf < $BASE && $step < $steps) {
 1639         $last = $r;
 1640         $r *= $cf++;
 1641         $step++;
 1642     }
 1643     if ((@$cx == 1) && $step == $cx->[0]) {
 1644         # completely done, so keep reference to $x and return
 1645         $cx->[0] = $r;
 1646         return $cx;
 1647     }
 1648 
 1649     # now we must do the left over steps
 1650     my $n;                      # steps still to do
 1651     if (@$cx == 1) {
 1652         $n = $cx->[0];
 1653     } else {
 1654         $n = $c->_copy($cx);
 1655     }
 1656 
 1657     # Set $cx to the last result below $BASE (but keep ref to $x)
 1658     $cx->[0] = $last;
 1659     splice (@$cx, 1);
 1660     # As soon as the last element of $cx is 0, we split it up and remember
 1661     # how many zeors we got so far. The reason is that n! will accumulate
 1662     # zeros at the end rather fast.
 1663     my $zero_elements = 0;
 1664 
 1665     # do left-over steps fit into a scalar?
 1666     if (ref $n eq 'ARRAY') {
 1667         # No, so use slower inc() & cmp()
 1668         # ($n is at least $BASE here)
 1669         my $base_2 = int(sqrt($BASE)) - 1;
 1670         #print STDERR "base_2: $base_2\n";
 1671         while ($step < $base_2) {
 1672             if ($cx->[0] == 0) {
 1673                 $zero_elements ++;
 1674                 shift @$cx;
 1675             }
 1676             my $b = $step * ($step + 1);
 1677             $step += 2;
 1678             $c->_mul($cx, [$b]);
 1679         }
 1680         $step = [$step];
 1681         while ($c->_acmp($step, $n) <= 0) {
 1682             if ($cx->[0] == 0) {
 1683                 $zero_elements ++;
 1684                 shift @$cx;
 1685             }
 1686             $c->_mul($cx, $step);
 1687             $c->_inc($step);
 1688         }
 1689     } else {
 1690         # Yes, so we can speed it up slightly
 1691 
 1692         #    print "# left over steps $n\n";
 1693 
 1694         my $base_4 = int(sqrt(sqrt($BASE))) - 2;
 1695         #print STDERR "base_4: $base_4\n";
 1696         my $n4 = $n - 4;
 1697         while ($step < $n4 && $step < $base_4) {
 1698             if ($cx->[0] == 0) {
 1699                 $zero_elements ++;
 1700                 shift @$cx;
 1701             }
 1702             my $b = $step * ($step + 1);
 1703             $step += 2;
 1704             $b *= $step * ($step + 1);
 1705             $step += 2;
 1706             $c->_mul($cx, [$b]);
 1707         }
 1708         my $base_2 = int(sqrt($BASE)) - 1;
 1709         my $n2 = $n - 2;
 1710         #print STDERR "base_2: $base_2\n";
 1711         while ($step < $n2 && $step < $base_2) {
 1712             if ($cx->[0] == 0) {
 1713                 $zero_elements ++;
 1714                 shift @$cx;
 1715             }
 1716             my $b = $step * ($step + 1);
 1717             $step += 2;
 1718             $c->_mul($cx, [$b]);
 1719         }
 1720         # do what's left over
 1721         while ($step <= $n) {
 1722             $c->_mul($cx, [$step]);
 1723             $step++;
 1724             if ($cx->[0] == 0) {
 1725                 $zero_elements ++;
 1726                 shift @$cx;
 1727             }
 1728         }
 1729     }
 1730     # multiply in the zeros again
 1731     unshift @$cx, (0) x $zero_elements;
 1732     $cx;                        # return result
 1733 }
 1734 
 1735 sub _log_int {
 1736     # calculate integer log of $x to base $base
 1737     # ref to array, ref to array - return ref to array
 1738     my ($c, $x, $base) = @_;
 1739 
 1740     # X == 0 => NaN
 1741     return if @$x == 1 && $x->[0] == 0;
 1742 
 1743     # BASE 0 or 1 => NaN
 1744     return if @$base == 1 && $base->[0] < 2;
 1745 
 1746     # X == 1 => 0 (is exact)
 1747     if (@$x == 1 && $x->[0] == 1) {
 1748         @$x = 0;
 1749         return $x, 1;
 1750     }
 1751 
 1752     my $cmp = $c->_acmp($x, $base);
 1753 
 1754     # X == BASE => 1 (is exact)
 1755     if ($cmp == 0) {
 1756         @$x = 1;
 1757         return $x, 1;
 1758     }
 1759 
 1760     # 1 < X < BASE => 0 (is truncated)
 1761     if ($cmp < 0) {
 1762         @$x = 0;
 1763         return $x, 0;
 1764     }
 1765 
 1766     my $x_org = $c->_copy($x);  # preserve x
 1767 
 1768     # Compute a guess for the result based on:
 1769     # $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) )
 1770     my $len = $c->_len($x_org);
 1771     my $log = log($base->[-1]) / log(10);
 1772 
 1773     # for each additional element in $base, we add $BASE_LEN to the result,
 1774     # based on the observation that log($BASE, 10) is BASE_LEN and
 1775     # log(x*y) == log(x) + log(y):
 1776     $log += (@$base - 1) * $BASE_LEN;
 1777 
 1778     # calculate now a guess based on the values obtained above:
 1779     my $res = int($len / $log);
 1780 
 1781     @$x = $res;
 1782     my $trial = $c->_pow($c->_copy($base), $x);
 1783     my $acmp = $c->_acmp($trial, $x_org);
 1784 
 1785     # Did we get the exact result?
 1786 
 1787     return $x, 1 if $acmp == 0;
 1788 
 1789     # Too small?
 1790 
 1791     while ($acmp < 0) {
 1792         $c->_mul($trial, $base);
 1793         $c->_inc($x);
 1794         $acmp = $c->_acmp($trial, $x_org);
 1795     }
 1796 
 1797     # Too big?
 1798 
 1799     while ($acmp > 0) {
 1800         $c->_div($trial, $base);
 1801         $c->_dec($x);
 1802         $acmp = $c->_acmp($trial, $x_org);
 1803     }
 1804 
 1805     return $x, 1 if $acmp == 0;         # result is exact
 1806     return $x, 0;                       # result is too small
 1807 }
 1808 
 1809 # for debugging:
 1810 use constant DEBUG => 0;
 1811 my $steps = 0;
 1812 sub steps { $steps };
 1813 
 1814 sub _sqrt {
 1815     # square-root of $x in place
 1816     # Compute a guess of the result (by rule of thumb), then improve it via
 1817     # Newton's method.
 1818     my ($c, $x) = @_;
 1819 
 1820     if (@$x == 1) {
 1821         # fits into one Perl scalar, so result can be computed directly
 1822         $x->[0] = int(sqrt($x->[0]));
 1823         return $x;
 1824     }
 1825     my $y = $c->_copy($x);
 1826     # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess
 1827     # since our guess will "grow"
 1828     my $l = int(($c->_len($x)-1) / 2);
 1829 
 1830     my $lastelem = $x->[-1];    # for guess
 1831     my $elems = @$x - 1;
 1832     # not enough digits, but could have more?
 1833     if ((length($lastelem) <= 3) && ($elems > 1)) {
 1834         # right-align with zero pad
 1835         my $len = length($lastelem) & 1;
 1836         print "$lastelem => " if DEBUG;
 1837         $lastelem .= substr($x->[-2] . '0' x $BASE_LEN, 0, $BASE_LEN);
 1838         # former odd => make odd again, or former even to even again
 1839         $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
 1840         print "$lastelem\n" if DEBUG;
 1841     }
 1842 
 1843     # construct $x (instead of $c->_lsft($x, $l, 10)
 1844     my $r = $l % $BASE_LEN;     # 10000 00000 00000 00000 ($BASE_LEN=5)
 1845     $l = int($l / $BASE_LEN);
 1846     print "l =  $l " if DEBUG;
 1847 
 1848     splice @$x, $l;              # keep ref($x), but modify it
 1849 
 1850     # we make the first part of the guess not '1000...0' but int(sqrt($lastelem))
 1851     # that gives us:
 1852     # 14400 00000 => sqrt(14400) => guess first digits to be 120
 1853     # 144000 000000 => sqrt(144000) => guess 379
 1854 
 1855     print "$lastelem (elems $elems) => " if DEBUG;
 1856     $lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even?
 1857     my $g = sqrt($lastelem);
 1858     $g =~ s/\.//;               # 2.345 => 2345
 1859     $r -= 1 if $elems & 1 == 0; # 70 => 7
 1860 
 1861     # padd with zeros if result is too short
 1862     $x->[$l--] = int(substr($g . '0' x $r, 0, $r+1));
 1863     print "now ", $x->[-1] if DEBUG;
 1864     print " would have been ", int('1' . '0' x $r), "\n" if DEBUG;
 1865 
 1866     # If @$x > 1, we could compute the second elem of the guess, too, to create
 1867     # an even better guess. Not implemented yet. Does it improve performance?
 1868     $x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
 1869 
 1870     print "start x= ", $c->_str($x), "\n" if DEBUG;
 1871     my $two = $c->_two();
 1872     my $last = $c->_zero();
 1873     my $lastlast = $c->_zero();
 1874     $steps = 0 if DEBUG;
 1875     while ($c->_acmp($last, $x) != 0 && $c->_acmp($lastlast, $x) != 0) {
 1876         $steps++ if DEBUG;
 1877         $lastlast = $c->_copy($last);
 1878         $last = $c->_copy($x);
 1879         $c->_add($x, $c->_div($c->_copy($y), $x));
 1880         $c->_div($x, $two );
 1881         print " x= ", $c->_str($x), "\n" if DEBUG;
 1882     }
 1883     print "\nsteps in sqrt: $steps, " if DEBUG;
 1884     $c->_dec($x) if $c->_acmp($y, $c->_mul($c->_copy($x), $x)) < 0; # overshot?
 1885     print " final ", $x->[-1], "\n" if DEBUG;
 1886     $x;
 1887 }
 1888 
 1889 sub _root {
 1890     # Take n'th root of $x in place.
 1891 
 1892     my ($c, $x, $n) = @_;
 1893 
 1894     # Small numbers.
 1895 
 1896     if (@$x == 1 && @$n == 1) {
 1897         # Result can be computed directly. Adjust initial result for numerical
 1898         # errors, e.g., int(1000**(1/3)) is 2, not 3.
 1899         my $y = int($x->[0] ** (1 / $n->[0]));
 1900         my $yp1 = $y + 1;
 1901         $y = $yp1 if $yp1 ** $n->[0] == $x->[0];
 1902         $x->[0] = $y;
 1903         return $x;
 1904     }
 1905 
 1906     # If x <= n, the result is always (truncated to) 1.
 1907 
 1908     if ((@$x > 1 || $x -> [0] > 0) &&           # if x is non-zero ...
 1909         $c -> _acmp($x, $n) <= 0)               # ... and x <= n
 1910     {
 1911         my $one = $x -> _one();
 1912         @$x = @$one;
 1913         return $x;
 1914     }
 1915 
 1916     # If $n is a power of two, take sqrt($x) repeatedly, e.g., root($x, 4) =
 1917     # sqrt(sqrt($x)), root($x, 8) = sqrt(sqrt(sqrt($x))).
 1918 
 1919     my $b = $c -> _as_bin($n);
 1920     if ($b =~ /0b1(0+)$/) {
 1921         my $count = length($1);       # 0b100 => len('00') => 2
 1922         my $cnt = $count;             # counter for loop
 1923         unshift @$x, 0;               # add one element, together with one
 1924                                       #   more below in the loop this makes 2
 1925         while ($cnt-- > 0) {
 1926             # 'Inflate' $x by adding one element, basically computing
 1927             # $x * $BASE * $BASE. This gives us more $BASE_LEN digits for
 1928             # result since len(sqrt($X)) approx == len($x) / 2.
 1929             unshift @$x, 0;
 1930             # Calculate sqrt($x), $x is now one element to big, again. In the
 1931             # next round we make that two, again.
 1932             $c -> _sqrt($x);
 1933         }
 1934 
 1935         # $x is now one element too big, so truncate result by removing it.
 1936         shift @$x;
 1937 
 1938         return $x;
 1939     }
 1940 
 1941     my $DEBUG = 0;
 1942 
 1943     # Now the general case. This works by finding an initial guess. If this
 1944     # guess is incorrect, a relatively small delta is chosen. This delta is
 1945     # used to find a lower and upper limit for the correct value. The delta is
 1946     # doubled in each iteration. When a lower and upper limit is found,
 1947     # bisection is applied to narrow down the region until we have the correct
 1948     # value.
 1949 
 1950     # Split x into mantissa and exponent in base 10, so that
 1951     #
 1952     #   x = xm * 10^xe, where 0 < xm < 1 and xe is an integer
 1953 
 1954     my $x_str = $c -> _str($x);
 1955     my $xm    = "." . $x_str;
 1956     my $xe    = length($x_str);
 1957 
 1958     # From this we compute the base 10 logarithm of x
 1959     #
 1960     #   log_10(x) = log_10(xm) + log_10(xe^10)
 1961     #             = log(xm)/log(10) + xe
 1962     #
 1963     # and then the base 10 logarithm of y, where y = x^(1/n)
 1964     #
 1965     #   log_10(y) = log_10(x)/n
 1966 
 1967     my $log10x = log($xm) / log(10) + $xe;
 1968     my $log10y = $log10x / $c -> _num($n);
 1969 
 1970     # And from this we compute ym and ye, the mantissa and exponent (in
 1971     # base 10) of y, where 1 < ym <= 10 and ye is an integer.
 1972 
 1973     my $ye = int $log10y;
 1974     my $ym = 10 ** ($log10y - $ye);
 1975 
 1976     # Finally, we scale the mantissa and exponent to incraese the integer
 1977     # part of ym, before building the string representing our guess of y.
 1978 
 1979     if ($DEBUG) {
 1980         print "\n";
 1981         print "xm     = $xm\n";
 1982         print "xe     = $xe\n";
 1983         print "log10x = $log10x\n";
 1984         print "log10y = $log10y\n";
 1985         print "ym     = $ym\n";
 1986         print "ye     = $ye\n";
 1987         print "\n";
 1988     }
 1989 
 1990     my $d = $ye < 15 ? $ye : 15;
 1991     $ym *= 10 ** $d;
 1992     $ye -= $d;
 1993 
 1994     my $y_str = sprintf('%.0f', $ym) . "0" x $ye;
 1995     my $y = $c -> _new($y_str);
 1996 
 1997     if ($DEBUG) {
 1998         print "ym     = $ym\n";
 1999         print "ye     = $ye\n";
 2000         print "\n";
 2001         print "y_str  = $y_str (initial guess)\n";
 2002         print "\n";
 2003     }
 2004 
 2005     # See if our guess y is correct.
 2006 
 2007     my $trial = $c -> _pow($c -> _copy($y), $n);
 2008     my $acmp  = $c -> _acmp($trial, $x);
 2009 
 2010     if ($acmp == 0) {
 2011         @$x = @$y;
 2012         return $x;
 2013     }
 2014 
 2015     # Find a lower and upper limit for the correct value of y. Start off with a
 2016     # delta value that is approximately the size of the accuracy of the guess.
 2017 
 2018     my $lower;
 2019     my $upper;
 2020 
 2021     my $delta = $c -> _new("1" . ("0" x $ye));
 2022     my $two   = $c -> _two();
 2023 
 2024     if ($acmp < 0) {
 2025         $lower = $y;
 2026         while ($acmp < 0) {
 2027             $upper = $c -> _add($c -> _copy($lower), $delta);
 2028 
 2029             if ($DEBUG) {
 2030                 print "lower  = $lower\n";
 2031                 print "upper  = $upper\n";
 2032                 print "delta  = $delta\n";
 2033                 print "\n";
 2034             }
 2035             $acmp  = $c -> _acmp($c -> _pow($c -> _copy($upper), $n), $x);
 2036             if ($acmp == 0) {
 2037                 @$x = @$upper;
 2038                 return $x;
 2039             }
 2040             $delta = $c -> _mul($delta, $two);
 2041         }
 2042     }
 2043 
 2044     elsif ($acmp > 0) {
 2045         $upper = $y;
 2046         while ($acmp > 0) {
 2047             if ($c -> _acmp($upper, $delta) <= 0) {
 2048                 $lower = $c -> _zero();
 2049                 last;
 2050             }
 2051             $lower = $c -> _sub($c -> _copy($upper), $delta);
 2052 
 2053             if ($DEBUG) {
 2054                 print "lower  = $lower\n";
 2055                 print "upper  = $upper\n";
 2056                 print "delta  = $delta\n";
 2057                 print "\n";
 2058             }
 2059             $acmp  = $c -> _acmp($c -> _pow($c -> _copy($lower), $n), $x);
 2060             if ($acmp == 0) {
 2061                 @$x = @$lower;
 2062                 return $x;
 2063             }
 2064             $delta = $c -> _mul($delta, $two);
 2065         }
 2066     }
 2067 
 2068     # Use bisection to narrow down the interval.
 2069 
 2070     my $one = $c -> _one();
 2071     {
 2072 
 2073         $delta = $c -> _sub($c -> _copy($upper), $lower);
 2074         if ($c -> _acmp($delta, $one) <= 0) {
 2075             @$x = @$lower;
 2076             return $x;
 2077         }
 2078 
 2079         if ($DEBUG) {
 2080             print "lower  = $lower\n";
 2081             print "upper  = $upper\n";
 2082             print "delta   = $delta\n";
 2083             print "\n";
 2084         }
 2085 
 2086         $delta = $c -> _div($delta, $two);
 2087         my $middle = $c -> _add($c -> _copy($lower), $delta);
 2088 
 2089         $acmp  = $c -> _acmp($c -> _pow($c -> _copy($middle), $n), $x);
 2090         if ($acmp < 0) {
 2091             $lower = $middle;
 2092         } elsif ($acmp > 0) {
 2093             $upper = $middle;
 2094         } else {
 2095             @$x = @$middle;
 2096             return $x;
 2097         }
 2098 
 2099         redo;
 2100     }
 2101 
 2102     $x;
 2103 }
 2104 
 2105 ##############################################################################
 2106 # binary stuff
 2107 
 2108 sub _and {
 2109     my ($c, $x, $y) = @_;
 2110 
 2111     # the shortcut makes equal, large numbers _really_ fast, and makes only a
 2112     # very small performance drop for small numbers (e.g. something with less
 2113     # than 32 bit) Since we optimize for large numbers, this is enabled.
 2114     return $x if $c->_acmp($x, $y) == 0; # shortcut
 2115 
 2116     my $m = $c->_one();
 2117     my ($xr, $yr);
 2118     my $mask = $AND_MASK;
 2119 
 2120     my $x1 = $c->_copy($x);
 2121     my $y1 = $c->_copy($y);
 2122     my $z  = $c->_zero();
 2123 
 2124     use integer;
 2125     until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
 2126         ($x1, $xr) = $c->_div($x1, $mask);
 2127         ($y1, $yr) = $c->_div($y1, $mask);
 2128 
 2129         $c->_add($z, $c->_mul([ 0 + $xr->[0] & 0 + $yr->[0] ], $m));
 2130         $c->_mul($m, $mask);
 2131     }
 2132 
 2133     @$x = @$z;
 2134     return $x;
 2135 }
 2136 
 2137 sub _xor {
 2138     my ($c, $x, $y) = @_;
 2139 
 2140     return $c->_zero() if $c->_acmp($x, $y) == 0; # shortcut (see -and)
 2141 
 2142     my $m = $c->_one();
 2143     my ($xr, $yr);
 2144     my $mask = $XOR_MASK;
 2145 
 2146     my $x1 = $c->_copy($x);
 2147     my $y1 = $c->_copy($y);      # make copy
 2148     my $z  = $c->_zero();
 2149 
 2150     use integer;
 2151     until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
 2152         ($x1, $xr) = $c->_div($x1, $mask);
 2153         ($y1, $yr) = $c->_div($y1, $mask);
 2154         # make ints() from $xr, $yr (see _and())
 2155         #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
 2156         #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
 2157         #$c->_add($x, $c->_mul($c->_new($xrr ^ $yrr)), $m) );
 2158 
 2159         $c->_add($z, $c->_mul([ 0 + $xr->[0] ^ 0 + $yr->[0] ], $m));
 2160         $c->_mul($m, $mask);
 2161     }
 2162     # the loop stops when the shorter of the two numbers is exhausted
 2163     # the remainder of the longer one will survive bit-by-bit, so we simple
 2164     # multiply-add it in
 2165     $c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1);
 2166     $c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1);
 2167 
 2168     @$x = @$z;
 2169     return $x;
 2170 }
 2171 
 2172 sub _or {
 2173     my ($c, $x, $y) = @_;
 2174 
 2175     return $x if $c->_acmp($x, $y) == 0; # shortcut (see _and)
 2176 
 2177     my $m = $c->_one();
 2178     my ($xr, $yr);
 2179     my $mask = $OR_MASK;
 2180 
 2181     my $x1 = $c->_copy($x);
 2182     my $y1 = $c->_copy($y);      # make copy
 2183     my $z  = $c->_zero();
 2184 
 2185     use integer;
 2186     until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
 2187         ($x1, $xr) = $c->_div($x1, $mask);
 2188         ($y1, $yr) = $c->_div($y1, $mask);
 2189         # make ints() from $xr, $yr (see _and())
 2190         #    $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
 2191         #    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
 2192         #    $c->_add($x, $c->_mul(_new( $c, ($xrr | $yrr) ), $m) );
 2193 
 2194         $c->_add($z, $c->_mul([ 0 + $xr->[0] | 0 + $yr->[0] ], $m));
 2195         $c->_mul($m, $mask);
 2196     }
 2197     # the loop stops when the shorter of the two numbers is exhausted
 2198     # the remainder of the longer one will survive bit-by-bit, so we simple
 2199     # multiply-add it in
 2200     $c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1);
 2201     $c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1);
 2202 
 2203     @$x = @$z;
 2204     return $x;
 2205 }
 2206 
 2207 sub _as_hex {
 2208     # convert a decimal number to hex (ref to array, return ref to string)
 2209     my ($c, $x) = @_;
 2210 
 2211     # fits into one element (handle also 0x0 case)
 2212     return sprintf("0x%x", $x->[0]) if @$x == 1;
 2213 
 2214     my $x1 = $c->_copy($x);
 2215 
 2216     my $es = '';
 2217     my ($xr, $h, $x10000);
 2218     if ($] >= 5.006) {
 2219         $x10000 = [ 0x10000 ];
 2220         $h = 'h4';
 2221     } else {
 2222         $x10000 = [ 0x1000 ];
 2223         $h = 'h3';
 2224     }
 2225     while (@$x1 != 1 || $x1->[0] != 0) # _is_zero()
 2226     {
 2227         ($x1, $xr) = $c->_div($x1, $x10000);
 2228         $es .= unpack($h, pack('V', $xr->[0]));
 2229     }
 2230     $es = reverse $es;
 2231     $es =~ s/^[0]+//;           # strip leading zeros
 2232     '0x' . $es;                 # return result prepended with 0x
 2233 }
 2234 
 2235 sub _as_bin {
 2236     # convert a decimal number to bin (ref to array, return ref to string)
 2237     my ($c, $x) = @_;
 2238 
 2239     # fits into one element (and Perl recent enough), handle also 0b0 case
 2240     # handle zero case for older Perls
 2241     if ($] <= 5.005 && @$x == 1 && $x->[0] == 0) {
 2242         my $t = '0b0';
 2243         return $t;
 2244     }
 2245     if (@$x == 1 && $] >= 5.006) {
 2246         my $t = sprintf("0b%b", $x->[0]);
 2247         return $t;
 2248     }
 2249     my $x1 = $c->_copy($x);
 2250 
 2251     my $es = '';
 2252     my ($xr, $b, $x10000);
 2253     if ($] >= 5.006) {
 2254         $x10000 = [ 0x10000 ];
 2255         $b = 'b16';
 2256     } else {
 2257         $x10000 = [ 0x1000 ];
 2258         $b = 'b12';
 2259     }
 2260     while (!(@$x1 == 1 && $x1->[0] == 0)) # _is_zero()
 2261     {
 2262         ($x1, $xr) = $c->_div($x1, $x10000);
 2263         $es .= unpack($b, pack('v', $xr->[0]));
 2264     }
 2265     $es = reverse $es;
 2266     $es =~ s/^[0]+//;           # strip leading zeros
 2267     '0b' . $es;                 # return result prepended with 0b
 2268 }
 2269 
 2270 sub _as_oct {
 2271     # convert a decimal number to octal (ref to array, return ref to string)
 2272     my ($c, $x) = @_;
 2273 
 2274     # fits into one element (handle also 0 case)
 2275     return sprintf("0%o", $x->[0]) if @$x == 1;
 2276 
 2277     my $x1 = $c->_copy($x);
 2278 
 2279     my $es = '';
 2280     my $xr;
 2281     my $x1000 = [ 0100000 ];
 2282     while (@$x1 != 1 || $x1->[0] != 0) # _is_zero()
 2283     {
 2284         ($x1, $xr) = $c->_div($x1, $x1000);
 2285         $es .= reverse sprintf("%05o", $xr->[0]);
 2286     }
 2287     $es = reverse $es;
 2288     $es =~ s/^0+//;             # strip leading zeros
 2289     '0' . $es;                  # return result prepended with 0
 2290 }
 2291 
 2292 sub _from_oct {
 2293     # convert a octal number to decimal (string, return ref to array)
 2294     my ($c, $os) = @_;
 2295 
 2296     # for older Perls, play safe
 2297     my $m = [ 0100000 ];
 2298     my $d = 5;                  # 5 digits at a time
 2299 
 2300     my $mul = $c->_one();
 2301     my $x = $c->_zero();
 2302 
 2303     my $len = int((length($os) - 1) / $d);      # $d digit parts, w/o the '0'
 2304     my $val;
 2305     my $i = -$d;
 2306     while ($len >= 0) {
 2307         $val = substr($os, $i, $d);             # get oct digits
 2308         $val = CORE::oct($val);
 2309         $i -= $d;
 2310         $len --;
 2311         my $adder = [ $val ];
 2312         $c->_add($x, $c->_mul($adder, $mul)) if $val != 0;
 2313         $c->_mul($mul, $m) if $len >= 0;        # skip last mul
 2314     }
 2315     $x;
 2316 }
 2317 
 2318 sub _from_hex {
 2319     # convert a hex number to decimal (string, return ref to array)
 2320     my ($c, $hs) = @_;
 2321 
 2322     my $m = $c->_new(0x10000000); # 28 bit at a time (<32 bit!)
 2323     my $d = 7;                    # 7 digits at a time
 2324     my $mul = $c->_one();
 2325     my $x = $c->_zero();
 2326 
 2327     my $len = int((length($hs) - 2) / $d); # $d digit parts, w/o the '0x'
 2328     my $val;
 2329     my $i = -$d;
 2330     while ($len >= 0) {
 2331         $val = substr($hs, $i, $d);     # get hex digits
 2332         $val =~ s/^0x// if $len == 0; # for last part only because
 2333         $val = CORE::hex($val);       # hex does not like wrong chars
 2334         $i -= $d;
 2335         $len --;
 2336         my $adder = [ $val ];
 2337         # if the resulting number was to big to fit into one element, create a
 2338         # two-element version (bug found by Mark Lakata - Thanx!)
 2339         if (CORE::length($val) > $BASE_LEN) {
 2340             $adder = $c->_new($val);
 2341         }
 2342         $c->_add($x, $c->_mul($adder, $mul)) if $val != 0;
 2343         $c->_mul($mul, $m) if $len >= 0; # skip last mul
 2344     }
 2345     $x;
 2346 }
 2347 
 2348 sub _from_bin {
 2349     # convert a hex number to decimal (string, return ref to array)
 2350     my ($c, $bs) = @_;
 2351 
 2352     # instead of converting X (8) bit at a time, it is faster to "convert" the
 2353     # number to hex, and then call _from_hex.
 2354 
 2355     my $hs = $bs;
 2356     $hs =~ s/^[+-]?0b//;                                # remove sign and 0b
 2357     my $l = length($hs);                                # bits
 2358     $hs = '0' x (8 - ($l % 8)) . $hs if ($l % 8) != 0;  # padd left side w/ 0
 2359     my $h = '0x' . unpack('H*', pack ('B*', $hs));      # repack as hex
 2360 
 2361     $c->_from_hex($h);
 2362 }
 2363 
 2364 ##############################################################################
 2365 # special modulus functions
 2366 
 2367 sub _modinv {
 2368     # modular multiplicative inverse
 2369     my ($c, $x, $y) = @_;
 2370 
 2371     # modulo zero
 2372     if ($c->_is_zero($y)) {
 2373         return undef, undef;
 2374     }
 2375 
 2376     # modulo one
 2377     if ($c->_is_one($y)) {
 2378         return $c->_zero(), '+';
 2379     }
 2380 
 2381     my $u = $c->_zero();
 2382     my $v = $c->_one();
 2383     my $a = $c->_copy($y);
 2384     my $b = $c->_copy($x);
 2385 
 2386     # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the result
 2387     # ($u) at the same time. See comments in BigInt for why this works.
 2388     my $q;
 2389     my $sign = 1;
 2390     {
 2391         ($a, $q, $b) = ($b, $c->_div($a, $b));          # step 1
 2392         last if $c->_is_zero($b);
 2393 
 2394         my $t = $c->_add(                               # step 2:
 2395                          $c->_mul($c->_copy($v), $q),   #  t =   v * q
 2396                          $u);                           #      + u
 2397         $u = $v;                                        #  u = v
 2398         $v = $t;                                        #  v = t
 2399         $sign = -$sign;
 2400         redo;
 2401     }
 2402 
 2403     # if the gcd is not 1, then return NaN
 2404     return (undef, undef) unless $c->_is_one($a);
 2405 
 2406     ($v, $sign == 1 ? '+' : '-');
 2407 }
 2408 
 2409 sub _modpow {
 2410     # modulus of power ($x ** $y) % $z
 2411     my ($c, $num, $exp, $mod) = @_;
 2412 
 2413     # a^b (mod 1) = 0 for all a and b
 2414     if ($c->_is_one($mod)) {
 2415         @$num = 0;
 2416         return $num;
 2417     }
 2418 
 2419     # 0^a (mod m) = 0 if m != 0, a != 0
 2420     # 0^0 (mod m) = 1 if m != 0
 2421     if ($c->_is_zero($num)) {
 2422         if ($c->_is_zero($exp)) {
 2423             @$num = 1;
 2424         } else {
 2425             @$num = 0;
 2426         }
 2427         return $num;
 2428     }
 2429 
 2430     #  $num = $c->_mod($num, $mod);   # this does not make it faster
 2431 
 2432     my $acc = $c->_copy($num);
 2433     my $t = $c->_one();
 2434 
 2435     my $expbin = $c->_as_bin($exp);
 2436     $expbin =~ s/^0b//;
 2437     my $len = length($expbin);
 2438     while (--$len >= 0) {
 2439         if (substr($expbin, $len, 1) eq '1') { # is_odd
 2440             $t = $c->_mul($t, $acc);
 2441             $t = $c->_mod($t, $mod);
 2442         }
 2443         $acc = $c->_mul($acc, $acc);
 2444         $acc = $c->_mod($acc, $mod);
 2445     }
 2446     @$num = @$t;
 2447     $num;
 2448 }
 2449 
 2450 sub _gcd {
 2451     # Greatest common divisor.
 2452 
 2453     my ($c, $x, $y) = @_;
 2454 
 2455     # gcd(0, 0) = 0
 2456     # gcd(0, a) = a, if a != 0
 2457 
 2458     if (@$x == 1 && $x->[0] == 0) {
 2459         if (@$y == 1 && $y->[0] == 0) {
 2460             @$x = 0;
 2461         } else {
 2462             @$x = @$y;
 2463         }
 2464         return $x;
 2465     }
 2466 
 2467     # Until $y is zero ...
 2468 
 2469     until (@$y == 1 && $y->[0] == 0) {
 2470 
 2471         # Compute remainder.
 2472 
 2473         $c->_mod($x, $y);
 2474 
 2475         # Swap $x and $y.
 2476 
 2477         my $tmp = $c->_copy($x);
 2478         @$x = @$y;
 2479         $y = $tmp;              # no deref here; that would modify input $y
 2480     }
 2481 
 2482     return $x;
 2483 }
 2484 
 2485 1;
 2486 
 2487 =pod
 2488 
 2489 =head1 NAME
 2490 
 2491 Math::BigInt::Calc - Pure Perl module to support Math::BigInt
 2492 
 2493 =head1 SYNOPSIS
 2494 
 2495     # to use it with Math::BigInt
 2496     use Math::BigInt lib => 'Calc';
 2497 
 2498     # to use it with Math::BigFloat
 2499     use Math::BigFloat lib => 'Calc';
 2500 
 2501     # to use it with Math::BigRat
 2502     use Math::BigRat lib => 'Calc';
 2503 
 2504 =head1 DESCRIPTION
 2505 
 2506 Math::BigInt::Calc inherits from Math::BigInt::Lib.
 2507 
 2508 In this library, the numbers are represented in base B = 10**N, where N is the
 2509 largest possible value that does not cause overflow in the intermediate
 2510 computations. The base B elements are stored in an array, with the least
 2511 significant element stored in array element zero. There are no leading zero
 2512 elements, except a single zero element when the number is zero.
 2513 
 2514 For instance, if B = 10000, the number 1234567890 is represented internally
 2515 as [7890, 3456, 12].
 2516 
 2517 =head1 SEE ALSO
 2518 
 2519 L<Math::BigInt::Lib> for a description of the API.
 2520 
 2521 Alternative libraries L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and
 2522 L<Math::BigInt::Pari>.
 2523 
 2524 Some of the modules that use these libraries L<Math::BigInt>,
 2525 L<Math::BigFloat>, and L<Math::BigRat>.
 2526 
 2527 =cut