![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ab.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 ab.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
1.1 root 1: static char Sccsid[] = "ab.c @(#)ab.c 1.1 10/1/82 Berkeley ";
2: #include "apl.h"
3:
4: ex_take()
5: {
6: int takezr();
7: register i, k, o;
8: int fill[MRANK], fflg;
9:
10: /* While TANSTAAFL, in APL there is a close approximation. It
11: * is possible to perform a "take" of more elements than an
12: * array actually contains (to be padded with zeros or blanks).
13: * If "td1()" detects that a dimension exceeds what the array
14: * actually contains it will return 1. Special code is then
15: * required to force the extra elements in the new array to
16: * zero or blank. This code is supposed to work for null items
17: * also, but it doesn't.
18: */
19:
20: o = 0;
21: fflg = td1(0);
22: for(i=0; i<idx.rank; i++) {
23: fill[i] = 0;
24: k = idx.idx[i];
25: if(k < 0) {
26: k = -k;
27: if (k > idx.dim[i])
28: fill[i] = idx.dim[i] - k;
29: o += idx.del[i] *
30: (idx.dim[i] - k);
31: } else
32: if (k > idx.dim[i])
33: fill[i] = idx.dim[i];
34: idx.dim[i] = k;
35: }
36: map(o);
37:
38: if (fflg){
39: bidx(sp[-1]);
40: forloop(takezr, fill);
41: }
42: }
43:
44: ex_drop()
45: {
46: register i, k, o;
47:
48: o = 0;
49: td1(1);
50: for(i=0; i<idx.rank; i++) {
51: k = idx.idx[i];
52: if(k > 0)
53: o += idx.del[i] * k;
54: else
55: k = -k;
56: idx.dim[i] -= k;
57: }
58: map(o);
59: }
60:
61: td1(tdmode)
62: {
63: register struct item *p;
64: struct item *q, *nq, *s2vect();
65: register i, k;
66: int r; /* set to 1 if take > array dim */
67:
68: p = fetch2();
69: q = sp[-2];
70: r = !q->size; /* Weird stuff for null items */
71: if (q->rank == 0){ /* Extend scalars */
72: nq = newdat(q->type, p->size, 1);
73: *nq->datap = *q->datap;
74: pop();
75: *sp++ = q = nq;
76: for(i=0; i<p->size; i++)
77: q->dim[i] = 1;
78: }
79: if(p->rank > 1 || q->rank != p->size)
80: error("take/drop C");
81: bidx(q);
82: for(i=0; i<p->size; i++) {
83: k = fix(getdat(p));
84: idx.idx[i] = k;
85: if(k < 0)
86: k = -k;
87:
88: /* If an attempt is made to drop more than what
89: * exists, modify the drop to drop exactly what
90: * exists.
91: */
92:
93: if(k > idx.dim[i])
94: if (tdmode)
95: idx.idx[i] = idx.dim[i];
96: else
97: r = 1;
98: }
99: pop();
100: return(r);
101: }
102:
103: ex_dtrn()
104: {
105: register struct item *p, *q;
106: register i;
107:
108: p = fetch2();
109: q = sp[-2];
110: if(p->rank > 1 || p->size != q->rank)
111: error("tranpose C");
112: for(i=0; i<p->size; i++)
113: idx.idx[i] = fix(getdat(p)) - thread.iorg;
114: pop();
115: trn0();
116: }
117:
118: ex_mtrn()
119: {
120: register struct item *p;
121: register i;
122:
123: p = fetch1();
124: if(p->rank <= 1)
125: return;
126: for(i=0; i<p->rank; i++)
127: idx.idx[i] = p->rank-1-i;
128: trn0();
129: }
130:
131: trn0()
132: {
133: register i, j;
134: int d[MRANK], r[MRANK];
135:
136: bidx(sp[-1]);
137: for(i=0; i<idx.rank; i++)
138: d[i] = -1;
139: for(i=0; i<idx.rank; i++) {
140: j = idx.idx[i];
141: if(j<0 || j>=idx.rank)
142: error("tranpose X");
143: if(d[j] != -1) {
144: if(idx.dim[i] < d[j])
145: d[j] = idx.dim[i];
146: r[j] += idx.del[i];
147: } else {
148: d[j] = idx.dim[i];
149: r[j] = idx.del[i];
150: }
151: }
152: j = idx.rank;
153: for(i=0; i<idx.rank; i++) {
154: if(d[i] != -1) {
155: if(i > j)
156: error("tranpose D");
157: idx.dim[i] = d[i];
158: idx.del[i] = r[i];
159: } else
160: if(i < j)
161: j = i;
162: }
163: idx.rank = j;
164: map(0);
165: }
166:
167: ex_rev0()
168: {
169:
170: fetch1();
171: revk(0);
172: }
173:
174: ex_revk()
175: {
176: register k;
177:
178: k = topfix() - thread.iorg;
179: fetch1();
180: revk(k);
181: }
182:
183: ex_rev()
184: {
185: register struct item *p;
186:
187: p = fetch1();
188: revk(p->rank-1);
189: }
190:
191: revk(k)
192: {
193: register o;
194:
195: bidx(sp[-1]);
196: if(k < 0 || k >= idx.rank)
197: error("reverse X");
198: o = idx.del[k] * (idx.dim[k]-1);
199: idx.del[k] = -idx.del[k];
200: map(o);
201: }
202:
203: map(o)
204: {
205: register struct item *p;
206: register n, i;
207: int map1();
208:
209: n = 1;
210: for(i=0; i<idx.rank; i++)
211: n *= idx.dim[i];
212: if(n == 0)
213: idx.rank == 0;
214: p = newdat(idx.type, idx.rank, n);
215: copy(IN, idx.dim, p->dim, idx.rank);
216: *sp++ = p;
217: if(n != 0)
218: forloop(map1, o);
219: sp--;
220: pop();
221: *sp++ = p;
222: }
223:
224: map1(o)
225: {
226: register struct item *p;
227:
228: p = sp[-2];
229: p->index = access() + o;
230: putdat(sp[-1], getdat(p));
231: }
232:
233: takezr(fill)
234: int *fill;
235: {
236: register struct item *p;
237: register i;
238:
239: /* Zero appropriate elements of an array created by taking
240: * more than you originally had. I apologize for the "dirty"
241: * argument passing (passing a pointer to an integer array
242: * through "forloop()" which treats it as an integer) and for
243: * the general dumbness of this code.
244: * --John Bruner
245: */
246:
247: for(i=0; i<idx.rank; i++)
248: if (fill[i] > 0 && idx.idx[i] >= fill[i]
249: || fill[i] < 0 && idx.idx[i] < -fill[i]){
250: p = sp[-1];
251: p->index = access();
252: putdat(p, (p->type==DA) ? zero : (data)' ');
253: return;
254: }
255: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.