Subversion Repositories Kolibri OS

Rev

Rev 4874 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
4349 Serge 1
/*
2
FUNCTION
3
        <>, <>---string to double or float
4
 
5
INDEX
6
	strtod
7
INDEX
8
	_strtod_r
9
INDEX
10
	strtof
11
 
12
ANSI_SYNOPSIS
13
        #include 
4921 Serge 14
        double strtod(const char *restrict <[str]>, char **restrict <[tail]>);
15
        float strtof(const char *restrict <[str]>, char **restrict <[tail]>);
4349 Serge 16
 
17
        double _strtod_r(void *<[reent]>,
4921 Serge 18
                         const char *restrict <[str]>, char **restrict <[tail]>);
4349 Serge 19
 
20
TRAD_SYNOPSIS
21
        #include 
22
        double strtod(<[str]>,<[tail]>)
23
        char *<[str]>;
24
        char **<[tail]>;
25
 
26
        float strtof(<[str]>,<[tail]>)
27
        char *<[str]>;
28
        char **<[tail]>;
29
 
30
        double _strtod_r(<[reent]>,<[str]>,<[tail]>)
31
	char *<[reent]>;
32
        char *<[str]>;
33
        char **<[tail]>;
34
 
35
DESCRIPTION
36
	The function <> parses the character string <[str]>,
37
	producing a substring which can be converted to a double
38
	value.  The substring converted is the longest initial
39
	subsequence of <[str]>, beginning with the first
40
	non-whitespace character, that has one of these formats:
41
	.[+|-]<[digits]>[.[<[digits]>]][(e|E)[+|-]<[digits]>]
42
	.[+|-].<[digits]>[(e|E)[+|-]<[digits]>]
43
	.[+|-](i|I)(n|N)(f|F)[(i|I)(n|N)(i|I)(t|T)(y|Y)]
44
	.[+|-](n|N)(a|A)(n|N)[<(>[<[hexdigits]>]<)>]
45
	.[+|-]0(x|X)<[hexdigits]>[.[<[hexdigits]>]][(p|P)[+|-]<[digits]>]
46
	.[+|-]0(x|X).<[hexdigits]>[(p|P)[+|-]<[digits]>]
47
	The substring contains no characters if <[str]> is empty, consists
48
	entirely of whitespace, or if the first non-whitespace
49
	character is something other than <<+>>, <<->>, <<.>>, or a
50
	digit, and cannot be parsed as infinity or NaN. If the platform
51
	does not support NaN, then NaN is treated as an empty substring.
52
	If the substring is empty, no conversion is done, and
53
	the value of <[str]> is stored in <<*<[tail]>>>.  Otherwise,
54
	the substring is converted, and a pointer to the final string
55
	(which will contain at least the terminating null character of
56
	<[str]>) is stored in <<*<[tail]>>>.  If you want no
57
	assignment to <<*<[tail]>>>, pass a null pointer as <[tail]>.
58
	<> is identical to <> except for its return type.
59
 
60
	This implementation returns the nearest machine number to the
61
	input decimal string.  Ties are broken by using the IEEE
62
	round-even rule.  However, <> is currently subject to
63
	double rounding errors.
64
 
65
	The alternate function <<_strtod_r>> is a reentrant version.
66
	The extra argument <[reent]> is a pointer to a reentrancy structure.
67
 
68
RETURNS
69
	<> returns the converted substring value, if any.  If
70
	no conversion could be performed, 0 is returned.  If the
71
	correct value is out of the range of representable values,
72
	plus or minus <> is returned, and <> is
73
	stored in errno. If the correct value would cause underflow, 0
74
	is returned and <> is stored in errno.
75
 
76
Supporting OS subroutines required: <>, <>, <>,
77
<>, <>, <>, <>.
78
*/
79
 
80
/****************************************************************
81
 
82
The author of this software is David M. Gay.
83
 
84
Copyright (C) 1998-2001 by Lucent Technologies
85
All Rights Reserved
86
 
87
Permission to use, copy, modify, and distribute this software and
88
its documentation for any purpose and without fee is hereby
89
granted, provided that the above copyright notice appear in all
90
copies and that both that the copyright notice and this
91
permission notice and warranty disclaimer appear in supporting
92
documentation, and that the name of Lucent or any of its entities
93
not be used in advertising or publicity pertaining to
94
distribution of the software without specific, written prior
95
permission.
96
 
97
LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
98
INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
99
IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
100
SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
101
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
102
IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
103
ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
104
THIS SOFTWARE.
105
 
106
****************************************************************/
107
 
108
/* Please send bug reports to David M. Gay (dmg at acm dot org,
109
 * with " at " changed at "@" and " dot " changed to ".").	*/
110
 
111
/* Original file gdtoa-strtod.c Modified 06-21-2006 by Jeff Johnston to work within newlib.  */
112
 
113
#include <_ansi.h>
114
#include 
115
#include 
116
#include 
117
#include "mprec.h"
118
#include "gdtoa.h"
119
#include "gd_qnan.h"
120
 
121
/* #ifndef NO_FENV_H */
122
/* #include  */
123
/* #endif */
124
 
125
#include "locale.h"
126
 
127
#ifdef IEEE_Arith
128
#ifndef NO_IEEE_Scale
129
#define Avoid_Underflow
130
#undef tinytens
4921 Serge 131
/* The factor of 2^106 in tinytens[4] helps us avoid setting the underflow */
4349 Serge 132
/* flag unnecessarily.  It leads to a song and dance at the end of strtod. */
4921 Serge 133
static _CONST double tinytens[] = { 1e-16, 1e-32,
134
#ifdef _DOUBLE_IS_32BITS
135
				    0.0, 0.0, 0.0
136
#else
137
				    1e-64, 1e-128,
138
				    9007199254740992. * 9007199254740992.e-256
139
#endif
4349 Serge 140
		};
4921 Serge 141
 
