// 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); } }