BSD 3 development

[unix-history] / usr / src / cmd / lisp / fex2.c

#include "global.h"
#define NDOVARS 15
#include <assert.h>
/*
* Ndo  maclisp do function.
*/
lispval
Ndo()
{
       register lispval current, where, handy;
       register struct nament *mybnp;
       register struct argent *lbot, *np;
       lispval atom, temp;
       lispval body, endtest, endform, varstuf, renewals[NDOVARS] ;
       struct argent *start, *last, *getem,  *savedlbot; 
       struct nament *savedbnp, *lastbnd;
       int count, index, saveme[SAVSIZE], virgin = 1;
       int myerrp; extern int errp;

       savedlbot = lbot;
       myerrp = errp;
       savedbnp = bnp;
       getexit(saveme);                /* common nonlocal return */
       if(retval = setexit()) {
               errp = myerrp;
               if(retval == BRRETN) {
                       resexit(saveme);
                       lbot = savedlbot;
                       popnames(savedbnp);
                       return((lispval) contval);
               } else {
                       resexit(saveme);
                       lbot = savedlbot;
                       reset(retval);
               }
       }
       current = lbot->val;
       varstuf = current->car;
       switch( TYPE(varstuf) ) {

       case ATOM:                      /* This is old style maclisp do;
                                          atom is var, cadr(current) = init;
                                          caddr(current) = repeat etc. */
               atom = varstuf;
               if(varstuf==nil) goto newstyle;
               bnp->atm = atom;        /* save current binding of atom */
               bnp++->val = atom->clb;
               if(bnp > bnplim)
                       binderr();
               current = current->cdr;
               atom->clb = eval(current->car);
                                       /* Init var.        */
               *renewals = (current = current->cdr)->car;
                                       /* get repeat form  */
               endtest = (current = current->cdr)->car;
               body = current->cdr;

               while(TRUE) {
                       if(eval(endtest)!=nil) {
                               resexit(saveme);
                               popnames(savedbnp);
                               return(nil);
                       }
                       doprog(body);
                       atom->clb = eval(*renewals);
               }
       

       newstyle:
       case DTPR:                      /* New style maclisp do; atom is
                                          list of things of the form
                                          (var init repeat)            */
               count = 0;
               start = np;
               for(where = varstuf; where != nil; where = where->cdr) {
                                       /* do inits and count do vars. */
                                       /* requires "simultaneous" eval
                                          of all inits                 */
                       handy = where->car->cdr;
                       temp = nil;
                       if(handy !=nil)
                               temp = eval(handy->car);
                       protect(temp);
                       count++;
               }
               if(count > NDOVARS)
                       error("More than 15 do vars",FALSE);
               bnp += count;
               if(bnp >= bnplim) {
                       bnp = savedbnp;
                       namerr();
               }
               last = np;
               where = varstuf;
               mybnp = savedbnp;
               getem = start;
               for(index = 0; index < count; index++) {

                       handy = where->car;
                                       /* get var name from group      */
                       atom = handy->car;
                       mybnp->atm = atom;
                       mybnp->val = atom->clb;
                                       /* Swap current binding of atom
                                          for init val pushed on stack */

                       atom->clb = getem++->val;
                                       /* As long as we are down here in the
                                          list, save repeat form       */
                       handy = handy->cdr->cdr;
                       if(handy==nil)
                               handy = CNIL;  /* be sure not to rebind later */
                       else
                               handy = handy->car;
                       renewals[index] = handy;

                                       /* more loop "increments" */
                       where = where->cdr;
                       mybnp++;
               }
                                       /* Examine End test and End form */
               current = current->cdr;
               handy = current->car;
               body = current->cdr;
               if (handy == nil) {
                       doprog(body);
                       popnames(savedbnp);
                       resexit(saveme);
                       return(nil);
               }
               endtest = handy->car;
               endform = handy->cdr;
                                       /* The following is the loop: */
       loop:
               if(eval(endtest)!=nil) {
                       for(handy = nil; endform!=nil; endform = endform->cdr){
                               handy = eval(endform->car);
                       }
                       resexit(saveme);
                       popnames(savedbnp);
                       return(handy);
               }
               doprog(body);
                                       /* Simultaneously eval repeat forms */
               for(index = 0; index < count; index++) {

                       temp = renewals[index];
                       if (temp == nil || temp == CNIL)
                               protect(temp);
                       else
                               protect(eval(temp));
               }
               getem = (np = last);
                                       /* now simult. rebind all the atoms */
               mybnp = savedbnp;
               for(index = 0; index < count; index++, getem++) {
                  if( (getem)->val != CNIL )  /* if this atom has a repeat form */
                       mybnp->atm->clb = (getem)->val;  /* rebind */
                       mybnp++;
               }
               goto loop;
       }
}
doprog(body)
register lispval body;
       {
       int     saveme[SAVSIZE];
       register lispval where, temp;
       /*register struct nament *savednp = np, *savedlbot = lbot;*/
       extern int errp; int myerrp = errp;
       struct nament *savedbnp = bnp;
       snpand(2);

       where = body;
       getexit(saveme);
       if(retval = setexit()) {
               errp = myerrp;
               switch (retval) {

               default:        resexit(saveme);
                               reset(retval);

               case BRGOTO:
                       for(where = body;
                               where->car != (lispval) contval; where = where->cdr) {

                               if(where==nil) {
                                       resexit(saveme);
                                       reset(retval);
                               }
                               /* np is automatically restored here by
                                  virtue of being a register */
                       }
                       popnames(savedbnp);
               }
       }
       while (TYPE(where) == DTPR) {
               temp = where->car;
               if((TYPE(temp))!=ATOM) eval(temp);
               where = where->cdr;
       }
       resexit(saveme);
}
lispval
Nprogv()
{
       register lispval argptr, where, handy, atoms;
       register struct argent *lbot, *np;
       struct argent *namptr, *start;
       struct nament *oldbnp = bnp;

       where = lbot->val;
       protect(eval(where->car));              /* list of vars */
       atoms = lbot[1].val;
       protect(eval((where = where->cdr)->car));
                                               /* list of vals */
       handy = lbot[2].val;
       start = np;
       for(;handy!=nil; handy = handy->cdr) {
               (np++)->val = eval(handy->car);
               TNP;
       }
       rebind(atoms,start);
       handy = nil;
       for(where = where->cdr; where != nil; where = where->cdr)
               handy = eval(where->car);
       popnames(oldbnp);
       return(handy);
}

lispval
Nprogn()
{
       register lispval result, where;
       snpand(2);

       result = nil;
       for(where = lbot->val; where != nil; where = where->cdr)
               result = eval(where->car);
       return(result);


}
lispval
Nprog2()
{
       register lispval result, where;
       snpand(2);

       where = lbot->val; 
       eval(where->car);
       result = eval((where = where->cdr)->car);
       protect(result);
       for(where = where->cdr; where != nil; where = where->cdr)
               eval(where->car);
       return(result);
}