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