exec.c

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· C语言 代码 · 共 881 行 · 第 1/2 页

#ifndef lint
static char	*sccsid = " @(#)exec.c	1.3	(ULTRIX)	1/15/86";
#endif lint

/************************************************************************
 *									*
 *			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:	exec.c		5.4		8/29/85
*
*************************************************************************/

/*
 * exec.c
 *
 * Routines for handling the semantics of control structures.
 * F77 compiler, pass 1.
 *
 * University of Utah CS Dept modification history:
 * 
 * $Log:	exec.c,v $
 * Revision 5.2  85/08/10  04:07:36  donn
 * Changed an error message to correct spelling and be more accurate.
 * From Jerry Berkman.
 * 
 * Revision 2.3  85/03/18  08:03:31  donn
 * Hacks for conversions from type address to numeric type -- prevent addresses
 * from being stored in shorts and prevent warnings about implicit conversions.
 * 
 * Revision 2.2  84/09/03  23:18:30  donn
 * When a DO loop had the same variable as its loop variable and its limit,
 * the limit temporary was assigned to AFTER the original value of the variable
 * was destroyed by assigning the initial value to the loop variable.  I
 * swapped the operands of a comparison and changed the direction of the
 * operator...  This only affected programs when optimizing.  (This may not
 * be enough if something alters the order of evaluation of side effects
 * later on... sigh.)
 * 
 * Revision 2.1  84/07/19  12:02:53  donn
 * Changed comment headers for UofU.
 * 
 * Revision 1.3  84/07/12  18:35:12  donn
 * Added change to enddo() to detect open 'if' blocks at the ends of loops.
 * 
 * Revision 1.2  84/06/08  11:22:53  donn
 * Fixed bug in exdo() -- if a loop parameter contained an instance of the loop
 * variable and the optimizer was off, the loop variable got converted to
 * register before the parameters were processed and so the loop parameters
 * were initialized from garbage in the register instead of the memory version
 * of the loop variable.
 * 
 */

#include "defs.h"
#include "optim.h"


/*   Logical IF codes
*/


exif(p)
expptr p;
{
register int k;
pushctl(CTLIF);
ctlstack->elselabel = newlabel();

if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
	{
	if(k != TYERROR)
		err("non-logical expression in IF statement");
	frexpr(p);
	}
else if (optimflag)
	optbuff (SKIFN, p, ctlstack->elselabel, 0);
else
	putif (p, ctlstack->elselabel);
}



exelif(p)
expptr p;
{
int k,oldelse;

if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
	{
	if(k != TYERROR)
		err("non-logical expression in IF statement");
	frexpr(p);
	}
else    {
        if(ctlstack->ctltype == CTLIF)
		{
		if(ctlstack->endlabel == 0) ctlstack->endlabel = newlabel();
        	oldelse=ctlstack->elselabel;
		ctlstack->elselabel = newlabel();
		if (optimflag)
			{
			optbuff (SKGOTO, 0, ctlstack->endlabel, 0);
			optbuff (SKLABEL, 0, oldelse, 0);
			optbuff (SKIFN, p, ctlstack->elselabel, 0);
			}
		else
			{
			putgoto (ctlstack->endlabel);
			putlabel (oldelse);
			putif (p, ctlstack->elselabel);
			}
		}
        else	execerr("elseif out of place", CNULL);
        }
}





exelse()
{
if(ctlstack->ctltype==CTLIF)
	{
	if(ctlstack->endlabel == 0)
		ctlstack->endlabel = newlabel();
	ctlstack->ctltype = CTLELSE;
	if (optimflag)
		{
		optbuff (SKGOTO, 0, ctlstack->endlabel, 0);
		optbuff (SKLABEL, 0, ctlstack->elselabel, 0);
		}
	else
		{
		putgoto (ctlstack->endlabel);
		putlabel (ctlstack->elselabel);
		}
	}

else	execerr("else out of place", CNULL);
}


exendif()
{
if (ctlstack->ctltype == CTLIF)
	{
	if (optimflag)
		{
		optbuff (SKLABEL, 0, ctlstack->elselabel, 0);
		if (ctlstack->endlabel)
			optbuff (SKLABEL, 0, ctlstack->endlabel, 0);
		}
	else
		{
		putlabel (ctlstack->elselabel);
		if (ctlstack->endlabel)
			putlabel (ctlstack->endlabel);
		}
	popctl ();
	}
else if (ctlstack->ctltype == CTLELSE)
	{
	if (optimflag)
		optbuff (SKLABEL, 0, ctlstack->endlabel, 0);
	else
		putlabel (ctlstack->endlabel);
	popctl ();
	}
else
	execerr("endif out of place", CNULL);
}



LOCAL pushctl(code)
int code;
{
register int i;

/* fprintf(diagfile,"old blklevel %d \n",blklevel); dmpframe(ctlstack); */
if(++ctlstack >= lastctl)
	many("loops or if-then-elses", 'c');
ctlstack->ctltype = code;
for(i = 0 ; i < 4 ; ++i)
	ctlstack->ctlabels[i] = 0;
++blklevel;
}


