Return to a3.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src

Annotation of 43BSD/contrib/apl/src/a3.c, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.