Commit | Line | Data |
---|---|---|
3d5c0bc1 KT |
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 | } |