dt.c revision 1.1 1 1.1 christos /****************************************************************
2 1.1 christos
3 1.1 christos The author of this software is David M. Gay.
4 1.1 christos
5 1.1 christos Copyright (C) 1998 by Lucent Technologies
6 1.1 christos All Rights Reserved
7 1.1 christos
8 1.1 christos Permission to use, copy, modify, and distribute this software and
9 1.1 christos its documentation for any purpose and without fee is hereby
10 1.1 christos granted, provided that the above copyright notice appear in all
11 1.1 christos copies and that both that the copyright notice and this
12 1.1 christos permission notice and warranty disclaimer appear in supporting
13 1.1 christos documentation, and that the name of Lucent or any of its entities
14 1.1 christos not be used in advertising or publicity pertaining to
15 1.1 christos distribution of the software without specific, written prior
16 1.1 christos permission.
17 1.1 christos
18 1.1 christos LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19 1.1 christos INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20 1.1 christos IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21 1.1 christos SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22 1.1 christos WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23 1.1 christos IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24 1.1 christos ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25 1.1 christos THIS SOFTWARE.
26 1.1 christos
27 1.1 christos ****************************************************************/
28 1.1 christos
29 1.1 christos /* Please send bug reports to David M. Gay (dmg at acm dot org,
30 1.1 christos * with " at " changed at "@" and " dot " changed to "."). */
31 1.1 christos
32 1.1 christos /* Test program for strtod and dtoa.
33 1.1 christos *
34 1.1 christos * Inputs (on stdin):
35 1.1 christos * number[: mode [ndigits]]
36 1.1 christos * or
37 1.1 christos * #hex0 hex1[: mode [ndigits]]
38 1.1 christos * where number is a decimal floating-point number,
39 1.1 christos * hex0 is a string of Hex digits for the most significant
40 1.1 christos * word of the number, hex1 is a similar string for the other
41 1.1 christos * (least significant) word, and mode and ndigits are
42 1.1 christos * parameters to dtoa.
43 1.1 christos */
44 1.1 christos
45 1.1 christos #include <stdio.h>
46 1.1 christos #include "gdtoa.h"
47 1.1 christos int STRTOD_DIGLIM = 24;
48 1.1 christos #ifdef KR_headers
49 1.1 christos #define Void /*void*/
50 1.1 christos #else
51 1.1 christos #define Void void
52 1.1 christos #endif
53 1.1 christos
54 1.1 christos #ifdef __STDC__
55 1.1 christos #include <stdlib.h>
56 1.1 christos #else
57 1.1 christos #ifdef __cplusplus
58 1.1 christos extern "C" double atof(const char*);
59 1.1 christos #else
60 1.1 christos extern double atof ANSI((char*));
61 1.1 christos #endif
62 1.1 christos #endif
63 1.1 christos
64 1.1 christos typedef union { double d; ULong L[2]; } U;
65 1.1 christos
66 1.1 christos #ifdef IEEE_8087
67 1.1 christos #define word0(x) (x)->L[1]
68 1.1 christos #define word1(x) (x)->L[0]
69 1.1 christos #else
70 1.1 christos #define word0(x) (x)->L[0]
71 1.1 christos #define word1(x) (x)->L[1]
72 1.1 christos #endif
73 1.1 christos #define dval(x) (x)->d
74 1.1 christos
75 1.1 christos #include "errno.h"
76 1.1 christos
77 1.1 christos #ifdef __cplusplus
78 1.1 christos extern "C" char *dtoa(double, int, int, int*, int*, char **);
79 1.1 christos #else
80 1.1 christos extern char *dtoa ANSI((double, int, int, int*, int*, char **));
81 1.1 christos #endif
82 1.1 christos
83 1.1 christos static void
84 1.1 christos #ifdef KR_headers
85 1.1 christos g_fmt(b, x) char *b; double x;
86 1.1 christos #else
87 1.1 christos g_fmt(char *b, double x)
88 1.1 christos #endif
89 1.1 christos {
90 1.1 christos char *s, *se;
91 1.1 christos int decpt, i, j, k, sign;
92 1.1 christos
93 1.1 christos if (!x) {
94 1.1 christos *b++ = '0';
95 1.1 christos *b = 0;
96 1.1 christos return;
97 1.1 christos }
98 1.1 christos s = dtoa(x, 0, 0, &decpt, &sign, &se);
99 1.1 christos if (sign)
100 1.1 christos *b++ = '-';
101 1.1 christos if (decpt == 9999) /* Infinity or Nan */ {
102 1.1 christos while((*b++ = *s++));
103 1.1 christos return;
104 1.1 christos }
105 1.1 christos if (decpt <= -4 || decpt > se - s + 5) {
106 1.1 christos *b++ = *s++;
107 1.1 christos if (*s) {
108 1.1 christos *b++ = '.';
109 1.1 christos while((*b = *s++))
110 1.1 christos b++;
111 1.1 christos }
112 1.1 christos *b++ = 'e';
113 1.1 christos /* sprintf(b, "%+.2d", decpt - 1); */
114 1.1 christos if (--decpt < 0) {
115 1.1 christos *b++ = '-';
116 1.1 christos decpt = -decpt;
117 1.1 christos }
118 1.1 christos else
119 1.1 christos *b++ = '+';
120 1.1 christos for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10){};
121 1.1 christos for(;;) {
122 1.1 christos i = decpt / k;
123 1.1 christos *b++ = i + '0';
124 1.1 christos if (--j <= 0)
125 1.1 christos break;
126 1.1 christos decpt -= i*k;
127 1.1 christos decpt *= 10;
128 1.1 christos }
129 1.1 christos *b = 0;
130 1.1 christos }
131 1.1 christos else if (decpt <= 0) {
132 1.1 christos *b++ = '.';
133 1.1 christos for(; decpt < 0; decpt++)
134 1.1 christos *b++ = '0';
135 1.1 christos while((*b++ = *s++));
136 1.1 christos }
137 1.1 christos else {
138 1.1 christos while((*b = *s++)) {
139 1.1 christos b++;
140 1.1 christos if (--decpt == 0 && *s)
141 1.1 christos *b++ = '.';
142 1.1 christos }
143 1.1 christos for(; decpt > 0; decpt--)
144 1.1 christos *b++ = '0';
145 1.1 christos *b = 0;
146 1.1 christos }
147 1.1 christos }
148 1.1 christos
149 1.1 christos static void
150 1.1 christos baderrno(Void)
151 1.1 christos {
152 1.1 christos fflush(stdout);
153 1.1 christos perror("\nerrno strtod");
154 1.1 christos fflush(stderr);
155 1.1 christos }
156 1.1 christos
157 1.1 christos #define UL (unsigned long)
158 1.1 christos
159 1.1 christos static void
160 1.1 christos #ifdef KR_headers
161 1.1 christos check(d) U *d;
162 1.1 christos #else
163 1.1 christos check(U *d)
164 1.1 christos #endif
165 1.1 christos {
166 1.1 christos char buf[64];
167 1.1 christos int decpt, sign;
168 1.1 christos char *s, *se;
169 1.1 christos U d1;
170 1.1 christos
171 1.1 christos s = dtoa(dval(d), 0, 0, &decpt, &sign, &se);
172 1.1 christos sprintf(buf, "%s%s%se%d", sign ? "-" : "",
173 1.1 christos decpt == 9999 ? "" : ".", s, decpt);
174 1.1 christos errno = 0;
175 1.1 christos dval(&d1) = strtod(buf, (char **)0);
176 1.1 christos if (errno)
177 1.1 christos baderrno();
178 1.1 christos if (dval(d) != dval(&d1)) {
179 1.1 christos printf("sent d = %.17g = 0x%lx %lx, buf = %s\n",
180 1.1 christos dval(d), UL word0(d), UL word1(d), buf);
181 1.1 christos printf("got d1 = %.17g = 0x%lx %lx\n",
182 1.1 christos dval(&d1), UL word0(&d1), UL word1(&d1));
183 1.1 christos }
184 1.1 christos }
185 1.1 christos
186 1.1 christos int
187 1.1 christos main(Void)
188 1.1 christos {
189 1.1 christos U d, d1;
190 1.1 christos char buf[2048], buf1[32];
191 1.1 christos char *fmt, *s, *s1, *se;
192 1.1 christos int decpt, sign;
193 1.1 christos int mode = 0, ndigits = 17;
194 1.1 christos ULong x, y;
195 1.1 christos #ifdef VAX
196 1.1 christos ULong z;
197 1.1 christos #endif
198 1.1 christos
199 1.1 christos while(fgets(buf, sizeof(buf), stdin)) {
200 1.1 christos if (*buf == '*') {
201 1.1 christos printf("%s", buf);
202 1.1 christos continue;
203 1.1 christos }
204 1.1 christos printf("Input: %s", buf);
205 1.1 christos if (*buf == '#') {
206 1.1 christos x = word0(&d);
207 1.1 christos y = word1(&d);
208 1.1 christos /* sscanf(buf+1, "%lx %lx:%d %d", &x, &y, &mode, &ndigits); */
209 1.1 christos x = (ULong)strtoul(s1 = buf+1, &se, 16);
210 1.1 christos if (se > s1) {
211 1.1 christos y = (ULong)strtoul(s1 = se, &se, 16);
212 1.1 christos if (se > s1)
213 1.1 christos sscanf(se, ":%d %d", &mode, &ndigits);
214 1.1 christos }
215 1.1 christos word0(&d) = x;
216 1.1 christos word1(&d) = y;
217 1.1 christos fmt = "Output: d =\n%.17g = 0x%lx %lx\n";
218 1.1 christos }
219 1.1 christos else if (*buf == '*') {
220 1.1 christos x = strtoul(buf,&s,10);
221 1.1 christos if (!*s && x > 18)
222 1.1 christos STRTOD_DIGLIM = (int)x;
223 1.1 christos printf("STRTOD_DIGLIM = %lu\n", UL x);
224 1.1 christos continue;
225 1.1 christos }
226 1.1 christos else {
227 1.1 christos errno = 0;
228 1.1 christos dval(&d) = strtod(buf,&se);
229 1.1 christos if (*se == ':')
230 1.1 christos sscanf(se+1,"%d %d", &mode, &ndigits);
231 1.1 christos dval(&d1) = atof(buf);
232 1.1 christos fmt = "Output: d =\n%.17g = 0x%lx %lx, se = %s";
233 1.1 christos if (errno)
234 1.1 christos baderrno();
235 1.1 christos }
236 1.1 christos printf(fmt, dval(&d), UL word0(&d), UL word1(&d), se);
237 1.1 christos g_fmt(buf1, dval(&d));
238 1.1 christos printf("\tg_fmt gives \"%s\"\n", buf1);
239 1.1 christos if (*buf != '#' && dval(&d) != dval(&d1))
240 1.1 christos printf("atof gives\n\
241 1.1 christos d1 = %.17g = 0x%lx %lx\nversus\n\
242 1.1 christos d = %.17g = 0x%lx %lx\n", dval(&d1), UL word0(&d1), UL word1(&d1),
243 1.1 christos dval(&d), UL word0(&d), UL word1(&d));
244 1.1 christos check(&d);
245 1.1 christos s = dtoa(dval(&d), mode, ndigits, &decpt, &sign, &se);
246 1.1 christos printf("\tdtoa(mode = %d, ndigits = %d):\n", mode, ndigits);
247 1.1 christos printf("\tdtoa returns sign = %d, decpt = %d, %d digits:\n%s\n",
248 1.1 christos sign, decpt, (int)(se-s), s);
249 1.1 christos x = word1(&d);
250 1.1 christos if (x != 0xffffffff
251 1.1 christos && (word0(&d) & 0x7ff00000) != 0x7ff00000) {
252 1.1 christos #ifdef VAX
253 1.1 christos z = x << 16 | x >> 16;
254 1.1 christos z++;
255 1.1 christos z = z << 16 | z >> 16;
256 1.1 christos word1(&d) = z;
257 1.1 christos #else
258 1.1 christos word1(&d) = x + 1;
259 1.1 christos #endif
260 1.1 christos printf("\tnextafter(d,+Inf) = %.17g = 0x%lx %lx:\n",
261 1.1 christos dval(&d), UL word0(&d), UL word1(&d));
262 1.1 christos g_fmt(buf1, dval(&d));
263 1.1 christos printf("\tg_fmt gives \"%s\"\n", buf1);
264 1.1 christos s = dtoa(dval(&d), mode, ndigits, &decpt, &sign, &se);
265 1.1 christos printf(
266 1.1 christos "\tdtoa returns sign = %d, decpt = %d, %d digits:\n%s\n",
267 1.1 christos sign, decpt, (int)(se-s), s);
268 1.1 christos check(&d);
269 1.1 christos }
270 1.1 christos if (x) {
271 1.1 christos #ifdef VAX
272 1.1 christos z = x << 16 | x >> 16;
273 1.1 christos z--;
274 1.1 christos z = z << 16 | z >> 16;
275 1.1 christos word1(&d) = z;
276 1.1 christos #else
277 1.1 christos word1(&d) = x - 1;
278 1.1 christos #endif
279 1.1 christos printf("\tnextafter(d,-Inf) = %.17g = 0x%lx %lx:\n",
280 1.1 christos dval(&d), UL word0(&d), UL word1(&d));
281 1.1 christos g_fmt(buf1, dval(&d));
282 1.1 christos printf("\tg_fmt gives \"%s\"\n", buf1);
283 1.1 christos s = dtoa(dval(&d), mode, ndigits, &decpt, &sign, &se);
284 1.1 christos printf(
285 1.1 christos "\tdtoa returns sign = %d, decpt = %d, %d digits:\n%s\n",
286 1.1 christos sign, decpt, (int)(se-s), s);
287 1.1 christos check(&d);
288 1.1 christos }
289 1.1 christos }
290 1.1 christos return 0;
291 1.1 christos }
292