Return to lam4.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / lisp

Annotation of 3BSD/cmd/lisp/lam4.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: #define protect(z) (np++->val = (z))
        !             3: typedef struct argent *ap;
        !             4: static int restype;
        !             5: static int prunep; lispval adbig(),subbig(),mulbig();
        !             6: lispval
        !             7: Ladd()
        !             8: {
        !             9:        register lispval work;
        !            10:        register ap result, mynp, oldnp, lbot, np;
        !            11:        int itemp;
        !            12: 
        !            13:        oldnp = result = np;
        !            14:        protect(rdrsdot);
        !            15:        rdrsdot->CDR = (lispval) 0;
        !            16:        rdrsdot->I =0;
        !            17:        restype = SDOT;
        !            18:        prunep = TRUE;
        !            19: 
        !            20:        for(mynp = lbot; mynp < oldnp; mynp++)
        !            21:        {
        !            22:                work = mynp->val;
        !            23:                switch(TYPE(work)) {
        !            24:                case INT:
        !            25:                        switch(restype) {
        !            26:                        case DOUB:
        !            27:                                result->val->r += work->i;
        !            28:                                break;
        !            29:                        case SDOT:
        !            30:                                dmlad(result->val,1,work->i);
        !            31:                                prunep = TRUE;
        !            32:                                break;
        !            33:                        default:
        !            34:                                goto urk;
        !            35:                        }
        !            36:                        break;
        !            37:                case SDOT:
        !            38:                        switch(restype) {
        !            39:                        case DOUB:
        !            40:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !            41:                                break;
        !            42:                        case SDOT:
        !            43:                                result->val = adbig(work,result->val);
        !            44:                                restype = TYPE(result->val);
        !            45:                                if(restype==INT) {
        !            46:                                        rdrsdot->I=result->val->I;
        !            47:                                        rdrsdot->CDR = (lispval) 0;
        !            48:                                        result->val = rdrsdot;
        !            49:                                        restype=SDOT;
        !            50:                                        prunep = TRUE;
        !            51:                                } else
        !            52:                                        prunep = FALSE;
        !            53:                                break;
        !            54:                        default:
        !            55:                                goto urk;
        !            56:                        }
        !            57:                        break;
        !            58:                case DOUB:
        !            59:                        switch(restype) {
        !            60:                        case SDOT:
        !            61:                                if(result->val->CDR==(lispval) 0) {
        !            62:                                        protect(newdoub());
        !            63:                                        np[-1].val->r = result->val->i+work->r;
        !            64:                                        result->val = np[-1].val;
        !            65:                                        np--;
        !            66:                                        restype = DOUB;
        !            67:                                } else 
        !            68:                                        error("Don't know how to make bignums into reals, yet",FALSE);
        !            69:                                break;
        !            70:                        case DOUB:
        !            71:                                result->val->r += work->r;
        !            72:                                break;
        !            73:                        default:
        !            74:                                goto urk;
        !            75:                        }
        !            76:                        break;
        !            77:                default:
        !            78:                        error("Non-number to add",FALSE);
        !            79:                }
        !            80:        }
        !            81:        if(restype==DOUB || prunep==FALSE)
        !            82:                return(result->val);
        !            83:        else if (result->val->CDR==(lispval) 0)
        !            84:                return(inewint(result->val->I));
        !            85:        else {
        !            86:                struct sdot dummybig;
        !            87: 
        !            88:                dummybig.I = 0;
        !            89:                dummybig.CDR = (lispval) 0;
        !            90:                return(adbig(&dummybig,result->val));
        !            91:        }
        !            92:        urk:
        !            93:                error("Internal error in (add,sub,quo,times)",FALSE);
        !            94: }
        !            95: lispval
        !            96: Lsub()
        !            97: {
        !            98:        register lispval work;
        !            99:        register ap result, mynp, oldnp, lbot, np;
        !           100:        int itemp;
        !           101:        lispval Lminus();
        !           102: 
        !           103:        oldnp = result = np;
        !           104:        mynp = lbot + 1;
        !           105:        protect(rdrsdot);
        !           106:        rdrsdot->CDR = (lispval) 0;
        !           107:        rdrsdot->I =0;
        !           108:        restype = SDOT;
        !           109:        prunep = TRUE;
        !           110:        if(oldnp==lbot)
        !           111:                goto out;
        !           112:        if(oldnp==mynp)
        !           113:                return(Lminus());
        !           114:        work = lbot->val;
        !           115:        switch(TYPE(work)) {
        !           116:        case INT:
        !           117:                rdrsdot->I = work->i;
        !           118:                break;
        !           119:        case SDOT:
        !           120:                result->val = adbig(result->val,work);
        !           121:                if(TYPE(result->val)==INT) {
        !           122:                        rdrsdot->I = result->val->i;
        !           123:                        result->val = rdrsdot;
        !           124:                }
        !           125:                break;
        !           126:        case DOUB:
        !           127:                (result->val = newdoub())->r = work->r;
        !           128:                restype = DOUB;
        !           129:        }
        !           130: 
        !           131:        for(; mynp < oldnp; mynp++)
        !           132:        {
        !           133:                work = mynp->val;
        !           134:                switch(TYPE(work)) {
        !           135:                case INT:
        !           136:                        switch(restype) {
        !           137:                        case DOUB:
        !           138:                                result->val->r -= work->i;
        !           139:                                break;
        !           140:                        case SDOT:
        !           141:                                dmlad(result->val,1, -work->i);
        !           142:                                prunep = TRUE;
        !           143:                                break;
        !           144:                        default:
        !           145:                                goto urk;
        !           146:                        }
        !           147:                        break;
        !           148:                case SDOT:
        !           149:                        switch(restype) {
        !           150:                        case DOUB:
        !           151:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !           152:                                break;
        !           153:                        case SDOT:
        !           154:                                result->val = subbig(result->val,work);
        !           155:                                restype = TYPE(result->val);
        !           156:                                if(restype==INT) {
        !           157:                                        rdrsdot->I=result->val->I;
        !           158:                                        rdrsdot->CDR = (lispval) 0;
        !           159:                                        result->val = rdrsdot;
        !           160:                                        restype=SDOT;
        !           161:                                        prunep = TRUE;
        !           162:                                } else
        !           163:                                        prunep = FALSE;
        !           164:                                break;
        !           165:                        default:
        !           166:                                goto urk;
        !           167:                        }
        !           168:                        break;
        !           169:                case DOUB:
        !           170:                        switch(restype) {
        !           171:                        case SDOT:
        !           172:                                if(result->val->CDR==(lispval) 0) {
        !           173:                                        protect(newdoub());
        !           174:                                        np[-1].val->r = result->val->i-work->r;
        !           175:                                        result->val = np[-1].val;
        !           176:                                        np--;
        !           177:                                        restype = DOUB;
        !           178:                                } else 
        !           179:                                        error("Don't know how to make bignums into reals, yet",FALSE);
        !           180:                                break;
        !           181:                        case DOUB:
        !           182:                                result->val->r -= work->r;
        !           183:                                break;
        !           184:                        default:
        !           185:                                goto urk;
        !           186:                        }
        !           187:                        break;
        !           188:                default:
        !           189:                        error("Non-number to minus",FALSE);
        !           190:                }
        !           191:        }
        !           192: out:
        !           193:        if(restype==DOUB || prunep==FALSE)
        !           194:                return(result->val);
        !           195:        else if (result->val->CDR==(lispval) 0)
        !           196:                return(inewint(result->val->I));
        !           197:        else {
        !           198:                struct sdot dummybig;
        !           199: 
        !           200:                dummybig.I = 0;
        !           201:                dummybig.CDR = (lispval) 0;
        !           202:                return(adbig(&dummybig,result->val));
        !           203:        }
        !           204:        urk:
        !           205:                error("Internal error in (add,sub,quo,times)",FALSE);
        !           206: }
        !           207: lispval
        !           208: Ltimes()
        !           209: {
        !           210:        register lispval work;
        !           211:        register ap result, mynp, oldnp, lbot, np;
        !           212:        int itemp;
        !           213: 
        !           214:        oldnp = result = np;
        !           215:        protect(rdrsdot);
        !           216:        rdrsdot->CDR = (lispval) 0;
        !           217:        rdrsdot->I = 1;
        !           218:        restype = SDOT;
        !           219:        prunep = TRUE;
        !           220: 
        !           221:        for(mynp = lbot; mynp < oldnp; mynp++)
        !           222:        {
        !           223:                work = mynp->val;
        !           224:                switch(TYPE(work)) {
        !           225:                case INT:
        !           226:                        switch(restype) {
        !           227:                        case DOUB:
        !           228:                                result->val->r *= work->i;
        !           229:                                break;
        !           230:                        case SDOT:
        !           231:                                dmlad(result->val,work->i,0);
        !           232:                                prunep = TRUE;
        !           233:                                break;
        !           234:                        default:
        !           235:                                goto urk;
        !           236:                        }
        !           237:                        break;
        !           238:                case SDOT:
        !           239:                        switch(restype) {
        !           240:                        case DOUB:
        !           241:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !           242:                                break;
        !           243:                        case SDOT:
        !           244:                                result->val = mulbig(work,result->val);
        !           245:                                restype = TYPE(result->val);
        !           246:                                if(restype==INT) {
        !           247:                                        if(result->val->i==0)
        !           248:                                                return(result->val);
        !           249:                                        rdrsdot->I=result->val->I;
        !           250:                                        rdrsdot->CDR = (lispval) 0;
        !           251:                                        result->val = rdrsdot;
        !           252:                                        restype=SDOT;
        !           253:                                        prunep = TRUE;
        !           254:                                } else
        !           255:                                        prunep = FALSE;
        !           256:                                break;
        !           257:                        default:
        !           258:                                goto urk;
        !           259:                        }
        !           260:                        break;
        !           261:                case DOUB:
        !           262:                        switch(restype) {
        !           263:                        case SDOT:
        !           264:                                if(result->val->CDR==(lispval) 0) {
        !           265:                                        protect(newdoub());
        !           266:                                        np[-1].val->r = result->val->i*work->r;
        !           267:                                        result->val = np[-1].val;
        !           268:                                        np--;
        !           269:                                        restype = DOUB;
        !           270:                                } else 
        !           271:                                        error("Don't know how to make bignums into reals, yet",FALSE);
        !           272:                                break;
        !           273:                        case DOUB:
        !           274:                                result->val->r *= work->r;
        !           275:                                break;
        !           276:                        default:
        !           277:                                goto urk;
        !           278:                        }
        !           279:                        break;
        !           280:                default:
        !           281:                        error("Non-number to times",FALSE);
        !           282:                }
        !           283:        }
        !           284:        if(restype==DOUB || prunep==FALSE)
        !           285:                return(result->val);
        !           286:        else if (result->val->CDR==(lispval) 0)
        !           287:                return(inewint(result->val->I));
        !           288:        else {
        !           289:                struct sdot dummybig;
        !           290: 
        !           291:                dummybig.I = 0;
        !           292:                dummybig.CDR = (lispval) 0;
        !           293:                return(adbig(&dummybig,result->val));
        !           294:        }
        !           295:        urk:
        !           296:                error("Internal error in (add,sub,quo,times)",FALSE);
        !           297: }
        !           298: lispval
        !           299: Lquo()
        !           300: {
        !           301:        register lispval work;
        !           302:        register lispval result;
        !           303:        register struct argent *mynp;
        !           304:        register struct argent *oldnp, *lbot, *np;
        !           305:        int bigflag = 0, realflag = 0, itemp;
        !           306:        struct sdot dummybig;
        !           307:        lispval divbig(), *resaddr;
        !           308: 
        !           309:        mynp = lbot;
        !           310:        oldnp = np-1;
        !           311:        dummybig.CDR = (lispval) 0;
        !           312:        dummybig.I = 1;
        !           313:        if(mynp > oldnp) goto out;
        !           314:        work = (mynp++)->val;
        !           315:        itemp = TYPE(work);
        !           316:        switch(itemp) {
        !           317:        case INT:
        !           318:                dummybig.I = work->i;
        !           319:                break;
        !           320:        case DOUB:
        !           321:                realflag = 1;
        !           322:                protect(result = newdoub());
        !           323:                result->r = work->r;
        !           324:                break;
        !           325:        case SDOT:
        !           326:                protect(work);
        !           327:                resaddr = &(np[-1].val);
        !           328:                bigflag = 1;
        !           329:                break;
        !           330:        default:
        !           331:                error("Don't know how to divide this type.",FALSE);
        !           332:        }
        !           333:        for(;mynp <= oldnp; mynp++) {
        !           334:                work = mynp->val;
        !           335:                itemp = TYPE(work);
        !           336:                switch(itemp) {
        !           337: 
        !           338:                case INT:
        !           339:                        if (work->i==0)
        !           340:                                kill(getpid(),8);
        !           341:                        if (realflag)
        !           342:                                result->r /= work->i;
        !           343:                        else if(bigflag) {
        !           344:                                dummybig.I = work->i;
        !           345:                                divbig(*resaddr, &dummybig, resaddr, 0);
        !           346:                        } else {
        !           347:                                dummybig.I /= work->i;
        !           348:                        }
        !           349:                        break;
        !           350:                case DOUB:
        !           351:                        if(realflag)
        !           352:                                result->r /= work->r;
        !           353:                        else if(bigflag)
        !           354:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !           355:                        else {
        !           356:                                realflag = 1;
        !           357:                                result = newdoub();
        !           358:                                result->r = (double) dummybig.I / work->r;
        !           359:                                protect(result);
        !           360:                        }
        !           361:                        break;
        !           362:                case SDOT:
        !           363:                        if(realflag)
        !           364:                                error("Don't know how to divide reals by bignums ",FALSE);
        !           365:                        else if(bigflag)
        !           366:                                divbig(*resaddr, work, resaddr, 0);
        !           367:                        else {
        !           368:                                bigflag = 1;
        !           369:                                protect(newsdot());
        !           370:                                resaddr = &(np[-1].val);
        !           371:                                np[-1].val->i = dummybig.I;
        !           372:                                divbig(*resaddr, work, resaddr, 0);
        !           373:                        }
        !           374:                        break;
        !           375:                default:
        !           376:                        error("Don't know how to divide this type",FALSE);
        !           377: 
        !           378:                }
        !           379:        }
        !           380: out:
        !           381:        if(realflag)
        !           382:                return(result);
        !           383:        else if (bigflag)
        !           384:                return(*resaddr);
        !           385:        else {
        !           386:                result = inewint(  dummybig.I );
        !           387:                return(result);
        !           388:        }
        !           389: }

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