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