gmp.xs

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

      break;

    case USE_MPF:
      RETVAL = mpf_get_si (SvMPF(sv));
      break;

    default:
      croak ("GMP::get_si invalid argument");
    }
OUTPUT:
    RETVAL


void
get_str (sv, ...)
    SV *sv
PREINIT:
    char      *str;
    mp_exp_t  exp;
    mpz_ptr   z;
    mpq_ptr   q;
    mpf       f;
    int       base;
    int       ndigits;
PPCODE:
    TRACE (printf ("GMP::get_str\n"));

    if (items >= 2)
      base = coerce_long (ST(1));
    else
      base = 10;
    TRACE (printf (" base=%d\n", base));

    if (items >= 3)
      ndigits = coerce_long (ST(2));
    else
      ndigits = 10;
    TRACE (printf (" ndigits=%d\n", ndigits));

    EXTEND (SP, 2);

    switch (use_sv (sv)) {
    case USE_IVX:
      mpz_set_si (tmp_mpz_0, SvIVX(sv));
    get_tmp_mpz_0:
      z = tmp_mpz_0;
      goto get_mpz;

    case USE_UVX:
      mpz_set_ui (tmp_mpz_0, SvUVX(sv));
      goto get_tmp_mpz_0;

    case USE_NVX:
      /* only digits in the original double, not in the coerced form */
      if (ndigits == 0)
        ndigits = DBL_DIG;
      mpf_set_d (tmp_mpf_0->m, SvNVX(sv));
      f = tmp_mpf_0->m;
      goto get_mpf;

    case USE_PVX:
      {
        /* get_str on a string is not much more than a base conversion */
        STRLEN len;
        str = SvPV (sv, len);
        if (mpz_set_str (tmp_mpz_0, str, 0) == 0)
          {
            z = tmp_mpz_0;
            goto get_mpz;
          }
        else if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
          {
            q = tmp_mpq_0;
            goto get_mpq;
          }
        else
          {
            /* FIXME: Would like perhaps a precision equivalent to the
               number of significant digits of the string, in its given
               base.  */
            tmp_mpf_set_prec (tmp_mpf_0, strlen(str));
            if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
              {
                f = tmp_mpf_0->m;
                goto get_mpf;
              }
            else
              croak ("GMP::get_str invalid string format");
          }
      }
      break;

    case USE_MPZ:
      z = SvMPZ(sv)->m;
    get_mpz:
      str = mpz_get_str (NULL, base, z);
    push_str:
      PUSHs (sv_2mortal (newSVpv (str, 0)));
      break;

    case USE_MPQ:
      q = SvMPQ(sv)->m;
    get_mpq:
      str = mpq_get_str (NULL, base, q);
      goto push_str;

    case USE_MPF:
      f = SvMPF(sv);
    get_mpf:
      str = mpf_get_str (NULL, &exp, base, 0, f);
      PUSHs (sv_2mortal (newSVpv (str, 0)));
      PUSHs (sv_2mortal (newSViv (exp)));
      break;

    default:
      croak ("GMP::get_str invalid argument");
    }


bool
integer_p (sv)
    SV *sv
CODE:
    switch (use_sv (sv)) {
    case USE_IVX:
    case USE_UVX:
      RETVAL = 1;
      break;

    case USE_NVX:
      RETVAL = double_integer_p (SvNVX(sv));
      break;

    case USE_PVX:
      {
        /* FIXME: Maybe this should be done by parsing the string, not by an
           actual conversion.  */
        STRLEN len;
        const char *str = SvPV (sv, len);
        if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
          RETVAL = x_mpq_integer_p (tmp_mpq_0);
        else
          {
            /* enough for all digits of the string */
            tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
            if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
              RETVAL = mpf_integer_p (tmp_mpf_0->m);
            else
              croak ("GMP::integer_p invalid string format");
          }
      }
      break;

    case USE_MPZ:
      RETVAL = 1;
      break;

    case USE_MPQ:
      RETVAL = x_mpq_integer_p (SvMPQ(sv)->m);
      break;

    case USE_MPF:
      RETVAL = mpf_integer_p (SvMPF(sv));
      break;

    default:
      croak ("GMP::integer_p invalid argument");
    }
OUTPUT:
    RETVAL


int
sgn (sv)
    SV *sv
CODE:
    switch (use_sv (sv)) {
    case USE_IVX:
      RETVAL = SGN (SvIVX(sv));
      break;

    case USE_UVX:
      RETVAL = (SvUVX(sv) > 0);
      break;

    case USE_NVX:
      RETVAL = SGN (SvNVX(sv));
      break;

    case USE_PVX:
      {
        /* FIXME: Maybe this should be done by parsing the string, not by an
           actual conversion.  */
        STRLEN len;
        const char *str = SvPV (sv, len);
        if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
          RETVAL = mpq_sgn (tmp_mpq_0);
        else
          {
            /* enough for all digits of the string */
            tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
            if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
              RETVAL = mpf_sgn (tmp_mpf_0->m);
            else
              croak ("GMP::sgn invalid string format");
          }
      }
      break;

    case USE_MPZ:
      RETVAL = mpz_sgn (SvMPZ(sv)->m);
      break;

    case USE_MPQ:
      RETVAL = mpq_sgn (SvMPQ(sv)->m);
      break;

    case USE_MPF:
      RETVAL = mpf_sgn (SvMPF(sv));
      break;

    default:
      croak ("GMP::sgn invalid argument");
    }
