gmp.xs

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

int
tstbit (z, bit)
    mpz_coerce   z
    ulong_coerce bit
CODE:
    RETVAL = mpz_tstbit (z, bit);
OUTPUT:
    RETVAL



#------------------------------------------------------------------------------

MODULE = GMP         PACKAGE = GMP::Mpq


mpq
mpq (...)
ALIAS:
    GMP::Mpq::new = 1
CODE:
    TRACE (printf ("%s new, ix=%ld, items=%d\n", mpq_class, ix, (int) items));
    RETVAL = new_mpq();
    switch (items) {
    case 0:
      mpq_set_ui (RETVAL->m, 0L, 1L);
      break;
    case 1:
      {
        mpq_ptr rp = RETVAL->m;
        mpq_ptr cp = coerce_mpq (rp, ST(0));
        if (cp != rp)
          mpq_set (rp, cp);
      }
      break;
    case 2:
      {
        mpz_ptr rp, cp;
        rp = mpq_numref (RETVAL->m);
        cp = coerce_mpz (rp, ST(0));
        if (cp != rp)
          mpz_set (rp, cp);
        rp = mpq_denref (RETVAL->m);
        cp = coerce_mpz (rp, ST(1));
        if (cp != rp)
          mpz_set (rp, cp);
      }
      break;
    default:
      croak ("%s new: invalid arguments", mpq_class);
    }
OUTPUT:
    RETVAL


void
overload_constant (str, pv, d1, ...)
    const_string_assume str
    SV                  *pv
    dummy               d1
PREINIT:
    SV  *sv;
    mpq q;
PPCODE:
    TRACE (printf ("%s constant: %s\n", mpq_class, str));
    q = new_mpq();
    if (mpq_set_str (q->m, str, 0) == 0)
      { sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, q), mpq_class_hv); }
    else
      { free_mpq (q); sv = pv; }
    XPUSHs(sv);


mpq
overload_copy (q, d1, d2)
    mpq_assume q
    dummy      d1
    dummy      d2
CODE:
    RETVAL = new_mpq();
    mpq_set (RETVAL->m, q->m);
OUTPUT:
    RETVAL


void
DESTROY (q)
    mpq_assume q
CODE:
    TRACE (printf ("%s DESTROY %p\n", mpq_class, q));
    free_mpq (q);


malloced_string
overload_string (q, d1, d2)
    mpq_assume q
    dummy      d1
    dummy      d2
CODE:
    TRACE (printf ("%s overload_string %p\n", mpq_class, q));
    RETVAL = mpq_get_str (NULL, 10, q->m);
OUTPUT:
    RETVAL


mpq
overload_add (xv, yv, order)
    SV *xv
    SV *yv
    SV *order
ALIAS:
    GMP::Mpq::overload_sub   = 1
    GMP::Mpq::overload_mul   = 2
    GMP::Mpq::overload_div   = 3
PREINIT:
    static_functable const struct {
      void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
    } table[] = {
      { mpq_add }, /* 0 */
      { mpq_sub }, /* 1 */
      { mpq_mul }, /* 2 */
      { mpq_div }, /* 3 */
    };
CODE:
    TRACE (printf ("%s binary\n", mpf_class));
    assert_table (ix);
    if (order == &PL_sv_yes)
      SV_PTR_SWAP (xv, yv);
    RETVAL = new_mpq();
    (*table[ix].op) (RETVAL->m,
                     coerce_mpq (tmp_mpq_0, xv),
                     coerce_mpq (tmp_mpq_1, yv));
OUTPUT:
    RETVAL


void
overload_addeq (x, y, o)
    mpq_assume   x
    mpq_coerce   y
    order_noswap o
ALIAS:
    GMP::Mpq::overload_subeq = 1
    GMP::Mpq::overload_muleq = 2
    GMP::Mpq::overload_diveq = 3
PREINIT:
    static_functable const struct {
      void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
    } table[] = {
      { mpq_add    }, /* 0 */
      { mpq_sub    }, /* 1 */
      { mpq_mul    }, /* 2 */
      { mpq_div    }, /* 3 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (x->m, x->m, y);
    XPUSHs(ST(0));


mpq
overload_lshift (qv, nv, order)
    SV *qv
    SV *nv
    SV *order
ALIAS:
    GMP::Mpq::overload_rshift   = 1
    GMP::Mpq::overload_pow      = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
    } table[] = {
      { mpq_mul_2exp }, /* 0 */
      { mpq_div_2exp }, /* 1 */
      { x_mpq_pow_ui }, /* 2 */
    };
