[unix-history] / usr / src / usr.bin / f77 / pass1.vax / optloop.c

/*-
 * Copyright (c) 1980 The Regents of the University of California.
 * All rights reserved.
 *
 * %sccs.include.proprietary.c%
 */

#ifndef lint
static char sccsid[] = "@(#)optloop.c	5.3 (Berkeley) %G%";
#endif /* not lint */

/*
 * optloop.c
 *
 * Loop optimizations, f77 compiler pass 1, 4.2 BSD.
 *
 * University of Utah CS Dept. modification history:
 *
 * $Log:	optloop.c,v $
 * Revision 1.4  84/10/25  01:27:29  donn
 * Fixed a subtle bug in removesafe().  When the moved code is an assignment
 * into a temporary, we use the lhs to substitute for the expression inside
 * the loop.  Previously the data structure for the temporary was not copied,
 * so later on when the lhs was freed, the substitute was too, turning it
 * into garbage.
 * 
 * Revision 1.3  84/08/05  17:04:03  donn
 * Changed worthcost() so that it skips variable length strings -- we can't
 * make temporaries for these...
 * 
 * Revision 1.2  84/07/19  11:50:39  donn
 * Installed changes to force non-intrinsic subroutines and functions to define
 * their arguments (make them ineligible for optimization), function setsuses.
 * Fix from A.F.
 * 
 */

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


#define SCFREE   0
#define SCSAFE   1


typedef
  struct varblock
    {
      struct varblock *next;
      field vstg;
      int memno;	/* holds memalloc for TTEMP */
      short sets;
      short uses;
      field setfirst;
    } VARBLOCK;

typedef VARBLOCK *Varp;

#define TABLESIZE 59

LOCAL Varp table[TABLESIZE];


LOCAL Varp mkbucket(vstg,memno)
field vstg;
int memno;

{
  Varp q;

  q = ALLOC(varblock);
  q->vstg = vstg;
  q->memno = memno;
  return q;
}


LOCAL Varp lookup(p)
tagptr p;

{
int vstg, memno;
int key;
Varp q, r;

switch (p->tag)
	{
	case TTEMP:
		vstg = 0;
		memno = (int) p->tempblock.memalloc;
		break;

	case TADDR:
		vstg = p->addrblock.vstg;
		memno = p->addrblock.memno;
		break;

	default:
		badtag ("lookup",p->tag);
	}
key = memno % TABLESIZE;
q = table[key];

if (q)
	{
	for (; q; r = q, q = q->next)
		if ((q->vstg == vstg) && (q->memno == memno))
			return q;
	return r->next = mkbucket(vstg,memno);
	}
else
	return table[key] = mkbucket(vstg,memno);
}


LOCAL freetable()

{
  int i;
  Varp p, q;

  for (i = 0; i < TABLESIZE; i++)
    if (table[i])
      {
	p = table[i];
	table[i] = NULL;

	while (p)
	  {
	    q = p->next;
	    free((char *) p);
	    p = q;
	  }
      }
}

\f

Slotp newcode;
Slotp dohead, doend;
LOCAL Slotp first, last;
LOCAL commonset;
LOCAL int comocount;	/* count of number of code motions done */


optloops()

{
int	match;
Slotp	nextslot;
Slotp	sl1,sl2;
Slotp	lastlabslot;
int	lab;

if (! optimflag) return;
if (debugflag[6]) return;

lastlabslot = NULL;
comocount = 0;
for (sl1 = firstslot; sl1; sl1 = nextslot)
	{
	nextslot = sl1->next;
	switch (sl1->type)
	    {
	    case SKLABEL:
		lastlabslot = sl1;
		break;

	    case SKGOTO:
		if (lastlabslot && sl1->label == lastlabslot->label)
			{
			lab = newlabel ();
			first = optinsert (SKLABEL,0,lab,0,lastlabslot->next);
			last = sl1;
			last->label = lab;
			optloop ();
			}
		break;

	    case SKDOHEAD:
		match = 0;
		for (sl2 = sl1; sl2; sl2 = sl2->next)
			{
			if (sl2->type == SKDOHEAD) match++;
			else if (sl2->type == SKENDDO) match--;
			if (match == 0) break;
			}
		if (sl2)
			last = sl2;
		else
			fatal ("unmatched do in code buffer");
		if (sl2->type != SKENDDO)
			fatal ("internal error in optloops");

		/*  last now points to the SKENDDO slot; the SKNULL slot
		 *  is reached through last->nullslot
		 */
		last = (Slotp) last->nullslot;

		first = sl1;

		optloop ();
		break;

	    default:
		break;
	    }
	}

if (debugflag[0])
	fprintf (diagfile,"%d code motion%s performed\n",comocount,
		(comocount==1 ? "" : "s") );
return;
}


