franz/fex1.c
/* Nprog ****************************************************************/
/* This first sets the local variables to nil while saving their old	*/
/* values on the name stack.  Then, pointers to various things are	*/
/* saved as this function may be returned to by an "Ngo" or by a	*/
/* "Lreturn".  At the end is the loop that cycles through the contents	*/
/* of the prog.								*/
Nprog
This first sets the local variables to nil while saving their old
values on the name stack.  Then, pointers to various things are
saved as this function may be returned to by an "Ngo" or by a
"Lreturn".  At the end is the loop that cycles through the contents
of the prog.
Nprog This first sets the local variables to nil while saving their old values on the name stack . Then pointers to various things are saved as this function may be returned to by an " Ngo " or by a " Lreturn " . At the end is the loop that cycles through the contents of the prog .
lispval
Nprog() {
	register lispval where, temp;
	struct nament *savedbnp = bnp;
	extern struct frame *errp;
	pbuf pb;
	extern int retval;
	extern lispval lispretval;
	if((np-lbot) < 1) chkarg(1,"prog");
	if(lbot->val->d.car != nil)
	{
	    for( where = lbot->val->d.car ; where != nil; where = where->d.cdr )
	    {
	        if(TYPE(where) != DTPR || TYPE(temp=where->d.car) != ATOM)
		    errorh1(Vermisc,
			   "Illegal local variable list in prog ",nil,FALSE,
			   1,where);
    	        PUSHDOWN(temp,nil);
	    }
	}
	errp = Pushframe(F_PROG,nil,nil);
	where = lbot->val->d.cdr;	
	switch (retval)	{
	case C_RET:	
			errp = Popframe();
			popnames(savedbnp);
			return(lispretval);
	case C_GO:	
			where = (lbot->val)->d.cdr;
			while ((TYPE(where) == DTPR) 
			       && (where->d.car != lispretval))
				where = where->d.cdr;
			if (where->d.car == lispretval) {
				popnames(errp->svbnp);
				break;
			}
			errp = Popframe();	
			Inonlocalgo(C_GO,lispretval,nil);
	case C_INITIAL: break;
	}
	while (TYPE(where) == DTPR)
		{
		temp = where->d.car;
		if((TYPE(temp))!=ATOM) eval(temp);
		where = where->d.cdr;
		}
	if((where != nil) && (TYPE(where) != DTPR)) 
	    errorh1(Vermisc,"Illegal form in prog body ", nil,FALSE,0,where);
	errp = Popframe();
	popnames(savedbnp);	
	return(nil);
}
lispval Nprog ( ) { register lispval where , temp ; struct nament * savedbnp = bnp ; extern struct frame * errp ; pbuf pb ; extern int retval ; extern lispval lispretval ; if ( ( np - lbot ) < 1 ) chkarg ( 1 , " " ) ; if ( lbot -> val -> d . car != nil ) { for ( where = lbot -> val -> d . car ; where != nil ; where = where -> d . cdr ) { if ( TYPE ( where ) != DTPR || TYPE ( temp = where -> d . car ) != ATOM ) errorh1 ( Vermisc , " " , nil , FALSE , 1 , where ) ; PUSHDOWN ( temp , nil ) ; } } errp = Pushframe ( F_PROG , nil , nil ) ; where = lbot -> val -> d . cdr ; switch ( retval ) { case C_RET : errp = Popframe ( ) ; popnames ( savedbnp ) ; return ( lispretval ) ; case C_GO : where = ( lbot -> val ) -> d . cdr ; while ( ( TYPE ( where ) == DTPR ) && ( where -> d . car != lispretval ) ) where = where -> d . cdr ; if ( where -> d . car == lispretval ) { popnames ( errp -> svbnp ) ; break ; } errp = Popframe ( ) ; Inonlocalgo ( C_GO , lispretval , nil ) ; case C_INITIAL : break ; } while ( TYPE ( where ) == DTPR ) { temp = where -> d . car ; if ( ( TYPE ( temp ) ) != ATOM ) eval ( temp ) ; where = where -> d . cdr ; } if ( ( where != nil ) && ( TYPE ( where ) != DTPR ) ) errorh1 ( Vermisc , " " , nil , FALSE , 0 , where ) ; errp = Popframe ( ) ; popnames ( savedbnp ) ; return ( nil ) ; }
Nprog
This first sets the local variables to nil while saving their old
values on the name stack.
Nprog This first sets the local variables to nil while saving their old values on the name stack .
/* shallow bind the local variables to nil */ /* put a frame on the stack which can be 'return'ed to or 'go'ed to */ /* first thing in the prog body */ /*
			 * returning from this prog, value to return
			 * is in lispretval
			 */ /*
			 * going to a certain label, label to go to in
			 * in lispretval
			 */ /* label not found in this prog, must 
			 * go up to higher prog
			 */ /* go to next frame */ /* NOT REACHED */ /* pop off locals */