Revision to common subexpression bug fix in f77

[donn at sdchema.UUCP]

Here's another fix for the common subexpression bug which causes
elements in the same COMMON block to be confused with each other.
This fix was sent to me by Ralph Campbell, who got it from a trusted
source.  The advantage of this new fix is that certain safe CSE
optimizations on COMMON variables are now permitted.

First remove the original fix that I supplied to scantree() in file
optcse.c:

------------------------------------------------------------------------
*** /tmp/,RCSt1021557	Fri Jun  8 14:28:06 1984
--- optcse.c	Fri Jun  8 11:45:29 1984
***************
*** 584,590
  				ap = (Addrp) p->exprblock.leftp;
  				idp = findid(ap);
  				killdepnodes(idp);
! 				if( ! (ap->isarray || ap->vstg == STGCOMMON) ) {
  					if(rnode->is_dead)idp->assgnval=idp->initval;
  					else idp->assgnval = rnode;
  				}

--- 603,609 -----
  				ap = (Addrp) p->exprblock.leftp;
  				idp = findid(ap);
  				killdepnodes(idp);
! 				if( ! ap->isarray ) {
  					if(rnode->is_dead)idp->assgnval=idp->initval;
  					else idp->assgnval = rnode;
  				}
------------------------------------------------------------------------

Then replace the samebase() routine in the same file with the following
revised version:

------------------------------------------------------------------------
LOCAL samebase(ep1,ep2)
expptr ep1,ep2;
{
    if ( ep1->tag == ep2->tag  )       
	switch (ep2->tag) {
	    case TTEMP :
		if (ep1->tempblock.memalloc == ep2->tempblock.memalloc)
			return (TRUE);
		break;
	    case TADDR :  
		if (ep1->addrblock.vstg == ep2->addrblock.vstg) {
		    switch(ep1->addrblock.vstg) {
			case STGCOMMON:
			    if (ep1->addrblock.memno == ep2->addrblock.memno &&
				ISCONST(ep1->addrblock.memoffset) &&
				ISCONST(ep2->addrblock.memoffset) &&
				ep1->addrblock.memoffset->constblock.const.ci ==
				ep2->addrblock.memoffset->constblock.const.ci ) {
				    return(TRUE); 
			    }
			    break;

			default:
			    if (ep1->addrblock.memno == ep2->addrblock.memno ) {
				return(TRUE); 
			    }
		    }
		}
		break;
	    case TCONST :
		if( (ep1->constblock.vtype) ==
		    (ep2->constblock.vtype)  ) 
		{
			union Constant *ap,*bp;
			ap= &ep1->constblock.const;
			bp= &ep2->constblock.const;
			switch(ep1->constblock.vtype)

			{
			case TYSHORT:
			case TYLONG:
				if(ap->ci == bp->ci) return(TRUE);
				break;
			case TYREAL:
			case TYDREAL:
				if(ap->cd[0] == bp->cd[0]) return(TRUE);
				break;
			case TYCOMPLEX:
			case TYDCOMPLEX:
				if(ap->cd[0] == bp->cd[0] &&
				    ap->cd[1] == bp->cd[1] )
					return(TRUE);
				break;
			}
		}
		break;

	    default : 
		badtag ("samebase",ep2->tag);
	}
    return(FALSE);
}
------------------------------------------------------------------------

Enjoy,

Donn Seeley    UCSD Chemistry Dept.       ucbvax!sdcsvax!sdchema!donn
32 52' 30"N 117 14' 25"W  (619) 452-4016  sdcsvax!sdchema!donn at nosc.ARPA