gmp.xs

来自「a very popular packet of cryptography to」· XS 代码 · 共 2,874 行 · 第 1/5 页

      break;
    case USE_MPQ:
      RETVAL = x_mpz_cmp_q (x->m, SvMPQ(yv)->m);
      break;
    case USE_MPF:
      RETVAL = x_mpz_cmp_f (x->m, SvMPF(yv));
      break;
    default:
      croak ("%s <=>: invalid operand", mpz_class);
    }
    RETVAL = SGN (RETVAL);
    if (order == &PL_sv_yes)
      RETVAL = -RETVAL;
OUTPUT:
    RETVAL


bool
overload_bool (z, d1, d2)
    mpz_assume z
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpz::overload_not = 1
CODE:
    RETVAL = (mpz_sgn (z->m) != 0) ^ ix;
OUTPUT:
    RETVAL


mpz
bin (n, k)
    mpz_coerce   n
    ulong_coerce k
ALIAS:
    GMP::Mpz::root = 1
PREINIT:
    /* mpz_root returns an int, hence the cast */
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
    } table[] = {
      {                                                mpz_bin_ui }, /* 0 */
      { (void (*)(mpz_ptr, mpz_srcptr, unsigned long)) mpz_root   }, /* 1 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m, n, k);
OUTPUT:
    RETVAL


void
cdiv (a, d)
    mpz_coerce a
    mpz_coerce d
ALIAS:
    GMP::Mpz::fdiv = 1
    GMP::Mpz::tdiv = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr);
    } table[] = {
      { mpz_cdiv_qr }, /* 0 */
      { mpz_fdiv_qr }, /* 1 */
      { mpz_tdiv_qr }, /* 2 */
    };
    mpz q, r;
PPCODE:
    assert_table (ix);
    q = new_mpz();
    r = new_mpz();
    (*table[ix].op) (q->m, r->m, a, d);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (q, mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (r, mpz_class_hv));


void
cdiv_2exp (a, d)
    mpz_coerce   a
    ulong_coerce d
ALIAS:
    GMP::Mpz::fdiv_2exp = 1
    GMP::Mpz::tdiv_2exp = 2
PREINIT:
    static_functable const struct {
      void (*q) (mpz_ptr, mpz_srcptr, unsigned long);
      void (*r) (mpz_ptr, mpz_srcptr, unsigned long);
    } table[] = {
      { mpz_cdiv_q_2exp, mpz_cdiv_r_2exp }, /* 0 */
      { mpz_fdiv_q_2exp, mpz_fdiv_r_2exp }, /* 1 */
      { mpz_tdiv_q_2exp, mpz_tdiv_r_2exp }, /* 2 */
    };
    mpz q, r;
PPCODE:
    assert_table (ix);
    q = new_mpz();
    r = new_mpz();
    (*table[ix].q) (q->m, a, d);
    (*table[ix].r) (r->m, a, d);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (q, mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (r, mpz_class_hv));


bool
congruent_p (a, c, d)
    mpz_coerce a
    mpz_coerce c
    mpz_coerce d
PREINIT:
CODE:
    RETVAL = mpz_congruent_p (a, c, d);
OUTPUT:
    RETVAL


bool
congruent_2exp_p (a, c, d)
    mpz_coerce   a
    mpz_coerce   c
    ulong_coerce d
PREINIT:
CODE:
    RETVAL = mpz_congruent_2exp_p (a, c, d);
OUTPUT:
    RETVAL


mpz
divexact (a, d)
    mpz_coerce a
    mpz_coerce d
ALIAS:
    GMP::Mpz::mod = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
    } table[] = {
      { mpz_divexact }, /* 0 */
      { mpz_mod      }, /* 1 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m, a, d);
OUTPUT:
    RETVAL


bool
divisible_p (a, d)
    mpz_coerce a
    mpz_coerce d
CODE:
    RETVAL = mpz_divisible_p (a, d);
OUTPUT:
    RETVAL


bool
divisible_2exp_p (a, d)
    mpz_coerce   a
    ulong_coerce d
CODE:
    RETVAL = mpz_divisible_2exp_p (a, d);
OUTPUT:
    RETVAL


bool
even_p (z)
    mpz_coerce z
ALIAS:
    GMP::Mpz::odd_p            = 1
    GMP::Mpz::perfect_square_p = 2
    GMP::Mpz::perfect_power_p  = 3
PREINIT:
    static_functable const struct {
      int (*op) (mpz_srcptr z);
    } table[] = {
      { x_mpz_even_p         }, /* 0 */
      { x_mpz_odd_p          }, /* 1 */
      { mpz_perfect_square_p }, /* 2 */
      { mpz_perfect_power_p  }, /* 3 */
    };
CODE:
    assert_table (ix);
    RETVAL = (*table[ix].op) (z);
OUTPUT:
    RETVAL


mpz
fac (n)
    ulong_coerce n