4349 Serge 142
#endif
143
#endif
144
 
145
#ifdef Honor_FLT_ROUNDS
146
#define Rounding rounding
147
#undef Check_FLT_ROUNDS
148
#define Check_FLT_ROUNDS
149
#else
150
#define Rounding Flt_Rounds
151
#endif
152
 
4921 Serge 153
#ifdef Avoid_Underflow /*{*/
154
 static double
155
_DEFUN (sulp, (x, scale),
156
       	U x _AND
157
	int scale)
158
{
159
        U u;
160
        double rv;
161
        int i;
162
 
163
        rv = ulp(dval(x));
164
        if (!scale || (i = 2*P + 1 - ((dword0(x) & Exp_mask) >> Exp_shift)) <= 0)
165
                return rv; /* Is there an example where i <= 0 ? */
166
        dword0(u) = Exp_1 + (i << Exp_shift);
167
#ifndef _DOUBLE_IS_32BITS
168
        dword1(u) = 0;
169
#endif
170
        return rv * u.d;
171
        }
172
#endif /*}*/
173
 
174
 
4349 Serge 175
#ifndef NO_HEX_FP
176
 
177
static void
178
_DEFUN (ULtod, (L, bits, exp, k),
179
	__ULong *L _AND
180
	__ULong *bits _AND
181
	Long exp _AND
182
	int k)
183
{
184
	switch(k & STRTOG_Retmask) {
185
	  case STRTOG_NoNumber:
186
	  case STRTOG_Zero:
187
		L[0] = L[1] = 0;
188
		break;
189
 
190
	  case STRTOG_Denormal:
191
		L[_1] = bits[0];
192
		L[_0] = bits[1];
193
		break;
194
 
195
	  case STRTOG_Normal:
196
	  case STRTOG_NaNbits:
197
		L[_1] = bits[0];
198
		L[_0] = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
199
		break;
200
 
201
	  case STRTOG_Infinite:
202
		L[_0] = 0x7ff00000;
203
		L[_1] = 0;
204
		break;
205
 
206
	  case STRTOG_NaN:
207
		L[_0] = 0x7fffffff;
208
		L[_1] = (__ULong)-1;
209
	  }
210
	if (k & STRTOG_Neg)
211
		L[_0] |= 0x80000000L;
212
}
213
#endif /* !NO_HEX_FP */
214
 
215
#ifdef INFNAN_CHECK
216
static int
217
_DEFUN (match, (sp, t),
218
	_CONST char **sp _AND
219
	char *t)
220
{
221
	int c, d;
222
	_CONST char *s = *sp;
223
 
224
	while( (d = *t++) !=0) {
225
		if ((c = *++s) >= 'A' && c <= 'Z')
226
			c += 'a' - 'A';
227
		if (c != d)
228
			return 0;
229
		}
230
	*sp = s + 1;
231
	return 1;
232
}
233
#endif /* INFNAN_CHECK */
234
 
235
 
236
double
237
_DEFUN (_strtod_r, (ptr, s00, se),
238
	struct _reent *ptr _AND
4921 Serge 239
	_CONST char *__restrict s00 _AND
240
	char **__restrict se)
4349 Serge 241
{
242
#ifdef Avoid_Underflow
243
	int scale;
244
#endif
245
	int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
246
		 e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
247
	_CONST char *s, *s0, *s1;
248
	double aadj, adj;
249
	U aadj1, rv, rv0;
250
	Long L;
251
	__ULong y, z;
4921 Serge 252
	_Bigint *bb = NULL, *bb1, *bd = NULL, *bd0, *bs = NULL, *delta = NULL;
253
#ifdef Avoid_Underflow
254
	__ULong Lsb, Lsb1;
255
#endif
4349 Serge 256
#ifdef SET_INEXACT
257
	int inexact, oldinexact;
258
#endif
259
#ifdef Honor_FLT_ROUNDS
260
	int rounding;
261
#endif
262
 
263
	delta = bs = bd = NULL;
264
	sign = nz0 = nz = decpt = 0;
265
	dval(rv) = 0.;
266
	for(s = s00;;s++) switch(*s) {
267
		case '-':
268
			sign = 1;
269
			/* no break */
270
		case '+':
271
			if (*++s)
272
				goto break2;
273
			/* no break */
274
		case 0:
275
			goto ret0;
276
		case '\t':
277
		case '\n':
278
		case '\v':
279
		case '\f':
280
		case '\r':
281
		case ' ':
282
			continue;
283
		default:
284
			goto break2;
285
		}
286
 break2:
287
	if (*s == '0') {
288
#ifndef NO_HEX_FP
289
		{
4921 Serge 290
		static _CONST FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
4349 Serge 291
		Long exp;
292
		__ULong bits[2];
293
		switch(s[1]) {
294
		  case 'x':
295
		  case 'X':
296
			/* If the number is not hex, then the parse of
297
 
298
			s00 = s + 1;
299
			{
300
#if defined(FE_DOWNWARD) && defined(FE_TONEAREST) && defined(FE_TOWARDZERO) && defined(FE_UPWARD)
301
			FPI fpi1 = fpi;
302
			switch(fegetround()) {
303
			  case FE_TOWARDZERO:	fpi1.rounding = 0; break;
304
			  case FE_UPWARD:	fpi1.rounding = 2; break;
305
			  case FE_DOWNWARD:	fpi1.rounding = 3;
306
			  }
307
#else
308
#define fpi1 fpi
309
#endif
310
			switch((i = gethex(ptr, &s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
311
			  case STRTOG_NoNumber:
312
				s = s00;
4921 Serge 313
				sign = 0;
314
				/* FALLTHROUGH */
4349 Serge 315
			  case STRTOG_Zero:
316
				break;
317
			  default:
318
				if (bb) {
319
					copybits(bits, fpi.nbits, bb);
320
					Bfree(ptr,bb);
321
					}
322
				ULtod(rv.i, bits, exp, i);
323
			  }}
324
			goto ret;
325
		  }
326
		}
