Blame FastCalc.xs

Packit dcde0c
#define PERL_NO_GET_CONTEXT
Packit dcde0c
Packit dcde0c
#include "EXTERN.h"
Packit dcde0c
#include "perl.h"
Packit dcde0c
#include "XSUB.h"
Packit dcde0c
Packit dcde0c
/* for Perl prior to v5.7.1 */
Packit dcde0c
#ifndef SvUOK
Packit dcde0c
#  define SvUOK(sv) SvIOK_UV(sv)
Packit dcde0c
#endif
Packit dcde0c
Packit dcde0c
/* for Perl v5.6 (RT #63859) */
Packit dcde0c
#ifndef croak_xs_usage
Packit dcde0c
# define croak_xs_usage croak
Packit dcde0c
#endif
Packit dcde0c
Packit dcde0c
static double XS_BASE = 0;
Packit dcde0c
static double XS_BASE_LEN = 0;
Packit dcde0c
Packit dcde0c
MODULE = Math::BigInt::FastCalc		PACKAGE = Math::BigInt::FastCalc
Packit dcde0c
Packit dcde0c
PROTOTYPES: DISABLE
Packit dcde0c
Packit dcde0c
 #############################################################################
Packit dcde0c
 # 2002-08-12 0.03 Tels unreleased
Packit dcde0c
 #  * is_zero/is_one/is_odd/is_even/len work now (pass v1.61 tests)
Packit dcde0c
 # 2002-08-13 0.04 Tels unreleased
Packit dcde0c
 #  * returns no/yes for is_foo() methods to be faster
Packit dcde0c
 # 2002-08-18 0.06alpha
Packit dcde0c
 #  * added _num(), _inc() and _dec()
Packit dcde0c
 # 2002-08-25 0.06 Tels
Packit dcde0c
 #  * added __strip_zeros(), _copy()
Packit dcde0c
 # 2004-08-13 0.07 Tels
Packit dcde0c
 #  * added _is_two(), _is_ten(), _ten()
Packit dcde0c
 # 2007-04-02 0.08 Tels
Packit dcde0c
 #  * plug leaks by creating mortals
Packit dcde0c
 # 2007-05-27 0.09 Tels
Packit dcde0c
 #  * add _new()
Packit dcde0c
Packit dcde0c
#define RETURN_MORTAL_INT(value)		\
Packit dcde0c
      ST(0) = sv_2mortal(newSViv(value));	\
Packit dcde0c
      XSRETURN(1);
