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.5 08/26/82"; */ 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.5 08/26/82"; 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 YASSERT '(' expr ')' 608 = $$ = tree3(T_ASRT, lineof($1), $3); 609 | 610 error 611 = { 612 NSerror: 613 $$ = NIL; 614 Serror: 615 yyPerror("Malformed statement", PSTAT); 616 } 617 ; 618 assign: 619 variable ':' '=' expr 620 = $$ = tree4(T_ASGN, lineof($2), $1, $4); 621 ; 622 623 /* 624 * EXPRESSION 625 */ 626 627 expr: 628 error 629 = { 630 NEerror: 631 $$ = NIL; 632 Eerror: 633 yyPerror("Missing/malformed expression", PEXPR); 634 } 635 | 636 expr relop expr %prec '<' 637 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 638 | 639 '+' expr %prec UNARYSIGN 640 = $$ = tree3(T_PLUS, $2[1], $2); 641 | 642 '-' expr %prec UNARYSIGN 643 = $$ = tree3(T_MINUS, $2[1], $2); 644 | 645 expr addop expr %prec '+' 646 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 647 | 648 expr divop expr %prec '*' 649 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 650 | 651 YNIL 652 = $$ = tree2(T_NIL, NOCON); 653 | 654 YSTRING 655 = $$ = tree3(T_STRNG, SAWCON, $1); 656 | 657 YINT 658 = $$ = tree3(T_INT, NOCON, $1); 659 | 660 YBINT 661 = $$ = tree3(T_BINT, NOCON, $1); 662 | 663 YNUMB 664 = $$ = tree3(T_FINT, NOCON, $1); 665 | 666 variable 667 | 668 YID error 669 = goto NEerror; 670 | 671 func_id '(' wexpr_list ')' 672 = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); 673 | 674 '(' expr ')' 675 = $$ = $2; 676 | 677 negop expr %prec YNOT 678 = $$ = tree3(T_NOT, NOCON, $2); 679 | 680 '[' element_list ']' 681 = $$ = tree3(T_CSET, SAWCON, fixlist($2)); 682 | 683 '[' ']' 684 = $$ = tree3(T_CSET, SAWCON, NIL); 685 ; 686 687 element_list: 688 element 689 = $$ = newlist($1); 690 | 691 element_list ',' element 692 = $$ = addlist($1, $3); 693 ; 694 element: 695 expr 696 | 697 expr YDOTDOT expr 698 = $$ = tree3(T_RANG, $1, $3); 699 ; 700 701 /* 702 * QUALIFIED VARIABLES 703 */ 704 705 variable: 706 YID 707 = { 708 @@ return (identis(var, VAR)); 709 $$ = setupvar($1, NIL); 710 } 711 | 712 qual_var 713 = $1[3] = fixlist($1[3]); 714 ; 715 qual_var: 716 array_id '[' expr_list ']' 717 = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); 718 | 719 qual_var '[' expr_list ']' 720 = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); 721 | 722 record_id '.' field_id 723 = $$ = setupvar($1, setupfield($3, NIL)); 724 | 725 qual_var '.' field_id 726 = $1[3] = addlist($1[3], setupfield($3, NIL)); 727 | 728 ptr_id '^' 729 = $$ = setupvar($1, tree1(T_PTR)); 730 | 731 qual_var '^' 732 = $1[3] = addlist($1[3], tree1(T_PTR)); 733 ; 734 735 /* 736 * Expression with write widths 737 */ 738 wexpr: 739 expr 740 | 741 expr ':' expr 742 = $$ = tree4(T_WEXP, $1, $3, NIL); 743 | 744 expr ':' expr ':' expr 745 = $$ = tree4(T_WEXP, $1, $3, $5); 746 | 747 expr octhex 748 = $$ = tree4(T_WEXP, $1, NIL, $2); 749 | 750 expr ':' expr octhex 751 = $$ = tree4(T_WEXP, $1, $3, $4); 752 ; 753 octhex: 754 YOCT 755 = $$ = OCT; 756 | 757 YHEX 758 = $$ = HEX; 759 ; 760 761 expr_list: 762 expr 763 = $$ = newlist($1); 764 | 765 expr_list ',' expr 766 = $$ = addlist($1, $3); 767 ; 768 769 wexpr_list: 770 wexpr 771 = $$ = newlist($1); 772 | 773 wexpr_list ',' wexpr 774 = $$ = addlist($1, $3); 775 ; 776 777 /* 778 * OPERATORS 779 */ 780 781 relop: 782 '=' = $$ = T_EQ; 783 | 784 '<' = $$ = T_LT; 785 | 786 '>' = $$ = T_GT; 787 | 788 '<' '>' = $$ = T_NE; 789 | 790 '<' '=' = $$ = T_LE; 791 | 792 '>' '=' = $$ = T_GE; 793 | 794 YIN = $$ = T_IN; 795 ; 796 addop: 797 '+' = $$ = T_ADD; 798 | 799 '-' = $$ = T_SUB; 800 | 801 YOR = $$ = T_OR; 802 | 803 '|' = $$ = T_OR; 804 ; 805 divop: 806 '*' = $$ = T_MULT; 807 | 808 '/' = $$ = T_DIVD; 809 | 810 YDIV = $$ = T_DIV; 811 | 812 YMOD = $$ = T_MOD; 813 | 814 YAND = $$ = T_AND; 815 | 816 '&' = $$ = T_AND; 817 ; 818 819 negop: 820 YNOT 821 | 822 '~' 823 ; 824 825 /* 826 * LISTS 827 */ 828 829 var_list: 830 variable 831 = $$ = newlist($1); 832 | 833 var_list ',' variable 834 = $$ = addlist($1, $3); 835 ; 836 837 id_list: 838 YID 839 = $$ = newlist($1); 840 | 841 id_list ',' YID 842 = $$ = addlist($1, $3); 843 ; 844 845 /* 846 * Identifier productions with semantic restrictions 847 * 848 * For these productions, the characters @@ signify 849 * that the associated C statement is to provide 850 * the semantic restriction for this reduction. 851 * These lines are made into a procedure yyEactr, similar to 852 * yyactr, which determines whether the corresponding reduction 853 * is permitted, or whether an error is to be signaled. 854 * A zero return from yyEactr is considered an error. 855 * YyEactr is called with an argument "var" giving the string 856 * name of the variable in question, essentially $1, although 857 * $1 will not work because yyEactr is called from loccor in 858 * the recovery routines. 859 */ 860 861 const_id: 862 YID 863 = @@ return (identis(var, CONST)); 864 ; 865 type_id: 866 YID 867 = { 868 @@ return (identis(var, TYPE)); 869 $$ = tree3(T_TYID, lineof(yyline), $1); 870 } 871 ; 872 var_id: 873 YID 874 = @@ return (identis(var, VAR)); 875 ; 876 array_id: 877 YID 878 = @@ return (identis(var, ARRAY)); 879 ; 880 ptr_id: 881 YID 882 = @@ return (identis(var, PTRFILE)); 883 ; 884 record_id: 885 YID 886 = @@ return (identis(var, RECORD)); 887 ; 888 field_id: 889 YID 890 = @@ return (identis(var, FIELD)); 891 ; 892 proc_id: 893 YID 894 = @@ return (identis(var, PROC)); 895 ; 896 func_id: 897 YID 898 = @@ return (identis(var, FUNC)); 899 ; 900