entrypt(int Class, int type, ftnint length, Extsym *entry, chainp args)
#endif
{
register Namep q;
register struct Entrypoint *p;
if(Class != CLENTRY)
puthead( procname = entry->cextname, Class);
else
fprintf(diagfile, " entry ");
fprintf(diagfile, " %s:\n", entry->fextname);
fflush(diagfile);
q = mkname(entry->fextname);
if (type == TYSUBR)
q->vstg = STGEXT;
type = lengtype(type, length);
if(Class == CLPROC)
{
procclass = CLPROC;
proctype = type;
procleng = type == TYCHAR ? length : 0;
}
p = ALLOC(Entrypoint);
p->entnextp = entries;
entries = p;
p->entryname = entry;
p->arglist = revchain(args);
p->enamep = q;
if(Class == CLENTRY)
{
Class = CLPROC;
if(proctype == TYSUBR)
type = TYSUBR;
}
q->vclass = Class;
q->vprocclass = 0;
settype(q, type, length);
q->vprocclass = PTHISPROC;
/* hold all initial entry points till end of declarations */
if(parstate >= INDATA)
doentry(p);
}
setimpl(int type, ftnint length, int c1, int c2)
#endif
{
int i;
char buff[100];
if(c1==0 || c2==0)
return;
if(c1 > c2) {
sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
err(buff);
}
else {
c1 = letter(c1);
c2 = letter(c2);
if(type < 0)
for(i = c1 ; i<=c2 ; ++i)
implstg[i] = - type;
else {
type = lengtype(type, length);
if(type == TYCHAR) {
if (length < 0) {
err("length (*) in implicit");
length = 1;
}
}
else if (type != TYLONG)
length = 0;
for(i = c1 ; i<=c2 ; ++i) {
impltype[i] = type;
implleng[i] = length;
}
}
}
}
settype(register Namep v, register int type, register ftnint length)
#endif
{
int type1;
if(type == TYUNKNOWN)
return;
if(type==TYSUBR && v->vtype!=TYUNKNOWN && v->vstg==STGARG)
{
v->vtype = TYSUBR;
frexpr(v->vleng);
v->vleng = 0;
v->vimpltype = 0;
}
else if(type < 0) /* storage class set */
{
if(v->vstg == STGUNKNOWN)
v->vstg = - type;
else if(v->vstg != -type)
dclerr("incompatible storage declarations", v);
}
else if(v->vtype == TYUNKNOWN
|| v->vtype != type
&& (v->vimpltype || v->vinftype || v->vinfproc))
{
if( (v->vtype = lengtype(type, length))==TYCHAR )
if (length>=0)
v->vleng = ICON(length);
else if (parstate >= INDATA)
v->vleng = ICON(1); /* avoid a memory fault */
v->vimpltype = 0;
v->vinftype = 0; /* 19960709 */
v->vinfproc = 0; /* 19960709 */
if (v->vclass == CLPROC) {
if (v->vstg == STGEXT
&& (type1 = extsymtab[v->vardesc.varno].extype)
&& type1 != v->vtype)
changedtype(v);
else if (v->vprocclass == PTHISPROC
&& (parstate >= INDATA
|| procclass == CLMAIN)
&& !xretslot[type]) {
xretslot[type] = autovar(ONEOF(type,
MSKCOMPLEX|MSKCHAR) ? 0 : 1, type,
v->vleng, " ret_val");
if (procclass == CLMAIN)
errstr(
"illegal use of %.60s (main program name)",
v->fvarname);
/* not completely right, but enough to */
/* avoid memory faults; we won't */
/* emit any C as we have illegal Fortran */
}
}
}
else if(v->vtype != type && v->vtype != lengtype(type, length)) {
incompat:
dclerr("incompatible type declarations", v);
}
else if (type==TYCHAR)
if (v->vleng && v->vleng->constblock.Const.ci != length)
goto incompat;
else if (parstate >= INDATA)
v->vleng = ICON(1); /* avoid a memory fault */
}
