GMP.xs

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

typedef mpz_t mpz_t_ornull;

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

#ifndef PERL_UNUSED_ARG
#  define PERL_UNUSED_ARG(x) ((void)x)
#endif

#ifndef gv_stashpvs
#  define gv_stashpvs(name, create) gv_stashpvn(name, sizeof(name) - 1, create)
#endif

#ifndef PERL_MAGIC_ext
#  define PERL_MAGIC_ext '~'
#endif

#if defined(USE_ITHREADS) && defined(MGf_DUP)
#  define GMP_THREADSAFE 1
#else
#  define GMP_THREADSAFE 0
#endif

#ifdef sv_magicext
#  define GMP_HAS_MAGICEXT 1
#else
#  define GMP_HAS_MAGICEXT 0
#endif

#define NEW_GMP_MPZ_T      RETVAL = malloc (sizeof(mpz_t));
#define NEW_GMP_MPZ_T_INIT RETVAL = malloc (sizeof(mpz_t)); mpz_init(*RETVAL);
#define GMP_GET_ARG_0      TEMP = mpz_from_sv(x);
#define GMP_GET_ARG_1      TEMP_1 = mpz_from_sv(y);
#define GMP_GET_ARGS_0_1   GMP_GET_ARG_0; GMP_GET_ARG_1;

#if GMP_THREADSAFE
STATIC int
dup_gmp_mpz (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
{
  mpz_t *RETVAL;
  PERL_UNUSED_ARG(params);
  NEW_GMP_MPZ_T;
  mpz_init_set(*RETVAL, *((mpz_t *)mg->mg_ptr));
  mg->mg_ptr = (char *)RETVAL;
  return 0;
}
#endif

#if GMP_HAS_MAGICEXT
STATIC MGVTBL vtbl_gmp = {
  NULL, /* get */
  NULL, /* set */
  NULL, /* len */
  NULL, /* clear */
  NULL, /* free */
# ifdef MGf_COPY
  NULL, /* copy */
# endif
# ifdef MGf_DUP
#  if GMP_THREADSAFE
  dup_gmp_mpz,
#  else
  NULL, /* dup */
#  endif
# endif
# ifdef MGf_LOCAL
  NULL, /* local */
# endif
};
#endif

STATIC void
attach_mpz_to_sv (SV *sv, mpz_t *mpz)
{
#if GMP_THREADSAFE
  MAGIC *mg;
#endif
#if !GMP_HAS_MAGICEXT
  SV *refaddr = sv_2mortal(newSViv(PTR2IV(mpz)));
#endif

  sv_bless(sv, gv_stashpvs("Math::BigInt::GMP", 0));

#if GMP_THREADSAFE && GMP_HAS_MAGICEXT
  mg =
#endif
#if GMP_HAS_MAGICEXT
    sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &vtbl_gmp, (void *)mpz, 0);
#else
  sv_magic(SvRV(sv), NULL, PERL_MAGIC_ext, (void *)refaddr, HEf_SVKEY);
#endif

#if GMP_THREADSAFE && GMP_HAS_MAGICEXT
  mg->mg_flags |= MGf_DUP;
#endif
}

STATIC SV *
sv_from_mpz (mpz_t *mpz)
{
  SV *sv = newSV(0);
  SV *obj = newRV_noinc(sv);

  attach_mpz_to_sv(obj, mpz);

  return obj;
}

STATIC mpz_t *
mpz_from_sv_nofail (SV *sv)
{
  MAGIC *mg;

  if (!sv_derived_from(sv, "Math::BigInt::GMP"))
    croak("not of type Math::BigInt::GMP");

  for (mg = SvMAGIC(SvRV(sv)); mg; mg = mg->mg_moremagic) {
    if (mg->mg_type == PERL_MAGIC_ext
#if GMP_HAS_MAGICEXT
        && mg->mg_virtual == &vtbl_gmp
#endif
        ) {
#if GMP_HAS_MAGICEXT
      return (mpz_t *)mg->mg_ptr;
#else
      return INT2PTR(mpz_t *, SvIV((SV *)mg->mg_ptr));
#endif
    }
  }

  return (mpz_t *)NULL;
}

