home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga 13 / MA_Cover_13.bin / source / c / apl / a3.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-11-23  |  1.3 KB  |  79 lines
  1. #include "apl.h"
  2.  
  3. ex_miot()
  4. {
  5.     struct item *p;
  6.     data *dp;
  7.     int i;
  8.  
  9.     i = topfix();
  10.     if(i < 0){            /* must allocate something to ")reset" properly */
  11.         *sp++ = newdat(DA, 1, 0);
  12.         error("miot D");
  13.     }
  14.     p = newdat(DA, 1, i);
  15.     dp = p->datap;
  16.     datum = thread.iorg;
  17.     for(; i; i--) {
  18.         *dp++ = datum;
  19.         datum += one;
  20.     }
  21.     *sp++ = p;
  22. }
  23.  
  24. ex_mrho()
  25. {
  26.     struct item *p, *q;
  27.     data *dp;
  28.     int i;
  29.  
  30.     p = fetch1();
  31.     q = newdat(DA, 1, p->rank);
  32.     dp = q->datap;
  33.     for(i=0; i<p->rank; i++) *dp++ = p->dim[i];
  34.     pop();
  35.     *sp++ = q;
  36. }
  37.  
  38. ex_drho()
  39. {
  40.     struct item *p, *q, *r;
  41.     int s, i;
  42.     data *dp;
  43.     char *cp;
  44.  
  45.     p = fetch2();
  46.     q = sp[-2];
  47.     if(p->type != DA || p->rank > 1 || q->size < 0) error("rho C");
  48.  
  49.     /* Allow null vector to be reshaped if one of the
  50.      * dimensions is null.
  51.      */
  52.  
  53.     if (!q->size){
  54.         dp = p->datap;
  55.         for(i=0; i < p->size; i++) if (fix(*dp++) == 0) goto null_ok;
  56.         error("rho C");
  57.     }
  58. null_ok:
  59.     s = 1;
  60.     dp = p->datap;
  61.     for(i=0; i<p->size; i++){
  62.         if (*dp < 0) error("rho C");        /* Negative dimensions illegal */
  63.         s *= fix(*dp++);
  64.     }
  65.     r = newdat(q->type, p->size, s);
  66.     dp = p->datap;
  67.     for(i=0; i<p->size; i++) r->dim[i] = fix(*dp++);
  68.     cp = (char *)r->datap;
  69.     while(s > 0) {
  70.         i = s;
  71.         if(i > q->size) i = q->size;
  72.         cp += copy(q->type, q->datap, cp, i);
  73.         s -= i;
  74.     }
  75.     pop();
  76.     pop();
  77.     *sp++ = r;
  78. }
  79.