ee0b677c53f10bb18f28ceb1995497c29755ab70
[perl.git] / 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.993';
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