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.6 08/27/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.6 08/27/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 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 proc_decl 185 ; 186 187 /* 188 * LABEL PART 189 */ 190 191 labels: 192 YLABEL label_decl ';' 193 = label(fixlist($2), lineof($1)); 194 ; 195 label_decl: 196 YINT 197 = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); 198 | 199 label_decl ',' YINT 200 = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); 201 ; 202 203 /* 204 * CONST PART 205 */ 206 207 const_decl: 208 YCONST YID '=' const ';' 209 = constbeg($1, line2of($2)), const(lineof($3), $2, $4); 210 | 211 const_decl YID '=' const ';' 212 = const(lineof($3), $2, $4); 213 | 214 YCONST error 215 = { 216 constbeg($1, line2of($1)); 217 Cerror: 218 yyPerror("Malformed const declaration", PDECL); 219 } 220 | 221 const_decl error 222 = goto Cerror; 223 ; 224 225 /* 226 * TYPE PART 227 */ 228 229 type_decl: 230 YTYPE YID '=' type ';' 231 = typebeg($1, line2of($2)), type(lineof($3), $2, $4); 232 | 233 type_decl YID '=' type ';' 234 = type(lineof($3), $2, $4); 235 | 236 YTYPE error 237 = { 238 typebeg($1, line2of($1)); 239 Terror: 240 yyPerror("Malformed type declaration", PDECL); 241 } 242 | 243 type_decl error 244 = goto Terror; 245 ; 246 247 /* 248 * VAR PART 249 */ 250 251 var_decl: 252 YVAR id_list ':' type ';' 253 = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); 254 | 255 var_decl id_list ':' type ';' 256 = var(lineof($3), fixlist($2), $4); 257 | 258 YVAR error 259 = { 260 varbeg($1, line2of($1)); 261 Verror: 262 yyPerror("Malformed var declaration", PDECL); 263 } 264 | 265 var_decl error 266 = goto Verror; 267 ; 268 269 /* 270 * PROCEDURE AND FUNCTION DECLARATION PART 271 */ 272 273 proc_decl: 274 phead YFORWARD ';' 275 = funcfwd($1); 276 | 277 phead YEXTERN ';' 278 = funcext($1); 279 | 280 pheadres decls block ';' 281 = funcend($1, $3, lineof($4)); 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 params ftype 318 = $$ = tree5(T_PFUNC, fixlist($2), $4, $3, lineof($1)); 319 | 320 YPROCEDURE id_list params ftype 321 = $$ = tree5(T_PPROC, fixlist($2), $4, $3, lineof($1)); 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 $$ = setuptyrec( lineof( $1 ) , $2 ); 412 if ($3 < 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 < 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 < 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 error 607 = { 608 NSerror: 609 $$ = NIL; 610 Serror: 611 yyPerror("Malformed statement", PSTAT); 612 } 613 ; 614 assign: 615 variable ':' '=' expr 616 = $$ = tree4(T_ASGN, lineof($2), $1, $4); 617 ; 618 619 /* 620 * EXPRESSION 621 */ 622 623 expr: 624 error 625 = { 626 NEerror: 627 $$ = NIL; 628 Eerror: 629 yyPerror("Missing/malformed expression", PEXPR); 630 } 631 | 632 expr relop expr %prec '<' 633 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 634 | 635 '+' expr %prec UNARYSIGN 636 = $$ = tree3(T_PLUS, $2[1], $2); 637 | 638 '-' expr %prec UNARYSIGN 639 = $$ = tree3(T_MINUS, $2[1], $2); 640 | 641 expr addop expr %prec '+' 642 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 643 | 644 expr divop expr %prec '*' 645 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 646 | 647 YNIL 648 = $$ = tree2(T_NIL, NOCON); 649 | 650 YSTRING 651 = $$ = tree3(T_STRNG, SAWCON, $1); 652 | 653 YINT 654 = $$ = tree3(T_INT, NOCON, $1); 655 | 656 YBINT 657 = $$ = tree3(T_BINT, NOCON, $1); 658 | 659 YNUMB 660 = $$ = tree3(T_FINT, NOCON, $1); 661 | 662 variable 663 | 664 YID error 665 = goto NEerror; 666 | 667 func_id '(' wexpr_list ')' 668 = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); 669 | 670 '(' expr ')' 671 = $$ = $2; 672 | 673 negop expr %prec YNOT 674 = $$ = tree3(T_NOT, NOCON, $2); 675 | 676 '[' element_list ']' 677 = $$ = tree3(T_CSET, SAWCON, fixlist($2)); 678 | 679 '[' ']' 680 = $$ = tree3(T_CSET, SAWCON, NIL); 681 ; 682 683 element_list: 684 element 685 = $$ = newlist($1); 686 | 687 element_list ',' element 688 = $$ = addlist($1, $3); 689 ; 690 element: 691 expr 692 | 693 expr YDOTDOT expr 694 = $$ = tree3(T_RANG, $1, $3); 695 ; 696 697 /* 698 * QUALIFIED VARIABLES 699 */ 700 701 variable: 702 YID 703 = { 704 @@ return (identis(var, VAR)); 705 $$ = setupvar($1, NIL); 706 } 707 | 708 qual_var 709 = $1[3] = fixlist($1[3]); 710 ; 711 qual_var: 712 array_id '[' expr_list ']' 713 = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); 714 | 715 qual_var '[' expr_list ']' 716 = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); 717 | 718 record_id '.' field_id 719 = $$ = setupvar($1, setupfield($3, NIL)); 720 | 721 qual_var '.' field_id 722 = $1[3] = addlist($1[3], setupfield($3, NIL)); 723 | 724 ptr_id '^' 725 = $$ = setupvar($1, tree1(T_PTR)); 726 | 727 qual_var '^' 728 = $1[3] = addlist($1[3], tree1(T_PTR)); 729 ; 730 731 /* 732 * Expression with write widths 733 */ 734 wexpr: 735 expr 736 | 737 expr ':' expr 738 = $$ = tree4(T_WEXP, $1, $3, NIL); 739 | 740 expr ':' expr ':' expr 741 = $$ = tree4(T_WEXP, $1, $3, $5); 742 | 743 expr octhex 744 = $$ = tree4(T_WEXP, $1, NIL, $2); 745 | 746 expr ':' expr octhex 747 = $$ = tree4(T_WEXP, $1, $3, $4); 748 ; 749 octhex: 750 YOCT 751 = $$ = OCT; 752 | 753 YHEX 754 = $$ = HEX; 755 ; 756 757 expr_list: 758 expr 759 = $$ = newlist($1); 760 | 761 expr_list ',' expr 762 = $$ = addlist($1, $3); 763 ; 764 765 wexpr_list: 766 wexpr 767 = $$ = newlist($1); 768 | 769 wexpr_list ',' wexpr 770 = $$ = addlist($1, $3); 771 ; 772 773 /* 774 * OPERATORS 775 */ 776 777 relop: 778 '=' = $$ = T_EQ; 779 | 780 '<' = $$ = T_LT; 781 | 782 '>' = $$ = T_GT; 783 | 784 '<' '>' = $$ = T_NE; 785 | 786 '<' '=' = $$ = T_LE; 787 | 788 '>' '=' = $$ = T_GE; 789 | 790 YIN = $$ = T_IN; 791 ; 792 addop: 793 '+' = $$ = T_ADD; 794 | 795 '-' = $$ = T_SUB; 796 | 797 YOR = $$ = T_OR; 798 | 799 '|' = $$ = T_OR; 800 ; 801 divop: 802 '*' = $$ = T_MULT; 803 | 804 '/' = $$ = T_DIVD; 805 | 806 YDIV = $$ = T_DIV; 807 | 808 YMOD = $$ = T_MOD; 809 | 810 YAND = $$ = T_AND; 811 | 812 '&' = $$ = T_AND; 813 ; 814 815 negop: 816 YNOT 817 | 818 '~' 819 ; 820 821 /* 822 * LISTS 823 */ 824 825 var_list: 826 variable 827 = $$ = newlist($1); 828 | 829 var_list ',' variable 830 = $$ = addlist($1, $3); 831 ; 832 833 id_list: 834 YID 835 = $$ = newlist($1); 836 | 837 id_list ',' YID 838 = $$ = addlist($1, $3); 839 ; 840 841 /* 842 * Identifier productions with semantic restrictions 843 * 844 * For these productions, the characters @@ signify 845 * that the associated C statement is to provide 846 * the semantic restriction for this reduction. 847 * These lines are made into a procedure yyEactr, similar to 848 * yyactr, which determines whether the corresponding reduction 849 * is permitted, or whether an error is to be signaled. 850 * A zero return from yyEactr is considered an error. 851 * YyEactr is called with an argument "var" giving the string 852 * name of the variable in question, essentially $1, although 853 * $1 will not work because yyEactr is called from loccor in 854 * the recovery routines. 855 */ 856 857 const_id: 858 YID 859 = @@ return (identis(var, CONST)); 860 ; 861 type_id: 862 YID 863 = { 864 @@ return (identis(var, TYPE)); 865 $$ = tree3(T_TYID, lineof(yyline), $1); 866 } 867 ; 868 var_id: 869 YID 870 = @@ return (identis(var, VAR)); 871 ; 872 array_id: 873 YID 874 = @@ return (identis(var, ARRAY)); 875 ; 876 ptr_id: 877 YID 878 = @@ return (identis(var, PTRFILE)); 879 ; 880 record_id: 881 YID 882 = @@ return (identis(var, RECORD)); 883 ; 884 field_id: 885 YID 886 = @@ return (identis(var, FIELD)); 887 ; 888 proc_id: 889 YID 890 = @@ return (identis(var, PROC)); 891 ; 892 func_id: 893 YID 894 = @@ return (identis(var, FUNC)); 895 ; 896