[p5sagit/p5-mst-13.2.git] / ext / Math / BigInt / FastCalc / FastCalc.xs

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

double XS_BASE = 0;
double XS_BASE_LEN = 0;

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

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