home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / f77 / equiv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-01-10  |  4.9 KB  |  265 lines
  1. #include "defs"
  2.  
  3. /* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */
  4.  
  5. /* called at end of declarations section to process chains
  6.    created by EQUIVALENCE statements
  7.  */
  8. doequiv()
  9. {
  10. register int i;
  11. int inequiv, comno, ovarno;
  12. ftnint comoffset, offset, leng, iarrlen(), lmin(), lmax();
  13. register struct equivblock *p;
  14. register struct eqvchain *q;
  15. struct primblock *itemp;
  16. register struct nameblock *np;
  17. expptr offp, suboffset();
  18. int ns, nsubs();
  19. chainp cp;
  20.  
  21. for(i = 0 ; i < nequiv ; ++i)
  22.     {
  23.     p = &eqvclass[i];
  24.     p->eqvbottom = p->eqvtop = 0;
  25.     comno = -1;
  26.  
  27.     for(q = p->equivs ; q ; q = q->nextp)
  28.         {
  29.         itemp = q->eqvitem;
  30.         vardcl(np = itemp->namep);
  31.         if(itemp->argsp || itemp->fcharp)
  32.             {
  33.             if(np->vdim!=NULL && np->vdim->ndim>1 &&
  34.                nsubs(itemp->argsp)==1 )
  35.                 {
  36.                 if(! ftn66flag)
  37.                     warn("1-dim subscript in EQUIVALENCE");
  38.                 cp = NULL;
  39.                 ns = np->vdim->ndim;
  40.                 while(--ns > 0)
  41.                     cp = mkchain( ICON(1), cp);
  42.                 itemp->argsp->listp->nextp = cp;
  43.                 }
  44.             offp = suboffset(itemp);
  45.             }
  46.         else    offp = ICON(0);
  47.         if(ISICON(offp))
  48.             offset = q->eqvoffset = offp->const.ci;
  49.         else    {
  50.             dclerr("nonconstant subscript in equivalence ", np);
  51.             np = NULL;
  52.             goto endit;
  53.             }
  54.         if( (leng = iarrlen(np)) < 0)
  55.             {
  56.             dclerr("adjustable in equivalence", np);
  57.             np = NULL;
  58.             goto endit;
  59.             }
  60.         p->eqvbottom = lmin(p->eqvbottom, -offset);
  61.         p->eqvtop = lmax(p->eqvtop, leng-offset);
  62.  
  63.         switch(np->vstg)
  64.             {
  65.             case STGUNKNOWN:
  66.             case STGBSS:
  67.             case STGEQUIV:
  68.                 break;
  69.  
  70.             case STGCOMMON:
  71.                 comno = np->vardesc.varno;
  72.                 comoffset = np->voffset + offset;
  73.                 break;
  74.  
  75.             default:
  76.                 dclerr("bad storage class in equivalence", np);
  77.                 np = NULL;
  78.                 goto endit;
  79.             }
  80.     endit:
  81.         frexpr(offp);
  82.         q->eqvitem = np;
  83.         }
  84.  
  85.     if(comno >= 0)
  86.         eqvcommon(p, comno, comoffset);
  87.     else  for(q = p->equivs ; q ; q = q->nextp)
  88.         {
  89.         if(np = q->eqvitem)
  90.             {
  91.             inequiv = NO;
  92.             if(np->vstg==STGEQUIV)
  93.                 if( (ovarno = np->vardesc.varno) == i)
  94.                     {
  95.                     if(np->voffset + q->eqvoffset != 0)
  96.                         dclerr("inconsistent equivalence", np);
  97.                     }
  98.                 else    {
  99.                     offset = np->voffset;
  100.                     inequiv = YES;
  101.                     }
  102.  
  103.             np->vstg = STGEQUIV;
  104.             np->vardesc.varno = i;
  105.             np->voffset = - q->eqvoffset;
  106.  
  107.             if(inequiv)
  108.                 eqveqv(i, ovarno, q->eqvoffset + offset);
  109.             }
  110.         }
  111.     }
  112.  
  113. for(i = 0 ; i < nequiv ; ++i)
  114.     {
  115.     p = & eqvclass[i];
  116.     if(p->eqvbottom!=0 || p->eqvtop!=0)
  117.         {
  118.         for(q = p->equivs ; q; q = q->nextp)
  119.             {
  120.             np = q->eqvitem;
  121.             np->voffset -= p->eqvbottom;
  122.             if(np->voffset % typealign[np->vtype] != 0)
  123.                 dclerr("bad alignment forced by equivalence", np);
  124.             }
  125.         p->eqvtop -= p->eqvbottom;
  126.         p->eqvbottom = 0;
  127.         }
  128.     freqchain(p);
  129.     }
  130. }
  131.  
  132.  
  133.  
  134.  
  135.  
  136. /* put equivalence chain p at common block comno + comoffset */
  137.  
  138. LOCAL eqvcommon(p, comno, comoffset)
  139. struct equivblock *p;
  140. int comno;
  141. ftnint comoffset;
  142. {
  143. int ovarno;
  144. ftnint k, offq;
  145. register struct nameblock *np;
  146. register struct eqvchain *q;
  147.  
  148. if(comoffset + p->eqvbottom < 0)
  149.     {
  150.     err1("attempt to extend common %s backward",
  151.         nounder(XL, extsymtab[comno].extname) );
  152.     freqchain(p);
  153.     return;
  154.     }
  155.  
  156. if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
  157.     extsymtab[comno].extleng = k;
  158.  
  159. for(q = p->equivs ; q ; q = q->nextp)
  160.     if(np = q->eqvitem)
  161.         {
  162.         switch(np->vstg)
  163.             {
  164.             case STGUNKNOWN:
  165.             case STGBSS:
  166.                 np->vstg = STGCOMMON;
  167.                 np->vardesc.varno = comno;
  168.                 np->voffset = comoffset - q->eqvoffset;
  169.                 break;
  170.  
  171.             case STGEQUIV:
  172.                 ovarno = np->vardesc.varno;
  173.                 offq = comoffset - q->eqvoffset - np->voffset;
  174.                 np->vstg = STGCOMMON;
  175.                 np->vardesc.varno = comno;
  176.                 np->voffset = comoffset - q->eqvoffset;
  177.                 if(ovarno != (p - eqvclass))
  178.                     eqvcommon(&eqvclass[ovarno], comno, offq);
  179.                 break;
  180.  
  181.             case STGCOMMON:
  182.                 if(comno != np->vardesc.varno ||
  183.                    comoffset != np->voffset+q->eqvoffset)
  184.                     dclerr("inconsistent common usage", np);
  185.                 break;
  186.  
  187.  
  188.             default:
  189.                 fatal1("eqvcommon: impossible vstg %d", np->vstg);
  190.             }
  191.         }
  192.  
  193. freqchain(p);
  194. p->eqvbottom = p->eqvtop = 0;
  195. }
  196.  
  197.  
  198. /* put all items on ovarno chain on front of nvarno chain
  199.  * adjust offsets of ovarno elements and top and bottom of nvarno chain
  200.  */
  201.  
  202. LOCAL eqveqv(nvarno, ovarno, delta)
  203. int ovarno, nvarno;
  204. ftnint delta;
  205. {
  206. register struct equivblock *p0, *p;
  207. register struct nameblock *np;
  208. struct eqvchain *q, *q1;
  209.  
  210. p0 = eqvclass + nvarno;
  211. p = eqvclass + ovarno;
  212. p0->eqvbottom = lmin(p0->eqvbottom, p->eqvbottom - delta);
  213. p0->eqvtop = lmax(p0->eqvtop, p->eqvtop - delta);
  214. p->eqvbottom = p->eqvtop = 0;
  215.  
  216. for(q = p->equivs ; q ; q = q1)
  217.     {
  218.     q1 = q->nextp;
  219.     if( (np = q->eqvitem) && np->vardesc.varno==ovarno)
  220.         {
  221.         q->nextp = p0->equivs;
  222.         p0->equivs = q;
  223.         q->eqvoffset -= delta;
  224.         np->vardesc.varno = nvarno;
  225.         np->voffset -= delta;
  226.         }
  227.     else    free(q);
  228.     }
  229. p->equivs = NULL;
  230. }
  231.  
  232.  
  233.  
  234.  
  235. LOCAL freqchain(p)
  236. register struct equivblock *p;
  237. {
  238. register struct eqvchain *q, *oq;
  239.  
  240. for(q = p->equivs ; q ; q = oq)
  241.     {
  242.     oq = q->nextp;
  243.     free(q);
  244.     }
  245. p->equivs = NULL;
  246. }
  247.  
  248.  
  249.  
  250.  
  251.  
  252. LOCAL nsubs(p)
  253. register struct listblock *p;
  254. {
  255. register int n;
  256. register chainp q;
  257.  
  258. n = 0;
  259. if(p)
  260.     for(q = p->listp ; q ; q = q->nextp)
  261.         ++n;
  262.  
  263. return(n);
  264. }
  265.