Return to a4.c CVS log

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

Annotation of 43BSD/contrib/apl/src/a4.c, revision 1.1

1.1     ! root        1: static char Sccsid[] = "a4.c @(#)a4.c  1.2     10/5/82 Berkeley ";
        !             2: #include "apl.h"
        !             3: 
        !             4: /*
        !             5:  *     parser generates the following for each  label
        !             6:  *
        !             7:  *     AUTO-name  CONST  NAME-name  LABEL
        !             8:  *
        !             9:  *     (where CONST is the label address)
        !            10:  */
        !            11: ex_label()
        !            12: {
        !            13:        register struct nlist *n;
        !            14: 
        !            15:        ex_asgn();
        !            16:        n = (struct nlist *)sp[-1];
        !            17:        n->itemp->type = LBL;   /* lock out assignments */
        !            18:        sp--;                   /* discard stack */
        !            19: }
        !            20: 
        !            21: 
        !            22: ex_asgn()
        !            23: {
        !            24:        register struct nlist *p;
        !            25:        register struct item *q;
        !            26: 
        !            27:        p = (struct nlist *)sp[-1];
        !            28:        switch(p->type){
        !            29:        case QX:
        !            30:                pop();
        !            31:                p = nlook("Llx");
        !            32:                if(p == 0){
        !            33:                        /*
        !            34:                         * allocate new name:
        !            35:                         */
        !            36:                        for(p=nlist; p->namep; p++) {}
        !            37:                        p->namep = alloc(4);
        !            38:                        copy(CH, "Llx", p->namep, 4);
        !            39:                        p->type = LV;
        !            40:                        p->use = 0;
        !            41:                        p->itemp = newdat(CH, 0, 0);
        !            42:                }
        !            43:                sp++;   /* reset stack */
        !            44:                break;
        !            45:        case QD:
        !            46:                pop();
        !            47:                ex_print();
        !            48:                return;
        !            49:        case QC:
        !            50:                pop();
        !            51:                ex_plot();
        !            52:                return;
        !            53:        case QQ:
        !            54:                pop();
        !            55:                epr0(); /* print w/out '\n'  (in a2.c) */
        !            56:                return;
        !            57:        case LV:
        !            58:                /* The following line checks that it is not the first assignment
        !            59:                 * to the local variable, in which case itemp has not be set yet
        !            60:                 * This used to produce an interesting bug when adress 1 was
        !            61:                 * holding the manifest constant LBL ... just by chance !
        !            62:                 */
        !            63:                if (((struct nlist *)p)->itemp != 0) {
        !            64:                        if(((struct nlist *)p)->itemp->type == LBL)
        !            65:                                error("asgn to label");
        !            66:                }
        !            67:                break;
        !            68:        default:
        !            69:                error("asgn lv");
        !            70:        }
        !            71:        if(p->use != 0 && p->use != DA)
        !            72:                error("asgn var");
        !            73:        sp--;
        !            74:        q = fetch1();
        !            75:        erase(p);
        !            76:        p->use = DA;
        !            77:        ((struct nlist *)p)->itemp = q;
        !            78:        sp[-1] = (struct item *)p;
        !            79: }
        !            80: 
        !            81: ex_elid()
        !            82: {
        !            83: 
        !            84:        *sp++ = newdat(EL, 0, 0);
        !            85: }
        !            86: 
        !            87: ex_index()
        !            88: {
        !            89:        register struct item *p;
        !            90:        struct item *q;
        !            91:        register i, j;
        !            92:        int f, n, lv;
        !            93: 
        !            94:        n = *pcp++;
        !            95:        f = *pcp;
        !            96:        p = sp[-1];
        !            97:        if(f == ASGN) {
        !            98:                pcp++;
        !            99:                if(p->type != LV)
        !           100:                        error("indexed assign value");
        !           101:                if(((struct nlist *)p)->use != DA)
        !           102:                        fetch1(); /* error("used before set"); */
        !           103:                q = ((struct nlist *)p)->itemp;
        !           104:        } else
        !           105:                q = fetch1();
        !           106:        if(q->rank != n)
        !           107:                error("subscript C");
        !           108:        idx.rank = 0;
        !           109:        for(i=0; i<n; i++) {
        !           110:                p = sp[-i-2];
        !           111:                if(p->type == EL) {
        !           112:                        idx.dim[idx.rank++] =
        !           113:                                q->dim[i];
        !           114:                        continue;
        !           115:                }
        !           116:                p = fetch(p);
        !           117:                sp[-i-2] = p;
        !           118:                for(j=0; j<p->rank; j++)
        !           119:                        idx.dim[idx.rank++] =
        !           120:                                p->dim[j];
        !           121:        }
        !           122:        size();
        !           123:        if(f == ASGN) {
        !           124:                p = fetch(sp[-n-2]);
        !           125:                sp[-n-2] = p;
        !           126:                if (p->size > 1) {
        !           127:                        if(idx.size != p->size)
        !           128:                                error("assign C");
        !           129:                        f = 1; /* v[i] <- v */
        !           130:                } else {
        !           131:                        if (idx.size && !p->size)
        !           132:                                error("assign C");
        !           133:                        /* Note -- for idx.size = 0, no assign occurs
        !           134:                         * anyway, so it is safe to set "datum" to 0
        !           135:                         */
        !           136:                        datum = p->size ? getdat(p) : 0;
        !           137:                        f = 2; /* v[i] <- s */
        !           138:                }
        !           139:                ex_elid();
        !           140:        } else {
        !           141:                p = newdat(q->type, idx.rank, idx.size);
        !           142:                copy(IN, idx.dim, p->dim, idx.rank);
        !           143:                *sp++ = p;
        !           144:                f = 0; /* v[i] */
        !           145:        }
        !           146:        bidx(q);
        !           147:        index1(0, f);
        !           148:        if(f == 0) {
        !           149:                p = sp[-1];
        !           150:                sp--;
        !           151:                for(i=0; i<=n; i++)
        !           152:                        pop();
        !           153:                *sp++ = p;
        !           154:        } else {
        !           155:                pop();          /* pop ELID */
        !           156:                sp--;           /* skip over LV */
        !           157:                for(i=0; i<n; i++)
        !           158:                        pop();
        !           159:        }
        !           160: }
        !           161: 
        !           162: index1(i, f)
        !           163: {
        !           164:        register struct item *p;
        !           165:        register j, k;
        !           166: 
        !           167:        if(i >= idx.rank)
        !           168:        switch(f) {
        !           169: 
        !           170:        case 0:
        !           171:                p = sp[-2];
        !           172:                p->index = access();
        !           173:                putdat(sp[-1], getdat(p));
        !           174:                return;
        !           175: 
        !           176:        case 1:
        !           177:                datum = getdat(sp[-idx.rank-3]);
        !           178: 
        !           179:        case 2:
        !           180:                p = ((struct nlist *)sp[-2])->itemp;
        !           181:                p->index = access();
        !           182:                putdat(p, datum);
        !           183:                return;
        !           184:        }
        !           185:        p = sp[-i-3];
        !           186:        if(p->type == EL) {
        !           187:                for(j=0; j<idx.dim[i]; j++) {
        !           188:                        idx.idx[i] = j;
        !           189:                        index1(i+1, f);
        !           190:                }
        !           191:                return;
        !           192:        }
        !           193:        p->index = 0;
        !           194:        for(j=0; j<p->size; j++) {
        !           195:                k = fix(getdat(p)) - thread.iorg;
        !           196:                if(k < 0 || k >= idx.dim[i])
        !           197:                        error("subscript X");
        !           198:                idx.idx[i] = k;
        !           199:                index1(i+1, f);
        !           200:        }
        !           201: }

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