1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 /* 4 * Yacc grammar for UNIX Pascal 5 * 6 * This grammar is processed by the commands in the shell script 7 * "gram" to yield parse tables and semantic routines in the file 8 * "y.tab.c" and a header defining the lexical tokens in "yy.h". 9 * 10 * In order for the syntactic error recovery possible with this 11 * grammar to work, the grammar must be processed by a yacc which 12 * has been modified to fully enumerate possibilities in states 13 * which involve the symbol "error". 14 * The parser used for Pascal also uses a different encoding of 15 * the test entries in the action table which speeds the parse. 16 * A version of yacc which will work for Pascal is included on 17 * the distribution table as "eyacc". 18 * 19 * The "gram" script also makes the following changes to the "y.tab.c" 20 * file: 21 * 22 * 1) Causes yyval to be declared int *. 23 * 24 * 2) Loads the variable yypv into a register as yyYpv so that 25 * the arguments $1, ... are available as yyYpv[1] etc. 26 * This produces much smaller code in the semantic actions. 27 * 28 * 3) Deletes the unused array yysterm. 29 * 30 * 4) Moves the declarations up to the flag line containing 31 * '##' to the file yy.h so that the routines which use 32 * these "magic numbers" don't have to all be compiled at 33 * the same time. 34 * 35 * 5) Creates the semantic restriction checking routine yyEactr 36 * by processing action lines containing `@@'. 37 * 38 * This compiler uses a different version of the yacc parser, a 39 * different yyerror which is called yerror, and requires more 40 * lookahead sets than normally provided by yacc. 41 * 42 * Source for the yacc used with this grammar is included on 43 * distribution tapes. 44 */ 45 46 /* 47 * TERMINAL DECLARATIONS 48 * 49 * Some of the terminal declarations are out of the most natural 50 * alphabetic order because the error recovery 51 * will guess the first of equal cost non-terminals. 52 * This makes, e.g. YTO preferable to YDOWNTO. 53 */ 54 55 %term 56 YAND YARRAY YBEGIN YCASE 57 YCONST YDIV YDO YDOTDOT 58 YTO YELSE YEND YFILE 59 YFOR YFORWARD YFUNCTION YGOTO 60 YID YIF YIN YINT 61 YLABEL YMOD YNOT YNUMB 62 YOF YOR YPACKED YNIL 63 YPROCEDURE YPROG YRECORD YREPEAT 64 YSET YSTRING YTHEN YDOWNTO 65 YTYPE YUNTIL YVAR YWHILE 66 YWITH YBINT YOCT YHEX 67 YASSERT YCASELAB YILLCH YEXTERN 68 YLAST 69 70 /* 71 * PRECEDENCE DECLARATIONS 72 * 73 * Highest precedence is the unary logical NOT. 74 * Next are the multiplying operators, signified by '*'. 75 * Lower still are the binary adding operators, signified by '+'. 76 * Finally, at lowest precedence and non-associative are the relationals. 77 */ 78 79 %binary '<' '=' '>' YIN 80 %left '+' '-' YOR '|' 81 %left UNARYSIGN 82 %left '*' '/' YDIV YMOD YAND '&' 83 %left YNOT 84 85 %{ 86 /* 87 * GLOBALS FOR ACTIONS 88 */ 89 90 /* Copyright (c) 1979 Regents of the University of California */ 91 92 /* static char sccsid[] = "@(#)pas.y 1.4 03/18/81"; */ 93 94 /* 95 * The following line marks the end of the yacc 96 * Constant definitions which are removed from 97 * y.tab.c and placed in the file y.tab.h. 98 */ 99 ## 100 /* Copyright (c) 1979 Regents of the University of California */ 101 102 static char sccsid[] = "@(#)pas.y 1.4 03/18/81"; 103 104 #include "whoami.h" 105 #include "0.h" 106 #include "yy.h" 107 #include "tree.h" 108 109 #ifdef PI 110 #define lineof(l) l 111 #define line2of(l) l 112 #endif 113 114 %} 115 116 %% 117 118 /* 119 * PRODUCTIONS 120 */ 121 122 goal: 123 prog_hedr decls block '.' 124 = funcend($1, $3, lineof($4)); 125 | 126 decls 127 = segend(); 128 ; 129 130 131 prog_hedr: 132 YPROG YID '(' id_list ')' ';' 133 = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL))); 134 | 135 YPROG error 136 = { 137 yyPerror("Malformed program statement", PPROG); 138 /* 139 * Should make a program statement 140 * with "input" and "output" here. 141 */ 142 $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL))); 143 } 144 ; 145 block: 146 YBEGIN stat_list YEND 147 = { 148 $$ = tree3(T_BSTL, lineof($1), fixlist($2)); 149 if ($3 < 0) 150 brerror($1, "begin"); 151 } 152 ; 153 154 155 /* 156 * DECLARATION PART 157 */ 158 decls: 159 decls decl 160 = trfree(); 161 | 162 decls error 163 = { 164 Derror: 165 constend(), typeend(), varend(), trfree(); 166 yyPerror("Malformed declaration", PDECL); 167 } 168 | 169 /* lambda */ 170 = trfree(); 171 ; 172 173 decl: 174 labels 175 | 176 const_decl 177 = constend(); 178 | 179 type_decl 180 = typeend(); 181 | 182 var_decl 183 = varend(); 184 | 185 proc_decl 186 ; 187 188 /* 189 * LABEL PART 190 */ 191 192 labels: 193 YLABEL label_decl ';' 194 = label(fixlist($2), lineof($1)); 195 ; 196 label_decl: 197 YINT 198 = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); 199 | 200 label_decl ',' YINT 201 = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); 202 ; 203 204 /* 205 * CONST PART 206 */ 207 208 const_decl: 209 YCONST YID '=' const ';' 210 = constbeg($1, line2of($2)), const(lineof($3), $2, $4); 211 | 212 const_decl YID '=' const ';' 213 = const(lineof($3), $2, $4); 214 | 215 YCONST error 216 = { 217 constbeg($1, line2of($1)); 218 Cerror: 219 yyPerror("Malformed const declaration", PDECL); 220 } 221 | 222 const_decl error 223 = goto Cerror; 224 ; 225 226 /* 227 * TYPE PART 228 */ 229 230 type_decl: 231 YTYPE YID '=' type ';' 232 = typebeg($1, line2of($2)), type(lineof($3), $2, $4); 233 | 234 type_decl YID '=' type ';' 235 = type(lineof($3), $2, $4); 236 | 237 YTYPE error 238 = { 239 typebeg($1, line2of($1)); 240 Terror: 241 yyPerror("Malformed type declaration", PDECL); 242 } 243 | 244 type_decl error 245 = goto Terror; 246 ; 247 248 /* 249 * VAR PART 250 */ 251 252 var_decl: 253 YVAR id_list ':' type ';' 254 = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); 255 | 256 var_decl id_list ':' type ';' 257 = var(lineof($3), fixlist($2), $4); 258 | 259 YVAR error 260 = { 261 varbeg($1, line2of($1)); 262 Verror: 263 yyPerror("Malformed var declaration", PDECL); 264 } 265 | 266 var_decl error 267 = goto Verror; 268 ; 269 270 /* 271 * PROCEDURE AND FUNCTION DECLARATION PART 272 */ 273 274 proc_decl: 275 phead YFORWARD ';' 276 = funcfwd($1); 277 | 278 phead YEXTERN ';' 279 = funcext($1); 280 | 281 pheadres decls block ';' 282 = funcend($1, $3, lineof($4)); 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 params ftype 319 = $$ = tree5(T_PFUNC, fixlist($2), $4, $3, lineof($1)); 320 | 321 YPROCEDURE id_list params ftype 322 = $$ = tree5(T_PPROC, fixlist($2), $4, $3, lineof($1)); 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 characters @@ signify 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 ; 903