Return to a6.c CVS log

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

Annotation of 43BSD/contrib/apl/src/a6.c, revision 1.1.1.1

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

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