|
|
1.1 ! root 1: /* ! 2: * Copyright (c) 1980 Regents of the University of California. ! 3: * All rights reserved. The Berkeley software License Agreement ! 4: * specifies the terms and conditions for redistribution. ! 5: * ! 6: * @(#)gram.expr 5.1 (Berkeley) 6/7/85 ! 7: */ ! 8: ! 9: /* ! 10: * gram.expr ! 11: * ! 12: * Grammar for expressions, f77 compiler pass 1, 4.2 BSD. ! 13: * ! 14: * University of Utah CS Dept modification history: ! 15: * ! 16: * $Log: gram.expr,v $ ! 17: Revision 1.3 86/02/12 15:28:19 rcs ! 18: 4.3 F77. C. Keating. ! 19: ! 20: * Revision 3.2 85/02/15 19:08:53 donn ! 21: * Put OPPAREN operators in trees when not optimizing as well as when ! 22: * optimizing -- this allows '(1)' to produce a writable temporary instead ! 23: * of a read-only constant when passed as an argument to a subroutine. ! 24: * ! 25: * Revision 3.1 84/10/13 00:42:08 donn ! 26: * Installed Jerry Berkman's version with cosmetic changes. ! 27: * ! 28: * Revision 1.2 84/08/04 21:27:05 donn ! 29: * Added Jerry Berkman's fix to stop complaints about parentheses in ! 30: * declarations. ! 31: * ! 32: */ ! 33: ! 34: funarglist: ! 35: { $$ = 0; } ! 36: | funargs ! 37: ; ! 38: ! 39: funargs: expr ! 40: { $$ = mkchain($1, CHNULL); } ! 41: | funargs SCOMMA expr ! 42: { $$ = hookup($1, mkchain($3,CHNULL) ); } ! 43: ; ! 44: ! 45: ! 46: expr: uexpr ! 47: | SLPAR expr SRPAR ! 48: { if (optimflag && parstate != INSIDE && parstate !=INDCL) ! 49: $$ = mkexpr(OPPAREN, $2, ENULL); ! 50: else $$ = $2; ! 51: } ! 52: | complex_const ! 53: ; ! 54: ! 55: uexpr: lhs ! 56: | simple_const ! 57: | expr addop expr %prec SPLUS ! 58: { $$ = mkexpr($2, $1, $3); } ! 59: | expr SSTAR expr ! 60: { $$ = mkexpr(OPSTAR, $1, $3); } ! 61: | expr SSLASH expr ! 62: { $$ = mkexpr(OPSLASH, $1, $3); } ! 63: | expr SPOWER expr ! 64: { $$ = mkexpr(OPPOWER, $1, $3); } ! 65: | addop expr %prec SSTAR ! 66: { if($1 == OPMINUS) ! 67: $$ = mkexpr(OPNEG, $2, ENULL); ! 68: else $$ = $2; ! 69: } ! 70: | expr relop expr %prec SEQ ! 71: { $$ = mkexpr($2, $1, $3); } ! 72: | expr SEQV expr ! 73: { NO66(".EQV. operator"); ! 74: $$ = mkexpr(OPEQV, $1,$3); } ! 75: | expr SNEQV expr ! 76: { NO66(".NEQV. operator"); ! 77: $$ = mkexpr(OPNEQV, $1, $3); } ! 78: | expr SOR expr ! 79: { $$ = mkexpr(OPOR, $1, $3); } ! 80: | expr SAND expr ! 81: { $$ = mkexpr(OPAND, $1, $3); } ! 82: | SNOT expr ! 83: { $$ = mkexpr(OPNOT, $2, ENULL); } ! 84: | expr SCONCAT expr ! 85: { NO66("concatenation operator //"); ! 86: $$ = mkexpr(OPCONCAT, $1, $3); } ! 87: ; ! 88: ! 89: addop: SPLUS { $$ = OPPLUS; } ! 90: | SMINUS { $$ = OPMINUS; } ! 91: ; ! 92: ! 93: relop: SEQ { $$ = OPEQ; } ! 94: | SGT { $$ = OPGT; } ! 95: | SLT { $$ = OPLT; } ! 96: | SGE { $$ = OPGE; } ! 97: | SLE { $$ = OPLE; } ! 98: | SNE { $$ = OPNE; } ! 99: ; ! 100: ! 101: lhs: name ! 102: { $$ = mkprim($1, PNULL, CHNULL); } ! 103: | name substring ! 104: { NO66("substring operator :"); ! 105: if( $1->vclass != CLPARAM ) { ! 106: $$ = mkprim($1, PNULL, $2); ! 107: } else { ! 108: errstr("substring of parameter %s", ! 109: varstr(VL,$1->varname) ); ! 110: YYERROR ; ! 111: } ! 112: } ! 113: | name SLPAR funarglist SRPAR ! 114: { if( $1->vclass != CLPARAM ) { ! 115: $$ = mkprim($1, mklist($3), CHNULL); ! 116: } else { ! 117: errstr("can not subscript parameter %s", ! 118: varstr(VL,$1->varname) ); ! 119: YYERROR ; ! 120: } ! 121: } ! 122: | name SLPAR funarglist SRPAR substring ! 123: { if( $1->vclass != CLPARAM ) { ! 124: NO66("substring operator :"); ! 125: $$ = mkprim($1, mklist($3), $5); ! 126: } else { ! 127: errstr("can not subscript parameter %s", ! 128: varstr(VL,$1->varname) ); ! 129: YYERROR ; ! 130: } ! 131: } ! 132: ; ! 133: ! 134: substring: SLPAR opt_expr SCOLON opt_expr SRPAR ! 135: { $$ = mkchain($2, mkchain($4,CHNULL)); } ! 136: ; ! 137: ! 138: opt_expr: ! 139: { $$ = 0; } ! 140: | expr ! 141: ; ! 142: ! 143: ! 144: simple_const: STRUE { $$ = mklogcon(1); } ! 145: | SFALSE { $$ = mklogcon(0); } ! 146: | SHOLLERITH { $$ = mkstrcon(toklen, token); } ! 147: | SICON = { $$ = mkintcon( convci(toklen, token) ); } ! 148: | SRCON = { $$ = mkrealcon(TYREAL, convcd(toklen, token)); } ! 149: | SDCON = { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); } ! 150: ; ! 151: ! 152: complex_const: SLPAR uexpr SCOMMA uexpr SRPAR ! 153: { $$ = mkcxcon($2,$4); } ! 154: ; ! 155: ! 156: ! 157: fexpr: unpar_fexpr ! 158: | SLPAR fexpr SRPAR ! 159: { if (optimflag && parstate != INDCL) ! 160: $$ = mkexpr(OPPAREN, $2, ENULL); ! 161: else $$ = $2; ! 162: } ! 163: ; ! 164: ! 165: unpar_fexpr: lhs ! 166: | simple_const ! 167: | fexpr addop fexpr %prec SPLUS ! 168: { $$ = mkexpr($2, $1, $3); } ! 169: | fexpr SSTAR fexpr ! 170: { $$ = mkexpr(OPSTAR, $1, $3); } ! 171: | fexpr SSLASH fexpr ! 172: { $$ = mkexpr(OPSLASH, $1, $3); } ! 173: | fexpr SPOWER fexpr ! 174: { $$ = mkexpr(OPPOWER, $1, $3); } ! 175: | addop fexpr %prec SSTAR ! 176: { if($1 == OPMINUS) ! 177: $$ = mkexpr(OPNEG, $2, ENULL); ! 178: else $$ = $2; ! 179: } ! 180: | fexpr SCONCAT fexpr ! 181: { NO66("concatenation operator //"); ! 182: $$ = mkexpr(OPCONCAT, $1, $3); } ! 183: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.