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.9 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.9 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 phead error 287 ; 288 pheadres: 289 phead 290 = funcbody($1); 291 ; 292 phead: 293 porf YID params ftype ';' 294 = $$ = funchdr(tree5($1, lineof($5), $2, $3, $4)); 295 ; 296 porf: 297 YPROCEDURE 298 = $$ = T_PDEC; 299 | 300 YFUNCTION 301 = $$ = T_FDEC; 302 ; 303 params: 304 '(' param_list ')' 305 = $$ = fixlist($2); 306 | 307 /* lambda */ 308 = $$ = NIL; 309 ; 310 311 /* 312 * PARAMETERS 313 */ 314 315 param: 316 id_list ':' type 317 = $$ = tree3(T_PVAL, fixlist($1), $3); 318 | 319 YVAR id_list ':' type 320 = $$ = tree3(T_PVAR, fixlist($2), $4); 321 | 322 YFUNCTION id_list params ftype 323 = $$ = tree5(T_PFUNC, fixlist($2), $4, $3, lineof($1)); 324 | 325 YPROCEDURE id_list params ftype 326 = $$ = tree5(T_PPROC, fixlist($2), $4, $3, lineof($1)); 327 ; 328 ftype: 329 ':' type 330 = $$ = $2; 331 | 332 /* lambda */ 333 = $$ = NIL; 334 ; 335 param_list: 336 param 337 = $$ = newlist($1); 338 | 339 param_list ';' param 340 = $$ = addlist($1, $3); 341 ; 342 343 /* 344 * CONSTANTS 345 */ 346 347 const: 348 YSTRING 349 = $$ = tree2(T_CSTRNG, $1); 350 | 351 number 352 | 353 '+' number 354 = $$ = tree2(T_PLUSC, $2); 355 | 356 '-' number 357 = $$ = tree2(T_MINUSC, $2); 358 ; 359 number: 360 const_id 361 = $$ = tree2(T_ID, $1); 362 | 363 YINT 364 = $$ = tree2(T_CINT, $1); 365 | 366 YBINT 367 = $$ = tree2(T_CBINT, $1); 368 | 369 YNUMB 370 = $$ = tree2(T_CFINT, $1); 371 ; 372 const_list: 373 const 374 = $$ = newlist($1); 375 | 376 const_list ',' const 377 = $$ = addlist($1, $3); 378 ; 379 380 /* 381 * TYPES 382 */ 383 384 type: 385 simple_type 386 | 387 '^' YID 388 = $$ = tree3(T_TYPTR, lineof($1), tree2(T_ID, $2)); 389 | 390 struct_type 391 | 392 YPACKED struct_type 393 = $$ = tree3(T_TYPACK, lineof($1), $2); 394 ; 395 simple_type: 396 type_id 397 | 398 '(' id_list ')' 399 = $$ = tree3(T_TYSCAL, lineof($1), fixlist($2)); 400 | 401 const YDOTDOT const 402 = $$ = tree4(T_TYRANG, lineof($2), $1, $3); 403 ; 404 struct_type: 405 YARRAY '[' simple_type_list ']' YOF type 406 = $$ = tree4(T_TYARY, lineof($1), fixlist($3), $6); 407 | 408 YFILE YOF type 409 = $$ = tree3(T_TYFILE, lineof($1), $3); 410 | 411 YSET YOF simple_type 412 = $$ = tree3(T_TYSET, lineof($1), $3); 413 | 414 YRECORD field_list YEND 415 = { 416 $$ = setuptyrec( lineof( $1 ) , $2 ); 417 if ($3 < 0) 418 brerror($1, "record"); 419 } 420 ; 421 simple_type_list: 422 simple_type 423 = $$ = newlist($1); 424 | 425 simple_type_list ',' simple_type 426 = $$ = addlist($1, $3); 427 ; 428 429 /* 430 * RECORD TYPE 431 */ 432 field_list: 433 fixed_part variant_part 434 = $$ = tree4(T_FLDLST, lineof(NIL), fixlist($1), $2); 435 ; 436 fixed_part: 437 field 438 = $$ = newlist($1); 439 | 440 fixed_part ';' field 441 = $$ = addlist($1, $3); 442 | 443 fixed_part error 444 = yyPerror("Malformed record declaration", PDECL); 445 ; 446 field: 447 /* lambda */ 448 = $$ = NIL; 449 | 450 id_list ':' type 451 = $$ = tree4(T_RFIELD, lineof($2), fixlist($1), $3); 452 ; 453 454 variant_part: 455 /* lambda */ 456 = $$ = NIL; 457 | 458 YCASE type_id YOF variant_list 459 = $$ = tree5(T_TYVARPT, lineof($1), NIL, $2, fixlist($4)); 460 | 461 YCASE YID ':' type_id YOF variant_list 462 = $$ = tree5(T_TYVARPT, lineof($1), $2, $4, fixlist($6)); 463 ; 464 variant_list: 465 variant 466 = $$ = newlist($1); 467 | 468 variant_list ';' variant 469 = $$ = addlist($1, $3); 470 | 471 variant_list error 472 = yyPerror("Malformed record declaration", PDECL); 473 ; 474 variant: 475 /* lambda */ 476 = $$ = NIL; 477 | 478 const_list ':' '(' field_list ')' 479 = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), $4); 480 ; 481 482 /* 483 * STATEMENT LIST 484 */ 485 486 stat_list: 487 stat 488 = $$ = newlist($1); 489 | 490 stat_lsth stat 491 = { 492 if ((p = $1) != NIL && (q = p[1])[0] == T_IFX) { 493 q[0] = T_IFEL; 494 q[4] = $2; 495 } else 496 $$ = addlist($1, $2); 497 } 498 ; 499 500 stat_lsth: 501 stat_list ';' 502 = if ((q = $1) != NIL && (p = q[1]) != NIL && p[0] == T_IF) { 503 if (yychar < 0) 504 yychar = yylex(); 505 if (yyshifts >= 2 && yychar == YELSE) { 506 recovered(); 507 copy(&Y, &OY, sizeof Y); 508 yerror("Deleted ';' before keyword else"); 509 yychar = yylex(); 510 p[0] = T_IFX; 511 } 512 } 513 ; 514 515 /* 516 * CASE STATEMENT LIST 517 */ 518 519 cstat_list: 520 cstat 521 = $$ = newlist($1); 522 | 523 cstat_list ';' cstat 524 = $$ = addlist($1, $3); 525 | 526 error 527 = { 528 $$ = NIL; 529 Kerror: 530 yyPerror("Malformed statement in case", PSTAT); 531 } 532 | 533 cstat_list error 534 = goto Kerror; 535 ; 536 537 cstat: 538 const_list ':' stat 539 = $$ = tree4(T_CSTAT, lineof($2), fixlist($1), $3); 540 | 541 YCASELAB stat 542 = $$ = tree4(T_CSTAT, lineof($1), NIL, $2); 543 | 544 /* lambda */ 545 = $$ = NIL; 546 ; 547 548 /* 549 * STATEMENT 550 */ 551 552 stat: 553 /* lambda */ 554 = $$ = NIL; 555 | 556 YINT ':' stat 557 = $$ = tree4(T_LABEL, lineof($2), $1 == NIL ? NIL : *hash($1, 1), $3); 558 | 559 proc_id 560 = $$ = tree4(T_PCALL, lineof(yyline), $1, NIL); 561 | 562 proc_id '(' wexpr_list ')' 563 = $$ = tree4(T_PCALL, lineof($2), $1, fixlist($3)); 564 | 565 YID error 566 = goto NSerror; 567 | 568 assign 569 | 570 YBEGIN stat_list YEND 571 = { 572 $$ = tree3(T_BLOCK, lineof($1), fixlist($2)); 573 if ($3 < 0) 574 brerror($1, "begin"); 575 } 576 | 577 YCASE expr YOF cstat_list YEND 578 = { 579 $$ = tree4(T_CASE, lineof($1), $2, fixlist($4)); 580 if ($5 < 0) 581 brerror($1, "case"); 582 } 583 | 584 YWITH var_list YDO stat 585 = $$ = tree4(T_WITH, lineof($1), fixlist($2), $4); 586 | 587 YWHILE expr YDO stat 588 = $$ = tree4(T_WHILE, lineof($1), $2, $4); 589 | 590 YREPEAT stat_list YUNTIL expr 591 = $$ = tree4(T_REPEAT, lineof($3), fixlist($2), $4); 592 | 593 YFOR assign YTO expr YDO stat 594 = $$ = tree5(T_FORU, lineof($1), $2, $4, $6); 595 | 596 YFOR assign YDOWNTO expr YDO stat 597 = $$ = tree5(T_FORD, lineof($1), $2, $4, $6); 598 | 599 YGOTO YINT 600 = $$ = tree3(T_GOTO, lineof($1), *hash($2, 1)); 601 | 602 YIF expr YTHEN stat 603 = $$ = tree5(T_IF, lineof($1), $2, $4, NIL); 604 | 605 YIF expr YTHEN stat YELSE stat 606 = $$ = tree5(T_IFEL, lineof($1), $2, $4, $6); 607 | 608 error 609 = { 610 NSerror: 611 $$ = NIL; 612 Serror: 613 yyPerror("Malformed statement", PSTAT); 614 } 615 ; 616 assign: 617 variable ':' '=' expr 618 = $$ = tree4(T_ASGN, lineof($2), $1, $4); 619 ; 620 621 /* 622 * EXPRESSION 623 */ 624 625 expr: 626 error 627 = { 628 NEerror: 629 $$ = NIL; 630 Eerror: 631 yyPerror("Missing/malformed expression", PEXPR); 632 } 633 | 634 expr relop expr %prec '<' 635 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 636 | 637 '+' expr %prec UNARYSIGN 638 = $$ = tree3(T_PLUS, $2[1], $2); 639 | 640 '-' expr %prec UNARYSIGN 641 = $$ = tree3(T_MINUS, $2[1], $2); 642 | 643 expr addop expr %prec '+' 644 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 645 | 646 expr divop expr %prec '*' 647 = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 648 | 649 YNIL 650 = $$ = tree2(T_NIL, NOCON); 651 | 652 YSTRING 653 = $$ = tree3(T_STRNG, SAWCON, $1); 654 | 655 YINT 656 = $$ = tree3(T_INT, NOCON, $1); 657 | 658 YBINT 659 = $$ = tree3(T_BINT, NOCON, $1); 660 | 661 YNUMB 662 = $$ = tree3(T_FINT, NOCON, $1); 663 | 664 variable 665 | 666 YID error 667 = goto NEerror; 668 | 669 func_id '(' wexpr_list ')' 670 = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); 671 | 672 '(' expr ')' 673 = $$ = $2; 674 | 675 negop expr %prec YNOT 676 = $$ = tree3(T_NOT, NOCON, $2); 677 | 678 '[' element_list ']' 679 = $$ = tree3(T_CSET, SAWCON, fixlist($2)); 680 | 681 '[' ']' 682 = $$ = tree3(T_CSET, SAWCON, NIL); 683 ; 684 685 element_list: 686 element 687 = $$ = newlist($1); 688 | 689 element_list ',' element 690 = $$ = addlist($1, $3); 691 ; 692 element: 693 expr 694 | 695 expr YDOTDOT expr 696 = $$ = tree3(T_RANG, $1, $3); 697 ; 698 699 /* 700 * QUALIFIED VARIABLES 701 */ 702 703 variable: 704 YID 705 = { 706 @@ return (identis(var, VAR)); 707 $$ = setupvar($1, NIL); 708 } 709 | 710 qual_var 711 = $1[3] = fixlist($1[3]); 712 ; 713 qual_var: 714 array_id '[' expr_list ']' 715 = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); 716 | 717 qual_var '[' expr_list ']' 718 = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); 719 | 720 record_id '.' field_id 721 = $$ = setupvar($1, setupfield($3, NIL)); 722 | 723 qual_var '.' field_id 724 = $1[3] = addlist($1[3], setupfield($3, NIL)); 725 | 726 ptr_id '^' 727 = $$ = setupvar($1, tree1(T_PTR)); 728 | 729 qual_var '^' 730 = $1[3] = addlist($1[3], tree1(T_PTR)); 731 ; 732 733 /* 734 * Expression with write widths 735 */ 736 wexpr: 737 expr 738 | 739 expr ':' expr 740 = $$ = tree4(T_WEXP, $1, $3, NIL); 741 | 742 expr ':' expr ':' expr 743 = $$ = tree4(T_WEXP, $1, $3, $5); 744 | 745 expr octhex 746 = $$ = tree4(T_WEXP, $1, NIL, $2); 747 | 748 expr ':' expr octhex 749 = $$ = tree4(T_WEXP, $1, $3, $4); 750 ; 751 octhex: 752 YOCT 753 = $$ = OCT; 754 | 755 YHEX 756 = $$ = HEX; 757 ; 758 759 expr_list: 760 expr 761 = $$ = newlist($1); 762 | 763 expr_list ',' expr 764 = $$ = addlist($1, $3); 765 ; 766 767 wexpr_list: 768 wexpr 769 = $$ = newlist($1); 770 | 771 wexpr_list ',' wexpr 772 = $$ = addlist($1, $3); 773 ; 774 775 /* 776 * OPERATORS 777 */ 778 779 relop: 780 '=' = $$ = T_EQ; 781 | 782 '<' = $$ = T_LT; 783 | 784 '>' = $$ = T_GT; 785 | 786 '<' '>' = $$ = T_NE; 787 | 788 '<' '=' = $$ = T_LE; 789 | 790 '>' '=' = $$ = T_GE; 791 | 792 YIN = $$ = T_IN; 793 ; 794 addop: 795 '+' = $$ = T_ADD; 796 | 797 '-' = $$ = T_SUB; 798 | 799 YOR = $$ = T_OR; 800 | 801 '|' = $$ = T_OR; 802 ; 803 divop: 804 '*' = $$ = T_MULT; 805 | 806 '/' = $$ = T_DIVD; 807 | 808 YDIV = $$ = T_DIV; 809 | 810 YMOD = $$ = T_MOD; 811 | 812 YAND = $$ = T_AND; 813 | 814 '&' = $$ = T_AND; 815 ; 816 817 negop: 818 YNOT 819 | 820 '~' 821 ; 822 823 /* 824 * LISTS 825 */ 826 827 var_list: 828 variable 829 = $$ = newlist($1); 830 | 831 var_list ',' variable 832 = $$ = addlist($1, $3); 833 ; 834 835 id_list: 836 YID 837 = $$ = newlist($1); 838 | 839 id_list ',' YID 840 = $$ = addlist($1, $3); 841 ; 842 843 /* 844 * Identifier productions with semantic restrictions 845 * 846 * For these productions, the characters @@ signify 847 * that the associated C statement is to provide 848 * the semantic restriction for this reduction. 849 * These lines are made into a procedure yyEactr, similar to 850 * yyactr, which determines whether the corresponding reduction 851 * is permitted, or whether an error is to be signaled. 852 * A zero return from yyEactr is considered an error. 853 * YyEactr is called with an argument "var" giving the string 854 * name of the variable in question, essentially $1, although 855 * $1 will not work because yyEactr is called from loccor in 856 * the recovery routines. 857 */ 858 859 const_id: 860 YID 861 = @@ return (identis(var, CONST)); 862 ; 863 type_id: 864 YID 865 = { 866 @@ return (identis(var, TYPE)); 867 $$ = tree3(T_TYID, lineof(yyline), $1); 868 } 869 ; 870 var_id: 871 YID 872 = @@ return (identis(var, VAR)); 873 ; 874 array_id: 875 YID 876 = @@ return (identis(var, ARRAY)); 877 ; 878 ptr_id: 879 YID 880 = @@ return (identis(var, PTRFILE)); 881 ; 882 record_id: 883 YID 884 = @@ return (identis(var, RECORD)); 885 ; 886 field_id: 887 YID 888 = @@ return (identis(var, FIELD)); 889 ; 890 proc_id: 891 YID 892 = @@ return (identis(var, PROC)); 893 ; 894 func_id: 895 YID 896 = @@ return (identis(var, FUNC)); 897 ; 898