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     ! 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.