STATIC mpz_t *
mpz_from_sv (SV *sv)
{
  mpz_t *mpz;

  if (!(mpz = mpz_from_sv_nofail(sv)))
    croak("failed to fetch mpz pointer");

  return mpz;
}

/*
Math::BigInt::GMP XS code, loosely based on Math::GMP, a Perl module for
high-speed arbitrary size integer calculations (C) 2000 James H. Turner
*/

MODULE = Math::BigInt::GMP              PACKAGE = Math::BigInt::GMP
PROTOTYPES: ENABLE

##############################################################################
# _new()

mpz_t *
_new(Class,x)
        SV*     x

  CODE:
    NEW_GMP_MPZ_T;
    /* using the IV directly is a bit faster */
    if ((SvUOK(x) || SvIOK(x)) && (sizeof(UV) <= sizeof(unsigned long) || SvUV(x) == (unsigned long)SvUV(x)))
      {
      mpz_init_set_ui(*RETVAL, (unsigned long)SvUV(x));
      }
    else
      {
      mpz_init_set_str(*RETVAL, SvPV_nolen(x), 10);
      }
  OUTPUT:
    RETVAL

##############################################################################
# _new_attach()

void
_new_attach(Class,sv,x)
    SV *sv
    SV *x
  PREINIT:
    mpz_t *mpz;
  CODE:
    mpz = malloc (sizeof(mpz_t));
    if ((SvUOK(x) || SvIOK(x)) && (sizeof(UV) <= sizeof(unsigned long) || SvUV(x) == (unsigned long)SvUV(x))) {
      mpz_init_set_ui(*mpz, (unsigned long)SvUV(x));
    }
    else {
      mpz_init_set_str(*mpz, SvPV_nolen(x), 10);
    }
    attach_mpz_to_sv(sv, mpz);

##############################################################################
# _from_bin()

mpz_t *
_from_bin(Class,x)
        SV*     x

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_str(*RETVAL, SvPV_nolen(x), 0);
  OUTPUT:
    RETVAL

##############################################################################
# _from_hex()

mpz_t *
_from_hex(Class,x)
        SV*     x

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_str(*RETVAL, SvPV_nolen(x), 0);
  OUTPUT:
    RETVAL

##############################################################################
# _from_oct()

mpz_t *
_from_oct(Class,x)
        SV*     x

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_str(*RETVAL, SvPV_nolen(x), 0);
  OUTPUT:
    RETVAL

##############################################################################
# _set() - set an already existing object to the given scalar value

void
_set(Class,n,x)
        mpz_t*  n
        SV*     x

  CODE:
    mpz_init_set_ui(*n, SvIV(x));

##############################################################################
# _zero()

mpz_t *
_zero(Class)

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_ui(*RETVAL, 0);
  OUTPUT:
    RETVAL

##############################################################################
# _one()

mpz_t *
_one(Class)

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_ui(*RETVAL, 1);
  OUTPUT:
    RETVAL

##############################################################################
# _two()

mpz_t *
_two(Class)

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_ui(*RETVAL, 2);
  OUTPUT:
    RETVAL

##############################################################################
# _ten()

mpz_t *
_ten(Class)

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_ui(*RETVAL, 10);
  OUTPUT:
    RETVAL

##############################################################################
# _1ex()

mpz_t *
_1ex(Class,x)
    int x;

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set_ui(*RETVAL, 10);
    mpz_pow_ui(*RETVAL, *RETVAL, x);
  OUTPUT:
    RETVAL

##############################################################################
# DESTROY() - free memory of a GMP number

void
DESTROY(n)
        mpz_t_ornull*   n

  PPCODE:
    if (n) {
        mpz_clear(*n);
        free(n);
    }

##############################################################################
# _str() - return string so that atof() and atoi() can use it

