Deleted Added
full compact
strtodI.c (165744) strtodI.c (219557)
1/****************************************************************
2
3The author of this software is David M. Gay.
4
5Copyright (C) 1998, 2000 by Lucent Technologies
6All Rights Reserved
7
8Permission to use, copy, modify, and distribute this software and

--- 19 unchanged lines hidden (view full) ---

28
29/* Please send bug reports to David M. Gay (dmg at acm dot org,
30 * with " at " changed at "@" and " dot " changed to "."). */
31
32#include "gdtoaimp.h"
33
34 static double
35#ifdef KR_headers
1/****************************************************************
2
3The author of this software is David M. Gay.
4
5Copyright (C) 1998, 2000 by Lucent Technologies
6All Rights Reserved
7
8Permission to use, copy, modify, and distribute this software and

--- 19 unchanged lines hidden (view full) ---

28
29/* Please send bug reports to David M. Gay (dmg at acm dot org,
30 * with " at " changed at "@" and " dot " changed to "."). */
31
32#include "gdtoaimp.h"
33
34 static double
35#ifdef KR_headers
36ulpdown(d) double *d;
36ulpdown(d) U *d;
37#else
37#else
38ulpdown(double *d)
38ulpdown(U *d)
39#endif
40{
41 double u;
39#endif
40{
41 double u;
42 ULong *L = (ULong*)d;
42 ULong *L = d->L;
43
43
44 u = ulp(*d);
45 if (!(L[_1] | L[_0] & 0xfffff)
44 u = ulp(d);
45 if (!(L[_1] | (L[_0] & 0xfffff))
46 && (L[_0] & 0x7ff00000) > 0x00100000)
47 u *= 0.5;
48 return u;
49 }
50
51 int
52#ifdef KR_headers
53strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
54#else
55strtodI(CONST char *s, char **sp, double *dd)
56#endif
57{
58 static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
59 ULong bits[2], sign;
60 Long exp;
61 int j, k;
46 && (L[_0] & 0x7ff00000) > 0x00100000)
47 u *= 0.5;
48 return u;
49 }
50
51 int
52#ifdef KR_headers
53strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
54#else
55strtodI(CONST char *s, char **sp, double *dd)
56#endif
57{
58 static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
59 ULong bits[2], sign;
60 Long exp;
61 int j, k;
62 typedef union {
63 double d[2];
64 ULong L[4];
65 } U;
66 U *u;
67
68 k = strtodg(s, sp, &fpi, &exp, bits);
69 u = (U*)dd;
70 sign = k & STRTOG_Neg ? 0x80000000L : 0;
71 switch(k & STRTOG_Retmask) {
72 case STRTOG_NoNumber:
62 U *u;
63
64 k = strtodg(s, sp, &fpi, &exp, bits);
65 u = (U*)dd;
66 sign = k & STRTOG_Neg ? 0x80000000L : 0;
67 switch(k & STRTOG_Retmask) {
68 case STRTOG_NoNumber:
73 u->d[0] = u->d[1] = 0.;
69 dval(&u[0]) = dval(&u[1]) = 0.;
74 break;
75
76 case STRTOG_Zero:
70 break;
71
72 case STRTOG_Zero:
77 u->d[0] = u->d[1] = 0.;
73 dval(&u[0]) = dval(&u[1]) = 0.;
78#ifdef Sudden_Underflow
79 if (k & STRTOG_Inexact) {
80 if (sign)
74#ifdef Sudden_Underflow
75 if (k & STRTOG_Inexact) {
76 if (sign)
81 u->L[_0] = 0x80100000L;
77 word0(&u[0]) = 0x80100000L;
82 else
78 else
83 u->L[2+_0] = 0x100000L;
79 word0(&u[1]) = 0x100000L;
84 }
85 break;
86#else
87 goto contain;
88#endif
89
90 case STRTOG_Denormal:
80 }
81 break;
82#else
83 goto contain;
84#endif
85
86 case STRTOG_Denormal:
91 u->L[_1] = bits[0];
92 u->L[_0] = bits[1];
87 word1(&u[0]) = bits[0];
88 word0(&u[0]) = bits[1];
93 goto contain;
94
95 case STRTOG_Normal:
89 goto contain;
90
91 case STRTOG_Normal:
96 u->L[_1] = bits[0];
97 u->L[_0] = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
92 word1(&u[0]) = bits[0];
93 word0(&u[0]) = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
98 contain:
99 j = k & STRTOG_Inexact;
100 if (sign) {
94 contain:
95 j = k & STRTOG_Inexact;
96 if (sign) {
101 u->L[_0] |= sign;
97 word0(&u[0]) |= sign;
102 j = STRTOG_Inexact - j;
103 }
104 switch(j) {
105 case STRTOG_Inexlo:
106#ifdef Sudden_Underflow
107 if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
98 j = STRTOG_Inexact - j;
99 }
100 switch(j) {
101 case STRTOG_Inexlo:
102#ifdef Sudden_Underflow
103 if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
108 u->L[2+_0] = u->L[_0] + 0x3500000;
109 u->L[2+_1] = u->L[_1];
110 u->d[1] += ulp(u->d[1]);
111 u->L[2+_0] -= 0x3500000;
112 if (!(u->L[2+_0] & 0x7ff00000)) {
113 u->L[2+_0] = sign;
114 u->L[2+_1] = 0;
104 word0(&u[1]) = word0(&u[0]) + 0x3500000;
105 word1(&u[1]) = word1(&u[0]);
106 dval(&u[1]) += ulp(&u[1]);
107 word0(&u[1]) -= 0x3500000;
108 if (!(word0(&u[1]) & 0x7ff00000)) {
109 word0(&u[1]) = sign;
110 word1(&u[1]) = 0;
115 }
116 }
117 else
118#endif
111 }
112 }
113 else
114#endif
119 u->d[1] = u->d[0] + ulp(u->d[0]);
115 dval(&u[1]) = dval(&u[0]) + ulp(&u[0]);
120 break;
121 case STRTOG_Inexhi:
116 break;
117 case STRTOG_Inexhi:
122 u->d[1] = u->d[0];
118 dval(&u[1]) = dval(&u[0]);
123#ifdef Sudden_Underflow
119#ifdef Sudden_Underflow
124 if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
125 u->L[_0] += 0x3500000;
126 u->d[0] -= ulpdown(u->d);
127 u->L[_0] -= 0x3500000;
128 if (!(u->L[_0] & 0x7ff00000)) {
129 u->L[_0] = sign;
130 u->L[_1] = 0;
120 if ((word0(&u[0]) & 0x7ff00000) < 0x3500000) {
121 word0(&u[0]) += 0x3500000;
122 dval(&u[0]) -= ulpdown(u);
123 word0(&u[0]) -= 0x3500000;
124 if (!(word0(&u[0]) & 0x7ff00000)) {
125 word0(&u[0]) = sign;
126 word1(&u[0]) = 0;
131 }
132 }
133 else
134#endif
127 }
128 }
129 else
130#endif
135 u->d[0] -= ulpdown(u->d);
131 dval(&u[0]) -= ulpdown(u);
136 break;
137 default:
132 break;
133 default:
138 u->d[1] = u->d[0];
134 dval(&u[1]) = dval(&u[0]);
139 }
140 break;
141
142 case STRTOG_Infinite:
135 }
136 break;
137
138 case STRTOG_Infinite:
143 u->L[_0] = u->L[2+_0] = sign | 0x7ff00000;
144 u->L[_1] = u->L[2+_1] = 0;
139 word0(&u[0]) = word0(&u[1]) = sign | 0x7ff00000;
140 word1(&u[0]) = word1(&u[1]) = 0;
145 if (k & STRTOG_Inexact) {
146 if (sign) {
141 if (k & STRTOG_Inexact) {
142 if (sign) {
147 u->L[2+_0] = 0xffefffffL;
148 u->L[2+_1] = 0xffffffffL;
143 word0(&u[1]) = 0xffefffffL;
144 word1(&u[1]) = 0xffffffffL;
149 }
150 else {
145 }
146 else {
151 u->L[_0] = 0x7fefffffL;
152 u->L[_1] = 0xffffffffL;
147 word0(&u[0]) = 0x7fefffffL;
148 word1(&u[0]) = 0xffffffffL;
153 }
154 }
155 break;
156
157 case STRTOG_NaN:
149 }
150 }
151 break;
152
153 case STRTOG_NaN:
158 u->L[0] = u->L[2] = d_QNAN0;
159 u->L[1] = u->L[3] = d_QNAN1;
154 u->L[0] = (u+1)->L[0] = d_QNAN0;
155 u->L[1] = (u+1)->L[1] = d_QNAN1;
160 break;
161
162 case STRTOG_NaNbits:
156 break;
157
158 case STRTOG_NaNbits:
163 u->L[_0] = u->L[2+_0] = 0x7ff00000 | sign | bits[1];
164 u->L[_1] = u->L[2+_1] = bits[0];
159 word0(&u[0]) = word0(&u[1]) = 0x7ff00000 | sign | bits[1];
160 word1(&u[0]) = word1(&u[1]) = bits[0];
165 }
166 return k;
167 }
161 }
162 return k;
163 }