%token SEOS 1
%token SCOMMENT 2
%token SLABEL 3
%token SUNKNOWN 4
%token SHOLLERITH 5
%token SICON 6
%token SRCON 7
%token SDCON 8
%token SBITCON 9
%token SOCTCON 10
%token SHEXCON 11
%token STRUE 12
%token SFALSE 13
%token SNAME 14
%token SNAMEEQ 15
%token SFIELD 16
%token SSCALE 17
%token SINCLUDE 18
%token SLET 19
%token SASSIGN 20
%token SAUTOMATIC 21
%token SBACKSPACE 22
%token SBLOCK 23
%token SCALL 24
%token SCHARACTER 25
%token SCLOSE 26
%token SCOMMON 27
%token SCOMPLEX 28
%token SCONTINUE 29
%token SDATA 30
%token SDCOMPLEX 31
%token SDIMENSION 32
%token SDO 33
%token SDOUBLE 34
%token SELSE 35
%token SELSEIF 36
%token SEND 37
%token SENDFILE 38
%token SENDIF 39
%token SENTRY 40
%token SEQUIV 41
%token SEXTERNAL 42
%token SFORMAT 43
%token SFUNCTION 44
%token SGOTO 45
%token SASGOTO 46
%token SCOMPGOTO 47
%token SARITHIF 48
%token SLOGIF 49
%token SIMPLICIT 50
%token SINQUIRE 51
%token SINTEGER 52
%token SINTRINSIC 53
%token SLOGICAL 54
%token SNAMELIST 55
%token SOPEN 56
%token SPARAM 57
%token SPAUSE 58
%token SPRINT 59
%token SPROGRAM 60
%token SPUNCH 61
%token SREAD 62
%token SREAL 63
%token SRETURN 64
%token SREWIND 65
%token SSAVE 66
%token SSTATIC 67
%token SSTOP 68
%token SSUBROUTINE 69
%token STHEN 70
%token STO 71
%token SUNDEFINED 72
%token SWRITE 73
%token SLPAR 74
%token SRPAR 75
%token SEQUALS 76
%token SCOLON 77
%token SCOMMA 78
%token SCURRENCY 79
%token SPLUS 80
%token SMINUS 81
%token SSTAR 82
%token SSLASH 83
%token SPOWER 84
%token SCONCAT 85
%token SAND 86
%token SOR 87
%token SNEQV 88
%token SEQV 89
%token SNOT 90
%token SEQ 91
%token SLT 92
%token SGT 93
%token SLE 94
%token SGE 95
%token SNE 96
%token SENDDO 97
%token SWHILE 98
%token SSLASHD 99
%token SENTERTASKING 100
%token SEXITTASKING 101
%token SINPUT 102
%token SOUTPUT 103
%token SPROCESSOR 104
%token STEMPLATE 105
%token SALIGN 106
%token SWITH 107
%token SDISTRIBUTE 108
%token SDBLOCK 109
%token SDCYCLIC 110
%token SDBLCYC 111
%token SPDO 112
%token SPINOUT 113
%token SPIN 114
%token SPOUT 115
%token SPMERGEVARS 116
%token SPCOMMUTATIVE 117
%token SPINIT 118
%token SPBODY 119
%token SPMERGE 120
%token SENDPDO 121
%token SLOCAL 122
%token SENDLOCAL 123
%token SORIGIN 124
%token SWHERE 125
%token SELSEWHERE 126
%token SENDWHERE 127
%token SLOCALDIST 128
%token SINHERIT 129
%token SNOCHECK 130
%token SCONFORM 131
%token SCOPYIN 132
%token SCOPYOUT 133
%token SIDXPERM 134
%token SBREAKDIST 135
%token SREPLICATE 136
%token SNODP 137
%token SENDNODP 138
%token SPREAD 139
%token SPWRITE 140
%token STASK_PARTITION 141
%token SSUBGROUP 142
%token SBEGINTASK_REGION 143
%token SENDTASK_REGION 144
%token SONSUBGROUP 145
%token SENDONSUBGROUP 146
/* $Source: /iwarp/member/fx/build/src/RCS/gram.head,v $  $Revision: 1.30 $ $Date: 96/11/07 17:04:39 $ $State: Exp $ $Author: stichnot $ */

/****************************************************************
Copyright 1990 by AT&T Bell Laboratories, Bellcore.

Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T Bell Laboratories or
Bellcore or any of their entities not be used in advertising or
publicity pertaining to distribution of the software without
specific, written prior permission.

AT&T and Bellcore disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness.  In no event shall AT&T or Bellcore be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
this software.
****************************************************************/

%{
#include "defs.h"
#include "stmtdefs.h"
#include "distribute.h"
#include "targetarch.h"
#include "error.fn.h"
#include "stmt.fn.h"
#include "lex.fn.h"
#include "main.fn.h"
#include "proc.fn.h"
#include "misc.fn.h"
#include "exec.fn.h"
#include "io.fn.h"
#include "data.fn.h"
#include "expr.fn.h"
#include "init.fn.h"
#include "f77ize.misc.fn.h"
#include "distribute.fn.h"
#include "group.h"

#define YYDEBUG 1

static void __stupid__(char *dumb)
{
  static char rcsid[] = "$Header: /iwarp/member/fx/build/src/RCS/gram.head,v 1.30 96/11/07 17:04:39 stichnot Exp $";
  __stupid__(rcsid);
}

static int nstars;			/* Number of labels in an
					   alternate return CALL */
static int ndim;
static int vartype;
int new_dcl;
static ftnint varleng;
static struct Dims dims[MAXDIM+1];
static struct Labelblock *labarray[MAXLABLIST];	/* Labels in an alternate
						   return CALL */

/* The next two variables are used to verify that each statement might be reached
   during runtime.   lastwasbranch   is tested only in the defintion of the
   stat:   nonterminal. */

int lastwasbranch = NO;
static int thiswasbranch = NO;
extern ftnint yystno;
extern flag intonly;
static chainp datastack;
extern long laststfcn, thisstno;
extern int can_include;	/* for netlib */
extern chainp inherit_list, nocheck_list, conform_list;
extern chainp copyin_list, copyout_list;
extern int needwith;
extern int fixtype_allow_impldo;

slicep mkslice();  /* Added by JMS */
ftnint convci();
Addrp nextdata();
expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
expptr mkcxcon();
struct Listblock *mklist();
struct Listblock *mklist();
struct Impldoblock *mkiodo();
Extsym *comblock();
chainp mergelist();
#define ESNULL (Extsym *)0
#define NPNULL (Namep)0
#define LBNULL (struct Listblock *)0
extern void freetemps(), make_param();
extern expptr exequals();
extern void printprogram();
extern Stmtp exdo();
extern Stmtp exenddo();
extern Stmtp exendif2();
extern expptr exif();
extern Stmtp  exelif();
extern Stmtp  exelse();
extern expptr excall();
extern expptr exreturn();
extern Stmtp exgoto();
extern Listp extaskio();
extern void apply_idxperm();
extern chainp ioclause();

Listp  tempxy;
 static void
pop_datastack() {
	chainp d0 = datastack;
	if (d0->datap)
		curdtp = (chainp)d0->datap;
	datastack = d0->nextp;
	d0->nextp = 0;
	frchain(&d0);
	}

%}

/* Specify precedences and associativities. */

%union	{
	int ival;
	ftnint lval;
	char *charpval;
	chainp chval;
	tagptr tagval;
	expptr expval;
        Stmtp  stmtval;
	struct Labelblock *labval;
	struct Nameblock *namval;
	struct Eqvchain *eqvval;
	Extsym *extval;
        slicep sliceval;  /* Added by JMS */
	}

