Math-Prime-Util
view release on metacpan or search on metacpan
}
}
#if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
void
CLONE(...)
PREINIT:
int i;
SV* bigintclass;
PPCODE:
{
MY_CXT_CLONE; /* possible declaration */
MY_CXT.MPUroot = gv_stashpv("Math::Prime::Util", TRUE);
MY_CXT.MPUGMP = gv_stashpv("Math::Prime::Util::GMP", TRUE);
MY_CXT.MPUPP = gv_stashpv("Math::Prime::Util::PP", TRUE);
/* These should be shared between threads, but that's dodgy. */
for (i = 0; i <= CINTS; i++) {
MY_CXT.const_int[i] = newSViv(i-1);
SvREADONLY_on(MY_CXT.const_int[i]);
}
}
return; /* skip implicit PUTBACK, returning @_ to caller, more efficient */
#endif
void
END(...)
PREINIT:
dMY_CXT;
int i;
PPCODE:
_prime_memfreeall();
MY_CXT.MPUroot = NULL;
MY_CXT.MPUGMP = NULL;
MY_CXT.MPUPP = NULL;
for (i = 0; i <= CINTS; i++) {
SV * const sv = MY_CXT.const_int[i];
MY_CXT.const_int[i] = NULL;
SvREFCNT_dec_NN(sv);
} /* stashes are owned by stash tree, no refcount on them in MY_CXT */
csprng_clear(MY_CXT.randcxt);
void csrand(IN SV* seed = 0)
PREINIT:
dMY_CXT;
STRLEN size;
unsigned char* data;
unsigned char gmpseed[64];
volatile unsigned char* p;
uint32_t size32, n, i;
PPCODE:
if (items == 0 || !SvOK(seed)) {
csprng_init_seed(MY_CXT.randcxt);
if (_XS_get_callgmp() >= 42) {
n = (uint32_t) sizeof(gmpseed);
if (get_entropy_bytes(n, gmpseed) != n)
croak("Failed to get entropy bytes for GMP CSPRNG seed");
SEED_GMP_CSPRNG(n, gmpseed);
p = (volatile unsigned char*) gmpseed;
i = n;
while (i-- > 0) *p++ = 0;
RETVAL = seedval;
OUTPUT:
RETVAL
void irand()
ALIAS:
irand32 = 1
irand64 = 2
PREINIT:
dMY_CXT;
PPCODE:
if (ix == 0 || ix == 1) {
XSRETURN_UV( irand32(MY_CXT.randcxt) );
} else {
#if BITS_PER_WORD == 64
XSRETURN_UV( irand64(MY_CXT.randcxt) );
#else
UV hi = irand32(MY_CXT.randcxt);
UV lo = irand32(MY_CXT.randcxt);
RETURN_UV_UV(hi, lo);
#endif
if (m != 0) RETVAL *= m;
OUTPUT:
RETVAL
void random_bytes(IN SV* svn)
ALIAS:
entropy_bytes = 1
PREINIT:
int nstatus;
UV n;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (nstatus != 1 || n > MAX_RANDOM_BYTES)
croak("%s: input must be an integer between 0 and %"UVuf, SUBNAME, MAX_RANDOM_BYTES);
if (n == 0)
RETURN_SV(sv_2mortal(newSVpvs("")));
{
dMY_CXT;
char* sptr;
SV* svret = sv_2mortal(newSV(n));
SvPOK_only(svret);
case 1: mask = IFLAG_NONNEG; break;
case 2: mask = IFLAG_POS; break;
case 3: mask = IFLAG_ABS; break;
default: croak("_validate_integer unknown flag value");
}
RETVAL = xs_validate_integer_inplace(aTHX_ svn, mask);
OUTPUT:
RETVAL
void _canonicalized_integer(SV* svn)
PPCODE:
RETURN_SV(xs_to_canonical(aTHX_ svn));
void _canonicalize_integers(SV* svr)
PREINIT:
SV *target, *out;
PPCODE:
if (!SvROK(svr))
croak("_canonicalize_integers: expected scalar or array reference");
target = SvRV(svr);
if (SvTYPE(target) == SVt_PVAV) {
xs_aref_to_canonical(aTHX_ svr, "_canonicalize_integers");
} else if (xs_is_sv_scalar_ref(svr)) {
out = xs_to_canonical(aTHX_ target);
if (out != target)
sv_setsv(target, out);
} else {
croak("_canonicalize_integers: expected scalar or array reference");
}
XSRETURN(0);
void prime_memfree()
PREINIT:
dMY_CXT;
PPCODE:
prime_memfree();
/* (void) _vcallgmpsubn(aTHX_ G_VOID|G_DISCARD, "_GMP_memfree", 0, 49); */
if (MY_CXT.MPUPP != NULL) DISPATCHPP_RETURN_VOID();
XSRETURN(0);
void prime_precalc(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) != 1)
croak("prime_precalc: n must fit in native unsigned integer");
prime_precalc(n);
XSRETURN(0);
void _XS_set_verbose(IN SV* svn)
ALIAS:
_XS_set_callgmp = 1
_XS_set_nobigint = 2
_end_for_loop = 3
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) != 1)
croak("%s: n must fit in native unsigned integer", SUBNAME);
switch (ix) {
case 0: _XS_set_verbose(n); break;
case 1: _XS_set_callgmp(n); break;
case 2: _XS_set_nobigint(n); break;
case 3:
default: { dMY_CXT; MY_CXT.forcount--; MY_CXT.forexit = n > 0; } break;
}
XSRETURN(0);
void prime_count(IN SV* svlo, IN SV* svhi = 0)
ALIAS:
semiprime_count = 1
twin_prime_count = 2
ramanujan_prime_count = 3
perfect_power_count = 4
prime_power_count = 5
lucky_count = 6
PREINIT:
UV lo = 0, hi, count = 0;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
if (lo <= hi) {
switch (ix) {
case 0: count = prime_count_range(lo, hi); break;
case 1: count = semiprime_count_range(lo, hi); break;
case 2: count = twin_prime_count_range(lo, hi); break;
case 3: count = ramanujan_prime_count_range(lo, hi); break;
case 4: count = perfect_power_count_range(lo, hi); break;
case 5: count = prime_power_count_range(lo, hi); break;
ramanujan_prime_count_upper = 9
ramanujan_prime_count_lower = 10
ramanujan_prime_count_approx = 11
twin_prime_count_approx = 12
semiprime_count_approx = 13
lucky_count_upper = 14
lucky_count_lower = 15
lucky_count_approx = 16
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
switch (ix) {
case 0: ret = prime_count_upper(n); break;
case 1: ret = prime_count_lower(n); break;
case 2: ret = prime_count_approx(n); break;
case 3: ret = prime_power_count_upper(n); break;
case 4: ret = prime_power_count_lower(n); break;
case 5: ret = prime_power_count_approx(n); break;
case 6: ret = perfect_power_count_upper(n); break;
case 7: ret = perfect_power_count_lower(n); break;
}
DISPATCHPP_RETURN();
void sum_primes(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
UV lo = 2, hi;
#if HAVE_FACTOR128 && HAVE_SUM_PRIMES128
uint64_t lo64 = 2, hi64;
#endif
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
UV count = 0;
/* 32/64-bit, Legendre or table-accelerated sieving. */
if (sum_primes(lo, hi, &count))
XSRETURN_UV(count);
/* If that didn't work, try the 128-bit version if supported. */
#if HAVE_FACTOR128 && HAVE_SUM_PRIMES128
{
uint128_t sum128;
if (sum_primes128(lo64, hi64, &sum128))
RETURN_U128(sum128);
}
#endif
DISPATCHPP_RETURN();
void random_prime(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
UV lo = 2, hi, ret;
dMY_CXT;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
ret = random_prime(MY_CXT.randcxt,lo,hi);
if (ret) XSRETURN_UV(ret);
else XSRETURN_UNDEF;
}
DISPATCHPP_RETURN();
void print_primes(IN SV* svlo, IN SV* svhi = 0, IN SV* svfd = 0)
PREINIT:
UV lo, hi, fd;
int status = 1, ifd, tfd, close_status, print_status = 1, saved_errno = 0;
PPCODE:
status &= _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG);
if (items > 1) status &= _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG);
if (items > 2) status &= _validate_and_set(&fd, aTHX_ svfd, IFLAG_NONNEG);
if (items == 1)
{ hi = lo; lo = 2; }
if (status == 0)
DISPATCHPP_RETURN_VOID();
if (items == 3) {
if (fd > INT_MAX) croak("print_primes: fd out of range");
void
sieve_primes(IN UV low, IN UV high)
ALIAS:
trial_primes = 1
erat_primes = 2
segment_primes = 3
PREINIT:
AV* av;
PPCODE:
CREATE_RETURN_AV(av);
if ((low <= 2) && (high >= 2)) av_push(av, newSVuv( 2 ));
if ((low <= 3) && (high >= 3)) av_push(av, newSVuv( 3 ));
if ((low <= 5) && (high >= 5)) av_push(av, newSVuv( 5 ));
if (low < 7) low = 7;
if (low <= high) {
if (ix == 0) { /* Sieve with primary cache */
START_DO_FOR_EACH_PRIME(low, high) {
av_push(av,newSVuv(p));
} END_DO_FOR_EACH_PRIME
}
XSRETURN(1);
void primes(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
AV* av;
UV lo = 0, hi, i;
int lostatus = 1, histatus = 0;
bool native_ok = FALSE;
PPCODE:
if (items == 1) {
histatus = _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG);
native_ok = histatus != 0;
} else if (items == 2) {
lostatus = _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG);
histatus = _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG);
native_ok = lostatus != 0 && histatus != 0;
}
if (native_ok) {
CREATE_RETURN_AV(av);
XSRETURN(1);
}
DISPATCHPP_RETURN();
void almost_primes(IN UV k, IN SV* svlo, IN SV* svhi = 0)
ALIAS:
omega_primes = 1
PREINIT:
AV* av;
UV lo = 1, hi, i, n, *S;
PPCODE:
if ((items == 2 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items >= 3 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
CREATE_RETURN_AV(av);
S = 0;
if (ix == 0) n = generate_almost_primes(&S, k, lo, hi);
else n = range_omega_prime_sieve(&S, k, lo, hi);
for (i = 0; i < n; i++)
av_push(av, newSVuv(S[i]));
if (S != 0) Safefree(S);
XSRETURN(1);
void prime_powers(IN SV* svlo, IN SV* svhi = 0)
ALIAS:
twin_primes = 1
semi_primes = 2
ramanujan_primes = 3
PREINIT:
AV* av;
UV lo = 0, hi, i, num, *L;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
CREATE_RETURN_AV(av);
if (ix == 0) { /* Prime power */
if ((lo <= 2) && (hi >= 2)) av_push(av, newSVuv( 2 ));
if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 ));
if ((lo <= 4) && (hi >= 4)) av_push(av, newSVuv( 4 ));
if ((lo <= 5) && (hi >= 5)) av_push(av, newSVuv( 5 ));
} else if (ix == 1) { /* Twin */
if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 ));
}
XSRETURN(1);
}
DISPATCHPP_RETURN();
void
lucky_numbers(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
AV* av;
UV lo = 0, hi, i, nlucky = 0;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
CREATE_RETURN_AV(av);
if (lo == 0 && hi <= UVCONST(4000000000)) {
uint32_t* lucky = lucky_sieve32(&nlucky, hi);
for (i = 0; i < nlucky; i++)
av_push(av,newSVuv(lucky[i]));
Safefree(lucky);
} else {
UV* lucky = lucky_sieve_range(&nlucky, lo, hi);
}
XSRETURN(1);
}
DISPATCHPP_RETURN();
void minimal_goldbach_pair(IN SV* svn)
ALIAS:
goldbach_pair_count = 1
PREINIT:
UV n, res;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
if (ix == 0) {
res = minimal_goldbach_pair(n);
if (res == 0) XSRETURN_UNDEF;
} else {
res = goldbach_pair_count(n);
}
XSRETURN_UV(res);
}
DISPATCHPP_RETURN();
void goldbach_pairs(IN SV* svn)
PREINIT:
size_t npairs, i;
UV n, *L;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) == 1) {
if (GIMME_V != G_ARRAY)
XSRETURN_UV(goldbach_pair_count(n));
L = goldbach_pairs(&npairs, n);
if (L == 0) XSRETURN_EMPTY;
EXTEND(SP, (EXTEND_TYPE)npairs);
for (i = 0; i < npairs; i++)
PUSHs(sv_2mortal(newSVuv(L[i])));
Safefree(L);
XSRETURN(npairs);
}
DISPATCHPP_RETURN();
void powerful_numbers(IN SV* svlo, IN SV* svhi = 0, IN SV* svk = 0)
PREINIT:
int kstatus = 1;
AV* av;
UV lo = 1, hi, i, k = 2, npowerful, *powerful;
PPCODE:
if (items >= 3)
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus == 1 &&
((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items >= 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) &&
_validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG)))) {
CREATE_RETURN_AV(av);
powerful = powerful_numbers_range(&npowerful, lo, hi, k);
for (i = 0; i < npowerful; i++)
av_push(av,newSVuv(powerful[i]));
Safefree(powerful);
XSRETURN(1);
}
DISPATCHPP_RETURN();
void sieve_range(IN SV* svn, IN SV* svwidth, IN SV* svdepth)
PREINIT:
int status;
UV n, width, depth, lo, hi, *P, np, i;
PPCODE:
/* Return index of every n unless it is a composite with factor > depth */
if (_validate_and_set(&width, aTHX_ svwidth, IFLAG_NONNEG) != 1)
croak("sieve_range: width must fit in native unsigned integer");
if (_validate_and_set(&depth, aTHX_ svdepth, IFLAG_NONNEG) != 1)
croak("sieve_range: depth must fit in native unsigned integer");
status = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (width == 0)
RETURN_NOTHING();
if (status != 1 || n > UV_MAX-(width-1))
DISPATCHPP_RETURN();
for (i = 0; i < np; i++)
PUSHs(sv_2mortal(newSVuv(P[i] - n)));
Safefree(P);
void
sieve_prime_cluster(IN SV* svlo, IN SV* svhi, ...)
PREINIT:
uint32_t nc, cl[100];
UV i, lo, hi, cval, nprimes, *list;
int done, leading_zero;
PPCODE:
nc = 1;
leading_zero = 0;
if (items > 100) croak("sieve_prime_cluster: too many entries");
cl[0] = 0;
for (i = 2; i < (UV)items; i++) {
if (!_validate_and_set(&cval, aTHX_ ST(i), IFLAG_NONNEG))
croak("sieve_prime_cluster: cluster values must be standard integers");
if (i == 2 && cval == 0) { leading_zero = 1; continue; }
if (cval & 1) croak("sieve_prime_cluster: values must be even");
if (cval > 2147483647UL) croak("sieve_prime_cluster: values must be 31-bit");
DISPATCHPP_RETURN_GMPIF(!leading_zero);
}
void is_pseudoprime(IN SV* svn, ...)
ALIAS:
is_euler_pseudoprime = 1
is_strong_pseudoprime = 2
PREINIT:
int i, status, ret = 0;
UV n, base;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
if (n < 3) {
ret = (n >= 2);
} else if (ix >= 1 && !(n&1)) {
ret = 0;
} else if (items == 1) {
ret = (ix == 0) ? is_pseudoprime(n, 2) :
(ix == 1) ? is_euler_pseudoprime(n, 2) :
is_strong_pseudoprime(n, 2);
is_catalan_pseudoprime = 10
is_euler_plumb_pseudoprime = 11
is_ramanujan_prime = 12
is_semiprime = 13
is_chen_prime = 14
is_safe_prime = 15
is_mersenne_prime = 16
PREINIT:
int status, ret;
UV n;
PPCODE:
ret = 0;
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
switch (ix) {
case 0: ret = 2*is_prime(n); break;
case 1: ret = 2*is_prob_prime(n); break;
case 2: ret = 2*is_prime(n); break;
case 3: ret = 2*BPSW(n); break;
case 4: ret = is_aks_prime(n); break;
case 5: ret = is_lucas_pseudoprime(n, 0); break;
DISPATCHPP_RETURN();
void
is_perrin_pseudoprime(IN SV* svn, IN SV* svk = 0)
ALIAS:
is_almost_extra_strong_lucas_pseudoprime = 1
is_delicate_prime = 2
PREINIT:
int nstatus, kstatus, ret = -1;
UV n, k;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items == 1) {
kstatus = 1;
k = (ix == 0) ? 0 : (ix == 1) ? 1 : 10;
} else {
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
}
if (kstatus == 1 && ix == 0) {
if (k > 3) croak("%s: restriction must be between 0 and 3", SUBNAME);
if (nstatus == 1) ret = is_perrin_pseudoprime(n, k);
if (ret >= 0)
RETURN_NPARITY(ret);
DISPATCHPP_RETURN_GMPIF(kstatus == 1);
void
is_frobenius_pseudoprime(IN SV* svn, IN SV* svp = 0, IN SV* svq = 0)
PREINIT:
int nstatus, pstatus, qstatus;
UV n;
IV P, Q, maxparam;
PPCODE:
if (items == 1) {
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (nstatus == -1) RETURN_NPARITY(0);
if (nstatus == 1) RETURN_NPARITY(is_frobenius_pseudoprime(n));
} else if (items == 3) {
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
pstatus = _validate_and_set((UV*)&P, aTHX_ svp, IFLAG_IV);
qstatus = _validate_and_set((UV*)&Q, aTHX_ svq, IFLAG_IV);
if (nstatus == -1) RETURN_NPARITY(0);
/* If |P| and |Q| are less than this, then D=P*P-4*Q cannot overflow IV */
RETURN_NPARITY(is_frobenius_pseudoprime_pq(n, P, Q));
} else
croak("is_frobenius_pseudoprime: expected 1 or 3 arguments");
DISPATCHPP_RETURN();
void
miller_rabin_random(IN SV* svn, IN SV* svnbases = 0)
PREINIT:
int nstatus, bstatus;
UV n, nbases;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items < 2) { bstatus = 1; nbases = 1; }
else bstatus=_validate_and_set(&nbases,aTHX_ svnbases,IFLAG_POS);
if (nstatus != 0 && bstatus != 0) {
dMY_CXT;
RETURN_NPARITY(nstatus == -1 ? 0 : is_mr_random(MY_CXT.randcxt,n,nbases));
}
DISPATCHPP_RETURN();
void is_gaussian_prime(IN SV* sva, IN SV* svb)
PREINIT:
UV a, b;
PPCODE:
if (_validate_and_set(&a, aTHX_ sva, IFLAG_ABS) &&
_validate_and_set(&b, aTHX_ svb, IFLAG_ABS)) {
if (a == 0) RETURN_NPARITY( ((b % 4) == 3) ? 2*is_prime(b) : 0 );
if (b == 0) RETURN_NPARITY( ((a % 4) == 3) ? 2*is_prime(a) : 0 );
if (a < HALF_WORD && b < HALF_WORD) {
UV aa = a*a, bb = b*b;
if (UV_MAX-aa >= bb)
RETURN_NPARITY( 2*is_prime(aa+bb) );
}
}
void
gcd(...)
PROTOTYPE: @
ALIAS:
lcm = 1
PREINIT:
int i, status = 1;
UV ret, nullv, n;
PPCODE:
/* For each arg, while valid input, validate+gcd/lcm. Shortcut stop. */
if (ix == 0) { ret = 0; nullv = 1; }
else { ret = 1; nullv = 0; }
for (i = 0; i < items && ret != nullv && status != 0; i++) {
status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ABS);
if (status == 0) break;
if (i == 0) {
ret = n;
} else {
UV gcd = gcd_ui(ret, n);
DISPATCHPP_RETURN();
void
vecmin(...)
PROTOTYPE: @
ALIAS:
vecmax = 1
PREINIT:
int i, status;
UV ret, n, retindex;
PPCODE:
if (items == 0) XSRETURN_UNDEF;
if (items == 1) RETURN_SV_CANONICAL(ST(0));
retindex = 0;
if ((status = _validate_and_set(&ret, aTHX_ ST(0), IFLAG_ANY)) != 0) {
int sign = status, minmax = (ix == 0);
for (i = 1; i < items; i++) {
status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ANY);
if (status == 0) break;
if (( (sign == -1 && status == 1) ||
(n >= ret && sign == status)
RETURN_SV_CANONICAL(ST(retindex));
void
vecsum(...)
PROTOTYPE: @
ALIAS:
vecprod = 1
PREINIT:
int i, status;
UV ret, n;
PPCODE:
if (items == 0)
XSRETURN_UV(ix == 0 ? 0 : 1);
status = 1;
if (ix == 0) {
UV lo = 0;
IV hi = 0;
for (ret = 0, i = 0; i < items; i++) {
status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ANY);
if (status == 0) break;
if (status == 1) hi += (n > (UV_MAX - lo));
}
DISPATCHPP_RETURN();
void
vecprefixsum(...)
PROTOTYPE: @
PREINIT:
int type;
size_t i, len;
UV *L;
PPCODE:
if (items == 0)
RETURN_NOTHING();
if (SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV) {
if (items != 1)
croak("vecprefixsum: expected integer list or single array reference");
type = arrayref_to_int_array(aTHX_ &len, &L, 0, ST(0), "vecprefixsum");
} else {
type = array_to_int_array(aTHX_ &len, &L, 0, &ST(0), items);
}
if (type == IARR_TYPE_NEG) {
if (i >= len) RETURN_LIST_VALS(len, L, 1);
}
Safefree(L);
DISPATCHPP_RETURN();
void
vecextract(IN SV* x, IN SV* svm)
PREINIT:
AV* av;
UV mask, i = 0;
PPCODE:
CHECK_ARRAYREF(x);
av = (AV*) SvRV(x);
if (SvROK(svm) && SvTYPE(SvRV(svm)) == SVt_PVAV) {
SSize_t j;
DECL_ARREF(mav);
USE_ARREF(mav, svm, SUBNAME, AR_READ);
for (j = 0; (Size_t)j < len_mav; j++) {
int status = _validate_and_set(&mask, aTHX_ FETCH_ARREF(mav,j), IFLAG_IV);
REFRESH_ARREF(mav);
if (status != 0) {
mask >>= 1;
}
} else {
DISPATCHPP_RETURN();
}
void
vecequal(IN SV* a, IN SV* b)
PREINIT:
int res;
PPCODE:
res = _compare_array_refs(aTHX_ a, b);
if (res == AREF_CMP_DISPATCH)
DISPATCHPP_RETURN();
if (res == AREF_CMP_INVALID)
croak("vecequal: expected scalar or array reference");
RETURN_NPARITY(res);
void
vecmex(...)
ALIAS:
vecpmex = 1
PROTOTYPE: @
PREINIT:
char *setv;
int i, status = 1;
UV min, n;
uint32_t mask;
PPCODE:
if (ix == 0) {
min = 0;
mask = IFLAG_NONNEG;
} else {
min = 1;
mask = IFLAG_POS;
}
if (items == 0)
XSRETURN_UV(min);
Newz(0, setv, items, char);
break;
Safefree(setv);
XSRETURN_UV(i+min);
void
frobenius_number(...)
PROTOTYPE: @
PREINIT:
int i, found1 = 0;
UV fn, n, *A;
PPCODE:
if (items == 0) XSRETURN_UNDEF;
Newz(0, A, items, UV);
for (i = 0; i < items; i++) {
if (!_validate_and_set(&n, aTHX_ ST(i), IFLAG_POS)) break;
if (n == 1) found1 = 1;
A[i] = n;
}
if (i == items && !found1)
fn = frobenius_number(A, i);
Safefree(A);
void
chinese(...)
ALIAS:
chinese2 = 1
PROTOTYPE: @
PREINIT:
int i, status, astatus, nstatus;
UV ret, lcm, *an;
SV **psva, **psvn;
PPCODE:
status = 1;
New(0, an, 2*items, UV);
ret = 0;
for (i = 0; i < items; i++) {
AV* av;
CHECK_ARRAYREF(ST(i));
av = (AV*) SvRV(ST(i));
if (av_count(av) != 2) croak("%s: expected 2-element array reference",SUBNAME);
psva = av_fetch(av, 0, 0);
psvn = av_fetch(av, 1, 0);
XPUSHs(sv_2mortal(newSVuv( lcm )));
}
XSRETURN(2);
}
}
DISPATCHPP_RETURN();
void cornacchia(IN SV* svd, IN SV* svn)
PREINIT:
UV d, n, x, y;
PPCODE:
if (_validate_and_set(&d, aTHX_ svd, IFLAG_NONNEG) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) ) {
if (!cornacchia(&x, &y, d, n)) XSRETURN_UNDEF;
PUSHs(sv_2mortal(newSVuv( x )));
PUSHs(sv_2mortal(newSVuv( y )));
XSRETURN(2);
}
DISPATCHPP_RETURN();
void lucas_sequence(...)
PREINIT:
UV U, V, Qk, n, P, Q, k;
int nstatus, pstatus, qstatus, kstatus;
PPCODE:
if (items != 4) croak("lucas_sequence: n, P, Q, k");
nstatus = _validate_and_set(&n, aTHX_ ST(0), IFLAG_POS);
pstatus = _validate_and_set(&P, aTHX_ ST(1), IFLAG_IV);
qstatus = _validate_and_set(&Q, aTHX_ ST(2), IFLAG_IV);
kstatus = _validate_and_set(&k, aTHX_ ST(3), IFLAG_NONNEG);
if (nstatus && pstatus && qstatus && kstatus) {
lucas_seq(&U, &V, &Qk, n, (IV)P, (IV)Q, k);
PUSHs(sv_2mortal(newSVuv( U ))); /* 4 args in, 3 out, no EXTEND needed */
PUSHs(sv_2mortal(newSVuv( V )));
PUSHs(sv_2mortal(newSVuv( Qk )));
}
DISPATCHPP_RETURN();
void lucasuvmod(IN SV* svp, IN SV* svq, IN SV* svk, IN SV* svn)
ALIAS:
lucasumod = 1
lucasvmod = 2
PREINIT:
int pstatus, qstatus;
UV P, Q, k, n, U, V;
PPCODE:
pstatus = _validate_and_set(&P, aTHX_ svp, IFLAG_ANY);
qstatus = _validate_and_set(&Q, aTHX_ svq, IFLAG_ANY);
if ((pstatus != 0) && (qstatus != 0) &&
_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)
) {
if (n == 0) XSRETURN_UNDEF;
P = (pstatus == 1) ? P % n : ivmod((IV)P,n);
Q = (qstatus == 1) ? Q % n : ivmod((IV)Q,n);
if (ix == 1) XSRETURN_UV(lucasumod(P, Q, k, n));
}
DISPATCHPP_RETURN();
void lucasuv(IN SV* svp, IN SV* svq, IN SV* svk)
ALIAS:
lucasu = 1
lucasv = 2
PREINIT:
UV k;
IV P, Q, U, V;
PPCODE:
if (_validate_and_set((UV*)&P, aTHX_ svp, IFLAG_IV) &&
_validate_and_set((UV*)&Q, aTHX_ svq, IFLAG_IV) &&
_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) &&
lucasuv(&U, &V, P, Q, k)) {
if (ix == 1) XSRETURN_IV(U); /* U = lucasu(P,Q,k) */
if (ix == 2) XSRETURN_IV(V); /* V = lucasv(P,Q,k) */
PUSHs(sv_2mortal(newSViv( U ))); /* (U,V) = lucasuv(P,Q,k) */
PUSHs(sv_2mortal(newSViv( V )));
XSRETURN(2);
}
DISPATCHPP_RETURN();
void fibonacci(IN SV* svk)
ALIAS:
lucas_number = 1
PREINIT:
UV k, N;
int kstatus;
PPCODE:
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY);
if (kstatus != 0) {
if (kstatus == -1) k = neg_iv(k);
N = ix == 0 ? fibonacci_number(k) : lucas_number(k);
if (k == 0 || N > 0) {
/* fib(-n) = -fib(n) for even n, luc(-n) = -luc(n) for odd n */
if (kstatus == 1 || k % 2 != (UV)ix)
XSRETURN_UV(N);
else if (N <= IV_MAX)
XSRETURN_IV(-(IV)N);
}
}
DISPATCHPP_RETURN();
void is_sum_of_squares(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus, ret;
UV n, k;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (items < 2) { kstatus = 1; k = 2; }
else { kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG); }
if (nstatus != 0 && kstatus != 0) {
switch (k) {
case 0: ret = (n==0); break;
case 1: ret = is_power(n,2); break;
case 2: ret = is_sum_of_two_squares(n); break;
case 3: ret = is_sum_of_three_squares(n); break;
default: ret = 1; break;
is_perfect_power = 3
is_fundamental = 4
is_lucky = 5
is_practical = 6
is_perfect_number = 7
is_cyclic = 8
is_totient = 9
PREINIT:
int status, ret;
UV n;
PPCODE:
ret = 0;
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
switch (ix) {
case 0: ret = is_perfect_square(n); break;
case 1: ret = is_carmichael(n); break;
case 2: ret = is_quasi_carmichael(n); break;
case 3: ret = is_perfect_power(n); break;
case 4: ret = is_fundamental(n,0); break;
case 5: ret = is_lucky(n); break;
if (ix == 0 && status == 0 &&
xs_sv_is_perfect_square(aTHX_ svn, &ret))
RETURN_NPARITY(ret);
if (status != 0) RETURN_NPARITY(ret);
DISPATCHPP_RETURN();
void squarefree_kernel(IN SV* svn)
PREINIT:
int status;
UV n;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1)
XSRETURN_IV( neg_iv(squarefree_kernel(neg_iv(n))) );
if (status == 1)
XSRETURN_UV( squarefree_kernel(n) );
DISPATCHPP_RETURN();
void is_powerfree(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus != 0)
RETURN_NPARITY( is_powerfree(n,k) );
DISPATCHPP_RETURN();
void powerfree_count(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus == -1)
XSRETURN_UV(0);
if (nstatus == 1)
XSRETURN_UV( powerfree_count(n,k) );
DISPATCHPP_RETURN();
void powerfree_sum(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2, res;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus == -1)
XSRETURN_UV(0);
if (nstatus == 1) {
res = powerfree_sum(n,k);
if (res != 0 || n == 0)
XSRETURN_UV(res);
/* res is 0 and n > 0, so we overflowed. Fall through to PP. */
}
DISPATCHPP_RETURN();
void powerfree_part(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus != 0) {
if (nstatus == -1)
XSRETURN_IV( neg_iv(powerfree_part(neg_iv(n),k)) );
XSRETURN_UV( powerfree_part(n,k) );
}
DISPATCHPP_RETURN();
void powerfree_part_sum(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2, res;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus == -1)
XSRETURN_UV(0);
if (nstatus == 1) {
res = powerfree_part_sum(n,k);
if (res != 0 || n == 0)
XSRETURN_UV(res);
/* res is 0 and n > 0, so we overflowed. Fall through to PP. */
}
DISPATCHPP_RETURN();
void nth_powerfree(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus = 1;
UV n, k = 2, res;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (items >= 2) kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1 || k > UINT32_MAX) croak("%s: k must be <= 4294967295", SUBNAME);
if (nstatus == 1) {
if (n == 0 || k < 2)
XSRETURN_UNDEF;
res = nth_powerfree(n,k);
if (res != 0)
XSRETURN_UV(res);
/* if res = 0, overflow */
}
DISPATCHPP_RETURN();
void
is_power(IN SV* svn, IN SV* svk = 0, IN SV* svroot = 0)
PREINIT:
int nstatus, kstatus, ret;
UV n, k;
uint32_t root;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items == 2 && xs_is_sv_scalar_ref(svk)) {
svroot = svk;
svk = 0;
}
if (svk) SvGETMAGIC(svk);
if (items < 2 || svk == 0 || !SvOK(svk)) {
kstatus = 1; k = 0;
} else {
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
}
RETURN_NPARITY(ret);
}
DISPATCHPP_RETURN_GMPIF(svroot == 0);
void
is_prime_power(IN SV* svn, IN SV* svroot = 0)
PREINIT:
int status, ret;
UV n, root;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (items >= 2 && !xs_is_sv_scalar_ref(svroot))
croak("is_prime_power: second argument not a scalar reference");
if (status != 0) {
ret = (status == 1) ? prime_power(n, &root) : 0;
if (ret && items >= 2)
sv_setuv(SvRV(svroot), root);
RETURN_NPARITY(ret);
}
DISPATCHPP_RETURN_GMPIF(svroot == 0);
void
is_polygonal(IN SV* svn, IN UV k, IN SV* svroot = 0)
PREINIT:
UV n;
int status;
PPCODE:
if (k < 3) croak("is_polygonal: k must be >= 3");
if (items >= 3 && !xs_is_sv_scalar_ref(svroot))
croak("is_polygonal: third argument not a scalar reference");
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1)
RETURN_NPARITY(0);
if (status == 1) {
bool overflow = 0;
UV root = polygonal_root(n, k, &overflow);
sv_setuv(SvRV(svroot), root);
RETURN_NPARITY(result);
}
}
DISPATCHPP_RETURN_GMPIF(svroot == 0);
void inverse_li(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
#if BITS_PER_WORD == 64
/* Larger values need more precision to identify the exact integer. */
if (n <= UVCONST(1000000000000) && n < MPU_MAX_PRIME_IDX)
#else
if (n < MPU_MAX_PRIME_IDX)
#endif
XSRETURN_UV(inverse_li(n));
}
DISPATCHPP_RETURN();
void inverse_li_nv(IN SV* svx)
PREINIT:
const char *xstr;
STRLEN xlen;
int xtype;
NV x, ret;
PPCODE:
SvGETMAGIC(svx);
if (SvOK(svx)) {
xstr = SvPV(svx, xlen);
xtype = grok_number(xstr, xlen, 0);
if (xtype && !(xtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN))) {
x = SvROK(svx) ? STRTONV(xstr) : SvNV(svx);
if (x >= 0.0 && MPU_NV_ISFINITE(x)) {
ret = (NV)ld_inverse_li(x,0);
if (MPU_NV_ISFINITE(ret))
XSRETURN_NV(ret);
}
croak("inverse_li_nv: x must be a finite non-negative real number");
void nth_prime(IN SV* svn)
ALIAS:
nth_prime_upper = 1
nth_prime_lower = 2
nth_prime_approx = 3
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_PRIME_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_prime(n); break;
case 1: ret = nth_prime_upper(n); break;
case 2: ret = nth_prime_lower(n); break;
case 3:
default: ret = nth_prime_approx(n); break;
}
}
DISPATCHPP_RETURN();
void nth_prime_power(IN SV* svn)
ALIAS:
nth_prime_power_upper = 1
nth_prime_power_lower = 2
nth_prime_power_approx = 3
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_PRIME_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_prime_power(n); break;
case 1: ret = nth_prime_power_upper(n); break;
case 2: ret = nth_prime_power_lower(n); break;
case 3:
default: ret = nth_prime_power_approx(n); break;
}
}
DISPATCHPP_RETURN();
void nth_perfect_power(IN SV* svn)
ALIAS:
nth_perfect_power_upper = 1
nth_perfect_power_lower = 2
nth_perfect_power_approx = 3
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_PERFECT_POW_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_perfect_power(n); break;
case 1: ret = nth_perfect_power_upper(n); break;
case 2: ret = nth_perfect_power_lower(n); break;
case 3:
default: ret = nth_perfect_power_approx(n); break;
}
}
DISPATCHPP_RETURN();
void nth_ramanujan_prime(IN SV* svn)
ALIAS:
nth_ramanujan_prime_upper = 1
nth_ramanujan_prime_lower = 2
nth_ramanujan_prime_approx = 3
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_RMJN_PRIME_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_ramanujan_prime(n); break;
case 1: ret = nth_ramanujan_prime_upper(n); break;
case 2: ret = nth_ramanujan_prime_lower(n); break;
case 3:
default: ret = nth_ramanujan_prime_approx(n); break;
}
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void nth_twin_prime(IN SV* svn)
ALIAS:
nth_twin_prime_approx = 1
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_TWIN_PRIME_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_twin_prime(n); break;
case 1:
default: ret = nth_twin_prime_approx(n); break;
}
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void nth_semiprime(IN SV* svn)
ALIAS:
nth_semiprime_approx = 1
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_SEMI_PRIME_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_semiprime(n); break;
case 1:
default: ret = nth_semiprime_approx(n); break;
}
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void nth_lucky(IN SV* svn)
ALIAS:
nth_lucky_upper = 1
nth_lucky_lower = 2
nth_lucky_approx = 3
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
n <= MPU_MAX_LUCKY_IDX ) {
if (n == 0) XSRETURN_UNDEF;
switch (ix) {
case 0: ret = nth_lucky(n); break;
case 1: ret = nth_lucky_upper(n); break;
case 2: ret = nth_lucky_lower(n); break;
case 3:
default: ret = nth_lucky_approx(n); break;
}
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void next_prime(IN SV* svn)
ALIAS:
prev_prime = 1
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)
&& !(ix == 0 && n >= MPU_MAX_PRIME)) {
ret = 0;
switch (ix) {
case 0: ret = next_prime(n); break;
case 1: ret = prev_prime(n); break;
default: break;
}
if (ret == 0) XSRETURN_UNDEF;
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void next_prime_power(IN SV* svn)
ALIAS:
prev_prime_power = 1
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)
&& !(ix == 0 && n >= MPU_MAX_PRIME)) {
ret = 0;
switch (ix) {
case 0: ret = next_prime_power(n); break;
case 1: ret = prev_prime_power(n); break;
default: break;
}
if (ret == 0) XSRETURN_UNDEF;
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void next_perfect_power(IN SV* svn)
PREINIT:
UV n;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
n = next_perfect_power(n);
if (n != 0) XSRETURN_UV(n);
} else if (status == -1) { /* next perfect power: negative n */
n = next_perfect_power_neg(neg_iv(n));
XSRETURN_IV(neg_iv(n));
}
DISPATCHPP_RETURN();
void prev_perfect_power(IN SV* svn)
PREINIT:
UV n;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
if (n == 0) XSRETURN_IV(-1);
n = prev_perfect_power(n);
XSRETURN_UV(n);
} else if (status == -1) { /* prev perfect power: negative n */
n = prev_perfect_power_neg(neg_iv(n));
if (n > 0 && n <= (UV)IV_MAX)
XSRETURN_IV(neg_iv(n));
}
DISPATCHPP_RETURN();
void next_chen_prime(IN SV* svn)
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
ret = next_chen_prime(n);
if (ret != 0) XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void urandomb(IN SV* svbits)
PREINIT:
UV bits;
int bstatus;
PPCODE:
bstatus = _validate_and_set(&bits, aTHX_ svbits, IFLAG_NONNEG);
if (bstatus != 1 || bits > MAX_RANDOM_BITS)
croak("%s: bits must be between 0 and %"UVuf, SUBNAME, MAX_RANDOM_BITS);
if (bits <= BITS_PER_WORD) {
dMY_CXT;
XSRETURN_UV( urandomb(MY_CXT.randcxt, bits) );
}
DISPATCHPP_RETURN();
void random_ndigit_prime(IN SV* svdigits)
PREINIT:
int dstatus;
UV digits;
PPCODE:
dstatus = _validate_and_set(&digits, aTHX_ svdigits, IFLAG_POS);
if (dstatus != 1 || digits < 1 || digits > MAX_RANDOM_DIGITS)
croak("%s: digits must be between 1 and %"UVuf, SUBNAME, MAX_RANDOM_DIGITS);
if (digits <= uvmax_maxlen) {
dMY_CXT;
UV res = random_ndigit_prime(MY_CXT.randcxt, digits);
if (res != 0) XSRETURN_UV(res);
}
/* We could implement the nobigint completely here if we cared */
DISPATCHPP_RETURN_GMPIF(!_XS_get_nobigint());
random_maurer_prime = 2
random_proven_prime = 3
random_strong_prime = 4
random_safe_prime = 5
random_semiprime = 6
random_unrestricted_semiprime = 7
PREINIT:
UV bits, res;
static const unsigned int minbits[] = { 2, 2, 2, 2, 128, 3, 4, 3 };
int bstatus;
PPCODE:
bstatus = _validate_and_set(&bits, aTHX_ svbits, IFLAG_POS);
if (bstatus != 1 || bits < minbits[ix] || bits > MAX_RANDOM_BITS)
croak("%s: bits must be between %u and %"UVuf, SUBNAME, minbits[ix], MAX_RANDOM_BITS);
if (bits <= BITS_PER_WORD) {
dMY_CXT;
void *cs = MY_CXT.randcxt;
switch (ix) {
case 5: res = random_safe_prime(cs,bits); break;
case 6: res = random_semiprime(cs,bits); break;
case 7: res = random_unrestricted_semiprime(cs,bits); break;
default: res = random_nbit_prime(cs,bits); break;
}
if (res) XSRETURN_UV(res);
}
DISPATCHPP_RETURN();
void urandomm(IN SV* svn)
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
dMY_CXT;
ret = urandomm64(MY_CXT.randcxt, n);
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void urandomr(IN SV* svlo, IN SV* svhi)
PREINIT:
UV lo, hi;
int lo_s, hi_s;
PPCODE:
lo_s = _validate_and_set(&lo, aTHX_ svlo, IFLAG_ANY);
hi_s = _validate_and_set(&hi, aTHX_ svhi, IFLAG_ANY);
if (lo_s == 1 && hi_s == 1) {
dMY_CXT;
if (lo > hi) XSRETURN_UNDEF;
if (lo == hi) XSRETURN_UV(lo);
if (lo == 0 && hi == UV_MAX)
XSRETURN_UV( BITS_PER_WORD == 64 ? irand64(MY_CXT.randcxt)
: irand32(MY_CXT.randcxt) );
XSRETURN_UV(lo + urandomm64(MY_CXT.randcxt, hi-lo+1));
}
DISPATCHPP_RETURN();
void toint(IN SV* svn)
PREINIT:
const char *s;
STRLEN len;
uint32_t stype;
SV *numsv;
PPCODE:
SvGETMAGIC(svn);
if (!SvOK(svn)) XSRETURN_UV(0); /* undef returns 0 without warning */
/* Fastest path: if it is already a native int then we're done. */
/* TODO: verify 5.6.2 */
if (SVNUMTEST(svn)) {
if (SvIsUV(svn)) XSRETURN_UV(SvUVX(svn));
XSRETURN_IV(SvIVX(svn));
}
/* Simple NV within native UV/IV range: truncate toward zero. */
if (SvNOK(svn) && !SvROK(svn)) {
if (stype & SNUMFLAG_BIGINT)
RETURN_SV(xs_to_canonical_bigint(aTHX_ numsv, s, len));
if (stype == SNUMFLAG_UNKNOWN)
RETURN_SV( xs_call_root_1_sv(aTHX_ "_int_from_float", numsv) );
croak("%s: internal numeric conversion error", SUBNAME);
void random_factored_integer(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
dMY_CXT;
int f, nf;
UV r, F[MPU_MAX_FACTORS+1];
AV* av = newAV();
r = random_factored_integer(MY_CXT.randcxt, n, &nf, F);
sort_uv_array(F, nf);
for (f = 0; f < nf; f++)
av_push(av, newSVuv(F[f]));
XPUSHs(sv_2mortal(newSVuv( r )));
} else {
DISPATCHPP_RETURN();
}
void contfrac(IN SV* svnum, IN SV* svden)
PREINIT:
UV num, den, *cf, rem;
int nstatus, dstatus, i, steps;
PPCODE:
nstatus = _validate_and_set(&num, aTHX_ svnum, IFLAG_ANY);
dstatus = _validate_and_set(&den, aTHX_ svden, IFLAG_POS);
if (nstatus == 0 || dstatus == 0)
DISPATCHPP_RETURN();
if (nstatus == -1) num = neg_iv(num);
steps = contfrac(&cf, &rem, num, den);
if (GIMME_V != G_ARRAY) {
int count = steps;
if (nstatus == -1 && steps > 1)
count += (cf[1] == 1) ? -1 : 1;
}
}
Safefree(cf);
void from_contfrac(...)
PROTOTYPE: @
PREINIT:
size_t i;
UV n, cfA0, cfA1, cfB0, cfB1, cfAn, cfBn;
int nstatus, overflow;
PPCODE:
nstatus = 1;
overflow = 0;
cfA0 = 1; cfA1 = 0;
cfB0 = 0; cfB1 = 1;
if (items > 0) {
nstatus = _validate_and_set(&n, aTHX_ ST(0), IFLAG_ANY);
/* TODO: handle negative n */
cfA1 = n;
for (i = 1; nstatus == 1 && i < (size_t) items; i++) {
if (!_validate_and_set(&n, aTHX_ ST(i), IFLAG_POS))
XSRETURN(2);
}
DISPATCHPP_RETURN();
void convergents(...)
PROTOTYPE: @
PREINIT:
size_t len;
UV *L, *P, *Q;
int type;
PPCODE:
if (items == 0)
RETURN_NOTHING();
type = array_to_int_array(aTHX_ &len, &L, 0, &ST(0), items);
/* We punt negative cases to PP */
if (!(type == IARR_TYPE_BAD || type == IARR_TYPE_NEG)) {
if (convergents(&P, &Q, L, len)) {
size_t i;
if (GIMME_V != G_ARRAY) {
Safefree(P);
Safefree(Q);
}
Safefree(L);
DISPATCHPP_RETURN();
void bestrational(IN SV* svx, IN SV* svdbound)
PREINIT:
UV dbound, P, Q;
STRLEN xlen;
const char *xstr;
int xtype;
PPCODE:
SvGETMAGIC(svx);
if (_validate_and_set(&dbound, aTHX_ svdbound, IFLAG_POS) &&
SvOK(svx) &&
!sv_isobject(svx)) {
xstr = SvPV_nomg(svx, xlen);
xtype = grok_number(xstr, xlen, 0);
if (xtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN))
croak("bestrational: first argument must be a finite real number");
if (xtype) {
NV x = SvNV(svx);
}
}
DISPATCHPP_RETURN();
void next_calkin_wilf(IN SV* svnum, IN SV* svden)
ALIAS:
next_stern_brocot = 1
PREINIT:
UV num, den;
int status;
PPCODE:
if (_validate_and_set(&num, aTHX_ svnum, IFLAG_POS) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS)) {
if (gcd_ui(num, den) != 1)
croak("%s: rational must be reduced", SUBNAME);
switch (ix) {
case 0: status = next_calkin_wilf(&num, &den); break;
case 1: status = next_stern_brocot(&num, &den); break;
default: status = 0; break;
}
if (status) {
XPUSHs(sv_2mortal(newSVuv( num )));
XSRETURN(2);
}
}
DISPATCHPP_RETURN();
void calkin_wilf_n(IN SV* svnum, IN SV* svden)
ALIAS:
stern_brocot_n = 1
PREINIT:
UV num, den, n;
PPCODE:
if (_validate_and_set(&num, aTHX_ svnum, IFLAG_POS) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS)) {
switch (ix) {
case 0: n = calkin_wilf_n(num, den); break;
case 1: n = stern_brocot_n(num, den); break;
default: n = 0; break;
}
if (n) XSRETURN_UV(n);
}
DISPATCHPP_RETURN();
void nth_calkin_wilf(IN SV* svn)
ALIAS:
nth_stern_brocot = 1
PREINIT:
UV n, num, den;
int status;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
switch (ix) {
case 0: status = nth_calkin_wilf(&num, &den, n); break;
case 1: status = nth_stern_brocot(&num, &den, n); break;
default: status = 0; break;
}
if (status) {
XPUSHs(sv_2mortal(newSVuv( num )));
XPUSHs(sv_2mortal(newSVuv( den )));
XSRETURN(2);
}
}
DISPATCHPP_RETURN();
void nth_stern_diatomic(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG))
XSRETURN_UV(nth_stern_diatomic(n));
DISPATCHPP_RETURN();
void farey(IN SV* svn, IN SV* svk = 0)
PREINIT:
UV n, k;
int wantsingle, kresult;
PPCODE:
wantsingle = svk != 0;
if (wantsingle) {
if (!_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG))
k = UV_MAX;
}
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= UINT32_MAX) {
uint32_t n32 = (uint32_t) n;
if (wantsingle) {
uint32_t p, q;
kresult = kth_farey(n32, k, &p, &q);
DISPATCHPP_RETURN();
void next_farey(IN SV* svn, IN SV* svfrac)
ALIAS:
farey_rank = 1
PREINIT:
SV **psvp, **psvq;
AV* av;
UV n, p64, q64;
int status;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= UINT32_MAX) {
uint32_t n32 = (uint32_t) n;
CHECK_ARRAYREF(svfrac);
av = (AV*) SvRV(svfrac);
if (av_count(av) != 2) croak("%s: expected 2-element array reference", SUBNAME);
psvp = av_fetch(av, 0, 0);
psvq = av_fetch(av, 1, 0);
status = 1;
if (psvp == 0 || psvq == 0)
status = 0;
const NV pival = 3.141592653589793238462643383279502884197169Q;
#elif defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
const UV mantsize = LDBL_DIG;
const NV pival = 3.141592653589793238462643383279502884197169L;
#else
const UV mantsize = DBL_DIG;
const NV pival = 3.141592653589793238462643383279502884197169;
#endif
UV digits;
int status;
PPCODE:
status = 1;
digits = 0;
if (items > 0)
status = _validate_and_set(&digits, aTHX_ svdigits, IFLAG_NONNEG);
if (status != 1 || digits > mantsize)
DISPATCHPP_RETURN();
if (digits == 0)
XSRETURN_NV( pival );
{
char* out = pidigits(digits);
NV pi = STRTONV(out);
Safefree(out);
XSRETURN_NV( pi );
}
void bernfrac(IN SV* svn)
ALIAS:
harmfrac = 1
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) != 0) {
if (ix == 0) {
IV num; UV den;
if (bernfrac(&num, &den, n)) {
XPUSHs(sv_2mortal(newSViv( num )));
XPUSHs(sv_2mortal(newSVuv( den )));
XSRETURN(2);
}
} else {
UV num, den;
}
}
}
DISPATCHPP_RETURN();
void
_pidigits(IN SV* svdigits)
PREINIT:
UV digits;
char* out;
PPCODE:
if (!_validate_and_set(&digits, aTHX_ svdigits, IFLAG_NONNEG) ||
digits > UINT32_MAX)
croak("_pidigits: input digits exceeds 32-bit limit");
if (digits == 0)
XSRETURN_PV("");
out = pidigits(digits);
XPUSHs(sv_2mortal(newSVpvn(out, digits + (digits>1))));
Safefree(out);
void inverse_totient(IN SV* svn)
PREINIT:
U32 gimme_v;
int status;
UV i, n, ntotients;
PPCODE:
gimme_v = GIMME_V;
status = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (status == 1) {
if (gimme_v == G_SCALAR) {
XSRETURN_UV( inverse_totient_count(n) );
} else if (gimme_v == G_ARRAY) {
UV* tots = inverse_totient_list(&ntotients, n);
if (ntotients != UV_MAX) {
EXTEND(SP, (EXTEND_TYPE)ntotients);
for (i = 0; i < ntotients; i++)
}
DISPATCHPP_RETURN();
void inverse_sigma0(IN SV* svk, IN SV* svlo, IN SV* svhi = 0)
ALIAS:
inverse_sigma0_count = 1
PREINIT:
AV* av;
UV k, lo = 1, hi, i, count, *list;
int kstatus, lostatus, histatus;
PPCODE:
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (items == 2) {
histatus = _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG);
lostatus = 1;
} else {
lostatus = _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG);
histatus = _validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG);
}
if (kstatus && lostatus && histatus) {
if (ix == 1)
void
factor(IN SV* svn)
ALIAS:
factor_exp = 1
PREINIT:
UV n;
uint32_t i;
U32 gimme_v;
int status;
PPCODE:
gimme_v = GIMME_V;
status = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (status == 1) {
if (ix == 0) {
UV factors[MPU_MAX_FACTORS];
uint32_t nfactors = factor(n, factors);
if (gimme_v == G_SCALAR)
XSRETURN_UV(nfactors);
EXTEND(SP, (EXTEND_TYPE)nfactors);
for (i = 0; i < nfactors; i++)
}
}
#endif
DISPATCHPP_RETURN();
}
void divisors(IN SV* svn, IN SV* svk = 0)
PREINIT:
int status;
UV n, k, i, ndivisors, *divs;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
k = n;
if (status == 1 && svk != 0) {
status = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (k > n) k = n;
}
if (status != 1)
DISPATCHPP_RETURN();
if (GIMME_V == G_VOID) {
/* Nothing */
pplus1_factor = 7
pbrent_factor = 8
pminus1_factor = 9
ecm_factor = 10
PREINIT:
int nstatus, a1status, a2status, a3status;
UV n, arg1, arg2, arg3;
static const UV default_arg1[] =
{0, 64000000, 8000000, 4000000, 1, 4000000, 0, 200, 4000000, 1000000, 4000};
/* Trial, Fermat, Holf, SQUFOF, Lmn, PRHO, Cheb, P+1, Brent, P-1, ECM64 */
PPCODE:
if (ix == 10 && items > 2 && !SvOK(ST(1)) && SvOK(ST(2)))
croak("ecm_factor: B1 must be specified if B2 is specified");
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (items > 1) a1status=_validate_and_set(&arg1, aTHX_ ST(1), IFLAG_NONNEG);
else { a1status = 1; arg1 = default_arg1[ix]; }
if (items > 2) a2status=_validate_and_set(&arg2, aTHX_ ST(2), IFLAG_NONNEG);
else { a2status = 1; arg2 = 0; }
if (items > 3) a3status=_validate_and_set(&arg3, aTHX_ ST(3), IFLAG_NONNEG);
else { a3status = 1; arg3 = 0; }
EXTEND(SP, (EXTEND_TYPE)nfactors);
for (i = 0; i < nfactors; i++)
PUSHs(sv_2mortal(newSVuv( factors[i] )));
}
void
divisor_sum(IN SV* svn, ...)
PREINIT:
UV n, k, sigma;
PPCODE:
if (items == 1) {
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
sigma = divisor_sum(n, 1);
if (n <= 1 || sigma != 0)
XSRETURN_UV(sigma);
}
} else {
SV* svk = ST(1);
if ( (!SvROK(svk) || (SvROK(svk) && SvTYPE(SvRV(svk)) != SVt_PVCV)) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
sigma = divisor_sum(n, k);
if (n <= 1 || sigma != 0)
XSRETURN_UV(sigma);
}
}
DISPATCHPP_RETURN();
void aliquot_sum(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
UV sum = aliquot_sum(n);
if (n <= 1 || sum != 0)
XSRETURN_UV(sum);
}
DISPATCHPP_RETURN();
void abundance(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
UV sum = aliquot_sum(n);
if (n <= 1 || sum != 0)
XSRETURN_IV((IV)(sum-n));
}
DISPATCHPP_RETURN();
void sopf(IN SV* svn)
ALIAS:
sopfr = 1
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
UV sum = ix ? sopfr(n) : sopf(n);
XSRETURN_UV(sum);
}
DISPATCHPP_RETURN();
void prime_signature(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
factored_t nf = factorint(n);
uint32_t i, j, nfactors = nf.nfactors;
/* Insertion sort the exponents in descending order */
for (i = 1; i < nfactors; i++) {
uint8_t t = nf.e[i];
for (j = i; j > 0 && nf.e[j-1] < t; j--)
nf.e[j] = nf.e[j-1];
nf.e[j] = t;
}
XSRETURN_UV(S);
}
}
DISPATCHPP_RETURN();
void jordan_totient(IN SV* svk, IN SV* svn)
PREINIT:
int kstatus, nstatus;
UV k, n;
PPCODE:
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (kstatus != 1)
croak("jordan_totient: k must fit in a UV");
if (nstatus == 1) {
UV ret = jordan_totient(k, n);
if (ret != UV_MAX)
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void powersum(IN SV* svn, IN SV* svk)
PREINIT:
int kstatus, nstatus;
UV k, n;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (kstatus != 1)
croak("powersum: k must fit in a UV");
if (nstatus == 1) {
UV ret = powersum(n, k);
if (ret != UV_MAX)
XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void
ramanujan_sum(IN SV* sva, IN SV* svn)
ALIAS:
legendre_phi = 1
smooth_count = 2
rough_count = 3
PREINIT:
int astatus, nstatus;
UV a, n, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_NONNEG);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (astatus != 0 && nstatus != 0) {
switch (ix) {
case 0: if (a < 1 || n < 1) XSRETURN_IV(0);
{
UV g = a / gcd_ui(a,n);
int m = moebius(g);
if (m == 0 || a == g) RETURN_NPARITY(m);
XSRETURN_IV( m * (totient(a) / totient(g)) );
DISPATCHPP_RETURN();
void almost_prime_count(IN SV* svk, IN SV* svn)
ALIAS:
almost_prime_count_approx = 1
almost_prime_count_lower = 2
almost_prime_count_upper = 3
omega_prime_count = 4
PREINIT:
UV k, n, ret;
PPCODE:
if (_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
k < BITS_PER_WORD) {
ret = 0;
switch (ix) {
case 0: ret = almost_prime_count(k, n); break;
case 1: ret = almost_prime_count_approx(k, n); break;
case 2: ret = almost_prime_count_lower(k, n); break;
case 3: ret = almost_prime_count_upper(k, n); break;
case 4: ret = omega_prime_count(k, n); break;
}
DISPATCHPP_RETURN();
void nth_almost_prime(IN SV* svk, IN SV* svn)
ALIAS:
nth_almost_prime_approx = 1
nth_almost_prime_lower = 2
nth_almost_prime_upper = 3
PREINIT:
UV k, n, max;
PPCODE:
if (_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
k < BITS_PER_WORD) {
UV ret = 0;
if (n == 0 || (k == 0 && n > 1)) XSRETURN_UNDEF;
max = max_almost_prime_count(k);
if (max > 0 && n <= max) {
switch (ix) {
case 0: ret = nth_almost_prime(k, n); break;
case 1: ret = nth_almost_prime_approx(k, n); break;
case 3: ret = nth_almost_prime_upper(k, n); break;
}
if (ret != 0) XSRETURN_UV(ret);
}
}
DISPATCHPP_RETURN();
void nth_omega_prime(IN SV* svk, IN SV* svn)
PREINIT:
UV k, n, max, ret;
PPCODE:
if (_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) &&
k < 16) {
if (n == 0 || (k == 0 && n > 1)) XSRETURN_UNDEF;
max = max_omega_prime_count(k);
if (max > 0 && n <= max) {
ret = nth_omega_prime(k, n);
if (ret != 0) XSRETURN_UV(ret);
}
}
DISPATCHPP_RETURN();
void powmod(IN SV* sva, IN SV* svg, IN SV* svn)
ALIAS:
rootmod = 1
PREINIT:
int astatus, gstatus, nstatus, retundef;
UV a, g, n, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
gstatus = _validate_and_set(&g, aTHX_ svg, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && gstatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) XSRETURN_UV(0);
_mod_with(&a, astatus, n);
retundef = ret = 0;
if (ix == 0) {
retundef = !prep_pow_inv(&a,&g,gstatus,n);
void addmod(IN SV* sva, IN SV* svb, IN SV* svn)
ALIAS:
submod = 1
mulmod = 2
divmod = 3
znlog = 4
PREINIT:
int astatus, bstatus, nstatus, retundef;
UV a, b, n, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && bstatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) XSRETURN_UV(0);
_mod_with(&a, astatus, n);
_mod_with(&b, bstatus, n);
retundef = ret = 0;
switch (ix) {
RETURN_PVSV_CANONICAL(tmp, rlen);
}
DISPATCHPP_RETURN();
void muladdmod(IN SV* sva, IN SV* svb, IN SV* svc, IN SV* svn)
ALIAS:
mulsubmod = 1
PREINIT:
int astatus, bstatus, cstatus, nstatus;
UV a, b, c, n, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY);
cstatus = _validate_and_set(&c, aTHX_ svc, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && bstatus != 0 && cstatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) XSRETURN_UV(0);
_mod_with(&a, astatus, n);
_mod_with(&b, bstatus, n);
_mod_with(&c, cstatus, n);
SV* tmp = sv_2mortal(newSV(0 + lenn));
rlen = strint_muladdmod_s(SvPVX(tmp), sa,lena, sb,lenb, sc,lenc, ix, sn,lenn);
RETURN_PVSV_CANONICAL(tmp,rlen);
}
DISPATCHPP_RETURN();
void binomialmod(IN SV* svn, IN SV* svk, IN SV* svm)
PREINIT:
int nstatus, kstatus, mstatus;
UV ret, n, k, m;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY);
mstatus = _validate_and_set(&m, aTHX_ svm, IFLAG_ABS);
if (nstatus != 0 && kstatus != 0 && mstatus != 0) {
if (m == 0) XSRETURN_UNDEF;
if (m == 1) XSRETURN_UV(0);
if ( (nstatus == 1 && (kstatus == -1 || k > n)) ||
(nstatus ==-1 && (kstatus == -1 && k > n)) )
XSRETURN_UV(0);
if (kstatus == -1) k = n - k;
if ((nstatus == -1) && (k & 1) && ret != 0) ret = m-ret;
XSRETURN_UV(ret);
}
}
DISPATCHPP_RETURN();
void factorialmod(IN SV* sva, IN SV* svn)
PREINIT:
int astatus, nstatus;
UV a, n;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_NONNEG);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) XSRETURN_UV(0);
XSRETURN_UV( factorialmod(a, n) );
}
DISPATCHPP_RETURN();
void invmod(IN SV* sva, IN SV* svn)
ALIAS:
znorder = 1
sqrtmod = 2
negmod = 3
PREINIT:
int astatus, nstatus;
UV a, n, r, retok;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) XSRETURN_UV((ix==1) ? 1 : 0); /* znorder different */
_mod_with(&a, astatus, n);
retok = r = 0;
switch (ix) {
case 0: retok = r = modinverse(a, n); break;
case 1: retok = r = znorder(a, n); break;
}
if (retok == 0) XSRETURN_UNDEF;
XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void allsqrtmod(IN SV* sva, IN SV* svn)
PREINIT:
int astatus, nstatus;
UV a, n, i, numr, *roots;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && nstatus != 0) {
if (n == 0) RETURN_NOTHING();
_mod_with(&a, astatus, n);
roots = allsqrtmod(&numr, a, n);
if (roots != 0) {
if (GIMME_V != G_ARRAY) {
PUSHs(sv_2mortal(newSVuv(numr)));
} else {
PUSHs(sv_2mortal(newSVuv(0)));
}
} else {
DISPATCHPP_RETURN();
}
void allrootmod(IN SV* sva, IN SV* svg, IN SV* svn)
PREINIT:
int astatus, gstatus, nstatus;
UV a, g, n, i, numr, *roots;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
gstatus = _validate_and_set(&g, aTHX_ svg, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && gstatus != 0 && nstatus != 0) {
if (n == 0) RETURN_NOTHING();
if (n == 1) XSRETURN_UV(GIMME_V == G_ARRAY ? 0 : 1);
_mod_with(&a, astatus, n);
if (!prep_pow_inv(&a,&g,gstatus,n))
RETURN_NOTHING();
roots = allrootmod(&numr, a, g, n);
PUSHs(sv_2mortal(newSVuv(0)));
}
} else {
DISPATCHPP_RETURN();
}
void is_primitive_root(IN SV* sva, IN SV* svn)
PREINIT:
int astatus, nstatus;
UV a, n;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
_mod_with(&a, astatus, n);
RETURN_NPARITY( is_primitive_root(a,n,0) );
}
DISPATCHPP_RETURN();
void qnr(IN SV* svn)
ALIAS:
znprimroot = 1
PREINIT:
UV n, r;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)) {
if (n == 0) XSRETURN_UNDEF;
if (ix == 0) {
r = qnr(n);
} else {
r = znprimroot(n);
if (r == 0 && n != 1) XSRETURN_UNDEF;
}
if (r < 100) RETURN_NPARITY(r);
else XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void
is_smooth(IN SV* svn, IN SV* svk)
ALIAS:
is_rough = 1
PREINIT:
UV n, k;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG)) {
RETURN_NPARITY( (ix == 0) ? is_smooth(n,k) : is_rough(n,k) );
}
DISPATCHPP_RETURN();
void
is_omega_prime(IN SV* svk, IN SV* svn)
ALIAS:
is_almost_prime = 1
PREINIT:
UV n, k;
int nstatus, kstatus;
PPCODE:
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (kstatus != 0 && nstatus != 0) {
int res = (nstatus != 1) ? 0
: (ix == 0) ? is_omega_prime(k, n)
: is_almost_prime(k, n);
RETURN_NPARITY(res);
}
#if HAVE_FACTOR128
if (kstatus != 0 && nstatus == 0) {
RETURN_NPARITY(nfac == k);
}
}
#endif
DISPATCHPP_RETURN();
void is_divisible(IN SV* svn, IN SV* svd, ...)
PREINIT:
UV n, d, ret;
size_t i;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
_validate_and_set(&d, aTHX_ svd, IFLAG_ABS)) {
int status = 1;
ret = d==0 ? (n==0) : n % d == 0;
for (i = 2; i < (size_t)items && !ret; i++) {
if ((status = _validate_and_set(&d, aTHX_ ST(i), IFLAG_ABS)) != 1)
break;
ret = d==0 ? (n==0) : n % d == 0;
}
if (status == 1) RETURN_NPARITY(ret);
}
DISPATCHPP_RETURN();
void is_congruent(IN SV* svn, IN SV* svc, IN SV* svd)
PREINIT:
UV n, c, d;
int nstatus, cstatus, dstatus;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
cstatus = _validate_and_set(&c, aTHX_ svc, IFLAG_ANY);
dstatus = _validate_and_set(&d, aTHX_ svd, IFLAG_ABS);
if (nstatus != 0 && cstatus != 0 && dstatus != 0) {
if (d != 0) {
_mod_with(&n, nstatus, d);
_mod_with(&c, cstatus, d);
}
RETURN_NPARITY( n == c );
}
DISPATCHPP_RETURN();
void valuation(IN SV* svn, IN SV* svk)
PREINIT:
UV n, k;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG)) {
if (k <= 1) croak("valuation: k must be > 1");
if (n == 0) XSRETURN_UNDEF;
RETURN_NPARITY(valuation(n, k));
}
DISPATCHPP_RETURN();
void remove_factors(IN SV* svn, IN SV* svk)
ALIAS:
remove_factors_exp = 1
PREINIT:
UV n, k, e;
int nstatus, kstatus;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (nstatus != 0 && kstatus != 0) {
if (k <= 1) croak("%s: k must be > 1", SUBNAME);
if (n == 0) {
XPUSHs(&PL_sv_undef);
if (ix == 1) XPUSHs(&PL_sv_undef);
} else {
if (nstatus == -1) n = (UV)neg_iv(n);
e = valuation_remainder(n, k, &n);
}
void is_powerful(IN SV* svn, IN SV* svk = 0);
ALIAS:
powerful_count = 1
sumpowerful = 2
nth_powerful = 3
PREINIT:
int nstatus;
UV n, ret, k = 2;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, (ix < 3) ? IFLAG_ANY: IFLAG_NONNEG);
if (nstatus != 0 && (!svk || _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG))) {
if (nstatus == -1) RETURN_NPARITY(0);
if (ix == 0) RETURN_NPARITY( is_powerful(n, k) );
if (ix == 1) XSRETURN_UV( powerful_count(n, k) );
if (ix == 2) {
if (n == 0) XSRETURN_UV(0);
ret = sumpowerful(n, k);
} else {
if (n == 0) XSRETURN_UNDEF;
}
/* ret=0: nth_powerful / sumpowerful result > UV_MAX, so go to PP/GMP */
if (ret > 0) XSRETURN_UV(ret);
}
DISPATCHPP_RETURN();
void kronecker(IN SV* sva, IN SV* svb)
PREINIT:
int k;
PPCODE:
if (xs_kronecker_result(aTHX_ sva, svb, &k))
RETURN_NPARITY( k );
DISPATCHPP_RETURN();
void is_qr(IN SV* sva, IN SV* svn)
PREINIT:
int astatus, nstatus;
UV a, n;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (astatus != 0 && nstatus != 0) {
if (n == 0) XSRETURN_UNDEF;
if (n == 1) RETURN_NPARITY(1);
_mod_with(&a, astatus, n);
RETURN_NPARITY( is_qr(a,n) );
}
DISPATCHPP_RETURN();
mulint = 2
divint = 3
modint = 4
cdivint = 5
powint = 7
PREINIT:
SV* slowret;
int astatus, bstatus, is_uv;
UV uvret;
IV ivret;
PPCODE:
if (addint_try_native_result(aTHX_ ix, sva, svb, SUBNAME,
&astatus, &bstatus, &is_uv, &uvret, &ivret)) {
if (is_uv) XSRETURN_UV(uvret);
XSRETURN_IV(ivret);
}
slowret = addint_try_slow_result(aTHX_ ix, sva, svb, astatus, bstatus, SUBNAME);
if (slowret != NULL)
RETURN_SV(slowret);
/* Others get dispatched here */
DISPATCHPP_RETURN();
void muladdint(IN SV* sva, IN SV* svb, IN SV* svc)
ALIAS:
mulsubint = 1
PREINIT:
int astatus, bstatus, cstatus;
UV a, b, c;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY);
cstatus = _validate_and_set(&c, aTHX_ svc, IFLAG_ANY);
if (astatus != 0 && bstatus != 0 && cstatus != 0) {
if (astatus == -1) a = neg_iv(a);
if (bstatus == -1) b = neg_iv(b);
if (cstatus == -1) c = neg_iv(c);
{
int sign;
UV hi, lo;
DISPATCHPP_RETURN();
void add1int(IN SV* svn)
ALIAS:
sub1int = 1
PREINIT:
SV* slowret;
int status, is_uv;
UV uvret;
IV ivret;
PPCODE:
if (add1_try_native_result(aTHX_ ix, svn, &status, &is_uv, &uvret, &ivret)) {
if (is_uv) XSRETURN_UV(uvret);
XSRETURN_IV(ivret);
}
slowret = add1_try_slow_result(aTHX_ ix, svn);
if (slowret != NULL)
RETURN_SV(slowret);
DISPATCHPP_RETURN();
void absint(IN SV* svn)
ALIAS:
negint = 1
PREINIT:
UV n;
PPCODE:
if (ix == 0) {
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS))
XSRETURN_UV(n);
} else {
int status = _validate_and_set(&n, aTHX_ svn, IFLAG_IV);
if (status == -1) XSRETURN_UV(neg_iv(n));
else if (status == 1) XSRETURN_IV(neg_iv(n));
}
TRY_MAGIC_UNARY(svn, ix==0 ? abs_amg : neg_amg);
{
SV* tmp = sv_2mortal(newSV(1 + len));
len = ix==0 ? strint_abs(SvPVX(tmp),s,len) : strint_neg(SvPVX(tmp),s,len);
RETURN_PVSV_CANONICAL(tmp,len);
}
DISPATCHPP_RETURN();
void signint(IN SV* svn)
ALIAS:
is_odd = 1
is_even = 2
PPCODE:
RETURN_NPARITY(xs_sign_parity_result(aTHX_ svn, SUBNAME, ix));
void cmpint(IN SV* sva, IN SV* svb)
PREINIT:
int ret;
PPCODE:
ret = xs_cmpint_result(aTHX_ sva, svb);
RETURN_NPARITY(ret);
void logint(IN SV* svn, IN SV* svb, IN SV* svret = 0)
PREINIT:
UV n, b;
int nstatus, bstatus;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_POS);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_POS);
if (bstatus != 0 && b < 2) croak("logint: base must be > 1");
if (items >= 3 && !xs_is_sv_scalar_ref(svret))
croak("logint: third argument not a scalar reference");
if (nstatus != 0 && bstatus != 0) {
UV ilog = logint(n, b);
if (svret) sv_setuv(SvRV(svret), ipow(b,ilog));
XSRETURN_UV(ilog);
}
}
XSRETURN_UV(result);
}
}
DISPATCHPP_RETURN_GMPIF(svret == 0 && (bstatus || _XS_get_callgmp() >= 54));
void rootint(IN SV* svn, IN SV* svk, IN SV* svret = 0)
PREINIT:
UV n, k;
int nstatus, kstatus;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS);
if (items >= 3 && !xs_is_sv_scalar_ref(svret))
croak("rootint: third argument not a scalar reference");
if (nstatus != 0 && kstatus != 0) {
UV iroot = rootint(n, k);
if (svret) sv_setuv(SvRV(svret), ipow(iroot,k));
XSRETURN_UV(iroot);
}
/* Fast path: strint_rootint for bigint n, UV k */
}
RETURN_PVSV_CANONICAL(tmp, rlen);
}
}
DISPATCHPP_RETURN_GMPIF(svret == 0 && (kstatus || _XS_get_callgmp() >= 54));
void crootint(IN SV* svn, IN SV* svk)
PREINIT:
UV n, k;
int nstatus, kstatus;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS);
if (nstatus != 0 && kstatus != 0)
XSRETURN_UV(crootint(n, k));
DISPATCHPP_RETURN();
void divrem(IN SV* sva, IN SV* svb)
ALIAS:
fdivrem = 1
cdivrem = 2
tdivrem = 3
PREINIT:
int astatus, bstatus;
UV D, d;
IV iD, id;
PPCODE:
astatus = _validate_and_set(&D, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&d, aTHX_ svb, IFLAG_ANY);
if (astatus != 0 && bstatus != 0 && d == 0)
croak("%s: divide by zero", SUBNAME);
if (astatus == 1 && bstatus == 1 && (ix != 2 || D % d == 0)) {
XPUSHs(sv_2mortal(newSVuv( D / d )));
XPUSHs(sv_2mortal(newSVuv( D % d )));
XSRETURN(2);
} else if (ix == 2 && astatus == 1 && bstatus == 1 && d <= (UV)IV_MAX) {
/* Exact division was handled above */
}
DISPATCHPP_RETURN();
void lshiftint(IN SV* svn, IN SV* svk = 0)
ALIAS:
rshiftint = 1
rashiftint = 2
PREINIT:
int nstatus, kstatus, nix;
UV n, k, nk;
PPCODE:
nix = ix;
if (items == 1) {
kstatus = 1;
k = 1;
} else {
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY);
if (kstatus == -1) {
k = neg_iv(k);
nix = !ix; /* 0 => 1, 1 => 0, 2 => 0 */
}
}
if (len > 0) RETURN_PVSV_CANONICAL(tmp,len);
}
}
DISPATCHPP_RETURN();
void
gcdext(IN SV* sva, IN SV* svb)
PREINIT:
IV u, v, d, a, b;
PPCODE:
if (_validate_and_set((UV*)&a, aTHX_ sva, IFLAG_IV) &&
_validate_and_set((UV*)&b, aTHX_ svb, IFLAG_IV) &&
a != IV_MIN && b != IV_MIN) {
d = gcdext(a, b, &u, &v, 0, 0);
XPUSHs(sv_2mortal(newSViv( u )));
XPUSHs(sv_2mortal(newSViv( v )));
XPUSHs(sv_2mortal(newSViv( d )));
} else {
DISPATCHPP_RETURN();
}
void
stirling(IN SV* svn, IN SV* svm, IN UV type = 1)
PREINIT:
UV n, m;
int nstatus, mstatus;
PPCODE:
if (type != 1 && type != 2 && type != 3)
croak("stirling: type must be 1, 2, or 3");
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
mstatus = _validate_and_set(&m, aTHX_ svm, IFLAG_NONNEG);
if (nstatus == 1 && mstatus == 1) {
if (n == m)
XSRETURN_UV(1);
if (n == 0 || m == 0 || m > n)
XSRETURN_UV(0);
if (type == 3) {
OUTPUT:
RETVAL
void euler_phi(IN SV* svlo, IN SV* svhi = 0)
ALIAS:
moebius = 1
PREINIT:
UV lo, hi;
int lostatus, histatus;
PPCODE:
lostatus = _validate_and_set(&lo, aTHX_ svlo, IFLAG_ANY);
if (items == 1) {
if (lostatus != 0 && ix == 0)
XSRETURN_UV(lostatus == -1 ? 0 : totient(lo));
if (lostatus != 0 && ix == 1)
RETURN_NPARITY(moebius(lostatus == -1 ? neg_iv(lo) : lo));
#if HAVE_FACTOR128
if (ix == 1) {
uint128_t n128;
if (ix == 0) PUSHs(sv_2mortal(newSVuv(totient(UV_MAX))));
else PUSH_NPARITY(-1); /* moebius 2^{32,64,128}-1 = -1 */
}
}
void
dedekind_psi(IN SV* svn)
PREINIT:
int nstatus;
UV n, r;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (nstatus != 0) {
if (nstatus == -1) XSRETURN_UV(0);
r = dedekind_psi(n);
if (n == 0 || r > 0) XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void sqrtint(IN SV* svn)
ALIAS:
carmichael_lambda = 1
exp_mangoldt = 2
PREINIT:
UV n, r;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
r = 0;
switch (ix) {
case 0: r = isqrt(n); break;
case 1: r = carmichael_lambda(n); break;
case 2: r = exp_mangoldt(n); break;
default: break;
}
XSRETURN_UV(r);
}
const char* sn = SvPV_nomg(svn, lenn);
SV* tmp = sv_2mortal(newSV(lenn + 2));
STRLEN rlen = strint_rootint(SvPVX(tmp), sn, lenn, 2);
if (rlen > 0) RETURN_PVSV_CANONICAL(tmp,rlen);
}
DISPATCHPP_RETURN();
void hammingweight(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS))
XSRETURN_UV(popcnt(n));
if (_XS_get_callgmp() < 47) {
char* ptr; STRLEN len; ptr = SvPV(svn, len);
XSRETURN_UV(mpu_popcount_string(ptr, len));
}
DISPATCHPP_RETURN();
void prime_omega(IN SV* svn)
ALIAS:
prime_bigomega = 1
is_square_free = 2
PREINIT:
UV n, ret;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (status != 0) {
ret = 0;
switch (ix) {
case 0: ret = prime_omega(n); break;
case 1: ret = prime_bigomega(n); break;
case 2: ret = is_square_free(n); break;
default: break;
}
RETURN_NPARITY(ret);
} else ret = (moebius128(n128) != 0);
RETURN_NPARITY(ret);
}
}
#endif
DISPATCHPP_RETURN();
void pisano_period(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
UV r = pisano_period(n);
if (r != UV_MAX)
XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void factorial(IN SV* svn)
ALIAS:
subfactorial = 1
bell_number = 2
fubini = 3
primorial = 4
pn_primorial = 5
catalan_number = 6
partitions = 7
partitionsq = 8
consecutive_integer_lcm = 9
PREINIT:
UV n, r = 0;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG) != 1)
croak("%s: n must fit in native unsigned integer", SUBNAME);
switch(ix) {
case 0: r = factorial(n); break;
case 1: r = subfactorial(n); break;
case 2: r = bell_number(n); break;
case 3: r = fubini(n); break;
case 4: r = primorial(n); break;
case 5: r = pn_primorial(n); break;
case 6: r = catalan_number(n); break;
default: break;
}
if (n == 0 || r > 0)
XSRETURN_UV(r);
DISPATCHPP_RETURN();
void integer_complexity(IN SV* svn)
PREINIT:
int nstatus;
UV n, r;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (nstatus == 0 || n > (UV)IV_MAX)
croak("integer_complexity: n must fit in native signed integer");
r = integer_complexity(n); /* Make sure to call it even if n=0 */
if (n == 0) XSRETURN_UNDEF;
XSRETURN_UV(r);
void sumtotient(IN SV* svn)
PREINIT:
UV n, r;
#if HAVE_FACTOR128 && HAVE_SUMTOTIENT128
uint64_t n64;
uint128_t sum128;
#endif
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
r = sumtotient(n);
if (n == 0 || r > 0) XSRETURN_UV(r);
#if HAVE_FACTOR128 && HAVE_SUMTOTIENT128
if (sumtotient128(n, &sum128)) /* 64-bit overflowed, try 128-bit. */
RETURN_U128(sum128);
#endif
}
#if HAVE_FACTOR128 && HAVE_SUMTOTIENT128
else if (xs_sv_to_uint64(aTHX_ &n64, svn)) {
if (sumtotient128(n64, &sum128))
RETURN_U128(sum128);
}
#endif
DISPATCHPP_RETURN();
void binomial(IN SV* svn, IN SV* svk)
PREINIT:
int nstatus, kstatus;
UV n, k, ret;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY);
if (nstatus != 0 && kstatus != 0) {
if ( (nstatus == 1 && (kstatus == -1 || k > n)) ||
(nstatus ==-1 && (kstatus == -1 && k > n)) )
XSRETURN_UV(0);
if (kstatus == -1) {
k = n - k; /* n<0,k<=n: (-1)^(n-k) * binomial(-k-1,n-k) */
kstatus = 1;
}
rstr = strint_binomial_u32(sn, snlen, (uint32_t)k, &rlen);
if (rstr)
RETURN_SIGN_STRINT_STR(1, rstr, rlen);
}
DISPATCHPP_RETURN();
void multifactorial(IN SV* svn, IN SV* svk)
PREINIT:
int nstatus, kstatus;
UV n, k, r;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS);
if (nstatus == 1 && kstatus == 1) {
r = multifactorial(n, k);
if (n == 0 || r > 0) XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void falling_factorial(IN SV* svn, IN SV* svk)
ALIAS:
rising_factorial = 1
PREINIT:
int nstatus, kstatus;
UV n, k;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_IV);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);
if (nstatus == 1 && kstatus == 1) {
UV ret = (ix==0) ? falling_factorial(n,k) : rising_factorial(n,k);
if (ret != UV_MAX) XSRETURN_UV(ret);
} else if (nstatus == -1 && kstatus == 1) {
IV in = (IV)n;
IV ret = (ix==0) ? falling_factorial_s(in,k) : rising_factorial_s(in,k);
if (ret != IV_MAX) XSRETURN_IV(ret);
}
DISPATCHPP_RETURN();
void floor_sum(IN SV* svn, IN SV* svm, IN SV* sva, IN SV* svb)
PREINIT:
int nstatus, mstatus, astatus, bstatus;
UV n, m, a, b;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
mstatus = _validate_and_set(&m, aTHX_ svm, IFLAG_POS);
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_NONNEG);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_NONNEG);
if (nstatus == 1 && mstatus == 1 && astatus == 1 && bstatus == 1) {
UV sum = floor_sum(n,m,a,b);
if (sum != UV_MAX)
XSRETURN_UV(sum);
}
DISPATCHPP_RETURN();
void mertens(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
UV lo = 1, hi;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_NONNEG)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_NONNEG) &&
_validate_and_set(&hi, aTHX_ svhi, IFLAG_NONNEG))) {
RETURN_NPARITY(mertens_range(lo, hi));
}
DISPATCHPP_RETURN();
void liouville(IN SV* svn)
ALIAS:
sumliouville = 1
is_pillai = 2
is_congruent_number = 3
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
IV r = 0;
switch(ix) {
case 0: r = liouville(n); break;
case 1: r = sumliouville(n); break;
case 2: r = pillai_v(n); break;
case 3: r = is_congruent_number(n); break;
default: break;
}
RETURN_NPARITY(r);
RETURN_NPARITY((factored128p_total_factors(&nf) & 1) ? -1 : 1);
}
}
#endif
DISPATCHPP_RETURN();
void hclassno(IN SV* svn)
PREINIT:
UV n, r;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1)
XSRETURN_IV(0);
if (status == 1) {
if (n == 0)
XSRETURN_IV(-1);
r = hclassno(n);
if (r != UV_MAX)
XSRETURN_UV(r);
}
DISPATCHPP_RETURN();
void ramanujan_tau(IN SV* svn)
PREINIT:
UV n;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1)
XSRETURN_IV(0);
if (status == 1) {
IV r = ramanujan_tau(n);
if (n == 0 || r != 0)
RETURN_NPARITY(r);
}
DISPATCHPP_RETURN();
CODE:
RETVAL = is_congruent_number_tunnell(n);
OUTPUT:
RETVAL
void chebyshev_theta(IN SV* svn)
ALIAS:
chebyshev_psi = 1
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
NV r = (ix==0) ? chebyshev_theta(n) : chebyshev_psi(n);
XSRETURN_NV(r);
}
DISPATCHPP_RETURN(); /* Result is FP */
#define RETURN_SET_REF(ps) /* Return sorted set values (ps is iset_t pointer) */ \
{ \
UV *sdata; \
}
#define RETURN_EMPTY_SET_REF() RETURN_EMPTY_LIST_REF()
void sumset(IN SV* sva, IN SV* svb = 0)
PROTOTYPE: $;$
PREINIT:
int atype, btype, stype, sign;
UV *ra, *rb;
size_t alen, blen, i, j;
iset_t s;
PPCODE:
atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, "sumset arg 1");
if (svb == 0 || atype == IARR_TYPE_BAD) {
rb = ra;
blen = alen;
btype = atype;
} else {
btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, "sumset arg 2");
}
if (alen == 0 || blen == 0) {
if (rb != ra) Safefree(rb);
Safefree(ra);
RETURN_SET_REF(&s);
void setbinop(IN SV* block, IN SV* sva, IN SV* svb = 0)
PROTOTYPE: &$;$
PREINIT:
int atype, btype;
UV *ra, *rb;
Size_t alen, blen;
CODE:
/* Must be CODE and not PPCODE */
atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, "setbinop arg 1");
if (svb == 0 || atype == IARR_TYPE_BAD) {
rb = ra;
blen = alen;
btype = atype;
} else {
btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, "setbinop arg 2");
}
if (alen == 0 || blen == 0) {
if (rb != ra) Safefree(rb);
DISPATCHPP_RETURN();
void setunion(IN SV* sva, IN SV* svb)
PROTOTYPE: $$
ALIAS:
setintersect = 1
setminus = 2
setdelta = 3
PREINIT:
SV *ret;
PPCODE:
/* Alias ix values intentionally match set_op_t. */
if (xs_set_op(aTHX_ sva, svb, (set_op_t)ix, &ret, SUBNAME)) {
ST(0) = sv_2mortal(ret);
XSRETURN(1);
}
DISPATCHPP_RETURN();
void set_is_disjoint(IN SV* sva, IN SV* svb)
PROTOTYPE: $$
ALIAS:
set_is_equal = 1
set_is_subset = 2
set_is_proper_subset = 3
set_is_superset = 4
set_is_proper_superset = 5
set_is_proper_intersection = 6
PREINIT:
int ret;
PPCODE:
/* Alias ix values intentionally match set_relation_op_t. */
if (xs_set_relation(aTHX_ sva, svb, (set_relation_op_t)ix, &ret, SUBNAME))
RETURN_NPARITY(ret);
DISPATCHPP_RETURN();
void setcontains(IN SV* sva, ...)
ALIAS:
setcontainsany = 1
PROTOTYPE: $@
PREINIT:
UV b;
AV *ava;
int bstatus, subset, findall;
Size_t alen, blen, i;
DECL_ARREF(arb);
PPCODE:
CHECK_ARRAYREF(sva); /* First argument is a set as array ref */
ava = (AV*) SvRV(sva);
alen = av_count(ava);
if (items < 2)
RETURN_NPARITY(ix == 0 ? 1 : 0);
if (SvMAGICAL(ava) || !AvREAL(ava)) /* Punt these to Perl */
DISPATCHPP_RETURN();
findall = ix == 0 ? 1 : 0;
if (items == 2 && SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) {
set_cache_t svcache;
RETURN_NPARITY(subset);
DISPATCHPP_RETURN();
void setinsert(IN SV* sva, ...)
PROTOTYPE: $@
PREINIT:
AV *ava;
Size_t alen, blen, i, j;
UV *rb;
int btype, bstatus;
PPCODE:
CHECK_ARRAYREF(sva); /* First argument is a set as array ref */
ava = (AV*) SvRV(sva);
alen = av_count(ava);
if (items < 2)
RETURN_NPARITY(0);
CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */
if (SvMAGICAL(ava) || !AvREAL(ava)) /* Punt these to Perl */
DISPATCHPP_RETURN();
if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) {
Safefree(rb);
DISPATCHPP_RETURN();
void setremove(IN SV* sva, ...)
PROTOTYPE: $@
PREINIT:
AV *ava;
Size_t alen, blen, i;
UV *rb;
int btype, bstatus;
PPCODE:
CHECK_ARRAYREF(sva); /* First argument is a set as array ref */
ava = (AV*) SvRV(sva);
alen = av_count(ava);
if (alen == 0 || items < 2)
RETURN_NPARITY(0);
CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */
if (SvMAGICAL(ava) || !AvREAL(ava)) /* Punt these to Perl */
DISPATCHPP_RETURN();
if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) {
if (items != 2)
DISPATCHPP_RETURN();
void setinvert(IN SV* sva, ...)
PROTOTYPE: $@
PREINIT:
AV *ava;
Size_t alen, blen, i;
UV *rb;
int btype, bstatus;
PPCODE:
CHECK_ARRAYREF(sva);
ava = (AV*) SvRV(sva);
alen = av_count(ava);
if (items < 2)
RETURN_NPARITY(0);
CHECK_AV_NOT_READONLY(ava);
if (SvMAGICAL(ava) || !AvREAL(ava))
DISPATCHPP_RETURN();
if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) {
if (items != 2)
}
}
Safefree(rb);
DISPATCHPP_RETURN();
void is_sidon_set(IN SV* sva)
PROTOTYPE: $
PREINIT:
int ret;
PPCODE:
if (xs_is_sidon_set(aTHX_ sva, &ret))
RETURN_NPARITY(ret);
DISPATCHPP_RETURN();
void is_sumfree_set(IN SV* sva)
PROTOTYPE: $
PREINIT:
int ret;
PPCODE:
if (xs_is_sumfree_set(aTHX_ sva, &ret))
RETURN_NPARITY(ret);
DISPATCHPP_RETURN();
void toset(...)
PROTOTYPE: @
PREINIT:
int type;
size_t len;
UV *L;
PPCODE:
if (items == 0) RETURN_EMPTY_SET_REF();
if (items == 1 && SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV)
croak("toset: expected integer list, not array reference");
type = array_to_int_array(aTHX_ &len, &L, 1, &ST(0), items);
if (type != IARR_TYPE_BAD)
RETURN_LIST_REF(len, L, type != IARR_TYPE_NEG);
Safefree(L);
DISPATCHPP_RETURN();
void vecsort(...)
PROTOTYPE: @
ALIAS:
vecrsort = 1
PREINIT:
int type;
size_t len;
UV *L;
PPCODE:
if (items == 0)
RETURN_NOTHING();
if (SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV) {
if (items != 1)
croak("%s: expected integer list or single array reference", SUBNAME);
type = arrayref_to_int_array(aTHX_ &len, &L, 0, ST(0), SUBNAME);
} else {
type = array_to_int_array(aTHX_ &len, &L, 0, &ST(0), items);
}
if (GIMME_V != G_ARRAY) /* In scalar context, return number of elements */
void vecsorti(IN SV* sva)
PROTOTYPE: $
ALIAS:
vecrsorti = 1
PREINIT:
int type;
size_t i, len;
UV *L;
SV **arr;
AV *ava;
PPCODE:
CHECK_ARRAYREF(sva);
ava = (AV*) SvRV(sva);
CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */
if (SvMAGICAL(ava) || !AvREAL(ava)) /* Punt these to Perl */
DISPATCHPP_RETURN();
type = arrayref_to_int_array(aTHX_ &len, &L, 0, sva, SUBNAME);
/* If we really wanted to optimize small values, the reading function
* could create a mask like:
* mask |= (istatus == 1) ? n : (n ^ (n<<1));
* then we know if the input is 8-bit, 16-bit, 32-bit, etc.
FASTSETSVINT(arr[i], type == IARR_TYPE_POS, L[ix ? len-i-1 : i]);
Safefree(L);
XSRETURN(1);
void numtoperm(IN SV* svn, IN SV* svk)
PREINIT:
UV k, n, fn;
int nstatus, kstatus;
int i, S[32];
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY);
if (nstatus != 0 && kstatus != 0 && n < 32) {
if (n == 0)
RETURN_NOTHING();
fn = factorial(n);
if (fn != 0) {
_mod_with(&k, kstatus, fn);
if (num_to_perm(k, n, S)) {
if (GIMME_V != G_ARRAY) XSRETURN_UV(n);
}
}
}
DISPATCHPP_RETURN();
void permtonum(IN SV* svp)
PREINIT:
UV val, num;
Size_t i, plen;
DECL_ARREF(avp);
PPCODE:
USE_ARREF(avp, svp, SUBNAME, AR_READ);
plen = len_avp;
if (plen <= 20) {
int V[21], A[21] = {0};
for (i = 0; i < plen; i++) {
SV *iv = FETCH_ARREF(avp,i);
int status = _validate_and_set(&val, aTHX_ iv, IFLAG_NONNEG);
REFRESH_ARREF(avp);
if (status != 1)
break;
if (i >= plen && perm_to_num(plen, V, &num))
XSRETURN_UV(num);
}
DISPATCHPP_RETURN();
void randperm(IN SV* svn, IN SV* svk = 0)
PREINIT:
int nstatus, kstatus;
UV n, k, i, *S;
dMY_CXT;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (items == 1) { kstatus = nstatus; k = nstatus ? n : 0; }
else { kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG);}
if (nstatus == 0)
DISPATCHPP_RETURN();
if (kstatus == 0 || k > n)
k = n;
if (k > (UV)IV_MAX)
croak("randperm: k must fit in native signed integer");
if (GIMME_V != G_ARRAY) XSRETURN_IV(k);
else PUSHs(sv_2mortal(newSVuv(S[i])));
}
Safefree(S);
void shuffle(...)
PROTOTYPE: @
PREINIT:
SSize_t i, j;
void* randcxt;
dMY_CXT;
PPCODE:
if (GIMME_V != G_ARRAY) XSRETURN_IV(items);
if (items == 0) XSRETURN_EMPTY;
for (i = 0, randcxt = MY_CXT.randcxt; i < items-1; i++) {
j = urandomm64(randcxt, items-i);
{ SV* t = ST(i); ST(i) = ST(i+j); ST(i+j) = t; }
}
XSRETURN(items);
void vecsample(IN SV* svk, ...)
PROTOTYPE: $@
PREINIT:
void *randcxt;
UV k;
Size_t nitems, i;
dMY_CXT;
PPCODE:
if (_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG) != 1)
DISPATCHPP_RETURN();
if (items == 1 || k == 0)
RETURN_NOTHING();
randcxt = MY_CXT.randcxt;
/*
* Fisher-Yates shuffle with first 'k' selections returned.
*
* There is only one algorithm here, no shortcuts other than
* detecting an empty list.
}
Safefree(I);
}
}
XSRETURN(k);
void is_happy(SV* svn, UV base = 10, UV k = 2)
PREINIT:
UV n, sum;
int h, status;
PPCODE:
if (base < 2 || base > 36) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (k > 10) croak("%s: invalid exponent %"UVuf, SUBNAME, k);
status = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
if (status == 0 && base == 10) { /* String op to reduce into range. */
STRLEN i, len;
const char* s = SvPV(svn, len);
if (len <= UV_MAX/ipow(9,k)) {
for (sum = 0, i = 0; i < len; i++)
sum += ipow(s[i]-'0',k);
h = happy_height(sum, base, k);
RETURN_NPARITY(h);
}
DISPATCHPP_RETURN();
void
sumdigits(SV* svn, SV* svbase = 0)
PREINIT:
UV sum, base = 10;
STRLEN i, len;
const char* s;
PPCODE:
SvGETMAGIC(svn);
if (!SvOK(svn)) croak("Parameter must be defined");
if (items > 1 && !_validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG))
DISPATCHPP_RETURN();
if (base < 2 || base > 36) croak("%s: invalid base: %"UVuf, SUBNAME, base);
sum = 0;
/* faster for integer input in base 10 */
if (base == 10 && SVNUMTEST(svn) && (SvIsUV(svn) || SvIVX(svn) >= 0)) {
UV n, t = my_svuv(svn);
while ((n=t)) {
else if (c >= 'A' && c <= 'Z') { d = c - 'A' + 10; }
if (d < base)
sum += d;
}
XSRETURN_UV(sum);
void reverse_digits(SV* svn, SV* svbase = 0)
PREINIT:
int nstatus, bstatus = 1;
UV n, base = 10, r = 0;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (items > 1)
bstatus = _validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG);
if (base < 2) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (nstatus == 1 && bstatus == 1) {
while (n > 0) {
UV q = n / base;
UV d = n - q * base;
if (r > (UV_MAX - d) / base)
break; /* overflow, dispatch */
RETURN_SIGN_STRINT_STR(1, rstr, rlen);
}
DISPATCHPP_RETURN();
void todigits(SV* svn, SV* svbase = 0, SV* svtlen = 0)
ALIAS:
todigitstring = 1
PREINIT:
int nstatus, bstatus, lstatus, tlen, i;
UV n, base;
PPCODE:
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
bstatus = lstatus = 1;
base = 10;
tlen = -1;
if (items > 1) {
bstatus = _validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG);
if (base < 2 || (ix == 1 && base > 36))
croak("%s: invalid base: %"UVuf, SUBNAME, base);
}
if (items > 2) {
DISPATCHPP_RETURN();
#endif
void fromdigits(SV* svn, SV* svbase = 0)
PREINIT:
int bstatus;
UV n, base;
STRLEN slen, rlen;
char *s, *str;
int status;
PPCODE:
SvGETMAGIC(svn);
if (!SvOK(svn)) croak("Parameter must be defined");
bstatus = 1;
base = 10;
if (items > 1)
bstatus = _validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG);
if (base < 2) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (bstatus == 1) {
if (SvROK(svn) && SvTYPE(SvRV(svn)) == SVt_PVAV) {
size_t len;
} else {
croak("fromdigits: first argument must be a string or array reference");
}
}
DISPATCHPP_RETURN();
void is_harshad(SV* svn, SV* svbase = 0)
PREINIT:
int nstatus, bstatus;
UV n, base;
PPCODE:
if (items == 1) { bstatus = 1; base = 10; }
else { bstatus = _validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG); }
if (bstatus == 1) {
if (base < 2) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (base <= UINT32_MAX) {
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (nstatus == -1 || (nstatus == 1 && n == 0))
RETURN_NPARITY(0);
if (nstatus == 1) {
UV N, t, sum;
}
}
}
/* We can read the string and sum the digits, but no way to mod here. */
DISPATCHPP_RETURN();
void is_palindrome(SV* svn, SV* svbase = 0)
PREINIT:
int bstatus;
UV n, base;
PPCODE:
if (items == 1) { bstatus = 1; base = 10; }
else { bstatus = _validate_and_set(&base, aTHX_ svbase, IFLAG_NONNEG); }
if (bstatus == 1) {
if (base < 2) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (base <= UINT32_MAX &&
_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
uint32_t b = (uint32_t) base;
UV forward = n, reverse = 0;
while (n > 0) {
uint32_t digit = n % b;
}
}
DISPATCHPP_RETURN();
void digital_root(SV* svn, IN SV* svbase = 0)
ALIAS:
mult_digital_root = 1
PREINIT:
UV n, dr, base;
int bstatus;
PPCODE:
if (items==1){bstatus = 1; base = 10;}
else {bstatus = _validate_and_set(&base,aTHX_ svbase,IFLAG_NONNEG);}
if (bstatus == 1 && _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
if (base < 2) croak("%s: invalid base: %"UVuf, SUBNAME, base);
if (n == 0) {
dr = 0;
} else if (ix == 0) {
dr = 1 + (n-1) % (base-1);
} else {
UV digits[128];
dr *= digits[i];
}
}
RETURN_NPARITY(dr);
}
DISPATCHPP_RETURN();
void tozeckendorf(SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG)) {
char *str = to_zeckendorf(n);
XPUSHs(sv_2mortal(newSVpv(str, 0)));
Safefree(str);
XSRETURN(1);
}
DISPATCHPP_RETURN();
void fromzeckendorf(IN SV* svstr)
PREINIT:
int status;
STRLEN len;
const char* str;
PPCODE:
SvGETMAGIC(svstr);
if (!SvOK(svstr)) croak("Parameter must be defined");
str = SvPV_nomg(svstr, len);
status = validate_zeckendorf(str, len);
if (status == 0)
croak("fromzeckendorf: expected binary string");
if (status == -1)
croak("fromzeckendorf: expected binary string in canonical Zeckendorf form");
if (status == 1)
XSRETURN_UV(from_zeckendorf(str, len));
DISPATCHPP_RETURN();
void
lastfor()
PREINIT:
dMY_CXT;
PPCODE:
/* printf("last for with count = %u\n", MY_CXT.forcount); */
if (MY_CXT.forcount == 0) croak("lastfor called outside a loop");
MY_CXT.forexit = 1;
/* In some ideal world this would also act like a last */
return;
#define START_FORCOUNT \
do { \
New(0, forguard, 1, forcount_guard_t); \
forguard->previous_forcount = MY_CXT.forcount; \
void
forprimes (SV* block, IN SV* svbeg, IN SV* svend = 0)
PROTOTYPE: &$;$
PREINIT:
SV* svarg;
CV *subcv;
unsigned char* segment;
UV beg, end, seg_base, seg_low, seg_high;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = 2; }
START_FORCOUNT;
SAVESPTR(GvSV(PL_defgv));
foroddcomposites (SV* block, IN SV* svbeg, IN SV* svend = 0)
ALIAS:
forcomposites = 1
PROTOTYPE: &$;$
PREINIT:
UV beg, end;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = ix ? 4 : 9; }
START_FORCOUNT;
SAVESPTR(GvSV(PL_defgv));
void
forsemiprimes (SV* block, IN SV* svbeg, IN SV* svend = 0)
PROTOTYPE: &$;$
PREINIT:
UV beg, end;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = 4; }
if (beg < 4) beg = 4;
if (end > MPU_MAX_SEMI_PRIME) end = MPU_MAX_SEMI_PRIME;
void
foralmostprimes (SV* block, IN UV k, IN SV* svbeg, IN SV* svend = 0)
PROTOTYPE: &$$;$
PREINIT:
UV c, beg, end, shiftres;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = 1; }
/* If k is over 63 but the beg/end points are UVs, then we're empty. */
if (k == 0 || k >= BITS_PER_WORD) XSRETURN(0);
void
fordivisors (SV* block, IN SV* svn)
PROTOTYPE: &$
PREINIT:
UV i, n, ndivisors;
UV *divs;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG))
DISPATCHPP_RETURN_VOID();
divs = divisor_list(n, &ndivisors, UV_MAX);
START_FORCOUNT;
SAVESPTR(GvSV(PL_defgv));
svarg = newSVuv(0);
forcomp = 1
PROTOTYPE: &$;$
PREINIT:
UV i, n, amin, amax, nmin, nmax, tmp;
int primeq;
bool doloop0, doloopn;
CV *subcv;
SV** svals;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG))
DISPATCHPP_RETURN_VOID();
if (n > (UV_MAX-2)) croak("%s: argument overflow", SUBNAME);
amin = 1; amax = n; nmin = 1; nmax = n; primeq = -1;
if (svh != 0) {
HV* rhash;
SV** svp;
forcomb (SV* block, IN SV* svn, IN SV* svk = 0)
PROTOTYPE: &$;$
PREINIT:
UV i, n, k, begk, endk;
int nstatus, kstatus;
CV *subcv;
SV** svals;
UV* cm;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG);
kstatus = 1;
if (nstatus != 0) {
if (items == 2) {
begk = 0; endk = n;
} else if (_validate_and_set(&k, aTHX_ svk, IFLAG_NONNEG)) {
begk = endk = k;
if (begk > n)
ALIAS:
forderange = 1
PROTOTYPE: &$
PREINIT:
UV i, n;
CV *subcv;
SV** svals;
UV* cm;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_NONNEG))
DISPATCHPP_RETURN_VOID();
if (n <= 1) {
if (!(ix == 1 && n == 1)) {
START_FORCOUNT;
PUSHMARK(SP); EXTEND(SP, 1);
if (n == 1) PUSH_NPARITY(0);
void forsetproduct (SV* block, ...)
PROTOTYPE: &@
PREINIT:
SSize_t narrays, i, j, *arlen, *arcnt;
SV ***arsvs;
CV *subcv;
forsetproduct_guard_t *fsguard;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
narrays = items-1;
if (narrays < 1) XSRETURN(0);
for (i = 1; i <= narrays; i++) {
SvGETMAGIC(ST(i));
CHECK_ARRAYREF(ST(i));
if (av_count((AV *)SvRV(ST(i))) == 0)
XSRETURN(0);
PROTOTYPE: &$;$
PREINIT:
UV beg, end, n, *factors;
int i, nfactors, maxfactors;
factor_range_context_t fctx;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
SV* svals[64];
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = 1; }
if (beg < 1) beg = 1;
if (beg > end) XSRETURN(0);
void forsquarefreeint(SV* block, IN SV* svbeg, IN SV* svend = 0)
PROTOTYPE: &$;$
PREINIT:
UV beg, end, i;
unsigned char* isf;
SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */
CV *subcv;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_NONNEG) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_NONNEG)))
DISPATCHPP_RETURN_VOID();
if (!svend) { end = beg; beg = 1; }
if (beg < 1) beg = 1;
if (beg > end) XSRETURN(0);
void
vecwindow(SV* block, SV* svstep, SV* svsize, ...)
PROTOTYPE: &$$@
PREINIT:
SSize_t i, j, nlist, step, size, numret;
UV ustep, usize;
CV *subcv;
SV **list;
AV *list_av, *result_av;
PPCODE:
{ /* Generalized sliding window: block, step, size, list.
Each window of 'size' elements is passed as @_ to block;
all return values are collected and returned (like map). */
SETSUBREF(subcv, block);
if (!_validate_and_set(&ustep, aTHX_ svstep, IFLAG_POS) ||
!_validate_and_set(&usize, aTHX_ svsize, IFLAG_POS) ||
ustep > (UV)MAX_SSIZET || usize > (UV)MAX_SSIZET) {
DISPATCHPP_RETURN();
}
vecpairwise(SV* block, SV* sva, SV* svb)
PROTOTYPE: &$$
PREINIT:
SSize_t i, npairs, numret;
CV *subcv;
AV *result_av;
GV *agv, *bgv;
SV *atmp, *btmp;
DECL_ARREF(arr1);
DECL_ARREF(arr2);
PPCODE:
{ /* Similar to pairwise from List::MoreUtils, but block values do not alias inputs. */
SETSUBREF(subcv, block);
if (!SvROK(sva) || SvTYPE(SvRV(sva)) != SVt_PVAV ||
!SvROK(svb) || SvTYPE(SvRV(svb)) != SVt_PVAV)
croak("vecpairwise: expected two array references");
USE_ARREF(arr1, sva, SUBNAME, AR_READ);
USE_ARREF(arr2, svb, SUBNAME, AR_READ);
npairs = (len_arr1 < len_arr2) ? (SSize_t)len_arr1 : (SSize_t)len_arr2;
void
vecnone(SV* block, ...)
ALIAS:
vecall = 1
vecany = 2
vecnotall = 3
vecfirst = 4
vecfirstidx = 6
PROTOTYPE: &@
PPCODE:
{ /* This is very similar to List::Util. Try to maintain compat. */
int ret_true = !(ix & 2); /* return true at end of loop for none/all; false for any/notall */
int invert = (ix & 1); /* invert block test for all/notall */
SSize_t index;
SV **args = &PL_stack_base[ax];
CV *subcv;
SETSUBREF(subcv, block);
SAVESPTR(GvSV(PL_defgv));
ret_true = !ret_true;
RETURN_NPARITY(ret_true ? 1 : 0);
}
void vecuniq(...)
PROTOTYPE: @
PREINIT:
int typemask, retvals;
SSize_t j;
PPCODE:
retvals = (GIMME_V != G_SCALAR && GIMME_V != G_VOID);
/* Check all inputs to see if we can quickly process as an iset. */
for (j = 0, typemask = 0; j < items; j++) {
SV *sv = ST(j);
SvGETMAGIC(sv);
if (!SvOK(sv) || !SVNUMTEST(sv))
break;
if ((UV)SvIVX(sv) > (UV)IV_MAX)
typemask |= (SvIsUV(sv) ? ISET_TYPE_UV : ISET_TYPE_IV);
XSRETURN(count);
XSRETURN_UV(count);
}
void vecfreq(...)
PROTOTYPE: @
PREINIT:
int itype;
size_t len, i, retlen;
UV *L, count;
PPCODE:
if (items == 0)
RETURN_NOTHING();
/* Try to read native integers. Bail to PP if something else. */
len = (size_t) items;
New(0, L, len, UV);
itype = IARR_TYPE_ANY;
for (i = 0; i < len && itype != IARR_TYPE_BAD && SVNUMTEST(ST(i)); i++) {
IV n = SvIVX(ST(i));
if (n < 0) {
if (SvIsUV(ST(i))) itype |= IARR_TYPE_POS;
Safefree(L);
XSRETURN(retlen);
void vecsingleton(...)
PROTOTYPE: @
PREINIT:
int itype;
size_t len, i, retlen, count;
UV *L;
iset_t seen, dups;
PPCODE:
if (items == 0)
RETURN_NOTHING();
/* Try to read native integers. Bail to PP if something else. */
len = (size_t) items;
New(0, L, len, UV);
iset_create(&seen, len);
iset_create(&dups, len>>1);
itype = IARR_TYPE_ANY;
for (i = 0; i < len && itype != IARR_TYPE_BAD && SVNUMTEST(ST(i)); i++) {
IV n = SvIVX(ST(i));
( run in 0.942 second using v1.01-cache-2.11-cpan-4e7a2411597 )