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
  22 void
  23 _set_XS_BASE(BASE, BASE_LEN)
  24   SV* BASE
  25   SV* BASE_LEN
  26
  27   CODE:
  28     XS_BASE = SvNV(BASE);
  29     XS_BASE_LEN = SvIV(BASE_LEN);
  30
  31 ##############################################################################
  32 # _copy
  33
  34 void
  35 _copy(class, x)
  36   SV*   x
  37   INIT:
  38     AV* a;
  39     AV* a2;
  40     I32 elems;
  41
  42   CODE:
  43     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
  44     elems = av_len(a);                  /* number of elems in array */
  45     a2 = (AV*)sv_2mortal((SV*)newAV());
  46     av_extend (a2, elems);              /* prepadd */
  47     while (elems >= 0)
  48       {
  49       /* av_store( a2,  elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */
  50
  51       /* looking and trying to preserve IV is actually slower when copying */
  52       /* temp = (SV*)*av_fetch(a, elems, 0);
  53       if (SvIOK(temp))
  54         {
  55         av_store( a2,  elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) )));
  56         }
  57       else
  58         {
  59         av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
  60         }
  61       */
  62       av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
  63       elems--;
  64       }
  65     ST(0) = sv_2mortal( newRV_inc((SV*) a2) );
  66
  67 ##############################################################################
  68 # __strip_zeros (also check for empty arrays from div)
  69
  70 void
  71 __strip_zeros(x)
  72   SV*   x
  73   INIT:
  74     AV* a;
  75     SV* temp;
  76     I32 elems;
  77     I32 index;
  78
  79   CODE:
  80     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
  81     elems = av_len(a);                  /* number of elems in array */
  82     ST(0) = x;                          /* we return x */
  83     if (elems == -1)
  84       {
  85       av_push (a, newSViv(0));          /* correct empty arrays */
  86       XSRETURN(1);
  87       }
  88     if (elems == 0)
  89       {
  90       XSRETURN(1);                      /* nothing to do since only one elem */
  91       }
  92     index = elems;
  93     while (index > 0)
  94       {
  95       temp = *av_fetch(a, index, 0);    /* fetch ptr to current element */
  96       if (SvNV(temp) != 0)
  97         {
  98         break;
  99         }
 100       index--;
 101       }
 102     if (index < elems)
 103       {
 104       index = elems - index;
 105       while (index-- > 0)
 106         {
 107         av_pop (a);
 108         }
 109       }
 110     XSRETURN(1);
 111
 112 ##############################################################################
 113 # decrement (subtract one)
 114
 115 void
 116 _dec(class,x)
 117   SV*   x
 118   INIT:
 119     AV* a;
 120     SV* temp;
 121     I32 elems;
 122     I32 index;
 123     NV  MAX;
 124
 125   CODE:
 126     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 127     elems = av_len(a);                  /* number of elems in array */
 128     ST(0) = x;                          /* we return x */
 129
 130     MAX = XS_BASE - 1;
 131     index = 0;
 132     while (index <= elems)
 133       {
 134       temp = *av_fetch(a, index, 0);    /* fetch ptr to current element */
 135       sv_setnv (temp, SvNV(temp)-1);
 136       if (SvNV(temp) >= 0)
 137         {
 138         break;                          /* early out */
 139         }
 140       sv_setnv (temp, MAX);             /* overflow, so set this to $MAX */
 141       index++;
 142       }
 143     /* do have more than one element? */
 144     /* (more than one because [0] should be kept as single-element) */
 145     if (elems > 0)
 146       {
 147       temp = *av_fetch(a, elems, 0);    /* fetch last element */
 148       if (SvIV(temp) == 0)              /* did last elem overflow? */
 149         {
 150         av_pop(a);                      /* yes, so shrink array */
 151                                         /* aka remove leading zeros */
 152         }
 153       }
 154     XSRETURN(1);                        /* return x */
 155
 156 ##############################################################################
 157 # increment (add one)
 158
 159 void
 160 _inc(class,x)
 161   SV*   x
 162   INIT:
 163     AV* a;
 164     SV* temp;
 165     I32 elems;
 166     I32 index;
 167     NV  BASE;
 168
 169   CODE:
 170     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 171     elems = av_len(a);                  /* number of elems in array */
 172     ST(0) = x;                          /* we return x */
 173
 174     BASE = XS_BASE;
 175     index = 0;
 176     while (index <= elems)
 177       {
 178       temp = *av_fetch(a, index, 0);    /* fetch ptr to current element */
 179       sv_setnv (temp, SvNV(temp)+1);
 180       if (SvNV(temp) < BASE)
 181         {
 182         XSRETURN(1);                    /* return (early out) */
 183         }
 184       sv_setiv (temp, 0);               /* overflow, so set this elem to 0 */
 185       index++;
 186       }
 187     temp = *av_fetch(a, elems, 0);      /* fetch last element */
 188     if (SvIV(temp) == 0)                /* did last elem overflow? */
 189       {
 190       av_push(a, newSViv(1));           /* yes, so extend array by 1 */
 191       }
 192     XSRETURN(1);                        /* return x */
 193
 194 ##############################################################################
 195 # Make a number (scalar int/float) from a BigInt object
 196
 197 void
 198 _num(class,x)
 199   SV*   x
 200   INIT:
 201     AV* a;
 202     NV  fac;
 203     SV* temp;
 204     NV  num;
 205     I32 elems;
 206     I32 index;
 207     NV  BASE;
 208
 209   CODE:
 210     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 211     elems = av_len(a);                  /* number of elems in array */
 212
 213     if (elems == 0)                     /* only one element? */
 214       {
 215       ST(0) = *av_fetch(a, 0, 0);       /* fetch first (only) element */
 216       XSRETURN(1);                      /* return it */
 217       }
 218     fac = 1.0;                          /* factor */
 219     index = 0;
 220     num = 0.0;
 221     BASE = XS_BASE;
 222     while (index <= elems)
 223       {
 224       temp = *av_fetch(a, index, 0);    /* fetch current element */
 225       num += fac * SvNV(temp);
 226       fac *= BASE;
 227       index++;
 228       }
 229     ST(0) = newSVnv(num);
 230
 231 ##############################################################################
 232
 233 void
 234 _zero(class)
 235   INIT:
 236     AV* a;
 237
 238   CODE:
 239     a = newAV();
 240     av_push (a, newSViv( 0 ));          /* zero */
 241     ST(0) = newRV_noinc((SV*) a);
 242
 243 ##############################################################################
 244
 245 void
 246 _one(class)
 247   INIT:
 248     AV* a;
 249
 250   CODE:
 251     a = newAV();
 252     av_push (a, newSViv( 1 ));          /* one */
 253     ST(0) = newRV_noinc((SV*) a);
 254
 255 ##############################################################################
 256
 257 void
 258 _two(class)
 259   INIT:
 260     AV* a;
 261
 262   CODE:
 263     a = newAV();
 264     av_push (a, newSViv( 2 ));          /* two */
 265     ST(0) = newRV_noinc((SV*) a);
 266
 267 ##############################################################################
 268
 269 void
 270 _ten(class)
 271   INIT:
 272     AV* a;
 273
 274   CODE:
 275     a = newAV();
 276     av_push (a, newSViv( 10 ));         /* ten */
 277     ST(0) = newRV_noinc((SV*) a);
 278
 279 ##############################################################################
 280
 281 void
 282 _is_even(class, x)
 283   SV*   x
 284   INIT:
 285     AV* a;
 286     SV* temp;
 287
 288   CODE:
 289     a = (AV*)SvRV(x);           /* ref to aray, don't check ref */
 290     temp = *av_fetch(a, 0, 0);  /* fetch first element */
 291     ST(0) = boolSV((SvIV(temp) & 1) == 0);
 292
 293 ##############################################################################
 294
 295 void
 296 _is_odd(class, x)
 297   SV*   x
 298   INIT:
 299     AV* a;
 300     SV* temp;
 301
 302   CODE:
 303     a = (AV*)SvRV(x);           /* ref to aray, don't check ref */
 304     temp = *av_fetch(a, 0, 0);  /* fetch first element */
 305     ST(0) = boolSV((SvIV(temp) & 1) != 0);
 306
 307 ##############################################################################
 308
 309 void
 310 _is_one(class, x)
 311   SV*   x
 312   INIT:
 313     AV* a;
 314     SV* temp;
 315
 316   CODE:
 317     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 318     if ( av_len(a) != 0)
 319       {
 320       ST(0) = &PL_sv_no;
 321       XSRETURN(1);                      /* len != 1, can't be '1' */
 322       }
 323     temp = *av_fetch(a, 0, 0);          /* fetch first element */
 324     ST(0) = boolSV((SvIV(temp) == 1));
 325
 326 ##############################################################################
 327
 328 void
 329 _is_two(class, x)
 330   SV*   x
 331   INIT:
 332     AV* a;
 333     SV* temp;
 334
 335   CODE:
 336     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 337     if ( av_len(a) != 0)
 338       {
 339       ST(0) = &PL_sv_no;
 340       XSRETURN(1);                      /* len != 1, can't be '2' */
 341       }
 342     temp = *av_fetch(a, 0, 0);          /* fetch first element */
 343     ST(0) = boolSV((SvIV(temp) == 2));
 344
 345 ##############################################################################
 346
 347 void
 348 _is_ten(class, x)
 349   SV*   x
 350   INIT:
 351     AV* a;
 352     SV* temp;
 353
 354   CODE:
 355     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 356     if ( av_len(a) != 0)
 357       {
 358       ST(0) = &PL_sv_no;
 359       XSRETURN(1);                      /* len != 1, can't be '10' */
 360       }
 361     temp = *av_fetch(a, 0, 0);          /* fetch first element */
 362     ST(0) = boolSV((SvIV(temp) == 10));
 363
 364 ##############################################################################
 365
 366 void
 367 _is_zero(class, x)
 368   SV*   x
 369   INIT:
 370     AV* a;
 371     SV* temp;
 372
 373   CODE:
 374     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 375     if ( av_len(a) != 0)
 376       {
 377       ST(0) = &PL_sv_no;
 378       XSRETURN(1);                      /* len != 1, can't be '0' */
 379       }
 380     temp = *av_fetch(a, 0, 0);          /* fetch first element */
 381     ST(0) = boolSV((SvIV(temp) == 0));
 382
 383 ##############################################################################
 384
 385 void
 386 _len(class,x)
 387   SV*   x
 388   INIT:
 389     AV* a;
 390     SV* temp;
 391     IV  elems;
 392     STRLEN len;
 393
 394   CODE:
 395     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
 396     elems = av_len(a);                  /* number of elems in array */
 397     temp = *av_fetch(a, elems, 0);      /* fetch last element */
 398     SvPV(temp, len);                    /* convert to string & store length */
 399     len += (IV) XS_BASE_LEN * elems;
 400     ST(0) = newSViv(len);
 401
 402 ##############################################################################
 403
 404 void
 405 _acmp(class, cx, cy);
 406   SV*  cx
 407   SV*  cy
 408   INIT:
 409     AV* array_x;
 410     AV* array_y;
 411     I32 elemsx, elemsy, diff;
 412     SV* tempx;
 413     SV* tempy;
 414     STRLEN lenx;
 415     STRLEN leny;
 416     NV diff_nv;
 417     I32 diff_str;
 418
 419   CODE:
 420     array_x = (AV*)SvRV(cx);            /* ref to aray, don't check ref */
 421     array_y = (AV*)SvRV(cy);            /* ref to aray, don't check ref */
 422     elemsx =  av_len(array_x);
 423     elemsy =  av_len(array_y);
 424     diff = elemsx - elemsy;             /* difference */
 425
 426     if (diff > 0)
 427       {
 428       ST(0) = newSViv(1);               /* len differs: X > Y */
 429       XSRETURN(1);
 430       }
 431     if (diff < 0)
 432       {
 433       ST(0) = newSViv(-1);              /* len differs: X < Y */
 434       XSRETURN(1);
 435       }
 436     /* both have same number of elements, so check length of last element
 437        and see if it differes */
 438     tempx = *av_fetch(array_x, elemsx, 0);      /* fetch last element */
 439     tempy = *av_fetch(array_y, elemsx, 0);      /* fetch last element */
 440     SvPV(tempx, lenx);                  /* convert to string & store length */
 441     SvPV(tempy, leny);                  /* convert to string & store length */
 442     diff_str = (I32)lenx - (I32)leny;
 443     if (diff_str > 0)
 444       {
 445       ST(0) = newSViv(1);               /* same len, but first elems differs in len */
 446       XSRETURN(1);
 447       }
 448     if (diff_str < 0)
 449       {
 450       ST(0) = newSViv(-1);              /* same len, but first elems differs in len */
 451       XSRETURN(1);
 452       }
 453     /* same number of digits, so need to make a full compare */
 454     diff_nv = 0;
 455     while (elemsx >= 0)
 456       {
 457       tempx = *av_fetch(array_x, elemsx, 0);    /* fetch curr x element */
 458       tempy = *av_fetch(array_y, elemsx, 0);    /* fetch curr y element */
 459       diff_nv = SvNV(tempx) - SvNV(tempy);
 460       if (diff_nv != 0)
 461         {
 462         break;
 463         }
 464       elemsx--;
 465       }
 466     if (diff_nv > 0)
 467       {
 468       ST(0) = newSViv(1);
 469       XSRETURN(1);
 470       }
 471     if (diff_nv < 0)
 472       {
 473       ST(0) = newSViv(-1);
 474       XSRETURN(1);
 475       }
 476     ST(0) = newSViv(0);         /* equal */
 477