%left SCOMMA
%nonassoc SCOLON
%right SEQUALS
%left SEQV SNEQV
%left SOR
%left SAND
%left SNOT
%nonassoc SLT SGT SLE SGE SEQ SNE
%left SCONCAT
%left SPLUS SMINUS
%left SSTAR SSLASH
%right SPOWER

%start program
%type <labval> thislabel label assignlabel
%type <tagval> other inelt iodospec
%type <ival> type typespec typename dcl letter addop relop nameeq integer
%type <lval> lengspec 
%type <charpval> filename
%type <chval> datavar datavarlist namelistlist funarglist funargs vallist val
%type <chval> dospec dospecw pdospec
%type <chval> callarglist arglist args exprlist inlist outlist out2 substring
%type <namval> name arg call var subgroup
%type <namval> opt_parenthesized_name, opt_name
%type <expval> lhs xlhs expr uexpr opt_expr fexpr unpar_fexpr logif
%type <expval> ubound simple value callarg complex_const simple_const bit_const
%type <extval> common comblock entryname progname
%type <eqvval> equivlist
%type <stmtval> iffable exec goto directive templatelist template
%type <stmtval> distributelist distribution
%type <sliceval> slice /* Added by JMS */
%type <expval>   procdim, b_c_optional_num_procs, bc_optional_num_procs
%type <chval> pair pairlist sizelist dpair dpairlist avarlist varlist 
%type <chval> aexp aexplist wvar subgrouplist
%type <charpval> avar
%type <chval> alignlhs alignlist intlist
%type <chval> ioctl ctllist ioclause infmt print
%type <ival> ctlkwd iofctl fmkwd iofmove
%type <stmtval> io io1

%%

program: 
	| program stat SEOS 
	;

stat:	  thislabel  entry
		{
/* stat:   is the nonterminal for Fortran statements */

		  lastwasbranch = NO; }
	| thislabel  spec {}
	| thislabel  exec
		{ /* forbid further statement function definitions... */
		  if (parstate == INDATA && laststfcn != thisstno)
			parstate = INEXEC;
		  thisstno++;
		  if($1 && ($1->labelno==dorange))
			enddo($1->labelno, $2);
		  if(lastwasbranch && thislabel==NULL)
			warn("statement cannot be reached");
		  lastwasbranch = thiswasbranch;
		  thiswasbranch = NO;
		  if($1)
			{
			if($1->labtype == LABFORMAT)
				err("label already that of a format");
			else
				$1->labtype = LABEXEC;
			}
		  /*
		   * added by jsp to detect legal FORTRAN statements,
		   * like STOP, PAUSE, WRITE, OPEN, READ, that the compiler
		   * just drops on the floor. This makes them much easier to
		   * find, since now we get a source line number instead of just
		   * a bus error.
		   */
		  if ($2 == NULL)
			warn ("statement not supported");

		  if ($1 != NULL)
                      process_labeled_statement($1, $2);

		  freetemps();
		}
	| thislabel SINCLUDE filename
		{ if (can_include)
			doinclude( $3 );
		  else {
			fprintf(diagfile, "Cannot open file %s\n", $3);
			done(1);
			}
		}
	| thislabel  SEND  end_spec
		{
                  Stmtp stmtp;
                  
                  if ($1)
			lastwasbranch = NO;
                  stmtp = mkaddstmt(S_END, NULL);
		  if ($1 != NULL)
                      process_labeled_statement($1, stmtp);
		  endproc(); /* lastwasbranch = NO; -- set in endproc() */
		}
	| thislabel SUNKNOWN
		{ extern void unclassifiable();
		  unclassifiable();

/* flline flushes the current line, ignoring the rest of the text there */

		  flline(); };
	| error
		{ flline();  needkwd = NO;  inioctl = NO;
		  yyerrok; yyclearin; }
	;

thislabel:  SLABEL
		{
		if(yystno != 0)
			{
			$$ = thislabel =  mklabel(yystno);
			if( ! headerdone ) {
				if (procclass == CLUNKNOWN)
					procclass = CLMAIN;
		                headerdone = YES;
				}
			if(thislabel->labdefined)
				execerr("label %s already defined",
					convic(thislabel->stateno) );
			else	{
				if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
				    && thislabel->labtype!=LABFORMAT)
					warn1("there is a branch to label %s from outside block",
					      convic( (ftnint) (thislabel->stateno) ) );
				thislabel->blklevel = blklevel;
				thislabel->labdefined = YES;
				if(thislabel->labtype != LABFORMAT)
				/*	p1_label((long)(thislabel - labeltab));  */ ;
				if (parstate < INDATA)
                                       earlylabs = mkchain((char *)
                                                 (long)(thislabel - labeltab), earlylabs);

				}
			}
		else    $$ = thislabel = NULL;
		}
	;
 
entry:	  SPROGRAM new_proc progname
		   {startproc($3, CLMAIN, S_PROGRAM); }
	| SPROGRAM new_proc progname progarglist
		   {	warn("ignoring arguments to main program");
			/* hashclear(); */
			startproc($3, CLMAIN, S_PROGRAM); }
	| SBLOCK new_proc progname
		{ if($3) NO66("named BLOCKDATA");
		  startproc($3, CLBLOCK, S_PROGRAM); }
	| SSUBROUTINE new_proc entryname arglist
		{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4,S_SUBROUTINE); }
	| SFUNCTION new_proc entryname arglist
		{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4, S_FUNCTION); }
	| type SFUNCTION new_proc entryname  lengspec arglist
		{  if ($5 > 0) varleng = $5;
	           entrypt(CLPROC, $1, varleng, $4, $6, S_FUNCTION); }
	| SENTRY entryname arglist
/* #ifdef SUPPORT_MULTIPLE_ENTRY	
		 { if(parstate==OUTSIDE || procclass==CLMAIN
			|| procclass==CLBLOCK)
				execerr("misplaced entry statement", CNULL);
		  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3, S_ENTRY);
		}
*/
		{ err("entry statement not supported");}
	;

new_proc:
		{ newproc(); }
	;

entryname:  name
		{ $$ = newentry($1, 1); }
	;

name:	  SNAME
		{ $$ = mkname(token); }
	;

progname:		{ $$ = NULL; }
	| entryname
	;

progarglist:
	  SLPAR SRPAR
	| SLPAR progargs SRPAR
	;

progargs: progarg
	| progargs SCOMMA progarg
	;

progarg:  SNAME
	| SNAME SEQUALS SNAME
	;

arglist:
		{ $$ = 0; }
	| SLPAR SRPAR
		{ NO66(" () argument list");
		  $$ = 0; }
	| SLPAR args SRPAR
		{$$ = $2; }
	;

args:	  arg
		{ $$ = ($1 ? mkchain((char *)$1,CHNULL) : CHNULL ); }
	| args SCOMMA arg
		{ if($3) $1 = $$ = mkchain((char *)$3, $1); }
	;

arg:	  name
		{ if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
			dclerr("name declared as argument after use", $1);
		  $1->vstg = STGARG;
		}
	| SSTAR
		{ NO66("altenate return argument");

/* substars   means that '*'ed formal parameters should be replaced.
   This is used to specify alternate return labels; in theory, only
   parameter slots which have '*' should accept the statement labels.
   This compiler chooses to ignore the '*'s in the formal declaration, and
   always return the proper value anyway.

   This variable is only referred to in   proc.c   */

		  $$ = 0;  substars = YES; }
	;



filename:   SHOLLERITH
		{
		char *s;
		s = copyn(toklen+1, token);
		s[toklen] = '\0';
		$$ = s;
		}
	;
/* $Source: /iwarp/member/fx/build/src/RCS/gram.dcl,v $  $Revision: 1.9 $ $Date: 96/11/07 17:04:58 $ $State: Exp $ $Author: stichnot $ */

