This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Math::BigInt from 1.999701 to 1.999704
[perl5.git] / cpan / Math-BigInt / lib / Math / BigInt / CalcEmu.pm
1 package Math::BigInt::CalcEmu;
2
3 use 5.006002;
4 use strict;
5 # use warnings; # do not use warnings for older Perls
6 use vars qw/$VERSION/;
7
8 $VERSION = '1.999704';
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
286 __END__
287
288 =pod
289
290 =head1 NAME
291
292 Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
293
294 =head1 SYNOPSIS
295
296         use Math::BigInt::CalcEmu;
297
298 =head1 DESCRIPTION
299
300 Contains routines that emulate low-level math functions in BigInt, e.g.
301 optional routines the low-level math package does not provide on its own.
302
303 Will be loaded on demand and called automatically by BigInt.
304
305 Stuff here is really low-priority to optimize, since it is far better to
306 implement the operation in the low-level math library directly, possible even
307 using a call to the native lib.
308
309 =head1 METHODS
310
311 =over
312
313 =item __emu_bxor
314
315 =item __emu_band
316
317 =item __emu_bior
318
319 =back
320
321 =head1 BUGS
322
323 Please report any bugs or feature requests to
324 C<bug-math-bigint at rt.cpan.org>, or through the web interface at
325 L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
326 (requires login).
327 We will be notified, and then you'll automatically be notified of progress on
328 your bug as I make changes.
329
330 =head1 SUPPORT
331
332 You can find documentation for this module with the perldoc command.
333
334     perldoc Math::BigInt::CalcEmu
335
336 You can also look for information at:
337
338 =over 4
339
340 =item * RT: CPAN's request tracker
341
342 L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
343
344 =item * AnnoCPAN: Annotated CPAN documentation
345
346 L<http://annocpan.org/dist/Math-BigInt>
347
348 =item * CPAN Ratings
349
350 L<http://cpanratings.perl.org/dist/Math-BigInt>
351
352 =item * Search CPAN
353
354 L<http://search.cpan.org/dist/Math-BigInt/>
355
356 =item * CPAN Testers Matrix
357
358 L<http://matrix.cpantesters.org/?dist=Math-BigInt>
359
360 =item * The Bignum mailing list
361
362 =over 4
363
364 =item * Post to mailing list
365
366 C<bignum at lists.scsys.co.uk>
367
368 =item * View mailing list
369
370 L<http://lists.scsys.co.uk/pipermail/bignum/>
371
372 =item * Subscribe/Unsubscribe
373
374 L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
375
376 =back
377
378 =back
379
380 =head1 LICENSE
381
382 This program is free software; you may redistribute it and/or modify it under
383 the same terms as Perl itself. 
384
385 =head1 AUTHORS
386
387 (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
388 Tels from 2001-2003.
389
390 =head1 SEE ALSO
391
392 L<Math::BigInt>, L<Math::BigFloat>,
393 L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
394
395 =cut