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
CommitLineData
ef9466ea 1package Math::BigInt::CalcEmu;
b282a552 2
a0ac753d 3use 5.006002;
b282a552 4use strict;
ada8209b 5# use warnings; # do not use warnings for older Perls
b282a552
T
6use vars qw/$VERSION/;
7
06ce15ad 8$VERSION = '1.999704';
ef9466ea
T
9
10package Math::BigInt;
b282a552
T
11
12# See SYNOPSIS below.
13
14my $CALC_EMU;
15
16BEGIN
17 {
18 $CALC_EMU = Math::BigInt->config()->{'lib'};
b68b7ab1
T
19 # register us with MBI to get notified of future lib changes
20 Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } );
b282a552
T
21 }
22
b282a552
T
23sub __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
9b924220
RGS
64 # padd the shorter string
65 my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
66 my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
b282a552
T
67 my $diff = CORE::length($bx) - CORE::length($by);
68 if ($diff > 0)
69 {
9b924220
RGS
70 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
71 $by .= $yy x $diff;
b282a552
T
72 }
73 elsif ($diff < 0)
74 {
9b924220
RGS
75 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
76 $bx .= $xx x abs($diff);
b282a552 77 }
9b924220 78
b282a552
T
79 # and the strings together
80 my $r = $bx & $by;
81
82 # and reverse the result again
83 $bx = reverse $r;
84
9b924220
RGS
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
b282a552
T
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
9b924220 97 # leading zeros will be stripped by _from_hex()
b282a552 98 $bx = '0x' . $bx;
9b924220 99 $x->{value} = $CALC_EMU->_from_hex( $bx );
b282a552
T
100
101 # calculate sign of result
102 $x->{sign} = '+';
b282a552
T
103 $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
104
105 $x->bdec() if $sign == 1;
106
107 $x->round(@r);
108 }
109
110sub __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
9b924220 182 # leading zeros will be stripped by _from_hex()
b282a552 183 $bx = '0x' . $bx;
9b924220
RGS
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();
b282a552
T
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
196sub __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
9b924220 268 # leading zeros will be stripped by _from_hex()
b282a552 269 $bx = '0x' . $bx;
9b924220 270 $x->{value} = $CALC_EMU->_from_hex( $bx );
b282a552
T
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
b282a552
T
281##############################################################################
282##############################################################################
283
2841;
945313f0 285
b282a552
T
286__END__
287
945313f0
PJA
288=pod
289
b282a552
T
290=head1 NAME
291
292Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
293
294=head1 SYNOPSIS
295
b68b7ab1
T
296 use Math::BigInt::CalcEmu;
297
298=head1 DESCRIPTION
299
b282a552 300Contains routines that emulate low-level math functions in BigInt, e.g.
384f06ae 301optional routines the low-level math package does not provide on its own.
b282a552 302
b68b7ab1 303Will be loaded on demand and called automatically by BigInt.
b282a552 304
b68b7ab1 305Stuff here is really low-priority to optimize, since it is far better to
df0693ed 306implement the operation in the low-level math library directly, possible even
b68b7ab1 307using a call to the native lib.
b282a552
T
308
309=head1 METHODS
310
3d6c5fec 311=over
b68b7ab1 312
3d6c5fec 313=item __emu_bxor
b68b7ab1 314
3d6c5fec
DG
315=item __emu_band
316
317=item __emu_bior
318
319=back
b68b7ab1 320
945313f0
PJA
321=head1 BUGS
322
323Please report any bugs or feature requests to
324C<bug-math-bigint at rt.cpan.org>, or through the web interface at
325L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
326(requires login).
327We will be notified, and then you'll automatically be notified of progress on
328your bug as I make changes.
329
330=head1 SUPPORT
331
332You can find documentation for this module with the perldoc command.
333
334 perldoc Math::BigInt::CalcEmu
335
336You can also look for information at:
337
338=over 4
339
340=item * RT: CPAN's request tracker
341
342L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
343
344=item * AnnoCPAN: Annotated CPAN documentation
345
346L<http://annocpan.org/dist/Math-BigInt>
347
348=item * CPAN Ratings
349
350L<http://cpanratings.perl.org/dist/Math-BigInt>
351
352=item * Search CPAN
353
354L<http://search.cpan.org/dist/Math-BigInt/>
355
356=item * CPAN Testers Matrix
357
358L<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
366C<bignum at lists.scsys.co.uk>
367
368=item * View mailing list
369
370L<http://lists.scsys.co.uk/pipermail/bignum/>
371
372=item * Subscribe/Unsubscribe
373
374L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
375
376=back
377
378=back
379
b282a552 380=head1 LICENSE
53ea20b1 381
b282a552
T
382This program is free software; you may redistribute it and/or modify it under
383the same terms as Perl itself.
384
385=head1 AUTHORS
386
9b924220 387(c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
b282a552
T
388Tels from 2001-2003.
389
390=head1 SEE ALSO
391
3cabf492 392L<Math::BigInt>, L<Math::BigFloat>,
b282a552
T
393L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
394
395=cut