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

##### Functions

    ex_drho           X
    ex_miot           X
    ex_mrho           X

       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

ex_drho defined in line 41; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 37, 161

ex_miot defined in line 4; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 83, 164

ex_mrho defined in line 26; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 85, 162

#### Defined variables

Sccsid defined in line 1; never used

Last modified: 1986-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 578 |