|
|
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.