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

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

Defined functions

Defined variables