2.11BSD#431 - /usr/src/new/PORT/apl/src/ad.c

   1: static char Sccsid[] = "ad.c @(#)ad.c	1.1	10/1/82 Berkeley ";
   2: #include "apl.h"
   3: 
   4: ex_com0()
   5: {
   6: 
   7:     fetch2();
   8:     comk(0);
   9: }
  10: 
  11: ex_comk()
  12: {
  13:     register k;
  14: 
  15:     k = topfix() - thread.iorg;
  16:     fetch2();
  17:     comk(k);
  18: }
  19: 
  20: ex_com()
  21: {
  22:     register struct item *q;
  23: 
  24:     fetch2();
  25:     q = sp[-2];
  26:     comk(q->rank-1);
  27: }
  28: 
  29: comk(k)
  30: {
  31:     register struct item *p;
  32:     data d;
  33:     register i;
  34:     int dk, ndk, com1();
  35: 
  36:     p = sp[-1];
  37:     bidx(sp[-2]);
  38: 
  39:     /* "getdat" returns the value of the data item which
  40: 	 * it is called to fetch.  If this is non-zero, just
  41: 	 * use the existing data on the stack (an example in
  42: 	 * APL would be "x/y" where x != 0.  If this is zero,
  43: 	 * the result is the null item, which is created by
  44: 	 * "newdat" and pushed on the stack.
  45: 	 */
  46: 
  47:     if(p->rank == 0 || (p->rank == 1 && p->size == 1)){
  48:         if(getdat(p)) {
  49:             pop();
  50:             return;
  51:         }
  52:         p = newdat(idx.type, 1, 0);
  53:         pop();
  54:         pop();
  55:         *sp++ = p;
  56:         return;
  57:     }
  58: 
  59:     if(idx.rank == 0 && p->rank == 1) {
  60:         /* then scalar right arg ok */
  61:         dk = p->dim[0];
  62:         ndk = 0;
  63:         for (i=0; i<dk; i++)
  64:             if(getdat(p))
  65:                 ndk++;
  66:         p = newdat(idx.type, 1, ndk);
  67:         d = getdat(sp[-2]);
  68:         for(i =0; i<ndk; i++)
  69:             putdat(p,d);
  70:         pop();
  71:         pop();
  72:         *sp++ = p;
  73:         return;
  74:     }
  75:     if(k < 0 || k >= idx.rank)
  76:         error("compress X");
  77:     dk = idx.dim[k];
  78:     if(p->rank != 1 || p->size != dk)
  79:         error("compress C");
  80:     ndk = 0;
  81:     for(i=0; i<dk; i++)
  82:         if(getdat(p))
  83:             ndk++;
  84:     p = newdat(idx.type, idx.rank, (idx.size/dk)*ndk);
  85:     copy(IN, idx.dim, p->dim, idx.rank);
  86:     p->dim[k] = ndk;
  87:     *sp++ = p;
  88:     forloop(com1, k);
  89:     sp--;
  90:     pop();
  91:     pop();
  92:     *sp++ = p;
  93: }
  94: 
  95: com1(k)
  96: {
  97:     register struct item *p;
  98: 
  99:     p = sp[-2];
 100:     p->index = idx.idx[k];
 101:     if(getdat(p)) {
 102:         p = sp[-3];
 103:         p->index = access();
 104:         putdat(sp[-1], getdat(p));
 105:     }
 106: }
 107: 
 108: ex_exd0()
 109: {
 110: 
 111:     fetch2();
 112:     exdk(0);
 113: }
 114: 
 115: ex_exdk()
 116: {
 117:     register k;
 118: 
 119:     k = topfix() - thread.iorg;
 120:     fetch2();
 121:     exdk(k);
 122: }
 123: 
 124: ex_exd()
 125: {
 126:     register struct item *q;
 127: 
 128:     fetch2();
 129:     q = sp[-2];
 130:     exdk(q->rank-1);
 131: }
 132: 
 133: exdk(k)
 134: {
 135:     register struct item *p;
 136:     register i, dk;
 137:     int exd1();
 138: 
 139:     p = sp[-1];
 140:     bidx(sp[-2]);
 141:     if(k < 0 || k >= idx.rank)
 142:         error("expand X");
 143:     dk = 0;
 144:     for(i=0; i<p->size; i++)
 145:         if(getdat(p))
 146:             dk++;
 147:     if(p->rank != 1 || dk != idx.dim[k])
 148:         error("expand C");
 149:     idx.dim[k] = p->size;
 150:     size();
 151:     p = newdat(idx.type, idx.rank, idx.size);
 152:     copy(IN, idx.dim, p->dim, idx.rank);
 153:     *sp++ = p;
 154:     forloop(exd1, k);
 155:     sp--;
 156:     pop();
 157:     pop();
 158:     *sp++ = p;
 159: }
 160: 
 161: exd1(k)
 162: {
 163:     register struct item *p;
 164: 
 165:     p = sp[-2];
 166:     p->index = idx.idx[k];
 167:     if(getdat(p))
 168:         datum = getdat(sp[-3]); else
 169:     if(idx.type == DA)
 170:         datum = zero; else
 171:         datum = ' ';
 172:     putdat(sp[-1], datum);
 173: }

Defined functions

Defined variables