Commit | Line | Data |
---|---|---|
0d57d6f5 TL |
1 | spec: dcl |
2 | | common | |
3 | | external | |
4 | | intrinsic | |
5 | | equivalence | |
6 | | data | |
7 | | implicit | |
8 | | SSAVE | |
9 | { saveall = YES; } | |
10 | | SSAVE savelist | |
11 | | SFORMAT | |
12 | { fmtstmt(thislabel); setfmt(thislabel); } | |
13 | | SPARAM in_dcl SLPAR paramlist SRPAR | |
14 | ; | |
15 | ||
16 | dcl: type name in_dcl lengspec dims | |
17 | { settype($2, $1, $4); | |
18 | if(ndim>0) setbound($2,ndim,dims); | |
19 | } | |
20 | | dcl SCOMMA name lengspec dims | |
21 | { settype($3, $1, $4); | |
22 | if(ndim>0) setbound($3,ndim,dims); | |
23 | } | |
24 | ; | |
25 | ||
26 | type: typespec lengspec | |
27 | { varleng = $2; } | |
28 | ; | |
29 | ||
30 | typespec: typename | |
31 | { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); } | |
32 | ; | |
33 | ||
34 | typename: SINTEGER { $$ = TYLONG; } | |
35 | | SREAL { $$ = TYREAL; } | |
36 | | SCOMPLEX { $$ = TYCOMPLEX; } | |
37 | | SDOUBLE { $$ = TYDREAL; } | |
38 | | SDCOMPLEX { $$ = TYDCOMPLEX; } | |
39 | | SLOGICAL { $$ = TYLOGICAL; } | |
40 | | SCHARACTER { $$ = TYCHAR; } | |
41 | | SUNDEFINED { $$ = TYUNKNOWN; } | |
42 | | SDIMENSION { $$ = TYUNKNOWN; } | |
43 | | SAUTOMATIC { $$ = - STGAUTO; } | |
44 | | SSTATIC { $$ = - STGBSS; } | |
45 | ; | |
46 | ||
47 | lengspec: | |
48 | { $$ = varleng; } | |
49 | | SSTAR expr | |
50 | { | |
51 | if( ! ISICON($2) ) | |
52 | { | |
53 | $$ = 0; | |
54 | dclerr("length must be an integer constant", 0); | |
55 | } | |
56 | else $$ = $2->const.ci; | |
57 | } | |
58 | | SSTAR SLPAR SSTAR SRPAR | |
59 | { $$ = 0; } | |
60 | ; | |
61 | ||
62 | common: SCOMMON in_dcl var | |
63 | { incomm( $$ = comblock(0, 0) , $3 ); } | |
64 | | SCOMMON in_dcl comblock var | |
65 | { $$ = $3; incomm($3, $4); } | |
66 | | common opt_comma comblock opt_comma var | |
67 | { $$ = $3; incomm($3, $5); } | |
68 | | common SCOMMA var | |
69 | { incomm($1, $3); } | |
70 | ; | |
71 | ||
72 | comblock: SCONCAT | |
73 | { $$ = comblock(0, 0); } | |
74 | | SSLASH SNAME SSLASH | |
75 | { $$ = comblock(toklen, token); } | |
76 | ; | |
77 | ||
78 | external: SEXTERNAL in_dcl name | |
79 | { setext($3); } | |
80 | | external SCOMMA name | |
81 | { setext($3); } | |
82 | ; | |
83 | ||
84 | intrinsic: SINTRINSIC in_dcl name | |
85 | { setintr($3); } | |
86 | | intrinsic SCOMMA name | |
87 | { setintr($3); } | |
88 | ; | |
89 | ||
90 | equivalence: SEQUIV in_dcl equivset | |
91 | | equivalence SCOMMA equivset | |
92 | ; | |
93 | ||
94 | equivset: SLPAR equivlist SRPAR | |
95 | { | |
96 | struct equivblock *p; | |
97 | if(nequiv >= MAXEQUIV) | |
98 | fatal("too many equivalences"); | |
99 | p = & eqvclass[nequiv++]; | |
100 | p->eqvinit = 0; | |
101 | p->eqvbottom = 0; | |
102 | p->eqvtop = 0; | |
103 | p->equivs = $2; | |
104 | } | |
105 | ; | |
106 | ||
107 | equivlist: lhs | |
108 | { $$ = ALLOC(eqvchain); $$->eqvitem = $1; } | |
109 | | equivlist SCOMMA lhs | |
110 | { $$ = ALLOC(eqvchain); $$->eqvitem = $3; $$->nextp = $1; } | |
111 | ; | |
112 | ||
113 | data: SDATA in_data datalist | |
114 | | data opt_comma datalist | |
115 | ; | |
116 | ||
117 | in_data: | |
118 | { if(parstate == OUTSIDE) | |
119 | { | |
120 | newproc(); | |
121 | startproc(0, CLMAIN); | |
122 | } | |
123 | if(parstate < INDATA) | |
124 | { | |
125 | enddcl(); | |
126 | parstate = INDATA; | |
127 | } | |
128 | } | |
129 | ; | |
130 | ||
131 | datalist: datavarlist SSLASH vallist SSLASH | |
132 | { ftnint junk; | |
133 | if(nextdata(&junk,&junk) != NULL) | |
134 | { | |
135 | err("too few initializers"); | |
136 | curdtp = NULL; | |
137 | } | |
138 | frdata($1); | |
139 | frrpl(); | |
140 | } | |
141 | ; | |
142 | ||
143 | vallist: { toomanyinit = NO; } val | |
144 | | vallist SCOMMA val | |
145 | ; | |
146 | ||
147 | val: value | |
148 | { dataval(NULL, $1); } | |
149 | | simple SSTAR value | |
150 | { dataval($1, $3); } | |
151 | ; | |
152 | ||
153 | value: simple | |
154 | | addop simple | |
155 | { if( $1==OPMINUS && ISCONST($2) ) | |
156 | consnegop($2); | |
157 | $$ = $2; | |
158 | } | |
159 | | complex_const | |
160 | | bit_const | |
161 | ; | |
162 | ||
163 | savelist: saveitem | |
164 | | savelist SCOMMA saveitem | |
165 | ; | |
166 | ||
167 | saveitem: name | |
168 | { int k; | |
169 | $1->vsave = 1; | |
170 | k = $1->vstg; | |
171 | if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) ) | |
172 | dclerr("can only save static variables", $1); | |
173 | } | |
174 | | comblock | |
175 | { $1->extsave = 1; } | |
176 | ; | |
177 | ||
178 | paramlist: paramitem | |
179 | | paramlist SCOMMA paramitem | |
180 | ; | |
181 | ||
182 | paramitem: name SEQUALS expr | |
183 | { if($1->vclass == CLUNKNOWN) | |
184 | { $1->vclass = CLPARAM; | |
185 | $1->paramval = $3; | |
186 | } | |
187 | else dclerr("cannot make %s parameter", $1); | |
188 | } | |
189 | ; | |
190 | ||
191 | var: name dims | |
192 | { if(ndim>0) setbounds($1, ndim, dims); } | |
193 | ; | |
194 | ||
195 | datavar: lhs | |
196 | { ptr np; | |
197 | vardcl(np = $1->namep); | |
198 | if(np->vstg == STGBSS) | |
199 | np->vstg = STGINIT; | |
200 | else if(np->vstg == STGCOMMON) | |
201 | extsymtab[np->vardesc.varno].extinit = YES; | |
202 | else if(np->vstg==STGEQUIV) | |
203 | eqvclass[np->vardesc.varno].eqvinit = YES; | |
204 | else if(np->vstg != STGINIT) | |
205 | dclerr("inconsistent storage classes", np); | |
206 | $$ = mkchain($1, 0); | |
207 | } | |
208 | | SLPAR datavarlist SCOMMA dospec SRPAR | |
209 | { chainp p; struct impldoblock *q; | |
210 | q = ALLOC(impldoblock); | |
211 | q->tag = TIMPLDO; | |
212 | q->varnp = $4->datap; | |
213 | p = $4->nextp; | |
214 | if(p) { q->implb = p->datap; p = p->nextp; } | |
215 | if(p) { q->impub = p->datap; p = p->nextp; } | |
216 | if(p) { q->impstep = p->datap; p = p->nextp; } | |
217 | frchain( & ($4) ); | |
218 | $$ = mkchain(q, 0); | |
219 | q->datalist = hookup($2, $$); | |
220 | } | |
221 | ; | |
222 | ||
223 | datavarlist: datavar | |
224 | { curdtp = $1; curdtelt = 0; } | |
225 | | datavarlist SCOMMA datavar | |
226 | { $$ = hookup($1, $3); } | |
227 | ; | |
228 | ||
229 | dims: | |
230 | { ndim = 0; } | |
231 | | SLPAR dimlist SRPAR | |
232 | ; | |
233 | ||
234 | dimlist: { ndim = 0; } dim | |
235 | | dimlist SCOMMA dim | |
236 | ; | |
237 | ||
238 | dim: ubound | |
239 | { dims[ndim].lb = 0; | |
240 | dims[ndim].ub = $1; | |
241 | ++ndim; | |
242 | } | |
243 | | expr SCOLON ubound | |
244 | { dims[ndim].lb = $1; | |
245 | dims[ndim].ub = $3; | |
246 | ++ndim; | |
247 | } | |
248 | ; | |
249 | ||
250 | ubound: SSTAR | |
251 | { $$ = 0; } | |
252 | | expr | |
253 | ; | |
254 | ||
255 | labellist: label | |
256 | { nstars = 1; labarray[0] = $1; } | |
257 | | labellist SCOMMA label | |
258 | { labarray[nstars++] = $3; } | |
259 | ; | |
260 | ||
261 | label: labelval | |
262 | { if($1->labinacc) | |
263 | warn1("illegal branch to inner block, statement %s", | |
264 | convic( (ftnint) ($1->stateno) )); | |
265 | else if($1->labdefined == NO) | |
266 | $1->blklevel = blklevel; | |
267 | $1->labused = YES; | |
268 | } | |
269 | ; | |
270 | ||
271 | labelval: SICON | |
272 | { $$ = mklabel( convci(toklen, token) ); } | |
273 | ; | |
274 | ||
275 | implicit: SIMPLICIT in_dcl implist | |
276 | | implicit SCOMMA implist | |
277 | ; | |
278 | ||
279 | implist: imptype SLPAR letgroups SRPAR | |
280 | ; | |
281 | ||
282 | imptype: { needkwd = 1; } type | |
283 | { vartype = $2; } | |
284 | ; | |
285 | ||
286 | letgroups: letgroup | |
287 | | letgroups SCOMMA letgroup | |
288 | ; | |
289 | ||
290 | letgroup: letter | |
291 | { setimpl(vartype, varleng, $1, $1); } | |
292 | | letter SMINUS letter | |
293 | { setimpl(vartype, varleng, $1, $3); } | |
294 | ; | |
295 | ||
296 | letter: SNAME | |
297 | { if(toklen!=1 || token[0]<'a' || token[0]>'z') | |
298 | { | |
299 | dclerr("implicit item must be single letter", 0); | |
300 | $$ = 0; | |
301 | } | |
302 | else $$ = token[0]; | |
303 | } | |
304 | ; | |
305 | ||
306 | in_dcl: | |
307 | { switch(parstate) | |
308 | { | |
309 | case OUTSIDE: newproc(); | |
310 | startproc(0, CLMAIN); | |
311 | case INSIDE: parstate = INDCL; | |
312 | case INDCL: break; | |
313 | ||
314 | default: | |
315 | dclerr("declaration among executables", 0); | |
316 | } | |
317 | } | |
318 | ; |