|
|
1.1 ! root 1: #include "apl.h" ! 2: ! 3: int gdu(); ! 4: int gdd(); ! 5: ! 6: ex_gdu() ! 7: { ! 8: register struct item *p; ! 9: ! 10: p = fetch1(); ! 11: gd0(p->rank-1, gdu); ! 12: } ! 13: ! 14: ex_gduk() ! 15: { ! 16: register k; ! 17: ! 18: k = topfix() - thread.iorg; ! 19: fetch1(); ! 20: gd0(k, gdu); ! 21: } ! 22: ! 23: ex_gdd() ! 24: { ! 25: register struct item *p; ! 26: ! 27: p = fetch1(); ! 28: gd0(p->rank-1, gdd); ! 29: } ! 30: ! 31: ex_gddk() ! 32: { ! 33: register k; ! 34: ! 35: k = topfix() - thread.iorg; ! 36: fetch1(); ! 37: gd0(k, gdd); ! 38: } ! 39: ! 40: gd0(k, f) ! 41: int (*f)(); ! 42: { ! 43: register struct item *p; ! 44: int param[2]; ! 45: int gd1(); ! 46: ! 47: bidx(sp[-1]); ! 48: if(k < 0 || k >= idx.rank) ! 49: error("grade X"); ! 50: p = newdat(DA, idx.rank, idx.size); ! 51: copy(IN, idx.dim, p->dim, idx.rank); ! 52: push(p); ! 53: colapse(k); ! 54: param[0] = alloc(idx.dimk*SINT); ! 55: param[1] = f; ! 56: forloop(gd1, param); ! 57: afree(param[0]); ! 58: p = sp[-1]; ! 59: sp--; ! 60: pop(); ! 61: push(p); ! 62: } ! 63: ! 64: gd1(param) ! 65: int param[]; ! 66: { ! 67: register struct item *p; ! 68: register i, *m; ! 69: ! 70: integ = access(); ! 71: m = param[0]; ! 72: for(i=0; i<idx.dimk; i++) ! 73: *m++ = i; ! 74: m = param[0]; ! 75: qsort(m, idx.dimk, SINT, param[1]); ! 76: p = sp[-1]; ! 77: for(i=0; i<idx.dimk; i++) { ! 78: p->index = integ; ! 79: datum = *m++ + thread.iorg; ! 80: putdat(p, datum); ! 81: integ =+ idx.delk; ! 82: } ! 83: } ! 84: ! 85: gdu(p1, p2) ! 86: int *p1, *p2; ! 87: { ! 88: register struct item *p; ! 89: data d1, d2; ! 90: ! 91: p = sp[-2]; ! 92: p->index = integ + *p1 * idx.delk; ! 93: d1 = getdat(p); ! 94: p->index = integ + *p2 * idx.delk; ! 95: d2 = getdat(p); ! 96: if(fuzz(d1, d2) != 0) { ! 97: if(d1 > d2) ! 98: return(1); ! 99: return(-1); ! 100: } ! 101: return(*p1 - *p2); ! 102: } ! 103: ! 104: gdd(p1, p2) ! 105: int *p1, *p2; ! 106: { ! 107: register struct item *p; ! 108: data d1, d2; ! 109: ! 110: p = sp[-2]; ! 111: p->index = integ + *p1 * idx.delk; ! 112: d1 = getdat(p); ! 113: p->index = integ + *p2 * idx.delk; ! 114: d2 = getdat(p); ! 115: if(fuzz(d1, d2) != 0) { ! 116: if(d1 > d2) ! 117: return(-1); ! 118: return(1); ! 119: } ! 120: return(*p1 - *p2); ! 121: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.