optloop()

{
newcode = NULL;

modify();

return;
}

\f
LOCAL modify()

{
  Slotp sp;
  int s;

  scanvars();

  for (sp = first; sp != last->next; sp = sp->next)
    switch (sp->type)
      {
      case SKEQ:
	s = anex(sp->expr);
	if (s == SCSAFE)
	  removesafe (&sp->expr);
	break;

      case SKARIF:
      case SKASGOTO:
      case SKCALL:
      case SKCMGOTO:
      case SKIFN:
      case SKSTOP:
      case SKRETURN:
      case SKPAUSE:
      case SKIOIFN:
	s = anex(sp->expr);
	if (s == SCSAFE)
	  removesafe(&sp->expr);
	break;

      default:
	break;
      }

  freetable();
  return;
}

\f
LOCAL scanvars()

{
  Slotp sp;
  Varp varinfo;
  int i;
  Varp p;

  commonset = NO;

  for (sp = first; sp != last->next; sp = sp->next)
    {
      switch (sp->type)
	{
	case SKARIF:
	case SKASGOTO:
	case SKCALL:
	case SKCMGOTO:
	case SKIFN:
	case SKSTOP:
	case SKRETURN:
	case SKPAUSE:
	case SKIOIFN:
	case SKEQ:
	  setsuses(sp->expr);
	  break;

	default:
	  break;
	}
    }

  if (commonset)
    for (i = 0; i < TABLESIZE; i++)
      for (p = table[i]; p; p = p->next)
	if (p->vstg == STGCOMMON)
	  {
	    p->sets++;
	    p->setfirst = NO;
	  }
}

\f
LOCAL setsuses(p)
expptr p;

{
  Addrp lhs;
  Varp varinfo;
  chainp args;

  if (!p) return;

  switch (p->tag)
    {
    case TEXPR:
      switch (p->exprblock.opcode)
	{
	default:
	  setsuses(p->exprblock.leftp);
	  setsuses(p->exprblock.rightp);
	  setsuses(p->exprblock.vleng);
	  break;

	case OPASSIGN:
	  switch (p->exprblock.leftp->tag)
	    {
	    case TTEMP:
	      lhs = (Addrp) p->exprblock.leftp;
	      goto taddr;

	    case TADDR:
	      lhs = (Addrp) p->exprblock.leftp;
	      setsuses(lhs->memoffset);
	      setsuses(lhs->vleng);
	    taddr:
	      setsuses(p->exprblock.rightp);
	      setsuses(p->exprblock.vleng);
	      varinfo = lookup(lhs);
	      varinfo->sets++;
              if (varinfo->uses == 0)
	        varinfo->setfirst = YES;
	      break;

	    default:
	      fatal("O6:  l-value expected");
	    }
	  break;

	case OPSTAREQ:
	case OPPLUSEQ:
	  switch (p->exprblock.leftp->tag)
	    {
	    case TADDR:
	      lhs = (Addrp) p->exprblock.leftp;
	      break;
	    case TTEMP:
	      lhs = (Addrp) p->exprblock.leftp;
	      break;
	    default:
	      fatal("O7:  l-value expected");
	    }
	  setsuses(p->exprblock.leftp);
	  setsuses(p->exprblock.rightp);
	  setsuses(p->exprblock.vleng);
	  varinfo = lookup(lhs);
	  varinfo->sets++;
	  break;

	case OPCALL:
	  if (p->exprblock.leftp->tag != TADDR)
	    fatal("O8:  subprogram expected");
	  setsuses(p->exprblock.rightp);
	  setsuses(p->exprblock.vleng);
	  if (p->exprblock.leftp->addrblock.vstg == STGINTR) break;
	  commonset = YES;
	  if (p->exprblock.rightp == NULL) break;
	  args = p->exprblock.rightp->listblock.listp;
	  for (; args; args = args->nextp)
	    if (args->datap->tag == TADDR)
	      {
		lhs = (Addrp) args->datap;
		switch (lhs->vstg)
		  {
		  case STGARG:
		  case STGAUTO:
		  case STGBSS:
		  case STGINIT:
		  case STGCOMMON:
		  case STGEQUIV:
		  case STGREG:
		  case STGPREG:
		    varinfo = lookup(lhs);
		    varinfo->sets++;
		  }
	      }
	    else if (args->datap->tag == TTEMP)
	      {
		lhs = (Addrp) args->datap;
		varinfo = lookup (lhs);
		varinfo->sets++;
	      }
	  break;
        }

      return;

    case TTEMP:
      varinfo = lookup((Addrp) p);
      varinfo->uses++;
      return;

    case TADDR:
      setsuses(p->addrblock.memoffset);
      setsuses(p->addrblock.vleng);
      varinfo = lookup((Addrp) p);
      varinfo->uses++;
      return;

    case TLIST:
      for (args = p->listblock.listp; args; args = args->nextp)
	setsuses(args->datap);

    case TCONST:
    case TERROR:
      return;

    default:
      fatal("O9:  bad tag value");
    }
}

