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

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.