327
#endif
328
		nz0 = 1;
329
		while(*++s == '0') ;
330
		if (!*s)
331
			goto ret;
332
		}
333
	s0 = s;
334
	y = z = 0;
4921 Serge 335
	for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
4349 Serge 336
			if (nd < 9)
337
				y = 10*y + c - '0';
338
			else
339
				z = 10*z + c - '0';
340
	nd0 = nd;
341
	if (strncmp (s, _localeconv_r (ptr)->decimal_point,
4921 Serge 342
		     strlen (_localeconv_r (ptr)->decimal_point)) == 0)
343
		{
4349 Serge 344
		decpt = 1;
345
		c = *(s += strlen (_localeconv_r (ptr)->decimal_point));
346
		if (!nd) {
347
			for(; c == '0'; c = *++s)
348
				nz++;
349
			if (c > '0' && c <= '9') {
350
				s0 = s;
351
				nf += nz;
352
				nz = 0;
353
				goto have_dig;
354
				}
355
			goto dig_done;
356
			}
357
		for(; c >= '0' && c <= '9'; c = *++s) {
358
 have_dig:
359
			nz++;
360
			if (c -= '0') {
4921 Serge 361
				nf += nz;
362
				for(i = 1; i < nz; i++)
363
					if (nd++ < 9)
4349 Serge 364
							y *= 10;
4921 Serge 365
					else if (nd <= DBL_DIG + 1)
4349 Serge 366
							z *= 10;
4921 Serge 367
				if (nd++ < 9)
4349 Serge 368
						y = 10*y + c;
4921 Serge 369
				else if (nd <= DBL_DIG + 1)
4349 Serge 370
						z = 10*z + c;
371
				nz = 0;
372
				}
373
			}
374
		}
375
 dig_done:
376
	e = 0;
377
	if (c == 'e' || c == 'E') {
378
		if (!nd && !nz && !nz0) {
379
			goto ret0;
380
			}
381
		s00 = s;
382
		esign = 0;
383
		switch(c = *++s) {
384
			case '-':
385
				esign = 1;
386
			case '+':
387
				c = *++s;
388
			}
389
		if (c >= '0' && c <= '9') {
390
			while(c == '0')
391
				c = *++s;
392
			if (c > '0' && c <= '9') {
393
				L = c - '0';
394
				s1 = s;
395
				while((c = *++s) >= '0' && c <= '9')
396
					L = 10*L + c - '0';
397
				if (s - s1 > 8 || L > 19999)
398
					/* Avoid confusion from exponents
399
					 * so large that e might overflow.
400
					 */
401
					e = 19999; /* safe for 16 bit ints */
402
				else
403
					e = (int)L;
404
				if (esign)
405
					e = -e;
406
				}
407
			else
408
				e = 0;
409
			}
410
		else
411
			s = s00;
412
		}
