4.3BSD - /usr/src/new/B/src/bint/b1nuC.c

   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
   2: 
   3: /*
   4:   $Header: b1nuC.c,v 1.4 85/08/22 16:50:36 timo Exp $
   5: */
   6: 
   7: #include <ctype.h>
   8: #include "b.h"
   9: #include "b0con.h"
  10: #include "b0fea.h"
  11: #include "b1obj.h"
  12: #include "b1mem.h"
  13: #include "b1num.h"
  14: #include "b2syn.h" /* temporary until numconst is fixed */
  15: 
  16: char *sprintf(); /* OS */
  17: extern value tento();
  18: extern integer int_tento();
  19: 
  20: #define EXPDIGITS 10    /* Extra positions to allow for exponent part */
  21:             /* -- must be larger than tenlogBASE */
  22: #define MAXDIGITS (MAXNUMDIG-1) /* Max precision for fixed/floating numbers */
  23: #define CONVBUFSIZE (MAXDIGITS+4)
  24:             /* Maximum number of digits to print in integer notation */
  25:             /* (4 is the size of 'e+00' added by sprintf) */
  26: 
  27: 
  28: /* Convert an integer to a C character string.
  29:    The character string is overwritten on each next call.
  30:    It assumes BASE is a power of 10. */
  31: 
  32: Hidden char *convint(v) register integer v; {
  33:     static char *buffer, shortbuffer[tenlogBASE+3];
  34:     static char fmt[10];
  35:     register char *cp;
  36:     register int i;
  37:     bool neg = No;
  38: 
  39:     if (IsSmallInt(v)) {
  40:         sprintf(shortbuffer, "%d", SmallIntVal(v));
  41:         return shortbuffer;
  42:     }
  43: 
  44:     if (Digit(v, Length(v)-1) < 0) {
  45:         neg = Yes;
  46:         v = int_neg(v);
  47:     }
  48:     if (buffer) freemem(buffer);
  49:     buffer = getmem((unsigned)(Length(v)*tenlogBASE + 1 + neg));
  50:     cp = buffer;
  51:     if (neg) *cp++ = '-';
  52:     sprintf(cp, "%d", Msd(v));
  53:     if (!IsSmallInt(v)) {
  54:         if (!*fmt) sprintf(fmt, "%%0%dd", tenlogBASE);
  55:         while (*cp) ++cp;
  56:         for (i = Length(v)-2; i >= 0; --i, cp += tenlogBASE)
  57:             sprintf(cp, fmt, Digit(v, i));
  58:         if (neg) release((value) v);
  59:     }
  60:     return buffer;
  61: }
  62: 
  63: #ifdef EXT_RANGE
  64: 
  65: /* This is terrible.  But never mind, it'll all change (sometimes). */
  66: 
  67: Hidden bool hugenumber(v) value v; {
  68:     bool huge;
  69:     real w = (real) approximate(v);
  70:     huge = Expo(w) > Maxexpo || Expo(w) < Minexpo && Frac(w) != 0;
  71:     release((value)w);
  72:     return huge;
  73: }
  74: 
  75: 
  76: Hidden string convapp(v) value v; {
  77:     value absv, tenlogv, expo, tentoexpo, frac;
  78:     static char buf[100];
  79:     char fmt[15];
  80:     int precision;
  81:     double fracval, expoval, i;
  82: 
  83:     absv = absval(v);
  84:     tenlogv = log2((value)int_10, absv), release(absv);
  85:     expo = floorf(tenlogv), release(tenlogv);
  86:     expoval = numval(expo), release(expo);
  87:     if (expoval*tenlogBASE >= Maxintlet || expoval*tenlogBASE <= -Maxintlet) {
  88:         expo = (value) mk_approx(expoval, 0.0);
  89:         tentoexpo = power((value)int_10, expo), release(expo);
  90:     }
  91:     else
  92:         tentoexpo = tento((int)expoval);
  93:     frac = quot(v, tentoexpo), release(tentoexpo);
  94:     fracval = numval(frac), release(frac);
  95:     while (fabs(fracval) >= 10) fracval /= 10, ++expoval;
  96:     while (fabs(fracval) < 1) fracval *= 10, --expoval;
  97:     precision = MAXDIGITS;
  98:     i = expoval < 0 ? -expoval : expoval;
  99:     while (i >= 10 && precision > 2) --precision, i /= 10;
 100:         /* Loose precision for large exponents! */
 101:         /* :-( But keep some too! )-: */
 102:     sprintf(fmt, "%%.%dlgE%%s%%2.0lf", precision);
 103:     sprintf(buf, fmt, fracval, expoval >= 0 ? "+" : "", expoval);
 104:     return buf;
 105: }
 106: 
 107: #endif EXT_RANGE
 108: 
 109: /* Convert a numeric value to a C character string.
 110:    The character string is overwritten on each next call. */
 111: 
 112: Visible string convnum(v) register value v; {
 113:     static char convbuf[3+CONVBUFSIZE+EXPDIGITS];
 114:         /* 3 extra for things (sign, 0.) to be stuck on front of it */
 115:     static char fmt[10];
 116:     char *bufstart = convbuf+3;
 117:     register char *cp = bufstart;
 118:     double x;
 119: 
 120:     if (Integral(v)) return convint((integer)v);
 121: #ifdef EXT_RANGE
 122:     if (hugenumber(v)) return convapp(v);
 123: #endif
 124: 
 125:     /* Reasonably-sized reals and rationals are treated alike.
 126: 	   However, not-too-large rationals resulting from
 127: 	   'n round x' are transformed to f-format. */
 128: 
 129:     x = numval(v);
 130:     if (!*fmt) sprintf(fmt, "%%.%dlg", MAXDIGITS);
 131:     sprintf(bufstart, fmt, x);
 132: 
 133:     for (cp = bufstart; *cp != '\0'; ++cp)
 134:         if (*cp == 'e') {   /* change sprintf's 'e' to 'E' */
 135:             *cp = 'E';
 136:             break;
 137:         }
 138: 
 139: #ifdef IBMPC
 140:     if (*cp != 'E') {
 141:         /* Delete trailing zeros after decimal pt; don't rely on %g */
 142:         for (cp = bufstart; *cp != '\0' && *cp != '.'; ++cp)
 143:             ;
 144:         if (*cp == '.') {
 145:             char *ep;
 146:             for (; *cp != '\0' && *cp != 'E'; ++cp)
 147:                 ;
 148:             ep = cp;
 149:             while (*--cp == '0')
 150:                 ;
 151:             if (++cp < ep) {
 152:                 while (*ep != '\0')
 153:                     *cp++ = *ep++;
 154:                 *cp = '\0';
 155:             }
 156:         }
 157:     }
 158: #endif IBMPC
 159: 
 160:     if (Rational(v) && Roundsize(v) > 0 && *cp != 'E') {
 161:         int i = Roundsize(v);
 162:         int j = 1;
 163:             /* Counts digits allowed beyond MAXDIGITS, 1 for '.' */
 164: 
 165:         for (cp = bufstart; *cp == '0'; ++cp)
 166:             ++j; /* Allow a trailing zero for each leading zero */
 167: 
 168:         for (; *cp != '\0' && *cp != '.'; ++cp)
 169:             ; /* Find '.' or end of string */
 170: 
 171:         if (*cp == '\0') {
 172:             *cp = '.'; /* Append '.' if not found */
 173:             *++cp = '\0';
 174:         }
 175:         else {
 176:             while (*++cp == '0')
 177:                 /* Allow more precision if leading zeros */
 178:                 ++j, --i;
 179:             while (*cp != '\0')
 180:                 --i, ++cp; /* Find last digit */
 181:         }
 182: 
 183:         /* Append extra zeros (but don't show more precision
 184: 		   than sprintf can!) */
 185:         while (--i >= 0 && cp < bufstart+MAXDIGITS+j)
 186:             *cp++ = '0';
 187: 
 188:         *cp = '\0'; /* Append new terminating null byte */
 189:     }
 190: 
 191:     return bufstart;
 192: }
 193: 
 194: 
 195: /* Convert a string to a number (assume it's syntactically correct!).
 196:    Pointers to the first and last+1 characters are given.
 197:    Again, BASE must be a power of 10.
 198:    ********** NEW **********
 199:    If E_EXACT is defined, all numbers input are made exact, even if
 200:    E-notation is used.
 201:    ********** WARNING **********
 202:    This routine must be fixed, because it accesses the source buffer
 203:    and it shouldn't because it's in the wrong place in the hierarchy
 204: */
 205: 
 206: Visible value numconst(text, end) register txptr text, end; {
 207:     register txptr tp;
 208:     register int numdigs, fraclen;
 209:     integer a;
 210:     register digit accu;
 211:     value c;
 212: 
 213:     if (Char(text) == 'E') a = int_1;
 214:     else {
 215:         while (text<end && Char(text)=='0') ++text; /* Skip leading zeros */
 216: 
 217:         for (tp = text; tp<end && isdigit(Char(tp)); ++tp)
 218:             ; /* Count integral digits */
 219:         numdigs = tp-text;
 220:         fraclen = 0;
 221:         if (tp<end && Char(tp)=='.') {
 222:             ++tp;
 223:             for (; tp<end && isdigit(Char(tp)); ++tp)
 224:                 ++fraclen; /* Count fractional digits */
 225:             numdigs += fraclen;
 226:         }
 227:         a = (integer) grab_num((numdigs+tenlogBASE-1) / tenlogBASE);
 228:         if (!a) return Vnil; /* Recovered error */
 229:         accu = 0;
 230:         /* Integer part: */
 231:         for (; text<end && isdigit(Char(text)); ++text) {
 232:             accu = accu*10 + Char(text)-'0';
 233:             --numdigs;
 234:             if (numdigs%tenlogBASE == 0) {
 235:                 Digit(a, numdigs/tenlogBASE) = accu;
 236:                 accu = 0;
 237:             }
 238:         }
 239:         /* Fraction: */
 240:         if (text < end && Char(text) == '.') {
 241:             ++text;
 242:             for (; text<end && isdigit(Char(text)); ++text) {
 243:                 accu = accu*10 + Char(text)-'0';
 244:                 --numdigs;
 245:                 if (numdigs%tenlogBASE == 0) {
 246:                     Digit(a, numdigs/tenlogBASE) = accu;
 247:                     accu = 0;
 248:                 }
 249:             }
 250:         }
 251:         if (numdigs != 0) syserr(MESS(800, "numconst: can't happen"));
 252:         a = int_canon(a);
 253:     }
 254: 
 255:     /* Exponent: */
 256:     if (text >= end || Char(text) != 'E') {
 257:         integer b = int_tento(fraclen);
 258:         c = mk_exact(a, b, fraclen);
 259:         release((value) b);
 260:     }
 261:     else {
 262:         double expo = 0;
 263:         int sign = 1;
 264:         value b;
 265:         ++text;
 266:         if (text < end) {
 267:             if (Char(text) == '+') ++text;
 268:             else if (Char(text) == '-') {
 269:                 ++text;
 270:                 sign = -1;
 271:             }
 272:         }
 273:         for (; text<end && isdigit(Char(text)); ++text) {
 274:             expo = expo*10 + Char(text)-'0';
 275:             if (expo > Maxint) {
 276:                 error(MESS(801, "excessive exponent in E-notation"));
 277:                 expo = 0;
 278:                 break;
 279:             }
 280:         }
 281:         b = tento((int)expo * sign - fraclen);
 282: #ifndef E_EXACT
 283:         /* Make approximate number if E-notation used */
 284:         c = approximate(b);
 285:         release(b);
 286:         b = c;
 287: #endif
 288:         if (a == int_1) c = b;
 289:         else c = prod((value)a, b), release(b);
 290:     }
 291:     release((value) a);
 292:     return c;
 293: }
 294: 
 295: 
 296: /*
 297:  * printnum(f, v) writes a number v on file f in such a way that it
 298:  * can be read back identically, assuming integral powers of ~2 can be
 299:  * computed exactly.  (This is necessary for the permanent environment.)
 300:  */
 301: 
 302: Visible Procedure printnum(f, v) FILE *f; value v; {
 303:     if (Approximate(v)) {
 304: #ifdef PRINT_APPROX
 305:         if (Frac((real)v) == 0) fprintf(f, "~0");
 306:         else {
 307:             static char fmt[25];
 308:             if (!*fmt)
 309:                 sprintf(fmt, "%%.%dlgE0*~2**%%.0lf", MAXDIGITS+2);
 310:             fprintf(f, fmt, Frac((real)v), Expo((real)v));
 311:         }
 312:         return;
 313: #else
 314:         fputc('~', f);
 315: #endif
 316:     }
 317:     if (Rational(v) && Denominator((rational)v) != int_1) {
 318:         int i = Roundsize(v);
 319:         fputs(convnum((value)Numerator((rational)v)), f);
 320:         if (i > 0 && i <= MAXDIGITS) {
 321:             /* The assumption here is that in u/v, the Roundsize
 322: 			   of the result is the sum of that of the operands. */
 323:             putc('.', f);
 324:             do putc('0', f); while (--i > 0);
 325:         }
 326:         putc('/', f);
 327:         v = (value) Denominator((rational)v);
 328:     }
 329:     fputs(convnum(v), f);
 330: }

Defined functions

Defined macros