# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b1nuC.c

##### Functions

    convapp           X
    convint           X
    convnum           X
    hugenumber        X
    numconst          X
    printnum          X

##### Macros

    CONVBUFSIZE       X
    EXPDIGITS         X
    MAXDIGITS         X

       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

convapp defined in line 76; used 1 times

- in line 122

convint defined in line 32; used 1 times

- in line 120

convnum defined in line 112; used 6 times

- in line 319, 329
- in /usr/src/new/PORT/B/src/bint/b1obj.c line 135
- in /usr/src/new/PORT/B/src/bint/b1obj.h line 96
- in /usr/src/new/PORT/B/src/bint/b1tex.c line 660
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 112

hugenumber defined in line 67; used 1 times

- in line 122

numconst defined in line 206; used 2 times

- in /usr/src/new/PORT/B/src/bint/b1obj.h line 101
- in /usr/src/new/PORT/B/src/bint/b2exp.c line 300

printnum defined in line 302; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3scr.c line 110

#### Defined macros

CONVBUFSIZE defined in line 23; used 1 times

- in line 113

EXPDIGITS defined in line 20; used 1 times

- in line 113

MAXDIGITS defined in line 22; used 6 times

- in line 23, 97, 130, 185, 309, 320

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1091 |