1*9a9a4122Sriastradh /* $NetBSD: strtodI.c,v 1.4 2019/08/01 02:27:43 riastradh Exp $ */
27684d5e0Skleink
37684d5e0Skleink /****************************************************************
47684d5e0Skleink
57684d5e0Skleink The author of this software is David M. Gay.
67684d5e0Skleink
77684d5e0Skleink Copyright (C) 1998, 2000 by Lucent Technologies
87684d5e0Skleink All Rights Reserved
97684d5e0Skleink
107684d5e0Skleink Permission to use, copy, modify, and distribute this software and
117684d5e0Skleink its documentation for any purpose and without fee is hereby
127684d5e0Skleink granted, provided that the above copyright notice appear in all
137684d5e0Skleink copies and that both that the copyright notice and this
147684d5e0Skleink permission notice and warranty disclaimer appear in supporting
157684d5e0Skleink documentation, and that the name of Lucent or any of its entities
167684d5e0Skleink not be used in advertising or publicity pertaining to
177684d5e0Skleink distribution of the software without specific, written prior
187684d5e0Skleink permission.
197684d5e0Skleink
207684d5e0Skleink LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
217684d5e0Skleink INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
227684d5e0Skleink IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
237684d5e0Skleink SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
247684d5e0Skleink WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
257684d5e0Skleink IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
267684d5e0Skleink ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
277684d5e0Skleink THIS SOFTWARE.
287684d5e0Skleink
297684d5e0Skleink ****************************************************************/
307684d5e0Skleink
317684d5e0Skleink /* Please send bug reports to David M. Gay (dmg at acm dot org,
327684d5e0Skleink * with " at " changed at "@" and " dot " changed to "."). */
337684d5e0Skleink
347684d5e0Skleink #include "gdtoaimp.h"
357684d5e0Skleink
367684d5e0Skleink static double
377684d5e0Skleink #ifdef KR_headers
ulpdown(d)3861e56760Schristos ulpdown(d) U *d;
397684d5e0Skleink #else
4061e56760Schristos ulpdown(U *d)
417684d5e0Skleink #endif
427684d5e0Skleink {
437684d5e0Skleink double u;
4461e56760Schristos ULong *L = d->L;
457684d5e0Skleink
4661e56760Schristos u = ulp(d);
4761e56760Schristos if (!(L[_1] | (L[_0] & 0xfffff))
487684d5e0Skleink && (L[_0] & 0x7ff00000) > 0x00100000)
497684d5e0Skleink u *= 0.5;
507684d5e0Skleink return u;
517684d5e0Skleink }
527684d5e0Skleink
537684d5e0Skleink int
547684d5e0Skleink #ifdef KR_headers
strtodI(s,sp,dd)557684d5e0Skleink strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
567684d5e0Skleink #else
577684d5e0Skleink strtodI(CONST char *s, char **sp, double *dd)
587684d5e0Skleink #endif
597684d5e0Skleink {
60*9a9a4122Sriastradh static CONST FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
617684d5e0Skleink ULong bits[2], sign;
627684d5e0Skleink Long exp;
637684d5e0Skleink int j, k;
647684d5e0Skleink U *u;
657684d5e0Skleink
667684d5e0Skleink k = strtodg(s, sp, &fpi, &exp, bits);
67ab625449Schristos if (k == STRTOG_NoMemory)
68ab625449Schristos return k;
697684d5e0Skleink u = (U*)dd;
707684d5e0Skleink sign = k & STRTOG_Neg ? 0x80000000L : 0;
717684d5e0Skleink switch(k & STRTOG_Retmask) {
727684d5e0Skleink case STRTOG_NoNumber:
7361e56760Schristos dval(&u[0]) = dval(&u[1]) = 0.;
747684d5e0Skleink break;
757684d5e0Skleink
767684d5e0Skleink case STRTOG_Zero:
7761e56760Schristos dval(&u[0]) = dval(&u[1]) = 0.;
787684d5e0Skleink #ifdef Sudden_Underflow
797684d5e0Skleink if (k & STRTOG_Inexact) {
807684d5e0Skleink if (sign)
8161e56760Schristos word0(&u[0]) = 0x80100000L;
827684d5e0Skleink else
8361e56760Schristos word0(&u[1]) = 0x100000L;
847684d5e0Skleink }
857684d5e0Skleink break;
867684d5e0Skleink #else
877684d5e0Skleink goto contain;
887684d5e0Skleink #endif
897684d5e0Skleink
907684d5e0Skleink case STRTOG_Denormal:
9161e56760Schristos word1(&u[0]) = bits[0];
9261e56760Schristos word0(&u[0]) = bits[1];
937684d5e0Skleink goto contain;
947684d5e0Skleink
957684d5e0Skleink case STRTOG_Normal:
9661e56760Schristos word1(&u[0]) = bits[0];
9761e56760Schristos word0(&u[0]) = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
987684d5e0Skleink contain:
997684d5e0Skleink j = k & STRTOG_Inexact;
1007684d5e0Skleink if (sign) {
10161e56760Schristos word0(&u[0]) |= sign;
1027684d5e0Skleink j = STRTOG_Inexact - j;
1037684d5e0Skleink }
1047684d5e0Skleink switch(j) {
1057684d5e0Skleink case STRTOG_Inexlo:
1067684d5e0Skleink #ifdef Sudden_Underflow
1077684d5e0Skleink if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
10861e56760Schristos word0(&u[1]) = word0(&u[0]) + 0x3500000;
10961e56760Schristos word1(&u[1]) = word1(&u[0]);
11061e56760Schristos dval(&u[1]) += ulp(&u[1]);
11161e56760Schristos word0(&u[1]) -= 0x3500000;
11261e56760Schristos if (!(word0(&u[1]) & 0x7ff00000)) {
11361e56760Schristos word0(&u[1]) = sign;
11461e56760Schristos word1(&u[1]) = 0;
1157684d5e0Skleink }
1167684d5e0Skleink }
1177684d5e0Skleink else
1187684d5e0Skleink #endif
11961e56760Schristos dval(&u[1]) = dval(&u[0]) + ulp(&u[0]);
1207684d5e0Skleink break;
1217684d5e0Skleink case STRTOG_Inexhi:
12261e56760Schristos dval(&u[1]) = dval(&u[0]);
1237684d5e0Skleink #ifdef Sudden_Underflow
12461e56760Schristos if ((word0(&u[0]) & 0x7ff00000) < 0x3500000) {
12561e56760Schristos word0(&u[0]) += 0x3500000;
12661e56760Schristos dval(&u[0]) -= ulpdown(u);
12761e56760Schristos word0(&u[0]) -= 0x3500000;
12861e56760Schristos if (!(word0(&u[0]) & 0x7ff00000)) {
12961e56760Schristos word0(&u[0]) = sign;
13061e56760Schristos word1(&u[0]) = 0;
1317684d5e0Skleink }
1327684d5e0Skleink }
1337684d5e0Skleink else
1347684d5e0Skleink #endif
13561e56760Schristos dval(&u[0]) -= ulpdown(u);
1367684d5e0Skleink break;
1377684d5e0Skleink default:
13861e56760Schristos dval(&u[1]) = dval(&u[0]);
1397684d5e0Skleink }
1407684d5e0Skleink break;
1417684d5e0Skleink
1427684d5e0Skleink case STRTOG_Infinite:
14361e56760Schristos word0(&u[0]) = word0(&u[1]) = sign | 0x7ff00000;
14461e56760Schristos word1(&u[0]) = word1(&u[1]) = 0;
1457684d5e0Skleink if (k & STRTOG_Inexact) {
1467684d5e0Skleink if (sign) {
14761e56760Schristos word0(&u[1]) = 0xffefffffL;
14861e56760Schristos word1(&u[1]) = 0xffffffffL;
1497684d5e0Skleink }
1507684d5e0Skleink else {
15161e56760Schristos word0(&u[0]) = 0x7fefffffL;
15261e56760Schristos word1(&u[0]) = 0xffffffffL;
1537684d5e0Skleink }
1547684d5e0Skleink }
1557684d5e0Skleink break;
1567684d5e0Skleink
1577684d5e0Skleink case STRTOG_NaN:
15861e56760Schristos u->L[0] = (u+1)->L[0] = d_QNAN0;
15961e56760Schristos u->L[1] = (u+1)->L[1] = d_QNAN1;
1607684d5e0Skleink break;
1617684d5e0Skleink
1627684d5e0Skleink case STRTOG_NaNbits:
16361e56760Schristos word0(&u[0]) = word0(&u[1]) = 0x7ff00000 | sign | bits[1];
16461e56760Schristos word1(&u[0]) = word1(&u[1]) = bits[0];
1657684d5e0Skleink }
1667684d5e0Skleink return k;
1677684d5e0Skleink }
168