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

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

Defined functions

Defined variables