BSD 4_3 development

[unix-history] / usr / src / usr.bin / efl / addr.c

#include "defs"

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

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

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

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

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

v->vsubs = s;

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

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

       s->leftp->datap = mkint(1);
       }
ret:
       return(v);
}





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

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



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

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

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

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

if(p->vsubs == 0)
       p->vsubs = mksub1();

}



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

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

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