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