1112158Sdas/**************************************************************** 2112158Sdas 3112158SdasThe author of this software is David M. Gay. 4112158Sdas 5112158SdasCopyright (C) 1998, 2000 by Lucent Technologies 6112158SdasAll Rights Reserved 7112158Sdas 8112158SdasPermission to use, copy, modify, and distribute this software and 9112158Sdasits documentation for any purpose and without fee is hereby 10112158Sdasgranted, provided that the above copyright notice appear in all 11112158Sdascopies and that both that the copyright notice and this 12112158Sdaspermission notice and warranty disclaimer appear in supporting 13112158Sdasdocumentation, and that the name of Lucent or any of its entities 14112158Sdasnot be used in advertising or publicity pertaining to 15112158Sdasdistribution of the software without specific, written prior 16112158Sdaspermission. 17112158Sdas 18112158SdasLUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, 19112158SdasINCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. 20112158SdasIN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY 21112158SdasSPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 22112158SdasWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER 23112158SdasIN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, 24112158SdasARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 25112158SdasTHIS SOFTWARE. 26112158Sdas 27112158Sdas****************************************************************/ 28112158Sdas 29165743Sdas/* Please send bug reports to David M. Gay (dmg at acm dot org, 30165743Sdas * with " at " changed at "@" and " dot " changed to "."). */ 31112158Sdas 32112158Sdas#include "gdtoaimp.h" 33112158Sdas 34112158Sdas static double 35112158Sdas#ifdef KR_headers 36219557Sdasulpdown(d) U *d; 37112158Sdas#else 38219557Sdasulpdown(U *d) 39112158Sdas#endif 40112158Sdas{ 41112158Sdas double u; 42219557Sdas ULong *L = d->L; 43112158Sdas 44219557Sdas u = ulp(d); 45219557Sdas if (!(L[_1] | (L[_0] & 0xfffff)) 46112158Sdas && (L[_0] & 0x7ff00000) > 0x00100000) 47112158Sdas u *= 0.5; 48112158Sdas return u; 49112158Sdas } 50112158Sdas 51112158Sdas int 52112158Sdas#ifdef KR_headers 53112158SdasstrtodI(s, sp, dd) CONST char *s; char **sp; double *dd; 54112158Sdas#else 55112158SdasstrtodI(CONST char *s, char **sp, double *dd) 56112158Sdas#endif 57112158Sdas{ 58165743Sdas static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI }; 59112158Sdas ULong bits[2], sign; 60112158Sdas Long exp; 61112158Sdas int j, k; 62112158Sdas U *u; 63112158Sdas 64112158Sdas k = strtodg(s, sp, &fpi, &exp, bits); 65112158Sdas u = (U*)dd; 66112158Sdas sign = k & STRTOG_Neg ? 0x80000000L : 0; 67112158Sdas switch(k & STRTOG_Retmask) { 68112158Sdas case STRTOG_NoNumber: 69219557Sdas dval(&u[0]) = dval(&u[1]) = 0.; 70112158Sdas break; 71112158Sdas 72112158Sdas case STRTOG_Zero: 73219557Sdas dval(&u[0]) = dval(&u[1]) = 0.; 74112158Sdas#ifdef Sudden_Underflow 75112158Sdas if (k & STRTOG_Inexact) { 76112158Sdas if (sign) 77219557Sdas word0(&u[0]) = 0x80100000L; 78112158Sdas else 79219557Sdas word0(&u[1]) = 0x100000L; 80112158Sdas } 81112158Sdas break; 82112158Sdas#else 83112158Sdas goto contain; 84112158Sdas#endif 85112158Sdas 86112158Sdas case STRTOG_Denormal: 87219557Sdas word1(&u[0]) = bits[0]; 88219557Sdas word0(&u[0]) = bits[1]; 89112158Sdas goto contain; 90112158Sdas 91112158Sdas case STRTOG_Normal: 92219557Sdas word1(&u[0]) = bits[0]; 93219557Sdas word0(&u[0]) = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20); 94112158Sdas contain: 95112158Sdas j = k & STRTOG_Inexact; 96112158Sdas if (sign) { 97219557Sdas word0(&u[0]) |= sign; 98112158Sdas j = STRTOG_Inexact - j; 99112158Sdas } 100112158Sdas switch(j) { 101112158Sdas case STRTOG_Inexlo: 102112158Sdas#ifdef Sudden_Underflow 103112158Sdas if ((u->L[_0] & 0x7ff00000) < 0x3500000) { 104219557Sdas word0(&u[1]) = word0(&u[0]) + 0x3500000; 105219557Sdas word1(&u[1]) = word1(&u[0]); 106219557Sdas dval(&u[1]) += ulp(&u[1]); 107219557Sdas word0(&u[1]) -= 0x3500000; 108219557Sdas if (!(word0(&u[1]) & 0x7ff00000)) { 109219557Sdas word0(&u[1]) = sign; 110219557Sdas word1(&u[1]) = 0; 111112158Sdas } 112112158Sdas } 113112158Sdas else 114112158Sdas#endif 115219557Sdas dval(&u[1]) = dval(&u[0]) + ulp(&u[0]); 116112158Sdas break; 117112158Sdas case STRTOG_Inexhi: 118219557Sdas dval(&u[1]) = dval(&u[0]); 119112158Sdas#ifdef Sudden_Underflow 120219557Sdas if ((word0(&u[0]) & 0x7ff00000) < 0x3500000) { 121219557Sdas word0(&u[0]) += 0x3500000; 122219557Sdas dval(&u[0]) -= ulpdown(u); 123219557Sdas word0(&u[0]) -= 0x3500000; 124219557Sdas if (!(word0(&u[0]) & 0x7ff00000)) { 125219557Sdas word0(&u[0]) = sign; 126219557Sdas word1(&u[0]) = 0; 127112158Sdas } 128112158Sdas } 129112158Sdas else 130112158Sdas#endif 131219557Sdas dval(&u[0]) -= ulpdown(u); 132112158Sdas break; 133112158Sdas default: 134219557Sdas dval(&u[1]) = dval(&u[0]); 135112158Sdas } 136112158Sdas break; 137112158Sdas 138112158Sdas case STRTOG_Infinite: 139219557Sdas word0(&u[0]) = word0(&u[1]) = sign | 0x7ff00000; 140219557Sdas word1(&u[0]) = word1(&u[1]) = 0; 141112158Sdas if (k & STRTOG_Inexact) { 142112158Sdas if (sign) { 143219557Sdas word0(&u[1]) = 0xffefffffL; 144219557Sdas word1(&u[1]) = 0xffffffffL; 145112158Sdas } 146112158Sdas else { 147219557Sdas word0(&u[0]) = 0x7fefffffL; 148219557Sdas word1(&u[0]) = 0xffffffffL; 149112158Sdas } 150112158Sdas } 151112158Sdas break; 152112158Sdas 153112158Sdas case STRTOG_NaN: 154219557Sdas u->L[0] = (u+1)->L[0] = d_QNAN0; 155219557Sdas u->L[1] = (u+1)->L[1] = d_QNAN1; 156112158Sdas break; 157112158Sdas 158112158Sdas case STRTOG_NaNbits: 159219557Sdas word0(&u[0]) = word0(&u[1]) = 0x7ff00000 | sign | bits[1]; 160219557Sdas word1(&u[0]) = word1(&u[1]) = bits[0]; 161112158Sdas } 162112158Sdas return k; 163112158Sdas } 164