BSD 3 development
[unix-history] / usr / src / cmd / apl / ab.c
CommitLineData
77bf4e3b
KT
1#include "apl.h"
2
3ex_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
21ex_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
37td1()
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
59ex_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
74ex_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
89trn0()
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
125ex_rev0()
126{
127
128 fetch1();
129 revk(0);
130}
131
132ex_revk()
133{
134 register k;
135
136 k = topfix() - thread.iorg;
137 fetch1();
138 revk(k);
139}
140
141ex_rev()
142{
143 register struct item *p;
144
145 p = fetch1();
146 revk(p->rank-1);
147}
148
149revk(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
161map(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
179map1(o)
180{
181 register struct item *p;
182
183 p = sp[-2];
184 p->index = access() + o;
185 putdat(sp[-1], getdat(p));
186}