Commit | Line | Data |
---|---|---|
3ec2bd83 BJ |
1 | #include "apl.h" |
2 | ||
3 | ex_base() | |
4 | { | |
5 | register struct item *p, *q; | |
6 | int s, s1; | |
7 | data d, d1; | |
8 | double r, b; | |
9 | ||
10 | p = fetch2(); | |
11 | q = sp[-2]; | |
12 | if(p->rank > 1 || q->rank > 1) | |
13 | error("base R"); | |
14 | b = 1.; | |
15 | r = 0.; | |
16 | s = p->size; | |
17 | s1 = q->size; | |
18 | while(s > 0 || s1 > 0) { | |
19 | if(s > 0) { | |
20 | s--; | |
21 | p->index = s; | |
22 | d = getdat(p); | |
23 | } | |
24 | if(s1 > 0) { | |
25 | s1--; | |
26 | q->index = s1; | |
27 | d1 = getdat(q); | |
28 | } | |
29 | r += d1 * b; | |
30 | b *= d; | |
31 | } | |
32 | pop(); | |
33 | pop(); | |
34 | p = newdat(DA, 0, 1); | |
35 | push(p); | |
36 | d = r; | |
37 | putdat(p, d); | |
38 | } | |
39 | ||
40 | ex_rep() | |
41 | { | |
42 | register struct item *p, *q; | |
43 | register s; | |
44 | double a, b, r; | |
45 | ||
46 | p = fetch2(); | |
47 | q = sp[-2]; | |
48 | if(q->size != 1 || p->rank > 1) | |
49 | error("represent R"); | |
50 | r = getdat(q); | |
51 | s = p->size; | |
52 | while(s > 0) { | |
53 | s--; | |
54 | p->index = s; | |
55 | b = getdat(p); | |
56 | if(b == 0.) | |
57 | error("represent D"); | |
58 | r /= b; | |
59 | a = r; | |
60 | r = floor(r); | |
61 | datum = (a - r) * b; | |
62 | p->index = s; | |
63 | putdat(p, datum); | |
64 | } | |
65 | sp--; | |
66 | pop(); | |
67 | push(p); | |
68 | } |