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

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.