Commit | Line | Data |
---|---|---|
957bb13d BJ |
1 | #include "apl.h" |
2 | ||
3 | ex_miot() | |
4 | { | |
5 | register struct item *p; | |
6 | register data *dp; | |
7 | register i; | |
8 | ||
9 | i = topfix(); | |
10 | if(i < 0) | |
11 | error("miot D"); | |
12 | p = newdat(DA, 1, i); | |
13 | dp = p->datap; | |
14 | datum = thread.iorg; | |
15 | for(; i; i--) { | |
16 | *dp++ = datum; | |
17 | datum =+ one; | |
18 | } | |
19 | push(p); | |
20 | } | |
21 | ||
22 | ex_mrho() | |
23 | { | |
24 | register struct item *p, *q; | |
25 | register data *dp; | |
26 | int i; | |
27 | ||
28 | p = fetch1(); | |
29 | q = newdat(DA, 1, p->rank); | |
30 | dp = q->datap; | |
31 | for(i=0; i<p->rank; i++) | |
32 | *dp++ = p->dim[i]; | |
33 | pop(); | |
34 | push(q); | |
35 | } | |
36 | ||
37 | ex_drho() | |
38 | { | |
39 | register struct item *p, *q; | |
40 | struct item *r; | |
41 | int s, i; | |
42 | register data *dp; | |
43 | char *cp; | |
44 | ||
45 | p = fetch2(); | |
46 | q = sp[-2]; | |
47 | if(p->type != DA || p->rank > 1 || q->size < 1) | |
48 | error("rho C"); | |
49 | s = 1; | |
50 | dp = p->datap; | |
51 | for(i=0; i<p->size; i++) | |
52 | s =* fix(*dp++); | |
53 | r = newdat(q->type, p->size, s); | |
54 | dp = p->datap; | |
55 | for(i=0; i<p->size; i++) | |
56 | r->dim[i] = fix(*dp++); | |
57 | cp = r->datap; | |
58 | while(s > 0) { | |
59 | i = s; | |
60 | if(i > q->size) | |
61 | i = q->size; | |
62 | cp =+ copy(q->type, q->datap, cp, i); | |
63 | s =- i; | |
64 | } | |
65 | pop(); | |
66 | pop(); | |
67 | push(r); | |
68 | } |