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