xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Math/BigInt/Calc.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gatepackage Math::BigInt::Calc;
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-gate
7*0Sstevel@tonic-gateuse vars qw/$VERSION/;
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gate$VERSION = '0.40';
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gate# Package to store unsigned big integers in decimal and do math with them
12*0Sstevel@tonic-gate
13*0Sstevel@tonic-gate# Internally the numbers are stored in an array with at least 1 element, no
14*0Sstevel@tonic-gate# leading zero parts (except the first) and in base 1eX where X is determined
15*0Sstevel@tonic-gate# automatically at loading time to be the maximum possible value
16*0Sstevel@tonic-gate
17*0Sstevel@tonic-gate# todo:
18*0Sstevel@tonic-gate# - fully remove funky $# stuff (maybe)
19*0Sstevel@tonic-gate
20*0Sstevel@tonic-gate# USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
21*0Sstevel@tonic-gate# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
22*0Sstevel@tonic-gate# BS2000, some Crays need USE_DIV instead.
23*0Sstevel@tonic-gate# The BEGIN block is used to determine which of the two variants gives the
24*0Sstevel@tonic-gate# correct result.
25*0Sstevel@tonic-gate
26*0Sstevel@tonic-gate# Beware of things like:
27*0Sstevel@tonic-gate# $i = $i * $y + $car; $car = int($i / $MBASE); $i = $i % $MBASE;
28*0Sstevel@tonic-gate# This works on x86, but fails on ARM (SA1100, iPAQ) due to whoknows what
29*0Sstevel@tonic-gate# reasons. So, use this instead (slower, but correct):
30*0Sstevel@tonic-gate# $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $MBASE * $car;
31*0Sstevel@tonic-gate
32*0Sstevel@tonic-gate##############################################################################
33*0Sstevel@tonic-gate# global constants, flags and accessory
34*0Sstevel@tonic-gate
35*0Sstevel@tonic-gate# announce that we are compatible with MBI v1.70 and up
36*0Sstevel@tonic-gatesub api_version () { 1; }
37*0Sstevel@tonic-gate
38*0Sstevel@tonic-gate# constants for easier life
39*0Sstevel@tonic-gatemy $nan = 'NaN';
40*0Sstevel@tonic-gatemy ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2,$BASE_LEN_SMALL);
41*0Sstevel@tonic-gatemy ($AND_BITS,$XOR_BITS,$OR_BITS);
42*0Sstevel@tonic-gatemy ($AND_MASK,$XOR_MASK,$OR_MASK);
43*0Sstevel@tonic-gate
44*0Sstevel@tonic-gatesub _base_len
45*0Sstevel@tonic-gate  {
46*0Sstevel@tonic-gate  # set/get the BASE_LEN and assorted other, connected values
47*0Sstevel@tonic-gate  # used only be the testsuite, set is used only by the BEGIN block below
48*0Sstevel@tonic-gate  shift;
49*0Sstevel@tonic-gate
50*0Sstevel@tonic-gate  my $b = shift;
51*0Sstevel@tonic-gate  if (defined $b)
52*0Sstevel@tonic-gate    {
53*0Sstevel@tonic-gate    # find whether we can use mul or div or none in mul()/div()
54*0Sstevel@tonic-gate    # (in last case reduce BASE_LEN_SMALL)
55*0Sstevel@tonic-gate    $BASE_LEN_SMALL = $b+1;
56*0Sstevel@tonic-gate    my $caught = 0;
57*0Sstevel@tonic-gate    while (--$BASE_LEN_SMALL > 5)
58*0Sstevel@tonic-gate      {
59*0Sstevel@tonic-gate      $MBASE = int("1e".$BASE_LEN_SMALL);
60*0Sstevel@tonic-gate      $RBASE = abs('1e-'.$BASE_LEN_SMALL);		# see USE_MUL
61*0Sstevel@tonic-gate      $caught = 0;
62*0Sstevel@tonic-gate      $caught += 1 if (int($MBASE * $RBASE) != 1);	# should be 1
63*0Sstevel@tonic-gate      $caught += 2 if (int($MBASE / $MBASE) != 1);	# should be 1
64*0Sstevel@tonic-gate      last if $caught != 3;
65*0Sstevel@tonic-gate      }
66*0Sstevel@tonic-gate    # BASE_LEN is used for anything else than mul()/div()
67*0Sstevel@tonic-gate    $BASE_LEN = $BASE_LEN_SMALL;
68*0Sstevel@tonic-gate    $BASE_LEN = shift if (defined $_[0]);		# one more arg?
69*0Sstevel@tonic-gate    $BASE = int("1e".$BASE_LEN);
70*0Sstevel@tonic-gate
71*0Sstevel@tonic-gate    $BASE_LEN2 = int($BASE_LEN_SMALL / 2);		# for mul shortcut
72*0Sstevel@tonic-gate    $MBASE = int("1e".$BASE_LEN_SMALL);
73*0Sstevel@tonic-gate    $RBASE = abs('1e-'.$BASE_LEN_SMALL);		# see USE_MUL
74*0Sstevel@tonic-gate    $MAX_VAL = $MBASE-1;
75*0Sstevel@tonic-gate
76*0Sstevel@tonic-gate    undef &_mul;
77*0Sstevel@tonic-gate    undef &_div;
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gate    # $caught & 1 != 0 => cannot use MUL
80*0Sstevel@tonic-gate    # $caught & 2 != 0 => cannot use DIV
81*0Sstevel@tonic-gate    # The parens around ($caught & 1) were important, indeed, if we would use
82*0Sstevel@tonic-gate    # & here.
83*0Sstevel@tonic-gate    if ($caught == 2)				# 2
84*0Sstevel@tonic-gate      {
85*0Sstevel@tonic-gate      # must USE_MUL since we cannot use DIV
86*0Sstevel@tonic-gate      *{_mul} = \&_mul_use_mul;
87*0Sstevel@tonic-gate      *{_div} = \&_div_use_mul;
88*0Sstevel@tonic-gate      }
89*0Sstevel@tonic-gate    else					# 0 or 1
90*0Sstevel@tonic-gate      {
91*0Sstevel@tonic-gate      # can USE_DIV instead
92*0Sstevel@tonic-gate      *{_mul} = \&_mul_use_div;
93*0Sstevel@tonic-gate      *{_div} = \&_div_use_div;
94*0Sstevel@tonic-gate      }
95*0Sstevel@tonic-gate    }
96*0Sstevel@tonic-gate  return $BASE_LEN unless wantarray;
97*0Sstevel@tonic-gate  return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL);
98*0Sstevel@tonic-gate  }
99*0Sstevel@tonic-gate
100*0Sstevel@tonic-gateBEGIN
101*0Sstevel@tonic-gate  {
102*0Sstevel@tonic-gate  # from Daniel Pfeiffer: determine largest group of digits that is precisely
103*0Sstevel@tonic-gate  # multipliable with itself plus carry
104*0Sstevel@tonic-gate  # Test now changed to expect the proper pattern, not a result off by 1 or 2
105*0Sstevel@tonic-gate  my ($e, $num) = 3;	# lowest value we will use is 3+1-1 = 3
106*0Sstevel@tonic-gate  do
107*0Sstevel@tonic-gate    {
108*0Sstevel@tonic-gate    $num = ('9' x ++$e) + 0;
109*0Sstevel@tonic-gate    $num *= $num + 1.0;
110*0Sstevel@tonic-gate    } while ("$num" =~ /9{$e}0{$e}/);	# must be a certain pattern
111*0Sstevel@tonic-gate  $e--; 				# last test failed, so retract one step
112*0Sstevel@tonic-gate  # the limits below brush the problems with the test above under the rug:
113*0Sstevel@tonic-gate  # the test should be able to find the proper $e automatically
114*0Sstevel@tonic-gate  $e = 5 if $^O =~ /^uts/;	# UTS get's some special treatment
115*0Sstevel@tonic-gate  $e = 5 if $^O =~ /^unicos/;	# unicos is also problematic (6 seems to work
116*0Sstevel@tonic-gate				# there, but we play safe)
117*0Sstevel@tonic-gate  $e = 5 if $] < 5.006;		# cap, for older Perls
118*0Sstevel@tonic-gate  $e = 7 if $e > 7;		# cap, for VMS, OS/390 and other 64 bit systems
119*0Sstevel@tonic-gate				# 8 fails inside random testsuite, so take 7
120*0Sstevel@tonic-gate
121*0Sstevel@tonic-gate  # determine how many digits fit into an integer and can be safely added
122*0Sstevel@tonic-gate  # together plus carry w/o causing an overflow
123*0Sstevel@tonic-gate
124*0Sstevel@tonic-gate  use integer;
125*0Sstevel@tonic-gate
126*0Sstevel@tonic-gate  ############################################################################
127*0Sstevel@tonic-gate  # the next block is no longer important
128*0Sstevel@tonic-gate
129*0Sstevel@tonic-gate  ## this below detects 15 on a 64 bit system, because after that it becomes
130*0Sstevel@tonic-gate  ## 1e16  and not 1000000 :/ I can make it detect 18, but then I get a lot of
131*0Sstevel@tonic-gate  ## test failures. Ugh! (Tomake detect 18: uncomment lines marked with *)
132*0Sstevel@tonic-gate
133*0Sstevel@tonic-gate  #my $bi = 5;			# approx. 16 bit
134*0Sstevel@tonic-gate  #$num = int('9' x $bi);
135*0Sstevel@tonic-gate  ## $num = 99999; # *
136*0Sstevel@tonic-gate  ## while ( ($num+$num+1) eq '1' . '9' x $bi)	# *
137*0Sstevel@tonic-gate  #while ( int($num+$num+1) eq '1' . '9' x $bi)
138*0Sstevel@tonic-gate  #  {
139*0Sstevel@tonic-gate  #  $bi++; $num = int('9' x $bi);
140*0Sstevel@tonic-gate  #  # $bi++; $num *= 10; $num += 9;	# *
141*0Sstevel@tonic-gate  #  }
142*0Sstevel@tonic-gate  #$bi--;				# back off one step
143*0Sstevel@tonic-gate  # by setting them equal, we ignore the findings and use the default
144*0Sstevel@tonic-gate  # one-size-fits-all approach from former versions
145*0Sstevel@tonic-gate  my $bi = $e;				# XXX, this should work always
146*0Sstevel@tonic-gate
147*0Sstevel@tonic-gate  __PACKAGE__->_base_len($e,$bi);	# set and store
148*0Sstevel@tonic-gate
149*0Sstevel@tonic-gate  # find out how many bits _and, _or and _xor can take (old default = 16)
150*0Sstevel@tonic-gate  # I don't think anybody has yet 128 bit scalars, so let's play safe.
151*0Sstevel@tonic-gate  local $^W = 0;	# don't warn about 'nonportable number'
152*0Sstevel@tonic-gate  $AND_BITS = 15; $XOR_BITS = 15; $OR_BITS = 15;
153*0Sstevel@tonic-gate
154*0Sstevel@tonic-gate  # find max bits, we will not go higher than numberofbits that fit into $BASE
155*0Sstevel@tonic-gate  # to make _and etc simpler (and faster for smaller, slower for large numbers)
156*0Sstevel@tonic-gate  my $max = 16;
157*0Sstevel@tonic-gate  while (2 ** $max < $BASE) { $max++; }
158*0Sstevel@tonic-gate  {
159*0Sstevel@tonic-gate    no integer;
160*0Sstevel@tonic-gate    $max = 16 if $] < 5.006;	# older Perls might not take >16 too well
161*0Sstevel@tonic-gate  }
162*0Sstevel@tonic-gate  my ($x,$y,$z);
163*0Sstevel@tonic-gate  do {
164*0Sstevel@tonic-gate    $AND_BITS++;
165*0Sstevel@tonic-gate    $x = oct('0b' . '1' x $AND_BITS); $y = $x & $x;
166*0Sstevel@tonic-gate    $z = (2 ** $AND_BITS) - 1;
167*0Sstevel@tonic-gate    } while ($AND_BITS < $max && $x == $z && $y == $x);
168*0Sstevel@tonic-gate  $AND_BITS --;						# retreat one step
169*0Sstevel@tonic-gate  do {
170*0Sstevel@tonic-gate    $XOR_BITS++;
171*0Sstevel@tonic-gate    $x = oct('0b' . '1' x $XOR_BITS); $y = $x ^ 0;
172*0Sstevel@tonic-gate    $z = (2 ** $XOR_BITS) - 1;
173*0Sstevel@tonic-gate    } while ($XOR_BITS < $max && $x == $z && $y == $x);
174*0Sstevel@tonic-gate  $XOR_BITS --;						# retreat one step
175*0Sstevel@tonic-gate  do {
176*0Sstevel@tonic-gate    $OR_BITS++;
177*0Sstevel@tonic-gate    $x = oct('0b' . '1' x $OR_BITS); $y = $x | $x;
178*0Sstevel@tonic-gate    $z = (2 ** $OR_BITS) - 1;
179*0Sstevel@tonic-gate    } while ($OR_BITS < $max && $x == $z && $y == $x);
180*0Sstevel@tonic-gate  $OR_BITS --;						# retreat one step
181*0Sstevel@tonic-gate
182*0Sstevel@tonic-gate  }
183*0Sstevel@tonic-gate
184*0Sstevel@tonic-gate###############################################################################
185*0Sstevel@tonic-gate
186*0Sstevel@tonic-gatesub _new
187*0Sstevel@tonic-gate  {
188*0Sstevel@tonic-gate  # (ref to string) return ref to num_array
189*0Sstevel@tonic-gate  # Convert a number from string format (without sign) to internal base
190*0Sstevel@tonic-gate  # 1ex format. Assumes normalized value as input.
191*0Sstevel@tonic-gate  my $il = length($_[1])-1;
192*0Sstevel@tonic-gate
193*0Sstevel@tonic-gate  # < BASE_LEN due len-1 above
194*0Sstevel@tonic-gate  return [ int($_[1]) ] if $il < $BASE_LEN;	# shortcut for short numbers
195*0Sstevel@tonic-gate
196*0Sstevel@tonic-gate  # this leaves '00000' instead of int 0 and will be corrected after any op
197*0Sstevel@tonic-gate  [ reverse(unpack("a" . ($il % $BASE_LEN+1)
198*0Sstevel@tonic-gate    . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
199*0Sstevel@tonic-gate  }
200*0Sstevel@tonic-gate
201*0Sstevel@tonic-gateBEGIN
202*0Sstevel@tonic-gate  {
203*0Sstevel@tonic-gate  $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS ));
204*0Sstevel@tonic-gate  $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS ));
205*0Sstevel@tonic-gate  $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS ));
206*0Sstevel@tonic-gate  }
207*0Sstevel@tonic-gate
208*0Sstevel@tonic-gatesub _zero
209*0Sstevel@tonic-gate  {
210*0Sstevel@tonic-gate  # create a zero
211*0Sstevel@tonic-gate  [ 0 ];
212*0Sstevel@tonic-gate  }
213*0Sstevel@tonic-gate
214*0Sstevel@tonic-gatesub _one
215*0Sstevel@tonic-gate  {
216*0Sstevel@tonic-gate  # create a one
217*0Sstevel@tonic-gate  [ 1 ];
218*0Sstevel@tonic-gate  }
219*0Sstevel@tonic-gate
220*0Sstevel@tonic-gatesub _two
221*0Sstevel@tonic-gate  {
222*0Sstevel@tonic-gate  # create a two (used internally for shifting)
223*0Sstevel@tonic-gate  [ 2 ];
224*0Sstevel@tonic-gate  }
225*0Sstevel@tonic-gate
226*0Sstevel@tonic-gatesub _ten
227*0Sstevel@tonic-gate  {
228*0Sstevel@tonic-gate  # create a 10 (used internally for shifting)
229*0Sstevel@tonic-gate  [ 10 ];
230*0Sstevel@tonic-gate  }
231*0Sstevel@tonic-gate
232*0Sstevel@tonic-gatesub _copy
233*0Sstevel@tonic-gate  {
234*0Sstevel@tonic-gate  # make a true copy
235*0Sstevel@tonic-gate  [ @{$_[1]} ];
236*0Sstevel@tonic-gate  }
237*0Sstevel@tonic-gate
238*0Sstevel@tonic-gate# catch and throw away
239*0Sstevel@tonic-gatesub import { }
240*0Sstevel@tonic-gate
241*0Sstevel@tonic-gate##############################################################################
242*0Sstevel@tonic-gate# convert back to string and number
243*0Sstevel@tonic-gate
244*0Sstevel@tonic-gatesub _str
245*0Sstevel@tonic-gate  {
246*0Sstevel@tonic-gate  # (ref to BINT) return num_str
247*0Sstevel@tonic-gate  # Convert number from internal base 100000 format to string format.
248*0Sstevel@tonic-gate  # internal format is always normalized (no leading zeros, "-0" => "+0")
249*0Sstevel@tonic-gate  my $ar = $_[1];
250*0Sstevel@tonic-gate  my $ret = "";
251*0Sstevel@tonic-gate
252*0Sstevel@tonic-gate  my $l = scalar @$ar;		# number of parts
253*0Sstevel@tonic-gate  return $nan if $l < 1;	# should not happen
254*0Sstevel@tonic-gate
255*0Sstevel@tonic-gate  # handle first one different to strip leading zeros from it (there are no
256*0Sstevel@tonic-gate  # leading zero parts in internal representation)
257*0Sstevel@tonic-gate  $l --; $ret .= int($ar->[$l]); $l--;
258*0Sstevel@tonic-gate  # Interestingly, the pre-padd method uses more time
259*0Sstevel@tonic-gate  # the old grep variant takes longer (14 vs. 10 sec)
260*0Sstevel@tonic-gate  my $z = '0' x ($BASE_LEN-1);
261*0Sstevel@tonic-gate  while ($l >= 0)
262*0Sstevel@tonic-gate    {
263*0Sstevel@tonic-gate    $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
264*0Sstevel@tonic-gate    $l--;
265*0Sstevel@tonic-gate    }
266*0Sstevel@tonic-gate  $ret;
267*0Sstevel@tonic-gate  }
268*0Sstevel@tonic-gate
269*0Sstevel@tonic-gatesub _num
270*0Sstevel@tonic-gate  {
271*0Sstevel@tonic-gate  # Make a number (scalar int/float) from a BigInt object
272*0Sstevel@tonic-gate  my $x = $_[1];
273*0Sstevel@tonic-gate
274*0Sstevel@tonic-gate  return 0+$x->[0] if scalar @$x == 1;  # below $BASE
275*0Sstevel@tonic-gate  my $fac = 1;
276*0Sstevel@tonic-gate  my $num = 0;
277*0Sstevel@tonic-gate  foreach (@$x)
278*0Sstevel@tonic-gate    {
279*0Sstevel@tonic-gate    $num += $fac*$_; $fac *= $BASE;
280*0Sstevel@tonic-gate    }
281*0Sstevel@tonic-gate  $num;
282*0Sstevel@tonic-gate  }
283*0Sstevel@tonic-gate
284*0Sstevel@tonic-gate##############################################################################
285*0Sstevel@tonic-gate# actual math code
286*0Sstevel@tonic-gate
287*0Sstevel@tonic-gatesub _add
288*0Sstevel@tonic-gate  {
289*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array)
290*0Sstevel@tonic-gate  # routine to add two base 1eX numbers
291*0Sstevel@tonic-gate  # stolen from Knuth Vol 2 Algorithm A pg 231
292*0Sstevel@tonic-gate  # there are separate routines to add and sub as per Knuth pg 233
293*0Sstevel@tonic-gate  # This routine clobbers up array x, but not y.
294*0Sstevel@tonic-gate
295*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
296*0Sstevel@tonic-gate
297*0Sstevel@tonic-gate  return $x if (@$y == 1) && $y->[0] == 0;		# $x + 0 => $x
298*0Sstevel@tonic-gate  if ((@$x == 1) && $x->[0] == 0)			# 0 + $y => $y->copy
299*0Sstevel@tonic-gate    {
300*0Sstevel@tonic-gate    # twice as slow as $x = [ @$y ], but necc. to retain $x as ref :(
301*0Sstevel@tonic-gate    @$x = @$y; return $x;
302*0Sstevel@tonic-gate    }
303*0Sstevel@tonic-gate
304*0Sstevel@tonic-gate  # for each in Y, add Y to X and carry. If after that, something is left in
305*0Sstevel@tonic-gate  # X, foreach in X add carry to X and then return X, carry
306*0Sstevel@tonic-gate  # Trades one "$j++" for having to shift arrays
307*0Sstevel@tonic-gate  my $i; my $car = 0; my $j = 0;
308*0Sstevel@tonic-gate  for $i (@$y)
309*0Sstevel@tonic-gate    {
310*0Sstevel@tonic-gate    $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
311*0Sstevel@tonic-gate    $j++;
312*0Sstevel@tonic-gate    }
313*0Sstevel@tonic-gate  while ($car != 0)
314*0Sstevel@tonic-gate    {
315*0Sstevel@tonic-gate    $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
316*0Sstevel@tonic-gate    }
317*0Sstevel@tonic-gate  $x;
318*0Sstevel@tonic-gate  }
319*0Sstevel@tonic-gate
320*0Sstevel@tonic-gatesub _inc
321*0Sstevel@tonic-gate  {
322*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array)
323*0Sstevel@tonic-gate  # Add 1 to $x, modify $x in place
324*0Sstevel@tonic-gate  my ($c,$x) = @_;
325*0Sstevel@tonic-gate
326*0Sstevel@tonic-gate  for my $i (@$x)
327*0Sstevel@tonic-gate    {
328*0Sstevel@tonic-gate    return $x if (($i += 1) < $BASE);		# early out
329*0Sstevel@tonic-gate    $i = 0;					# overflow, next
330*0Sstevel@tonic-gate    }
331*0Sstevel@tonic-gate  push @$x,1 if ($x->[-1] == 0);		# last overflowed, so extend
332*0Sstevel@tonic-gate  $x;
333*0Sstevel@tonic-gate  }
334*0Sstevel@tonic-gate
335*0Sstevel@tonic-gatesub _dec
336*0Sstevel@tonic-gate  {
337*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array)
338*0Sstevel@tonic-gate  # Sub 1 from $x, modify $x in place
339*0Sstevel@tonic-gate  my ($c,$x) = @_;
340*0Sstevel@tonic-gate
341*0Sstevel@tonic-gate  my $MAX = $BASE-1;				# since MAX_VAL based on MBASE
342*0Sstevel@tonic-gate  for my $i (@$x)
343*0Sstevel@tonic-gate    {
344*0Sstevel@tonic-gate    last if (($i -= 1) >= 0);			# early out
345*0Sstevel@tonic-gate    $i = $MAX;					# underflow, next
346*0Sstevel@tonic-gate    }
347*0Sstevel@tonic-gate  pop @$x if $x->[-1] == 0 && @$x > 1;		# last underflowed (but leave 0)
348*0Sstevel@tonic-gate  $x;
349*0Sstevel@tonic-gate  }
350*0Sstevel@tonic-gate
351*0Sstevel@tonic-gatesub _sub
352*0Sstevel@tonic-gate  {
353*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array, swap)
354*0Sstevel@tonic-gate  # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
355*0Sstevel@tonic-gate  # subtract Y from X by modifying x in place
356*0Sstevel@tonic-gate  my ($c,$sx,$sy,$s) = @_;
357*0Sstevel@tonic-gate
358*0Sstevel@tonic-gate  my $car = 0; my $i; my $j = 0;
359*0Sstevel@tonic-gate  if (!$s)
360*0Sstevel@tonic-gate    {
361*0Sstevel@tonic-gate    for $i (@$sx)
362*0Sstevel@tonic-gate      {
363*0Sstevel@tonic-gate      last unless defined $sy->[$j] || $car;
364*0Sstevel@tonic-gate      $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++;
365*0Sstevel@tonic-gate      }
366*0Sstevel@tonic-gate    # might leave leading zeros, so fix that
367*0Sstevel@tonic-gate    return __strip_zeros($sx);
368*0Sstevel@tonic-gate    }
369*0Sstevel@tonic-gate  for $i (@$sx)
370*0Sstevel@tonic-gate    {
371*0Sstevel@tonic-gate    # we can't do an early out if $x is < than $y, since we
372*0Sstevel@tonic-gate    # need to copy the high chunks from $y. Found by Bob Mathews.
373*0Sstevel@tonic-gate    #last unless defined $sy->[$j] || $car;
374*0Sstevel@tonic-gate    $sy->[$j] += $BASE
375*0Sstevel@tonic-gate     if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0);
376*0Sstevel@tonic-gate    $j++;
377*0Sstevel@tonic-gate    }
378*0Sstevel@tonic-gate  # might leave leading zeros, so fix that
379*0Sstevel@tonic-gate  __strip_zeros($sy);
380*0Sstevel@tonic-gate  }
381*0Sstevel@tonic-gate
382*0Sstevel@tonic-gatesub _mul_use_mul
383*0Sstevel@tonic-gate  {
384*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array)
385*0Sstevel@tonic-gate  # multiply two numbers in internal representation
386*0Sstevel@tonic-gate  # modifies first arg, second need not be different from first
387*0Sstevel@tonic-gate  my ($c,$xv,$yv) = @_;
388*0Sstevel@tonic-gate
389*0Sstevel@tonic-gate  if (@$yv == 1)
390*0Sstevel@tonic-gate    {
391*0Sstevel@tonic-gate    # shortcut for two very short numbers (improved by Nathan Zook)
392*0Sstevel@tonic-gate    # works also if xv and yv are the same reference, and handles also $x == 0
393*0Sstevel@tonic-gate    if (@$xv == 1)
394*0Sstevel@tonic-gate      {
395*0Sstevel@tonic-gate      if (($xv->[0] *= $yv->[0]) >= $MBASE)
396*0Sstevel@tonic-gate         {
397*0Sstevel@tonic-gate         $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE;
398*0Sstevel@tonic-gate         };
399*0Sstevel@tonic-gate      return $xv;
400*0Sstevel@tonic-gate      }
401*0Sstevel@tonic-gate    # $x * 0 => 0
402*0Sstevel@tonic-gate    if ($yv->[0] == 0)
403*0Sstevel@tonic-gate      {
404*0Sstevel@tonic-gate      @$xv = (0);
405*0Sstevel@tonic-gate      return $xv;
406*0Sstevel@tonic-gate      }
407*0Sstevel@tonic-gate    # multiply a large number a by a single element one, so speed up
408*0Sstevel@tonic-gate    my $y = $yv->[0]; my $car = 0;
409*0Sstevel@tonic-gate    foreach my $i (@$xv)
410*0Sstevel@tonic-gate      {
411*0Sstevel@tonic-gate      $i = $i * $y + $car; $car = int($i * $RBASE); $i -= $car * $MBASE;
412*0Sstevel@tonic-gate      }
413*0Sstevel@tonic-gate    push @$xv, $car if $car != 0;
414*0Sstevel@tonic-gate    return $xv;
415*0Sstevel@tonic-gate    }
416*0Sstevel@tonic-gate  # shortcut for result $x == 0 => result = 0
417*0Sstevel@tonic-gate  return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
418*0Sstevel@tonic-gate
419*0Sstevel@tonic-gate  # since multiplying $x with $x fails, make copy in this case
420*0Sstevel@tonic-gate  $yv = [@$xv] if $xv == $yv;	# same references?
421*0Sstevel@tonic-gate
422*0Sstevel@tonic-gate  my @prod = (); my ($prod,$car,$cty,$xi,$yi);
423*0Sstevel@tonic-gate
424*0Sstevel@tonic-gate  for $xi (@$xv)
425*0Sstevel@tonic-gate    {
426*0Sstevel@tonic-gate    $car = 0; $cty = 0;
427*0Sstevel@tonic-gate
428*0Sstevel@tonic-gate    # slow variant
429*0Sstevel@tonic-gate#    for $yi (@$yv)
430*0Sstevel@tonic-gate#      {
431*0Sstevel@tonic-gate#      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
432*0Sstevel@tonic-gate#      $prod[$cty++] =
433*0Sstevel@tonic-gate#       $prod - ($car = int($prod * RBASE)) * $MBASE;  # see USE_MUL
434*0Sstevel@tonic-gate#      }
435*0Sstevel@tonic-gate#    $prod[$cty] += $car if $car; # need really to check for 0?
436*0Sstevel@tonic-gate#    $xi = shift @prod;
437*0Sstevel@tonic-gate
438*0Sstevel@tonic-gate    # faster variant
439*0Sstevel@tonic-gate    # looping through this if $xi == 0 is silly - so optimize it away!
440*0Sstevel@tonic-gate    $xi = (shift @prod || 0), next if $xi == 0;
441*0Sstevel@tonic-gate    for $yi (@$yv)
442*0Sstevel@tonic-gate      {
443*0Sstevel@tonic-gate      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
444*0Sstevel@tonic-gate##     this is actually a tad slower
445*0Sstevel@tonic-gate##        $prod = $prod[$cty]; $prod += ($car + $xi * $yi);	# no ||0 here
446*0Sstevel@tonic-gate      $prod[$cty++] =
447*0Sstevel@tonic-gate       $prod - ($car = int($prod * $RBASE)) * $MBASE;  # see USE_MUL
448*0Sstevel@tonic-gate      }
449*0Sstevel@tonic-gate    $prod[$cty] += $car if $car; # need really to check for 0?
450*0Sstevel@tonic-gate    $xi = shift @prod || 0;	# || 0 makes v5.005_3 happy
451*0Sstevel@tonic-gate    }
452*0Sstevel@tonic-gate  push @$xv, @prod;
453*0Sstevel@tonic-gate  __strip_zeros($xv);
454*0Sstevel@tonic-gate  $xv;
455*0Sstevel@tonic-gate  }
456*0Sstevel@tonic-gate
457*0Sstevel@tonic-gatesub _mul_use_div
458*0Sstevel@tonic-gate  {
459*0Sstevel@tonic-gate  # (ref to int_num_array, ref to int_num_array)
460*0Sstevel@tonic-gate  # multiply two numbers in internal representation
461*0Sstevel@tonic-gate  # modifies first arg, second need not be different from first
462*0Sstevel@tonic-gate  my ($c,$xv,$yv) = @_;
463*0Sstevel@tonic-gate
464*0Sstevel@tonic-gate  if (@$yv == 1)
465*0Sstevel@tonic-gate    {
466*0Sstevel@tonic-gate    # shortcut for two small numbers, also handles $x == 0
467*0Sstevel@tonic-gate    if (@$xv == 1)
468*0Sstevel@tonic-gate      {
469*0Sstevel@tonic-gate      # shortcut for two very short numbers (improved by Nathan Zook)
470*0Sstevel@tonic-gate      # works also if xv and yv are the same reference, and handles also $x == 0
471*0Sstevel@tonic-gate      if (($xv->[0] *= $yv->[0]) >= $MBASE)
472*0Sstevel@tonic-gate          {
473*0Sstevel@tonic-gate          $xv->[0] =
474*0Sstevel@tonic-gate              $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE;
475*0Sstevel@tonic-gate          };
476*0Sstevel@tonic-gate      return $xv;
477*0Sstevel@tonic-gate      }
478*0Sstevel@tonic-gate    # $x * 0 => 0
479*0Sstevel@tonic-gate    if ($yv->[0] == 0)
480*0Sstevel@tonic-gate      {
481*0Sstevel@tonic-gate      @$xv = (0);
482*0Sstevel@tonic-gate      return $xv;
483*0Sstevel@tonic-gate      }
484*0Sstevel@tonic-gate    # multiply a large number a by a single element one, so speed up
485*0Sstevel@tonic-gate    my $y = $yv->[0]; my $car = 0;
486*0Sstevel@tonic-gate    foreach my $i (@$xv)
487*0Sstevel@tonic-gate      {
488*0Sstevel@tonic-gate      $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $car * $MBASE;
489*0Sstevel@tonic-gate      }
490*0Sstevel@tonic-gate    push @$xv, $car if $car != 0;
491*0Sstevel@tonic-gate    return $xv;
492*0Sstevel@tonic-gate    }
493*0Sstevel@tonic-gate  # shortcut for result $x == 0 => result = 0
494*0Sstevel@tonic-gate  return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
495*0Sstevel@tonic-gate
496*0Sstevel@tonic-gate  # since multiplying $x with $x fails, make copy in this case
497*0Sstevel@tonic-gate  $yv = [@$xv] if $xv == $yv;	# same references?
498*0Sstevel@tonic-gate
499*0Sstevel@tonic-gate  my @prod = (); my ($prod,$car,$cty,$xi,$yi);
500*0Sstevel@tonic-gate  for $xi (@$xv)
501*0Sstevel@tonic-gate    {
502*0Sstevel@tonic-gate    $car = 0; $cty = 0;
503*0Sstevel@tonic-gate    # looping through this if $xi == 0 is silly - so optimize it away!
504*0Sstevel@tonic-gate    $xi = (shift @prod || 0), next if $xi == 0;
505*0Sstevel@tonic-gate    for $yi (@$yv)
506*0Sstevel@tonic-gate      {
507*0Sstevel@tonic-gate      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
508*0Sstevel@tonic-gate      $prod[$cty++] =
509*0Sstevel@tonic-gate       $prod - ($car = int($prod / $MBASE)) * $MBASE;
510*0Sstevel@tonic-gate      }
511*0Sstevel@tonic-gate    $prod[$cty] += $car if $car; # need really to check for 0?
512*0Sstevel@tonic-gate    $xi = shift @prod || 0;	# || 0 makes v5.005_3 happy
513*0Sstevel@tonic-gate    }
514*0Sstevel@tonic-gate  push @$xv, @prod;
515*0Sstevel@tonic-gate  __strip_zeros($xv);
516*0Sstevel@tonic-gate  $xv;
517*0Sstevel@tonic-gate  }
518*0Sstevel@tonic-gate
519*0Sstevel@tonic-gatesub _div_use_mul
520*0Sstevel@tonic-gate  {
521*0Sstevel@tonic-gate  # ref to array, ref to array, modify first array and return remainder if
522*0Sstevel@tonic-gate  # in list context
523*0Sstevel@tonic-gate
524*0Sstevel@tonic-gate  # see comments in _div_use_div() for more explanations
525*0Sstevel@tonic-gate
526*0Sstevel@tonic-gate  my ($c,$x,$yorg) = @_;
527*0Sstevel@tonic-gate
528*0Sstevel@tonic-gate  # the general div algorithmn here is about O(N*N) and thus quite slow, so
529*0Sstevel@tonic-gate  # we first check for some special cases and use shortcuts to handle them.
530*0Sstevel@tonic-gate
531*0Sstevel@tonic-gate  # This works, because we store the numbers in a chunked format where each
532*0Sstevel@tonic-gate  # element contains 5..7 digits (depending on system).
533*0Sstevel@tonic-gate
534*0Sstevel@tonic-gate  # if both numbers have only one element:
535*0Sstevel@tonic-gate  if (@$x == 1 && @$yorg == 1)
536*0Sstevel@tonic-gate    {
537*0Sstevel@tonic-gate    # shortcut, $yorg and $x are two small numbers
538*0Sstevel@tonic-gate    if (wantarray)
539*0Sstevel@tonic-gate      {
540*0Sstevel@tonic-gate      my $r = [ $x->[0] % $yorg->[0] ];
541*0Sstevel@tonic-gate      $x->[0] = int($x->[0] / $yorg->[0]);
542*0Sstevel@tonic-gate      return ($x,$r);
543*0Sstevel@tonic-gate      }
544*0Sstevel@tonic-gate    else
545*0Sstevel@tonic-gate      {
546*0Sstevel@tonic-gate      $x->[0] = int($x->[0] / $yorg->[0]);
547*0Sstevel@tonic-gate      return $x;
548*0Sstevel@tonic-gate      }
549*0Sstevel@tonic-gate    }
550*0Sstevel@tonic-gate
551*0Sstevel@tonic-gate  # if x has more than one, but y has only one element:
552*0Sstevel@tonic-gate  if (@$yorg == 1)
553*0Sstevel@tonic-gate    {
554*0Sstevel@tonic-gate    my $rem;
555*0Sstevel@tonic-gate    $rem = _mod($c,[ @$x ],$yorg) if wantarray;
556*0Sstevel@tonic-gate
557*0Sstevel@tonic-gate    # shortcut, $y is < $BASE
558*0Sstevel@tonic-gate    my $j = scalar @$x; my $r = 0;
559*0Sstevel@tonic-gate    my $y = $yorg->[0]; my $b;
560*0Sstevel@tonic-gate    while ($j-- > 0)
561*0Sstevel@tonic-gate      {
562*0Sstevel@tonic-gate      $b = $r * $MBASE + $x->[$j];
563*0Sstevel@tonic-gate      $x->[$j] = int($b/$y);
564*0Sstevel@tonic-gate      $r = $b % $y;
565*0Sstevel@tonic-gate      }
566*0Sstevel@tonic-gate    pop @$x if @$x > 1 && $x->[-1] == 0;	# splice up a leading zero
567*0Sstevel@tonic-gate    return ($x,$rem) if wantarray;
568*0Sstevel@tonic-gate    return $x;
569*0Sstevel@tonic-gate    }
570*0Sstevel@tonic-gate
571*0Sstevel@tonic-gate  # now x and y have more than one element
572*0Sstevel@tonic-gate
573*0Sstevel@tonic-gate  # check whether y has more elements than x, if yet, the result will be 0
574*0Sstevel@tonic-gate  if (@$yorg > @$x)
575*0Sstevel@tonic-gate    {
576*0Sstevel@tonic-gate    my $rem;
577*0Sstevel@tonic-gate    $rem = [@$x] if wantarray;                  # make copy
578*0Sstevel@tonic-gate    splice (@$x,1);                             # keep ref to original array
579*0Sstevel@tonic-gate    $x->[0] = 0;                                # set to 0
580*0Sstevel@tonic-gate    return ($x,$rem) if wantarray;              # including remainder?
581*0Sstevel@tonic-gate    return $x;					# only x, which is [0] now
582*0Sstevel@tonic-gate    }
583*0Sstevel@tonic-gate  # check whether the numbers have the same number of elements, in that case
584*0Sstevel@tonic-gate  # the result will fit into one element and can be computed efficiently
585*0Sstevel@tonic-gate  if (@$yorg == @$x)
586*0Sstevel@tonic-gate    {
587*0Sstevel@tonic-gate    my $rem;
588*0Sstevel@tonic-gate    # if $yorg has more digits than $x (it's leading element is longer than
589*0Sstevel@tonic-gate    # the one from $x), the result will also be 0:
590*0Sstevel@tonic-gate    if (length(int($yorg->[-1])) > length(int($x->[-1])))
591*0Sstevel@tonic-gate      {
592*0Sstevel@tonic-gate      $rem = [@$x] if wantarray;		# make copy
593*0Sstevel@tonic-gate      splice (@$x,1);				# keep ref to org array
594*0Sstevel@tonic-gate      $x->[0] = 0;				# set to 0
595*0Sstevel@tonic-gate      return ($x,$rem) if wantarray;		# including remainder?
596*0Sstevel@tonic-gate      return $x;
597*0Sstevel@tonic-gate      }
598*0Sstevel@tonic-gate    # now calculate $x / $yorg
599*0Sstevel@tonic-gate    if (length(int($yorg->[-1])) == length(int($x->[-1])))
600*0Sstevel@tonic-gate      {
601*0Sstevel@tonic-gate      # same length, so make full compare, and if equal, return 1
602*0Sstevel@tonic-gate      # hm, same lengths, but same contents? So we need to check all parts:
603*0Sstevel@tonic-gate      my $a = 0; my $j = scalar @$x - 1;
604*0Sstevel@tonic-gate      # manual way (abort if unequal, good for early ne)
605*0Sstevel@tonic-gate      while ($j >= 0)
606*0Sstevel@tonic-gate        {
607*0Sstevel@tonic-gate        last if ($a = $x->[$j] - $yorg->[$j]); $j--;
608*0Sstevel@tonic-gate        }
609*0Sstevel@tonic-gate      # $a contains the result of the compare between X and Y
610*0Sstevel@tonic-gate      # a < 0: x < y, a == 0 => x == y, a > 0: x > y
611*0Sstevel@tonic-gate      if ($a <= 0)
612*0Sstevel@tonic-gate        {
613*0Sstevel@tonic-gate        if (wantarray)
614*0Sstevel@tonic-gate	  {
615*0Sstevel@tonic-gate          $rem = [ 0 ];			# a = 0 => x == y => rem 1
616*0Sstevel@tonic-gate          $rem = [@$x] if $a != 0;	# a < 0 => x < y => rem = x
617*0Sstevel@tonic-gate	  }
618*0Sstevel@tonic-gate        splice(@$x,1);			# keep single element
619*0Sstevel@tonic-gate        $x->[0] = 0;			# if $a < 0
620*0Sstevel@tonic-gate        if ($a == 0)
621*0Sstevel@tonic-gate          {
622*0Sstevel@tonic-gate          # $x == $y
623*0Sstevel@tonic-gate          $x->[0] = 1;
624*0Sstevel@tonic-gate          }
625*0Sstevel@tonic-gate        return ($x,$rem) if wantarray;
626*0Sstevel@tonic-gate        return $x;
627*0Sstevel@tonic-gate        }
628*0Sstevel@tonic-gate      # $x >= $y, proceed normally
629*0Sstevel@tonic-gate      }
630*0Sstevel@tonic-gate    }
631*0Sstevel@tonic-gate
632*0Sstevel@tonic-gate  # all other cases:
633*0Sstevel@tonic-gate
634*0Sstevel@tonic-gate  my $y = [ @$yorg ];				# always make copy to preserve
635*0Sstevel@tonic-gate
636*0Sstevel@tonic-gate  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
637*0Sstevel@tonic-gate
638*0Sstevel@tonic-gate  $car = $bar = $prd = 0;
639*0Sstevel@tonic-gate  if (($dd = int($MBASE/($y->[-1]+1))) != 1)
640*0Sstevel@tonic-gate    {
641*0Sstevel@tonic-gate    for $xi (@$x)
642*0Sstevel@tonic-gate      {
643*0Sstevel@tonic-gate      $xi = $xi * $dd + $car;
644*0Sstevel@tonic-gate      $xi -= ($car = int($xi * $RBASE)) * $MBASE;	# see USE_MUL
645*0Sstevel@tonic-gate      }
646*0Sstevel@tonic-gate    push(@$x, $car); $car = 0;
647*0Sstevel@tonic-gate    for $yi (@$y)
648*0Sstevel@tonic-gate      {
649*0Sstevel@tonic-gate      $yi = $yi * $dd + $car;
650*0Sstevel@tonic-gate      $yi -= ($car = int($yi * $RBASE)) * $MBASE;	# see USE_MUL
651*0Sstevel@tonic-gate      }
652*0Sstevel@tonic-gate    }
653*0Sstevel@tonic-gate  else
654*0Sstevel@tonic-gate    {
655*0Sstevel@tonic-gate    push(@$x, 0);
656*0Sstevel@tonic-gate    }
657*0Sstevel@tonic-gate  @q = (); ($v2,$v1) = @$y[-2,-1];
658*0Sstevel@tonic-gate  $v2 = 0 unless $v2;
659*0Sstevel@tonic-gate  while ($#$x > $#$y)
660*0Sstevel@tonic-gate    {
661*0Sstevel@tonic-gate    ($u2,$u1,$u0) = @$x[-3..-1];
662*0Sstevel@tonic-gate    $u2 = 0 unless $u2;
663*0Sstevel@tonic-gate    #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
664*0Sstevel@tonic-gate    # if $v1 == 0;
665*0Sstevel@tonic-gate    $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
666*0Sstevel@tonic-gate    --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2);
667*0Sstevel@tonic-gate    if ($q)
668*0Sstevel@tonic-gate      {
669*0Sstevel@tonic-gate      ($car, $bar) = (0,0);
670*0Sstevel@tonic-gate      for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
671*0Sstevel@tonic-gate        {
672*0Sstevel@tonic-gate        $prd = $q * $y->[$yi] + $car;
673*0Sstevel@tonic-gate        $prd -= ($car = int($prd * $RBASE)) * $MBASE;	# see USE_MUL
674*0Sstevel@tonic-gate	$x->[$xi] += $MBASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
675*0Sstevel@tonic-gate	}
676*0Sstevel@tonic-gate      if ($x->[-1] < $car + $bar)
677*0Sstevel@tonic-gate        {
678*0Sstevel@tonic-gate        $car = 0; --$q;
679*0Sstevel@tonic-gate	for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
680*0Sstevel@tonic-gate          {
681*0Sstevel@tonic-gate	  $x->[$xi] -= $MBASE
682*0Sstevel@tonic-gate	   if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE));
683*0Sstevel@tonic-gate	  }
684*0Sstevel@tonic-gate	}
685*0Sstevel@tonic-gate      }
686*0Sstevel@tonic-gate    pop(@$x);
687*0Sstevel@tonic-gate    unshift(@q, $q);
688*0Sstevel@tonic-gate    }
689*0Sstevel@tonic-gate  if (wantarray)
690*0Sstevel@tonic-gate    {
691*0Sstevel@tonic-gate    @d = ();
692*0Sstevel@tonic-gate    if ($dd != 1)
693*0Sstevel@tonic-gate      {
694*0Sstevel@tonic-gate      $car = 0;
695*0Sstevel@tonic-gate      for $xi (reverse @$x)
696*0Sstevel@tonic-gate        {
697*0Sstevel@tonic-gate        $prd = $car * $MBASE + $xi;
698*0Sstevel@tonic-gate        $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL
699*0Sstevel@tonic-gate        unshift(@d, $tmp);
700*0Sstevel@tonic-gate        }
701*0Sstevel@tonic-gate      }
702*0Sstevel@tonic-gate    else
703*0Sstevel@tonic-gate      {
704*0Sstevel@tonic-gate      @d = @$x;
705*0Sstevel@tonic-gate      }
706*0Sstevel@tonic-gate    @$x = @q;
707*0Sstevel@tonic-gate    my $d = \@d;
708*0Sstevel@tonic-gate    __strip_zeros($x);
709*0Sstevel@tonic-gate    __strip_zeros($d);
710*0Sstevel@tonic-gate    return ($x,$d);
711*0Sstevel@tonic-gate    }
712*0Sstevel@tonic-gate  @$x = @q;
713*0Sstevel@tonic-gate  __strip_zeros($x);
714*0Sstevel@tonic-gate  $x;
715*0Sstevel@tonic-gate  }
716*0Sstevel@tonic-gate
717*0Sstevel@tonic-gatesub _div_use_div
718*0Sstevel@tonic-gate  {
719*0Sstevel@tonic-gate  # ref to array, ref to array, modify first array and return remainder if
720*0Sstevel@tonic-gate  # in list context
721*0Sstevel@tonic-gate  my ($c,$x,$yorg) = @_;
722*0Sstevel@tonic-gate
723*0Sstevel@tonic-gate  # the general div algorithmn here is about O(N*N) and thus quite slow, so
724*0Sstevel@tonic-gate  # we first check for some special cases and use shortcuts to handle them.
725*0Sstevel@tonic-gate
726*0Sstevel@tonic-gate  # This works, because we store the numbers in a chunked format where each
727*0Sstevel@tonic-gate  # element contains 5..7 digits (depending on system).
728*0Sstevel@tonic-gate
729*0Sstevel@tonic-gate  # if both numbers have only one element:
730*0Sstevel@tonic-gate  if (@$x == 1 && @$yorg == 1)
731*0Sstevel@tonic-gate    {
732*0Sstevel@tonic-gate    # shortcut, $yorg and $x are two small numbers
733*0Sstevel@tonic-gate    if (wantarray)
734*0Sstevel@tonic-gate      {
735*0Sstevel@tonic-gate      my $r = [ $x->[0] % $yorg->[0] ];
736*0Sstevel@tonic-gate      $x->[0] = int($x->[0] / $yorg->[0]);
737*0Sstevel@tonic-gate      return ($x,$r);
738*0Sstevel@tonic-gate      }
739*0Sstevel@tonic-gate    else
740*0Sstevel@tonic-gate      {
741*0Sstevel@tonic-gate      $x->[0] = int($x->[0] / $yorg->[0]);
742*0Sstevel@tonic-gate      return $x;
743*0Sstevel@tonic-gate      }
744*0Sstevel@tonic-gate    }
745*0Sstevel@tonic-gate  # if x has more than one, but y has only one element:
746*0Sstevel@tonic-gate  if (@$yorg == 1)
747*0Sstevel@tonic-gate    {
748*0Sstevel@tonic-gate    my $rem;
749*0Sstevel@tonic-gate    $rem = _mod($c,[ @$x ],$yorg) if wantarray;
750*0Sstevel@tonic-gate
751*0Sstevel@tonic-gate    # shortcut, $y is < $BASE
752*0Sstevel@tonic-gate    my $j = scalar @$x; my $r = 0;
753*0Sstevel@tonic-gate    my $y = $yorg->[0]; my $b;
754*0Sstevel@tonic-gate    while ($j-- > 0)
755*0Sstevel@tonic-gate      {
756*0Sstevel@tonic-gate      $b = $r * $MBASE + $x->[$j];
757*0Sstevel@tonic-gate      $x->[$j] = int($b/$y);
758*0Sstevel@tonic-gate      $r = $b % $y;
759*0Sstevel@tonic-gate      }
760*0Sstevel@tonic-gate    pop @$x if @$x > 1 && $x->[-1] == 0;	# splice up a leading zero
761*0Sstevel@tonic-gate    return ($x,$rem) if wantarray;
762*0Sstevel@tonic-gate    return $x;
763*0Sstevel@tonic-gate    }
764*0Sstevel@tonic-gate  # now x and y have more than one element
765*0Sstevel@tonic-gate
766*0Sstevel@tonic-gate  # check whether y has more elements than x, if yet, the result will be 0
767*0Sstevel@tonic-gate  if (@$yorg > @$x)
768*0Sstevel@tonic-gate    {
769*0Sstevel@tonic-gate    my $rem;
770*0Sstevel@tonic-gate    $rem = [@$x] if wantarray;			# make copy
771*0Sstevel@tonic-gate    splice (@$x,1);				# keep ref to original array
772*0Sstevel@tonic-gate    $x->[0] = 0;				# set to 0
773*0Sstevel@tonic-gate    return ($x,$rem) if wantarray;		# including remainder?
774*0Sstevel@tonic-gate    return $x;					# only x, which is [0] now
775*0Sstevel@tonic-gate    }
776*0Sstevel@tonic-gate  # check whether the numbers have the same number of elements, in that case
777*0Sstevel@tonic-gate  # the result will fit into one element and can be computed efficiently
778*0Sstevel@tonic-gate  if (@$yorg == @$x)
779*0Sstevel@tonic-gate    {
780*0Sstevel@tonic-gate    my $rem;
781*0Sstevel@tonic-gate    # if $yorg has more digits than $x (it's leading element is longer than
782*0Sstevel@tonic-gate    # the one from $x), the result will also be 0:
783*0Sstevel@tonic-gate    if (length(int($yorg->[-1])) > length(int($x->[-1])))
784*0Sstevel@tonic-gate      {
785*0Sstevel@tonic-gate      $rem = [@$x] if wantarray;		# make copy
786*0Sstevel@tonic-gate      splice (@$x,1);				# keep ref to org array
787*0Sstevel@tonic-gate      $x->[0] = 0;				# set to 0
788*0Sstevel@tonic-gate      return ($x,$rem) if wantarray;		# including remainder?
789*0Sstevel@tonic-gate      return $x;
790*0Sstevel@tonic-gate      }
791*0Sstevel@tonic-gate    # now calculate $x / $yorg
792*0Sstevel@tonic-gate
793*0Sstevel@tonic-gate    if (length(int($yorg->[-1])) == length(int($x->[-1])))
794*0Sstevel@tonic-gate      {
795*0Sstevel@tonic-gate      # same length, so make full compare, and if equal, return 1
796*0Sstevel@tonic-gate      # hm, same lengths, but same contents? So we need to check all parts:
797*0Sstevel@tonic-gate      my $a = 0; my $j = scalar @$x - 1;
798*0Sstevel@tonic-gate      # manual way (abort if unequal, good for early ne)
799*0Sstevel@tonic-gate      while ($j >= 0)
800*0Sstevel@tonic-gate        {
801*0Sstevel@tonic-gate        last if ($a = $x->[$j] - $yorg->[$j]); $j--;
802*0Sstevel@tonic-gate        }
803*0Sstevel@tonic-gate      # $a contains the result of the compare between X and Y
804*0Sstevel@tonic-gate      # a < 0: x < y, a == 0 => x == y, a > 0: x > y
805*0Sstevel@tonic-gate      if ($a <= 0)
806*0Sstevel@tonic-gate        {
807*0Sstevel@tonic-gate        if (wantarray)
808*0Sstevel@tonic-gate	  {
809*0Sstevel@tonic-gate          $rem = [ 0 ];			# a = 0 => x == y => rem 1
810*0Sstevel@tonic-gate          $rem = [@$x] if $a != 0;	# a < 0 => x < y => rem = x
811*0Sstevel@tonic-gate	  }
812*0Sstevel@tonic-gate        splice(@$x,1);			# keep single element
813*0Sstevel@tonic-gate        $x->[0] = 0;			# if $a < 0
814*0Sstevel@tonic-gate        if ($a == 0)
815*0Sstevel@tonic-gate          {
816*0Sstevel@tonic-gate          # $x == $y
817*0Sstevel@tonic-gate          $x->[0] = 1;
818*0Sstevel@tonic-gate          }
819*0Sstevel@tonic-gate        return ($x,$rem) if wantarray;
820*0Sstevel@tonic-gate        return $x;
821*0Sstevel@tonic-gate        }
822*0Sstevel@tonic-gate      # $x >= $y, so proceed normally
823*0Sstevel@tonic-gate      }
824*0Sstevel@tonic-gate    }
825*0Sstevel@tonic-gate
826*0Sstevel@tonic-gate  # all other cases:
827*0Sstevel@tonic-gate
828*0Sstevel@tonic-gate  my $y = [ @$yorg ];				# always make copy to preserve
829*0Sstevel@tonic-gate
830*0Sstevel@tonic-gate  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
831*0Sstevel@tonic-gate
832*0Sstevel@tonic-gate  $car = $bar = $prd = 0;
833*0Sstevel@tonic-gate  if (($dd = int($MBASE/($y->[-1]+1))) != 1)
834*0Sstevel@tonic-gate    {
835*0Sstevel@tonic-gate    for $xi (@$x)
836*0Sstevel@tonic-gate      {
837*0Sstevel@tonic-gate      $xi = $xi * $dd + $car;
838*0Sstevel@tonic-gate      $xi -= ($car = int($xi / $MBASE)) * $MBASE;
839*0Sstevel@tonic-gate      }
840*0Sstevel@tonic-gate    push(@$x, $car); $car = 0;
841*0Sstevel@tonic-gate    for $yi (@$y)
842*0Sstevel@tonic-gate      {
843*0Sstevel@tonic-gate      $yi = $yi * $dd + $car;
844*0Sstevel@tonic-gate      $yi -= ($car = int($yi / $MBASE)) * $MBASE;
845*0Sstevel@tonic-gate      }
846*0Sstevel@tonic-gate    }
847*0Sstevel@tonic-gate  else
848*0Sstevel@tonic-gate    {
849*0Sstevel@tonic-gate    push(@$x, 0);
850*0Sstevel@tonic-gate    }
851*0Sstevel@tonic-gate
852*0Sstevel@tonic-gate  # @q will accumulate the final result, $q contains the current computed
853*0Sstevel@tonic-gate  # part of the final result
854*0Sstevel@tonic-gate
855*0Sstevel@tonic-gate  @q = (); ($v2,$v1) = @$y[-2,-1];
856*0Sstevel@tonic-gate  $v2 = 0 unless $v2;
857*0Sstevel@tonic-gate  while ($#$x > $#$y)
858*0Sstevel@tonic-gate    {
859*0Sstevel@tonic-gate    ($u2,$u1,$u0) = @$x[-3..-1];
860*0Sstevel@tonic-gate    $u2 = 0 unless $u2;
861*0Sstevel@tonic-gate    #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
862*0Sstevel@tonic-gate    # if $v1 == 0;
863*0Sstevel@tonic-gate    $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
864*0Sstevel@tonic-gate    --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2);
865*0Sstevel@tonic-gate    if ($q)
866*0Sstevel@tonic-gate      {
867*0Sstevel@tonic-gate      ($car, $bar) = (0,0);
868*0Sstevel@tonic-gate      for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
869*0Sstevel@tonic-gate        {
870*0Sstevel@tonic-gate        $prd = $q * $y->[$yi] + $car;
871*0Sstevel@tonic-gate        $prd -= ($car = int($prd / $MBASE)) * $MBASE;
872*0Sstevel@tonic-gate	$x->[$xi] += $MBASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
873*0Sstevel@tonic-gate	}
874*0Sstevel@tonic-gate      if ($x->[-1] < $car + $bar)
875*0Sstevel@tonic-gate        {
876*0Sstevel@tonic-gate        $car = 0; --$q;
877*0Sstevel@tonic-gate	for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
878*0Sstevel@tonic-gate          {
879*0Sstevel@tonic-gate	  $x->[$xi] -= $MBASE
880*0Sstevel@tonic-gate	   if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE));
881*0Sstevel@tonic-gate	  }
882*0Sstevel@tonic-gate	}
883*0Sstevel@tonic-gate      }
884*0Sstevel@tonic-gate    pop(@$x); unshift(@q, $q);
885*0Sstevel@tonic-gate    }
886*0Sstevel@tonic-gate  if (wantarray)
887*0Sstevel@tonic-gate    {
888*0Sstevel@tonic-gate    @d = ();
889*0Sstevel@tonic-gate    if ($dd != 1)
890*0Sstevel@tonic-gate      {
891*0Sstevel@tonic-gate      $car = 0;
892*0Sstevel@tonic-gate      for $xi (reverse @$x)
893*0Sstevel@tonic-gate        {
894*0Sstevel@tonic-gate        $prd = $car * $MBASE + $xi;
895*0Sstevel@tonic-gate        $car = $prd - ($tmp = int($prd / $dd)) * $dd;
896*0Sstevel@tonic-gate        unshift(@d, $tmp);
897*0Sstevel@tonic-gate        }
898*0Sstevel@tonic-gate      }
899*0Sstevel@tonic-gate    else
900*0Sstevel@tonic-gate      {
901*0Sstevel@tonic-gate      @d = @$x;
902*0Sstevel@tonic-gate      }
903*0Sstevel@tonic-gate    @$x = @q;
904*0Sstevel@tonic-gate    my $d = \@d;
905*0Sstevel@tonic-gate    __strip_zeros($x);
906*0Sstevel@tonic-gate    __strip_zeros($d);
907*0Sstevel@tonic-gate    return ($x,$d);
908*0Sstevel@tonic-gate    }
909*0Sstevel@tonic-gate  @$x = @q;
910*0Sstevel@tonic-gate  __strip_zeros($x);
911*0Sstevel@tonic-gate  $x;
912*0Sstevel@tonic-gate  }
913*0Sstevel@tonic-gate
914*0Sstevel@tonic-gate##############################################################################
915*0Sstevel@tonic-gate# testing
916*0Sstevel@tonic-gate
917*0Sstevel@tonic-gatesub _acmp
918*0Sstevel@tonic-gate  {
919*0Sstevel@tonic-gate  # internal absolute post-normalized compare (ignore signs)
920*0Sstevel@tonic-gate  # ref to array, ref to array, return <0, 0, >0
921*0Sstevel@tonic-gate  # arrays must have at least one entry; this is not checked for
922*0Sstevel@tonic-gate  my ($c,$cx,$cy) = @_;
923*0Sstevel@tonic-gate
924*0Sstevel@tonic-gate  # shortcut for short numbers
925*0Sstevel@tonic-gate  return (($cx->[0] <=> $cy->[0]) <=> 0)
926*0Sstevel@tonic-gate   if scalar @$cx == scalar @$cy && scalar @$cx == 1;
927*0Sstevel@tonic-gate
928*0Sstevel@tonic-gate  # fast comp based on number of array elements (aka pseudo-length)
929*0Sstevel@tonic-gate  my $lxy = (scalar @$cx - scalar @$cy)
930*0Sstevel@tonic-gate  # or length of first element if same number of elements (aka difference 0)
931*0Sstevel@tonic-gate    ||
932*0Sstevel@tonic-gate  # need int() here because sometimes the last element is '00018' vs '18'
933*0Sstevel@tonic-gate   (length(int($cx->[-1])) - length(int($cy->[-1])));
934*0Sstevel@tonic-gate  return -1 if $lxy < 0;				# already differs, ret
935*0Sstevel@tonic-gate  return 1 if $lxy > 0;					# ditto
936*0Sstevel@tonic-gate
937*0Sstevel@tonic-gate  # manual way (abort if unequal, good for early ne)
938*0Sstevel@tonic-gate  my $a; my $j = scalar @$cx;
939*0Sstevel@tonic-gate  while (--$j >= 0)
940*0Sstevel@tonic-gate    {
941*0Sstevel@tonic-gate    last if ($a = $cx->[$j] - $cy->[$j]);
942*0Sstevel@tonic-gate    }
943*0Sstevel@tonic-gate  $a <=> 0;
944*0Sstevel@tonic-gate  }
945*0Sstevel@tonic-gate
946*0Sstevel@tonic-gatesub _len
947*0Sstevel@tonic-gate  {
948*0Sstevel@tonic-gate  # compute number of digits
949*0Sstevel@tonic-gate
950*0Sstevel@tonic-gate  # int() because add/sub sometimes leaves strings (like '00005') instead of
951*0Sstevel@tonic-gate  # '5' in this place, thus causing length() to report wrong length
952*0Sstevel@tonic-gate  my $cx = $_[1];
953*0Sstevel@tonic-gate
954*0Sstevel@tonic-gate  (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
955*0Sstevel@tonic-gate  }
956*0Sstevel@tonic-gate
957*0Sstevel@tonic-gatesub _digit
958*0Sstevel@tonic-gate  {
959*0Sstevel@tonic-gate  # return the nth digit, negative values count backward
960*0Sstevel@tonic-gate  # zero is rightmost, so _digit(123,0) will give 3
961*0Sstevel@tonic-gate  my ($c,$x,$n) = @_;
962*0Sstevel@tonic-gate
963*0Sstevel@tonic-gate  my $len = _len('',$x);
964*0Sstevel@tonic-gate
965*0Sstevel@tonic-gate  $n = $len+$n if $n < 0;		# -1 last, -2 second-to-last
966*0Sstevel@tonic-gate  $n = abs($n);				# if negative was too big
967*0Sstevel@tonic-gate  $len--; $n = $len if $n > $len;	# n to big?
968*0Sstevel@tonic-gate
969*0Sstevel@tonic-gate  my $elem = int($n / $BASE_LEN);	# which array element
970*0Sstevel@tonic-gate  my $digit = $n % $BASE_LEN;		# which digit in this element
971*0Sstevel@tonic-gate  $elem = '0000'.@$x[$elem];		# get element padded with 0's
972*0Sstevel@tonic-gate  substr($elem,-$digit-1,1);
973*0Sstevel@tonic-gate  }
974*0Sstevel@tonic-gate
975*0Sstevel@tonic-gatesub _zeros
976*0Sstevel@tonic-gate  {
977*0Sstevel@tonic-gate  # return amount of trailing zeros in decimal
978*0Sstevel@tonic-gate  # check each array elem in _m for having 0 at end as long as elem == 0
979*0Sstevel@tonic-gate  # Upon finding a elem != 0, stop
980*0Sstevel@tonic-gate  my $x = $_[1];
981*0Sstevel@tonic-gate
982*0Sstevel@tonic-gate  return 0 if scalar @$x == 1 && $x->[0] == 0;
983*0Sstevel@tonic-gate
984*0Sstevel@tonic-gate  my $zeros = 0; my $elem;
985*0Sstevel@tonic-gate  foreach my $e (@$x)
986*0Sstevel@tonic-gate    {
987*0Sstevel@tonic-gate    if ($e != 0)
988*0Sstevel@tonic-gate      {
989*0Sstevel@tonic-gate      $elem = "$e";				# preserve x
990*0Sstevel@tonic-gate      $elem =~ s/.*?(0*$)/$1/;			# strip anything not zero
991*0Sstevel@tonic-gate      $zeros *= $BASE_LEN;			# elems * 5
992*0Sstevel@tonic-gate      $zeros += length($elem);			# count trailing zeros
993*0Sstevel@tonic-gate      last;					# early out
994*0Sstevel@tonic-gate      }
995*0Sstevel@tonic-gate    $zeros ++;					# real else branch: 50% slower!
996*0Sstevel@tonic-gate    }
997*0Sstevel@tonic-gate  $zeros;
998*0Sstevel@tonic-gate  }
999*0Sstevel@tonic-gate
1000*0Sstevel@tonic-gate##############################################################################
1001*0Sstevel@tonic-gate# _is_* routines
1002*0Sstevel@tonic-gate
1003*0Sstevel@tonic-gatesub _is_zero
1004*0Sstevel@tonic-gate  {
1005*0Sstevel@tonic-gate  # return true if arg is zero
1006*0Sstevel@tonic-gate  (((scalar @{$_[1]} == 1) && ($_[1]->[0] == 0))) <=> 0;
1007*0Sstevel@tonic-gate  }
1008*0Sstevel@tonic-gate
1009*0Sstevel@tonic-gatesub _is_even
1010*0Sstevel@tonic-gate  {
1011*0Sstevel@tonic-gate  # return true if arg is even
1012*0Sstevel@tonic-gate  (!($_[1]->[0] & 1)) <=> 0;
1013*0Sstevel@tonic-gate  }
1014*0Sstevel@tonic-gate
1015*0Sstevel@tonic-gatesub _is_odd
1016*0Sstevel@tonic-gate  {
1017*0Sstevel@tonic-gate  # return true if arg is even
1018*0Sstevel@tonic-gate  (($_[1]->[0] & 1)) <=> 0;
1019*0Sstevel@tonic-gate  }
1020*0Sstevel@tonic-gate
1021*0Sstevel@tonic-gatesub _is_one
1022*0Sstevel@tonic-gate  {
1023*0Sstevel@tonic-gate  # return true if arg is one
1024*0Sstevel@tonic-gate  (scalar @{$_[1]} == 1) && ($_[1]->[0] == 1) <=> 0;
1025*0Sstevel@tonic-gate  }
1026*0Sstevel@tonic-gate
1027*0Sstevel@tonic-gatesub _is_two
1028*0Sstevel@tonic-gate  {
1029*0Sstevel@tonic-gate  # return true if arg is two
1030*0Sstevel@tonic-gate  (scalar @{$_[1]} == 1) && ($_[1]->[0] == 2) <=> 0;
1031*0Sstevel@tonic-gate  }
1032*0Sstevel@tonic-gate
1033*0Sstevel@tonic-gatesub _is_ten
1034*0Sstevel@tonic-gate  {
1035*0Sstevel@tonic-gate  # return true if arg is ten
1036*0Sstevel@tonic-gate  (scalar @{$_[1]} == 1) && ($_[1]->[0] == 10) <=> 0;
1037*0Sstevel@tonic-gate  }
1038*0Sstevel@tonic-gate
1039*0Sstevel@tonic-gatesub __strip_zeros
1040*0Sstevel@tonic-gate  {
1041*0Sstevel@tonic-gate  # internal normalization function that strips leading zeros from the array
1042*0Sstevel@tonic-gate  # args: ref to array
1043*0Sstevel@tonic-gate  my $s = shift;
1044*0Sstevel@tonic-gate
1045*0Sstevel@tonic-gate  my $cnt = scalar @$s; # get count of parts
1046*0Sstevel@tonic-gate  my $i = $cnt-1;
1047*0Sstevel@tonic-gate  push @$s,0 if $i < 0;		# div might return empty results, so fix it
1048*0Sstevel@tonic-gate
1049*0Sstevel@tonic-gate  return $s if @$s == 1;		# early out
1050*0Sstevel@tonic-gate
1051*0Sstevel@tonic-gate  #print "strip: cnt $cnt i $i\n";
1052*0Sstevel@tonic-gate  # '0', '3', '4', '0', '0',
1053*0Sstevel@tonic-gate  #  0    1    2    3    4
1054*0Sstevel@tonic-gate  # cnt = 5, i = 4
1055*0Sstevel@tonic-gate  # i = 4
1056*0Sstevel@tonic-gate  # i = 3
1057*0Sstevel@tonic-gate  # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
1058*0Sstevel@tonic-gate  # >= 1: skip first part (this can be zero)
1059*0Sstevel@tonic-gate  while ($i > 0) { last if $s->[$i] != 0; $i--; }
1060*0Sstevel@tonic-gate  $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
1061*0Sstevel@tonic-gate  $s;
1062*0Sstevel@tonic-gate  }
1063*0Sstevel@tonic-gate
1064*0Sstevel@tonic-gate###############################################################################
1065*0Sstevel@tonic-gate# check routine to test internal state for corruptions
1066*0Sstevel@tonic-gate
1067*0Sstevel@tonic-gatesub _check
1068*0Sstevel@tonic-gate  {
1069*0Sstevel@tonic-gate  # used by the test suite
1070*0Sstevel@tonic-gate  my $x = $_[1];
1071*0Sstevel@tonic-gate
1072*0Sstevel@tonic-gate  return "$x is not a reference" if !ref($x);
1073*0Sstevel@tonic-gate
1074*0Sstevel@tonic-gate  # are all parts are valid?
1075*0Sstevel@tonic-gate  my $i = 0; my $j = scalar @$x; my ($e,$try);
1076*0Sstevel@tonic-gate  while ($i < $j)
1077*0Sstevel@tonic-gate    {
1078*0Sstevel@tonic-gate    $e = $x->[$i]; $e = 'undef' unless defined $e;
1079*0Sstevel@tonic-gate    $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)";
1080*0Sstevel@tonic-gate    last if $e !~ /^[+]?[0-9]+$/;
1081*0Sstevel@tonic-gate    $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)";
1082*0Sstevel@tonic-gate    last if "$e" !~ /^[+]?[0-9]+$/;
1083*0Sstevel@tonic-gate    $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)";
1084*0Sstevel@tonic-gate    last if '' . "$e" !~ /^[+]?[0-9]+$/;
1085*0Sstevel@tonic-gate    $try = ' < 0 || >= $BASE; '."($x, $e)";
1086*0Sstevel@tonic-gate    last if $e <0 || $e >= $BASE;
1087*0Sstevel@tonic-gate    # this test is disabled, since new/bnorm and certain ops (like early out
1088*0Sstevel@tonic-gate    # in add/sub) are allowed/expected to leave '00000' in some elements
1089*0Sstevel@tonic-gate    #$try = '=~ /^00+/; '."($x, $e)";
1090*0Sstevel@tonic-gate    #last if $e =~ /^00+/;
1091*0Sstevel@tonic-gate    $i++;
1092*0Sstevel@tonic-gate    }
1093*0Sstevel@tonic-gate  return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
1094*0Sstevel@tonic-gate  0;
1095*0Sstevel@tonic-gate  }
1096*0Sstevel@tonic-gate
1097*0Sstevel@tonic-gate
1098*0Sstevel@tonic-gate###############################################################################
1099*0Sstevel@tonic-gate
1100*0Sstevel@tonic-gatesub _mod
1101*0Sstevel@tonic-gate  {
1102*0Sstevel@tonic-gate  # if possible, use mod shortcut
1103*0Sstevel@tonic-gate  my ($c,$x,$yo) = @_;
1104*0Sstevel@tonic-gate
1105*0Sstevel@tonic-gate  # slow way since $y to big
1106*0Sstevel@tonic-gate  if (scalar @$yo > 1)
1107*0Sstevel@tonic-gate    {
1108*0Sstevel@tonic-gate    my ($xo,$rem) = _div($c,$x,$yo);
1109*0Sstevel@tonic-gate    return $rem;
1110*0Sstevel@tonic-gate    }
1111*0Sstevel@tonic-gate
1112*0Sstevel@tonic-gate  my $y = $yo->[0];
1113*0Sstevel@tonic-gate  # both are single element arrays
1114*0Sstevel@tonic-gate  if (scalar @$x == 1)
1115*0Sstevel@tonic-gate    {
1116*0Sstevel@tonic-gate    $x->[0] %= $y;
1117*0Sstevel@tonic-gate    return $x;
1118*0Sstevel@tonic-gate    }
1119*0Sstevel@tonic-gate
1120*0Sstevel@tonic-gate  # @y is a single element, but @x has more than one element
1121*0Sstevel@tonic-gate  my $b = $BASE % $y;
1122*0Sstevel@tonic-gate  if ($b == 0)
1123*0Sstevel@tonic-gate    {
1124*0Sstevel@tonic-gate    # when BASE % Y == 0 then (B * BASE) % Y == 0
1125*0Sstevel@tonic-gate    # (B * BASE) % $y + A % Y => A % Y
1126*0Sstevel@tonic-gate    # so need to consider only last element: O(1)
1127*0Sstevel@tonic-gate    $x->[0] %= $y;
1128*0Sstevel@tonic-gate    }
1129*0Sstevel@tonic-gate  elsif ($b == 1)
1130*0Sstevel@tonic-gate    {
1131*0Sstevel@tonic-gate    # else need to go through all elements: O(N), but loop is a bit simplified
1132*0Sstevel@tonic-gate    my $r = 0;
1133*0Sstevel@tonic-gate    foreach (@$x)
1134*0Sstevel@tonic-gate      {
1135*0Sstevel@tonic-gate      $r = ($r + $_) % $y;		# not much faster, but heh...
1136*0Sstevel@tonic-gate      #$r += $_ % $y; $r %= $y;
1137*0Sstevel@tonic-gate      }
1138*0Sstevel@tonic-gate    $r = 0 if $r == $y;
1139*0Sstevel@tonic-gate    $x->[0] = $r;
1140*0Sstevel@tonic-gate    }
1141*0Sstevel@tonic-gate  else
1142*0Sstevel@tonic-gate    {
1143*0Sstevel@tonic-gate    # else need to go through all elements: O(N)
1144*0Sstevel@tonic-gate    my $r = 0; my $bm = 1;
1145*0Sstevel@tonic-gate    foreach (@$x)
1146*0Sstevel@tonic-gate      {
1147*0Sstevel@tonic-gate      $r = ($_ * $bm + $r) % $y;
1148*0Sstevel@tonic-gate      $bm = ($bm * $b) % $y;
1149*0Sstevel@tonic-gate
1150*0Sstevel@tonic-gate      #$r += ($_ % $y) * $bm;
1151*0Sstevel@tonic-gate      #$bm *= $b;
1152*0Sstevel@tonic-gate      #$bm %= $y;
1153*0Sstevel@tonic-gate      #$r %= $y;
1154*0Sstevel@tonic-gate      }
1155*0Sstevel@tonic-gate    $r = 0 if $r == $y;
1156*0Sstevel@tonic-gate    $x->[0] = $r;
1157*0Sstevel@tonic-gate    }
1158*0Sstevel@tonic-gate  splice (@$x,1);		# keep one element of $x
1159*0Sstevel@tonic-gate  $x;
1160*0Sstevel@tonic-gate  }
1161*0Sstevel@tonic-gate
1162*0Sstevel@tonic-gate##############################################################################
1163*0Sstevel@tonic-gate# shifts
1164*0Sstevel@tonic-gate
1165*0Sstevel@tonic-gatesub _rsft
1166*0Sstevel@tonic-gate  {
1167*0Sstevel@tonic-gate  my ($c,$x,$y,$n) = @_;
1168*0Sstevel@tonic-gate
1169*0Sstevel@tonic-gate  if ($n != 10)
1170*0Sstevel@tonic-gate    {
1171*0Sstevel@tonic-gate    $n = _new($c,$n); return _div($c,$x, _pow($c,$n,$y));
1172*0Sstevel@tonic-gate    }
1173*0Sstevel@tonic-gate
1174*0Sstevel@tonic-gate  # shortcut (faster) for shifting by 10)
1175*0Sstevel@tonic-gate  # multiples of $BASE_LEN
1176*0Sstevel@tonic-gate  my $dst = 0;				# destination
1177*0Sstevel@tonic-gate  my $src = _num($c,$y);		# as normal int
1178*0Sstevel@tonic-gate  my $xlen = (@$x-1)*$BASE_LEN+length(int($x->[-1]));  # len of x in digits
1179*0Sstevel@tonic-gate  if ($src > $xlen or ($src == $xlen and ! defined $x->[1]))
1180*0Sstevel@tonic-gate    {
1181*0Sstevel@tonic-gate    # 12345 67890 shifted right by more than 10 digits => 0
1182*0Sstevel@tonic-gate    splice (@$x,1);                    # leave only one element
1183*0Sstevel@tonic-gate    $x->[0] = 0;                       # set to zero
1184*0Sstevel@tonic-gate    return $x;
1185*0Sstevel@tonic-gate    }
1186*0Sstevel@tonic-gate  my $rem = $src % $BASE_LEN;		# remainder to shift
1187*0Sstevel@tonic-gate  $src = int($src / $BASE_LEN);		# source
1188*0Sstevel@tonic-gate  if ($rem == 0)
1189*0Sstevel@tonic-gate    {
1190*0Sstevel@tonic-gate    splice (@$x,0,$src);		# even faster, 38.4 => 39.3
1191*0Sstevel@tonic-gate    }
1192*0Sstevel@tonic-gate  else
1193*0Sstevel@tonic-gate    {
1194*0Sstevel@tonic-gate    my $len = scalar @$x - $src;	# elems to go
1195*0Sstevel@tonic-gate    my $vd; my $z = '0'x $BASE_LEN;
1196*0Sstevel@tonic-gate    $x->[scalar @$x] = 0;		# avoid || 0 test inside loop
1197*0Sstevel@tonic-gate    while ($dst < $len)
1198*0Sstevel@tonic-gate      {
1199*0Sstevel@tonic-gate      $vd = $z.$x->[$src];
1200*0Sstevel@tonic-gate      $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
1201*0Sstevel@tonic-gate      $src++;
1202*0Sstevel@tonic-gate      $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
1203*0Sstevel@tonic-gate      $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
1204*0Sstevel@tonic-gate      $x->[$dst] = int($vd);
1205*0Sstevel@tonic-gate      $dst++;
1206*0Sstevel@tonic-gate      }
1207*0Sstevel@tonic-gate    splice (@$x,$dst) if $dst > 0;		# kill left-over array elems
1208*0Sstevel@tonic-gate    pop @$x if $x->[-1] == 0 && @$x > 1;	# kill last element if 0
1209*0Sstevel@tonic-gate    } # else rem == 0
1210*0Sstevel@tonic-gate  $x;
1211*0Sstevel@tonic-gate  }
1212*0Sstevel@tonic-gate
1213*0Sstevel@tonic-gatesub _lsft
1214*0Sstevel@tonic-gate  {
1215*0Sstevel@tonic-gate  my ($c,$x,$y,$n) = @_;
1216*0Sstevel@tonic-gate
1217*0Sstevel@tonic-gate  if ($n != 10)
1218*0Sstevel@tonic-gate    {
1219*0Sstevel@tonic-gate    $n = _new($c,$n); return _mul($c,$x, _pow($c,$n,$y));
1220*0Sstevel@tonic-gate    }
1221*0Sstevel@tonic-gate
1222*0Sstevel@tonic-gate  # shortcut (faster) for shifting by 10) since we are in base 10eX
1223*0Sstevel@tonic-gate  # multiples of $BASE_LEN:
1224*0Sstevel@tonic-gate  my $src = scalar @$x;			# source
1225*0Sstevel@tonic-gate  my $len = _num($c,$y);		# shift-len as normal int
1226*0Sstevel@tonic-gate  my $rem = $len % $BASE_LEN;		# remainder to shift
1227*0Sstevel@tonic-gate  my $dst = $src + int($len/$BASE_LEN);	# destination
1228*0Sstevel@tonic-gate  my $vd;				# further speedup
1229*0Sstevel@tonic-gate  $x->[$src] = 0;			# avoid first ||0 for speed
1230*0Sstevel@tonic-gate  my $z = '0' x $BASE_LEN;
1231*0Sstevel@tonic-gate  while ($src >= 0)
1232*0Sstevel@tonic-gate    {
1233*0Sstevel@tonic-gate    $vd = $x->[$src]; $vd = $z.$vd;
1234*0Sstevel@tonic-gate    $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
1235*0Sstevel@tonic-gate    $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
1236*0Sstevel@tonic-gate    $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
1237*0Sstevel@tonic-gate    $x->[$dst] = int($vd);
1238*0Sstevel@tonic-gate    $dst--; $src--;
1239*0Sstevel@tonic-gate    }
1240*0Sstevel@tonic-gate  # set lowest parts to 0
1241*0Sstevel@tonic-gate  while ($dst >= 0) { $x->[$dst--] = 0; }
1242*0Sstevel@tonic-gate  # fix spurios last zero element
1243*0Sstevel@tonic-gate  splice @$x,-1 if $x->[-1] == 0;
1244*0Sstevel@tonic-gate  $x;
1245*0Sstevel@tonic-gate  }
1246*0Sstevel@tonic-gate
1247*0Sstevel@tonic-gatesub _pow
1248*0Sstevel@tonic-gate  {
1249*0Sstevel@tonic-gate  # power of $x to $y
1250*0Sstevel@tonic-gate  # ref to array, ref to array, return ref to array
1251*0Sstevel@tonic-gate  my ($c,$cx,$cy) = @_;
1252*0Sstevel@tonic-gate
1253*0Sstevel@tonic-gate  if (scalar @$cy == 1 && $cy->[0] == 0)
1254*0Sstevel@tonic-gate    {
1255*0Sstevel@tonic-gate    splice (@$cx,1); $cx->[0] = 1;		# y == 0 => x => 1
1256*0Sstevel@tonic-gate    return $cx;
1257*0Sstevel@tonic-gate    }
1258*0Sstevel@tonic-gate  if ((scalar @$cx == 1 && $cx->[0] == 1) ||	#    x == 1
1259*0Sstevel@tonic-gate      (scalar @$cy == 1 && $cy->[0] == 1))	# or y == 1
1260*0Sstevel@tonic-gate    {
1261*0Sstevel@tonic-gate    return $cx;
1262*0Sstevel@tonic-gate    }
1263*0Sstevel@tonic-gate  if (scalar @$cx == 1 && $cx->[0] == 0)
1264*0Sstevel@tonic-gate    {
1265*0Sstevel@tonic-gate    splice (@$cx,1); $cx->[0] = 0;		# 0 ** y => 0 (if not y <= 0)
1266*0Sstevel@tonic-gate    return $cx;
1267*0Sstevel@tonic-gate    }
1268*0Sstevel@tonic-gate
1269*0Sstevel@tonic-gate  my $pow2 = _one();
1270*0Sstevel@tonic-gate
1271*0Sstevel@tonic-gate  my $y_bin = _as_bin($c,$cy); $y_bin =~ s/^0b//;
1272*0Sstevel@tonic-gate  my $len = length($y_bin);
1273*0Sstevel@tonic-gate  while (--$len > 0)
1274*0Sstevel@tonic-gate    {
1275*0Sstevel@tonic-gate    _mul($c,$pow2,$cx) if substr($y_bin,$len,1) eq '1';		# is odd?
1276*0Sstevel@tonic-gate    _mul($c,$cx,$cx);
1277*0Sstevel@tonic-gate    }
1278*0Sstevel@tonic-gate
1279*0Sstevel@tonic-gate  _mul($c,$cx,$pow2);
1280*0Sstevel@tonic-gate  $cx;
1281*0Sstevel@tonic-gate  }
1282*0Sstevel@tonic-gate
1283*0Sstevel@tonic-gatesub _fac
1284*0Sstevel@tonic-gate  {
1285*0Sstevel@tonic-gate  # factorial of $x
1286*0Sstevel@tonic-gate  # ref to array, return ref to array
1287*0Sstevel@tonic-gate  my ($c,$cx) = @_;
1288*0Sstevel@tonic-gate
1289*0Sstevel@tonic-gate  if ((@$cx == 1) && ($cx->[0] <= 2))
1290*0Sstevel@tonic-gate    {
1291*0Sstevel@tonic-gate    $cx->[0] ||= 1;		# 0 => 1, 1 => 1, 2 => 2
1292*0Sstevel@tonic-gate    return $cx;
1293*0Sstevel@tonic-gate    }
1294*0Sstevel@tonic-gate
1295*0Sstevel@tonic-gate  # go forward until $base is exceeded
1296*0Sstevel@tonic-gate  # limit is either $x steps (steps == 100 means a result always too high) or
1297*0Sstevel@tonic-gate  # $base.
1298*0Sstevel@tonic-gate  my $steps = 100; $steps = $cx->[0] if @$cx == 1;
1299*0Sstevel@tonic-gate  my $r = 2; my $cf = 3; my $step = 2; my $last = $r;
1300*0Sstevel@tonic-gate  while ($r*$cf < $BASE && $step < $steps)
1301*0Sstevel@tonic-gate    {
1302*0Sstevel@tonic-gate    $last = $r; $r *= $cf++; $step++;
1303*0Sstevel@tonic-gate    }
1304*0Sstevel@tonic-gate  if ((@$cx == 1) && $step == $cx->[0])
1305*0Sstevel@tonic-gate    {
1306*0Sstevel@tonic-gate    # completely done, so keep reference to $x and return
1307*0Sstevel@tonic-gate    $cx->[0] = $r;
1308*0Sstevel@tonic-gate    return $cx;
1309*0Sstevel@tonic-gate    }
1310*0Sstevel@tonic-gate
1311*0Sstevel@tonic-gate  # now we must do the left over steps
1312*0Sstevel@tonic-gate  my $n;					# steps still to do
1313*0Sstevel@tonic-gate  if (scalar @$cx == 1)
1314*0Sstevel@tonic-gate    {
1315*0Sstevel@tonic-gate    $n = $cx->[0];
1316*0Sstevel@tonic-gate    }
1317*0Sstevel@tonic-gate  else
1318*0Sstevel@tonic-gate    {
1319*0Sstevel@tonic-gate    $n = _copy($c,$cx);
1320*0Sstevel@tonic-gate    }
1321*0Sstevel@tonic-gate
1322*0Sstevel@tonic-gate  $cx->[0] = $last; splice (@$cx,1);		# keep ref to $x
1323*0Sstevel@tonic-gate  my $zero_elements = 0;
1324*0Sstevel@tonic-gate
1325*0Sstevel@tonic-gate  # do left-over steps fit into a scalar?
1326*0Sstevel@tonic-gate  if (ref $n eq 'ARRAY')
1327*0Sstevel@tonic-gate    {
1328*0Sstevel@tonic-gate    # No, so use slower inc() & cmp()
1329*0Sstevel@tonic-gate    $step = [$step];
1330*0Sstevel@tonic-gate    while (_acmp($step,$n) <= 0)
1331*0Sstevel@tonic-gate      {
1332*0Sstevel@tonic-gate      # as soon as the last element of $cx is 0, we split it up and remember
1333*0Sstevel@tonic-gate      # how many zeors we got so far. The reason is that n! will accumulate
1334*0Sstevel@tonic-gate      # zeros at the end rather fast.
1335*0Sstevel@tonic-gate      if ($cx->[0] == 0)
1336*0Sstevel@tonic-gate        {
1337*0Sstevel@tonic-gate        $zero_elements ++; shift @$cx;
1338*0Sstevel@tonic-gate        }
1339*0Sstevel@tonic-gate      _mul($c,$cx,$step); _inc($c,$step);
1340*0Sstevel@tonic-gate      }
1341*0Sstevel@tonic-gate    }
1342*0Sstevel@tonic-gate  else
1343*0Sstevel@tonic-gate    {
1344*0Sstevel@tonic-gate    # Yes, so we can speed it up slightly
1345*0Sstevel@tonic-gate    while ($step <= $n)
1346*0Sstevel@tonic-gate      {
1347*0Sstevel@tonic-gate      # When the last element of $cx is 0, we split it up and remember
1348*0Sstevel@tonic-gate      # how many we got so far. The reason is that n! will accumulate
1349*0Sstevel@tonic-gate      # zeros at the end rather fast.
1350*0Sstevel@tonic-gate      if ($cx->[0] == 0)
1351*0Sstevel@tonic-gate        {
1352*0Sstevel@tonic-gate        $zero_elements ++; shift @$cx;
1353*0Sstevel@tonic-gate        }
1354*0Sstevel@tonic-gate      _mul($c,$cx,[$step]); $step++;
1355*0Sstevel@tonic-gate      }
1356*0Sstevel@tonic-gate    }
1357*0Sstevel@tonic-gate  # multiply in the zeros again
1358*0Sstevel@tonic-gate  while ($zero_elements-- > 0)
1359*0Sstevel@tonic-gate    {
1360*0Sstevel@tonic-gate    unshift @$cx, 0;
1361*0Sstevel@tonic-gate    }
1362*0Sstevel@tonic-gate  $cx;			# return result
1363*0Sstevel@tonic-gate  }
1364*0Sstevel@tonic-gate
1365*0Sstevel@tonic-gate#############################################################################
1366*0Sstevel@tonic-gate
1367*0Sstevel@tonic-gatesub _log_int
1368*0Sstevel@tonic-gate  {
1369*0Sstevel@tonic-gate  # calculate integer log of $x to base $base
1370*0Sstevel@tonic-gate  # ref to array, ref to array - return ref to array
1371*0Sstevel@tonic-gate  my ($c,$x,$base) = @_;
1372*0Sstevel@tonic-gate
1373*0Sstevel@tonic-gate  # X == 0 => NaN
1374*0Sstevel@tonic-gate  return if (scalar @$x == 1 && $x->[0] == 0);
1375*0Sstevel@tonic-gate  # BASE 0 or 1 => NaN
1376*0Sstevel@tonic-gate  return if (scalar @$base == 1 && $base->[0] < 2);
1377*0Sstevel@tonic-gate  my $cmp = _acmp($c,$x,$base); # X == BASE => 1
1378*0Sstevel@tonic-gate  if ($cmp == 0)
1379*0Sstevel@tonic-gate    {
1380*0Sstevel@tonic-gate    splice (@$x,1); $x->[0] = 1;
1381*0Sstevel@tonic-gate    return ($x,1)
1382*0Sstevel@tonic-gate    }
1383*0Sstevel@tonic-gate  # X < BASE
1384*0Sstevel@tonic-gate  if ($cmp < 0)
1385*0Sstevel@tonic-gate    {
1386*0Sstevel@tonic-gate    splice (@$x,1); $x->[0] = 0;
1387*0Sstevel@tonic-gate    return ($x,undef);
1388*0Sstevel@tonic-gate    }
1389*0Sstevel@tonic-gate
1390*0Sstevel@tonic-gate  # this trial multiplication is very fast, even for large counts (like for
1391*0Sstevel@tonic-gate  # 2 ** 1024, since this still requires only 1024 very fast steps
1392*0Sstevel@tonic-gate  # (multiplication of a large number by a very small number is very fast))
1393*0Sstevel@tonic-gate  my $x_org = _copy($c,$x);		# preserve x
1394*0Sstevel@tonic-gate  splice(@$x,1); $x->[0] = 1;		# keep ref to $x
1395*0Sstevel@tonic-gate
1396*0Sstevel@tonic-gate  my $trial = _copy($c,$base);
1397*0Sstevel@tonic-gate
1398*0Sstevel@tonic-gate  # XXX TODO this only works if $base has only one element
1399*0Sstevel@tonic-gate  if (scalar @$base == 1)
1400*0Sstevel@tonic-gate    {
1401*0Sstevel@tonic-gate    # compute int ( length_in_base_10(X) / ( log(base) / log(10) ) )
1402*0Sstevel@tonic-gate    my $len = _len($c,$x_org);
1403*0Sstevel@tonic-gate    my $res = int($len / (log($base->[0]) / log(10))) || 1; # avoid $res == 0
1404*0Sstevel@tonic-gate
1405*0Sstevel@tonic-gate    $x->[0] = $res;
1406*0Sstevel@tonic-gate    $trial = _pow ($c, _copy($c, $base), $x);
1407*0Sstevel@tonic-gate    my $a = _acmp($x,$trial,$x_org);
1408*0Sstevel@tonic-gate    return ($x,1) if $a == 0;
1409*0Sstevel@tonic-gate    # we now know that $res is too small
1410*0Sstevel@tonic-gate    if ($res < 0)
1411*0Sstevel@tonic-gate      {
1412*0Sstevel@tonic-gate      _mul($c,$trial,$base); _add($c, $x, [1]);
1413*0Sstevel@tonic-gate      }
1414*0Sstevel@tonic-gate    else
1415*0Sstevel@tonic-gate      {
1416*0Sstevel@tonic-gate      # or too big
1417*0Sstevel@tonic-gate      _div($c,$trial,$base); _sub($c, $x, [1]);
1418*0Sstevel@tonic-gate      }
1419*0Sstevel@tonic-gate    # did we now get the right result?
1420*0Sstevel@tonic-gate    $a = _acmp($x,$trial,$x_org);
1421*0Sstevel@tonic-gate    return ($x,1) if $a == 0;		# yes, exactly
1422*0Sstevel@tonic-gate    # still too big
1423*0Sstevel@tonic-gate    if ($a > 0)
1424*0Sstevel@tonic-gate      {
1425*0Sstevel@tonic-gate      _div($c,$trial,$base); _sub($c, $x, [1]);
1426*0Sstevel@tonic-gate      }
1427*0Sstevel@tonic-gate    }
1428*0Sstevel@tonic-gate
1429*0Sstevel@tonic-gate  # simple loop that increments $x by two in each step, possible overstepping
1430*0Sstevel@tonic-gate  # the real result by one
1431*0Sstevel@tonic-gate
1432*0Sstevel@tonic-gate  my $a;
1433*0Sstevel@tonic-gate  my $base_mul = _mul($c, _copy($c,$base), $base);
1434*0Sstevel@tonic-gate
1435*0Sstevel@tonic-gate  while (($a = _acmp($c,$trial,$x_org)) < 0)
1436*0Sstevel@tonic-gate    {
1437*0Sstevel@tonic-gate    _mul($c,$trial,$base_mul); _add($c, $x, [2]);
1438*0Sstevel@tonic-gate    }
1439*0Sstevel@tonic-gate
1440*0Sstevel@tonic-gate  my $exact = 1;
1441*0Sstevel@tonic-gate  if ($a > 0)
1442*0Sstevel@tonic-gate    {
1443*0Sstevel@tonic-gate    # overstepped the result
1444*0Sstevel@tonic-gate    _dec($c, $x);
1445*0Sstevel@tonic-gate    _div($c,$trial,$base);
1446*0Sstevel@tonic-gate    $a = _acmp($c,$trial,$x_org);
1447*0Sstevel@tonic-gate    if ($a > 0)
1448*0Sstevel@tonic-gate      {
1449*0Sstevel@tonic-gate      _dec($c, $x);
1450*0Sstevel@tonic-gate      }
1451*0Sstevel@tonic-gate    $exact = 0 if $a != 0;
1452*0Sstevel@tonic-gate    }
1453*0Sstevel@tonic-gate
1454*0Sstevel@tonic-gate  ($x,$exact);				# return result
1455*0Sstevel@tonic-gate  }
1456*0Sstevel@tonic-gate
1457*0Sstevel@tonic-gate# for debugging:
1458*0Sstevel@tonic-gate  use constant DEBUG => 0;
1459*0Sstevel@tonic-gate  my $steps = 0;
1460*0Sstevel@tonic-gate  sub steps { $steps };
1461*0Sstevel@tonic-gate
1462*0Sstevel@tonic-gatesub _sqrt
1463*0Sstevel@tonic-gate  {
1464*0Sstevel@tonic-gate  # square-root of $x in place
1465*0Sstevel@tonic-gate  # Compute a guess of the result (by rule of thumb), then improve it via
1466*0Sstevel@tonic-gate  # Newton's method.
1467*0Sstevel@tonic-gate  my ($c,$x) = @_;
1468*0Sstevel@tonic-gate
1469*0Sstevel@tonic-gate  if (scalar @$x == 1)
1470*0Sstevel@tonic-gate    {
1471*0Sstevel@tonic-gate    # fit's into one Perl scalar, so result can be computed directly
1472*0Sstevel@tonic-gate    $x->[0] = int(sqrt($x->[0]));
1473*0Sstevel@tonic-gate    return $x;
1474*0Sstevel@tonic-gate    }
1475*0Sstevel@tonic-gate  my $y = _copy($c,$x);
1476*0Sstevel@tonic-gate  # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess
1477*0Sstevel@tonic-gate  # since our guess will "grow"
1478*0Sstevel@tonic-gate  my $l = int((_len($c,$x)-1) / 2);
1479*0Sstevel@tonic-gate
1480*0Sstevel@tonic-gate  my $lastelem = $x->[-1];					# for guess
1481*0Sstevel@tonic-gate  my $elems = scalar @$x - 1;
1482*0Sstevel@tonic-gate  # not enough digits, but could have more?
1483*0Sstevel@tonic-gate  if ((length($lastelem) <= 3) && ($elems > 1))
1484*0Sstevel@tonic-gate    {
1485*0Sstevel@tonic-gate    # right-align with zero pad
1486*0Sstevel@tonic-gate    my $len = length($lastelem) & 1;
1487*0Sstevel@tonic-gate    print "$lastelem => " if DEBUG;
1488*0Sstevel@tonic-gate    $lastelem .= substr($x->[-2] . '0' x $BASE_LEN,0,$BASE_LEN);
1489*0Sstevel@tonic-gate    # former odd => make odd again, or former even to even again
1490*0Sstevel@tonic-gate    $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
1491*0Sstevel@tonic-gate    print "$lastelem\n" if DEBUG;
1492*0Sstevel@tonic-gate    }
1493*0Sstevel@tonic-gate
1494*0Sstevel@tonic-gate  # construct $x (instead of _lsft($c,$x,$l,10)
1495*0Sstevel@tonic-gate  my $r = $l % $BASE_LEN;	# 10000 00000 00000 00000 ($BASE_LEN=5)
1496*0Sstevel@tonic-gate  $l = int($l / $BASE_LEN);
1497*0Sstevel@tonic-gate  print "l =  $l " if DEBUG;
1498*0Sstevel@tonic-gate
1499*0Sstevel@tonic-gate  splice @$x,$l;		# keep ref($x), but modify it
1500*0Sstevel@tonic-gate
1501*0Sstevel@tonic-gate  # we make the first part of the guess not '1000...0' but int(sqrt($lastelem))
1502*0Sstevel@tonic-gate  # that gives us:
1503*0Sstevel@tonic-gate  # 14400 00000 => sqrt(14400) => guess first digits to be 120
1504*0Sstevel@tonic-gate  # 144000 000000 => sqrt(144000) => guess 379
1505*0Sstevel@tonic-gate
1506*0Sstevel@tonic-gate  print "$lastelem (elems $elems) => " if DEBUG;
1507*0Sstevel@tonic-gate  $lastelem = $lastelem / 10 if ($elems & 1 == 1);		# odd or even?
1508*0Sstevel@tonic-gate  my $g = sqrt($lastelem); $g =~ s/\.//;			# 2.345 => 2345
1509*0Sstevel@tonic-gate  $r -= 1 if $elems & 1 == 0;					# 70 => 7
1510*0Sstevel@tonic-gate
1511*0Sstevel@tonic-gate  # padd with zeros if result is too short
1512*0Sstevel@tonic-gate  $x->[$l--] = int(substr($g . '0' x $r,0,$r+1));
1513*0Sstevel@tonic-gate  print "now ",$x->[-1] if DEBUG;
1514*0Sstevel@tonic-gate  print " would have been ", int('1' . '0' x $r),"\n" if DEBUG;
1515*0Sstevel@tonic-gate
1516*0Sstevel@tonic-gate  # If @$x > 1, we could compute the second elem of the guess, too, to create
1517*0Sstevel@tonic-gate  # an even better guess. Not implemented yet. Does it improve performance?
1518*0Sstevel@tonic-gate  $x->[$l--] = 0 while ($l >= 0);	# all other digits of guess are zero
1519*0Sstevel@tonic-gate
1520*0Sstevel@tonic-gate  print "start x= ",_str($c,$x),"\n" if DEBUG;
1521*0Sstevel@tonic-gate  my $two = _two();
1522*0Sstevel@tonic-gate  my $last = _zero();
1523*0Sstevel@tonic-gate  my $lastlast = _zero();
1524*0Sstevel@tonic-gate  $steps = 0 if DEBUG;
1525*0Sstevel@tonic-gate  while (_acmp($c,$last,$x) != 0 && _acmp($c,$lastlast,$x) != 0)
1526*0Sstevel@tonic-gate    {
1527*0Sstevel@tonic-gate    $steps++ if DEBUG;
1528*0Sstevel@tonic-gate    $lastlast = _copy($c,$last);
1529*0Sstevel@tonic-gate    $last = _copy($c,$x);
1530*0Sstevel@tonic-gate    _add($c,$x, _div($c,_copy($c,$y),$x));
1531*0Sstevel@tonic-gate    _div($c,$x, $two );
1532*0Sstevel@tonic-gate    print " x= ",_str($c,$x),"\n" if DEBUG;
1533*0Sstevel@tonic-gate    }
1534*0Sstevel@tonic-gate  print "\nsteps in sqrt: $steps, " if DEBUG;
1535*0Sstevel@tonic-gate  _dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0;	# overshot?
1536*0Sstevel@tonic-gate  print " final ",$x->[-1],"\n" if DEBUG;
1537*0Sstevel@tonic-gate  $x;
1538*0Sstevel@tonic-gate  }
1539*0Sstevel@tonic-gate
1540*0Sstevel@tonic-gatesub _root
1541*0Sstevel@tonic-gate  {
1542*0Sstevel@tonic-gate  # take n'th root of $x in place (n >= 3)
1543*0Sstevel@tonic-gate  my ($c,$x,$n) = @_;
1544*0Sstevel@tonic-gate
1545*0Sstevel@tonic-gate  if (scalar @$x == 1)
1546*0Sstevel@tonic-gate    {
1547*0Sstevel@tonic-gate    if (scalar @$n > 1)
1548*0Sstevel@tonic-gate      {
1549*0Sstevel@tonic-gate      # result will always be smaller than 2 so trunc to 1 at once
1550*0Sstevel@tonic-gate      $x->[0] = 1;
1551*0Sstevel@tonic-gate      }
1552*0Sstevel@tonic-gate    else
1553*0Sstevel@tonic-gate      {
1554*0Sstevel@tonic-gate      # fit's into one Perl scalar, so result can be computed directly
1555*0Sstevel@tonic-gate      # cannot use int() here, because it rounds wrongly (try
1556*0Sstevel@tonic-gate      # (81 ** 3) ** (1/3) to see what I mean)
1557*0Sstevel@tonic-gate      #$x->[0] = int( $x->[0] ** (1 / $n->[0]) );
1558*0Sstevel@tonic-gate      # round to 8 digits, then truncate result to integer
1559*0Sstevel@tonic-gate      $x->[0] = int ( sprintf ("%.8f", $x->[0] ** (1 / $n->[0]) ) );
1560*0Sstevel@tonic-gate      }
1561*0Sstevel@tonic-gate    return $x;
1562*0Sstevel@tonic-gate    }
1563*0Sstevel@tonic-gate
1564*0Sstevel@tonic-gate  # we know now that X is more than one element long
1565*0Sstevel@tonic-gate
1566*0Sstevel@tonic-gate  # if $n is a power of two, we can repeatedly take sqrt($X) and find the
1567*0Sstevel@tonic-gate  # proper result, because sqrt(sqrt($x)) == root($x,4)
1568*0Sstevel@tonic-gate  my $b = _as_bin($c,$n);
1569*0Sstevel@tonic-gate  if ($b =~ /0b1(0+)$/)
1570*0Sstevel@tonic-gate    {
1571*0Sstevel@tonic-gate    my $count = CORE::length($1);	# 0b100 => len('00') => 2
1572*0Sstevel@tonic-gate    my $cnt = $count;			# counter for loop
1573*0Sstevel@tonic-gate    unshift (@$x, 0);			# add one element, together with one
1574*0Sstevel@tonic-gate					# more below in the loop this makes 2
1575*0Sstevel@tonic-gate    while ($cnt-- > 0)
1576*0Sstevel@tonic-gate      {
1577*0Sstevel@tonic-gate      # 'inflate' $X by adding one element, basically computing
1578*0Sstevel@tonic-gate      # $x * $BASE * $BASE. This gives us more $BASE_LEN digits for result
1579*0Sstevel@tonic-gate      # since len(sqrt($X)) approx == len($x) / 2.
1580*0Sstevel@tonic-gate      unshift (@$x, 0);
1581*0Sstevel@tonic-gate      # calculate sqrt($x), $x is now one element to big, again. In the next
1582*0Sstevel@tonic-gate      # round we make that two, again.
1583*0Sstevel@tonic-gate      _sqrt($c,$x);
1584*0Sstevel@tonic-gate      }
1585*0Sstevel@tonic-gate    # $x is now one element to big, so truncate result by removing it
1586*0Sstevel@tonic-gate    splice (@$x,0,1);
1587*0Sstevel@tonic-gate    }
1588*0Sstevel@tonic-gate  else
1589*0Sstevel@tonic-gate    {
1590*0Sstevel@tonic-gate    # trial computation by starting with 2,4,8,16 etc until we overstep
1591*0Sstevel@tonic-gate    my $step;
1592*0Sstevel@tonic-gate    my $trial = _two();
1593*0Sstevel@tonic-gate
1594*0Sstevel@tonic-gate    # while still to do more than X steps
1595*0Sstevel@tonic-gate    do
1596*0Sstevel@tonic-gate      {
1597*0Sstevel@tonic-gate      $step = _two();
1598*0Sstevel@tonic-gate      while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0)
1599*0Sstevel@tonic-gate        {
1600*0Sstevel@tonic-gate        _mul ($c, $step, [2]);
1601*0Sstevel@tonic-gate        _add ($c, $trial, $step);
1602*0Sstevel@tonic-gate        }
1603*0Sstevel@tonic-gate
1604*0Sstevel@tonic-gate      # hit exactly?
1605*0Sstevel@tonic-gate      if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) == 0)
1606*0Sstevel@tonic-gate        {
1607*0Sstevel@tonic-gate        @$x = @$trial;			# make copy while preserving ref to $x
1608*0Sstevel@tonic-gate        return $x;
1609*0Sstevel@tonic-gate        }
1610*0Sstevel@tonic-gate      # overstepped, so go back on step
1611*0Sstevel@tonic-gate      _sub($c, $trial, $step);
1612*0Sstevel@tonic-gate      } while (scalar @$step > 1 || $step->[0] > 128);
1613*0Sstevel@tonic-gate
1614*0Sstevel@tonic-gate    # reset step to 2
1615*0Sstevel@tonic-gate    $step = _two();
1616*0Sstevel@tonic-gate    # add two, because $trial cannot be exactly the result (otherwise we would
1617*0Sstevel@tonic-gate    # alrady have found it)
1618*0Sstevel@tonic-gate    _add($c, $trial, $step);
1619*0Sstevel@tonic-gate
1620*0Sstevel@tonic-gate    # and now add more and more (2,4,6,8,10 etc)
1621*0Sstevel@tonic-gate    while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0)
1622*0Sstevel@tonic-gate      {
1623*0Sstevel@tonic-gate      _add ($c, $trial, $step);
1624*0Sstevel@tonic-gate      }
1625*0Sstevel@tonic-gate
1626*0Sstevel@tonic-gate    # hit not exactly? (overstepped)
1627*0Sstevel@tonic-gate    if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0)
1628*0Sstevel@tonic-gate      {
1629*0Sstevel@tonic-gate      _dec($c,$trial);
1630*0Sstevel@tonic-gate      }
1631*0Sstevel@tonic-gate
1632*0Sstevel@tonic-gate    # hit not exactly? (overstepped)
1633*0Sstevel@tonic-gate    # 80 too small, 81 slightly too big, 82 too big
1634*0Sstevel@tonic-gate    if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0)
1635*0Sstevel@tonic-gate      {
1636*0Sstevel@tonic-gate      _dec ($c, $trial);
1637*0Sstevel@tonic-gate      }
1638*0Sstevel@tonic-gate
1639*0Sstevel@tonic-gate    @$x = @$trial;			# make copy while preserving ref to $x
1640*0Sstevel@tonic-gate    return $x;
1641*0Sstevel@tonic-gate    }
1642*0Sstevel@tonic-gate  $x;
1643*0Sstevel@tonic-gate  }
1644*0Sstevel@tonic-gate
1645*0Sstevel@tonic-gate##############################################################################
1646*0Sstevel@tonic-gate# binary stuff
1647*0Sstevel@tonic-gate
1648*0Sstevel@tonic-gatesub _and
1649*0Sstevel@tonic-gate  {
1650*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
1651*0Sstevel@tonic-gate
1652*0Sstevel@tonic-gate  # the shortcut makes equal, large numbers _really_ fast, and makes only a
1653*0Sstevel@tonic-gate  # very small performance drop for small numbers (e.g. something with less
1654*0Sstevel@tonic-gate  # than 32 bit) Since we optimize for large numbers, this is enabled.
1655*0Sstevel@tonic-gate  return $x if _acmp($c,$x,$y) == 0;		# shortcut
1656*0Sstevel@tonic-gate
1657*0Sstevel@tonic-gate  my $m = _one(); my ($xr,$yr);
1658*0Sstevel@tonic-gate  my $mask = $AND_MASK;
1659*0Sstevel@tonic-gate
1660*0Sstevel@tonic-gate  my $x1 = $x;
1661*0Sstevel@tonic-gate  my $y1 = _copy($c,$y);			# make copy
1662*0Sstevel@tonic-gate  $x = _zero();
1663*0Sstevel@tonic-gate  my ($b,$xrr,$yrr);
1664*0Sstevel@tonic-gate  use integer;
1665*0Sstevel@tonic-gate  while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
1666*0Sstevel@tonic-gate    {
1667*0Sstevel@tonic-gate    ($x1, $xr) = _div($c,$x1,$mask);
1668*0Sstevel@tonic-gate    ($y1, $yr) = _div($c,$y1,$mask);
1669*0Sstevel@tonic-gate
1670*0Sstevel@tonic-gate    # make ints() from $xr, $yr
1671*0Sstevel@tonic-gate    # this is when the AND_BITS are greater than $BASE and is slower for
1672*0Sstevel@tonic-gate    # small (<256 bits) numbers, but faster for large numbers. Disabled
1673*0Sstevel@tonic-gate    # due to KISS principle
1674*0Sstevel@tonic-gate
1675*0Sstevel@tonic-gate#    $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
1676*0Sstevel@tonic-gate#    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
1677*0Sstevel@tonic-gate#    _add($c,$x, _mul($c, _new( $c, ($xrr & $yrr) ), $m) );
1678*0Sstevel@tonic-gate
1679*0Sstevel@tonic-gate    # 0+ due to '&' doesn't work in strings
1680*0Sstevel@tonic-gate    _add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) );
1681*0Sstevel@tonic-gate    _mul($c,$m,$mask);
1682*0Sstevel@tonic-gate    }
1683*0Sstevel@tonic-gate  $x;
1684*0Sstevel@tonic-gate  }
1685*0Sstevel@tonic-gate
1686*0Sstevel@tonic-gatesub _xor
1687*0Sstevel@tonic-gate  {
1688*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
1689*0Sstevel@tonic-gate
1690*0Sstevel@tonic-gate  return _zero() if _acmp($c,$x,$y) == 0;	# shortcut (see -and)
1691*0Sstevel@tonic-gate
1692*0Sstevel@tonic-gate  my $m = _one(); my ($xr,$yr);
1693*0Sstevel@tonic-gate  my $mask = $XOR_MASK;
1694*0Sstevel@tonic-gate
1695*0Sstevel@tonic-gate  my $x1 = $x;
1696*0Sstevel@tonic-gate  my $y1 = _copy($c,$y);			# make copy
1697*0Sstevel@tonic-gate  $x = _zero();
1698*0Sstevel@tonic-gate  my ($b,$xrr,$yrr);
1699*0Sstevel@tonic-gate  use integer;
1700*0Sstevel@tonic-gate  while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
1701*0Sstevel@tonic-gate    {
1702*0Sstevel@tonic-gate    ($x1, $xr) = _div($c,$x1,$mask);
1703*0Sstevel@tonic-gate    ($y1, $yr) = _div($c,$y1,$mask);
1704*0Sstevel@tonic-gate    # make ints() from $xr, $yr (see _and())
1705*0Sstevel@tonic-gate    #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
1706*0Sstevel@tonic-gate    #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
1707*0Sstevel@tonic-gate    #_add($c,$x, _mul($c, _new( $c, ($xrr ^ $yrr) ), $m) );
1708*0Sstevel@tonic-gate
1709*0Sstevel@tonic-gate    # 0+ due to '^' doesn't work in strings
1710*0Sstevel@tonic-gate    _add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) );
1711*0Sstevel@tonic-gate    _mul($c,$m,$mask);
1712*0Sstevel@tonic-gate    }
1713*0Sstevel@tonic-gate  # the loop stops when the shorter of the two numbers is exhausted
1714*0Sstevel@tonic-gate  # the remainder of the longer one will survive bit-by-bit, so we simple
1715*0Sstevel@tonic-gate  # multiply-add it in
1716*0Sstevel@tonic-gate  _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1);
1717*0Sstevel@tonic-gate  _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1);
1718*0Sstevel@tonic-gate
1719*0Sstevel@tonic-gate  $x;
1720*0Sstevel@tonic-gate  }
1721*0Sstevel@tonic-gate
1722*0Sstevel@tonic-gatesub _or
1723*0Sstevel@tonic-gate  {
1724*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
1725*0Sstevel@tonic-gate
1726*0Sstevel@tonic-gate  return $x if _acmp($c,$x,$y) == 0;		# shortcut (see _and)
1727*0Sstevel@tonic-gate
1728*0Sstevel@tonic-gate  my $m = _one(); my ($xr,$yr);
1729*0Sstevel@tonic-gate  my $mask = $OR_MASK;
1730*0Sstevel@tonic-gate
1731*0Sstevel@tonic-gate  my $x1 = $x;
1732*0Sstevel@tonic-gate  my $y1 = _copy($c,$y);			# make copy
1733*0Sstevel@tonic-gate  $x = _zero();
1734*0Sstevel@tonic-gate  my ($b,$xrr,$yrr);
1735*0Sstevel@tonic-gate  use integer;
1736*0Sstevel@tonic-gate  while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
1737*0Sstevel@tonic-gate    {
1738*0Sstevel@tonic-gate    ($x1, $xr) = _div($c,$x1,$mask);
1739*0Sstevel@tonic-gate    ($y1, $yr) = _div($c,$y1,$mask);
1740*0Sstevel@tonic-gate    # make ints() from $xr, $yr (see _and())
1741*0Sstevel@tonic-gate#    $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
1742*0Sstevel@tonic-gate#    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
1743*0Sstevel@tonic-gate#    _add($c,$x, _mul($c, _new( $c, ($xrr | $yrr) ), $m) );
1744*0Sstevel@tonic-gate
1745*0Sstevel@tonic-gate    # 0+ due to '|' doesn't work in strings
1746*0Sstevel@tonic-gate    _add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) );
1747*0Sstevel@tonic-gate    _mul($c,$m,$mask);
1748*0Sstevel@tonic-gate    }
1749*0Sstevel@tonic-gate  # the loop stops when the shorter of the two numbers is exhausted
1750*0Sstevel@tonic-gate  # the remainder of the longer one will survive bit-by-bit, so we simple
1751*0Sstevel@tonic-gate  # multiply-add it in
1752*0Sstevel@tonic-gate  _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1);
1753*0Sstevel@tonic-gate  _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1);
1754*0Sstevel@tonic-gate
1755*0Sstevel@tonic-gate  $x;
1756*0Sstevel@tonic-gate  }
1757*0Sstevel@tonic-gate
1758*0Sstevel@tonic-gatesub _as_hex
1759*0Sstevel@tonic-gate  {
1760*0Sstevel@tonic-gate  # convert a decimal number to hex (ref to array, return ref to string)
1761*0Sstevel@tonic-gate  my ($c,$x) = @_;
1762*0Sstevel@tonic-gate
1763*0Sstevel@tonic-gate  # fit's into one element (handle also 0x0 case)
1764*0Sstevel@tonic-gate  if (@$x == 1)
1765*0Sstevel@tonic-gate    {
1766*0Sstevel@tonic-gate    my $t = sprintf("0x%x",$x->[0]);
1767*0Sstevel@tonic-gate    return $t;
1768*0Sstevel@tonic-gate    }
1769*0Sstevel@tonic-gate
1770*0Sstevel@tonic-gate  my $x1 = _copy($c,$x);
1771*0Sstevel@tonic-gate
1772*0Sstevel@tonic-gate  my $es = '';
1773*0Sstevel@tonic-gate  my ($xr, $h, $x10000);
1774*0Sstevel@tonic-gate  if ($] >= 5.006)
1775*0Sstevel@tonic-gate    {
1776*0Sstevel@tonic-gate    $x10000 = [ 0x10000 ]; $h = 'h4';
1777*0Sstevel@tonic-gate    }
1778*0Sstevel@tonic-gate  else
1779*0Sstevel@tonic-gate    {
1780*0Sstevel@tonic-gate    $x10000 = [ 0x1000 ]; $h = 'h3';
1781*0Sstevel@tonic-gate    }
1782*0Sstevel@tonic-gate  # while (! _is_zero($c,$x1))
1783*0Sstevel@tonic-gate  while (@$x1 != 1 || $x1->[0] != 0)		# _is_zero()
1784*0Sstevel@tonic-gate    {
1785*0Sstevel@tonic-gate    ($x1, $xr) = _div($c,$x1,$x10000);
1786*0Sstevel@tonic-gate    $es .= unpack($h,pack('v',$xr->[0]));	# XXX TODO: why pack('v',...)?
1787*0Sstevel@tonic-gate    }
1788*0Sstevel@tonic-gate  $es = reverse $es;
1789*0Sstevel@tonic-gate  $es =~ s/^[0]+//;   # strip leading zeros
1790*0Sstevel@tonic-gate  $es = '0x' . $es;
1791*0Sstevel@tonic-gate  $es;
1792*0Sstevel@tonic-gate  }
1793*0Sstevel@tonic-gate
1794*0Sstevel@tonic-gatesub _as_bin
1795*0Sstevel@tonic-gate  {
1796*0Sstevel@tonic-gate  # convert a decimal number to bin (ref to array, return ref to string)
1797*0Sstevel@tonic-gate  my ($c,$x) = @_;
1798*0Sstevel@tonic-gate
1799*0Sstevel@tonic-gate  # fit's into one element (and Perl recent enough), handle also 0b0 case
1800*0Sstevel@tonic-gate  # handle zero case for older Perls
1801*0Sstevel@tonic-gate  if ($] <= 5.005 && @$x == 1 && $x->[0] == 0)
1802*0Sstevel@tonic-gate    {
1803*0Sstevel@tonic-gate    my $t = '0b0'; return $t;
1804*0Sstevel@tonic-gate    }
1805*0Sstevel@tonic-gate  if (@$x == 1 && $] >= 5.006)
1806*0Sstevel@tonic-gate    {
1807*0Sstevel@tonic-gate    my $t = sprintf("0b%b",$x->[0]);
1808*0Sstevel@tonic-gate    return $t;
1809*0Sstevel@tonic-gate    }
1810*0Sstevel@tonic-gate  my $x1 = _copy($c,$x);
1811*0Sstevel@tonic-gate
1812*0Sstevel@tonic-gate  my $es = '';
1813*0Sstevel@tonic-gate  my ($xr, $b, $x10000);
1814*0Sstevel@tonic-gate  if ($] >= 5.006)
1815*0Sstevel@tonic-gate    {
1816*0Sstevel@tonic-gate    $x10000 = [ 0x10000 ]; $b = 'b16';
1817*0Sstevel@tonic-gate    }
1818*0Sstevel@tonic-gate  else
1819*0Sstevel@tonic-gate    {
1820*0Sstevel@tonic-gate    $x10000 = [ 0x1000 ]; $b = 'b12';
1821*0Sstevel@tonic-gate    }
1822*0Sstevel@tonic-gate  # while (! _is_zero($c,$x1))
1823*0Sstevel@tonic-gate  while (!(@$x1 == 1 && $x1->[0] == 0))		# _is_zero()
1824*0Sstevel@tonic-gate    {
1825*0Sstevel@tonic-gate    ($x1, $xr) = _div($c,$x1,$x10000);
1826*0Sstevel@tonic-gate    $es .= unpack($b,pack('v',$xr->[0]));	# XXX TODO: why pack('v',...)?
1827*0Sstevel@tonic-gate    # $es .= unpack($b,$xr->[0]);
1828*0Sstevel@tonic-gate    }
1829*0Sstevel@tonic-gate  $es = reverse $es;
1830*0Sstevel@tonic-gate  $es =~ s/^[0]+//;   # strip leading zeros
1831*0Sstevel@tonic-gate  $es = '0b' . $es;
1832*0Sstevel@tonic-gate  $es;
1833*0Sstevel@tonic-gate  }
1834*0Sstevel@tonic-gate
1835*0Sstevel@tonic-gatesub _from_hex
1836*0Sstevel@tonic-gate  {
1837*0Sstevel@tonic-gate  # convert a hex number to decimal (ref to string, return ref to array)
1838*0Sstevel@tonic-gate  my ($c,$hs) = @_;
1839*0Sstevel@tonic-gate
1840*0Sstevel@tonic-gate  my $mul = _one();
1841*0Sstevel@tonic-gate  my $m = [ 0x10000 ];				# 16 bit at a time
1842*0Sstevel@tonic-gate  my $x = _zero();
1843*0Sstevel@tonic-gate
1844*0Sstevel@tonic-gate  my $len = length($hs)-2;
1845*0Sstevel@tonic-gate  $len = int($len/4);				# 4-digit parts, w/o '0x'
1846*0Sstevel@tonic-gate  my $val; my $i = -4;
1847*0Sstevel@tonic-gate  while ($len >= 0)
1848*0Sstevel@tonic-gate    {
1849*0Sstevel@tonic-gate    $val = substr($hs,$i,4);
1850*0Sstevel@tonic-gate    $val =~ s/^[+-]?0x// if $len == 0;		# for last part only because
1851*0Sstevel@tonic-gate    $val = hex($val);				# hex does not like wrong chars
1852*0Sstevel@tonic-gate    $i -= 4; $len --;
1853*0Sstevel@tonic-gate    _add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0;
1854*0Sstevel@tonic-gate    _mul ($c, $mul, $m ) if $len >= 0; 		# skip last mul
1855*0Sstevel@tonic-gate    }
1856*0Sstevel@tonic-gate  $x;
1857*0Sstevel@tonic-gate  }
1858*0Sstevel@tonic-gate
1859*0Sstevel@tonic-gatesub _from_bin
1860*0Sstevel@tonic-gate  {
1861*0Sstevel@tonic-gate  # convert a hex number to decimal (ref to string, return ref to array)
1862*0Sstevel@tonic-gate  my ($c,$bs) = @_;
1863*0Sstevel@tonic-gate
1864*0Sstevel@tonic-gate  # instead of converting X (8) bit at a time, it is faster to "convert" the
1865*0Sstevel@tonic-gate  # number to hex, and then call _from_hex.
1866*0Sstevel@tonic-gate
1867*0Sstevel@tonic-gate  my $hs = $bs;
1868*0Sstevel@tonic-gate  $hs =~ s/^[+-]?0b//;					# remove sign and 0b
1869*0Sstevel@tonic-gate  my $l = length($hs);					# bits
1870*0Sstevel@tonic-gate  $hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0;	# padd left side w/ 0
1871*0Sstevel@tonic-gate  my $h = unpack('H*', pack ('B*', $hs));		# repack as hex
1872*0Sstevel@tonic-gate
1873*0Sstevel@tonic-gate  $c->_from_hex('0x'.$h);
1874*0Sstevel@tonic-gate  }
1875*0Sstevel@tonic-gate
1876*0Sstevel@tonic-gate##############################################################################
1877*0Sstevel@tonic-gate# special modulus functions
1878*0Sstevel@tonic-gate
1879*0Sstevel@tonic-gatesub _modinv
1880*0Sstevel@tonic-gate  {
1881*0Sstevel@tonic-gate  # modular inverse
1882*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
1883*0Sstevel@tonic-gate
1884*0Sstevel@tonic-gate  my $u = _zero($c); my $u1 = _one($c);
1885*0Sstevel@tonic-gate  my $a = _copy($c,$y); my $b = _copy($c,$x);
1886*0Sstevel@tonic-gate
1887*0Sstevel@tonic-gate  # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the
1888*0Sstevel@tonic-gate  # result ($u) at the same time. See comments in BigInt for why this works.
1889*0Sstevel@tonic-gate  my $q;
1890*0Sstevel@tonic-gate  ($a, $q, $b) = ($b, _div($c,$a,$b));		# step 1
1891*0Sstevel@tonic-gate  my $sign = 1;
1892*0Sstevel@tonic-gate  while (!_is_zero($c,$b))
1893*0Sstevel@tonic-gate    {
1894*0Sstevel@tonic-gate    my $t = _add($c, 				# step 2:
1895*0Sstevel@tonic-gate       _mul($c,_copy($c,$u1), $q) ,		#  t =  u1 * q
1896*0Sstevel@tonic-gate       $u );					#     + u
1897*0Sstevel@tonic-gate    $u = $u1;					#  u = u1, u1 = t
1898*0Sstevel@tonic-gate    $u1 = $t;
1899*0Sstevel@tonic-gate    $sign = -$sign;
1900*0Sstevel@tonic-gate    ($a, $q, $b) = ($b, _div($c,$a,$b));	# step 1
1901*0Sstevel@tonic-gate    }
1902*0Sstevel@tonic-gate
1903*0Sstevel@tonic-gate  # if the gcd is not 1, then return NaN
1904*0Sstevel@tonic-gate  return (undef,undef) unless _is_one($c,$a);
1905*0Sstevel@tonic-gate
1906*0Sstevel@tonic-gate  $sign = $sign == 1 ? '+' : '-';
1907*0Sstevel@tonic-gate  ($u1,$sign);
1908*0Sstevel@tonic-gate  }
1909*0Sstevel@tonic-gate
1910*0Sstevel@tonic-gatesub _modpow
1911*0Sstevel@tonic-gate  {
1912*0Sstevel@tonic-gate  # modulus of power ($x ** $y) % $z
1913*0Sstevel@tonic-gate  my ($c,$num,$exp,$mod) = @_;
1914*0Sstevel@tonic-gate
1915*0Sstevel@tonic-gate  # in the trivial case,
1916*0Sstevel@tonic-gate  if (_is_one($c,$mod))
1917*0Sstevel@tonic-gate    {
1918*0Sstevel@tonic-gate    splice @$num,0,1; $num->[0] = 0;
1919*0Sstevel@tonic-gate    return $num;
1920*0Sstevel@tonic-gate    }
1921*0Sstevel@tonic-gate  if ((scalar @$num == 1) && (($num->[0] == 0) || ($num->[0] == 1)))
1922*0Sstevel@tonic-gate    {
1923*0Sstevel@tonic-gate    $num->[0] = 1;
1924*0Sstevel@tonic-gate    return $num;
1925*0Sstevel@tonic-gate    }
1926*0Sstevel@tonic-gate
1927*0Sstevel@tonic-gate#  $num = _mod($c,$num,$mod);	# this does not make it faster
1928*0Sstevel@tonic-gate
1929*0Sstevel@tonic-gate  my $acc = _copy($c,$num); my $t = _one();
1930*0Sstevel@tonic-gate
1931*0Sstevel@tonic-gate  my $expbin = _as_bin($c,$exp); $expbin =~ s/^0b//;
1932*0Sstevel@tonic-gate  my $len = length($expbin);
1933*0Sstevel@tonic-gate  while (--$len >= 0)
1934*0Sstevel@tonic-gate    {
1935*0Sstevel@tonic-gate    if ( substr($expbin,$len,1) eq '1')			# is_odd
1936*0Sstevel@tonic-gate      {
1937*0Sstevel@tonic-gate      _mul($c,$t,$acc);
1938*0Sstevel@tonic-gate      $t = _mod($c,$t,$mod);
1939*0Sstevel@tonic-gate      }
1940*0Sstevel@tonic-gate    _mul($c,$acc,$acc);
1941*0Sstevel@tonic-gate    $acc = _mod($c,$acc,$mod);
1942*0Sstevel@tonic-gate    }
1943*0Sstevel@tonic-gate  @$num = @$t;
1944*0Sstevel@tonic-gate  $num;
1945*0Sstevel@tonic-gate  }
1946*0Sstevel@tonic-gate
1947*0Sstevel@tonic-gatesub _gcd
1948*0Sstevel@tonic-gate  {
1949*0Sstevel@tonic-gate  # greatest common divisor
1950*0Sstevel@tonic-gate  my ($c,$x,$y) = @_;
1951*0Sstevel@tonic-gate
1952*0Sstevel@tonic-gate  while (! _is_zero($c,$y))
1953*0Sstevel@tonic-gate    {
1954*0Sstevel@tonic-gate    my $t = _copy($c,$y);
1955*0Sstevel@tonic-gate    $y = _mod($c, $x, $y);
1956*0Sstevel@tonic-gate    $x = $t;
1957*0Sstevel@tonic-gate    }
1958*0Sstevel@tonic-gate  $x;
1959*0Sstevel@tonic-gate  }
1960*0Sstevel@tonic-gate
1961*0Sstevel@tonic-gate##############################################################################
1962*0Sstevel@tonic-gate##############################################################################
1963*0Sstevel@tonic-gate
1964*0Sstevel@tonic-gate1;
1965*0Sstevel@tonic-gate__END__
1966*0Sstevel@tonic-gate
1967*0Sstevel@tonic-gate=head1 NAME
1968*0Sstevel@tonic-gate
1969*0Sstevel@tonic-gateMath::BigInt::Calc - Pure Perl module to support Math::BigInt
1970*0Sstevel@tonic-gate
1971*0Sstevel@tonic-gate=head1 SYNOPSIS
1972*0Sstevel@tonic-gate
1973*0Sstevel@tonic-gateProvides support for big integer calculations. Not intended to be used by other
1974*0Sstevel@tonic-gatemodules. Other modules which sport the same functions can also be used to support
1975*0Sstevel@tonic-gateMath::BigInt, like Math::BigInt::GMP or Math::BigInt::Pari.
1976*0Sstevel@tonic-gate
1977*0Sstevel@tonic-gate=head1 DESCRIPTION
1978*0Sstevel@tonic-gate
1979*0Sstevel@tonic-gateIn order to allow for multiple big integer libraries, Math::BigInt was
1980*0Sstevel@tonic-gaterewritten to use library modules for core math routines. Any module which
1981*0Sstevel@tonic-gatefollows the same API as this can be used instead by using the following:
1982*0Sstevel@tonic-gate
1983*0Sstevel@tonic-gate	use Math::BigInt lib => 'libname';
1984*0Sstevel@tonic-gate
1985*0Sstevel@tonic-gate'libname' is either the long name ('Math::BigInt::Pari'), or only the short
1986*0Sstevel@tonic-gateversion like 'Pari'.
1987*0Sstevel@tonic-gate
1988*0Sstevel@tonic-gate=head1 STORAGE
1989*0Sstevel@tonic-gate
1990*0Sstevel@tonic-gate=head1 METHODS
1991*0Sstevel@tonic-gate
1992*0Sstevel@tonic-gateThe following functions MUST be defined in order to support the use by
1993*0Sstevel@tonic-gateMath::BigInt v1.70 or later:
1994*0Sstevel@tonic-gate
1995*0Sstevel@tonic-gate	api_version()	return API version, minimum 1 for v1.70
1996*0Sstevel@tonic-gate	_new(string)	return ref to new object from ref to decimal string
1997*0Sstevel@tonic-gate	_zero()		return a new object with value 0
1998*0Sstevel@tonic-gate	_one()		return a new object with value 1
1999*0Sstevel@tonic-gate	_two()		return a new object with value 2
2000*0Sstevel@tonic-gate	_ten()		return a new object with value 10
2001*0Sstevel@tonic-gate
2002*0Sstevel@tonic-gate	_str(obj)	return ref to a string representing the object
2003*0Sstevel@tonic-gate	_num(obj)	returns a Perl integer/floating point number
2004*0Sstevel@tonic-gate			NOTE: because of Perl numeric notation defaults,
2005*0Sstevel@tonic-gate			the _num'ified obj may lose accuracy due to
2006*0Sstevel@tonic-gate			machine-dependend floating point size limitations
2007*0Sstevel@tonic-gate
2008*0Sstevel@tonic-gate	_add(obj,obj)	Simple addition of two objects
2009*0Sstevel@tonic-gate	_mul(obj,obj)	Multiplication of two objects
2010*0Sstevel@tonic-gate	_div(obj,obj)	Division of the 1st object by the 2nd
2011*0Sstevel@tonic-gate			In list context, returns (result,remainder).
2012*0Sstevel@tonic-gate			NOTE: this is integer math, so no
2013*0Sstevel@tonic-gate			fractional part will be returned.
2014*0Sstevel@tonic-gate			The second operand will be not be 0, so no need to
2015*0Sstevel@tonic-gate			check for that.
2016*0Sstevel@tonic-gate	_sub(obj,obj)	Simple subtraction of 1 object from another
2017*0Sstevel@tonic-gate			a third, optional parameter indicates that the params
2018*0Sstevel@tonic-gate			are swapped. In this case, the first param needs to
2019*0Sstevel@tonic-gate			be preserved, while you can destroy the second.
2020*0Sstevel@tonic-gate			sub (x,y,1) => return x - y and keep x intact!
2021*0Sstevel@tonic-gate	_dec(obj)	decrement object by one (input is garant. to be > 0)
2022*0Sstevel@tonic-gate	_inc(obj)	increment object by one
2023*0Sstevel@tonic-gate
2024*0Sstevel@tonic-gate
2025*0Sstevel@tonic-gate	_acmp(obj,obj)	<=> operator for objects (return -1, 0 or 1)
2026*0Sstevel@tonic-gate
2027*0Sstevel@tonic-gate	_len(obj)	returns count of the decimal digits of the object
2028*0Sstevel@tonic-gate	_digit(obj,n)	returns the n'th decimal digit of object
2029*0Sstevel@tonic-gate
2030*0Sstevel@tonic-gate	_is_one(obj)	return true if argument is 1
2031*0Sstevel@tonic-gate	_is_two(obj)	return true if argument is 2
2032*0Sstevel@tonic-gate	_is_ten(obj)	return true if argument is 10
2033*0Sstevel@tonic-gate	_is_zero(obj)	return true if argument is 0
2034*0Sstevel@tonic-gate	_is_even(obj)	return true if argument is even (0,2,4,6..)
2035*0Sstevel@tonic-gate	_is_odd(obj)	return true if argument is odd (1,3,5,7..)
2036*0Sstevel@tonic-gate
2037*0Sstevel@tonic-gate	_copy		return a ref to a true copy of the object
2038*0Sstevel@tonic-gate
2039*0Sstevel@tonic-gate	_check(obj)	check whether internal representation is still intact
2040*0Sstevel@tonic-gate			return 0 for ok, otherwise error message as string
2041*0Sstevel@tonic-gate
2042*0Sstevel@tonic-gate	_from_hex(str)	return ref to new object from ref to hexadecimal string
2043*0Sstevel@tonic-gate	_from_bin(str)	return ref to new object from ref to binary string
2044*0Sstevel@tonic-gate
2045*0Sstevel@tonic-gate	_as_hex(str)	return string containing the value as
2046*0Sstevel@tonic-gate			unsigned hex string, with the '0x' prepended.
2047*0Sstevel@tonic-gate			Leading zeros must be stripped.
2048*0Sstevel@tonic-gate	_as_bin(str)	Like as_hex, only as binary string containing only
2049*0Sstevel@tonic-gate			zeros and ones. Leading zeros must be stripped and a
2050*0Sstevel@tonic-gate			'0b' must be prepended.
2051*0Sstevel@tonic-gate
2052*0Sstevel@tonic-gate	_rsft(obj,N,B)	shift object in base B by N 'digits' right
2053*0Sstevel@tonic-gate	_lsft(obj,N,B)	shift object in base B by N 'digits' left
2054*0Sstevel@tonic-gate
2055*0Sstevel@tonic-gate	_xor(obj1,obj2)	XOR (bit-wise) object 1 with object 2
2056*0Sstevel@tonic-gate			Note: XOR, AND and OR pad with zeros if size mismatches
2057*0Sstevel@tonic-gate	_and(obj1,obj2)	AND (bit-wise) object 1 with object 2
2058*0Sstevel@tonic-gate	_or(obj1,obj2)	OR (bit-wise) object 1 with object 2
2059*0Sstevel@tonic-gate
2060*0Sstevel@tonic-gate	_mod(obj,obj)	Return remainder of div of the 1st by the 2nd object
2061*0Sstevel@tonic-gate	_sqrt(obj)	return the square root of object (truncated to int)
2062*0Sstevel@tonic-gate	_root(obj)	return the n'th (n >= 3) root of obj (truncated to int)
2063*0Sstevel@tonic-gate	_fac(obj)	return factorial of object 1 (1*2*3*4..)
2064*0Sstevel@tonic-gate	_pow(obj,obj)	return object 1 to the power of object 2
2065*0Sstevel@tonic-gate			return undef for NaN
2066*0Sstevel@tonic-gate	_zeros(obj)	return number of trailing decimal zeros
2067*0Sstevel@tonic-gate	_modinv		return inverse modulus
2068*0Sstevel@tonic-gate	_modpow		return modulus of power ($x ** $y) % $z
2069*0Sstevel@tonic-gate	_log_int(X,N)	calculate integer log() of X in base N
2070*0Sstevel@tonic-gate			X >= 0, N >= 0 (return undef for NaN)
2071*0Sstevel@tonic-gate			returns (RESULT, EXACT) where EXACT is:
2072*0Sstevel@tonic-gate			 1     : result is exactly RESULT
2073*0Sstevel@tonic-gate			 0     : result was truncated to RESULT
2074*0Sstevel@tonic-gate			 undef : unknown whether result is exactly RESULT
2075*0Sstevel@tonic-gate        _gcd(obj,obj)	return Greatest Common Divisor of two objects
2076*0Sstevel@tonic-gate
2077*0Sstevel@tonic-gateThe following functions are optional, and can be defined if the underlying lib
2078*0Sstevel@tonic-gatehas a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
2079*0Sstevel@tonic-gateslow) fallback routines to emulate these:
2080*0Sstevel@tonic-gate
2081*0Sstevel@tonic-gate	_signed_or
2082*0Sstevel@tonic-gate	_signed_and
2083*0Sstevel@tonic-gate	_signed_xor
2084*0Sstevel@tonic-gate
2085*0Sstevel@tonic-gate
2086*0Sstevel@tonic-gateInput strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
2087*0Sstevel@tonic-gateor '0b1101').
2088*0Sstevel@tonic-gate
2089*0Sstevel@tonic-gateSo the library needs only to deal with unsigned big integers. Testing of input
2090*0Sstevel@tonic-gateparameter validity is done by the caller, so you need not worry about
2091*0Sstevel@tonic-gateunderflow (f.i. in C<_sub()>, C<_dec()>) nor about division by zero or similar
2092*0Sstevel@tonic-gatecases.
2093*0Sstevel@tonic-gate
2094*0Sstevel@tonic-gateThe first parameter can be modified, that includes the possibility that you
2095*0Sstevel@tonic-gatereturn a reference to a completely different object instead. Although keeping
2096*0Sstevel@tonic-gatethe reference and just changing it's contents is prefered over creating and
2097*0Sstevel@tonic-gatereturning a different reference.
2098*0Sstevel@tonic-gate
2099*0Sstevel@tonic-gateReturn values are always references to objects, strings, or true/false for
2100*0Sstevel@tonic-gatecomparisation routines.
2101*0Sstevel@tonic-gate
2102*0Sstevel@tonic-gate=head1 WRAP YOUR OWN
2103*0Sstevel@tonic-gate
2104*0Sstevel@tonic-gateIf you want to port your own favourite c-lib for big numbers to the
2105*0Sstevel@tonic-gateMath::BigInt interface, you can take any of the already existing modules as
2106*0Sstevel@tonic-gatea rough guideline. You should really wrap up the latest BigInt and BigFloat
2107*0Sstevel@tonic-gatetestsuites with your module, and replace in them any of the following:
2108*0Sstevel@tonic-gate
2109*0Sstevel@tonic-gate	use Math::BigInt;
2110*0Sstevel@tonic-gate
2111*0Sstevel@tonic-gateby this:
2112*0Sstevel@tonic-gate
2113*0Sstevel@tonic-gate	use Math::BigInt lib => 'yourlib';
2114*0Sstevel@tonic-gate
2115*0Sstevel@tonic-gateThis way you ensure that your library really works 100% within Math::BigInt.
2116*0Sstevel@tonic-gate
2117*0Sstevel@tonic-gate=head1 LICENSE
2118*0Sstevel@tonic-gate
2119*0Sstevel@tonic-gateThis program is free software; you may redistribute it and/or modify it under
2120*0Sstevel@tonic-gatethe same terms as Perl itself.
2121*0Sstevel@tonic-gate
2122*0Sstevel@tonic-gate=head1 AUTHORS
2123*0Sstevel@tonic-gate
2124*0Sstevel@tonic-gateOriginal math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
2125*0Sstevel@tonic-gatein late 2000.
2126*0Sstevel@tonic-gateSeperated from BigInt and shaped API with the help of John Peacock.
2127*0Sstevel@tonic-gateFixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
2128*0Sstevel@tonic-gateFurther streamlining (api_version 1) by Tels 2004.
2129*0Sstevel@tonic-gate
2130*0Sstevel@tonic-gate=head1 SEE ALSO
2131*0Sstevel@tonic-gate
2132*0Sstevel@tonic-gateL<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
2133*0Sstevel@tonic-gateL<Math::BigInt::GMP>, L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.
2134*0Sstevel@tonic-gate
2135*0Sstevel@tonic-gate=cut
2136