|
|
1.1 root 1: /*
2: * pi - Pascal interpreter code translator
3: *
4: * Charles Haley, Bill Joy UCB
5: * Version 1.0 August 1977
6: *
7: * pxp - Pascal execution profiler
8: *
9: * Bill Joy UCB
10: * Version 1.0 August 1977
11: */
12:
13: /*
14: * Yacc grammar for UNIX Pascal
15: *
16: * This grammar is processed by the commands in the shell script
17: * "gram" to yield parse tables and semantic routines in the file
18: * "y.tab.c" and a header defining the lexical tokens in "yy.h".
19: *
20: * In order for the syntactic error recovery possible with this
21: * grammar to work, the grammar must be processed by a yacc which
22: * has been modified to fully enumerate possibilities in states
23: * which involve the symbol "error".
24: * The parser used for Pascal also uses a different encoding of
25: * the test entries in the action table which speeds the parse.
26: * A version of yacc which will work for Pascal is included on
27: * the distribution table as "eyacc".
28: *
29: * The "gram" script also makes the following changes to the "y.tab.c"
30: * file:
31: *
32: * 1) Causes yyval to be declared int *.
33: *
34: * 2) Loads the variable yypv into a register as yyYpv so that
35: * the arguments $1, ... are available as yyYpv[1] etc.
36: * This produces much smaller code in the semantic actions.
37: *
38: * 3) Deletes the unused array yysterm.
39: *
40: * 4) Moves the declarations up to the flag line containing
41: * '##' to the file yy.h so that the routines which use
42: * these "magic numbers" don't have to all be compiled at
43: * the same time.
44: *
45: * 5) Creates the semantic restriction checking routine yyEactr
46: * by processing action lines containing `@'.
47: *
48: * This compiler uses a different version of the yacc parser, a
49: * different yyerror which is called yerror, and requires more
50: * lookahead sets than normally provided by yacc.
51: *
52: * Source for the yacc used with this grammar is included on
53: * distribution tapes.
54: */
55:
56: /*
57: * TERMINAL DECLARATIONS
58: *
59: * Some of the terminal declarations are out of the most natural
60: * alphabetic order because the error recovery
61: * will guess the first of equal cost non-terminals.
62: * This makes, e.g. YTO preferable to YDOWNTO.
63: */
64:
65: %term
66: YAND YARRAY YBEGIN YCASE
67: YCONST YDIV YDO YDOTDOT
68: YTO YELSE YEND YFILE
69: YFOR YFORWARD YFUNCTION YGOTO
70: YID YIF YIN YINT
71: YLABEL YMOD YNOT YNUMB
72: YOF YOR YPACKED YNIL
73: YPROCEDURE YPROG YRECORD YREPEAT
74: YSET YSTRING YTHEN YDOWNTO
75: YTYPE YUNTIL YVAR YWHILE
76: YWITH YBINT YOCT YHEX
77: YASSERT YCASELAB YILLCH YLAST
78:
79: /*
80: * PRECEDENCE DECLARATIONS
81: *
82: * Highest precedence is the unary logical NOT.
83: * Next are the multiplying operators, signified by '*'.
84: * Lower still are the binary adding operators, signified by '+'.
85: * Finally, at lowest precedence and non-associative are the relationals.
86: */
87:
88: %binary '<' '=' '>' YIN
89: %left '+' '-' YOR '|'
90: %left UNARYSIGN
91: %left '*' '/' YDIV YMOD YAND '&'
92: %left YNOT
93:
94: %{
95:
96: /*
97: * GLOBALS FOR ACTIONS
98: */
99:
100: /*
101: * The following line marks the end of the yacc
102: * Constant definitions which are removed from
103: * y.tab.c and placed in the file y.tab.h.
104: */
105: ##
106:
107: #include "0.h"
108: #include "yy.h"
109: #include "tree.h"
110:
111: #ifdef PI
112: #define lineof(l) l
113: #define line2of(l) l
114: #endif
115:
116: %}
117:
118: %%
119:
120: /*
121: * PRODUCTIONS
122: */
123:
124: goal:
125: prog_hedr decls procs block '.'
126: = funcend($1, $4, lineof($5));
127: ;
128:
129: prog_hedr:
130: YPROG YID '(' id_list ')' ';'
131: = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL)));
132: |
133: YPROG error
134: = {
135: yyPerror("Malformed program statement", PPROG);
136: /*
137: * Should make a program statement
138: * with "input" and "output" here.
139: */
140: $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL)));
141: }
142: ;
143: block:
144: YBEGIN stat_list YEND
145: = {
146: $$ = tree3(T_BSTL, lineof($1), fixlist($2));
147: if ($3.pint < 0)
148: brerror($1, "begin");
149: }
150: ;
151:
152:
153: /*
154: * DECLARATION PART
155: */
156: decls:
157: decls decl
158: = trfree();
159: |
160: decls error
161: = {
162: Derror:
163: constend(), typeend(), varend(), trfree();
164: yyPerror("Malformed declaration", PDECL);
165: }
166: |
167: /* lambda */
168: = trfree();
169: ;
170:
171: decl:
172: labels
173: |
174: const_decl
175: = constend();
176: |
177: type_decl
178: = typeend();
179: |
180: var_decl
181: = varend();
182: ;
183:
184: /*
185: * LABEL PART
186: */
187:
188: labels:
189: YLABEL label_decl ';'
190: = label(fixlist($2), lineof($1));
191: ;
192: label_decl:
193: YINT
194: = $$ = newlist($1 == NIL ? NIL : *hash($1, 1));
195: |
196: label_decl ',' YINT
197: = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1));
198: ;
199:
200: /*
201: * CONST PART
202: */
203:
204: const_decl:
205: YCONST YID '=' const ';'
206: = constbeg($1, line2of($2)), const(lineof($3), $2, $4);
207: |
208: const_decl YID '=' const ';'
209: = const(lineof($3), $2, $4);
210: |
211: YCONST error
212: = {
213: constbeg($1, line2of($1));
214: Cerror:
215: yyPerror("Malformed const declaration", PDECL);
216: }
217: |
218: const_decl error
219: = goto Cerror;
220: ;
221:
222: /*
223: * TYPE PART
224: */
225:
226: type_decl:
227: YTYPE YID '=' type ';'
228: = typebeg($1, line2of($2)), type(lineof($3), $2, $4);
229: |
230: type_decl YID '=' type ';'
231: = type(lineof($3), $2, $4);
232: |
233: YTYPE error
234: = {
235: typebeg($1, line2of($1));
236: Terror:
237: yyPerror("Malformed type declaration", PDECL);
238: }
239: |
240: type_decl error
241: = goto Terror;
242: ;
243:
244: /*
245: * VAR PART
246: */
247:
248: var_decl:
249: YVAR id_list ':' type ';'
250: = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4);
251: |
252: var_decl id_list ':' type ';'
253: = var(lineof($3), fixlist($2), $4);
254: |
255: YVAR error
256: = {
257: varbeg($1, line2of($1));
258: Verror:
259: yyPerror("Malformed var declaration", PDECL);
260: }
261: |
262: var_decl error
263: = goto Verror;
264: ;
265:
266: /*
267: * PROCEDURE AND FUNCTION DECLARATION PART
268: */
269:
270: procs:
271: /* lambda */
272: |
273: procs proc
274: = trfree();
275: ;
276: proc:
277: phead YFORWARD ';'
278: = funcfwd($1);
279: |
280: pheadres decls procs block ';'
281: = funcend($1, $4, lineof($5));
282: ;
283: pheadres:
284: phead
285: = funcbody($1);
286: ;
287: phead:
288: porf YID params ftype ';'
289: = $$ = funchdr(tree5($1, lineof($5), $2, $3, $4));
290: ;
291: porf:
292: YPROCEDURE
293: = $$ = T_PDEC;
294: |
295: YFUNCTION
296: = $$ = T_FDEC;
297: ;
298: params:
299: '(' param_list ')'
300: = $$ = fixlist($2);
301: |
302: /* lambda */
303: = $$ = NIL;
304: ;
305:
306: /*
307: * PARAMETERS
308: */
309:
310: param:
311: id_list ':' type
312: = $$ = tree3(T_PVAL, fixlist($1), $3);
313: |
314: YVAR id_list ':' type
315: = $$ = tree3(T_PVAR, fixlist($2), $4);
316: |
317: YFUNCTION id_list ':' type
318: = $$ = tree3(T_PFUNC, fixlist($2), $4);
319: |
320: YPROCEDURE id_list
321: = $$ = tree2(T_PPROC, fixlist($2));
322: ;
323: ftype:
324: ':' type
325: = $$ = $2;
326: |
327: /* lambda */
328: = $$ = NIL;
329: ;
330: param_list:
331: param
332: = $$ = newlist($1);
333: |
334: param_list ';' param
335: = $$ = addlist($1, $3);
336: ;
337:
338: /*
339: * CONSTANTS
340: */
341:
342: const:
343: YSTRING
344: = $$ = tree2(T_CSTRNG, $1);
345: |
346: number
347: |
348: '+' number
349: = $$ = tree2(T_PLUSC, $2);
350: |
351: '-' number
352: = $$ = tree2(T_MINUSC, $2);
353: ;
354: number:
355: const_id
356: = $$ = tree2(T_ID, $1);
357: |
358: YINT
359: = $$ = tree2(T_CINT, $1);
360: |
361: YBINT
362: = $$ = tree2(T_CBINT, $1);
363: |
364: YNUMB
365: = $$ = tree2(T_CFINT, $1);
366: ;
367: const_list:
368: const
369: = $$ = newlist($1);
370: |
371: const_list ',' const
372: = $$ = addlist($1, $3);
373: ;
374:
375: /*
376: * TYPES
377: */
378:
379: type:
380: simple_type
381: |
382: '^' YID
383: = $$ = tree3(T_TYPTR, lineof($1), tree2(T_ID, $2));
384: |
385: struct_type
386: |
387: YPACKED struct_type
388: = $$ = tree3(T_TYPACK, lineof($1), $2);
389: ;
390: simple_type:
391: type_id
392: |
393: '(' id_list ')'
394: = $$ = tree3(T_TYSCAL, lineof($1), fixlist($2));
395: |
396: const YDOTDOT const
397: = $$ = tree4(T_TYRANG, lineof($2), $1, $3);
398: ;
399: struct_type:
400: YARRAY '[' simple_type_list ']' YOF type
401: = $$ = tree4(T_TYARY, lineof($1), fixlist($3), $6);
402: |
403: YFILE YOF type
404: = $$ = tree3(T_TYFILE, lineof($1), $3);
405: |
406: YSET YOF simple_type
407: = $$ = tree3(T_TYSET, lineof($1), $3);
408: |
409: YRECORD field_list YEND
410: = {
411: $$ = tree3(T_TYREC, lineof($1), $2);
412: if ($3.pint < 0)
413: brerror($1, "record");
414: }
415: ;
416: simple_type_list:
417: simple_type
418: = $$ = newlist($1);
419: |
420: simple_type_list ',' simple_type
421: = $$ = addlist($1, $3);
422: ;
423:
424: /*
425: * RECORD TYPE
426: */
427: field_list:
428: fixed_part variant_part
429: = $$ = tree4(T_FLDLST, lineof(NIL), fixlist($1), $2);
430: ;
431: fixed_part:
432: field
433: = $$ = newlist($1);
434: |
435: fixed_part ';' field
436: = $$ = addlist($1, $3);
437: |
438: fixed_part error
439: = yyPerror("Malformed record declaration", PDECL);
440: ;
441: field:
442: /* lambda */
443: = $$ = NIL;
444: |
445: id_list ':' type
446: = $$ = tree4(T_RFIELD, lineof($2), fixlist($1), $3);
447: ;
448:
449: variant_part:
450: /* lambda */
451: = $$ = NIL;
452: |
453: YCASE type_id YOF variant_list
454: = $$ = tree5(T_TYVARPT, lineof($1), NIL, $2, fixlist($4));
455: |
456: YCASE YID ':' type_id YOF variant_list
457: = $$ = tree5(T_TYVARPT, lineof($1), $2, $4, fixlist($6));
458: ;
459: variant_list:
460: variant
461: = $$ = newlist($1);
462: |
463: variant_list ';' variant
464: = $$ = addlist($1, $3);
465: |
466: variant_list error
467: = yyPerror("Malformed record declaration", PDECL);
468: ;
469: variant:
470: /* lambda */
471: = $$ = NIL;
472: |
473: const_list ':' '(' field_list ')'
474: = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), $4);
475: |
476: const_list ':' '(' ')'
477: = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), NIL);
478: ;
479:
480: /*
481: * STATEMENT LIST
482: */
483:
484: stat_list:
485: stat
486: = $$ = newlist($1);
487: |
488: stat_lsth stat
489: = {
490: if ((p = $1) != NIL && (q = p[1])[0] == T_IFX) {
491: q[0] = T_IFEL;
492: q[4] = $2;
493: } else
494: $$ = addlist($1, $2);
495: }
496: ;
497:
498: stat_lsth:
499: stat_list ';'
500: = if ((q = $1) != NIL && (p = q[1]) != NIL && p[0] == T_IF) {
501: if (yychar < 0)
502: yychar = yylex();
503: if (yyshifts >= 2 && yychar == YELSE) {
504: recovered();
505: copy(&Y, &OY, sizeof Y);
506: yerror("Deleted ';' before keyword else");
507: yychar = yylex();
508: p[0] = T_IFX;
509: }
510: }
511: ;
512:
513: /*
514: * CASE STATEMENT LIST
515: */
516:
517: cstat_list:
518: cstat
519: = $$ = newlist($1);
520: |
521: cstat_list ';' cstat
522: = $$ = addlist($1, $3);
523: |
524: error
525: = {
526: $$ = NIL;
527: Kerror:
528: yyPerror("Malformed statement in case", PSTAT);
529: }
530: |
531: cstat_list error
532: = goto Kerror;
533: ;
534:
535: cstat:
536: const_list ':' stat
537: = $$ = tree4(T_CSTAT, lineof($2), fixlist($1), $3);
538: |
539: YCASELAB stat
540: = $$ = tree4(T_CSTAT, lineof($1), NIL, $2);
541: |
542: /* lambda */
543: = $$ = NIL;
544: ;
545:
546: /*
547: * STATEMENT
548: */
549:
550: stat:
551: /* lambda */
552: = $$ = NIL;
553: |
554: YINT ':' stat
555: = $$ = tree4(T_LABEL, lineof($2), $1 == NIL ? NIL : *hash($1, 1), $3);
556: |
557: proc_id
558: = $$ = tree4(T_PCALL, lineof(yyline), $1, NIL);
559: |
560: proc_id '(' wexpr_list ')'
561: = $$ = tree4(T_PCALL, lineof($2), $1, fixlist($3));
562: |
563: YID error
564: = goto NSerror;
565: |
566: assign
567: |
568: YBEGIN stat_list YEND
569: = {
570: $$ = tree3(T_BLOCK, lineof($1), fixlist($2));
571: if ($3.pint < 0)
572: brerror($1, "begin");
573: }
574: |
575: YCASE expr YOF cstat_list YEND
576: = {
577: $$ = tree4(T_CASE, lineof($1), $2, fixlist($4));
578: if ($5.pint < 0)
579: brerror($1, "case");
580: }
581: |
582: YWITH var_list YDO stat
583: = $$ = tree4(T_WITH, lineof($1), fixlist($2), $4);
584: |
585: YWHILE expr YDO stat
586: = $$ = tree4(T_WHILE, lineof($1), $2, $4);
587: |
588: YREPEAT stat_list YUNTIL expr
589: = $$ = tree4(T_REPEAT, lineof($3), fixlist($2), $4);
590: |
591: YFOR assign YTO expr YDO stat
592: = $$ = tree5(T_FORU, lineof($1), $2, $4, $6);
593: |
594: YFOR assign YDOWNTO expr YDO stat
595: = $$ = tree5(T_FORD, lineof($1), $2, $4, $6);
596: |
597: YGOTO YINT
598: = $$ = tree3(T_GOTO, lineof($1), *hash($2, 1));
599: |
600: YIF expr YTHEN stat
601: = $$ = tree5(T_IF, lineof($1), $2, $4, NIL);
602: |
603: YIF expr YTHEN stat YELSE stat
604: = $$ = tree5(T_IFEL, lineof($1), $2, $4, $6);
605: |
606: YIF expr YTHEN stat YELSE
607: = $$ = tree5(T_IFEL, lineof($1), $2, $4, NIL);
608: |
609: YASSERT '(' expr ')'
610: = $$ = tree3(T_ASRT, lineof($1), $3);
611: |
612: error
613: = {
614: NSerror:
615: $$ = NIL;
616: Serror:
617: yyPerror("Malformed statement", PSTAT);
618: }
619: ;
620: assign:
621: variable ':' '=' expr
622: = $$ = tree4(T_ASGN, lineof($2), $1, $4);
623: ;
624:
625: /*
626: * EXPRESSION
627: */
628:
629: expr:
630: error
631: = {
632: NEerror:
633: $$ = NIL;
634: Eerror:
635: yyPerror("Missing/malformed expression", PEXPR);
636: }
637: |
638: expr relop expr %prec '<'
639: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3);
640: |
641: '+' expr %prec UNARYSIGN
642: = $$ = tree3(T_PLUS, $2[1], $2);
643: |
644: '-' expr %prec UNARYSIGN
645: = $$ = tree3(T_MINUS, $2[1], $2);
646: |
647: expr addop expr %prec '+'
648: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3);
649: |
650: expr divop expr %prec '*'
651: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3);
652: |
653: YNIL
654: = $$ = tree2(T_NIL, NOCON);
655: |
656: YSTRING
657: = $$ = tree3(T_STRNG, SAWCON, $1);
658: |
659: YINT
660: = $$ = tree3(T_INT, NOCON, $1);
661: |
662: YBINT
663: = $$ = tree3(T_BINT, NOCON, $1);
664: |
665: YNUMB
666: = $$ = tree3(T_FINT, NOCON, $1);
667: |
668: variable
669: |
670: YID error
671: = goto NEerror;
672: |
673: func_id '(' wexpr_list ')'
674: = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3));
675: |
676: '(' expr ')'
677: = $$ = $2;
678: |
679: negop expr %prec YNOT
680: = $$ = tree3(T_NOT, NOCON, $2);
681: |
682: '[' element_list ']'
683: = $$ = tree3(T_CSET, SAWCON, fixlist($2));
684: |
685: '[' ']'
686: = $$ = tree3(T_CSET, SAWCON, NIL);
687: ;
688:
689: element_list:
690: element
691: = $$ = newlist($1);
692: |
693: element_list ',' element
694: = $$ = addlist($1, $3);
695: ;
696: element:
697: expr
698: |
699: expr YDOTDOT expr
700: = $$ = tree3(T_RANG, $1, $3);
701: ;
702:
703: /*
704: * QUALIFIED VARIABLES
705: */
706:
707: variable:
708: YID
709: = {
710: @ return (identis(var, VAR));
711: $$ = setupvar($1, NIL);
712: }
713: |
714: qual_var
715: = $1[3] = fixlist($1[3]);
716: ;
717: qual_var:
718: array_id '[' expr_list ']'
719: = $$ = setupvar($1, tree2(T_ARY, fixlist($3)));
720: |
721: qual_var '[' expr_list ']'
722: = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3)));
723: |
724: record_id '.' field_id
725: = $$ = setupvar($1, tree3(T_FIELD, $3, NIL));
726: |
727: qual_var '.' field_id
728: = $1[3] = addlist($1[3], tree3(T_FIELD, $3, NIL));
729: |
730: ptr_id '^'
731: = $$ = setupvar($1, tree1(T_PTR));
732: |
733: qual_var '^'
734: = $1[3] = addlist($1[3], tree1(T_PTR));
735: ;
736:
737: /*
738: * Expression with write widths
739: */
740: wexpr:
741: expr
742: |
743: expr ':' expr
744: = $$ = tree4(T_WEXP, $1, $3, NIL);
745: |
746: expr ':' expr ':' expr
747: = $$ = tree4(T_WEXP, $1, $3, $5);
748: |
749: expr octhex
750: = $$ = tree4(T_WEXP, $1, NIL, $2);
751: |
752: expr ':' expr octhex
753: = $$ = tree4(T_WEXP, $1, $3, $4);
754: ;
755: octhex:
756: YOCT
757: = $$ = OCT;
758: |
759: YHEX
760: = $$ = HEX;
761: ;
762:
763: expr_list:
764: expr
765: = $$ = newlist($1);
766: |
767: expr_list ',' expr
768: = $$ = addlist($1, $3);
769: ;
770:
771: wexpr_list:
772: wexpr
773: = $$ = newlist($1);
774: |
775: wexpr_list ',' wexpr
776: = $$ = addlist($1, $3);
777: ;
778:
779: /*
780: * OPERATORS
781: */
782:
783: relop:
784: '=' = $$ = T_EQ;
785: |
786: '<' = $$ = T_LT;
787: |
788: '>' = $$ = T_GT;
789: |
790: '<' '>' = $$ = T_NE;
791: |
792: '<' '=' = $$ = T_LE;
793: |
794: '>' '=' = $$ = T_GE;
795: |
796: YIN = $$ = T_IN;
797: ;
798: addop:
799: '+' = $$ = T_ADD;
800: |
801: '-' = $$ = T_SUB;
802: |
803: YOR = $$ = T_OR;
804: |
805: '|' = $$ = T_OR;
806: ;
807: divop:
808: '*' = $$ = T_MULT;
809: |
810: '/' = $$ = T_DIVD;
811: |
812: YDIV = $$ = T_DIV;
813: |
814: YMOD = $$ = T_MOD;
815: |
816: YAND = $$ = T_AND;
817: |
818: '&' = $$ = T_AND;
819: ;
820:
821: negop:
822: YNOT
823: |
824: '~'
825: ;
826:
827: /*
828: * LISTS
829: */
830:
831: var_list:
832: variable
833: = $$ = newlist($1);
834: |
835: var_list ',' variable
836: = $$ = addlist($1, $3);
837: ;
838:
839: id_list:
840: YID
841: = $$ = newlist($1);
842: |
843: id_list ',' YID
844: = $$ = addlist($1, $3);
845: ;
846:
847: /*
848: * Identifier productions with semantic restrictions
849: *
850: * For these productions, the character @ signifies
851: * that the associated C statement is to provide
852: * the semantic restriction for this reduction.
853: * These lines are made into a procedure yyEactr, similar to
854: * yyactr, which determines whether the corresponding reduction
855: * is permitted, or whether an error is to be signaled.
856: * A zero return from yyEactr is considered an error.
857: * YyEactr is called with an argument "var" giving the string
858: * name of the variable in question, essentially $1, although
859: * $1 will not work because yyEactr is called from loccor in
860: * the recovery routines.
861: */
862:
863: const_id:
864: YID
865: = @ return (identis(var, CONST));
866: ;
867: type_id:
868: YID
869: = {
870: @ return (identis(var, TYPE));
871: $$ = tree3(T_TYID, lineof(yyline), $1);
872: }
873: ;
874: var_id:
875: YID
876: = @ return (identis(var, VAR));
877: ;
878: array_id:
879: YID
880: = @ return (identis(var, ARRAY));
881: ;
882: ptr_id:
883: YID
884: = @ return (identis(var, PTRFILE));
885: ;
886: record_id:
887: YID
888: = @ return (identis(var, RECORD));
889: ;
890: field_id:
891: YID
892: = @ return (identis(var, FIELD));
893: ;
894: proc_id:
895: YID
896: = @ return (identis(var, PROC));
897: ;
898: func_id:
899: YID
900: = @ return (identis(var, FUNC));
901: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.