\f
LOCAL int anex(p)
expptr p;

{
  int s1, s2, s3;
  expptr q;
  Varp varinfo;
  chainp ch;
  int setfirst;
  expptr expr;


  if (p == ENULL)
    return SCSAFE;

  switch (p->tag)
    {
    case TCONST:
      return SCSAFE;

    case TLIST:
      for (ch = p->listblock.listp; ch; ch = ch->nextp)
	{
	  s1 = anex (ch->datap);
	  if (s1 == SCSAFE)
	    removesafe (&ch->datap);
	}
      return SCFREE;

    case TEXPR:
      s1 = anex(p->exprblock.leftp);
      s2 = anex(p->exprblock.rightp);
      s3 = anex(p->exprblock.vleng);

      switch (p->exprblock.opcode)
	{
	case OPASSIGN:
	  expr = p->exprblock.leftp;
	  varinfo = lookup(expr);
	  setfirst = varinfo->setfirst && (varinfo->sets == 1);
	  if (expr->tag == TTEMP && setfirst &&
		s2 == SCSAFE && s3 == SCSAFE)
	    {
	      movefrtemp (expr);
	      return SCSAFE;
	    }
	  else
	    {
	      if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
	      if (s3 == SCSAFE) removesafe (&p->exprblock.vleng);
	      return SCFREE;
	    }

	case OPNEG:
	case OPNOT:
	case OPABS:
	case OPADDR:
	case OPBITNOT:
	  if ((s2 == SCSAFE) && (s3 == SCSAFE))
	    return s1;
	  else
	    return SCFREE;

	case OPCONV:
	  if ((s2 != SCSAFE) || (s3 != SCSAFE))
	    return SCFREE;

	  if (ISINT(p->exprblock.vtype))
	    return s1;
	  if (ISINT(p->exprblock.leftp->headblock.vtype))
	    return s1;

	  return SCFREE;


	case OPSTAR:
	  if (ISINT(p->exprblock.vtype))
	    goto safeop;

	  if (safefactor(p->exprblock.leftp) ||
	      safefactor(p->exprblock.rightp))
	    goto safeop;

	  goto floatop;


	case OPPLUS:
	case OPMINUS:
	  if (ISINT(p->exprblock.vtype))
	    goto safeop;

	floatop:
	  if (!(ISREAL(p->exprblock.vtype) || ISCOMPLEX(p->exprblock.vtype)))
	    return SCFREE;

	  switch (s1)
	    {
	    case SCSAFE:
	      removesafe(&p->exprblock.leftp);
	      if (s2 == SCSAFE)
		removesafe(&p->exprblock.leftp);
	      return SCFREE;

	    case SCFREE:
	      if (s2 == SCSAFE)
		removesafe(&p->exprblock.rightp);
	      return SCFREE;
	    }

	case OPOR:
	case OPAND:
	case OPEQV:
	case OPNEQV:
	case OPLT:
	case OPEQ:
	case OPGT:
	case OPLE:
	case OPNE:
	case OPGE:
	case OPLSHIFT:
	case OPMIN:
	case OPMAX:
	case OPBITOR:
	case OPBITAND:
	case OPBITXOR:
	case OPRSHIFT:
	safeop:
	  if ((p->exprblock.vleng != ENULL) && ( ! ISCONST(p->exprblock.vleng)))
	    return SCFREE;

	  switch (s1)
	    {
	    case SCSAFE:
		if (s2 == SCFREE) removesafe (&p->exprblock.leftp);
		return s2;

	    case SCFREE:
		if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
		return SCFREE;
	    }

	default:
	  if (s1 == SCSAFE) removesafe(&p->exprblock.leftp);
	  if (s2 == SCSAFE) removesafe(&p->exprblock.rightp);
	  if (s3 == SCSAFE) removesafe(&p->exprblock.vleng);
	  return SCFREE;
	}


    case TTEMP:
      varinfo = lookup(p);
      if (varinfo->sets == 0)
	return SCSAFE;
      else
	return SCFREE;

    case TADDR:
      s1 = anex(p->addrblock.memoffset);
      s2 = anex(p->addrblock.vleng);

      varinfo = lookup(p);

      if (varinfo->sets == 0)
	switch (s1)
	  {
	  case SCSAFE:
		if (s2 == SCFREE) removesafe(&p->addrblock.memoffset);
		return s2;

	  case SCFREE:
		if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
		return SCFREE;
	  }

      if (s1 == SCSAFE) removesafe(&p->addrblock.memoffset);
      if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
      return SCFREE;
    
	
    default:
      return SCFREE;
    }
}


