10 { NO66("SAVE statement");
13 { NO66("SAVE statement"); }
15 { fmtstmt(thislabel); setfmt(thislabel); }
16 | SPARAM in_dcl SLPAR paramlist SRPAR
17 { NO66("PARAMETER statement"); }
20 dcl: type opt_comma name in_dcl new_dcl dims lengspec
21 { settype($3, $1, $7);
22 if(ndim>0) setbound($3,ndim,dims);
24 | dcl SCOMMA name dims lengspec
25 { settype($3, $1, $5);
26 if(ndim>0) setbound($3,ndim,dims);
28 | dcl SSLASHD datainit vallist SSLASHD
30 err("attempt to give DATA in type-declaration");
36 new_dcl: { new_dcl = 2; }
38 type: typespec lengspec
40 if (vartype == TYLOGICAL && varleng == 1) {
42 err("treating LOGICAL*1 as LOGICAL");
43 --nerr; /* allow generation of .c file */
49 { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]);
53 typename: SINTEGER { $$ = TYLONG; }
54 | SREAL { $$ = tyreal; }
55 | SCOMPLEX { ++complex_seen; $$ = TYCOMPLEX; }
56 | SDOUBLE { $$ = TYDREAL; }
57 | SDCOMPLEX { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
58 | SLOGICAL { $$ = TYLOGICAL; }
59 | SCHARACTER { NO66("CHARACTER statement"); $$ = TYCHAR; }
60 | SUNDEFINED { $$ = TYUNKNOWN; }
61 | SDIMENSION { $$ = TYUNKNOWN; }
62 | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
63 | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; }
68 | SSTAR intonlyon expr intonlyoff
72 NO66("length specification *n");
73 if( ! ISICON(p) || p->constblock.Const.ci<0 )
76 dclerr("length must be a positive integer constant",
80 if (vartype == TYCHAR)
81 $$ = p->constblock.Const.ci;
82 else switch((int)p->constblock.Const.ci) {
83 case 1: $$ = 1; break;
84 case 2: $$ = typesize[TYSHORT]; break;
85 case 4: $$ = typesize[TYLONG]; break;
86 case 8: $$ = typesize[TYDREAL]; break;
87 case 16: $$ = typesize[TYDCOMPLEX]; break;
89 dclerr("invalid length",NPNULL);
94 | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
95 { NO66("length specification *(*)"); $$ = -1; }
98 common: SCOMMON in_dcl var
99 { incomm( $$ = comblock("") , $3 ); }
100 | SCOMMON in_dcl comblock var
101 { $$ = $3; incomm($3, $4); }
102 | common opt_comma comblock opt_comma var
103 { $$ = $3; incomm($3, $5); }
109 { $$ = comblock(""); }
110 | SSLASH SNAME SSLASH
111 { $$ = comblock(token); }
114 external: SEXTERNAL in_dcl name
116 | external SCOMMA name
120 intrinsic: SINTRINSIC in_dcl name
121 { NO66("INTRINSIC statement"); setintr($3); }
122 | intrinsic SCOMMA name
126 equivalence: SEQUIV in_dcl equivset
127 | equivalence SCOMMA equivset
130 equivset: SLPAR equivlist SRPAR
132 struct Equivblock *p;
133 if(nequiv >= maxequiv)
134 many("equivalences", 'q', maxequiv);
135 p = & eqvclass[nequiv++];
144 { $$=ALLOC(Eqvchain);
145 $$->eqvitem.eqvlhs = (struct Primblock *)$1;
147 | equivlist SCOMMA lhs
148 { $$=ALLOC(Eqvchain);
149 $$->eqvitem.eqvlhs = (struct Primblock *) $3;
154 data: SDATA in_data datalist
155 | data opt_comma datalist
159 { if(parstate == OUTSIDE)
162 startproc(ESNULL, CLMAIN);
164 if(parstate < INDATA)
172 datalist: datainit datavarlist SSLASH datapop vallist SSLASH
174 if(nextdata(&junk) != NULL)
175 err("too few initializers");
181 datainit: /* nothing */ { frchain(&datastack); curdtp = 0; }
183 datapop: /* nothing */ { pop_datastack(); }
185 vallist: { toomanyinit = NO; } val
190 { dataval(ENULL, $1); }
197 { if( $1==OPMINUS && ISCONST($2) )
198 consnegop((Constp)$2);
205 | savelist SCOMMA saveitem
212 if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
213 dclerr("can only save static variables", $1);
219 | paramlist SCOMMA paramitem
222 paramitem: name SEQUALS expr
223 { if($1->vclass == CLUNKNOWN)
224 make_param((struct Paramblock *)$1, $3);
225 else dclerr("cannot make into parameter", $1);
230 { if(ndim>0) setbound($1, ndim, dims); }
235 np = ( (struct Primblock *) $1) -> namep;
237 if(np->vstg == STGCOMMON)
238 extsymtab[np->vardesc.varno].extinit = YES;
239 else if(np->vstg==STGEQUIV)
240 eqvclass[np->vardesc.varno].eqvinit = YES;
241 else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
242 dclerr("inconsistent storage classes", np);
243 $$ = mkchain((char *)$1, CHNULL);
245 | SLPAR datavarlist SCOMMA dospec SRPAR
246 { chainp p; struct Impldoblock *q;
248 q = ALLOC(Impldoblock);
250 (q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
252 if(p) { q->implb = (expptr)(p->datap); p = p->nextp; }
253 if(p) { q->impub = (expptr)(p->datap); p = p->nextp; }
254 if(p) { q->impstep = (expptr)(p->datap); }
256 $$ = mkchain((char *)q, CHNULL);
257 q->datalist = hookup($2, $$);
264 datastack = mkchain((char *)curdtp, datastack);
265 curdtp = $1; curdtelt = 0;
267 | datavarlist SCOMMA datavar
268 { $$ = hookup($1, $3); }
273 | SLPAR dimlist SRPAR
276 dimlist: { ndim = 0; } dim
283 err("too many dimensions");
284 else if(ndim < maxdim)
293 err("too many dimensions");
294 else if(ndim < maxdim)
295 { dims[ndim].lb = $1;
308 { nstars = 1; labarray[0] = $1; }
309 | labellist SCOMMA label
310 { if(nstars < MAXLABLIST) labarray[nstars++] = $3; }
314 { $$ = execlab( convci(toklen, token) ); }
317 implicit: SIMPLICIT in_dcl implist
318 { NO66("IMPLICIT statement"); }
319 | implicit SCOMMA implist
322 implist: imptype SLPAR letgroups SRPAR
324 { if (vartype != TYUNKNOWN)
325 dclerr("-- expected letter range",NPNULL);
326 setimpl(vartype, varleng, 'a', 'z'); }
329 imptype: { needkwd = 1; } type
330 /* { vartype = $2; } */
334 | letgroups SCOMMA letgroup
338 { setimpl(vartype, varleng, $1, $1); }
339 | letter SMINUS letter
340 { setimpl(vartype, varleng, $1, $3); }
344 { if(toklen!=1 || token[0]<'a' || token[0]>'z')
346 dclerr("implicit item must be single letter", NPNULL);
354 | namelist namelistentry
357 namelistentry: SSLASH name SSLASH namelistlist
359 if($2->vclass == CLUNKNOWN)
361 $2->vclass = CLNAMELIST;
364 $2->varxptr.namelist = $4;
365 $2->vardesc.varno = ++lastvarno;
367 else dclerr("cannot be a namelist name", $2);
372 { $$ = mkchain((char *)$1, CHNULL); }
373 | namelistlist SCOMMA name
374 { $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
380 case OUTSIDE: newproc();
381 startproc(ESNULL, CLMAIN);
382 case INSIDE: parstate = INDCL;
387 "Statement order error: declaration after DATA",
392 dclerr("declaration among executables", NPNULL);