1 /**************************************************************** 2 3 The author of this software is David M. Gay. 4 5 Copyright (C) 1998, 1999 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 "gdtoaimp.h" 33 34 Bigint * 35 s2b 36 #ifdef KR_headers 37 (s, nd0, nd, y9) CONST char *s; int nd0, nd; ULong y9; 38 #else 39 (CONST char *s, int nd0, int nd, ULong y9) 40 #endif 41 { 42 Bigint *b; 43 int i, k; 44 Long x, y; 45 46 x = (nd + 8) / 9; 47 for(k = 0, y = 1; x > y; y <<= 1, k++) ; 48 #ifdef Pack_32 49 b = Balloc(k); 50 b->x[0] = y9; 51 b->wds = 1; 52 #else 53 b = Balloc(k+1); 54 b->x[0] = y9 & 0xffff; 55 b->wds = (b->x[1] = y9 >> 16) ? 2 : 1; 56 #endif 57 58 i = 9; 59 if (9 < nd0) { 60 s += 9; 61 do b = multadd(b, 10, *s++ - '0'); 62 while(++i < nd0); 63 s++; 64 } 65 else 66 s += 10; 67 for(; i < nd; i++) 68 b = multadd(b, 10, *s++ - '0'); 69 return b; 70 } 71 72 double 73 ratio 74 #ifdef KR_headers 75 (a, b) Bigint *a, *b; 76 #else 77 (Bigint *a, Bigint *b) 78 #endif 79 { 80 double da, db; 81 int k, ka, kb; 82 83 dval(da) = b2d(a, &ka); 84 dval(db) = b2d(b, &kb); 85 k = ka - kb + ULbits*(a->wds - b->wds); 86 #ifdef IBM 87 if (k > 0) { 88 word0(da) += (k >> 2)*Exp_msk1; 89 if (k &= 3) 90 dval(da) *= 1 << k; 91 } 92 else { 93 k = -k; 94 word0(db) += (k >> 2)*Exp_msk1; 95 if (k &= 3) 96 dval(db) *= 1 << k; 97 } 98 #else 99 if (k > 0) 100 word0(da) += k*Exp_msk1; 101 else { 102 k = -k; 103 word0(db) += k*Exp_msk1; 104 } 105 #endif 106 return dval(da) / dval(db); 107 } 108 109 #ifdef INFNAN_CHECK 110 111 int 112 match 113 #ifdef KR_headers 114 (sp, t) char **sp, *t; 115 #else 116 (CONST char **sp, char *t) 117 #endif 118 { 119 int c, d; 120 CONST char *s = *sp; 121 122 while( (d = *t++) !=0) { 123 if ((c = *++s) >= 'A' && c <= 'Z') 124 c += 'a' - 'A'; 125 if (c != d) 126 return 0; 127 } 128 *sp = s + 1; 129 return 1; 130 } 131 #endif /* INFNAN_CHECK */ 132 133 void 134 #ifdef KR_headers 135 copybits(c, n, b) ULong *c; int n; Bigint *b; 136 #else 137 copybits(ULong *c, int n, Bigint *b) 138 #endif 139 { 140 ULong *ce, *x, *xe; 141 #ifdef Pack_16 142 int nw, nw1; 143 #endif 144 145 ce = c + ((n-1) >> kshift) + 1; 146 x = b->x; 147 #ifdef Pack_32 148 xe = x + b->wds; 149 while(x < xe) 150 *c++ = *x++; 151 #else 152 nw = b->wds; 153 nw1 = nw & 1; 154 for(xe = x + (nw - nw1); x < xe; x += 2) 155 Storeinc(c, x[1], x[0]); 156 if (nw1) 157 *c++ = *x; 158 #endif 159 while(c < ce) 160 *c++ = 0; 161 } 162 163 ULong 164 #ifdef KR_headers 165 any_on(b, k) Bigint *b; int k; 166 #else 167 any_on(Bigint *b, int k) 168 #endif 169 { 170 int n, nwds; 171 ULong *x, *x0, x1, x2; 172 173 x = b->x; 174 nwds = b->wds; 175 n = k >> kshift; 176 if (n > nwds) 177 n = nwds; 178 else if (n < nwds && (k &= kmask)) { 179 x1 = x2 = x[n]; 180 x1 >>= k; 181 x1 <<= k; 182 if (x1 != x2) 183 return 1; 184 } 185 x0 = x; 186 x += n; 187 while(x > x0) 188 if (*--x) 189 return 1; 190 return 0; 191 } 192