spec:	  dcl {}
	| common {}
	| external
	| intrinsic
	| equivalence
	| data
	| implicit
	| namelist
	| SSAVE
		{ NO66("SAVE statement");
		  saveall = YES; }
	| SSAVE savelist
		{ NO66("SAVE statement"); }
	| SFORMAT
		{ fmtstmt(thislabel); setfmt(thislabel);
		  mkaddstmt(S_FORMAT,(char *)thislabel); }
	| SPARAM in_dcl SLPAR paramlist SRPAR
		{ NO66("PARAMETER statement"); }
	;

dcl:	  type opt_comma name in_dcl new_dcl dims lengspec
		{ settype($3, $1, $7);
		  if(ndim>0) setbound($3,ndim,dims);
		}
	| dcl SCOMMA name dims lengspec
		{ settype($3, $1, $5);
		  if(ndim>0) setbound($3,ndim,dims);
		}
	| dcl SSLASHD datainit vallist SSLASHD
		{ if (new_dcl == 2) {
			err("attempt to give DATA in type-declaration");
			new_dcl = 1;
			}
		}
	;

new_dcl:	{ new_dcl = 2; }

type:	  typespec lengspec
		{ varleng = $2;
		  if (vartype == TYLOGICAL && varleng == 1) {
			varleng = 0;
			err("treating LOGICAL*1 as LOGICAL");
			--nerr;	/* allow generation of .c file */
			}
		}
	;

typespec:  typename
		{ varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]);
		  vartype = $1; }
	;

