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

##### Functions

    com1              X
    comk              X
    ex_com            X
    ex_com0           X
    ex_comk           X
    ex_exd            X
    ex_exd0           X
    ex_exdk           X
    exd1              X
    exdk              X

       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

com1 defined in line 95; used 2 times

- in line 34, 88

comk defined in line 29; used 3 times

- in line 8, 17, 26

ex_com defined in line 20; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 25, 187

ex_com0 defined in line 4; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 26, 233

ex_comk defined in line 11; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 28, 189

ex_exd defined in line 124; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 44, 175

ex_exd0 defined in line 108; used 3 times

- in /usr/src/new/OLD/apl/src/at.c line 45, 223, 235

ex_exdk defined in line 115; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 46, 177

exd1 defined in line 161; used 2 times

- in line 137, 154

exdk defined in line 133; used 3 times

- in line 112, 121, 130

#### Defined variables

Sccsid defined in line 1; never used

Last modified: 1986-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 655 |