Math-Prime-Util
view release on metacpan or search on metacpan
MY_CXT.forexit = 0;
}
}
#if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
void
CLONE(...)
PREINIT:
int i;
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 */
Safefree(MY_CXT.randcxt); MY_CXT.randcxt = 0;
return; /* skip implicit PUTBACK, returning @_ to caller, more efficient*/
void csrand(IN SV* seed = 0)
PREINIT:
unsigned char* data;
STRLEN size;
dMY_CXT;
PPCODE:
if (items == 0) {
csprng_init_seed(MY_CXT.randcxt);
} else if (_XS_get_secure()) {
croak("secure option set, manual seeding disabled");
} else {
data = (unsigned char*) SvPV(seed, size);
csprng_seed(MY_CXT.randcxt, size, data);
}
if (_XS_get_callgmp() >= 42) CALLROOTSUB("_csrand_p");
return;
sv_setsv(svn, sv_to_bigint(aTHX_ svn));
}
}
RETVAL = TRUE;
OUTPUT:
RETVAL
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) DISPATCH_VOIDPP();
XSRETURN(0);
void
prime_precalc(IN UV n)
ALIAS:
_XS_set_verbose = 1
_XS_set_callgmp = 2
_end_for_loop = 3
PPCODE:
PUTBACK; /* SP is never used again, the 3 next func calls are tailcall
friendly since this XSUB has nothing to do after the 3 calls return */
switch (ix) {
case 0: prime_precalc(n); break;
case 1: _XS_set_verbose(n); break;
case 2: _XS_set_callgmp(n); break;
case 3:
default: { dMY_CXT; MY_CXT.forcount--; MY_CXT.forexit = n>0; } break;
}
return; /* skip implicit PUTBACK */
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_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
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_POS)) {
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;
XSRETURN_UV(ret);
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void sum_primes(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
UV lo = 2, hi;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
UV count = 0;
int retok = 1;
/* 32/64-bit, Legendre or table-accelerated sieving. */
retok = sum_primes(lo, hi, &count);
/* If that didn't work, try the 128-bit version if supported. */
if (retok == 0 && HAVE_SUM_PRIMES128) {
UV hicount, lo_hic, lo_loc;
retok = sum_primes128(hi, &hicount, &count);
if (retok == 1)
XSRETURN_UV(count);
}
DISPATCHPP();
XSRETURN(1);
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_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
ret = random_prime(MY_CXT.randcxt,lo,hi);
if (ret) XSRETURN_UV(ret);
else XSRETURN_UNDEF;
}
DISPATCHPP();
objectify_result(aTHX_ svlo, ST(0));
XSRETURN(1);
void print_primes(IN SV* svlo, IN SV* svhi = 0, IN int infd = -1)
PREINIT:
UV lo = 2, hi;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) ||
(items >= 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
if (lo <= hi) {
int fd = (infd == -1) ? fileno(stdout) : infd;
print_primes(lo, hi, fd);
}
} else {
DISPATCH_VOIDPP();
}
return;
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
end_segment_primes(ctx);
}
}
return; /* skip implicit PUTBACK */
void primes(IN SV* svlo, IN SV* svhi = 0)
PREINIT:
AV* av;
UV lo = 0, hi, i;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
CREATE_RETURN_AV(av);
if ((lo <= 2) && (hi >= 2)) av_push(av, newSVuv( 2 ));
if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 ));
if ((lo <= 5) && (hi >= 5)) av_push(av, newSVuv( 5 ));
if (lo < 7) lo = 7;
if (lo <= hi) {
if ( hi-lo <= 10
|| (hi > 100000000UL && hi-lo <= 330)
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_POS)) ||
(items >= 3 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
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);
} else {
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_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
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 ));
} else {
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_POS)) ||
(items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
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);
} else {
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_POS)) {
if (ix == 0) {
res = minimal_goldbach_pair(n);
if (res == 0) XSRETURN_UNDEF;
} else {
res = goldbach_pair_count(n);
}
XSRETURN_UV(res);
}
DISPATCHPP();
XSRETURN(1);
void goldbach_pairs(IN SV* svn)
PREINIT:
size_t npairs, i;
UV n, *L;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) == 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);
} else {
DISPATCHPP();
return;
}
void powerful_numbers(IN SV* svlo, IN SV* svhi = 0, IN UV k = 2)
PREINIT:
AV* av;
UV lo = 1, hi, i, npowerful, *powerful;
PPCODE:
if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) ||
(items >= 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) {
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);
} else {
DISPATCHPP();
}
return;
void
sieve_range(IN SV* svn, IN UV width, IN UV depth)
PREINIT:
int status;
UV i, n;
PPCODE:
/* Return index of every n unless it is a composite with factor > depth */
status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS);
if (status == 1) {
if ((n+width) < n) {
status = 0; /* range will overflow */
} else { /* TODO: actually sieve */
for (i = (n<2)?2-n:0; i < width; i++)
if (is_rough(n+i, (depth+1) >= (n+i) ? n+i : depth+1))
XPUSHs(sv_2mortal(newSVuv( i )));
}
DISPATCHPP();
return;
}
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;
PPCODE:
nc = items-1;
if (items > 100) croak("sieve_prime_cluster: too many entries");
cl[0] = 0;
for (i = 1; i < nc; i++) {
if (!_validate_and_set(&cval, aTHX_ ST(1+i), IFLAG_POS))
croak("sieve_prime_cluster: cluster values must be standard integers");
if (cval & 1) croak("sieve_prime_cluster: values must be even");
if (cval > 2147483647UL) croak("sieve_prime_cluster: values must be 31-bit");
if (cval <= cl[i-1]) croak("sieve_prime_cluster: values must be increasing");
cl[i] = cval;
return;
}
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 == 2 && !(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_frobenius_khashin_pseudoprime = 9
is_catalan_pseudoprime = 10
is_euler_plumb_pseudoprime = 11
is_ramanujan_prime = 12
is_semiprime = 13
is_chen_prime = 14
is_mersenne_prime = 15
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 = BPSW(n); break;
case 4: ret = is_aks_prime(n); break;
case 5: ret = is_lucas_pseudoprime(n, 0); break;
XSRETURN(1);
void
is_perrin_pseudoprime(IN SV* svn, IN UV k = 0)
ALIAS:
is_almost_extra_strong_lucas_pseudoprime = 1
is_delicate_prime = 2
PREINIT:
int status, ret;
UV n;
PPCODE:
/* k is a UV, so always positive. */
/* ix = 0 k = 0 - 3 n below 2 returns 0 for all k
* ix = 1 k = 0 - 256 n below 2 returns 0 for all k
* ix = 2 k = 0 - 2^32 n below 2 returns 0 for all k
*/
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
ret = 0;
if (status == 1) {
switch (ix) {
case 0: if (items == 1) k = 0;
}
if (status != 0) RETURN_NPARITY(ret);
DISPATCHPP();
XSRETURN(1);
void
is_frobenius_pseudoprime(IN SV* svn, IN IV P = 0, IN IV Q = 0)
PREINIT:
int status;
UV n;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status != 0)
RETURN_NPARITY((status == 1) ? is_frobenius_pseudoprime(n, P, Q) : 0);
DISPATCHPP();
XSRETURN(1);
void
miller_rabin_random(IN SV* svn, IN IV bases = 1, IN char* seed = 0)
PREINIT:
int status;
UV n;
dMY_CXT;
PPCODE:
if (bases < 0) croak("miller_rabin_random: expected positive number of bases");
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1) RETURN_NPARITY(0);
if (seed == 0 && status == 1)
RETURN_NPARITY( is_mr_random(MY_CXT.randcxt, n, bases) );
DISPATCHPP();
XSRETURN(1);
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) );
}
}
PROTOTYPE: @
ALIAS:
lcm = 1
vecmin = 2
vecmax = 3
vecsum = 4
vecprod = 5
PREINIT:
int i, status = 1;
UV ret, nullv, n;
PPCODE:
if (ix == 2 || ix == 3) {
UV retindex = 0;
int sign, minmax = (ix == 2);
if (items == 0) XSRETURN_UNDEF;
if (items == 1) XSRETURN(1);
if (items > 1 && (status = _validate_and_set(&ret, aTHX_ ST(0), IFLAG_ANY))) {
sign = status;
for (i = 1; i < items; i++) {
status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ANY);
if (status == 0) break;
}
DISPATCHPP();
if (ix == 0 || ix == 1) objectify_result(aTHX_ 0, ST(0));
XSRETURN(1);
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, index;
DECL_ARREF(mav);
USE_ARREF(mav, svm, SUBNAME, AR_READ);
for (j = 0; (Size_t)j < len_mav; j++) {
SV* v = FETCH_ARREF(mav, j);
if (_validate_and_set(&mask, aTHX_ v, IFLAG_IV) == 0)
croak("vecextract invalid index");
}
} else {
DISPATCHPP();
return;
}
void
vecequal(IN SV* a, IN SV* b)
PREINIT:
int res;
PPCODE:
res = _compare_array_refs(aTHX_ a, b);
if (res == -1)
croak("vecequal: expected scalar or array reference");
RETURN_NPARITY(res);
XSRETURN(1);
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_POS;
} else {
min = 1;
mask = IFLAG_POS | IFLAG_NONZERO;
}
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 | IFLAG_NONZERO)) break;
if (n == 1) { found1 = 1; break; }
A[i] = n;
}
if (i == items) {
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;
SV *svfirstmod;
PPCODE:
status = 1;
New(0, an, 2*items, UV);
ret = 0;
svfirstmod = 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);
XSRETURN(2);
}
}
DISPATCHPP();
if (ix == 0) objectify_result(aTHX_ svfirstmod, ST(0));
XSRETURN(1 + ix);
void cornacchia(IN SV* svd, IN SV* svn)
PREINIT:
UV d, n, x, y;
PPCODE:
if (_validate_and_set(&d, aTHX_ svd, IFLAG_POS) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_POS) ) {
if (!cornacchia(&x, &y, d, n)) XSRETURN_UNDEF;
PUSHs(sv_2mortal(newSVuv( x )));
PUSHs(sv_2mortal(newSVuv( y )));
} else {
DISPATCHPP();
return; /* Can return undef or two values */
}
void lucas_sequence(...)
PREINIT:
UV U, V, Qk, n, P, Q, k;
PPCODE:
if (items != 4) croak("lucas_sequence: n, P, Q, k");
if (_validate_and_set(&n, aTHX_ ST(0), IFLAG_POS | IFLAG_NONZERO) &&
_validate_and_set(&P, aTHX_ ST(1), IFLAG_ANY | IFLAG_IV) &&
_validate_and_set(&Q, aTHX_ ST(2), IFLAG_ANY | IFLAG_IV) &&
_validate_and_set(&k, aTHX_ ST(3), IFLAG_POS)) {
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 )));
} else {
XSRETURN(3);
}
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_POS) &&
_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);
switch (ix) {
XSRETURN(ix==0 ? 2 : 1);
}
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_POS) &&
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 )));
} else {
DISPATCHPP();
OBJECTIFY_STACK(ix==0 ? 2 : 1);
XSRETURN(ix==0 ? 2 : 1);
}
void is_sum_of_squares(IN SV* svn, IN UV k = 2)
PREINIT:
int status, ret;
UV n;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
if (status != 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;
}
RETURN_NPARITY(ret);
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_power(n,2); 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 (status != 0) RETURN_NPARITY(ret);
DISPATCHPP();
XSRETURN(1);
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();
XSRETURN(1);
void is_powerfree(IN SV* svn, IN int k = 2)
ALIAS:
powerfree_sum = 1
powerfree_part = 2
powerfree_part_sum = 3
PREINIT:
int status;
UV n, res;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1) {
n = neg_iv(n);
if (ix == 2)
XSRETURN_IV( neg_iv(powerfree_part(n,k)) );
}
if (status != 0) {
switch (ix) {
case 0: res = is_powerfree(n,k); break;
case 1: res = powerfree_sum(n,k); break;
}
DISPATCHPP();
XSRETURN(1);
void powerfree_count(IN SV* svn, IN int k = 2)
ALIAS:
nth_powerfree = 1
PREINIT:
int status;
UV n, res;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, (ix==0) ? IFLAG_ANY : IFLAG_POS);
if (status != 0) {
if (status == -1)
XSRETURN_UV(0);
if (ix == 0) {
res = powerfree_count(n,k);
XSRETURN_UV(res);
} else {
if (n == 0 || k < 2)
XSRETURN_UNDEF;
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void
is_power(IN SV* svn, IN UV k = 0, IN SV* svroot = 0)
PREINIT:
int status, ret;
UV n;
uint32_t root;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status != 0) {
if (k != 0) {
if (status == -1) {
if (k % 2 == 0) RETURN_NPARITY(0); /* negative n even k return 0 */
n = neg_iv(n);
}
ret = is_power_ret(n, k, &root);
} else { /* k = 0 */
if (status == -1)
RETURN_NPARITY(ret);
}
DISPATCHPP_GMPONLYIF(svroot == 0);
XSRETURN(1);
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 (status != 0) {
ret = (status == 1) ? prime_power(n, &root) : 0;
if (ret && svroot != 0) {
if (!SvROK(svroot))croak("is_prime_power: second argument not a scalar reference");
sv_setuv(SvRV(svroot), root);
}
RETURN_NPARITY(ret);
}
DISPATCHPP_GMPONLYIF(svroot == 0);
XSRETURN(1);
void
is_polygonal(IN SV* svn, IN UV k, IN SV* svroot = 0)
PREINIT:
UV n;
int status;
PPCODE:
if (svroot != 0 && !SvROK(svroot))
croak("is_polygonal: third argument not a scalar reference");
if (k < 3)
croak("is_polygonal: k must be >= 3");
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == -1)
RETURN_NPARITY(0);
if (status == 1) {
bool overflow = 0;
RETURN_NPARITY(result);
}
}
DISPATCHPP_GMPONLYIF(svroot == 0);
XSRETURN(1);
void inverse_li(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
if (n < MPU_MAX_PRIME_IDX) /* Fall through to Perl if out of range. */
XSRETURN_UV(inverse_li(n));
}
DISPATCHPP();
XSRETURN(1);
NV inverse_li_nv(IN NV x)
CODE:
RETVAL = ld_inverse_li(x);
OUTPUT:
RETVAL
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_POS) &&
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();
XSRETURN(1);
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_POS) &&
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();
XSRETURN(1);
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_POS) &&
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;
}
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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_POS) &&
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();
XSRETURN(1);
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_POS) &&
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();
XSRETURN(1);
void nth_semiprime(IN SV* svn)
ALIAS:
nth_semiprime_approx = 1
PREINIT:
UV n, ret;
PPCODE:
if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) &&
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();
XSRETURN(1);
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_POS) &&
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;
}
}
DISPATCHPP();
XSRETURN(1);
void next_prime(IN SV* svn)
ALIAS:
prev_prime = 1
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)
&& !(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();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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();
XSRETURN(1);
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();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void next_chen_prime(IN SV* svn)
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
ret = next_chen_prime(n);
if (ret != 0) XSRETURN_UV(ret);
}
DISPATCHPP();
XSRETURN(1);
void urandomb(IN UV bits)
ALIAS:
random_ndigit_prime = 1
random_safe_prime = 4
random_nbit_prime = 5
random_shawe_taylor_prime = 6
random_maurer_prime = 7
random_proven_prime = 8
random_strong_prime = 9
PREINIT:
UV res, minarg;
dMY_CXT;
void* cs;
PPCODE:
switch (ix) {
case 1: minarg = 1; break;
case 2: minarg = 4; break;
case 3: minarg = 3; break;
case 4: minarg = 3; break;
case 5:
case 6:
case 7:
case 8: minarg = 2; break;
case 9: minarg = 128; break;
}
if (res || ix == 0) XSRETURN_UV(res);
}
DISPATCHPP_GMPONLYIF(ix != 1 || bits != uvmax_maxlen);
objectify_result(aTHX_ 0, ST(0));
XSRETURN(1);
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();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void pisano_period(IN SV* svn)
ALIAS:
partitions = 1
consecutive_integer_lcm = 2
PREINIT:
UV n, r = 0;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
switch (ix) {
case 0: r = pisano_period(n); break;
case 1: r = npartitions(n); break;
case 2: r = consecutive_integer_lcm(n); break;
default: break;
}
/* Returns 0 if n=0 or result overflows */
if (r != 0 || n == 0)
XSRETURN_UV(r);
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void random_factored_integer(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO)) {
dMY_CXT;
int f, nf, flip;
UV r, F[MPU_MAX_FACTORS+1];
AV* av = newAV();
r = random_factored_integer(MY_CXT.randcxt, n, &nf, F);
flip = (F[0] >= F[nf-1]); /* Handle results in either sort order */
for (f = 0; f < nf; f++)
av_push(av, newSVuv(F[flip ? nf-1-f : f]));
XPUSHs(sv_2mortal(newSVuv( r )));
DISPATCHPP();
XSRETURN(1);
}
void contfrac(IN SV* svnum, IN SV* svden)
PREINIT:
UV num, den;
int nstatus;
PPCODE:
nstatus = _validate_and_set(&num, aTHX_ svnum, IFLAG_ANY);
/* TODO: handle negative numerator */
if (nstatus == 1 && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) {
UV *cf, rem;
int i, steps = contfrac(&cf, &rem, num, den);
EXTEND(SP, (EXTEND_TYPE)steps);
for (i = 0; i < steps; i++)
PUSHs(sv_2mortal(newSVuv( cf[i] )));
Safefree(cf);
} else {
DISPATCHPP();
return;
}
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 | IFLAG_NONZERO))
DISPATCHPP();
}
XSRETURN(2);
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 | IFLAG_NONZERO) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) {
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 )));
XPUSHs(sv_2mortal(newSVuv( den )));
XSRETURN(2);
}
}
DISPATCHPP();
XSRETURN(2);
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 | IFLAG_NONZERO) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) {
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();
XSRETURN(1);
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 | IFLAG_NONZERO)) {
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();
XSRETURN(2);
void nth_stern_diatomic(IN SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS))
XSRETURN_UV(nth_stern_diatomic(n));
DISPATCHPP();
XSRETURN(1);
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_POS))
k = UV_MAX;
}
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO)) {
if (!wantsingle && GIMME_V != G_ARRAY)
XSRETURN_UV(farey_length(n));
if (n <= UVCONST(4294967295)) {
if (wantsingle) {
void next_farey(IN SV* svn, IN SV* svfrac)
ALIAS:
farey_rank = 1
PREINIT:
SV **psvp, **psvq;
AV* av;
UV n, p64, q64;
uint32_t p, q;
int status;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO) &&
n <= UVCONST(4294967295)) {
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;
#ifdef USE_QUADMATH
const UV mantsize = FLT128_DIG;
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
PPCODE:
if (digits == 0) {
XSRETURN_NV( pival );
} else if (digits <= mantsize) {
char* out = pidigits(digits);
NV pi = STRTONV(out);
Safefree(out);
XSRETURN_NV( pi );
} else {
DISPATCHPP();
XSRETURN(1);
}
void bernfrac(IN SV* svn)
ALIAS:
harmfrac = 1
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) != 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();
OBJECTIFY_STACK(2);
XSRETURN(2);
void
_pidigits(IN int digits)
PREINIT:
char* out;
PPCODE:
if (digits <= 0) XSRETURN_EMPTY;
out = pidigits(digits);
XPUSHs(sv_2mortal(newSVpvn(out, 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_POS);
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++)
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_POS);
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++)
}
} else {
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_POS);
k = n;
if (status == 1 && svk != 0) {
status = _validate_and_set(&k, aTHX_ svk, IFLAG_POS);
if (k > n) k = n;
}
if (status != 1) {
DISPATCHPP();
return;
}
cheb_factor = 6
pplus1_factor = 7
pbrent_factor = 8
pminus1_factor = 9
ecm_factor = 10
PREINIT:
UV n, arg1, arg2;
static const UV default_arg1[] =
{0, 64000000, 8000000, 4000000, 1, 4000000, 0, 200, 4000000, 1000000};
/* Trial, Fermat, Holf, SQUFOF, Lmn, PRHO, Cheb, P+1, Brent, P-1 */
PPCODE:
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS) || ix == 10) {
DISPATCHPP();
return;
}
if (n == 0) XSRETURN_UV(0);
/* Must read arguments before pushing anything */
arg1 = (items >= 2) ? my_svuv(ST(1)) : default_arg1[ix];
arg2 = (items >= 3) ? my_svuv(ST(2)) : 0;
/* Small factors */
while ( (n% 2) == 0 ) { n /= 2; XPUSHs(sv_2mortal(newSVuv( 2 ))); }
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_POS)) {
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_POS) &&
jordan_totient(IN SV* sva, IN SV* svn)
ALIAS:
powersum = 1
ramanujan_sum = 2
legendre_phi = 3
smooth_count = 4
rough_count = 5
PREINIT:
int astatus, nstatus;
UV a, n, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_POS);
nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_POS);
if (astatus != 0 && nstatus != 0) {
switch (ix) {
case 0: ret = jordan_totient(a, n);
if (ret == 0 && n > 1)
goto overflow;
break;
case 1: ret = powersum(a, n);
if (ret == 0 && a > 0)
XSRETURN(1);
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_ABS) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
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;
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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_ABS) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
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;
}
if (ret != 0) XSRETURN_UV(ret);
}
}
DISPATCHPP();
XSRETURN(1);
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_ABS) &&
_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) &&
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);
XSRETURN_UV(ret);
}
}
DISPATCHPP();
XSRETURN(1);
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) {
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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);
XSRETURN_UV(ret);
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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;
XSRETURN_UV(ret);
}
}
DISPATCHPP();
XSRETURN(1);
void factorialmod(IN SV* sva, IN SV* svn)
PREINIT:
int astatus, nstatus;
UV a, n;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_POS);
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_GMPONLYIF(astatus == 1);
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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;
XSRETURN_UV(r);
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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) XSRETURN_EMPTY;
_mod_with(&a, astatus, n);
roots = allsqrtmod(&numr, a, n);
if (roots != 0) {
if (GIMME_V != G_ARRAY) {
PUSHs(sv_2mortal(newSVuv(numr)));
} else {
}
} 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) XSRETURN_EMPTY;
_mod_with(&a, astatus, n);
if (!prep_pow_inv(&a,&g,gstatus,n)) XSRETURN_EMPTY;
roots = allrootmod(&numr, a, g, n);
if (roots != 0) {
if (GIMME_V != G_ARRAY) {
}
} 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();
XSRETURN(1);
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();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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_POS)) {
RETURN_NPARITY( (ix == 0) ? is_smooth(n,k) : is_rough(n,k) );
}
DISPATCHPP();
XSRETURN(1);
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_POS);
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);
}
DISPATCHPP();
XSRETURN(1);
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();
XSRETURN(1);
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();
XSRETURN(1);
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_POS)) {
if (k <= 1) croak("valuation: k must be > 1");
if (n == 0) XSRETURN_UNDEF;
RETURN_NPARITY(valuation(n, k));
}
DISPATCHPP();
XSRETURN(1);
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_POS);
if (nstatus != 0 && (!svk || _validate_and_set(&k, aTHX_ svk, IFLAG_POS))) {
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;
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void kronecker(IN SV* sva, IN SV* svb)
PREINIT:
int astatus, bstatus;
UV a, b;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY);
if (astatus != 0 && bstatus != 0) {
int k;
if (bstatus == 1)
k = (astatus==1) ? kronecker_uu(a,b) : kronecker_su((IV)a,b);
else
k = (astatus==1) ? kronecker_uu(a,neg_iv(b)) : -kronecker_su((IV)a,neg_iv(b));
RETURN_NPARITY( k );
}
DISPATCHPP();
XSRETURN(1);
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();
XSRETURN(1);
ALIAS:
subint = 1
mulint = 2
divint = 3
modint = 4
cdivint = 5
powint = 7
PREINIT:
int astatus, bstatus, overflow, postneg, nix, smask;
UV a, b, t, ret;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, (ix == 7) ? IFLAG_POS : IFLAG_ANY);
if (astatus != 0 && bstatus != 0) {
/* We will try to do everything with non-negative integers, with overflow
* detection. This means some pre-processing and post-processing for
* negative inputs. */
nix = ix; /* So we can modify */
ret = overflow = postneg = 0;
smask = ((astatus == -1) << 1) + (bstatus == -1);
DISPATCHPP();
objectify_result(aTHX_ sva, ST(0));
XSRETURN(1);
void add1int(IN SV* svn)
ALIAS:
sub1int = 1
PREINIT:
int status;
UV n;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 1) {
if (ix == 1 && n == 0) XSRETURN_IV(-1);
if (ix == 1 || (ix == 0 && n < UV_MAX))
XSRETURN_UV( (ix==0) ? n+1 : n-1 );
} else if (status == -1) {
if (ix == 0 || (ix == 1 && (IV)n > IV_MIN))
XSRETURN_IV( (ix==0) ? (IV)n+1 : (IV)n-1 );
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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));
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
void signint(IN SV* svn)
ALIAS:
is_odd = 1
is_even = 2
PREINIT:
int status, sign, isodd;
UV n;
const char* s;
STRLEN len;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY);
if (status == 0) { /* Look at the string input */
s = SvPV(svn, len);
if (len == 0 || s == 0) croak("%s: invalid non-empty input", SUBNAME);
sign = (s[0] == '-') ? -1 : (s[0] == '0') ? 0 : 1;
isodd = (s[len-1] == '1' || s[len-1] == '3' || s[len-1] == '5' || s[len-1] == '7' || s[len-1] == '9');
} else {
sign = (status == -1) ? -1 : (n == 0) ? 0 : 1;
isodd = n & 1;
}
RETURN_NPARITY( (ix==0) ? sign : (ix==1) ? isodd : !isodd );
void cmpint(IN SV* sva, IN SV* svb)
PREINIT:
int astatus, bstatus, ret = 0;
UV a, b;
PPCODE:
astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY);
bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY);
if (astatus != 0 && bstatus != 0) {
if (astatus > bstatus) ret = 1;
else if (astatus < bstatus) ret = -1;
else if (a == b) ret = 0;
else ret = ((astatus == 1 && a > b) || (astatus == -1 && (IV)a > (IV)b)) ? 1 : -1;
} else {
STRLEN alen, blen;
char *aptr, *bptr;
bptr = SvPV(svb, blen);
ret = strnum_cmp(aptr, alen, bptr, blen);
}
RETURN_NPARITY(ret);
void logint(IN SV* svn, IN UV k, IN SV* svret = 0)
ALIAS:
rootint = 1
PREINIT:
UV n, root;
PPCODE:
if (ix == 0 && k <= 1) croak("logint: base must be > 1");
if (ix == 1 && k <= 0) croak("rootint: k must be > 0");
if (svret != 0 && !SvROK(svret))
croak("%s: third argument not a scalar reference",SUBNAME);
if (_validate_and_set(&n, aTHX_ svn, ix == 0 ? IFLAG_POS | IFLAG_NONZERO : IFLAG_POS)) {
root = (ix == 0) ? logint(n, k) : rootint(n, k);
if (svret) sv_setuv(SvRV(svret), ix == 0 ? ipow(k,root) : ipow(root,k));
XSRETURN_UV(root);
}
DISPATCHPP_GMPONLYIF(svret == 0);
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 */
OBJECTIFY_STACK(2);
XSRETURN(2);
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 */
}
}
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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)) {
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();
OBJECTIFY_STACK(3);
XSRETURN(3);
}
void
stirling(IN UV n, IN UV m, IN UV type = 1)
PPCODE:
if (type != 1 && type != 2 && type != 3)
croak("stirling: type must be 1, 2, or 3");
if (n == m)
XSRETURN_UV(1);
else if (n == 0 || m == 0 || m > n)
XSRETURN_UV(0);
else if (type == 3) {
UV s = stirling3(n, m);
if (s != 0) XSRETURN_UV(s);
} else if (type == 2) {
RETVAL
void euler_phi(IN SV* svlo, IN SV* svhi = 0)
ALIAS:
moebius = 1
PREINIT:
UV lo, hi;
int lostatus, histatus;
uint32_t mask;
PPCODE:
mask = (ix == 1 && items == 1) ? IFLAG_ABS : IFLAG_ANY;
lostatus = _validate_and_set(&lo, aTHX_ svlo, mask);
if (svhi == 0 && lostatus != 0) {
if (ix == 0) XSRETURN_UV( (lostatus == -1) ? 0 : totient(lo) );
else RETURN_NPARITY( moebius(lo) );
}
histatus = (svhi == 0) ? 0 : _validate_and_set(&hi, aTHX_ svhi, IFLAG_ANY);
/* - If range is larger than MAX_EXTEND, reduce it to fit.
* Arguably we should croak as invalid input.
* - If range includes UV_MAX, pull it off and handle separately.
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_POS)) {
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);
}
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
void prime_omega(IN SV* svn)
ALIAS:
prime_bigomega = 1
hammingweight = 2
is_square_free = 3
PREINIT:
UV n, ret;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)) {
ret = 0;
switch (ix) {
case 0: ret = prime_omega(n); break;
case 1: ret = prime_bigomega(n); break;
case 2: ret = popcnt(n); break;
case 3: ret = is_square_free(n); break;
default: break;
}
RETURN_NPARITY(ret);
void factorial(IN SV* svn)
ALIAS:
subfactorial = 1
fubini = 2
primorial = 3
pn_primorial = 4
sumtotient = 5
PREINIT:
UV n, r;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
r = 0;
switch(ix) {
case 0: r = factorial(n); break;
case 1: r = subfactorial(n); break;
case 2: r = fubini(n); break;
case 3: r = primorial(n); break;
case 4: r = pn_primorial(n); break;
case 5: r = sumtotient(n); break;
default: break;
}
}
DISPATCHPP();
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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) */
if (nstatus == -1) {
ret = binomial( neg_iv(n)+k-1, k );
DISPATCHPP_GMPONLYIF(nstatus == 1 && kstatus != 0);
objectify_result(aTHX_ svn, ST(0));
XSRETURN(1);
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_ANY | IFLAG_IV);
kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS);
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);
}
ALIAS:
liouville = 1
sumliouville = 2
is_pillai = 3
is_congruent_number = 4
hclassno = 5
ramanujan_tau = 6
PREINIT:
UV n;
int status;
PPCODE:
status = _validate_and_set(&n, aTHX_ svn, (ix < 5) ? IFLAG_POS : IFLAG_ANY);
if (status == -1)
XSRETURN_IV(0);
if (status == 1) {
IV r = 0;
switch(ix) {
case 0: r = mertens(n); break;
case 1: r = liouville(n); break;
case 2: r = sumliouville(n); break;
case 3: r = pillai_v(n); break;
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_POS)) {
NV r = (ix==0) ? chebyshev_theta(n) : chebyshev_psi(n);
XSRETURN_NV(r);
}
DISPATCHPP();
/* Result is FP */
XSRETURN(1);
#define RETURN_SET_REF(s) /* Return sorted set values */ \
}
#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 */
#if PERL_VERSION_GE(5,10,1)
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) {
void setunion(IN SV* sva, IN SV* svb)
PROTOTYPE: $$
ALIAS:
setintersect = 1
setminus = 2
setdelta = 3
PREINIT:
int atype, btype;
UV *ra, *rb;
size_t alen, blen;
PPCODE:
/* Fast path: both inputs are arrayrefs of native non-negative sorted
* unique integers. Merge SV* directly with SvREFCNT_inc, skipping
* intermediate UV array allocations and per-element newSVuv calls. */
{
size_t fa, fb;
SV **aa = _check_sorted_nonneg_arrayref(aTHX_ sva, &fa);
SV **bb = aa ? _check_sorted_nonneg_arrayref(aTHX_ svb, &fb) : NULL;
if (aa && bb) {
int inc_eq = (ix == 0 || ix == 1); /* union, intersect */
int inc_lt = (ix != 1); /* union, minus, delta */
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 atype, btype, ret;
UV *ra, *rb;
size_t alen, blen, inalen, inblen;
PPCODE:
/* If one set is much smaller than the other, it would be faster using
* is_in_set(). We'll keep things simple and slurp in both sets. */
/* THIS ASSUMES THE INPUT LISTS HAVE NO DUPLICATES */
inalen = inblen = 0;
if (SvROK(sva) && SvTYPE(SvRV(sva)) == SVt_PVAV && SvROK(svb) && SvTYPE(SvRV(svb)) == SVt_PVAV) {
/* Shortcut on length if we can to skip intersection. */
inalen = av_count((AV*) SvRV(sva));
inblen = av_count((AV*) SvRV(svb));
if ( (ix == 1 && inalen != inblen) ||
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(1);
if (SvMAGICAL(ava) || !AvREAL(ava)) { /* Punt these to Perl */
DISPATCHPP();
XSRETURN(1);
}
findall = ix == 0 ? 1 : 0;
if (items == 2 && SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) {
DISPATCHPP();
XSRETURN(1);
void setinsert(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 (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();
XSRETURN(1);
}
DISPATCHPP();
XSRETURN(1);
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();
XSRETURN(1);
}
XSRETURN(1);
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();
XSRETURN(1);
}
XSRETURN(1);
void is_sidon_set(IN SV* sva)
PROTOTYPE: $
PREINIT:
int itype, is_sidon;
size_t len, i, j;
UV *data;
iset_t s;
PPCODE:
itype = arrayref_to_int_array(aTHX_ &len, &data, 1, sva,"is_sidon_set");
if (itype == IARR_TYPE_NEG) { /* All elements must be non-negative. */
Safefree(data);
RETURN_NPARITY(0);
}
/* If any bigints or we cannot add the values in 64-bits, call PP. */
if (itype == IARR_TYPE_BAD || itype == IARR_TYPE_POS) {
Safefree(data);
DISPATCHPP();
XSRETURN(1);
iset_destroy(&s);
RETURN_NPARITY(is_sidon);
void is_sumfree_set(IN SV* sva)
PROTOTYPE: $
PREINIT:
UV *data;
size_t len, i, j;
int itype;
bool is_sumfree;
PPCODE:
itype = arrayref_to_int_array(aTHX_ &len, &data,1,sva,"is_sumfree_set");
if (itype != IARR_TYPE_BAD && len <= 1) { /* Degenerate cases: len 0 or 1 */
is_sumfree = len == 0 || data[0] != 0;
Safefree(data);
RETURN_NPARITY(is_sumfree);
}
/* Check for IV overflow on sum */
if (itype == IARR_TYPE_NEG) {
IV min = data[0], max = data[len-1]; /* Array is sorted */
if (min < IV_MIN/2 || max > IV_MAX/2) itype = IARR_TYPE_BAD;
*/
DISPATCHPP();
XSRETURN(1);
void toset(...)
PROTOTYPE: @
PREINIT:
int type;
size_t len;
UV *L;
PPCODE:
if (items == 0) RETURN_EMPTY_SET_REF();
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();
XSRETURN(1);
void vecsort(...)
PROTOTYPE: @
PREINIT:
int type;
size_t len;
UV *L;
PPCODE:
if (items == 0)
XSRETURN_EMPTY;
if (SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV) {
if (items != 1)
croak("vecsort: expected integer list or single array reference");
type = arrayref_to_int_array(aTHX_ &len, &L, 0, ST(0), "vecsort");
} 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 */
RETURN_LIST_VALS( len, L, (type != IARR_TYPE_NEG) );
void vecsorti(IN SV* sva)
PROTOTYPE: $
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();
XSRETURN(1);
}
type = arrayref_to_int_array(aTHX_ &len, &L, 0, sva, "vecsorti");
/* If we really wanted to optimize small values, the reading function
* could create a mask like:
for (i = 0; i < len; i++)
FASTSETSVINT(arr[i], type == IARR_TYPE_POS, L[i]);
Safefree(L);
XSRETURN(1);
void numtoperm(IN UV n, IN SV* svk)
PREINIT:
UV k;
int i, S[32];
PPCODE:
if (n == 0)
XSRETURN_EMPTY;
if (n < 32 && _validate_and_set(&k, aTHX_ svk, IFLAG_ABS) == 1) {
if (num_to_perm(k, n, S)) {
dMY_CXT;
EXTEND(SP, (EXTEND_TYPE)n);
for (i = 0; i < (int)n; i++)
PUSH_NPARITY( S[i] );
XSRETURN(n);
}
}
DISPATCHPP();
XSRETURN(1);
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);
if (_validate_and_set(&val, aTHX_ iv, IFLAG_POS) != 1)
break;
if (val >= plen || A[val] != 0) break;
A[val] = i+1;
XSRETURN_UV(num);
}
DISPATCHPP();
objectify_result(aTHX_ svp, ST(0));
XSRETURN(1);
void randperm(IN UV n, IN UV k = 0)
PREINIT:
UV i, *S;
dMY_CXT;
PPCODE:
if (items == 1) k = n;
if (k > n) k = n;
if (k == 0) XSRETURN_EMPTY;
New(0, S, k, UV);
randperm(MY_CXT.randcxt, n, k, S);
EXTEND(SP, (EXTEND_TYPE)k);
for (i = 0; i < k; i++) {
if (n < 2*CINTS) PUSH_NPARITY(S[i]);
else PUSHs(sv_2mortal(newSVuv(S[i])));
}
Safefree(S);
void shuffle(...)
PROTOTYPE: @
PREINIT:
SSize_t i, j;
void* randcxt;
dMY_CXT;
PPCODE:
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 (items == 1)
XSRETURN_EMPTY;
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.
*
* With a list input, the input is on the stack ST(1),ST(2),...
}
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("is_happy: invalid base %"UVuf, base);
if (k > 10) croak("is_happy: invalid exponent %"UVuf, k);
status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS);
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(happy_height(n, base, k));
DISPATCHPP();
XSRETURN(1);
void
sumdigits(SV* svn, UV ibase = 255)
PREINIT:
UV base, sum;
STRLEN i, len;
const char* s;
PPCODE:
base = (ibase == 255) ? 10 : ibase;
if (base < 2 || base > 36) croak("sumdigits: invalid base %"UVuf, 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)) {
t = n / base;
sum += n - base*t;
}
XSRETURN_UV(sum);
void todigits(SV* svn, int base=10, int length=-1)
ALIAS:
todigitstring = 1
fromdigits = 2
PREINIT:
int i, status;
UV n;
char *str;
PPCODE:
if (base < 2) croak("%s: invalid base: %d", SUBNAME, base);
status = 0;
if (ix == 0 || ix == 1) {
status = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS);
}
/* todigits with native input */
if (ix == 0 && status != 0 && length < 128) {
int digits[128];
IV len = to_digit_array(digits, n, base, length);
if (len >= 0) {
Safefree(r);
}
}
DISPATCHPP();
if (ix == 2) objectify_result(aTHX_ 0, ST(0));
return;
void tozeckendorf(SV* svn)
PREINIT:
UV n;
PPCODE:
if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
char *str = to_zeckendorf(n);
XPUSHs(sv_2mortal(newSVpv(str, 0)));
Safefree(str);
XSRETURN(1);
}
DISPATCHPP();
XSRETURN(1);
void fromzeckendorf(IN char* str)
PREINIT:
int status;
PPCODE:
status = validate_zeckendorf(str);
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));
DISPATCHPP();
XSRETURN(1);
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 { \
oldforloop = ++MY_CXT.forcount; \
oldforexit = MY_CXT.forexit; \
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (!svend) { end = beg; beg = 2; }
START_FORCOUNT;
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (!svend) { end = beg; beg = ix ? 4 : 9; }
START_FORCOUNT;
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (!svend) { end = beg; beg = 4; }
if (beg < 4) beg = 4;
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (!svend) { end = beg; beg = 1; }
/* If k is over 63 but the beg/end points are UVs, then we're empty. */
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_POS)) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
divs = divisor_list(n, &ndivisors, UV_MAX);
START_FORCOUNT;
ALIAS:
forcomp = 1
PROTOTYPE: &$;$
PREINIT:
UV i, n, amin, amax, nmin, nmax;
int primeq;
CV *subcv;
SV** svals;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (n > (UV_MAX-2)) croak("%s: argument overflow", SUBNAME);
New(0, svals, n+1, SV*);
for (i = 0; i <= n; i++) {
svals[i] = newSVuv(i);
forperm = 1
forderange = 2
PROTOTYPE: &$;$
PREINIT:
UV i, n, k, begk, endk;
CV *subcv;
SV** svals;
UV* cm;
DECL_FORCOUNT;
dMY_CXT;
PPCODE:
SETSUBREF(subcv, block);
if (ix > 0 && svk != 0)
croak("%s: too many arguments", SUBNAME);
if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS) ||
(svk && !_validate_and_set(&k, aTHX_ svk, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
END_FORCOUNT;
void forsetproduct (SV* block, ...)
PROTOTYPE: &@
PREINIT:
SSize_t narrays, i, j, *arlen, *arcnt;
SV ***arsvs;
CV *subcv;
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
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_POS) ||
(svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) {
DISPATCH_VOIDPP();
XSRETURN(0);
}
if (!svend) { end = beg; beg = 1; }
if (beg < 1) beg = 1;
if (beg > end) XSRETURN(0);
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));
}
void vecuniq(...)
PROTOTYPE: @
PREINIT:
iset_t s;
int status, retvals;
SSize_t j;
UV n;
unsigned long sz, nret;
PPCODE:
retvals = (GIMME_V != G_SCALAR && GIMME_V != G_VOID);
s = iset_create((size_t)items);
for (status = 1, nret = 0, j = 0; j < items; j++) {
status = _validate_and_set(&n, aTHX_ ST(j), IFLAG_ANY);
if (status == 0) break;
if (iset_add(&s, n, status) == 0)
continue;
if (iset_sign(s) == 0) { status = 0; break; }
if (retvals) {
PUSHs(sv_2mortal(NEWSVINT(status,n)));
}
XSRETURN(count);
}
void vecfreq(...)
PROTOTYPE: @
PREINIT:
int itype;
size_t len, i, retlen;
UV *L, count;
PPCODE:
if (items == 0) {
if (GIMME_V == G_SCALAR) XSRETURN_UV(0);
else XSRETURN_EMPTY;
}
/* 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));
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) {
if (GIMME_V == G_SCALAR) XSRETURN_UV(0);
else XSRETURN_EMPTY;
}
/* Try to read native integers. Bail to PP if something else. */
len = (size_t) items;
New(0, L, len, UV);
seen = iset_create(len);
dups = iset_create(len>>1);
itype = IARR_TYPE_ANY;
( run in 0.809 second using v1.01-cache-2.11-cpan-5511b514fd6 )