![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to addr.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / efl|
Return to addr.c CVS log | Up to [Research Unix] / researchv10no / cmd / efl |
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.