home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / CalcEmu.pm < prev    next >
Text File  |  2005-01-27  |  9KB  |  320 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.04';
  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_band
  22.   {
  23.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  24.  
  25.   return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
  26.   
  27.   my $sign = 0;                    # sign of result
  28.   $sign = 1 if $sx == -1 && $sy == -1;
  29.  
  30.   my ($bx,$by);
  31.  
  32.   if ($sx == -1)                # if x is negative
  33.     {
  34.     # two's complement: inc and flip all "bits" in $bx
  35.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  36.     $bx =~ s/-?0x//;
  37.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  38.     }
  39.   else
  40.     {
  41.     $bx = $x->as_hex();                # get binary representation
  42.     $bx =~ s/-?0x//;
  43.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  44.     }
  45.   if ($sy == -1)                # if y is negative
  46.     {
  47.     # two's complement: inc and flip all "bits" in $by
  48.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  49.     $by =~ s/-?0x//;
  50.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  51.     }
  52.   else
  53.     {
  54.     $by = $y->as_hex();                # get binary representation
  55.     $by =~ s/-?0x//;
  56.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  57.     }
  58.   # now we have bit-strings from X and Y, reverse them for padding
  59.   $bx = reverse $bx;
  60.   $by = reverse $by;
  61.  
  62.   # padd the shorter string
  63.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  64.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  65.   my $diff = CORE::length($bx) - CORE::length($by);
  66.   if ($diff > 0)
  67.     {
  68.     # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
  69.     $by .= $yy x $diff;
  70.     }
  71.   elsif ($diff < 0)
  72.     {
  73.     # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
  74.     $bx .= $xx x abs($diff);
  75.     }
  76.   
  77.   # and the strings together
  78.   my $r = $bx & $by;
  79.  
  80.   # and reverse the result again
  81.   $bx = reverse $r;
  82.  
  83.   # One of $x or $y was negative, so need to flip bits in the result.
  84.   # In both cases (one or two of them negative, or both positive) we need
  85.   # to get the characters back.
  86.   if ($sign == 1)
  87.     {
  88.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  89.     }
  90.   else
  91.     {
  92.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  93.     }
  94.  
  95.   # leading zeros will be stripped by _from_hex()
  96.   $bx = '0x' . $bx;
  97.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  98.  
  99.   # calculate sign of result
  100.   $x->{sign} = '+';
  101.   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
  102.  
  103.   $x->bdec() if $sign == 1;
  104.  
  105.   $x->round(@r);
  106.   }
  107.  
  108. sub __emu_bior
  109.   {
  110.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  111.  
  112.   return $x->round(@r) if $y->is_zero();
  113.  
  114.   my $sign = 0;                    # sign of result
  115.   $sign = 1 if ($sx == -1) || ($sy == -1);
  116.  
  117.   my ($bx,$by);
  118.  
  119.   if ($sx == -1)                # if x is negative
  120.     {
  121.     # two's complement: inc and flip all "bits" in $bx
  122.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  123.     $bx =~ s/-?0x//;
  124.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  125.     }
  126.   else
  127.     {
  128.     $bx = $x->as_hex();                # get binary representation
  129.     $bx =~ s/-?0x//;
  130.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  131.     }
  132.   if ($sy == -1)                # if y is negative
  133.     {
  134.     # two's complement: inc and flip all "bits" in $by
  135.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  136.     $by =~ s/-?0x//;
  137.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  138.     }
  139.   else
  140.     {
  141.     $by = $y->as_hex();                # get binary representation
  142.     $by =~ s/-?0x//;
  143.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  144.     }
  145.   # now we have bit-strings from X and Y, reverse them for padding
  146.   $bx = reverse $bx;
  147.   $by = reverse $by;
  148.  
  149.   # padd the shorter string
  150.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  151.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  152.   my $diff = CORE::length($bx) - CORE::length($by);
  153.   if ($diff > 0)
  154.     {
  155.     $by .= $yy x $diff;
  156.     }
  157.   elsif ($diff < 0)
  158.     {
  159.     $bx .= $xx x abs($diff);
  160.     }
  161.  
  162.   # or the strings together
  163.   my $r = $bx | $by;
  164.  
  165.   # and reverse the result again
  166.   $bx = reverse $r;
  167.  
  168.   # one of $x or $y was negative, so need to flip bits in the result
  169.   # in both cases (one or two of them negative, or both positive) we need
  170.   # to get the characters back.
  171.   if ($sign == 1)
  172.     {
  173.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  174.     }
  175.   else
  176.     {
  177.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  178.     }
  179.  
  180.   # leading zeros will be stripped by _from_hex()
  181.   $bx = '0x' . $bx;
  182.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  183.  
  184.   # calculate sign of result
  185.   $x->{sign} = '+';
  186.   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
  187.  
  188.   # if one of X or Y was negative, we need to decrement result
  189.   $x->bdec() if $sign == 1;
  190.  
  191.   $x->round(@r);
  192.   }
  193.  
  194. sub __emu_bxor
  195.   {
  196.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  197.  
  198.   return $x->round(@r) if $y->is_zero();
  199.  
  200.   my $sign = 0;                    # sign of result
  201.   $sign = 1 if $x->{sign} ne $y->{sign};
  202.  
  203.   my ($bx,$by);
  204.  
  205.   if ($sx == -1)                # if x is negative
  206.     {
  207.     # two's complement: inc and flip all "bits" in $bx
  208.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  209.     $bx =~ s/-?0x//;
  210.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  211.     }
  212.   else
  213.     {
  214.     $bx = $x->as_hex();                # get binary representation
  215.     $bx =~ s/-?0x//;
  216.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  217.     }
  218.   if ($sy == -1)                # if y is negative
  219.     {
  220.     # two's complement: inc and flip all "bits" in $by
  221.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  222.     $by =~ s/-?0x//;
  223.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  224.     }
  225.   else
  226.     {
  227.     $by = $y->as_hex();                # get binary representation
  228.     $by =~ s/-?0x//;
  229.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  230.     }
  231.   # now we have bit-strings from X and Y, reverse them for padding
  232.   $bx = reverse $bx;
  233.   $by = reverse $by;
  234.  
  235.   # padd the shorter string
  236.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  237.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  238.   my $diff = CORE::length($bx) - CORE::length($by);
  239.   if ($diff > 0)
  240.     {
  241.     $by .= $yy x $diff;
  242.     }
  243.   elsif ($diff < 0)
  244.     {
  245.     $bx .= $xx x abs($diff);
  246.     }
  247.  
  248.   # xor the strings together
  249.   my $r = $bx ^ $by;
  250.  
  251.   # and reverse the result again
  252.   $bx = reverse $r;
  253.  
  254.   # one of $x or $y was negative, so need to flip bits in the result
  255.   # in both cases (one or two of them negative, or both positive) we need
  256.   # to get the characters back.
  257.   if ($sign == 1)
  258.     {
  259.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  260.     }
  261.   else
  262.     {
  263.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  264.     }
  265.  
  266.   # leading zeros will be stripped by _from_hex()
  267.   $bx = '0x' . $bx;
  268.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  269.  
  270.   # calculate sign of result
  271.   $x->{sign} = '+';
  272.   $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
  273.  
  274.   $x->bdec() if $sign == 1;
  275.  
  276.   $x->round(@r);
  277.   }
  278.  
  279. ##############################################################################
  280. ##############################################################################
  281.  
  282. 1;
  283. __END__
  284.  
  285. =head1 NAME
  286.  
  287. Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
  288.  
  289. =head1 SYNOPSIS
  290.  
  291. Contains routines that emulate low-level math functions in BigInt, e.g.
  292. optional routines the low-level math package does not provide on it's own.
  293.  
  294. Will be loaded on demand and automatically by BigInt.
  295.  
  296. Stuff here is really low-priority to optimize,
  297. since it is far better to implement the operation in the low-level math
  298. libary directly, possible even using a call to the native lib.
  299.  
  300. =head1 DESCRIPTION
  301.  
  302. =head1 METHODS
  303.  
  304. =head1 LICENSE
  305.  
  306. This program is free software; you may redistribute it and/or modify it under
  307. the same terms as Perl itself. 
  308.  
  309. =head1 AUTHORS
  310.  
  311. (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
  312. Tels from 2001-2003.
  313.  
  314. =head1 SEE ALSO
  315.  
  316. L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
  317. L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
  318.  
  319. =cut
  320.