xref: /netbsd-src/lib/libc/gdtoa/strtodI.c (revision 9a9a41227b42868f516d4f928b32562ad0f5bc3b)
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