Return to ad.c CVS log

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

Annotation of 40BSD/cmd/apl/ad.c, revision 1.1

1.1     ! root        1: #include "apl.h"
        !             2: 
        !             3: ex_com0()
        !             4: {
        !             5: 
        !             6:        fetch2();
        !             7:        comk(0);
        !             8: }
        !             9: 
        !            10: ex_comk()
        !            11: {
        !            12:        register k;
        !            13: 
        !            14:        k = topfix() - thread.iorg;
        !            15:        fetch2();
        !            16:        comk(k);
        !            17: }
        !            18: 
        !            19: ex_com()
        !            20: {
        !            21:        register struct item *q;
        !            22: 
        !            23:        fetch2();
        !            24:        q = sp[-2];
        !            25:        comk(q->rank-1);
        !            26: }
        !            27: 
        !            28: comk(k)
        !            29: {
        !            30:        register struct item *p;
        !            31:        register i;
        !            32:        int dk, ndk, com1();
        !            33: 
        !            34:        p = sp[-1];
        !            35:        bidx(sp[-2]);
        !            36:        if(p->rank==0||p->rank==1&&p->size==1) {
        !            37:                if(getdat(p)) {
        !            38:                        pop();
        !            39:                        return;
        !            40:                }
        !            41:                p = newdat(idx.type, 1, 0);
        !            42:                pop();
        !            43:                pop();
        !            44:                push(p);
        !            45:                return;
        !            46:        }
        !            47:        if(k < 0 || k >= idx.rank)
        !            48:                error("compress X");
        !            49:        dk = idx.dim[k];
        !            50:        if(p->rank != 1 || p->size != dk)
        !            51:                error("compress C");
        !            52:        ndk = 0;
        !            53:        for(i=0; i<dk; i++)
        !            54:                if(getdat(p))
        !            55:                        ndk++;
        !            56:        p = newdat(idx.type, idx.rank, (idx.size/dk)*ndk);
        !            57:        copy(IN, idx.dim, p->dim, idx.rank);
        !            58:        p->dim[k] = ndk;
        !            59:        push(p);
        !            60:        forloop(com1, k);
        !            61:        sp--;
        !            62:        pop();
        !            63:        pop();
        !            64:        push(p);
        !            65: }
        !            66: 
        !            67: com1(k)
        !            68: {
        !            69:        register struct item *p;
        !            70: 
        !            71:        p = sp[-2];
        !            72:        p->index = idx.idx[k];
        !            73:        if(getdat(p)) {
        !            74:                p = sp[-3];
        !            75:                p->index = access();
        !            76:                putdat(sp[-1], getdat(p));
        !            77:        }
        !            78: }
        !            79: 
        !            80: ex_exd0()
        !            81: {
        !            82: 
        !            83:        fetch2();
        !            84:        exdk(0);
        !            85: }
        !            86: 
        !            87: ex_exdk()
        !            88: {
        !            89:        register k;
        !            90: 
        !            91:        k = topfix() - thread.iorg;
        !            92:        fetch2();
        !            93:        exdk(k);
        !            94: }
        !            95: 
        !            96: ex_exd()
        !            97: {
        !            98:        register struct item *q;
        !            99: 
        !           100:        fetch2();
        !           101:        q = sp[-2];
        !           102:        exdk(q->rank-1);
        !           103: }
        !           104: 
        !           105: exdk(k)
        !           106: {
        !           107:        register struct item *p;
        !           108:        register i, dk;
        !           109:        int exd1();
        !           110: 
        !           111:        p = sp[-1];
        !           112:        bidx(sp[-2]);
        !           113:        if(k < 0 || k >= idx.rank)
        !           114:                error("expand X");
        !           115:        dk = 0;
        !           116:        for(i=0; i<p->size; i++)
        !           117:                if(getdat(p))
        !           118:                        dk++;
        !           119:        if(p->rank != 1 || dk != idx.dim[k])
        !           120:                error("expand C");
        !           121:        idx.dim[k] = p->size;
        !           122:        size();
        !           123:        p = newdat(idx.type, idx.rank, idx.size);
        !           124:        copy(IN, idx.dim, p->dim, idx.rank);
        !           125:        push(p);
        !           126:        forloop(exd1, k);
        !           127:        sp--;
        !           128:        pop();
        !           129:        pop();
        !           130:        push(p);
        !           131: }
        !           132: 
        !           133: exd1(k)
        !           134: {
        !           135:        register struct item *p;
        !           136: 
        !           137:        p = sp[-2];
        !           138:        p->index = idx.idx[k];
        !           139:        if(getdat(p))
        !           140:                datum = getdat(sp[-3]); else
        !           141:        if(idx.type == DA)
        !           142:                datum = zero; else
        !           143:                datum = ' ';
        !           144:        putdat(sp[-1], datum);
        !           145: }

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