4.3BSD - /usr/src/ucb/lisp/franz/trace.c

   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: }

Defined functions

Defined variables