![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to a4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src|
Return to a4.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
1.1 root 1: static char Sccsid[] = "a4.c @(#)a4.c 1.2 10/5/82 Berkeley ";
2: #include "apl.h"
3:
4: /*
5: * parser generates the following for each label
6: *
7: * AUTO-name CONST NAME-name LABEL
8: *
9: * (where CONST is the label address)
10: */
11: ex_label()
12: {
13: register struct nlist *n;
14:
15: ex_asgn();
16: n = (struct nlist *)sp[-1];
17: n->itemp->type = LBL; /* lock out assignments */
18: sp--; /* discard stack */
19: }
20:
21:
22: ex_asgn()
23: {
24: register struct nlist *p;
25: register struct item *q;
26:
27: p = (struct nlist *)sp[-1];
28: switch(p->type){
29: case QX:
30: pop();
31: p = nlook("Llx");
32: if(p == 0){
33: /*
34: * allocate new name:
35: */
36: for(p=nlist; p->namep; p++) {}
37: p->namep = alloc(4);
38: copy(CH, "Llx", p->namep, 4);
39: p->type = LV;
40: p->use = 0;
41: p->itemp = newdat(CH, 0, 0);
42: }
43: sp++; /* reset stack */
44: break;
45: case QD:
46: pop();
47: ex_print();
48: return;
49: case QC:
50: pop();
51: ex_plot();
52: return;
53: case QQ:
54: pop();
55: epr0(); /* print w/out '\n' (in a2.c) */
56: return;
57: case LV:
58: /* The following line checks that it is not the first assignment
59: * to the local variable, in which case itemp has not be set yet
60: * This used to produce an interesting bug when adress 1 was
61: * holding the manifest constant LBL ... just by chance !
62: */
63: if (((struct nlist *)p)->itemp != 0) {
64: if(((struct nlist *)p)->itemp->type == LBL)
65: error("asgn to label");
66: }
67: break;
68: default:
69: error("asgn lv");
70: }
71: if(p->use != 0 && p->use != DA)
72: error("asgn var");
73: sp--;
74: q = fetch1();
75: erase(p);
76: p->use = DA;
77: ((struct nlist *)p)->itemp = q;
78: sp[-1] = (struct item *)p;
79: }
80:
81: ex_elid()
82: {
83:
84: *sp++ = newdat(EL, 0, 0);
85: }
86:
87: ex_index()
88: {
89: register struct item *p;
90: struct item *q;
91: register i, j;
92: int f, n, lv;
93:
94: n = *pcp++;
95: f = *pcp;
96: p = sp[-1];
97: if(f == ASGN) {
98: pcp++;
99: if(p->type != LV)
100: error("indexed assign value");
101: if(((struct nlist *)p)->use != DA)
102: fetch1(); /* error("used before set"); */
103: q = ((struct nlist *)p)->itemp;
104: } else
105: q = fetch1();
106: if(q->rank != n)
107: error("subscript C");
108: idx.rank = 0;
109: for(i=0; i<n; i++) {
110: p = sp[-i-2];
111: if(p->type == EL) {
112: idx.dim[idx.rank++] =
113: q->dim[i];
114: continue;
115: }
116: p = fetch(p);
117: sp[-i-2] = p;
118: for(j=0; j<p->rank; j++)
119: idx.dim[idx.rank++] =
120: p->dim[j];
121: }
122: size();
123: if(f == ASGN) {
124: p = fetch(sp[-n-2]);
125: sp[-n-2] = p;
126: if (p->size > 1) {
127: if(idx.size != p->size)
128: error("assign C");
129: f = 1; /* v[i] <- v */
130: } else {
131: if (idx.size && !p->size)
132: error("assign C");
133: /* Note -- for idx.size = 0, no assign occurs
134: * anyway, so it is safe to set "datum" to 0
135: */
136: datum = p->size ? getdat(p) : 0;
137: f = 2; /* v[i] <- s */
138: }
139: ex_elid();
140: } else {
141: p = newdat(q->type, idx.rank, idx.size);
142: copy(IN, idx.dim, p->dim, idx.rank);
143: *sp++ = p;
144: f = 0; /* v[i] */
145: }
146: bidx(q);
147: index1(0, f);
148: if(f == 0) {
149: p = sp[-1];
150: sp--;
151: for(i=0; i<=n; i++)
152: pop();
153: *sp++ = p;
154: } else {
155: pop(); /* pop ELID */
156: sp--; /* skip over LV */
157: for(i=0; i<n; i++)
158: pop();
159: }
160: }
161:
162: index1(i, f)
163: {
164: register struct item *p;
165: register j, k;
166:
167: if(i >= idx.rank)
168: switch(f) {
169:
170: case 0:
171: p = sp[-2];
172: p->index = access();
173: putdat(sp[-1], getdat(p));
174: return;
175:
176: case 1:
177: datum = getdat(sp[-idx.rank-3]);
178:
179: case 2:
180: p = ((struct nlist *)sp[-2])->itemp;
181: p->index = access();
182: putdat(p, datum);
183: return;
184: }
185: p = sp[-i-3];
186: if(p->type == EL) {
187: for(j=0; j<idx.dim[i]; j++) {
188: idx.idx[i] = j;
189: index1(i+1, f);
190: }
191: return;
192: }
193: p->index = 0;
194: for(j=0; j<p->size; j++) {
195: k = fix(getdat(p)) - thread.iorg;
196: if(k < 0 || k >= idx.dim[i])
197: error("subscript X");
198: idx.idx[i] = k;
199: index1(i+1, f);
200: }
201: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.