OUTPUT:
    RETVAL


# currently undocumented
void
shrink ()
CODE:
#define x_mpz_shrink(z) \
    mpz_set_ui (z, 0L); _mpz_realloc (z, 1)
#define x_mpq_shrink(q) \
    x_mpz_shrink (mpq_numref(q)); x_mpz_shrink (mpq_denref(q))

    x_mpz_shrink (tmp_mpz_0);
    x_mpz_shrink (tmp_mpz_1);
    x_mpz_shrink (tmp_mpz_2);
    x_mpq_shrink (tmp_mpq_0);
    x_mpq_shrink (tmp_mpq_1);
    tmp_mpf_shrink (tmp_mpf_0);
    tmp_mpf_shrink (tmp_mpf_1);



malloced_string
sprintf_internal (fmt, sv)
    const_string fmt
    SV           *sv
CODE:
    assert (strlen (fmt) >= 3);
    assert (SvROK(sv));
    assert ((sv_derived_from (sv, mpz_class)    && fmt[strlen(fmt)-2] == 'Z')
            || (sv_derived_from (sv, mpq_class) && fmt[strlen(fmt)-2] == 'Q')
            || (sv_derived_from (sv, mpf_class) && fmt[strlen(fmt)-2] == 'F'));
    TRACE (printf ("GMP::sprintf_internal\n");
           printf ("  fmt  |%s|\n", fmt);
           printf ("  sv   |%p|\n", SvMPZ(sv)));

    /* cheat a bit here, SvMPZ works for mpq and mpf too */
    gmp_asprintf (&RETVAL, fmt, SvMPZ(sv));

    TRACE (printf ("  result |%s|\n", RETVAL));
OUTPUT:
    RETVAL



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

MODULE = GMP         PACKAGE = GMP::Mpz

mpz
mpz (...)
ALIAS:
    GMP::Mpz::new = 1
PREINIT:
    SV *sv;
CODE:
    TRACE (printf ("%s new, ix=%ld, items=%d\n", mpz_class, ix, (int) items));
    RETVAL = new_mpz();

    switch (items) {
    case 0:
      mpz_set_ui (RETVAL->m, 0L);
      break;

    case 1:
      sv = ST(0);
      TRACE (printf ("  use %d\n", use_sv (sv)));
      switch (use_sv (sv)) {
      case USE_IVX:
        mpz_set_si (RETVAL->m, SvIVX(sv));
        break;

      case USE_UVX:
        mpz_set_ui (RETVAL->m, SvUVX(sv));
        break;

      case USE_NVX:
        mpz_set_d (RETVAL->m, SvNVX(sv));
        break;

      case USE_PVX:
        my_mpz_set_svstr (RETVAL->m, sv);
        break;

      case USE_MPZ:
        mpz_set (RETVAL->m, SvMPZ(sv)->m);
        break;

      case USE_MPQ:
        mpz_set_q (RETVAL->m, SvMPQ(sv)->m);
        break;

      case USE_MPF:
        mpz_set_f (RETVAL->m, SvMPF(sv));
        break;

      default:
        goto invalid;
      }
      break;

    default:
    invalid:
      croak ("%s new: invalid arguments", mpz_class);
    }
OUTPUT:
    RETVAL


void
overload_constant (str, pv, d1, ...)
    const_string_assume str
    SV                  *pv
    dummy               d1
PREINIT:
    mpz z;
PPCODE:
    TRACE (printf ("%s constant: %s\n", mpz_class, str));
    z = new_mpz();
    if (mpz_set_str (z->m, str, 0) == 0)
      {
        PUSHs (MPX_NEWMORTAL (z, mpz_class_hv));
      }
    else
      {
        free_mpz (z);
        PUSHs(pv);
      }


mpz
overload_copy (z, d1, d2)
    mpz_assume z
    dummy      d1
    dummy      d2
CODE:
    RETVAL = new_mpz();
    mpz_set (RETVAL->m, z->m);
OUTPUT:
    RETVAL


void
DESTROY (z)
    mpz_assume z
CODE:
    TRACE (printf ("%s DESTROY %p\n", mpz_class, z));
    free_mpz (z);


malloced_string
overload_string (z, d1, d2)
    mpz_assume z
    dummy      d1
    dummy      d2
CODE:
    TRACE (printf ("%s overload_string %p\n", mpz_class, z));
    RETVAL = mpz_get_str (NULL, 10, z->m);
OUTPUT:
    RETVAL


mpz
overload_add (xv, yv, order)
    SV *xv
    SV *yv
    SV *order
