From 957bb13dde1e8e8ba4efeba4a26336805c9b1e2c Mon Sep 17 00:00:00 2001 From: Bill Joy Date: Fri, 4 May 1979 10:19:31 -0800 Subject: [PATCH] BSD 4 development Work on file usr/src/cmd/apl/a3.c Work on file usr/src/cmd/apl/a5.c Work on file usr/src/cmd/apl/a6.c Work on file usr/src/cmd/apl/a7.c Work on file usr/src/cmd/apl/ab.c Work on file usr/src/cmd/apl/ac.c Work on file usr/src/cmd/apl/ad.c Work on file usr/src/cmd/apl/ag.c Work on file usr/src/cmd/apl/ak.c Synthesized-from: CSRG//cd1/4.0 --- usr/src/cmd/apl/a3.c | 68 ++++++++++++++++ usr/src/cmd/apl/a5.c | 154 +++++++++++++++++++++++++++++++++++ usr/src/cmd/apl/a6.c | 93 ++++++++++++++++++++++ usr/src/cmd/apl/a7.c | 104 ++++++++++++++++++++++++ usr/src/cmd/apl/ab.c | 186 +++++++++++++++++++++++++++++++++++++++++++ usr/src/cmd/apl/ac.c | 78 ++++++++++++++++++ usr/src/cmd/apl/ad.c | 145 +++++++++++++++++++++++++++++++++ usr/src/cmd/apl/ag.c | 50 ++++++++++++ usr/src/cmd/apl/ak.c | 127 +++++++++++++++++++++++++++++ 9 files changed, 1005 insertions(+) create mode 100644 usr/src/cmd/apl/a3.c create mode 100644 usr/src/cmd/apl/a5.c create mode 100644 usr/src/cmd/apl/a6.c create mode 100644 usr/src/cmd/apl/a7.c create mode 100644 usr/src/cmd/apl/ab.c create mode 100644 usr/src/cmd/apl/ac.c create mode 100644 usr/src/cmd/apl/ad.c create mode 100644 usr/src/cmd/apl/ag.c create mode 100644 usr/src/cmd/apl/ak.c diff --git a/usr/src/cmd/apl/a3.c b/usr/src/cmd/apl/a3.c new file mode 100644 index 0000000000..c8d2ac1296 --- /dev/null +++ b/usr/src/cmd/apl/a3.c @@ -0,0 +1,68 @@ +#include "apl.h" + +ex_miot() +{ + register struct item *p; + register data *dp; + register i; + + i = topfix(); + if(i < 0) + error("miot D"); + p = newdat(DA, 1, i); + dp = p->datap; + datum = thread.iorg; + for(; i; i--) { + *dp++ = datum; + datum =+ one; + } + push(p); +} + +ex_mrho() +{ + register struct item *p, *q; + register data *dp; + int i; + + p = fetch1(); + q = newdat(DA, 1, p->rank); + dp = q->datap; + for(i=0; irank; i++) + *dp++ = p->dim[i]; + pop(); + push(q); +} + +ex_drho() +{ + register struct item *p, *q; + struct item *r; + int s, i; + register data *dp; + char *cp; + + p = fetch2(); + q = sp[-2]; + if(p->type != DA || p->rank > 1 || q->size < 1) + error("rho C"); + s = 1; + dp = p->datap; + for(i=0; isize; i++) + s =* fix(*dp++); + r = newdat(q->type, p->size, s); + dp = p->datap; + for(i=0; isize; i++) + r->dim[i] = fix(*dp++); + cp = r->datap; + while(s > 0) { + i = s; + if(i > q->size) + i = q->size; + cp =+ copy(q->type, q->datap, cp, i); + s =- i; + } + pop(); + pop(); + push(r); +} diff --git a/usr/src/cmd/apl/a5.c b/usr/src/cmd/apl/a5.c new file mode 100644 index 0000000000..e1eb3d004a --- /dev/null +++ b/usr/src/cmd/apl/a5.c @@ -0,0 +1,154 @@ +#include "apl.h" + +ex_rav() +{ + register struct item *p, *r; + + p = fetch1(); + if(p->rank == 0) { + r = newdat(p->type, 1, 1); + putdat(r, getdat(p)); + pop(); + push(r); + return; + } + rav0(p->rank-1); +} + +ex_ravk() +{ + register i; + + i = topfix() - thread.iorg; + fetch1(); + rav0(i); +} + +rav0(k) +{ + register struct item *p, *r; + struct item *param[2]; + int rav1(); + + p = sp[-1]; + bidx(p); + colapse(k); + r = newdat(p->type, 1, p->size); + param[0] = p; + param[1] = r; + forloop(rav1, param); + pop(); + push(r); +} + +rav1(param) +struct item *param[]; +{ + register struct item *p; + register i, n; + + p = param[0]; + n = access(); + for(i=0; iindex = n; + putdat(param[1], getdat(p)); + n =+ idx.delk; + } +} + +ex_cat() +{ + register struct item *p, *q; + struct item *r; + register k; + + p = fetch2(); + q = sp[-2]; + k = p->rank; + if(q->rank > k) + k = q->rank; + if(k == 0) { + r = newdat(p->type, 1, 2); + putdat(r, getdat(p)); + putdat(r, getdat(q)); + pop(); + pop(); + push(r); + } else + cat0(k-1); +} + +ex_catk() +{ + register k; + + k = topfix() - thread.iorg; + fetch2(); + cat0(k); +} + +cat0(k) +{ + register struct item *p, *q; + register i; + struct item *r; + int a, b; + + p = sp[-1]; + q = sp[-2]; + i = k; + if(p->rank >= q->rank) { + bidx(p); + b = cat1(q, i); + a = idx.dim[i]; + } else { + bidx(q); + a = cat1(p, i); + b = idx.dim[i]; + } + idx.dim[i] = a+b; + size(); + r = newdat(p->type, idx.rank, idx.size); + copy(IN, idx.dim, r->dim, idx.rank); + i = idx.del[i]; + a =* i; + b =* i; + while(r->index < r->size) { + for(i=0; i= idx.rank) + error("cat X"); + p = ip; + a = 1; + if(p->rank == 0) + return(a); + j = 0; + for(i=0; irank == idx.rank) { + a = p->dim[i]; + j++; + } + continue; + } + if(idx.dim[i] != p->dim[j]) + error("cat C"); + j++; + } + return(a); +} diff --git a/usr/src/cmd/apl/a6.c b/usr/src/cmd/apl/a6.c new file mode 100644 index 0000000000..6d4f0d43f3 --- /dev/null +++ b/usr/src/cmd/apl/a6.c @@ -0,0 +1,93 @@ +#include "apl.h" + +ex_red0() +{ + + fetch1(); + red0(0); +} + +ex_red() +{ + register struct item *p; + + p = fetch1(); + red0(p->rank-1); +} + +ex_redk() +{ + register i; + + i = topfix() - thread.iorg; + fetch1(); + red0(i); +} + +red0(k) +{ + register struct item *p, *q; + int param[3], red1(); + + p = fetch1(); + if(p->type != DA) + error("red T"); + bidx(p); + colapse(k); + if(idx.dimk == 0) { +/* + * reduction identities - ets/jrl 5/76 + */ + q = newdat(DA,0,1); + q->dim[0] = 1; + switch(*pcp++) { + case ADD: + case SUB: + case OR: + q->datap[0] = 0; + break; + case AND: + case MUL: + case DIV: + q->datap[0] = 1; + break; + case MIN: + q->datap[0] = 1.0e38; + break; + case MAX: + q->datap[0] = -1.0e38; + break; + default: + error("reduce identity"); + } + pop(); + push(q); + return; + } + q = newdat(idx.type, idx.rank, idx.size); + copy(IN, idx.dim, q->dim, idx.rank); + param[0] = p->datap; + param[1] = q; + param[2] = exop[*pcp++]; + forloop(red1, param); + pop(); + push(q); +} + +red1(param) +int param[]; +{ + register i; + register data *dp; + data d, (*f)(); + + dp = param[0]; + dp =+ access() + (idx.dimk-1) * idx.delk; + f = param[2]; + d = *dp; + for(i=1; itype != DA || q->type != DA) + error("iprod T"); + bidx(p); + idx.rank--; + param[2] = idx.dim[idx.rank]; + if(param[2] != q->dim[0]) + error("inner prod C"); + param[3] = q->size/param[2]; + for(i=1; irank; i++) + idx.dim[idx.rank++] = q->dim[i]; + r = newdat(DA, idx.rank, size()); + copy(IN, idx.dim, r->dim, idx.rank); + param[4] = 0; + param[5] = 0; + param[6] = p->datap; + param[7] = q->datap; + param[8] = r->datap; + param[9] = p->size; + forloop(ipr1, param); + pop(); + pop(); + push(r); +} + +ipr1(param) +int param[]; +{ + register i, dk; + int lk, a, b; + data *dp1, *dp2, *dp3; + data (*f1)(), (*f2)(), d; + + f1 = param[0]; + f2 = param[1]; + dk = param[2]; + lk = param[3]; + a = param[4]; + b = param[5]; + dp1 = param[6]; + dp2 = param[7]; + dp3 = param[8]; + a =+ dk; + b =+ (dk * lk); + for(i=0; i= lk) { + param[5] = 0; + param[4] =+ dk; + if(param[4] >= param[9]) + param[4] = 0; + } +} + +ex_oprod() +{ + register i, j; + register data *dp; + struct item *p, *q, *r; + data *dp1, *dp2; + data (*f)(); + + f = exop[*pcp++]; + p = fetch2(); + q = sp[-2]; + if(p->type != DA || q->type != DA) + error("oprod T"); + bidx(p); + for(i=0; irank; i++) + idx.dim[idx.rank++] = q->dim[i]; + r = newdat(DA, idx.rank, size()); + copy(IN, idx.dim, r->dim, idx.rank); + dp = r->datap; + dp1 = p->datap; + for(i=0; isize; i++) { + datum = *dp1++; + dp2 = q->datap; + for(j=0; jsize; j++) + *dp++ = (*f)(datum, *dp2++); + } + pop(); + pop(); + push(r); +} diff --git a/usr/src/cmd/apl/ab.c b/usr/src/cmd/apl/ab.c new file mode 100644 index 0000000000..b2213fb1a4 --- /dev/null +++ b/usr/src/cmd/apl/ab.c @@ -0,0 +1,186 @@ +#include "apl.h" + +ex_take() +{ + register i, k, o; + + o = 0; + td1(); + for(i=0; i 0) + o =+ idx.del[i] * k; else + k = -k; + idx.dim[i] =- k; + } + map(o); +} + +td1() +{ + register struct item *p; + struct item *q; + register i, k; + + p = fetch2(); + q = sp[-2]; + if(p->rank > 1 || q->rank != p->size) + error("take C"); + bidx(q); + for(i=0; isize; i++) { + k = fix(getdat(p)); + idx.idx[i] = k; + if(k < 0) + k = -k; + if(k > idx.dim[i]) + error("take C"); + } + pop(); +} + +ex_dtrn() +{ + register struct item *p, *q; + register i; + + p = fetch2(); + q = sp[-2]; + if(p->rank > 1 || p->size != q->rank) + error("tranpose C"); + for(i=0; isize; i++) + idx.idx[i] = fix(getdat(p)) - thread.iorg; + pop(); + trn0(); +} + +ex_mtrn() +{ + register struct item *p; + register i; + + p = fetch1(); + if(p->rank <= 1) + return; + for(i=0; irank; i++) + idx.idx[i] = i; + idx.idx[i-1] = i-2; + idx.idx[i-2] = i-1; + trn0(); +} + +trn0() +{ + register i, j; + int d[MRANK], r[MRANK]; + + bidx(sp[-1]); + for(i=0; i=idx.rank) + error("tranpose X"); + if(d[j] != -1) { + if(idx.dim[i] < d[j]) + d[j] = idx.dim[i]; + r[j] =+ idx.del[i]; + } else { + d[j] = idx.dim[i]; + r[j] = idx.del[i]; + } + } + j = idx.rank; + for(i=0; i j) + error("tranpose D"); + idx.dim[i] = d[i]; + idx.del[i] = r[i]; + } else + if(i < j) + j = i; + } + idx.rank = j; + map(0); +} + +ex_rev0() +{ + + fetch1(); + revk(0); +} + +ex_revk() +{ + register k; + + k = topfix() - thread.iorg; + fetch1(); + revk(k); +} + +ex_rev() +{ + register struct item *p; + + p = fetch1(); + revk(p->rank-1); +} + +revk(k) +{ + register o; + + bidx(sp[-1]); + if(k < 0 || k >= idx.rank) + error("reverse X"); + o = idx.del[k] * (idx.dim[k]-1); + idx.del[k] = -idx.del[k]; + map(o); +} + +map(o) +{ + register struct item *p; + register n, i; + int map1(); + + n = 1; + for(i=0; idim, idx.rank); + push(p); + forloop(map1, o); + sp--; + pop(); + push(p); +} + +map1(o) +{ + register struct item *p; + + p = sp[-2]; + p->index = access() + o; + putdat(sp[-1], getdat(p)); +} diff --git a/usr/src/cmd/apl/ac.c b/usr/src/cmd/apl/ac.c new file mode 100644 index 0000000000..7a05f61fbc --- /dev/null +++ b/usr/src/cmd/apl/ac.c @@ -0,0 +1,78 @@ +#include "apl.h" + +ex_rot0() +{ + + fetch2(); + rotk(0); +} + +ex_rotk() +{ + register k; + + k = topfix() - thread.iorg; + fetch2(); + rotk(k); +} + +ex_rot() +{ + register struct item *p; + + fetch2(); + p = sp[-2]; + rotk(p->rank-1); +} + +rotk(k) +{ + register struct item *p, *q; + register param; + int rot1(); + + p = sp[-1]; + bidx(sp[-2]); + if(k < 0 || k >= idx.rank) + error("rotate X"); + param = 0; + colapse(k); + if(idx.size != p->size) { + if(p->size != 1) + error("rotate C"); + param++; + datum = getdat(p); + } + p = newdat(idx.type, 1, idx.dimk); + push(p); + forloop(rot1, param); + pop(); + pop(); +} + +rot1(param) +{ + register struct item *p, *q; + register i; + int o, n; + + if(param == 0) + datum = getdat(sp[-2]); + o = fix(datum); + if(o < 0) + o = idx.dimk - (-o % idx.dimk); + q = sp[-1]; + p = sp[-3]; + q->index = 0; + n = access(); + for(i=0; iindex = n + (o%idx.dimk)*idx.delk; + putdat(q, getdat(p)); + o++; + } + for(i=0; iindex = n; + putdat(p, getdat(q)); + n =+ idx.delk; + } +} diff --git a/usr/src/cmd/apl/ad.c b/usr/src/cmd/apl/ad.c new file mode 100644 index 0000000000..8fad0586bf --- /dev/null +++ b/usr/src/cmd/apl/ad.c @@ -0,0 +1,145 @@ +#include "apl.h" + +ex_com0() +{ + + fetch2(); + comk(0); +} + +ex_comk() +{ + register k; + + k = topfix() - thread.iorg; + fetch2(); + comk(k); +} + +ex_com() +{ + register struct item *q; + + fetch2(); + q = sp[-2]; + comk(q->rank-1); +} + +comk(k) +{ + register struct item *p; + register i; + int dk, ndk, com1(); + + p = sp[-1]; + bidx(sp[-2]); + if(p->rank==0||p->rank==1&&p->size==1) { + if(getdat(p)) { + pop(); + return; + } + p = newdat(idx.type, 1, 0); + pop(); + pop(); + push(p); + return; + } + if(k < 0 || k >= idx.rank) + error("compress X"); + dk = idx.dim[k]; + if(p->rank != 1 || p->size != dk) + error("compress C"); + ndk = 0; + for(i=0; idim, idx.rank); + p->dim[k] = ndk; + push(p); + forloop(com1, k); + sp--; + pop(); + pop(); + push(p); +} + +com1(k) +{ + register struct item *p; + + p = sp[-2]; + p->index = idx.idx[k]; + if(getdat(p)) { + p = sp[-3]; + p->index = access(); + putdat(sp[-1], getdat(p)); + } +} + +ex_exd0() +{ + + fetch2(); + exdk(0); +} + +ex_exdk() +{ + register k; + + k = topfix() - thread.iorg; + fetch2(); + exdk(k); +} + +ex_exd() +{ + register struct item *q; + + fetch2(); + q = sp[-2]; + exdk(q->rank-1); +} + +exdk(k) +{ + register struct item *p; + register i, dk; + int exd1(); + + p = sp[-1]; + bidx(sp[-2]); + if(k < 0 || k >= idx.rank) + error("expand X"); + dk = 0; + for(i=0; isize; i++) + if(getdat(p)) + dk++; + if(p->rank != 1 || dk != idx.dim[k]) + error("expand C"); + idx.dim[k] = p->size; + size(); + p = newdat(idx.type, idx.rank, idx.size); + copy(IN, idx.dim, p->dim, idx.rank); + push(p); + forloop(exd1, k); + sp--; + pop(); + pop(); + push(p); +} + +exd1(k) +{ + register struct item *p; + + p = sp[-2]; + p->index = idx.idx[k]; + if(getdat(p)) + datum = getdat(sp[-3]); else + if(idx.type == DA) + datum = zero; else + datum = ' '; + putdat(sp[-1], datum); +} diff --git a/usr/src/cmd/apl/ag.c b/usr/src/cmd/apl/ag.c new file mode 100644 index 0000000000..56dbbed4cb --- /dev/null +++ b/usr/src/cmd/apl/ag.c @@ -0,0 +1,50 @@ +#include "apl.h" + +ex_diot() +{ + register struct item *p, *q, *r; + int i, j; + + p = fetch2(); + q = sp[-2]; + r = newdat(DA, q->rank, q->size); + copy(IN, q->dim, r->dim, q->rank); + for(i=0; isize; i++) { + datum = getdat(q); + p->index = 0; + for(j=0; jsize; j++) + if(fuzz(getdat(p), datum) == 0) + break; + datum = j + thread.iorg; + putdat(r, datum); + } + pop(); + pop(); + push(r); +} + +ex_eps() +{ + register struct item *p, *q, *r; + int i, j; + data d; + + p = fetch2(); + q = sp[-2]; + r = newdat(DA, p->rank, p->size); + copy(IN, p->dim, r->dim, p->rank); + for(i=0; isize; i++) { + datum = getdat(p); + d = zero; + q->index = 0; + for(j=0; jsize; j++) + if(fuzz(getdat(q), datum) == 0) { + d = one; + break; + } + putdat(r, d); + } + pop(); + pop(); + push(r); +} diff --git a/usr/src/cmd/apl/ak.c b/usr/src/cmd/apl/ak.c new file mode 100644 index 0000000000..c51e629bfd --- /dev/null +++ b/usr/src/cmd/apl/ak.c @@ -0,0 +1,127 @@ +#include "apl.h" + +ex_scn0() +{ + fetch1(); + scan0(0); +} + +ex_scan() +{ + register struct item *p; + + p = fetch1(); + scan0(p->rank-1); +} + +ex_scnk() +{ + register i; + + i = topfix() - thread.iorg; + scan0(i); +} + +scan0(k) +{ + register struct item *p, *q; + int param[2]; + int scan1(); + + p = fetch1(); + if(p->type != DA) + error("scan T"); + + bidx(p); + colapse(k); + if(idx.dimk == 0) { +/* + * scan identities - ets/jrl 5/76 + */ + q = newdat(DA,0,1); + q->dim[0] = 1; + switch(*pcp++) { + case ADD: + case SUB: + case OR: + q->datap[0] = 0; + break; + case AND: + case MUL: + case DIV: + q->datap[0] = 1; + break; + case MIN: + q->datap[0] = 1.0e38; + break; + case MAX: + q->datap[0] = -1.0e38; + break; + default: + error("reduce identity"); + } + pop(); + push(q); + return; + } + param[0] = p->datap; + param[1] = exop[*pcp++]; + forloop(scan1, param); +} + +scan1(param) +int param[]; +{ + register i; + register data *dp; + data d; + data (*f)(); + + dp = param[0]; + f = param[1]; + dp =+ access(); + d = *dp; + for(i = 1; i < idx.dimk; i++) { + dp =+ idx.delk; + *dp = d = (*f)(*dp, d); + } +} + +data scalex 453.; +data scaley 453.; +data origx 0.0; +data origy 0.0; + +ex_plot() +{ + register struct item *p; + register data *dp; + register i; + int ic; + int x, y; + + p = fetch1(); + if(p->type != DA) + error("plot T"); + if(p->rank != 2) + error("plot R"); + if(p->dim[1] != 2) + error("plot C"); + + dp = p->datap; + if ((i = p->dim[0]) == 0) return; + ic=0; + while(i--) { + x = scalex*(*dp++ - origx); + y = 454-(scaley*(*dp++ - origy)); + if(x<0 || x >= 576 || + y<0 || y>=454) + error("plot off screen"); + if(ic) + line(x,y); + else { + move(x,y); + ic=1; + } + } +} -- 2.20.1