Return to fex2.c CVS log

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

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

1.1     ! root        1: #include "global.h"
        !             2: #define NDOVARS 15
        !             3: #include <assert.h>
        !             4: /*
        !             5:  * Ndo  maclisp do function.
        !             6:  */
        !             7: lispval
        !             8: Ndo()
        !             9: {
        !            10:        register lispval current, where, handy;
        !            11:        register struct nament *mybnp;
        !            12:        register struct argent *lbot, *np;
        !            13:        lispval atom, temp;
        !            14:        lispval body, endtest, endform, varstuf, renewals[NDOVARS] ;
        !            15:        struct argent *start, *last, *getem,  *savedlbot; 
        !            16:        struct nament *savedbnp, *lastbnd;
        !            17:        int count, index, saveme[SAVSIZE], virgin = 1;
        !            18:        int myerrp; extern int errp;
        !            19: 
        !            20:        savedlbot = lbot;
        !            21:        myerrp = errp;
        !            22:        savedbnp = bnp;
        !            23:        getexit(saveme);                /* common nonlocal return */
        !            24:        if(retval = setexit()) {
        !            25:                errp = myerrp;
        !            26:                if(retval == BRRETN) {
        !            27:                        resexit(saveme);
        !            28:                        lbot = savedlbot;
        !            29:                        popnames(savedbnp);
        !            30:                        return((lispval) contval);
        !            31:                } else {
        !            32:                        resexit(saveme);
        !            33:                        lbot = savedlbot;
        !            34:                        reset(retval);
        !            35:                }
        !            36:        }
        !            37:        current = lbot->val;
        !            38:        varstuf = current->car;
        !            39:        switch( TYPE(varstuf) ) {
        !            40: 
        !            41:        case ATOM:                      /* This is old style maclisp do;
        !            42:                                           atom is var, cadr(current) = init;
        !            43:                                           caddr(current) = repeat etc. */
        !            44:                atom = varstuf;
        !            45:                if(varstuf==nil) goto newstyle;
        !            46:                bnp->atm = atom;        /* save current binding of atom */
        !            47:                bnp++->val = atom->clb;
        !            48:                if(bnp > bnplim)
        !            49:                        binderr();
        !            50:                current = current->cdr;
        !            51:                atom->clb = eval(current->car);
        !            52:                                        /* Init var.        */
        !            53:                *renewals = (current = current->cdr)->car;
        !            54:                                        /* get repeat form  */
        !            55:                endtest = (current = current->cdr)->car;
        !            56:                body = current->cdr;
        !            57: 
        !            58:                while(TRUE) {
        !            59:                        if(eval(endtest)!=nil) {
        !            60:                                resexit(saveme);
        !            61:                                popnames(savedbnp);
        !            62:                                return(nil);
        !            63:                        }
        !            64:                        doprog(body);
        !            65:                        atom->clb = eval(*renewals);
        !            66:                }
        !            67:        
        !            68: 
        !            69:        newstyle:
        !            70:        case DTPR:                      /* New style maclisp do; atom is
        !            71:                                           list of things of the form
        !            72:                                           (var init repeat)            */
        !            73:                count = 0;
        !            74:                start = np;
        !            75:                for(where = varstuf; where != nil; where = where->cdr) {
        !            76:                                        /* do inits and count do vars. */
        !            77:                                        /* requires "simultaneous" eval
        !            78:                                           of all inits                 */
        !            79:                        handy = where->car->cdr;
        !            80:                        temp = nil;
        !            81:                        if(handy !=nil)
        !            82:                                temp = eval(handy->car);
        !            83:                        protect(temp);
        !            84:                        count++;
        !            85:                }
        !            86:                if(count > NDOVARS)
        !            87:                        error("More than 15 do vars",FALSE);
        !            88:                bnp += count;
        !            89:                if(bnp >= bnplim) {
        !            90:                        bnp = savedbnp;
        !            91:                        namerr();
        !            92:                }
        !            93:                last = np;
        !            94:                where = varstuf;
        !            95:                mybnp = savedbnp;
        !            96:                getem = start;
        !            97:                for(index = 0; index < count; index++) {
        !            98: 
        !            99:                        handy = where->car;
        !           100:                                        /* get var name from group      */
        !           101:                        atom = handy->car;
        !           102:                        mybnp->atm = atom;
        !           103:                        mybnp->val = atom->clb;
        !           104:                                        /* Swap current binding of atom
        !           105:                                           for init val pushed on stack */
        !           106: 
        !           107:                        atom->clb = getem++->val;
        !           108:                                        /* As long as we are down here in the
        !           109:                                           list, save repeat form       */
        !           110:                        handy = handy->cdr->cdr;
        !           111:                        if(handy==nil)
        !           112:                                handy = CNIL;  /* be sure not to rebind later */
        !           113:                        else
        !           114:                                handy = handy->car;
        !           115:                        renewals[index] = handy;
        !           116: 
        !           117:                                        /* more loop "increments" */
        !           118:                        where = where->cdr;
        !           119:                        mybnp++;
        !           120:                }
        !           121:                                        /* Examine End test and End form */
        !           122:                current = current->cdr;
        !           123:                handy = current->car;
        !           124:                body = current->cdr;
        !           125:                if (handy == nil) {
        !           126:                        doprog(body);
        !           127:                        popnames(savedbnp);
        !           128:                        resexit(saveme);
        !           129:                        return(nil);
        !           130:                }
        !           131:                endtest = handy->car;
        !           132:                endform = handy->cdr;
        !           133:                                        /* The following is the loop: */
        !           134:        loop:
        !           135:                if(eval(endtest)!=nil) {
        !           136:                        for(handy = nil; endform!=nil; endform = endform->cdr){
        !           137:                                handy = eval(endform->car);
        !           138:                        }
        !           139:                        resexit(saveme);
        !           140:                        popnames(savedbnp);
        !           141:                        return(handy);
        !           142:                }
        !           143:                doprog(body);
        !           144:                                        /* Simultaneously eval repeat forms */
        !           145:                for(index = 0; index < count; index++) {
        !           146: 
        !           147:                        temp = renewals[index];
        !           148:                        if (temp == nil || temp == CNIL)
        !           149:                                protect(temp);
        !           150:                        else
        !           151:                                protect(eval(temp));
        !           152:                }
        !           153:                getem = (np = last);
        !           154:                                        /* now simult. rebind all the atoms */
        !           155:                mybnp = savedbnp;
        !           156:                for(index = 0; index < count; index++, getem++) {
        !           157:                   if( (getem)->val != CNIL )  /* if this atom has a repeat form */
        !           158:                        mybnp->atm->clb = (getem)->val;  /* rebind */
        !           159:                        mybnp++;
        !           160:                }
        !           161:                goto loop;
        !           162:        }
        !           163: }
        !           164: doprog(body)
        !           165: register lispval body;
        !           166:        {
        !           167:        int     saveme[SAVSIZE];
        !           168:        register lispval where, temp;
        !           169:        /*register struct nament *savednp = np, *savedlbot = lbot;*/
        !           170:        extern int errp; int myerrp = errp;
        !           171:        struct nament *savedbnp = bnp;
        !           172:        snpand(2);
        !           173: 
        !           174:        where = body;
        !           175:        getexit(saveme);
        !           176:        if(retval = setexit()) {
        !           177:                errp = myerrp;
        !           178:                switch (retval) {
        !           179: 
        !           180:                default:        resexit(saveme);
        !           181:                                reset(retval);
        !           182: 
        !           183:                case BRGOTO:
        !           184:                        for(where = body;
        !           185:                                where->car != (lispval) contval; where = where->cdr) {
        !           186: 
        !           187:                                if(where==nil) {
        !           188:                                        resexit(saveme);
        !           189:                                        reset(retval);
        !           190:                                }
        !           191:                                /* np is automatically restored here by
        !           192:                                   virtue of being a register */
        !           193:                        }
        !           194:                        popnames(savedbnp);
        !           195:                }
        !           196:        }
        !           197:        while (TYPE(where) == DTPR) {
        !           198:                temp = where->car;
        !           199:                if((TYPE(temp))!=ATOM) eval(temp);
        !           200:                where = where->cdr;
        !           201:        }
        !           202:        resexit(saveme);
        !           203: }
        !           204: lispval
        !           205: Nprogv()
        !           206: {
        !           207:        register lispval argptr, where, handy, atoms;
        !           208:        register struct argent *lbot, *np;
        !           209:        struct argent *namptr, *start;
        !           210:        struct nament *oldbnp = bnp;
        !           211: 
        !           212:        where = lbot->val;
        !           213:        protect(eval(where->car));              /* list of vars */
        !           214:        atoms = lbot[1].val;
        !           215:        protect(eval((where = where->cdr)->car));
        !           216:                                                /* list of vals */
        !           217:        handy = lbot[2].val;
        !           218:        start = np;
        !           219:        for(;handy!=nil; handy = handy->cdr) {
        !           220:                (np++)->val = eval(handy->car);
        !           221:                TNP;
        !           222:        }
        !           223:        rebind(atoms,start);
        !           224:        handy = nil;
        !           225:        for(where = where->cdr; where != nil; where = where->cdr)
        !           226:                handy = eval(where->car);
        !           227:        popnames(oldbnp);
        !           228:        return(handy);
        !           229: }
        !           230: 
        !           231: lispval
        !           232: Nprogn()
        !           233: {
        !           234:        register lispval result, where;
        !           235:        snpand(2);
        !           236: 
        !           237:        result = nil;
        !           238:        for(where = lbot->val; where != nil; where = where->cdr)
        !           239:                result = eval(where->car);
        !           240:        return(result);
        !           241: 
        !           242: 
        !           243: }
        !           244: lispval
        !           245: Nprog2()
        !           246: {
        !           247:        register lispval result, where;
        !           248:        snpand(2);
        !           249: 
        !           250:        where = lbot->val; 
        !           251:        eval(where->car);
        !           252:        result = eval((where = where->cdr)->car);
        !           253:        protect(result);
        !           254:        for(where = where->cdr; where != nil; where = where->cdr)
        !           255:                eval(where->car);
        !           256:        return(result);
        !           257: }

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