Return to a4.c CVS log

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

Annotation of 3BSD/cmd/apl/a4.c, revision 1.1.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.