Return to ad.c CVS log

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

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

1.1       root        1: static char Sccsid[] = "ad.c @(#)ad.c  1.1     10/1/82 Berkeley ";
                      2: #include "apl.h"
                      3: 
                      4: ex_com0()
                      5: {
                      6: 
                      7:        fetch2();
                      8:        comk(0);
                      9: }
                     10: 
                     11: ex_comk()
                     12: {
                     13:        register k;
                     14: 
                     15:        k = topfix() - thread.iorg;
                     16:        fetch2();
                     17:        comk(k);
                     18: }
                     19: 
                     20: ex_com()
                     21: {
                     22:        register struct item *q;
                     23: 
                     24:        fetch2();
                     25:        q = sp[-2];
                     26:        comk(q->rank-1);
                     27: }
                     28: 
                     29: comk(k)
                     30: {
                     31:        register struct item *p;
                     32:        data d;
                     33:        register i;
                     34:        int dk, ndk, com1();
                     35: 
                     36:        p = sp[-1];
                     37:        bidx(sp[-2]);
                     38: 
                     39:        /* "getdat" returns the value of the data item which
                     40:         * it is called to fetch.  If this is non-zero, just
                     41:         * use the existing data on the stack (an example in
                     42:         * APL would be "x/y" where x != 0.  If this is zero,
                     43:         * the result is the null item, which is created by
                     44:         * "newdat" and pushed on the stack.
                     45:         */
                     46: 
                     47:        if(p->rank == 0 || (p->rank == 1 && p->size == 1)){
                     48:                if(getdat(p)) {
                     49:                        pop();
                     50:                        return;
                     51:                }
                     52:                p = newdat(idx.type, 1, 0);
                     53:                pop();
                     54:                pop();
                     55:                *sp++ = p;
                     56:                return;
                     57:        }
                     58: 
                     59:        if(idx.rank == 0 && p->rank == 1) {
                     60:                /* then scalar right arg ok */
                     61:                dk = p->dim[0];
                     62:                ndk = 0;
                     63:                for (i=0; i<dk; i++)
                     64:                        if(getdat(p))
                     65:                                ndk++;
                     66:                p = newdat(idx.type, 1, ndk);
                     67:                d = getdat(sp[-2]);
                     68:                for(i =0; i<ndk; i++)
                     69:                        putdat(p,d);
                     70:                pop();
                     71:                pop();
                     72:                *sp++ = p;
                     73:                return;
                     74:        }
                     75:        if(k < 0 || k >= idx.rank)
                     76:                error("compress X");
                     77:        dk = idx.dim[k];
                     78:        if(p->rank != 1 || p->size != dk)
                     79:                error("compress C");
                     80:        ndk = 0;
                     81:        for(i=0; i<dk; i++)
                     82:                if(getdat(p))
                     83:                        ndk++;
                     84:        p = newdat(idx.type, idx.rank, (idx.size/dk)*ndk);
                     85:        copy(IN, idx.dim, p->dim, idx.rank);
                     86:        p->dim[k] = ndk;
                     87:        *sp++ = p;
                     88:        forloop(com1, k);
                     89:        sp--;
                     90:        pop();
                     91:        pop();
                     92:        *sp++ = p;
                     93: }
                     94: 
                     95: com1(k)
                     96: {
                     97:        register struct item *p;
                     98: 
                     99:        p = sp[-2];
                    100:        p->index = idx.idx[k];
                    101:        if(getdat(p)) {
                    102:                p = sp[-3];
                    103:                p->index = access();
                    104:                putdat(sp[-1], getdat(p));
                    105:        }
                    106: }
                    107: 
                    108: ex_exd0()
                    109: {
                    110: 
                    111:        fetch2();
                    112:        exdk(0);
                    113: }
                    114: 
                    115: ex_exdk()
                    116: {
                    117:        register k;
                    118: 
                    119:        k = topfix() - thread.iorg;
                    120:        fetch2();
                    121:        exdk(k);
                    122: }
                    123: 
                    124: ex_exd()
                    125: {
                    126:        register struct item *q;
                    127: 
                    128:        fetch2();
                    129:        q = sp[-2];
                    130:        exdk(q->rank-1);
                    131: }
                    132: 
                    133: exdk(k)
                    134: {
                    135:        register struct item *p;
                    136:        register i, dk;
                    137:        int exd1();
                    138: 
                    139:        p = sp[-1];
                    140:        bidx(sp[-2]);
                    141:        if(k < 0 || k >= idx.rank)
                    142:                error("expand X");
                    143:        dk = 0;
                    144:        for(i=0; i<p->size; i++)
                    145:                if(getdat(p))
                    146:                        dk++;
                    147:        if(p->rank != 1 || dk != idx.dim[k])
                    148:                error("expand C");
                    149:        idx.dim[k] = p->size;
                    150:        size();
                    151:        p = newdat(idx.type, idx.rank, idx.size);
                    152:        copy(IN, idx.dim, p->dim, idx.rank);
                    153:        *sp++ = p;
                    154:        forloop(exd1, k);
                    155:        sp--;
                    156:        pop();
                    157:        pop();
                    158:        *sp++ = p;
                    159: }
                    160: 
                    161: exd1(k)
                    162: {
                    163:        register struct item *p;
                    164: 
                    165:        p = sp[-2];
                    166:        p->index = idx.idx[k];
                    167:        if(getdat(p))
                    168:                datum = getdat(sp[-3]); else
                    169:        if(idx.type == DA)
                    170:                datum = zero; else
                    171:                datum = ' ';
                    172:        putdat(sp[-1], datum);
                    173: }

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