1 /*-
2  * Copyright (c) 1980 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.proprietary.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)regalloc.c	5.3 (Berkeley) 04/12/91";
10 #endif /* not lint */
11 
12 /*
13  * regalloc.c
14  *
15  * Register optimization routines for f77 compiler, pass 1
16  *
17  * University of Utah CS Dept modification history:
18  *
19  * $History$
20  * $Log:	regalloc.c,v $
21  * Revision 1.4  86/02/12  15:29:16  rcs
22  * 4.3 F77. C. Keating.
23  *
24  * Revision 2.9  85/03/18  21:35:05  donn
25  * Bob Corbett's hack to prevent conflicts between subroutine side effects
26  * and register assignment.  Makes the code a lot worse...
27  *
28  * Revision 2.8  85/02/22  02:14:08  donn
29  * In code like 'x = foo(x)', alreg() would copy the memory version of the
30  * variable 'x' into the register version after the assignment, clobbering
31  * the result.  A small change to regwrite() seems to prevent this.
32  *
33  * Revision 2.7  85/02/16  03:32:45  donn
34  * Fixed a bug where the loop test and increment were having register
35  * substitution performed twice, once in the environment of the current
36  * loop and once in the environment of the containing loop.  If the
37  * containing loop puts (say) the inner loop's index variable in register
38  * but the inner loop does not, havoc results.
39  *
40  * Revision 2.6  85/02/14  23:21:45  donn
41  * Don't permit variable references of the form 'a(i)' to be put in register
42  * if array 'a' is in common.  This is because there is no good way to
43  * identify instances of this sort without getting confused with other
44  * variables in the same common block which are in register.  Sigh.
45  *
46  * Revision 2.5  85/01/11  21:08:00  donn
47  * Made changes so that we pay attention to SAVE statements.  Added a new
48  * gensetreturn() function to implement this.
49  *
50  * Revision 2.4  84/09/03  22:37:28  donn
51  * Changed the treatment of SKRETURN in alreg() so that all variables in
52  * register, not just COMMON variables, get written out to memory before a
53  * RETURN.  This was causing the return value of a function to get lost when
54  * a RETURN was done from inside a loop (among other problems).
55  *
56  * Revision 2.3  84/08/04  20:52:42  donn
57  * Added fixes for EXTERNAL parameters from Jerry Berkman.
58  *
59  * Revision 2.2  84/08/04  20:34:29  donn
60  * Fixed a stupidity pointed out by Jerry Berkman -- the 'floats in register'
61  * stuff applies if the TARGET is a VAX, not if the local machine is a VAX.
62  *
63  * Revision 2.1  84/07/19  12:04:47  donn
64  * Changed comment headers for UofU.
65  *
66  * Revision 1.5  83/11/27  19:25:41  donn
67  * Added REAL to the list of types which may appear in registers (VAXen only).
68  *
69  * Revision 1.4  83/11/13  02:38:39  donn
70  * Bug fixed in alreg()'s handling of computed goto's.  A '<=' in place of a
71  * '<' led to core dumps when we walked off the end of the list of labels...
72  *
73  * Revision 1.3  83/11/12  01:25:57  donn
74  * Bug in redundant register assignment code, mistakenly carried over some old
75  * code that sometimes rewound a slot pointer even when a redundant slot wasn't
76  * deleted; this caused an infinite loop...  Seems to work now.
77  *
78  * Revision 1.2  83/11/09  14:58:12  donn
79  * Took out broken code dealing with redundant register initializations.
80  * Couldn't see what to do about redundantly initializing a DO variable but
81  * I did fix things so that an assignment from a register into the same
82  * register is always deleted.
83  *
84  */
85 
86 #include "defs.h"
87 #include "optim.h"
88 
89 #define LABTABSIZE 101
90 #define VARTABSIZE 1009
91 #define TABLELIMIT 12
92 
93 #if TARGET==VAX || TARGET==TAHOE
94 #define MSKREGTYPES M(TYLOGICAL) | M(TYADDR) | M(TYSHORT) | M(TYLONG) | M(TYREAL)
95 #if TARGET==TAHOE
96 #define BUMPREALS	/* put floats last */
97 #endif
98 #else
99 #define MSKREGTYPES M(TYLOGICAL) | M(TYADDR) | M(TYSHORT) | M(TYLONG)
100 #endif
101 
102 
103 #define ISREGTYPE(x) ONEOF(x, MSKREGTYPES)
104 
105 #define MSKVARS M(STGAUTO) | M(STGBSS) | M(STGINIT) | M(STGCONST) |\
106 		M(STGEQUIV) | M(STGARG) | M(STGCOMMON)
107 
108 #define ISVAR(x) ((((expptr) x)->headblock.vclass == CLVAR || \
109 			((expptr) x)->headblock.vclass == CLUNKNOWN) \
110                   && ONEOF(((expptr) x)->headblock.vstg, MSKVARS))
111 
112 
113 typedef
114   struct regdata
115     {
116       field vstg;
117       field vtype;
118       int memno;
119       int memoffset;
120       int refs;
121       Addrp stgp;
122       unsigned isarrayarg : 1;
123       unsigned istemp : 1;
124       unsigned isset : 1;
125       unsigned setfirst : 1;
126     } REGDATA;
127 
128 
129 typedef
130   struct labelnode
131     {
132       struct labelnode *link;
133       int labelno;
134     } LABELNODE;
135 
136 
137 
138 typedef
139   struct varnode
140     {
141       struct varnode *link;
142       int memoffset;
143       unsigned isset : 1;
144       unsigned isused : 1;
145       unsigned setfirst : 1;
146       unsigned unusable : 1;
147       int refs;
148       Addrp stgp;
149     } VARNODE;
150 
151 
152 typedef
153   struct addrnode
154     {
155       struct addrnode *link;
156       field vtype;
157       field vstg;
158       int memno;
159       unsigned istemp : 1;
160       unsigned isset : 1;
161       unsigned loopset :1;
162       unsigned freeuse : 1;
163       unsigned mixedtype : 1;
164       unsigned fixed : 1;
165       int refs;
166       struct addrnode *commonlink;
167       VARNODE *varlist;
168     } ADDRNODE;
169 
170 
171 typedef
172   struct setnode
173     {
174       struct setnode *link;
175       field vstg;
176       int memno;
177       int memoffset;
178     } SETNODE;
179 
180 
181 typedef
182   struct doqueue
183     {
184       struct doqueue *up, *down;
185       Slotp dohead, doend;
186       int nregvars;
187       REGNODE *reg[MAXREGVAR];
188     }  DOQUEUE;
189 
190 LOCAL DOQUEUE *dqptr, *dqtop, *dqbottom;
191 
192 
193 LOCAL Slotp dohead;
194 LOCAL Slotp doend;
195 LOCAL Slotp newcode;
196 
197 
198 
199 LOCAL LABELNODE *labeltable[LABTABSIZE];
200 LOCAL ADDRNODE *vartable[VARTABSIZE];
201 LOCAL ADDRNODE *commonvars;
202 LOCAL SETNODE *setlist;
203 LOCAL int topregvar;
204 LOCAL int toplcv;
205 LOCAL int allset;
206 LOCAL ADDRNODE *currentaddr;
207 LOCAL int loopcost;
208 LOCAL REGDATA *regtab[MAXREGVAR];
209 LOCAL REGDATA *rt[TABLELIMIT];
210 LOCAL int tabletop;
211 LOCAL int linearcode;
212 LOCAL int docount;
213 LOCAL int globalbranch;
214 LOCAL int commonunusable;
215 LOCAL int regdefined[MAXREGVAR];
216 LOCAL int memdefined[MAXREGVAR];
217 LOCAL int regaltered[MAXREGVAR];
218 
219 
220 
221 LOCAL insertlabel(l)
222 int l;
223 
224 {
225   int key;
226   LABELNODE *p;
227 
228   key = l % LABTABSIZE;
229   for (p = labeltable[key]; p; p = p->link)
230     if (p->labelno == l) return;
231   p = labeltable[key];
232   labeltable[key] = ALLOC(labelnode);
233   labeltable[key]->link = p;
234   labeltable[key]->labelno = l;
235   return;
236 }
237 
238 
239 
240 LOCAL int locallabel(l)
241 int l;
242 
243 {
244   int key;
245   LABELNODE *p;
246 
247   key = l % LABTABSIZE;
248   for (p = labeltable[key]; p; p = p->link)
249     if (p->labelno == l) return YES;
250 
251   return NO;
252 }
253 
254 
255 
256 LOCAL freelabtab()
257 
258 {
259   int i;
260   LABELNODE *p, *q;
261 
262   for (i = 0; i < LABTABSIZE; i++)
263     if (labeltable[i])
264       {
265 	p = labeltable[i];
266 	labeltable[i] = NULL;
267 	while (p)
268 	  {
269 	    q = p->link;
270 	    free(p);
271 	    p = q;
272 	  }
273       }
274   return;
275 }
276 
277 
278 
279 LOCAL ADDRNODE *getaddr(ap)
280 Addrp ap;
281 
282 {
283   int key;
284   field vstg;
285   int memno;
286   register ADDRNODE *q;
287   ADDRNODE *q1;
288 
289   if (!ISVAR(ap))
290     fatal("regalloc: bad data sent to getaddr");
291   vstg = ap->vstg;
292   memno = ap->memno;
293   key = (256*vstg + memno) % VARTABSIZE;
294 
295   for (q = vartable[key]; q; q = q->link)
296     if ((q->vstg == vstg) && (q->memno == memno))
297       {
298 	if (ap->istemp) q->istemp = YES;
299 	if (ap->vtype != q->vtype)
300 	  q->mixedtype = YES;
301 	if (!fixedaddress(ap))
302 	  q->fixed = NO;
303 	return q;
304       }
305 
306   q1 = vartable[key];
307   vartable[key] = q = ALLOC(addrnode);
308   q->link = q1;
309   q->vstg = vstg;
310   q->memno = memno;
311   if (ap->istemp) q->istemp = YES;
312   if (fixedaddress(ap)) q->fixed = YES;
313   q->vtype = ap->vtype;
314   q->varlist = NULL;
315   if (vstg == STGCOMMON)
316     {
317       q->commonlink = commonvars;
318       commonvars = q;
319     }
320   return q;
321 }
322 
323 
324 
325 LOCAL VARNODE *getvar(ainfo, ap)
326 ADDRNODE *ainfo;
327 Addrp ap;
328 
329 {
330   register VARNODE *q;
331   register VARNODE *q1;
332 
333   int memoffset;
334 
335   if (!ISVAR(ap))
336     fatal("regalloc:  bad data sent to getvar");
337 
338   memoffset = ap->memoffset->constblock.constant.ci;
339 
340   for (q = ainfo->varlist; q; q = q->link)
341     if (q->memoffset == memoffset)
342       return q;
343 
344   q1 = ainfo->varlist;
345   ainfo->varlist = q = ALLOC(varnode);
346   q->link = q1;
347   q->memoffset = memoffset;
348   q->stgp = (Addrp) cpexpr(ap);
349   return q;
350 }
351 
352 
353 LOCAL ADDRNODE *lookupaddr(vstg, memno)
354 field vstg;
355 int memno;
356 
357 {
358   int key;
359   register ADDRNODE *q;
360 
361   key = (256*vstg + memno) % VARTABSIZE;
362 
363   for (q = vartable[key]; q; q = q->link)
364     if ((q->vstg == vstg) && (q->memno == memno))
365       return q;
366 
367   fatal("regalloc:  lookupaddr");
368 }
369 
370 
371 LOCAL VARNODE *lookupvar(ainfo, memoffset)
372 ADDRNODE *ainfo;
373 int memoffset;
374 
375 {
376   register VARNODE *q;
377 
378   for (q = ainfo->varlist; q; q = q->link)
379     if (q->memoffset == memoffset)
380       return q;
381 
382   fatal("regalloc:  lookupvar");
383 }
384 
385 
386 
387 LOCAL int invartable(p)
388 REGNODE *p;
389 
390 {
391   field vstg;
392   int memno;
393   int key;
394   register ADDRNODE *q;
395 
396   vstg = p->vstg;
397   memno = p->memno;
398   key = (256*vstg + memno) % VARTABSIZE;
399 
400   for (q = vartable[key]; q; q = q->link)
401     if ((q->vstg == vstg) && (q->memno == memno))
402       return YES;
403 
404   return NO;
405 }
406 
407 
408 
409 LOCAL freevartab()
410 
411 {
412   register ADDRNODE *p;
413   ADDRNODE *p1;
414   register VARNODE *q;
415   VARNODE *q1;
416   register int i;
417 
418   for (i = 0; i < VARTABSIZE; i++)
419     if (vartable[i])
420       {
421 	p = vartable[i];
422 	vartable[i] = NULL;
423 
424 	while (p)
425 	  {
426 	    for (q = p->varlist; q; q = q1)
427 	      {
428 		q1 = q->link;
429 		frexpr(q->stgp);
430 		free ((char *) q);
431 	      }
432 	    p1 = p->link;
433 	    free((char *) p);
434 	    p = p1;
435 	  }
436       }
437 }
438 
439 
440 
441 LOCAL insertset(vstg, memno, memoffset)
442 field vstg;
443 int memno;
444 int memoffset;
445 
446 {
447   register SETNODE *p;
448   SETNODE *q;
449 
450   if (allset) return;
451   for (p = setlist; p; p = p->link)
452     if((p->vstg == vstg) && (p->memno == memno) && (p->memoffset == memoffset))
453       return;
454 
455   q = p;
456   setlist = p = ALLOC(setnode);
457   p->link = q;
458   p->vstg = vstg;
459   p->memno = memno;
460   p->memoffset = memoffset;
461   return;
462 }
463 
464 
465 
466 LOCAL int insetlist(vstg, memno, memoffset)
467 field vstg;
468 int memno;
469 int memoffset;
470 
471 {
472   register SETNODE *p;
473 
474   if (allset) return YES;
475   for (p = setlist; p; p = p->link)
476     if((p->vstg == vstg) && (p->memno == memno) && (p->memoffset == memoffset))
477       return YES;
478 
479   return NO;
480 }
481 
482 
483 
484 LOCAL clearsets()
485 
486 {
487   register SETNODE *p, *q;
488 
489   allset = NO;
490 
491   p = setlist;
492   while (p)
493     {
494       q = p->link;
495       free ((char *) p);
496       p = q;
497     }
498   setlist = NULL;
499   return;
500 }
501 
502 
503 
504 LOCAL alreg()
505 
506 {
507   register Slotp sp;
508   register int i;
509   register ADDRNODE *p;
510   register VARNODE *q;
511   Slotp sp1, sp2;
512   ADDRNODE *addrinfo;
513   VARNODE *varinfo;
514   struct Labelblock **lp;
515   int toptrack;
516   int track[MAXREGVAR];
517   Addrp ap, ap1;
518   DOQUEUE *dqp;
519   REGDATA *rp;
520   REGNODE *regp;
521 
522   if (nregvar >= maxregvar) return;
523 
524   commonvars = NULL;
525   docount = 0;
526 
527   for (sp = dohead; sp != doend->next; sp = sp->next)
528     switch (sp->type)
529       {
530       case SKLABEL:
531 	insertlabel(sp->label);
532 	break;
533 
534       case SKARIF:
535       case SKASGOTO:
536       case SKCALL:
537       case SKCMGOTO:
538       case SKEQ:
539       case SKIFN:
540       case SKIOIFN:
541       case SKSTOP:
542       case SKPAUSE:
543       case SKRETURN:
544 	scanvars(sp->expr);
545 	break;
546 
547       case SKDOHEAD:
548 	++docount;
549 	break;
550 
551       case SKENDDO:
552 	--docount;
553 	break;
554 
555       case SKNULL:
556       case SKGOTO:
557       case SKASSIGN:
558 	break;
559 
560       default:
561 	badthing ("SKtype", "alreg-1", sp->type);
562       }
563 
564   loopcost = 0;
565   docount = 1;
566   commonunusable = NO;
567   if (! dohead->nullslot) fatal ("missing dohead->nullslot -cbb");
568   for (sp = dohead->next, globalbranch = NO;
569        docount;
570        sp = sp->next, clearsets(), globalbranch = NO)
571     if (docount > 1)
572       switch (sp->type)
573 	{
574 	case SKDOHEAD:
575 	  docount++;
576 	  break;
577 
578 	case SKENDDO:
579 	  docount--;
580 
581 	default:
582 	  break;
583 	}
584     else
585       switch (sp->type)
586 	{
587 	case SKARIF:
588 #define LM   ((struct Labelblock * *)sp->ctlinfo)[0]->labelno
589 #define LZ   ((struct Labelblock * *)sp->ctlinfo)[1]->labelno
590 #define LP   ((struct Labelblock * *)sp->ctlinfo)[2]->labelno
591 
592 	  if (!locallabel(LM) || !locallabel(LZ) || !locallabel(LP))
593 	    {
594 	      setall();
595 	      globalbranch = YES;
596 	    }
597 	  countrefs(sp->expr);
598 	  break;
599 
600 	case SKASGOTO:
601 	  setall();
602 	  globalbranch = YES;
603 	  countrefs(sp->expr);
604 	  break;
605 
606 	case SKCMGOTO:
607 	  lp = (struct Labelblock **) sp->ctlinfo;
608 	  for (i = 0; i < sp->label; i++, lp++)
609 	    if (!locallabel((*lp)->labelno))
610 	      {
611 		setall();
612 		globalbranch = YES;
613 		break;
614 	      }
615 	  countrefs(sp->expr);
616 	  break;
617 
618 	case SKDOHEAD:
619 	  globalbranch = YES;
620 	  loopcost = 2;
621 	  docount++;
622 	  break;
623 
624 	case SKENDDO:
625 	  docount = 0;
626 	  break;
627 
628 	case SKGOTO:
629 	  if (!locallabel(sp->label))
630 	    {
631 	      setall();
632 	      globalbranch = YES;
633 	    }
634 	  break;
635 
636 	case SKIFN:
637 	case SKIOIFN:
638 	  if (!locallabel(sp->label))
639 	    {
640 	      setall();
641 	      globalbranch = YES;
642 	    }
643 	  countrefs(sp->expr);
644 	  break;
645 
646 	case SKEQ:
647 	case SKCALL:
648 	case SKSTOP:
649 	case SKPAUSE:
650 	  linearcode = YES;
651 	  countrefs(sp->expr);
652 	  linearcode = NO;
653 	  break;
654 	}
655 
656   topregvar = toplcv = nregvar - 1;
657 
658   for (i = 0; i < nregvar; i++)
659     {
660       ap = memversion(regnamep[i]);
661       regtab[i] = rp = ALLOC(regdata);
662       rp->vstg = ap->vstg;
663       rp->vtype = ap->vtype;
664       rp->memno = ap->memno;
665       rp->memoffset = ap->memoffset->constblock.constant.ci;
666       rp->isarrayarg = NO;
667       rp->stgp = ap;
668     }
669 
670   for (i = 0; i < MAXREGVAR; i++)
671     track[i] = YES;
672 
673   for (dqp = dqptr->down; dqp; dqp = dqp->down)
674     {
675       if (dqp->nregvars - 1 > topregvar)
676 	topregvar = dqp->nregvars -1;
677       for (i = toplcv + 1; i < dqp->nregvars; i++)
678 	if (track[i])
679 	  if (regp = dqp->reg[i])
680 	    if (rp = regtab[i])
681 	      {
682 		if (!samevar(rp, regp))
683 		  track[i] = NO;
684 	      }
685 	    else if (invartable(regp))
686 	      {
687 		regtab[i] = rp = ALLOC(regdata);
688 		rp->vstg = regp->vstg;
689 		rp->vtype = regp->vtype;
690 		rp->memno = regp->memno;
691 		rp->memoffset = regp->memoffset;
692 		addrinfo = lookupaddr(rp->vstg, rp->memno);
693 		if (regp->isarrayarg)
694 		  {
695 		    rp->isarrayarg = YES;
696 		    rp->refs = addrinfo->refs;
697 		  }
698 		else
699 		  {
700 		    varinfo = lookupvar(addrinfo, regp->memoffset);
701 		    rp->refs = varinfo->refs;
702 		    rp->stgp = (Addrp) cpexpr(varinfo->stgp);
703 		    rp->istemp = addrinfo->istemp;
704 		    rp->isset = varinfo->isset;
705 		    rp->setfirst = varinfo->setfirst;
706 		  }
707 	      }
708 	    else
709               track[i] = NO;
710 	  else
711 	    track[i] = NO;
712     }
713 
714   toptrack = topregvar;
715 
716   for (i = toplcv + 1; i <= topregvar; i++)
717     if (regtab[i])
718       if ((track[i] == NO) || (regtab[i]->refs <= 0))
719         {
720 	  free((char *) regtab[i]);
721 	  regtab[i] = NULL;
722         }
723 
724   tabletop = -1;
725   if (topregvar < maxregvar - 1)
726     for (i = 0; i < VARTABSIZE; i++)
727       for (p = vartable[i]; p; p = p->link)
728 	{
729 	  entableaddr(p);
730 	  if ((!p->loopset) &&
731 	      (!p->mixedtype) &&
732 	      (p->vstg != STGARG) &&
733 	      !((p->vstg == STGCOMMON) && ((!p->fixed) || commonunusable)))
734 	    for (q = p->varlist; q; q = q->link)
735 	      entablevar(q);
736 	}
737 
738   for (i = 0; (i <= tabletop) && (topregvar + 1 < maxregvar); i++)
739     {
740       if (inregtab(rt[i]) || (loopcost && rt[i]->isset))
741 	continue;
742       topregvar++;
743       regtab[topregvar] = rp = ALLOC(regdata);
744       rp->vstg = rt[i]->vstg;
745       rp->vtype = rt[i]->vtype;
746       rp->memno = rt[i]->memno;
747       rp->memoffset = rt[i]->memoffset;
748       rp->refs = rt[i]->refs;
749       rp->stgp = (Addrp) cpexpr(rt[i]->stgp);
750       rp->isarrayarg = rt[i]->isarrayarg;
751       rp->istemp = rt[i]->istemp;
752       rp->isset = rt[i]->isset;
753       rp->setfirst = rt[i]->setfirst;
754     }
755 
756   for (i = toplcv + 1; i <= topregvar; i++)
757     {
758       if (rp = regtab[i])
759 	if (rp->isarrayarg)
760 	  {
761 	    ap = ALLOC(Addrblock);
762 	    ap->tag = TADDR;
763 	    ap->vstg = STGREG;
764 	    ap->vtype = TYADDR;
765 	    ap->vclass = CLVAR;
766 	    ap->memno = regnum[i];
767 	    ap->memoffset = ICON(0);
768 
769 	    ap1 = ALLOC(Addrblock);
770 	    ap1->tag = TADDR;
771 	    ap1->vstg = rp->vstg;
772 	    ap1->vtype = rp->vtype;
773 	    ap1->vclass = CLVAR;
774 	    ap1->memno = rp->memno;
775 	    ap1->memoffset = ICON(0);
776 
777 	    insertassign(dohead, ap, addrof(ap1));
778 	  }
779         else if (!(rp->setfirst && rp->istemp))
780 	  {
781 	    if (rp->istemp)
782 	      for (sp = newcode; sp && sp != dohead; sp = sp->next)
783 	        if (sp->type == SKEQ)
784 		  {
785 		    ap = (Addrp) sp->expr->exprblock.leftp;
786 		    if ((ap->vstg == rp->vstg) && (ap->memno == rp->memno) &&
787 			fixedaddress(ap) &&
788 			(ap->memoffset->constblock.constant.ci == rp->memoffset))
789 		      {
790 			changetoreg(ap, i);
791 			goto L1;
792 		      }
793 		  }
794 	    ap = (Addrp) cpexpr(rp->stgp);
795 	    changetoreg(ap, i);
796 	    insertassign(dohead, ap, cpexpr(rp->stgp));
797 	  }
798 L1:;
799     }
800 
801   for (i = toplcv + 1; i <= topregvar; i++)
802     if (rp = regtab[i])
803       if (rp->isset && !(rp->istemp || rp->isarrayarg))
804 	{
805 	  ap = (Addrp) cpexpr(rp->stgp);
806 	  changetoreg(ap, i);
807 	  appendassign(doend, cpexpr(rp->stgp), ap);
808 	}
809 
810   docount = 1;
811   clearmems();
812   setregs();
813   sp = dohead->next;
814   if (loopcost)
815     for (i = toptrack + 1; i <= topregvar; i++)
816       if ((rp = regtab[i]) && !rp->isarrayarg)
817 	{
818 	  ap = (Addrp) cpexpr(rp->stgp);
819 	  changetoreg(ap, i);
820 	  insertassign(sp, cpexpr(rp->stgp), ap);
821 	}
822 
823   for ( sp = dohead->next;
824 	docount || sp->type != SKNULL;
825 	sp = sp->next)
826     if (docount > 1)
827       switch (sp->type)
828 	{
829 	case SKDOHEAD:
830 	  docount++;
831 	  break;
832 
833 	case SKENDDO:
834 	  if (--docount == 1)
835 	    {
836 	      /*
837 	       * Remove redundant stores to memory.
838 	       */
839 	      sp1 = sp->nullslot->next;
840 	      while (sp1)
841 		{
842 		  if (regtomem(sp1))
843 		    {
844 		      ap = (Addrp) sp1->expr->exprblock.rightp;
845 		      sp2 = sp1->next;
846 		      for (i = toplcv + 2; i <= toptrack; i++)
847 			if (regtab[i] && (regnum[i] == ap->memno))
848 			  {
849 			    deleteslot(sp1);
850 			    break;
851 			  }
852 		      sp1 = sp2;
853 		    }
854 		  else
855 		    sp1 = NULL;
856 		}
857 
858 	      /*
859 	       * Restore register variables (complement to DOHEAD code).
860 	       */
861 	      sp1 = sp->nullslot->next;
862 	      for (i = toplcv + 1; i <= topregvar; i++)
863 		if (rp = regtab[i])
864 		  if (!regdefined[i])
865 		    if (i >= dqp->nregvars || !samevar(rp, dqp->reg[i]))
866 		      {
867 			ap = (Addrp) cpexpr(rp->stgp);
868 			changetoreg(ap, i);
869 			insertassign(sp1, ap, cpexpr(rp->stgp));
870 			regdefined[i] = YES;
871 		      }
872 
873 	      clearmems();
874 	      if (toplcv + 1 < maxregvar)
875 		memdefined[toplcv + 1] = YES;
876 	      sp = sp1->prev;
877 	    }
878 	  break;
879 	}
880       else
881 	{
882 	  setregs();
883 	  for (i = 0; i <= MAXREGVAR; i++)
884 	    regaltered[i] = NO;
885 	  globalbranch = NO;
886 
887 	  switch (sp->type)
888 	    {
889 	    case SKLABEL:
890 	      clearmems();
891 	      break;
892 
893 	    case SKGOTO:
894 	      if (!locallabel(sp->label))
895 		gensetall(sp);
896 	      break;
897 
898 	    case SKENDDO:
899 	      docount = 0;
900 	      break;
901 
902 	    case SKRETURN:
903 	      gensetreturn(sp);
904 	      linearcode = YES;
905 	      regwrite(sp, sp->expr);
906 	      linearcode = NO;
907 	      break;
908 
909 	    case SKDOHEAD:
910 	      /*
911 	       * If one of the current loop's register variables is not in
912 	       * register in an inner loop, we must save it.  It's a pity
913 	       * we don't save enough info to optimize this properly...
914 	       */
915 	      for (dqp = dqptr->down; dqp; dqp = dqp->down)
916 		if (dqp->dohead == sp)
917 		  break;
918 	      if (dqp == NULL)
919 		fatal("confused in alreg loop analysis");
920 	      for (i = toplcv + 1; i <= topregvar; i++)
921 		if (rp = regtab[i])
922 		  if (!memdefined[i])
923 		    if (i >= dqp->nregvars || !samevar(rp, dqp->reg[i]))
924 		      {
925 			ap = (Addrp) cpexpr(rp->stgp);
926 			changetoreg(ap, i);
927 			insertassign(sp, cpexpr(rp->stgp), ap);
928 			memdefined[i] = YES;
929 			regdefined[i] = NO;
930 		      }
931 
932 	      docount++;
933 	      globalbranch = YES;
934 	      break;
935 
936 	    case SKEQ:
937 	    case SKCALL:
938 	    case SKSTOP:
939 	    case SKPAUSE:
940 	      linearcode = YES;
941 	      regwrite(sp, sp->expr);
942 	      for (i = toplcv + 1; i <= topregvar; i++)
943 		if (!regdefined[i] && ((rp = regtab[i]) && rp->isset))
944 		  {
945 		    ap = (Addrp) cpexpr(rp->stgp);
946 		    changetoreg(ap, i);
947 		    appendassign(sp, ap, cpexpr(rp->stgp));
948 		    sp = sp->next;
949 		    regdefined[i] = YES;
950 		  }
951 	      linearcode = NO;
952 
953 	      /*
954 	       * Eliminate redundant register moves.
955 	       */
956 	      if (regtoreg(sp))
957 		{
958 		  ap = (Addrp) sp->expr->exprblock.leftp;
959 	          sp1 = sp->prev;
960 		  for (i = toplcv + 1; i <= toptrack; i++)
961 		    if (regtab[i] && (regnum[i] == ap->memno))
962 		      {
963 			deleteslot(sp);
964 			sp = sp1;
965 			break;
966 		      }
967 		}
968 	      break;
969 
970 	    case SKARIF:
971 	      if (!locallabel(LM) || !locallabel(LZ) || !locallabel(LP))
972 		{
973 		  gensetall(sp);
974 		  globalbranch = YES;
975 		}
976 	      regwrite(sp, sp->expr);
977 	      break;
978 
979 	    case SKASGOTO:
980 	      gensetall(sp);
981 	      globalbranch = YES;
982 	      regwrite(sp, sp->expr);
983 	      break;
984 
985 	    case SKCMGOTO:
986 	      lp = (struct Labelblock **) sp->ctlinfo;
987 	      for (i = 0; i < sp->label; i++, lp++)
988 		if (!locallabel((*lp)->labelno))
989 		  {
990 		    gensetall(sp);
991 		    globalbranch = YES;
992 		    break;
993 		  }
994 	      regwrite(sp, sp->expr);
995 	      break;
996 
997 	    case SKIFN:
998 	    case SKIOIFN:
999 	      if (!locallabel(sp->label))
1000 		{
1001 		  gensetall(sp);
1002 		  globalbranch = YES;
1003 		}
1004 	      regwrite(sp, sp->expr);
1005 	      break;
1006 
1007 	    case SKNULL:
1008 	    case SKASSIGN:
1009 	      break;
1010 
1011 	    default:
1012 	      badthing ("SKtype","alreg-3",sp->type);
1013 	    }
1014 
1015 	  for (i = toplcv + 1; i <= topregvar; i++)
1016 	    if (regaltered[i])
1017 	      memdefined[i] = NO;
1018 	}
1019 
1020   if (topregvar + 1 > highregvar)
1021     highregvar = topregvar + 1;
1022   dqptr->nregvars = topregvar + 1;
1023   for (i = 0; i <= topregvar; i++)
1024     if (rp = regtab[i])
1025       {
1026 	dqptr->reg[i] = regp = ALLOC(regnode);
1027 	regp->vstg = rp->vstg;
1028 	regp->vtype = rp->vtype;
1029 	regp->memno = rp->memno;
1030 	regp->memoffset = rp->memoffset;
1031 	regp->isarrayarg = rp->isarrayarg;
1032 	frexpr(rp->stgp);
1033 	free((char *) rp);
1034 	regtab[i] = NULL;
1035       }
1036 
1037   while (tabletop >= 0)
1038     free((char *) rt[tabletop--]);
1039   freelabtab();
1040   freevartab();
1041   return;
1042 }
1043 
1044 
1045 
1046 LOCAL scanvars(p)
1047 expptr p;
1048 
1049 {
1050   Addrp ap;
1051   ADDRNODE *addrinfo;
1052   VARNODE *varinfo;
1053   chainp args;
1054   VARNODE *q;
1055 
1056   if (p == NULL) return;
1057 
1058   switch (p->tag)
1059     {
1060     case TCONST:
1061       return;
1062 
1063     case TEXPR:
1064       switch (p->exprblock.opcode)
1065 	{
1066 	case OPASSIGN:
1067 	  scanassign(p);
1068 	  return;
1069 
1070 	case OPPLUSEQ:
1071 	case OPSTAREQ:
1072 	  scanopeq(p);
1073 	  return;
1074 
1075 	case OPCALL:
1076 	  scancall(p);
1077 	  return;
1078 
1079 	default:
1080 	  scanvars(p->exprblock.vleng);
1081 	  scanvars(p->exprblock.leftp);
1082 	  scanvars(p->exprblock.rightp);
1083 	  return;
1084 	}
1085 
1086     case TADDR:
1087       ap = (Addrp) p;
1088       scanvars(ap->vleng);
1089       scanvars(ap->memoffset);
1090       if (!ISVAR(ap)) return;
1091 
1092       addrinfo = getaddr(ap);
1093       if (fixedaddress(ap))
1094 	{
1095 	  if (ISREGTYPE(ap->vtype))
1096 	    {
1097 	      varinfo = getvar(addrinfo, ap);
1098 	      varinfo->isused = YES;
1099 	    }
1100 	}
1101       else
1102 	{
1103 	  addrinfo->freeuse = YES;
1104 	  for (q = addrinfo->varlist; q; q = q->link)
1105 	    q->isused = YES;
1106 	}
1107       return;
1108 
1109     case TLIST:
1110       for (args = p->listblock.listp; args; args = args->nextp)
1111 	scanvars(args->datap);
1112       return;
1113 
1114     default:
1115       badtag ("regalloc:scanvars", p->tag);
1116     }
1117 }
1118 
1119 
1120 
1121 LOCAL scanassign(ep)
1122 Exprp ep;
1123 
1124 {
1125   Addrp lhs;
1126   VARNODE *varinfo;
1127   ADDRNODE *addrinfo;
1128 
1129   scanvars(ep->rightp);
1130   if (ep->leftp->tag == TADDR)
1131     {
1132       lhs = (Addrp) ep->leftp;
1133       scanvars(lhs->vleng);
1134       scanvars(lhs->memoffset);
1135       if ((lhs->vstg == STGREG) || (lhs->vstg == STGPREG))
1136 	return;
1137       if (ISVAR(lhs))
1138 	{
1139           addrinfo = getaddr(lhs);
1140           addrinfo->isset = YES;
1141 	  if (docount > 1)
1142 		addrinfo->loopset = YES;
1143           if (fixedaddress(lhs) && ISREGTYPE(lhs->vtype))
1144 	    {
1145 	      varinfo = getvar(addrinfo, lhs);
1146 	      if (addrinfo->freeuse) varinfo->isused = YES;
1147 	      varinfo->isset = YES;
1148 	      if (!addrinfo->freeuse && !varinfo->isused)
1149 	        varinfo->setfirst = YES;
1150 	    }
1151         }
1152     }
1153   else
1154     badtag ("regalloc:scanassign", ep->leftp->tag);
1155 }
1156 
1157 
1158 
1159 LOCAL scanopeq(ep)
1160 Exprp ep;
1161 
1162 {
1163   Addrp lhs;
1164   ADDRNODE *addrinfo;
1165   VARNODE *varinfo;
1166 
1167   scanvars(ep->rightp);
1168   if (ep->leftp->tag == TADDR)
1169     {
1170       lhs = (Addrp) ep->leftp;
1171       scanvars(lhs->vleng);
1172       scanvars(lhs->memoffset);
1173       if ((lhs->vstg == STGREG) || (lhs->vstg == STGPREG))
1174 	return;
1175       if (ISVAR(lhs))
1176 	{
1177           addrinfo = getaddr(lhs);
1178           addrinfo->isset = YES;
1179 	  if (docount > 1)
1180 		addrinfo->loopset = YES;
1181           if (fixedaddress(lhs))
1182 	    {
1183 	      if (ISREGTYPE(lhs->vtype))
1184 	        {
1185 	          varinfo = getvar(addrinfo, lhs);
1186 	          varinfo->isused = YES;
1187 	          varinfo->isset = YES;
1188 	        }
1189 	    }
1190         }
1191       else
1192 	addrinfo->freeuse = YES;
1193     }
1194   else
1195     badtag ("regalloc:scanopeq", ep->leftp->tag);
1196 }
1197 
1198 
1199 
1200 LOCAL scancall(ep)
1201 Exprp ep;
1202 
1203 {
1204   Addrp lhs;
1205   chainp args;
1206   Addrp ap;
1207   VARNODE *varinfo;
1208   ADDRNODE *addrinfo;
1209 
1210   lhs = (Addrp) ep->leftp;
1211   scanvars(lhs->vleng);
1212   scanvars(lhs->memoffset);
1213 
1214   if (ep->rightp == NULL) return;
1215 
1216   if (lhs->vstg != STGINTR)
1217     {
1218       args = ep->rightp->listblock.listp;
1219       for (; args; args = args->nextp)
1220 	{
1221 	  if (args->datap->tag == TADDR)
1222 	    {
1223 	      ap = (Addrp) args->datap;
1224 	      scanvars(ap->vleng);
1225 	      scanvars(ap->memoffset);
1226 	      if (!ISVAR(ap)) continue;
1227 
1228 	      addrinfo = getaddr(ap);
1229 	      addrinfo->isset = YES;
1230 	      if (docount > 1)
1231 		addrinfo->loopset = YES;
1232 	      if (fixedaddress(ap))
1233 		{
1234 		  varinfo = getvar(addrinfo, ap);
1235 		  if (ap->vstg != STGCONST)
1236 		    varinfo->isset = YES;
1237 		  varinfo->isused = YES;
1238 		}
1239 	      else
1240 		addrinfo->freeuse = YES;
1241 	    }
1242 	  else
1243 	    scanvars(args->datap);
1244 	}
1245     }
1246   else
1247     scanvars(ep->rightp);
1248 
1249   return;
1250 }
1251 
1252 
1253 
1254 LOCAL int fixedaddress(ap)
1255 Addrp ap;
1256 
1257 {
1258   if (!ap->memoffset)
1259     return NO;
1260   return (ISCONST(ap->memoffset) && ISINT(ap->memoffset->headblock.vtype));
1261 }
1262 
1263 
1264 
1265 LOCAL countrefs(p)
1266 expptr p;
1267 
1268 {
1269   Addrp ap;
1270   ADDRNODE *addrinfo;
1271   VARNODE *varinfo;
1272   VARNODE *vp;
1273   chainp args;
1274 
1275   if (p == NULL) return;
1276 
1277   switch (p->tag)
1278     {
1279     case TCONST:
1280       return;
1281 
1282     case TEXPR:
1283       switch (p->exprblock.opcode)
1284 	{
1285 	case OPCALL:
1286 	  if (p->exprblock.leftp->tag != TADDR)
1287 	    badtag ("regalloc:countrefs", p->exprblock.leftp->tag);
1288 	  countrefs(p->exprblock.leftp->addrblock.vleng);
1289 	  countrefs(p->exprblock.leftp->addrblock.memoffset);
1290 
1291 	  if (p->exprblock.leftp->addrblock.vstg != STGINTR)
1292 	    {
1293 	      if (!commonunusable)
1294 		if (linearcode)
1295 		  setcommon();
1296 	        else
1297 		  commonunusable = YES;
1298 	      if (p->exprblock.rightp == NULL) return;
1299 	      args = p->exprblock.rightp->listblock.listp;
1300 	      for (; args; args = args->nextp)
1301 		if (args->datap->tag == TADDR)
1302 		  {
1303 		    ap = (Addrp) args->datap;
1304 		    countrefs(ap->vleng);
1305 		    countrefs(ap->memoffset);
1306 		    if (!ISVAR(ap) || ap->vstg == STGCONST) continue;
1307 		    addrinfo = lookupaddr(ap->vstg, ap->memno);
1308 		    if (ap->vstg == STGARG)
1309 		      addrinfo->refs++;
1310 		    for (vp = addrinfo->varlist; vp; vp = vp->link)
1311 		      if (linearcode)
1312 		        if (!insetlist(ap->vstg, ap->memno, vp->memoffset))
1313 			  if (addrinfo->istemp)
1314 			    vp->refs--;
1315 			  else
1316 			    {
1317 			      vp->refs -= 2;
1318 			      insertset(ap->vstg, ap->memno, vp->memoffset);
1319 			    }
1320 		        else
1321 			  vp->refs--;
1322 		      else
1323 			{
1324 			  if (!addrinfo->istemp)
1325 			    vp->unusable = YES;
1326 			}
1327 		  }
1328 		else
1329 		  countrefs(args->datap);
1330             }
1331 	  else
1332 	    {
1333 	      if (p->exprblock.rightp == NULL) return;
1334 	      args = p->exprblock.rightp->listblock.listp;
1335 	      for (; args; args = args->nextp)
1336 		if (args->datap->tag == TADDR)
1337 		  {
1338 		    ap = (Addrp) args->datap;
1339 		    countrefs(ap->vleng);
1340 		    countrefs(ap->memoffset);
1341 		    if (!ISVAR(ap) || ap->vstg == STGCONST) continue;
1342 		    addrinfo = lookupaddr(ap->vstg, ap->memno);
1343 		    addrinfo->refs++;
1344 		    for (vp = addrinfo->varlist; vp; vp = vp->link)
1345 		      if (!insetlist(ap->vstg, ap->memno, vp->memoffset))
1346 			{
1347 			  vp->refs--;
1348 			  insertset(ap->vstg, ap->memno, vp->memoffset);
1349 			}
1350 		  }
1351 		else
1352 		  countrefs(args->datap);
1353 	    }
1354 	  return;
1355 
1356 	case OPASSIGN:
1357 	case OPPLUSEQ:
1358 	case OPSTAREQ:
1359 	  countrefs(p->exprblock.vleng);
1360 	  countrefs(p->exprblock.rightp);
1361 	  ap = (Addrp) p->exprblock.leftp;
1362 	  if (fixedaddress(ap))
1363 	    if (globalbranch)
1364 	      {
1365 		countrefs(ap->vleng);
1366 		countrefs(ap->memoffset);
1367 	      }
1368 	    else
1369 	      countrefs(ap);
1370 	  else if (linearcode)
1371 	    {
1372 	      countrefs(ap);
1373 	      for (vp = lookupaddr(ap->vstg, ap->memno)->varlist;
1374 		   vp;
1375 		   vp = vp->link)
1376 		vp->refs--;
1377 	    }
1378 	  else
1379 	    {
1380 	      countrefs(ap);
1381 	      for (vp = lookupaddr(ap->vstg, ap->memno)->varlist;
1382 		   vp;
1383 		   vp = vp->link)
1384 		vp->unusable = YES;
1385 	    }
1386 	  return;
1387 
1388 	default:
1389 	  countrefs(p->exprblock.vleng);
1390 	  countrefs(p->exprblock.leftp);
1391 	  countrefs(p->exprblock.rightp);
1392 	  return;
1393 	}
1394 
1395     case TADDR:
1396       ap = (Addrp) p;
1397       countrefs(ap->vleng);
1398       countrefs(ap->memoffset);
1399       if (!ISVAR(ap)) return;
1400 
1401       addrinfo = lookupaddr(ap->vstg, ap->memno);
1402       if (ap->vstg == STGARG)
1403 	addrinfo->refs++;
1404 
1405       if (fixedaddress(ap))
1406 	{
1407 	  if (ISREGTYPE(ap->vtype))
1408 	    {
1409 	      varinfo = lookupvar(addrinfo, ap->memoffset->constblock.constant.ci);
1410 	      varinfo->refs++;
1411 	    }
1412 	}
1413       else
1414 	for (vp = addrinfo->varlist; vp; vp = vp->link)
1415 	  if (!insetlist(ap->vstg, ap->memno, vp->memoffset))
1416 	    {
1417 	      vp->refs--;
1418 	      insertset(ap->vstg, ap->memno, vp->memoffset);
1419 	    }
1420       return;
1421 
1422     case TLIST:
1423       args = p->listblock.listp;
1424       for (; args; args = args->nextp)
1425 	countrefs(args->datap);
1426       return;
1427 
1428     default:
1429       badtag ("regalloc:countrefs", p->tag);
1430     }
1431 }
1432 
1433 
1434 
1435 LOCAL regwrite(sp, p)
1436 Slotp sp;
1437 expptr p;
1438 
1439 {
1440   register int i;
1441   REGDATA *rp;
1442   chainp args;
1443   Addrp ap, ap1;
1444   int memoffset;
1445 
1446   if (p == NULL) return;
1447 
1448   switch (p->tag)
1449     {
1450     case TCONST:
1451       return;
1452 
1453     case TEXPR:
1454       switch (p->exprblock.opcode)
1455 	{
1456 	case OPCALL:
1457 	  ap = (Addrp) p->exprblock.leftp;
1458 	  regwrite(sp, ap->vleng);
1459 	  regwrite(sp, ap->memoffset);
1460 	  if (ap->vstg != STGINTR)
1461 	    {
1462 	      if (linearcode)
1463 		{
1464 		  gensetcommon(sp);
1465 		  for (i = toplcv + 1; i <= topregvar; i++)
1466 		    if ((rp = regtab[i]) && (rp->vstg == STGCOMMON))
1467 		      regdefined[i] = NO;
1468 		}
1469 	      if (p->exprblock.rightp == NULL) return;
1470 	      args = p->exprblock.rightp->listblock.listp;
1471 	      for (; args; args = args->nextp)
1472 		if (args->datap->tag == TADDR)
1473 		  {
1474 		    ap = (Addrp) args->datap;
1475 		    regwrite(sp, ap->vleng);
1476 		    regwrite(sp, ap->memoffset);
1477 		    for (i = toplcv + 1; i <= topregvar; i++)
1478 		      if ((rp = regtab[i]) &&
1479 			  !rp->isarrayarg &&
1480 			  !rp->istemp &&
1481 			  (rp->vstg == ap->vstg) &&
1482 			  (rp->memno == ap->memno))
1483 			{
1484 			  regdefined[i] = NO;
1485 			  if (!memdefined[i])
1486 			    {
1487 			      ap1 = (Addrp) cpexpr(rp->stgp);
1488 			      changetoreg(ap1, i);
1489 			      insertassign(sp, cpexpr(rp->stgp), ap1);
1490 			      memdefined[i] = YES;
1491 			    }
1492 			}
1493 		      else if (rp->isarrayarg &&
1494 			       (ap->vstg == STGARG) &&
1495 			       (ap->memno == rp->memno))
1496 			{
1497 			  ap->vstg = STGPREG;
1498 			  ap->memno = regnum[i];
1499 			}
1500 		  }
1501 		else
1502 		  regwrite(sp, args->datap);
1503 	    }
1504 	  else
1505 	    {
1506 	      if (p->exprblock.rightp == NULL) return;
1507 	      args = p->exprblock.rightp->listblock.listp;
1508 	      for (; args; args = args->nextp)
1509 		if (args->datap->tag == TADDR)
1510 		  {
1511 		    ap = (Addrp) args->datap;
1512 		    regwrite(sp, ap->vleng);
1513 		    regwrite(sp, ap->memoffset);
1514 		    for (i = toplcv + 1; i <= topregvar; i++)
1515 		      if ((rp = regtab[i]) &&
1516 			  !rp->isarrayarg &&
1517 			  !rp->istemp &&
1518 			  (rp->vstg == ap->vstg) &&
1519 			  (rp->memno == ap->memno) &&
1520 			  !memdefined[i])
1521 			{
1522 			  ap1 = (Addrp) cpexpr(rp->stgp);
1523 			  changetoreg(ap1, i);
1524 			  insertassign(sp, cpexpr(rp->stgp), ap1);
1525 			  memdefined[i] = YES;
1526 			}
1527 		      else if (rp->isarrayarg &&
1528 			       (ap->vstg == STGARG) &&
1529 			       (rp->memno == ap->memno))
1530 			{
1531 			  ap->vstg = STGPREG;
1532 			  ap->memno = regnum[i];
1533 			}
1534 		  }
1535 		else
1536 		  {
1537 		    regwrite(sp, args->datap);
1538 		  }
1539 	    }
1540 	  return;
1541 
1542 	case OPASSIGN:
1543 	case OPPLUSEQ:
1544 	case OPSTAREQ:
1545 	  regwrite(sp, p->exprblock.vleng);
1546 	  regwrite(sp, p->exprblock.rightp);
1547 	  ap = (Addrp) p->exprblock.leftp;
1548 	  regwrite(sp, ap->vleng);
1549 	  regwrite(sp, ap->memoffset);
1550 
1551 	  if (ap->vstg == STGARG)
1552 	    for (i = toplcv + 1; i<=topregvar; i++)
1553 	      if ((rp = regtab[i]) &&
1554 		  rp->isarrayarg &&
1555 		  (rp->memno == ap->memno))
1556 		{
1557 		  ap->vstg = STGPREG;
1558 		  ap->memno = regnum[i];
1559 		  return;
1560 		}
1561 
1562 	  if (fixedaddress(ap))
1563 	    {
1564 	      memoffset = ap->memoffset->constblock.constant.ci;
1565 	      for (i = toplcv + 1; i <= topregvar; i++)
1566 		if ((rp = regtab[i]) &&
1567 		    !rp->isarrayarg &&
1568 		    (rp->vstg == ap->vstg) &&
1569 		    (rp->memno == ap->memno) &&
1570 		    (rp->memoffset == memoffset))
1571 		  {
1572 		    changetoreg(ap, i);
1573 		    if (globalbranch)
1574 		      {
1575 			p->exprblock.rightp = (expptr) cpexpr(p);
1576 			p->exprblock.leftp = (expptr) cpexpr(rp->stgp);
1577 			p->exprblock.opcode = OPASSIGN;
1578 			memdefined[i] = YES;
1579 		      }
1580 		    else
1581 		      {
1582 			regaltered[i] = YES;
1583 			regdefined[i] = YES;
1584 		      }
1585 		  }
1586 	      return;
1587 	    }
1588 
1589 	  if (linearcode)
1590 	    for (i = toplcv + 1; i <= topregvar; i++)
1591 	      if ((rp = regtab[i]) &&
1592 		  !rp->isarrayarg &&
1593 		  (rp->vstg == ap->vstg) &&
1594 		  (rp->memno == ap->memno))
1595 		regdefined[i] = NO;
1596 	  return;
1597 
1598 	default:
1599 	  regwrite(sp, p->exprblock.vleng);
1600 	  regwrite(sp, p->exprblock.leftp);
1601 	  regwrite(sp, p->exprblock.rightp);
1602 	  return;
1603 	}
1604 
1605     case TADDR:
1606       ap = (Addrp) p;
1607       regwrite(sp, ap->vleng);
1608       regwrite(sp, ap->memoffset);
1609 
1610       if (ap->vstg == STGARG)
1611 	for (i = toplcv + 1; i <= topregvar; i++)
1612 	  if ((rp = regtab[i]) &&
1613 	      rp->isarrayarg &&
1614 	      (rp->memno == ap->memno))
1615 	    {
1616 	      ap->vstg = STGPREG;
1617 	      ap->memno = regnum[i];
1618 	      return;
1619 	    }
1620 
1621       if (fixedaddress(ap))
1622 	{
1623           memoffset = ap->memoffset->constblock.constant.ci;
1624 	  for (i = toplcv + 1; i <= topregvar; i++)
1625 	    if ((rp = regtab[i]) &&
1626 		!rp->isarrayarg &&
1627 		(rp->vstg == ap->vstg) &&
1628 		(rp->memno == ap->memno) &&
1629 		(rp->memoffset == memoffset))
1630 	      {
1631 		changetoreg(ap, i);
1632 		return;
1633 	      }
1634 	}
1635       else
1636 	{
1637 	  for (i = toplcv + 1; i <= topregvar; i++)
1638 	    if ((rp = regtab[i]) &&
1639 		!rp->isarrayarg &&
1640 		(rp->vstg == ap->vstg) &&
1641 		(rp->memno == ap->memno) &&
1642 		!memdefined[i])
1643 	      {
1644 		ap1 = (Addrp) cpexpr(rp->stgp);
1645 		changetoreg(ap1, i);
1646 		insertassign(sp, cpexpr(rp->stgp), ap1);
1647 		memdefined[i] = YES;
1648 	      }
1649 	}
1650       return;
1651 
1652     case TLIST:
1653       for (args = p->listblock.listp; args; args = args->nextp)
1654 	regwrite(sp, args->datap);
1655       return;
1656 
1657     default:
1658       badtag ("regalloc:regwrite", p->tag);
1659     }
1660 }
1661 
1662 
1663 
1664 LOCAL setcommon()
1665 
1666 {
1667   ADDRNODE *ap;
1668   VARNODE *vp;
1669 
1670   for (ap = commonvars; ap; ap = ap->commonlink)
1671     for (vp = ap->varlist; vp; vp = vp->link)
1672       if (!insetlist(ap->vstg, ap->memno, vp->memoffset))
1673 	{
1674 	  vp->refs -= 2;
1675 	  insertset(ap->vstg, ap->memno, vp->memoffset);
1676 	}
1677       else
1678 	vp->refs--;
1679 
1680   return;
1681 }
1682 
1683 
1684 
1685 LOCAL setall()
1686 
1687 {
1688   register int i;
1689   register ADDRNODE *p;
1690   register VARNODE *q;
1691 
1692   for (i = 0; i < VARTABSIZE; i++)
1693     for (p = vartable[i]; p; p = p->link)
1694       if (p->istemp || !p->isset)
1695 	break;
1696       else
1697 	for (q = p->varlist; q; q = q->link)
1698 	  if (q->isset && !insetlist(p->vstg, p->memno, q->memoffset))
1699 	    q->refs--;
1700 
1701   allset = YES;
1702   return;
1703 }
1704 
1705 
1706 
1707 LOCAL int samevar(r1, r2)
1708 register REGDATA *r1;
1709 register REGNODE *r2;
1710 
1711 {
1712   if ((r1->vstg != r2->vstg) ||
1713       (r1->memno != r2->memno) ||
1714       (r1->isarrayarg != r2->isarrayarg))
1715     return NO;
1716   if (r1->isarrayarg)
1717     return YES;
1718   return (r1->memoffset == r2->memoffset);
1719 }
1720 
1721 
1722 
1723 LOCAL entableaddr(p)
1724 ADDRNODE *p;
1725 
1726 {
1727   int refs;
1728   Addrp ap;
1729   register int i;
1730 
1731   if (p->vstg != STGARG)
1732     {
1733       currentaddr = p;
1734       return;
1735     }
1736 
1737   refs = p->refs;
1738   if (refs <= 0) return;
1739 
1740   if (tabletop < 0)
1741     tabletop = i = 0;
1742   else if (refs > rt[tabletop]->refs)
1743     {
1744       if (tabletop + 1 < TABLELIMIT)
1745 	tabletop++;
1746       else
1747 	{
1748 	  frexpr(rt[tabletop]->stgp);
1749 	  free((char *) rt[tabletop]);
1750 	}
1751 
1752       for (i = tabletop; i > 0; i--)
1753 	if (refs > rt[i - 1]->refs)
1754 	  rt[i] = rt[i - 1];
1755 	else
1756 	  break;
1757     }
1758   else if (tabletop + 1 < TABLELIMIT)
1759     i = ++tabletop;
1760   else
1761     return;
1762 
1763   rt[i] = ALLOC(regdata);
1764   rt[i]->vstg = p->vstg;
1765   rt[i]->vtype = p->vtype;
1766   rt[i]->memno = p->memno;
1767   rt[i]->refs = refs;
1768   rt[i]->isarrayarg = YES;
1769 
1770   return;
1771 }
1772 
1773 
1774 
1775 
1776 LOCAL entablevar(p)
1777 VARNODE *p;
1778 
1779 {
1780   int refs;
1781   register int i;
1782 
1783   if (p->unusable) return;
1784   refs = p->refs - loopcost;
1785   if (refs <= 0) return;
1786 
1787   if (tabletop < 0)
1788     tabletop = i = 0;
1789   else if (refs > rt[tabletop]->refs
1790 #ifdef BUMPREALS	/* put floats last */
1791     || currentaddr->vtype!=TYREAL && rt[tabletop]->vtype==TYREAL && !rt[tabletop]->isarrayarg
1792 #endif
1793     ){
1794       if (tabletop + 1 < TABLELIMIT)
1795         tabletop++;
1796       else
1797 	{
1798 	  frexpr(rt[tabletop]->stgp);
1799           free((char *) rt[tabletop]);
1800 	}
1801 
1802       for (i = tabletop; i > 0; i--)
1803         if (refs > rt[i - 1]->refs
1804 #ifdef BUMPREALS	/* put floats last */
1805          || currentaddr->vtype!=TYREAL && rt[i-1]->vtype==TYREAL && !rt[i-1]->isarrayarg
1806 #endif
1807 	)
1808           rt[i] = rt[i - 1];
1809         else
1810           break;
1811     }
1812   else if (tabletop + 1 < TABLELIMIT)
1813     i = ++tabletop;
1814   else
1815     return;
1816 
1817   rt[i] = ALLOC(regdata);
1818   rt[i]->vstg = currentaddr->vstg;
1819   rt[i]->vtype = currentaddr->vtype;
1820   rt[i]->memno = currentaddr->memno;
1821   rt[i]->memoffset = p->memoffset;
1822   rt[i]->refs = refs;
1823   rt[i]->stgp = (Addrp) cpexpr(p->stgp);
1824   rt[i]->isarrayarg = NO;
1825   rt[i]->istemp = currentaddr->istemp;
1826   rt[i]->isset = p->isset;
1827   rt[i]->setfirst = p->setfirst;
1828 
1829   return;
1830 }
1831 
1832 
1833 
1834 LOCAL int inregtab(p)
1835 register REGDATA *p;
1836 
1837 {
1838   register REGDATA *rp;
1839   register int i;
1840 
1841   for (i = 0; i <= topregvar; i++)
1842     if (rp = regtab[i])
1843       if ((rp->vstg == p->vstg) &&
1844 	  (rp->memno == p->memno) &&
1845 	  (rp->isarrayarg == p->isarrayarg))
1846 	if (rp->isarrayarg)
1847           return YES;
1848         else if (rp->memoffset == p->memoffset)
1849           return YES;
1850 
1851   return NO;
1852 }
1853 
1854 
1855 
1856 LOCAL changetoreg(ap, i)
1857 register Addrp ap;
1858 int i;
1859 
1860 {
1861   ap->vstg = STGREG;
1862   ap->memno = regnum[i];
1863   frexpr(ap->memoffset);
1864   ap->memoffset = ICON(0);
1865   ap->istemp = NO;
1866   return;
1867 }
1868 
1869 
1870 
1871 LOCAL insertassign(sp, dest, src)
1872 Slotp sp;
1873 Addrp dest;
1874 expptr src;
1875 
1876 {
1877   Slotp newslot;
1878   expptr p;
1879 
1880   p = mkexpr(OPASSIGN, dest, src);
1881   newslot = optinsert (SKEQ,p,0,0,sp);
1882 
1883   if (sp == dohead)
1884     if (!newcode)
1885       newcode = newslot;
1886 
1887   return;
1888 }
1889 
1890 
1891 LOCAL appendassign(sp, dest, src)
1892 Slotp sp;
1893 Addrp dest;
1894 expptr src;
1895 
1896 {
1897   Slotp newslot;
1898   expptr p;
1899 
1900   if (!sp)
1901     fatal ("regalloc:appendassign");
1902 
1903   p = mkexpr(OPASSIGN, dest, src);
1904   newslot = optinsert (SKEQ,p,0,0,sp->next);
1905 
1906   return;
1907 }
1908 
1909 
1910 
1911 LOCAL int regtomem(sp)
1912 Slotp sp;
1913 
1914 {
1915   expptr p, l, r;
1916   int i;
1917 
1918   if (sp->type != SKEQ) return NO;
1919 
1920   p = sp->expr;
1921   if ((p->tag != TEXPR) || (p->exprblock.opcode != OPASSIGN))
1922     return NO;
1923 
1924   r = p->exprblock.rightp;
1925   if ((r->tag != TADDR) || (r->addrblock.vstg != STGREG))
1926     return NO;
1927 
1928   l = p->exprblock.leftp;
1929   if (l->tag != TADDR)
1930     return NO;
1931   i = r->addrblock.memno;
1932   if (regtab[i] &&
1933       (l->addrblock.vstg == regtab[i]->vstg) &&
1934       (l->addrblock.memno == regtab[i]->memno) &&
1935       fixedaddress(l) &&
1936       (l->addrblock.memoffset->constblock.constant.ci == regtab[i]->memoffset))
1937     return YES;
1938 
1939   return NO;
1940 }
1941 
1942 
1943 
1944 LOCAL int regtoreg(sp)
1945 Slotp sp;
1946 
1947 {
1948   expptr p, l, r;
1949 
1950   if (sp->type != SKEQ) return NO;
1951 
1952   p = sp->expr;
1953   if ((p->tag != TEXPR) || (p->exprblock.opcode != OPASSIGN))
1954     return NO;
1955 
1956   l = p->exprblock.leftp;
1957   if ((l->tag != TADDR) || (l->addrblock.vstg != STGREG))
1958     return NO;
1959 
1960   r = p->exprblock.rightp;
1961   if ((r->tag == TADDR) &&
1962       (r->addrblock.vstg == STGREG) &&
1963       (r->addrblock.memno == l->addrblock.memno))
1964     return YES;
1965 
1966   if ((r->tag == TEXPR) &&
1967       (r->exprblock.opcode == OPADDR) &&
1968       (r->exprblock.leftp->tag == TADDR) &&
1969       (r->exprblock.leftp->addrblock.vstg == STGPREG) &&
1970       (r->exprblock.leftp->addrblock.memno == l->addrblock.memno))
1971       return YES;
1972 
1973   return NO;
1974 }
1975 
1976 
1977 
1978 LOCAL deleteslot(sp)
1979 Slotp sp;
1980 
1981 {
1982   if (newcode == sp)
1983     {
1984       newcode = sp->next;
1985       if (newcode == dohead)
1986 	newcode = NULL;
1987     }
1988 
1989   delslot (sp);
1990   return;
1991 }
1992 
1993 
1994 
1995 LOCAL gensetall(sp)
1996 Slotp sp;
1997 
1998 {
1999   register int i;
2000   register REGDATA *rp;
2001   register Addrp ap;
2002 
2003   for (i = toplcv + 1; i <= topregvar; i++)
2004     if (rp = regtab[i])
2005       if (rp->isset && !(rp->istemp || rp->isarrayarg))
2006 	if (!memdefined[i])
2007 	  {
2008 	    ap = (Addrp) cpexpr(rp->stgp);
2009 	    changetoreg(ap, i);
2010 	    insertassign(sp, cpexpr(rp->stgp), ap);
2011 	    memdefined[i] = YES;
2012 	  }
2013 
2014   return;
2015 }
2016 
2017 
2018 LOCAL gensetcommon(sp)
2019 Slotp sp;
2020 
2021 {
2022   register int i;
2023   register REGDATA *rp;
2024   register Addrp ap;
2025 
2026   for (i = toplcv + 1; i <= topregvar; i++)
2027     if (rp = regtab[i])
2028       if ((rp->vstg == STGCOMMON) && !rp->isarrayarg)
2029 	if (!memdefined[i])
2030 	  {
2031 	    ap = (Addrp) cpexpr(rp->stgp);
2032 	    changetoreg(ap, i);
2033 	    insertassign(sp, cpexpr(rp->stgp), ap);
2034 	    memdefined[i] = YES;
2035 	  }
2036 
2037   return;
2038 }
2039 
2040 
2041 LOCAL gensetreturn(sp)
2042 Slotp sp;
2043 
2044 {
2045   register int i;
2046   register REGDATA *rp;
2047   register Addrp ap;
2048 
2049   for (i = toplcv + 1; i <= topregvar; i++)
2050     if (rp = regtab[i])
2051       if (((rp->vstg == STGCOMMON) && !rp->isarrayarg)
2052       || (rp->isset && (saveall || rp->stgp->issaved) && !(rp->istemp || rp->isarrayarg)))
2053 	if (!memdefined[i])
2054 	  {
2055 	    ap = (Addrp) cpexpr(rp->stgp);
2056 	    changetoreg(ap, i);
2057 	    insertassign(sp, cpexpr(rp->stgp), ap);
2058 	    memdefined[i] = YES;
2059 	  }
2060 
2061   return;
2062 }
2063 
2064 
2065 
2066 LOCAL clearmems()
2067 
2068 {
2069   REGDATA *rp;
2070   register int i;
2071 
2072   for (i = 0; i <= toplcv; i++)
2073     memdefined[i] = YES;
2074   for (; i <= topregvar; i++)
2075     if ((rp = regtab[i]) && rp->isset)
2076       memdefined[i] = NO;
2077     else
2078       memdefined[i] = YES;
2079   return;
2080 }
2081 
2082 
2083 LOCAL setregs()
2084 
2085 {
2086   register int i;
2087 
2088   for (i = 0; i <= topregvar; i++)
2089     regdefined[i] = YES;
2090   return;
2091 }
2092 
2093 
2094 
2095 regalloc()
2096 
2097 {
2098 int	match;
2099 Slotp	nextslot;
2100 Slotp	sl1,sl2;
2101 Slotp	lastlabslot;
2102 
2103 if (! optimflag) return;
2104 
2105 docount = 0;
2106 lastlabslot = NULL;
2107 for (sl1 = firstslot; sl1; sl1 = nextslot)
2108 	{
2109 	nextslot = sl1->next;
2110 	switch (sl1->type)
2111 	    {
2112 
2113 /* temporarily commented out -----
2114 	    case SKLABEL:
2115 		lastlabslot = sl1;
2116 		break;
2117 
2118 	    case SKGOTO:
2119 		if (lastlabslot && sl1->label == lastlabslot->label)
2120 			{
2121 			dohead = lastlabslot;
2122 			doend = sl1;
2123 			alreg ();
2124 			}
2125 		break;
2126 ----- */
2127 
2128 	    case SKDOHEAD:
2129 		++docount;
2130 		pushq (sl1);
2131 		break;
2132 
2133 	    case SKENDDO:
2134 		--docount;
2135 		match = 0;
2136 		for (sl2 = sl1; sl2; sl2 = sl2->prev)
2137 			{
2138 			if (sl2->type == SKDOHEAD) match++;
2139 			else if (sl2->type == SKENDDO) match--;
2140 			if (match == 0) break;
2141 			}
2142 		if (sl2)
2143 			dohead = sl2;
2144 		else
2145 			fatal ("unmatched enddo in code buffer");
2146 		if (sl2->type != SKDOHEAD)
2147 			fatal ("internal error in regalloc");
2148 
2149 		for (dqptr = dqbottom; dqptr; dqptr = dqptr->up)
2150 			{
2151 			if (dqptr->dohead == dohead)
2152 				break;
2153 			}
2154 
2155 		if (!dqptr)
2156 			fatal ("garbled doqueue in regalloc");
2157 
2158 		/*  sl1 now points to the SKENDDO slot; the SKNULL slot
2159 		 *  is reached through sl1->nullslot
2160 		 */
2161 		dqptr->doend = (Slotp) sl1->nullslot;
2162 		if (docount == 0)
2163 			{
2164 			for (dqptr = dqbottom; dqptr; dqptr = dqptr->up)
2165 				{
2166 				dohead = dqptr->dohead;
2167 				doend = dqptr->doend;
2168 				alreg();
2169 				}
2170 			while (dqtop)
2171 				popq(dqtop->dohead);
2172 			docount = 0;
2173 			}
2174 		break;
2175 
2176 	    default:
2177 		break;
2178 	    }
2179 	}
2180 
2181 return;
2182 }
2183 
2184 
2185 
2186 LOCAL pushq(sp)
2187 Slotp sp;
2188 
2189 {
2190   DOQUEUE *t;
2191 
2192   if (sp->type != SKDOHEAD)
2193     fatal("regalloc:pushq:  DO statement expected");
2194 
2195   if (dqbottom)
2196     {
2197       t = ALLOC(doqueue);
2198       t->up = dqbottom;
2199       dqbottom->down = t;
2200       dqbottom = t;
2201     }
2202   else
2203     dqtop = dqbottom = ALLOC(doqueue);
2204 
2205   dqbottom->dohead = sp;
2206 }
2207 
2208 
2209 LOCAL popq(sp)
2210 Slotp sp;
2211 
2212 {
2213   DOQUEUE *t;
2214   register int i;
2215 
2216   if (!dqtop)
2217     fatal("regalloc:popq:  empty DO queue");
2218   if (dqtop->dohead != sp)
2219     fatal("regalloc:popq:  garbled DO queue");
2220 
2221   t = dqtop;
2222 
2223   dqtop = t->down;
2224   if (dqtop)
2225     dqtop->up = NULL;
2226   else
2227     dqbottom = NULL;
2228   for (i = 0; i < MAXREGVAR; i++)
2229     if (t->reg[i])
2230       free((char *) t->reg[i]);
2231   free(t);
2232 }
2233