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