Commit | Line | Data |
---|---|---|
71e91d93 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 | } | |
140 |