413
	if (!nd) {
414
		if (!nz && !nz0) {
415
#ifdef INFNAN_CHECK
416
			/* Check for Nan and Infinity */
417
			__ULong bits[2];
4921 Serge 418
			static _CONST FPI fpinan =	/* only 52 explicit bits */
4349 Serge 419
				{ 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
420
			if (!decpt)
421
			 switch(c) {
422
			  case 'i':
423
			  case 'I':
424
				if (match(&s,"nf")) {
425
					--s;
426
					if (!match(&s,"inity"))
427
						++s;
428
					dword0(rv) = 0x7ff00000;
429
#ifndef _DOUBLE_IS_32BITS
430
					dword1(rv) = 0;
431
#endif /*!_DOUBLE_IS_32BITS*/
432
					goto ret;
433
					}
434
				break;
435
			  case 'n':
436
			  case 'N':
437
				if (match(&s, "an")) {
438
#ifndef No_Hex_NaN
439
					if (*s == '(' /*)*/
440
					 && hexnan(&s, &fpinan, bits)
441
							== STRTOG_NaNbits) {
442
						dword0(rv) = 0x7ff00000 | bits[1];
443
#ifndef _DOUBLE_IS_32BITS
444
						dword1(rv) = bits[0];
445
#endif /*!_DOUBLE_IS_32BITS*/
446
						}
447
					else {
448
#endif
449
						dword0(rv) = NAN_WORD0;
450
#ifndef _DOUBLE_IS_32BITS
451
						dword1(rv) = NAN_WORD1;
452
#endif /*!_DOUBLE_IS_32BITS*/
453
#ifndef No_Hex_NaN
454
						}
455
#endif
456
					goto ret;
457
					}
458
			  }
459
#endif /* INFNAN_CHECK */
460
 ret0:
461
			s = s00;
462
			sign = 0;
463
			}
464
		goto ret;
465
		}
466
	e1 = e -= nf;
467
 
468
	/* Now we have nd0 digits, starting at s0, followed by a
469
	 * decimal point, followed by nd-nd0 digits.  The number we're
470
	 * after is the integer represented by those digits times
471
	 * 10**e */
472
 
473
	if (!nd0)
474
		nd0 = nd;
475
	k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
476
	dval(rv) = y;
477
	if (k > 9) {
478
#ifdef SET_INEXACT
479
		if (k > DBL_DIG)
480
			oldinexact = get_inexact();
481
#endif
482
		dval(rv) = tens[k - 9] * dval(rv) + z;
483
		}
484
	bd0 = 0;
485
	if (nd <= DBL_DIG
486
#ifndef RND_PRODQUOT
487
#ifndef Honor_FLT_ROUNDS
488
		&& Flt_Rounds == 1
489
#endif
490
#endif
491
			) {
492
		if (!e)
493
			goto ret;
494
		if (e > 0) {
495
			if (e <= Ten_pmax) {
496
#ifdef VAX
497
				goto vax_ovfl_check;
498
#else
499
#ifdef Honor_FLT_ROUNDS
500
				/* round correctly FLT_ROUNDS = 2 or 3 */
501
				if (sign) {
502
					dval(rv) = -dval(rv);
503
					sign = 0;
504
					}
505
#endif
506
				/* rv = */ rounded_product(dval(rv), tens[e]);
507
				goto ret;
508
#endif
509
				}
510
			i = DBL_DIG - nd;
511
			if (e <= Ten_pmax + i) {
512
				/* A fancier test would sometimes let us do
513
				 * this for larger i values.
514
				 */
515
#ifdef Honor_FLT_ROUNDS
516
				/* round correctly FLT_ROUNDS = 2 or 3 */
517
				if (sign) {
518
					dval(rv) = -dval(rv);
519
					sign = 0;
520
					}
521
#endif
522
				e -= i;
523
				dval(rv) *= tens[i];
524
#ifdef VAX
525
				/* VAX exponent range is so narrow we must
526
				 * worry about overflow here...
527
				 */
528
 vax_ovfl_check:
529
				dword0(rv) -= P*Exp_msk1;
530
				/* rv = */ rounded_product(dval(rv), tens[e]);
531
				if ((dword0(rv) & Exp_mask)
532
				 > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
533
					goto ovfl;
534
				dword0(rv) += P*Exp_msk1;
535
#else
536
				/* rv = */ rounded_product(dval(rv), tens[e]);
537
#endif
538
				goto ret;
539
				}
540
			}
541
#ifndef Inaccurate_Divide
542
		else if (e >= -Ten_pmax) {
543
#ifdef Honor_FLT_ROUNDS
544
			/* round correctly FLT_ROUNDS = 2 or 3 */
545
			if (sign) {
546
				dval(rv) = -dval(rv);
547
				sign = 0;
548
				}
549
#endif
550
			/* rv = */ rounded_quotient(dval(rv), tens[-e]);
551
			goto ret;
552
			}
553
#endif
554
		}
555
	e1 += nd - k;
556
 
557
#ifdef IEEE_Arith
558
#ifdef SET_INEXACT
559
	inexact = 1;
560
	if (k <= DBL_DIG)
561
		oldinexact = get_inexact();
562
#endif
563
#ifdef Avoid_Underflow
564
	scale = 0;
565
#endif
566
#ifdef Honor_FLT_ROUNDS
567
	if ((rounding = Flt_Rounds) >= 2) {
568
		if (sign)
569
			rounding = rounding == 2 ? 0 : 2;
570
		else
571
			if (rounding != 2)
572
				rounding = 0;
573
		}
574
#endif
575
#endif /*IEEE_Arith*/
576
 
577
	/* Get starting approximation = rv * 10**e1 */
578
 
579
	if (e1 > 0) {
580
		if ( (i = e1 & 15) !=0)
581
			dval(rv) *= tens[i];
582
		if (e1 &= ~15) {
583
			if (e1 > DBL_MAX_10_EXP) {
584
 ovfl:
585
#ifndef NO_ERRNO
586
				ptr->_errno = ERANGE;
587
#endif
588
				/* Can't trust HUGE_VAL */
589
#ifdef IEEE_Arith
590
#ifdef Honor_FLT_ROUNDS
591
				switch(rounding) {
592
				  case 0: /* toward 0 */
593
				  case 3: /* toward -infinity */
594
					dword0(rv) = Big0;
595
#ifndef _DOUBLE_IS_32BITS
596
					dword1(rv) = Big1;
597
#endif /*!_DOUBLE_IS_32BITS*/
598
					break;
599
				  default:
600
					dword0(rv) = Exp_mask;
601
#ifndef _DOUBLE_IS_32BITS
602
					dword1(rv) = 0;
603
#endif /*!_DOUBLE_IS_32BITS*/
604
				  }
605
#else /*Honor_FLT_ROUNDS*/
606
				dword0(rv) = Exp_mask;
607
#ifndef _DOUBLE_IS_32BITS
608
				dword1(rv) = 0;
609
#endif /*!_DOUBLE_IS_32BITS*/
610
#endif /*Honor_FLT_ROUNDS*/
611
#ifdef SET_INEXACT
612
				/* set overflow bit */
613
				dval(rv0) = 1e300;
614
				dval(rv0) *= dval(rv0);
615
#endif
616
#else /*IEEE_Arith*/
617
				dword0(rv) = Big0;
618
#ifndef _DOUBLE_IS_32BITS
619
				dword1(rv) = Big1;
620
#endif /*!_DOUBLE_IS_32BITS*/
621
#endif /*IEEE_Arith*/
622
				if (bd0)
623
					goto retfree;
624
				goto ret;
625
				}
626
			e1 >>= 4;
627
			for(j = 0; e1 > 1; j++, e1 >>= 1)
628
				if (e1 & 1)
629
					dval(rv) *= bigtens[j];
630
		/* The last multiplication could overflow. */
631
			dword0(rv) -= P*Exp_msk1;
632
			dval(rv) *= bigtens[j];
633
			if ((z = dword0(rv) & Exp_mask)
634
			 > Exp_msk1*(DBL_MAX_EXP+Bias-P))
635
				goto ovfl;
636
			if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
637
				/* set to largest number */
638
				/* (Can't trust DBL_MAX) */
639
				dword0(rv) = Big0;
640
#ifndef _DOUBLE_IS_32BITS
641
				dword1(rv) = Big1;
642
#endif /*!_DOUBLE_IS_32BITS*/
643
				}
644
			else
645
				dword0(rv) += P*Exp_msk1;
646
			}
647
		}
648
	else if (e1 < 0) {
649
		e1 = -e1;
650
		if ( (i = e1 & 15) !=0)
651
			dval(rv) /= tens[i];
652
		if (e1 >>= 4) {
653
			if (e1 >= 1 << n_bigtens)
654
				goto undfl;
655
#ifdef Avoid_Underflow
656
			if (e1 & Scale_Bit)
657
				scale = 2*P;
658
			for(j = 0; e1 > 0; j++, e1 >>= 1)
659
				if (e1 & 1)
660
					dval(rv) *= tinytens[j];
661
			if (scale && (j = 2*P + 1 - ((dword0(rv) & Exp_mask)
662
						>> Exp_shift)) > 0) {
663
				/* scaled rv is denormal; zap j low bits */
664
				if (j >= 32) {
665
#ifndef _DOUBLE_IS_32BITS
666
					dword1(rv) = 0;
667
#endif /*!_DOUBLE_IS_32BITS*/
668
					if (j >= 53)
669
					 dword0(rv) = (P+2)*Exp_msk1;
670
					else
671
					 dword0(rv) &= 0xffffffff << (j-32);
672
					}
673
#ifndef _DOUBLE_IS_32BITS
674
				else
675
					dword1(rv) &= 0xffffffff << j;
676
#endif /*!_DOUBLE_IS_32BITS*/
677
				}
678
#else
679
			for(j = 0; e1 > 1; j++, e1 >>= 1)
680
				if (e1 & 1)
681
					dval(rv) *= tinytens[j];
682
			/* The last multiplication could underflow. */
683
			dval(rv0) = dval(rv);
684
			dval(rv) *= tinytens[j];
685
			if (!dval(rv)) {
686
				dval(rv) = 2.*dval(rv0);
687
				dval(rv) *= tinytens[j];
688
#endif
689
				if (!dval(rv)) {
690
 undfl:
691
					dval(rv) = 0.;
692
#ifndef NO_ERRNO
693
					ptr->_errno = ERANGE;
694
#endif
695
					if (bd0)
696
						goto retfree;
697
					goto ret;
698
					}
699
#ifndef Avoid_Underflow
700
#ifndef _DOUBLE_IS_32BITS
701
				dword0(rv) = Tiny0;
702
				dword1(rv) = Tiny1;
703
#else
704
				dword0(rv) = Tiny1;
705
#endif /*_DOUBLE_IS_32BITS*/
706
				/* The refinement below will clean
707
				 * this approximation up.
708
				 */
709
				}
710
#endif
711
			}
712
		}
713
 
714
	/* Now the hard part -- adjusting rv to the correct value.*/
715
 
716
	/* Put digits into bd: true value = bd * 10^e */
717
 
718
	bd0 = s2b(ptr, s0, nd0, nd, y);
4921 Serge 719
	if (bd0 == NULL)
720
		goto ovfl;
4349 Serge 721
 
722
	for(;;) {
723
		bd = Balloc(ptr,bd0->_k);
4921 Serge 724
		if (bd == NULL)
725
			goto ovfl;
4349 Serge 726
		Bcopy(bd, bd0);
727
		bb = d2b(ptr,dval(rv), &bbe, &bbbits);	/* rv = bb * 2^bbe */
4921 Serge 728
		if (bb == NULL)
729
			goto ovfl;
4349 Serge 730
		bs = i2b(ptr,1);
4921 Serge 731
		if (bs == NULL)
732
			goto ovfl;
4349 Serge 733
 
734
		if (e >= 0) {
735
			bb2 = bb5 = 0;
736
			bd2 = bd5 = e;
737
			}
738
		else {
739
			bb2 = bb5 = -e;
740
			bd2 = bd5 = 0;
741
			}
742
		if (bbe >= 0)
743
			bb2 += bbe;
744
		else
745
			bd2 -= bbe;
746
		bs2 = bb2;
747
#ifdef Honor_FLT_ROUNDS
748
		if (rounding != 1)
749
			bs2++;
750
#endif
751
#ifdef Avoid_Underflow
4921 Serge 752
		Lsb = LSB;
753
		Lsb1 = 0;
4349 Serge 754
		j = bbe - scale;
755
		i = j + bbbits - 1;	/* logb(rv) */
4921 Serge 756
		j = P + 1 - bbbits;
757
		if (i < Emin) {	/* denormal */
758
			i = Emin - i;
759
			j -= i;
760
			if (i < 32)
761
				Lsb <<= i;
4349 Serge 762
		else
4921 Serge 763
				Lsb1 = Lsb << (i-32);
764
			}
4349 Serge 765
#else /*Avoid_Underflow*/
766
#ifdef Sudden_Underflow
767
#ifdef IBM
768
		j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
769
#else
770
		j = P + 1 - bbbits;
771
#endif
772
#else /*Sudden_Underflow*/
773
		j = bbe;
774
		i = j + bbbits - 1;	/* logb(rv) */
775
		if (i < Emin)	/* denormal */
776
			j += P - Emin;
777
		else
778
			j = P + 1 - bbbits;
779
#endif /*Sudden_Underflow*/
780
#endif /*Avoid_Underflow*/
781
		bb2 += j;
782
		bd2 += j;
783
#ifdef Avoid_Underflow
784
		bd2 += scale;
785
#endif
786
		i = bb2 < bd2 ? bb2 : bd2;
787
		if (i > bs2)
788
			i = bs2;
789
		if (i > 0) {
790
			bb2 -= i;
791
			bd2 -= i;
792
			bs2 -= i;
793
			}
794
		if (bb5 > 0) {
795
			bs = pow5mult(ptr, bs, bb5);
4921 Serge 796
			if (bs == NULL)
797
				goto ovfl;
4349 Serge 798
			bb1 = mult(ptr, bs, bb);
4921 Serge 799
			if (bb1 == NULL)
800
				goto ovfl;
4349 Serge 801
			Bfree(ptr, bb);
802
			bb = bb1;
803
			}
4921 Serge 804
		if (bb2 > 0) {
4349 Serge 805
			bb = lshift(ptr, bb, bb2);
4921 Serge 806
			if (bb == NULL)
807
				goto ovfl;
808
			}
809
		if (bd5 > 0) {
4349 Serge 810
			bd = pow5mult(ptr, bd, bd5);
4921 Serge 811
			if (bd == NULL)
812
				goto ovfl;
813
			}
814
		if (bd2 > 0) {
4349 Serge 815
			bd = lshift(ptr, bd, bd2);
4921 Serge 816
			if (bd == NULL)
817
				goto ovfl;
818
			}
819
		if (bs2 > 0) {
4349 Serge 820
			bs = lshift(ptr, bs, bs2);
4921 Serge 821
			if (bs == NULL)
822
				goto ovfl;
823
			}
4349 Serge 824
		delta = diff(ptr, bb, bd);
4921 Serge 825
		if (delta == NULL)
826
			goto ovfl;
4349 Serge 827
		dsign = delta->_sign;
828
		delta->_sign = 0;
829
		i = cmp(delta, bs);
830
#ifdef Honor_FLT_ROUNDS
831
		if (rounding != 1) {
832
			if (i < 0) {
833
				/* Error is less than an ulp */
834
				if (!delta->_x[0] && delta->_wds <= 1) {
835
					/* exact */
836
#ifdef SET_INEXACT
837
					inexact = 0;
838
#endif
839
					break;
840
					}
841
				if (rounding) {
842
					if (dsign) {
843
						adj = 1.;
844
						goto apply_adj;
845
						}
846
					}
847
				else if (!dsign) {
848
					adj = -1.;
849
					if (!dword1(rv)
850
					 && !(dword0(rv) & Frac_mask)) {
851
						y = dword0(rv) & Exp_mask;
852
#ifdef Avoid_Underflow
853
						if (!scale || y > 2*P*Exp_msk1)
854
#else
855
						if (y)
856
#endif
857
						  {
858
						  delta = lshift(ptr, delta,Log2P);
859
						  if (cmp(delta, bs) <= 0)
860
							adj = -0.5;
861
						  }
862
						}
863
 apply_adj:
864
#ifdef Avoid_Underflow
865
					if (scale && (y = dword0(rv) & Exp_mask)
866
						<= 2*P*Exp_msk1)
867
					  dword0(adj) += (2*P+1)*Exp_msk1 - y;
868
#else
869
#ifdef Sudden_Underflow
870
					if ((dword0(rv) & Exp_mask) <=
871
							P*Exp_msk1) {
872
						dword0(rv) += P*Exp_msk1;
873
						dval(rv) += adj*ulp(dval(rv));
874
						dword0(rv) -= P*Exp_msk1;
875
						}
876
					else
877
#endif /*Sudden_Underflow*/
878
#endif /*Avoid_Underflow*/
879
					dval(rv) += adj*ulp(dval(rv));
880
					}
881
				break;
882
				}
883
			adj = ratio(delta, bs);
884
			if (adj < 1.)
885
				adj = 1.;
886
			if (adj <= 0x7ffffffe) {
887
				/* adj = rounding ? ceil(adj) : floor(adj); */
888
				y = adj;
889
				if (y != adj) {
890
					if (!((rounding>>1) ^ dsign))
891
						y++;
892
					adj = y;
893
					}
894
				}
895
#ifdef Avoid_Underflow
896
			if (scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
897
				dword0(adj) += (2*P+1)*Exp_msk1 - y;
898
#else
899
#ifdef Sudden_Underflow
900
			if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
901
				dword0(rv) += P*Exp_msk1;
902
				adj *= ulp(dval(rv));
903
				if (dsign)
904
					dval(rv) += adj;
905
				else
906
					dval(rv) -= adj;
907
				dword0(rv) -= P*Exp_msk1;
908
				goto cont;
909
				}
910
#endif /*Sudden_Underflow*/
911
#endif /*Avoid_Underflow*/
912
			adj *= ulp(dval(rv));
4921 Serge 913
			if (dsign) {
914
				if (dword0(rv) == Big0 && dword1(rv) == Big1)
915
					goto ovfl;
4349 Serge 916
				dval(rv) += adj;
917
			else
918
				dval(rv) -= adj;
919
			goto cont;
920
			}
921
#endif /*Honor_FLT_ROUNDS*/
922
 
923
		if (i < 0) {
924
			/* Error is less than half an ulp -- check for
925
			 * special case of mantissa a power of two.
926
			 */
927
			if (dsign || dword1(rv) || dword0(rv) & Bndry_mask
928
#ifdef IEEE_Arith
929
#ifdef Avoid_Underflow
930
			 || (dword0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1
931
#else
932
			 || (dword0(rv) & Exp_mask) <= Exp_msk1
933
#endif
934
#endif
935
				) {
936
#ifdef SET_INEXACT
937
				if (!delta->x[0] && delta->wds <= 1)
938
					inexact = 0;
939
#endif
940
				break;
941
				}
942
			if (!delta->_x[0] && delta->_wds <= 1) {
943
				/* exact result */
944
#ifdef SET_INEXACT
945
				inexact = 0;
946
#endif
947
				break;
948
				}
949
			delta = lshift(ptr,delta,Log2P);
950
			if (cmp(delta, bs) > 0)
951
				goto drop_down;
952
			break;
953
			}
954
		if (i == 0) {
955
			/* exactly half-way between */
956
			if (dsign) {
957
				if ((dword0(rv) & Bndry_mask1) == Bndry_mask1
958
				 &&  dword1(rv) == (
959
#ifdef Avoid_Underflow
960
			(scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
961
		? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
962
#endif
963
						   0xffffffff)) {
964
					/*boundary case -- increment exponent*/
4921 Serge 965
					if (dword0(rv) == Big0 && dword1(rv) == Big1)
966
						goto ovfl;
4349 Serge 967
					dword0(rv) = (dword0(rv) & Exp_mask)
968
						+ Exp_msk1
969
#ifdef IBM
970
						| Exp_msk1 >> 4
971
#endif
972
						;
973
#ifndef _DOUBLE_IS_32BITS
974
					dword1(rv) = 0;
975
#endif /*!_DOUBLE_IS_32BITS*/
976
#ifdef Avoid_Underflow
977
					dsign = 0;
978
#endif
979
					break;
980
					}
981
				}
982
			else if (!(dword0(rv) & Bndry_mask) && !dword1(rv)) {
983
 drop_down:
984
				/* boundary case -- decrement exponent */
985
#ifdef Sudden_Underflow /*{{*/
986
				L = dword0(rv) & Exp_mask;
987
#ifdef IBM
988
				if (L <  Exp_msk1)
989
#else
990
#ifdef Avoid_Underflow
991
				if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
992
#else
993
				if (L <= Exp_msk1)
994
#endif /*Avoid_Underflow*/
995
#endif /*IBM*/
996
					goto undfl;
997
				L -= Exp_msk1;
998
#else /*Sudden_Underflow}{*/
999
#ifdef Avoid_Underflow
1000
				if (scale) {
1001
					L = dword0(rv) & Exp_mask;
1002
					if (L <= (2*P+1)*Exp_msk1) {
1003
						if (L > (P+2)*Exp_msk1)
1004
							/* round even ==> */
1005
							/* accept rv */
1006
							break;
1007
						/* rv = smallest denormal */
1008
						goto undfl;
1009
						}
1010
					}
1011
#endif /*Avoid_Underflow*/
1012
				L = (dword0(rv) & Exp_mask) - Exp_msk1;
1013
#endif /*Sudden_Underflow}*/
1014
				dword0(rv) = L | Bndry_mask1;
1015
#ifndef _DOUBLE_IS_32BITS
1016
				dword1(rv) = 0xffffffff;
1017
#endif /*!_DOUBLE_IS_32BITS*/
1018
#ifdef IBM
1019
				goto cont;
1020
#else
1021
				break;
1022
#endif
1023
				}
1024
#ifndef ROUND_BIASED
4921 Serge 1025
#ifdef Avoid_Underflow
1026
			if (Lsb1) {
1027
				if (!(dword0(rv) & Lsb1))
1028
					break;
1029
				}
1030
			else if (!(dword1(rv) & Lsb))
1031
				break;
1032
#else
4349 Serge 1033
			if (!(dword1(rv) & LSB))
1034
				break;
1035
#endif
4921 Serge 1036
#endif
4349 Serge 1037
			if (dsign)
4921 Serge 1038
#ifdef Avoid_Underflow
1039
				dval(rv) += sulp(rv, scale);
1040
#else
4349 Serge 1041
				dval(rv) += ulp(dval(rv));
4921 Serge 1042
#endif
4349 Serge 1043
#ifndef ROUND_BIASED
1044
			else {
4921 Serge 1045
#ifdef Avoid_Underflow
1046
				dval(rv) -= sulp(rv, scale);
1047
#else
4349 Serge 1048
				dval(rv) -= ulp(dval(rv));
4921 Serge 1049
#endif
4349 Serge 1050
#ifndef Sudden_Underflow
1051
				if (!dval(rv))
1052
					goto undfl;
1053
#endif
1054
				}
1055
#ifdef Avoid_Underflow
1056
			dsign = 1 - dsign;
1057
#endif
1058
#endif
1059
			break;
1060
			}
1061
		if ((aadj = ratio(delta, bs)) <= 2.) {
1062
			if (dsign)
1063
				aadj = dval(aadj1) = 1.;
1064
			else if (dword1(rv) || dword0(rv) & Bndry_mask) {
1065
#ifndef Sudden_Underflow
1066
				if (dword1(rv) == Tiny1 && !dword0(rv))
1067
					goto undfl;
1068
#endif
1069
				aadj = 1.;
1070
				dval(aadj1) = -1.;
1071
				}
1072
			else {
1073
				/* special case -- power of FLT_RADIX to be */
1074
				/* rounded down... */
1075
 
1076
				if (aadj < 2./FLT_RADIX)
1077
					aadj = 1./FLT_RADIX;
1078
				else
1079
					aadj *= 0.5;
1080
				dval(aadj1) = -aadj;
1081
				}
1082
			}
1083
		else {
1084
			aadj *= 0.5;
1085
			dval(aadj1) = dsign ? aadj : -aadj;
1086
#ifdef Check_FLT_ROUNDS
1087
			switch(Rounding) {
1088
				case 2: /* towards +infinity */
1089
					dval(aadj1) -= 0.5;
1090
					break;
1091
				case 0: /* towards 0 */
1092
				case 3: /* towards -infinity */
1093
					dval(aadj1) += 0.5;
1094
				}
1095
#else
1096
			if (Flt_Rounds == 0)
1097
				dval(aadj1) += 0.5;
1098
#endif /*Check_FLT_ROUNDS*/
1099
			}
1100
		y = dword0(rv) & Exp_mask;
1101
 
1102
		/* Check for overflow */
1103
 
1104
		if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
1105
			dval(rv0) = dval(rv);
1106
			dword0(rv) -= P*Exp_msk1;
1107
			adj = dval(aadj1) * ulp(dval(rv));
1108
			dval(rv) += adj;
1109
			if ((dword0(rv) & Exp_mask) >=
1110
					Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
1111
				if (dword0(rv0) == Big0 && dword1(rv0) == Big1)
1112
					goto ovfl;
1113
				dword0(rv) = Big0;
1114
#ifndef _DOUBLE_IS_32BITS
1115
				dword1(rv) = Big1;
1116
#endif /*!_DOUBLE_IS_32BITS*/
1117
				goto cont;
1118
				}
1119
			else
1120
				dword0(rv) += P*Exp_msk1;
1121
			}
1122
		else {
1123
#ifdef Avoid_Underflow
1124
			if (scale && y <= 2*P*Exp_msk1) {
1125
				if (aadj <= 0x7fffffff) {
4921 Serge 1126
					if ((z = aadj) == 0)
4349 Serge 1127
						z = 1;
1128
					aadj = z;
1129
					dval(aadj1) = dsign ? aadj : -aadj;
1130
					}
1131
				dword0(aadj1) += (2*P+1)*Exp_msk1 - y;
1132
				}
1133
			adj = dval(aadj1) * ulp(dval(rv));
1134
			dval(rv) += adj;
1135
#else
1136
#ifdef Sudden_Underflow
1137
			if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
1138
				dval(rv0) = dval(rv);
1139
				dword0(rv) += P*Exp_msk1;
1140
				adj = dval(aadj1) * ulp(dval(rv));
1141
				dval(rv) += adj;
1142
#ifdef IBM
1143
				if ((dword0(rv) & Exp_mask) <  P*Exp_msk1)
1144
#else
1145
				if ((dword0(rv) & Exp_mask) <= P*Exp_msk1)
1146
#endif
1147
					{
1148
					if (dword0(rv0) == Tiny0
1149
					 && dword1(rv0) == Tiny1)
1150
						goto undfl;
1151
#ifndef _DOUBLE_IS_32BITS
1152
					dword0(rv) = Tiny0;
1153
					dword1(rv) = Tiny1;
1154
#else
1155
					dword0(rv) = Tiny1;
1156
#endif /*_DOUBLE_IS_32BITS*/
1157
					goto cont;
1158
					}
1159
				else
1160
					dword0(rv) -= P*Exp_msk1;
1161
				}
1162
			else {
1163
				adj = dval(aadj1) * ulp(dval(rv));
1164
				dval(rv) += adj;
1165
				}
1166
#else /*Sudden_Underflow*/
1167
			/* Compute adj so that the IEEE rounding rules will
1168
			 * correctly round rv + adj in some half-way cases.
1169
			 * If rv * ulp(rv) is denormalized (i.e.,
1170
			 * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
1171
			 * trouble from bits lost to denormalization;
1172
			 * example: 1.2e-307 .
1173
			 */
1174
			if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
1175
				dval(aadj1) = (double)(int)(aadj + 0.5);
1176
				if (!dsign)
1177
					dval(aadj1) = -dval(aadj1);
1178
				}
1179
			adj = dval(aadj1) * ulp(dval(rv));
1180
			dval(rv) += adj;
1181
#endif /*Sudden_Underflow*/
1182
#endif /*Avoid_Underflow*/
1183
			}
1184
		z = dword0(rv) & Exp_mask;
1185
#ifndef SET_INEXACT
1186
#ifdef Avoid_Underflow
1187
		if (!scale)
1188
#endif
1189
		if (y == z) {
1190
			/* Can we stop now? */
1191
			L = (Long)aadj;
1192
			aadj -= L;
1193
			/* The tolerances below are conservative. */
1194
			if (dsign || dword1(rv) || dword0(rv) & Bndry_mask) {
1195
				if (aadj < .4999999 || aadj > .5000001)
1196
					break;
1197
				}
1198
			else if (aadj < .4999999/FLT_RADIX)
1199
				break;
1200
			}
1201
#endif
1202
 cont:
1203
		Bfree(ptr,bb);
1204
		Bfree(ptr,bd);
1205
		Bfree(ptr,bs);
1206
		Bfree(ptr,delta);
1207
		}
1208
#ifdef SET_INEXACT
1209
	if (inexact) {
1210
		if (!oldinexact) {
1211
			dword0(rv0) = Exp_1 + (70 << Exp_shift);
1212
#ifndef _DOUBLE_IS_32BITS
1213
			dword1(rv0) = 0;
1214
#endif /*!_DOUBLE_IS_32BITS*/
1215
			dval(rv0) += 1.;
1216
			}
1217
		}
1218
	else if (!oldinexact)
1219
		clear_inexact();
1220
#endif
1221
#ifdef Avoid_Underflow
1222
	if (scale) {
1223
		dword0(rv0) = Exp_1 - 2*P*Exp_msk1;
1224
#ifndef _DOUBLE_IS_32BITS
1225
		dword1(rv0) = 0;
1226
#endif /*!_DOUBLE_IS_32BITS*/
1227
		dval(rv) *= dval(rv0);
1228
#ifndef NO_ERRNO
1229
		/* try to avoid the bug of testing an 8087 register value */
1230
		if (dword0(rv) == 0 && dword1(rv) == 0)
1231
			ptr->_errno = ERANGE;
1232
#endif
1233
		}
1234
#endif /* Avoid_Underflow */
1235
#ifdef SET_INEXACT
1236
	if (inexact && !(dword0(rv) & Exp_mask)) {
1237
		/* set underflow bit */
1238
		dval(rv0) = 1e-300;
1239
		dval(rv0) *= dval(rv0);
1240
		}
1241
#endif
1242
 retfree:
1243
	Bfree(ptr,bb);
1244
	Bfree(ptr,bd);
1245
	Bfree(ptr,bs);
1246
	Bfree(ptr,bd0);
1247
	Bfree(ptr,delta);
1248
 ret:
1249
	if (se)
1250
		*se = (char *)s;
1251
	return sign ? -dval(rv) : dval(rv);
1252
}
1253
 
1254
#ifndef _REENT_ONLY
1255
 
1256
double
1257
_DEFUN (strtod, (s00, se),
4921 Serge 1258
	_CONST char *__restrict s00 _AND char **__restrict se)
4349 Serge 1259
{
1260
  return _strtod_r (_REENT, s00, se);
1261
}
1262
 
1263
float
1264
_DEFUN (strtof, (s00, se),
4921 Serge 1265
	_CONST char *__restrict s00 _AND
1266
	char **__restrict se)
4349 Serge 1267
{
1268
  double retval = _strtod_r (_REENT, s00, se);
1269
  if (isnan (retval))
1270
    return nanf (NULL);
1271
  return (float)retval;
1272
}
1273
 
1274
#endif