Return to evalf.c CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / franz

Annotation of 43BSD/ucb/lisp/franz/evalf.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: #include "frame.h"
        !             3: 
        !             4: lispval
        !             5: Levalf ()
        !             6: {
        !             7:     register struct frame *myfp;
        !             8:     register lispval handy, result;
        !             9:     struct frame *searchforpdl();
        !            10:     int evaltype;
        !            11:     Savestack(3);
        !            12: 
        !            13:     if(lbot==np) handy = nil;
        !            14:     else if((np-lbot) == 1) handy = lbot->val;
        !            15:     else argerr("evalf");
        !            16: 
        !            17:     if (handy == nil)  /* Arg of nil means start at the top */
        !            18:     {
        !            19:        myfp = searchforpdl(errp);      
        !            20:        /* 
        !            21:         * myfp may be nil, if *rset t wasn't done. In that case we
        !            22:         * just return nil
        !            23:         */
        !            24:        if(myfp == (struct frame *) 0) return(nil);
        !            25:        /*
        !            26:         * myfp may point to the call to evalframe, in which case we
        !            27:         * want to go to the next frame down.  myfp will not point
        !            28:         * to the call to evalframe if for example the translink tables
        !            29:         * are turned on and the call came from compiled code
        !            30:         */
        !            31:        if(    ((myfp->class == F_EVAL) 
        !            32:                     && TYPE(myfp->larg1) == DTPR
        !            33:                     && myfp->larg1->d.car == Vevalframe)
        !            34:            || ((myfp->class == F_FUNCALL)
        !            35:                     && (myfp->larg1 = Vevalframe)))
        !            36:            
        !            37:           myfp = searchforpdl(myfp->olderrp);  /* advance to next frame */
        !            38:     } 
        !            39:     else 
        !            40:     {
        !            41:        if( TYPE(handy) != INT ) 
        !            42:            error("Arg to evalframe must be integer",TRUE);
        !            43:            /* 
        !            44:             * Interesting artifact: A pdl pointer will be an INT, but if
        !            45:             * read in, the Franz reader produces a bignum, thus giving some
        !            46:             * protection from being hacked. 
        !            47:             */
        !            48:            
        !            49:        myfp = (struct frame *)(handy->i);
        !            50:        vfypdlp(myfp);  /* make sure we are given valid pointer */
        !            51:        myfp = searchforpdl(myfp);
        !            52:         if (myfp == (struct frame *) 0 ) return(nil);  /* end of frames */
        !            53:        myfp = searchforpdl(myfp->olderrp);     /* advance to next one */
        !            54:     };
        !            55: 
        !            56: 
        !            57:     if (myfp == (struct frame *) 0 ) return(nil);      /* end of frames */
        !            58: 
        !            59:     if(myfp->class == F_EVAL) evaltype = TRUE; else evaltype = FALSE;
        !            60: 
        !            61:     /* return ( <eval or apply> <fp> <exp being evaled> <bnp>) */
        !            62:     protect(result = newdot());
        !            63:     /* 
        !            64:      * See maclisp manual for difference between eval frames and apply
        !            65:      * frames, or else see the code below. 
        !            66:      */
        !            67:     result->d.car = matom (evaltype ? "eval" : "apply"); 
        !            68:     result->d.cdr = (handy = newdot());
        !            69:     handy->d.car = inewint(myfp); /* The frame pointer as a lisp int */
        !            70:     handy->d.cdr = newdot();
        !            71:     handy = handy->d.cdr;
        !            72:     if (evaltype)
        !            73:        handy->d.car = myfp->larg1;  /* eval type - simply the arg to eval */
        !            74:     else 
        !            75:     {  /*  
        !            76:         * apply type ; must build argument list. The form will look like
        !            77:        *
        !            78:        *         (<function> (<evaled arg1> <evaled arg2> ....))
        !            79:        *   i.e. the function name followed by a list of evaluated args 
        !            80:        */
        !            81:        lispval form, arglist;
        !            82:        struct argent *pntr;
        !            83:        (form = newdot())->d.car = myfp->larg1;
        !            84:        handy->d.car = form;                    /* link in to save from gc */
        !            85:        (form->d.cdr = newdot())->d.cdr = nil;
        !            86:        for (arglist = nil, pntr = myfp->svlbot; pntr < myfp->svnp;  pntr++) 
        !            87:        {
        !            88:            if(arglist == nil) 
        !            89:            {
        !            90:                protect(arglist = newdot());
        !            91:                form->d.cdr->d.car = arglist;   /* save from gc */
        !            92:            }
        !            93:            else arglist = (arglist->d.cdr = newdot());
        !            94:            arglist->d.car = pntr->val;
        !            95:        };
        !            96:     };
        !            97:     handy->d.cdr = newdot();
        !            98:     handy = handy->d.cdr;
        !            99:        /* Next is index into bindstack lisp pseudo-array, for maximum
        !           100:            usefulness */
        !           101:     handy->d.car = inewint( myfp->svbnp - orgbnp); 
        !           102:     handy->d.cdr = newdot();
        !           103:     handy = handy->d.cdr;
        !           104:        
        !           105:     handy->d.car = inewint(myfp->svnp - orgnp);        /* index of np in namestack*/
        !           106:     handy->d.cdr = newdot();
        !           107:     handy = handy->d.cdr;
        !           108:     handy->d.car = inewint(myfp->svlbot - orgnp);/* index of lbot in namestack*/
        !           109:     Restorestack();
        !           110:     return(result);
        !           111: }
        !           112: 
        !           113: struct frame *searchforpdl (myfp)
        !           114: struct frame *myfp;
        !           115: {
        !           116:     /*
        !           117:      * for safety sake, we verify that this is a real pdl pointer by
        !           118:      * tracing back all pdl pointers from the start
        !           119:      * then after we find it, we just advance to next F_EVAL or F_FUNCALL
        !           120:      */
        !           121:     vfypdlp(myfp);
        !           122:     for(  ; myfp != (struct frame *)0 ; myfp= myfp->olderrp)
        !           123:     {
        !           124:        if((myfp->class == F_EVAL) || (myfp->class == F_FUNCALL))
        !           125:            return(myfp);
        !           126:     }
        !           127:     return((struct frame *)0);
        !           128: }
        !           129: 
        !           130: /*
        !           131:  * vfypdlp :: verify pdl pointer as existing,  do not return unless
        !           132:  * it is valid
        !           133:  */
        !           134: vfypdlp(curfp)
        !           135: register struct frame *curfp;
        !           136: {
        !           137:     register struct frame *myfp;
        !           138: 
        !           139:     for (myfp = errp; myfp != (struct frame *)0 ; myfp = myfp->olderrp)
        !           140:        if(myfp == curfp) return;
        !           141:     errorh1(Vermisc,"Invalid pdl pointer given: ",nil,FALSE,0,inewint(curfp));
        !           142: }
        !           143: 
        !           144: lispval
        !           145: Lfretn ()
        !           146: {
        !           147:     struct frame *myfp;        
        !           148:     chkarg(2,"freturn");
        !           149: 
        !           150:     if( TYPE(lbot->val) != INT )
        !           151:        error("freturn: 1st arg not pdl pointer",FALSE);
        !           152: 
        !           153:     myfp = (struct frame *) (lbot->val->i);
        !           154:     vfypdlp(myfp);             /* make sure pdlp is valid */
        !           155: 
        !           156:     retval = C_FRETURN;                /* signal coming from freturn */
        !           157:     lispretval = (lbot+1)->val;        /* value to return      */
        !           158:     Iretfromfr(myfp);
        !           159:     /* NOT REACHED */
        !           160: }

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