Home | History | Annotate | Line # | Download | only in gdtoa
strtopdd.c revision 1.3
      1  1.3  christos /* $NetBSD: strtopdd.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  int
     37  1.1    kleink #ifdef KR_headers
     38  1.1    kleink strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
     39  1.1    kleink #else
     40  1.1    kleink strtopdd(CONST char *s, char **sp, double *dd)
     41  1.1    kleink #endif
     42  1.1    kleink {
     43  1.1    kleink #ifdef Sudden_Underflow
     44  1.3  christos 	static FPI fpi0 = { 106, 1-1023, 2046-1023-106+1, 1, 1 };
     45  1.1    kleink #else
     46  1.3  christos 	static FPI fpi0 = { 106, 1-1023-53+1, 2046-1023-106+1, 1, 0 };
     47  1.1    kleink #endif
     48  1.1    kleink 	ULong bits[4];
     49  1.3  christos 	Long expt;
     50  1.1    kleink 	int i, j, rv;
     51  1.1    kleink 	typedef union {
     52  1.1    kleink 		double d[2];
     53  1.1    kleink 		ULong L[4];
     54  1.1    kleink 		} U;
     55  1.1    kleink 	U *u;
     56  1.3  christos #ifdef Honor_FLT_ROUNDS
     57  1.3  christos #include "gdtoa_fltrnds.h"
     58  1.3  christos #else
     59  1.3  christos #define fpi &fpi0
     60  1.3  christos #endif
     61  1.1    kleink 
     62  1.3  christos 	rv = strtodg(s, sp, fpi, &expt, bits);
     63  1.2  christos 	if (rv == STRTOG_NoMemory)
     64  1.2  christos 		return rv;
     65  1.1    kleink 	u = (U*)dd;
     66  1.1    kleink 	switch(rv & STRTOG_Retmask) {
     67  1.1    kleink 	  case STRTOG_NoNumber:
     68  1.1    kleink 	  case STRTOG_Zero:
     69  1.1    kleink 		u->d[0] = u->d[1] = 0.;
     70  1.1    kleink 		break;
     71  1.1    kleink 
     72  1.1    kleink 	  case STRTOG_Normal:
     73  1.1    kleink 		u->L[_1] = (bits[1] >> 21 | bits[2] << 11) & 0xffffffffL;
     74  1.3  christos 		u->L[_0] = (bits[2] >> 21) | ((bits[3] << 11) & 0xfffff)
     75  1.3  christos 			  | ((expt + 0x3ff + 105) << 20);
     76  1.3  christos 		expt += 0x3ff + 52;
     77  1.1    kleink 		if (bits[1] &= 0x1fffff) {
     78  1.1    kleink 			i = hi0bits(bits[1]) - 11;
     79  1.3  christos 			if (i >= expt) {
     80  1.3  christos 				i = expt - 1;
     81  1.3  christos 				expt = 0;
     82  1.1    kleink 				}
     83  1.1    kleink 			else
     84  1.3  christos 				expt -= i;
     85  1.1    kleink 			if (i > 0) {
     86  1.3  christos 				bits[1] = bits[1] << i | bits[0] >> (32-i);
     87  1.1    kleink 				bits[0] = bits[0] << i & 0xffffffffL;
     88  1.1    kleink 				}
     89  1.1    kleink 			}
     90  1.1    kleink 		else if (bits[0]) {
     91  1.1    kleink 			i = hi0bits(bits[0]) + 21;
     92  1.3  christos 			if (i >= expt) {
     93  1.3  christos 				i = expt - 1;
     94  1.3  christos 				expt = 0;
     95  1.1    kleink 				}
     96  1.1    kleink 			else
     97  1.3  christos 				expt -= i;
     98  1.1    kleink 			if (i < 32) {
     99  1.3  christos 				bits[1] = bits[0] >> (32 - i);
    100  1.1    kleink 				bits[0] = bits[0] << i & 0xffffffffL;
    101  1.1    kleink 				}
    102  1.1    kleink 			else {
    103  1.3  christos 				bits[1] = bits[0] << (i - 32);
    104  1.1    kleink 				bits[0] = 0;
    105  1.1    kleink 				}
    106  1.1    kleink 			}
    107  1.1    kleink 		else {
    108  1.1    kleink 			u->L[2] = u->L[3] = 0;
    109  1.1    kleink 			break;
    110  1.1    kleink 			}
    111  1.1    kleink 		u->L[2+_1] = bits[0];
    112  1.3  christos 		u->L[2+_0] = (bits[1] & 0xfffff) | (expt << 20);
    113  1.1    kleink 		break;
    114  1.1    kleink 
    115  1.1    kleink 	  case STRTOG_Denormal:
    116  1.1    kleink 		if (bits[3])
    117  1.1    kleink 			goto nearly_normal;
    118  1.1    kleink 		if (bits[2])
    119  1.1    kleink 			goto partly_normal;
    120  1.1    kleink 		if (bits[1] & 0xffe00000)
    121  1.1    kleink 			goto hardly_normal;
    122  1.1    kleink 		/* completely denormal */
    123  1.1    kleink 		u->L[2] = u->L[3] = 0;
    124  1.1    kleink 		u->L[_1] = bits[0];
    125  1.1    kleink 		u->L[_0] = bits[1];
    126  1.1    kleink 		break;
    127  1.1    kleink 
    128  1.1    kleink 	  nearly_normal:
    129  1.1    kleink 		i = hi0bits(bits[3]) - 11;	/* i >= 12 */
    130  1.1    kleink 		j = 32 - i;
    131  1.3  christos 		u->L[_0] = ((bits[3] << i | bits[2] >> j) & 0xfffff)
    132  1.3  christos 			| ((65 - i) << 20);
    133  1.1    kleink 		u->L[_1] = (bits[2] << i | bits[1] >> j) & 0xffffffffL;
    134  1.3  christos 		u->L[2+_0] = bits[1] & ((1L << j) - 1);
    135  1.1    kleink 		u->L[2+_1] = bits[0];
    136  1.1    kleink 		break;
    137  1.1    kleink 
    138  1.1    kleink 	  partly_normal:
    139  1.1    kleink 		i = hi0bits(bits[2]) - 11;
    140  1.1    kleink 		if (i < 0) {
    141  1.1    kleink 			j = -i;
    142  1.1    kleink 			i += 32;
    143  1.3  christos 			u->L[_0] = (bits[2] >> j & 0xfffff) | (33 + j) << 20;
    144  1.3  christos 			u->L[_1] = ((bits[2] << i) | (bits[1] >> j)) & 0xffffffffL;
    145  1.3  christos 			u->L[2+_0] = bits[1] & ((1L << j) - 1);
    146  1.1    kleink 			u->L[2+_1] = bits[0];
    147  1.1    kleink 			break;
    148  1.1    kleink 			}
    149  1.1    kleink 		if (i == 0) {
    150  1.3  christos 			u->L[_0] = (bits[2] & 0xfffff) | (33 << 20);
    151  1.1    kleink 			u->L[_1] = bits[1];
    152  1.1    kleink 			u->L[2+_0] = 0;
    153  1.1    kleink 			u->L[2+_1] = bits[0];
    154  1.1    kleink 			break;
    155  1.1    kleink 			}
    156  1.1    kleink 		j = 32 - i;
    157  1.3  christos 		u->L[_0] = (((bits[2] << i) | (bits[1] >> j)) & 0xfffff)
    158  1.3  christos 				| ((j + 1) << 20);
    159  1.1    kleink 		u->L[_1] = (bits[1] << i | bits[0] >> j) & 0xffffffffL;
    160  1.1    kleink 		u->L[2+_0] = 0;
    161  1.3  christos 		u->L[2+_1] = bits[0] & ((1L << j) - 1);
    162  1.1    kleink 		break;
    163  1.1    kleink 
    164  1.1    kleink 	  hardly_normal:
    165  1.1    kleink 		j = 11 - hi0bits(bits[1]);
    166  1.1    kleink 		i = 32 - j;
    167  1.3  christos 		u->L[_0] = (bits[1] >> j & 0xfffff) | ((j + 1) << 20);
    168  1.1    kleink 		u->L[_1] = (bits[1] << i | bits[0] >> j) & 0xffffffffL;
    169  1.1    kleink 		u->L[2+_0] = 0;
    170  1.3  christos 		u->L[2+_1] = bits[0] & ((1L << j) - 1);
    171  1.1    kleink 		break;
    172  1.1    kleink 
    173  1.1    kleink 	  case STRTOG_Infinite:
    174  1.1    kleink 		u->L[_0] = u->L[2+_0] = 0x7ff00000;
    175  1.1    kleink 		u->L[_1] = u->L[2+_1] = 0;
    176  1.1    kleink 		break;
    177  1.1    kleink 
    178  1.1    kleink 	  case STRTOG_NaN:
    179  1.1    kleink 		u->L[0] = u->L[2] = d_QNAN0;
    180  1.1    kleink 		u->L[1] = u->L[3] = d_QNAN1;
    181  1.1    kleink 	  }
    182  1.1    kleink 	if (rv & STRTOG_Neg) {
    183  1.1    kleink 		u->L[  _0] |= 0x80000000L;
    184  1.1    kleink 		u->L[2+_0] |= 0x80000000L;
    185  1.1    kleink 		}
    186  1.1    kleink 	return rv;
    187  1.1    kleink 	}
    188