Packit dcde0c
Packit dcde0c
BOOT:
Packit dcde0c
{
Packit dcde0c
    if (items < 4)
Packit dcde0c
	croak("Usage: Math::BigInt::FastCalc::BOOT(package, version, base_len, base)");
Packit dcde0c
    XS_BASE_LEN = SvIV(ST(2));
Packit dcde0c
    XS_BASE = SvNV(ST(3));
Packit dcde0c
}
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
# _new
Packit dcde0c
Packit dcde0c
SV *
Packit dcde0c
_new(class, x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    STRLEN len;
Packit dcde0c
    char* cur;
Packit dcde0c
    STRLEN part_len;
Packit dcde0c
    AV *av = newAV();
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    if (SvUOK(x) && SvUV(x) < XS_BASE)
Packit dcde0c
      {
Packit dcde0c
      /* shortcut for integer arguments */
Packit dcde0c
      av_push (av, newSVuv( SvUV(x) ));
Packit dcde0c
      }
Packit dcde0c
    else
Packit dcde0c
      {
Packit dcde0c
      /* split the input (as string) into XS_BASE_LEN long parts */
Packit dcde0c
      /* in perl:
Packit dcde0c
		[ reverse(unpack("a" . ($il % $BASE_LEN+1)
Packit dcde0c
		. ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
Packit dcde0c
      */
Packit dcde0c
      cur = SvPV(x, len);			/* convert to string & store length */
Packit dcde0c
      cur += len;				/* doing "cur = SvEND(x)" does not work! */
Packit dcde0c
      # process the string from the back
Packit dcde0c
      while (len > 0)
Packit dcde0c
        {
Packit dcde0c
        /* use either BASE_LEN or the amount of remaining digits */
Packit dcde0c
        part_len = (STRLEN) XS_BASE_LEN;
Packit dcde0c
        if (part_len > len)
Packit dcde0c
          {
Packit dcde0c
          part_len = len;
Packit dcde0c
          }
Packit dcde0c
        /* processed so many digits */
Packit dcde0c
        cur -= part_len;
Packit dcde0c
        len -= part_len;
Packit dcde0c
        /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */
Packit dcde0c
        if (part_len > 0)
Packit dcde0c
	  {
Packit dcde0c
	  av_push (av, newSVpvn(cur, part_len) );
Packit dcde0c
	  }
Packit dcde0c
        }
Packit dcde0c
      }
Packit dcde0c
    RETVAL = newRV_noinc((SV *)av);
Packit dcde0c
  OUTPUT:
Packit dcde0c
    RETVAL
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
# _copy
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_copy(class, x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    AV*	a2;
Packit dcde0c
    SSize_t elems;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    elems = av_len(a);			/* number of elems in array */
Packit dcde0c
    a2 = (AV*)sv_2mortal((SV*)newAV());
Packit dcde0c
    av_extend (a2, elems);		/* pre-padd */
Packit dcde0c
    while (elems >= 0)
Packit dcde0c
      {
Packit dcde0c
      /* av_store( a2,  elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */
Packit dcde0c
Packit dcde0c
      /* looking and trying to preserve IV is actually slower when copying */
Packit dcde0c
      /* temp = (SV*)*av_fetch(a, elems, 0);
Packit dcde0c
      if (SvIOK(temp))
Packit dcde0c
        {
Packit dcde0c
        av_store( a2,  elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) )));
Packit dcde0c
        }
Packit dcde0c
      else
Packit dcde0c
        {
Packit dcde0c
        av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
Packit dcde0c
        }
Packit dcde0c
      */
Packit dcde0c
      av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
Packit dcde0c
      elems--;
Packit dcde0c
      }
Packit dcde0c
    ST(0) = sv_2mortal( newRV_inc((SV*) a2) );
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
# __strip_zeros (also check for empty arrays from div)
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
__strip_zeros(x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    SV*	temp;
Packit dcde0c
    SSize_t elems;
Packit dcde0c
    SSize_t index;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    elems = av_len(a);			/* number of elems in array */
Packit dcde0c
    ST(0) = x;				/* we return x */
Packit dcde0c
    if (elems == -1)
Packit dcde0c
      {
Packit dcde0c
      av_push (a, newSViv(0));		/* correct empty arrays */
Packit dcde0c
      XSRETURN(1);
Packit dcde0c
      }
Packit dcde0c
    if (elems == 0)
Packit dcde0c
      {
Packit dcde0c
      XSRETURN(1);			/* nothing to do since only one elem */
Packit dcde0c
      }
Packit dcde0c
    index = elems;
Packit dcde0c
    while (index > 0)
Packit dcde0c
      {
Packit dcde0c
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
Packit dcde0c
      if (SvNV(temp) != 0)
Packit dcde0c
        {
Packit dcde0c
        break;
Packit dcde0c
        }
Packit dcde0c
      index--;
Packit dcde0c
      }
Packit dcde0c
    if (index < elems)
Packit dcde0c
      {
Packit dcde0c
      index = elems - index;
Packit dcde0c
      while (index-- > 0)
Packit dcde0c
        {
Packit dcde0c
        av_pop (a);
Packit dcde0c
        }
Packit dcde0c
      }
Packit dcde0c
    XSRETURN(1);
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
# decrement (subtract one)
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_dec(class,x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    SV*	temp;
Packit dcde0c
    SSize_t elems;
Packit dcde0c
    SSize_t index;
Packit dcde0c
    NV	MAX;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    elems = av_len(a);			/* number of elems in array */
Packit dcde0c
    ST(0) = x;				/* we return x */
Packit dcde0c
Packit dcde0c
    MAX = XS_BASE - 1;
Packit dcde0c
    index = 0;
Packit dcde0c
    while (index <= elems)
Packit dcde0c
      {
Packit dcde0c
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
Packit dcde0c
      sv_setnv (temp, SvNV(temp)-1);	/* decrement */
Packit dcde0c
      if (SvNV(temp) >= 0)
Packit dcde0c
        {
Packit dcde0c
        break;				/* early out */
Packit dcde0c
        }
Packit dcde0c
      sv_setnv (temp, MAX);		/* overflow, so set this to $MAX */
Packit dcde0c
      index++;
Packit dcde0c
      }
Packit dcde0c
    /* do have more than one element? */
Packit dcde0c
    /* (more than one because [0] should be kept as single-element) */
Packit dcde0c
    if (elems > 0)
Packit dcde0c
      {
Packit dcde0c
      temp = *av_fetch(a, elems, 0);	/* fetch last element */
Packit dcde0c
      if (SvIV(temp) == 0)		/* did last elem overflow? */
Packit dcde0c
        {
Packit dcde0c
        av_pop(a);			/* yes, so shrink array */
Packit dcde0c
        				/* aka remove leading zeros */
Packit dcde0c
        }
Packit dcde0c
      }
Packit dcde0c
    XSRETURN(1);			/* return x */
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
# increment (add one)
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_inc(class,x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    SV*	temp;
Packit dcde0c
    SSize_t elems;
Packit dcde0c
    SSize_t index;
Packit dcde0c
    NV	BASE;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    elems = av_len(a);			/* number of elems in array */
Packit dcde0c
    ST(0) = x;				/* we return x */
Packit dcde0c
Packit dcde0c
    BASE = XS_BASE;
Packit dcde0c
    index = 0;
Packit dcde0c
    while (index <= elems)
Packit dcde0c
      {
Packit dcde0c
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
Packit dcde0c
      sv_setnv (temp, SvNV(temp)+1);
Packit dcde0c
      if (SvNV(temp) < BASE)
Packit dcde0c
        {
Packit dcde0c
        XSRETURN(1);			/* return (early out) */
Packit dcde0c
        }
Packit dcde0c
      sv_setiv (temp, 0);		/* overflow, so set this elem to 0 */
Packit dcde0c
      index++;
Packit dcde0c
      }
Packit dcde0c
    temp = *av_fetch(a, elems, 0);	/* fetch last element */
Packit dcde0c
    if (SvIV(temp) == 0)		/* did last elem overflow? */
Packit dcde0c
      {
Packit dcde0c
      av_push(a, newSViv(1));		/* yes, so extend array by 1 */
Packit dcde0c
      }
Packit dcde0c
    XSRETURN(1);			/* return x */
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
Packit dcde0c
SV *
Packit dcde0c
_zero(class)
Packit dcde0c
  ALIAS:
Packit dcde0c
    _one = 1
Packit dcde0c
    _two = 2
Packit dcde0c
    _ten = 10
Packit dcde0c
  PREINIT:
Packit dcde0c
    AV *av = newAV();
Packit dcde0c
  CODE:
Packit dcde0c
    av_push (av, newSViv( ix ));
Packit dcde0c
    RETVAL = newRV_noinc((SV *)av);
Packit dcde0c
  OUTPUT:
Packit dcde0c
    RETVAL
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_is_even(class, x)
Packit dcde0c
  SV*	x
Packit dcde0c
  ALIAS:
Packit dcde0c
    _is_odd = 1
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    SV*	temp;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
Packit dcde0c
    temp = *av_fetch(a, 0, 0);	/* fetch first element */
Packit dcde0c
    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == ix));
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_is_zero(class, x)
Packit dcde0c
  SV*	x
Packit dcde0c
  ALIAS:
Packit dcde0c
    _is_one = 1
Packit dcde0c
    _is_two = 2
Packit dcde0c
    _is_ten = 10
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    if ( av_len(a) != 0)
Packit dcde0c
      {
Packit dcde0c
      ST(0) = &PL_sv_no;		/* len != 1, can't be '0' */
Packit dcde0c
      }
Packit dcde0c
    else
Packit dcde0c
      {
Packit dcde0c
      SV *const temp = *av_fetch(a, 0, 0);	/* fetch first element */
Packit dcde0c
      ST(0) = boolSV(SvIV(temp) == ix);
Packit dcde0c
      }
Packit dcde0c
    XSRETURN(1);
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_len(class,x)
Packit dcde0c
  SV*	x
Packit dcde0c
  INIT:
Packit dcde0c
    AV*	a;
Packit dcde0c
    SV*	temp;
Packit dcde0c
    IV	elems;
Packit dcde0c
    STRLEN len;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
Packit dcde0c
    elems = av_len(a);			/* number of elems in array */
Packit dcde0c
    temp = *av_fetch(a, elems, 0);	/* fetch last element */
Packit dcde0c
    SvPV(temp, len);			/* convert to string & store length */
Packit dcde0c
    len += (IV) XS_BASE_LEN * elems;
Packit dcde0c
    ST(0) = sv_2mortal(newSViv(len));
Packit dcde0c
Packit dcde0c
##############################################################################
Packit dcde0c
Packit dcde0c
void
Packit dcde0c
_acmp(class, cx, cy);
Packit dcde0c
  SV*  cx
Packit dcde0c
  SV*  cy
Packit dcde0c
  INIT:
Packit dcde0c
    AV* array_x;
Packit dcde0c
    AV* array_y;
Packit dcde0c
    SSize_t elemsx, elemsy, diff;
Packit dcde0c
    SV* tempx;
Packit dcde0c
    SV* tempy;
Packit dcde0c
    STRLEN lenx;
Packit dcde0c
    STRLEN leny;
Packit dcde0c
    NV diff_nv;
Packit dcde0c
    SSize_t diff_str;
Packit dcde0c
Packit dcde0c
  CODE:
Packit dcde0c
    array_x = (AV*)SvRV(cx);		/* ref to aray, don't check ref */
Packit dcde0c
    array_y = (AV*)SvRV(cy);		/* ref to aray, don't check ref */
Packit dcde0c
    elemsx =  av_len(array_x);
Packit dcde0c
    elemsy =  av_len(array_y);
Packit dcde0c
    diff = elemsx - elemsy;		/* difference */
Packit dcde0c
Packit dcde0c
    if (diff > 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(1);		/* len differs: X > Y */
Packit dcde0c
      }
Packit dcde0c
    else if (diff < 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(-1);		/* len differs: X < Y */
Packit dcde0c
      }
Packit dcde0c
    /* both have same number of elements, so check length of last element
Packit dcde0c
       and see if it differs */
Packit dcde0c
    tempx = *av_fetch(array_x, elemsx, 0);	/* fetch last element */
Packit dcde0c
    tempy = *av_fetch(array_y, elemsx, 0);	/* fetch last element */
Packit dcde0c
    SvPV(tempx, lenx);			/* convert to string & store length */
Packit dcde0c
    SvPV(tempy, leny);			/* convert to string & store length */
Packit dcde0c
    diff_str = (SSize_t)lenx - (SSize_t)leny;
Packit dcde0c
    if (diff_str > 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(1);		/* same len, but first elems differs in len */
Packit dcde0c
      }
Packit dcde0c
    if (diff_str < 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(-1);		/* same len, but first elems differs in len */
Packit dcde0c
      }
Packit dcde0c
    /* same number of digits, so need to make a full compare */
Packit dcde0c
    diff_nv = 0;
Packit dcde0c
    while (elemsx >= 0)
Packit dcde0c
      {
Packit dcde0c
      tempx = *av_fetch(array_x, elemsx, 0);	/* fetch curr x element */
Packit dcde0c
      tempy = *av_fetch(array_y, elemsx, 0);	/* fetch curr y element */
Packit dcde0c
      diff_nv = SvNV(tempx) - SvNV(tempy);
Packit dcde0c
      if (diff_nv != 0)
Packit dcde0c
        {
Packit dcde0c
        break;
Packit dcde0c
        }
Packit dcde0c
      elemsx--;
Packit dcde0c
      }
Packit dcde0c
    if (diff_nv > 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(1);
Packit dcde0c
      }
Packit dcde0c
    if (diff_nv < 0)
Packit dcde0c
      {
Packit dcde0c
      RETURN_MORTAL_INT(-1);
Packit dcde0c
      }
Packit dcde0c
    ST(0) = sv_2mortal(newSViv(0));		/* X and Y are equal */