LOCAL popctl()
{
if( ctlstack-- < ctls )
	fatal("control stack empty");
--blklevel;
}



LOCAL poplab()
{
register struct Labelblock  *lp;

for(lp = labeltab ; lp < highlabtab ; ++lp)
	if(lp->labdefined)
		{
		/* mark all labels in inner blocks unreachable */
		if(lp->blklevel > blklevel)
			lp->labinacc = YES;
		}
	else if(lp->blklevel > blklevel)
		{
		/* move all labels referred to in inner blocks out a level */
		lp->blklevel = blklevel;
		}
}



/*  BRANCHING CODE
*/

exgoto(lab)
struct Labelblock *lab;
{
if (optimflag)
	optbuff (SKGOTO, 0, lab->labelno, 0);
else
	putgoto (lab->labelno);
}







exequals(lp, rp)
register struct Primblock *lp;
register expptr rp;
{
register Namep np;

if(lp->tag != TPRIM)
	{
	err("assignment to a non-variable");
	frexpr(lp);
	frexpr(rp);
	}
else if(lp->namep->vclass!=CLVAR && lp->argsp)
	{
	if(parstate >= INEXEC)
		err("undimensioned array or statement function out of order");
	else
		mkstfunct(lp, rp);
	}
else
	{
	np = (Namep) lp->namep;
	if (np->vclass == CLPROC && np->vprocclass == PTHISPROC
		&& proctype == TYSUBR)
		{
		err("assignment to a subroutine name");
		return;
		}
	if(parstate < INDATA)
		enddcl();
	if (optimflag)
		optbuff (SKEQ, mkexpr(OPASSIGN, mklhs(lp), fixtype(rp)), 0, 0);
	else
		puteq (mklhs(lp), fixtype(rp));
	}
}



mkstfunct(lp, rp)
struct Primblock *lp;
expptr rp;
{
register struct Primblock *p;
register Namep np;
chainp args;

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

np = lp->namep;
if(np->vclass == CLUNKNOWN)
	np->vclass = CLPROC;
else
	{
	dclerr("redeclaration of statement function", np);
	return;
	}
np->vprocclass = PSTFUNCT;
np->vstg = STGSTFUNCT;
impldcl(np);
args = (lp->argsp ? lp->argsp->listp : CHNULL);
np->varxptr.vstfdesc = mkchain(args , rp );

for( ; args ; args = args->nextp)
	if( args->datap->tag!=TPRIM ||
		(p = (struct Primblock *) (args->datap) )->argsp ||
		p->fcharp || p->lcharp )
		err("non-variable argument in statement function definition");
	else
		{
		args->datap = (tagptr) (p->namep);
		vardcl(p->namep);
		free(p);
		}
}



excall(name, args, nstars, labels)
Namep name;
struct Listblock *args;
int nstars;
struct Labelblock *labels[ ];
{
register expptr p;

settype(name, TYSUBR, ENULL);
p = mkfunct( mkprim(name, args, CHNULL) );
p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;
if (nstars > 0)
	if (optimflag)
		optbuff (SKCMGOTO, p, nstars, labels);
	else
		putcmgo (p, nstars, labels);
else
	if (optimflag)
		optbuff (SKCALL, p, 0, 0);
	else
		putexpr (p);
}



exstop(stop, p)
int stop;
register expptr p;
{
char *q;
int n;
expptr mkstrcon();

if(p)
	{
	if( ! ISCONST(p) )
		{
		execerr("pause/stop argument must be constant", CNULL);
		frexpr(p);
		p = mkstrcon(0, CNULL);
		}
	else if( ISINT(p->constblock.vtype) )
		{
		q = convic(p->constblock.const.ci);
		n = strlen(q);
		if(n > 0)
			{
			p->constblock.const.ccp = copyn(n, q);
			p->constblock.vtype = TYCHAR;
			p->constblock.vleng = (expptr) ICON(n);
			}
		else
			p = (expptr) mkstrcon(0, CNULL);
		}
	else if(p->constblock.vtype != TYCHAR)
		{
		execerr("pause/stop argument must be integer or string", CNULL);
		p = (expptr) mkstrcon(0, CNULL);
		}
	}
else	p = (expptr) mkstrcon(0, CNULL);

if (optimflag)
	optbuff ((stop ? SKSTOP : SKPAUSE), p, 0, 0);
else
	putexpr (call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p));
}


/* UCB DO LOOP CODE */

#define DOINIT	par[0]
#define DOLIMIT	par[1]
#define DOINCR	par[2]

#define CONSTINIT  const[0]
#define CONSTLIMIT const[1]
#define CONSTINCR  const[2]

#define VARSTEP	0
#define POSSTEP	1
#define NEGSTEP	2


exdo(range, spec)
int range;
chainp spec;

{
  register expptr p, q;