|
|
1.1 root 1: dcls1: dcl1
2: | dcls1 EOS
3: | dcls1 EOS dcl1
4: { $$ = hookup($1,$3); }
5: ;
6:
7: dcl1: dcl
8: | varlist
9: ;
10:
11: dcl: attrs vars
12: { attvars($1,$2); $$ = $2; }
13: | attrs LBRACK dcls1 RBRACK
14: { attvars($1,$3); $$ = $3; }
15: | INITIAL initlist
16: { $$ = 0; }
17: | IMPLICIT letton implist lettoff
18: { $$ = 0; }
19: | EQUIVALENCE equivsets
20: { $$ = 0; }
21: | EQUIVALENCE equivlist
22: { mkequiv($2); $$ = 0; }
23: ;
24:
25: dcls: dcl
26: | dcls EOS
27: | dcls EOS dcl
28: { $$ = hookup($1,$3); }
29: ;
30:
31: initlist: init
32: | initlist COMMA init
33: ;
34:
35: init: lhs ASGNOP {ininit = YES; } expr
36: = { ininit = NO; mkinit($1,$4); frexpr($1); }
37: ;
38:
39: implist: impgroup
40: | implist COMMA impgroup;
41: ;
42:
43: impgroup: impspec
44: { setimpl(imptype, 'a', 'z'); }
45: | impspec LPAR impsets RPAR
46: ;
47:
48: impspec: specs
49: { imptype = $1->attype; cfree($1); }
50: ;
51:
52: impsets: impset
53: | impsets COMMA impset
54: ;
55:
56: impset: LETTER
57: { setimpl(imptype, $1, $1); }
58: | LETTER ADDOP LETTER
59: { setimpl(imptype, $1, $3); }
60: ;
61:
62: equivsets: equivset
63: | equivsets COMMA equivset
64: ;
65:
66: equivset: LPAR equivlist RPAR
67: { mkequiv($2); }
68: ;
69:
70: equivlist: lhs COMMA lhs
71: { $$ = mkchain($1, mkchain($3,CHNULL)); }
72: | equivlist COMMA lhs
73: { $$ = hookup($1, mkchain($3,CHNULL)); }
74: ;
75:
76: attrs: attr
77: | attrs attr { attatt($1,$2); }
78: ;
79:
80: attr: spec dim { $1->atdim = $2; }
81: | array dim { $$ = ALLOC(atblock); $$->atdim = $2; }
82: ;
83:
84: dim: { $$ = 0; }
85: | dimbound
86: ;
87:
88: dimbound: LPAR { inbound = 1; } bounds RPAR
89: { inbound = 0; $$ = arrays = mkchain($3,arrays); }
90: ;
91:
92: bounds: bound
93: | bounds COMMA bound { hookup($1,$3); }
94: ;
95:
96: bound: ubound
97: {
98: $$ = ALLOC(dimblock);
99: $$->lowerb = 0;
100: $$->upperb = $1;
101: }
102: | expr COLON ubound
103: {
104: $$ = ALLOC(dimblock);
105: $$->lowerb = $1;
106: $$->upperb = $3;
107: }
108: ;
109:
110: ubound: expr
111: | MULTOP { $$ = 0; }
112: ;
113:
114: vars: { $$ = 0; }
115: | varlist
116: ;
117:
118: varlist: var
119: | varlist COMMA var { hookup($1,$3); }
120: ;
121:
122: var: varname dim
123: {
124: if($2!=0)
125: if($1->vdim==0)
126: $1->vdim = $2;
127: else if(!eqdim($2,$1->vdim))
128: dclerr("multiple dimension", $1->namep);
129: $$ = mkchain($1,CHNULL);
130: }
131: | varname dim ASGNOP { ininit = YES; } expr
132: {
133: ininit = NO;
134: if($3!=OPASGN)
135: dclerr("illegal initialization operator", $1->sthead->namep);
136: if($2!=0)
137: if($1->vdim==0)
138: $1->vdim = $2;
139: else if(!eqdim($2,$1->vdim))
140: dclerr("multiple dimension", $1->sthead->namep);
141: if($5!=0 && $1->vinit!=0)
142: dclerr("multiple initialization", $1->sthead->namep);
143: $1->vinit = $5;
144: $$ = mkchain($1,CHNULL);
145: }
146: ;
147:
148: varname: NAME
149: { $$ = mkvar($1); }
150: ;
151:
152:
153: specs: specarray
154: | specs specarray { attatt($1,$2); }
155: ;
156:
157: specarray: spec
158: | array dimbound
159: { $$ = ALLOC(atblock); $$->atdim = $2; }
160: ;
161:
162: spec: sclass
163: {
164: $$ = ALLOC(atblock);
165: if($1 == CLEXT)
166: $$->atext = 1;
167: $$->atclass = $1;
168: }
169: | comclass contnu
170: {
171: $$ = ALLOC(atblock);
172: $$->atclass = CLCOMMON;
173: $$->atcommon = $1;
174: }
175: | stype
176: { $$ = ALLOC(atblock); $$->attype = $1; }
177: | CHARACTER LPAR expr RPAR
178: { $$ = ALLOC(atblock); $$->attype = TYCHAR; $$->attypep = $3; }
179: | FIELD LPAR bound RPAR
180: { $$ = ALLOC(atblock); $$->attype = TYFIELD;
181: $$->attypep = mkfield($3); }
182: | deftype
183: { $$ = ALLOC(atblock); $$->attype = TYSTRUCT;
184: $$->attypep = $1; }
185: | prec
186: { $$ = ALLOC(atblock); $$->atprec = $1; }
187: ;
188:
189: sclass: AUTOMATIC { $$ = CLAUTO;
190: fprintf(diagfile,"AUTOMATIC not yet implemented\n"); }
191: | STATIC { $$ = CLSTAT; }
192: | INTERNAL { $$ = CLSTAT; }
193: | VALUE { $$ = CLVALUE;
194: fprintf(diagfile, "VALUE not yet implemented\n"); }
195: | EXTERNAL { $$ = CLEXT; }
196: ;
197:
198: comclass: COMMON LPAR comneed comname RPAR
199: { $$ = $4; }
200: | COMMON MULTOP comneed comname MULTOP
201: { $$ = $4; }
202: ;
203:
204: comneed: { comneed = 1; }
205: ;
206:
207: comname: { $$ = mkcomm(""); }
208: | COMNAME
209: ;
210:
211: stype: INTEGER { $$ = TYINT; }
212: | REAL { $$ = TYREAL; }
213: | COMPLEX { $$ = TYCOMPLEX; }
214: | LOGICAL { $$ = TYLOG; }
215: | DOUBLE PRECISION
216: { $$ = TYLREAL; /* holdover from Fortran */ }
217: | DOUBLEPRECISION
218: { $$ = TYLREAL; /* holdover from Fortran */ }
219: ;
220:
221: deftype: STRUCTNAME
222: { $$ = $1->varp; }
223: | STRUCT structname contnu struct
224: { $$ = mkstruct($2,$4); }
225: | STRUCT struct
226: { $$ = mkstruct(PNULL,$2); }
227: ;
228:
229: structname: NAME
230: { if($1->varp && $1->varp->blklevel<blklevel)
231: hide($1);
232: $1->tag = TSTRUCT;
233: }
234: | STRUCTNAME
235: { if($1->varp)
236: if($1->varp->blklevel<blklevel)
237: hide($1);
238: else dclerr("multiple declaration for type %s", $1->namep);
239: }
240: ;
241:
242: struct: LBRACK { ++instruct; } dcls { --instruct; } RBRACK EOS
243: { $$ = $3; prevv = -1; }
244: ;
245:
246: array: ARRAY
247: | DIMENSION
248: ;
249:
250: prec: LONG { $$ = 1; }
251: | SHORT { $$ = 0; }
252: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.