1: /* 2: * pi - Pascal interpreter code translator 3: * 4: * Charles Haley, Bill Joy UCB 5: * Version 1.0 August 1977 6: * 7: * pxp - Pascal execution profiler 8: * 9: * Bill Joy UCB 10: * Version 1.0 August 1977 11: */ 12: 13: /* 14: * Yacc grammar for UNIX Pascal 15: * 16: * This grammar is processed by the commands in the shell script 17: * "gram" to yield parse tables and semantic routines in the file 18: * "y.tab.c" and a header defining the lexical tokens in "yy.h". 19: * 20: * In order for the syntactic error recovery possible with this 21: * grammar to work, the grammar must be processed by a yacc which 22: * has been modified to fully enumerate possibilities in states 23: * which involve the symbol "error". 24: * The parser used for Pascal also uses a different encoding of 25: * the test entries in the action table which speeds the parse. 26: * A version of yacc which will work for Pascal is included on 27: * the distribution table as "eyacc". 28: * 29: * The "gram" script also makes the following changes to the "y.tab.c" 30: * file: 31: * 32: * 1) Causes yyval to be declared int *. 33: * 34: * 2) Loads the variable yypv into a register as yyYpv so that 35: * the arguments $1, ... are available as yyYpv[1] etc. 36: * This produces much smaller code in the semantic actions. 37: * 38: * 3) Deletes the unused array yysterm. 39: * 40: * 4) Moves the declarations up to the flag line containing 41: * '##' to the file yy.h so that the routines which use 42: * these "magic numbers" don't have to all be compiled at 43: * the same time. 44: * 45: * 5) Creates the semantic restriction checking routine yyEactr 46: * by processing action lines containing `@'. 47: * 48: * This compiler uses a different version of the yacc parser, a 49: * different yyerror which is called yerror, and requires more 50: * lookahead sets than normally provided by yacc. 51: * 52: * Source for the yacc used with this grammar is included on 53: * distribution tapes. 54: */ 55: 56: /* 57: * TERMINAL DECLARATIONS 58: * 59: * Some of the terminal declarations are out of the most natural 60: * alphabetic order because the error recovery 61: * will guess the first of equal cost non-terminals. 62: * This makes, e.g. YTO preferable to YDOWNTO. 63: */ 64: 65: %term 66: YAND YARRAY YBEGIN YCASE 67: YCONST YDIV YDO YDOTDOT 68: YTO YELSE YEND YFILE 69: YFOR YFORWARD YFUNCTION YGOTO 70: YID YIF YIN YINT 71: YLABEL YMOD YNOT YNUMB 72: YOF YOR YPACKED YNIL 73: YPROCEDURE YPROG YRECORD YREPEAT 74: YSET YSTRING YTHEN YDOWNTO 75: YTYPE YUNTIL YVAR YWHILE 76: YWITH YBINT YOCT YHEX 77: YASSERT YCASELAB YILLCH YLAST 78: 79: /* 80: * PRECEDENCE DECLARATIONS 81: * 82: * Highest precedence is the unary logical NOT. 83: * Next are the multiplying operators, signified by '*'. 84: * Lower still are the binary adding operators, signified by '+'. 85: * Finally, at lowest precedence and non-associative are the relationals. 86: */ 87: 88: %binary '<' '=' '>' YIN 89: %left '+' '-' YOR '|' 90: %left UNARYSIGN 91: %left '*' '/' YDIV YMOD YAND '&' 92: %left YNOT 93: 94: %{ 95: 96: /* 97: * GLOBALS FOR ACTIONS 98: */ 99: 100: /* 101: * The following line marks the end of the yacc 102: * Constant definitions which are removed from 103: * y.tab.c and placed in the file y.tab.h. 104: */ 105: ## 106: 107: #include "0.h" 108: #include "yy.h" 109: #include "tree.h" 110: 111: #ifdef PI 112: #define lineof(l) l 113: #define line2of(l) l 114: #endif 115: 116: %} 117: 118: %% 119: 120: /* 121: * PRODUCTIONS 122: */ 123: 124: goal: 125: prog_hedr decls procs block '.' 126: = funcend($1, $4, lineof($5)); 127: ; 128: 129: prog_hedr: 130: YPROG YID '(' id_list ')' ';' 131: = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL))); 132: | 133: YPROG error 134: = { 135: yyPerror("Malformed program statement", PPROG); 136: /* 137: * Should make a program statement 138: * with "input" and "output" here. 139: */ 140: $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL))); 141: } 142: ; 143: block: 144: YBEGIN stat_list YEND 145: = { 146: $$ = tree3(T_BSTL, lineof($1), fixlist($2)); 147: if ($3.pint < 0) 148: brerror($1, "begin"); 149: } 150: ; 151: 152: 153: /* 154: * DECLARATION PART 155: */ 156: decls: 157: decls decl 158: = trfree(); 159: | 160: decls error 161: = { 162: Derror: 163: constend(), typeend(), varend(), trfree(); 164: yyPerror("Malformed declaration", PDECL); 165: } 166: | 167: /* lambda */ 168: = trfree(); 169: ; 170: 171: decl: 172: labels 173: | 174: const_decl 175: = constend(); 176: | 177: type_decl 178: = typeend(); 179: | 180: var_decl 181: = varend(); 182: ; 183: 184: /* 185: * LABEL PART 186: */ 187: 188: labels: 189: YLABEL label_decl ';' 190: = label(fixlist($2), lineof($1)); 191: ; 192: label_decl: 193: YINT 194: = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); 195: | 196: label_decl ',' YINT 197: = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); 198: ; 199: 200: /* 201: * CONST PART 202: */ 203: 204: const_decl: 205: YCONST YID '=' const ';' 206: = constbeg($1, line2of($2)), const(lineof($3), $2, $4); 207: | 208: const_decl YID '=' const ';' 209: = const(lineof($3), $2, $4); 210: | 211: YCONST error 212: = { 213: constbeg($1, line2of($1)); 214: Cerror: 215: yyPerror("Malformed const declaration", PDECL); 216: } 217: | 218: const_decl error 219: = goto Cerror; 220: ; 221: 222: /* 223: * TYPE PART 224: */ 225: 226: type_decl: 227: YTYPE YID '=' type ';' 228: = typebeg($1, line2of($2)), type(lineof($3), $2, $4); 229: | 230: type_decl YID '=' type ';' 231: = type(lineof($3), $2, $4); 232: | 233: YTYPE error 234: = { 235: typebeg($1, line2of($1)); 236: Terror: 237: yyPerror("Malformed type declaration", PDECL); 238: } 239: | 240: type_decl error 241: = goto Terror; 242: ; 243: 244: /* 245: * VAR PART 246: */ 247: 248: var_decl: 249: YVAR id_list ':' type ';' 250: = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); 251: | 252: var_decl id_list ':' type ';' 253: = var(lineof($3), fixlist($2), $4); 254: | 255: YVAR error 256: = { 257: varbeg($1, line2of($1)); 258: Verror: 259: yyPerror("Malformed var declaration", PDECL); 260: } 261: | 262: var_decl error 263: = goto Verror; 264: ; 265: 266: /* 267: * PROCEDURE AND FUNCTION DECLARATION PART 268: */ 269: 270: procs: 271: /* lambda */ 272: | 273: procs proc 274: = trfree(); 275: ; 276: proc: 277: phead YFORWARD ';' 278: = funcfwd($1); 279: | 280: pheadres decls procs block ';' 281: = funcend($1, $4, lineof($5)); 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 ':' type 318: = $$ = tree3(T_PFUNC, fixlist($2), $4); 319: | 320: YPROCEDURE id_list 321: = $$ = tree2(T_PPROC, fixlist($2)); 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: $$ = tree3(T_TYREC, lineof($1), $2); 412: if ($3.pint < 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.pint < 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.pint < 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: YIF expr YTHEN stat YELSE 607: = $$ = tree5(T_IFEL, lineof($1), $2, $4, NIL); 608: | 609: YASSERT '(' expr ')' 610: = $$ = tree3(T_ASRT, lineof($1), $3); 611: | 612: error 613: = { 614: NSerror: 615: $$ = NIL; 616: Serror: 617: yyPerror("Malformed statement", PSTAT); 618: } 619: ; 620: assign: 621: variable ':' '=' expr 622: = $$ = tree4(T_ASGN, lineof($2), $1, $4); 623: ; 624: 625: /* 626: * EXPRESSION 627: */ 628: 629: expr: 630: error 631: = { 632: NEerror: 633: $$ = NIL; 634: Eerror: 635: yyPerror("Missing/malformed expression", PEXPR); 636: } 637: | 638: expr relop expr %prec '<' 639: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 640: | 641: '+' expr %prec UNARYSIGN 642: = $$ = tree3(T_PLUS, $2[1], $2); 643: | 644: '-' expr %prec UNARYSIGN 645: = $$ = tree3(T_MINUS, $2[1], $2); 646: | 647: expr addop expr %prec '+' 648: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 649: | 650: expr divop expr %prec '*' 651: = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); 652: | 653: YNIL 654: = $$ = tree2(T_NIL, NOCON); 655: | 656: YSTRING 657: = $$ = tree3(T_STRNG, SAWCON, $1); 658: | 659: YINT 660: = $$ = tree3(T_INT, NOCON, $1); 661: | 662: YBINT 663: = $$ = tree3(T_BINT, NOCON, $1); 664: | 665: YNUMB 666: = $$ = tree3(T_FINT, NOCON, $1); 667: | 668: variable 669: | 670: YID error 671: = goto NEerror; 672: | 673: func_id '(' wexpr_list ')' 674: = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); 675: | 676: '(' expr ')' 677: = $$ = $2; 678: | 679: negop expr %prec YNOT 680: = $$ = tree3(T_NOT, NOCON, $2); 681: | 682: '[' element_list ']' 683: = $$ = tree3(T_CSET, SAWCON, fixlist($2)); 684: | 685: '[' ']' 686: = $$ = tree3(T_CSET, SAWCON, NIL); 687: ; 688: 689: element_list: 690: element 691: = $$ = newlist($1); 692: | 693: element_list ',' element 694: = $$ = addlist($1, $3); 695: ; 696: element: 697: expr 698: | 699: expr YDOTDOT expr 700: = $$ = tree3(T_RANG, $1, $3); 701: ; 702: 703: /* 704: * QUALIFIED VARIABLES 705: */ 706: 707: variable: 708: YID 709: = { 710: @ return (identis(var, VAR)); 711: $$ = setupvar($1, NIL); 712: } 713: | 714: qual_var 715: = $1[3] = fixlist($1[3]); 716: ; 717: qual_var: 718: array_id '[' expr_list ']' 719: = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); 720: | 721: qual_var '[' expr_list ']' 722: = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); 723: | 724: record_id '.' field_id 725: = $$ = setupvar($1, tree3(T_FIELD, $3, NIL)); 726: | 727: qual_var '.' field_id 728: = $1[3] = addlist($1[3], tree3(T_FIELD, $3, NIL)); 729: | 730: ptr_id '^' 731: = $$ = setupvar($1, tree1(T_PTR)); 732: | 733: qual_var '^' 734: = $1[3] = addlist($1[3], tree1(T_PTR)); 735: ; 736: 737: /* 738: * Expression with write widths 739: */ 740: wexpr: 741: expr 742: | 743: expr ':' expr 744: = $$ = tree4(T_WEXP, $1, $3, NIL); 745: | 746: expr ':' expr ':' expr 747: = $$ = tree4(T_WEXP, $1, $3, $5); 748: | 749: expr octhex 750: = $$ = tree4(T_WEXP, $1, NIL, $2); 751: | 752: expr ':' expr octhex 753: = $$ = tree4(T_WEXP, $1, $3, $4); 754: ; 755: octhex: 756: YOCT 757: = $$ = OCT; 758: | 759: YHEX 760: = $$ = HEX; 761: ; 762: 763: expr_list: 764: expr 765: = $$ = newlist($1); 766: | 767: expr_list ',' expr 768: = $$ = addlist($1, $3); 769: ; 770: 771: wexpr_list: 772: wexpr 773: = $$ = newlist($1); 774: | 775: wexpr_list ',' wexpr 776: = $$ = addlist($1, $3); 777: ; 778: 779: /* 780: * OPERATORS 781: */ 782: 783: relop: 784: '=' = $$ = T_EQ; 785: | 786: '<' = $$ = T_LT; 787: | 788: '>' = $$ = T_GT; 789: | 790: '<' '>' = $$ = T_NE; 791: | 792: '<' '=' = $$ = T_LE; 793: | 794: '>' '=' = $$ = T_GE; 795: | 796: YIN = $$ = T_IN; 797: ; 798: addop: 799: '+' = $$ = T_ADD; 800: | 801: '-' = $$ = T_SUB; 802: | 803: YOR = $$ = T_OR; 804: | 805: '|' = $$ = T_OR; 806: ; 807: divop: 808: '*' = $$ = T_MULT; 809: | 810: '/' = $$ = T_DIVD; 811: | 812: YDIV = $$ = T_DIV; 813: | 814: YMOD = $$ = T_MOD; 815: | 816: YAND = $$ = T_AND; 817: | 818: '&' = $$ = T_AND; 819: ; 820: 821: negop: 822: YNOT 823: | 824: '~' 825: ; 826: 827: /* 828: * LISTS 829: */ 830: 831: var_list: 832: variable 833: = $$ = newlist($1); 834: | 835: var_list ',' variable 836: = $$ = addlist($1, $3); 837: ; 838: 839: id_list: 840: YID 841: = $$ = newlist($1); 842: | 843: id_list ',' YID 844: = $$ = addlist($1, $3); 845: ; 846: 847: /* 848: * Identifier productions with semantic restrictions 849: * 850: * For these productions, the character @ signifies 851: * that the associated C statement is to provide 852: * the semantic restriction for this reduction. 853: * These lines are made into a procedure yyEactr, similar to 854: * yyactr, which determines whether the corresponding reduction 855: * is permitted, or whether an error is to be signaled. 856: * A zero return from yyEactr is considered an error. 857: * YyEactr is called with an argument "var" giving the string 858: * name of the variable in question, essentially $1, although 859: * $1 will not work because yyEactr is called from loccor in 860: * the recovery routines. 861: */ 862: 863: const_id: 864: YID 865: = @ return (identis(var, CONST)); 866: ; 867: type_id: 868: YID 869: = { 870: @ return (identis(var, TYPE)); 871: $$ = tree3(T_TYID, lineof(yyline), $1); 872: } 873: ; 874: var_id: 875: YID 876: = @ return (identis(var, VAR)); 877: ; 878: array_id: 879: YID 880: = @ return (identis(var, ARRAY)); 881: ; 882: ptr_id: 883: YID 884: = @ return (identis(var, PTRFILE)); 885: ; 886: record_id: 887: YID 888: = @ return (identis(var, RECORD)); 889: ; 890: field_id: 891: YID 892: = @ return (identis(var, FIELD)); 893: ; 894: proc_id: 895: YID 896: = @ return (identis(var, PROC)); 897: ; 898: func_id: 899: YID 900: = @ return (identis(var, FUNC)); 901: ;