Home | History | Annotate | Line # | Download | only in gdtoa
strtoIg.c revision 1.2
      1  1.2  christos /* $NetBSD: strtoIg.c,v 1.2 2008/03/21 23:13:48 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 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 strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
     39  1.1    kleink #else
     40  1.1    kleink strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
     41  1.1    kleink #endif
     42  1.1    kleink {
     43  1.1    kleink 	Bigint *b, *b1;
     44  1.1    kleink 	int i, nb, nw, nw1, rv, rv1, swap;
     45  1.1    kleink 	unsigned int nb1, nb11;
     46  1.1    kleink 	Long e1;
     47  1.1    kleink 
     48  1.1    kleink 	b = *B;
     49  1.1    kleink 	rv = strtodg(s00, se, fpi, exp, b->x);
     50  1.2  christos 	if (rv == STRTOG_NoMemory)
     51  1.2  christos 		return rv;
     52  1.1    kleink 	if (!(rv & STRTOG_Inexact)) {
     53  1.1    kleink 		B[1] = 0;
     54  1.1    kleink 		return *rvp = rv;
     55  1.1    kleink 		}
     56  1.1    kleink 	e1 = exp[0];
     57  1.1    kleink 	rv1 = rv ^ STRTOG_Inexact;
     58  1.1    kleink 	b1 = Balloc(b->k);
     59  1.2  christos 	if (b1 == NULL)
     60  1.2  christos 		return STRTOG_NoMemory;
     61  1.1    kleink 	Bcopy(b1, b);
     62  1.1    kleink 	nb = fpi->nbits;
     63  1.1    kleink 	nb1 = nb & 31;
     64  1.1    kleink 	nb11 = (nb1 - 1) & 31;
     65  1.1    kleink 	nw = b->wds;
     66  1.1    kleink 	nw1 = nw - 1;
     67  1.1    kleink 	if (rv & STRTOG_Inexlo) {
     68  1.1    kleink 		swap = 0;
     69  1.1    kleink 		b1 = increment(b1);
     70  1.1    kleink 		if (fpi->sudden_underflow
     71  1.1    kleink 		 && (rv & STRTOG_Retmask) == STRTOG_Zero) {
     72  1.1    kleink 			b1->x[0] = 0;
     73  1.1    kleink 			b1->x[nw1] = 1L << nb11;
     74  1.1    kleink 			rv1 += STRTOG_Normal - STRTOG_Zero;
     75  1.1    kleink 			rv1 &= ~STRTOG_Underflow;
     76  1.1    kleink 			goto swapcheck;
     77  1.1    kleink 			}
     78  1.1    kleink 		if (b1->wds > nw
     79  1.1    kleink 		 || nb1 && b1->x[nw1] & 1L << nb1) {
     80  1.1    kleink 			if (++e1 > fpi->emax)
     81  1.1    kleink 				rv1 = STRTOG_Infinite | STRTOG_Inexhi;
     82  1.1    kleink 			rshift(b1, 1);
     83  1.1    kleink 			}
     84  1.1    kleink 		else if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
     85  1.1    kleink 			if (b1->x[nw1] & 1L << nb11) {
     86  1.1    kleink 				rv1 += STRTOG_Normal - STRTOG_Denormal;
     87  1.1    kleink 				rv1 &= ~STRTOG_Underflow;
     88  1.1    kleink 				}
     89  1.1    kleink 			}
     90  1.1    kleink 		}
     91  1.1    kleink 	else {
     92  1.1    kleink 		swap = STRTOG_Neg;
     93  1.1    kleink 		if ((rv & STRTOG_Retmask) == STRTOG_Infinite) {
     94  1.1    kleink 			b1 = set_ones(b1, nb);
     95  1.1    kleink 			e1 = fpi->emax;
     96  1.1    kleink 			rv1 = STRTOG_Normal | STRTOG_Inexlo;
     97  1.1    kleink 			goto swapcheck;
     98  1.1    kleink 			}
     99  1.1    kleink 		decrement(b1);
    100  1.1    kleink 		if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
    101  1.1    kleink 			for(i = nw1; !b1->x[i]; --i)
    102  1.1    kleink 				if (!i) {
    103  1.1    kleink 					rv1 = STRTOG_Zero | STRTOG_Inexlo;
    104  1.1    kleink 					break;
    105  1.1    kleink 					}
    106  1.1    kleink 			goto swapcheck;
    107  1.1    kleink 			}
    108  1.1    kleink 		if (!(b1->x[nw1] & 1L << nb11)) {
    109  1.1    kleink 			if (e1 == fpi->emin) {
    110  1.1    kleink 				if (fpi->sudden_underflow)
    111  1.1    kleink 					rv1 += STRTOG_Zero - STRTOG_Normal;
    112  1.1    kleink 				else
    113  1.1    kleink 					rv1 += STRTOG_Denormal - STRTOG_Normal;
    114  1.1    kleink 				rv1 |= STRTOG_Underflow;
    115  1.1    kleink 				}
    116  1.1    kleink 			else {
    117  1.1    kleink 				b1 = lshift(b1, 1);
    118  1.1    kleink 				b1->x[0] |= 1;
    119  1.1    kleink 				--e1;
    120  1.1    kleink 				}
    121  1.1    kleink 			}
    122  1.1    kleink 		}
    123  1.1    kleink  swapcheck:
    124  1.1    kleink 	if (swap ^ (rv & STRTOG_Neg)) {
    125  1.1    kleink 		rvp[0] = rv1;
    126  1.1    kleink 		rvp[1] = rv;
    127  1.1    kleink 		B[0] = b1;
    128  1.1    kleink 		B[1] = b;
    129  1.1    kleink 		exp[1] = exp[0];
    130  1.1    kleink 		exp[0] = e1;
    131  1.1    kleink 		}
    132  1.1    kleink 	else {
    133  1.1    kleink 		rvp[0] = rv;
    134  1.1    kleink 		rvp[1] = rv1;
    135  1.1    kleink 		B[1] = b1;
    136  1.1    kleink 		exp[1] = e1;
    137  1.1    kleink 		}
    138  1.1    kleink 	return rv;
    139  1.1    kleink 	}
    140