ALIAS:
    GMP::Mpz::fib    = 1
    GMP::Mpz::lucnum = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr r, unsigned long n);
    } table[] = {
      { mpz_fac_ui },    /* 0 */
      { mpz_fib_ui },    /* 1 */
      { mpz_lucnum_ui }, /* 2 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m, n);
OUTPUT:
    RETVAL


void
fib2 (n)
    ulong_coerce n
ALIAS:
    GMP::Mpz::lucnum2 = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr r, mpz_ptr r2, unsigned long n);
    } table[] = {
      { mpz_fib2_ui },    /* 0 */
      { mpz_lucnum2_ui }, /* 1 */
    };
    mpz  r, r2;
PPCODE:
    assert_table (ix);
    r = new_mpz();
    r2 = new_mpz();
    (*table[ix].op) (r->m, r2->m, n);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (r,  mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (r2, mpz_class_hv));


mpz
gcd (x, ...)
    mpz_coerce x
ALIAS:
    GMP::Mpz::lcm = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr w, mpz_srcptr x, mpz_srcptr y);
      void (*op_ui) (mpz_ptr w, mpz_srcptr x, unsigned long y);
    } table[] = {
      /* cast to ignore ulong return from mpz_gcd_ui */
      { mpz_gcd,
        (void (*) (mpz_ptr, mpz_srcptr, unsigned long)) mpz_gcd_ui }, /* 0 */
      { mpz_lcm, mpz_lcm_ui },                                        /* 1 */
    };
    int  i;
    SV   *yv;
CODE:
    assert_table (ix);
    RETVAL = new_mpz();
    if (items == 1)
      mpz_set (RETVAL->m, x);
    else
      {
        for (i = 1; i < items; i++)
          {
            yv = ST(i);
            if (SvIOK(yv))
              (*table[ix].op_ui) (RETVAL->m, x, ABS(SvIVX(yv)));
            else
              (*table[ix].op) (RETVAL->m, x, coerce_mpz (tmp_mpz_1, yv));
            x = RETVAL->m;
          }
      }
OUTPUT:
    RETVAL


void
gcdext (a, b)
    mpz_coerce a
    mpz_coerce b
PREINIT:
    mpz g, x, y;
    SV  *sv;
PPCODE:
    g = new_mpz();
    x = new_mpz();
    y = new_mpz();
    mpz_gcdext (g->m, x->m, y->m, a, b);
    EXTEND (SP, 3);
    PUSHs (MPX_NEWMORTAL (g, mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (x, mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (y, mpz_class_hv));


unsigned long
hamdist (x, y)
    mpz_coerce x
    mpz_coerce y
CODE:
    RETVAL = mpz_hamdist (x, y);
OUTPUT:
    RETVAL


mpz
invert (a, m)
    mpz_coerce a
    mpz_coerce m
CODE:
    RETVAL = new_mpz();
    if (! mpz_invert (RETVAL->m, a, m))
      {
        free_mpz (RETVAL);
        XSRETURN_UNDEF;
      }
OUTPUT:
    RETVAL


int
jacobi (a, b)
    mpz_coerce a
    mpz_coerce b
CODE:
    RETVAL = mpz_jacobi (a, b);
OUTPUT:
    RETVAL


int
kronecker (a, b)
    SV *a
    SV *b
CODE:
    if (SvIOK(b))
      RETVAL = mpz_kronecker_si (coerce_mpz(tmp_mpz_0,a), SvIVX(b));
    else if (SvIOK(a))
      RETVAL = mpz_si_kronecker (SvIVX(a), coerce_mpz(tmp_mpz_0,b));
    else
      RETVAL = mpz_kronecker (coerce_mpz(tmp_mpz_0,a),
                              coerce_mpz(tmp_mpz_1,b));
OUTPUT:
    RETVAL


void
mpz_export (order, size, endian, nails, z)
    int        order
    size_t     size
    int        endian
    size_t     nails
    mpz_coerce z
PREINIT:
    size_t  numb, count, bytes, actual_count;
    char    *data;
    SV      *sv;
PPCODE:
    numb = 8*size - nails;
    count = (mpz_sizeinbase (z, 2) + numb-1) / numb;
    bytes = count * size;
    New (GMP_MALLOC_ID, data, bytes+1, char);
    mpz_export (data, &actual_count, order, size, endian, nails, z);
    assert (count == actual_count);
    data[bytes] = '\0';
    sv = sv_newmortal(); sv_usepvn_mg (sv, data, bytes); PUSHs(sv);


mpz
mpz_import (order, size, endian, nails, sv)
    int     order
    size_t  size
    int     endian
    size_t  nails
    SV      *sv
PREINIT:
    size_t      count;
    const char  *data;
    STRLEN      len;
CODE:
    data = SvPV (sv, len);
    if ((len % size) != 0)
      croak ("%s mpz_import: string not a multiple of the given size",
             mpz_class);
    count = len / size;
    RETVAL = new_mpz();
    mpz_import (RETVAL->m, count, order, size, endian, nails, data);
OUTPUT:
    RETVAL


mpz
nextprime (z)
    mpz_coerce z
CODE:
    RETVAL = new_mpz();
    mpz_nextprime (RETVAL->m, z);
OUTPUT:
    RETVAL


unsigned long
popcount (x)
    mpz_coerce x
CODE:
    RETVAL = mpz_popcount (x);
OUTPUT:
    RETVAL


mpz
powm (b, e, m)
    mpz_coerce b
    mpz_coerce e
    mpz_coerce m
CODE:
    RETVAL = new_mpz();
    mpz_powm (RETVAL->m, b, e, m);
OUTPUT:
    RETVAL


bool
probab_prime_p (z, n)
    mpz_coerce   z
    ulong_coerce n
CODE:
    RETVAL = mpz_probab_prime_p (z, n);
OUTPUT:
    RETVAL


# No attempt to coerce here, only an mpz makes sense.
void
realloc (z, limbs)
    mpz z
    int limbs
CODE:
    _mpz_realloc (z->m, limbs);


void
remove (z, f)
    mpz_coerce z
    mpz_coerce f
PREINIT:
    SV             *sv;
    mpz            rem;
    unsigned long  mult;
PPCODE:
    rem = new_mpz();
    mult = mpz_remove (rem->m, z, f);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (rem, mpz_class_hv));
    PUSHs (sv_2mortal (newSViv (mult)));


void
roote (z, n)
    mpz_coerce   z
    ulong_coerce n
PREINIT:
    SV  *sv;
    mpz root;
    int exact;
PPCODE:
    root = new_mpz();
    exact = mpz_root (root->m, z, n);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (root, mpz_class_hv));
    sv = (exact ? &PL_sv_yes : &PL_sv_no); sv_2mortal(sv); PUSHs(sv);


