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