Commit | Line | Data |
---|---|---|
957bb13d BJ |
1 | #include "apl.h" |
2 | ||
3 | ex_rav() | |
4 | { | |
5 | register struct item *p, *r; | |
6 | ||
7 | p = fetch1(); | |
8 | if(p->rank == 0) { | |
9 | r = newdat(p->type, 1, 1); | |
10 | putdat(r, getdat(p)); | |
11 | pop(); | |
12 | push(r); | |
13 | return; | |
14 | } | |
15 | rav0(p->rank-1); | |
16 | } | |
17 | ||
18 | ex_ravk() | |
19 | { | |
20 | register i; | |
21 | ||
22 | i = topfix() - thread.iorg; | |
23 | fetch1(); | |
24 | rav0(i); | |
25 | } | |
26 | ||
27 | rav0(k) | |
28 | { | |
29 | register struct item *p, *r; | |
30 | struct item *param[2]; | |
31 | int rav1(); | |
32 | ||
33 | p = sp[-1]; | |
34 | bidx(p); | |
35 | colapse(k); | |
36 | r = newdat(p->type, 1, p->size); | |
37 | param[0] = p; | |
38 | param[1] = r; | |
39 | forloop(rav1, param); | |
40 | pop(); | |
41 | push(r); | |
42 | } | |
43 | ||
44 | rav1(param) | |
45 | struct item *param[]; | |
46 | { | |
47 | register struct item *p; | |
48 | register i, n; | |
49 | ||
50 | p = param[0]; | |
51 | n = access(); | |
52 | for(i=0; i<idx.dimk; i++) { | |
53 | p->index = n; | |
54 | putdat(param[1], getdat(p)); | |
55 | n =+ idx.delk; | |
56 | } | |
57 | } | |
58 | ||
59 | ex_cat() | |
60 | { | |
61 | register struct item *p, *q; | |
62 | struct item *r; | |
63 | register k; | |
64 | ||
65 | p = fetch2(); | |
66 | q = sp[-2]; | |
67 | k = p->rank; | |
68 | if(q->rank > k) | |
69 | k = q->rank; | |
70 | if(k == 0) { | |
71 | r = newdat(p->type, 1, 2); | |
72 | putdat(r, getdat(p)); | |
73 | putdat(r, getdat(q)); | |
74 | pop(); | |
75 | pop(); | |
76 | push(r); | |
77 | } else | |
78 | cat0(k-1); | |
79 | } | |
80 | ||
81 | ex_catk() | |
82 | { | |
83 | register k; | |
84 | ||
85 | k = topfix() - thread.iorg; | |
86 | fetch2(); | |
87 | cat0(k); | |
88 | } | |
89 | ||
90 | cat0(k) | |
91 | { | |
92 | register struct item *p, *q; | |
93 | register i; | |
94 | struct item *r; | |
95 | int a, b; | |
96 | ||
97 | p = sp[-1]; | |
98 | q = sp[-2]; | |
99 | i = k; | |
100 | if(p->rank >= q->rank) { | |
101 | bidx(p); | |
102 | b = cat1(q, i); | |
103 | a = idx.dim[i]; | |
104 | } else { | |
105 | bidx(q); | |
106 | a = cat1(p, i); | |
107 | b = idx.dim[i]; | |
108 | } | |
109 | idx.dim[i] = a+b; | |
110 | size(); | |
111 | r = newdat(p->type, idx.rank, idx.size); | |
112 | copy(IN, idx.dim, r->dim, idx.rank); | |
113 | i = idx.del[i]; | |
114 | a =* i; | |
115 | b =* i; | |
116 | while(r->index < r->size) { | |
117 | for(i=0; i<a; i++) | |
118 | putdat(r, getdat(p)); | |
119 | for(i=0; i<b; i++) | |
120 | putdat(r, getdat(q)); | |
121 | } | |
122 | pop(); | |
123 | pop(); | |
124 | push(r); | |
125 | } | |
126 | ||
127 | cat1(ip, k) | |
128 | struct item *ip; | |
129 | { | |
130 | register struct item *p; | |
131 | register i, j; | |
132 | int a; | |
133 | ||
134 | if(k < 0 || k >= idx.rank) | |
135 | error("cat X"); | |
136 | p = ip; | |
137 | a = 1; | |
138 | if(p->rank == 0) | |
139 | return(a); | |
140 | j = 0; | |
141 | for(i=0; i<idx.rank; i++) { | |
142 | if(i == k) { | |
143 | if(p->rank == idx.rank) { | |
144 | a = p->dim[i]; | |
145 | j++; | |
146 | } | |
147 | continue; | |
148 | } | |
149 | if(idx.dim[i] != p->dim[j]) | |
150 | error("cat C"); | |
151 | j++; | |
152 | } | |
153 | return(a); | |
154 | } |