exec.c

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

  expptr q1;
  register Namep np;
  chainp cp;
  register int i;
  int dotype, incsign;
  Addrp dovarp, dostgp;
  expptr par[3];
  expptr const[3];
  Slotp doslot;

  pushctl(CTLDO);
  dorange = ctlstack->dolabel = range;
  np = (Namep) (spec->datap);
  ctlstack->donamep = NULL;
  if(np->vdovar)
    {
      errstr("nested loops with variable %s", varstr(VL,np->varname));
      return;
    }

  dovarp = mkplace(np);
  dotype = dovarp->vtype;

  if( ! ONEOF(dotype, MSKINT|MSKREAL) )
    {
      err("bad type on DO variable");
      return;
    }


  for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
    {
      p = fixtype((expptr) cpexpr((tagptr) q = cp->datap));
      if(!ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
	{
	  err("bad type on DO parameter");
	  return;
	}


      if (ISCONST(q))
	const[i] = mkconv(dotype, q);
      else
	{
	  frexpr(q);
	  const[i] = NULL;
	}

      par[i++] = mkconv(dotype, p);
    }

  frchain(&spec);
  switch(i)
    {
    case 0:
    case 1:
      err("too few DO parameters");
      return;

    case 2:
      DOINCR = (expptr) ICON(1);
      CONSTINCR = ICON(1);

    case 3:
      break;

    default:
      err("too many DO parameters");
      return;
    }

  ctlstack->donamep = np;

  np->vdovar = YES;
  if( !optimflag && enregister(np) )
    {
      /* stgp points to a storage version, varp to a register version */
      dostgp = dovarp;
      dovarp = mkplace(np);
    }
  else
    dostgp = NULL;

  for (i = 0; i < 4; i++)
    ctlstack->ctlabels[i] = newlabel();

  if( CONSTLIMIT )
    ctlstack->domax = DOLIMIT;
  else
    ctlstack->domax = (expptr) mktemp(dotype, PNULL);

  if( CONSTINCR )
    {
      ctlstack->dostep = DOINCR;
      if( (incsign = conssgn(CONSTINCR)) == 0)
	err("zero DO increment");
      ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
    }
  else
    {
      ctlstack->dostep = (expptr) mktemp(dotype, PNULL);
      ctlstack->dostepsign = VARSTEP;
    }

if (optimflag)
	doslot = optbuff (SKDOHEAD,0,0,ctlstack);

if( CONSTLIMIT && CONSTINIT && ctlstack->dostepsign!=VARSTEP)
	{
	if (optimflag)
		optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp),cpexpr(DOINIT)),
			0,0);
	else
		puteq (cpexpr(dovarp), cpexpr(DOINIT));
	if( ! onetripflag )
		{
		q = mkexpr(OPMINUS, cpexpr(CONSTLIMIT), cpexpr(CONSTINIT));
		if((incsign * conssgn(q)) == -1)
			{
			warn("DO range never executed");
			if (optimflag)
				optbuff (SKGOTO,0,ctlstack->endlabel,0);
			else
				putgoto (ctlstack->endlabel);
			}
		frexpr(q);
		}
	}


else if (ctlstack->dostepsign != VARSTEP && !onetripflag)
	{
	if (CONSTLIMIT)
		q = (expptr) cpexpr(ctlstack->domax);
	else
		q = mkexpr(OPASSIGN, cpexpr(ctlstack->domax), DOLIMIT);
	q1 = mkexpr(OPASSIGN, cpexpr(dovarp), DOINIT);
	q = mkexpr( (ctlstack->dostepsign == POSSTEP ? OPGE : OPLE),
		   q, q1);
	if (optimflag)
		optbuff (SKIFN,q, ctlstack->endlabel,0);
	else
		putif (q, ctlstack->endlabel);
	}
