Return to dc.c CVS log

Up to [MW Coherent from dump] / coherent / d / bin / dc

Annotation of coherent/d/bin/dc/dc.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * DC - Reverse Polish desk calculator (multi-precision)
        !             3:  * Depends on mint value being defined as a `char *'
        !             4:  * so mint may also be char string
        !             5:  */
        !             6: #include <stdio.h>
        !             7: #include "bc.h"
        !             8: 
        !             9: char   *version = "DC Version 1.00.\n";
        !            10: 
        !            11: #define        NREG    256
        !            12: #define        NSTACK  256
        !            13: 
        !            14: struct reg_t   {
        !            15:        struct  reg_t   *next;
        !            16:        rvalue  regval;
        !            17: }      *reg[NREG];
        !            18: 
        !            19: rvalue stack[NSTACK],
        !            20:        *sp = &stack[0];
        !            21: 
        !            22: static char    *soflmsg = "Out of pushdown",
        !            23:                *suflmsg = "stack empty",
        !            24:                *oospmsg = "Out of space",
        !            25:                *nregmsg = "Missing reg name";
        !            26: 
        !            27: #define        skiperr(m) {fprintf(stderr,"%s\n",m);return(-1);}
        !            28: 
        !            29: #define        push(x) {if(sp==&stack[NSTACK]){skiperr(soflmsg);}else{x=sp++;}}
        !            30: 
        !            31: #define        pop(x)  {if(sp==&stack[0]){skiperr(suflmsg);}else{x=--sp;}}
        !            32: 
        !            33: #define        new(x)  {push(x);minit(&(x)->mantissa);}
        !            34: 
        !            35: #define        temp(x) {push(x);pop(x);}
        !            36: 
        !            37: #define        tos(x)  {pop(x);push(x);}
        !            38: 
        !            39: #define        getreg(c,r){if((c=getc(infile))==EOF){skiperr(nregmsg);}else{r=reg[c];}}
        !            40: 
        !            41: #define        newreg(c, r) {\
        !            42:                struct reg_t *nr=(struct reg_t *)malloc(sizeof(struct reg_t));\
        !            43:                if (nr == NULL) {\
        !            44:                        skiperr(oospmsg);\
        !            45:                } else {\
        !            46:                        nr->next = r;\
        !            47:                        r = reg[c] = nr;\
        !            48:                }\
        !            49:        }
        !            50: 
        !            51: #define        execute(x, y) if((x)->scale<0){\
        !            52:        FILE f;char *s=(x)->mantissa.val;if(y)minit(&(x)->mantissa);\
        !            53:        _stropen(s,strlen(s),&f);c=interp(&f);infile=fp;if(y)mpfree(s);\
        !            54:        if(c)return(c-1);}
        !            55: 
        !            56: main(argc, argv)
        !            57: int    argc;
        !            58: char   *argv[];
        !            59: {
        !            60:        FILE    *fp;
        !            61: 
        !            62:        init();
        !            63:        if (argc > 1)
        !            64:                if (!strcmp(argv[1], "-V")) {
        !            65:                        fprintf(stderr, version);
        !            66:                        exit(0);
        !            67:                } else if ((fp=fopen(argv[1], "r"))==NULL) {
        !            68:                        fprintf(stderr, "Dc: can't open %s\n", argv[1]);
        !            69:                        return (1);
        !            70:                } else if (interp(fp) > 0)
        !            71:                        return (0);
        !            72:                else
        !            73:                        fclose(fp);
        !            74:        while (interp(stdin) < 0)
        !            75:                ;
        !            76:        return (0);
        !            77: }
        !            78: 
        !            79: interp(fp)
        !            80: FILE   *fp;
        !            81: {
        !            82:        register int    c;
        !            83:        register rvalue *a, *b;
        !            84:        struct  reg_t   *r;
        !            85:        int     (*f)();
        !            86:        int     d;
        !            87:        extern int iseq(), isne(), islt(), isle(), isge(), isgt();
        !            88:        extern int dcsub(), bcadd(), bcmul(), bcdiv(), bcrem(), bcexp();
        !            89:        extern int sibase(), sobase(), output();
        !            90: 
        !            91:        infile = fp;
        !            92:        for (f=NULL;;f=NULL) switch (c = getc(infile)) {
        !            93:        case EOF:
        !            94:                return (0);
        !            95:        case ' ':
        !            96:        case '\t':
        !            97:        case '\n':
        !            98:                continue;
        !            99:        case '_':
        !           100:                c = getc(infile);
        !           101:                f = mneg;
        !           102:                /* Fall through */
        !           103:        case '0': case '1': case '2': case '3':
        !           104:        case '4': case '5': case '6': case '7':
        !           105:        case '8': case '9': case 'A': case 'B':
        !           106:        case 'C': case 'D': case 'E': case 'F':
        !           107:        case '.':
        !           108:                push(a);
        !           109:                b = getnum(c);
        !           110:                *a = *b;
        !           111:                mpfree((char *)b);
        !           112:                if (f!=NULL)
        !           113:                        (*f)(&a->mantissa, &a->mantissa);
        !           114:                continue;
        !           115:        case '-':
        !           116:                f = dcsub;
        !           117:                goto binary;
        !           118:        case '+':
        !           119:                f = bcadd;
        !           120:                goto binary;
        !           121:        case '*':
        !           122:                f = bcmul;
        !           123:                goto binary;
        !           124:        case '/':
        !           125:                f = bcdiv;
        !           126:                goto binary;
        !           127:        case '%':
        !           128:                f = bcrem;
        !           129:                goto binary;
        !           130:        case '^':
        !           131:                f = bcexp;
        !           132:                /* Fall through */
        !           133:        binary:
        !           134:                pop(b);
        !           135:                pop(a);
        !           136:                (*f)(b, a);
        !           137:                push(a);
        !           138:                continue;
        !           139:        case '[':
        !           140:                push(a);
        !           141:                if (c = rdstring(a))
        !           142:                        return (c);
        !           143:                continue;
        !           144:        case '<':
        !           145:                f = islt;
        !           146:                goto compare;
        !           147:        case '=':
        !           148:                f = iseq;
        !           149:                goto compare;
        !           150:        case '>':
        !           151:                f = isgt;
        !           152:                goto compare;
        !           153:        case '!':
        !           154:                switch (c=getc(infile)) {
        !           155:                case '<':
        !           156:                        f = isge;
        !           157:                        goto compare;
        !           158:                case '=':
        !           159:                        f = isne;
        !           160:                        goto compare;
        !           161:                case '>':
        !           162:                        f = isle;
        !           163:                        goto compare;
        !           164:                default:
        !           165:                        ungetc(c, infile);
        !           166:                        temp(a);
        !           167:                        rdline(a, infile);
        !           168:                        system(a->mantissa.val);
        !           169:                        printf("!\n");
        !           170:                        mvfree(&a->mantissa);
        !           171:                        continue;
        !           172:                }
        !           173:        compare:
        !           174:                pop(b);
        !           175:                pop(a);
        !           176:                d = (*f)(bccmp(b, a));
        !           177:                getreg(c, r);
        !           178:                if (d && r != NULL)
        !           179:                        execute(&r->regval, 0);
        !           180:                continue;
        !           181:        case '?':
        !           182:                temp(a);
        !           183:                rdline(a, stdin);
        !           184:                execute(a, 1);
        !           185:                continue;
        !           186:        case 'c':
        !           187:                while (sp != &stack[0]) {
        !           188:                        pop(a);
        !           189:                        mvfree(&a->mantissa);
        !           190:                }
        !           191:                continue;
        !           192:        case 'd':
        !           193:                tos(a);
        !           194:                new(b);
        !           195:                mcopy(&a->mantissa, &b->mantissa);
        !           196:                b->scale = a->scale;
        !           197:                continue;
        !           198:        case 'f':
        !           199:                for (c = 0;  c != NREG; c++)
        !           200:                        if ((r=reg[c]) != NULL) {
        !           201:                                printf("`%c': ", c);
        !           202:                                output(&r->regval);
        !           203:                        }
        !           204:                printf("stack:\n");
        !           205:                for (a = &stack[0];  a < sp;  a++)
        !           206:                        output(a);
        !           207:                continue;
        !           208:        case 'i':
        !           209:                f = sibase;
        !           210:                goto unary;
        !           211:        case 'I':
        !           212:        case 'K':
        !           213:                new(a);
        !           214:                mitom((c=='I' ? ibase : scale), &a->mantissa);
        !           215:                a->scale = 0;
        !           216:                continue;
        !           217:        case 'k':
        !           218:                pop(a);
        !           219:                scale = rtoint(a);
        !           220:                mvfree(&a->mantissa);
        !           221:                if (scale < 0) {
        !           222:                        scale = 0;
        !           223:                        skiperr("Scale < 0");
        !           224:                }
        !           225:                continue;
        !           226:        case 'l':
        !           227:        case 'L':
        !           228:                getreg(c, r);
        !           229:                new(a);
        !           230:                if (r == NULL) {
        !           231:                        newscalar(a);
        !           232:                } else if (c == 'l') {
        !           233:                        mcopy(&r->regval.mantissa, &a->mantissa);
        !           234:                        a->scale = r->regval.scale;
        !           235:                } else {
        !           236:                        reg[c] = r->next;
        !           237:                        *a = r->regval;
        !           238:                        free((char *)r);
        !           239:                }
        !           240:                continue;
        !           241:        case 'o':
        !           242:                f = sobase;
        !           243:                goto unary;
        !           244:        case 'O':
        !           245:                new(a);
        !           246:                mcopy(&outbase, &a->mantissa);
        !           247:                a->scale = 0;
        !           248:                continue;
        !           249:        case 'p':
        !           250:                tos(a);
        !           251:                output(a);
        !           252:                continue;
        !           253:        case 'P':
        !           254:                f = output;
        !           255:                /* Fall through */
        !           256:        unary:
        !           257:                pop(a);
        !           258:                (*f)(a);
        !           259:                mvfree(&a->mantissa);
        !           260:                continue;
        !           261:        case 'q':
        !           262:                return (1);
        !           263:                continue;
        !           264:        case 'Q':
        !           265:                pop(a);
        !           266:                c = rtoint(a);
        !           267:                mvfree(&a->mantissa);
        !           268:                return (--c > 0 ? c : 0);
        !           269:                continue;
        !           270:        case 's':
        !           271:                getreg(c, r);
        !           272:                pop(a);
        !           273:                if (r != NULL) {
        !           274:                        mvfree(&r->regval.mantissa);
        !           275:                } else
        !           276:                        newreg(c, r);
        !           277:                r->regval = *a;
        !           278:                continue;
        !           279:        case 'S':
        !           280:                getreg(c, r);
        !           281:                pop(a);
        !           282:                newreg(c, r);
        !           283:                r->regval = *a;
        !           284:                continue;
        !           285:        case 'v':
        !           286:                tos(a);
        !           287:                bcsqrt(a);
        !           288:                continue;
        !           289:        case 'x':
        !           290:                pop(a);
        !           291:                execute(a, 1);
        !           292:                continue;
        !           293:        case 'X':
        !           294:                tos(a);
        !           295:                mitom(a->scale, &a->mantissa);
        !           296:                a->scale = 0;
        !           297:                continue;
        !           298:        case 'z':
        !           299:                new(a);
        !           300:                mitom(sp - &stack[0], &a->mantissa);
        !           301:                a->scale = 0;
        !           302:                continue;
        !           303:        case 'Z':
        !           304:        {
        !           305:                char    *s;
        !           306: 
        !           307:                tos(a);
        !           308:                s = mtos(&a->mantissa);
        !           309:                mitom(strlen(s), &a->mantissa);
        !           310:                a->scale = 0;
        !           311:                mpfree(s);
        !           312:        }
        !           313:                continue;
        !           314:        default:
        !           315:                fprintf(stderr, "`%c'", c);
        !           316:                skiperr("?");
        !           317:        }
        !           318: }
        !           319: 
        !           320: iseq(x)
        !           321: {
        !           322:        return (x==0);
        !           323: }
        !           324: 
        !           325: isne(x)
        !           326: {
        !           327:        return (x!=0);
        !           328: }
        !           329: 
        !           330: islt(x)
        !           331: {
        !           332:        return (x<0);
        !           333: }
        !           334: 
        !           335: isle(x)
        !           336: {
        !           337:        return (x<=0);
        !           338: }
        !           339: 
        !           340: isge(x)
        !           341: {
        !           342:        return (x>=0);
        !           343: }
        !           344: 
        !           345: isgt(x)
        !           346: {
        !           347:        return (x>0);
        !           348: }
        !           349: 
        !           350: rdstring(v)
        !           351: rvalue *v;
        !           352: {
        !           353:        register int    c;
        !           354:        register char   *s,
        !           355:                        *str;
        !           356:        unsigned int    len,
        !           357:                        d = 0;          /* nesting depth */
        !           358: 
        !           359:        s = str = malloc(len=16);
        !           360:        while ((c=getc(infile)) != EOF) {
        !           361:                if (c == '[')
        !           362:                        ++d;
        !           363:                else if (c == ']' && d-- == 0)
        !           364:                        break;
        !           365:                if (str != NULL)
        !           366:                        *s++ = c;
        !           367:                if (s == &str[len]) {
        !           368:                        str = realloc(str, len*=2);
        !           369:                        s = &str[len/2];
        !           370:                }
        !           371:        }
        !           372:        if (str == NULL) {
        !           373:                skiperr(oospmsg);
        !           374:        } else if (c == EOF) {
        !           375:                skiperr("Missing ']'");
        !           376:        } else {
        !           377:                *s = '\0';
        !           378:                v->mantissa.val = str;
        !           379:                v->mantissa.len = len;
        !           380:                v->scale = -1;
        !           381:                return (0);
        !           382:        }
        !           383: }
        !           384: rdline(v, fp)
        !           385: rvalue *v;
        !           386: FILE   *fp;
        !           387: {
        !           388:        register int    c;
        !           389:        register char   *s,
        !           390:                        *str;
        !           391:        unsigned int    len;
        !           392: 
        !           393:        s = str = malloc(len=16);
        !           394:        while ((c=getc(fp))!= EOF && c != '\n') {
        !           395:                if (str != NULL)
        !           396:                        *s++ = c;
        !           397:                if (s == &str[len]) {
        !           398:                        str = realloc(str, len*=2);
        !           399:                        s = &str[len/2];
        !           400:                }
        !           401:        }
        !           402:        if (str == NULL) {
        !           403:                skiperr(oospmsg);
        !           404:        } else {
        !           405:                *s = '\0';
        !           406:                v->mantissa.val = str;
        !           407:                v->mantissa.len = len;
        !           408:                v->scale = -1;
        !           409:                return (0);
        !           410:        }
        !           411: }
        !           412: 
        !           413: output(v)
        !           414: rvalue *v;
        !           415: {
        !           416:        if (v->scale < 0)
        !           417:                printf("%s\n", v->mantissa.val);
        !           418:        else {
        !           419:                putnum(v);
        !           420:                pnewln();
        !           421:        }
        !           422: }

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