aa.c

Functions

ex_gdd            X
ex_gddk           X
ex_gdu            X
ex_gduk           X
gd0               X
gd1               X
gdd               X
gdu               X

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