Return to ab.c CVS log

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

Annotation of 41BSD/cmd/apl/ab.c, revision 1.1.1.1

1.1       root        1: #include "apl.h"
                      2: 
                      3: ex_take()
                      4: {
                      5:        register i, k, o;
                      6: 
                      7:        o = 0;
                      8:        td1();
                      9:        for(i=0; i<idx.rank; i++) {
                     10:                k = idx.idx[i];
                     11:                if(k < 0) {
                     12:                        k = -k;
                     13:                        o =+ idx.del[i] *
                     14:                                (idx.dim[i] - k);
                     15:                }
                     16:                idx.dim[i] = k;
                     17:        }
                     18:        map(o);
                     19: }
                     20: 
                     21: ex_drop()
                     22: {
                     23:        register i, k, o;
                     24: 
                     25:        o = 0;
                     26:        td1();
                     27:        for(i=0; i<idx.rank; i++) {
                     28:                k = idx.idx[i];
                     29:                if(k > 0)
                     30:                        o =+ idx.del[i] * k; else
                     31:                        k = -k;
                     32:                idx.dim[i] =- k;
                     33:        }
                     34:        map(o);
                     35: }
                     36: 
                     37: td1()
                     38: {
                     39:        register struct item *p;
                     40:        struct item *q;
                     41:        register i, k;
                     42: 
                     43:        p = fetch2();
                     44:        q = sp[-2];
                     45:        if(p->rank > 1 || q->rank !=  p->size)
                     46:                error("take C");
                     47:        bidx(q);
                     48:        for(i=0; i<p->size; i++) {
                     49:                k = fix(getdat(p));
                     50:                idx.idx[i] = k;
                     51:                if(k < 0)
                     52:                        k = -k;
                     53:                if(k > idx.dim[i])
                     54:                        error("take C");
                     55:        }
                     56:        pop();
                     57: }
                     58: 
                     59: ex_dtrn()
                     60: {
                     61:        register struct item *p, *q;
                     62:        register i;
                     63: 
                     64:        p = fetch2();
                     65:        q = sp[-2];
                     66:        if(p->rank > 1 || p->size != q->rank)
                     67:                error("tranpose C");
                     68:        for(i=0; i<p->size; i++)
                     69:                idx.idx[i] = fix(getdat(p)) - thread.iorg;
                     70:        pop();
                     71:        trn0();
                     72: }
                     73: 
                     74: ex_mtrn()
                     75: {
                     76:        register struct item *p;
                     77:        register i;
                     78: 
                     79:        p = fetch1();
                     80:        if(p->rank <= 1)
                     81:                return;
                     82:        for(i=0; i<p->rank; i++)
                     83:                idx.idx[i] = i;
                     84:        idx.idx[i-1] = i-2;
                     85:        idx.idx[i-2] = i-1;
                     86:        trn0();
                     87: }
                     88: 
                     89: trn0()
                     90: {
                     91:        register i, j;
                     92:        int d[MRANK], r[MRANK];
                     93: 
                     94:        bidx(sp[-1]);
                     95:        for(i=0; i<idx.rank; i++)
                     96:                d[i] = -1;
                     97:        for(i=0; i<idx.rank; i++) {
                     98:                j = idx.idx[i];
                     99:                if(j<0 || j>=idx.rank)
                    100:                        error("tranpose X");
                    101:                if(d[j] != -1) {
                    102:                        if(idx.dim[i] < d[j])
                    103:                                d[j] = idx.dim[i];
                    104:                        r[j] =+ idx.del[i];
                    105:                } else {
                    106:                        d[j] = idx.dim[i];
                    107:                        r[j] = idx.del[i];
                    108:                }
                    109:        }
                    110:        j = idx.rank;
                    111:        for(i=0; i<idx.rank; i++) {
                    112:                if(d[i] != -1) {
                    113:                        if(i > j)
                    114:                                error("tranpose D");
                    115:                        idx.dim[i] = d[i];
                    116:                        idx.del[i] = r[i];
                    117:                } else
                    118:                if(i < j)
                    119:                        j = i;
                    120:        }
                    121:        idx.rank = j;
                    122:        map(0);
                    123: }
                    124: 
                    125: ex_rev0()
                    126: {
                    127: 
                    128:        fetch1();
                    129:        revk(0);
                    130: }
                    131: 
                    132: ex_revk()
                    133: {
                    134:        register k;
                    135: 
                    136:        k = topfix() - thread.iorg;
                    137:        fetch1();
                    138:        revk(k);
                    139: }
                    140: 
                    141: ex_rev()
                    142: {
                    143:        register struct item *p;
                    144: 
                    145:        p = fetch1();
                    146:        revk(p->rank-1);
                    147: }
                    148: 
                    149: revk(k)
                    150: {
                    151:        register o;
                    152: 
                    153:        bidx(sp[-1]);
                    154:        if(k < 0 || k >= idx.rank)
                    155:                error("reverse X");
                    156:        o = idx.del[k] * (idx.dim[k]-1);
                    157:        idx.del[k] = -idx.del[k];
                    158:        map(o);
                    159: }
                    160: 
                    161: map(o)
                    162: {
                    163:        register struct item *p;
                    164:        register n, i;
                    165:        int map1();
                    166: 
                    167:        n = 1;
                    168:        for(i=0; i<idx.rank; i++)
                    169:                n =* idx.dim[i];
                    170:        p = newdat(idx.type, idx.rank, n);
                    171:        copy(IN, idx.dim, p->dim, idx.rank);
                    172:        push(p);
                    173:        forloop(map1, o);
                    174:        sp--;
                    175:        pop();
                    176:        push(p);
                    177: }
                    178: 
                    179: map1(o)
                    180: {
                    181:        register struct item *p;
                    182: 
                    183:        p = sp[-2];
                    184:        p->index = access() + o;
                    185:        putdat(sp[-1], getdat(p));
                    186: }

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