|
|
1.1 root 1: #include "apl.h"
2:
3: ex_take()
4: {
5: register i, k, o;
6:
7: o = 0;
8: td1();
9: for(i=0; i<idx.rank; i++) {
10: k = idx.idx[i];
11: if(k < 0) {
12: k = -k;
13: o =+ idx.del[i] *
14: (idx.dim[i] - k);
15: }
16: idx.dim[i] = k;
17: }
18: map(o);
19: }
20:
21: ex_drop()
22: {
23: register i, k, o;
24:
25: o = 0;
26: td1();
27: for(i=0; i<idx.rank; i++) {
28: k = idx.idx[i];
29: if(k > 0)
30: o =+ idx.del[i] * k; else
31: k = -k;
32: idx.dim[i] =- k;
33: }
34: map(o);
35: }
36:
37: td1()
38: {
39: register struct item *p;
40: struct item *q;
41: register i, k;
42:
43: p = fetch2();
44: q = sp[-2];
45: if(p->rank > 1 || q->rank != p->size)
46: error("take C");
47: bidx(q);
48: for(i=0; i<p->size; i++) {
49: k = fix(getdat(p));
50: idx.idx[i] = k;
51: if(k < 0)
52: k = -k;
53: if(k > idx.dim[i])
54: error("take C");
55: }
56: pop();
57: }
58:
59: ex_dtrn()
60: {
61: register struct item *p, *q;
62: register i;
63:
64: p = fetch2();
65: q = sp[-2];
66: if(p->rank > 1 || p->size != q->rank)
67: error("tranpose C");
68: for(i=0; i<p->size; i++)
69: idx.idx[i] = fix(getdat(p)) - thread.iorg;
70: pop();
71: trn0();
72: }
73:
74: ex_mtrn()
75: {
76: register struct item *p;
77: register i;
78:
79: p = fetch1();
80: if(p->rank <= 1)
81: return;
82: for(i=0; i<p->rank; i++)
83: idx.idx[i] = i;
84: idx.idx[i-1] = i-2;
85: idx.idx[i-2] = i-1;
86: trn0();
87: }
88:
89: trn0()
90: {
91: register i, j;
92: int d[MRANK], r[MRANK];
93:
94: bidx(sp[-1]);
95: for(i=0; i<idx.rank; i++)
96: d[i] = -1;
97: for(i=0; i<idx.rank; i++) {
98: j = idx.idx[i];
99: if(j<0 || j>=idx.rank)
100: error("tranpose X");
101: if(d[j] != -1) {
102: if(idx.dim[i] < d[j])
103: d[j] = idx.dim[i];
104: r[j] =+ idx.del[i];
105: } else {
106: d[j] = idx.dim[i];
107: r[j] = idx.del[i];
108: }
109: }
110: j = idx.rank;
111: for(i=0; i<idx.rank; i++) {
112: if(d[i] != -1) {
113: if(i > j)
114: error("tranpose D");
115: idx.dim[i] = d[i];
116: idx.del[i] = r[i];
117: } else
118: if(i < j)
119: j = i;
120: }
121: idx.rank = j;
122: map(0);
123: }
124:
125: ex_rev0()
126: {
127:
128: fetch1();
129: revk(0);
130: }
131:
132: ex_revk()
133: {
134: register k;
135:
136: k = topfix() - thread.iorg;
137: fetch1();
138: revk(k);
139: }
140:
141: ex_rev()
142: {
143: register struct item *p;
144:
145: p = fetch1();
146: revk(p->rank-1);
147: }
148:
149: revk(k)
150: {
151: register o;
152:
153: bidx(sp[-1]);
154: if(k < 0 || k >= idx.rank)
155: error("reverse X");
156: o = idx.del[k] * (idx.dim[k]-1);
157: idx.del[k] = -idx.del[k];
158: map(o);
159: }
160:
161: map(o)
162: {
163: register struct item *p;
164: register n, i;
165: int map1();
166:
167: n = 1;
168: for(i=0; i<idx.rank; i++)
169: n =* idx.dim[i];
170: p = newdat(idx.type, idx.rank, n);
171: copy(IN, idx.dim, p->dim, idx.rank);
172: push(p);
173: forloop(map1, o);
174: sp--;
175: pop();
176: push(p);
177: }
178:
179: map1(o)
180: {
181: register struct item *p;
182:
183: p = sp[-2];
184: p->index = access() + o;
185: putdat(sp[-1], getdat(p));
186: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.