Return to fex2.c CVS log

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

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

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

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