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.8 08/30/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.8 08/30/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 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