Doxygen Source Code Documentation
data.c File Reference
#include "defs.h"Go to the source code of this file.
Functions | |
| void | dataval (register expptr repp, register expptr valp) |
| Addrp | nextdata (ftnint *elenp) |
| void | setdata (register Addrp varp, register Constp valp, ftnint elen) |
| char * | dataname (int stg, long memno) |
| void | frdata (chainp p0) |
| void | dataline (char *varname, ftnint offset, int type) |
| void | make_param (register struct Paramblock *p, expptr e) |
Variables | |
| char | datafmt [] = "%s\t%09ld\t%d" |
| char * | cur_varname |
| LOCAL FILEP | dfile |
Function Documentation
|
||||||||||||||||
|
Definition at line 437 of file data.c. References datafmt, dfile, and offset. Referenced by setdata().
|
|
||||||||||||
|
Definition at line 376 of file data.c. References memname(), STGCOMMON, and STGEQUIV. Referenced by setdata().
00378 {
00379 static char varname[64];
00380 register char *s, *t;
00381 char buf[16];
00382
00383 if (stg == STGCOMMON) {
00384 varname[0] = '2';
00385 sprintf(s = buf, "Q.%ld", memno);
00386 }
00387 else {
00388 varname[0] = stg==STGEQUIV ? '1' : '0';
00389 s = memname(stg, memno);
00390 }
00391 t = varname + 1;
00392 while(*t++ = *s++);
00393 *t = 0;
00394 return(varname);
00395 }
|
|
||||||||||||
|
Definition at line 38 of file data.c. References Expression::addrblock, err, frexpr(), i, INDATA, ISCONST, ISICON, Addrblock::memoffset, nextdata(), p, setdata(), TADDR, Expression::tag, TCONST, UNAM_CONST, Addrblock::uname_tag, and YES. Referenced by yyparse().
00040 {
00041 int i, nrep;
00042 ftnint elen;
00043 register Addrp p;
00044
00045 if (parstate < INDATA) {
00046 frexpr(repp);
00047 goto ret;
00048 }
00049 if(repp == NULL)
00050 nrep = 1;
00051 else if (ISICON(repp) && repp->constblock.Const.ci >= 0)
00052 nrep = repp->constblock.Const.ci;
00053 else
00054 {
00055 err("invalid repetition count in DATA statement");
00056 frexpr(repp);
00057 goto ret;
00058 }
00059 frexpr(repp);
00060
00061 if( ! ISCONST(valp) ) {
00062 if (valp->tag == TADDR
00063 && valp->addrblock.uname_tag == UNAM_CONST) {
00064 /* kludge */
00065 frexpr(valp->addrblock.memoffset);
00066 valp->tag = TCONST;
00067 }
00068 else {
00069 err("non-constant initializer");
00070 goto ret;
00071 }
00072 }
00073
00074 if(toomanyinit) goto ret;
00075 for(i = 0 ; i < nrep ; ++i)
00076 {
00077 p = nextdata(&elen);
00078 if(p == NULL)
00079 {
00080 if (lineno != err_lineno)
00081 err("too many initializers");
00082 toomanyinit = YES;
00083 goto ret;
00084 }
00085 setdata((Addrp)p, (Constp)valp, elen);
00086 frexpr((expptr)p);
00087 }
00088
00089 ret:
00090 frexpr(valp);
00091 }
|
|
|
Definition at line 405 of file data.c. References charptr, Chain::datap, frchain(), free, frexpr(), Chain::nextp, q, TIMPLDO, and YES. Referenced by yyparse().
00407 {
00408 register struct Chain *p;
00409 register tagptr q;
00410
00411 for(p = p0 ; p ; p = p->nextp)
00412 {
00413 q = (tagptr)p->datap;
00414 if(q->tag == TIMPLDO)
00415 {
00416 if(q->impldoblock.isbusy)
00417 return; /* circular chain completed */
00418 q->impldoblock.isbusy = YES;
00419 frdata(q->impldoblock.datalist);
00420 free( (charptr) q);
00421 }
00422 else
00423 frexpr(q);
00424 }
00425
00426 frchain( &p0);
00427 }
|
|
||||||||||||
|
Definition at line 449 of file data.c. References Expression::addrblock, Constant::ccp1, Constant::ci, CLPARAM, Constblock::Const, Expression::constblock, errstr(), fixexpr(), fixtype(), frexpr(), Paramblock::fvarname, ICON, impldcl(), ISCONST, mkconst(), mkconv(), Paramblock::paramval, putx(), q, STGARG, TADDR, Expression::tag, TEXPR, UNAM_CONST, Addrblock::uname_tag, Addrblock::user, Paramblock::vclass, Paramblock::vleng, Addrblock::vleng, Constblock::vleng, Paramblock::vstg, Constblock::vtype, and Paramblock::vtype. Referenced by yyparse().
00451 {
00452 register expptr q;
00453 Constp qc;
00454
00455 if (p->vstg == STGARG)
00456 errstr("Dummy argument %.50s appears in a parameter statement.",
00457 p->fvarname);
00458 p->vclass = CLPARAM;
00459 impldcl((Namep)p);
00460 if (e->headblock.vtype != TYCHAR)
00461 e = putx(fixtype(e));
00462 p->paramval = q = mkconv(p->vtype, e);
00463 if (p->vtype == TYCHAR) {
00464 if (q->tag == TEXPR)
00465 p->paramval = q = fixexpr((Exprp)q);
00466 if (q->tag == TADDR && q->addrblock.uname_tag == UNAM_CONST) {
00467 qc = mkconst(TYCHAR);
00468 qc->Const = q->addrblock.user.Const;
00469 qc->vleng = q->addrblock.vleng;
00470 q->addrblock.vleng = 0;
00471 frexpr(q);
00472 p->paramval = q = (expptr)qc;
00473 }
00474 if (!ISCONST(q) || q->constblock.vtype != TYCHAR) {
00475 errstr("invalid value for character parameter %s",
00476 p->fvarname);
00477 return;
00478 }
00479 if (!(e = p->vleng))
00480 p->vleng = ICON(q->constblock.vleng->constblock.Const.ci
00481 + q->constblock.Const.ccp1.blanks);
00482 else if (q->constblock.vleng->constblock.Const.ci
00483 > e->constblock.Const.ci) {
00484 q->constblock.vleng->constblock.Const.ci
00485 = e->constblock.Const.ci;
00486 q->constblock.Const.ccp1.blanks = 0;
00487 }
00488 else
00489 q->constblock.Const.ccp1.blanks
00490 = e->constblock.Const.ci
00491 - q->constblock.vleng->constblock.Const.ci;
00492 }
00493 }
|
|
|
Definition at line 99 of file data.c. References Expression::addrblock, ALLOC, Primblock::argsp, charptr, Constant::ci, Constblock::Const, Expression::constblock, cpexpr(), cur_varname, Impldoblock::datalist, err, Fatal(), fatali(), fixtype(), free, frexpr(), Expression::headblock, Impldoblock::impdiff, Impldoblock::implb, Impldoblock::implim, Impldoblock::impstep, Impldoblock::impub, Impldoblock::isactive, ISCONST, ISICON, Addrblock::memoffset, mkaddr(), mkexpr(), mkintcon(), mklhs(), Primblock::namep, NO, OPPLUS, p, q, Rplblock::rplnextp, Rplblock::rplnp, Rplblock::rpltag, Rplblock::rplvp, skip, STGBSS, STGINIT, TCONST, TIMPLDO, Impldoblock::varnp, Impldoblock::varvp, Headblock::vleng, Headblock::vtype, and YES. Referenced by dataval(), and yyparse().
00101 {
00102 register struct Impldoblock *ip;
00103 struct Primblock *pp;
00104 register Namep np;
00105 register struct Rplblock *rp;
00106 tagptr p;
00107 expptr neltp;
00108 register expptr q;
00109 int skip;
00110 ftnint off, vlen;
00111
00112 while(curdtp)
00113 {
00114 p = (tagptr)curdtp->datap;
00115 if(p->tag == TIMPLDO)
00116 {
00117 ip = &(p->impldoblock);
00118 if(ip->implb==NULL || ip->impub==NULL || ip->varnp==NULL)
00119 fatali("bad impldoblock 0%o", (int) ip);
00120 if(ip->isactive)
00121 ip->varvp->Const.ci += ip->impdiff;
00122 else
00123 {
00124 q = fixtype(cpexpr(ip->implb));
00125 if( ! ISICON(q) )
00126 goto doerr;
00127 ip->varvp = (Constp) q;
00128
00129 if(ip->impstep)
00130 {
00131 q = fixtype(cpexpr(ip->impstep));
00132 if( ! ISICON(q) )
00133 goto doerr;
00134 ip->impdiff = q->constblock.Const.ci;
00135 frexpr(q);
00136 }
00137 else
00138 ip->impdiff = 1;
00139
00140 q = fixtype(cpexpr(ip->impub));
00141 if(! ISICON(q))
00142 goto doerr;
00143 ip->implim = q->constblock.Const.ci;
00144 frexpr(q);
00145
00146 ip->isactive = YES;
00147 rp = ALLOC(Rplblock);
00148 rp->rplnextp = rpllist;
00149 rpllist = rp;
00150 rp->rplnp = ip->varnp;
00151 rp->rplvp = (expptr) (ip->varvp);
00152 rp->rpltag = TCONST;
00153 }
00154
00155 if( (ip->impdiff>0 && (ip->varvp->Const.ci <= ip->implim))
00156 || (ip->impdiff<0 && (ip->varvp->Const.ci >= ip->implim)) )
00157 { /* start new loop */
00158 curdtp = ip->datalist;
00159 goto next;
00160 }
00161
00162 /* clean up loop */
00163
00164 if(rpllist)
00165 {
00166 rp = rpllist;
00167 rpllist = rpllist->rplnextp;
00168 free( (charptr) rp);
00169 }
00170 else
00171 Fatal("rpllist empty");
00172
00173 frexpr((expptr)ip->varvp);
00174 ip->isactive = NO;
00175 curdtp = curdtp->nextp;
00176 goto next;
00177 }
00178
00179 pp = (struct Primblock *) p;
00180 np = pp->namep;
00181 cur_varname = np->fvarname;
00182 skip = YES;
00183
00184 if(p->primblock.argsp==NULL && np->vdim!=NULL)
00185 { /* array initialization */
00186 q = (expptr) mkaddr(np);
00187 off = typesize[np->vtype] * curdtelt;
00188 if(np->vtype == TYCHAR)
00189 off *= np->vleng->constblock.Const.ci;
00190 q->addrblock.memoffset =
00191 mkexpr(OPPLUS, q->addrblock.memoffset, mkintcon(off) );
00192 if( (neltp = np->vdim->nelt) && ISCONST(neltp))
00193 {
00194 if(++curdtelt < neltp->constblock.Const.ci)
00195 skip = NO;
00196 }
00197 else
00198 err("attempt to initialize adjustable array");
00199 }
00200 else
00201 q = mklhs((struct Primblock *)cpexpr((expptr)pp), 0);
00202 if(skip)
00203 {
00204 curdtp = curdtp->nextp;
00205 curdtelt = 0;
00206 }
00207 if(q->headblock.vtype == TYCHAR)
00208 if(ISICON(q->headblock.vleng))
00209 *elenp = q->headblock.vleng->constblock.Const.ci;
00210 else {
00211 err("initialization of string of nonconstant length");
00212 continue;
00213 }
00214 else *elenp = typesize[q->headblock.vtype];
00215
00216 if (np->vstg == STGBSS) {
00217 vlen = np->vtype==TYCHAR
00218 ? np->vleng->constblock.Const.ci
00219 : typesize[np->vtype];
00220 if(vlen > 0)
00221 np->vstg = STGINIT;
00222 }
00223 return( (Addrp) q );
00224
00225 doerr:
00226 err("nonconstant implied DO parameter");
00227 frexpr(q);
00228 curdtp = curdtp->nextp;
00229
00230 next:
00231 curdtelt = 0;
00232 }
00233
00234 return(NULL);
00235 }
|
|
||||||||||||||||
|
Definition at line 248 of file data.c. References badtype(), Constant::ci, cktype(), CLBLOCK, consconv(), Constblock::Const, Expression::constblock, cur_varname, dataline(), dataname(), dfile, err, i, ICON, offset, OPASSIGN, opf(), prcona(), prconi(), prconr(), STGCOMMON, TYBLANK, TYERROR, TYQUAD, UNAM_NAME, Constblock::vleng, Constblock::vtype, and warn1(). Referenced by dataval().
00250 {
00251 struct Constblock con;
00252 register int type;
00253 int i, k, valtype;
00254 ftnint offset;
00255 char *varname;
00256 static Addrp badvar;
00257 register unsigned char *s;
00258 static int last_lineno;
00259 static char *last_varname;
00260
00261 if (varp->vstg == STGCOMMON) {
00262 if (!(dfile = blkdfile))
00263 dfile = blkdfile = opf(blkdfname, textwrite);
00264 }
00265 else {
00266 if (procclass == CLBLOCK) {
00267 if (varp != badvar) {
00268 badvar = varp;
00269 warn1("%s is not in a COMMON block",
00270 varp->uname_tag == UNAM_NAME
00271 ? varp->user.name->fvarname
00272 : "???");
00273 }
00274 return;
00275 }
00276 if (!(dfile = initfile))
00277 dfile = initfile = opf(initfname, textwrite);
00278 }
00279 varname = dataname(varp->vstg, varp->memno);
00280 offset = varp->memoffset->constblock.Const.ci;
00281 type = varp->vtype;
00282 valtype = valp->vtype;
00283 if(type!=TYCHAR && valtype==TYCHAR)
00284 {
00285 if(! ftn66flag
00286 && (last_varname != cur_varname || last_lineno != lineno)) {
00287 /* prevent multiple warnings */
00288 last_lineno = lineno;
00289 warn1(
00290 "non-character datum %.42s initialized with character string",
00291 last_varname = cur_varname);
00292 }
00293 varp->vleng = ICON(typesize[type]);
00294 varp->vtype = type = TYCHAR;
00295 }
00296 else if( (type==TYCHAR && valtype!=TYCHAR) ||
00297 (cktype(OPASSIGN,type,valtype) == TYERROR) )
00298 {
00299 err("incompatible types in initialization");
00300 return;
00301 }
00302 if(type == TYADDR)
00303 con.Const.ci = valp->Const.ci;
00304 else if(type != TYCHAR)
00305 {
00306 if(valtype == TYUNKNOWN)
00307 con.Const.ci = valp->Const.ci;
00308 else consconv(type, &con, valp);
00309 }
00310
00311 k = 1;
00312
00313 switch(type)
00314 {
00315 case TYLOGICAL:
00316 case TYINT1:
00317 case TYLOGICAL1:
00318 case TYLOGICAL2:
00319 case TYSHORT:
00320 case TYLONG:
00321 #ifdef TYQUAD
00322 case TYQUAD:
00323 #endif
00324 dataline(varname, offset, type);
00325 prconi(dfile, con.Const.ci);
00326 break;
00327
00328 case TYADDR:
00329 dataline(varname, offset, type);
00330 prcona(dfile, con.Const.ci);
00331 break;
00332
00333 case TYCOMPLEX:
00334 case TYDCOMPLEX:
00335 k = 2;
00336 case TYREAL:
00337 case TYDREAL:
00338 dataline(varname, offset, type);
00339 prconr(dfile, &con, k);
00340 break;
00341
00342 case TYCHAR:
00343 k = valp -> vleng -> constblock.Const.ci;
00344 if (elen < k)
00345 k = elen;
00346 s = (unsigned char *)valp->Const.ccp;
00347 for(i = 0 ; i < k ; ++i) {
00348 dataline(varname, offset++, TYCHAR);
00349 fprintf(dfile, "\t%d\n", *s++);
00350 }
00351 k = elen - valp->vleng->constblock.Const.ci;
00352 if(k > 0) {
00353 dataline(varname, offset, TYBLANK);
00354 fprintf(dfile, "\t%d\n", k);
00355 }
00356 break;
00357
00358 default:
00359 badtype("setdata", type);
00360 }
00361
00362 }
|
Variable Documentation
|
|
Definition at line 29 of file data.c. Referenced by nextdata(), and setdata(). |
|
|
Definition at line 28 of file data.c. Referenced by dataline(). |
|
|
Definition at line 239 of file data.c. Referenced by dataline(), and setdata(). |
