[perl5.git] / cpan / Math-BigInt-FastCalc / FastCalc.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* for Perl prior to v5.7.1 */
#ifndef SvUOK
#  define SvUOK(sv) SvIOK_UV(sv)
#endif

double XS_BASE = 0;
double XS_BASE_LEN = 0;

MODULE = Math::BigInt::FastCalc		PACKAGE = Math::BigInt::FastCalc

PROTOTYPES: DISABLE

 #############################################################################
 # 2002-08-12 0.03 Tels unreleased
 #  * is_zero/is_one/is_odd/is_even/len work now (pass v1.61 tests)
 # 2002-08-13 0.04 Tels unreleased
 #  * returns no/yes for is_foo() methods to be faster
 # 2002-08-18 0.06alpha
 #  * added _num(), _inc() and _dec()
 # 2002-08-25 0.06 Tels
 #  * added __strip_zeros(), _copy()
 # 2004-08-13 0.07 Tels
 #  * added _is_two(), _is_ten(), _ten()
 # 2007-04-02 0.08 Tels
 #  * plug leaks by creating mortals
 # 2007-05-27 0.09 Tels
 #  * add _new()

#define RETURN_MORTAL_INT(value)		\
      ST(0) = sv_2mortal(newSViv(value));	\
      XSRETURN(1);

#define RETURN_MORTAL_BOOL(temp, comp)			\
      ST(0) = sv_2mortal(boolSV( SvIV(temp) == comp));

#define CONSTANT_OBJ(int)			\
    RETVAL = newAV();				\
    sv_2mortal((SV*)RETVAL);			\
    av_push (RETVAL, newSViv( int ));

void 
_set_XS_BASE(BASE, BASE_LEN)
  SV* BASE
  SV* BASE_LEN

  CODE:
    XS_BASE = SvNV(BASE); 
    XS_BASE_LEN = SvIV(BASE_LEN); 

##############################################################################
# _new

AV *
_new(class, x)
  SV*	x
  INIT:
    STRLEN len;
    char* cur;
    STRLEN part_len;

  CODE:
    /* create the array */
    RETVAL = newAV();
    sv_2mortal((SV*)RETVAL);
    if (SvUOK(x) && SvUV(x) < XS_BASE)
      {
      /* shortcut for integer arguments */
      av_push (RETVAL, newSVuv( SvUV(x) ));
      }
    else
      {
      /* split the input (as string) into XS_BASE_LEN long parts */
      /* in perl:
		[ reverse(unpack("a" . ($il % $BASE_LEN+1)
		. ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
      */
      cur = SvPV(x, len);			/* convert to string & store length */
      cur += len;				/* doing "cur = SvEND(x)" does not work! */
      # process the string from the back
      while (len > 0)
        {
        /* use either BASE_LEN or the amount of remaining digits */
        part_len = (STRLEN) XS_BASE_LEN;
        if (part_len > len)
          {
          part_len = len;
          }
        /* processed so many digits */
        cur -= part_len;
        len -= part_len;
        /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */
        if (part_len > 0)
	  {
	  av_push (RETVAL, newSVpvn(cur, part_len) );
	  }
        }
      }
  OUTPUT:
    RETVAL

##############################################################################
# _copy

void
_copy(class, x)
  SV*	x
  INIT:
    AV*	a;
    AV*	a2;
    I32	elems;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */
    a2 = (AV*)sv_2mortal((SV*)newAV());
    av_extend (a2, elems);		/* pre-padd */
    while (elems >= 0)
      {
      /* av_store( a2,  elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */

      /* looking and trying to preserve IV is actually slower when copying */
      /* temp = (SV*)*av_fetch(a, elems, 0);
      if (SvIOK(temp))
        {
        av_store( a2,  elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) )));
        }
      else
        {
        av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
        }
      */
      av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
      elems--;
      }
    ST(0) = sv_2mortal( newRV_inc((SV*) a2) );

##############################################################################
# __strip_zeros (also check for empty arrays from div)