CODE:
    assert_table (ix);
    if (order == &PL_sv_yes)
      SV_PTR_SWAP (qv, nv);
    RETVAL = new_mpq();
    (*table[ix].op) (RETVAL->m, coerce_mpq (RETVAL->m, qv), coerce_ulong (nv));
OUTPUT:
    RETVAL


void
overload_lshifteq (q, n, o)
    mpq_assume   q
    ulong_coerce n
    order_noswap o
ALIAS:
    GMP::Mpq::overload_rshifteq   = 1
    GMP::Mpq::overload_poweq      = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
    } table[] = {
      { mpq_mul_2exp }, /* 0 */
      { mpq_div_2exp }, /* 1 */
      { x_mpq_pow_ui }, /* 2 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (q->m, q->m, n);
    XPUSHs(ST(0));


void
overload_inc (q, d1, d2)
    mpq_assume q
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpq::overload_dec = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
    } table[] = {
      { mpz_add }, /* 0 */
      { mpz_sub }, /* 1 */
    };
CODE:
    assert_table (ix);
    (*table[ix].op) (mpq_numref(q->m), mpq_numref(q->m), mpq_denref(q->m));


mpq
overload_abs (q, d1, d2)
    mpq_assume q
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpq::overload_neg = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpq_ptr w, mpq_srcptr x);
    } table[] = {
      { mpq_abs }, /* 0 */
      { mpq_neg }, /* 1 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpq();
    (*table[ix].op) (RETVAL->m, q->m);
OUTPUT:
    RETVAL


int
overload_spaceship (x, y, order)
    mpq_assume x
    mpq_coerce y
    SV         *order
CODE:
    RETVAL = mpq_cmp (x->m, y);
    RETVAL = SGN (RETVAL);
    if (order == &PL_sv_yes)
      RETVAL = -RETVAL;
OUTPUT:
    RETVAL


bool
overload_bool (q, d1, d2)
    mpq_assume q
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpq::overload_not = 1
CODE:
    RETVAL = (mpq_sgn (q->m) != 0) ^ ix;
OUTPUT:
    RETVAL


bool
overload_eq (x, yv, d)
    mpq_assume x
    SV         *yv
    dummy      d
ALIAS:
    GMP::Mpq::overload_ne = 1
PREINIT:
    int  use;
CODE:
    use = use_sv (yv);
    switch (use) {
    case USE_IVX:
    case USE_UVX:
    case USE_MPZ:
      RETVAL = 0;
      if (x_mpq_integer_p (x->m))
        {
          switch (use) {
          case USE_IVX:
            RETVAL = (mpz_cmp_si (mpq_numref(x->m), SvIVX(yv)) == 0);
            break;
          case USE_UVX:
            RETVAL = (mpz_cmp_ui (mpq_numref(x->m), SvUVX(yv)) == 0);
            break;
          case USE_MPZ:
            RETVAL = (mpz_cmp (mpq_numref(x->m), SvMPZ(yv)->m) == 0);
            break;
          }
        }
      break;

    case USE_MPQ:
      RETVAL = (mpq_equal (x->m, SvMPQ(yv)->m) != 0);
      break;

    default:
      RETVAL = (mpq_equal (x->m, coerce_mpq_using (tmp_mpq_0, yv, use)) != 0);
      break;
    }
    RETVAL ^= ix;
OUTPUT:
    RETVAL


void
canonicalize (q)
    mpq q
CODE:
    mpq_canonicalize (q->m);


mpq
inv (q)
    mpq_coerce q
CODE:
    RETVAL = new_mpq();
    mpq_inv (RETVAL->m, q);
OUTPUT:
    RETVAL


mpz
num (q)
    mpq q
ALIAS:
    GMP::Mpq::den = 1
CODE:
    RETVAL = new_mpz();
    mpz_set (RETVAL->m, (ix == 0 ? mpq_numref(q->m) : mpq_denref(q->m)));
OUTPUT:
    RETVAL



#------------------------------------------------------------------------------

MODULE = GMP         PACKAGE = GMP::Mpf


mpf
mpf (...)
ALIAS:
    GMP::Mpf::new = 1
PREINIT:
    unsigned long  prec;
CODE:
    TRACE (printf ("%s new\n", mpf_class));
    if (items > 2)
      croak ("%s new: invalid arguments", mpf_class);
    prec = (items == 2 ? coerce_ulong (ST(1)) : mpf_get_default_prec());
    RETVAL = new_mpf (prec);
    if (items >= 1)
      {
        SV *sv = ST(0);
        my_mpf_set_sv_using (RETVAL, sv, use_sv(sv));
      }
OUTPUT:
    RETVAL


mpf
overload_constant (sv, d1, d2, ...)
    SV     *sv
    dummy  d1
    dummy  d2
CODE:
    assert (SvPOK (sv));
    TRACE (printf ("%s constant: %s\n", mpq_class, SvPVX(sv)));
    RETVAL = new_mpf (mpf_get_default_prec());
    my_mpf_set_svstr (RETVAL, sv);
OUTPUT:
    RETVAL


mpf
overload_copy (f, d1, d2)
    mpf_assume f
    dummy      d1
    dummy      d2
CODE:
    TRACE (printf ("%s copy\n", mpf_class));
    RETVAL = new_mpf (mpf_get_prec (f));
    mpf_set (RETVAL, f);
OUTPUT:
    RETVAL


void
DESTROY (f)
    mpf_assume f
CODE:
    TRACE (printf ("%s DESTROY %p\n", mpf_class, f));
    mpf_clear (f);
    Safefree (f);
    assert_support (mpf_count--);
    TRACE_ACTIVE ();


mpf
overload_add (x, y, order)
    mpf_assume     x
    mpf_coerce_st0 y
    SV             *order
ALIAS:
    GMP::Mpf::overload_sub   = 1
    GMP::Mpf::overload_mul   = 2
    GMP::Mpf::overload_div   = 3
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
    } table[] = {
      { mpf_add }, /* 0 */
      { mpf_sub }, /* 1 */
      { mpf_mul }, /* 2 */
      { mpf_div }, /* 3 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpf (mpf_get_prec (x));
    if (order == &PL_sv_yes)
      MPF_PTR_SWAP (x, y);
    (*table[ix].op) (RETVAL, x, y);
OUTPUT:
    RETVAL


void
overload_addeq (x, y, o)
    mpf_assume     x
    mpf_coerce_st0 y
    order_noswap   o
ALIAS:
    GMP::Mpf::overload_subeq = 1
    GMP::Mpf::overload_muleq = 2
    GMP::Mpf::overload_diveq = 3
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
    } table[] = {
      { mpf_add }, /* 0 */
      { mpf_sub }, /* 1 */
      { mpf_mul }, /* 2 */
      { mpf_div }, /* 3 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (x, x, y);
    XPUSHs(ST(0));


mpf
overload_lshift (fv, nv, order)
    SV *fv
    SV *nv
    SV *order
ALIAS:
    GMP::Mpf::overload_rshift = 1
    GMP::Mpf::overload_pow    = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
    } table[] = {
      { mpf_mul_2exp }, /* 0 */
      { mpf_div_2exp }, /* 1 */
      { mpf_pow_ui   }, /* 2 */
    };
    mpf f;
    unsigned long prec;
