Return to ae.c CVS log

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

Annotation of 41BSD/cmd/apl/ae.c, revision 1.1

1.1     ! root        1: #include "apl.h"
        !             2: 
        !             3: ex_base()
        !             4: {
        !             5:        register struct item *p, *q;
        !             6:        int s, s1;
        !             7:        data d, d1;
        !             8:        double r, b;
        !             9: 
        !            10:        p = fetch2();
        !            11:        q = sp[-2];
        !            12:        if(p->rank > 1 || q->rank > 1)
        !            13:                error("base R");
        !            14:        b = 1.;
        !            15:        r = 0.;
        !            16:        s = p->size;
        !            17:        s1 = q->size;
        !            18:        while(s > 0 || s1 > 0) {
        !            19:                if(s > 0) {
        !            20:                        s--;
        !            21:                        p->index = s;
        !            22:                        d = getdat(p);
        !            23:                }
        !            24:                if(s1 > 0) {
        !            25:                        s1--;
        !            26:                        q->index = s1;
        !            27:                        d1 = getdat(q);
        !            28:                }
        !            29:                r += d1 * b;
        !            30:                b *= d;
        !            31:        }
        !            32:        pop();
        !            33:        pop();
        !            34:        p = newdat(DA, 0, 1);
        !            35:        push(p);
        !            36:        d = r;
        !            37:        putdat(p, d);
        !            38: }
        !            39: 
        !            40: ex_rep()
        !            41: {
        !            42:        register struct item *p, *q;
        !            43:        register s;
        !            44:        double a, b, r;
        !            45: 
        !            46:        p = fetch2();
        !            47:        q = sp[-2];
        !            48:        if(q->size != 1 || p->rank > 1)
        !            49:                error("represent R");
        !            50:        r = getdat(q);
        !            51:        s = p->size;
        !            52:        while(s > 0) {
        !            53:                s--;
        !            54:                p->index = s;
        !            55:                b = getdat(p);
        !            56:                if(b == 0.)
        !            57:                        error("represent D");
        !            58:                r /= b;
        !            59:                a = r;
        !            60:                r = floor(r);
        !            61:                datum = (a - r) * b;
        !            62:                p->index = s;
        !            63:                putdat(p, datum);
        !            64:        }
        !            65:        sp--;
        !            66:        pop();
        !            67:        push(p);
        !            68: }

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