1/*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 *
7 *	@(#)gram.dcl	5.3 (Berkeley) 04/12/91
8 */
9
10/*
11 * Grammar for declarations, f77 compiler, 4.2 BSD.
12 *
13 * University of Utah CS Dept modification history:
14 *
15 * $Log:	gram.dcl,v $
16 * Revision 3.2  84/11/12  18:36:26  donn
17 * A side effect of removing the ability of labels to define the start of
18 * a program is that format statements have to do the job now...
19 *
20 * Revision 3.1  84/10/13  00:26:54  donn
21 * Installed Jerry Berkman's version; added comment header.
22 *
23 */
24
25spec:	  dcl
26	| common
27	| external
28	| intrinsic
29	| equivalence
30	| implicit
31	| data
32	| namelist
33	| SSAVE
34		{ NO66("SAVE statement");
35		  saveall = YES; }
36	| SSAVE savelist
37		{ NO66("SAVE statement"); }
38	| SFORMAT
39		{
40		if (parstate == OUTSIDE)
41			{
42			newproc();
43			startproc(PNULL, CLMAIN);
44			parstate = INSIDE;
45			}
46		if (parstate < INDCL)
47			parstate = INDCL;
48		fmtstmt(thislabel);
49		setfmt(thislabel);
50		}
51	| SPARAM in_dcl SLPAR paramlist SRPAR
52		{ NO66("PARAMETER statement"); }
53	;
54
55dcl:	  type opt_comma name in_dcl dims lengspec
56		{ settype($3, $1, $6);
57		  if(ndim>0) setbound($3,ndim,dims);
58		}
59	| dcl SCOMMA name dims lengspec
60		{ settype($3, $1, $5);
61		  if(ndim>0) setbound($3,ndim,dims);
62		}
63	;
64
65type:	  typespec lengspec
66		{ varleng = $2; }
67	;
68
69typespec:  typename
70		{ varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
71	;
72
73typename:    SINTEGER	{ $$ = TYLONG; }
74	| SREAL		{ $$ = TYREAL; }
75	| SCOMPLEX	{ $$ = TYCOMPLEX; }
76	| SDOUBLE	{ $$ = TYDREAL; }
77	| SDCOMPLEX	{ NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
78	| SLOGICAL	{ $$ = TYLOGICAL; }
79	| SCHARACTER	{ NO66("CHARACTER statement"); $$ = TYCHAR; }
80	| SUNDEFINED	{ $$ = TYUNKNOWN; }
81	| SDIMENSION	{ $$ = TYUNKNOWN; }
82	| SAUTOMATIC	{ NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
83	| SSTATIC	{ NOEXT("STATIC statement"); $$ = - STGBSS; }
84	;
85
86lengspec:
87		{ $$ = varleng; }
88	| SSTAR intonlyon expr intonlyoff
89		{
90		expptr p;
91		p = $3;
92		NO66("length specification *n");
93		if( ! ISICON(p) || p->constblock.constant.ci<0 )
94			{
95			$$ = 0;
96			dclerr("- length must be a positive integer value",
97				PNULL);
98			}
99		else $$ = p->constblock.constant.ci;
100		}
101	| SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
102		{ NO66("length specification *(*)"); $$ = -1; }
103	;
104
105common:	  SCOMMON in_dcl var
106		{ incomm( $$ = comblock(0, CNULL) , $3 ); }
107	| SCOMMON in_dcl comblock var
108		{ $$ = $3;  incomm($3, $4); }
109	| common opt_comma comblock opt_comma var
110		{ $$ = $3;  incomm($3, $5); }
111	| common SCOMMA var
112		{ incomm($1, $3); }
113	;
114
115comblock:  SCONCAT
116		{ $$ = comblock(0, CNULL); }
117	| SSLASH SNAME SSLASH
118		{ $$ = comblock(toklen, token); }
119	;
120
121external: SEXTERNAL in_dcl name
122		{ setext($3); }
123	| external SCOMMA name
124		{ setext($3); }
125	;
126
127intrinsic:  SINTRINSIC in_dcl name
128		{ NO66("INTRINSIC statement"); setintr($3); }
129	| intrinsic SCOMMA name
130		{ setintr($3); }
131	;
132
133equivalence:  SEQUIV in_dcl equivset
134	| equivalence SCOMMA equivset
135	;
136
137equivset:  SLPAR equivlist SRPAR
138		{
139		struct Equivblock *p;
140		if(nequiv >= maxequiv)
141			many("equivalences", 'q');
142		if( !equivlisterr ) {
143		   p  =  & eqvclass[nequiv++];
144		   p->eqvinit = NO;
145		   p->eqvbottom = 0;
146		   p->eqvtop = 0;
147		   p->equivs = $2;
148		   p->init = NO;
149		   p->initoffset = 0;
150		   }
151		}
152	;
153
154equivlist:  lhs
155		{ $$=ALLOC(Eqvchain);
156		  equivlisterr = 0;
157		  if( $1->tag == TCONST ) {
158			equivlisterr = 1;
159			dclerr( "- constant in equivalence", NULL );
160		  }
161		  $$->eqvitem.eqvlhs = (struct Primblock *)$1;
162		}
163	| equivlist SCOMMA lhs
164		{ $$=ALLOC(Eqvchain);
165		  if( $3->tag == TCONST ) {
166			equivlisterr = 1;
167			dclerr( "constant in equivalence", NULL );
168		  }
169		  $$->eqvitem.eqvlhs = (struct Primblock *) $3;
170		  $$->eqvnextp = $1;
171		}
172	;
173
174
175savelist: saveitem
176	| savelist SCOMMA saveitem
177	;
178
179saveitem: name
180		{ int k;
181		  $1->vsave = YES;
182		  k = $1->vstg;
183		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT))
184				|| ($1->vclass == CLPARAM) )
185			dclerr("can only save static variables", $1);
186		}
187	| comblock
188		{ $1->extsave = 1; }
189	;
190
191paramlist:  paramitem
192	| paramlist SCOMMA paramitem
193	;
194
195paramitem:  name SEQUALS expr
196		{ paramset( $1, $3 ); }
197	;
198
199var:	  name dims
200		{ if(ndim>0) setbound($1, ndim, dims); }
201	;
202
203
204dims:
205		{ ndim = 0; }
206	| SLPAR dimlist SRPAR
207	;
208
209dimlist:   { ndim = 0; }   dim
210	| dimlist SCOMMA dim
211	;
212
213dim:	  ubound
214		{ if(ndim == maxdim)
215			err("too many dimensions");
216		  else if(ndim < maxdim)
217			{ dims[ndim].lb = 0;
218			  dims[ndim].ub = $1;
219			}
220		  ++ndim;
221		}
222	| expr SCOLON ubound
223		{ if(ndim == maxdim)
224			err("too many dimensions");
225		  else if(ndim < maxdim)
226			{ dims[ndim].lb = $1;
227			  dims[ndim].ub = $3;
228			}
229		  ++ndim;
230		}
231	;
232
233ubound:	  SSTAR
234		{ $$ = 0; }
235	| expr
236	;
237
238labellist: label
239		{ nstars = 1; labarray[0] = $1; }
240	| labellist SCOMMA label
241		{ if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
242	;
243
244label:	  SICON
245		{ $$ = execlab( convci(toklen, token) ); }
246	;
247
248implicit:  SIMPLICIT in_dcl implist
249		{ NO66("IMPLICIT statement"); }
250	| implicit SCOMMA implist
251	;
252
253implist:  imptype SLPAR letgroups SRPAR
254	;
255
256imptype:   { needkwd = 1; } type
257		{ vartype = $2; }
258	;
259
260letgroups: letgroup
261	| letgroups SCOMMA letgroup
262	;
263
264letgroup:  letter
265		{ setimpl(vartype, varleng, $1, $1); }
266	| letter SMINUS letter
267		{ setimpl(vartype, varleng, $1, $3); }
268	;
269
270letter:  SNAME
271		{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
272			{
273			dclerr("implicit item must be single letter", PNULL);
274			$$ = 0;
275			}
276		  else $$ = token[0];
277		}
278	;
279
280namelist:	SNAMELIST
281	| namelist namelistentry
282	;
283
284namelistentry:  SSLASH name SSLASH namelistlist
285		{
286		if($2->vclass == CLUNKNOWN)
287			{
288			$2->vclass = CLNAMELIST;
289			$2->vtype = TYINT;
290			$2->vstg = STGINIT;
291			$2->varxptr.namelist = $4;
292			$2->vardesc.varno = ++lastvarno;
293			}
294		else dclerr("cannot be a namelist name", $2);
295		}
296	;
297
298namelistlist:  name
299		{ $$ = mkchain($1, CHNULL); }
300	| namelistlist SCOMMA name
301		{ $$ = hookup($1, mkchain($3, CHNULL)); }
302	;
303
304in_dcl:
305		{ switch(parstate)
306			{
307			case OUTSIDE:	newproc();
308					startproc(PNULL, CLMAIN);
309			case INSIDE:	parstate = INDCL;
310			case INDCL:	break;
311
312			default:
313				dclerr("declaration among executables", PNULL);
314			}
315		}
316	;
317
318data:	data1
319	{
320	  if (overlapflag == YES)
321	    warn("overlapping initializations");
322	}
323
324data1:	SDATA in_data datapair
325    |	data1 opt_comma datapair
326    ;
327
328in_data:
329		{ if(parstate == OUTSIDE)
330			{
331			newproc();
332			startproc(PNULL, CLMAIN);
333			}
334		  if(parstate < INDATA)
335			{
336			enddcl();
337			parstate = INDATA;
338			}
339		  overlapflag = NO;
340		}
341	;
342
343datapair:	datalvals SSLASH datarvals SSLASH
344			{ savedata($1, $3); }
345	;
346
347datalvals:	datalval
348		{ $$ = preplval(NULL, $1); }
349	 |	datalvals SCOMMA datalval
350		{ $$ = preplval($1, $3); }
351	 ;
352
353datarvals:	datarval
354	 |	datarvals SCOMMA datarval
355			{
356			  $3->next = $1;
357			  $$ = $3;
358			}
359	 ;
360
361datalval:	dataname
362			{ $$ = mkdlval($1, NULL, NULL); }
363	|	dataname datasubs
364			{ $$ = mkdlval($1, $2, NULL); }
365	|	dataname datarange
366			{ $$ = mkdlval($1, NULL, $2); }
367	|	dataname datasubs datarange
368			{ $$ = mkdlval($1, $2, $3); }
369	|	dataimplieddo
370	;
371
372dataname:	SNAME { $$ = mkdname(toklen, token); }
373	;
374
375datasubs:	SLPAR iconexprlist SRPAR
376			{ $$ = revvlist($2); }
377	;
378
379datarange:	SLPAR opticonexpr SCOLON opticonexpr SRPAR
380			{ $$ = mkdrange($2, $4); }
381	 ;
382
383iconexprlist:	iconexpr
384			{
385			  $$ = prepvexpr(NULL, $1);
386			}
387	    |	iconexprlist SCOMMA iconexpr
388			{
389			  $$ = prepvexpr($1, $3);
390			}
391	    ;
392
393opticonexpr:			{ $$ = NULL; }
394	   |	iconexpr	{ $$ = $1; }
395	   ;
396
397dataimplieddo:	SLPAR dlist SCOMMA dataname SEQUALS iconexprlist SRPAR
398		{ $$ = mkdatado($2, $4, $6); }
399	     ;
400
401dlist:	dataelt
402	{ $$ = preplval(NULL, $1); }
403     |	dlist SCOMMA dataelt
404	{ $$ = preplval($1, $3); }
405     ;
406
407dataelt:	dataname datasubs
408		{ $$ = mkdlval($1, $2, NULL); }
409       |	dataname datarange
410		{ $$ = mkdlval($1, NULL, $2); }
411       |	dataname datasubs datarange
412		{ $$ = mkdlval($1, $2, $3); }
413       |	dataimplieddo
414       ;
415
416datarval:	datavalue
417			{
418			  static dvalue one = { DVALUE, NORMAL, 1 };
419
420			  $$ = mkdrval(&one, $1);
421			}
422	|	dataname SSTAR datavalue
423			{
424			  $$ = mkdrval($1, $3);
425			  frvexpr($1);
426			}
427	|	unsignedint SSTAR datavalue
428			{
429			  $$ = mkdrval($1, $3);
430			  frvexpr($1);
431			}
432	;
433
434datavalue:	dataname
435			{
436			  $$ = evparam($1);
437			  free((char *) $1);
438			}
439	 |	int_const
440			{
441			  $$ = ivaltoicon($1);
442			  frvexpr($1);
443			}
444
445	 |	real_const
446	 |	complex_const
447	 |	STRUE		{ $$ = mklogcon(1); }
448	 |	SFALSE		{ $$ = mklogcon(0); }
449	 |	SHOLLERITH	{ $$ = mkstrcon(toklen, token); }
450	 |	SSTRING		{ $$ = mkstrcon(toklen, token); }
451	 |	bit_const
452	 ;
453
454int_const:	unsignedint
455	 |	SPLUS unsignedint
456			{ $$ = $2; }
457	 |	SMINUS unsignedint
458			{
459			  $$ = negival($2);
460			  frvexpr($2);
461			}
462
463	 ;
464
465unsignedint:	SICON { $$ = evicon(toklen, token); }
466	   ;
467
468real_const:	unsignedreal
469	  |	SPLUS unsignedreal
470			{ $$ = $2; }
471	  |	SMINUS unsignedreal
472			{
473			  consnegop($2);
474			  $$ = $2;
475			}
476	  ;
477
478unsignedreal:	SRCON { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
479	    |	SDCON { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
480	    ;
481
482bit_const:	SHEXCON { $$ = mkbitcon(4, toklen, token); }
483	 |	SOCTCON { $$ = mkbitcon(3, toklen, token); }
484	 |	SBITCON { $$ = mkbitcon(1, toklen, token); }
485	 ;
486
487iconexpr:	iconterm
488	|	SPLUS iconterm
489			{ $$ = $2; }
490	|	SMINUS iconterm
491			{ $$ = mkdexpr(OPNEG, NULL, $2); }
492	|	iconexpr SPLUS iconterm
493			{ $$ = mkdexpr(OPPLUS, $1, $3); }
494	|	iconexpr SMINUS iconterm
495			{ $$ = mkdexpr(OPMINUS, $1, $3); }
496	;
497
498iconterm:	iconfactor
499	|	iconterm SSTAR iconfactor
500			{ $$ = mkdexpr(OPSTAR, $1, $3); }
501	|	iconterm SSLASH iconfactor
502			{ $$ = mkdexpr(OPSLASH, $1, $3); }
503	;
504
505iconfactor:	iconprimary
506	  |	iconprimary SPOWER iconfactor
507			{ $$ = mkdexpr(OPPOWER, $1, $3); }
508	  ;
509
510iconprimary:	SICON
511			{ $$ = evicon(toklen, token); }
512	   |	dataname
513	   |	SLPAR iconexpr SRPAR
514			{ $$ = $2; }
515	   ;
516