Return to b1nuC.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

Annotation of 43BSD/contrib/B/src/bint/b1nuC.c, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.