SV *
_str(Class, n)
        mpz_t*  n
  PREINIT:
    int len;
    char *buf;
    char *buf_end;

  CODE:
    /* len is always >= 1, and might be off (greater) by one than real len */
    len = mpz_sizeinbase(*n, 10);
    RETVAL = newSV(len);                /* alloc len +1 bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    buf_end = buf + len - 1;            /* end of storage (-1)*/
    mpz_get_str(buf, 10, *n);           /* convert to decimal string */
    if (*buf_end == 0)
      {
      len --;                           /* got one shorter than expected */
      }
    SvCUR_set(RETVAL, len);             /* so set real length */
   OUTPUT:
     RETVAL

##############################################################################
# _len() - return the length of the number in base 10 (costly)

int
_len(Class, n)
        mpz_t*  n
  PREINIT:
    char *buf;
    char *buf_end;

  CODE:
    /* len is always >= 1, and might be off (greater) by one than real len */
    RETVAL = mpz_sizeinbase(*n, 10);
    if (RETVAL > 1)                     /* is at least 10? */
      {
      New(0, buf, RETVAL + 1, I8);      /* alloc scratch buffer (len+1) bytes */
      buf_end = buf + RETVAL - 1;       /* end of storage (-1)*/
      mpz_get_str(buf, 10, *n);         /* convert to decimal string */
      if (*buf_end == 0)
        {
        RETVAL --;                      /* got one shorter than expected */
        }
      Safefree(buf);                    /* free the scratch buffer */
      }
   OUTPUT:
     RETVAL

##############################################################################
# _alen() - return the approx. length of the number in base 10 (fast)

int
_alen(Class, n)
        mpz_t*  n

  CODE:
    /* len is always >= 1, and might be off (greater) by one than real len */
    RETVAL = mpz_sizeinbase(*n, 10);
   OUTPUT:
     RETVAL

##############################################################################
# _zeros() - return number of trailing zeros (in decimal form)
# This is costly, since it needs O(N*N) to convert the number to decimal,
# even though for most cases the number does not have many trailing zeros.
# For numbers longer than X digits (10?) we could divide repeatable by 1e5
# or something and see if we get zeros.

int
_zeros(Class,n)
        mpz_t*  n

  PREINIT:
    int len;
    char *buf;
    char *buf_end;

  CODE:
    /* odd numbers can not have trailing zeros */
    RETVAL = 1 - mpz_tstbit(*n,0);

    if (RETVAL != 0)                    /* was even */
      {
      /* len is always >= 1, and might be off (greater) by one than real len */
      RETVAL = 0;
      len = mpz_sizeinbase(*n, 10);
      if (len > 1)                      /* '0' has no trailing zeros! */
        {
        New(0, buf, len + 1, I8);
        mpz_get_str(buf, 10, *n);       /* convert to decimal string */
        buf_end = buf + len - 1;
        if (*buf_end == 0)              /* points to terminating zero? */
          {
          buf_end--;                    /* ptr to last real digit */
          len--;                        /* got one shorter than expected */
          }
        while (len-- > 0)               /* actually, we should hit a non-zero before the end */
          {
          if (*buf_end-- != '0')
            {
            break;
            }
          RETVAL++;
          }
        Safefree(buf);                  /* free the scratch buffer */
        }
      } /* end if n was even */
  OUTPUT:
    RETVAL

##############################################################################
# _to_hex() - return ref to hexadecimal string (unprefixed)

