|
|
1.1 ! root 1: #include "apl.h" ! 2: ! 3: ex_rav() ! 4: { ! 5: register struct item *p, *r; ! 6: ! 7: p = fetch1(); ! 8: if(p->rank == 0) { ! 9: r = newdat(p->type, 1, 1); ! 10: putdat(r, getdat(p)); ! 11: pop(); ! 12: push(r); ! 13: return; ! 14: } ! 15: rav0(p->rank-1); ! 16: } ! 17: ! 18: ex_ravk() ! 19: { ! 20: register i; ! 21: ! 22: i = topfix() - thread.iorg; ! 23: fetch1(); ! 24: rav0(i); ! 25: } ! 26: ! 27: rav0(k) ! 28: { ! 29: register struct item *p, *r; ! 30: struct item *param[2]; ! 31: int rav1(); ! 32: ! 33: p = sp[-1]; ! 34: bidx(p); ! 35: colapse(k); ! 36: r = newdat(p->type, 1, p->size); ! 37: param[0] = p; ! 38: param[1] = r; ! 39: forloop(rav1, param); ! 40: pop(); ! 41: push(r); ! 42: } ! 43: ! 44: rav1(param) ! 45: struct item *param[]; ! 46: { ! 47: register struct item *p; ! 48: register i, n; ! 49: ! 50: p = param[0]; ! 51: n = access(); ! 52: for(i=0; i<idx.dimk; i++) { ! 53: p->index = n; ! 54: putdat(param[1], getdat(p)); ! 55: n =+ idx.delk; ! 56: } ! 57: } ! 58: ! 59: ex_cat() ! 60: { ! 61: register struct item *p, *q; ! 62: struct item *r; ! 63: register k; ! 64: ! 65: p = fetch2(); ! 66: q = sp[-2]; ! 67: k = p->rank; ! 68: if(q->rank > k) ! 69: k = q->rank; ! 70: if(k == 0) { ! 71: r = newdat(p->type, 1, 2); ! 72: putdat(r, getdat(p)); ! 73: putdat(r, getdat(q)); ! 74: pop(); ! 75: pop(); ! 76: push(r); ! 77: } else ! 78: cat0(k-1); ! 79: } ! 80: ! 81: ex_catk() ! 82: { ! 83: register k; ! 84: ! 85: k = topfix() - thread.iorg; ! 86: fetch2(); ! 87: cat0(k); ! 88: } ! 89: ! 90: cat0(k) ! 91: { ! 92: register struct item *p, *q; ! 93: register i; ! 94: struct item *r; ! 95: int a, b; ! 96: ! 97: p = sp[-1]; ! 98: q = sp[-2]; ! 99: i = k; ! 100: if(p->rank >= q->rank) { ! 101: bidx(p); ! 102: b = cat1(q, i); ! 103: a = idx.dim[i]; ! 104: } else { ! 105: bidx(q); ! 106: a = cat1(p, i); ! 107: b = idx.dim[i]; ! 108: } ! 109: idx.dim[i] = a+b; ! 110: size(); ! 111: r = newdat(p->type, idx.rank, idx.size); ! 112: copy(IN, idx.dim, r->dim, idx.rank); ! 113: i = idx.del[i]; ! 114: a =* i; ! 115: b =* i; ! 116: while(r->index < r->size) { ! 117: for(i=0; i<a; i++) ! 118: putdat(r, getdat(p)); ! 119: for(i=0; i<b; i++) ! 120: putdat(r, getdat(q)); ! 121: } ! 122: pop(); ! 123: pop(); ! 124: push(r); ! 125: } ! 126: ! 127: cat1(ip, k) ! 128: struct item *ip; ! 129: { ! 130: register struct item *p; ! 131: register i, j; ! 132: int a; ! 133: ! 134: if(k < 0 || k >= idx.rank) ! 135: error("cat X"); ! 136: p = ip; ! 137: a = 1; ! 138: if(p->rank == 0) ! 139: return(a); ! 140: j = 0; ! 141: for(i=0; i<idx.rank; i++) { ! 142: if(i == k) { ! 143: if(p->rank == idx.rank) { ! 144: a = p->dim[i]; ! 145: j++; ! 146: } ! 147: continue; ! 148: } ! 149: if(idx.dim[i] != p->dim[j]) ! 150: error("cat C"); ! 151: j++; ! 152: } ! 153: return(a); ! 154: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.