|
|
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 || 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.