Return to lam4.c CVS log

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

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

1.1     ! root        1: static char *sccsid = "@(#)lam4.c      34.1 10/3/80";
        !             2: 
        !             3: #include "global.h"
        !             4: typedef struct argent *ap;
        !             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,restype;
        !            12: 
        !            13:        oldnp = result = np;
        !            14:        protect(rdrsdot);
        !            15:        rdrsdot->s.CDR = (lispval) 0;
        !            16:        rdrsdot->s.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->s.I=result->val->s.I;
        !            47:                                        rdrsdot->s.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->s.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:                        errorh(Vermisc,"Non-number to add",nil,0,FALSE,work);
        !            79:                }
        !            80:        }
        !            81:        if(restype==DOUB || prunep==FALSE)
        !            82:                return(result->val);
        !            83:        else if (result->val->s.CDR==(lispval) 0)
        !            84:                return(inewint(result->val->s.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,restype;
        !           101:        lispval Lminus();
        !           102: 
        !           103:        oldnp = result = np;
        !           104:        mynp = lbot + 1;
        !           105:        protect(rdrsdot);
        !           106:        rdrsdot->s.CDR = (lispval) 0;
        !           107:        rdrsdot->s.I =0;
        !           108:        restype = SDOT;
        !           109:        prunep = TRUE;
        !           110:        if(oldnp==lbot)
        !           111:                goto out;
        !           112:        if(oldnp==mynp) {
        !           113:                np--;
        !           114:                return(Lminus());
        !           115:        }
        !           116:        work = lbot->val;
        !           117:        switch(TYPE(work)) {
        !           118:        case INT:
        !           119:                rdrsdot->s.I = work->i;
        !           120:                break;
        !           121:        case SDOT:
        !           122:                result->val = adbig(result->val,work);
        !           123:                if(TYPE(result->val)==INT) {
        !           124:                        rdrsdot->s.I = result->val->i;
        !           125:                        result->val = rdrsdot;
        !           126:                }
        !           127:                break;
        !           128:        case DOUB:
        !           129:                (result->val = newdoub())->r = work->r;
        !           130:                restype = DOUB;
        !           131:        }
        !           132: 
        !           133:        for(; mynp < oldnp; mynp++)
        !           134:        {
        !           135:                work = mynp->val;
        !           136:                switch(TYPE(work)) {
        !           137:                case INT:
        !           138:                        switch(restype) {
        !           139:                        case DOUB:
        !           140:                                result->val->r -= work->i;
        !           141:                                break;
        !           142:                        case SDOT:
        !           143:                                dmlad(result->val,1, -work->i);
        !           144:                                prunep = TRUE;
        !           145:                                break;
        !           146:                        default:
        !           147:                                goto urk;
        !           148:                        }
        !           149:                        break;
        !           150:                case SDOT:
        !           151:                        switch(restype) {
        !           152:                        case DOUB:
        !           153:                                errorh(Vermisc,
        !           154:                                       "difference: Don't know how to make bignums into reals, yet",
        !           155:                                       nil,FALSE,0,work);
        !           156:                                break;
        !           157:                        case SDOT:
        !           158:                                result->val = subbig(result->val,work);
        !           159:                                restype = TYPE(result->val);
        !           160:                                if(restype==INT) {
        !           161:                                        rdrsdot->s.I=result->val->s.I;
        !           162:                                        rdrsdot->s.CDR = (lispval) 0;
        !           163:                                        result->val = rdrsdot;
        !           164:                                        restype=SDOT;
        !           165:                                        prunep = TRUE;
        !           166:                                } else
        !           167:                                        prunep = FALSE;
        !           168:                                break;
        !           169:                        default:
        !           170:                                goto urk;
        !           171:                        }
        !           172:                        break;
        !           173:                case DOUB:
        !           174:                        switch(restype) {
        !           175:                        case SDOT:
        !           176:                                if(result->val->s.CDR==(lispval) 0) {
        !           177:                                        protect(newdoub());
        !           178:                                        np[-1].val->r = result->val->i-work->r;
        !           179:                                        result->val = np[-1].val;
        !           180:                                        np--;
        !           181:                                        restype = DOUB;
        !           182:                                } else 
        !           183:                                        errorh(Vermisc,
        !           184:                                               "difference: Don't know how to make bignums into reals ",nil,FALSE,0,work);
        !           185:                                break;
        !           186:                        case DOUB:
        !           187:                                result->val->r -= work->r;
        !           188:                                break;
        !           189:                        default:
        !           190:                                goto urk;
        !           191:                        }
        !           192:                        break;
        !           193:                default:
        !           194:                        errorh(Vermisc,"Non-number to minus",nil,FALSE,0,work);
        !           195:                }
        !           196:        }
        !           197: out:
        !           198:        if(restype==DOUB || prunep==FALSE)
        !           199:                return(result->val);
        !           200:        else if (result->val->s.CDR==(lispval) 0)
        !           201:                return(inewint(result->val->s.I));
        !           202:        else {
        !           203:                struct sdot dummybig;
        !           204: 
        !           205:                dummybig.I = 0;
        !           206:                dummybig.CDR = (lispval) 0;
        !           207:                return(adbig(&dummybig,result->val));
        !           208:        }
        !           209:        urk:
        !           210:                error("Internal error in (add,sub,quo,times)",FALSE);
        !           211: }
        !           212: lispval
        !           213: Ltimes()
        !           214: {
        !           215:        register lispval work;
        !           216:        register ap result, mynp, oldnp, lbot, np;
        !           217:        int itemp,restype;
        !           218: 
        !           219:        oldnp = result = np;
        !           220:        protect(rdrsdot);
        !           221:        rdrsdot->s.CDR = (lispval) 0;
        !           222:        rdrsdot->s.I = 1;
        !           223:        restype = SDOT;
        !           224:        prunep = TRUE;
        !           225: 
        !           226:        for(mynp = lbot; mynp < oldnp; mynp++)
        !           227:        {
        !           228:                work = mynp->val;
        !           229:                switch(TYPE(work)) {
        !           230:                case INT:
        !           231:                        switch(restype) {
        !           232:                        case DOUB:
        !           233:                                result->val->r *= work->i;
        !           234:                                break;
        !           235:                        case SDOT:
        !           236:                                dmlad(result->val,work->i,0);
        !           237:                                prunep = TRUE;
        !           238:                                break;
        !           239:                        default:
        !           240:                                goto urk;
        !           241:                        }
        !           242:                        break;
        !           243:                case SDOT:
        !           244:                        switch(restype) {
        !           245:                        case DOUB:
        !           246:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !           247:                                break;
        !           248:                        case SDOT:
        !           249:                                result->val = mulbig(work,result->val);
        !           250:                                restype = TYPE(result->val);
        !           251:                                if(restype==INT) {
        !           252:                                        if(result->val->i==0)
        !           253:                                                return(result->val);
        !           254:                                        rdrsdot->s.I=result->val->s.I;
        !           255:                                        rdrsdot->s.CDR = (lispval) 0;
        !           256:                                        result->val = rdrsdot;
        !           257:                                        restype=SDOT;
        !           258:                                        prunep = TRUE;
        !           259:                                } else
        !           260:                                        prunep = FALSE;
        !           261:                                break;
        !           262:                        default:
        !           263:                                goto urk;
        !           264:                        }
        !           265:                        break;
        !           266:                case DOUB:
        !           267:                        switch(restype) {
        !           268:                        case SDOT:
        !           269:                                if(result->val->s.CDR==(lispval) 0) {
        !           270:                                        protect(newdoub());
        !           271:                                        np[-1].val->r = result->val->i*work->r;
        !           272:                                        result->val = np[-1].val;
        !           273:                                        np--;
        !           274:                                        restype = DOUB;
        !           275:                                } else 
        !           276:                                        error("Don't know how to make bignums into reals, yet",FALSE);
        !           277:                                break;
        !           278:                        case DOUB:
        !           279:                                result->val->r *= work->r;
        !           280:                                break;
        !           281:                        default:
        !           282:                                goto urk;
        !           283:                        }
        !           284:                        break;
        !           285:                default:
        !           286:                        error("Non-number to times",FALSE);
        !           287:                }
        !           288:        }
        !           289:        if(restype==DOUB || prunep==FALSE)
        !           290:                return(result->val);
        !           291:        else if (result->val->s.CDR==(lispval) 0)
        !           292:                return(inewint(result->val->s.I));
        !           293:        else {
        !           294:                struct sdot dummybig;
        !           295: 
        !           296:                dummybig.I = 0;
        !           297:                dummybig.CDR = (lispval) 0;
        !           298:                return(adbig(&dummybig,result->val));
        !           299:        }
        !           300:        urk:
        !           301:                error("Internal error in (add,sub,quo,times)",FALSE);
        !           302: }
        !           303: lispval
        !           304: Lquo()
        !           305: {
        !           306:        register lispval work;
        !           307:        register lispval result;
        !           308:        register struct argent *mynp;
        !           309:        register struct argent *oldnp, *lbot, *np;
        !           310:        int bigflag = 0, realflag = 0, itemp;
        !           311:        struct sdot dummybig;
        !           312:        lispval divbig(), *resaddr;
        !           313: 
        !           314:        mynp = lbot;
        !           315:        oldnp = np-1;
        !           316:        dummybig.CDR = (lispval) 0;
        !           317:        dummybig.I = 1;
        !           318:        if(mynp > oldnp) goto out;
        !           319:        work = (mynp++)->val;
        !           320:        itemp = TYPE(work);
        !           321:        switch(itemp) {
        !           322:        case INT:
        !           323:                if(mynp <= oldnp) dummybig.I = work->i;
        !           324:                else dummybig.I = 1/work->i;
        !           325:                break;
        !           326:        case DOUB:
        !           327:                realflag = 1;
        !           328:                protect(result = newdoub());
        !           329:                if(mynp <= oldnp) result->r = work->r;
        !           330:                else result->r = 1.0/work->r;
        !           331:                break;
        !           332:        case SDOT: /* must be fixed for the inverse case */
        !           333:                protect(work);
        !           334:                resaddr = &(np[-1].val);
        !           335:                bigflag = 1;
        !           336:                break;
        !           337:        default:
        !           338:                error("Don't know how to divide this type.",FALSE);
        !           339:        }
        !           340:        for(;mynp <= oldnp; mynp++) {
        !           341:                work = mynp->val;
        !           342:                itemp = TYPE(work);
        !           343:                switch(itemp) {
        !           344: 
        !           345:                case INT:
        !           346:                        if (work->i==0)
        !           347:                                kill(getpid(),8);
        !           348:                        if (realflag)
        !           349:                                result->r /= work->i;
        !           350:                        else if(bigflag) {
        !           351:                                dummybig.I = work->i;
        !           352:                                divbig(*resaddr, &dummybig, resaddr, 0);
        !           353:                        } else {
        !           354:                                dummybig.I /= work->i;
        !           355:                        }
        !           356:                        break;
        !           357:                case DOUB:
        !           358:                        if(realflag)
        !           359:                                result->r /= work->r;
        !           360:                        else if(bigflag)
        !           361:                                error("Don't know how to make bignums into reals, yet",FALSE);
        !           362:                        else {
        !           363:                                realflag = 1;
        !           364:                                result = newdoub();
        !           365:                                result->r = (double) dummybig.I / work->r;
        !           366:                                protect(result);
        !           367:                        }
        !           368:                        break;
        !           369:                case SDOT:
        !           370:                        if(realflag)
        !           371:                                error("Don't know how to divide reals by bignums ",FALSE);
        !           372:                        else if(bigflag)
        !           373:                                divbig(*resaddr, work, resaddr, 0);
        !           374:                        else {
        !           375:                                bigflag = 1;
        !           376:                                protect(newsdot());
        !           377:                                resaddr = &(np[-1].val);
        !           378:                                np[-1].val->i = dummybig.I;
        !           379:                                divbig(*resaddr, work, resaddr, 0);
        !           380:                        }
        !           381:                        break;
        !           382:                default:
        !           383:                        error("Don't know how to divide this type",FALSE);
        !           384: 
        !           385:                }
        !           386:        }
        !           387: out:
        !           388:        if(realflag)
        !           389:                return(result);
        !           390:        else if (bigflag)
        !           391:                return(*resaddr);
        !           392:        else {
        !           393:                result = inewint(  dummybig.I );
        !           394:                return(result);
        !           395:        }
        !           396: }

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