|
|
1.1 root 1: #include "apl.h"
2:
3: int gdu();
4: int gdd();
5:
6: ex_gdu()
7: {
8: register struct item *p;
9:
10: p = fetch1();
11: gd0(p->rank-1, gdu);
12: }
13:
14: ex_gduk()
15: {
16: register k;
17:
18: k = topfix() - thread.iorg;
19: fetch1();
20: gd0(k, gdu);
21: }
22:
23: ex_gdd()
24: {
25: register struct item *p;
26:
27: p = fetch1();
28: gd0(p->rank-1, gdd);
29: }
30:
31: ex_gddk()
32: {
33: register k;
34:
35: k = topfix() - thread.iorg;
36: fetch1();
37: gd0(k, gdd);
38: }
39:
40: gd0(k, f)
41: int (*f)();
42: {
43: register struct item *p;
44: int param[2];
45: int gd1();
46:
47: bidx(sp[-1]);
48: if(k < 0 || k >= idx.rank)
49: error("grade X");
50: p = newdat(DA, idx.rank, idx.size);
51: copy(IN, idx.dim, p->dim, idx.rank);
52: push(p);
53: colapse(k);
54: param[0] = alloc(idx.dimk*SINT);
55: param[1] = f;
56: forloop(gd1, param);
57: afree(param[0]);
58: p = sp[-1];
59: sp--;
60: pop();
61: push(p);
62: }
63:
64: gd1(param)
65: int param[];
66: {
67: register struct item *p;
68: register i, *m;
69:
70: integ = access();
71: m = param[0];
72: for(i=0; i<idx.dimk; i++)
73: *m++ = i;
74: m = param[0];
75: qsort(m, idx.dimk, SINT, param[1]);
76: p = sp[-1];
77: for(i=0; i<idx.dimk; i++) {
78: p->index = integ;
79: datum = *m++ + thread.iorg;
80: putdat(p, datum);
81: integ =+ idx.delk;
82: }
83: }
84:
85: gdu(p1, p2)
86: int *p1, *p2;
87: {
88: register struct item *p;
89: data d1, d2;
90:
91: p = sp[-2];
92: p->index = integ + *p1 * idx.delk;
93: d1 = getdat(p);
94: p->index = integ + *p2 * idx.delk;
95: d2 = getdat(p);
96: if(fuzz(d1, d2) != 0) {
97: if(d1 > d2)
98: return(1);
99: return(-1);
100: }
101: return(*p1 - *p2);
102: }
103:
104: gdd(p1, p2)
105: int *p1, *p2;
106: {
107: register struct item *p;
108: data d1, d2;
109:
110: p = sp[-2];
111: p->index = integ + *p1 * idx.delk;
112: d1 = getdat(p);
113: p->index = integ + *p2 * idx.delk;
114: d2 = getdat(p);
115: if(fuzz(d1, d2) != 0) {
116: if(d1 > d2)
117: return(-1);
118: return(1);
119: }
120: return(*p1 - *p2);
121: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.