static char rcsid[] = "$Header:addr.c 12.0$";
#include "defs"

struct varblock *subscript(v,s)
register ptr v,s;
{
ptr p;
register ptr q;
ptr bounds, subs;
int size, align, mask;

if(((struct headbits *)v)->tag == TERROR)
	goto ret;
if(((struct headbits *)v)->tag!=TNAME && ((struct headbits *)v)->tag!=TTEMP)
	badtag("subscript", ((struct headbits *)v)->tag);
if(((struct headbits *)s)->tag == TERROR)
	{
	((struct varblock *)v)->vsubs = 0;
	goto ret;
	}

if(((struct headbits *)s)->tag != TLIST)
	badtag("subscript", ((struct headbits *)s)->tag);
sizalign(v, &size, &align, &mask);
if(bounds = ((struct varblock *)v)->vdim)
	bounds = ((struct chain *)bounds)->datap;
subs = ((struct exprblock *)s)->leftp;

while ( bounds && subs)
	{
	if(((struct dimblock *)bounds)->lowerb)
		{
		p = mknode(TAROP,OPMINUS,mkint(1),cpexpr(((struct dimblock *)bounds)->lowerb));
		((struct chain *)subs)->datap = mknode(TAROP,OPPLUS, ((struct chain *)subs)->datap, p);
		}
	bounds = ((struct dimblock *)bounds)->nextp;
	subs = ((struct dimblock *)subs)->nextp;
	}
((struct varblock *)v)->vdim = 0;
if(bounds || subs)
	{
	exprerr("subscript and bounds of different length", CNULL);
	((struct varblock *)v)->vsubs = 0;
	goto ret;
	}

if(((struct varblock *)v)->vsubs)
	{ /* special case of subscripted type element */
	if(((struct exprblock *)s)->leftp==0 || ((struct dimblock *)((struct exprblock *)s)->leftp)->nextp!=0)
		{
		exprerr("not exactly one subscript on type member", CNULL);
		((struct varblock *)v)->vsubs = 0;
		goto ret;
		}
	q = mknode(TAROP,OPMINUS,((struct chain *)((struct exprblock *)s)->leftp)->datap, mkint(1) );
	q = mknode(TAROP,OPSTAR, mkint(size), q);
	if(((struct exprblock *)v)->voffset)
		((struct exprblock *)v)->voffset = mknode(TAROP,OPPLUS,((struct exprblock *)v)->voffset, q);
	else	((struct exprblock *)v)->voffset = q;
	goto ret;
	}

((struct varblock *)v)->vsubs = s;

if(((struct varblock *)v)->vtype==TYCHAR || ((struct varblock *)v)->vtype==TYSTRUCT ||
	(((struct varblock *)v)->vtype==TYLCOMPLEX && tailor.lngcxtype==NULL) )
	{ /* add an initial unit subscript */
	((struct exprblock *)s)->leftp = (ptr)mkchain(mkint(1), ((struct exprblock *)s)->leftp);
	}

else	{   /* add to offset, set first subscript to 1 */
	q = mknode(TAROP,OPMINUS,((struct chain *)((struct exprblock *)s)->leftp)->datap, mkint(1) );
	q = mknode(TAROP,OPSTAR, mkint(size), q);
	if(((struct exprblock *)v)->voffset)
		((struct exprblock *)v)->voffset = mknode(TAROP,OPPLUS,((struct exprblock *)v)->voffset, q);
	else	((struct exprblock *)v)->voffset = q;

	((struct chain *)((struct exprblock *)s)->leftp)->datap = mkint(1);
	}
ret:
	return((struct varblock *)v);
}





ptr strucelt(var, subelt)
register ptr var;
ptr subelt;
{
register ptr p, q;

if(((struct headbits *)var)->tag == TERROR)
	return(var);
if(((struct varblock *)var)->vtype!=TYSTRUCT || ((struct varblock *)var)->vtypep==0 || ((struct varblock *)var)->vdim!=0)
	{
	exprerr("attempt to find a member in an array or non-structure", CNULL);
	return(errnode());
	}
for(p = ((struct typeblock *)((struct varblock *)var)->vtypep)->strdesc ; p ; p = ((struct dimblock *)p)->nextp)
	if(subelt == ((struct varblock *)((struct chain *)p)->datap)->sthead) break;
if(p == 0)
	{
	exprerr("%s is not in structure\n", ((struct stentry *)subelt)->namep);
	return(errnode());
	}
q = ((struct chain *)p)->datap;
((struct varblock *)var)->vdim = ((struct varblock *)q)->vdim;
((struct varblock *)var)->vtypep = ((struct varblock *)q)->vtypep;
if(((struct exprblock *)q)->voffset)
	if(((struct exprblock *)var)->voffset)
		((struct exprblock *)var)->voffset = mknode(TAROP,OPPLUS,((struct exprblock *)var)->voffset,cpexpr(((struct exprblock *)q)->voffset));
	else	{
		((struct exprblock *)var)->voffset = cpexpr(((struct exprblock *)q)->voffset);
		}
if( (((struct varblock *)var)->vtype = ((struct varblock *)q)->vtype) != TYSTRUCT)
	convtype(var);
return(var);
}



convtype(p)
register ptr p;
{
register int i, k;
ptr mksub1();

switch(((struct varblock *)p)->vtype)
	{
	case TYFIELD:
	case TYINT:
	case TYCHAR:
	case TYREAL:
	case TYLREAL:
	case TYCOMPLEX:
	case TYLOG:
		k = eflftn[((struct varblock *)p)->vtype];
		break;

	default:
		fatal("convtype: impossible type");
	}

for(i=0; i<NFTNTYPES; ++i)
	if(i != k) ((struct varblock *)p)->vbase[i] = 0;
	else if(((struct varblock *)p)->vbase[i]==0)
		{
		exprerr("illegal combination of array and dot",CNULL);
		mvexpr(errnode(), p);
		return;
		}

if(((struct varblock *)p)->vsubs == 0)
	((struct varblock *)p)->vsubs = mksub1();

}



fixsubs(p)
register ptr p;
{
ptr q, *firstsub;
int size,align,mask;

if(((struct exprblock *)p)->voffset)
	{
	firstsub = &(((struct chain *)((struct exprblock *)((struct varblock *)p)->vsubs)->leftp)->datap);
	sizalign(p, &size,&align,&mask);
	if(((struct varblock *)p)->vtype == TYCHAR)
		size = tailor.ftnsize[FTNINT];

	q = mknode(TAROP,OPSLASH,((struct exprblock *)p)->voffset,mkint(size));
	*firstsub = mknode(TAROP,OPPLUS, q, *firstsub);
	((struct exprblock *)p)->voffset = 0;
	}
}
