-#endif
- if (exp < 0L)
- {
- if (exp > (EMULONG) (-NBITS - 1))
- {
- j = (int) exp;
- i = eshift (s, j);
- if (i)
- lost = 1;
- }
- else
- {
- ecleazs (s);
- return;
- }
- }
- /* Round off, unless told not to by rcntrl. */
- if (rcntrl == 0)
- goto mdfin;
- /* Set up rounding parameters if the control register changed. */
- if (rndprc != rlast)
- {
- ecleaz (rbit);
- switch (rndprc)
- {
- default:
- case NBITS:
- rw = NI - 1; /* low guard word */
- rmsk = 0xffff;
- rmbit = 0x8000;
- re = rw - 1;
- rebit = 1;
- break;
-
- case 113:
- rw = 10;
- rmsk = 0x7fff;
- rmbit = 0x4000;
- rebit = 0x8000;
- re = rw;
- break;
-
- case 64:
- rw = 7;
- rmsk = 0xffff;
- rmbit = 0x8000;
- re = rw - 1;
- rebit = 1;
- break;
-
- /* For DEC or IBM arithmetic */
- case 56:
- rw = 6;
- rmsk = 0xff;
- rmbit = 0x80;
- rebit = 0x100;
- re = rw;
- break;
-
- case 53:
- rw = 6;
- rmsk = 0x7ff;
- rmbit = 0x0400;
- rebit = 0x800;
- re = rw;
- break;
-
- /* For C4x arithmetic */
- case 32:
- rw = 5;
- rmsk = 0xffff;
- rmbit = 0x8000;
- rebit = 1;
- re = rw - 1;
- break;
-
- case 24:
- rw = 4;
- rmsk = 0xff;
- rmbit = 0x80;
- rebit = 0x100;
- re = rw;
- break;
- }
- rbit[re] = rebit;
- rlast = rndprc;
- }
-
- /* Shift down 1 temporarily if the data structure has an implied
- most significant bit and the number is denormal.
- Intel long double denormals also lose one bit of precision. */
- if ((exp <= 0) && (rndprc != NBITS)
- && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
- {
- lost |= s[NI - 1] & 1;
- eshdn1 (s);
- }
- /* Clear out all bits below the rounding bit,
- remembering in r if any were nonzero. */
- r = s[rw] & rmsk;
- if (rndprc < NBITS)
- {
- i = rw + 1;
- while (i < NI)
- {
- if (s[i])
- r |= 1;
- s[i] = 0;
- ++i;
- }
- }
- s[rw] &= ~rmsk;
- if ((r & rmbit) != 0)
- {
-#ifndef C4X
- if (r == rmbit)
- {
- if (lost == 0)
- { /* round to even */
- if ((s[re] & rebit) == 0)
- goto mddone;
- }
- else
- {
- if (subflg != 0)
- goto mddone;
- }
- }
-#endif
- eaddm (rbit, s);
- }
- mddone:
-/* Undo the temporary shift for denormal values. */
- if ((exp <= 0) && (rndprc != NBITS)
- && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
- {
- eshup1 (s);
- }
- if (s[2] != 0)
- { /* overflow on roundoff */
- eshdn1 (s);
- exp += 1;
- }
- mdfin:
- s[NI - 1] = 0;
- if (exp >= 32767L)
- {
-#ifndef INFINITY
- overf:
-#endif
-#ifdef INFINITY
- s[1] = 32767;
- for (i = 2; i < NI - 1; i++)
- s[i] = 0;
- if (extra_warnings)
- warning ("floating point overflow");
-#else
- s[1] = 32766;
- s[2] = 0;
- for (i = M + 1; i < NI - 1; i++)
- s[i] = 0xffff;
- s[NI - 1] = 0;
- if ((rndprc < 64) || (rndprc == 113))
- {
- s[rw] &= ~rmsk;
- if (rndprc == 24)
- {
- s[5] = 0;
- s[6] = 0;
- }
- }
-#endif
- return;
- }
- if (exp < 0)
- s[1] = 0;
- else
- s[1] = (UEMUSHORT) exp;
-}
-
-/* Subtract. C = B - A, all e type numbers. */
-
-static int subflg = 0;
-
-static void
-esub (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
-
-#ifdef NANS
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Infinity minus infinity is a NaN.
- Test for subtracting infinities of the same sign. */
- if (eisinf (a) && eisinf (b)
- && ((eisneg (a) ^ eisneg (b)) == 0))
- {
- mtherr ("esub", INVALID);
- enan (c, 0);
- return;
- }
-#endif
- subflg = 1;
- eadd1 (a, b, c);
-}
-
-/* Add. C = A + B, all e type. */
-
-static void
-eadd (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
-
-#ifdef NANS
-/* NaN plus anything is a NaN. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Infinity minus infinity is a NaN.
- Test for adding infinities of opposite signs. */
- if (eisinf (a) && eisinf (b)
- && ((eisneg (a) ^ eisneg (b)) != 0))
- {
- mtherr ("esub", INVALID);
- enan (c, 0);
- return;
- }
-#endif
- subflg = 0;
- eadd1 (a, b, c);
-}
-
-/* Arithmetic common to both addition and subtraction. */
-
-static void
-eadd1 (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI], ci[NI];
- int i, lost, j, k;
- EMULONG lt, lta, ltb;
-
-#ifdef INFINITY
- if (eisinf (a))
- {
- emov (a, c);
- if (subflg)
- eneg (c);
- return;
- }
- if (eisinf (b))
- {
- emov (b, c);
- return;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- if (subflg)
- ai[0] = ~ai[0];
-
- /* compare exponents */
- lta = ai[E];
- ltb = bi[E];
- lt = lta - ltb;
- if (lt > 0L)
- { /* put the larger number in bi */
- emovz (bi, ci);
- emovz (ai, bi);
- emovz (ci, ai);
- ltb = bi[E];
- lt = -lt;
- }
- lost = 0;
- if (lt != 0L)
- {
- if (lt < (EMULONG) (-NBITS - 1))
- goto done; /* answer same as larger addend */
- k = (int) lt;
- lost = eshift (ai, k); /* shift the smaller number down */
- }
- else
- {
- /* exponents were the same, so must compare significands */
- i = ecmpm (ai, bi);
- if (i == 0)
- { /* the numbers are identical in magnitude */
- /* if different signs, result is zero */
- if (ai[0] != bi[0])
- {
- eclear (c);
- return;
- }
- /* if same sign, result is double */
- /* double denormalized tiny number */
- if ((bi[E] == 0) && ((bi[3] & 0x8000) == 0))
- {
- eshup1 (bi);
- goto done;
- }
- /* add 1 to exponent unless both are zero! */
- for (j = 1; j < NI - 1; j++)
- {
- if (bi[j] != 0)
- {
- ltb += 1;
- if (ltb >= 0x7fff)
- {
- eclear (c);
- if (ai[0] != 0)
- eneg (c);
- einfin (c);
- return;
- }
- break;
- }
- }
- bi[E] = (UEMUSHORT) ltb;
- goto done;
- }
- if (i > 0)
- { /* put the larger number in bi */
- emovz (bi, ci);
- emovz (ai, bi);
- emovz (ci, ai);
- }
- }
- if (ai[0] == bi[0])
- {
- eaddm (ai, bi);
- subflg = 0;
- }
- else
- {
- esubm (ai, bi);
- subflg = 1;
- }
- emdnorm (bi, lost, subflg, ltb, 64);
-
- done:
- emovo (bi, c);
-}
-
-/* Divide: C = B/A, all e type. */
-
-static void
-ediv (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI];
- int i, sign;
- EMULONG lt, lta, ltb;
-
-/* IEEE says if result is not a NaN, the sign is "-" if and only if
- operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
- sign = eisneg (a) ^ eisneg (b);
-
-#ifdef NANS
-/* Return any NaN input. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Zero over zero, or infinity over infinity, is a NaN. */
- if (((ecmp (a, ezero) == 0) && (ecmp (b, ezero) == 0))
- || (eisinf (a) && eisinf (b)))
- {
- mtherr ("ediv", INVALID);
- enan (c, sign);
- return;
- }
-#endif
-/* Infinity over anything else is infinity. */
-#ifdef INFINITY
- if (eisinf (b))
- {
- einfin (c);
- goto divsign;
- }
-/* Anything else over infinity is zero. */
- if (eisinf (a))
- {
- eclear (c);
- goto divsign;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- lta = ai[E];
- ltb = bi[E];
- if (bi[E] == 0)
- { /* See if numerator is zero. */
- for (i = 1; i < NI - 1; i++)
- {
- if (bi[i] != 0)
- {
- ltb -= enormlz (bi);
- goto dnzro1;
- }
- }
- eclear (c);
- goto divsign;
- }
- dnzro1:
-
- if (ai[E] == 0)
- { /* possible divide by zero */
- for (i = 1; i < NI - 1; i++)
- {
- if (ai[i] != 0)
- {
- lta -= enormlz (ai);
- goto dnzro2;
- }
- }
-/* Divide by zero is not an invalid operation.
- It is a divide-by-zero operation! */
- einfin (c);
- mtherr ("ediv", SING);
- goto divsign;
- }
- dnzro2:
-
- i = edivm (ai, bi);
- /* calculate exponent */
- lt = ltb - lta + EXONE;
- emdnorm (bi, i, 0, lt, 64);
- emovo (bi, c);
-
- divsign:
-
- if (sign
-#ifndef IEEE
- && (ecmp (c, ezero) != 0)
-#endif
- )
- *(c+(NE-1)) |= 0x8000;
- else
- *(c+(NE-1)) &= ~0x8000;
-}
-
-/* Multiply e-types A and B, return e-type product C. */
-
-static void
-emul (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI];
- int i, j, sign;
- EMULONG lt, lta, ltb;
-
-/* IEEE says if result is not a NaN, the sign is "-" if and only if
- operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
- sign = eisneg (a) ^ eisneg (b);
-
-#ifdef NANS
-/* NaN times anything is the same NaN. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Zero times infinity is a NaN. */
- if ((eisinf (a) && (ecmp (b, ezero) == 0))
- || (eisinf (b) && (ecmp (a, ezero) == 0)))
- {
- mtherr ("emul", INVALID);
- enan (c, sign);
- return;
- }
-#endif
-/* Infinity times anything else is infinity. */
-#ifdef INFINITY
- if (eisinf (a) || eisinf (b))
- {
- einfin (c);
- goto mulsign;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- lta = ai[E];
- ltb = bi[E];
- if (ai[E] == 0)
- {
- for (i = 1; i < NI - 1; i++)
- {
- if (ai[i] != 0)
- {
- lta -= enormlz (ai);
- goto mnzer1;
- }
- }
- eclear (c);
- goto mulsign;
- }
- mnzer1:
-
- if (bi[E] == 0)
- {
- for (i = 1; i < NI - 1; i++)
- {
- if (bi[i] != 0)
- {
- ltb -= enormlz (bi);
- goto mnzer2;
- }
- }
- eclear (c);
- goto mulsign;
- }
- mnzer2:
-
- /* Multiply significands */
- j = emulm (ai, bi);
- /* calculate exponent */
- lt = lta + ltb - (EXONE - 1);
- emdnorm (bi, j, 0, lt, 64);
- emovo (bi, c);
-
- mulsign:
-
- if (sign
-#ifndef IEEE
- && (ecmp (c, ezero) != 0)
-#endif
- )
- *(c+(NE-1)) |= 0x8000;
- else
- *(c+(NE-1)) &= ~0x8000;
-}
-
-/* Convert double precision PE to e-type Y. */
-
-static void
-e53toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
-#ifdef DEC
-
- dectoe (pe, y);
-
-#else
-#ifdef IBM
-
- ibmtoe (pe, y, DFmode);
-
-#else
-#ifdef C4X
-
- c4xtoe (pe, y, HFmode);
-
-#else
- UEMUSHORT r;
- const UEMUSHORT *e;
- UEMUSHORT *p;
- UEMUSHORT yy[NI];
- int denorm, k;
-
- e = pe;
- denorm = 0; /* flag if denormalized number */
- ecleaz (yy);
- if (! REAL_WORDS_BIG_ENDIAN)
- e += 3;
- r = *e;
- yy[0] = 0;
- if (r & 0x8000)
- yy[0] = 0xffff;
- yy[M] = (r & 0x0f) | 0x10;
- r &= ~0x800f; /* strip sign and 4 significand bits */
-#ifdef INFINITY
- if (r == 0x7ff0)
- {
-#ifdef NANS
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- if (((pe[3] & 0xf) != 0) || (pe[2] != 0)
- || (pe[1] != 0) || (pe[0] != 0))
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- else
- {
- if (((pe[0] & 0xf) != 0) || (pe[1] != 0)
- || (pe[2] != 0) || (pe[3] != 0))
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (yy[0])
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- r >>= 4;
- /* If zero exponent, then the significand is denormalized.
- So take back the understood high significand bit. */
-
- if (r == 0)
- {
- denorm = 1;
- yy[M] &= ~0x10;
- }
- r += EXONE - 01777;
- yy[E] = r;
- p = &yy[M + 1];
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- *p++ = *(--e);
- *p++ = *(--e);
- *p++ = *(--e);
- }
- else
- {
- ++e;
- *p++ = *e++;
- *p++ = *e++;
- *p++ = *e++;
- }
-#endif
- eshift (yy, -5);
- if (denorm)
- {
- /* If zero exponent, then normalize the significand. */
- if ((k = enormlz (yy)) > NBITS)
- ecleazs (yy);
- else
- yy[E] -= (UEMUSHORT) (k - 1);
- }
- emovo (yy, y);
-#endif /* not C4X */
-#endif /* not IBM */
-#endif /* not DEC */
-}
-
-/* Convert double extended precision float PE to e type Y. */
-
-static void
-e64toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
- UEMUSHORT yy[NI];
- const UEMUSHORT *e;
- UEMUSHORT *p, *q;
- int i;
-
- e = pe;
- p = yy;
- for (i = 0; i < NE - 5; i++)
- *p++ = 0;
-/* This precision is not ordinarily supported on DEC or IBM. */
-#ifdef DEC
- for (i = 0; i < 5; i++)
- *p++ = *e++;
-#endif
-#ifdef IBM
- p = &yy[0] + (NE - 1);
- *p-- = *e++;
- ++e;
- for (i = 0; i < 5; i++)
- *p-- = *e++;
-#endif
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 5; i++)
- *p++ = *e++;
-
- /* For denormal long double Intel format, shift significand up one
- -- but only if the top significand bit is zero. A top bit of 1
- is "pseudodenormal" when the exponent is zero. */
- if ((yy[NE-1] & 0x7fff) == 0 && (yy[NE-2] & 0x8000) == 0)
- {
- UEMUSHORT temp[NI];
-
- emovi (yy, temp);
- eshup1 (temp);
- emovo (temp,y);
- return;
- }
- }
- else
- {
- p = &yy[0] + (NE - 1);
-#ifdef ARM_EXTENDED_IEEE_FORMAT
- /* For ARMs, the exponent is in the lowest 15 bits of the word. */
- *p-- = (e[0] & 0x8000) | (e[1] & 0x7ffff);
- e += 2;
-#else
- *p-- = *e++;
- ++e;
-#endif
- for (i = 0; i < 4; i++)
- *p-- = *e++;
- }
-#endif
-#ifdef INFINITY
- /* Point to the exponent field and check max exponent cases. */
- p = &yy[NE - 1];
- if ((*p & 0x7fff) == 0x7fff)
- {
-#ifdef NANS
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 4; i++)
- {
- if ((i != 3 && pe[i] != 0)
- /* Anything but 0x8000 here, including 0, is a NaN. */
- || (i == 3 && pe[i] != 0x8000))
- {
- enan (y, (*p & 0x8000) != 0);
- return;
- }
- }
- }
- else
- {
-#ifdef ARM_EXTENDED_IEEE_FORMAT
- for (i = 2; i <= 5; i++)
- {
- if (pe[i] != 0)
- {
- enan (y, (*p & 0x8000) != 0);
- return;
- }
- }
-#else /* not ARM */
- /* In Motorola extended precision format, the most significant
- bit of an infinity mantissa could be either 1 or 0. It is
- the lower order bits that tell whether the value is a NaN. */
- if ((pe[2] & 0x7fff) != 0)
- goto bigend_nan;
-
- for (i = 3; i <= 5; i++)
- {
- if (pe[i] != 0)
- {
-bigend_nan:
- enan (y, (*p & 0x8000) != 0);
- return;
- }
- }
-#endif /* not ARM */
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (*p & 0x8000)
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- p = yy;
- q = y;
- for (i = 0; i < NE; i++)
- *q++ = *p++;
-}
-
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* Convert 128-bit long double precision float PE to e type Y. */
-
-static void
-e113toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
- UEMUSHORT r;
- const UEMUSHORT *e;
- UEMUSHORT *p;
- UEMUSHORT yy[NI];
- int denorm, i;
-
- e = pe;
- denorm = 0;
- ecleaz (yy);
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- e += 7;
-#endif
- r = *e;
- yy[0] = 0;
- if (r & 0x8000)
- yy[0] = 0xffff;
- r &= 0x7fff;
-#ifdef INFINITY
- if (r == 0x7fff)
- {
-#ifdef NANS
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 7; i++)
- {
- if (pe[i] != 0)
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- }
- else
- {
- for (i = 1; i < 8; i++)
- {
- if (pe[i] != 0)
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (yy[0])
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- yy[E] = r;
- p = &yy[M + 1];
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 7; i++)
- *p++ = *(--e);
- }
- else
- {
- ++e;
- for (i = 0; i < 7; i++)
- *p++ = *e++;
- }
-#endif
-/* If denormal, remove the implied bit; else shift down 1. */
- if (r == 0)
- {
- yy[M] = 0;
- }
- else
- {
- yy[M] = 1;
- eshift (yy, -1);
- }
- emovo (yy, y);
-}
-#endif
-
-/* Convert single precision float PE to e type Y. */
-
-static void
-e24toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
-#ifdef IBM
-
- ibmtoe (pe, y, SFmode);
-
-#else
-
-#ifdef C4X
-
- c4xtoe (pe, y, QFmode);
-
-#else
-
- UEMUSHORT r;
- const UEMUSHORT *e;
- UEMUSHORT *p;
- UEMUSHORT yy[NI];
- int denorm, k;
-
- e = pe;
- denorm = 0; /* flag if denormalized number */
- ecleaz (yy);
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- e += 1;
-#endif
-#ifdef DEC
- e += 1;
-#endif
- r = *e;
- yy[0] = 0;
- if (r & 0x8000)
- yy[0] = 0xffff;
- yy[M] = (r & 0x7f) | 0200;
- r &= ~0x807f; /* strip sign and 7 significand bits */
-#ifdef INFINITY
- if (r == 0x7f80)
- {
-#ifdef NANS
- if (REAL_WORDS_BIG_ENDIAN)
- {
- if (((pe[0] & 0x7f) != 0) || (pe[1] != 0))
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- else
- {
- if (((pe[1] & 0x7f) != 0) || (pe[0] != 0))
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (yy[0])
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- r >>= 7;
- /* If zero exponent, then the significand is denormalized.
- So take back the understood high significand bit. */
- if (r == 0)
- {
- denorm = 1;
- yy[M] &= ~0200;
- }
- r += EXONE - 0177;
- yy[E] = r;
- p = &yy[M + 1];
-#ifdef DEC
- *p++ = *(--e);
-#endif
-#ifdef IEEE
- if (! REAL_WORDS_BIG_ENDIAN)
- *p++ = *(--e);
- else
- {
- ++e;
- *p++ = *e++;
- }
-#endif
- eshift (yy, -8);
- if (denorm)
- { /* if zero exponent, then normalize the significand */
- if ((k = enormlz (yy)) > NBITS)
- ecleazs (yy);
- else
- yy[E] -= (UEMUSHORT) (k - 1);
- }
- emovo (yy, y);
-#endif /* not C4X */
-#endif /* not IBM */
-}
-
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* Convert e-type X to IEEE 128-bit long double format E. */
-
-static void
-etoe113 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
-
-#ifdef NANS
- if (eisnan (x))
- {
- make_nan (e, eisneg (x), TFmode);
- return;
- }
-#endif
- emovi (x, xi);
- exp = (EMULONG) xi[E];
-#ifdef INFINITY
- if (eisinf (x))
- goto nonorm;
-#endif
- /* round off to nearest or even */
- rndsav = rndprc;
- rndprc = 113;
- emdnorm (xi, 0, 0, exp, 64);
- rndprc = rndsav;
-#ifdef INFINITY
- nonorm:
-#endif
- toe113 (xi, e);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 113-bit precision, to IEEE 128-bit long double format Y. */
-
-static void
-toe113 (a, b)
- UEMUSHORT *a, *b;
-{
- UEMUSHORT *p, *q;
- UEMUSHORT i;
-
-#ifdef NANS
- if (eiisnan (a))
- {
- make_nan (b, eiisneg (a), TFmode);
- return;
- }
-#endif
- p = a;
- if (REAL_WORDS_BIG_ENDIAN)
- q = b;
- else
- q = b + 7; /* point to output exponent */
-
- /* If not denormal, delete the implied bit. */
- if (a[E] != 0)
- {
- eshup1 (a);
- }
- /* combine sign and exponent */
- i = *p++;
- if (REAL_WORDS_BIG_ENDIAN)
- {
- if (i)
- *q++ = *p++ | 0x8000;
- else
- *q++ = *p++;
- }
- else
- {
- if (i)
- *q-- = *p++ | 0x8000;
- else
- *q-- = *p++;
- }
- /* skip over guard word */
- ++p;
- /* move the significand */
- if (REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 7; i++)
- *q++ = *p++;
- }
- else
- {
- for (i = 0; i < 7; i++)
- *q-- = *p++;
- }
-}
-#endif
-
-/* Convert e-type X to IEEE double extended format E. */
-
-static void
-etoe64 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
-
-#ifdef NANS
- if (eisnan (x))
- {
- make_nan (e, eisneg (x), XFmode);
- return;
- }
-#endif
- emovi (x, xi);
- /* adjust exponent for offset */
- exp = (EMULONG) xi[E];
-#ifdef INFINITY
- if (eisinf (x))
- goto nonorm;
-#endif
- /* round off to nearest or even */
- rndsav = rndprc;
- rndprc = 64;
- emdnorm (xi, 0, 0, exp, 64);
- rndprc = rndsav;
-#ifdef INFINITY
- nonorm:
-#endif
- toe64 (xi, e);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 64-bit precision, to IEEE double extended format Y. */
-
-static void
-toe64 (a, b)
- UEMUSHORT *a, *b;
-{
- UEMUSHORT *p, *q;
- UEMUSHORT i;
-
-#ifdef NANS
- if (eiisnan (a))
- {
- make_nan (b, eiisneg (a), XFmode);
- return;
- }
-#endif
- /* Shift denormal long double Intel format significand down one bit. */
- if ((a[E] == 0) && ! REAL_WORDS_BIG_ENDIAN)
- eshdn1 (a);
- p = a;
-#ifdef IBM
- q = b;
-#endif
-#ifdef DEC
- q = b + 4;
-#endif
-#ifdef IEEE
- if (REAL_WORDS_BIG_ENDIAN)
- q = b;
- else
- {
- q = b + 4; /* point to output exponent */
- /* Clear the last two bytes of 12-byte Intel format. q is pointing
- into an array of size 6 (e.g. x[NE]), so the last two bytes are
- always there, and there are never more bytes, even when we are using
- INTEL_EXTENDED_IEEE_FORMAT. */
- *(q+1) = 0;
- }
-#endif
-
- /* combine sign and exponent */
- i = *p++;
-#ifdef IBM
- if (i)
- *q++ = *p++ | 0x8000;
- else
- *q++ = *p++;
- *q++ = 0;
-#endif
-#ifdef DEC
- if (i)
- *q-- = *p++ | 0x8000;
- else
- *q-- = *p++;
-#endif
-#ifdef IEEE
- if (REAL_WORDS_BIG_ENDIAN)
- {
-#ifdef ARM_EXTENDED_IEEE_FORMAT
- /* The exponent is in the lowest 15 bits of the first word. */
- *q++ = i ? 0x8000 : 0;
- *q++ = *p++;
-#else
- if (i)
- *q++ = *p++ | 0x8000;
- else
- *q++ = *p++;
- *q++ = 0;
-#endif
- }
- else
- {
- if (i)
- *q-- = *p++ | 0x8000;
- else
- *q-- = *p++;
- }
-#endif
- /* skip over guard word */
- ++p;
- /* move the significand */
-#ifdef IBM
- for (i = 0; i < 4; i++)
- *q++ = *p++;
-#endif
-#ifdef DEC
- for (i = 0; i < 4; i++)
- *q-- = *p++;
-#endif
-#ifdef IEEE
- if (REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 4; i++)
- *q++ = *p++;
- }
- else
- {
-#ifdef INFINITY
- if (eiisinf (a))
- {
- /* Intel long double infinity significand. */
- *q-- = 0x8000;
- *q-- = 0;
- *q-- = 0;
- *q = 0;
- return;
- }
-#endif
- for (i = 0; i < 4; i++)
- *q-- = *p++;
- }
-#endif
-}
-
-/* e type to double precision. */
-
-#ifdef DEC
-/* Convert e-type X to DEC-format double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etodec (x, e); /* see etodec.c */
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit double precision, to DEC double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- todec (x, y);
-}
-
-#else
-#ifdef IBM
-/* Convert e-type X to IBM 370-format double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoibm (x, e, DFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit precision, to IBM 370 double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- toibm (x, y, DFmode);
-}
-
-#else /* it's neither DEC nor IBM */
-#ifdef C4X
-/* Convert e-type X to C4X-format long double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoc4x (x, e, HFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit precision, to IBM 370 double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- toc4x (x, y, HFmode);