dist/Math-BigInt-FastCalc/FastCalc.xs

   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