|
|
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.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: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.