LOCAL safefactor(p)
expptr p;

{
  if ( ! ISCONST(p))
    return NO;

  if (ISINT(p->constblock.vtype))
    if (abs(p->constblock.constant.ci) <= 1)
      return YES;

  if (ISREAL(p->constblock.vtype))
    if (abs(p->constblock.constant.cd[0]) <= 1.0)
      return YES;

  return NO;
}

\f
LOCAL int worthcost(p)
expptr p;

{
  int cost;
  chainp q;
  expptr memoffset,vleng;

  if (p == ENULL)
    return NO;

  switch (p->tag)
    {
    case TCONST:
      return NO;

    case TTEMP:
      return NO;

    case TADDR:
      if ((vleng = p->addrblock.vleng) && ! ISCONST(vleng))
	return NO;	/* Can't make variable length temporaries */
      if ((memoffset = p->addrblock.memoffset) && ! ISCONST(memoffset))
	return YES;
      else
	return NO;

    case TEXPR:
      return YES;

    case TLIST:
      cost = 0;
      for (q = p->listblock.listp; q; q = q->nextp)
	{
	if (worthcost ((expptr) q->datap))
	  return YES;
	cost++;
	}
      return (cost>2 ? YES : NO);

    default:
      return NO;
    }
}

\f
LOCAL removesafe(refexpr)
expptr *refexpr;

{
  expptr ep;
  Tempp ap;
  Slotp newslot;

  extern Addrp gettemp();

  ep = *refexpr;
  if (! worthcost(ep))
    return;

  if (ep->tag == TEXPR && ep->exprblock.opcode == OPASSIGN)
    {
      if (ep->exprblock.leftp->tag != TTEMP)
	fatal ("non-TEMP in assignment to be moved in optloop");

      newslot = optinsert (SKEQ, ep, 0, 0, first);
      *refexpr = (expptr) cpexpr (ep->exprblock.leftp);
    }
  else
    {
      ap = (Tempp) gettemp(ep);
      newslot = optinsert (SKEQ, mkexpr(OPASSIGN,cpexpr(ap),ep), 0, 0, first);
      *refexpr = (expptr) ap;
      optinsert (SKFRTEMP,ap->memalloc,0,0,last->next);
    }

  comocount++;
  if (!newcode)
    newcode = newslot;

  return;
}

\f
LOCAL Addrp gettemp(p)
expptr p;

{
  return mktemp(p->headblock.vtype, p->headblock.vleng);
}


LOCAL movefrtemp (expr)
Tempp	expr;

{
  Slotp	s;

  if (expr->tag != TTEMP)
    badtag ("movefrtemp",expr->tag);

  for (s = first; s; s = s->next)
    if (s->type == SKFRTEMP && s->expr == (expptr) expr->memalloc)
      {
	removeslot (s);
	insertslot (s,last->next);
	return;
      }
}
Commit	Line	Data
dc5f2268 KB	1	/*-
	2	* Copyright (c) 1980 The Regents of the University of California.
	3	* All rights reserved.
	4	*
	5	* %sccs.include.proprietary.c%
67c207eb KM	6	*/
	7
	8	#ifndef lint
