Return to a6.c CVS log

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

Annotation of 40BSD/cmd/apl/a6.c, revision 1.1.1.1

1.1       root        1: #include "apl.h"
                      2: 
                      3: ex_red0()
                      4: {
                      5: 
                      6:        fetch1();
                      7:        red0(0);
                      8: }
                      9: 
                     10: ex_red()
                     11: {
                     12:        register struct item *p;
                     13: 
                     14:        p = fetch1();
                     15:        red0(p->rank-1);
                     16: }
                     17: 
                     18: ex_redk()
                     19: {
                     20:        register i;
                     21: 
                     22:        i = topfix() - thread.iorg;
                     23:        fetch1();
                     24:        red0(i);
                     25: }
                     26: 
                     27: red0(k)
                     28: {
                     29:        register struct item *p, *q;
                     30:        int param[3], red1();
                     31: 
                     32:        p = fetch1();
                     33:        if(p->type != DA)
                     34:                error("red T");
                     35:        bidx(p);
                     36:        colapse(k);
                     37:        if(idx.dimk == 0) {
                     38: /*
                     39:  *  reduction identities - ets/jrl 5/76
                     40:  */
                     41:                q = newdat(DA,0,1);
                     42:                q->dim[0] = 1;
                     43:                switch(*pcp++) {
                     44:        case ADD:
                     45:        case SUB:
                     46:        case OR:
                     47:                        q->datap[0] = 0;
                     48:                        break;
                     49:        case AND:
                     50:        case MUL:
                     51:        case DIV:
                     52:                        q->datap[0] = 1;
                     53:                        break;
                     54:        case MIN:
                     55:                        q->datap[0] = 1.0e38;
                     56:                        break;
                     57:        case MAX:
                     58:                        q->datap[0] = -1.0e38;
                     59:                        break;
                     60:        default:
                     61:                        error("reduce identity");
                     62:                }
                     63:                pop();
                     64:                push(q);
                     65:                return;
                     66:        }
                     67:        q = newdat(idx.type, idx.rank, idx.size);
                     68:        copy(IN, idx.dim, q->dim, idx.rank);
                     69:        param[0] = p->datap;
                     70:        param[1] = q;
                     71:        param[2] = exop[*pcp++];
                     72:        forloop(red1, param);
                     73:        pop();
                     74:        push(q);
                     75: }
                     76: 
                     77: red1(param)
                     78: int param[];
                     79: {
                     80:        register i;
                     81:        register data *dp;
                     82:        data d, (*f)();
                     83: 
                     84:        dp = param[0];
                     85:        dp =+ access() + (idx.dimk-1) * idx.delk;
                     86:        f = param[2];
                     87:        d = *dp;
                     88:        for(i=1; i<idx.dimk; i++) {
                     89:                dp =- idx.delk;
                     90:                d = (*f)(*dp, d);
                     91:        }
                     92:        putdat(param[1], d);
                     93: }

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