Return to a7.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / apl

Annotation of 3BSD/cmd/apl/a7.c, revision 1.1.1.1

1.1       root        1: #include "apl.h"
                      2: 
                      3: ex_iprod()
                      4: {
                      5:        register i, j;
                      6:        struct item *p, *q, *r;
                      7:        int param[10], ipr1();
                      8: 
                      9:        param[0] = exop[*pcp++];
                     10:        param[1] = exop[*pcp++];
                     11:        p = fetch2();
                     12:        q = sp[-2];
                     13:        if(p->type != DA || q->type != DA)
                     14:                error("iprod T");
                     15:        bidx(p);
                     16:        idx.rank--;
                     17:        param[2] = idx.dim[idx.rank];
                     18:        if(param[2] != q->dim[0])
                     19:                error("inner prod C");
                     20:        param[3] = q->size/param[2];
                     21:        for(i=1; i<q->rank; i++)
                     22:                idx.dim[idx.rank++] = q->dim[i];
                     23:        r = newdat(DA, idx.rank, size());
                     24:        copy(IN, idx.dim, r->dim, idx.rank);
                     25:        param[4] = 0;
                     26:        param[5] = 0;
                     27:        param[6] = p->datap;
                     28:        param[7] = q->datap;
                     29:        param[8] = r->datap;
                     30:        param[9] = p->size;
                     31:        forloop(ipr1, param);
                     32:        pop();
                     33:        pop();
                     34:        push(r);
                     35: }
                     36: 
                     37: ipr1(param)
                     38: int param[];
                     39: {
                     40:        register i, dk;
                     41:        int lk, a, b;
                     42:        data *dp1, *dp2, *dp3;
                     43:        data (*f1)(), (*f2)(), d;
                     44: 
                     45:        f1 = param[0];
                     46:        f2 = param[1];
                     47:        dk = param[2];
                     48:        lk = param[3];
                     49:        a = param[4];
                     50:        b = param[5];
                     51:        dp1 = param[6];
                     52:        dp2 = param[7];
                     53:        dp3 = param[8];
                     54:        a =+ dk;
                     55:        b =+ (dk * lk);
                     56:        for(i=0; i<dk; i++) {
                     57:                a--;
                     58:                b =- lk;
                     59:                d = (*f2)(dp1[a], dp2[b]);
                     60:                if(i == 0)
                     61:                        datum = d; else
                     62:                        datum = (*f1)(d, datum);
                     63:        }
                     64:        *dp3++ = datum;
                     65:        param[8] = dp3;
                     66:        param[5]++;
                     67:        if(param[5] >= lk) {
                     68:                param[5] = 0;
                     69:                param[4] =+ dk;
                     70:                if(param[4] >= param[9])
                     71:                        param[4] = 0;
                     72:        }
                     73: }
                     74: 
                     75: ex_oprod()
                     76: {
                     77:        register i, j;
                     78:        register data *dp;
                     79:        struct item *p, *q, *r;
                     80:        data *dp1, *dp2;
                     81:        data (*f)();
                     82: 
                     83:        f = exop[*pcp++];
                     84:        p = fetch2();
                     85:        q = sp[-2];
                     86:        if(p->type != DA || q->type != DA)
                     87:                error("oprod T");
                     88:        bidx(p);
                     89:        for(i=0; i<q->rank; i++)
                     90:                idx.dim[idx.rank++] = q->dim[i];
                     91:        r = newdat(DA, idx.rank, size());
                     92:        copy(IN, idx.dim, r->dim, idx.rank);
                     93:        dp = r->datap;
                     94:        dp1 = p->datap;
                     95:        for(i=0; i<p->size; i++) {
                     96:                datum = *dp1++;
                     97:                dp2 = q->datap;
                     98:                for(j=0; j<q->size; j++)
                     99:                        *dp++ = (*f)(datum, *dp2++);
                    100:        }
                    101:        pop();
                    102:        pop();
                    103:        push(r);
                    104: }

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