Commit | Line | Data |
---|---|---|
77bf4e3b KT |
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 | } |