1cc36ccd1SDavid Schultz /****************************************************************
2cc36ccd1SDavid Schultz
3cc36ccd1SDavid Schultz The author of this software is David M. Gay.
4cc36ccd1SDavid Schultz
5cc36ccd1SDavid Schultz Copyright (C) 1998, 2000 by Lucent Technologies
6cc36ccd1SDavid Schultz All Rights Reserved
7cc36ccd1SDavid Schultz
8cc36ccd1SDavid Schultz Permission to use, copy, modify, and distribute this software and
9cc36ccd1SDavid Schultz its documentation for any purpose and without fee is hereby
10cc36ccd1SDavid Schultz granted, provided that the above copyright notice appear in all
11cc36ccd1SDavid Schultz copies and that both that the copyright notice and this
12cc36ccd1SDavid Schultz permission notice and warranty disclaimer appear in supporting
13cc36ccd1SDavid Schultz documentation, and that the name of Lucent or any of its entities
14cc36ccd1SDavid Schultz not be used in advertising or publicity pertaining to
15cc36ccd1SDavid Schultz distribution of the software without specific, written prior
16cc36ccd1SDavid Schultz permission.
17cc36ccd1SDavid Schultz
18cc36ccd1SDavid Schultz LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19cc36ccd1SDavid Schultz INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20cc36ccd1SDavid Schultz IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21cc36ccd1SDavid Schultz SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22cc36ccd1SDavid Schultz WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23cc36ccd1SDavid Schultz IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24cc36ccd1SDavid Schultz ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25cc36ccd1SDavid Schultz THIS SOFTWARE.
26cc36ccd1SDavid Schultz
27cc36ccd1SDavid Schultz ****************************************************************/
28cc36ccd1SDavid Schultz
29c88250a5SDavid Schultz /* Please send bug reports to David M. Gay (dmg at acm dot org,
30c88250a5SDavid Schultz * with " at " changed at "@" and " dot " changed to "."). */
31cc36ccd1SDavid Schultz
32cc36ccd1SDavid Schultz #include "gdtoaimp.h"
33cc36ccd1SDavid Schultz
34cc36ccd1SDavid Schultz static double
35cc36ccd1SDavid Schultz #ifdef KR_headers
ulpdown(d)36*50dad48bSDavid Schultz ulpdown(d) U *d;
37cc36ccd1SDavid Schultz #else
38*50dad48bSDavid Schultz ulpdown(U *d)
39cc36ccd1SDavid Schultz #endif
40cc36ccd1SDavid Schultz {
41cc36ccd1SDavid Schultz double u;
42*50dad48bSDavid Schultz ULong *L = d->L;
43cc36ccd1SDavid Schultz
44*50dad48bSDavid Schultz u = ulp(d);
45*50dad48bSDavid Schultz if (!(L[_1] | (L[_0] & 0xfffff))
46cc36ccd1SDavid Schultz && (L[_0] & 0x7ff00000) > 0x00100000)
47cc36ccd1SDavid Schultz u *= 0.5;
48cc36ccd1SDavid Schultz return u;
49cc36ccd1SDavid Schultz }
50cc36ccd1SDavid Schultz
51cc36ccd1SDavid Schultz int
52cc36ccd1SDavid Schultz #ifdef KR_headers
strtodI(s,sp,dd)53cc36ccd1SDavid Schultz strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
54cc36ccd1SDavid Schultz #else
55cc36ccd1SDavid Schultz strtodI(CONST char *s, char **sp, double *dd)
56cc36ccd1SDavid Schultz #endif
57cc36ccd1SDavid Schultz {
58c88250a5SDavid Schultz static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
59cc36ccd1SDavid Schultz ULong bits[2], sign;
60cc36ccd1SDavid Schultz Long exp;
61cc36ccd1SDavid Schultz int j, k;
62cc36ccd1SDavid Schultz U *u;
63cc36ccd1SDavid Schultz
64cc36ccd1SDavid Schultz k = strtodg(s, sp, &fpi, &exp, bits);
65cc36ccd1SDavid Schultz u = (U*)dd;
66cc36ccd1SDavid Schultz sign = k & STRTOG_Neg ? 0x80000000L : 0;
67cc36ccd1SDavid Schultz switch(k & STRTOG_Retmask) {
68cc36ccd1SDavid Schultz case STRTOG_NoNumber:
69*50dad48bSDavid Schultz dval(&u[0]) = dval(&u[1]) = 0.;
70cc36ccd1SDavid Schultz break;
71cc36ccd1SDavid Schultz
72cc36ccd1SDavid Schultz case STRTOG_Zero:
73*50dad48bSDavid Schultz dval(&u[0]) = dval(&u[1]) = 0.;
74cc36ccd1SDavid Schultz #ifdef Sudden_Underflow
75cc36ccd1SDavid Schultz if (k & STRTOG_Inexact) {
76cc36ccd1SDavid Schultz if (sign)
77*50dad48bSDavid Schultz word0(&u[0]) = 0x80100000L;
78cc36ccd1SDavid Schultz else
79*50dad48bSDavid Schultz word0(&u[1]) = 0x100000L;
80cc36ccd1SDavid Schultz }
81cc36ccd1SDavid Schultz break;
82cc36ccd1SDavid Schultz #else
83cc36ccd1SDavid Schultz goto contain;
84cc36ccd1SDavid Schultz #endif
85cc36ccd1SDavid Schultz
86cc36ccd1SDavid Schultz case STRTOG_Denormal:
87*50dad48bSDavid Schultz word1(&u[0]) = bits[0];
88*50dad48bSDavid Schultz word0(&u[0]) = bits[1];
89cc36ccd1SDavid Schultz goto contain;
90cc36ccd1SDavid Schultz
91cc36ccd1SDavid Schultz case STRTOG_Normal:
92*50dad48bSDavid Schultz word1(&u[0]) = bits[0];
93*50dad48bSDavid Schultz word0(&u[0]) = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
94cc36ccd1SDavid Schultz contain:
95cc36ccd1SDavid Schultz j = k & STRTOG_Inexact;
96cc36ccd1SDavid Schultz if (sign) {
97*50dad48bSDavid Schultz word0(&u[0]) |= sign;
98cc36ccd1SDavid Schultz j = STRTOG_Inexact - j;
99cc36ccd1SDavid Schultz }
100cc36ccd1SDavid Schultz switch(j) {
101cc36ccd1SDavid Schultz case STRTOG_Inexlo:
102cc36ccd1SDavid Schultz #ifdef Sudden_Underflow
103cc36ccd1SDavid Schultz if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
104*50dad48bSDavid Schultz word0(&u[1]) = word0(&u[0]) + 0x3500000;
105*50dad48bSDavid Schultz word1(&u[1]) = word1(&u[0]);
106*50dad48bSDavid Schultz dval(&u[1]) += ulp(&u[1]);
107*50dad48bSDavid Schultz word0(&u[1]) -= 0x3500000;
108*50dad48bSDavid Schultz if (!(word0(&u[1]) & 0x7ff00000)) {
109*50dad48bSDavid Schultz word0(&u[1]) = sign;
110*50dad48bSDavid Schultz word1(&u[1]) = 0;
111cc36ccd1SDavid Schultz }
112cc36ccd1SDavid Schultz }
113cc36ccd1SDavid Schultz else
114cc36ccd1SDavid Schultz #endif
115*50dad48bSDavid Schultz dval(&u[1]) = dval(&u[0]) + ulp(&u[0]);
116cc36ccd1SDavid Schultz break;
117cc36ccd1SDavid Schultz case STRTOG_Inexhi:
118*50dad48bSDavid Schultz dval(&u[1]) = dval(&u[0]);
119cc36ccd1SDavid Schultz #ifdef Sudden_Underflow
120*50dad48bSDavid Schultz if ((word0(&u[0]) & 0x7ff00000) < 0x3500000) {
121*50dad48bSDavid Schultz word0(&u[0]) += 0x3500000;
122*50dad48bSDavid Schultz dval(&u[0]) -= ulpdown(u);
123*50dad48bSDavid Schultz word0(&u[0]) -= 0x3500000;
124*50dad48bSDavid Schultz if (!(word0(&u[0]) & 0x7ff00000)) {
125*50dad48bSDavid Schultz word0(&u[0]) = sign;
126*50dad48bSDavid Schultz word1(&u[0]) = 0;
127cc36ccd1SDavid Schultz }
128cc36ccd1SDavid Schultz }
129cc36ccd1SDavid Schultz else
130cc36ccd1SDavid Schultz #endif
131*50dad48bSDavid Schultz dval(&u[0]) -= ulpdown(u);
132cc36ccd1SDavid Schultz break;
133cc36ccd1SDavid Schultz default:
134*50dad48bSDavid Schultz dval(&u[1]) = dval(&u[0]);
135cc36ccd1SDavid Schultz }
136cc36ccd1SDavid Schultz break;
137cc36ccd1SDavid Schultz
138cc36ccd1SDavid Schultz case STRTOG_Infinite:
139*50dad48bSDavid Schultz word0(&u[0]) = word0(&u[1]) = sign | 0x7ff00000;
140*50dad48bSDavid Schultz word1(&u[0]) = word1(&u[1]) = 0;
141cc36ccd1SDavid Schultz if (k & STRTOG_Inexact) {
142cc36ccd1SDavid Schultz if (sign) {
143*50dad48bSDavid Schultz word0(&u[1]) = 0xffefffffL;
144*50dad48bSDavid Schultz word1(&u[1]) = 0xffffffffL;
145cc36ccd1SDavid Schultz }
146cc36ccd1SDavid Schultz else {
147*50dad48bSDavid Schultz word0(&u[0]) = 0x7fefffffL;
148*50dad48bSDavid Schultz word1(&u[0]) = 0xffffffffL;
149cc36ccd1SDavid Schultz }
150cc36ccd1SDavid Schultz }
151cc36ccd1SDavid Schultz break;
152cc36ccd1SDavid Schultz
153cc36ccd1SDavid Schultz case STRTOG_NaN:
154*50dad48bSDavid Schultz u->L[0] = (u+1)->L[0] = d_QNAN0;
155*50dad48bSDavid Schultz u->L[1] = (u+1)->L[1] = d_QNAN1;
156cc36ccd1SDavid Schultz break;
157cc36ccd1SDavid Schultz
158cc36ccd1SDavid Schultz case STRTOG_NaNbits:
159*50dad48bSDavid Schultz word0(&u[0]) = word0(&u[1]) = 0x7ff00000 | sign | bits[1];
160*50dad48bSDavid Schultz word1(&u[0]) = word1(&u[1]) = bits[0];
161cc36ccd1SDavid Schultz }
162cc36ccd1SDavid Schultz return k;
163cc36ccd1SDavid Schultz }
164