1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 5 /* for Perl prior to v5.7.1 */ 6 #ifndef SvUOK 7 # define SvUOK(sv) SvIOK_UV(sv) 8 #endif 9 10 double XS_BASE = 0; 11 double XS_BASE_LEN = 0; 12 13 MODULE = Math::BigInt::FastCalc PACKAGE = Math::BigInt::FastCalc 14 15 PROTOTYPES: DISABLE 16 17 ############################################################################# 18 # 2002-08-12 0.03 Tels unreleased 19 # * is_zero/is_one/is_odd/is_even/len work now (pass v1.61 tests) 20 # 2002-08-13 0.04 Tels unreleased 21 # * returns no/yes for is_foo() methods to be faster 22 # 2002-08-18 0.06alpha 23 # * added _num(), _inc() and _dec() 24 # 2002-08-25 0.06 Tels 25 # * added __strip_zeros(), _copy() 26 # 2004-08-13 0.07 Tels 27 # * added _is_two(), _is_ten(), _ten() 28 # 2007-04-02 0.08 Tels 29 # * plug leaks by creating mortals 30 # 2007-05-27 0.09 Tels 31 # * add _new() 32 33 #define RETURN_MORTAL_INT(value) \ 34 ST(0) = sv_2mortal(newSViv(value)); \ 35 XSRETURN(1); 36 37 #define RETURN_MORTAL_BOOL(temp, comp) \ 38 ST(0) = sv_2mortal(boolSV( SvIV(temp) == comp)); 39 40 #define CONSTANT_OBJ(int) \ 41 RETVAL = newAV(); \ 42 sv_2mortal((SV*)RETVAL); \ 43 av_push (RETVAL, newSViv( int )); 44 45 void 46 _set_XS_BASE(BASE, BASE_LEN) 47 SV* BASE 48 SV* BASE_LEN 49 50 CODE: 51 XS_BASE = SvNV(BASE); 52 XS_BASE_LEN = SvIV(BASE_LEN); 53 54 ############################################################################## 55 # _new 56 57 AV * 58 _new(class, x) 59 SV* x 60 INIT: 61 STRLEN len; 62 char* cur; 63 STRLEN part_len; 64 65 CODE: 66 /* create the array */ 67 RETVAL = newAV(); 68 sv_2mortal((SV*)RETVAL); 69 if (SvUOK(x) && SvUV(x) < XS_BASE) 70 { 71 /* shortcut for integer arguments */ 72 av_push (RETVAL, newSVuv( SvUV(x) )); 73 } 74 else 75 { 76 /* split the input (as string) into XS_BASE_LEN long parts */ 77 /* in perl: 78 [ reverse(unpack("a" . ($il % $BASE_LEN+1) 79 . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ]; 80 */ 81 cur = SvPV(x, len); /* convert to string & store length */ 82 cur += len; /* doing "cur = SvEND(x)" does not work! */ 83 # process the string from the back 84 while (len > 0) 85 { 86 /* use either BASE_LEN or the amount of remaining digits */ 87 part_len = (STRLEN) XS_BASE_LEN; 88 if (part_len > len) 89 { 90 part_len = len; 91 } 92 /* processed so many digits */ 93 cur -= part_len; 94 len -= part_len; 95 /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */ 96 if (part_len > 0) 97 { 98 av_push (RETVAL, newSVpvn(cur, part_len) ); 99 } 100 } 101 } 102 OUTPUT: 103 RETVAL 104 105 ############################################################################## 106 # _copy 107 108 void 109 _copy(class, x) 110 SV* x 111 INIT: 112 AV* a; 113 AV* a2; 114 I32 elems; 115 116 CODE: 117 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 118 elems = av_len(a); /* number of elems in array */ 119 a2 = (AV*)sv_2mortal((SV*)newAV()); 120 av_extend (a2, elems); /* pre-padd */ 121 while (elems >= 0) 122 { 123 /* av_store( a2, elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */ 124 125 /* looking and trying to preserve IV is actually slower when copying */ 126 /* temp = (SV*)*av_fetch(a, elems, 0); 127 if (SvIOK(temp)) 128 { 129 av_store( a2, elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) ))); 130 } 131 else 132 { 133 av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) ))); 134 } 135 */ 136 av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) ))); 137 elems--; 138 } 139 ST(0) = sv_2mortal( newRV_inc((SV*) a2) ); 140 141 ############################################################################## 142 # __strip_zeros (also check for empty arrays from div) 143 144 void 145 __strip_zeros(x) 146 SV* x 147 INIT: 148 AV* a; 149 SV* temp; 150 I32 elems; 151 I32 index; 152 153 CODE: 154 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 155 elems = av_len(a); /* number of elems in array */ 156 ST(0) = x; /* we return x */ 157 if (elems == -1) 158 { 159 av_push (a, newSViv(0)); /* correct empty arrays */ 160 XSRETURN(1); 161 } 162 if (elems == 0) 163 { 164 XSRETURN(1); /* nothing to do since only one elem */ 165 } 166 index = elems; 167 while (index > 0) 168 { 169 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ 170 if (SvNV(temp) != 0) 171 { 172 break; 173 } 174 index--; 175 } 176 if (index < elems) 177 { 178 index = elems - index; 179 while (index-- > 0) 180 { 181 av_pop (a); 182 } 183 } 184 XSRETURN(1); 185 186 ############################################################################## 187 # decrement (subtract one) 188 189 void 190 _dec(class,x) 191 SV* x 192 INIT: 193 AV* a; 194 SV* temp; 195 I32 elems; 196 I32 index; 197 NV MAX; 198 199 CODE: 200 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 201 elems = av_len(a); /* number of elems in array */ 202 ST(0) = x; /* we return x */ 203 204 MAX = XS_BASE - 1; 205 index = 0; 206 while (index <= elems) 207 { 208 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ 209 sv_setnv (temp, SvNV(temp)-1); /* decrement */ 210 if (SvNV(temp) >= 0) 211 { 212 break; /* early out */ 213 } 214 sv_setnv (temp, MAX); /* overflow, so set this to $MAX */ 215 index++; 216 } 217 /* do have more than one element? */ 218 /* (more than one because [0] should be kept as single-element) */ 219 if (elems > 0) 220 { 221 temp = *av_fetch(a, elems, 0); /* fetch last element */ 222 if (SvIV(temp) == 0) /* did last elem overflow? */ 223 { 224 av_pop(a); /* yes, so shrink array */ 225 /* aka remove leading zeros */ 226 } 227 } 228 XSRETURN(1); /* return x */ 229 230 ############################################################################## 231 # increment (add one) 232 233 void 234 _inc(class,x) 235 SV* x 236 INIT: 237 AV* a; 238 SV* temp; 239 I32 elems; 240 I32 index; 241 NV BASE; 242 243 CODE: 244 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 245 elems = av_len(a); /* number of elems in array */ 246 ST(0) = x; /* we return x */ 247 248 BASE = XS_BASE; 249 index = 0; 250 while (index <= elems) 251 { 252 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ 253 sv_setnv (temp, SvNV(temp)+1); 254 if (SvNV(temp) < BASE) 255 { 256 XSRETURN(1); /* return (early out) */ 257 } 258 sv_setiv (temp, 0); /* overflow, so set this elem to 0 */ 259 index++; 260 } 261 temp = *av_fetch(a, elems, 0); /* fetch last element */ 262 if (SvIV(temp) == 0) /* did last elem overflow? */ 263 { 264 av_push(a, newSViv(1)); /* yes, so extend array by 1 */ 265 } 266 XSRETURN(1); /* return x */ 267 268 ############################################################################## 269 # Make a number (scalar int/float) from a BigInt object 270 271 void 272 _num(class,x) 273 SV* x 274 INIT: 275 AV* a; 276 NV fac; 277 SV* temp; 278 NV num; 279 I32 elems; 280 I32 index; 281 NV BASE; 282 283 CODE: 284 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 285 elems = av_len(a); /* number of elems in array */ 286 287 if (elems == 0) /* only one element? */ 288 { 289 ST(0) = *av_fetch(a, 0, 0); /* fetch first (only) element */ 290 XSRETURN(1); /* return it */ 291 } 292 fac = 1.0; /* factor */ 293 index = 0; 294 num = 0.0; 295 BASE = XS_BASE; 296 while (index <= elems) 297 { 298 temp = *av_fetch(a, index, 0); /* fetch current element */ 299 num += fac * SvNV(temp); 300 fac *= BASE; 301 index++; 302 } 303 ST(0) = newSVnv(num); 304 305 ############################################################################## 306 307 AV * 308 _zero(class) 309 CODE: 310 CONSTANT_OBJ(0) 311 OUTPUT: 312 RETVAL 313 314 ############################################################################## 315 316 AV * 317 _one(class) 318 CODE: 319 CONSTANT_OBJ(1) 320 OUTPUT: 321 RETVAL 322 323 ############################################################################## 324 325 AV * 326 _two(class) 327 CODE: 328 CONSTANT_OBJ(2) 329 OUTPUT: 330 RETVAL 331 332 ############################################################################## 333 334 AV * 335 _ten(class) 336 CODE: 337 CONSTANT_OBJ(10) 338 OUTPUT: 339 RETVAL 340 341 ############################################################################## 342 343 void 344 _is_even(class, x) 345 SV* x 346 INIT: 347 AV* a; 348 SV* temp; 349 350 CODE: 351 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 352 temp = *av_fetch(a, 0, 0); /* fetch first element */ 353 ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == 0)); 354 355 ############################################################################## 356 357 void 358 _is_odd(class, x) 359 SV* x 360 INIT: 361 AV* a; 362 SV* temp; 363 364 CODE: 365 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 366 temp = *av_fetch(a, 0, 0); /* fetch first element */ 367 ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) != 0)); 368 369 ############################################################################## 370 371 void 372 _is_one(class, x) 373 SV* x 374 INIT: 375 AV* a; 376 SV* temp; 377 378 CODE: 379 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 380 if ( av_len(a) != 0) 381 { 382 ST(0) = &PL_sv_no; 383 XSRETURN(1); /* len != 1, can't be '1' */ 384 } 385 temp = *av_fetch(a, 0, 0); /* fetch first element */ 386 RETURN_MORTAL_BOOL(temp, 1); 387 388 ############################################################################## 389 390 void 391 _is_two(class, x) 392 SV* x 393 INIT: 394 AV* a; 395 SV* temp; 396 397 CODE: 398 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 399 if ( av_len(a) != 0) 400 { 401 ST(0) = &PL_sv_no; 402 XSRETURN(1); /* len != 1, can't be '2' */ 403 } 404 temp = *av_fetch(a, 0, 0); /* fetch first element */ 405 RETURN_MORTAL_BOOL(temp, 2); 406 407 ############################################################################## 408 409 void 410 _is_ten(class, x) 411 SV* x 412 INIT: 413 AV* a; 414 SV* temp; 415 416 CODE: 417 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 418 if ( av_len(a) != 0) 419 { 420 ST(0) = &PL_sv_no; 421 XSRETURN(1); /* len != 1, can't be '10' */ 422 } 423 temp = *av_fetch(a, 0, 0); /* fetch first element */ 424 RETURN_MORTAL_BOOL(temp, 10); 425 426 ############################################################################## 427 428 void 429 _is_zero(class, x) 430 SV* x 431 INIT: 432 AV* a; 433 SV* temp; 434 435 CODE: 436 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 437 if ( av_len(a) != 0) 438 { 439 ST(0) = &PL_sv_no; 440 XSRETURN(1); /* len != 1, can't be '0' */ 441 } 442 temp = *av_fetch(a, 0, 0); /* fetch first element */ 443 RETURN_MORTAL_BOOL(temp, 0); 444 445 ############################################################################## 446 447 void 448 _len(class,x) 449 SV* x 450 INIT: 451 AV* a; 452 SV* temp; 453 IV elems; 454 STRLEN len; 455 456 CODE: 457 a = (AV*)SvRV(x); /* ref to aray, don't check ref */ 458 elems = av_len(a); /* number of elems in array */ 459 temp = *av_fetch(a, elems, 0); /* fetch last element */ 460 SvPV(temp, len); /* convert to string & store length */ 461 len += (IV) XS_BASE_LEN * elems; 462 ST(0) = sv_2mortal(newSViv(len)); 463 464 ############################################################################## 465 466 void 467 _acmp(class, cx, cy); 468 SV* cx 469 SV* cy 470 INIT: 471 AV* array_x; 472 AV* array_y; 473 I32 elemsx, elemsy, diff; 474 SV* tempx; 475 SV* tempy; 476 STRLEN lenx; 477 STRLEN leny; 478 NV diff_nv; 479 I32 diff_str; 480 481 CODE: 482 array_x = (AV*)SvRV(cx); /* ref to aray, don't check ref */ 483 array_y = (AV*)SvRV(cy); /* ref to aray, don't check ref */ 484 elemsx = av_len(array_x); 485 elemsy = av_len(array_y); 486 diff = elemsx - elemsy; /* difference */ 487 488 if (diff > 0) 489 { 490 RETURN_MORTAL_INT(1); /* len differs: X > Y */ 491 } 492 else if (diff < 0) 493 { 494 RETURN_MORTAL_INT(-1); /* len differs: X < Y */ 495 } 496 /* both have same number of elements, so check length of last element 497 and see if it differes */ 498 tempx = *av_fetch(array_x, elemsx, 0); /* fetch last element */ 499 tempy = *av_fetch(array_y, elemsx, 0); /* fetch last element */ 500 SvPV(tempx, lenx); /* convert to string & store length */ 501 SvPV(tempy, leny); /* convert to string & store length */ 502 diff_str = (I32)lenx - (I32)leny; 503 if (diff_str > 0) 504 { 505 RETURN_MORTAL_INT(1); /* same len, but first elems differs in len */ 506 } 507 if (diff_str < 0) 508 { 509 RETURN_MORTAL_INT(-1); /* same len, but first elems differs in len */ 510 } 511 /* same number of digits, so need to make a full compare */ 512 diff_nv = 0; 513 while (elemsx >= 0) 514 { 515 tempx = *av_fetch(array_x, elemsx, 0); /* fetch curr x element */ 516 tempy = *av_fetch(array_y, elemsx, 0); /* fetch curr y element */ 517 diff_nv = SvNV(tempx) - SvNV(tempy); 518 if (diff_nv != 0) 519 { 520 break; 521 } 522 elemsx--; 523 } 524 if (diff_nv > 0) 525 { 526 RETURN_MORTAL_INT(1); 527 } 528 if (diff_nv < 0) 529 { 530 RETURN_MORTAL_INT(-1); 531 } 532 ST(0) = sv_2mortal(newSViv(0)); /* X and Y are equal */ 533 534