dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm

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