![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fex2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to fex2.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1: static char *sccsid = "@(#)fex2.c 34.1 10/3/80";
2:
3: #include "global.h"
4: #define NDOVARS 30
5: #include <assert.h>
6: /*
7: * Ndo maclisp do function.
8: */
9: lispval
10: Ndo()
11: {
12: register lispval current, where, handy;
13: register struct nament *mybnp;
14: register struct argent *lbot, *np;
15: lispval atom, temp;
16: lispval body, endtest, endform, varstuf, renewals[NDOVARS] ;
17: struct argent *start, *last, *getem, *savedlbot;
18: struct nament *savedbnp, *lastbnd;
19: int count, index, saveme[SAVSIZE], virgin = 1;
20: long myerrp; extern long errp;
21:
22: savedlbot = lbot;
23: myerrp = errp;
24: savedbnp = bnp;
25: getexit(saveme); /* common nonlocal return */
26: if(retval = setexit()) {
27: errp = myerrp;
28: if(retval == BRRETN) {
29: resexit(saveme);
30: lbot = savedlbot;
31: popnames(savedbnp);
32: return((lispval) contval);
33: } else {
34: resexit(saveme);
35: lbot = savedlbot;
36: reset(retval);
37: }
38: }
39: current = lbot->val;
40: varstuf = current->d.car;
41: switch( TYPE(varstuf) ) {
42:
43: case ATOM: /* This is old style maclisp do;
44: atom is var, cadr(current) = init;
45: caddr(current) = repeat etc. */
46: atom = varstuf;
47: if(varstuf==nil) goto newstyle;
48: bnp->atm = atom; /* save current binding of atom */
49: bnp++->val = atom->a.clb;
50: if(bnp > bnplim)
51: binderr();
52: current = current->d.cdr;
53: atom->a.clb = eval(current->d.car);
54: /* Init var. */
55: *renewals = (current = current->d.cdr)->d.car;
56: /* get repeat form */
57: endtest = (current = current->d.cdr)->d.car;
58: body = current->d.cdr;
59:
60: while(TRUE) {
61: if(eval(endtest)!=nil) {
62: resexit(saveme);
63: popnames(savedbnp);
64: return(nil);
65: }
66: doprog(body);
67: atom->a.clb = eval(*renewals);
68: }
69:
70:
71: newstyle:
72: case DTPR: /* New style maclisp do; atom is
73: list of things of the form
74: (var init repeat) */
75: count = 0;
76: start = np;
77: for(where = varstuf; where != nil; where = where->d.cdr) {
78: /* do inits and count do vars. */
79: /* requires "simultaneous" eval
80: of all inits */
81: handy = where->d.car->d.cdr;
82: temp = nil;
83: if(handy !=nil)
84: temp = eval(handy->d.car);
85: protect(temp);
86: count++;
87: }
88: if(count > NDOVARS)
89: error("More than 15 do vars",FALSE);
90: bnp += count;
91: if(bnp >= bnplim) {
92: bnp = savedbnp;
93: namerr();
94: }
95: last = np;
96: where = varstuf;
97: mybnp = savedbnp;
98: getem = start;
99: for(index = 0; index < count; index++) {
100:
101: handy = where->d.car;
102: /* get var name from group */
103: atom = handy->d.car;
104: mybnp->atm = atom;
105: mybnp->val = atom->a.clb;
106: /* Swap current binding of atom
107: for init val pushed on stack */
108:
109: atom->a.clb = getem++->val;
110: /* As long as we are down here in the
111: list, save repeat form */
112: handy = handy->d.cdr->d.cdr;
113: if(handy==nil)
114: handy = CNIL; /* be sure not to rebind later */
115: else
116: handy = handy->d.car;
117: renewals[index] = handy;
118:
119: /* more loop "increments" */
120: where = where->d.cdr;
121: mybnp++;
122: }
123: /* Examine End test and End form */
124: current = current->d.cdr;
125: handy = current->d.car;
126: body = current->d.cdr;
127: if (handy == nil) {
128: doprog(body);
129: popnames(savedbnp);
130: resexit(saveme);
131: return(nil);
132: }
133: endtest = handy->d.car;
134: endform = handy->d.cdr;
135: /* The following is the loop: */
136: loop:
137: if(eval(endtest)!=nil) {
138: for(handy = nil; endform!=nil; endform = endform->d.cdr){
139: handy = eval(endform->d.car);
140: }
141: resexit(saveme);
142: popnames(savedbnp);
143: return(handy);
144: }
145: doprog(body);
146: /* Simultaneously eval repeat forms */
147: for(index = 0; index < count; index++) {
148:
149: temp = renewals[index];
150: if (temp == nil || temp == CNIL)
151: protect(temp);
152: else
153: protect(eval(temp));
154: }
155: getem = (np = last);
156: /* now simult. rebind all the atoms */
157: mybnp = savedbnp;
158: for(index = 0; index < count; index++, getem++) {
159: if( (getem)->val != CNIL ) /* if this atom has a repeat form */
160: mybnp->atm->a.clb = (getem)->val; /* rebind */
161: mybnp++;
162: }
163: goto loop;
164: }
165: }
166: doprog(body)
167: register lispval body;
168: {
169: int saveme[SAVSIZE];
170: register lispval where, temp;
171: /*register struct nament *savednp = np, *savedlbot = lbot;*/
172: extern long errp; long myerrp = errp;
173: struct nament *savedbnp = bnp;
174: snpand(3);
175:
176: where = body;
177: getexit(saveme);
178: if(retval = setexit()) {
179: errp = myerrp;
180: switch (retval) {
181:
182: default: resexit(saveme);
183: reset(retval);
184:
185: case BRGOTO:
186: for(where = body;
187: where->d.car != (lispval) contval; where = where->d.cdr) {
188:
189: if(where==nil) {
190: resexit(saveme);
191: reset(retval);
192: }
193: /* np is automatically restored here by
194: virtue of being a register */
195: }
196: popnames(savedbnp);
197: }
198: }
199: while (TYPE(where) == DTPR) {
200: temp = where->d.car;
201: if((TYPE(temp))!=ATOM) eval(temp);
202: where = where->d.cdr;
203: }
204: resexit(saveme);
205: }
206: lispval
207: Nprogv()
208: {
209: register lispval where, handy;
210: register struct nament *namptr;
211: register struct argent *vars, *lbot, *np;
212: struct argent *start;
213: struct nament *oldbnp = bnp;
214:
215: where = lbot->val;
216: protect(eval(where->d.car)); /* list of vars = lbot[1].val */
217: protect(eval((where = where->d.cdr)->d.car));
218: /* list of vals */
219: handy = lbot[2].val;
220: start = np; namptr = oldbnp;
221: /* simultaneous eval of all
222: args */
223: for(;handy!=nil; handy = handy->d.cdr) {
224: (np++)->val = eval(handy->d.car);
225: TNP;
226: }
227: asm("# Here is where rebinding is done");
228: for(handy=lbot[1].val,vars=lbot+3; handy!=nil; handy=handy->d.cdr) {
229: namptr->atm = handy->d.car;
230: ++namptr; /* protect against interrupts
231: while re-lambda binding */
232: bnp = namptr;
233: namptr[-1].atm = handy->d.car;
234: namptr[-1].val = handy->d.car->a.clb;
235: if(vars < np)
236: handy->d.car->a.clb = vars++->val;
237: else
238: handy->d.car->a.clb = nil;
239: }
240:
241: handy = nil;
242: for(where = where->d.cdr; where != nil; where = where->d.cdr)
243: handy = eval(where->d.car);
244: popnames(oldbnp);
245: return(handy);
246: }
247:
248: lispval
249: Nprogn()
250: {
251: register lispval result, where;
252: snpand(2);
253:
254: result = nil;
255: for(where = lbot->val; where != nil; where = where->d.cdr)
256: result = eval(where->d.car);
257: return(result);
258:
259:
260: }
261: lispval
262: Nprog2()
263: {
264: register lispval result, where;
265: snpand(2);
266:
267: where = lbot->val;
268: eval(where->d.car);
269: result = eval((where = where->d.cdr)->d.car);
270: protect(result);
271: for(where = where->d.cdr; where != nil; where = where->d.cdr)
272: eval(where->d.car);
273: return(result);
274: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.