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