Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

strtodg.c @ 620

Last change on this file since 620 was 444, checked in by satin@…, 6 years ago
add newlib,libalmos-mkh, restructure shared_syscalls.h and mini-libc
File size: 21.3 KB

Line
1	/****************************************************************
2
3	The author of this software is David M. Gay.
4
5	Copyright (C) 1998-2001 by Lucent Technologies
6	All Rights Reserved
7
8	Permission to use, copy, modify, and distribute this software and
9	its documentation for any purpose and without fee is hereby
10	granted, provided that the above copyright notice appear in all
11	copies and that both that the copyright notice and this
12	permission notice and warranty disclaimer appear in supporting
13	documentation, and that the name of Lucent or any of its entities
14	not be used in advertising or publicity pertaining to
15	distribution of the software without specific, written prior
16	permission.
17
18	LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19	INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20	IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21	SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22	WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23	IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24	ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25	THIS SOFTWARE.
26
27	****************************************************************/
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 <_ansi.h>
33	#include <errno.h>
34	#include <stdlib.h>
35	#include <string.h>
36	#include "mprec.h"
37	#include "gdtoa.h"
38	#include "gd_qnan.h"
39
40	#include "locale.h"
41
42	#if defined (_HAVE_LONG_DOUBLE) && !defined (_LDBL_EQ_DBL)
43
44	#define USE_LOCALE
45
46	static const int
47	fivesbits[] = { 0, 3, 5, 7, 10, 12, 14, 17, 19, 21,
48	24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
49	47, 49, 52
50	#ifdef VAX
51	, 54, 56
52	#endif
53	};
54
55	static _Bigint *
56	sum (struct _reent p, _Bigint a, _Bigint *b)
57	{
58	_Bigint *c;
59	__ULong carry, xc, xa, xb, xe, y;
60	#ifdef Pack_32
61	__ULong z;
62	#endif
63
64	if (a->_wds < b->_wds) {
65	c = b; b = a; a = c;
66	}
67	c = Balloc(p, a->_k);
68	c->_wds = a->_wds;
69	carry = 0;
70	xa = a->_x;
71	xb = b->_x;
72	xc = c->_x;
73	xe = xc + b->_wds;
74	#ifdef Pack_32
75	do {
76	y = (xa & 0xffff) + (xb & 0xffff) + carry;
77	carry = (y & 0x10000) >> 16;
78	z = (xa++ >> 16) + (xb++ >> 16) + carry;
79	carry = (z & 0x10000) >> 16;
80	Storeinc(xc, z, y);
81	}
82	while(xc < xe);
83	xe += a->_wds - b->_wds;
84	while(xc < xe) {
85	y = (*xa & 0xffff) + carry;
86	carry = (y & 0x10000) >> 16;
87	z = (*xa++ >> 16) + carry;
88	carry = (z & 0x10000) >> 16;
89	Storeinc(xc, z, y);
90	}
91	#else
92	do {
93	y = xa++ + xb++ + carry;
94	carry = (y & 0x10000) >> 16;
95	*xc++ = y & 0xffff;
96	}
97	while(xc < xe);
98	xe += a->_wds - b->_wds;
99	while(xc < xe) {
100	y = *xa++ + carry;
101	carry = (y & 0x10000) >> 16;
102	*xc++ = y & 0xffff;
103	}
104	#endif
105	if (carry) {
106	if (c->_wds == c->_maxwds) {
107	b = Balloc(p, c->_k + 1);
108	Bcopy(b, c);
109	Bfree(p, c);
110	c = b;
111	}
112	c->_x[c->_wds++] = 1;
113	}
114	return c;
115	}
116
117	static void
118	rshift (_Bigint *b, int k)
119	{
120	__ULong x, x1, *xe, y;
121	int n;
122
123	x = x1 = b->_x;
124	n = k >> kshift;
125	if (n < b->_wds) {
126	xe = x + b->_wds;
127	x += n;
128	if (k &= kmask) {
129	n = ULbits - k;
130	y = *x++ >> k;
131	while(x < xe) {
132	x1++ = (y \| (x << n)) & ALL_ON;
133	y = *x++ >> k;
134	}
135	if ((*x1 = y) !=0)
136	x1++;
137	}
138	else
139	while(x < xe)
140	x1++ = x++;
141	}
142	if ((b->_wds = x1 - b->_x) == 0)
143	b->_x[0] = 0;
144	}
145
146	static int
147	trailz (_Bigint *b)
148	{
149	__ULong L, x, xe;
150	int n = 0;
151
152	x = b->_x;
153	xe = x + b->_wds;
154	for(n = 0; x < xe && !*x; x++)
155	n += ULbits;
156	if (x < xe) {
157	L = *x;
158	n += lo0bits(&L);
159	}
160	return n;
161	}
162
163	_Bigint *
164	increment (struct _reent p, _Bigint b)
165	{
166	__ULong x, xe;
167	_Bigint *b1;
168	#ifdef Pack_16
169	__ULong carry = 1, y;
170	#endif
171
172	x = b->_x;
173	xe = x + b->_wds;
174	#ifdef Pack_32
175	do {
176	if (*x < (__ULong)0xffffffffL) {
177	++*x;
178	return b;
179	}
180	*x++ = 0;
181	} while(x < xe);
182	#else
183	do {
184	y = *x + carry;
185	carry = y >> 16;
186	*x++ = y & 0xffff;
187	if (!carry)
188	return b;
189	} while(x < xe);
190	if (carry)
191	#endif
192	{
193	if (b->_wds >= b->_maxwds) {
194	b1 = Balloc(p,b->_k+1);
195	Bcopy(b1,b);
196	Bfree(p,b);
197	b = b1;
198	}
199	b->_x[b->_wds++] = 1;
200	}
201	return b;
202	}
203
204	int
205	decrement (_Bigint *b)
206	{
207	__ULong x, xe;
208	#ifdef Pack_16
209	__ULong borrow = 1, y;
210	#endif
211
212	x = b->_x;
213	xe = x + b->_wds;
214	#ifdef Pack_32
215	do {
216	if (*x) {
217	--*x;
218	break;
219	}
220	*x++ = 0xffffffffL;
221	}
222	while(x < xe);
223	#else
224	do {
225	y = *x - borrow;
226	borrow = (y & 0x10000) >> 16;
227	*x++ = y & 0xffff;
228	} while(borrow && x < xe);
229	#endif
230	return STRTOG_Inexlo;
231	}
232
233	static int
234	all_on (_Bigint *b, int n)
235	{
236	__ULong x, xe;
237
238	x = b->_x;
239	xe = x + (n >> kshift);
240	while(x < xe)
241	if ((*x++ & ALL_ON) != ALL_ON)
242	return 0;
243	if (n &= kmask)
244	return ((*x \| (ALL_ON << n)) & ALL_ON) == ALL_ON;
245	return 1;
246	}
247
248	_Bigint *
249	set_ones (struct _reent p, _Bigint b, int n)
250	{
251	int k;
252	__ULong x, xe;
253
254	k = (n + ((1 << kshift) - 1)) >> kshift;
255	if (b->_k < k) {
256	Bfree(p,b);
257	b = Balloc(p,k);
258	}
259	k = n >> kshift;
260	if (n &= kmask)
261	k++;
262	b->_wds = k;
263	x = b->_x;
264	xe = x + k;
265	while(x < xe)
266	*x++ = ALL_ON;
267	if (n)
268	x[-1] >>= ULbits - n;
269	return b;
270	}
271
272	static int
273	rvOK (struct _reent p, double d, FPI fpi, Long exp, __ULong bits, int exact,
274	int rd, int *irv)
275	{
276	_Bigint *b;
277	__ULong carry, inex, lostbits;
278	int bdif, e, j, k, k1, nb, rv;
279
280	carry = rv = 0;
281	b = d2b(p, d, &e, &bdif);
282	bdif -= nb = fpi->nbits;
283	e += bdif;
284	if (bdif <= 0) {
285	if (exact)
286	goto trunc;
287	goto ret;
288	}
289	if (P == nb) {
290	if (
291	#ifndef IMPRECISE_INEXACT
292	exact &&
293	#endif
294	fpi->rounding ==
295	#ifdef RND_PRODQUOT
296	FPI_Round_near
297	#else
298	Flt_Rounds
299	#endif
300	) goto trunc;
301	goto ret;
302	}
303	switch(rd) {
304	case 1:
305	goto trunc;
306	case 2:
307	break;
308	default: /* round near */
309	k = bdif - 1;
310	if (k < 0)
311	goto trunc;
312	if (!k) {
313	if (!exact)
314	goto ret;
315	if (b->_x[0] & 2)
316	break;
317	goto trunc;
318	}
319	if (b->_x[k>>kshift] & ((__ULong)1 << (k & kmask)))
320	break;
321	goto trunc;
322	}
323	/* "break" cases: round up 1 bit, then truncate; bdif > 0 */
324	carry = 1;
325	trunc:
326	inex = lostbits = 0;
327	if (bdif > 0) {
328	if ( (lostbits = any_on(b, bdif)) !=0)
329	inex = STRTOG_Inexlo;
330	rshift(b, bdif);
331	if (carry) {
332	inex = STRTOG_Inexhi;
333	b = increment(p, b);
334	if ( (j = nb & kmask) !=0)
335	j = ULbits - j;
336	if (hi0bits(b->_x[b->_wds - 1]) != j) {
337	if (!lostbits)
338	lostbits = b->_x[0] & 1;
339	rshift(b, 1);
340	e++;
341	}
342	}
343	}
344	else if (bdif < 0)
345	b = lshift(p, b, -bdif);
346	if (e < fpi->emin) {
347	k = fpi->emin - e;
348	e = fpi->emin;
349	if (k > nb \|\| fpi->sudden_underflow) {
350	b->_wds = inex = 0;
351	*irv = STRTOG_Underflow \| STRTOG_Inexlo;
352	}
353	else {
354	k1 = k - 1;
355	if (k1 > 0 && !lostbits)
356	lostbits = any_on(b, k1);
357	if (!lostbits && !exact)
358	goto ret;
359	lostbits \|=
360	carry = b->_x[k1>>kshift] & (1 << (k1 & kmask));
361	rshift(b, k);
362	*irv = STRTOG_Denormal;
363	if (carry) {
364	b = increment(p, b);
365	inex = STRTOG_Inexhi \| STRTOG_Underflow;
366	}
367	else if (lostbits)
368	inex = STRTOG_Inexlo \| STRTOG_Underflow;
369	}
370	}
371	else if (e > fpi->emax) {
372	e = fpi->emax + 1;
373	*irv = STRTOG_Infinite \| STRTOG_Overflow \| STRTOG_Inexhi;
374	#ifndef NO_ERRNO
375	errno = ERANGE;
376	#endif
377	b->_wds = inex = 0;
378	}
379	*exp = e;
380	copybits(bits, nb, b);
381	*irv \|= inex;
382	rv = 1;
383	ret:
384	Bfree(p,b);
385	return rv;
386	}
387
388	static int
389	mantbits (U d)
390	{
391	__ULong L;
392	#ifdef VAX
393	L = word1(d) << 16 \| word1(d) >> 16;
394	if (L)
395	#else
396	if ( (L = word1(d)) !=0)
397	#endif
398	return P - lo0bits(&L);
399	#ifdef VAX
400	L = word0(d) << 16 \| word0(d) >> 16 \| Exp_msk11;
401	#else
402	L = word0(d) \| Exp_msk1;
403	#endif
404	return P - 32 - lo0bits(&L);
405	}
406
407	int
408	_strtodg_l (struct _reent p, const char s00, char *se, FPI fpi, Long *exp,
409	__ULong *bits, locale_t loc)
410	{
411	int abe, abits, asub;
412	int bb0, bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, denorm;
413	int dsign, e, e1, e2, emin, esign, finished, i, inex, irv;
414	int j, k, nbits, nd, nd0, nf, nz, nz0, rd, rvbits, rve, rve1, sign;
415	int sudden_underflow;
416	const char s, s0, *s1;
417	//double adj, adj0, rv, tol;
418	double adj0, tol;
419	U adj, rv;
420	Long L;
421	__ULong y, z;
422	_Bigint ab, bb, bb1, bd, bd0, bs, delta, rvb, *rvb0;
423	struct lconv *lconv = __localeconv_l (loc);
424	int dec_len = strlen (lconv->decimal_point);
425
426	irv = STRTOG_Zero;
427	denorm = sign = nz0 = nz = 0;
428	dval(rv) = 0.;
429	rvb = 0;
430	nbits = fpi->nbits;
431	for(s = s00;;s++) switch(*s) {
432	case '-':
433	sign = 1;
434	/* no break */
435	case '+':
436	if (*++s)
437	goto break2;
438	/* no break */
439	case 0:
440	sign = 0;
441	irv = STRTOG_NoNumber;
442	s = s00;
443	goto ret;
444	case '\t':
445	case '\n':
446	case '\v':
447	case '\f':
448	case '\r':
449	case ' ':
450	continue;
451	default:
452	goto break2;
453	}
454	break2:
455	if (*s == '0') {
456	#ifndef NO_HEX_FP
457	switch(s[1]) {
458	case 'x':
459	case 'X':
460	irv = gethex(p, &s, fpi, exp, &rvb, sign, loc);
461	if (irv == STRTOG_NoNumber) {
462	s = s00;
463	sign = 0;
464	}
465	goto ret;
466	}
467	#endif
468	nz0 = 1;
469	while(*++s == '0') ;
470	if (!*s)
471	goto ret;
472	}
473	sudden_underflow = fpi->sudden_underflow;
474	s0 = s;
475	y = z = 0;
476	for(decpt = nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
477	if (nd < 9)
478	y = 10*y + c - '0';
479	else if (nd < 16)
480	z = 10*z + c - '0';
481	nd0 = nd;
482	#ifdef USE_LOCALE
483	if (strncmp (s, lconv->decimal_point, dec_len) == 0)
484	#else
485	if (c == '.')
486	#endif
487	{
488	decpt = 1;
489	#ifdef USE_LOCALE
490	c = *(s += dec_len);
491	#else
492	c = *++s;
493	#endif
494	if (!nd) {
495	for(; c == '0'; c = *++s)
496	nz++;
497	if (c > '0' && c <= '9') {
498	s0 = s;
499	nf += nz;
500	nz = 0;
501	goto have_dig;
502	}
503	goto dig_done;
504	}
505	for(; c >= '0' && c <= '9'; c = *++s) {
506	have_dig:
507	nz++;
508	if (c -= '0') {
509	nf += nz;
510	for(i = 1; i < nz; i++)
511	if (nd++ < 9)
512	y *= 10;
513	else if (nd <= DBL_DIG + 1)
514	z *= 10;
515	if (nd++ < 9)
516	y = 10*y + c;
517	else if (nd <= DBL_DIG + 1)
518	z = 10*z + c;
519	nz = 0;
520	}
521	}
522	}
523	dig_done:
524	e = 0;
525	if (c == 'e' \|\| c == 'E') {
526	if (!nd && !nz && !nz0) {
527	irv = STRTOG_NoNumber;
528	s = s00;
529	goto ret;
530	}
531	s00 = s;
532	esign = 0;
533	switch(c = *++s) {
534	case '-':
535	esign = 1;
536	case '+':
537	c = *++s;
538	}
539	if (c >= '0' && c <= '9') {
540	while(c == '0')
541	c = *++s;
542	if (c > '0' && c <= '9') {
543	L = c - '0';
544	s1 = s;
545	while((c = *++s) >= '0' && c <= '9')
546	L = 10*L + c - '0';
547	if (s - s1 > 8 \|\| L > 19999)
548	/* Avoid confusion from exponents
549	* so large that e might overflow.
550	*/
551	e = 19999; /* safe for 16 bit ints */
552	else
553	e = (int)L;
554	if (esign)
555	e = -e;
556	}
557	else
558	e = 0;
559	}
560	else
561	s = s00;
562	}
563	if (!nd) {
564	if (!nz && !nz0) {
565	#ifdef INFNAN_CHECK
566	/* Check for Nan and Infinity */
567	if (!decpt)
568	switch(c) {
569	case 'i':
570	case 'I':
571	if (match(&s,"nf")) {
572	--s;
573	if (!match(&s,"inity"))
574	++s;
575	irv = STRTOG_Infinite;
576	goto infnanexp;
577	}
578	break;
579	case 'n':
580	case 'N':
581	if (match(&s, "an")) {
582	irv = STRTOG_NaN;
583	*exp = fpi->emax + 1;
584	#ifndef No_Hex_NaN
585	if (s == '(') /)*/
586	irv = hexnan(&s, fpi, bits);
587	#endif
588	goto infnanexp;
589	}
590	}
591	#endif /* INFNAN_CHECK */
592	irv = STRTOG_NoNumber;
593	s = s00;
594	}
595	goto ret;
596	}
597
598	irv = STRTOG_Normal;
599	e1 = e -= nf;
600	rd = 0;
601	switch(fpi->rounding & 3) {
602	case FPI_Round_up:
603	rd = 2 - sign;
604	break;
605	case FPI_Round_zero:
606	rd = 1;
607	break;
608	case FPI_Round_down:
609	rd = 1 + sign;
610	}
611
612	/* Now we have nd0 digits, starting at s0, followed by a
613	* decimal point, followed by nd-nd0 digits. The number we're
614	* after is the integer represented by those digits times
615	* 10*e /
616
617	if (!nd0)
618	nd0 = nd;
619	k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
620	dval(rv) = y;
621	if (k > 9)
622	dval(rv) = tens[k - 9] * dval(rv) + z;
623	bd0 = 0;
624	if (nbits <= P && nd <= DBL_DIG) {
625	if (!e) {
626	if (rvOK(p, dval(rv), fpi, exp, bits, 1, rd, &irv))
627	goto ret;
628	}
629	else if (e > 0) {
630	if (e <= Ten_pmax) {
631	#ifdef VAX
632	goto vax_ovfl_check;
633	#else
634	i = fivesbits[e] + mantbits(rv) <= P;
635	/* rv = */ rounded_product(dval(rv), tens[e]);
636	if (rvOK(p, dval(rv), fpi, exp, bits, i, rd, &irv))
637	goto ret;
638	e1 -= e;
639	goto rv_notOK;
640	#endif
641	}
642	i = DBL_DIG - nd;
643	if (e <= Ten_pmax + i) {
644	/* A fancier test would sometimes let us do
645	* this for larger i values.
646	*/
647	e2 = e - i;
648	e1 -= i;
649	dval(rv) *= tens[i];
650	#ifdef VAX
651	/* VAX exponent range is so narrow we must
652	* worry about overflow here...
653	*/
654	vax_ovfl_check:
655	dval(adj) = dval(rv);
656	word0(adj) -= P*Exp_msk1;
657	/* adj = */ rounded_product(dval(adj), tens[e2]);
658	if ((word0(adj) & Exp_mask)
659	> Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
660	goto rv_notOK;
661	word0(adj) += P*Exp_msk1;
662	dval(rv) = dval(adj);
663	#else
664	/* rv = */ rounded_product(dval(rv), tens[e2]);
665	#endif
666	if (rvOK(p, dval(rv), fpi, exp, bits, 0, rd, &irv))
667	goto ret;
668	e1 -= e2;
669	}
670	}
671	#ifndef Inaccurate_Divide
672	else if (e >= -Ten_pmax) {
673	/* rv = */ rounded_quotient(dval(rv), tens[-e]);
674	if (rvOK(p, dval(rv), fpi, exp, bits, 0, rd, &irv))
675	goto ret;
676	e1 -= e;
677	}
678	#endif
679	}
680	rv_notOK:
681	e1 += nd - k;
682
683	/* Get starting approximation = rv * 10*e1 /
684
685	e2 = 0;
686	if (e1 > 0) {
687	if ( (i = e1 & 15) !=0)
688	dval(rv) *= tens[i];
689	if (e1 &= ~15) {
690	e1 >>= 4;
691	while(e1 >= (1 << n_bigtens-1)) {
692	e2 += ((word0(rv) & Exp_mask)
693	>> Exp_shift1) - Bias;
694	word0(rv) &= ~Exp_mask;
695	word0(rv) \|= Bias << Exp_shift1;
696	dval(rv) *= bigtens[n_bigtens-1];
697	e1 -= 1 << n_bigtens-1;
698	}
699	e2 += ((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;
700	word0(rv) &= ~Exp_mask;
701	word0(rv) \|= Bias << Exp_shift1;
702	for(j = 0; e1 > 0; j++, e1 >>= 1)
703	if (e1 & 1)
704	dval(rv) *= bigtens[j];
705	}
706	}
707	else if (e1 < 0) {
708	e1 = -e1;
709	if ( (i = e1 & 15) !=0)
710	dval(rv) /= tens[i];
711	if (e1 &= ~15) {
712	e1 >>= 4;
713	while(e1 >= (1 << n_bigtens-1)) {
714	e2 += ((word0(rv) & Exp_mask)
715	>> Exp_shift1) - Bias;
716	word0(rv) &= ~Exp_mask;
717	word0(rv) \|= Bias << Exp_shift1;
718	dval(rv) *= tinytens[n_bigtens-1];
719	e1 -= 1 << n_bigtens-1;
720	}
721	e2 += ((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;
722	word0(rv) &= ~Exp_mask;
723	word0(rv) \|= Bias << Exp_shift1;
724	for(j = 0; e1 > 0; j++, e1 >>= 1)
725	if (e1 & 1)
726	dval(rv) *= tinytens[j];
727	}
728	}
729	#ifdef IBM
730	/* e2 is a correction to the (base 2) exponent of the return
731	* value, reflecting adjustments above to avoid overflow in the
732	* native arithmetic. For native IBM (base 16) arithmetic, we
733	* must multiply e2 by 4 to change from base 16 to 2.
734	*/
735	e2 <<= 2;
736	#endif
737	rvb = d2b(p, dval(rv), &rve, &rvbits); /* rv = rvb * 2^rve */
738	rve += e2;
739	if ((j = rvbits - nbits) > 0) {
740	rshift(rvb, j);
741	rvbits = nbits;
742	rve += j;
743	}
744	bb0 = 0; /* trailing zero bits in rvb */
745	e2 = rve + rvbits - nbits;
746	if (e2 > fpi->emax + 1)
747	goto huge;
748	rve1 = rve + rvbits - nbits;
749	if (e2 < (emin = fpi->emin)) {
750	denorm = 1;
751	j = rve - emin;
752	if (j > 0) {
753	rvb = lshift(p, rvb, j);
754	rvbits += j;
755	}
756	else if (j < 0) {
757	rvbits += j;
758	if (rvbits <= 0) {
759	if (rvbits < -1) {
760	ufl:
761	rvb->_wds = 0;
762	rvb->_x[0] = 0;
763	*exp = emin;
764	irv = STRTOG_Underflow \| STRTOG_Inexlo;
765	goto ret;
766	}
767	rvb->_x[0] = rvb->_wds = rvbits = 1;
768	}
769	else
770	rshift(rvb, -j);
771	}
772	rve = rve1 = emin;
773	if (sudden_underflow && e2 + 1 < emin)
774	goto ufl;
775	}
776
777	/* Now the hard part -- adjusting rv to the correct value.*/
778
779	/* Put digits into bd: true value = bd * 10^e */
780
781	bd0 = s2b(p, s0, nd0, nd, y);
782
783	for(;;) {
784	bd = Balloc(p,bd0->_k);
785	Bcopy(bd, bd0);
786	bb = Balloc(p,rvb->_k);
787	Bcopy(bb, rvb);
788	bbbits = rvbits - bb0;
789	bbe = rve + bb0;
790	bs = i2b(p, 1);
791
792	if (e >= 0) {
793	bb2 = bb5 = 0;
794	bd2 = bd5 = e;
795	}
796	else {
797	bb2 = bb5 = -e;
798	bd2 = bd5 = 0;
799	}
800	if (bbe >= 0)
801	bb2 += bbe;
802	else
803	bd2 -= bbe;
804	bs2 = bb2;
805	j = nbits + 1 - bbbits;
806	i = bbe + bbbits - nbits;
807	if (i < emin) /* denormal */
808	j += i - emin;
809	bb2 += j;
810	bd2 += j;
811	i = bb2 < bd2 ? bb2 : bd2;
812	if (i > bs2)
813	i = bs2;
814	if (i > 0) {
815	bb2 -= i;
816	bd2 -= i;
817	bs2 -= i;
818	}
819	if (bb5 > 0) {
820	bs = pow5mult(p, bs, bb5);
821	bb1 = mult(p, bs, bb);
822	Bfree(p,bb);
823	bb = bb1;
824	}
825	bb2 -= bb0;
826	if (bb2 > 0)
827	bb = lshift(p, bb, bb2);
828	else if (bb2 < 0)
829	rshift(bb, -bb2);
830	if (bd5 > 0)
831	bd = pow5mult(p, bd, bd5);
832	if (bd2 > 0)
833	bd = lshift(p, bd, bd2);
834	if (bs2 > 0)
835	bs = lshift(p, bs, bs2);
836	asub = 1;
837	inex = STRTOG_Inexhi;
838	delta = diff(p, bb, bd);
839	if (delta->_wds <= 1 && !delta->_x[0])
840	break;
841	dsign = delta->_sign;
842	delta->_sign = finished = 0;
843	L = 0;
844	i = cmp(delta, bs);
845	if (rd && i <= 0) {
846	irv = STRTOG_Normal;
847	if ( (finished = dsign ^ (rd&1)) !=0) {
848	if (dsign != 0) {
849	irv \|= STRTOG_Inexhi;
850	goto adj1;
851	}
852	irv \|= STRTOG_Inexlo;
853	if (rve1 == emin)
854	goto adj1;
855	for(i = 0, j = nbits; j >= ULbits;
856	i++, j -= ULbits) {
857	if (rvb->_x[i] & ALL_ON)
858	goto adj1;
859	}
860	if (j > 1 && lo0bits(rvb->_x + i) < j - 1)
861	goto adj1;
862	rve = rve1 - 1;
863	rvb = set_ones(p, rvb, rvbits = nbits);
864	break;
865	}
866	irv \|= dsign ? STRTOG_Inexlo : STRTOG_Inexhi;
867	break;
868	}
869	if (i < 0) {
870	/* Error is less than half an ulp -- check for
871	* special case of mantissa a power of two.
872	*/
873	irv = dsign
874	? STRTOG_Normal \| STRTOG_Inexlo
875	: STRTOG_Normal \| STRTOG_Inexhi;
876	if (dsign \|\| bbbits > 1 \|\| denorm \|\| rve1 == emin)
877	break;
878	delta = lshift(p, delta,1);
879	if (cmp(delta, bs) > 0) {
880	irv = STRTOG_Normal \| STRTOG_Inexlo;
881	goto drop_down;
882	}
883	break;
884	}
885	if (i == 0) {
886	/* exactly half-way between */
887	if (dsign) {
888	if (denorm && all_on(rvb, rvbits)) {
889	/boundary case -- increment exponent/
890	rvb->_wds = 1;
891	rvb->_x[0] = 1;
892	rve = emin + nbits - (rvbits = 1);
893	irv = STRTOG_Normal \| STRTOG_Inexhi;
894	denorm = 0;
895	break;
896	}
897	irv = STRTOG_Normal \| STRTOG_Inexlo;
898	}
899	else if (bbbits == 1) {
900	irv = STRTOG_Normal;
901	drop_down:
902	/* boundary case -- decrement exponent */
903	if (rve1 == emin) {
904	irv = STRTOG_Normal \| STRTOG_Inexhi;
905	if (rvb->_wds == 1 && rvb->_x[0] == 1)
906	sudden_underflow = 1;
907	break;
908	}
909	rve -= nbits;
910	rvb = set_ones(p, rvb, rvbits = nbits);
911	break;
912	}
913	else
914	irv = STRTOG_Normal \| STRTOG_Inexhi;
915	if (bbbits < nbits && !denorm \|\| !(rvb->_x[0] & 1))
916	break;
917	if (dsign) {
918	rvb = increment(p, rvb);
919	j = kmask & (ULbits - (rvbits & kmask));
920	if (hi0bits(rvb->_x[rvb->_wds - 1]) != j)
921	rvbits++;
922	irv = STRTOG_Normal \| STRTOG_Inexhi;
923	}
924	else {
925	if (bbbits == 1)
926	goto undfl;
927	decrement(rvb);
928	irv = STRTOG_Normal \| STRTOG_Inexlo;
929	}
930	break;
931	}
932	if ((dval(adj) = ratio(delta, bs)) <= 2.) {
933	adj1:
934	inex = STRTOG_Inexlo;
935	if (dsign) {
936	asub = 0;
937	inex = STRTOG_Inexhi;
938	}
939	else if (denorm && bbbits <= 1) {
940	undfl:
941	rvb->_wds = 0;
942	rve = emin;
943	irv = STRTOG_Underflow \| STRTOG_Inexlo;
944	break;
945	}
946	adj0 = dval(adj) = 1.;
947	}
948	else {
949	adj0 = dval(adj) *= 0.5;
950	if (dsign) {
951	asub = 0;
952	inex = STRTOG_Inexlo;
953	}
954	if (dval(adj) < 2147483647.) {
955	L = adj0;
956	adj0 -= L;
957	switch(rd) {
958	case 0:
959	if (adj0 >= .5)
960	goto inc_L;
961	break;
962	case 1:
963	if (asub && adj0 > 0.)
964	goto inc_L;
965	break;
966	case 2:
967	if (!asub && adj0 > 0.) {
968	inc_L:
969	L++;
970	inex = STRTOG_Inexact - inex;
971	}
972	}
973	dval(adj) = L;
974	}
975	}
976	y = rve + rvbits;
977
978	/* adj = ulp(dval(rv)); /
979	/* if (asub) rv -= adj; else rv += adj; */
980
981	if (!denorm && rvbits < nbits) {
982	rvb = lshift(p, rvb, j = nbits - rvbits);
983	rve -= j;
984	rvbits = nbits;
985	}
986	ab = d2b(p, dval(adj), &abe, &abits);
987	if (abe < 0)
988	rshift(ab, -abe);
989	else if (abe > 0)
990	ab = lshift(p, ab, abe);
991	rvb0 = rvb;
992	if (asub) {
993	/* rv -= adj; */
994	j = hi0bits(rvb->_x[rvb->_wds-1]);
995	rvb = diff(p, rvb, ab);
996	k = rvb0->_wds - 1;
997	if (denorm)
998	/* do nothing */;
999	else if (rvb->_wds <= k
1000	\|\| hi0bits( rvb->_x[k]) >
1001	hi0bits(rvb0->_x[k])) {
1002	/* unlikely; can only have lost 1 high bit */
1003	if (rve1 == emin) {
1004	--rvbits;
1005	denorm = 1;
1006	}
1007	else {
1008	rvb = lshift(p, rvb, 1);
1009	--rve;
1010	--rve1;
1011	L = finished = 0;
1012	}
1013	}
1014	}
1015	else {
1016	rvb = sum(p, rvb, ab);
1017	k = rvb->_wds - 1;
1018	if (k >= rvb0->_wds
1019	\|\| hi0bits(rvb->_x[k]) < hi0bits(rvb0->_x[k])) {
1020	if (denorm) {
1021	if (++rvbits == nbits)
1022	denorm = 0;
1023	}
1024	else {
1025	rshift(rvb, 1);
1026	rve++;
1027	rve1++;
1028	L = 0;
1029	}
1030	}
1031	}
1032	Bfree(p,ab);
1033	Bfree(p,rvb0);
1034	if (finished)
1035	break;
1036
1037	z = rve + rvbits;
1038	if (y == z && L) {
1039	/* Can we stop now? */
1040	tol = dval(adj) * 5e-16; /* > max rel error */
1041	dval(adj) = adj0 - .5;
1042	if (dval(adj) < -tol) {
1043	if (adj0 > tol) {
1044	irv \|= inex;
1045	break;
1046	}
1047	}
1048	else if (dval(adj) > tol && adj0 < 1. - tol) {
1049	irv \|= inex;
1050	break;
1051	}
1052	}
1053	bb0 = denorm ? 0 : trailz(rvb);
1054	Bfree(p,bb);
1055	Bfree(p,bd);
1056	Bfree(p,bs);
1057	Bfree(p,delta);
1058	}
1059	if (!denorm && (j = nbits - rvbits)) {
1060	if (j > 0)
1061	rvb = lshift(p, rvb, j);
1062	else
1063	rshift(rvb, -j);
1064	rve -= j;
1065	}
1066	*exp = rve;
1067	Bfree(p,bb);
1068	Bfree(p,bd);
1069	Bfree(p,bs);
1070	Bfree(p,bd0);
1071	Bfree(p,delta);
1072	if (rve > fpi->emax) {
1073	huge:
1074	rvb->_wds = 0;
1075	irv = STRTOG_Infinite \| STRTOG_Overflow \| STRTOG_Inexhi;
1076	#ifndef NO_ERRNO
1077	errno = ERANGE;
1078	#endif
1079	infnanexp:
1080	*exp = fpi->emax + 1;
1081	}
1082	ret:
1083	if (denorm) {
1084	if (sudden_underflow) {
1085	rvb->_wds = 0;
1086	irv = STRTOG_Underflow \| STRTOG_Inexlo;
1087	}
1088	else {
1089	irv = (irv & ~STRTOG_Retmask) \|
1090	(rvb->_wds > 0 ? STRTOG_Denormal : STRTOG_Zero);
1091	if (irv & STRTOG_Inexact)
1092	irv \|= STRTOG_Underflow;
1093	}
1094	}
1095	if (se)
1096	se = (char )s;
1097	if (sign)
1098	irv \|= STRTOG_Neg;
1099	if (rvb) {
1100	copybits(bits, nbits, rvb);
1101	Bfree(p,rvb);
1102	}
1103	return irv;
1104	}
1105
1106	#endif /* _HAVE_LONG_DOUBLE && !_LDBL_EQ_DBL */

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/libs/newlib/src/newlib/libc/stdlib/strtodg.c @ 620

Download in other formats: