Return to trace.c CVS log

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

Annotation of 42BSD/ucb/lisp/franz/trace.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char *rcsid =
        !             3:    "$Header: /na/franz/franz/RCS/trace.c,v 1.2 83/08/19 09:50:34 jkf Exp $";
        !             4: #endif
        !             5: 
        !             6: /*                                     -[Thu Aug 18 10:08:36 1983 by jkf]-
        !             7:  *     trace.c                         $Locker:  $
        !             8:  * evalhook evaluator
        !             9:  *
        !            10:  * (c) copyright 1982, Regents of the University of California
        !            11:  */
        !            12: 
        !            13: #include "global.h"
        !            14: lispval
        !            15: Leval1(){
        !            16:     register struct nament *bindptr;
        !            17:     register lispval handy;
        !            18:     if (np-lbot == 2) {        /*if two arguments to eval */
        !            19:        if (TYPE((lbot+1)->val) != INT)
        !            20:            error("Eval: 2nd arg not legal alist pointer", FALSE);
        !            21:        bindptr = orgbnp + (lbot+1)->val->i;
        !            22:        if (rsetsw == 0 || rsetatom->a.clb == nil)
        !            23:            error("Not in *rsetmode; second arg is useless - eval", TRUE);
        !            24:        if (bptr_atom->a.clb != nil)
        !            25:            error("WARNING - Nesting 2nd args to eval will give spurious values", TRUE);
        !            26:        if (bindptr < orgbnp || bindptr >bnplim)
        !            27:            error("Illegal pdl pointer as 2nd arg - eval", FALSE);
        !            28:        handy = newdot();
        !            29:        handy->d.car = (lispval)bindptr;
        !            30:        handy->d.cdr = (lispval)bnp;
        !            31:        PUSHDOWN(bptr_atom, handy); 
        !            32:        handy = eval(lbot->val);
        !            33:        POP;
        !            34:        return(handy);
        !            35:     } else {   /* normal case - only one arg */
        !            36:        chkarg(1,"eval");
        !            37:        handy = eval(lbot->val);
        !            38:        return(handy);
        !            39:     };
        !            40: }
        !            41: 
        !            42: lispval
        !            43: Levalhook()
        !            44: {
        !            45:     register lispval handy;
        !            46:     register lispval funhval = CNIL;
        !            47: 
        !            48:     switch (np-lbot) 
        !            49:     {
        !            50:     case 2: break;
        !            51:     case 3: funhval = (lbot+2)->val;
        !            52:            break;
        !            53:     default: argerr("evalhook");
        !            54:     }
        !            55: 
        !            56:     /* Don't do this check any longer
        !            57:      * if (evalhsw == 0) 
        !            58:      *     error("evalhook called before doing sstatus-evalhook", TRUE);
        !            59:      * if (rsetsw == 0 || rsetatom->a.clb == nil)
        !            60:      *    error("evalhook called while not in *rset mode", TRUE);
        !            61:      */
        !            62:      
        !            63:     if(funhval != CNIL) { PUSHDOWN(funhatom,funhval); }
        !            64: 
        !            65:     PUSHDOWN(evalhatom,(lispval)(lbot+1)->val);
        !            66:     /* eval checks evalhcall to see if this is a LISP call to evalhook
        !            67:        in which case it avoids call to evalhook function, but clobbers
        !            68:        value to nil so recursive calls will check.  */
        !            69:     evalhcallsw = TRUE;        
        !            70:     handy = eval(lbot->val);
        !            71:     POP;
        !            72: 
        !            73:     if(funhval != CNIL) { POP; }
        !            74: 
        !            75:     return(handy);
        !            76: }
        !            77: 
        !            78: 
        !            79: lispval
        !            80: Lfunhook()
        !            81: {
        !            82:     register lispval handy;
        !            83:     register lispval evalhval = CNIL;
        !            84:     Savestack(2);
        !            85: 
        !            86: 
        !            87:     switch (np-lbot) 
        !            88:     {
        !            89:     case 2: break;
        !            90:     case 3: evalhval = (lbot+2)->val;
        !            91:            break;
        !            92:     default: argerr("funcallhook");
        !            93:     }
        !            94: 
        !            95:     /* Don't do this check any longer
        !            96:      * if (evalhsw == 0) 
        !            97:      *     error("funcallhook called before doing sstatus-evalhook", TRUE);
        !            98:      *if (rsetsw == 0 || rsetatom->a.clb == nil)
        !            99:      *     error("funcallhook called while not in *rset mode", TRUE);
        !           100:      */
        !           101:      
        !           102:     handy = lbot->val;
        !           103:     while (TYPE(handy) != DTPR) 
        !           104:       handy = errorh1(Vermisc,"funcallhook: first arg must be a list",nil,TRUE,
        !           105:                                           0,handy);
        !           106:     if(evalhval != CNIL) { PUSHDOWN(evalhatom,evalhval); }
        !           107: 
        !           108:     PUSHDOWN(funhatom,(lispval)(lbot+1)->val);
        !           109:     /* funcall checks funcallhcall to see if this is a LISP call to evalhook
        !           110:        in which case it avoids call to evalhook function, but clobbers
        !           111:        value to nil so recursive calls will check.  */
        !           112:     funhcallsw = TRUE; 
        !           113:     /*
        !           114:      * the first argument to funhook is a list of already evaluated expressions
        !           115:      * which we just stack can call funcall on
        !           116:      */
        !           117:     lbot = np;         /* base of new args */
        !           118:     for ( ; handy != nil ; handy = handy->d.cdr)
        !           119:     {
        !           120:        protect(handy->d.car);
        !           121:     }
        !           122:     handy = Lfuncal();
        !           123:     POP;
        !           124:     if(evalhval != CNIL) { POP;  }
        !           125:     Restorestack();
        !           126:     return(handy);
        !           127: }
        !           128: 
        !           129: 
        !           130: lispval
        !           131: Lrset ()
        !           132:     {
        !           133:     chkarg(1,"rset");
        !           134: 
        !           135:     rsetsw = (lbot->val == nil) ? 0 : 1;
        !           136:     rsetatom->a.clb = (lbot->val == nil) ? nil: tatom;
        !           137:     evalhcallsw = FALSE;
        !           138:     return(lbot->val);
        !           139: }
        !           140: 

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