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

   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

Defined variables