|
|
1.1 root 1: #include "apl.h"
2:
3: funedit(an_editor)
4: register char *an_editor;
5: {
6: register struct item *p;
7: register f;
8: int a, q;
9:
10: p = sp[-1];
11: if(p->type != LV)
12: error("ed B");
13: f = fork();
14: if(f==0) {
15: for(f=3; f<7; f++)
16: close(f);
17: execl(an_editor+4, an_editor+9, p->namep, 0);
18: execl(an_editor, an_editor+9, p->namep, 0);
19: aprintf("exec failure: ");
20: aprintf(an_editor);
21: exit(0);
22: }
23: if(f==-1)
24: error("try again");
25: a = signal(2, 1);
26: while((q=wait(&integ))!=f)
27: if(q==-1)
28: break;
29: signal(2, a);
30: funload(0);
31: }
32:
33: funload(s)
34: {
35: register struct item *p;
36: register int *f;
37:
38: p = sp[-1];
39: sp--;
40: if(p->type != LV)
41: error("fnl B");
42: f = open(p->namep, 0);
43: if((int)f <= 0)
44: error("cannot open");
45: switch(s) {
46: case 0:
47: fundef(f);
48: return;
49: case 2:
50: clear();
51: case 1:
52: wsload(f);
53: aputchar('\n');
54: }
55: }
56:
57: fundef(f)
58: {
59: short i;
60: register char *a, *c;
61: struct nlist *np;
62: int oifile;
63: long b[256];
64: char bbuf[BUFSIZ];
65:
66: oifile = ifile;
67: ifile = f;
68: a = rline(0);
69: if(a == 0)
70: error("fnd eof");
71: c = compile(a, 2);
72: afree(a);
73: if(c == 0)
74: goto out;
75: copy(IN, c+1, &np, 1);
76: erase(np);
77: np->use = c->c[0];
78: fstat(wfile, b);
79: np->label = b[4];
80: lseek(wfile, 0,2);
81: lseek(ifile, 0, 0);
82: while((a=read(ifile, bbuf, BUFSIZ)) > 0)
83: write(wfile, bbuf, a);
84: write(wfile, '\0', 1);
85: out:
86: close(ifile);
87: ifile = oifile;
88: }
89:
90: struct lablist labldefs = { 0, 0, 0 };
91:
92: funcomp(np)
93: struct nlist *np;
94: {
95: register a, c, *p;
96: int err, size;
97: int oifile;
98:
99: ifile = dup(wfile);
100: lseek(ifile, np->label, 0);
101: size = 0;
102: err = 0;
103: labldefs.nextll = 0;
104: now_xeq.name = np->namep;
105: now_xeq.line = 0;
106: afree(rline(0)); /* Rather inefficient */
107: pass1A:
108: now_xeq.line = size++;
109: if((a=rline(0))==0) {
110: lseek(ifile, np->label, 0);
111: size = 0;
112: now_xeq.line = -1;
113: goto pass1B;
114: }
115: lablchk(a,size);
116: afree(a);
117: goto pass1A;
118:
119: pass1B:
120: ++now_xeq.line;
121: a = rline(0);
122: if(a == 0) {
123: if(err)
124: goto out;
125: p = alloc((size+2)*SINT);
126: *p = size;
127: size = 0;
128: now_xeq.line = -1;
129: lseek(ifile, np->label, 0);
130: err++;
131: goto pass2;
132: }
133: c = compile(a, size==0? 3: 5);
134: size++;
135: afree(a);
136: if(c == 0) {
137: err++;
138: goto pass1B;
139: }
140: afree(c);
141: goto pass1B;
142:
143: pass2:
144: ++now_xeq.line;
145: a = rline(0);
146: if(a == 0)
147: goto pass3;
148: c = compile(a, size==0? 3: 5);
149: size++;
150: afree(a);
151: if(c == 0)
152: goto out;
153: p[size] = c;
154: goto pass2;
155:
156: pass3:
157: now_xeq.line = 0;
158: lseek(ifile, np->label, 0);
159: a = rline(0);
160: if(a == 0)
161: goto out;
162: c = compile(a, 4);
163: afree(a);
164: if(c == 0)
165: goto out;
166: p[size+1] = c;
167: #ifdef SOMED
168: if(debug) {
169: dump(p[1]);
170: dump(c);
171: }
172: #endif
173: np->itemp = p;
174: err = 0;
175:
176: out:
177: unlabel();
178: close(ifile);
179: ifile = oifile;
180: if(err)
181: error("syntax");
182: }
183:
184: lablchk(line,line_no)
185: register char *line;
186: {
187: register struct lablist *lblthru = &labldefs;
188: register char *match;
189: int i, len;
190:
191: match = line;
192: while(*match++==' ')
193: continue;
194: line = --match;
195: if(!alpha(*match++))
196: return;
197: len = 1;
198: while(alpha(*match)||digit(*match))
199: ++len, ++match;
200: while(*match++==' ')
201: continue;
202: --match;
203: if(*match++!='>')
204: return;
205: match[-1] = '\0';
206: while(lblthru->nextll) {
207: if(equal(line,lblthru->lname)) {
208: xeq_mark();
209: aprintf(lblthru->lname);
210: aprintf("> ");
211: error("dup label");
212: }
213: lblthru = lblthru->nextll;
214: }
215: lblthru = lblthru->nextll = alloc(sizeof(struct lablist));
216: lblthru->lno = line_no;
217: lblthru->lname = alloc(match-line);
218: lblthru->nextll = 0;
219: match = line;
220: line = lblthru->lname;
221: for(i=0; i<len; ++i)
222: *line++ = *match++;
223: *line = '\0';
224: }
225:
226: unlabel()
227: {
228: register struct lablist *lblthru, *nextdef;
229:
230: lblthru = labldefs.nextll;
231: while(lblthru) {
232: afree(lblthru->lname);
233: lblthru = lblthru->nextll;
234: }
235: lblthru = &labldefs;
236: while(nextdef=lblthru->nextll) {
237: lblthru = nextdef->nextll;
238: afree(nextdef);
239: if(!lblthru)
240: goto quit;
241: }
242: quit:
243: labldefs.nextll = 0;
244: }
245:
246: ex_fun()
247: {
248: struct nlist *np;
249: register *p, s;
250: int oldflc, oldpcp;
251:
252: pcp += copy(IN, pcp, &np, 1);
253: if(np->itemp == 0)
254: funcomp(np);
255: switch(np->use) {
256: default:
257: error("arg B");
258: case NF:
259: break;
260: case DF:
261: insulate(-2);
262: case MF:
263: insulate(-1);
264: }
265: p = np->itemp;
266: oldflc = funlc;
267: oldpcp = pcp;
268: funlc = 0;
269: s = *p;
270: loop:
271: funlc++;
272: now_xeq.name = np->namep;
273: now_xeq.line = funlc;
274: execute(p[funlc]);
275: if(intflg)
276: error("I");
277: if(funlc <= 0 || funlc >= s) {
278: execute(p[s+1]);
279: funlc = oldflc;
280: pcp = oldpcp;
281: now_xeq.name = now_xeq.line = 0;
282: return;
283: }
284: pop();
285: goto loop;
286: }
287:
288: insulate(arg)
289: {
290: register s, p;
291:
292: p = sp[arg];
293: switch(p->type) {
294: case DA:
295: case CH:
296: p->index = 0;
297: return;
298: case LV:
299: p = p->itemp;
300: s = newdat(p->type, p->rank, p->size);
301: copy(IN, p->dim, s->dim, p->rank);
302: copy(p->type, p->datap, s->datap, p->size);
303: sp[arg] = s;
304: return;
305: default:
306: error("ins B");
307: }
308: }
309:
310: ex_arg1()
311: {
312: register struct item *p;
313: struct nlist *np;
314:
315: pcp += copy(IN, pcp, &np, 1);
316: p = fetch1();
317: sp[-1] = np->itemp;
318: np->itemp = p;
319: np->use = DA;
320: }
321:
322: ex_arg2()
323: {
324: register struct item *p;
325: struct nlist *np;
326:
327: pcp += copy(IN, pcp, &np, 1);
328: p = fetch(sp[-2]);
329: sp[-2] = np->itemp;
330: np->itemp = p;
331: np->use = DA;
332: }
333:
334: ex_auto()
335: {
336: struct nlist *np;
337:
338: pcp += copy(IN, pcp, &np, 1);
339: push(np->itemp);
340: np->itemp = 0;
341: np->use = 0;
342: }
343:
344: ex_rest()
345: {
346: register struct item *p;
347: struct nlist *np;
348:
349: p = fetch1();
350: pcp += copy(IN, pcp, &np, 1);
351: erase(np);
352: np->itemp = sp[-2];
353: np->use = 0;
354: if(np->itemp)
355: np->use = DA;
356: sp--;
357: sp[-1] = p;
358: }
359:
360: ex_br0()
361: {
362:
363: funlc = 0;
364: ex_elid();
365: }
366:
367: ex_br()
368: {
369: register struct item *p;
370:
371: p = fetch1();
372: if(p->size == 0)
373: return;
374: if(p->size != 1)
375: error("branch C");
376: funlc = fix(getdat(p));
377: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.