cpan/Math-BigInt-FastCalc/FastCalc.xs

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