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