home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / CalcEmu.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-13  |  16.5 KB  |  634 lines
  1. package Math::BigInt::CalcEmu;
  2.  
  3. use 5.005;
  4. use strict;
  5. # use warnings;    # dont use warnings for older Perls
  6. use vars qw/$VERSION/;
  7.  
  8. $VERSION = '0.03';
  9.  
  10. package Math::BigInt;
  11.  
  12. # See SYNOPSIS below.
  13.  
  14. my $CALC_EMU;
  15.  
  16. BEGIN
  17.   {
  18.   $CALC_EMU = Math::BigInt->config()->{'lib'};
  19.   }
  20.  
  21. sub __emu_blog
  22.   {
  23.   my ($self,$x,$base,@r) = @_;
  24.  
  25.   return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
  26.  
  27.   my $acmp = $x->bacmp($base);
  28.   return $x->bone('+',@r) if $acmp == 0;
  29.   return $x->bzero(@r) if $acmp < 0 || $x->is_one();
  30.  
  31.   # blog($x,$base) ** $base + $y = $x
  32.  
  33.   # this trial multiplication is very fast, even for large counts (like for
  34.   # 2 ** 1024, since this still requires only 1024 very fast steps
  35.   # (multiplication of a large number by a very small number is very fast))
  36.   # See Calc for an even faster algorightmn
  37.   my $x_org = $x->copy();        # preserve orgx
  38.   $x->bzero();                # keep ref to $x
  39.   my $trial = $base->copy();
  40.   while ($trial->bacmp($x_org) <= 0)
  41.     {
  42.     $trial->bmul($base); $x->binc();
  43.     }
  44.   $x->round(@r);
  45.   }
  46.  
  47. sub __emu_bmodinv
  48.   {
  49.   my ($self,$x,$y,@r) = @_;
  50.  
  51.   my ($u, $u1) = ($self->bzero(), $self->bone());
  52.   my ($a, $b) = ($y->copy(), $x->copy());
  53.  
  54.   # first step need always be done since $num (and thus $b) is never 0
  55.   # Note that the loop is aligned so that the check occurs between #2 and #1
  56.   # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
  57.   # a case with 28 loops still gains about 3% with this layout.
  58.   my $q;
  59.   ($a, $q, $b) = ($b, $a->bdiv($b));            # step #1
  60.   # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
  61.   # two values in $u and $u1, we use only $u1 afterwards)
  62.   my $sign = 1;                        # flip-flop
  63.   while (!$b->is_zero())                # found GCD if $b == 0
  64.     {
  65.     # the original algorithm had:
  66.     # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
  67.     # The following creates exact the same sequence of numbers in $u1,
  68.     # except for the sign ($u1 is now always positive). Since formerly
  69.     # the sign of $u1 was alternating between '-' and '+', the $sign
  70.     # flip-flop will take care of that, so that at the end of the loop
  71.     # we have the real sign of $u1. Keeping numbers positive gains us
  72.     # speed since badd() is faster than bsub() and makes it possible
  73.     # to have the algorithmn in Calc for even more speed.
  74.  
  75.     ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q)));    # step #2
  76.     $sign = - $sign;                    # flip sign
  77.  
  78.     ($a, $q, $b) = ($b, $a->bdiv($b));            # step #1 again
  79.     }
  80.  
  81.   # If the gcd is not 1, then return NaN! It would be pointless to have
  82.   # called bgcd to check this first, because we would then be performing
  83.   # the same Euclidean Algorithm *twice* in case the gcd is 1.
  84.   return $x->bnan() unless $a->is_one();
  85.  
  86.   $u1->bneg() if $sign != 1;                # need to flip?
  87.  
  88.   $u1->bmod($y);                    # calc result
  89.   $x->{value} = $u1->{value};                # and copy over to $x
  90.   $x->{sign} = $u1->{sign};                # to modify in place
  91.   $x->round(@r);
  92.   }
  93.  
  94. sub __emu_bmodpow
  95.   {
  96.   my ($self,$num,$exp,$mod,@r) = @_;
  97.  
  98.   # in the trivial case,
  99.   return $num->bzero(@r) if $mod->is_one();
  100.   return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
  101.  
  102.   # $num->bmod($mod);           # if $x is large, make it smaller first
  103.   my $acc = $num->copy();       # but this is not really faster...
  104.  
  105.   $num->bone(); # keep ref to $num
  106.  
  107.   my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
  108.   my $len = CORE::length($expbin);
  109.   while (--$len >= 0)
  110.     {
  111.     $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
  112.     $acc->bmul($acc)->bmod($mod);
  113.     }
  114.  
  115.   $num->round(@r);
  116.   }
  117.  
  118. sub __emu_bfac
  119.   {
  120.   my ($self,$x,@r) = @_;
  121.  
  122.   return $x->bone('+',@r) if $x->is_zero() || $x->is_one();     # 0 or 1 => 1
  123.  
  124.   my $n = $x->copy();
  125.   $x->bone();
  126.   # seems we need not to temp. clear A/P of $x since the result is the same
  127.   my $f = $self->new(2);
  128.   while ($f->bacmp($n) < 0)
  129.     {
  130.     $x->bmul($f); $f->binc();
  131.     }
  132.   $x->bmul($f,@r);            # last step and also round result
  133.   }
  134.  
  135. sub __emu_bpow
  136.   {
  137.   my ($self,$x,$y,@r) = @_;
  138.  
  139.   return $x->bone('+',@r) if $y->is_zero();
  140.   return $x->round(@r) if $x->is_one() || $y->is_one();
  141.   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
  142.  
  143.   my $pow2 = $self->bone();
  144.   my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
  145.   my $len = CORE::length($y_bin);
  146.   while (--$len > 0)
  147.     {
  148.     $pow2->bmul($x) if substr($y_bin,$len,1) eq '1';    # is odd?
  149.     $x->bmul($x);
  150.     }
  151.   $x->bmul($pow2);
  152.   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
  153.   $x;
  154.   }
  155.  
  156. sub __emu_band
  157.   {
  158.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  159.  
  160.   return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
  161.   
  162.   my $sign = 0;                    # sign of result
  163.   $sign = 1 if $sx == -1 && $sy == -1;
  164.  
  165.   my ($bx,$by);
  166.  
  167.   if ($sx == -1)                # if x is negative
  168.     {
  169.     # two's complement: inc and flip all "bits" in $bx
  170.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  171.     $bx =~ s/-?0x//;
  172.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  173.     }
  174.   else
  175.     {
  176.     $bx = $x->as_hex();                # get binary representation
  177.     $bx =~ s/-?0x//;
  178.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  179.     }
  180.   if ($sy == -1)                # if y is negative
  181.     {
  182.     # two's complement: inc and flip all "bits" in $by
  183.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  184.     $by =~ s/-?0x//;
  185.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  186.     }
  187.   else
  188.     {
  189.     $by = $y->as_hex();                # get binary representation
  190.     $by =~ s/-?0x//;
  191.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  192.     }
  193.   # now we have bit-strings from X and Y, reverse them for padding
  194.   $bx = reverse $bx;
  195.   $by = reverse $by;
  196.  
  197.   # cut the longer string to the length of the shorter one (the result would
  198.   # be 0 due to AND anyway)
  199.   my $diff = CORE::length($bx) - CORE::length($by);
  200.   if ($diff > 0)
  201.     {
  202.     $bx = substr($bx,0,CORE::length($by));
  203.     }
  204.   elsif ($diff < 0)
  205.     {
  206.     $by = substr($by,0,CORE::length($bx));
  207.     }
  208.  
  209.   # and the strings together
  210.   my $r = $bx & $by;
  211.  
  212.   # and reverse the result again
  213.   $bx = reverse $r;
  214.  
  215.   # one of $x or $y was negative, so need to flip bits in the result
  216.   # in both cases (one or two of them negative, or both positive) we need
  217.   # to get the characters back.
  218.   if ($sign == 1)
  219.     {
  220.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  221.     }
  222.   else
  223.     {
  224.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  225.     }
  226.  
  227.   $bx = '0x' . $bx;
  228.   if ($CALC_EMU->can('_from_hex'))
  229.     {
  230.     $x->{value} = $CALC_EMU->_from_hex( \$bx );
  231.     }
  232.   else
  233.     {
  234.     $r = $self->new($bx);
  235.     $x->{value} = $r->{value};
  236.     }
  237.  
  238.   # calculate sign of result
  239.   $x->{sign} = '+';
  240.   #$x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
  241.   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
  242.  
  243.   $x->bdec() if $sign == 1;
  244.  
  245.   $x->round(@r);
  246.   }
  247.  
  248. sub __emu_bior
  249.   {
  250.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  251.  
  252.   return $x->round(@r) if $y->is_zero();
  253.  
  254.   my $sign = 0;                    # sign of result
  255.   $sign = 1 if ($sx == -1) || ($sy == -1);
  256.  
  257.   my ($bx,$by);
  258.  
  259.   if ($sx == -1)                # if x is negative
  260.     {
  261.     # two's complement: inc and flip all "bits" in $bx
  262.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  263.     $bx =~ s/-?0x//;
  264.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  265.     }
  266.   else
  267.     {
  268.     $bx = $x->as_hex();                # get binary representation
  269.     $bx =~ s/-?0x//;
  270.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  271.     }
  272.   if ($sy == -1)                # if y is negative
  273.     {
  274.     # two's complement: inc and flip all "bits" in $by
  275.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  276.     $by =~ s/-?0x//;
  277.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  278.     }
  279.   else
  280.     {
  281.     $by = $y->as_hex();                # get binary representation
  282.     $by =~ s/-?0x//;
  283.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  284.     }
  285.   # now we have bit-strings from X and Y, reverse them for padding
  286.   $bx = reverse $bx;
  287.   $by = reverse $by;
  288.  
  289.   # padd the shorter string
  290.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  291.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  292.   my $diff = CORE::length($bx) - CORE::length($by);
  293.   if ($diff > 0)
  294.     {
  295.     $by .= $yy x $diff;
  296.     }
  297.   elsif ($diff < 0)
  298.     {
  299.     $bx .= $xx x abs($diff);
  300.     }
  301.  
  302.   # or the strings together
  303.   my $r = $bx | $by;
  304.  
  305.   # and reverse the result again
  306.   $bx = reverse $r;
  307.  
  308.   # one of $x or $y was negative, so need to flip bits in the result
  309.   # in both cases (one or two of them negative, or both positive) we need
  310.   # to get the characters back.
  311.   if ($sign == 1)
  312.     {
  313.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  314.     }
  315.   else
  316.     {
  317.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  318.     }
  319.  
  320.   $bx = '0x' . $bx;
  321.   if ($CALC_EMU->can('_from_hex'))
  322.     {
  323.     $x->{value} = $CALC_EMU->_from_hex( \$bx );
  324.     }
  325.   else
  326.     {
  327.     $r = $self->new($bx);
  328.     $x->{value} = $r->{value};
  329.     }
  330.  
  331.   # if one of X or Y was negative, we need to decrement result
  332.   $x->bdec() if $sign == 1;
  333.  
  334.   $x->round(@r);
  335.   }
  336.  
  337. sub __emu_bxor
  338.   {
  339.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  340.  
  341.   return $x->round(@r) if $y->is_zero();
  342.  
  343.   my $sign = 0;                    # sign of result
  344.   $sign = 1 if $x->{sign} ne $y->{sign};
  345.  
  346.   my ($bx,$by);
  347.  
  348.   if ($sx == -1)                # if x is negative
  349.     {
  350.     # two's complement: inc and flip all "bits" in $bx
  351.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  352.     $bx =~ s/-?0x//;
  353.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  354.     }
  355.   else
  356.     {
  357.     $bx = $x->as_hex();                # get binary representation
  358.     $bx =~ s/-?0x//;
  359.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  360.     }
  361.   if ($sy == -1)                # if y is negative
  362.     {
  363.     # two's complement: inc and flip all "bits" in $by
  364.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  365.     $by =~ s/-?0x//;
  366.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  367.     }
  368.   else
  369.     {
  370.     $by = $y->as_hex();                # get binary representation
  371.     $by =~ s/-?0x//;
  372.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  373.     }
  374.   # now we have bit-strings from X and Y, reverse them for padding
  375.   $bx = reverse $bx;
  376.   $by = reverse $by;
  377.  
  378.   # padd the shorter string
  379.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  380.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  381.   my $diff = CORE::length($bx) - CORE::length($by);
  382.   if ($diff > 0)
  383.     {
  384.     $by .= $yy x $diff;
  385.     }
  386.   elsif ($diff < 0)
  387.     {
  388.     $bx .= $xx x abs($diff);
  389.     }
  390.  
  391.   # xor the strings together
  392.   my $r = $bx ^ $by;
  393.  
  394.   # and reverse the result again
  395.   $bx = reverse $r;
  396.  
  397.   # one of $x or $y was negative, so need to flip bits in the result
  398.   # in both cases (one or two of them negative, or both positive) we need
  399.   # to get the characters back.
  400.   if ($sign == 1)
  401.     {
  402.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  403.     }
  404.   else
  405.     {
  406.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  407.     }
  408.  
  409.   $bx = '0x' . $bx;
  410.   if ($CALC_EMU->can('_from_hex'))
  411.     {
  412.     $x->{value} = $CALC_EMU->_from_hex( \$bx );
  413.     }
  414.   else
  415.     {
  416.     $r = $self->new($bx);
  417.     $x->{value} = $r->{value};
  418.     }
  419.  
  420.   # calculate sign of result
  421.   $x->{sign} = '+';
  422.   $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
  423.  
  424.   $x->bdec() if $sign == 1;
  425.  
  426.   $x->round(@r);
  427.   }
  428.  
  429. sub __emu_bsqrt
  430.   {
  431.   my ($self,$x,@r) = @_;
  432.  
  433.   # this is slow:
  434.   return $x->round(@r) if $x->is_zero();    # 0,1 => 0,1
  435.  
  436.   return $x->bone('+',@r) if $x < 4;        # 1,2,3 => 1
  437.   my $y = $x->copy();
  438.   my $l = int($x->length()/2);
  439.  
  440.   $x->bone();                    # keep ref($x), but modify it
  441.   $x->blsft($l,10) if $l != 0;            # first guess: 1.('0' x (l/2))
  442.  
  443.   my $last = $self->bzero();
  444.   my $two = $self->new(2);
  445.   my $lastlast = $self->bzero();
  446.   #my $lastlast = $x+$two;
  447.   while ($last != $x && $lastlast != $x)
  448.     {
  449.     $lastlast = $last; $last = $x->copy();
  450.     $x->badd($y / $x);
  451.     $x->bdiv($two);
  452.     }
  453.   $x->bdec() if $x * $x > $y;            # overshot?
  454.   $x->round(@r);
  455.   }
  456.  
  457. sub __emu_broot
  458.   {
  459.   my ($self,$x,$y,@r) = @_;
  460.  
  461.   return $x->bsqrt() if $y->bacmp(2) == 0;    # 2 => square root
  462.  
  463.   # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
  464.   return $x->bone('+',@r) if $x < 8;        # $x=2..7 => 1
  465.  
  466.   my $num = $x->numify();
  467.  
  468.   if ($num <= 1000000)
  469.     {
  470.     $x = $self->new( int ( sprintf ("%.8f", $num ** (1 / $y->numify() ))));
  471.     return $x->round(@r);
  472.     }
  473.  
  474.   # if $n is a power of two, we can repeatedly take sqrt($X) and find the
  475.   # proper result, because sqrt(sqrt($x)) == root($x,4)
  476.   # See Calc.pm for more details
  477.   my $b = $y->as_bin();
  478.   if ($b =~ /0b1(0+)$/)
  479.     {
  480.     my $count = CORE::length($1);        # 0b100 => len('00') => 2
  481.     my $cnt = $count;                # counter for loop
  482.     my $shift = $self->new(6);
  483.     $x->blsft($shift);                # add some zeros (even amount)
  484.     while ($cnt-- > 0)
  485.       {
  486.       # 'inflate' $X by adding more zeros
  487.       $x->blsft($shift);
  488.       # calculate sqrt($x), $x is now a bit too big, again. In the next
  489.       # round we make even bigger, again.
  490.       $x->bsqrt($x);
  491.       }
  492.     # $x is still to big, so truncate result
  493.     $x->brsft($shift);
  494.     }
  495.   else
  496.     {
  497.     # trial computation by starting with 2,4,6,8,10 etc until we overstep
  498.     my $step;
  499.     my $trial = $self->new(2);
  500.     my $two = $self->new(2);
  501.     my $s_128 = $self->new(128);
  502.  
  503.     local undef $Math::BigInt::accuracy;
  504.     local undef $Math::BigInt::precision;
  505.  
  506.     # while still to do more than X steps
  507.     do
  508.       {
  509.       $step = $self->new(2);
  510.       while ( $trial->copy->bpow($y)->bacmp($x) < 0)
  511.         {
  512.         $step->bmul($two);
  513.         $trial->badd($step);
  514.         }
  515.  
  516.       # hit exactly?
  517.       if ( $trial->copy->bpow($y)->bacmp($x) == 0)
  518.         {
  519.         $x->{value} = $trial->{value};    # make copy while preserving ref to $x
  520.         return $x->round(@r);
  521.         }
  522.       # overstepped, so go back on step
  523.       $trial->bsub($step);
  524.       } while ($step > $s_128);
  525.  
  526.     $step = $two->copy();
  527.     while ( $trial->copy->bpow($y)->bacmp($x) < 0)
  528.       {
  529.       $trial->badd($step);
  530.       }
  531.  
  532.     # not hit exactly?
  533.     if ( $x->bacmp( $trial->copy()->bpow($y) ) < 0)
  534.       {
  535.       $trial->bdec();
  536.       }
  537.     # copy result into $x (preserve ref)
  538.     $x->{value} = $trial->{value};
  539.     }
  540.   $x->round(@r);
  541.   }
  542.  
  543. sub __emu_as_hex
  544.   {
  545.   my ($self,$x,$s) = @_;
  546.  
  547.   return '0x0' if $x->is_zero();
  548.  
  549.   my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h,$es);
  550.   if ($] >= 5.006)
  551.     {
  552.     $x10000 = $self->new (0x10000); $h = 'h4';
  553.     }
  554.   else
  555.     {
  556.     $x10000 = $self->new (0x1000); $h = 'h3';
  557.     }
  558.   while (!$x1->is_zero())
  559.     {
  560.     ($x1, $xr) = bdiv($x1,$x10000);
  561.     $es .= unpack($h,pack('v',$xr->numify()));
  562.     }
  563.   $es = reverse $es;
  564.   $es =~ s/^[0]+//;        # strip leading zeros
  565.   $s . '0x' . $es;
  566.   }
  567.  
  568. sub __emu_as_bin
  569.   {
  570.   my ($self,$x,$s) = @_;
  571.  
  572.   return '0b0' if $x->is_zero();
  573.  
  574.   my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b,$es);
  575.   if ($] >= 5.006)
  576.     {
  577.     $x10000 = $self->new (0x10000); $b = 'b16';
  578.     }
  579.   else
  580.     {
  581.     $x10000 = $self->new (0x1000); $b = 'b12';
  582.     }
  583.   while (!$x1->is_zero())
  584.     {
  585.     ($x1, $xr) = bdiv($x1,$x10000);
  586.     $es .= unpack($b,pack('v',$xr->numify()));
  587.     }
  588.   $es = reverse $es;
  589.   $es =~ s/^[0]+//;   # strip leading zeros
  590.   $s . '0b' . $es;
  591.   }
  592.  
  593. ##############################################################################
  594. ##############################################################################
  595.  
  596. 1;
  597. __END__
  598.  
  599. =head1 NAME
  600.  
  601. Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
  602.  
  603. =head1 SYNOPSIS
  604.  
  605. Contains routines that emulate low-level math functions in BigInt, e.g.
  606. optional routines the low-level math package does not provide on it's own.
  607.  
  608. Will be loaded on demand and automatically by BigInt.
  609.  
  610. Stuff here is really low-priority to optimize,
  611. since it is far better to implement the operation in the low-level math
  612. libary directly, possible even using a call to the native lib.
  613.  
  614. =head1 DESCRIPTION
  615.  
  616. =head1 METHODS
  617.  
  618. =head1 LICENSE
  619.  
  620. This program is free software; you may redistribute it and/or modify it under
  621. the same terms as Perl itself. 
  622.  
  623. =head1 AUTHORS
  624.  
  625. (c) Tels http://bloodgate.com 2003 - based on BigInt code by
  626. Tels from 2001-2003.
  627.  
  628. =head1 SEE ALSO
  629.  
  630. L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
  631. L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
  632.  
  633. =cut
  634.