void
__strip_zeros(x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;
    I32	elems;
    I32	index;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */
    ST(0) = x;				/* we return x */
    if (elems == -1)
      { 
      av_push (a, newSViv(0));		/* correct empty arrays */
      XSRETURN(1);
      }
    if (elems == 0)
      {
      XSRETURN(1);			/* nothing to do since only one elem */
      }
    index = elems;
    while (index > 0)
      {
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
      if (SvNV(temp) != 0)
        {
        break;
        }
      index--;
      }
    if (index < elems)
      {
      index = elems - index;
      while (index-- > 0)
        {
        av_pop (a);
        }
      }
    XSRETURN(1);

##############################################################################
# decrement (subtract one)

void
_dec(class,x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;
    I32	elems;
    I32	index;
    NV	MAX;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */
    ST(0) = x;				/* we return x */

    MAX = XS_BASE - 1;
    index = 0;
    while (index <= elems)
      {
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
      sv_setnv (temp, SvNV(temp)-1);	/* decrement */
      if (SvNV(temp) >= 0)
        {
        break;				/* early out */
        }
      sv_setnv (temp, MAX);		/* overflow, so set this to $MAX */
      index++;
      } 
    /* do have more than one element? */
    /* (more than one because [0] should be kept as single-element) */
    if (elems > 0)
      {
      temp = *av_fetch(a, elems, 0);	/* fetch last element */
      if (SvIV(temp) == 0)		/* did last elem overflow? */ 
        {
        av_pop(a);			/* yes, so shrink array */
        				/* aka remove leading zeros */
        }
      }
    XSRETURN(1);			/* return x */

##############################################################################
# increment (add one)

void
_inc(class,x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;
    I32	elems;
    I32	index;
    NV	BASE;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */
    ST(0) = x;				/* we return x */

    BASE = XS_BASE;
    index = 0;
    while (index <= elems)
      {
      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
      sv_setnv (temp, SvNV(temp)+1);
      if (SvNV(temp) < BASE)
        {
        XSRETURN(1);			/* return (early out) */
        }
      sv_setiv (temp, 0);		/* overflow, so set this elem to 0 */
      index++;
      } 
    temp = *av_fetch(a, elems, 0);	/* fetch last element */
    if (SvIV(temp) == 0)		/* did last elem overflow? */
      {
      av_push(a, newSViv(1));		/* yes, so extend array by 1 */
      }
    XSRETURN(1);			/* return x */

##############################################################################
# Make a number (scalar int/float) from a BigInt object

void
_num(class,x)
  SV*	x
  INIT:
    AV*	a;
    NV	fac;
    SV*	temp;
    NV	num;
    I32	elems;
    I32	index;
    NV	BASE;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */

    if (elems == 0)			/* only one element? */
      {
      ST(0) = *av_fetch(a, 0, 0);	/* fetch first (only) element */
      XSRETURN(1);			/* return it */
      }
    fac = 1.0;				/* factor */
    index = 0;
    num = 0.0;
    BASE = XS_BASE;
    while (index <= elems)
      {
      temp = *av_fetch(a, index, 0);	/* fetch current element */
      num += fac * SvNV(temp);
      fac *= BASE;
      index++;
      }
    ST(0) = newSVnv(num);

##############################################################################

AV *
_zero(class)
  CODE:
    CONSTANT_OBJ(0)
  OUTPUT:
    RETVAL

##############################################################################

AV *
_one(class)
  CODE:
    CONSTANT_OBJ(1)
  OUTPUT:
    RETVAL

##############################################################################

AV *
_two(class)
  CODE:
    CONSTANT_OBJ(2)
  OUTPUT:
    RETVAL

##############################################################################

AV *
_ten(class)
  CODE:
    CONSTANT_OBJ(10)
  OUTPUT:
    RETVAL

##############################################################################

void
_is_even(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
    temp = *av_fetch(a, 0, 0);	/* fetch first element */
    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == 0));

##############################################################################

void
_is_odd(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
    temp = *av_fetch(a, 0, 0);	/* fetch first element */
    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) != 0));

##############################################################################

void
_is_one(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    if ( av_len(a) != 0)
      {
      ST(0) = &PL_sv_no;
      XSRETURN(1);			/* len != 1, can't be '1' */
      }
    temp = *av_fetch(a, 0, 0);		/* fetch first element */
    RETURN_MORTAL_BOOL(temp, 1);

##############################################################################

void
_is_two(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    if ( av_len(a) != 0)
      {
      ST(0) = &PL_sv_no;
      XSRETURN(1);			/* len != 1, can't be '2' */
      }
    temp = *av_fetch(a, 0, 0);		/* fetch first element */
    RETURN_MORTAL_BOOL(temp, 2);

##############################################################################

void
_is_ten(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    if ( av_len(a) != 0)
      {
      ST(0) = &PL_sv_no;
      XSRETURN(1);			/* len != 1, can't be '10' */
      }
    temp = *av_fetch(a, 0, 0);		/* fetch first element */
    RETURN_MORTAL_BOOL(temp, 10);

##############################################################################

void
_is_zero(class, x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    if ( av_len(a) != 0)
      {
      ST(0) = &PL_sv_no;
      XSRETURN(1);			/* len != 1, can't be '0' */
      }
    temp = *av_fetch(a, 0, 0);		/* fetch first element */
    RETURN_MORTAL_BOOL(temp, 0);

##############################################################################

void
_len(class,x)
  SV*	x
  INIT:
    AV*	a;
    SV*	temp;
    IV	elems;
    STRLEN len;

  CODE:
    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
    elems = av_len(a);			/* number of elems in array */
    temp = *av_fetch(a, elems, 0);	/* fetch last element */
    SvPV(temp, len);			/* convert to string & store length */
    len += (IV) XS_BASE_LEN * elems;
    ST(0) = sv_2mortal(newSViv(len));

##############################################################################

void
_acmp(class, cx, cy);
  SV*  cx
  SV*  cy
  INIT:
    AV* array_x;
    AV* array_y;
    I32 elemsx, elemsy, diff;
    SV* tempx;
    SV* tempy;
    STRLEN lenx;
    STRLEN leny;
    NV diff_nv;
    I32 diff_str;

  CODE:
    array_x = (AV*)SvRV(cx);		/* ref to aray, don't check ref */
    array_y = (AV*)SvRV(cy);		/* ref to aray, don't check ref */
    elemsx =  av_len(array_x);
    elemsy =  av_len(array_y);
    diff = elemsx - elemsy;		/* difference */

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