|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.