CODE:
    assert_table (ix);
    MPF_ASSUME (f, fv);
    prec = mpf_get_prec (f);
    if (order == &PL_sv_yes)
      SV_PTR_SWAP (fv, nv);
    f = coerce_mpf (tmp_mpf_0, fv, prec);
    RETVAL = new_mpf (prec);
    (*table[ix].op) (RETVAL, f, coerce_ulong (nv));
OUTPUT:
    RETVAL


void
overload_lshifteq (f, n, o)
    mpf_assume   f
    ulong_coerce n
    order_noswap o
ALIAS:
    GMP::Mpf::overload_rshifteq   = 1
    GMP::Mpf::overload_poweq      = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
    } table[] = {
      { mpf_mul_2exp }, /* 0 */
      { mpf_div_2exp }, /* 1 */
      { mpf_pow_ui   }, /* 2 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (f, f, n);
    XPUSHs(ST(0));


mpf
overload_abs (f, d1, d2)
    mpf_assume f
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpf::overload_neg   = 1
    GMP::Mpf::overload_sqrt  = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr w, mpf_srcptr x);
    } table[] = {
      { mpf_abs  }, /* 0 */
      { mpf_neg  }, /* 1 */
      { mpf_sqrt }, /* 2 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpf (mpf_get_prec (f));
    (*table[ix].op) (RETVAL, f);
OUTPUT:
    RETVAL


void
overload_inc (f, d1, d2)
    mpf_assume f
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpf::overload_dec = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpf_ptr w, mpf_srcptr x, unsigned long y);
    } table[] = {
      { mpf_add_ui }, /* 0 */
      { mpf_sub_ui }, /* 1 */
    };
CODE:
    assert_table (ix);
    (*table[ix].op) (f, f, 1L);


int
overload_spaceship (xv, yv, order)
    SV *xv
    SV *yv
    SV *order
PREINIT:
    mpf x;
CODE:
    MPF_ASSUME (x, xv);
    switch (use_sv (yv)) {
    case USE_IVX