# In the past scan0 and scan1 were described as returning ULONG_MAX which
# could be obtained in perl with ~0.  That wasn't true on 64-bit systems
# (eg. alpha) with perl 5.005, since in that version IV and UV were still
# 32-bits.
#
# We changed in gmp 4.1.3 to just say ~0 for the not-found return.  It's
# likely most people have used ~0 rather than POSIX::ULONG_MAX(), so this
# change should match existing usage.  It only actually makes a difference
# in old perl, since recent versions have gone to 64-bits for IV and UV, the
# same as a ulong.
#
# In perl 5.005 we explicitly mask the mpz return down to 32-bits to get ~0.
# UV_MAX is no good, it reflects the size of the UV type (64-bits), rather
# than the size of the values one ought to be storing in an SV (32-bits).

gmp_UV
scan0 (z, start)
    mpz_coerce   z
    ulong_coerce start
ALIAS:
    GMP::Mpz::scan1 = 1
PREINIT:
    static_functable const struct {
      unsigned long (*op) (mpz_srcptr, unsigned long);
    } table[] = {
      { mpz_scan0  }, /* 0 */
      { mpz_scan1  }, /* 1 */
    };
CODE:
    assert_table (ix);
    RETVAL = (*table[ix].op) (z, start);
    if (PERL_LT (5,6))
      RETVAL &= 0xFFFFFFFF;
OUTPUT:
    RETVAL


void
setbit (sv, bit)
    SV           *sv
    ulong_coerce bit
ALIAS:
    GMP::Mpz::clrbit = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, unsigned long);
    } table[] = {
      { mpz_setbit }, /* 0 */
      { mpz_clrbit }, /* 1 */
    };
    int  use;
    mpz  z;
CODE:
    use = use_sv (sv);
    if (use == USE_MPZ && SvREFCNT(SvRV(sv)) == 1 && ! SvSMAGICAL(sv))
      {
        /* our operand is a non-magical mpz with a reference count of 1, so
           we can just modify it */
        (*table[ix].op) (SvMPZ(sv)->m, bit);
      }
    else
      {
        /* otherwise we need to make a new mpz, from whatever we have, and
           operate on that, possibly invoking magic when storing back */
        SV   *new_sv;
        mpz  z = new_mpz ();
        mpz_ptr  coerce_ptr = coerce_mpz_using (z->m, sv, use);
        if (coerce_ptr != z->m)
          mpz_set (z->m, coerce_ptr);
        (*table[ix].op) (z->m, bit);
        new_sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, z),
                           mpz_class_hv);
        SvSetMagicSV (sv, new_sv);
      }


void
sqrtrem (z)
    mpz_coerce z
PREINIT:
    SV  *sv;
    mpz root;
    mpz rem;
PPCODE:
    root = new_mpz();
    rem = new_mpz();
    mpz_sqrtrem (root->m, rem->m, z);
    EXTEND (SP, 2);
    PUSHs (MPX_NEWMORTAL (root, mpz_class_hv));
    PUSHs (MPX_NEWMORTAL (rem,  mpz_class_hv));


size_t
sizeinbase (z, base)
    mpz_coerce z
    int        base
CODE:
    RETVAL = mpz_sizeinbase (z, base);
OUTPUT:
    RETVAL