dc5f2268 KB	9	static char sccsid[] = "@(#)optloop.c 5.3 (Berkeley) %G%";
dc5f2268 KB	10	#endif /* not lint */
67c207eb KM	11
	12	/*
	13	* optloop.c
	14	*
	15	* Loop optimizations, f77 compiler pass 1, 4.2 BSD.
	16	*
	17	* University of Utah CS Dept. modification history:
	18	*
	19	* $Log: optloop.c,v $
	20	* Revision 1.4 84/10/25 01:27:29 donn
	21	* Fixed a subtle bug in removesafe(). When the moved code is an assignment
	22	* into a temporary, we use the lhs to substitute for the expression inside
	23	* the loop. Previously the data structure for the temporary was not copied,
	24	* so later on when the lhs was freed, the substitute was too, turning it
	25	* into garbage.
	26	*
	27	* Revision 1.3 84/08/05 17:04:03 donn
	28	* Changed worthcost() so that it skips variable length strings -- we can't
	29	* make temporaries for these...
	30	*
	31	* Revision 1.2 84/07/19 11:50:39 donn
	32	* Installed changes to force non-intrinsic subroutines and functions to define
	33	* their arguments (make them ineligible for optimization), function setsuses.
	34	* Fix from A.F.
	35	*
	36	*/
	37
	38	#include "defs.h"
	39	#include "optim.h"
	40
	41
	42	#define SCFREE 0
	43	#define SCSAFE 1
	44
	45
	46
	47	typedef
	48	struct varblock
	49	{
	50	struct varblock *next;
	51	field vstg;
	52	int memno; /* holds memalloc for TTEMP */
	53	short sets;
	54	short uses;
	55	field setfirst;
	56	} VARBLOCK;
	57
	58	typedef VARBLOCK *Varp;
	59
	60	#define TABLESIZE 59
	61
	62	LOCAL Varp table[TABLESIZE];
	63
	64
	65
	66	LOCAL Varp mkbucket(vstg,memno)
	67	field vstg;
	68	int memno;
	69
	70	{
	71	Varp q;
	72
	73	q = ALLOC(varblock);
	74	q->vstg = vstg;
75	q->memno = memno;
76	return q;
77	}
78
79
80
81	LOCAL Varp lookup(p)
82	tagptr p;
83
84	{
85	int vstg, memno;
86	int key;
87	Varp q, r;
88
89	switch (p->tag)
90	{
91	case TTEMP:
92	vstg = 0;
93	memno = (int) p->tempblock.memalloc;
94	break;
95
96	case TADDR:
97	vstg = p->addrblock.vstg;
98	memno = p->addrblock.memno;
99	break;
100
101	default:
102	badtag ("lookup",p->tag);
103	}
104	key = memno % TABLESIZE;
105	q = table[key];
106
107	if (q)
108	{
109	for (; q; r = q, q = q->next)
110	if ((q->vstg == vstg) && (q->memno == memno))
111	return q;
112	return r->next = mkbucket(vstg,memno);
113	}
114	else
115	return table[key] = mkbucket(vstg,memno);
116	}
117
118
119
120	LOCAL freetable()
121
122	{
123	int i;
124	Varp p, q;
125
126	for (i = 0; i < TABLESIZE; i++)
127	if (table[i])
128	{
129	p = table[i];
130	table[i] = NULL;
131
132	while (p)
133	{
134	q = p->next;
135	free((char *) p);
136	p = q;
137	}
138	}
139	}
140
141	\f
142
143	Slotp newcode;
144	Slotp dohead, doend;
145	LOCAL Slotp first, last;
146	LOCAL commonset;
147	LOCAL int comocount; /* count of number of code motions done */
148
149
150	optloops()
151
152	{
153	int match;
154	Slotp nextslot;
155	Slotp sl1,sl2;
156	Slotp lastlabslot;
157	int lab;
158
159	if (! optimflag) return;
160	if (debugflag[6]) return;
161
162	lastlabslot = NULL;
163	comocount = 0;
164	for (sl1 = firstslot; sl1; sl1 = nextslot)
165	{
166	nextslot = sl1->next;
167	switch (sl1->type)
168	{
169	case SKLABEL:
170	lastlabslot = sl1;
171	break;
172
173	case SKGOTO:
174	if (lastlabslot && sl1->label == lastlabslot->label)
175	{
176	lab = newlabel ();
177	first = optinsert (SKLABEL,0,lab,0,lastlabslot->next);
178	last = sl1;
179	last->label = lab;
180	optloop ();
181	}
182	break;
183
184	case SKDOHEAD:
185	match = 0;
186	for (sl2 = sl1; sl2; sl2 = sl2->next)
187	{
188	if (sl2->type == SKDOHEAD) match++;
189	else if (sl2->type == SKENDDO) match--;
190	if (match == 0) break;
191	}
192	if (sl2)
193	last = sl2;
194	else
195	fatal ("unmatched do in code buffer");
196	if (sl2->type != SKENDDO)
197	fatal ("internal error in optloops");
198
199	/* last now points to the SKENDDO slot; the SKNULL slot
200	* is reached through last->nullslot
201	*/
202	last = (Slotp) last->nullslot;
203
204	first = sl1;
205
206	optloop ();
207	break;
208
209	default:
210	break;
211	}
212	}
213
214	if (debugflag[0])
215	fprintf (diagfile,"%d code motion%s performed\n",comocount,
216	(comocount==1 ? "" : "s") );
217	return;
218	}
219
220
221
222	optloop()
223
224	{
225	newcode = NULL;
226
227	modify();
228
229	return;
230	}
231
232	\f
233	LOCAL modify()
234
235	{
236	Slotp sp;
237	int s;
238
239	scanvars();
240
241	for (sp = first; sp != last->next; sp = sp->next)
242	switch (sp->type)
243	{
244	case SKEQ:
245	s = anex(sp->expr);
246	if (s == SCSAFE)
247	removesafe (&sp->expr);
248	break;
249
250	case SKARIF:
251	case SKASGOTO:
252	case SKCALL:
253	case SKCMGOTO:
254	case SKIFN:
255	case SKSTOP:
256	case SKRETURN:
257	case SKPAUSE:
258	case SKIOIFN:
259	s = anex(sp->expr);
260	if (s == SCSAFE)
261	removesafe(&sp->expr);
262	break;
263
264	default:
265	break;
266	}
267
268	freetable();
269	return;
270	}
271
272	\f
273	LOCAL scanvars()
274
275	{
276	Slotp sp;
277	Varp varinfo;
278	int i;
279	Varp p;
280
281	commonset = NO;
282
283	for (sp = first; sp != last->next; sp = sp->next)
284	{
285	switch (sp->type)
286	{
287	case SKARIF:
288	case SKASGOTO:
289	case SKCALL:
290	case SKCMGOTO:
291	case SKIFN:
292	case SKSTOP:
293	case SKRETURN:
294	case SKPAUSE:
295	case SKIOIFN:
296	case SKEQ:
297	setsuses(sp->expr);
298	break;
299
300	default:
301	break;
302	}
303	}
304
305	if (commonset)
306	for (i = 0; i < TABLESIZE; i++)
307	for (p = table[i]; p; p = p->next)
308	if (p->vstg == STGCOMMON)
309	{
310	p->sets++;
311	p->setfirst = NO;
312	}
313	}
314
315	\f
316	LOCAL setsuses(p)
317	expptr p;
318
319	{
320	Addrp lhs;
321	Varp varinfo;
322	chainp args;
323
324	if (!p) return;
325
326	switch (p->tag)
327	{
328	case TEXPR:
329	switch (p->exprblock.opcode)
330	{
331	default:
332	setsuses(p->exprblock.leftp);
333	setsuses(p->exprblock.rightp);
334	setsuses(p->exprblock.vleng);
335	break;
336
337	case OPASSIGN:
338	switch (p->exprblock.leftp->tag)
339	{
340	case TTEMP:
341	lhs = (Addrp) p->exprblock.leftp;
342	goto taddr;
343
344	case TADDR:
345	lhs = (Addrp) p->exprblock.leftp;
346	setsuses(lhs->memoffset);
347	setsuses(lhs->vleng);
348	taddr:
349	setsuses(p->exprblock.rightp);
350	setsuses(p->exprblock.vleng);
351	varinfo = lookup(lhs);
352	varinfo->sets++;
353	if (varinfo->uses == 0)
354	varinfo->setfirst = YES;
355	break;
356
357	default:
358	fatal("O6: l-value expected");
359	}
360	break;
361
362	case OPSTAREQ:
363	case OPPLUSEQ:
364	switch (p->exprblock.leftp->tag)
365	{
366	case TADDR:
367	lhs = (Addrp) p->exprblock.leftp;
368	break;
369	case TTEMP:
370	lhs = (Addrp) p->exprblock.leftp;
371	break;
372	default:
373	fatal("O7: l-value expected");
374	}
375	setsuses(p->exprblock.leftp);
376	setsuses(p->exprblock.rightp);
377	setsuses(p->exprblock.vleng);
378	varinfo = lookup(lhs);
379	varinfo->sets++;
380	break;
381
382	case OPCALL:
383	if (p->exprblock.leftp->tag != TADDR)
384	fatal("O8: subprogram expected");
385	setsuses(p->exprblock.rightp);
386	setsuses(p->exprblock.vleng);
387	if (p->exprblock.leftp->addrblock.vstg == STGINTR) break;
388	commonset = YES;
389	if (p->exprblock.rightp == NULL) break;
390	args = p->exprblock.rightp->listblock.listp;
391	for (; args; args = args->nextp)
392	if (args->datap->tag == TADDR)
393	{
394	lhs = (Addrp) args->datap;
395	switch (lhs->vstg)
396	{
397	case STGARG:
398	case STGAUTO:
399	case STGBSS:
400	case STGINIT:
401	case STGCOMMON:
402	case STGEQUIV:
403	case STGREG:
404	case STGPREG:
405	varinfo = lookup(lhs);
406	varinfo->sets++;
407	}
408	}
409	else if (args->datap->tag == TTEMP)
410	{
411	lhs = (Addrp) args->datap;
412	varinfo = lookup (lhs);
413	varinfo->sets++;
414	}
415	break;
416	}
417
418	return;
419
420	case TTEMP:
421	varinfo = lookup((Addrp) p);
422	varinfo->uses++;
423	return;
424
425	case TADDR:
426	setsuses(p->addrblock.memoffset);
427	setsuses(p->addrblock.vleng);
428	varinfo = lookup((Addrp) p);
429	varinfo->uses++;
430	return;
431
432	case TLIST:
433	for (args = p->listblock.listp; args; args = args->nextp)
434	setsuses(args->datap);
435
436	case TCONST:
437	case TERROR:
438	return;
439
440	default:
441	fatal("O9: bad tag value");
442	}
443	}
444
445	\f
446	LOCAL int anex(p)
447	expptr p;
448
449	{
450	int s1, s2, s3;
451	expptr q;
452	Varp varinfo;
453	chainp ch;
454	int setfirst;
455	expptr expr;
456
457
458	if (p == ENULL)
459	return SCSAFE;
460
461	switch (p->tag)
462	{
463	case TCONST:
464	return SCSAFE;
465
466	case TLIST:
467	for (ch = p->listblock.listp; ch; ch = ch->nextp)
468	{
469	s1 = anex (ch->datap);
470	if (s1 == SCSAFE)
471	removesafe (&ch->datap);
472	}
473	return SCFREE;
474
475	case TEXPR:
476	s1 = anex(p->exprblock.leftp);
477	s2 = anex(p->exprblock.rightp);
478	s3 = anex(p->exprblock.vleng);
479
480	switch (p->exprblock.opcode)
481	{
482	case OPASSIGN:
483	expr = p->exprblock.leftp;
484	varinfo = lookup(expr);
485	setfirst = varinfo->setfirst && (varinfo->sets == 1);
486	if (expr->tag == TTEMP && setfirst &&
487	s2 == SCSAFE && s3 == SCSAFE)
488	{
489	movefrtemp (expr);
490	return SCSAFE;
491	}
492	else
493	{
494	if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
495	if (s3 == SCSAFE) removesafe (&p->exprblock.vleng);
496	return SCFREE;
497	}
498
499	case OPNEG:
500	case OPNOT:
501	case OPABS:
502	case OPADDR:
503	case OPBITNOT:
504	if ((s2 == SCSAFE) && (s3 == SCSAFE))
505	return s1;
506	else
507	return SCFREE;
508
509	case OPCONV:
510	if ((s2 != SCSAFE) \|\| (s3 != SCSAFE))
511	return SCFREE;
512
513	if (ISINT(p->exprblock.vtype))
514	return s1;
515	if (ISINT(p->exprblock.leftp->headblock.vtype))
516	return s1;
517
518	return SCFREE;
519
520
521	case OPSTAR:
522	if (ISINT(p->exprblock.vtype))
523	goto safeop;
524
525	if (safefactor(p->exprblock.leftp) \|\|
526	safefactor(p->exprblock.rightp))
527	goto safeop;
528
529	goto floatop;
530
531
532	case OPPLUS:
533	case OPMINUS:
534	if (ISINT(p->exprblock.vtype))
535	goto safeop;
536
537	floatop:
538	if (!(ISREAL(p->exprblock.vtype) \|\| ISCOMPLEX(p->exprblock.vtype)))
539	return SCFREE;
540
541	switch (s1)
542	{
543	case SCSAFE:
544	removesafe(&p->exprblock.leftp);
545	if (s2 == SCSAFE)
546	removesafe(&p->exprblock.leftp);
547	return SCFREE;
548
549	case SCFREE:
550	if (s2 == SCSAFE)
551	removesafe(&p->exprblock.rightp);
552	return SCFREE;
553	}
554
555	case OPOR:
556	case OPAND:
557	case OPEQV:
558	case OPNEQV:
559	case OPLT:
560	case OPEQ:
561	case OPGT:
562	case OPLE:
563	case OPNE:
564	case OPGE:
565	case OPLSHIFT:
566	case OPMIN:
567	case OPMAX:
568	case OPBITOR:
569	case OPBITAND:
570	case OPBITXOR:
571	case OPRSHIFT:
572	safeop:
573	if ((p->exprblock.vleng != ENULL) && ( ! ISCONST(p->exprblock.vleng)))
574	return SCFREE;
575
576	switch (s1)
577	{
578	case SCSAFE:
579	if (s2 == SCFREE) removesafe (&p->exprblock.leftp);
580	return s2;
581
582	case SCFREE:
583	if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
584	return SCFREE;
585	}
586
587	default:
588	if (s1 == SCSAFE) removesafe(&p->exprblock.leftp);
589	if (s2 == SCSAFE) removesafe(&p->exprblock.rightp);
590	if (s3 == SCSAFE) removesafe(&p->exprblock.vleng);
591	return SCFREE;
592	}
593
594
595	case TTEMP:
596	varinfo = lookup(p);
597	if (varinfo->sets == 0)
598	return SCSAFE;
599	else
600	return SCFREE;
601
602	case TADDR:
603	s1 = anex(p->addrblock.memoffset);
604	s2 = anex(p->addrblock.vleng);
605
606	varinfo = lookup(p);
607
608	if (varinfo->sets == 0)
609	switch (s1)
610	{
611	case SCSAFE:
612	if (s2 == SCFREE) removesafe(&p->addrblock.memoffset);
613	return s2;
614
615	case SCFREE:
616	if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
617	return SCFREE;
618	}
619
620	if (s1 == SCSAFE) removesafe(&p->addrblock.memoffset);
621	if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
622	return SCFREE;
623
624
625	default:
626	return SCFREE;
627	}
628	}
629
630
631	LOCAL safefactor(p)
632	expptr p;
633
634	{
635	if ( ! ISCONST(p))
636	return NO;
637
638	if (ISINT(p->constblock.vtype))
9868d2fe	639	if (abs(p->constblock.constant.ci) <= 1)
67c207eb KM	640	return YES;
	641
	642	if (ISREAL(p->constblock.vtype))
9868d2fe	643	if (abs(p->constblock.constant.cd[0]) <= 1.0)
67c207eb KM	644	return YES;
	645
	646	return NO;
	647	}
	648
	649	\f
	650	LOCAL int worthcost(p)
	651	expptr p;
	652
	653	{
	654	int cost;
	655	chainp q;
	656	expptr memoffset,vleng;
	657
	658	if (p == ENULL)
	659	return NO;
	660
	661	switch (p->tag)
	662	{
	663	case TCONST:
	664	return NO;
	665
	666	case TTEMP:
	667	return NO;
	668
	669	case TADDR:
	670	if ((vleng = p->addrblock.vleng) && ! ISCONST(vleng))
	671	return NO; /* Can't make variable length temporaries */
	672	if ((memoffset = p->addrblock.memoffset) && ! ISCONST(memoffset))
	673	return YES;
	674	else
	675	return NO;
	676
	677	case TEXPR:
	678	return YES;
	679
	680	case TLIST:
	681	cost = 0;
	682	for (q = p->listblock.listp; q; q = q->nextp)
	683	{
	684	if (worthcost ((expptr) q->datap))
	685	return YES;
	686	cost++;
	687	}
	688	return (cost>2 ? YES : NO);
	689
	690	default:
	691	return NO;
	692	}
	693	}
	694
	695	\f
	696	LOCAL removesafe(refexpr)
	697	expptr *refexpr;
	698
	699	{
	700	expptr ep;
	701	Tempp ap;
	702	Slotp newslot;
	703
	704	extern Addrp gettemp();
	705
	706	ep = *refexpr;
	707	if (! worthcost(ep))
708	return;
709
710	if (ep->tag == TEXPR && ep->exprblock.opcode == OPASSIGN)
711	{
712	if (ep->exprblock.leftp->tag != TTEMP)
713	fatal ("non-TEMP in assignment to be moved in optloop");
714
715	newslot = optinsert (SKEQ, ep, 0, 0, first);
716	*refexpr = (expptr) cpexpr (ep->exprblock.leftp);
717	}
718	else
719	{
720	ap = (Tempp) gettemp(ep);
721	newslot = optinsert (SKEQ, mkexpr(OPASSIGN,cpexpr(ap),ep), 0, 0, first);
722	*refexpr = (expptr) ap;
723	optinsert (SKFRTEMP,ap->memalloc,0,0,last->next);
724	}
725
726	comocount++;
727	if (!newcode)
728	newcode = newslot;
729
730	return;
731	}
732
733	\f
734	LOCAL Addrp gettemp(p)
735	expptr p;
736
737	{
738	return mktemp(p->headblock.vtype, p->headblock.vleng);
739	}
740
741
742
743	LOCAL movefrtemp (expr)
744	Tempp expr;
745
746	{
747	Slotp s;
748
749	if (expr->tag != TTEMP)
750	badtag ("movefrtemp",expr->tag);
751
752	for (s = first; s; s = s->next)
753	if (s->type == SKFRTEMP && s->expr == (expptr) expr->memalloc)
754	{
755	removeslot (s);
756	insertslot (s,last->next);
757	return;
758	}
759	}