// Digit reversal
GEN
rev(GEN n, long B)
{
pari_sp av = avma;
if (typ(n) != t_INT)
pari_err_TYPE("rev", n);
GEN m = modis(n, B);
n = divis(n, B);
pari_sp btop = avma, st_lim = stack_lim(btop, 1);
while (signe(n)) {
m = addis(mulis(m, B), smodis(n, B));
n = divis(n, B);
if (low_stack(st_lim, stack_lim(btop, 1)))
gerepileall(btop, 2, &m, &n);
}
m = gerepilecopy(av, m);
return m;
}
Lisp_Object modulus(Lisp_Object a, Lisp_Object b)
{
switch ((int)a & TAG_BITS)
{
case TAG_FIXNUM:
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
/*
* This is where fixnum % fixnum arithmetic happens - the case I most want to
* make efficient.
*/
{ int32_t p = int_of_fixnum(a);
int32_t q = int_of_fixnum(b);
if (q == 0) return aerror2("bad arg for mod", a, b);
p = p % q;
if (q < 0)
{ if (p > 0) p += q;
}
else if (p < 0) p += q;
/* No overflow is possible in a modulus operation */
return fixnum_of_int(p);
}
/*
* Common Lisp defines a meaning for the modulus function when applied
* to floating point values - so there is a whole pile of mess here to
* support that. Standard Lisp is only concerned with fixnums and
* bignums.
*/
case TAG_SFLOAT:
return modis(a, b);
case TAG_NUMBERS:
{ int32_t hb = type_of_header(numhdr(b));
switch (hb)
{
case TYPE_BIGNUM:
return modib(a, b);
case TYPE_RATNUM:
return modir(a, b);
default:
return aerror1("Bad arg for mod", b);
}
}
case TAG_BOXFLOAT:
return modif(a, b);
default:
return aerror1("Bad arg for mod", b);
}
case TAG_SFLOAT:
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
return modsi(a, b);
case TAG_SFLOAT:
{ Float_union aa, bb;
aa.i = a - TAG_SFLOAT;
bb.i = b - TAG_SFLOAT;
aa.f = (float) (aa.f + bb.f);
return (aa.i & ~(int32_t)0xf) + TAG_SFLOAT;
}
case TAG_NUMBERS:
{ int32_t hb = type_of_header(numhdr(b));
switch (hb)
{
case TYPE_BIGNUM:
return modsb(a, b);
case TYPE_RATNUM:
return modsr(a, b);
default:
return aerror1("Bad arg for mod", b);
}
}
case TAG_BOXFLOAT:
return modsf(a, b);
default:
return aerror1("Bad arg for mod", b);
}
case TAG_NUMBERS:
{ int32_t ha = type_of_header(numhdr(a));
switch (ha)
{
case TYPE_BIGNUM:
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
return modbi(a, b);
case TAG_SFLOAT:
return modbs(a, b);
case TAG_NUMBERS:
{ int32_t hb = type_of_header(numhdr(b));
switch (hb)
{
case TYPE_BIGNUM:
return modbb(a, b);
case TYPE_RATNUM:
return modbr(a, b);
default:
return aerror1("Bad arg for mod", b);
}
}
case TAG_BOXFLOAT:
return modbf(a, b);
default:
return aerror1("Bad arg for mod", b);
}
case TYPE_RATNUM:
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
return modri(a, b);
case TAG_SFLOAT:
return modrs(a, b);
case TAG_NUMBERS:
{ int32_t hb = type_of_header(numhdr(b));
switch (hb)
{
case TYPE_BIGNUM:
return modrb(a, b);
case TYPE_RATNUM:
return modrr(a, b);
default:
return aerror1("Bad arg for mod", b);
}
}
case TAG_BOXFLOAT:
return modrf(a, b);
default:
return aerror1("Bad arg for mod", b);
}
default:
return aerror1("Bad arg for mod", a);
}
}
case TAG_BOXFLOAT:
switch ((int)b & TAG_BITS)
{
case TAG_FIXNUM:
return modfi(a, b);
case TAG_SFLOAT:
return modfs(a, b);
case TAG_NUMBERS:
{ int32_t hb = type_of_header(numhdr(b));
switch (hb)
{
case TYPE_BIGNUM:
return modfb(a, b);
case TYPE_RATNUM:
return modfr(a, b);
default:
return aerror1("Bad arg for mod", b);
}
}
case TAG_BOXFLOAT:
return ccl_modff(a, b);
default:
return aerror1("Bad arg for mod", b);
}
default:
return aerror1("Bad arg for mod", a);
}
}
