GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
/* __gmp_extract_double -- convert from double to array of mp_limb_t.12Copyright 1996, 1999, 2000, 2001, 2002, 2006 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. */2021#include "gmp.h"22#include "gmp-impl.h"2324#ifdef XDEBUG25#undef _GMP_IEEE_FLOATS26#endif2728#ifndef _GMP_IEEE_FLOATS29#define _GMP_IEEE_FLOATS 030#endif3132#define BITS_IN_MANTISSA 533334/* Extract a non-negative double in d. */3536int37__gmp_extract_double (mp_ptr rp, double d)38{39long exp;40unsigned sc;41#ifdef _LONG_LONG_LIMB42#define BITS_PER_PART 64 /* somewhat bogus */43unsigned long long int manl;44#else45#define BITS_PER_PART GMP_LIMB_BITS46unsigned long int manh, manl;47#endif4849/* BUGS50511. Should handle Inf and NaN in IEEE specific code.522. Handle Inf and NaN also in default code, to avoid hangs.533. Generalize to handle all GMP_LIMB_BITS >= 32.544. This lits is incomplete and misspelled.55*/5657ASSERT (d >= 0.0);5859if (d == 0.0)60{61MPN_ZERO (rp, LIMBS_PER_DOUBLE);62return 0;63}6465#if _GMP_IEEE_FLOATS66{67#if defined (__alpha) && __GNUC__ == 2 && __GNUC_MINOR__ == 868/* Work around alpha-specific bug in GCC 2.8.x. */69volatile70#endif71union ieee_double_extract x;72x.d = d;73exp = x.s.exp;74#if BITS_PER_PART == 64 /* generalize this to BITS_PER_PART > BITS_IN_MANTISSA */75manl = (((mp_limb_t) 1 << 63)76| ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11));77if (exp == 0)78{79/* Denormalized number. Don't try to be clever about this,80since it is not an important case to make fast. */81exp = 1;82do83{84manl = manl << 1;85exp--;86}87while ((manl & GMP_LIMB_HIGHBIT) == 0);88}89#endif90#if BITS_PER_PART == 3291manh = ((mp_limb_t) 1 << 31) | (x.s.manh << 11) | (x.s.manl >> 21);92manl = x.s.manl << 11;93if (exp == 0)94{95/* Denormalized number. Don't try to be clever about this,96since it is not an important case to make fast. */97exp = 1;98do99{100manh = (manh << 1) | (manl >> 31);101manl = manl << 1;102exp--;103}104while ((manh & GMP_LIMB_HIGHBIT) == 0);105}106#endif107#if BITS_PER_PART != 32 && BITS_PER_PART != 64108You need to generalize the code above to handle this.109#endif110exp -= 1022; /* Remove IEEE bias. */111}112#else113{114/* Unknown (or known to be non-IEEE) double format. */115exp = 0;116if (d >= 1.0)117{118ASSERT_ALWAYS (d * 0.5 != d);119120while (d >= 32768.0)121{122d *= (1.0 / 65536.0);123exp += 16;124}125while (d >= 1.0)126{127d *= 0.5;128exp += 1;129}130}131else if (d < 0.5)132{133while (d < (1.0 / 65536.0))134{135d *= 65536.0;136exp -= 16;137}138while (d < 0.5)139{140d *= 2.0;141exp -= 1;142}143}144145d *= (4.0 * ((unsigned long int) 1 << (BITS_PER_PART - 2)));146#if BITS_PER_PART == 64147manl = d;148#else149manh = d;150manl = (d - manh) * (4.0 * ((unsigned long int) 1 << (BITS_PER_PART - 2)));151#endif152}153#endif /* IEEE */154155/* Up until here, we have ignored the actual limb size. Remains156to split manh,,manl into an array of LIMBS_PER_DOUBLE limbs.157*/158159sc = (unsigned) (exp + 64 * GMP_NUMB_BITS) % GMP_NUMB_BITS;160161/* We add something here to get rounding right. */162exp = (exp + 64 * GMP_NUMB_BITS) / GMP_NUMB_BITS - 64 * GMP_NUMB_BITS / GMP_NUMB_BITS + 1;163164#if LIMBS_PER_DOUBLE == 2165#if GMP_NAIL_BITS == 0166if (sc != 0)167{168rp[1] = manl >> (GMP_LIMB_BITS - sc);169rp[0] = manl << sc;170}171else172{173rp[1] = manl;174rp[0] = 0;175exp--;176}177#else178if (sc > GMP_NAIL_BITS)179{180rp[1] = manl >> (GMP_LIMB_BITS - sc);181rp[0] = (manl << (sc - GMP_NAIL_BITS)) & GMP_NUMB_MASK;182}183else184{185if (sc == 0)186{187rp[1] = manl >> GMP_NAIL_BITS;188rp[0] = (manl << GMP_NUMB_BITS - GMP_NAIL_BITS) & GMP_NUMB_MASK;189exp--;190}191else192{193rp[1] = manl >> (GMP_LIMB_BITS - sc);194rp[0] = (manl >> (GMP_NAIL_BITS - sc)) & GMP_NUMB_MASK;195}196}197#endif198#endif199200#if LIMBS_PER_DOUBLE == 3201#if GMP_NAIL_BITS == 0202if (sc != 0)203{204rp[2] = manh >> (GMP_LIMB_BITS - sc);205rp[1] = (manh << sc) | (manl >> (GMP_LIMB_BITS - sc));206rp[0] = manl << sc;207}208else209{210rp[2] = manh;211rp[1] = manl;212rp[0] = 0;213exp--;214}215#else216if (sc > GMP_NAIL_BITS)217{218rp[2] = (manh >> (GMP_LIMB_BITS - sc));219rp[1] = ((manh << (sc - GMP_NAIL_BITS)) |220(manl >> (GMP_LIMB_BITS - sc + GMP_NAIL_BITS))) & GMP_NUMB_MASK;221if (sc >= 2 * GMP_NAIL_BITS)222rp[0] = (manl << sc - 2 * GMP_NAIL_BITS) & GMP_NUMB_MASK;223else224rp[0] = manl >> (2 * GMP_NAIL_BITS - sc) & GMP_NUMB_MASK;225}226else227{228if (sc == 0)229{230rp[2] = manh >> GMP_NAIL_BITS;231rp[1] = ((manh << GMP_NUMB_BITS - GMP_NAIL_BITS) | (manl >> 2 * GMP_NAIL_BITS)) & GMP_NUMB_MASK;232rp[0] = 0;233exp--;234}235else236{237rp[2] = (manh >> (GMP_LIMB_BITS - sc));238rp[1] = (manh >> (GMP_NAIL_BITS - sc)) & GMP_NUMB_MASK;239rp[0] = ((manh << (GMP_NUMB_BITS - GMP_NAIL_BITS + sc))240| (manl >> (GMP_LIMB_BITS - (GMP_NUMB_BITS - GMP_NAIL_BITS + sc)))) & GMP_NUMB_MASK;241}242}243#endif244#endif245246#if LIMBS_PER_DOUBLE > 3247if (sc == 0)248{249int i;250251for (i = LIMBS_PER_DOUBLE - 1; i >= 0; i--)252{253rp[i] = manh >> (BITS_PER_ULONG - GMP_NUMB_BITS);254manh = ((manh << GMP_NUMB_BITS)255| (manl >> (BITS_PER_ULONG - GMP_NUMB_BITS)));256manl = manl << GMP_NUMB_BITS;257}258exp--;259}260else261{262int i;263264rp[LIMBS_PER_DOUBLE - 1] = (manh >> (GMP_LIMB_BITS - sc));265manh = (manh << sc) | (manl >> (GMP_LIMB_BITS - sc));266manl = (manl << sc);267for (i = LIMBS_PER_DOUBLE - 2; i >= 0; i--)268{269rp[i] = manh >> (BITS_PER_ULONG - GMP_NUMB_BITS);270manh = ((manh << GMP_NUMB_BITS)271| (manl >> (BITS_PER_ULONG - GMP_NUMB_BITS)));272manl = manl << GMP_NUMB_BITS;273}274}275#endif276277return exp;278}279280281