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

diff --git a/usr/src/cmd/apl/a3.c b/usr/src/cmd/apl/a3.c
new file mode 100644 (file)
index 0000000..c8d2ac1
--- /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; i<p->rank; 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; i<p->size; i++)
+               s =* fix(*dp++);
+       r = newdat(q->type, p->size, s);
+       dp = p->datap;
+       for(i=0; i<p->size; 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 (file)
index 0000000..e1eb3d0
--- /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; i<idx.dimk; i++) {
+               p->index = 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<a; i++)
+                       putdat(r, getdat(p));
+               for(i=0; i<b; i++)
+                       putdat(r, getdat(q));
+       }
+       pop();
+       pop();
+       push(r);
+}
+
+cat1(ip, k)
+struct item *ip;
+{
+       register struct item *p;
+       register i, j;
+       int a;
+
+       if(k < 0 || k >= idx.rank)
+               error("cat X");
+       p = ip;
+       a = 1;
+       if(p->rank == 0)
+               return(a);
+       j = 0;
+       for(i=0; i<idx.rank; i++) {
+               if(i == k) {
+                       if(p->rank == 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 (file)
index 0000000..6d4f0d4
--- /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; i<idx.dimk; i++) {
+               dp =- idx.delk;
+               d = (*f)(*dp, d);
+       }
+       putdat(param[1], d);
+}

diff --git a/usr/src/cmd/apl/a7.c b/usr/src/cmd/apl/a7.c
new file mode 100644 (file)
index 0000000..693ced4
--- /dev/null
+++ b/usr/src/cmd/apl/a7.c
@@ -0,0 +1,104 @@
+#include "apl.h"
+
+ex_iprod()
+{
+       register i, j;
+       struct item *p, *q, *r;
+       int param[10], ipr1();
+
+       param[0] = exop[*pcp++];
+       param[1] = exop[*pcp++];
+       p = fetch2();
+       q = sp[-2];
+       if(p->type != 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; i<q->rank; 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<dk; i++) {
+               a--;
+               b =- lk;
+               d = (*f2)(dp1[a], dp2[b]);
+               if(i == 0)
+                       datum = d; else
+                       datum = (*f1)(d, datum);
+       }
+       *dp3++ = datum;
+       param[8] = dp3;
+       param[5]++;
+       if(param[5] >= 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; i<q->rank; 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; i<p->size; i++) {
+               datum = *dp1++;
+               dp2 = q->datap;
+               for(j=0; j<q->size; 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 (file)
index 0000000..b2213fb
--- /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<idx.rank; i++) {
+               k = idx.idx[i];
+               if(k < 0) {
+                       k = -k;
+                       o =+ idx.del[i] *
+                               (idx.dim[i] - k);
+               }
+               idx.dim[i] = k;
+       }
+       map(o);
+}
+
+ex_drop()
+{
+       register i, k, o;
+
+       o = 0;
+       td1();
+       for(i=0; i<idx.rank; i++) {
+               k = idx.idx[i];
+               if(k > 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; i<p->size; 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; i<p->size; 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; i<p->rank; 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; i++)
+               d[i] = -1;
+       for(i=0; i<idx.rank; i++) {
+               j = idx.idx[i];
+               if(j<0 || j>=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<idx.rank; i++) {
+               if(d[i] != -1) {
+                       if(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; i<idx.rank; i++)
+               n =* idx.dim[i];
+       p = newdat(idx.type, idx.rank, n);
+       copy(IN, idx.dim, p->dim, 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 (file)
index 0000000..7a05f61
--- /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; i<idx.dimk; i++) {
+               p->index = n + (o%idx.dimk)*idx.delk;
+               putdat(q, getdat(p));
+               o++;
+       }
+       for(i=0; i<idx.dimk; i++) {
+               p->index = 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 (file)
index 0000000..8fad058
--- /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; i<dk; i++)
+               if(getdat(p))
+                       ndk++;
+       p = newdat(idx.type, idx.rank, (idx.size/dk)*ndk);
+       copy(IN, idx.dim, p->dim, 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; i<p->size; 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 (file)
index 0000000..56dbbed
--- /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; i<q->size; i++) {
+               datum = getdat(q);
+               p->index = 0;
+               for(j=0; j<p->size; 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; i<p->size; i++) {
+               datum = getdat(p);
+               d = zero;
+               q->index = 0;
+               for(j=0; j<q->size; 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 (file)
index 0000000..c51e629
--- /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;
+               }
+       }
+}