gram.in

<B>Digital的Unix操作系统VAX 4.2源码</B>

%token SEOS 1
%token SCOMMENT 2
%token SLABEL 3
%token SUNKNOWN 4
%token SHOLLERITH 5
%token SSTRING 6
%token SICON 7
%token SRCON 8
%token SDCON 9
%token SBITCON 10
%token SOCTCON 11
%token SHEXCON 12
%token STRUE 13
%token SFALSE 14
%token SNAME 15
%token SNAMEEQ 16
%token SFIELD 17
%token SSCALE 18
%token SINCLUDE 19
%token SLET 20
%token SASSIGN 21
%token SAUTOMATIC 22
%token SBACKSPACE 23
%token SBLOCK 24
%token SCALL 25
%token SCHARACTER 26
%token SCLOSE 27
%token SCOMMON 28
%token SCOMPLEX 29
%token SCONTINUE 30
%token SDATA 31
%token SDCOMPLEX 32
%token SDIMENSION 33
%token SDO 34
%token SDOUBLE 35
%token SELSE 36
%token SELSEIF 37
%token SEND 38
%token SENDFILE 39
%token SENDIF 40
%token SENTRY 41
%token SEQUIV 42
%token SEXTERNAL 43
%token SFORMAT 44
%token SFUNCTION 45
%token SGOTO 46
%token SASGOTO 47
%token SCOMPGOTO 48
%token SARITHIF 49
%token SLOGIF 50
%token SIMPLICIT 51
%token SINQUIRE 52
%token SINTEGER 53
%token SINTRINSIC 54
%token SLOGICAL 55
%token SNAMELIST 56
%token SOPEN 57
%token SPARAM 58
%token SPAUSE 59
%token SPRINT 60
%token SPROGRAM 61
%token SPUNCH 62
%token SREAD 63
%token SREAL 64
%token SRETURN 65
%token SREWIND 66
%token SSAVE 67
%token SSTATIC 68
%token SSTOP 69
%token SSUBROUTINE 70
%token STHEN 71
%token STO 72
%token SUNDEFINED 73
%token SWRITE 74
%token SLPAR 75
%token SRPAR 76
%token SEQUALS 77
%token SCOLON 78
%token SCOMMA 79
%token SCURRENCY 80
%token SPLUS 81
%token SMINUS 82
%token SSTAR 83
%token SSLASH 84
%token SPOWER 85
%token SCONCAT 86
%token SAND 87
%token SOR 88
%token SNEQV 89
%token SEQV 90
%token SNOT 91
%token SEQ 92
%token SLT 93
%token SGT 94
%token SLE 95
%token SGE 96
%token SNE 97
%{ 
#ifndef lint
static	char	*sccsid = "@(#)gram.head	4.1	(ULTRIX)	7/17/90";
#endif lint
%} 
/************************************************************************
 *									*
 *			Copyright (c) 1984 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/
/*	@(#)gram.head	4.4 (Berkeley) 7/26/84	*/
/*
 * gram.head
 *
 * First part of the f77 grammar, f77 compiler pass 1.
 *
 * University of Utah CS Dept modification history:
 *
 * $Log:	gram.head,v $
 * Revision 3.2  84/11/06  17:40:52  donn
 * Fixed bug with redundant labels causing errors when they appear on (e.g.)
 * PROGRAM statements.
 * 
 * Revision 3.1  84/10/13  00:22:16  donn
 * Merged Jerry Berkman's version into mine.
 * 
 * Revision 2.2  84/08/04  21:13:02  donn
 * Moved some code out of gram.head into gram.exec in accordance with
 * Jerry Berkman's fixes to make ASSIGNs work right.
 * 
 * Revision 2.1  84/07/19  12:03:20  donn
 * Changed comment headers for UofU.
 * 
 * Revision 1.2  84/03/23  22:43:06  donn
 * The subroutine argument temporary fixes from Bob Corbett didn't take into
 * account the fact that the code generator collects all the assignments to
 * temporaries at the start of a statement -- hence the temporaries need to
 * be initialized once per statement instead of once per call.
 * 
 */

%{
#	include "defs.h"
#	include "data.h"

#ifdef SDB
#	include <a.out.h>

#	ifndef N_SO
#		include <stab.h>
#	endif
#endif

static int equivlisterr;
static int do_name_err;
static int nstars;
static int ndim;
static int vartype;
static ftnint varleng;
static struct { expptr lb, ub; } dims[MAXDIM+1];
static struct Labelblock *labarray[MAXLABLIST];
static int lastwasbranch = NO;
static int thiswasbranch = NO;
extern ftnint yystno;
extern flag intonly;

ftnint convci();
double convcd();
expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
expptr mkcxcon();
struct Listblock *mklist();
struct Listblock *mklist();
struct Impldoblock *mkiodo();
struct Extsym *comblock();

%}

/* Specify precedences and associativities. */

%union	{
	int ival;
	char *charpval;
	chainp chval;
	tagptr tagval;
	expptr expval;
	struct Labelblock *labval;
	struct Nameblock *namval;
	struct Eqvchain *eqvval;
	struct Extsym *extval;
	union  Vexpr *vexpval;
	struct ValList *drvals;
	struct Vlist *dvals;
	union  Delt *deltp;
	struct Rpair *rpairp;
	struct Elist *elistp;
	}

