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