home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga 13 / MA_Cover_13.bin / source / c / apl / ad.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-11-23  |  2.3 KB  |  161 lines
  1. #include "apl.h"
  2.  
  3. ex_com0()
  4. {
  5.     fetch2();
  6.     comk(0);
  7. }
  8.  
  9. ex_comk()
  10. {
  11.     int k;
  12.  
  13.     k = topfix() - thread.iorg;
  14.     fetch2();
  15.     comk(k);
  16. }
  17.  
  18. ex_com()
  19. {
  20.     struct item *q;
  21.  
  22.     fetch2();
  23.     q = sp[-2];
  24.     comk(q->rank-1);
  25. }
  26.  
  27. comk(k)
  28. {
  29.     struct item *p;
  30.     data d;
  31.     int i, dk, ndk, com1();
  32.  
  33.     p = sp[-1];
  34.     bidx(sp[-2]);
  35.  
  36.     /* "getdat" returns the value of the data item which
  37.      * it is called to fetch.  If this is non-zero, just
  38.      * use the existing data on the stack (an example in
  39.      * APL would be "x/y" where x != 0.  If this is zero,
  40.      * the result is the null item, which is created by
  41.      * "newdat" and pushed on the stack.
  42.      */
  43.  
  44.     if(p->rank == 0 || (p->rank == 1 && p->size == 1)){
  45.         if(getdat(p)) {
  46.             pop();
  47.             return;
  48.         }
  49.         p = newdat(idx.type, 1, 0);
  50.         pop();
  51.         pop();
  52.         *sp++ = p;
  53.         return;
  54.     }
  55.  
  56.     if(idx.rank == 0 && p->rank == 1) {
  57.         /* then scalar right arg ok */
  58.         dk = p->dim[0];
  59.         ndk = 0;
  60.         for (i=0; i<dk; i++) {
  61.             if(getdat(p)) ndk++;
  62.         }
  63.         p = newdat(idx.type, 1, ndk);
  64.         d = getdat(sp[-2]);
  65.         for(i =0; i<ndk; i++) putdat(p,d);
  66.         pop();
  67.         pop();
  68.         *sp++ = p;
  69.         return;
  70.     }
  71.     if(k < 0 || k >= idx.rank) error("compress X");
  72.     dk = idx.dim[k];
  73.     if(p->rank != 1 || p->size != dk) error("compress C");
  74.     ndk = 0;
  75.     for(i=0; i<dk; i++) {
  76.         if(getdat(p)) ndk++;
  77.     }
  78.     p = newdat(idx.type, idx.rank, (idx.size/dk)*ndk);
  79.     copy(IN, idx.dim, p->dim, idx.rank);
  80.     p->dim[k] = ndk;
  81.     *sp++ = p;
  82.     forloop(com1, k);
  83.     sp--;
  84.     pop();
  85.     pop();
  86.     *sp++ = p;
  87. }
  88.  
  89. com1(k)
  90. {
  91.     struct item *p;
  92.  
  93.     p = sp[-2];
  94.     p->index = idx.idx[k];
  95.     if(getdat(p)) {
  96.         p = sp[-3];
  97.         p->index = access();
  98.         putdat(sp[-1], getdat(p));
  99.     }
  100. }
  101.  
  102. ex_exd0()
  103. {
  104.     fetch2();
  105.     exdk(0);
  106. }
  107.  
  108. ex_exdk()
  109. {
  110.     int k;
  111.  
  112.     k = topfix() - thread.iorg;
  113.     fetch2();
  114.     exdk(k);
  115. }
  116.  
  117. ex_exd()
  118. {
  119.     struct item *q;
  120.  
  121.     fetch2();
  122.     q = sp[-2];
  123.     exdk(q->rank-1);
  124. }
  125.  
  126. exdk(k)
  127. {
  128.     struct item *p;
  129.     int i, dk;
  130.     int exd1();
  131.  
  132.     p = sp[-1];
  133.     bidx(sp[-2]);
  134.     if(k < 0 || k >= idx.rank) error("expand X");
  135.     dk = 0;
  136.     for(i=0; i<p->size; i++) if(getdat(p)) dk++;
  137.     if(p->rank != 1 || dk != idx.dim[k]) error("expand C");
  138.     idx.dim[k] = p->size;
  139.     size();
  140.     p = newdat(idx.type, idx.rank, idx.size);
  141.     copy(IN, idx.dim, p->dim, idx.rank);
  142.     *sp++ = p;
  143.     forloop(exd1, k);
  144.     sp--;
  145.     pop();
  146.     pop();
  147.     *sp++ = p;
  148. }
  149.  
  150. exd1(k)
  151. {
  152.     struct item *p;
  153.  
  154.     p = sp[-2];
  155.     p->index = idx.idx[k];
  156.     if(getdat(p)) datum = getdat(sp[-3]);
  157.     else if(idx.type == DA) datum = zero;
  158.     else datum = ' ';
  159.     putdat(sp[-1], datum);
  160. }
  161.