/* ROUTINES CALLED DURING DATA STATEMENT PROCESSING */
static char datafmt
[] = "%s\t%05ld\t%05ld\t%d" ;
/* another initializer, called from parser */
register struct constblock
*repp
, *valp
;
register struct addrblock
*p
;
struct addrblock
*nextdata();
else if (ISICON(repp
) && repp
->const.ci
>= 0)
err("invalid repetition count in DATA statement");
err("non-constant initializer");
if(toomanyinit
) goto ret
;
for(i
= 0 ; i
< nrep
; ++i
)
p
= nextdata(&elen
, &vlen
);
err("too many initializers");
setdata(p
, valp
, elen
, vlen
);
struct addrblock
*nextdata(elenp
, vlenp
)
register struct impldoblock
*ip
;
register struct nameblock
*np
;
register struct rplblock
*rp
;
struct constblock
*mkintcon();
if(ip
->implb
==NULL
|| ip
->impub
==NULL
|| ip
->varnp
==NULL
)
fatal1("bad impldoblock 0%o", ip
);
ip
->varvp
->const.ci
+= ip
->impdiff
;
q
= fixtype(cpexpr(ip
->implb
));
q
= fixtype(cpexpr(ip
->impstep
));
ip
->impdiff
= q
->const.ci
;
q
= fixtype(cpexpr(ip
->impub
));
ip
->implim
= q
->const.ci
;
if( (ip
->impdiff
>0 && (ip
->varvp
->const.ci
<= ip
->implim
))
|| (ip
->impdiff
<0 && (ip
->varvp
->const.ci
>= ip
->implim
)) )
if(p
->argsp
==NULL
&& np
->vdim
!=NULL
)
{ /* array initialization */
off
= typesize
[np
->vtype
] * curdtelt
;
off
*= np
->vleng
->const.ci
;
q
->memoffset
= mkexpr(OPPLUS
, q
->memoffset
, mkintcon(off
) );
if( (neltp
= np
->vdim
->nelt
) && ISCONST(neltp
))
if(++curdtelt
< neltp
->const.ci
)
err("attempt to initialize adjustable array");
*elenp
= q
->vleng
->const.ci
;
err("initialization of string of nonconstant length");
else *elenp
= typesize
[q
->vtype
];
if(np
->vstg
== STGCOMMON
)
*vlenp
= extsymtab
[np
->vardesc
.varno
].maxleng
;
else if(np
->vstg
== STGEQUIV
)
*vlenp
= eqvclass
[np
->vardesc
.varno
].eqvleng
;
*vlenp
= (np
->vtype
==TYCHAR
?
np
->vleng
->const.ci
: typesize
[np
->vtype
]);
*vlenp
*= np
->vdim
->nelt
->const.ci
;
err("nonconstant implied DO parameter");
LOCAL
setdata(varp
, valp
, elen
, vlen
)
static char varname
[XL
+2];
/* output form of name is padded with blanks and preceded
with a storage class digit
varname
[0] = (stg
==STGCOMMON
? '2' : (stg
==STGEQUIV
? '1' : '0') );
s
= memname(stg
, varp
->memno
);
for(t
= varname
+1 ; *s
; )
offset
= varp
->memoffset
->const.ci
;
if(type
!=TYCHAR
&& valtype
==TYCHAR
)
warn("non-character datum initialized with character string");
varp
->vleng
= ICON(typesize
[type
]);
varp
->vtype
= type
= TYCHAR
;
else if( (type
==TYCHAR
&& valtype
!=TYCHAR
) ||
(cktype(OPASSIGN
,type
,valtype
) == TYERROR
) )
err("incompatible types in initialization");
else consconv(type
, &con
, valtype
, &valp
->const);
fprintf(initfile
, datafmt
, varname
, offset
, vlen
, type
);
prconi(initfile
, type
, con
.ci
);
fprintf(initfile
, datafmt
, varname
, offset
, vlen
, type
);
prconr(initfile
, type
, con
.cd
[i
]);
offset
+= typesize
[type
];
k
= valp
->vleng
->const.ci
;
fprintf(initfile
, datafmt
, varname
, offset
++, vlen
, TYCHAR
);
fprintf(initfile
, "\t%d\n", valp
->const.ccp
[i
]);
k
= elen
- valp
->vleng
->const.ci
;
fprintf(initfile
, datafmt
, varname
, offset
++, vlen
, TYCHAR
);
fprintf(initfile
, "\t%d\n", ' ');
fatal1("setdata: impossible type %d", type
);
for(p
= p0
; p
; p
= p
->nextp
)
return; /* circular chain completed */