Return to addr.c CVS log

Up to [Research Unix] / researchv10no / cmd / efl

Annotation of researchv10no/cmd/efl/addr.c, revision 1.1

1.1     ! root        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 || ((struct dimblock *)(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,((struct chain *)(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 = (int *)mkchain(mkint(1), s->leftp);
        !            68:        }
        !            69: 
        !            70: else   {   /* add to offset, set first subscript to 1 */
        !            71:        q = mknode(TAROP,OPMINUS,((struct chain *)(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:        ((struct chain *)(s->leftp))->datap = (int *)mkint(1);
        !            78:        }
        !            79: ret:
        !            80:        return((struct varblock *)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: if(subelt->tag == TLABEL)
        !           101:        {
        !           102:        exprerr("attempt to use label name as structure member", CNULL);
        !           103:        return(errnode());
        !           104:        }
        !           105: for(p = ((struct typeblock *)var->vtypep)->strdesc ; p ; p = p->nextp)
        !           106:        if(subelt == ((struct defblock *)p->datap)->sthead) break;
        !           107: if(p == 0)
        !           108:        {
        !           109:        exprerr("%s is not in structure\n", subelt->namep);
        !           110:        return(errnode());
        !           111:        }
        !           112: q = p->datap;
        !           113: var->vdim = q->vdim;
        !           114: var->vtypep = q->vtypep;
        !           115: if(q->voffset)
        !           116:        if(var->voffset)
        !           117:                var->voffset = mknode(TAROP,OPPLUS,var->voffset,cpexpr(q->voffset));
        !           118:        else    {
        !           119:                var->voffset = cpexpr(q->voffset);
        !           120:                }
        !           121: if( (var->vtype = q->vtype) != TYSTRUCT)
        !           122:        convtype(var);
        !           123: return(var);
        !           124: }
        !           125: 
        !           126: 
        !           127: 
        !           128: convtype(p)
        !           129: register ptr p;
        !           130: {
        !           131: register int i, k;
        !           132: ptr mksub1();
        !           133: 
        !           134: switch(p->vtype)
        !           135:        {
        !           136:        case TYFIELD:
        !           137:        case TYINT:
        !           138:        case TYCHAR:
        !           139:        case TYREAL:
        !           140:        case TYLREAL:
        !           141:        case TYCOMPLEX:
        !           142:        case TYLOG:
        !           143:                k = eflftn[p->vtype];
        !           144:                break;
        !           145: 
        !           146:        default:
        !           147:                fatal("convtype: impossible type");
        !           148:        }
        !           149: 
        !           150: for(i=0; i<NFTNTYPES; ++i)
        !           151:        if(i != k) p->vbase[i] = 0;
        !           152:        else if(p->vbase[i]==0)
        !           153:                {
        !           154:                exprerr("illegal combination of array and dot",CNULL);
        !           155:                mvexpr(errnode(), p);
        !           156:                return;
        !           157:                }
        !           158: 
        !           159: if(p->vsubs == 0)
        !           160:        p->vsubs = mksub1();
        !           161: 
        !           162: }
        !           163: 
        !           164: 
        !           165: 
        !           166: fixsubs(p)
        !           167: register ptr p;
        !           168: {
        !           169: ptr q, *firstsub;
        !           170: int size,align,mask;
        !           171: 
        !           172: if(p->voffset)
        !           173:        {
        !           174:        firstsub = &(((struct chain *)(((struct exprblock *)p->vsubs)->leftp))->datap);
        !           175:        sizalign(p, &size,&align,&mask);
        !           176:        if(p->vtype == TYCHAR)
        !           177:                size = tailor.ftnsize[FTNINT];
        !           178: 
        !           179:        q = mknode(TAROP,OPSLASH,p->voffset,mkint(size));
        !           180:        *firstsub = mknode(TAROP,OPPLUS, q, *firstsub);
        !           181:        p->voffset = 0;
        !           182:        }
        !           183: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.