[perl5.git] / dist / 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);

BOOT:
{
    if (items < 4)
	croak_xs_usage(aTHX_ cv, "package, version, base_len, base");
    XS_BASE_LEN = SvIV(ST(2)); 
    XS_BASE = SvNV(ST(3)); 
}

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

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

  CODE:
    if (SvUOK(x) && SvUV(x) < XS_BASE)
      {
      /* shortcut for integer arguments */
      av_push (av, 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 (av, newSVpvn(cur, part_len) );
	  }
        }
      }
    RETVAL = newRV_noinc((SV *)av);
  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);

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

SV *
_zero(class)
  ALIAS:
    _one = 1
    _two = 2
    _ten = 10
  PREINIT:
    AV *av = newAV();
  CODE:
    av_push (av, newSViv( ix ));
    RETVAL = newRV_noinc((SV *)av);
  OUTPUT:
    RETVAL

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

void
_is_even(class, x)
  SV*	x
  ALIAS:
    _is_odd = 1
  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) == ix));

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

void
_is_zero(class, x)
  SV*	x
  ALIAS:
    _is_one = 1
    _is_two = 2
    _is_ten = 10
  INIT:
    AV*	a;

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

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

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
c0fdee65 NC	37	BOOT:
	38	{
	39	if (items < 4)
5e4a1484	40	croak_xs_usage(aTHX_ cv, "package, version, base_len, base");
c0fdee65 NC	41	XS_BASE_LEN = SvIV(ST(2));
	42	XS_BASE = SvNV(ST(3));
	43	}
062a4e99 T	44
062a4e99 T	45	##############################################################################
5ed38b1a T	46	# _new
5ed38b1a T	47
4019471a	48	SV *
5ed38b1a T	49	_new(class, x)
	50	SV* x
	51	INIT:
	52	STRLEN len;
	53	char* cur;
a436f3ee	54	STRLEN part_len;
4019471a	55	AV *av = newAV();
5ed38b1a T	56
5ed38b1a T	57	CODE:
206957a7	58	if (SvUOK(x) && SvUV(x) < XS_BASE)
5ed38b1a T	59	{
5ed38b1a T	60	/* shortcut for integer arguments */
4019471a	61	av_push (av, newSVuv( SvUV(x) ));
5ed38b1a T	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 */
a436f3ee	76	part_len = (STRLEN) XS_BASE_LEN;
5ed38b1a T	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	{
4019471a	87	av_push (av, newSVpvn(cur, part_len) );
5ed38b1a T	88	}
	89	}
	90	}
4019471a	91	RETVAL = newRV_noinc((SV *)av);
5ed38b1a T	92	OUTPUT:
	93	RETVAL
	94
	95	##############################################################################
062a4e99 T	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());
206957a7	110	av_extend (a2, elems); /* pre-padd */
062a4e99 T	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 */
206957a7	199	sv_setnv (temp, SvNV(temp)-1); /* decrement */
062a4e99 T	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
4019471a	297	SV *
caa64001	298	_zero(class)
2d032f98 NC	299	ALIAS:
	300	_one = 1
	301	_two = 2
	302	_ten = 10
4019471a NC	303	PREINIT:
4019471a NC	304	AV *av = newAV();
062a4e99	305	CODE:
4019471a NC	306	av_push (av, newSViv( ix ));
4019471a NC	307	RETVAL = newRV_noinc((SV *)av);
caa64001 T	308	OUTPUT:
caa64001 T	309	RETVAL
062a4e99 T	310
	311	##############################################################################
	312
	313	void
	314	_is_even(class, x)
	315	SV* x
2d032f98 NC	316	ALIAS:
2d032f98 NC	317	_is_odd = 1
062a4e99 T	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 */
2d032f98	325	ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == ix));
062a4e99 T	326
	327	##############################################################################
	328
	329	void
	330	_is_zero(class, x)
	331	SV* x
2d032f98 NC	332	ALIAS:
	333	_is_one = 1
	334	_is_two = 2
	335	_is_ten = 10
062a4e99 T	336	INIT:
062a4e99 T	337	AV* a;
062a4e99 T	338
	339	CODE:
	340	a = (AV)SvRV(x); / ref to aray, don't check ref */
	341	if ( av_len(a) != 0)
	342	{
8e1dd0a2 NC	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);
062a4e99	349	}
8e1dd0a2	350	XSRETURN(1);
062a4e99 T	351
	352	##############################################################################
	353
	354	void
	355	_len(class,x)
	356	SV* x
	357	INIT:
	358	AV* a;
	359	SV* temp;
6c0b8e73	360	IV elems;
062a4e99 T	361	STRLEN len;
	362
	363	CODE:
	364	a = (AV)SvRV(x); / ref to aray, don't check ref */
6c0b8e73	365	elems = av_len(a); /* number of elems in array */
062a4e99 T	366	temp = av_fetch(a, elems, 0); / fetch last element */
062a4e99 T	367	SvPV(temp, len); /* convert to string & store length */
6c0b8e73	368	len += (IV) XS_BASE_LEN * elems;
7d193e39	369	ST(0) = sv_2mortal(newSViv(len));
062a4e99 T	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	{
7d193e39	397	RETURN_MORTAL_INT(1); /* len differs: X > Y */
062a4e99	398	}
7d193e39	399	else if (diff < 0)
062a4e99	400	{
7d193e39	401	RETURN_MORTAL_INT(-1); /* len differs: X < Y */
062a4e99 T	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	{
7d193e39	412	RETURN_MORTAL_INT(1); /* same len, but first elems differs in len */
062a4e99 T	413	}
	414	if (diff_str < 0)
	415	{
7d193e39	416	RETURN_MORTAL_INT(-1); /* same len, but first elems differs in len */
062a4e99 T	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	{
7d193e39	433	RETURN_MORTAL_INT(1);
062a4e99 T	434	}
	435	if (diff_nv < 0)
	436	{
7d193e39	437	RETURN_MORTAL_INT(-1);
062a4e99	438	}
7d193e39	439	ST(0) = sv_2mortal(newSViv(0)); /* X and Y are equal */
062a4e99	440