ext/Math/BigInt/FastCalc/FastCalc.xs

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