1: #include "defs"
   2: 
   3: struct varblock *subscript(v,s)
   4: register ptr v,s;
   5: {
   6: ptr p;
   7: register ptr q;
   8: ptr bounds, subs;
   9: int size, align, mask;
  10: 
  11: if(v->tag == TERROR)
  12:     goto ret;
  13: if(v->tag!=TNAME && v->tag!=TTEMP)
  14:     badtag("subscript", v->tag);
  15: if(s->tag == TERROR)
  16:     {
  17:     v->vsubs = 0;
  18:     goto ret;
  19:     }
  20: 
  21: if(s->tag != TLIST)
  22:     badtag("subscript", s->tag);
  23: sizalign(v, &size, &align, &mask);
  24: if(bounds = v->vdim)
  25:     bounds = bounds->datap;
  26: subs = s->leftp;
  27: 
  28: while ( bounds && subs)
  29:     {
  30:     if(bounds->lowerb)
  31:         {
  32:         p = mknode(TAROP,OPMINUS,mkint(1),cpexpr(bounds->lowerb));
  33:         subs->datap = mknode(TAROP,OPPLUS, subs->datap, p);
  34:         }
  35:     bounds = bounds->nextp;
  36:     subs = subs->nextp;
  37:     }
  38: v->vdim = 0;
  39: if(bounds || subs)
  40:     {
  41:     exprerr("subscript and bounds of different length", CNULL);
  42:     v->vsubs = 0;
  43:     goto ret;
  44:     }
  45: 
  46: if(v->vsubs)
  47:     { /* special case of subscripted type element */
  48:     if(s->leftp==0 || s->leftp->nextp!=0)
  49:         {
  50:         exprerr("not exactly one subscript on type member", CNULL);
  51:         v->vsubs = 0;
  52:         goto ret;
  53:         }
  54:     q = mknode(TAROP,OPMINUS,s->leftp->datap, mkint(1) );
  55:     q = mknode(TAROP,OPSTAR, mkint(size), q);
  56:     if(v->voffset)
  57:         v->voffset = mknode(TAROP,OPPLUS,v->voffset, q);
  58:     else    v->voffset = q;
  59:     goto ret;
  60:     }
  61: 
  62: v->vsubs = s;
  63: 
  64: if(v->vtype==TYCHAR || v->vtype==TYSTRUCT ||
  65:     (v->vtype==TYLCOMPLEX && tailor.lngcxtype==NULL) )
  66:     { /* add an initial unit subscript */
  67:     s->leftp = mkchain(mkint(1), s->leftp);
  68:     }
  69: 
  70: else    {   /* add to offset, set first subscript to 1 */
  71:     q = mknode(TAROP,OPMINUS,s->leftp->datap, mkint(1) );
  72:     q = mknode(TAROP,OPSTAR, mkint(size), q);
  73:     if(v->voffset)
  74:         v->voffset = mknode(TAROP,OPPLUS,v->voffset, q);
  75:     else    v->voffset = q;
  76: 
  77:     s->leftp->datap = mkint(1);
  78:     }
  79: ret:
  80:     return(v);
  81: }
  82: 
  83: 
  84: 
  85: 
  86: 
  87: ptr strucelt(var, subelt)
  88: register ptr var;
  89: ptr subelt;
  90: {
  91: register ptr p, q;
  92: 
  93: if(var->tag == TERROR)
  94:     return(var);
  95: if(var->vtype!=TYSTRUCT || var->vtypep==0 || var->vdim!=0)
  96:     {
  97:     exprerr("attempt to find a member in an array or non-structure", CNULL);
  98:     return(errnode());
  99:     }
 100: for(p = var->vtypep->strdesc ; p ; p = p->nextp)
 101:     if(subelt == p->datap->sthead) break;
 102: if(p == 0)
 103:     {
 104:     exprerr("%s is not in structure\n", subelt->namep);
 105:     return(errnode());
 106:     }
 107: q = p->datap;
 108: var->vdim = q->vdim;
 109: var->vtypep = q->vtypep;
 110: if(q->voffset)
 111:     if(var->voffset)
 112:         var->voffset = mknode(TAROP,OPPLUS,var->voffset,cpexpr(q->voffset));
 113:     else    {
 114:         var->voffset = cpexpr(q->voffset);
 115:         }
 116: if( (var->vtype = q->vtype) != TYSTRUCT)
 117:     convtype(var);
 118: return(var);
 119: }
 120: 
 121: 
 122: 
 123: convtype(p)
 124: register ptr p;
 125: {
 126: register int i, k;
 127: ptr mksub1();
 128: 
 129: switch(p->vtype)
 130:     {
 131:     case TYFIELD:
 132:     case TYINT:
 133:     case TYCHAR:
 134:     case TYREAL:
 135:     case TYLREAL:
 136:     case TYCOMPLEX:
 137:     case TYLOG:
 138:         k = eflftn[p->vtype];
 139:         break;
 140: 
 141:     default:
 142:         fatal("convtype: impossible type");
 143:     }
 144: 
 145: for(i=0; i<NFTNTYPES; ++i)
 146:     if(i != k) p->vbase[i] = 0;
 147:     else if(p->vbase[i]==0)
 148:         {
 149:         exprerr("illegal combination of array and dot",CNULL);
 150:         mvexpr(errnode(), p);
 151:         return;
 152:         }
 153: 
 154: if(p->vsubs == 0)
 155:     p->vsubs = mksub1();
 156: 
 157: }
 158: 
 159: 
 160: 
 161: fixsubs(p)
 162: register ptr p;
 163: {
 164: ptr q, *firstsub;
 165: int size,align,mask;
 166: 
 167: if(p->voffset)
 168:     {
 169:     firstsub = &(p->vsubs->leftp->datap);
 170:     sizalign(p, &size,&align,&mask);
 171:     if(p->vtype == TYCHAR)
 172:         size = tailor.ftnsize[FTNINT];
 173: 
 174:     q = mknode(TAROP,OPSLASH,p->voffset,mkint(size));
 175:     *firstsub = mknode(TAROP,OPPLUS, q, *firstsub);
 176:     p->voffset = 0;
 177:     }
 178: }

Defined functions

convtype defined in line 123; used 1 times
fixsubs defined in line 161; used 1 times
strucelt defined in line 87; never used
subscript defined in line 3; used 3 times
Last modified: 1982-06-09
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1038
Valid CSS Valid XHTML 1.0 Strict