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