#include "defs.h"Include dependency graph for equiv.c:
Go to the source code of this file.
Functions | |
| static void eqvcommon | Argdcl ((struct Equivblock *, int, long int)) |
| static void eqveqv | Argdcl ((int, int, long int)) |
| static int nsubs | Argdcl ((struct Listblock *)) |
| void | doequiv (Void) |
| LOCAL void | eqvcommon (struct Equivblock *p, int comno, ftnint comoffset) |
| LOCAL void | eqveqv (int nvarno, int ovarno, ftnint delta) |
| void | freqchain (register struct Equivblock *p) |
| LOCAL int | nsubs (register struct Listblock *p) |
| Primblock * | primchk (expptr e) |
| static void eqvcommon Argdcl | ( | (struct Equivblock *, int, long int) | ) | [static] |
| void doequiv | ( | Void | ) |
Definition at line 36 of file equiv.c.
References Primblock::argsp, dclerr(), Equivblock::equivs, Equivblock::eqvbottom, eqvclass, Eqvchain::eqvitem, Eqvchain::eqvlhs, Eqvchain::eqvnextp, Equivblock::eqvtop, Primblock::fcharp, frexpr(), ftn66flag, i, ICON, ISICON, Listblock::listp, mkchain(), Primblock::namep, ndim, Dimblock::ndim, nequiv, Chain::nextp, nsubs(), NULL, offset, suboffset(), t, type_pref, vardcl(), Nameblock::vdim, and warni().
Referenced by enddcl().
00037 { 00038 register int i; 00039 int inequiv; /* True if one namep occurs in 00040 several EQUIV declarations */ 00041 int comno; /* Index into Extsym table of the last 00042 COMMON block seen (implicitly assuming 00043 that only one will be given) */ 00044 int ovarno; 00045 ftnint comoffset; /* Index into the COMMON block */ 00046 ftnint offset; /* Offset from array base */ 00047 ftnint leng; 00048 register struct Equivblock *equivdecl; 00049 register struct Eqvchain *q; 00050 struct Primblock *primp; 00051 register Namep np; 00052 int k, k1, ns, pref, t; 00053 chainp cp; 00054 extern int type_pref[]; 00055 00056 for(i = 0 ; i < nequiv ; ++i) 00057 { 00058 00059 /* Handle each equivalence declaration */ 00060 00061 equivdecl = &eqvclass[i]; 00062 equivdecl->eqvbottom = equivdecl->eqvtop = 0; 00063 comno = -1; 00064 00065 00066 00067 for(q = equivdecl->equivs ; q ; q = q->eqvnextp) 00068 { 00069 offset = 0; 00070 if (!(primp = q->eqvitem.eqvlhs)) 00071 continue; 00072 vardcl(np = primp->namep); 00073 if(primp->argsp || primp->fcharp) 00074 { 00075 expptr offp; 00076 00077 /* Pad ones onto the end of an array declaration when needed */ 00078 00079 if(np->vdim!=NULL && np->vdim->ndim>1 && 00080 nsubs(primp->argsp)==1 ) 00081 { 00082 if(! ftn66flag) 00083 warni 00084 ("1-dim subscript in EQUIVALENCE, %d-dim declared", 00085 np -> vdim -> ndim); 00086 cp = NULL; 00087 ns = np->vdim->ndim; 00088 while(--ns > 0) 00089 cp = mkchain((char *)ICON(1), cp); 00090 primp->argsp->listp->nextp = cp; 00091 } 00092 00093 offp = suboffset(primp); 00094 if(ISICON(offp)) 00095 offset = offp->constblock.Const.ci; 00096 else { 00097 dclerr 00098 ("nonconstant subscript in equivalence ", 00099 np); 00100 np = NULL; 00101 } 00102 frexpr(offp); 00103 } 00104 00105 /* Free up the primblock, since we now have a hash table (Namep) entry */ 00106 00107 frexpr((expptr)primp); 00108 00109 if(np && (leng = iarrlen(np))<0) 00110 { 00111 dclerr("adjustable in equivalence", np); 00112 np = NULL; 00113 } 00114 00115 if(np) switch(np->vstg) 00116 { 00117 case STGUNKNOWN: 00118 case STGBSS: 00119 case STGEQUIV: 00120 break; 00121 00122 case STGCOMMON: 00123 00124 /* The code assumes that all COMMON references in a given EQUIVALENCE will 00125 be to the same COMMON block, and will all be consistent */ 00126 00127 comno = np->vardesc.varno; 00128 comoffset = np->voffset + offset; 00129 break; 00130 00131 default: 00132 dclerr("bad storage class in equivalence", np); 00133 np = NULL; 00134 break; 00135 } 00136 00137 if(np) 00138 { 00139 q->eqvoffset = offset; 00140 00141 /* eqvbottom gets the largest difference between the array base address 00142 and the address specified in the EQUIV declaration */ 00143 00144 equivdecl->eqvbottom = 00145 lmin(equivdecl->eqvbottom, -offset); 00146 00147 /* eqvtop gets the largest difference between the end of the array and 00148 the address given in the EQUIVALENCE */ 00149 00150 equivdecl->eqvtop = 00151 lmax(equivdecl->eqvtop, leng-offset); 00152 } 00153 q->eqvitem.eqvname = np; 00154 } 00155 00156 /* Now all equivalenced variables are in the hash table with the proper 00157 offset, and eqvtop and eqvbottom are set. */ 00158 00159 if(comno >= 0) 00160 00161 /* Get rid of all STGEQUIVS, they will be mapped onto STGCOMMON variables 00162 */ 00163 00164 eqvcommon(equivdecl, comno, comoffset); 00165 else for(q = equivdecl->equivs ; q ; q = q->eqvnextp) 00166 { 00167 if(np = q->eqvitem.eqvname) 00168 { 00169 inequiv = NO; 00170 if(np->vstg==STGEQUIV) 00171 if( (ovarno = np->vardesc.varno) == i) 00172 { 00173 00174 /* Can't EQUIV different elements of the same array */ 00175 00176 if(np->voffset + q->eqvoffset != 0) 00177 dclerr 00178 ("inconsistent equivalence", np); 00179 } 00180 else { 00181 offset = np->voffset; 00182 inequiv = YES; 00183 } 00184 00185 np->vstg = STGEQUIV; 00186 np->vardesc.varno = i; 00187 np->voffset = - q->eqvoffset; 00188 00189 if(inequiv) 00190 00191 /* Combine 2 equivalence declarations */ 00192 00193 eqveqv(i, ovarno, q->eqvoffset + offset); 00194 } 00195 } 00196 } 00197 00198 /* Now each equivalence declaration is distinct (all connections have been 00199 merged in eqveqv()), and some may be empty. */ 00200 00201 for(i = 0 ; i < nequiv ; ++i) 00202 { 00203 equivdecl = & eqvclass[i]; 00204 if(equivdecl->eqvbottom!=0 || equivdecl->eqvtop!=0) { 00205 00206 /* a live chain */ 00207 00208 k = TYCHAR; 00209 pref = 1; 00210 for(q = equivdecl->equivs ; q; q = q->eqvnextp) 00211 if ((np = q->eqvitem.eqvname) 00212 && !np->veqvadjust) { 00213 np->veqvadjust = 1; 00214 np->voffset -= equivdecl->eqvbottom; 00215 t = typealign[k1 = np->vtype]; 00216 if (pref < type_pref[k1]) { 00217 k = k1; 00218 pref = type_pref[k1]; 00219 } 00220 if(np->voffset % t != 0) { 00221 dclerr("bad alignment forced by equivalence", np); 00222 --nerr; /* don't give bad return code for this */ 00223 } 00224 } 00225 equivdecl->eqvtype = k; 00226 } 00227 freqchain(equivdecl); 00228 } 00229 }
Here is the call graph for this function:
Here is the caller graph for this function:
| LOCAL void eqvcommon | ( | struct Equivblock * | p, | |
| int | comno, | |||
| ftnint | comoffset | |||
| ) |
Definition at line 244 of file equiv.c.
References badstg(), dclerr(), eqvclass, Eqvchain::eqvitem, Eqvchain::eqvname, Eqvchain::eqvnextp, Eqvchain::eqvoffset, errstr(), Extsym::extleng, extsymtab, freqchain(), p, STGBSS, STGCOMMON, STGEQUIV, STGUNKNOWN, Nameblock::vardesc, Nameblock::varno, Nameblock::vcommequiv, Nameblock::voffset, and Nameblock::vstg.
00246 { 00247 int ovarno; 00248 ftnint k, offq; 00249 register Namep np; 00250 register struct Eqvchain *q; 00251 00252 if(comoffset + p->eqvbottom < 0) 00253 { 00254 errstr("attempt to extend common %s backward", 00255 extsymtab[comno].fextname); 00256 freqchain(p); 00257 return; 00258 } 00259 00260 if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng) 00261 extsymtab[comno].extleng = k; 00262 00263 00264 for(q = p->equivs ; q ; q = q->eqvnextp) 00265 if(np = q->eqvitem.eqvname) 00266 { 00267 switch(np->vstg) 00268 { 00269 case STGUNKNOWN: 00270 case STGBSS: 00271 np->vstg = STGCOMMON; 00272 np->vcommequiv = 1; 00273 np->vardesc.varno = comno; 00274 00275 /* np -> voffset will point to the base of the array */ 00276 00277 np->voffset = comoffset - q->eqvoffset; 00278 break; 00279 00280 case STGEQUIV: 00281 ovarno = np->vardesc.varno; 00282 00283 /* offq will point to the current element, even if it's in an array */ 00284 00285 offq = comoffset - q->eqvoffset - np->voffset; 00286 np->vstg = STGCOMMON; 00287 np->vcommequiv = 1; 00288 np->vardesc.varno = comno; 00289 00290 /* np -> voffset will point to the base of the array */ 00291 00292 np->voffset += offq; 00293 if(ovarno != (p - eqvclass)) 00294 eqvcommon(&eqvclass[ovarno], comno, offq); 00295 break; 00296 00297 case STGCOMMON: 00298 if(comno != np->vardesc.varno || 00299 comoffset != np->voffset+q->eqvoffset) 00300 dclerr("inconsistent common usage", np); 00301 break; 00302 00303 00304 default: 00305 badstg("eqvcommon", np->vstg); 00306 } 00307 } 00308 00309 freqchain(p); 00310 p->eqvbottom = p->eqvtop = 0; 00311 }
Here is the call graph for this function:
Definition at line 325 of file equiv.c.
References Equivblock::equivs, Equivblock::eqvbottom, eqvclass, Eqvchain::eqvitem, Eqvchain::eqvname, Eqvchain::eqvnextp, Eqvchain::eqvoffset, Equivblock::eqvtop, free(), lmax(), lmin(), NULL, Nameblock::vardesc, Nameblock::varno, and Nameblock::voffset.
00327 { 00328 register struct Equivblock *neweqv, *oldeqv; 00329 register Namep np; 00330 struct Eqvchain *q, *q1; 00331 00332 neweqv = eqvclass + nvarno; 00333 oldeqv = eqvclass + ovarno; 00334 neweqv->eqvbottom = lmin(neweqv->eqvbottom, oldeqv->eqvbottom - delta); 00335 neweqv->eqvtop = lmax(neweqv->eqvtop, oldeqv->eqvtop - delta); 00336 oldeqv->eqvbottom = oldeqv->eqvtop = 0; 00337 00338 for(q = oldeqv->equivs ; q ; q = q1) 00339 { 00340 q1 = q->eqvnextp; 00341 if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno) 00342 { 00343 q->eqvnextp = neweqv->equivs; 00344 neweqv->equivs = q; 00345 q->eqvoffset += delta; 00346 np->vardesc.varno = nvarno; 00347 np->voffset -= delta; 00348 } 00349 else free( (charptr) q); 00350 } 00351 oldeqv->equivs = NULL; 00352 }
Here is the call graph for this function:
| void freqchain | ( | register struct Equivblock * | p | ) |
Definition at line 361 of file equiv.c.
References Eqvchain::eqvnextp, free(), and NULL.
Referenced by eqvcommon().
00363 { 00364 register struct Eqvchain *q, *oq; 00365 00366 for(q = p->equivs ; q ; q = oq) 00367 { 00368 oq = q->eqvnextp; 00369 free( (charptr) q); 00370 } 00371 p->equivs = NULL; 00372 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 386 of file equiv.c.
References n, and Chain::nextp.
Referenced by doequiv(), and scicos().
00388 { 00389 register int n; 00390 register chainp q; 00391 00392 n = 0; 00393 if(p) 00394 for(q = p->listp ; q ; q = q->nextp) 00395 ++n; 00396 00397 return(n); 00398 }
Here is the caller graph for this function:
Definition at line 404 of file equiv.c.
References err, Expression::headblock, Expression::primblock, Headblock::tag, and TPRIM.
Referenced by yyparse().
00406 { 00407 if (e->headblock.tag != TPRIM) { 00408 err("Invalid name in EQUIVALENCE."); 00409 return 0; 00410 } 00411 return &e->primblock; 00412 }
Here is the caller graph for this function:
1.5.1