GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
/* dumbmp mini GMP compatible library.12Copyright 2001, 2002, 2004 Free Software Foundation, Inc.34This file is part of the GNU MP Library.56The GNU MP Library is free software; you can redistribute it and/or modify7it under the terms of the GNU Lesser General Public License as published by8the Free Software Foundation; either version 2.1 of the License, or (at your9option) any later version.1011The GNU MP Library is distributed in the hope that it will be useful, but12WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY13or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public14License for more details.1516You should have received a copy of the GNU Lesser General Public License17along with the GNU MP Library; see the file COPYING.LIB. If not, write to18the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,19MA 02110-1301, USA. */202122/* The code here implements a subset (a very limited subset) of the main GMP23functions. It's designed for use in a few build-time calculations and24will be slow, but highly portable.2526None of the normal GMP configure things are used, nor any of the normal27gmp.h or gmp-impl.h. To use this file in a program just #include28"dumbmp.c".2930ANSI function definitions can be used here, since ansi2knr is run if31necessary. But other ANSI-isms like "const" should be avoided.3233mp_limb_t here is an unsigned long, since that's a sensible type34everywhere we know of, with 8*sizeof(unsigned long) giving the number of35bits in the type (that not being true for instance with int or short on36Cray vector systems.)3738Only the low half of each mp_limb_t is used, so as to make carry handling39and limb multiplies easy. GMP_LIMB_BITS is the number of bits used. */4041#include <stdio.h>42#include <stdlib.h>43#include <string.h>444546typedef unsigned long mp_limb_t;4748typedef struct {49int _mp_alloc;50int _mp_size;51mp_limb_t *_mp_d;52} mpz_t[1];5354#define GMP_LIMB_BITS (sizeof (mp_limb_t) * 8 / 2)5556#define ABS(x) ((x) >= 0 ? (x) : -(x))57#define MIN(l,o) ((l) < (o) ? (l) : (o))58#define MAX(h,i) ((h) > (i) ? (h) : (i))5960#define ALLOC(x) ((x)->_mp_alloc)61#define PTR(x) ((x)->_mp_d)62#define SIZ(x) ((x)->_mp_size)63#define ABSIZ(x) ABS (SIZ (x))64#define LOMASK ((1L << GMP_LIMB_BITS) - 1)65#define LO(x) ((x) & LOMASK)66#define HI(x) ((x) >> GMP_LIMB_BITS)6768#define ASSERT(cond) \69do { \70if (! (cond)) \71{ \72fprintf (stderr, "Assertion failure\n"); \73abort (); \74} \75} while (0)767778char *79xmalloc (int n)80{81char *p;82p = malloc (n);83if (p == NULL)84{85fprintf (stderr, "Out of memory (alloc %d bytes)\n", n);86abort ();87}88return p;89}9091mp_limb_t *92xmalloc_limbs (int n)93{94return (mp_limb_t *) xmalloc (n * sizeof (mp_limb_t));95}9697void98mem_copyi (char *dst, char *src, int size)99{100int i;101for (i = 0; i < size; i++)102dst[i] = src[i];103}104105int106isprime (int n)107{108int i;109if (n < 2)110return 0;111for (i = 2; i < n; i++)112if ((n % i) == 0)113return 0;114return 1;115}116117int118log2_ceil (int n)119{120int e;121ASSERT (n >= 1);122for (e = 0; ; e++)123if ((1 << e) >= n)124break;125return e;126}127128void129mpz_realloc (mpz_t r, int n)130{131if (n <= ALLOC(r))132return;133134ALLOC(r) = n;135PTR(r) = (mp_limb_t *) realloc (PTR(r), n * sizeof (mp_limb_t));136if (PTR(r) == NULL)137{138fprintf (stderr, "Out of memory (realloc to %d)\n", n);139abort ();140}141}142143void144mpn_normalize (mp_limb_t *rp, int *rnp)145{146int rn = *rnp;147while (rn > 0 && rp[rn-1] == 0)148rn--;149*rnp = rn;150}151152void153mpn_copyi (mp_limb_t *dst, mp_limb_t *src, int n)154{155int i;156for (i = 0; i < n; i++)157dst[i] = src[i];158}159160void161mpn_zero (mp_limb_t *rp, int rn)162{163int i;164for (i = 0; i < rn; i++)165rp[i] = 0;166}167168void169mpz_init (mpz_t r)170{171ALLOC(r) = 1;172PTR(r) = xmalloc_limbs (ALLOC(r));173PTR(r)[0] = 0;174SIZ(r) = 0;175}176177void178mpz_clear (mpz_t r)179{180free (PTR (r));181ALLOC(r) = -1;182SIZ (r) = 0xbadcafeL;183PTR (r) = (mp_limb_t *) 0xdeadbeefL;184}185186int187mpz_sgn (mpz_t a)188{189return (SIZ(a) > 0 ? 1 : SIZ(a) == 0 ? 0 : -1);190}191192int193mpz_odd_p (mpz_t a)194{195if (SIZ(a) == 0)196return 0;197else198return (PTR(a)[0] & 1) != 0;199}200201int202mpz_even_p (mpz_t a)203{204if (SIZ(a) == 0)205return 1;206else207return (PTR(a)[0] & 1) == 0;208}209210size_t211mpz_sizeinbase (mpz_t a, int base)212{213int an = ABSIZ (a);214mp_limb_t *ap = PTR (a);215int cnt;216mp_limb_t hi;217218if (base != 2)219abort ();220221if (an == 0)222return 1;223224cnt = 0;225for (hi = ap[an - 1]; hi != 0; hi >>= 1)226cnt += 1;227return (an - 1) * GMP_LIMB_BITS + cnt;228}229230void231mpz_set (mpz_t r, mpz_t a)232{233mpz_realloc (r, ABSIZ (a));234SIZ(r) = SIZ(a);235mpn_copyi (PTR(r), PTR(a), ABSIZ (a));236}237238void239mpz_init_set (mpz_t r, mpz_t a)240{241mpz_init (r);242mpz_set (r, a);243}244245void246mpz_set_ui (mpz_t r, unsigned long ui)247{248int rn;249mpz_realloc (r, 2);250PTR(r)[0] = LO(ui);251PTR(r)[1] = HI(ui);252rn = 2;253mpn_normalize (PTR(r), &rn);254SIZ(r) = rn;255}256257void258mpz_init_set_ui (mpz_t r, unsigned long ui)259{260mpz_init (r);261mpz_set_ui (r, ui);262}263264void265mpz_setbit (mpz_t r, unsigned long bit)266{267int limb, rn, extend;268mp_limb_t *rp;269270rn = SIZ(r);271if (rn < 0)272abort (); /* only r>=0 */273274limb = bit / GMP_LIMB_BITS;275bit %= GMP_LIMB_BITS;276277mpz_realloc (r, limb+1);278rp = PTR(r);279extend = (limb+1) - rn;280if (extend > 0)281mpn_zero (rp + rn, extend);282283rp[limb] |= (mp_limb_t) 1 << bit;284SIZ(r) = MAX (rn, limb+1);285}286287int288mpz_tstbit (mpz_t r, unsigned long bit)289{290int limb;291292if (SIZ(r) < 0)293abort (); /* only r>=0 */294295limb = bit / GMP_LIMB_BITS;296if (SIZ(r) <= limb)297return 0;298299bit %= GMP_LIMB_BITS;300return (PTR(r)[limb] >> bit) & 1;301}302303int304popc_limb (mp_limb_t a)305{306int ret = 0;307while (a != 0)308{309ret += (a & 1);310a >>= 1;311}312return ret;313}314315unsigned long316mpz_popcount (mpz_t a)317{318unsigned long ret;319int i;320321if (SIZ(a) < 0)322abort ();323324ret = 0;325for (i = 0; i < SIZ(a); i++)326ret += popc_limb (PTR(a)[i]);327return ret;328}329330void331mpz_add (mpz_t r, mpz_t a, mpz_t b)332{333int an = ABSIZ (a), bn = ABSIZ (b), rn;334mp_limb_t *rp, *ap, *bp;335int i;336mp_limb_t t, cy;337338if ((SIZ (a) ^ SIZ (b)) < 0)339abort (); /* really subtraction */340if (SIZ (a) < 0)341abort ();342343mpz_realloc (r, MAX (an, bn) + 1);344ap = PTR (a); bp = PTR (b); rp = PTR (r);345if (an < bn)346{347mp_limb_t *tp; int tn;348tn = an; an = bn; bn = tn;349tp = ap; ap = bp; bp = tp;350}351352cy = 0;353for (i = 0; i < bn; i++)354{355t = ap[i] + bp[i] + cy;356rp[i] = LO (t);357cy = HI (t);358}359for (i = bn; i < an; i++)360{361t = ap[i] + cy;362rp[i] = LO (t);363cy = HI (t);364}365rp[an] = cy;366rn = an + 1;367368mpn_normalize (rp, &rn);369SIZ (r) = rn;370}371372void373mpz_add_ui (mpz_t r, mpz_t a, unsigned long int ui)374{375mpz_t b;376377mpz_init (b);378mpz_set_ui (b, ui);379mpz_add (r, a, b);380mpz_clear (b);381}382383void384mpz_sub (mpz_t r, mpz_t a, mpz_t b)385{386int an = ABSIZ (a), bn = ABSIZ (b), rn;387mp_limb_t *rp, *ap, *bp;388int i;389mp_limb_t t, cy;390391if ((SIZ (a) ^ SIZ (b)) < 0)392abort (); /* really addition */393if (SIZ (a) < 0)394abort ();395396mpz_realloc (r, MAX (an, bn) + 1);397ap = PTR (a); bp = PTR (b); rp = PTR (r);398if (an < bn)399{400mp_limb_t *tp; int tn;401tn = an; an = bn; bn = tn;402tp = ap; ap = bp; bp = tp;403}404405cy = 0;406for (i = 0; i < bn; i++)407{408t = ap[i] - bp[i] - cy;409rp[i] = LO (t);410cy = LO (-HI (t));411}412for (i = bn; i < an; i++)413{414t = ap[i] - cy;415rp[i] = LO (t);416cy = LO (-HI (t));417}418rp[an] = cy;419rn = an + 1;420421if (cy != 0)422{423cy = 0;424for (i = 0; i < rn; i++)425{426t = -rp[i] - cy;427rp[i] = LO (t);428cy = LO (-HI (t));429}430SIZ (r) = -rn;431return;432}433434mpn_normalize (rp, &rn);435SIZ (r) = rn;436}437438void439mpz_sub_ui (mpz_t r, mpz_t a, unsigned long int ui)440{441mpz_t b;442443mpz_init (b);444mpz_set_ui (b, ui);445mpz_sub (r, a, b);446mpz_clear (b);447}448449void450mpz_mul (mpz_t r, mpz_t a, mpz_t b)451{452int an = ABSIZ (a), bn = ABSIZ (b), rn;453mp_limb_t *scratch, *tmp, *ap = PTR (a), *bp = PTR (b);454int ai, bi;455mp_limb_t t, cy;456457scratch = xmalloc_limbs (an + bn);458tmp = scratch;459460for (bi = 0; bi < bn; bi++)461tmp[bi] = 0;462463for (ai = 0; ai < an; ai++)464{465tmp = scratch + ai;466cy = 0;467for (bi = 0; bi < bn; bi++)468{469t = ap[ai] * bp[bi] + tmp[bi] + cy;470tmp[bi] = LO (t);471cy = HI (t);472}473tmp[bn] = cy;474}475476rn = an + bn;477mpn_normalize (scratch, &rn);478free (PTR (r));479PTR (r) = scratch;480SIZ (r) = (SIZ (a) ^ SIZ (b)) >= 0 ? rn : -rn;481ALLOC (r) = an + bn;482}483484void485mpz_mul_ui (mpz_t r, mpz_t a, unsigned long int ui)486{487mpz_t b;488489mpz_init (b);490mpz_set_ui (b, ui);491mpz_mul (r, a, b);492mpz_clear (b);493}494495void496mpz_mul_2exp (mpz_t r, mpz_t a, unsigned long int bcnt)497{498mpz_set (r, a);499while (bcnt)500{501mpz_add (r, r, r);502bcnt -= 1;503}504}505506void507mpz_ui_pow_ui (mpz_t r, unsigned long b, unsigned long e)508{509unsigned long i;510mpz_t bz;511512mpz_init (bz);513mpz_set_ui (bz, b);514515mpz_set_ui (r, 1L);516for (i = 0; i < e; i++)517mpz_mul (r, r, bz);518519mpz_clear (bz);520}521522void523mpz_tdiv_q_2exp (mpz_t r, mpz_t a, unsigned long int bcnt)524{525int as, rn;526int cnt, tnc;527int lcnt;528mp_limb_t high_limb, low_limb;529int i;530531as = SIZ (a);532lcnt = bcnt / GMP_LIMB_BITS;533rn = ABS (as) - lcnt;534if (rn <= 0)535SIZ (r) = 0;536else537{538mp_limb_t *rp, *ap;539540mpz_realloc (r, rn);541542rp = PTR (r);543ap = PTR (a);544545cnt = bcnt % GMP_LIMB_BITS;546if (cnt != 0)547{548ap += lcnt;549tnc = GMP_LIMB_BITS - cnt;550high_limb = *ap++;551low_limb = high_limb >> cnt;552553for (i = rn - 1; i != 0; i--)554{555high_limb = *ap++;556*rp++ = low_limb | LO (high_limb << tnc);557low_limb = high_limb >> cnt;558}559*rp = low_limb;560rn -= low_limb == 0;561}562else563{564ap += lcnt;565mpn_copyi (rp, ap, rn);566}567568SIZ (r) = as >= 0 ? rn : -rn;569}570}571572void573mpz_tdiv_r_2exp (mpz_t r, mpz_t a, unsigned long int bcnt)574{575int rn, bwhole;576577mpz_set (r, a);578rn = ABSIZ(r);579580bwhole = bcnt / GMP_LIMB_BITS;581bcnt %= GMP_LIMB_BITS;582if (rn > bwhole)583{584rn = bwhole+1;585PTR(r)[rn-1] &= ((mp_limb_t) 1 << bcnt) - 1;586mpn_normalize (PTR(r), &rn);587SIZ(r) = (SIZ(r) >= 0 ? rn : -rn);588}589}590591int592mpz_cmp (mpz_t a, mpz_t b)593{594mp_limb_t *ap, *bp, al, bl;595int as = SIZ (a), bs = SIZ (b);596int i;597int sign;598599if (as != bs)600return as > bs ? 1 : -1;601602sign = as > 0 ? 1 : -1;603604ap = PTR (a);605bp = PTR (b);606for (i = ABS (as) - 1; i >= 0; i--)607{608al = ap[i];609bl = bp[i];610if (al != bl)611return al > bl ? sign : -sign;612}613return 0;614}615616int617mpz_cmp_ui (mpz_t a, unsigned long b)618{619mpz_t bz;620int ret;621mpz_init_set_ui (bz, b);622ret = mpz_cmp (a, bz);623mpz_clear (bz);624return ret;625}626627void628mpz_tdiv_qr (mpz_t q, mpz_t r, mpz_t a, mpz_t b)629{630mpz_t tmpr, tmpb;631unsigned long cnt;632633ASSERT (mpz_sgn(a) >= 0);634ASSERT (mpz_sgn(b) > 0);635636mpz_init_set (tmpr, a);637mpz_init_set (tmpb, b);638mpz_set_ui (q, 0L);639640if (mpz_cmp (tmpr, tmpb) > 0)641{642cnt = mpz_sizeinbase (tmpr, 2) - mpz_sizeinbase (tmpb, 2) + 1;643mpz_mul_2exp (tmpb, tmpb, cnt);644645for ( ; cnt > 0; cnt--)646{647mpz_mul_2exp (q, q, 1);648mpz_tdiv_q_2exp (tmpb, tmpb, 1L);649if (mpz_cmp (tmpr, tmpb) >= 0)650{651mpz_sub (tmpr, tmpr, tmpb);652mpz_add_ui (q, q, 1L);653ASSERT (mpz_cmp (tmpr, tmpb) < 0);654}655}656}657658mpz_set (r, tmpr);659mpz_clear (tmpr);660mpz_clear (tmpb);661}662663void664mpz_tdiv_qr_ui (mpz_t q, mpz_t r, mpz_t a, unsigned long b)665{666mpz_t bz;667mpz_init_set_ui (bz, b);668mpz_tdiv_qr (q, r, a, bz);669mpz_clear (bz);670}671672void673mpz_tdiv_q (mpz_t q, mpz_t a, mpz_t b)674{675mpz_t r;676677mpz_init (r);678mpz_tdiv_qr (q, r, a, b);679mpz_clear (r);680}681682void683mpz_tdiv_q_ui (mpz_t q, mpz_t n, unsigned long d)684{685mpz_t dz;686mpz_init_set_ui (dz, d);687mpz_tdiv_q (q, n, dz);688mpz_clear (dz);689}690691/* Set inv to the inverse of d, in the style of invert_limb, ie. for692udiv_qrnnd_preinv. */693void694mpz_preinv_invert (mpz_t inv, mpz_t d, int numb_bits)695{696mpz_t t;697int norm;698ASSERT (SIZ(d) > 0);699700norm = numb_bits - mpz_sizeinbase (d, 2);701ASSERT (norm >= 0);702mpz_init_set_ui (t, 1L);703mpz_mul_2exp (t, t, 2*numb_bits - norm);704mpz_tdiv_q (inv, t, d);705mpz_set_ui (t, 1L);706mpz_mul_2exp (t, t, numb_bits);707mpz_sub (inv, inv, t);708709mpz_clear (t);710}711712/* Remove leading '0' characters from the start of a string, by copying the713remainder down. */714void715strstrip_leading_zeros (char *s)716{717char c, *p;718719p = s;720while (*s == '0')721s++;722723do724{725c = *s++;726*p++ = c;727}728while (c != '\0');729}730731char *732mpz_get_str (char *buf, int base, mpz_t a)733{734static char tohex[] = "0123456789abcdef";735736mp_limb_t alimb, *ap;737int an, bn, i, j;738char *bp;739740if (base != 16)741abort ();742if (SIZ (a) < 0)743abort ();744745if (buf == 0)746buf = xmalloc (ABSIZ (a) * (GMP_LIMB_BITS / 4) + 3);747748an = ABSIZ (a);749if (an == 0)750{751buf[0] = '0';752buf[1] = '\0';753return buf;754}755756ap = PTR (a);757bn = an * (GMP_LIMB_BITS / 4);758bp = buf + bn;759760for (i = 0; i < an; i++)761{762alimb = ap[i];763for (j = 0; j < GMP_LIMB_BITS / 4; j++)764{765bp--;766*bp = tohex [alimb & 0xF];767alimb >>= 4;768}769ASSERT (alimb == 0);770}771ASSERT (bp == buf);772773buf[bn] = '\0';774775strstrip_leading_zeros (buf);776return buf;777}778779void780mpz_out_str (FILE *file, int base, mpz_t a)781{782char *str;783784if (file == 0)785file = stdout;786787str = mpz_get_str (0, 16, a);788fputs (str, file);789free (str);790}791792/* Calculate r satisfying r*d == 1 mod 2^n. */793void794mpz_invert_2exp (mpz_t r, mpz_t a, unsigned long n)795{796unsigned long i;797mpz_t inv, prod;798799ASSERT (mpz_odd_p (a));800801mpz_init_set_ui (inv, 1L);802mpz_init (prod);803804for (i = 1; i < n; i++)805{806mpz_mul (prod, inv, a);807if (mpz_tstbit (prod, i) != 0)808mpz_setbit (inv, i);809}810811mpz_mul (prod, inv, a);812mpz_tdiv_r_2exp (prod, prod, n);813ASSERT (mpz_cmp_ui (prod, 1L) == 0);814815mpz_set (r, inv);816817mpz_clear (inv);818mpz_clear (prod);819}820821/* Calculate inv satisfying r*a == 1 mod 2^n. */822void823mpz_invert_ui_2exp (mpz_t r, unsigned long a, unsigned long n)824{825mpz_t az;826mpz_init_set_ui (az, a);827mpz_invert_2exp (r, az, n);828mpz_clear (az);829}830831/* x=y^z */832void833mpz_pow_ui (mpz_t x, mpz_t y, unsigned long z)834{835mpz_t t;836837mpz_init_set_ui (t, 1);838for (; z != 0; z--)839mpz_mul (t, t, y);840mpz_set (x, t);841mpz_clear (t);842}843844/* x=x+y*z */845void846mpz_addmul_ui (mpz_t x, mpz_t y, unsigned long z)847{848mpz_t t;849850mpz_init (t);851mpz_mul_ui (t, y, z);852mpz_add (x, x, t);853mpz_clear (t);854}855856/* x=floor(y^(1/z)) */857void858mpz_root (mpz_t x, mpz_t y, unsigned long z)859{860mpz_t t, u;861862if (mpz_sgn (y) < 0)863{864fprintf (stderr, "mpz_root does not accept negative values\n");865abort ();866}867if (mpz_cmp_ui (y, 1) <= 0)868{869mpz_set (x, y);870return;871}872mpz_init (t);873mpz_init_set (u, y);874do875{876mpz_pow_ui (t, u, z - 1);877mpz_tdiv_q (t, y, t);878mpz_addmul_ui (t, u, z - 1);879mpz_tdiv_q_ui (t, t, z);880if (mpz_cmp (t, u) >= 0)881break;882mpz_set (u, t);883}884while (1);885mpz_set (x, u);886mpz_clear (t);887mpz_clear (u);888}889890891