Testing latest pari + WASM + node.js... and it works?! Wow.
License: GPL3
ubuntu2004
#line 2 "../src/kernel/none/mp_indep.c"1/* Copyright (C) 2000 The PARI group.23This file is part of the PARI/GP package.45PARI/GP is free software; you can redistribute it and/or modify it under the6terms of the GNU General Public License as published by the Free Software7Foundation; either version 2 of the License, or (at your option) any later8version. It is distributed in the hope that it will be useful, but WITHOUT9ANY WARRANTY WHATSOEVER.1011Check the License for details. You should have received a copy of it, along12with the package; see the file 'COPYING'. If not, write to the Free Software13Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */1415/* Find c such that 1=c*b mod 2^BITS_IN_LONG, assuming b odd (unchecked) */16ulong17invmod2BIL(ulong b)18{19static int tab[] = { 0, 0, 0, 8, 0, 8, 0, 0 };20ulong x = b + tab[b & 7]; /* b^(-1) mod 2^4 */2122/* Newton applied to 1/x - b = 0 */23#ifdef LONG_IS_64BIT24x = x*(2-b*x); /* one more pass necessary */25#endif26x = x*(2-b*x);27x = x*(2-b*x); return x*(2-b*x);28}2930void31affrr(GEN x, GEN y)32{33long i, lx, ly = lg(y);34if (!signe(x))35{36y[1] = evalexpo(minss(expo(x), -bit_accuracy(ly)));37return;38}39y[1] = x[1]; lx = lg(x);40if (lx <= ly)41{42for (i=2; i<lx; i++) y[i]=x[i];43for ( ; i<ly; i++) y[i]=0;44return;45}46for (i=2; i<ly; i++) y[i]=x[i];47/* lx > ly: round properly */48if (x[ly] & HIGHBIT) roundr_up_ip(y, ly);49}5051GEN52trunc2nr(GEN x, long n)53{54long ex;55if (!signe(x)) return gen_0;56ex = expo(x) + n; if (ex < 0) return gen_0;57return mantissa2nr(x, ex - bit_prec(x) + 1);58}5960/* x a t_REAL, x = i/2^e, i a t_INT */61GEN62mantissa_real(GEN x, long *e)63{64*e = bit_prec(x)-1-expo(x);65return mantissa2nr(x, 0);66}6768GEN69mului(ulong x, GEN y)70{71long s = signe(y);72GEN z;7374if (!s || !x) return gen_0;75z = muluispec(x, y+2, lgefint(y)-2);76setsigne(z,s); return z;77}7879GEN80mulsi(long x, GEN y)81{82long s = signe(y);83GEN z;8485if (!s || !x) return gen_0;86if (x<0) { s = -s; x = -x; }87z = muluispec((ulong)x, y+2, lgefint(y)-2);88setsigne(z,s); return z;89}9091GEN92mulss(long x, long y)93{94long p1;95LOCAL_HIREMAINDER;9697if (!x || !y) return gen_0;98if (x<0) {99x = -x;100if (y<0) { y = -y; p1 = mulll(x,y); return uutoi(hiremainder, p1); }101p1 = mulll(x,y); return uutoineg(hiremainder, p1);102} else {103if (y<0) { y = -y; p1 = mulll(x,y); return uutoineg(hiremainder, p1); }104p1 = mulll(x,y); return uutoi(hiremainder, p1);105}106}107GEN108sqrs(long x)109{110long p1;111LOCAL_HIREMAINDER;112113if (!x) return gen_0;114if (x<0) x = -x;115p1 = mulll(x,x); return uutoi(hiremainder, p1);116}117GEN118muluu(ulong x, ulong y)119{120long p1;121LOCAL_HIREMAINDER;122123if (!x || !y) return gen_0;124p1 = mulll(x,y); return uutoi(hiremainder, p1);125}126GEN127sqru(ulong x)128{129long p1;130LOCAL_HIREMAINDER;131132if (!x) return gen_0;133p1 = mulll(x,x); return uutoi(hiremainder, p1);134}135136/* assume x > 1, y != 0. Return u * y with sign s */137static GEN138mulur_2(ulong x, GEN y, long s)139{140long m, sh, i, lx = lg(y), e = expo(y);141GEN z = cgetr(lx);142ulong garde;143LOCAL_HIREMAINDER;144145y--; garde = mulll(x,y[lx]);146for (i=lx-1; i>=3; i--) z[i]=addmul(x,y[i]);147z[2]=hiremainder; /* != 0 since y normalized and |x| > 1 */148sh = bfffo(hiremainder); m = BITS_IN_LONG-sh;149if (sh) shift_left(z,z, 2,lx-1, garde,sh);150z[1] = evalsigne(s) | evalexpo(m+e);151if ((garde << sh) & HIGHBIT) roundr_up_ip(z, lx);152return z;153}154155INLINE GEN156mul0r(GEN x)157{158long l = lg(x), e = expo(x);159e = (l > 2)? -prec2nbits(l) + e: (e < 0? 2*e: 0);160return real_0_bit(e);161}162/* lg(x) > 2 */163INLINE GEN164div0r(GEN x) {165long l = lg(x), e = expo(x);166return real_0_bit(-prec2nbits(l) - e);167}168169GEN170mulsr(long x, GEN y)171{172long s;173174if (!x) return mul0r(y);175s = signe(y);176if (!s)177{178if (x < 0) x = -x;179return real_0_bit( expo(y) + expu(x) );180}181if (x==1) return rcopy(y);182if (x==-1) return negr(y);183if (x < 0)184return mulur_2((ulong)-x, y, -s);185else186return mulur_2((ulong)x, y, s);187}188189GEN190mulur(ulong x, GEN y)191{192long s;193194if (!x) return mul0r(y);195s = signe(y);196if (!s) return real_0_bit( expo(y) + expu(x) );197if (x==1) return rcopy(y);198return mulur_2(x, y, s);199}200201INLINE void202mulrrz_end(GEN z, GEN hi, long lz, long sz, long ez, ulong garde)203{204long i;205if (hi[2] < 0)206{207if (z != hi)208for (i=2; i<lz ; i++) z[i] = hi[i];209ez++;210}211else212{213shift_left(z,hi,2,lz-1, garde, 1);214garde <<= 1;215}216if (garde & HIGHBIT)217{ /* round to nearest */218i = lz; do ((ulong*)z)[--i]++; while (i>1 && z[i]==0);219if (i == 1) { z[2] = (long)HIGHBIT; ez++; }220}221z[1] = evalsigne(sz)|evalexpo(ez);222}223/* mulrrz_end for lz = 3, minor simplifications. z[2]=hiremainder from mulll */224INLINE void225mulrrz_3end(GEN z, long sz, long ez, ulong garde)226{227if (z[2] < 0)228{ /* z2 < (2^BIL-1)^2 / 2^BIL, hence z2+1 != 0 */229if (garde & HIGHBIT) z[2]++; /* round properly */230ez++;231}232else233{234uel(z,2) = (uel(z,2)<<1) | (garde>>(BITS_IN_LONG-1));235if (garde & (1UL<<(BITS_IN_LONG-2)))236{237uel(z,2)++; /* round properly, z2+1 can overflow */238if (!uel(z,2)) { uel(z,2) = HIGHBIT; ez++; }239}240}241z[1] = evalsigne(sz)|evalexpo(ez);242}243244/* set z <-- x^2 != 0, floating point multiplication.245* lz = lg(z) = lg(x) */246INLINE void247sqrz_i(GEN z, GEN x, long lz)248{249long ez = 2*expo(x);250long i, j, lzz, p1;251ulong garde;252GEN x1;253LOCAL_HIREMAINDER;254LOCAL_OVERFLOW;255256if (lz > SQRR_SQRI_LIMIT)257{258pari_sp av = avma;259GEN hi = sqrispec_mirror(x+2, lz-2);260mulrrz_end(z, hi, lz, 1, ez, hi[lz]);261set_avma(av); return;262}263if (lz == 3)264{265garde = mulll(x[2],x[2]);266z[2] = hiremainder;267mulrrz_3end(z, 1, ez, garde);268return;269}270271lzz = lz-1; p1 = x[lzz];272if (p1)273{274(void)mulll(p1,x[3]);275garde = addmul(p1,x[2]);276z[lzz] = hiremainder;277}278else279{280garde = 0;281z[lzz] = 0;282}283for (j=lz-2, x1=x-j; j>=3; j--)284{285p1 = x[j]; x1++;286if (p1)287{288(void)mulll(p1,x1[lz+1]);289garde = addll(addmul(p1,x1[lz]), garde);290for (i=lzz; i>j; i--)291{292hiremainder += overflow;293z[i] = addll(addmul(p1,x1[i]), z[i]);294}295z[j] = hiremainder+overflow;296}297else z[j]=0;298}299p1 = x[2]; x1++;300garde = addll(mulll(p1,x1[lz]), garde);301for (i=lzz; i>2; i--)302{303hiremainder += overflow;304z[i] = addll(addmul(p1,x1[i]), z[i]);305}306z[2] = hiremainder+overflow;307mulrrz_end(z, z, lz, 1, ez, garde);308}309310/* lz "large" = lg(y) = lg(z), lg(x) > lz if flag = 1 and >= if flag = 0 */311INLINE void312mulrrz_int(GEN z, GEN x, GEN y, long lz, long flag, long sz)313{314pari_sp av = avma;315GEN hi = muliispec_mirror(y+2, x+2, lz+flag-2, lz-2);316mulrrz_end(z, hi, lz, sz, expo(x)+expo(y), hi[lz]);317set_avma(av);318}319320/* lz = 3 */321INLINE void322mulrrz_3(GEN z, GEN x, GEN y, long flag, long sz)323{324ulong garde;325LOCAL_HIREMAINDER;326if (flag)327{328(void)mulll(x[2],y[3]);329garde = addmul(x[2],y[2]);330}331else332garde = mulll(x[2],y[2]);333z[2] = hiremainder;334mulrrz_3end(z, sz, expo(x)+expo(y), garde);335}336337/* set z <-- x*y, floating point multiplication. Trailing 0s for x are338* treated efficiently (important application: mulir).339* lz = lg(z) = lg(x) <= ly <= lg(y), sz = signe(z). flag = lg(x) < lg(y) */340INLINE void341mulrrz_i(GEN z, GEN x, GEN y, long lz, long flag, long sz)342{343long ez, i, j, lzz, p1;344ulong garde;345GEN y1;346LOCAL_HIREMAINDER;347LOCAL_OVERFLOW;348349if (x == y) { sqrz_i(z,x,lz); return; }350if (lz > MULRR_MULII_LIMIT) { mulrrz_int(z,x,y,lz,flag,sz); return; }351if (lz == 3) { mulrrz_3(z,x,y,flag,sz); return; }352ez = expo(x) + expo(y);353if (flag) { (void)mulll(x[2],y[lz]); garde = hiremainder; } else garde = 0;354lzz=lz-1; p1=x[lzz];355if (p1)356{357(void)mulll(p1,y[3]);358garde = addll(addmul(p1,y[2]), garde);359z[lzz] = overflow+hiremainder;360}361else z[lzz]=0;362for (j=lz-2, y1=y-j; j>=3; j--)363{364p1 = x[j]; y1++;365if (p1)366{367(void)mulll(p1,y1[lz+1]);368garde = addll(addmul(p1,y1[lz]), garde);369for (i=lzz; i>j; i--)370{371hiremainder += overflow;372z[i] = addll(addmul(p1,y1[i]), z[i]);373}374z[j] = hiremainder+overflow;375}376else z[j]=0;377}378p1 = x[2]; y1++;379garde = addll(mulll(p1,y1[lz]), garde);380for (i=lzz; i>2; i--)381{382hiremainder += overflow;383z[i] = addll(addmul(p1,y1[i]), z[i]);384}385z[2] = hiremainder+overflow;386mulrrz_end(z, z, lz, sz, ez, garde);387}388389GEN390mulrr(GEN x, GEN y)391{392long flag, ly, lz, sx, sy;393GEN z;394395if (x == y) return sqrr(x);396sx = signe(x); if (!sx) return real_0_bit(expo(x) + expo(y));397sy = signe(y); if (!sy) return real_0_bit(expo(x) + expo(y));398if (sy < 0) sx = -sx;399lz = lg(x);400ly = lg(y);401if (lz > ly) { lz = ly; swap(x, y); flag = 1; } else flag = (lz != ly);402z = cgetr(lz);403mulrrz_i(z, x,y, lz,flag, sx);404return z;405}406407GEN408sqrr(GEN x)409{410long lz, sx = signe(x);411GEN z;412413if (!sx) return real_0_bit(2*expo(x));414lz = lg(x); z = cgetr(lz);415sqrz_i(z, x, lz);416return z;417}418419GEN420mulir(GEN x, GEN y)421{422long sx = signe(x), sy;423if (!sx) return mul0r(y);424if (lgefint(x) == 3) {425GEN z = mulur(uel(x,2), y);426if (sx < 0) togglesign(z);427return z;428}429sy = signe(y);430if (!sy) return real_0_bit(expi(x) + expo(y));431if (sy < 0) sx = -sx;432{433long lz = lg(y), lx = lgefint(x);434GEN hi, z = cgetr(lz);435pari_sp av = avma;436if (lx < (lz>>1) || (lx < lz && lz > MULRR_MULII_LIMIT))437{ /* size mantissa of x < half size of mantissa z, or lx < lz so large438* that mulrr will call mulii anyway: mulii */439x = itor(x, lx);440hi = muliispec_mirror(y+2, x+2, lz-2, lx-2);441mulrrz_end(z, hi, lz, sx, expo(x)+expo(y), hi[lz]);442}443else /* dubious: complete x with 0s and call mulrr */444mulrrz_i(z, itor(x,lz), y, lz, 0, sx);445set_avma(av); return z;446}447}448449/* x + y*z, generic. If lgefint(z) <= 3, caller should use faster variants */450static GEN451addmulii_gen(GEN x, GEN y, GEN z, long lz)452{453long lx = lgefint(x), ly;454pari_sp av;455GEN t;456if (lx == 2) return mulii(z,y);457ly = lgefint(y);458if (ly == 2) return icopy(x); /* y = 0, wasteful copy */459av = avma; (void)new_chunk(lx+ly+lz); /*HACK*/460t = mulii(z, y);461set_avma(av); return addii(t,x);462}463/* x + y*z, lgefint(z) == 3 */464static GEN465addmulii_lg3(GEN x, GEN y, GEN z)466{467long s = signe(z), lx, ly;468ulong w = z[2];469pari_sp av;470GEN t;471if (w == 1) return (s > 0)? addii(x,y): subii(x,y); /* z = +- 1 */472lx = lgefint(x);473ly = lgefint(y);474if (lx == 2)475{ /* x = 0 */476if (ly == 2) return gen_0;477t = muluispec(w, y+2, ly-2);478if (signe(y) < 0) s = -s;479setsigne(t, s); return t;480}481if (ly == 2) return icopy(x); /* y = 0, wasteful copy */482av = avma; (void)new_chunk(1+lx+ly);/*HACK*/483t = muluispec(w, y+2, ly-2);484if (signe(y) < 0) s = -s;485setsigne(t, s);486set_avma(av); return addii(x,t);487}488/* x + y*z */489GEN490addmulii(GEN x, GEN y, GEN z)491{492long lz = lgefint(z);493switch(lz)494{495case 2: return icopy(x); /* z = 0, wasteful copy */496case 3: return addmulii_lg3(x, y, z);497default:return addmulii_gen(x, y, z, lz);498}499}500/* x + y*z, returns x itself and not a copy when y*z = 0 */501GEN502addmulii_inplace(GEN x, GEN y, GEN z)503{504long lz;505if (lgefint(y) == 2) return x;506lz = lgefint(z);507switch(lz)508{509case 2: return x;510case 3: return addmulii_lg3(x, y, z);511default:return addmulii_gen(x, y, z, lz);512}513}514515/* written by Bruno Haible following an idea of Robert Harley */516long517vals(ulong z)518{519static char tab[64]={-1,0,1,12,2,6,-1,13,3,-1,7,-1,-1,-1,-1,14,10,4,-1,-1,8,-1,-1,25,-1,-1,-1,-1,-1,21,27,15,31,11,5,-1,-1,-1,-1,-1,9,-1,-1,24,-1,-1,20,26,30,-1,-1,-1,-1,23,-1,19,29,-1,22,18,28,17,16,-1};520#ifdef LONG_IS_64BIT521long s;522#endif523524if (!z) return -1;525#ifdef LONG_IS_64BIT526if (! (z&0xffffffff)) { s = 32; z >>=32; } else s = 0;527#endif528z |= ~z + 1;529z += z << 4;530z += z << 6;531z ^= z << 16; /* or z -= z<<16 */532#ifdef LONG_IS_64BIT533return s + tab[(z&0xffffffff)>>26];534#else535return tab[z>>26];536#endif537}538539GEN540divsi(long x, GEN y)541{542long p1, s = signe(y);543LOCAL_HIREMAINDER;544545if (!s) pari_err_INV("divsi",gen_0);546if (!x || lgefint(y)>3 || ((long)y[2])<0) return gen_0;547hiremainder=0; p1=divll(labs(x),y[2]);548if (x<0) { hiremainder = -((long)hiremainder); p1 = -p1; }549if (s<0) p1 = -p1;550return stoi(p1);551}552553GEN554divir(GEN x, GEN y)555{556GEN z;557long ly = lg(y), lx = lgefint(x);558pari_sp av;559560if (ly == 2) pari_err_INV("divir",y);561if (lx == 2) return div0r(y);562if (lx == 3) {563z = divur(x[2], y);564if (signe(x) < 0) togglesign(z);565return z;566}567z = cgetr(ly); av = avma;568affrr(divrr(itor(x, ly+1), y), z);569set_avma(av); return z;570}571572GEN573divur(ulong x, GEN y)574{575pari_sp av;576long ly = lg(y);577GEN z;578579if (ly == 2) pari_err_INV("divur",y);580if (!x) return div0r(y);581if (ly > INVNEWTON_LIMIT) {582av = avma; z = invr(y);583if (x == 1) return z;584return gerepileuptoleaf(av, mulur(x, z));585}586z = cgetr(ly); av = avma;587affrr(divrr(utor(x,ly+1), y), z);588set_avma(av); return z;589}590591GEN592divsr(long x, GEN y)593{594pari_sp av;595long ly = lg(y);596GEN z;597598if (ly == 2) pari_err_INV("divsr",y);599if (!x) return div0r(y);600if (ly > INVNEWTON_LIMIT) {601av = avma; z = invr(y);602if (x == 1) return z;603if (x ==-1) { togglesign(z); return z; }604return gerepileuptoleaf(av, mulsr(x, z));605}606z = cgetr(ly); av = avma;607affrr(divrr(stor(x,ly+1), y), z);608set_avma(av); return z;609}610611/* returns 1/y, assume y != 0 */612static GEN613invr_basecase(GEN y)614{615long ly = lg(y);616GEN z = cgetr(ly);617pari_sp av = avma;618affrr(divrr(real_1(ly+1), y), z);619set_avma(av); return z;620}621/* returns 1/b, Newton iteration */622GEN623invr(GEN b)624{625const long s = 6;626long i, p, l = lg(b);627GEN x, a;628ulong mask;629630if (l <= maxss(INVNEWTON_LIMIT, (1L<<s) + 2)) {631if (l == 2) pari_err_INV("invr",b);632return invr_basecase(b);633}634mask = quadratic_prec_mask(l-2);635for(i=0, p=1; i<s; i++) { p <<= 1; if (mask & 1) p--; mask >>= 1; }636x = cgetr(l);637a = rcopy(b); a[1] = _evalexpo(0) | evalsigne(1);638affrr(invr_basecase(rtor(a, p+2)), x);639while (mask > 1)640{641p <<= 1; if (mask & 1) p--;642mask >>= 1;643setlg(a, p + 2);644setlg(x, p + 2);645/* TODO: mulrr(a,x) should be a half product (the higher half is known).646* mulrr(x, ) already is */647affrr(addrr(x, mulrr(x, subsr(1, mulrr(a,x)))), x);648set_avma((pari_sp)a);649}650x[1] = (b[1] & SIGNBITS) | evalexpo(expo(x)-expo(b));651set_avma((pari_sp)x); return x;652}653654GEN655modii(GEN x, GEN y)656{657switch(signe(x))658{659case 0: return gen_0;660case 1: return remii(x,y);661default:662{663pari_sp av = avma;664(void)new_chunk(lgefint(y));665x = remii(x,y); set_avma(av);666if (x==gen_0) return x;667return subiispec(y+2,x+2,lgefint(y)-2,lgefint(x)-2);668}669}670}671672void673modiiz(GEN x, GEN y, GEN z)674{675const pari_sp av = avma;676affii(modii(x,y),z); set_avma(av);677}678679GEN680divrs(GEN x, long y)681{682GEN z;683if (y < 0)684{685z = divru(x, (ulong)-y);686togglesign(z);687}688else689z = divru(x, (ulong)y);690return z;691}692693GEN694divru(GEN x, ulong y)695{696long i, lx, sh, e, s = signe(x);697ulong garde;698GEN z;699LOCAL_HIREMAINDER;700701if (!y) pari_err_INV("divru",gen_0);702if (!s) return real_0_bit(expo(x) - expu(y));703if (!(y & (y-1))) /* power of 2 */704{705if (y == 1) return rcopy(x);706return shiftr(x, -expu(y));707}708e = expo(x);709lx = lg(x);710z = cgetr(lx);711if (lx == 3)712{713if (y <= uel(x,2))714{715hiremainder = 0;716z[2] = divll(x[2],y);717/* we may have hiremainder != 0 ==> garde */718garde = divll(0,y);719}720else721{722hiremainder = x[2];723z[2] = divll(0,y);724garde = hiremainder;725e -= BITS_IN_LONG;726}727}728else729{730ulong yp = get_Fl_red(y);731if (y <= uel(x,2))732{733hiremainder = 0;734for (i=2; i<lx; i++) z[i] = divll_pre(x[i],y,yp);735/* we may have hiremainder != 0 ==> garde */736garde = divll_pre(0,y,yp);737}738else739{740long l = lx-1;741hiremainder = x[2];742for (i=2; i<l; i++) z[i] = divll_pre(x[i+1],y,yp);743z[i] = divll_pre(0,y,yp);744garde = hiremainder;745e -= BITS_IN_LONG;746}747}748sh=bfffo(z[2]); /* z[2] != 0 */749if (sh) shift_left(z,z, 2,lx-1, garde,sh);750z[1] = evalsigne(s) | evalexpo(e-sh);751if ((garde << sh) & HIGHBIT) roundr_up_ip(z, lx);752return z;753}754755GEN756truedvmdii(GEN x, GEN y, GEN *z)757{758pari_sp av;759GEN r, q, *gptr[2];760if (!is_bigint(y)) return truedvmdis(x, itos(y), z);761if (z == ONLY_REM) return modii(x,y);762763av = avma;764q = dvmdii(x,y,&r); /* assume that r is last on stack */765switch(signe(r))766{767case 0:768if (z) *z = gen_0;769return q;770case 1:771if (z) *z = r; else cgiv(r);772return q;773case -1: break;774}775q = addis(q, -signe(y));776if (!z) return gerepileuptoint(av, q);777778*z = subiispec(y+2,r+2, lgefint(y)-2,lgefint(r)-2);779gptr[0]=&q; gptr[1]=z; gerepilemanysp(av,(pari_sp)r,gptr,2);780return q;781}782GEN783truedvmdis(GEN x, long y, GEN *z)784{785pari_sp av = avma;786long r;787GEN q;788789if (z == ONLY_REM) return modis(x, y);790q = divis_rem(x,y,&r);791792if (r >= 0)793{794if (z) *z = utoi(r);795return q;796}797q = gerepileuptoint(av, addis(q, (y < 0)? 1: -1));798if (z) *z = utoi(r + labs(y));799return q;800}801GEN802truedvmdsi(long x, GEN y, GEN *z)803{804long q, r;805if (z == ONLY_REM) return modsi(x, y);806q = sdivsi_rem(x,y,&r);807if (r >= 0) {808if (z) *z = utoi(r);809return stoi(q);810}811q = q - signe(y);812if (!z) return stoi(q);813814*z = subiuspec(y+2,(ulong)-r, lgefint(y)-2);815return stoi(q);816}817818/* 2^n = shifti(gen_1, n) */819GEN820int2n(long n) {821long i, m, l;822GEN z;823if (n < 0) return gen_0;824if (n == 0) return gen_1;825826l = dvmdsBIL(n, &m) + 3;827z = cgetipos(l);828for (i = 2; i < l; i++) z[i] = 0;829*int_MSW(z) = 1UL << m; return z;830}831/* To avoid problems when 2^(BIL-1) < n. Overflow cleanly, where int2n832* returns gen_0 */833GEN834int2u(ulong n) {835ulong i, m, l;836GEN z;837if (n == 0) return gen_1;838839l = dvmduBIL(n, &m) + 3;840z = cgetipos(l);841for (i = 2; i < l; i++) z[i] = 0;842*int_MSW(z) = 1UL << m; return z;843}844/* 2^n - 1 */845GEN846int2um1(ulong n) {847ulong i, m, l;848GEN z;849if (n == 0) return gen_0;850851l = dvmduBIL(n, &m);852l += m? 3: 2;853z = cgetipos(l);854for (i = 2; i < l; i++) z[i] = ~0UL;855if (m) *int_MSW(z) = (1UL << m) - 1;856return z;857}858859GEN860shifti(GEN x, long n)861{862long s = signe(x);863GEN y;864865if(s == 0) return gen_0;866y = shiftispec(x + 2, lgefint(x) - 2, n);867if (signe(y)) setsigne(y, s);868return y;869}870871/* actual operations will take place on a+2 and b+2: we strip the codewords */872GEN873mulii(GEN a,GEN b)874{875long sa,sb;876GEN z;877878sa=signe(a); if (!sa) return gen_0;879sb=signe(b); if (!sb) return gen_0;880if (sb<0) sa = -sa;881z = muliispec(a+2,b+2, lgefint(a)-2,lgefint(b)-2);882setsigne(z,sa); return z;883}884885GEN886sqri(GEN a) { return sqrispec(a+2, lgefint(a)-2); }887888/* sqrt()'s result may be off by 1 when a is not representable exactly as a889* double [64bit machine] */890ulong891usqrt(ulong a)892{893ulong x = (ulong)sqrt((double)a);894#ifdef LONG_IS_64BIT895if (x > LOWMASK || x*x > a) x--;896#endif897return x;898}899900/********************************************************************/901/** **/902/** EXPONENT / CONVERSION t_REAL --> double **/903/** **/904/********************************************************************/905906#ifdef LONG_IS_64BIT907long908dblexpo(double x)909{910union { double f; ulong i; } fi;911const int mant_len = 52; /* mantissa bits (excl. hidden bit) */912const int exp_mid = 0x3ff;/* exponent bias */913914if (x==0.) return -exp_mid;915fi.f = x;916return ((fi.i & (HIGHBIT-1)) >> mant_len) - exp_mid;917}918919ulong920dblmantissa(double x)921{922union { double f; ulong i; } fi;923const int expo_len = 11; /* number of bits of exponent */924925if (x==0.) return 0;926fi.f = x;927return (fi.i << expo_len) | HIGHBIT;928}929930GEN931dbltor(double x)932{933GEN z;934long e;935union { double f; ulong i; } fi;936const int mant_len = 52; /* mantissa bits (excl. hidden bit) */937const int exp_mid = 0x3ff;/* exponent bias */938const int expo_len = 11; /* number of bits of exponent */939940if (x==0.) return real_0_bit(-exp_mid);941fi.f = x; z = cgetr(DEFAULTPREC);942{943const ulong a = fi.i;944ulong A;945e = ((a & (HIGHBIT-1)) >> mant_len) - exp_mid;946if (e == exp_mid+1) pari_err_OVERFLOW("dbltor [NaN or Infinity]");947A = a << expo_len;948if (e == -exp_mid)949{ /* unnormalized values */950int sh = bfffo(A);951e -= sh-1;952z[2] = A << sh;953}954else955z[2] = HIGHBIT | A;956z[1] = _evalexpo(e) | evalsigne(x<0? -1: 1);957}958return z;959}960961double962rtodbl(GEN x)963{964long ex,s=signe(x);965ulong a;966union { double f; ulong i; } fi;967const int mant_len = 52; /* mantissa bits (excl. hidden bit) */968const int exp_mid = 0x3ff;/* exponent bias */969const int expo_len = 11; /* number of bits of exponent */970971if (!s || (ex=expo(x)) < - exp_mid) return 0.0;972973/* start by rounding to closest */974a = (x[2] & (HIGHBIT-1)) + 0x400;975if (a & HIGHBIT) { ex++; a=0; }976if (ex >= exp_mid) pari_err_OVERFLOW("t_REAL->double conversion");977fi.i = ((ex + exp_mid) << mant_len) | (a >> expo_len);978if (s<0) fi.i |= HIGHBIT;979return fi.f;980}981982#else /* LONG_IS_64BIT */983984#if PARI_DOUBLE_FORMAT == 1985# define INDEX0 1986# define INDEX1 0987#elif PARI_DOUBLE_FORMAT == 0988# define INDEX0 0989# define INDEX1 1990#endif991992long993dblexpo(double x)994{995union { double f; ulong i[2]; } fi;996const int mant_len = 52; /* mantissa bits (excl. hidden bit) */997const int exp_mid = 0x3ff;/* exponent bias */998const int shift = mant_len-32;9991000if (x==0.) return -exp_mid;1001fi.f = x;1002{1003const ulong a = fi.i[INDEX0];1004return ((a & (HIGHBIT-1)) >> shift) - exp_mid;1005}1006}10071008ulong1009dblmantissa(double x)1010{1011union { double f; ulong i[2]; } fi;1012const int expo_len = 11; /* number of bits of exponent */10131014if (x==0.) return 0;1015fi.f = x;1016{1017const ulong a = fi.i[INDEX0];1018const ulong b = fi.i[INDEX1];1019return HIGHBIT | b >> (BITS_IN_LONG-expo_len) | (a << expo_len);1020}1021}10221023GEN1024dbltor(double x)1025{1026GEN z;1027long e;1028union { double f; ulong i[2]; } fi;1029const int mant_len = 52; /* mantissa bits (excl. hidden bit) */1030const int exp_mid = 0x3ff;/* exponent bias */1031const int expo_len = 11; /* number of bits of exponent */1032const int shift = mant_len-32;10331034if (x==0.) return real_0_bit(-exp_mid);1035fi.f = x; z = cgetr(DEFAULTPREC);1036{1037const ulong a = fi.i[INDEX0];1038const ulong b = fi.i[INDEX1];1039ulong A, B;1040e = ((a & (HIGHBIT-1)) >> shift) - exp_mid;1041if (e == exp_mid+1) pari_err_OVERFLOW("dbltor [NaN or Infinity]");1042A = b >> (BITS_IN_LONG-expo_len) | (a << expo_len);1043B = b << expo_len;1044if (e == -exp_mid)1045{ /* unnormalized values */1046int sh;1047if (A)1048{1049sh = bfffo(A);1050e -= sh-1;1051z[2] = (A << sh) | (B >> (32-sh));1052z[3] = B << sh;1053}1054else1055{1056sh = bfffo(B); /* B != 0 */1057e -= sh-1 + 32;1058z[2] = B << sh;1059z[3] = 0;1060}1061}1062else1063{1064z[3] = B;1065z[2] = HIGHBIT | A;1066}1067z[1] = _evalexpo(e) | evalsigne(x<0? -1: 1);1068}1069return z;1070}10711072double1073rtodbl(GEN x)1074{1075long ex,s=signe(x),lx=lg(x);1076ulong a,b,k;1077union { double f; ulong i[2]; } fi;1078const int mant_len = 52; /* mantissa bits (excl. hidden bit) */1079const int exp_mid = 0x3ff;/* exponent bias */1080const int expo_len = 11; /* number of bits of exponent */1081const int shift = mant_len-32;10821083if (!s || (ex=expo(x)) < - exp_mid) return 0.0;10841085/* start by rounding to closest */1086a = x[2] & (HIGHBIT-1);1087if (lx > 3)1088{1089b = x[3] + 0x400UL; if (b < 0x400UL) a++;1090if (a & HIGHBIT) { ex++; a=0; }1091}1092else b = 0;1093if (ex >= exp_mid) pari_err_OVERFLOW("t_REAL->double conversion");1094ex += exp_mid;1095k = (a >> expo_len) | (ex << shift);1096if (s<0) k |= HIGHBIT;1097fi.i[INDEX0] = k;1098fi.i[INDEX1] = (a << (BITS_IN_LONG-expo_len)) | (b >> expo_len);1099return fi.f;1100}1101#endif /* LONG_IS_64BIT */1102110311041105