SV *
_to_hex(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 16);
    RETVAL = newSV(len);                /* alloc len bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    mpz_get_str(buf, 16, *n);           /* convert to hexadecimal string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _to_bin() - return ref to binary string (unprefixed)

SV *
_to_bin(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 2);
    RETVAL = newSV(len);                /* alloc len bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    mpz_get_str(buf, 2, *n);            /* convert to binary string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _to_oct() - return ref to octal string (unprefixed)

SV *
_to_oct(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 8);
    RETVAL = newSV(len);                /* alloc len bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    mpz_get_str(buf, 8, *n);            /* convert to octal string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _as_hex() - return ref to hexadecimal string (prefixed with 0x)

SV *
_as_hex(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 16) + 2;
    RETVAL = newSV(len);                /* alloc len +1 (+2 for '0x') bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    *buf++ = '0'; *buf++ = 'x';         /* prepend '0x' */
    mpz_get_str(buf, 16, *n);           /* convert to hexadecimal string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _as_bin() - return ref to binary string (prefixed with 0b)

SV *
_as_bin(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 2) + 2;
    RETVAL = newSV(len);                /* alloc len +1 (+2 for '0b') bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    *buf++ = '0'; *buf++ = 'b';         /* prepend '0b' */
    mpz_get_str(buf, 2, *n);            /* convert to binary string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _as_oct() - return ref to octal string (prefixed with 0)

SV *
_as_oct(Class,n)
        mpz_t * n

  PREINIT:
    int len;
    char *buf;

  CODE:
    /* len is always >= 1, and accurate (unlike in decimal) */
    len = mpz_sizeinbase(*n, 8) + 1;
    RETVAL = newSV(len);                /* alloc len +1 (+1 for '0') bytes */
    SvPOK_on(RETVAL);
    buf = SvPVX(RETVAL);                /* get ptr to storage */
    *buf++ = '0';                       /* prepend '0' */
    mpz_get_str(buf, 8, *n);            /* convert to octal string */
    SvCUR_set(RETVAL, len);             /* so set real length */
  OUTPUT:
    RETVAL

##############################################################################
# _modpow() - ($n ** $exp) % $mod

mpz_t *
_modpow(Class, n, exp, mod)
       mpz_t*   n
       mpz_t*   exp
       mpz_t*   mod

  CODE:
    NEW_GMP_MPZ_T_INIT;
    mpz_powm(*RETVAL, *n, *exp, *mod);
  OUTPUT:
    RETVAL

##############################################################################
# _modinv() - compute the inverse of x % y
#
# int mpz_invert (mpz_t rop, mpz_t op1, mpz_t op2)      Function
# Compute the inverse of op1 modulo op2 and put the result in rop. If the
# inverse exists, the return value is non-zero and rop will satisfy
# 0 <= rop < op2. If an inverse doesn't exist the return value is zero and rop
# is undefined.

void
_modinv(Class,x,y)
        mpz_t*  x
        mpz_t*  y

  PREINIT:
    int rc, sign;
    SV* s;
    mpz_t* RETVAL;
  PPCODE:
    NEW_GMP_MPZ_T_INIT;
    rc = mpz_invert(*RETVAL, *x, *y);
    EXTEND(SP, 2);      /* we return two values */
    if (rc == 0)
      {
      /* Inverse doesn't exist. Return both values undefined. */
      PUSHs ( &PL_sv_undef );
      PUSHs ( &PL_sv_undef );
      mpz_clear(*RETVAL);
      free(RETVAL);
      }
    else
      {
      /* Inverse exists. When the modulus to mpz_invert() is positive,
       * the returned value is also positive. */
      PUSHs(sv_2mortal(sv_from_mpz(RETVAL)));
        s = sv_newmortal();
        sv_setpvn (s, "+", 1);
      PUSHs ( s );
      }

##############################################################################
# _add() - add $y to $x in place

