lib/Math/BigInt/CalcEmu.pm

   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