ALIAS:
    GMP::Mpz::overload_sub = 1
    GMP::Mpz::overload_mul = 2
    GMP::Mpz::overload_div = 3
    GMP::Mpz::overload_rem = 4
    GMP::Mpz::overload_and = 5
    GMP::Mpz::overload_ior = 6
    GMP::Mpz::overload_xor = 7
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
    } table[] = {
      { mpz_add    }, /* 0 */
      { mpz_sub    }, /* 1 */
      { mpz_mul    }, /* 2 */
      { mpz_tdiv_q }, /* 3 */
      { mpz_tdiv_r }, /* 4 */
      { mpz_and    }, /* 5 */
      { mpz_ior    }, /* 6 */
      { mpz_xor    }, /* 7 */
    };
CODE:
    assert_table (ix);
    if (order == &PL_sv_yes)
      SV_PTR_SWAP (xv, yv);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m,
                     coerce_mpz (tmp_mpz_0, xv),
                     coerce_mpz (tmp_mpz_1, yv));
OUTPUT:
    RETVAL


void
overload_addeq (x, y, o)
    mpz_assume   x
    mpz_coerce   y
    order_noswap o
ALIAS:
    GMP::Mpz::overload_subeq = 1
    GMP::Mpz::overload_muleq = 2
    GMP::Mpz::overload_diveq = 3
    GMP::Mpz::overload_remeq = 4
    GMP::Mpz::overload_andeq = 5
    GMP::Mpz::overload_ioreq = 6
    GMP::Mpz::overload_xoreq = 7
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
    } table[] = {
      { mpz_add    }, /* 0 */
      { mpz_sub    }, /* 1 */
      { mpz_mul    }, /* 2 */
      { mpz_tdiv_q }, /* 3 */
      { mpz_tdiv_r }, /* 4 */
      { mpz_and    }, /* 5 */
      { mpz_ior    }, /* 6 */
      { mpz_xor    }, /* 7 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (x->m, x->m, y);
    XPUSHs (ST(0));


mpz
overload_lshift (zv, nv, order)
    SV *zv
    SV *nv
    SV *order
ALIAS:
    GMP::Mpz::overload_rshift   = 1
    GMP::Mpz::overload_pow      = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
    } table[] = {
      { mpz_mul_2exp }, /* 0 */
      { mpz_div_2exp }, /* 1 */
      { mpz_pow_ui   }, /* 2 */
    };
CODE:
    assert_table (ix);
    if (order == &PL_sv_yes)
      SV_PTR_SWAP (zv, nv);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m, coerce_mpz (RETVAL->m, zv), coerce_ulong (nv));
OUTPUT:
    RETVAL


void
overload_lshifteq (z, n, o)
    mpz_assume   z
    ulong_coerce n
    order_noswap o
ALIAS:
    GMP::Mpz::overload_rshifteq   = 1
    GMP::Mpz::overload_poweq      = 2
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
    } table[] = {
      { mpz_mul_2exp }, /* 0 */
      { mpz_div_2exp }, /* 1 */
      { mpz_pow_ui   }, /* 2 */
    };
PPCODE:
    assert_table (ix);
    (*table[ix].op) (z->m, z->m, n);
    XPUSHs(ST(0));


mpz
overload_abs (z, d1, d2)
    mpz_assume z
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpz::overload_neg  = 1
    GMP::Mpz::overload_com  = 2
    GMP::Mpz::overload_sqrt = 3
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr w, mpz_srcptr x);
    } table[] = {
      { mpz_abs  }, /* 0 */
      { mpz_neg  }, /* 1 */
      { mpz_com  }, /* 2 */
      { mpz_sqrt }, /* 3 */
    };
CODE:
    assert_table (ix);
    RETVAL = new_mpz();
    (*table[ix].op) (RETVAL->m, z->m);
OUTPUT:
    RETVAL


void
overload_inc (z, d1, d2)
    mpz_assume z
    dummy      d1
    dummy      d2
ALIAS:
    GMP::Mpz::overload_dec = 1
PREINIT:
    static_functable const struct {
      void (*op) (mpz_ptr w, mpz_srcptr x, unsigned long y);
    } table[] = {
      { mpz_add_ui }, /* 0 */
      { mpz_sub_ui }, /* 1 */
    };
CODE:
    assert_table (ix);
    (*table[ix].op) (z->m, z->m, 1L);


int
overload_spaceship (xv, yv, order)
    SV *xv
    SV *yv
    SV *order
PREINIT:
    mpz x;
CODE:
    TRACE (printf ("%s overload_spaceship\n", mpz_class));
    MPZ_ASSUME (x, xv);
    switch (use_sv (yv)) {
    case USE_IVX:
      RETVAL = mpz_cmp_si (x->m, SvIVX(yv));
      break;
    case USE_UVX:
      RETVAL = mpz_cmp_ui (x->m, SvUVX(yv));
      break;
    case USE_PVX:
      RETVAL = mpz_cmp (x->m, coerce_mpz (tmp_mpz_0, yv));
      break;
    case USE_NVX:
      RETVAL = mpz_cmp_d (x->m, SvNVX(yv));
      break;
    case USE_MPZ:
      RETVAL = mpz_cmp (x->m, SvMPZ(yv)->m);