Return to a4.c CVS log

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

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

1.1     ! root        1: #include "apl.h"
        !             2: 
        !             3: ex_asgn()
        !             4: {
        !             5:        register struct nlist *p;
        !             6:        register struct item *q;
        !             7: 
        !             8:        p = sp[-1];
        !             9:        if(p->type == QD) {
        !            10:                pop();
        !            11:                ex_print();
        !            12:                return;
        !            13:        }
        !            14:        if(p->type == QC) {
        !            15:                pop();
        !            16:                ex_plot();
        !            17:                return;
        !            18:        }
        !            19:        if(p->type != LV)
        !            20:                error("asgn lv");
        !            21:        if(p->use != 0 && p->use != DA)
        !            22:                error("asgn var");
        !            23:        sp--;
        !            24:        q = fetch1();
        !            25:        erase(p);
        !            26:        p->use = DA;
        !            27:        p->itemp = q;
        !            28:        sp[-1] = p;
        !            29: }
        !            30: 
        !            31: ex_elid()
        !            32: {
        !            33: 
        !            34:        push(newdat(EL,0,0));
        !            35: }
        !            36: 
        !            37: ex_index()
        !            38: {
        !            39:        register struct item *p;
        !            40:        struct item *q;
        !            41:        register i, j;
        !            42:        int f, n, lv;
        !            43: 
        !            44:        n = *pcp++;
        !            45:        f = *pcp;
        !            46:        p = sp[-1];
        !            47:        if(f == ASGN) {
        !            48:                pcp++;
        !            49:                if(p->type != LV)
        !            50:                        error("indexed assign value");
        !            51:                if(p->use != DA)
        !            52:                        fetch1(); /* error("used before set"); */
        !            53:                q = p->itemp;
        !            54:        } else
        !            55:                q = fetch1();
        !            56:        if(q->rank != n)
        !            57:                error("subscript C");
        !            58:        idx.rank = 0;
        !            59:        for(i=0; i<n; i++) {
        !            60:                p = sp[-i-2];
        !            61:                if(p->type == EL) {
        !            62:                        idx.dim[idx.rank++] =
        !            63:                                q->dim[i];
        !            64:                        continue;
        !            65:                }
        !            66:                p = fetch(p);
        !            67:                sp[-i-2] = p;
        !            68:                for(j=0; j<p->rank; j++)
        !            69:                        idx.dim[idx.rank++] =
        !            70:                                p->dim[j];
        !            71:        }
        !            72:        size();
        !            73:        if(f == ASGN) {
        !            74:                p = fetch(sp[-n-2]);
        !            75:                sp[-n-2] = p;
        !            76:                if(p->size > 1) {
        !            77:                        if(idx.size != p->size)
        !            78:                                error("assign C");
        !            79:                        f = 1; /* v[i] <- v */
        !            80:                } else {
        !            81:                        datum = getdat(p);
        !            82:                        f = 2; /* v[i] <- s */
        !            83:                }
        !            84:                ex_elid();
        !            85:        } else {
        !            86:                p = newdat(q->type, idx.rank, idx.size);
        !            87:                copy(IN, idx.dim, p->dim, idx.rank);
        !            88:                push(p);
        !            89:                f = 0; /* v[i] */
        !            90:        }
        !            91:        bidx(q);
        !            92:        index1(0, f);
        !            93:        if(f == 0) {
        !            94:                p = sp[-1];
        !            95:                sp--;
        !            96:                for(i=0; i<=n; i++)
        !            97:                        pop();
        !            98:                push(p);
        !            99:        } else {
        !           100:                sp -= 2;
        !           101:                for(i=0; i<n; i++)
        !           102:                        pop();
        !           103:        }
        !           104: }
        !           105: 
        !           106: index1(i, f)
        !           107: {
        !           108:        register struct item *p;
        !           109:        register j, k;
        !           110: 
        !           111:        if(i >= idx.rank)
        !           112:        switch(f) {
        !           113: 
        !           114:        case 0:
        !           115:                p = sp[-2];
        !           116:                p->index = access();
        !           117:                putdat(sp[-1], getdat(p));
        !           118:                return;
        !           119: 
        !           120:        case 1:
        !           121:                datum = getdat(sp[-idx.rank-3]);
        !           122: 
        !           123:        case 2:
        !           124:                p = sp[-2]->itemp;
        !           125:                p->index = access();
        !           126:                putdat(p, datum);
        !           127:                return;
        !           128:        }
        !           129:        p = sp[-i-3];
        !           130:        if(p->type == EL) {
        !           131:                for(j=0; j<idx.dim[i]; j++) {
        !           132:                        idx.idx[i] = j;
        !           133:                        index1(i+1, f);
        !           134:                }
        !           135:                return;
        !           136:        }
        !           137:        p->index = 0;
        !           138:        for(j=0; j<p->size; j++) {
        !           139:                k = fix(getdat(p)) - thread.iorg;
        !           140:                if(k < 0 || k > idx.dim[i])
        !           141:                        error("subscript X");
        !           142:                idx.idx[i] = k;
        !           143:                index1(i+1, f);
        !           144:        }
        !           145: }

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