Commit | Line | Data |
---|---|---|
957bb13d BJ |
1 | #include "apl.h" |
2 | ||
3 | ex_red0() | |
4 | { | |
5 | ||
6 | fetch1(); | |
7 | red0(0); | |
8 | } | |
9 | ||
10 | ex_red() | |
11 | { | |
12 | register struct item *p; | |
13 | ||
14 | p = fetch1(); | |
15 | red0(p->rank-1); | |
16 | } | |
17 | ||
18 | ex_redk() | |
19 | { | |
20 | register i; | |
21 | ||
22 | i = topfix() - thread.iorg; | |
23 | fetch1(); | |
24 | red0(i); | |
25 | } | |
26 | ||
27 | red0(k) | |
28 | { | |
29 | register struct item *p, *q; | |
30 | int param[3], red1(); | |
31 | ||
32 | p = fetch1(); | |
33 | if(p->type != DA) | |
34 | error("red T"); | |
35 | bidx(p); | |
36 | colapse(k); | |
37 | if(idx.dimk == 0) { | |
38 | /* | |
39 | * reduction identities - ets/jrl 5/76 | |
40 | */ | |
41 | q = newdat(DA,0,1); | |
42 | q->dim[0] = 1; | |
43 | switch(*pcp++) { | |
44 | case ADD: | |
45 | case SUB: | |
46 | case OR: | |
47 | q->datap[0] = 0; | |
48 | break; | |
49 | case AND: | |
50 | case MUL: | |
51 | case DIV: | |
52 | q->datap[0] = 1; | |
53 | break; | |
54 | case MIN: | |
55 | q->datap[0] = 1.0e38; | |
56 | break; | |
57 | case MAX: | |
58 | q->datap[0] = -1.0e38; | |
59 | break; | |
60 | default: | |
61 | error("reduce identity"); | |
62 | } | |
63 | pop(); | |
64 | push(q); | |
65 | return; | |
66 | } | |
67 | q = newdat(idx.type, idx.rank, idx.size); | |
68 | copy(IN, idx.dim, q->dim, idx.rank); | |
69 | param[0] = p->datap; | |
70 | param[1] = q; | |
71 | param[2] = exop[*pcp++]; | |
72 | forloop(red1, param); | |
73 | pop(); | |
74 | push(q); | |
75 | } | |
76 | ||
77 | red1(param) | |
78 | int param[]; | |
79 | { | |
80 | register i; | |
81 | register data *dp; | |
82 | data d, (*f)(); | |
83 | ||
84 | dp = param[0]; | |
85 | dp =+ access() + (idx.dimk-1) * idx.delk; | |
86 | f = param[2]; | |
87 | d = *dp; | |
88 | for(i=1; i<idx.dimk; i++) { | |
89 | dp =- idx.delk; | |
90 | d = (*f)(*dp, d); | |
91 | } | |
92 | putdat(param[1], d); | |
93 | } |