%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
%type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq
%type <charpval> filename
%type <chval> namelistlist funarglist funargs dospec
%type <chval> callarglist arglist args exprlist inlist outlist out2 substring
%type <namval> name arg call var entryname progname
%type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr
%type <expval> ubound callarg complex_const simple_const 
%type <extval> common comblock
%type <eqvval> equivlist
%type <expval> datavalue real_const unsignedreal bit_const
%type <vexpval> unsignedint int_const
%type <vexpval> dataname
%type <vexpval> iconprimary iconfactor iconterm iconexpr opticonexpr
%type <drvals>	datarval datarvals
%type <dvals>	iconexprlist datasubs
%type <deltp>	dataelt dataimplieddo datalval
%type <rpairp>	datarange
%type <elistp>	dlist datalvals

%%

program:
	| program stat SEOS
	;

stat:	  thislabel  entry
		{ lastwasbranch = NO; }
	| thislabel  spec
	| thislabel  exec
		{ if($1 && ($1->labelno==dorange))
			enddo($1->labelno);
		  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;
			}
		  if(!optimflag)
			{
			argtemplist = hookup(argtemplist, activearglist);
			activearglist = CHNULL;
			}
		}
	| thislabel SINCLUDE filename
		{ doinclude( $3 ); }
	| thislabel  SEND  end_spec
		{ lastwasbranch = NO;  endproc(); }
	| thislabel SUNKNOWN
		{ execerr("unclassifiable statement", CNULL);  flline(); };
	| error
		{ flline();  needkwd = NO;  inioctl = NO; 
		  yyerrok; yyclearin; }
	;

thislabel:  SLABEL
		{
#ifdef SDB
		if( sdbflag )
			{
			linenostab(lineno);
			}
#endif

		if(yystno != 0)
			{
			$$ = thislabel =  mklabel(yystno);
			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;
				}
			}
		else    $$ = thislabel = NULL;
		}
	;

entry:	  SPROGRAM new_proc progname
		   {startproc($3, CLMAIN); }
	| SBLOCK new_proc progname
		{ if($3) NO66("named BLOCKDATA");
		  startproc($3, CLBLOCK); }
	| SSUBROUTINE new_proc entryname arglist
		{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
	| SFUNCTION new_proc entryname arglist
		{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
	| type SFUNCTION new_proc entryname arglist
		{ entrypt(CLPROC, $1, varleng, $4, $5); }
	| SENTRY entryname arglist
		{ if(parstate==OUTSIDE || procclass==CLMAIN
			|| procclass==CLBLOCK)
				execerr("misplaced entry statement", CNULL);
			entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
		}
	;

new_proc:
		{ newproc(); }
	;

entryname:  name
	;

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

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

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

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

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



filename:   SHOLLERITH
		{
		char *s;
		s = copyn(toklen+1, token);
		s[toklen] = '\0';
		$$ = s;
		}
	;
/*
*	@(#)gram.dcl	1.3	(ULTRIX)	1/15/86
*/

/************************************************************************
 *									*
 *			Copyright (c) 1986 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/

/************************************************************************
*
*			Modification History
*
*	David Metsky		14-Jan-86
*
* 001	Replaced old version with BSD 4.3 version as part of upgrade.
*
*	Based on:	gram.dcl	5.2		8/29/85
*
*************************************************************************/

/*
 * Grammar for declarations, f77 compiler, 4.2 BSD.
 *
 * University of Utah CS Dept modification history:
 *
 * $Log:	gram.dcl,v $
 * Revision 5.4  85/08/20  23:37:33  donn
 * Fix from Jerry Berkman to prevent length problems with -r8.
 * 
 * Revision 5.3  85/08/15  20:16:29  donn
 * SAVE statements are not executable...
 * 
 * Revision 5.2  85/08/10  04:24:56  donn
 * Jerry Berkman's changes to handle the -r8/double precision flag.
 * 
 * Revision 5.1  85/08/10  03:47:18  donn
 * 4.3 alpha
 * 
 * Revision 3.2  84/11/12  18:36:26  donn
 * A side effect of removing the ability of labels to define the start of
 * a program is that format statements have to do the job now...
 * 
 * Revision 3.1  84/10/13  00:26:54  donn
 * Installed Jerry Berkman's version; added comment header.
 * 
 */

spec:	  dcl
	| common
	| external
	| intrinsic
	| equivalence
	| implicit
	| data
	| namelist
	| SSAVE in_dcl
		{ NO66("SAVE statement");
		  saveall = YES; }
	| SSAVE in_dcl savelist
		{ NO66("SAVE statement"); }
	| SFORMAT
		{
		if (parstate == OUTSIDE)
			{
			newproc();
			startproc(PNULL, CLMAIN);
			parstate = INSIDE;
			}
		if (parstate < INDCL)
			parstate = INDCL;
		fmtstmt(thislabel);
		setfmt(thislabel);
		}
	| SPARAM in_dcl SLPAR paramlist SRPAR
		{ NO66("PARAMETER statement"); }
	;

dcl:	  type opt_comma name in_dcl dims lengspec
		{ settype($3, $1, $6);
		  if(ndim>0) setbound($3,ndim,dims);
		}
	| dcl SCOMMA name dims lengspec
		{ settype($3, $1, $5);
		  if(ndim>0) setbound($3,ndim,dims);
		}
	;

type:	  typespec lengspec
		{ varleng = $2; }
	;

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

typename:    SINTEGER	{ $$ = TYLONG; }
	| SREAL		{ $$ = dblflag ? TYDREAL : TYREAL; }
	| SCOMPLEX	{ $$ = dblflag ? TYDCOMPLEX : TYCOMPLEX; }
	| SDOUBLE	{ $$ = TYDREAL; }
	| SDCOMPLEX	{ 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; }