typename:    SINTEGER	{ $$ = TYLONG; }
	| SREAL		{ $$ = tyreal; }
	| SCOMPLEX	{ ++complex_seen; $$ = TYCOMPLEX; }
	| SDOUBLE	{ $$ = TYDREAL; }
	| SDCOMPLEX	{ ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
	| SLOGICAL	{ $$ = TYLOGICAL; }
	| SCHARACTER	{ NO66("CHARACTER statement"); $$ = TYCHAR; }
	| SUNDEFINED	{ $$ = TYUNKNOWN; }
	| SDIMENSION	{ $$ = TYUNKNOWN; }
	| SAUTOMATIC	{ NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
	| SSTATIC	{ NOEXT("STATIC statement"); $$ = - STGBSS; }
	;

lengspec:
		{ $$ = varleng; }
	| SSTAR intonlyon expr intonlyoff
		{
		expptr p;
		p = $3;
		NO66("length specification *n");
		if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
			{
			$$ = 0;
			dclerr("length must be a positive integer constant",
				NPNULL);
			}
		else {
			if (vartype == TYCHAR)
				$$ = p->constblock.Const.ci;
			else switch((int)p->constblock.Const.ci) {
				case 1:	$$ = 1; break;
				case 2: $$ = typesize[TYSHORT];	break;
				case 4: $$ = typesize[TYLONG];	break;
				case 8: $$ = typesize[TYDREAL];	break;
				case 16: $$ = typesize[TYDCOMPLEX]; break;
				default:
					dclerr("invalid length",NPNULL);
					$$ = varleng;
				}
			}
		}
	| SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
		{ NO66("length specification *(*)"); $$ = -1; }
	;

common:	  SCOMMON in_dcl var
		{ incomm( $$ = comblock("") , $3 ); }
	| SCOMMON in_dcl comblock var
		{ $$ = $3;  incomm($3, $4); }
	| common opt_comma comblock opt_comma var
		{ $$ = $3;  incomm($3, $5); }
	| common SCOMMA var
		{ incomm($1, $3); }
	;

comblock:  SCONCAT
		{ $$ = comblock(""); }
	| SSLASH SNAME SSLASH
		{ $$ = comblock(token); }
	;

external: SEXTERNAL in_dcl name
		{ setext($3); }
	| external SCOMMA name
		{ setext($3); }
	;

/* Ignore intrinsic declaration     jss 8/92       */
/* Could treat them like externals alternately.... */
intrinsic:  SINTRINSIC in_dcl name
/*		{ NO66("INTRINSIC statement"); setintr($3); }   */
	| intrinsic SCOMMA name
/*		{ setintr($3); }  */
	;

equivalence:  SEQUIV in_dcl equivset
	| equivalence SCOMMA equivset
	;

equivset:  SLPAR equivlist SRPAR
		{
		struct Equivblock *p;
		if(nequiv >= maxequiv)
			many("equivalences", 'q', maxequiv);
		p  =  & eqvclass[nequiv++];
		p->eqvinit = NO;
		p->eqvbottom = 0;
		p->eqvtop = 0;
		p->equivs = $2;
		}
	;

equivlist:  lhs
		{ $$=ALLOC(Eqvchain);
		  $$->eqvitem.eqvlhs = (struct Primblock *)$1;
		}
	| equivlist SCOMMA lhs
		{ $$=ALLOC(Eqvchain);
		  $$->eqvitem.eqvlhs = (struct Primblock *) $3;
		  $$->eqvnextp = $1;
		}
	;

data:	  SDATA in_data datalist
	| data opt_comma datalist
	;

in_data:
		{ if(parstate == OUTSIDE)
			{
			newproc();
			startproc(ESNULL, CLMAIN, 0/*wrong*/);
			}
		  if(parstate < INDATA)
			{
			enddcl();
			parstate = INDATA;
			}
		}
	;

datalist:  datainit datavarlist SSLASH datapop vallist SSLASH
		{ ftnint junk;
		  extern chainp data_stmt_list;
		  if(nextdata(&junk) != NULL)
			err("too few initializers");
		  frrpl();
/* Would like to return something like <$2, $5> */
		  data_stmt_list = hookup(data_stmt_list,
				mkchain(mkchain($2,mkchain($5,NULL)),NULL));
		}
	;

datainit: /* nothing */ { frchain(&datastack); curdtp = 0; }

datapop: /* nothing */ { pop_datastack(); }

vallist:  { toomanyinit = NO; }  val
		{ $$ = mkchain($2,NULL); }
	| vallist SCOMMA val
		{ $$ = hookup($1,mkchain($3,NULL)); }
	;

val:	  value
		{ dataval(ENULL, $1); $$ = mkchain(NULL,mkchain($1,NULL)); }
	| simple SSTAR value
		{ dataval($1, $3); $$ = mkchain($1,mkchain($3,NULL)); }
	;

value:	  simple
	| addop simple
		{ if( $1==OPMINUS && ISCONST($2) )
			consnegop((Constp)$2);
		  $$ = $2;
		}
	| complex_const
	;

savelist: saveitem
	| savelist SCOMMA saveitem
	;

saveitem: name
		{ int k;
		  $1->vsave = YES;
		  k = $1->vstg;
		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
			dclerr("can only save static variables", $1);
		}
	| comblock {}
	;

paramlist:  paramitem
	| paramlist SCOMMA paramitem
	;

paramitem:  name SEQUALS expr
		{ if($1->vclass == CLUNKNOWN)
			make_param((struct Paramblock *)$1, $3);
		  else dclerr("cannot make into parameter", $1);
		}
	;

var:	  name dims
		{ if(ndim>0) setbound($1, ndim, dims); }
	;

datavar:	  lhs
		{ Namep np;
		  np = ( (struct Primblock *) $1) -> namep;
		  vardcl(np);
		  if(np->vstg == STGCOMMON)
			extsymtab[np->vardesc.varno].extinit = YES;
		  else if(np->vstg==STGEQUIV)
			eqvclass[np->vardesc.varno].eqvinit = YES;
		  else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
			dclerr("inconsistent storage classes", np);
		  $$ = mkchain((char *)$1, CHNULL);
		}
	| SLPAR datavarlist SCOMMA dospec SRPAR
		{ chainp p; struct Impldoblock *q;
		pop_datastack();
		q = ALLOC(Impldoblock);
		q->tag = TIMPLDO;
		(q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
		p = $4->nextp;
		if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
		if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
		if(p)  { q->impstep = (expptr)(p->datap); }
		frchain( & ($4) );
		$$ = mkchain((char *)q, CHNULL);
		q->datalist = hookup($2, $$);
		q->impdospec = NULL;
		}
	;

datavarlist: datavar
		{ if (!datastack)
			curdtp = 0;
		  datastack = mkchain((char *)curdtp, datastack);
		  curdtp = $1; curdtelt = 0;
		  }
	| datavarlist SCOMMA datavar
		{ $$ = hookup($1, $3); }
	;

dims:
		{ ndim = 0; }
	| SLPAR dimlist SRPAR
	;

dimlist:   { ndim = 0; }   dim
	| dimlist SCOMMA dim
	;

dim:	  ubound
		{
		  if(ndim == maxdim)
			err("too many dimensions");
		  else if(ndim < maxdim)
			{ dims[ndim].lb = 0;
			  dims[ndim].ub = $1;
			}
		  ++ndim;
		}
	| expr SCOLON ubound
		{
		  if(ndim == maxdim)
			err("too many dimensions");
		  else if(ndim < maxdim)
			{ dims[ndim].lb = $1;
			  dims[ndim].ub = $3;
			}
		  ++ndim;
		}
	;

ubound:	  SSTAR
		{ $$ = 0; }
	| expr
	;

labellist: label
		{ nstars = 1; labarray[0] = $1; }
	| labellist SCOMMA label
		{ if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
	;

label:	  SICON
		{ $$ = execlab( convci(toklen, token) ); }
	;

implicit:  SIMPLICIT in_dcl implist
		{ NO66("IMPLICIT statement"); }
	| implicit SCOMMA implist
	;

implist:  imptype SLPAR letgroups SRPAR
	| imptype
		{ if (vartype != TYUNKNOWN)
			dclerr("-- expected letter range",NPNULL);
		  setimpl(vartype, varleng, 'a', 'z'); }
	;

imptype:   { needkwd = 1; } type
		/* { vartype = $2; } */
	;

letgroups: letgroup
	| letgroups SCOMMA letgroup
	;

letgroup:  letter
		{ setimpl(vartype, varleng, $1, $1); }
	| letter SMINUS letter
		{ setimpl(vartype, varleng, $1, $3); }
	;

letter:  SNAME
		{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
			{
			dclerr("implicit item must be single letter", NPNULL);
			$$ = 0;
			}
		  else $$ = token[0];
		}
	;

namelist:	SNAMELIST
	| namelist namelistentry
	;

namelistentry:  SSLASH name SSLASH namelistlist
		{
		if($2->vclass == CLUNKNOWN)
			{
			$2->vclass = CLNAMELIST;
			$2->vtype = TYINT;
			$2->vstg = STGBSS;
			$2->varxptr.namelist = $4;
			$2->vardesc.varno = ++lastvarno;
			}
		else dclerr("cannot be a namelist name", $2);
		}
	;

namelistlist:  name
		{ $$ = mkchain((char *)$1, CHNULL); }
	| namelistlist SCOMMA name
		{ $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
	;

in_dcl:
		{ switch(parstate)
			{
			case OUTSIDE:	newproc();
					startproc(ESNULL, CLMAIN, 0/*wrong*/);
			case INSIDE:	parstate = INDCL;
			case INDCL:	break;

			case INDATA:
				errstr(
				"Statement order error: declaration after DATA",
					CNULL);
				break;

			default:
				dclerr("declaration among executables", NPNULL);
			}
		}
	;
funarglist:
		{ $$ = 0; }
	| funargs
		{ $$ = revchain($1); }
	;

funargs:  expr
		{ $$ = mkchain((char *)$1, CHNULL); }
	| funargs SCOMMA expr
		{ $$ = mkchain((char *)$3, $1); }
	;

integer: SICON
		{ $$ = convci(toklen,token); }
	;

intlist: integer
		{ $$ = mkchain((void*)$1,NULL); }
	| intlist SCOMMA integer
		{ $$ = mkchain((void*)$3,$1); }
	;

expr:	  uexpr
	| SLPAR expr SRPAR	{ $$ = $2; }
	| SIDXPERM SLPAR expr SCOMMA intlist SRPAR
		{ apply_idxperm($3,revchain($5)); $$ = $3; }
	| complex_const
	;

uexpr:	  lhs
	| simple_const
	| expr addop expr   %prec SPLUS
		{ $$ = mkexpr($2, $1, $3); }
	| expr SSTAR expr
		{ $$ = mkexpr(OPSTAR, $1, $3); }
	| expr SSLASH expr
		{ $$ = mkexpr(OPSLASH, $1, $3); }
	| expr SPOWER expr
		{ $$ = mkexpr(OPPOWER, $1, $3); }
	| addop expr  %prec SSTAR
		{ if($1 == OPMINUS)
			$$ = mkexpr(OPNEG, $2, ENULL);
		  else 	$$ = $2;
		}
	| expr relop expr  %prec SEQ
		{ $$ = mkexpr($2, $1, $3); }
	| expr SEQV expr
		{ NO66(".EQV. operator");
		  $$ = mkexpr(OPEQV, $1,$3); }
	| expr SNEQV expr
		{ NO66(".NEQV. operator");
		  $$ = mkexpr(OPNEQV, $1, $3); }
	| expr SOR expr
		{ $$ = mkexpr(OPOR, $1, $3); }
	| expr SAND expr
		{ $$ = mkexpr(OPAND, $1, $3); }
	| SNOT expr
		{ $$ = mkexpr(OPNOT, $2, ENULL); }
	| expr SCONCAT expr
		{ NO66("concatenation operator //");
		  $$ = mkexpr(OPCONCAT, $1, $3); }
	;

addop:	  SPLUS		{ $$ = OPPLUS; }
	| SMINUS	{ $$ = OPMINUS; }
	;

relop:	  SEQ	{ $$ = OPEQ; }
	| SGT	{ $$ = OPGT; }
	| SLT	{ $$ = OPLT; }
	| SGE	{ $$ = OPGE; }
	| SLE	{ $$ = OPLE; }
	| SNE	{ $$ = OPNE; }
	;


 /*
  * HACK warning:
  *   Since the substring syntax conflicts with the 
  *   array slice syntax, we first treat one dim character array
  *   references like
  *           a(1:2)
  *   as array slice syntax.  Then mkprim() takes a look at the
  *   declaration of array to see which one is appropriate
  *
  *   Note that references like a(1:2)(3:4) will be parsed correctly
  *   because there is no ambiguity in the syntax
  */
 
lhs:	 name
		{ $$ = mkprim($1, LBNULL, CHNULL); }
/* Substring syntax removed by JMS
	| name substring
		{ NO66("substring operator :");
		  $$ = mkprim($1, LBNULL, $2); }
*/
	| name SLPAR funarglist SRPAR
		{ $$ = mkprim($1, mklist($3), CHNULL); }
/* More substring syntax --JMS */
	| name SLPAR funarglist SRPAR substring
		{ NO66("substring operator :");
		  $$ = mkprim($1, mklist($3), $5); }
	;

xlhs:	lhs
	| SIDXPERM SLPAR xlhs SCOMMA intlist SRPAR
		{ apply_idxperm($3,revchain($5)); $$ = $3; }
	;

substring:  SLPAR opt_expr SCOLON opt_expr SRPAR
		{ $$ = mkchain((char *)$2, mkchain((char *)$4,CHNULL)); }
	;

opt_expr:
		{ $$ = 0; }
	| expr
	;

simple:	  name
		{ if($1->vclass == CLPARAM)
			$$ = (expptr) cpexpr(
				( (struct Paramblock *) ($1) ) -> paramval);
		}
	| simple_const
	;

simple_const:   STRUE	{ $$ = mklogcon(1); }
	| SFALSE	{ $$ = mklogcon(0); }
	| SHOLLERITH  { $$ = mkstrcon(toklen, token); }
	| SICON	= { $$ = mkintcon( convci(toklen, token) ); }
	| SRCON	= { $$ = mkrealcon(tyreal, token); }
	| SDCON	= { $$ = mkrealcon(TYDREAL, token); }
	| bit_const
	;

complex_const:  SLPAR uexpr SCOMMA uexpr SRPAR
		{ $$ = mkcxcon($2,$4); }
	;

bit_const:  SHEXCON
		{ NOEXT("hex constant");
		  $$ = mkbitcon(4, toklen, token); }
	| SOCTCON
		{ NOEXT("octal constant");
		  $$ = mkbitcon(3, toklen, token); }
	| SBITCON
		{ NOEXT("binary constant");
		  $$ = mkbitcon(1, toklen, token); }
	;

fexpr:	  unpar_fexpr
	| SLPAR fexpr SRPAR
		{ $$ = $2; }
	;

unpar_fexpr:	  lhs
	| simple_const
	| fexpr addop fexpr   %prec SPLUS
		{ $$ = mkexpr($2, $1, $3); }
	| fexpr SSTAR fexpr
		{ $$ = mkexpr(OPSTAR, $1, $3); }
	| fexpr SSLASH fexpr
		{ $$ = mkexpr(OPSLASH, $1, $3); }
	| fexpr SPOWER fexpr
		{ $$ = mkexpr(OPPOWER, $1, $3); }
	| addop fexpr  %prec SSTAR
		{ if($1 == OPMINUS)
			$$ = mkexpr(OPNEG, $2, ENULL);
		  else	$$ = $2;
		}
	| fexpr SCONCAT fexpr
		{ NO66("concatenation operator //");
		  $$ = mkexpr(OPCONCAT, $1, $3); }
	;


/* The following is added to account for slices. -- JMS */
slice:	opt_expr SCOLON opt_expr SCOLON expr
		{ $$ = mkslice($1,$3,$5); }
	| opt_expr SCOLON opt_expr
		{ $$ = mkslice($1,$3,ENULL); }
	;

funargs: slice
		{ $$ = mkchain((char *)$1, CHNULL); }
	| funargs SCOMMA slice
		{ $$ = mkchain((char *)$3, $1); }
	;


/* opt_parenthesized_name and opt_name are added by bwolen */	
opt_parenthesized_name:
                { $$ = NULL; }
	| SLPAR name SRPAR
                { $$ = $2; }
        ;

opt_name:
                { $$ = NULL; }
	| name 
                { $$ = $1; }
        ;
	/* $Source: /iwarp/member/fx/build/src/RCS/gram.exec,v $  $Revision: 1.53 $ $Date: 97/01/09 21:59:37 $ $State: Exp $ $Author: stichnot $ */

exec:	  iffable  { /* addstmt($1); */
                     $$ = $1; }
	| SDO end_spec intonlyon label intonlyoff opt_comma dospecw
		{
		if($4->labdefined)
			execerr("no backward DO loops", CNULL);
		$4->nEndDos++;
		$4->blklevel = blklevel+1;
		/*
		 * From now on, do loops has no labels.
		 */
		/* $$ = exdo($4 -> labelno,(int)($4->stateno), NPNULL, $7); */
		$$ = exdo($4->labelno, 0, NPNULL, $7);
		}
	| SDO end_spec opt_comma dospecw
		{
		$$ = exdo((int)(ctls - ctlstack - 2), 0, NPNULL, $4);
		NOEXT("DO without label");
		}
	| SENDDO
		{ $$ = exenddo(NPNULL); }
	| logif iffable
		{ exendif();  thiswasbranch = NO;
                  $$ = mkadd_ifstmt($1,$2);
                 }
	| logif STHEN  {$$ = ctlstack->ctlstmt = mkadd_ifblock($1);}
	| SELSEIF end_spec SLPAR expr SRPAR STHEN
		{ $$ = exelif($4); lastwasbranch = NO;
                }
	| SELSE end_spec
		{ $$ = exelse(); lastwasbranch = NO;
	        }
	| SENDIF end_spec
		{ $$ = exendif2(); lastwasbranch = NO;
		 }
	| directive
	 	{ $$ = $1;
		}
	;

logif:	  SLOGIF end_spec SLPAR expr SRPAR
		{ $$ = exif($4); }
	;

dospec:	  name SEQUALS exprlist
		{ $$ = mkchain((char *)$1, $3); }
	;

pdospec: name SEQUALS slice
		{
		 $3 = (slicep)fixtype((tagptr)$3);
		 $$ = mkchain(mkchain((char *)$1, mkchain($3, CHNULL)),
 			      CHNULL); }
	| pdospec SCOMMA name SEQUALS slice
		{$5 = (slicep)fixtype((tagptr)$5);
		 $$ = hookup($1, mkchain(mkchain((char *)$3,
		                                 mkchain($5, CHNULL)),
					 CHNULL));}
	;


dospecw:  dospec
	| SWHILE SLPAR expr SRPAR
		{ $$ = mkchain(CNULL, (chainp)$3); }
	;

directive: SENTERTASKING
		{
		  $$ = mkadd_taskstmt(S_ENTERTASKING, NULL);
                }

	| SEXITTASKING
		{
		  $$ = mkadd_taskstmt(S_EXITTASKING, NULL);
		}
	| SINPUT SLPAR exprlist SRPAR
	  	{
                   $$ = mkadd_taskstmt(S_INPUT, (char *) extaskio($3));
		}
	| SOUTPUT SLPAR exprlist SRPAR
		{ $$ = mkadd_taskstmt(S_OUTPUT,(char *) extaskio($3));
		}
	| SPROCESSOR SLPAR procdim SCOMMA procdim SRPAR SCOMMA
                     SLPAR procdim SCOMMA procdim SRPAR
		{ 
  switch (target_arch)
    {
      case arch_pvm:
warn("PVM version treats PROCESSOR(px,py,x,y) as PROCESSOR px*py");
$$=mkadd_processorstmt( cvalue($3)*cvalue($5),0,0,0);
        break;
      default:
$$ = mkadd_processorstmt( cvalue($3), cvalue($5), cvalue($9), cvalue($11));
        break;
    }
		}
        |SPROCESSOR SLPAR procdim SCOMMA procdim SRPAR
		{
  switch (target_arch)
    {
      case arch_pvm:
warn("PVM version treats PROCESSOR(px,py) as PROCESSOR px*py");
$$ = mkadd_processorstmt( cvalue($3)*cvalue($5), 0,0,0);
        break;
      default:
$$ = mkadd_processorstmt( cvalue($3), cvalue($5), 0,0);
        break;
    }
                }

/* This is for the general case where shape shouldn't matter - PAD */
/* Right now, it will only work for PVM - no origin statement is needed */

        | SPROCESSOR procdim
                { 
  switch (target_arch)
    {
      case arch_pvm:
$$ = mkadd_processorstmt(cvalue($2),0,0,0);
        break;
      default:
warn("PROCESSOR p directive used in non-PVM version");
$$ = mkadd_processorstmt(cvalue($2),1,0,0);
        break;
    }
                }

	| SREPLICATE procdim
	        {
  switch (target_arch)
    {
      case arch_pvm:
{
   int stupiddumbvariable=cvalue($2);
   $$=mkadd_taskstmt(S_REPLICATE,&stupiddumbvariable);
}
        break;
      default:
   warn("REPLICATE directive used in non-PVM version - ignored");
        break;
    }
                }

	| SORIGIN pairlist
	        {
  switch (target_arch)
    {
      case arch_iwarp:
   $$ = mkadd_taskstmt(S_ORIGIN,conv_pairlist($2));
        break;
      default:
   warn("ORIGIN statement is ignored in PVM version");
        break;
    }
                }
	| STEMPLATE templatelist
		{ $$ = $2; }
	| SALIGN alignlist SWITH avar SLPAR aexplist SRPAR
		{ chainp search, tmp=revchain($6);
		  for (search=$2;search!=NULL;search=search->nextp) {
			chainp alignlhs = (chainp) search->datap;
			$$ = mkaddstmt(S_ALIGN,
			  conv_add_alignment((Namep)alignlhs->datap,$4,
					     revchain(alignlhs->nextp->datap),
					     tmp)); }
		}
	| SDISTRIBUTE distributelist
		{ $$ = $2; }
	| SINHERIT varlist
		{ inherit_list = hookup(inherit_list,$2);
		  $$ = mkaddstmt(S_INHERIT, $2); }
	| SNOCHECK varlist
		{ nocheck_list = hookup(nocheck_list,$2);
		  $$ = mkaddstmt(S_NOCHECK, $2); }
	| SNOCHECK
		{ extern Boolean nocheckall; nocheckall = TRUE;
		  $$ = mkaddstmt(S_NOCHECK, NULL); }
	| SCONFORM varlist
		{ conform_list = hookup(conform_list,$2);
		  $$ = mkaddstmt(S_CONFORM, $2); }
	| SCOPYIN varlist
		{ copyin_list = hookup(copyin_list,$2);
		  $$ = mkaddstmt(S_COPYIN, $2); }
	| SCOPYOUT varlist
		{ copyout_list = hookup(copyout_list,$2);
		  $$ = mkaddstmt(S_COPYOUT, $2); }

	| SPDO dospec
		{$$ = mkaddstmt(S_PDO, pdo_list_to_slice($2)); }
	| SPDO SLPAR pdospec SRPAR
		{$$ = mkaddstmt(S_PDO, $3); }
	| SPINOUT exprlist
	  	{ $$ = mkaddstmt(S_PINOUT, extaskio($2));
		}
	| SPMERGEVARS exprlist
	  	{ $$ = mkaddstmt(S_PMERGEVARS, extaskio($2));
		}
	| SPIN exprlist
	  	{ $$ = mkaddstmt(S_PIN, extaskio($2));
		}
	| SPOUT exprlist
	  	{ $$ = mkaddstmt(S_POUT, extaskio($2)); }
	| SPCOMMUTATIVE
	  	{ $$ = mkaddstmt(S_PCOMMUTATIVE, NULL);
		}
	| SPINIT
	  	{ $$ = mkaddstmt(S_PINIT, NULL);
		}
	| SPBODY
	  	{ $$ = mkaddstmt(S_PBODY, NULL);
		}
	| SPMERGE
	  	{ $$ = mkaddstmt(S_PMERGE, NULL);
		}
	| SLOCAL
		{ $$ = mkaddstmt(S_LOCAL, NULL); }
	| SENDLOCAL
		{ $$ = mkaddstmt(S_ENDLOCAL, NULL); }
	| SNODP
		{ $$ = mkaddstmt(S_NODP, NULL); }
	| SENDNODP
		{ $$ = mkaddstmt(S_ENDNODP, NULL); }
	| SENDPDO
		{ $$ = mkaddstmt(S_ENDPDO, NULL); }
	| SWHERE SLPAR expr SRPAR let lhs SEQUALS expr
		{ mkaddstmt(S_WHERE, fixexpr((Exprp)$3));
		  mkaddstmt(S_ASSIGN,
                            (exequals((struct Primblock *)$6, $8)));
		  $$ = mkaddstmt(S_ENDWHERE, NULL); }
	| SWHERE SLPAR expr SRPAR
		{ $$ = mkaddstmt(S_WHERE, fixexpr((Exprp)$3)); }
	| SELSEWHERE
		{ $$ = mkaddstmt(S_ELSEWHERE, NULL); }
	| SENDWHERE
		{ $$ = mkaddstmt(S_ENDWHERE, NULL); }
	| SLOCALDIST SLPAR exprlist SRPAR
		{ $$ = mkaddstmt(S_LOCALDIST, $3); }
	| SBREAKDIST 
		{ $$ = mkaddstmt(S_BREAKDIST, NULL); }
	| STASK_PARTITION opt_parenthesized_name SCOLON SCOLON subgrouplist
		{ $$ = mkaddstmt(S_TASK_PARTITION, mkchain($2, revchain($5)));
		  subgroup_setup_partition((chainp)($$->stmt));	
		}
	| SSUBGROUP SLPAR name SRPAR SCOLON SCOLON varlist
		{ subgroup_declare_vars($7, $3);
		  $$ = mkaddstmt(S_SUBGROUP, mkchain($3,revchain($7)));
		}
        | SBEGINTASK_REGION opt_name
	        { $$ = mkaddstmt(S_BEGINTASK_REGION, $2); }
        | SENDTASK_REGION 
	        { $$ = mkaddstmt(S_ENDTASK_REGION, NULL); }
        | SONSUBGROUP name 
	        { $$ = mkaddstmt(S_ONSUBGROUP, $2); }
        | SENDONSUBGROUP
	        { $$ = mkaddstmt(S_ENDONSUBGROUP, NULL); }
	;

				
subgrouplist: subgroup
 		{ $$ = mkchain($1, NULL);}
	| subgrouplist SCOMMA subgroup
		{ $$ = mkchain($3, $1);}
	;	

subgroup: name SLPAR procdim SRPAR
	{
	   subgroup_define_nProcs($1, $3);
	   $$ = $1;
	}
	;

alignlhs: name SLPAR avarlist SRPAR
		{ $$ = mkchain($1,mkchain($3,NULL)); needwith=1; }
	;

alignlist: alignlhs
		{ $$ = mkchain($1,NULL); }
	| alignlist SCOMMA {needwith=0;} alignlhs
		{ $$ = mkchain($4,$1); }
	;

distributelist: distribution
		{ $$ = $1; }
	| distributelist SCOMMA distribution
		{ $$ = $3; }
	;

distribution: avar SLPAR dpairlist SRPAR
		{ $$ = mkaddstmt(S_DISTRIBUTE,conv_add_distribute($1,revchain($3)));}
	;

templatelist: template
		{ $$ = $1; }
	| templatelist SCOMMA template
		{ $$ = $3; }
	;

template: avar SLPAR sizelist SRPAR
		{ $$ = mkaddstmt(S_TEMPLATE,conv_add_template($1,revchain($3)));}
	;

procdim: intonlyon expr intonlyoff
		{ /*if ($2->tag != TCONST)
			err("Expected constant expression");*/
		  $2 = fixtype($2);
		  if ($2->exprblock.vtype != TYLONG)
			err("Expected integer expression");
		  $$ = $2; }
	;

sizelist: procdim
		{ $$ = mkchain($1,CHNULL); }
	| sizelist SCOMMA procdim
		{ $$ = mkchain($3,$1); }
	;

dpairlist: {needkwd = 1;} dpair
		{ $$ = mkchain((char*)$2,CHNULL); }
	| dpairlist SCOMMA {needkwd = 1;} dpair
		{ $$ = mkchain((char*)$4,$1); }
	;

dpair:	SDBLOCK {needkwd=0;} b_c_optional_num_procs
		{ $$ = mkchain((char*)DIST_BLOCK,
		         mkchain((char*)NULL,
			   mkchain((char*)$3,CHNULL))); }
	| SDCYCLIC {needkwd=0;} b_c_optional_num_procs
		{ $$ = mkchain((char*)DIST_CYCLIC,
		         mkchain((char*)mkintcon(1),
			   mkchain((char*)$3,CHNULL))); }
	| SDBLCYC {needkwd=0;} SLPAR procdim bc_optional_num_procs SRPAR
		{ $$ = mkchain((char*)DIST_BLOCK_CYCLIC,
		         mkchain((char*)($4),mkchain((char*)($5),CHNULL))); }
	;


b_c_optional_num_procs: /* optional number of processors for block or cyclic */
		{ $$ = NULL; }
	| SLPAR procdim SRPAR
		{ $$ = $2; }
	;

bc_optional_num_procs: /* optional number of processors for block-cyclic */
	        { $$ = NULL; }
	| SCOMMA procdim
		{$$ = $2;}
	;	
		
pairlist: pair
		{ $$ = mkchain((char*)($1),CHNULL); }
	| pairlist SCOMMA pair
		{ $$ = mkchain((char*)($3),$1); }
	;

pair:	SLPAR procdim SCOMMA procdim SRPAR
		{ $$ = mkchain((char*)($2),mkchain((char*)($4),CHNULL)); }
	;

avarlist: wvar
		{ $$ = mkchain((char*)$1,CHNULL); }
	| avarlist SCOMMA wvar
		{ $$ = mkchain((char*)($3),$1); }
	;

wvar:	avar
		{ $$ = mkchain((char*)$1,mkchain((char*)mkintcon(0),mkchain((char*)mkintcon(0),CHNULL))); }
	| avar SMINUS procdim SCOLON avar SPLUS procdim
		{ $$ = mkchain((char*)$1,mkchain((char*)mkexpr(OPNEG,$3,NULL),mkchain((char*)($7),CHNULL))); }
	;

avar:	SNAME
		{ $$ = strdup(token); }

aexplist: aexp
		{ $$ = mkchain((char*)$1,CHNULL); }
	| aexplist SCOMMA aexp
		{ $$ = mkchain((char*)($3),$1); }
	;

aexp:	avar SPLUS procdim
		{ $$ = mkchain((char*)$1,mkchain((char*)$3,CHNULL)); }
	| avar
		{ $$ = mkchain((char*)$1,mkchain((char*)mkintcon(0),CHNULL)); }
	| procdim
		{ $$ = mkchain((char*)0,mkchain((char*)$1,CHNULL)); }
	| avar SMINUS procdim
		{ $$ = mkchain((char*)$1,mkchain((char*)mkexpr(OPNEG,$3,NULL),CHNULL)); }
	;

iffable:  let xlhs SEQUALS expr
		{$$ = mkaddstmt(S_ASSIGN,
                            (char *) (exequals((struct Primblock *)$2, $4))); }
	| SASSIGN end_spec assignlabel STO name
		{ exassign($5, $3);
                  $$ = STNULL; }
	| SCONTINUE end_spec{$$=mkaddstmt(S_CONTINUE,(char *) NULL);}
	| goto
/*	| io_stmt
		{ $$ = $1; }*/
	| io
		{ inioctl = NO;
		  $$ = $1;
                }
	| SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
		{ exarif($4, $6, $8, $10);  thiswasbranch = YES;
		  $$ = STNULL;
		 }
 	| call
		{ $$ = mkadd_taskstmt(S_CALL,excall($1, LBNULL, 0, labarray));
		  }
	| call SLPAR SRPAR
		{ $$ = mkadd_taskstmt(S_CALL,excall($1, LBNULL, 0, labarray)); }
	| call SLPAR callarglist SRPAR
		{ if(nstars < MAXLABLIST)
		      $$ = mkadd_taskstmt(S_CALL,
                      excall($1, mklist(revchain($3)), nstars, labarray));
		  else
		  {
		      err("too many alternate returns");
             	      $$ = STNULL;
		  }
		}
	| SRETURN end_spec 
		{ $$ = mkaddstmt(S_RETURN, NULL);
                  thiswasbranch = YES;
                }
	| SPAUSE end_spec opt_expr
		{ exstop(0, $3);  thiswasbranch = 0;
                  $$ = mkaddstmt(S_PAUSE,$3);
                }
	| SSTOP end_spec opt_expr
		{ exstop(1, $3);  thiswasbranch = 1;
                  $$ = mkaddstmt(S_STOP,$3);
                }
	;

assignlabel:   SICON
		{ $$ = mklabel( convci(toklen, token) ); }
	;

let:	  SLET
		{ if(parstate == OUTSIDE)
			{
			newproc();
			startproc(ESNULL, CLMAIN, 0/*wrong*/);
			}
		}
	;

goto:	  SGOTO end_spec label
		{ $$ = exgoto($3);  thiswasbranch = YES; }
	| SASGOTO end_spec name
	        {$$ = NULL; /* not supported */}
	| SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
	        {$$ = NULL; /* not supported */}
	| SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
	        {$$ = NULL; /* not supported */}
	;

opt_comma:
	| SCOMMA
	;

call:	  SCALL end_spec name
		{ nstars = 0; $$ = $3; }
	;

callarglist:  callarg
		{ $$ = $1 ? mkchain((char *)$1,CHNULL) : CHNULL; }
	| callarglist SCOMMA callarg
		{ $$ = $3 ? mkchain((char *)$3, $1) : $1; }
	;

callarg:  expr
	;

/*stop:	  SPAUSE
		{ $$ = mkaddstmt(S_PAUSE,NULL); }
	| SSTOP
		{ $$ = mkaddstmt(S_STOP,NULL); }
	;*/

exprlist:  expr
		{ $$ = mkchain((char *)$1, CHNULL); }
	| exprlist SCOMMA expr
		{ $$ = hookup($1, mkchain((char *)$3,CHNULL) ); }
	;

varlist: name
		{ $$ = mkchain((char *)$1, CHNULL); }
	| varlist SCOMMA name
		{ $$ = mkchain((char *)$3, $1); }
	;

end_spec:
		{ if(parstate == OUTSIDE)
			{
			newproc();
			startproc(ESNULL, CLMAIN, 0/*wrong*/);
			}

/* This next statement depends on the ordering of the state table encoding */

		  if(parstate < INDATA) enddcl();
		}
	;

intonlyon:
		{ intonly = YES; }
	;

intonlyoff:
		{ intonly = NO; }
	;
/* $Source: /iwarp/member/fx/build/src/RCS/gram.io,v $  $Revision: 1.9 $ $Date: 97/01/09 21:59:38 $ $State: Exp $ $Author: stichnot $ */

  /*  Input/Output Statements */

/*io_stmt: jims_print
	{ $$ = $1; }
	;*/

/*jims_print: SPRINT end_spec SSTAR SCOMMA exprlist
	{ Listp lp=mklist($5); fixargs(0,lp); $$ = mkaddstmt(S_PRINT,lp); }
	;*/

io:	  io1
		{ $$ = $1; }
/*		{ endio(); }*/
	;

io1:	  iofmove ioctl
		{ $$ = mkaddstmt($1,$2); }
	| iofmove unpar_fexpr
		{ $$ = mkaddstmt($1,mkchain(ioclause(IOSUNIT, $2),NULL)); endioctl(); }
	| iofmove SSTAR
		{ $$ = mkaddstmt($1,mkchain(ioclause(IOSUNIT, ENULL),NULL)); endioctl(); }
	| iofmove SPOWER
		{ $$ = mkaddstmt($1,mkchain(ioclause(IOSUNIT, IOSTDERR),NULL)); endioctl(); }
	| iofctl ioctl
		{ $$ = mkaddstmt($1,$2); }
	| read ioctl
		{ $$ = mkaddstmt(S_READ,mkchain($2,mkchain(NULL,NULL))); }
	| read infmt
		{ $$ = mkaddstmt(S_READ,mkchain($2,mkchain(NULL,NULL))); }
	| read ioctl inlist
		{ Listp lp=mklist(revchain($3)); fixtype_allow_impldo=1; fixargs(0,lp); fixtype_allow_impldo=0;
		  $$ = mkaddstmt(S_READ,mkchain($2,mkchain(lp,NULL))); }
	| read infmt SCOMMA inlist
		{ Listp lp=mklist(revchain($4)); fixtype_allow_impldo=1; fixargs(0,lp); fixtype_allow_impldo=0;
		  $$ = mkaddstmt(S_READ,mkchain($2,mkchain(lp,NULL))); }
	| read ioctl SCOMMA inlist
		{ Listp lp=mklist(revchain($4)); fixtype_allow_impldo=1; fixargs(0,lp); fixtype_allow_impldo=0;
		  $$ = mkaddstmt(S_READ,mkchain($2,mkchain(lp,NULL))); }
	| write ioctl
		{ $$ = mkaddstmt(S_WRITE,mkchain($2,mkchain(NULL,NULL))); }
	| write ioctl outlist
		{ Listp lp=mklist(revchain($3)); fixtype_allow_impldo=1; fixargs(0,lp); fixtype_allow_impldo=0;
		  $$ = mkaddstmt(S_WRITE,mkchain($2,mkchain(lp,NULL))); }
	| print
		{ $$ = mkaddstmt(S_WRITE,mkchain($1,mkchain(NULL,NULL))); }
	| print SCOMMA outlist
		{ Listp lp=mklist(revchain($3)); fixtype_allow_impldo=1; fixargs(0,lp); fixtype_allow_impldo=0;
		  $$ = mkaddstmt(S_WRITE,mkchain($1,mkchain(lp,NULL))); }

        | SPREAD SLPAR expr SCOMMA expr SCOMMA expr SRPAR
           {
  switch (target_arch)
    {
      case arch_pvm:
           $$ = mkaddstmt(S_PREAD,mkchain($3,mkchain($5,mkchain($7,NULL))));
        break;
      default:
           warn("PREAD ignored - use Yuppy I/O");
        break;
    }
           }

        | SPWRITE SLPAR expr SCOMMA expr SCOMMA expr SRPAR
           { 
  switch (target_arch)
    {
      case arch_pvm:
           $$ = mkaddstmt(S_PWRITE,mkchain($3,mkchain($5,mkchain($7,NULL))));
        break;
      default:
           warn("PWRITE ignored - use Yuppy I/O");
        break;
    }
           }
	;

iofmove:   fmkwd end_spec in_ioctl
		{ $$ = $1; }
	;

fmkwd:	  SBACKSPACE
		{ iostmt = IOBACKSPACE; $$ = S_BACKSPACE; }
	| SREWIND
		{ iostmt = IOREWIND; $$ = S_REWIND; }
	| SENDFILE
		{ iostmt = IOENDFILE; $$ = S_ENDFILE; }
	;

iofctl:  ctlkwd end_spec in_ioctl
		{ $$ = $1; }
	;

ctlkwd:	  SINQUIRE
		{ iostmt = IOINQUIRE; $$ = S_INQUIRE; }
	| SOPEN
		{ iostmt = IOOPEN; $$ = S_OPEN; }
	| SCLOSE
		{ iostmt = IOCLOSE; $$ = S_CLOSE; }
	;

infmt:	  unpar_fexpr
		{ $$ = mkchain(ioclause(IOSUNIT, ENULL),mkchain(ioclause(IOSFMT, $1),NULL));
		  endioctl(); }
	| SSTAR
		{ $$ = mkchain(ioclause(IOSUNIT, ENULL),mkchain(ioclause(IOSFMT, ENULL),NULL));
		  endioctl(); }
	;

ioctl:	  SLPAR fexpr SRPAR
		{
		  $$ = mkchain(ioclause(IOSUNIT, $2),NULL);
		  endioctl();
		}
	| SLPAR ctllist SRPAR
		{ $$ = revchain($2);
		  endioctl(); }
	;

ctllist:  ioclause
		{ $$ = mkchain($1,NULL); }
	| ctllist SCOMMA ioclause
		{ $$ = mkchain($3,$1); }
	;

ioclause:  fexpr
		{ $$ = ioclause(IOSPOSITIONAL, $1); }
	| SSTAR
		{ $$ = ioclause(IOSPOSITIONAL, ENULL); }
	| SPOWER
		{ $$ = ioclause(IOSPOSITIONAL, IOSTDERR); }
	| nameeq expr
		{ $$ = ioclause($1, $2); }
	| nameeq SSTAR
		{ $$ = ioclause($1, ENULL); }
	| nameeq SPOWER
		{ $$ = ioclause($1, IOSTDERR); }
	;

nameeq:  SNAMEEQ
		{ $$ = iocname(); }
	;

read:	  SREAD end_spec in_ioctl
		{ iostmt = IOREAD; }
	;

write:	  SWRITE end_spec in_ioctl
		{ iostmt = IOWRITE; }
	;

print:	  SPRINT end_spec fexpr in_ioctl
		{
		iostmt = IOWRITE;
		$$ = mkchain(ioclause(IOSUNIT, ENULL),mkchain(ioclause(IOSFMT, $3),NULL));
		endioctl();
		}
	| SPRINT end_spec SSTAR in_ioctl
		{
		iostmt = IOWRITE;
		$$ = mkchain(ioclause(IOSUNIT, ENULL),mkchain(ioclause(IOSFMT, ENULL),NULL));
		endioctl();
		}
	;

inlist:	  inelt
		{ $$ = mkchain((char *)$1, CHNULL); }
	| inlist SCOMMA inelt
		{ $$ = mkchain((char *)$3, $1); }
	;

inelt:	  lhs
		{ $$ = (tagptr) $1; }
	| SLPAR inlist SCOMMA dospec SRPAR
		{ $$ = (tagptr) mkiodo($4,revchain($2)); }
	;

outlist:  uexpr
		{ $$ = mkchain((char *)$1, CHNULL); }
	| other
		{ $$ = mkchain((char *)$1, CHNULL); }
	| out2
	;

out2:	  uexpr SCOMMA uexpr
		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
	| uexpr SCOMMA other
		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
	| other SCOMMA uexpr
		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
	| other SCOMMA other
		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
	| out2  SCOMMA uexpr
		{ $$ = mkchain((char *)$3, $1); }
	| out2  SCOMMA other
		{ $$ = mkchain((char *)$3, $1); }
	;

other:	  complex_const
		{ $$ = (tagptr) $1; }
	| SLPAR expr SRPAR
		{ $$ = (tagptr) $2; }
        | SLPAR iodospec SRPAR
		{ $$ = (tagptr) $2; }
	;

iodospec: SLPAR iodospec SRPAR
		{ $$ = (tagptr) $2; }		
	| uexpr SCOMMA dospec
		{ $$ = (tagptr) mkiodo($3, mkchain((char *)$1, CHNULL) ); }
	| other SCOMMA dospec 
		{ $$ = (tagptr) mkiodo($3, mkchain((char *)$1, CHNULL) ); }
	| out2  SCOMMA dospec 
		{ $$ = (tagptr) mkiodo($3, revchain($1)); }
	;


in_ioctl:
		{ startioctl(); }
	;
