1*9feb722eSchristos /* $NetBSD: strtoIg.c,v 1.5 2021/05/06 16:15:33 christos Exp $ */
27684d5e0Skleink
37684d5e0Skleink /****************************************************************
47684d5e0Skleink
57684d5e0Skleink The author of this software is David M. Gay.
67684d5e0Skleink
77684d5e0Skleink Copyright (C) 1998 by Lucent Technologies
87684d5e0Skleink All Rights Reserved
97684d5e0Skleink
107684d5e0Skleink Permission to use, copy, modify, and distribute this software and
117684d5e0Skleink its documentation for any purpose and without fee is hereby
127684d5e0Skleink granted, provided that the above copyright notice appear in all
137684d5e0Skleink copies and that both that the copyright notice and this
147684d5e0Skleink permission notice and warranty disclaimer appear in supporting
157684d5e0Skleink documentation, and that the name of Lucent or any of its entities
167684d5e0Skleink not be used in advertising or publicity pertaining to
177684d5e0Skleink distribution of the software without specific, written prior
187684d5e0Skleink permission.
197684d5e0Skleink
207684d5e0Skleink LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
217684d5e0Skleink INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
227684d5e0Skleink IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
237684d5e0Skleink SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
247684d5e0Skleink WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
257684d5e0Skleink IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
267684d5e0Skleink ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
277684d5e0Skleink THIS SOFTWARE.
287684d5e0Skleink
297684d5e0Skleink ****************************************************************/
307684d5e0Skleink
317684d5e0Skleink /* Please send bug reports to David M. Gay (dmg at acm dot org,
327684d5e0Skleink * with " at " changed at "@" and " dot " changed to "."). */
337684d5e0Skleink
347684d5e0Skleink #include "gdtoaimp.h"
357684d5e0Skleink
367684d5e0Skleink int
377684d5e0Skleink #ifdef KR_headers
strtoIg(s00,se,fpi,exp,B,rvp)389a9a4122Sriastradh strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; CONST FPI *fpi; Long *exp; Bigint **B; int *rvp;
397684d5e0Skleink #else
409a9a4122Sriastradh strtoIg(CONST char *s00, char **se, CONST FPI *fpi, Long *exp, Bigint **B, int *rvp)
417684d5e0Skleink #endif
427684d5e0Skleink {
437684d5e0Skleink Bigint *b, *b1;
447684d5e0Skleink int i, nb, nw, nw1, rv, rv1, swap;
457684d5e0Skleink unsigned int nb1, nb11;
467684d5e0Skleink Long e1;
477684d5e0Skleink
487684d5e0Skleink b = *B;
497684d5e0Skleink rv = strtodg(s00, se, fpi, exp, b->x);
50ab625449Schristos if (rv == STRTOG_NoMemory)
51ab625449Schristos return rv;
527684d5e0Skleink if (!(rv & STRTOG_Inexact)) {
537684d5e0Skleink B[1] = 0;
547684d5e0Skleink return *rvp = rv;
557684d5e0Skleink }
567684d5e0Skleink e1 = exp[0];
577684d5e0Skleink rv1 = rv ^ STRTOG_Inexact;
587684d5e0Skleink b1 = Balloc(b->k);
59ab625449Schristos if (b1 == NULL)
60ab625449Schristos return STRTOG_NoMemory;
617684d5e0Skleink Bcopy(b1, b);
627684d5e0Skleink nb = fpi->nbits;
637684d5e0Skleink nb1 = nb & 31;
647684d5e0Skleink nb11 = (nb1 - 1) & 31;
657684d5e0Skleink nw = b->wds;
667684d5e0Skleink nw1 = nw - 1;
677684d5e0Skleink if (rv & STRTOG_Inexlo) {
687684d5e0Skleink swap = 0;
697684d5e0Skleink b1 = increment(b1);
7061e56760Schristos if ((rv & STRTOG_Retmask) == STRTOG_Zero) {
7161e56760Schristos if (fpi->sudden_underflow) {
727684d5e0Skleink b1->x[0] = 0;
737684d5e0Skleink b1->x[nw1] = 1L << nb11;
747684d5e0Skleink rv1 += STRTOG_Normal - STRTOG_Zero;
757684d5e0Skleink rv1 &= ~STRTOG_Underflow;
767684d5e0Skleink goto swapcheck;
777684d5e0Skleink }
7861e56760Schristos rv1 &= STRTOG_Inexlo | STRTOG_Underflow | STRTOG_Zero;
7961e56760Schristos rv1 |= STRTOG_Inexhi | STRTOG_Denormal;
8061e56760Schristos goto swapcheck;
8161e56760Schristos }
827684d5e0Skleink if (b1->wds > nw
8361e56760Schristos || (nb1 && b1->x[nw1] & 1L << nb1)) {
847684d5e0Skleink if (++e1 > fpi->emax)
857684d5e0Skleink rv1 = STRTOG_Infinite | STRTOG_Inexhi;
867684d5e0Skleink rshift(b1, 1);
877684d5e0Skleink }
887684d5e0Skleink else if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
897684d5e0Skleink if (b1->x[nw1] & 1L << nb11) {
907684d5e0Skleink rv1 += STRTOG_Normal - STRTOG_Denormal;
917684d5e0Skleink rv1 &= ~STRTOG_Underflow;
927684d5e0Skleink }
937684d5e0Skleink }
947684d5e0Skleink }
957684d5e0Skleink else {
967684d5e0Skleink swap = STRTOG_Neg;
977684d5e0Skleink if ((rv & STRTOG_Retmask) == STRTOG_Infinite) {
987684d5e0Skleink b1 = set_ones(b1, nb);
997684d5e0Skleink e1 = fpi->emax;
1007684d5e0Skleink rv1 = STRTOG_Normal | STRTOG_Inexlo;
1017684d5e0Skleink goto swapcheck;
1027684d5e0Skleink }
1037684d5e0Skleink decrement(b1);
1047684d5e0Skleink if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
1057684d5e0Skleink for(i = nw1; !b1->x[i]; --i)
1067684d5e0Skleink if (!i) {
1077684d5e0Skleink rv1 = STRTOG_Zero | STRTOG_Inexlo;
1087684d5e0Skleink break;
1097684d5e0Skleink }
1107684d5e0Skleink goto swapcheck;
1117684d5e0Skleink }
1127684d5e0Skleink if (!(b1->x[nw1] & 1L << nb11)) {
1137684d5e0Skleink if (e1 == fpi->emin) {
1147684d5e0Skleink if (fpi->sudden_underflow)
1157684d5e0Skleink rv1 += STRTOG_Zero - STRTOG_Normal;
1167684d5e0Skleink else
1177684d5e0Skleink rv1 += STRTOG_Denormal - STRTOG_Normal;
1187684d5e0Skleink rv1 |= STRTOG_Underflow;
1197684d5e0Skleink }
1207684d5e0Skleink else {
1217684d5e0Skleink b1 = lshift(b1, 1);
122*9feb722eSchristos if (b1 == NULL)
123*9feb722eSchristos return STRTOG_NoMemory;
1247684d5e0Skleink b1->x[0] |= 1;
1257684d5e0Skleink --e1;
1267684d5e0Skleink }
1277684d5e0Skleink }
1287684d5e0Skleink }
1297684d5e0Skleink swapcheck:
1307684d5e0Skleink if (swap ^ (rv & STRTOG_Neg)) {
1317684d5e0Skleink rvp[0] = rv1;
1327684d5e0Skleink rvp[1] = rv;
1337684d5e0Skleink B[0] = b1;
1347684d5e0Skleink B[1] = b;
1357684d5e0Skleink exp[1] = exp[0];
1367684d5e0Skleink exp[0] = e1;
1377684d5e0Skleink }
1387684d5e0Skleink else {
1397684d5e0Skleink rvp[0] = rv;
1407684d5e0Skleink rvp[1] = rv1;
1417684d5e0Skleink B[1] = b1;
1427684d5e0Skleink exp[1] = e1;
1437684d5e0Skleink }
1447684d5e0Skleink return rv;
1457684d5e0Skleink }
146