else
	{
	if (!CONSTLIMIT)
	    if (optimflag)
		optbuff (SKEQ,
			mkexpr(OPASSIGN,cpexpr(ctlstack->domax),DOLIMIT),0,0);
	    else
		puteq (cpexpr(ctlstack->domax), DOLIMIT);
	q = DOINIT;
	if (!onetripflag)
		q = mkexpr(OPMINUS, q,
			mkexpr(OPASSIGN, cpexpr(ctlstack->dostep),
			       DOINCR) );
	if (optimflag)
		optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp), q),0,0);
	else
		puteq (cpexpr(dovarp), q);
	if (onetripflag && ctlstack->dostepsign == VARSTEP)
	    if (optimflag)
		optbuff (SKEQ,
			mkexpr(OPASSIGN,cpexpr(ctlstack->dostep),DOINCR),0,0);
	    else
		puteq (cpexpr(ctlstack->dostep), DOINCR);
	}

if (ctlstack->dostepsign == VARSTEP)
	{
	expptr incr,test;
	if (onetripflag)
		if (optimflag)
			optbuff (SKGOTO,0,ctlstack->dobodylabel,0);
		else
			putgoto (ctlstack->dobodylabel);
	else
	    if (optimflag)
		optbuff (SKIFN,mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)),
			ctlstack->doneglabel,0);
	    else
		putif (mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)),
			ctlstack->doneglabel);
	if (optimflag)
		optbuff (SKLABEL,0,ctlstack->doposlabel,0);
	else
		putlabel (ctlstack->doposlabel);
	incr = mkexpr(OPPLUSEQ, cpexpr(dovarp), cpexpr(ctlstack->dostep));
	test = mkexpr(OPLE, incr, cpexpr(ctlstack->domax));
	if (optimflag)
		optbuff (SKIFN,test, ctlstack->endlabel,0);
	else
		putif (test, ctlstack->endlabel);
	}

if (optimflag)
	optbuff (SKLABEL,0,ctlstack->dobodylabel,0);
else
	putlabel (ctlstack->dobodylabel);
if (dostgp)
	{
	if (optimflag)
		optbuff (SKEQ,mkexpr(OPASSIGN,dostgp, dovarp),0,0);
	else
		puteq (dostgp, dovarp);
	}
else
	frexpr(dovarp);
if (optimflag)
	doslot->nullslot = optbuff (SKNULL,0,0,0);

frexpr(CONSTINIT);
frexpr(CONSTLIMIT);
frexpr(CONSTINCR);
}


enddo(here)
int here;

{
  register struct Ctlframe *q;
  Namep np;
  Addrp ap, rv;
  expptr t;
  register int i;
  Slotp doslot;

  while (here == dorange)
    {
      while (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLELSE)
	{
	  execerr("missing endif", CNULL);
	  exendif();
	}
      
      if (np = ctlstack->donamep)
	{
	rv = mkplace (np);

	t = mkexpr(OPPLUSEQ, cpexpr(rv), cpexpr(ctlstack->dostep) );

	if (optimflag)
		doslot = optbuff (SKENDDO,0,0,ctlstack);

	if (ctlstack->dostepsign == VARSTEP)
		if (optimflag)
			{
			optbuff (SKIFN,
				mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)),
				ctlstack->doposlabel,0);
			optbuff (SKLABEL,0,ctlstack->doneglabel,0);
			optbuff (SKIFN,mkexpr(OPLT, t, ctlstack->domax),
				ctlstack->dobodylabel,0);
			}
		else
			{
			putif (mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)),
				ctlstack->doposlabel);
			putlabel (ctlstack->doneglabel);
			putif (mkexpr(OPLT, t, ctlstack->domax),
				ctlstack->dobodylabel);
			}
	else
		{
		int op;
		op = (ctlstack->dostepsign == POSSTEP ? OPGT : OPLT);
		if (optimflag)
			optbuff (SKIFN, mkexpr(op,t,ctlstack->domax),
				ctlstack->dobodylabel,0);
		else
			putif (mkexpr(op, t, ctlstack->domax),
				ctlstack->dobodylabel);
		}
	if (optimflag)
		optbuff (SKLABEL,0,ctlstack->endlabel,0);
	else
		putlabel (ctlstack->endlabel);

	if (ap = memversion(np))
		{
		if (optimflag)
			optbuff (SKEQ,mkexpr(OPASSIGN,ap, rv),0,0);
		else
			puteq (ap, rv);
		}
	else
		frexpr(rv);
	for (i = 0; i < 4; i++)
		ctlstack->ctlabels[i] = 0;
	if (!optimflag)
		deregister(ctlstack->donamep);
	ctlstack->donamep->vdovar = NO;
	if (optimflag)
		doslot->nullslot = optbuff (SKNULL,0,0,0);
	}

      popctl();
      poplab();
      
      dorange = 0;
      for (q = ctlstack; q >= ctls; --q)
	if (q->ctltype == CTLDO)
	  {
	    dorange = q->dolabel;
	    break;
	  }
    }
}


