1*47957Sbostic/*-
2*47957Sbostic * Copyright (c) 1980 The Regents of the University of California.
3*47957Sbostic * All rights reserved.
422824Smckusick *
5*47957Sbostic * %sccs.include.proprietary.c%
6*47957Sbostic *
7*47957Sbostic *	@(#)gram.exec	5.3 (Berkeley) 04/12/91
822824Smckusick */
922824Smckusick
1022824Smckusick/*
1122824Smckusick * gram.exec
1222824Smckusick *
1322824Smckusick * Grammar for executable statements, f77 compiler pass 1, 4.2 BSD.
1422824Smckusick *
1522824Smckusick * University of Utah CS Dept modification history:
1622824Smckusick *
1722824Smckusick * $Log:	gram.exec,v $
1825738Sdonn * Revision 5.2  85/12/18  20:17:38  donn
1925738Sdonn * Modified end_spec to insist on parser state INEXEC after seeing an
2025738Sdonn * executable statement.  This allows us to limit statement functions to
2125738Sdonn * parser state INDATA.
2225738Sdonn *
2325738Sdonn * Revision 5.1  85/08/10  03:47:22  donn
2425738Sdonn * 4.3 alpha
2525738Sdonn *
2622824Smckusick * Revision 3.1  84/10/13  00:36:41  donn
2722824Smckusick * Installed Jerry Berkman's version; preserved comment header.
2822824Smckusick *
2922824Smckusick * Revision 1.3  84/08/06  18:38:43  donn
3022824Smckusick * Fixed a bug in Jerry Berkman's label fixes which caused the same label to
3122824Smckusick * be generated twice for some types of logical IF statements.
3222824Smckusick *
3322824Smckusick * Revision 1.2  84/08/04  21:09:57  donn
3422824Smckusick * Added fixes from Jerry Berkman to allow proper ASSIGNS from format
3522824Smckusick * statement numbers.
3622824Smckusick *
3722824Smckusick */
3822824Smckusick
3922824Smckusickexec:	  iffable
4022824Smckusick	| SDO end_spec intonlyon label intonlyoff opt_comma dospec
4122824Smckusick		{
4222824Smckusick		if( !do_name_err ) {
4322824Smckusick		   if($4->labdefined)
4422824Smckusick			execerr("no backward DO loops", CNULL);
4522824Smckusick		   $4->blklevel = blklevel+1;
4622824Smckusick		   exdo($4->labelno, $7);
4722824Smckusick		   }
4822824Smckusick		}
4922824Smckusick	| logif iffable
5022824Smckusick		{ exendif();  thiswasbranch = NO; }
5122824Smckusick	| logif STHEN
5222824Smckusick	| SELSEIF end_spec SLPAR expr SRPAR STHEN
5322824Smckusick		{ exelif($4); lastwasbranch = NO; }
5422824Smckusick	| SELSE end_spec
5522824Smckusick		{ exelse(); lastwasbranch = NO; }
5622824Smckusick	| SENDIF end_spec
5722824Smckusick		{ exendif(); lastwasbranch = NO; }
5822824Smckusick	;
5922824Smckusick
6022824Smckusicklogif:	  SLOGIF end_spec SLPAR expr SRPAR
6122824Smckusick		{ exif($4); }
6222824Smckusick	;
6322824Smckusick
6422824Smckusickdospec:	  name SEQUALS exprlist
6522824Smckusick		{ if( $1->vclass != CLPARAM ) {
6622824Smckusick			$$ = mkchain($1, $3);
6722824Smckusick			do_name_err = 0;
6822824Smckusick		  } else {
6922824Smckusick			err("symbolic constant not allowed as DO variable");
7022824Smckusick		 	do_name_err = 1;
7122824Smckusick		  }
7222824Smckusick		}
7322824Smckusick	;
7422824Smckusick
7522824Smckusickiffable:  let lhs SEQUALS expr
7622824Smckusick		{ exequals($2, $4); }
7722824Smckusick	| SASSIGN end_spec assignlabel STO name
7822824Smckusick		{ if( $5->vclass != CLPARAM ) {
7922824Smckusick			exassign($5, $3);
8022824Smckusick		  } else {
8122824Smckusick			err("can only assign to a variable");
8222824Smckusick		  }
8322824Smckusick		}
8422824Smckusick	| SCONTINUE end_spec
8522824Smckusick	| goto
8622824Smckusick	| io
8722824Smckusick		{ inioctl = NO; }
8822824Smckusick	| SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
8922824Smckusick		{ exarif($4, $6, $8, $10);  thiswasbranch = YES; }
9022824Smckusick	| call
9122824Smckusick		{ excall($1, PNULL, 0, labarray); }
9222824Smckusick	| call SLPAR SRPAR
9322824Smckusick		{ excall($1, PNULL, 0, labarray); }
9422824Smckusick	| call SLPAR callarglist SRPAR
9522824Smckusick		{ if(nstars < MAXLABLIST)
9622824Smckusick			excall($1, mklist($3), nstars, labarray);
9722824Smckusick		  else
9822824Smckusick			err("too many alternate returns");
9922824Smckusick		}
10022824Smckusick	| SRETURN end_spec opt_expr
10122824Smckusick		{ exreturn($3);  thiswasbranch = YES; }
10222824Smckusick	| stop end_spec opt_expr
10322824Smckusick		{ exstop($1, $3);  thiswasbranch = $1; }
10422824Smckusick	;
10522824Smckusick
10622824Smckusickassignlabel:   SICON
10722824Smckusick		{ $$ = mklabel( convci(toklen, token) ); }
10822824Smckusick	;
10922824Smckusick
11022824Smckusicklet:	  SLET
11122824Smckusick		{ if(parstate == OUTSIDE)
11222824Smckusick			{
11322824Smckusick			newproc();
11422824Smckusick			startproc(PNULL, CLMAIN);
11522824Smckusick			}
11622824Smckusick		  if( yystno != 0 && thislabel->labtype != LABFORMAT)
11722824Smckusick			if (optimflag)
11822824Smckusick				optbuff (SKLABEL, 0, thislabel->labelno, 1);
11922824Smckusick			else
12022824Smckusick				putlabel(thislabel->labelno);
12122824Smckusick		}
12222824Smckusick	;
12322824Smckusick
12422824Smckusickgoto:	  SGOTO end_spec label
12522824Smckusick		{ exgoto($3);  thiswasbranch = YES; }
12622824Smckusick	| SASGOTO end_spec name
12722824Smckusick		{ if( $3->vclass != CLPARAM ) {
12822824Smckusick			exasgoto($3);  thiswasbranch = YES;
12922824Smckusick		  } else {
13022824Smckusick			err("must go to label or assigned variable");
13122824Smckusick		  }
13222824Smckusick		}
13322824Smckusick	| SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
13422824Smckusick		{ if( $3->vclass != CLPARAM ) {
13522824Smckusick			exasgoto($3);  thiswasbranch = YES;
13622824Smckusick		  } else {
13722824Smckusick			err("must go to label or assigned variable");
13822824Smckusick		  }
13922824Smckusick		}
14022824Smckusick	| SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
14122824Smckusick		{ if(nstars < MAXLABLIST)
14222824Smckusick			if (optimflag)
14322824Smckusick			    optbuff (SKCMGOTO, fixtype($7), nstars, labarray);
14422824Smckusick			else
14522824Smckusick			    putcmgo (fixtype($7), nstars, labarray);
14622824Smckusick		  else
14722824Smckusick			err("computed GOTO list too long");
14822824Smckusick		}
14922824Smckusick	;
15022824Smckusick
15122824Smckusickopt_comma:
15222824Smckusick	| SCOMMA
15322824Smckusick	;
15422824Smckusick
15522824Smckusickcall:	  SCALL end_spec name
15622824Smckusick		{ nstars = 0; $$ = $3; }
15722824Smckusick	;
15822824Smckusick
15922824Smckusickcallarglist:  callarg
16022824Smckusick		{ $$ = ($1 ? mkchain($1,CHNULL) : CHNULL); }
16122824Smckusick	| callarglist SCOMMA callarg
16222824Smckusick		{ if($3)
16322824Smckusick			if($1) $$ = hookup($1, mkchain($3,CHNULL));
16422824Smckusick			else $$ = mkchain($3,CHNULL);
16522824Smckusick		  else
16622824Smckusick			$$ = $1;
16722824Smckusick		}
16822824Smckusick	;
16922824Smckusick
17022824Smckusickcallarg:  expr
17122824Smckusick	| SSTAR label
17222824Smckusick		{ if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; }
17322824Smckusick	;
17422824Smckusick
17522824Smckusickstop:	  SPAUSE
17622824Smckusick		{ $$ = 0; }
17722824Smckusick	| SSTOP
17822824Smckusick		{ $$ = 1; }
17922824Smckusick	;
18022824Smckusick
18122824Smckusickexprlist:  expr
18222824Smckusick		{ $$ = mkchain($1, CHNULL); }
18322824Smckusick	| exprlist SCOMMA expr
18422824Smckusick		{ $$ = hookup($1, mkchain($3,CHNULL) ); }
18522824Smckusick	;
18622824Smckusick
18722824Smckusickend_spec:
18822824Smckusick		{ if(parstate == OUTSIDE)
18922824Smckusick			{
19022824Smckusick			newproc();
19122824Smckusick			startproc(PNULL, CLMAIN);
19222824Smckusick			}
19322824Smckusick		  if(parstate < INDATA) enddcl();
19425738Sdonn		  parstate = INEXEC;
19522824Smckusick		  if( yystno != 0 && thislabel->labtype != LABFORMAT)
19622824Smckusick			if (optimflag)
19722824Smckusick				optbuff (SKLABEL, 0, thislabel->labelno, 1);
19822824Smckusick			else
19922824Smckusick				putlabel(thislabel->labelno);
20022824Smckusick		  yystno = 0;
20122824Smckusick		}
20222824Smckusick	;
20322824Smckusick
20422824Smckusickintonlyon:
20522824Smckusick		{ intonly = YES; }
20622824Smckusick	;
20722824Smckusick
20822824Smckusickintonlyoff:
20922824Smckusick		{ intonly = NO; }
21022824Smckusick	;
211