void
_add(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_add(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );


##############################################################################
# _inc() - modify x inline by doing x++

void
_inc(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;      /* TEMP =  mpz_t(x)  */
    mpz_add_ui(*TEMP, *TEMP, 1);
    PUSHs( x );

##############################################################################
# _dec() - modify x inline by doing x--

void
_dec(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;      /* TEMP =  mpz_t(x)  */
    mpz_sub_ui(*TEMP, *TEMP, 1);
    PUSHs( x );

##############################################################################
# _sub() - $x - $y
# $x is always larger than $y! So overflow/underflow can not happen here.
# Formerly this code was:
# # if ($_[3])
#    {
#    $_[2] = Math::BigInt::GMP::sub_two($_[1],$_[2]); return $_[2];
#    }
#  Math::BigInt::GMP::_sub_in_place($_[1],$_[2]);
#  }

void
_sub(Class,x,y, ...)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    if ( items == 4 && SvTRUE(ST(3)) )
      {
      /* y -= x */
      mpz_sub(*TEMP_1, *TEMP, *TEMP_1);
      PUSHs( y );
      }
    else
      {
      /* x -= y */
      mpz_sub(*TEMP, *TEMP, *TEMP_1);
      PUSHs( x );
      }

##############################################################################
# _rsft()

void
_rsft(Class,x,y,base_sv)
        SV*     x
        SV*     y
        SV*     base_sv
  PREINIT:
        unsigned long   y_ui;
        mpz_t*  TEMP;
        mpz_t*  TEMP_1;
        mpz_t*  BASE;

  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */

    y_ui = mpz_get_ui(*TEMP_1);
    BASE = malloc (sizeof(mpz_t));
    mpz_init_set_ui(*BASE,SvUV(base_sv));

    mpz_pow_ui(*BASE, *BASE, y_ui); /* ">> 3 in base 4" => "x / (4 ** 3)" */
    mpz_div(*TEMP, *TEMP, *BASE);
    mpz_clear(*BASE);
    free(BASE);
    PUSHs( x );

##############################################################################
# _lsft()

void
_lsft(Class,x,y,base_sv)
        SV*     x
        SV*     y
        SV*     base_sv
  PREINIT:
        unsigned long   y_ui;
        mpz_t*  TEMP;
        mpz_t*  TEMP_1;
        mpz_t*  BASE;

  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */

    y_ui = mpz_get_ui(*TEMP_1);
    BASE = malloc (sizeof(mpz_t));
    mpz_init_set_ui(*BASE,SvUV(base_sv));

    mpz_pow_ui(*BASE, *BASE, y_ui); /* "<< 3 in base 4" => "x * (4 ** 3)" */
    mpz_mul(*TEMP, *TEMP, *BASE);
    mpz_clear(*BASE);
    free(BASE);
    PUSHs ( x );

##############################################################################
# _mul()

void
_mul(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_mul(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );

##############################################################################
# _div(): x /= y or (x,rem) = x / y
# was in perl:
#sub _div
#  {
#  i f (wantarray)
#    {
#    # return (a/b,a%b)
#    my $r;
#    ($_[1],$r) = Math::BigInt::GMP::bdiv_two($_[1],$_[2]);
#    return ($_[1], $r);
#    }
#  # return a / b
#  Math::BigInt::GMP::div_two($_[1],$_[2]);
#  }

void
_div(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
    mpz_t* TEMP;
    mpz_t* TEMP_1;
    mpz_t * rem;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    if (GIMME_V == G_ARRAY)
      {
      /* former bdiv_two() routine */
      rem = malloc (sizeof(mpz_t));
      mpz_init(*rem);
      mpz_tdiv_qr(*TEMP, *rem, *TEMP, *TEMP_1);
      EXTEND(SP, 2);
      PUSHs( x );
      PUSHs(sv_2mortal(sv_from_mpz(rem)));
      }
    else
      {
      /* former div_two() routine */
      mpz_div(*TEMP, *TEMP, *TEMP_1);                   /* x /= y */
      PUSHs( x );
      }

##############################################################################
# _mod() - x %= y

void
_mod(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_mod(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );

##############################################################################
# _acmp() - cmp two numbers

int
_acmp(Class,m,n)
        mpz_t * m
        mpz_t * n

  CODE:
    RETVAL = mpz_cmp(*m, *n);
    if ( RETVAL < 0) { RETVAL = -1; }
    if ( RETVAL > 0) { RETVAL = 1; }
  OUTPUT:
    RETVAL

##############################################################################
# _is_zero()

int
_is_zero(Class,x)
        mpz_t * x

  CODE:
    RETVAL = mpz_cmp_ui(*x, 0);
    if ( RETVAL != 0) { RETVAL = 0; } else { RETVAL = 1; }
  OUTPUT:
    RETVAL

##############################################################################
# _is_one()

int
_is_one(Class,x)
        mpz_t * x

  CODE:
    RETVAL = mpz_cmp_ui(*x, 1);
    if ( RETVAL != 0) { RETVAL = 0; } else { RETVAL = 1; }
  OUTPUT:
    RETVAL

##############################################################################
# _is_two()

int
_is_two(Class,x)
        mpz_t * x

  CODE:
    RETVAL = mpz_cmp_ui(*x, 2);
    if ( RETVAL != 0) { RETVAL = 0; } else { RETVAL = 1; }
  OUTPUT:
    RETVAL

##############################################################################
# _is_ten()

int
_is_ten(Class,x)
        mpz_t * x

  CODE:
    RETVAL = mpz_cmp_ui(*x, 10);
    if ( RETVAL != 0) { RETVAL = 0; } else { RETVAL = 1; }
  OUTPUT:
    RETVAL

##############################################################################
# _pow() - x **= y

void
_pow(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_pow_ui(*TEMP, *TEMP, mpz_get_ui( *TEMP_1 ) );
    PUSHs( x );

##############################################################################
# _lcm() - lcm(m,n)

mpz_t *
_lcm(Class,x,y)
        mpz_t*  x
        mpz_t*  y

  CODE:
    NEW_GMP_MPZ_T_INIT;
    mpz_lcm(*RETVAL, *x, *y);
  OUTPUT:
    RETVAL

##############################################################################
# _gcd() - gcd(m,n)

mpz_t *
_gcd(Class,x,y)
        mpz_t*  x
        mpz_t*  y

  CODE:
    NEW_GMP_MPZ_T_INIT;
    mpz_gcd(*RETVAL, *x, *y);
  OUTPUT:
    RETVAL

##############################################################################
# _nok() - n over k (binomial coefficient)

void
_nok(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_bin_ui(*TEMP, *TEMP, mpz_get_ui(*TEMP_1));
    PUSHs( x );

##############################################################################
# _fib() - Fibonacci number

void
_fib(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;   /* TEMP = x */
    mpz_fib_ui(*TEMP, mpz_get_ui(*TEMP));
    PUSHs( x );

##############################################################################
# _lucas() - Lucas number

void
_lucas(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;   /* TEMP = x */
    mpz_lucnum_ui(*TEMP, mpz_get_ui(*TEMP));
    PUSHs( x );

##############################################################################
# _and() - m &= n

void
_and(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_and(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );


##############################################################################
# _xor() - m =^ n

void
_xor(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_xor(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );


##############################################################################
# _or() - m =| n

void
_or(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_ior(*TEMP, *TEMP, *TEMP_1);
    PUSHs( x );


##############################################################################
# _fac() - n! (factorial)

void
_fac(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;   /* TEMP = x */
    mpz_fac_ui(*TEMP, mpz_get_ui(*TEMP));
    PUSHs( x );


##############################################################################
# _dfac() - n!! (double factorial)

void
_dfac(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;   /* TEMP = x */
    mpz_2fac_ui(*TEMP, mpz_get_ui(*TEMP));
    PUSHs( x );


##############################################################################
# _copy()

mpz_t *
_copy(Class,m)
        mpz_t*  m

  CODE:
    NEW_GMP_MPZ_T;
    mpz_init_set(*RETVAL, *m);
  OUTPUT:
    RETVAL


##############################################################################
# _is_odd() - test for number being odd

int
_is_odd(Class,n)
        mpz_t*  n

  CODE:
   RETVAL = mpz_tstbit(*n,0);
  OUTPUT:
    RETVAL

##############################################################################
# _is_even() - test for number being even

int
_is_even(Class,n)
        mpz_t*  n

  CODE:
     RETVAL = ! mpz_tstbit(*n,0);
  OUTPUT:
    RETVAL

##############################################################################
# _sqrt() - square root

void
_sqrt(Class,x)
        SV*     x
  PREINIT:
        mpz_t* TEMP;
  PPCODE:
    GMP_GET_ARG_0;   /* TEMP = x */
    mpz_sqrt(*TEMP, *TEMP);
    PUSHs( x );


##############################################################################
# _root() - integer roots

void
_root(Class,x,y)
        SV*     x
        SV*     y
  PREINIT:
        mpz_t* TEMP;
        mpz_t* TEMP_1;
  PPCODE:
    GMP_GET_ARGS_0_1;   /* (TEMP, TEMP_1) = (x,y)  */
    mpz_root(*TEMP, *TEMP, mpz_get_ui(*TEMP_1));
    PUSHs( x );

##############################################################################
# gmp_version()

SV*
gmp_version()
    CODE:
        RETVAL = newSVpv(gmp_version, 0);

    OUTPUT:
        RETVAL