![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fex1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz|
Return to fex1.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz |
1.1 root 1: #ifndef lint
2: static char *rcsid =
3: "$Header: fex1.c,v 1.5 85/03/24 11:03:51 sklower Exp $";
4: #endif
5:
6: /* -[Sat Mar 5 19:50:28 1983 by layer]-
7: * fex1.c $Locker: $
8: * nlambda functions
9: *
10: * (c) copyright 1982, Regents of the University of California
11: */
12:
13:
14: #include "global.h"
15: #include "frame.h"
16:
17: /* Nprog ****************************************************************/
18: /* This first sets the local variables to nil while saving their old */
19: /* values on the name stack. Then, pointers to various things are */
20: /* saved as this function may be returned to by an "Ngo" or by a */
21: /* "Lreturn". At the end is the loop that cycles through the contents */
22: /* of the prog. */
23:
24: lispval
25: Nprog() {
26: register lispval where, temp;
27: struct nament *savedbnp = bnp;
28: extern struct frame *errp;
29: pbuf pb;
30: extern int retval;
31: extern lispval lispretval;
32:
33: if((np-lbot) < 1) chkarg(1,"prog");
34:
35: /* shallow bind the local variables to nil */
36: if(lbot->val->d.car != nil)
37: {
38: for( where = lbot->val->d.car ; where != nil; where = where->d.cdr )
39: {
40: if(TYPE(where) != DTPR || TYPE(temp=where->d.car) != ATOM)
41: errorh1(Vermisc,
42: "Illegal local variable list in prog ",nil,FALSE,
43: 1,where);
44: PUSHDOWN(temp,nil);
45: }
46: }
47:
48: /* put a frame on the stack which can be 'return'ed to or 'go'ed to */
49: errp = Pushframe(F_PROG,nil,nil);
50:
51: where = lbot->val->d.cdr; /* first thing in the prog body */
52:
53: switch (retval) {
54: case C_RET: /*
55: * returning from this prog, value to return
56: * is in lispretval
57: */
58: errp = Popframe();
59: popnames(savedbnp);
60: return(lispretval);
61:
62: case C_GO: /*
63: * going to a certain label, label to go to in
64: * in lispretval
65: */
66: where = (lbot->val)->d.cdr;
67: while ((TYPE(where) == DTPR)
68: && (where->d.car != lispretval))
69: where = where->d.cdr;
70: if (where->d.car == lispretval) {
71: popnames(errp->svbnp);
72: break;
73: }
74: /* label not found in this prog, must
75: * go up to higher prog
76: */
77: errp = Popframe(); /* go to next frame */
78: Inonlocalgo(C_GO,lispretval,nil);
79:
80: /* NOT REACHED */
81:
82: case C_INITIAL: break;
83:
84: }
85:
86: while (TYPE(where) == DTPR)
87: {
88: temp = where->d.car;
89: if((TYPE(temp))!=ATOM) eval(temp);
90: where = where->d.cdr;
91: }
92: if((where != nil) && (TYPE(where) != DTPR))
93: errorh1(Vermisc,"Illegal form in prog body ", nil,FALSE,0,where);
94: errp = Popframe();
95: popnames(savedbnp); /* pop off locals */
96: return(nil);
97: }
98:
99: lispval globtag;
100: /*
101: Ncatch is now linked to the lisp symbol *catch , which has the form
102: (*catch tag form)
103: tag is evaluated and then the catch entry is set up.
104: then form is evaluated
105: finally the catch entry is removed.
106:
107: *catch is still an nlambda since its arguments should not be evaluated
108: before this routine is called.
109:
110: (catch form [tag]) is translated to (*catch 'tag form) by a macro.
111: */
112: lispval
113: Ncatch()
114: {
115: register lispval tag;
116: pbuf pb;
117: Savestack(3); /* save stack pointers */
118:
119: if((TYPE(lbot->val))!=DTPR) return(nil);
120: protect(tag = eval(lbot->val->d.car)); /* protect tag from gc */
121:
122: errp = Pushframe(F_CATCH,tag,nil);
123:
124: switch(retval) {
125:
126: case C_THROW: /*
127: * value thrown is in lispretval
128: */
129: break;
130:
131: case C_INITIAL: /*
132: * calculate value of expression
133: */
134: lispretval = eval(lbot->val->d.cdr->d.car);
135: }
136:
137:
138: errp = Popframe();
139: Restorestack();
140: return(lispretval);
141: }
142: /* (errset form [flag])
143: if present, flag determines if the error message will be printed
144: if an error reaches the errset.
145: if no error occurs, errset returns a list of one element, the
146: value returned from form.
147: if an error occurs, nil is usually returned although it could
148: be non nil if err threw a non nil value
149: */
150:
151: lispval Nerrset()
152: {
153: lispval temp,flag;
154: pbuf pb;
155: Savestack(0);
156:
157: if(TYPE(lbot->val) != DTPR) return(nil); /* no form */
158:
159: /* evaluate and save flag first */
160: flag = lbot->val->d.cdr;
161: if(TYPE(flag) == DTPR) flag = eval(flag->d.car);
162: else flag = tatom; /* if not present , assume t */
163: protect(flag);
164:
165: errp = Pushframe(F_CATCH,Verall,flag);
166:
167: switch(retval) {
168:
169: case C_THROW: /*
170: * error thrown to this routine, value thrown is
171: * in lispretval
172: */
173: break;
174:
175: case C_INITIAL: /*
176: * normally just evaluate expression and listify it.
177: */
178: temp = eval(lbot->val->d.car);
179: protect(temp);
180: (lispretval = newdot())->d.car = temp;
181: break;
182: }
183:
184: errp = Popframe();
185: Restorestack();
186: return(lispretval);
187: }
188:
189: /* this was changed from throw to *throw 21nov79
190: it is now a lambda and really should be called Lthrow
191: */
192: lispval
193: Nthrow()
194: {
195: switch(np-lbot) {
196: case 0:
197: protect(nil);
198: case 1:
199: protect(nil);
200: case 2: break;
201: default:
202: argerr("throw");
203: }
204: Inonlocalgo(C_THROW,lbot->val,(lbot+1)->val);
205: /* NOT REACHED */
206: }
207:
208:
209:
210: /* Ngo ******************************************************************/
211: /* First argument only is checked - and must be an atom or evaluate */
212: /* to one. */
213: lispval
214: Ngo()
215: {
216: register lispval temp;
217: chkarg(1,"go");
218:
219: temp = (lbot->val)->d.car;
220: if (TYPE(temp) != ATOM)
221: {
222: temp = eval(temp);
223: while(TYPE(temp) != ATOM)
224: temp = errorh1(Vermisc,"Illegal tag to go to",nil,TRUE, 0,lbot->val);
225: }
226: Inonlocalgo(C_GO,temp,nil);
227: /* NOT REACHED */
228: }
229:
230:
231: /* Nreset ***************************************************************/
232: /* All arguments are ignored. This just returns-from-break to depth 0. */
233: lispval
234: Nreset()
235: {
236: Inonlocalgo(C_RESET,inewint(0),nil);
237: }
238:
239:
240:
241: /* Nbreak ***************************************************************/
242: /* If first argument is not nil, this is evaluated and printed. Then */
243: /* error is called with the "breaking" message. */
244:
245: lispval
246: Nbreak()
247: {
248: register lispval hold; register FILE *port;
249: port = okport(Vpoport->a.clb,stdout);
250: fprintf(port,"Breaking:");
251:
252: if ((hold = lbot->val) != nil && ((hold = hold->d.car) != nil))
253: {
254: printr(hold,port);
255: }
256: putc('\n',port);
257: dmpport(port);
258: return(errorh(Verbrk,"",nil,TRUE,0));
259: }
260:
261:
262: /* Nexit ****************************************************************/
263: /* Just calls lispend with no message. */
264: Nexit()
265: {
266: lispend("");
267: }
268:
269:
270: /* Nsys *****************************************************************/
271: /* Just calls lispend with no message. */
272:
273: lispval
274: Nsys()
275: {
276: lispend("");
277: }
278:
279:
280:
281:
282: lispval
283: Ndef() {
284: register lispval arglist, body, name, form;
285:
286: form = lbot->val;
287: name = form->d.car;
288: body = form->d.cdr->d.car;
289: arglist = body->d.cdr->d.car;
290: if((TYPE(arglist))!=DTPR && arglist != nil)
291: error("Warning: defining function with nonlist of args",
292: TRUE);
293: name->a.fnbnd = body;
294: return(name);
295: }
296:
297:
298: lispval
299: Nquote()
300: {
301: return((lbot->val)->d.car);
302: }
303:
304:
305: lispval
306: Nsetq()
307: { register lispval handy, where, value;
308: register int lefttype;
309:
310: value = nil;
311:
312: for(where = lbot->val; where != nil; where = handy->d.cdr) {
313: handy = where->d.cdr;
314: if((TYPE(handy))!=DTPR)
315: error("odd number of args to setq",FALSE);
316: if((lefttype=TYPE(where->d.car))==ATOM) {
317: if(where->d.car==nil)
318: error("Attempt to set nil",FALSE);
319: where->d.car->a.clb = value = eval(handy->d.car);
320: }else if(lefttype==VALUE)
321: where->d.car->l = value = eval(handy->d.car);
322: else errorh1(Vermisc,
323: "Can only setq atoms or values",nil,FALSE,0,
324: where->d.car);
325: }
326: return(value);
327: }
328:
329:
330: lispval
331: Ncond()
332: {
333: register lispval where, last;
334:
335: where = lbot->val;
336: last = nil;
337: for(;;) {
338: if ((TYPE(where))!=DTPR)
339: break;
340: if ((TYPE(where->d.car))!=DTPR)
341: break;
342: if ((last=eval((where->d.car)->d.car)) != nil)
343: break;
344: where = where->d.cdr;
345: }
346:
347: if ((TYPE(where)) != DTPR)
348: return(nil);
349: where = (where->d.car)->d.cdr;
350: while ((TYPE(where))==DTPR) {
351: last = eval(where->d.car);
352: where = where->d.cdr;
353: }
354: return(last);
355: }
356:
357: lispval
358: Nand()
359: {
360: register lispval current, temp;
361:
362: current = lbot->val;
363: temp = tatom;
364: while (current != nil)
365: if ( (temp = current->d.car)!=nil && (temp = eval(temp))!=nil)
366: current = current->d.cdr;
367: else {
368: current = nil;
369: temp = nil;
370: }
371: return(temp);
372: }
373:
374:
375: lispval
376: Nor()
377: {
378: register lispval current, temp;
379:
380: current = lbot->val;
381: temp = nil;
382: while (current != nil)
383: if ( (temp = eval(current->d.car)) == nil)
384: current = current->d.cdr;
385: else
386: break;
387: return(temp);
388: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.