4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/gram.expr

   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:     ;