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