| 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 | } |