|
|
1.1 root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.