| 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 | } |