![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to apl.y CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src|
Return to apl.y CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
1.1 root 1: %{
2: static char apl_y_Sccsid[] = "apl.y @(#)apl.y 1.3 10/5/82 Berkeley ";
3: %}
4: %union {
5: char *charptr;
6: char charval;
7: }
8: %term lex0, lex1, lex2, lex3, lex4, lex5, lex6
9: %term lpar, rpar, lbkt, rbkt, eol, unk
10: %term <charval> com, com0, Quad, asg
11: %term null, dot, cln, semi, comnt, tran
12: %term <charptr> strng nam, numb, nfun, mfun, dfun
13: %term <charval> comexpr, comnam, comnull, comlist
14:
15: %term <charval> dscal, mdscal
16: %term <charval> m, d, md, msub, mdsub
17:
18: %type <charptr> func, header, args, autos, labels, label
19: %type <charptr> fstat0, stat, statement, output, expr
20: %type <charptr> e1, e2, number, subs, sub, monadic
21: %type <charptr> dyadic, subr, anyname, hprint
22: %type <charval> comand, lsub, monad, smonad, sdyad
23: %type <charval> comp, dyad, mdcom, mondya, scalar
24:
25: %{
26: #include "apl.h"
27: int vcount;
28: int scount;
29: int litflag;
30: int nlexsym;
31: int context;
32: char *iline;
33: char *ccharp, *ccharp2;
34: data lnumb; /* current label number */
35: char *labcpp; /* label prologue */
36: char *labcpe; /* label epilogue */
37: int immedcmd; /* immediate command number */
38: %}
39:
40: %%
41:
42: /*
43: * line-at-a-time APL compiler.
44: * first lexical character gives context.
45: */
46: line:
47:
48: /*
49: * immediate.
50: */
51: lex0 stat =
52: {
53: integ = ccharp[-1];
54: if(integ != ASGN && integ != PRINT && integ != COMNT)
55: *ccharp++ = PRINT;
56: *ccharp++ = EOL;
57: } |
58: lex0 bcomand comand eol =
59: {
60: *ccharp++ = IMMED;
61: *ccharp++ = $3;
62: } |
63: /*
64: * immediate mode state indicator stuff
65: */
66: lex0 tran eol =
67: {
68: *ccharp++ = SICLR0;
69: } |
70: lex0 tran expr eol =
71: {
72: *ccharp++ = SICLR;
73: } |
74: /*
75: * quad input
76: */
77: lex1 stat |
78: /*
79: * function definition
80: */
81: lex2 func |
82: /*
83: * function prolog
84: */
85: lex3 func |
86: /*
87: * function epilog
88: */
89: lex4 func |
90: /*
91: * function body
92: */
93: lex5 fstat ;
94:
95:
96:
97:
98:
99:
100:
101:
102:
103: /*
104: * function header
105: */
106: func:
107: anyname asg header =
108: {
109: switch(context) {
110:
111: case lex3:
112: name($$, AUTO);
113: /*
114: * see comments in ai.c/funcomp() concerning
115: * label processing.
116: */
117: *ccharp++ = ELID;
118: break;
119:
120: case lex4:
121: ccharp2 = ccharp;
122: *ccharp++ = EOL;
123: name($$, RVAL);
124: name($$, REST);
125: invert($3, ccharp2);
126: }
127: } |
128: header =
129: {
130: if(context == lex3)
131: *ccharp++ = ELID;
132: if(context == lex4){
133: *ccharp++ = EOL; /* pop previous result */
134: *ccharp++ = NILRET; /* return empty result */
135: }
136: } ;
137: header:
138: args autos =
139: {
140: if(context == lex4)
141: invert($$, $2);
142: } ;
143:
144: args:
145: anyname anyname anyname =
146: {
147: $$ = ccharp;
148: switch(context) {
149:
150: case lex2:
151: name($2, DF);
152: break;
153:
154: case lex3:
155: name($3, ARG2);
156: name($1, ARG1);
157: break;
158:
159: case lex4:
160: name($1, REST);
161: name($3, REST);
162: }
163: } |
164: anyname anyname =
165: {
166: $$ = ccharp;
167: switch(context) {
168:
169: case lex2:
170: name($1, MF);
171: break;
172:
173: case lex3:
174: name($2, ARG1);
175: break;
176:
177: case lex4:
178: name($2, REST);
179: }
180: } |
181: anyname =
182: {
183: if(context == lex2)
184: name($$, NF);
185: $$ = ccharp;
186: } ;
187: autos:
188: semi nam autos =
189: {
190: $$ = $3;
191: switch(context) {
192:
193: case lex3:
194: name($2, AUTO);
195: break;
196:
197: case lex4:
198: ccharp2 = name($2, REST);
199: invert($$, ccharp2);
200: }
201: } |
202: eol =
203: {
204: $$ = ccharp;
205: } ;
206:
207: /*
208: * system commands
209: */
210: bcomand:
211: rpar =
212: {
213: litflag = -1;
214: } ;
215: comand:
216: comexpr expr |
217: comnam anyname =
218: {
219: name($2, NAME);
220: } |
221: comlist anylist |
222: comnull ;
223:
224: anylist:
225: anylist anyname =
226: {
227: *ccharp++ = IMMED;
228: *ccharp++ = immedcmd;
229: name($2, NAME);
230: } |
231: anyname =
232: {
233: name($1, NAME);
234: };
235:
236:
237: /*
238: * statement:
239: * comments
240: * expressions
241: * heterogeneous output
242: * transfers (in functions)
243: */
244: fstat:
245: labels fstat0 | fstat0;
246:
247: labels:
248: label | labels label;
249:
250: label:
251: anyname cln = {
252: if(labgen)
253: genlab($1);
254: } ;
255:
256: fstat0:
257: stat =
258: {
259: integ = ccharp[-1];
260: if(integ != ASGN && integ != PRINT && integ != COMNT)
261: *ccharp++ = PRINT;
262: } |
263: tran eol =
264: {
265: $$ = ccharp;
266: *ccharp++ = BRAN0;
267: } |
268: tran expr eol =
269: {
270: $$ = $2;
271: *ccharp++ = BRAN;
272: } ;
273: stat:
274: eol =
275: {
276: $$ = ccharp;
277: *ccharp++ = COMNT;
278: } |
279: statement eol ;
280: statement:
281: comnt =
282: {
283: litflag = 1;
284: $$ = ccharp;
285: *ccharp++ = COMNT;
286: } |
287: expr |
288: hprint ;
289: hprint:
290: expr hsemi output ;
291: output:
292: expr =
293: {
294: *ccharp++ = PRINT;
295: } |
296: hprint ;
297: hsemi:
298: semi =
299: {
300: *ccharp++ = HPRINT;
301: };
302: expr:
303: e1 |
304: monadic expr =
305: {
306: invert($$, $2);
307: } |
308: e1 dyadic expr =
309: {
310: invert($$, $3);
311: } ;
312: e1:
313: e2 |
314: e2 lsub subs rbkt =
315: {
316: invert($$, $3);
317: *ccharp++ = INDEX;
318: *ccharp++ = scount;
319: scount = $2;
320: } ;
321: e2:
322: nfun =
323: {
324: $$ = name($$, FUN);
325: } |
326: nam =
327: {
328: $$ = name($$, NAME);
329: } |
330: strng =
331: {
332: $$ = ccharp;
333: ccharp += 2;
334: integ = iline[-1];
335: vcount = 0;
336: for(;;) {
337: if(*iline == '\n') {
338: nlexsym = unk;
339: break;
340: }
341: if(*iline == integ) {
342: iline++;
343: if(*iline != integ)
344: break;
345: }
346: *ccharp++ = *iline++;
347: vcount++;
348: }
349: ((struct chrstrct *)$$)->c[0] = QUOT;
350: ((struct chrstrct *)$$)->c[1] = vcount;
351: } |
352: vector =
353: {
354: *ccharp++ = CONST;
355: *ccharp++ = vcount;
356: invert($$, ccharp-2);
357: } |
358: lpar expr rpar =
359: {
360: $$ = $2;
361: } |
362: Quad =
363: {
364: $$ = ccharp;
365: *ccharp++ = $1;
366: } ;
367: vector:
368: number vector =
369: {
370: vcount++;
371: } |
372: number =
373: {
374: vcount = 1;
375: } ;
376: number:
377: numb =
378: {
379: $$ = ccharp;
380: ccharp += copy(DA,&datum,ccharp,1);
381: } ;
382:
383: /*
384: * indexing subscripts
385: * optional expressions separated by semi
386: */
387: lsub:
388: lbkt =
389: {
390: $$ = scount;
391: scount = 1;
392: } ;
393: subs:
394: sub |
395: subs semi sub =
396: {
397: invert($$, $3);
398: scount++;
399: } ;
400: sub:
401: expr |
402: =
403: {
404: $$ = ccharp;
405: *ccharp++ = ELID;
406: } ;
407:
408: /*
409: * return a string of a monadic operator.
410: */
411: monadic:
412: monad =
413: {
414: $$ = ccharp;
415: *ccharp++ = $1;
416: } |
417: smonad subr =
418: {
419: $$ = $2;
420: *ccharp++ = $1+1;
421: } |
422: mfun =
423: {
424: $$ = name($$, FUN);
425: } |
426: scalar comp =
427: {
428: $$ = ccharp;
429: *ccharp++ = $2+1;
430: *ccharp++ = $1;
431: } |
432: scalar com subr =
433: {
434: $$ = $3;
435: *ccharp++ = $2+3;
436: *ccharp++ = $1;
437: } ;
438: monad:
439: m |
440: msub |
441: mondya =
442: {
443: $$++;
444: } ;
445: smonad:
446: msub |
447: mdsub =
448: {
449: $$ += 2;
450: } ;
451:
452: /*
453: * return a string of a dyadic operator.
454: */
455: dyadic:
456: dyad =
457: {
458: $$ = ccharp;
459: *ccharp++ = $1;
460: } |
461: sdyad subr =
462: {
463: $$ = $2;
464: *ccharp++ = $1;
465: } |
466: dfun =
467: {
468: $$ = name($$, FUN);
469: } |
470: null dot scalar =
471: {
472: $$ = ccharp;
473: *ccharp++ = OPROD;
474: *ccharp++ = $3;
475: } |
476: scalar dot scalar =
477: {
478: $$ = ccharp;
479: *ccharp++ = IPROD;
480: *ccharp++ = $1;
481: *ccharp++ = $3;
482: } ;
483: sdyad:
484: mdcom =
485: {
486: $$ += 2;
487: } ;
488:
489: /*
490: * single expression subscript
491: * as found on operators to select
492: * a dimension.
493: */
494: subr:
495: lbkt expr rbkt =
496: {
497: $$ = $2;
498: } ;
499:
500: /*
501: * various combinations
502: */
503: comp:
504: com | com0 ;
505: dyad:
506: mondya | dscal | d | com0 | asg | com ;
507: mdcom:
508: mdsub | com ;
509: mondya:
510: mdscal | md | mdsub ;
511: scalar:
512: mdscal | dscal ;
513: anyname:
514: nam | nfun | mfun | dfun ;
515: %%
516: #include "tab.c"
517: #include "lex.c"
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.