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

##### Functions

    ex_red            X
    ex_red0           X
    ex_redk           X
    red0              X
    red1              X

       1: static char Sccsid[] = "a6.c @(#)a6.c	1.1	10/1/82 Berkeley ";
       2: #include "apl.h"
       3:
       4: ex_red0()
       5: {
       6:
       7:     fetch1();
       8:     red0(0);
       9: }
      10:
      11: ex_red()
      12: {
      13:     register struct item *p;
      14:
      15:     p = fetch1();
      16:     red0(p->rank-1);
      17: }
      18:
      19: ex_redk()
      20: {
      21:     register i;
      22:
      23:     i = topfix() - thread.iorg;
      24:     fetch1();
      25:     red0(i);
      26: }
      27:
      28: red0(k)
      29: {
      30:     register struct item *p, *q;
      31:     int param[3], red1();
      32:
      33:     p = fetch1();
      34:     if(p->type != DA)
      35:         error("red T");
      36:     bidx(p);
      37:     if (p->rank)
      38:         colapse(k);
      39:     else
      40:         idx.dimk = idx.delk = 1;  /* (handcraft for scalars) */
      41:     if(idx.dimk == 0) {
      42: /*
      43:  *  reduction identities - ets/jrl 5/76
      44:  */
      45:         q = newdat(DA,0,1);
      46:         q->dim[0] = 1;
      47:         switch(*pcp++) {
      48:     case ADD:
      49:     case SUB:
      50:     case OR:
      51:             q->datap[0] = 0;
      52:             break;
      53:     case AND:
      54:     case MUL:
      55:     case DIV:
      56:             q->datap[0] = 1;
      57:             break;
      58:     case MIN:
      59:             q->datap[0] = 1.0e38;
      60:             break;
      61:     case MAX:
      62:             q->datap[0] = -1.0e38;
      63:             break;
      64:     default:
      65:             error("reduce identity");
      66:         }
      67:         pop();
      68:         *sp++ = q;
      69:         return;
      70:     }
      71:     q = newdat(idx.type, idx.rank, idx.size);
      72:     copy(IN, idx.dim, q->dim, idx.rank);
      73:     param[0] = p->datap;
      74:     param[1] = q;
      75:     param[2] = exop[*pcp++];
      76:     forloop(red1, param);
      77:     pop();
      78:     *sp++ = q;
      79: }
      80:
      81: red1(param)
      82: int param[];
      83: {
      84:     register i;
      85:     register data *dp;
      86:     data d, (*f)();
      87:
      88:     dp = param[0];
      89:     dp += access() + (idx.dimk-1) * idx.delk;
      90:     f = param[2];
      91:     d = *dp;
      92:     for(i=1; i<idx.dimk; i++) {
      93:         dp -= idx.delk;
      94:         d = (*f)(*dp, d);
      95:     }
      96:     putdat(param[1], d);
      97: }

#### Defined functions

ex_red defined in line 11; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 108, 188

ex_red0 defined in line 4; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 109, 234

ex_redk defined in line 19; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 110, 190

red0 defined in line 28; used 3 times

- in line 8, 16, 25

red1 defined in line 81; used 2 times

- in line 31, 76

#### 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: 511 |