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.2 (Berkeley) 1/7/86 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 5.2 85/12/21 07:26:39 donn 18: * Permit CHARACTER*(4) in function declarations by eliminating parentheses 19: * more appropriately. 20: * 21: * Revision 5.1 85/08/10 03:47:25 donn 22: * 4.3 alpha 23: * 24: * Revision 3.2 85/02/15 19:08:53 donn 25: * Put OPPAREN operators in trees when not optimizing as well as when 26: * optimizing -- this allows '(1)' to produce a writable temporary instead 27: * of a read-only constant when passed as an argument to a subroutine. 28: * 29: * Revision 3.1 84/10/13 00:42:08 donn 30: * Installed Jerry Berkman's version with cosmetic changes. 31: * 32: * Revision 1.2 84/08/04 21:27:05 donn 33: * Added Jerry Berkman's fix to stop complaints about parentheses in 34: * declarations. 35: * 36: */ 37: 38: funarglist: 39: { $$ = 0; } 40: | funargs 41: ; 42: 43: funargs: expr 44: { $$ = mkchain($1, CHNULL); } 45: | funargs SCOMMA expr 46: { $$ = hookup($1, mkchain($3,CHNULL) ); } 47: ; 48: 49: 50: expr: uexpr 51: | SLPAR expr SRPAR 52: { if (parstate > INDCL) 53: $$ = mkexpr(OPPAREN, $2, ENULL); 54: else $$ = $2; 55: } 56: | complex_const 57: ; 58: 59: uexpr: lhs 60: | simple_const 61: | expr addop expr %prec SPLUS 62: { $$ = mkexpr($2, $1, $3); } 63: | expr SSTAR expr 64: { $$ = mkexpr(OPSTAR, $1, $3); } 65: | expr SSLASH expr 66: { $$ = mkexpr(OPSLASH, $1, $3); } 67: | expr SPOWER expr 68: { $$ = mkexpr(OPPOWER, $1, $3); } 69: | addop expr %prec SSTAR 70: { if($1 == OPMINUS) 71: $$ = mkexpr(OPNEG, $2, ENULL); 72: else $$ = $2; 73: } 74: | expr relop expr %prec SEQ 75: { $$ = mkexpr($2, $1, $3); } 76: | expr SEQV expr 77: { NO66(".EQV. operator"); 78: $$ = mkexpr(OPEQV, $1,$3); } 79: | expr SNEQV expr 80: { NO66(".NEQV. operator"); 81: $$ = mkexpr(OPNEQV, $1, $3); } 82: | expr SOR expr 83: { $$ = mkexpr(OPOR, $1, $3); } 84: | expr SAND expr 85: { $$ = mkexpr(OPAND, $1, $3); } 86: | SNOT expr 87: { $$ = mkexpr(OPNOT, $2, ENULL); } 88: | expr SCONCAT expr 89: { NO66("concatenation operator //"); 90: $$ = mkexpr(OPCONCAT, $1, $3); } 91: ; 92: 93: addop: SPLUS { $$ = OPPLUS; } 94: | SMINUS { $$ = OPMINUS; } 95: ; 96: 97: relop: SEQ { $$ = OPEQ; } 98: | SGT { $$ = OPGT; } 99: | SLT { $$ = OPLT; } 100: | SGE { $$ = OPGE; } 101: | SLE { $$ = OPLE; } 102: | SNE { $$ = OPNE; } 103: ; 104: 105: lhs: name 106: { $$ = mkprim($1, PNULL, CHNULL); } 107: | name substring 108: { NO66("substring operator :"); 109: if( $1->vclass != CLPARAM ) { 110: $$ = mkprim($1, PNULL, $2); 111: } else { 112: errstr("substring of parameter %s", 113: varstr(VL,$1->varname) ); 114: YYERROR ; 115: } 116: } 117: | name SLPAR funarglist SRPAR 118: { if( $1->vclass != CLPARAM ) { 119: $$ = mkprim($1, mklist($3), CHNULL); 120: } else { 121: errstr("can not subscript parameter %s", 122: varstr(VL,$1->varname) ); 123: YYERROR ; 124: } 125: } 126: | name SLPAR funarglist SRPAR substring 127: { if( $1->vclass != CLPARAM ) { 128: NO66("substring operator :"); 129: $$ = mkprim($1, mklist($3), $5); 130: } else { 131: errstr("can not subscript parameter %s", 132: varstr(VL,$1->varname) ); 133: YYERROR ; 134: } 135: } 136: ; 137: 138: substring: SLPAR opt_expr SCOLON opt_expr SRPAR 139: { $$ = mkchain($2, mkchain($4,CHNULL)); } 140: ; 141: 142: opt_expr: 143: { $$ = 0; } 144: | expr 145: ; 146: 147: 148: simple_const: STRUE { $$ = mklogcon(1); } 149: | SFALSE { $$ = mklogcon(0); } 150: | SHOLLERITH { $$ = mkstrcon(toklen, token); } 151: | SICON = { $$ = mkintcon( convci(toklen, token) ); } 152: | SRCON = { $$ = mkrealcon(TYREAL, convcd(toklen, token)); } 153: | SDCON = { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); } 154: ; 155: 156: complex_const: SLPAR uexpr SCOMMA uexpr SRPAR 157: { $$ = mkcxcon($2,$4); } 158: ; 159: 160: 161: fexpr: unpar_fexpr 162: | SLPAR fexpr SRPAR 163: { if (optimflag && parstate > INDCL) 164: $$ = mkexpr(OPPAREN, $2, ENULL); 165: else $$ = $2; 166: } 167: ; 168: 169: unpar_fexpr: lhs 170: | simple_const 171: | fexpr addop fexpr %prec SPLUS 172: { $$ = mkexpr($2, $1, $3); } 173: | fexpr SSTAR fexpr 174: { $$ = mkexpr(OPSTAR, $1, $3); } 175: | fexpr SSLASH fexpr 176: { $$ = mkexpr(OPSLASH, $1, $3); } 177: | fexpr SPOWER fexpr 178: { $$ = mkexpr(OPPOWER, $1, $3); } 179: | addop fexpr %prec SSTAR 180: { if($1 == OPMINUS) 181: $$ = mkexpr(OPNEG, $2, ENULL); 182: else $$ = $2; 183: } 184: | fexpr SCONCAT fexpr 185: { NO66("concatenation operator //"); 186: $$ = mkexpr(OPCONCAT, $1, $3); } 187: ;