exassign(vname, labelval)
Namep vname;
struct Labelblock *labelval;
{
Addrp p;
expptr mkaddcon();

p = mkplace(vname);
#if SZADDR > SZSHORT
if( p->vtype == TYSHORT )
	err("insufficient precision in ASSIGN variable");
else
#endif
if( ! ONEOF(p->vtype, MSKINT|MSKADDR) )
	err("noninteger assign variable");
else
	{
	if (optimflag)
		optbuff (SKASSIGN, p, labelval->labelno, 0);
	else
		puteq (p, intrconv(p->vtype, mkaddcon(labelval->labelno)));
	}
}



exarif(expr, neglab, zerlab, poslab)
expptr expr;
struct Labelblock *neglab, *zerlab, *poslab;
{
register int lm, lz, lp;
struct Labelblock *labels[3];

lm = neglab->labelno;
lz = zerlab->labelno;
lp = poslab->labelno;
expr = fixtype(expr);

if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
	{
	err("invalid type of arithmetic if expression");
	frexpr(expr);
	}
else
	{
	if(lm == lz)
		exar2(OPLE, expr, lm, lp);
	else if(lm == lp)
		exar2(OPNE, expr, lm, lz);
	else if(lz == lp)
		exar2(OPGE, expr, lz, lm);
	else
		if (optimflag)
			{
			labels[0] = neglab;
			labels[1] = zerlab;
			labels[2] = poslab;
			optbuff (SKARIF, expr, 0, labels);
			}
		else
			prarif(expr, lm, lz, lp);
	}
}



LOCAL exar2 (op, e, l1, l2)
int	op;
expptr	e;
int	l1,l2;
{
if (optimflag)
	{
	optbuff (SKIFN, mkexpr(op, e, ICON(0)), l2, 0);
	optbuff (SKGOTO, 0, l1, 0);
	}
else
	{
	putif (mkexpr(op, e, ICON(0)), l2);
	putgoto (l1);
	}
}


exreturn(p)
register expptr p;
{
if(procclass != CLPROC)
	warn("RETURN statement in main or block data");
if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
	{
	err("alternate return in nonsubroutine");
	p = 0;
	}

if(p)
	if (optimflag)
		optbuff (SKRETURN, p, retlabel, 0);
	else
		{
		putforce (TYINT, p);
		putgoto (retlabel);
		}
else
	if (optimflag)
		optbuff (SKRETURN, p,
			 (proctype==TYSUBR ? ret0label : retlabel), 0);
	else
		putgoto (proctype==TYSUBR ? ret0label : retlabel);
}



exasgoto(labvar)
struct Hashentry *labvar;
{
register Addrp p;

p = mkplace(labvar);
if( ! ISINT(p->vtype) )
	err("assigned goto variable must be integer");
else
	if (optimflag)
		optbuff (SKASGOTO, p, 0, 0);
	else
		putbranch (p);
}