1spec:	  dcl
2	| common
3	| external
4	| intrinsic
5	| equivalence
6	| data
7	| implicit
8	| namelist
9	| SSAVE
10		{ NO66("SAVE statement");
11		  saveall = YES; }
12	| SSAVE savelist
13		{ NO66("SAVE statement"); }
14	| SFORMAT
15		{ fmtstmt(thislabel); setfmt(thislabel); }
16	| SPARAM in_dcl SLPAR paramlist SRPAR
17		{ NO66("PARAMETER statement"); }
18	;
19
20dcl:	  type opt_comma name in_dcl new_dcl dims lengspec
21		{ settype($3, $1, $7);
22		  if(ndim>0) setbound($3,ndim,dims);
23		}
24	| dcl SCOMMA name dims lengspec
25		{ settype($3, $1, $5);
26		  if(ndim>0) setbound($3,ndim,dims);
27		}
28	| dcl SSLASHD datainit vallist SSLASHD
29		{ if (new_dcl == 2) {
30			err("attempt to give DATA in type-declaration");
31			new_dcl = 1;
32			}
33		}
34	;
35
36new_dcl:	{ new_dcl = 2; } ;
37
38type:	  typespec lengspec
39		{ varleng = $2; }
40	;
41
42typespec:  typename
43		{ varleng = ($1<0 || ONEOF($1,M(TYLOGICAL)|M(TYLONG))
44				? 0 : typesize[$1]);
45		  vartype = $1; }
46	;
47
48typename:    SINTEGER	{ $$ = TYLONG; }
49	| SREAL		{ $$ = tyreal; }
50	| SCOMPLEX	{ ++complex_seen; $$ = tycomplex; }
51	| SDOUBLE	{ $$ = TYDREAL; }
52	| SDCOMPLEX	{ ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
53	| SLOGICAL	{ $$ = TYLOGICAL; }
54	| SCHARACTER	{ NO66("CHARACTER statement"); $$ = TYCHAR; }
55	| SUNDEFINED	{ $$ = TYUNKNOWN; }
56	| SDIMENSION	{ $$ = TYUNKNOWN; }
57	| SAUTOMATIC	{ NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
58	| SSTATIC	{ NOEXT("STATIC statement"); $$ = - STGBSS; }
59	| SBYTE		{ $$ = TYINT1; }
60	;
61
62lengspec:
63		{ $$ = varleng; }
64	| SSTAR intonlyon expr intonlyoff
65		{
66		expptr p;
67		p = $3;
68		NO66("length specification *n");
69		if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
70			{
71			$$ = 0;
72			dclerr("length must be a positive integer constant",
73				NPNULL);
74			}
75		else {
76			if (vartype == TYCHAR)
77				$$ = p->constblock.Const.ci;
78			else switch((int)p->constblock.Const.ci) {
79				case 1:	$$ = 1; break;
80				case 2: $$ = typesize[TYSHORT];	break;
81				case 4: $$ = typesize[TYLONG];	break;
82				case 8: $$ = typesize[TYDREAL];	break;
83				case 16: $$ = typesize[TYDCOMPLEX]; break;
84				default:
85					dclerr("invalid length",NPNULL);
86					$$ = varleng;
87				}
88			}
89		}
90	| SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
91		{ NO66("length specification *(*)"); $$ = -1; }
92	;
93
94common:	  SCOMMON in_dcl var
95		{ incomm( $$ = comblock("") , $3 ); }
96	| SCOMMON in_dcl comblock var
97		{ $$ = $3;  incomm($3, $4); }
98	| common opt_comma comblock opt_comma var
99		{ $$ = $3;  incomm($3, $5); }
100	| common SCOMMA var
101		{ incomm($1, $3); }
102	;
103
104comblock:  SCONCAT
105		{ $$ = comblock(""); }
106	| SSLASH SNAME SSLASH
107		{ $$ = comblock(token); }
108	;
109
110external: SEXTERNAL in_dcl name
111		{ setext($3); }
112	| external SCOMMA name
113		{ setext($3); }
114	;
115
116intrinsic:  SINTRINSIC in_dcl name
117		{ NO66("INTRINSIC statement"); setintr($3); }
118	| intrinsic SCOMMA name
119		{ setintr($3); }
120	;
121
122equivalence:  SEQUIV in_dcl equivset
123	| equivalence SCOMMA equivset
124	;
125
126equivset:  SLPAR equivlist SRPAR
127		{
128		struct Equivblock *p;
129		if(nequiv >= maxequiv)
130			many("equivalences", 'q', maxequiv);
131		p  =  & eqvclass[nequiv++];
132		p->eqvinit = NO;
133		p->eqvbottom = 0;
134		p->eqvtop = 0;
135		p->equivs = $2;
136		}
137	;
138
139equivlist:  lhs
140		{ $$=ALLOC(Eqvchain);
141		  $$->eqvitem.eqvlhs = primchk($1);
142		}
143	| equivlist SCOMMA lhs
144		{ $$=ALLOC(Eqvchain);
145		  $$->eqvitem.eqvlhs = primchk($3);
146		  $$->eqvnextp = $1;
147		}
148	;
149
150data:	  SDATA in_data datalist
151	| data opt_comma datalist
152	;
153
154in_data:
155		{ if(parstate == OUTSIDE)
156			{
157			newproc();
158			startproc(ESNULL, CLMAIN);
159			}
160		  if(parstate < INDATA)
161			{
162			enddcl();
163			parstate = INDATA;
164			datagripe = 1;
165			}
166		}
167	;
168
169datalist:  datainit datavarlist SSLASH datapop vallist SSLASH
170		{ ftnint junk;
171		  if(nextdata(&junk) != NULL)
172			err("too few initializers");
173		  frdata($2);
174		  frrpl();
175		}
176	;
177
178datainit: /* nothing */ { frchain(&datastack); curdtp = 0; } ;
179
180datapop: /* nothing */ { pop_datastack(); } ;
181
182vallist:  { toomanyinit = NO; }  val
183	| vallist SCOMMA val
184	;
185
186val:	  value
187		{ dataval(ENULL, $1); }
188	| simple SSTAR value
189		{ dataval($1, $3); }
190	;
191
192value:	  simple
193	| addop simple
194		{ if( $1==OPMINUS && ISCONST($2) )
195			consnegop((Constp)$2);
196		  $$ = $2;
197		}
198	| complex_const
199	;
200
201savelist: saveitem
202	| savelist SCOMMA saveitem
203	;
204
205saveitem: name
206		{ int k;
207		  $1->vsave = YES;
208		  k = $1->vstg;
209		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
210			dclerr("can only save static variables", $1);
211		}
212	| comblock
213	;
214
215paramlist:  paramitem
216	| paramlist SCOMMA paramitem
217	;
218
219paramitem:  name SEQUALS expr
220		{ if($1->vclass == CLUNKNOWN)
221			make_param((struct Paramblock *)$1, $3);
222		  else dclerr("cannot make into parameter", $1);
223		}
224	;
225
226var:	  name dims
227		{ if(ndim>0) setbound($1, ndim, dims); }
228	;
229
230datavar:	  lhs
231		{ Namep np;
232		  struct Primblock *pp = (struct Primblock *)$1;
233		  int tt = $1->tag;
234		  if (tt != TPRIM) {
235			if (tt == TCONST)
236				err("parameter in data statement");
237			else
238				erri("tag %d in data statement",tt);
239			$$ = 0;
240			err_lineno = lineno;
241			break;
242			}
243		  np = pp -> namep;
244		  vardcl(np);
245		  if ((pp->fcharp || pp->lcharp)
246		   && (np->vtype != TYCHAR || np->vdim))
247			sserr(np);
248		  if(np->vstg == STGCOMMON)
249			extsymtab[np->vardesc.varno].extinit = YES;
250		  else if(np->vstg==STGEQUIV)
251			eqvclass[np->vardesc.varno].eqvinit = YES;
252		  else if(np->vstg!=STGINIT && np->vstg!=STGBSS) {
253			errstr(np->vstg == STGARG
254				? "Dummy argument \"%.60s\" in data statement."
255				: "Cannot give data to \"%.75s\"",
256				np->fvarname);
257			$$ = 0;
258			err_lineno = lineno;
259			break;
260			}
261		  $$ = mkchain((char *)$1, CHNULL);
262		}
263	| SLPAR datavarlist SCOMMA dospec SRPAR
264		{ chainp p; struct Impldoblock *q;
265		pop_datastack();
266		q = ALLOC(Impldoblock);
267		q->tag = TIMPLDO;
268		(q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
269		p = $4->nextp;
270		if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
271		if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
272		if(p)  { q->impstep = (expptr)(p->datap); }
273		frchain( & ($4) );
274		$$ = mkchain((char *)q, CHNULL);
275		q->datalist = hookup($2, $$);
276		}
277	;
278
279datavarlist: datavar
280		{ if (!datastack)
281			curdtp = 0;
282		  datastack = mkchain((char *)curdtp, datastack);
283		  curdtp = $1; curdtelt = 0;
284		  }
285	| datavarlist SCOMMA datavar
286		{ $$ = hookup($1, $3); }
287	;
288
289dims:
290		{ ndim = 0; }
291	| SLPAR dimlist SRPAR
292	;
293
294dimlist:   { ndim = 0; }   dim
295	| dimlist SCOMMA dim
296	;
297
298dim:	  ubound
299		{
300		  if(ndim == maxdim)
301			err("too many dimensions");
302		  else if(ndim < maxdim)
303			{ dims[ndim].lb = 0;
304			  dims[ndim].ub = $1;
305			}
306		  ++ndim;
307		}
308	| expr SCOLON ubound
309		{
310		  if(ndim == maxdim)
311			err("too many dimensions");
312		  else if(ndim < maxdim)
313			{ dims[ndim].lb = $1;
314			  dims[ndim].ub = $3;
315			}
316		  ++ndim;
317		}
318	;
319
320ubound:	  SSTAR
321		{ $$ = 0; }
322	| expr
323	;
324
325labellist: label
326		{ nstars = 1; labarray[0] = $1; }
327	| labellist SCOMMA label
328		{ if(nstars < maxlablist)  labarray[nstars++] = $3; }
329	;
330
331label:	  SICON
332		{ $$ = execlab( convci(toklen, token) ); }
333	;
334
335implicit:  SIMPLICIT in_dcl implist
336		{ NO66("IMPLICIT statement"); }
337	| implicit SCOMMA implist
338	;
339
340implist:  imptype SLPAR letgroups SRPAR
341	| imptype
342		{ if (vartype != TYUNKNOWN)
343			dclerr("-- expected letter range",NPNULL);
344		  setimpl(vartype, varleng, 'a', 'z'); }
345	;
346
347imptype:   { needkwd = 1; } type
348		/* { vartype = $2; } */
349	;
350
351letgroups: letgroup
352	| letgroups SCOMMA letgroup
353	;
354
355letgroup:  letter
356		{ setimpl(vartype, varleng, $1, $1); }
357	| letter SMINUS letter
358		{ setimpl(vartype, varleng, $1, $3); }
359	;
360
361letter:  SNAME
362		{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
363			{
364			dclerr("implicit item must be single letter", NPNULL);
365			$$ = 0;
366			}
367		  else $$ = token[0];
368		}
369	;
370
371namelist:	SNAMELIST
372	| namelist namelistentry
373	;
374
375namelistentry:  SSLASH name SSLASH namelistlist
376		{
377		if($2->vclass == CLUNKNOWN)
378			{
379			$2->vclass = CLNAMELIST;
380			$2->vtype = TYINT;
381			$2->vstg = STGBSS;
382			$2->varxptr.namelist = $4;
383			$2->vardesc.varno = ++lastvarno;
384			}
385		else dclerr("cannot be a namelist name", $2);
386		}
387	;
388
389namelistlist:  name
390		{ $$ = mkchain((char *)$1, CHNULL); }
391	| namelistlist SCOMMA name
392		{ $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
393	;
394
395in_dcl:
396		{ switch(parstate)
397			{
398			case OUTSIDE:	newproc();
399					startproc(ESNULL, CLMAIN);
400			case INSIDE:	parstate = INDCL;
401			case INDCL:	break;
402
403			case INDATA:
404				if (datagripe) {
405					errstr(
406				"Statement order error: declaration after DATA",
407						CNULL);
408					datagripe = 0;
409					}
410				break;
411
412			default:
413				dclerr("declaration among executables", NPNULL);
414			}
415		}
416	;
417