BSD 4_2 development
authorCSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 11 May 1983 14:24:11 +0000 (06:24 -0800)
committerCSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 11 May 1983 14:24:11 +0000 (06:24 -0800)
Work on file usr/src/new/new/icon/int/operators/Makefile
Work on file usr/src/new/new/icon/int/operators/cat.c
Work on file usr/src/new/new/icon/int/operators/bang.c
Work on file usr/src/new/new/icon/int/operators/asgn.c
Work on file usr/src/new/new/icon/cmp/operators/bang.c
Work on file usr/src/new/new/icon/cmp/operators/asgn.c
Work on file usr/src/new/new/icon/cmp/operators/cat.c
Work on file usr/src/new/new/icon/cmp/operators/diff.c
Work on file usr/src/new/new/icon/int/operators/diff.c
Work on file usr/src/new/new/icon/cmp/operators/div.c
Work on file usr/src/new/new/icon/int/operators/div.c
Work on file usr/src/new/new/icon/cmp/operators/compl.c
Work on file usr/src/new/new/icon/int/operators/compl.c
Work on file usr/src/new/new/icon/cmp/operators/eqv.c
Work on file usr/src/new/new/icon/cmp/operators/lconcat.c
Work on file usr/src/new/new/icon/cmp/operators/inter.c
Work on file usr/src/new/new/icon/int/operators/eqv.c
Work on file usr/src/new/new/icon/int/operators/lconcat.c
Work on file usr/src/new/new/icon/int/operators/inter.c
Work on file usr/src/new/new/icon/int/operators/lexeq.c
Work on file usr/src/new/new/icon/cmp/operators/lexeq.c
Work on file usr/src/new/new/icon/int/operators/lexge.c
Work on file usr/src/new/new/icon/cmp/operators/lexge.c
Work on file usr/src/new/new/icon/cmp/operators/lexgt.c
Work on file usr/src/new/new/icon/int/operators/lexgt.c
Work on file usr/src/new/new/icon/int/operators/lexle.c
Work on file usr/src/new/new/icon/cmp/operators/lexle.c
Work on file usr/src/new/new/icon/cmp/operators/lexlt.c
Work on file usr/src/new/new/icon/int/operators/lexlt.c
Work on file usr/src/new/new/icon/int/operators/lexne.c
Work on file usr/src/new/new/icon/int/operators/minus.c
Work on file usr/src/new/new/icon/cmp/operators/lexne.c
Work on file usr/src/new/new/icon/cmp/operators/minus.c
Work on file usr/src/new/new/icon/cmp/operators/mod.c
Work on file usr/src/new/new/icon/cmp/operators/mult.c
Work on file usr/src/new/new/icon/int/operators/mult.c
Work on file usr/src/new/new/icon/int/operators/mod.c
Work on file usr/src/new/new/icon/int/operators/neg.c
Work on file usr/src/new/new/icon/cmp/operators/neg.c
Work on file usr/src/new/new/icon/int/operators/neqv.c
Work on file usr/src/new/new/icon/cmp/operators/neqv.c
Work on file usr/src/new/new/icon/int/operators/null.c
Work on file usr/src/new/new/icon/cmp/operators/nonnull.c
Work on file usr/src/new/new/icon/int/operators/nonnull.c
Work on file usr/src/new/new/icon/cmp/operators/null.c
Work on file usr/src/new/new/icon/int/operators/number.c
Work on file usr/src/new/new/icon/cmp/operators/number.c
Work on file usr/src/new/new/icon/int/operators/numge.c
Work on file usr/src/new/new/icon/cmp/operators/numeq.c
Work on file usr/src/new/new/icon/cmp/operators/numge.c
Work on file usr/src/new/new/icon/int/operators/numeq.c
Work on file usr/src/new/new/icon/cmp/operators/numlt.c
Work on file usr/src/new/new/icon/cmp/operators/numle.c
Work on file usr/src/new/new/icon/int/operators/numlt.c
Work on file usr/src/new/new/icon/int/operators/numle.c
Work on file usr/src/new/new/icon/cmp/operators/plus.c
Work on file usr/src/new/new/icon/int/operators/plus.c
Work on file usr/src/new/new/icon/int/operators/power.c
Work on file usr/src/new/new/icon/int/operators/numne.c
Work on file usr/src/new/new/icon/cmp/operators/power.c
Work on file usr/src/new/new/icon/cmp/operators/numne.c
Work on file usr/src/new/new/icon/cmp/operators/random.c
Work on file usr/src/new/new/icon/int/operators/random.c
Work on file usr/src/new/new/icon/int/operators/rasgn.c
Work on file usr/src/new/new/icon/cmp/operators/rasgn.c
Work on file usr/src/new/new/icon/cmp/operators/rswap.c
Work on file usr/src/new/new/icon/int/operators/rswap.c
Work on file usr/src/new/new/icon/int/operators/sect.c
Work on file usr/src/new/new/icon/cmp/operators/sect.c
Work on file usr/src/new/new/icon/cmp/operators/subsc.c
Work on file usr/src/new/new/icon/int/operators/subsc.c
Work on file usr/src/new/new/icon/int/operators/size.c
Work on file usr/src/new/new/icon/cmp/operators/size.c
Work on file usr/src/new/new/icon/int/operators/swap.c
Work on file usr/src/new/new/icon/cmp/operators/swap.c
Work on file usr/src/new/new/icon/int/operators/tabmat.c
Work on file usr/src/new/new/icon/int/operators/toby.c
Work on file usr/src/new/new/icon/cmp/operators/toby.c
Work on file usr/src/new/new/icon/cmp/operators/tabmat.c
Work on file usr/src/new/new/icon/int/operators/unioncs.c
Work on file usr/src/new/new/icon/int/operators/value.c
Work on file usr/src/new/new/icon/cmp/operators/unioncs.c
Work on file usr/src/new/new/icon/cmp/operators/value.c
Work on file usr/src/new/new/icon/int/operators/refresh.c
Work on file usr/src/new/new/icon/cmp/operators/refresh.c

Synthesized-from: CSRG/cd1/4.2

85 files changed:
usr/src/new/new/icon/cmp/operators/asgn.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/bang.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/cat.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/compl.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/diff.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/div.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/eqv.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/inter.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lconcat.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexeq.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexge.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexgt.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexle.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexlt.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/lexne.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/minus.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/mod.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/mult.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/neg.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/neqv.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/nonnull.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/null.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/number.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/numeq.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/numge.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/numle.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/numlt.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/numne.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/plus.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/power.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/random.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/rasgn.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/refresh.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/rswap.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/sect.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/size.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/subsc.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/swap.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/tabmat.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/toby.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/unioncs.c [new file with mode: 0644]
usr/src/new/new/icon/cmp/operators/value.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/Makefile [new file with mode: 0644]
usr/src/new/new/icon/int/operators/asgn.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/bang.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/cat.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/compl.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/diff.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/div.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/eqv.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/inter.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lconcat.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexeq.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexge.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexgt.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexle.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexlt.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/lexne.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/minus.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/mod.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/mult.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/neg.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/neqv.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/nonnull.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/null.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/number.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/numeq.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/numge.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/numle.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/numlt.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/numne.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/plus.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/power.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/random.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/rasgn.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/refresh.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/rswap.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/sect.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/size.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/subsc.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/swap.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/tabmat.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/toby.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/unioncs.c [new file with mode: 0644]
usr/src/new/new/icon/int/operators/value.c [new file with mode: 0644]

diff --git a/usr/src/new/new/icon/cmp/operators/asgn.c b/usr/src/new/new/icon/cmp/operators/asgn.c
new file mode 100644 (file)
index 0000000..5bdadd5
--- /dev/null
@@ -0,0 +1,29 @@
+#include "../h/rt.h"
+
+/*
+ * x := y - assign y to x.
+ */
+
+asgn(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   arg0 = arg1;
+   deref(&arg2);
+   doasgn(&arg1, &arg2);
+   ClearBound;
+   }
+struct b_iproc Basgn = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(asgn),
+   2,
+   -1,
+   0,
+   0,
+   {2, ":="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/bang.c b/usr/src/new/new/icon/cmp/operators/bang.c
new file mode 100644 (file)
index 0000000..855feb9
--- /dev/null
@@ -0,0 +1,121 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * !x - generate successive values from object x.
+ * Generator.
+ */
+
+bang(nargs, arg1v, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg1, arg0;
+   {
+   register int i, j, slen;
+   register union block *bp, *ep;
+   register struct descrip *dp;
+   int ub, typ1;
+   char sbuf[MAXSTRING];
+   FILE *fd;
+   extern char *alcstr();
+
+   SetBound;
+   arg1v = arg1;
+
+   if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {
+      i = 1;
+      while (i <= STRLEN(arg1)) {
+         if (typ1 == 1) {
+            sneed(1);
+            STRLEN(arg0) = 1;
+            STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
+            suspend();
+            }
+         else {
+            hneed(sizeof(struct b_tvsubs));
+            mksubs(&arg1v, &arg1, i, 1, &arg0);
+            suspend();
+            arg1 = arg1v;
+            deref(&arg1);
+            if (!QUAL(arg1))
+               runerr(103, &arg1);
+            }
+         i++;
+         }
+      }
+   else {
+      deref(&arg1);
+      switch (TYPE(arg1)) {
+         case T_LIST:
+            bp = BLKLOC(arg1);
+            for (arg1 = bp->list.listhead; arg1.type == D_LISTB;
+                arg1 = BLKLOC(arg1)->listb.listnext) {
+               bp = BLKLOC(arg1);
+               for (i = 0; i < bp->listb.nused; i++) {
+                 j = bp->listb.first + i;
+                 if (j >= bp->listb.nelem)
+                    j -= bp->listb.nelem;
+                 dp = &bp->listb.lelem[j];
+                  arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                  BLKLOC(arg0) = dp;
+                  suspend();
+                  bp = BLKLOC(arg1);   /* bp is untended, must reset */
+                  }
+               }
+            break;
+
+         case T_FILE:
+            fd = BLKLOC(arg1)->file.fd;
+            if ((BLKLOC(arg1)->file.status & FS_READ) == 0)
+               runerr(212, &arg1);
+            while ((slen = getstr(sbuf,MAXSTRING,fd)) >= 0) {
+               sneed(slen);
+               STRLEN(arg0) = slen;
+               STRLOC(arg0) = alcstr(sbuf,slen);
+               suspend();
+               }
+            break;
+
+         case T_TABLE:
+            for (i = 0; i < NBUCKETS; i++) {
+               bp = BLKLOC(arg1);
+               for (arg1v = bp->table.buckets[i]; arg1v.type == D_TELEM;
+                   arg1v = BLKLOC(arg1v)->telem.blink) {
+                 ep = BLKLOC(arg1v);
+                  dp = &ep->telem.tval;
+                  arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                  BLKLOC(arg0) = dp;
+                  suspend();
+                  bp = BLKLOC(arg1);   /* bp is untended, must reset */
+                  }
+               }
+            break;
+
+        case T_RECORD:
+           bp = BLKLOC(arg1);
+           j = bp->record.recptr->nfields;
+           for (i = 0; i < j; i++) {
+              dp = &bp->record.fields[i];
+              arg0.type = D_VAR + ((int *)dp - (int *)bp);
+              BLKLOC(arg0) = dp;
+              suspend();
+               bp = BLKLOC(arg1);   /* bp is untended, must reset */
+              }
+           break;
+
+         default:
+            runerr(116, &arg1);
+         }
+      }
+
+   fail();
+   }
+struct b_iproc Bbang = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(bang),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "!"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/cat.c b/usr/src/new/new/icon/cmp/operators/cat.c
new file mode 100644 (file)
index 0000000..fcfb9de
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x || y - concatenate strings x and y.
+ */
+
+cat(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if (cvstr(&arg2, sbuf2) == NULL)
+      runerr(103, &arg2);
+
+   sneed(STRLEN(arg1)+STRLEN(arg2));
+   if (STRLOC(arg1) + STRLEN(arg1) == sfree)
+      STRLOC(arg0) = STRLOC(arg1);
+   else
+      STRLOC(arg0) = alcstr(STRLOC(arg1),STRLEN(arg1));
+   alcstr(STRLOC(arg2),STRLEN(arg2));
+
+   STRLEN(arg0) = STRLEN(arg1) + STRLEN(arg2);
+   ClearBound;
+   }
+struct b_iproc Bcat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(cat),
+   2,
+   -1,
+   0,
+   0,
+   {2, "||"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/compl.c b/usr/src/new/new/icon/cmp/operators/compl.c
new file mode 100644 (file)
index 0000000..628c9ef
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * ~x - complement cset x.
+ */
+
+compl(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs, csbuf[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs, csbuf) == NULL)
+      runerr(104, &arg1);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+       bp->cset.bits[i] = ~cs[i];
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bcompl = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(compl),
+   1,
+   -1,
+   0,
+   0,
+   {1, "~"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/diff.c b/usr/src/new/new/icon/cmp/operators/diff.c
new file mode 100644 (file)
index 0000000..9addbb8
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x -- y - difference of csets x and y.
+ */
+
+diff(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int i;
+   register union block *bp;
+   int *cs1, *cs2, csbuf1[CSETSIZE], csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+      bp->cset.bits[i] = cs1[i] & ~cs2[i];
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bdiff = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(diff),
+   2,
+   -1,
+   0,
+   0,
+   {2, "--"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/div.c b/usr/src/new/new/icon/cmp/operators/div.c
new file mode 100644 (file)
index 0000000..e4397dc
--- /dev/null
@@ -0,0 +1,43 @@
+#include "../h/rt.h"
+
+/*
+ * x / y - divide y into x.
+ */
+
+div(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT) {
+      if (n2.i == 0L)
+         runerr(201, &arg2);
+      mkint(n1.i / n2.i, &arg0);
+      }
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r / n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bdiv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(div),
+   2,
+   -1,
+   0,
+   0,
+   {1, "/"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/eqv.c b/usr/src/new/new/icon/cmp/operators/eqv.c
new file mode 100644 (file)
index 0000000..d51f329
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * x === y - test equivalence of x and y.
+ */
+
+eqv(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+
+   if (!equiv(&arg1, &arg2))
+      fail();
+   arg0 = arg2;
+   ClearBound;
+   }
+struct b_iproc Beqv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(eqv),
+   2,
+   -1,
+   0,
+   0,
+   {3, "==="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/inter.c b/usr/src/new/new/icon/cmp/operators/inter.c
new file mode 100644 (file)
index 0000000..016ce60
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * x ** y - intersection of csets x and y.
+ */
+
+inter(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs1, csbuf1[CSETSIZE], *cs2, csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+      bp->cset.bits[i] = cs1[i] & cs2[i];
+
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Binter = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(inter),
+   2,
+   -1,
+   0,
+   0,
+   {2, "**"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lconcat.c b/usr/src/new/new/icon/cmp/operators/lconcat.c
new file mode 100644 (file)
index 0000000..9bee0f9
--- /dev/null
@@ -0,0 +1,56 @@
+#include "../h/rt.h"
+
+/*
+ * x ||| y - concatenate lists x and y.
+ */
+
+lconcat(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register struct b_list *bp1, *bp2;
+   register struct b_listb *lp1, *lp2;
+   int size1, size2;
+
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+   if (TYPE(arg1) != T_LIST)
+      runerr(108, &arg1);
+   if (TYPE(arg2) != T_LIST)
+      runerr(108, &arg2);
+
+   size1 = BLKLOC(arg1)->list.cursize;
+   size2 = BLKLOC(arg2)->list.cursize;
+
+   cplist(&arg1, &arg1, 1, size1 + 1);
+   cplist(&arg2, &arg2, 1, size2 + 1);
+
+   bp1 = BLKLOC(arg1);
+   bp2 = BLKLOC(arg2);
+
+   lp1 = BLKLOC(bp1->listtail);
+   lp2 = BLKLOC(bp2->listhead);
+
+   lp1->listnext.type = D_LISTB;
+   BLKLOC(lp1->listnext) = lp2;
+
+   lp2->listprev.type = D_LISTB;
+   BLKLOC(lp2->listprev) = lp1;
+
+   bp1->cursize = size1 + size2;
+   BLKLOC(bp1->listtail) = BLKLOC(bp2->listtail);
+
+   arg0 = arg1;
+   ClearBound;
+   }
+struct b_iproc Blconcat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lconcat),
+   2,
+   -1,
+   0,
+   0,
+   {3, "|||"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexeq.c b/usr/src/new/new/icon/cmp/operators/lexeq.c
new file mode 100644 (file)
index 0000000..0335dba
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * x == y - test if x is lexically equal to y.
+ */
+
+lexeq(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) != 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexeq = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexeq),
+   2,
+   -1,
+   0,
+   0,
+   {2, "=="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexge.c b/usr/src/new/new/icon/cmp/operators/lexge.c
new file mode 100644 (file)
index 0000000..1657c30
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 >>= s2 - test if s1 is lexically greater than or equal to s2.
+ */
+
+lexge(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) < 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexge = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexge),
+   2,
+   -1,
+   0,
+   0,
+   {3, ">>="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexgt.c b/usr/src/new/new/icon/cmp/operators/lexgt.c
new file mode 100644 (file)
index 0000000..6e4a098
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 >> s2 - test if s1 is lexically greater than s2.
+ */
+
+lexgt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) <= 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexgt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexgt),
+   2,
+   -1,
+   0,
+   0,
+   {2, ">>"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexle.c b/usr/src/new/new/icon/cmp/operators/lexle.c
new file mode 100644 (file)
index 0000000..da7d7fc
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 <<= s2 - test if s1 is lexically less than or equal to s2.
+ */
+
+lexle(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) > 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexle = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexle),
+   2,
+   -1,
+   0,
+   0,
+   {3, "<<="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexlt.c b/usr/src/new/new/icon/cmp/operators/lexlt.c
new file mode 100644 (file)
index 0000000..c3bbfcb
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 << s2 - test if s1 is lexically less than s2.
+ */
+
+lexlt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) >= 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexlt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexlt),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<<"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/lexne.c b/usr/src/new/new/icon/cmp/operators/lexne.c
new file mode 100644 (file)
index 0000000..acfe332
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * x ~== y - test if x is lexically not equal to y.
+ */
+
+lexne(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) == 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexne = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexne),
+   2,
+   -1,
+   0,
+   0,
+   {3, "~=="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/minus.c b/usr/src/new/new/icon/cmp/operators/minus.c
new file mode 100644 (file)
index 0000000..09c1117
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * x - y - subtract y from x.
+ */
+
+minus(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern long cksub();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(cksub(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r - n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bminus = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(minus),
+   2,
+   -1,
+   0,
+   0,
+   {1, "-"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/mod.c b/usr/src/new/new/icon/cmp/operators/mod.c
new file mode 100644 (file)
index 0000000..d8c52c1
--- /dev/null
@@ -0,0 +1,43 @@
+#include "../h/rt.h"
+
+/*
+ * x % y - take remainder of x / y.
+ */
+
+mod(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT) {
+      if (n2.i == 0L)
+         runerr(202, &arg2);
+      mkint(n1.i % n2.i, &arg0);
+      }
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r - n2.r * (int)(n1.r / n2.r), &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bmod = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(mod),
+   2,
+   -1,
+   0,
+   0,
+   {1, "%"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/mult.c b/usr/src/new/new/icon/cmp/operators/mult.c
new file mode 100644 (file)
index 0000000..a6cfa54
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x * y - multiply x and y.
+ */
+
+mult(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(n1.i * n2.i, &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r * n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bmult = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(mult),
+   2,
+   -1,
+   0,
+   0,
+   {1, "*"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/neg.c b/usr/src/new/new/icon/cmp/operators/neg.c
new file mode 100644 (file)
index 0000000..7bf7502
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * -x - negate x.
+ */
+
+neg(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   union numeric n;
+   long l;
+
+   SetBound;
+   switch (cvnum(&arg1, &n)) {
+      case T_LONGINT:
+        l = -n.i;
+         if (n.i < 0 && l < 0)
+            runerr(203, &arg1);
+         mkint(l, &arg0);
+         break;
+
+      case T_REAL:
+        mkreal(-n.r, &arg0);
+        break;
+
+      default:
+        runerr(102, &arg1);
+      }
+   ClearBound;
+   }
+struct b_iproc Bneg = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(neg),
+   1,
+   -1,
+   0,
+   0,
+   {1, "-"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/neqv.c b/usr/src/new/new/icon/cmp/operators/neqv.c
new file mode 100644 (file)
index 0000000..85374e5
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * x ~=== y - object inequivalence operation.
+ */
+
+neqv(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+
+   if (equiv(&arg1, &arg2))
+      fail();
+   arg0 = arg2;
+   ClearBound;
+   }
+struct b_iproc Bneqv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(neqv),
+   2,
+   -1,
+   0,
+   0,
+   {4, "~==="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/nonnull.c b/usr/src/new/new/icon/cmp/operators/nonnull.c
new file mode 100644 (file)
index 0000000..34159f2
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * \x - test x for non-null value.
+ */
+
+nonnull(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int i, j;
+
+   SetBound;
+   arg0 = arg1;
+   deref(&arg1);
+
+   if (NULLDESC(arg1))
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnonnull = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(nonnull),
+   1,
+   -1,
+   0,
+   0,
+   {1, "\\"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/null.c b/usr/src/new/new/icon/cmp/operators/null.c
new file mode 100644 (file)
index 0000000..67915bd
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * /x - test x for null value.
+ */
+
+null(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int i, j;
+
+   SetBound;
+   arg0 = arg1;
+   deref(&arg1);
+
+   if (!NULLDESC(arg1))
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnull = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(null),
+   1,
+   -1,
+   0,
+   0,
+   {1, "/"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/number.c b/usr/src/new/new/icon/cmp/operators/number.c
new file mode 100644 (file)
index 0000000..32b3712
--- /dev/null
@@ -0,0 +1,38 @@
+#include "../h/rt.h"
+
+/*
+ * +x - convert x to numeric type.
+ */
+
+number(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   union numeric n;
+
+   SetBound;
+   switch (cvnum(&arg1, &n)) {
+      case T_LONGINT:
+        mkint(n.i, &arg0);
+        break;
+
+      case T_REAL:
+         mkreal(n.r, &arg0);
+        break;
+
+      default:
+         runerr(102, &arg1);
+      }
+   ClearBound;
+   }
+struct b_iproc Bnumber = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(number),
+   1,
+   -1,
+   0,
+   0,
+   {1, "+"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/numeq.c b/usr/src/new/new/icon/cmp/operators/numeq.c
new file mode 100644 (file)
index 0000000..fe48cdb
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x = y - test if x is numerically equal to y.
+ */
+
+numeq(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) != 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumeq = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numeq),
+   2,
+   -1,
+   0,
+   0,
+   {1, "="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/numge.c b/usr/src/new/new/icon/cmp/operators/numge.c
new file mode 100644 (file)
index 0000000..93ea480
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x >= y - test if x is numerically greater or equal to y.
+ */
+
+numge(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) < 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumge = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numge),
+   2,
+   -1,
+   0,
+   0,
+   {2, ">="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/numle.c b/usr/src/new/new/icon/cmp/operators/numle.c
new file mode 100644 (file)
index 0000000..82f281f
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x <= y - test if x is numerically less than or equal to y.
+ */
+
+numle(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) > 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumle = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numle),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/numlt.c b/usr/src/new/new/icon/cmp/operators/numlt.c
new file mode 100644 (file)
index 0000000..a40b400
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x < y - test if x is numerically less than y.
+ */
+
+numlt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) >= 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumlt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numlt),
+   2,
+   -1,
+   0,
+   0,
+   {1, "<"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/numne.c b/usr/src/new/new/icon/cmp/operators/numne.c
new file mode 100644 (file)
index 0000000..805d68f
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x ~= y - test if x is numerically not equal to y.
+ */
+
+numne(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) == 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumne = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numne),
+   2,
+   -1,
+   0,
+   0,
+   {2, "~="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/plus.c b/usr/src/new/new/icon/cmp/operators/plus.c
new file mode 100644 (file)
index 0000000..c04764b
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * x + y - add x and y.
+ */
+
+plus(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern long ckadd();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(ckadd(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r + n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bplus = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(plus),
+   2,
+   -1,
+   0,
+   0,
+   {1, "+"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/power.c b/usr/src/new/new/icon/cmp/operators/power.c
new file mode 100644 (file)
index 0000000..3fb6392
--- /dev/null
@@ -0,0 +1,65 @@
+#include "../h/rt.h"
+
+/*
+ * x ^ y - raise x to the y power.
+ */
+
+power(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern double pow();
+   extern long ipow();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(ipow(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      if (n1.r == 0.0 && n2.r <= 0.0)
+        runerr(204, NULL);
+      if (n1.r < 0.0 && t2 == T_REAL)
+         runerr(206, NULL);
+      mkreal(pow(n1.r,n2.r), &arg0);
+      }
+   ClearBound;
+   }
+
+long ipow(n1, n2)
+long n1, n2;
+   {
+   long result;
+
+   if (n1 == 0 && n2 <= 0)
+      runerr(204, NULL);
+   if (n2 < 0)
+      return (0.0);
+   result = 1L;
+   while (n2 > 0) {
+      if (n2 & 01L)
+        result *= n1;
+      n1 *= n1;
+      n2 >>= 1;
+      }
+   return (result);
+   }
+struct b_iproc Bpower = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(power),
+   2,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/random.c b/usr/src/new/new/icon/cmp/operators/random.c
new file mode 100644 (file)
index 0000000..384d418
--- /dev/null
@@ -0,0 +1,139 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+#define randval (RSCALE*(k_random=(RANDA*k_random+RANDC)&MAXLONG))
+
+/*
+ * ?x - produce a randomly selected element of x.
+ */
+
+random(nargs, arg1v, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg1, arg0;
+   {
+   register int val, i, j;
+   register union block *bp;
+   long l1;
+   double r1;
+   char sbuf[MAXSTRING];
+   union block *ep;
+   struct descrip *dp;
+   extern char *alcstr();
+
+   SetBound;
+   arg1v = arg1;
+   deref(&arg1);
+
+   if (NULLDESC(arg1))
+      runerr(113, &arg1);
+
+   if (QUAL(arg1)) {                    /* random char in string */
+      if ((val = STRLEN(arg1)) <= 0)
+         fail();
+      hneed(sizeof(struct b_tvsubs));
+      mksubs(&arg1v, &arg1, (int)(randval*val)+1, 1, &arg0);
+      ClearBound;
+      return;
+      }
+
+   switch (TYPE(arg1)) {
+      case T_CSET:
+         cvstr(&arg1, sbuf);
+         if ((val = STRLEN(arg1)) <= 0)
+            fail();
+         sneed(1);
+         STRLEN(arg0) = 1;
+         STRLOC(arg0) = alcstr(STRLOC(arg1)+(int)(randval*val), 1);
+         ClearBound;
+         return;
+
+      case T_REAL:
+         r1 = BLKLOC(arg1)->realval;
+         if (r1 < 0 || r1 > MAXSHORT)
+            runerr(205, &arg1);
+         val = (int)r1;
+         goto getrand;
+
+      case T_INTEGER:
+         val = INTVAL(arg1);
+         if (val < 0)
+            runerr(205, &arg1);
+      getrand:
+         if (val == 0)          /* return real in range [0,1) */
+            mkreal(randval, &arg0);
+         else                   /* return integer in range [1,val] */
+            mkint((long)(randval*val) + 1, &arg0);
+         ClearBound;
+         return;
+
+#ifndef BIT32
+      case T_LONGINT:
+         runerr(205, &arg1);
+
+#endif
+      case T_LIST:
+         bp = BLKLOC(arg1);
+         val = bp->list.cursize;
+         if (val <= 0)
+           fail();
+         i = (int)(randval*val) + 1;
+        j = 1;
+        bp = BLKLOC(BLKLOC(arg1)->list.listhead);
+        while (i >= j + bp->listb.nused) {
+           j += bp->listb.nused;
+           if (TYPE(bp->listb.listnext) != T_LISTB)
+              syserr("list reference out of bounds in random");
+           bp = BLKLOC(bp->listb.listnext);
+           }
+        i += bp->listb.first - j;
+        if (i >= bp->listb.nelem)
+           i -= bp->listb.nelem;
+        dp = &bp->listb.lelem[i];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+        BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      case T_TABLE:
+          bp = BLKLOC(arg1);
+          val = bp->table.cursize;
+          if (val <= 0)
+            fail();
+          i = (int)(randval*val) + 1;
+          for (j = 0; j < NBUCKETS; j++) {
+             for (ep = BLKLOC(bp->table.buckets[j]); ep != NULL;
+                 ep = BLKLOC(ep->telem.blink)) {
+                if (--i <= 0) {
+                   dp = &ep->telem.tval;
+                   arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                   BLKLOC(arg0) = dp;
+                   ClearBound;
+                   return;
+                   }
+                }
+             }
+
+      case T_RECORD:
+         bp = BLKLOC(arg1);
+         val = bp->record.recptr->nfields;
+         if (val <= 0)
+           fail();
+        dp = &bp->record.fields[(int)(randval*val)];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+         BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      default:
+         runerr(113, &arg1);
+      }
+   }
+struct b_iproc Brandom = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(random),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "?"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/rasgn.c b/usr/src/new/new/icon/cmp/operators/rasgn.c
new file mode 100644 (file)
index 0000000..25aa5b7
--- /dev/null
@@ -0,0 +1,33 @@
+#include "../h/rt.h"
+
+/*
+ * x <- y - assign y to x.
+ * Reversible.
+ */
+
+rasgn(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   arg0 = arg1;
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);       /* do the assignment */
+   suspend();                  /* suspend */
+   doasgn(&arg0, &arg1);       /* reverse the assignment */
+   fail();
+   }
+struct b_iproc Brasgn = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(rasgn),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<-"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/refresh.c b/usr/src/new/new/icon/cmp/operators/refresh.c
new file mode 100644 (file)
index 0000000..b70193f
--- /dev/null
@@ -0,0 +1,211 @@
+#include "../h/rt.h"
+#ifdef VAX
+/*
+ * ^x - return an entry block for co-expression x from the refresh block.
+ * NOTE:  this code is highly dependent on stack frame layout.
+ */
+
+refresh(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int *ap, *sp, *tp;
+   struct descrip *dp, *dsp;
+   register struct b_estack *ep;
+   register struct b_eblock *hp;
+   int na, nl, *r5, *newap;
+   extern struct b_estack *alcestk();
+#ifdef INT
+   extern interp();
+#endif INT
+
+   SetBound;
+   deref(&arg1);
+   if (TYPE(arg1) != T_ESTACK)
+      runerr(118, &arg1);
+
+   esneed();                            /* check for room in stack space */
+   ep = alcestk();                      /* allocate expression stack */
+   ep->activator = nulldesc;
+   ep->nresults = 0;
+   ep->freshblk = BLKLOC(arg1)->estack.freshblk;
+
+   ep->sbase = sp = (int *)ep;         /* initialize new stack pointer */
+   hp = BLKLOC(ep->freshblk);
+   na = hp->numargs;                   /* get value of nargs */
+   nl = hp->numlocals;
+   ap = hp->elems;                     /* find arg0 of caller */
+
+   /* copy arguments into new stack and refresh block */
+   dsp = sp;
+   dp = ap;
+   *--dsp = *dp++;
+   while (na-- > 0) {
+      *--dsp = *dp++;
+      }
+   sp = dsp;
+   ap = dp;
+
+   /* set up original procedure frame in new stack */
+   *--sp = hp->numargs;                        /* copy nargs */
+   *--sp = (hp->numargs*2) + 1;                /*+ invent a nwords value ??-whm */
+   newap = sp;
+#ifdef INT
+   *--sp = interp;                     /* return pc */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* return pc */
+#endif CMP
+   *--sp = 0;                          /* saved r5 (frame pointer) */
+   *--sp = 0;                          /* saved ap */
+   *--sp = 0;                          /* psw/reg. mask */
+   *--sp = 0;                          /* condition handler */
+   r5 = sp;                            /*   (save its address) */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+
+   /* copy local variables into new stack */
+   dsp = sp;
+   dp = ap;
+   while (nl-- > 0) {
+      *--dsp = *dp++;
+      }
+   sp = dsp;
+   ap = dp;
+
+   /* set up dummy call to activate */
+   *--sp = nulldesc.type;              /* place for result */
+   *--sp = INTVAL(nulldesc);
+   *--sp = nulldesc.type;              /* place for activate coexpr */
+   *--sp = INTVAL(nulldesc);
+   /* these values are the initial register state for the coexpression */
+   *--sp = 1;                          /* nargs */
+   *--sp = 3;                          /* nwords */
+   tp = sp;                            /* save pointer to start of arg
+                                           list in this frame */
+#ifdef INT
+   *--sp = hp->ep;                     /* saved r9 (coexpr entry point) */
+   *--sp = interp;                     /* return pc (entry point) */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* saved r9 (coexpr entry point) */
+   *--sp = hp->ep;                     /* return pc (entry point) */
+#endif CMP
+   *--sp = r5;                         /* saved r5 */
+   *--sp = newap;                      /* saved ap */
+   *--sp = 0x02000000;                 /* psw/reg mask with bit set to
+                                           restore r9, the ipc */
+   *--sp = 0;
+   ep->boundary = sp;                  /*   (initial boundary) */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+   ep->sp = sp;                                /* initial stack pointer */
+   ep->ap = tp;
+   arg0.type = D_ESTACK;
+   BLKLOC(arg0) = ep;
+   ClearBound;
+   }
+struct b_iproc Brefresh = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(refresh),
+   1,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
+#endif VAX
+#ifdef PDP11
+/*
+ * ^x - return an entry block for co-expression x from the refresh block.
+ * NOTE:  this code is highly dependent on stack frame layout.
+ */
+
+refresh(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int *ap, *sp;
+   register struct b_estack *ep;
+   register struct b_eblock *hp;
+   int na, nl, *r5;
+   extern struct b_estack *alcestk();
+#ifdef INT
+   extern interp();
+#endif INT
+
+   deref(&arg1);
+   if (TYPE(arg1) != T_ESTACK)
+      runerr(118, &arg1);
+
+   esneed();                            /* check for room in stack space */
+   ep = alcestk();                      /* allocate expression stack */
+   ep->activator = nulldesc;
+   ep->nresults = 0;
+   ep->freshblk = BLKLOC(arg1)->estack.freshblk;
+
+   ep->sbase = sp = (int *)ep;         /* initialize new stack pointer */
+   hp = BLKLOC(ep->freshblk);
+   na = hp->numargs;                   /* get value of nargs */
+   nl = hp->numlocals;
+   ap = hp->elems;                     /* find arg0 of caller */
+
+   /* copy arguments into new stack and refresh block */
+   *--(struct descrip *)sp = *(struct descrip *)ap;   /* copy arg0 */
+   while (na-- > 0)
+      *--(struct descrip *)sp = *++(struct descrip *)ap;
+
+   /* set up original procedure frame in new stack */
+   *--sp = hp->numargs;                        /* copy nargs */
+   *--sp = 0;                          /* return pc */
+   *--sp = 0;                          /* saved r5 */
+   r5 = sp;                            /*   (save its address) */
+   *--sp = 0;                          /* saved r4 */
+   *--sp = 0;                          /* saved r3 */
+   *--sp = 0;                          /* saved r2 */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+
+   /* copy local variables into new stack */
+   while (nl-- > 0)
+      *--(struct descrip *)sp = *++(struct descrip *)ap;
+
+   /* set up dummy call to activate */
+   *--(struct descrip *)sp = nulldesc;  /* place for result */
+   *--(struct descrip *)sp = nulldesc;  /* place for activate coexpr */
+   /* these values are the initial register state for the coexpression */
+   *--sp = 1;                          /* nargs */
+#ifdef INT
+   *--sp = interp;                     /* return pc (entry point) */
+#endif INT
+#ifdef CMP
+   *--sp = hp->ep;                     /* return pc (entry point) */
+#endif CMP
+   *--sp = r5;                         /* saved r5 */
+   ep->boundary = sp;                  /*   (initial boundary) */
+   *--sp = 0;                          /* saved r4 */
+   *--sp = 0;                          /* saved r3 */
+#ifdef INT
+   *--sp = hp->ep;                     /* saved r2 */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* saved r2 */
+#endif CMP
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+   ep->sp = sp;                                /* initial stack pointer */
+   arg0.type = D_ESTACK;
+   BLKLOC(arg0) = ep;
+   }
+struct b_iproc Brefresh = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(refresh),
+   1,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
+#endif PDP11
diff --git a/usr/src/new/new/icon/cmp/operators/rswap.c b/usr/src/new/new/icon/cmp/operators/rswap.c
new file mode 100644 (file)
index 0000000..8f90eb0
--- /dev/null
@@ -0,0 +1,59 @@
+#include "../h/rt.h"
+
+/*
+ * x <-> y - swap values of x and y.
+ * Reversible.
+ */
+
+rswap(nargs, arg2v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2v, arg2, arg1, arg0;
+   {
+   register union block *bp1, *bp2;
+   int adj1, adj2;
+
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   if (QUAL(arg2) || !VAR(arg2))
+      runerr(111, &arg2);
+   arg0 = arg1;
+   arg2v = arg2;
+   adj1 = adj2 = 0;
+   if (arg1.type == D_TVSUBS && arg2.type == D_TVSUBS) {
+      bp1 = BLKLOC(arg1);
+      bp2 = BLKLOC(arg2);
+      if (VARLOC(bp1->tvsubs.ssvar) == VARLOC(bp2->tvsubs.ssvar)) {
+         if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
+            adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
+         else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
+            adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
+        }
+      }
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);               /* lhs := rhs */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg1);              /* rhs := lhs */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   suspend();                          /* suspend */
+   doasgn(&arg0, &arg1);               /* reverse first assignment */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg2);              /* reverse second assignment */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   fail();
+   }
+struct b_iproc Brswap = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(rswap),
+   3,
+   -1,
+   -2,
+   0,
+   {3, "<->"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/sect.c b/usr/src/new/new/icon/cmp/operators/sect.c
new file mode 100644 (file)
index 0000000..18020c1
--- /dev/null
@@ -0,0 +1,72 @@
+#include "../h/rt.h"
+
+/*
+ * x[i:j] - form a substring or list section of x.
+ */
+
+sect(nargs, arg1v, arg3, arg2, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg3, arg2, arg1, arg0;
+   {
+   register int i, j;
+   int t, typ1;
+   char sbuf[MAXSTRING];
+   long l1, l2;
+   extern char *alcstr();
+
+   SetBound;
+   hneed(sizeof(struct b_tvsubs));              /* check heap */
+
+   if (cvint(&arg2, &l1) == NULL)
+      runerr(101, &arg2);
+   if (cvint(&arg3, &l2) == NULL)
+      runerr(101, &arg3);
+
+   arg1v = arg1;
+   deref(&arg1);
+
+   if (!QUAL(arg1) && TYPE(arg1) == T_LIST) {
+      i = cvpos(l1, BLKLOC(arg1)->list.cursize);
+      j = cvpos(l2, BLKLOC(arg1)->list.cursize);
+      if (i > j) {
+         t = i;
+         i = j;
+         j = t;
+         }
+      cplist(&arg1, &arg0, i, j);
+      ClearBound;
+      return;
+      }
+
+   if ((typ1 = cvstr(&arg1, sbuf)) == NULL)
+      runerr(110, &arg1);
+
+   i = cvpos(l1, STRLEN(arg1));
+   j = cvpos(l2, STRLEN(arg1));
+   if (i > j) {                                /* convert section to substring */
+      t = i;
+      i = j;
+      j = t - j;
+      }
+   else
+      j = j - i;
+
+   if (typ1 == 1) {                    /* if string was created, */
+      sneed(j);                                /*   just return a string */
+      STRLEN(arg0) = j;
+      STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, j);
+      }
+   else                                        /* else make a substring tv */
+      mksubs(&arg1v, &arg1, i, j, &arg0);
+   ClearBound;
+   }
+struct b_iproc Bsect = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(sect),
+   4,
+   -1,
+   -3,
+   0,
+   {1, ":"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/size.c b/usr/src/new/new/icon/cmp/operators/size.c
new file mode 100644 (file)
index 0000000..d7ea6e8
--- /dev/null
@@ -0,0 +1,60 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * *x - return size of string or object x.
+ */
+
+size(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   char sbuf[MAXSTRING];
+
+   SetBound;
+   deref(&arg1);
+   if (NULLDESC(arg1))
+      runerr(112, &arg1);
+   if (cvstr(&arg1, sbuf) != NULL) {
+      arg0.type = D_INTEGER;
+      INTVAL(arg0) = STRLEN(arg1);
+      }
+   else {
+      switch (TYPE(arg1)) {
+         case T_LIST:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->list.cursize;
+           break;
+
+         case T_TABLE:
+            arg0.type = D_INTEGER;
+            BLKLOC(arg0) = BLKLOC(arg1)->table.cursize;
+            break;
+
+         case T_RECORD:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->record.recptr->proc.nfields;
+           break;
+
+         case T_ESTACK:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->estack.nresults;
+           break;
+
+         default:
+            runerr(112, &arg1);
+         }
+      }
+   ClearBound;
+   }
+struct b_iproc Bsize = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(size),
+   1,
+   -1,
+   0,
+   0,
+   {1, "*"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/subsc.c b/usr/src/new/new/icon/cmp/operators/subsc.c
new file mode 100644 (file)
index 0000000..e05b16c
--- /dev/null
@@ -0,0 +1,114 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * x[y] - access y'th character or element of x.
+ */
+
+subsc(nargs, arg1v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg2, arg1, arg0;
+   {
+   register int i, j;
+   register union block *bp;
+   int typ1;
+   long l1;
+   struct descrip *dp;
+   char sbuf[MAXSTRING];
+   extern char *alcstr();
+   extern struct b_tvtbl *alctvtbl();
+
+   SetBound;
+   arg1v = arg1;
+
+   if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {   /* subscripting a string */
+      if (cvint(&arg2, &l1) == NULL)
+         runerr(101, &arg2);
+      i = cvpos(l1, STRLEN(arg1));
+      if (i > STRLEN(arg1))             /* fail if off string */
+         fail();
+      if (typ1 == 1) {                 /* if string was created, */
+         sneed(1);                     /*   just return a string */
+         STRLEN(arg0) = 1;
+         STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
+         }
+      else {                           /* else make a substring tv */
+         hneed(sizeof(struct b_tvsubs));
+         mksubs(&arg1v, &arg1, i, 1, &arg0);
+        }
+      ClearBound;
+      return;
+      }
+
+   deref(&arg1);
+   switch (TYPE(arg1)) {                /* subscripting an aggregate */
+      case T_LIST:
+         if (cvint(&arg2, &l1) == NULL)
+            runerr(101, &arg2);
+        i = cvpos(l1, BLKLOC(arg1)->list.cursize);
+         if (i > BLKLOC(arg1)->list.cursize)    /* insure legal subscript */
+            fail();
+        bp = BLKLOC(BLKLOC(arg1)->list.listhead);      
+        j = 1;
+        while (i >= j + bp->listb.nused) {
+           j += bp->listb.nused;
+            if (TYPE(bp->listb.listnext) != T_LISTB)
+              syserr("list reference out of bounds in subsc");
+           bp = BLKLOC(bp->listb.listnext);
+           }
+         i += bp->listb.first - j;
+         if (i >= bp->listb.nelem)
+            i -= bp->listb.nelem;
+         dp = &bp->listb.lelem[i];
+         arg0.type = D_VAR + ((int *)dp - (int *)bp);
+        BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      case T_TABLE:
+         deref(&arg2);
+        hneed(sizeof(struct b_tvtbl));
+        bp = BLKLOC(BLKLOC(arg1)->table.buckets[hash(&arg2)]);
+        while (bp != NULL) {
+           if (equiv(&bp->telem.tref, &arg2)) {
+              dp = &bp->telem.tval;
+              arg0.type = D_VAR + ((int *)dp - (int *)bp);
+              BLKLOC(arg0) = dp;
+               ClearBound;
+              return;
+              }
+           bp = BLKLOC(bp->telem.blink);
+           }
+        arg0.type = D_TVTBL;
+         BLKLOC(arg0) = alctvtbl(&arg1, &arg2);
+         ClearBound;
+        return;
+
+      case T_RECORD:
+         if (cvint(&arg2, &l1) == NULL)
+            runerr(101, &arg2);
+        bp = BLKLOC(arg1);
+        i = cvpos(l1, bp->record.recptr->nfields);
+        if (i > bp->record.recptr->nfields)
+           fail();
+        dp = &bp->record.fields[i-1];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+         BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      default:
+        runerr(114, &arg1);
+      }        
+   ClearBound;
+   }
+struct b_iproc Bsubsc = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(subsc),
+   3,
+   -1,
+   -2,
+   0,
+   {2, "[]"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/swap.c b/usr/src/new/new/icon/cmp/operators/swap.c
new file mode 100644 (file)
index 0000000..6ee26e5
--- /dev/null
@@ -0,0 +1,51 @@
+#include "../h/rt.h"
+
+/*
+ * x :=: y - swap values of x and y.
+ */
+
+swap(nargs, arg2v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2v, arg2, arg1, arg0;
+   {
+   register union block *bp1, *bp2;
+   int adj1, adj2;
+
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   if (QUAL(arg2) || !VAR(arg2))
+      runerr(111, &arg2);
+   arg0 = arg1;
+   arg2v = arg2;
+   adj1 = adj2 = 0;
+   if (arg1.type == D_TVSUBS && arg2.type == D_TVSUBS) {
+      bp1 = BLKLOC(arg1);
+      bp2 = BLKLOC(arg2);
+      if (VARLOC(bp1->tvsubs.ssvar) == VARLOC(bp2->tvsubs.ssvar)) {
+         if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
+            adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
+         else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
+            adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
+        }
+      }
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);          /* lhs := rhs */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg1);         /* rhs := lhs */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   ClearBound;
+   }
+struct b_iproc Bswap = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(swap),
+   3,
+   -1,
+   -2,
+   0,
+   {3, ":=:"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/tabmat.c b/usr/src/new/new/icon/cmp/operators/tabmat.c
new file mode 100644 (file)
index 0000000..019d19d
--- /dev/null
@@ -0,0 +1,55 @@
+#include "../h/rt.h"
+
+/*
+ * =x - tab(match(x)).
+ * Reversible.
+ */
+
+tabmat(nargs, oldsubj, arg1, arg0)
+int nargs;
+struct descrip oldsubj, arg1, arg0;
+   {
+   DclSave
+   register int l;
+   register char *s1, *s2;
+   int i, j;
+   char sbuf[MAXSTRING];
+
+   SetBound;
+   if (cvstr(&arg1,sbuf) == NULL)
+      runerr(103, &arg1);
+
+   oldsubj = k_subject;
+   i = k_pos;
+   j = STRLEN(k_subject) - i + 1;
+
+   if (j < STRLEN(arg1))
+      fail();
+
+   s1 = STRLOC(arg1);
+   s2 = STRLOC(k_subject) + i - 1;
+   l = STRLEN(arg1);
+   while (l-- > 0) {
+      if (*s1++ != *s2++)
+        fail();
+      }
+
+   l = STRLEN(arg1);
+   k_pos += l;
+   arg0 = arg1;
+   suspend();
+
+   k_subject = oldsubj;
+   k_pos = i;
+   fail();
+   }
+struct b_iproc Btabmat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(tabmat),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "="}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/toby.c b/usr/src/new/new/icon/cmp/operators/toby.c
new file mode 100644 (file)
index 0000000..51cb33d
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * e1 to e2 by e3 - generate successive values.
+ * Generator.
+ */
+
+toby(nargs, arg3, arg2, arg1, arg0)
+int nargs;
+struct descrip arg3, arg2, arg1, arg0;
+   {
+   DclSave
+   long from, to, by;
+
+   SetBound;
+   if (cvint(&arg1, &from) == NULL)
+      runerr(101, &arg1);
+   if (cvint(&arg2, &to) == NULL)
+      runerr(101, &arg2);
+   if (cvint(&arg3, &by) == NULL)
+      runerr(101, &arg3);
+   if (by == 0)
+      runerr(211, &arg3);
+
+   while ((from <= to && by > 0) || (from >= to && by < 0)) {
+      mkint(from, &arg0);
+      suspend();
+      from += by;
+      }
+   fail();
+   }
+struct b_iproc Btoby = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(toby),
+   3,
+   -1,
+   0,
+   0,
+   {4, "toby"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/unioncs.c b/usr/src/new/new/icon/cmp/operators/unioncs.c
new file mode 100644 (file)
index 0000000..8fbfac6
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * x ++ y - union of csets x and y.
+ */
+
+unioncs(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs1, *cs2, csbuf1[CSETSIZE], csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+       bp->cset.bits[i] = cs1[i] | cs2[i];
+
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bunioncs = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(unioncs),
+   2,
+   -1,
+   0,
+   0,
+   {2, "++"}
+   };
diff --git a/usr/src/new/new/icon/cmp/operators/value.c b/usr/src/new/new/icon/cmp/operators/value.c
new file mode 100644 (file)
index 0000000..18288b8
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * .x - dereference x.
+ */
+
+value(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   arg0 = arg1;
+   deref(&arg0);
+   ClearBound;
+   }
+struct b_iproc Bvalue = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(value),
+   1,
+   -1,
+   0,
+   0,
+   {1, "."}
+   };
diff --git a/usr/src/new/new/icon/int/operators/Makefile b/usr/src/new/new/icon/int/operators/Makefile
new file mode 100644 (file)
index 0000000..973dacd
--- /dev/null
@@ -0,0 +1,75 @@
+CFLAGS = -O -w
+
+Lib:           asgn.o bang.o cat.o compl.o diff.o div.o eqv.o inter.o \
+               lconcat.o lexeq.o lexge.o lexgt.o lexle.o lexlt.o lexne.o \
+               minus.o mod.o mult.o neg.o neqv.o nonnull.o null.o number.o \
+               numeq.o numge.o numgt.o numle.o numlt.o numne.o \
+               plus.o power.o random.o rasgn.o refresh.o rswap.o sect.o \
+               size.o subsc.o swap.o tabmat.o toby.o unioncs.o value.o
+       ar r Lib $?
+       ranlib Lib
+
+asgn.o:                ../h/rt.h
+bang.o:                ../h/rt.h ../h/record.h
+cat.o:         ../h/rt.h
+compl.o:       ../h/rt.h
+diff.o:                ../h/rt.h
+div.o:         ../h/rt.h
+eqv.o:         ../h/rt.h
+inter.o:       ../h/rt.h
+lconcat.o:     ../h/rt.h
+lexeq.o:       ../h/rt.h
+lexge.o:       ../h/rt.h
+lexgt.o:       ../h/rt.h
+lexle.o:       ../h/rt.h
+lexlt.o:       ../h/rt.h
+lexne.o:       ../h/rt.h
+minus.o:       ../h/rt.h
+mod.o:         ../h/rt.h
+mult.o:                ../h/rt.h
+neg.o:         ../h/rt.h
+neqv.o:                ../h/rt.h
+nonnull.o:     ../h/rt.h
+null.o:                ../h/rt.h
+number.o:      ../h/rt.h
+numeq.o:       ../h/rt.h
+numge.o:       ../h/rt.h
+numgt.o:       ../h/rt.h
+numle.o:       ../h/rt.h
+numlt.o:       ../h/rt.h
+numne.o:       ../h/rt.h
+plus.o:                ../h/rt.h
+power.o:       ../h/rt.h
+random.o:      ../h/rt.h ../h/record.h
+rasgn.o:       ../h/rt.h
+refresh.o:     ../h/rt.h
+rswap.o:       ../h/rt.h
+sect.o:                ../h/rt.h
+size.o:                ../h/rt.h ../h/record.h
+subsc.o:       ../h/rt.h ../h/record.h
+swap.o:                ../h/rt.h
+tabmat.o:      ../h/rt.h
+toby.o:                ../h/rt.h
+unioncs.o:     ../h/rt.h
+value.o:       ../h/rt.h
+
+Listall:
+       @pr *.[cs]
+       @date >List
+
+List:          asgn.c bang.c cat.c compl.c diff.c div.c eqv.c inter.c \
+               lconcat.c lexeq.c lexge.c lexgt.c lexle.c lexlt.c lexne.c \
+               minus.c mod.c mult.c neg.c neqv.c nonnull.c null.c number.c \
+               numeq.c numge.c numgt.c numle.c numlt.c numne.c \
+               plus.c power.c random.c rasgn.c refresh.c rswap.c sect.c \
+               size.c subsc.c swap.c tabmat.c toby.c unioncs.c value.c
+       @pr $?
+       @date >List
+
+.s.o:
+       as -o $@ ../h/defs.s $<
+clean:
+       rm -f Lib *.o
+
+dist-clean: clean
+       rm -f `gcomp Makefile *.c`
diff --git a/usr/src/new/new/icon/int/operators/asgn.c b/usr/src/new/new/icon/int/operators/asgn.c
new file mode 100644 (file)
index 0000000..5bdadd5
--- /dev/null
@@ -0,0 +1,29 @@
+#include "../h/rt.h"
+
+/*
+ * x := y - assign y to x.
+ */
+
+asgn(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   arg0 = arg1;
+   deref(&arg2);
+   doasgn(&arg1, &arg2);
+   ClearBound;
+   }
+struct b_iproc Basgn = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(asgn),
+   2,
+   -1,
+   0,
+   0,
+   {2, ":="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/bang.c b/usr/src/new/new/icon/int/operators/bang.c
new file mode 100644 (file)
index 0000000..855feb9
--- /dev/null
@@ -0,0 +1,121 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * !x - generate successive values from object x.
+ * Generator.
+ */
+
+bang(nargs, arg1v, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg1, arg0;
+   {
+   register int i, j, slen;
+   register union block *bp, *ep;
+   register struct descrip *dp;
+   int ub, typ1;
+   char sbuf[MAXSTRING];
+   FILE *fd;
+   extern char *alcstr();
+
+   SetBound;
+   arg1v = arg1;
+
+   if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {
+      i = 1;
+      while (i <= STRLEN(arg1)) {
+         if (typ1 == 1) {
+            sneed(1);
+            STRLEN(arg0) = 1;
+            STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
+            suspend();
+            }
+         else {
+            hneed(sizeof(struct b_tvsubs));
+            mksubs(&arg1v, &arg1, i, 1, &arg0);
+            suspend();
+            arg1 = arg1v;
+            deref(&arg1);
+            if (!QUAL(arg1))
+               runerr(103, &arg1);
+            }
+         i++;
+         }
+      }
+   else {
+      deref(&arg1);
+      switch (TYPE(arg1)) {
+         case T_LIST:
+            bp = BLKLOC(arg1);
+            for (arg1 = bp->list.listhead; arg1.type == D_LISTB;
+                arg1 = BLKLOC(arg1)->listb.listnext) {
+               bp = BLKLOC(arg1);
+               for (i = 0; i < bp->listb.nused; i++) {
+                 j = bp->listb.first + i;
+                 if (j >= bp->listb.nelem)
+                    j -= bp->listb.nelem;
+                 dp = &bp->listb.lelem[j];
+                  arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                  BLKLOC(arg0) = dp;
+                  suspend();
+                  bp = BLKLOC(arg1);   /* bp is untended, must reset */
+                  }
+               }
+            break;
+
+         case T_FILE:
+            fd = BLKLOC(arg1)->file.fd;
+            if ((BLKLOC(arg1)->file.status & FS_READ) == 0)
+               runerr(212, &arg1);
+            while ((slen = getstr(sbuf,MAXSTRING,fd)) >= 0) {
+               sneed(slen);
+               STRLEN(arg0) = slen;
+               STRLOC(arg0) = alcstr(sbuf,slen);
+               suspend();
+               }
+            break;
+
+         case T_TABLE:
+            for (i = 0; i < NBUCKETS; i++) {
+               bp = BLKLOC(arg1);
+               for (arg1v = bp->table.buckets[i]; arg1v.type == D_TELEM;
+                   arg1v = BLKLOC(arg1v)->telem.blink) {
+                 ep = BLKLOC(arg1v);
+                  dp = &ep->telem.tval;
+                  arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                  BLKLOC(arg0) = dp;
+                  suspend();
+                  bp = BLKLOC(arg1);   /* bp is untended, must reset */
+                  }
+               }
+            break;
+
+        case T_RECORD:
+           bp = BLKLOC(arg1);
+           j = bp->record.recptr->nfields;
+           for (i = 0; i < j; i++) {
+              dp = &bp->record.fields[i];
+              arg0.type = D_VAR + ((int *)dp - (int *)bp);
+              BLKLOC(arg0) = dp;
+              suspend();
+               bp = BLKLOC(arg1);   /* bp is untended, must reset */
+              }
+           break;
+
+         default:
+            runerr(116, &arg1);
+         }
+      }
+
+   fail();
+   }
+struct b_iproc Bbang = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(bang),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "!"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/cat.c b/usr/src/new/new/icon/int/operators/cat.c
new file mode 100644 (file)
index 0000000..fcfb9de
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x || y - concatenate strings x and y.
+ */
+
+cat(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if (cvstr(&arg2, sbuf2) == NULL)
+      runerr(103, &arg2);
+
+   sneed(STRLEN(arg1)+STRLEN(arg2));
+   if (STRLOC(arg1) + STRLEN(arg1) == sfree)
+      STRLOC(arg0) = STRLOC(arg1);
+   else
+      STRLOC(arg0) = alcstr(STRLOC(arg1),STRLEN(arg1));
+   alcstr(STRLOC(arg2),STRLEN(arg2));
+
+   STRLEN(arg0) = STRLEN(arg1) + STRLEN(arg2);
+   ClearBound;
+   }
+struct b_iproc Bcat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(cat),
+   2,
+   -1,
+   0,
+   0,
+   {2, "||"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/compl.c b/usr/src/new/new/icon/int/operators/compl.c
new file mode 100644 (file)
index 0000000..628c9ef
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * ~x - complement cset x.
+ */
+
+compl(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs, csbuf[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs, csbuf) == NULL)
+      runerr(104, &arg1);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+       bp->cset.bits[i] = ~cs[i];
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bcompl = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(compl),
+   1,
+   -1,
+   0,
+   0,
+   {1, "~"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/diff.c b/usr/src/new/new/icon/int/operators/diff.c
new file mode 100644 (file)
index 0000000..9addbb8
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x -- y - difference of csets x and y.
+ */
+
+diff(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int i;
+   register union block *bp;
+   int *cs1, *cs2, csbuf1[CSETSIZE], csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+      bp->cset.bits[i] = cs1[i] & ~cs2[i];
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bdiff = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(diff),
+   2,
+   -1,
+   0,
+   0,
+   {2, "--"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/div.c b/usr/src/new/new/icon/int/operators/div.c
new file mode 100644 (file)
index 0000000..e4397dc
--- /dev/null
@@ -0,0 +1,43 @@
+#include "../h/rt.h"
+
+/*
+ * x / y - divide y into x.
+ */
+
+div(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT) {
+      if (n2.i == 0L)
+         runerr(201, &arg2);
+      mkint(n1.i / n2.i, &arg0);
+      }
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r / n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bdiv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(div),
+   2,
+   -1,
+   0,
+   0,
+   {1, "/"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/eqv.c b/usr/src/new/new/icon/int/operators/eqv.c
new file mode 100644 (file)
index 0000000..d51f329
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * x === y - test equivalence of x and y.
+ */
+
+eqv(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+
+   if (!equiv(&arg1, &arg2))
+      fail();
+   arg0 = arg2;
+   ClearBound;
+   }
+struct b_iproc Beqv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(eqv),
+   2,
+   -1,
+   0,
+   0,
+   {3, "==="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/inter.c b/usr/src/new/new/icon/int/operators/inter.c
new file mode 100644 (file)
index 0000000..016ce60
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * x ** y - intersection of csets x and y.
+ */
+
+inter(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs1, csbuf1[CSETSIZE], *cs2, csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+      bp->cset.bits[i] = cs1[i] & cs2[i];
+
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Binter = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(inter),
+   2,
+   -1,
+   0,
+   0,
+   {2, "**"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lconcat.c b/usr/src/new/new/icon/int/operators/lconcat.c
new file mode 100644 (file)
index 0000000..9bee0f9
--- /dev/null
@@ -0,0 +1,56 @@
+#include "../h/rt.h"
+
+/*
+ * x ||| y - concatenate lists x and y.
+ */
+
+lconcat(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register struct b_list *bp1, *bp2;
+   register struct b_listb *lp1, *lp2;
+   int size1, size2;
+
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+   if (TYPE(arg1) != T_LIST)
+      runerr(108, &arg1);
+   if (TYPE(arg2) != T_LIST)
+      runerr(108, &arg2);
+
+   size1 = BLKLOC(arg1)->list.cursize;
+   size2 = BLKLOC(arg2)->list.cursize;
+
+   cplist(&arg1, &arg1, 1, size1 + 1);
+   cplist(&arg2, &arg2, 1, size2 + 1);
+
+   bp1 = BLKLOC(arg1);
+   bp2 = BLKLOC(arg2);
+
+   lp1 = BLKLOC(bp1->listtail);
+   lp2 = BLKLOC(bp2->listhead);
+
+   lp1->listnext.type = D_LISTB;
+   BLKLOC(lp1->listnext) = lp2;
+
+   lp2->listprev.type = D_LISTB;
+   BLKLOC(lp2->listprev) = lp1;
+
+   bp1->cursize = size1 + size2;
+   BLKLOC(bp1->listtail) = BLKLOC(bp2->listtail);
+
+   arg0 = arg1;
+   ClearBound;
+   }
+struct b_iproc Blconcat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lconcat),
+   2,
+   -1,
+   0,
+   0,
+   {3, "|||"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexeq.c b/usr/src/new/new/icon/int/operators/lexeq.c
new file mode 100644 (file)
index 0000000..0335dba
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * x == y - test if x is lexically equal to y.
+ */
+
+lexeq(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) != 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexeq = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexeq),
+   2,
+   -1,
+   0,
+   0,
+   {2, "=="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexge.c b/usr/src/new/new/icon/int/operators/lexge.c
new file mode 100644 (file)
index 0000000..1657c30
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 >>= s2 - test if s1 is lexically greater than or equal to s2.
+ */
+
+lexge(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) < 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexge = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexge),
+   2,
+   -1,
+   0,
+   0,
+   {3, ">>="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexgt.c b/usr/src/new/new/icon/int/operators/lexgt.c
new file mode 100644 (file)
index 0000000..6e4a098
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 >> s2 - test if s1 is lexically greater than s2.
+ */
+
+lexgt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) <= 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexgt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexgt),
+   2,
+   -1,
+   0,
+   0,
+   {2, ">>"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexle.c b/usr/src/new/new/icon/int/operators/lexle.c
new file mode 100644 (file)
index 0000000..da7d7fc
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 <<= s2 - test if s1 is lexically less than or equal to s2.
+ */
+
+lexle(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) > 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexle = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexle),
+   2,
+   -1,
+   0,
+   0,
+   {3, "<<="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexlt.c b/usr/src/new/new/icon/int/operators/lexlt.c
new file mode 100644 (file)
index 0000000..c3bbfcb
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * s1 << s2 - test if s1 is lexically less than s2.
+ */
+
+lexlt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) >= 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexlt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexlt),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<<"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/lexne.c b/usr/src/new/new/icon/int/operators/lexne.c
new file mode 100644 (file)
index 0000000..acfe332
--- /dev/null
@@ -0,0 +1,39 @@
+#include "../h/rt.h"
+
+/*
+ * x ~== y - test if x is lexically not equal to y.
+ */
+
+lexne(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int t;
+   char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
+   extern char *alcstr();
+
+   SetBound;
+   if (cvstr(&arg1, sbuf1) == NULL)
+      runerr(103, &arg1);
+   if ((t = cvstr(&arg2, sbuf2)) == NULL)
+      runerr(103, &arg2);
+
+   if (lexcmp(&arg1, &arg2) == 0)
+      fail();
+
+   arg0 = arg2;
+   if (t == 1)         /* string needs to be allocated */
+      STRLOC(arg0) = alcstr(STRLOC(arg0), STRLEN(arg0));
+   ClearBound;
+   }
+struct b_iproc Blexne = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(lexne),
+   2,
+   -1,
+   0,
+   0,
+   {3, "~=="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/minus.c b/usr/src/new/new/icon/int/operators/minus.c
new file mode 100644 (file)
index 0000000..09c1117
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * x - y - subtract y from x.
+ */
+
+minus(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern long cksub();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(cksub(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r - n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bminus = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(minus),
+   2,
+   -1,
+   0,
+   0,
+   {1, "-"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/mod.c b/usr/src/new/new/icon/int/operators/mod.c
new file mode 100644 (file)
index 0000000..d8c52c1
--- /dev/null
@@ -0,0 +1,43 @@
+#include "../h/rt.h"
+
+/*
+ * x % y - take remainder of x / y.
+ */
+
+mod(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT) {
+      if (n2.i == 0L)
+         runerr(202, &arg2);
+      mkint(n1.i % n2.i, &arg0);
+      }
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r - n2.r * (int)(n1.r / n2.r), &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bmod = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(mod),
+   2,
+   -1,
+   0,
+   0,
+   {1, "%"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/mult.c b/usr/src/new/new/icon/int/operators/mult.c
new file mode 100644 (file)
index 0000000..a6cfa54
--- /dev/null
@@ -0,0 +1,40 @@
+#include "../h/rt.h"
+
+/*
+ * x * y - multiply x and y.
+ */
+
+mult(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(n1.i * n2.i, &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r * n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bmult = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(mult),
+   2,
+   -1,
+   0,
+   0,
+   {1, "*"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/neg.c b/usr/src/new/new/icon/int/operators/neg.c
new file mode 100644 (file)
index 0000000..7bf7502
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * -x - negate x.
+ */
+
+neg(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   union numeric n;
+   long l;
+
+   SetBound;
+   switch (cvnum(&arg1, &n)) {
+      case T_LONGINT:
+        l = -n.i;
+         if (n.i < 0 && l < 0)
+            runerr(203, &arg1);
+         mkint(l, &arg0);
+         break;
+
+      case T_REAL:
+        mkreal(-n.r, &arg0);
+        break;
+
+      default:
+        runerr(102, &arg1);
+      }
+   ClearBound;
+   }
+struct b_iproc Bneg = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(neg),
+   1,
+   -1,
+   0,
+   0,
+   {1, "-"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/neqv.c b/usr/src/new/new/icon/int/operators/neqv.c
new file mode 100644 (file)
index 0000000..85374e5
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * x ~=== y - object inequivalence operation.
+ */
+
+neqv(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   deref(&arg1);
+   deref(&arg2);
+
+   if (equiv(&arg1, &arg2))
+      fail();
+   arg0 = arg2;
+   ClearBound;
+   }
+struct b_iproc Bneqv = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(neqv),
+   2,
+   -1,
+   0,
+   0,
+   {4, "~==="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/nonnull.c b/usr/src/new/new/icon/int/operators/nonnull.c
new file mode 100644 (file)
index 0000000..34159f2
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * \x - test x for non-null value.
+ */
+
+nonnull(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int i, j;
+
+   SetBound;
+   arg0 = arg1;
+   deref(&arg1);
+
+   if (NULLDESC(arg1))
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnonnull = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(nonnull),
+   1,
+   -1,
+   0,
+   0,
+   {1, "\\"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/null.c b/usr/src/new/new/icon/int/operators/null.c
new file mode 100644 (file)
index 0000000..67915bd
--- /dev/null
@@ -0,0 +1,30 @@
+#include "../h/rt.h"
+
+/*
+ * /x - test x for null value.
+ */
+
+null(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int i, j;
+
+   SetBound;
+   arg0 = arg1;
+   deref(&arg1);
+
+   if (!NULLDESC(arg1))
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnull = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(null),
+   1,
+   -1,
+   0,
+   0,
+   {1, "/"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/number.c b/usr/src/new/new/icon/int/operators/number.c
new file mode 100644 (file)
index 0000000..32b3712
--- /dev/null
@@ -0,0 +1,38 @@
+#include "../h/rt.h"
+
+/*
+ * +x - convert x to numeric type.
+ */
+
+number(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   union numeric n;
+
+   SetBound;
+   switch (cvnum(&arg1, &n)) {
+      case T_LONGINT:
+        mkint(n.i, &arg0);
+        break;
+
+      case T_REAL:
+         mkreal(n.r, &arg0);
+        break;
+
+      default:
+         runerr(102, &arg1);
+      }
+   ClearBound;
+   }
+struct b_iproc Bnumber = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(number),
+   1,
+   -1,
+   0,
+   0,
+   {1, "+"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/numeq.c b/usr/src/new/new/icon/int/operators/numeq.c
new file mode 100644 (file)
index 0000000..fe48cdb
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x = y - test if x is numerically equal to y.
+ */
+
+numeq(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) != 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumeq = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numeq),
+   2,
+   -1,
+   0,
+   0,
+   {1, "="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/numge.c b/usr/src/new/new/icon/int/operators/numge.c
new file mode 100644 (file)
index 0000000..93ea480
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x >= y - test if x is numerically greater or equal to y.
+ */
+
+numge(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) < 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumge = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numge),
+   2,
+   -1,
+   0,
+   0,
+   {2, ">="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/numle.c b/usr/src/new/new/icon/int/operators/numle.c
new file mode 100644 (file)
index 0000000..82f281f
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x <= y - test if x is numerically less than or equal to y.
+ */
+
+numle(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) > 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumle = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numle),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/numlt.c b/usr/src/new/new/icon/int/operators/numlt.c
new file mode 100644 (file)
index 0000000..a40b400
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x < y - test if x is numerically less than y.
+ */
+
+numlt(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) >= 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumlt = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numlt),
+   2,
+   -1,
+   0,
+   0,
+   {1, "<"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/numne.c b/usr/src/new/new/icon/int/operators/numne.c
new file mode 100644 (file)
index 0000000..805d68f
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * x ~= y - test if x is numerically not equal to y.
+ */
+
+numne(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (numcmp(&arg1, &arg2, &arg0) == 0)
+      fail();
+   ClearBound;
+   }
+struct b_iproc Bnumne = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(numne),
+   2,
+   -1,
+   0,
+   0,
+   {2, "~="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/plus.c b/usr/src/new/new/icon/int/operators/plus.c
new file mode 100644 (file)
index 0000000..c04764b
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * x + y - add x and y.
+ */
+
+plus(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern long ckadd();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(ckadd(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      mkreal(n1.r + n2.r, &arg0);
+      }
+   ClearBound;
+   }
+struct b_iproc Bplus = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(plus),
+   2,
+   -1,
+   0,
+   0,
+   {1, "+"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/power.c b/usr/src/new/new/icon/int/operators/power.c
new file mode 100644 (file)
index 0000000..3fb6392
--- /dev/null
@@ -0,0 +1,65 @@
+#include "../h/rt.h"
+
+/*
+ * x ^ y - raise x to the y power.
+ */
+
+power(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   register int t1, t2;
+   union numeric n1, n2;
+   extern double pow();
+   extern long ipow();
+
+   SetBound;
+   if ((t1 = cvnum(&arg1, &n1)) == NULL)
+      runerr(102, &arg1);
+   if ((t2 = cvnum(&arg2, &n2)) == NULL)
+      runerr(102, &arg2);
+
+   if (t1 == T_LONGINT && t2 == T_LONGINT)
+      mkint(ipow(n1.i, n2.i), &arg0);
+   else {
+      if (t1 == T_LONGINT)
+         n1.r = n1.i;
+      if (t2 == T_LONGINT)
+         n2.r = n2.i;
+      if (n1.r == 0.0 && n2.r <= 0.0)
+        runerr(204, NULL);
+      if (n1.r < 0.0 && t2 == T_REAL)
+         runerr(206, NULL);
+      mkreal(pow(n1.r,n2.r), &arg0);
+      }
+   ClearBound;
+   }
+
+long ipow(n1, n2)
+long n1, n2;
+   {
+   long result;
+
+   if (n1 == 0 && n2 <= 0)
+      runerr(204, NULL);
+   if (n2 < 0)
+      return (0.0);
+   result = 1L;
+   while (n2 > 0) {
+      if (n2 & 01L)
+        result *= n1;
+      n1 *= n1;
+      n2 >>= 1;
+      }
+   return (result);
+   }
+struct b_iproc Bpower = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(power),
+   2,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/random.c b/usr/src/new/new/icon/int/operators/random.c
new file mode 100644 (file)
index 0000000..384d418
--- /dev/null
@@ -0,0 +1,139 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+#define randval (RSCALE*(k_random=(RANDA*k_random+RANDC)&MAXLONG))
+
+/*
+ * ?x - produce a randomly selected element of x.
+ */
+
+random(nargs, arg1v, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg1, arg0;
+   {
+   register int val, i, j;
+   register union block *bp;
+   long l1;
+   double r1;
+   char sbuf[MAXSTRING];
+   union block *ep;
+   struct descrip *dp;
+   extern char *alcstr();
+
+   SetBound;
+   arg1v = arg1;
+   deref(&arg1);
+
+   if (NULLDESC(arg1))
+      runerr(113, &arg1);
+
+   if (QUAL(arg1)) {                    /* random char in string */
+      if ((val = STRLEN(arg1)) <= 0)
+         fail();
+      hneed(sizeof(struct b_tvsubs));
+      mksubs(&arg1v, &arg1, (int)(randval*val)+1, 1, &arg0);
+      ClearBound;
+      return;
+      }
+
+   switch (TYPE(arg1)) {
+      case T_CSET:
+         cvstr(&arg1, sbuf);
+         if ((val = STRLEN(arg1)) <= 0)
+            fail();
+         sneed(1);
+         STRLEN(arg0) = 1;
+         STRLOC(arg0) = alcstr(STRLOC(arg1)+(int)(randval*val), 1);
+         ClearBound;
+         return;
+
+      case T_REAL:
+         r1 = BLKLOC(arg1)->realval;
+         if (r1 < 0 || r1 > MAXSHORT)
+            runerr(205, &arg1);
+         val = (int)r1;
+         goto getrand;
+
+      case T_INTEGER:
+         val = INTVAL(arg1);
+         if (val < 0)
+            runerr(205, &arg1);
+      getrand:
+         if (val == 0)          /* return real in range [0,1) */
+            mkreal(randval, &arg0);
+         else                   /* return integer in range [1,val] */
+            mkint((long)(randval*val) + 1, &arg0);
+         ClearBound;
+         return;
+
+#ifndef BIT32
+      case T_LONGINT:
+         runerr(205, &arg1);
+
+#endif
+      case T_LIST:
+         bp = BLKLOC(arg1);
+         val = bp->list.cursize;
+         if (val <= 0)
+           fail();
+         i = (int)(randval*val) + 1;
+        j = 1;
+        bp = BLKLOC(BLKLOC(arg1)->list.listhead);
+        while (i >= j + bp->listb.nused) {
+           j += bp->listb.nused;
+           if (TYPE(bp->listb.listnext) != T_LISTB)
+              syserr("list reference out of bounds in random");
+           bp = BLKLOC(bp->listb.listnext);
+           }
+        i += bp->listb.first - j;
+        if (i >= bp->listb.nelem)
+           i -= bp->listb.nelem;
+        dp = &bp->listb.lelem[i];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+        BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      case T_TABLE:
+          bp = BLKLOC(arg1);
+          val = bp->table.cursize;
+          if (val <= 0)
+            fail();
+          i = (int)(randval*val) + 1;
+          for (j = 0; j < NBUCKETS; j++) {
+             for (ep = BLKLOC(bp->table.buckets[j]); ep != NULL;
+                 ep = BLKLOC(ep->telem.blink)) {
+                if (--i <= 0) {
+                   dp = &ep->telem.tval;
+                   arg0.type = D_VAR + ((int *)dp - (int *)bp);
+                   BLKLOC(arg0) = dp;
+                   ClearBound;
+                   return;
+                   }
+                }
+             }
+
+      case T_RECORD:
+         bp = BLKLOC(arg1);
+         val = bp->record.recptr->nfields;
+         if (val <= 0)
+           fail();
+        dp = &bp->record.fields[(int)(randval*val)];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+         BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      default:
+         runerr(113, &arg1);
+      }
+   }
+struct b_iproc Brandom = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(random),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "?"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/rasgn.c b/usr/src/new/new/icon/int/operators/rasgn.c
new file mode 100644 (file)
index 0000000..25aa5b7
--- /dev/null
@@ -0,0 +1,33 @@
+#include "../h/rt.h"
+
+/*
+ * x <- y - assign y to x.
+ * Reversible.
+ */
+
+rasgn(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   arg0 = arg1;
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);       /* do the assignment */
+   suspend();                  /* suspend */
+   doasgn(&arg0, &arg1);       /* reverse the assignment */
+   fail();
+   }
+struct b_iproc Brasgn = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(rasgn),
+   2,
+   -1,
+   0,
+   0,
+   {2, "<-"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/refresh.c b/usr/src/new/new/icon/int/operators/refresh.c
new file mode 100644 (file)
index 0000000..b70193f
--- /dev/null
@@ -0,0 +1,211 @@
+#include "../h/rt.h"
+#ifdef VAX
+/*
+ * ^x - return an entry block for co-expression x from the refresh block.
+ * NOTE:  this code is highly dependent on stack frame layout.
+ */
+
+refresh(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int *ap, *sp, *tp;
+   struct descrip *dp, *dsp;
+   register struct b_estack *ep;
+   register struct b_eblock *hp;
+   int na, nl, *r5, *newap;
+   extern struct b_estack *alcestk();
+#ifdef INT
+   extern interp();
+#endif INT
+
+   SetBound;
+   deref(&arg1);
+   if (TYPE(arg1) != T_ESTACK)
+      runerr(118, &arg1);
+
+   esneed();                            /* check for room in stack space */
+   ep = alcestk();                      /* allocate expression stack */
+   ep->activator = nulldesc;
+   ep->nresults = 0;
+   ep->freshblk = BLKLOC(arg1)->estack.freshblk;
+
+   ep->sbase = sp = (int *)ep;         /* initialize new stack pointer */
+   hp = BLKLOC(ep->freshblk);
+   na = hp->numargs;                   /* get value of nargs */
+   nl = hp->numlocals;
+   ap = hp->elems;                     /* find arg0 of caller */
+
+   /* copy arguments into new stack and refresh block */
+   dsp = sp;
+   dp = ap;
+   *--dsp = *dp++;
+   while (na-- > 0) {
+      *--dsp = *dp++;
+      }
+   sp = dsp;
+   ap = dp;
+
+   /* set up original procedure frame in new stack */
+   *--sp = hp->numargs;                        /* copy nargs */
+   *--sp = (hp->numargs*2) + 1;                /*+ invent a nwords value ??-whm */
+   newap = sp;
+#ifdef INT
+   *--sp = interp;                     /* return pc */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* return pc */
+#endif CMP
+   *--sp = 0;                          /* saved r5 (frame pointer) */
+   *--sp = 0;                          /* saved ap */
+   *--sp = 0;                          /* psw/reg. mask */
+   *--sp = 0;                          /* condition handler */
+   r5 = sp;                            /*   (save its address) */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+
+   /* copy local variables into new stack */
+   dsp = sp;
+   dp = ap;
+   while (nl-- > 0) {
+      *--dsp = *dp++;
+      }
+   sp = dsp;
+   ap = dp;
+
+   /* set up dummy call to activate */
+   *--sp = nulldesc.type;              /* place for result */
+   *--sp = INTVAL(nulldesc);
+   *--sp = nulldesc.type;              /* place for activate coexpr */
+   *--sp = INTVAL(nulldesc);
+   /* these values are the initial register state for the coexpression */
+   *--sp = 1;                          /* nargs */
+   *--sp = 3;                          /* nwords */
+   tp = sp;                            /* save pointer to start of arg
+                                           list in this frame */
+#ifdef INT
+   *--sp = hp->ep;                     /* saved r9 (coexpr entry point) */
+   *--sp = interp;                     /* return pc (entry point) */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* saved r9 (coexpr entry point) */
+   *--sp = hp->ep;                     /* return pc (entry point) */
+#endif CMP
+   *--sp = r5;                         /* saved r5 */
+   *--sp = newap;                      /* saved ap */
+   *--sp = 0x02000000;                 /* psw/reg mask with bit set to
+                                           restore r9, the ipc */
+   *--sp = 0;
+   ep->boundary = sp;                  /*   (initial boundary) */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+   ep->sp = sp;                                /* initial stack pointer */
+   ep->ap = tp;
+   arg0.type = D_ESTACK;
+   BLKLOC(arg0) = ep;
+   ClearBound;
+   }
+struct b_iproc Brefresh = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(refresh),
+   1,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
+#endif VAX
+#ifdef PDP11
+/*
+ * ^x - return an entry block for co-expression x from the refresh block.
+ * NOTE:  this code is highly dependent on stack frame layout.
+ */
+
+refresh(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   register int *ap, *sp;
+   register struct b_estack *ep;
+   register struct b_eblock *hp;
+   int na, nl, *r5;
+   extern struct b_estack *alcestk();
+#ifdef INT
+   extern interp();
+#endif INT
+
+   deref(&arg1);
+   if (TYPE(arg1) != T_ESTACK)
+      runerr(118, &arg1);
+
+   esneed();                            /* check for room in stack space */
+   ep = alcestk();                      /* allocate expression stack */
+   ep->activator = nulldesc;
+   ep->nresults = 0;
+   ep->freshblk = BLKLOC(arg1)->estack.freshblk;
+
+   ep->sbase = sp = (int *)ep;         /* initialize new stack pointer */
+   hp = BLKLOC(ep->freshblk);
+   na = hp->numargs;                   /* get value of nargs */
+   nl = hp->numlocals;
+   ap = hp->elems;                     /* find arg0 of caller */
+
+   /* copy arguments into new stack and refresh block */
+   *--(struct descrip *)sp = *(struct descrip *)ap;   /* copy arg0 */
+   while (na-- > 0)
+      *--(struct descrip *)sp = *++(struct descrip *)ap;
+
+   /* set up original procedure frame in new stack */
+   *--sp = hp->numargs;                        /* copy nargs */
+   *--sp = 0;                          /* return pc */
+   *--sp = 0;                          /* saved r5 */
+   r5 = sp;                            /*   (save its address) */
+   *--sp = 0;                          /* saved r4 */
+   *--sp = 0;                          /* saved r3 */
+   *--sp = 0;                          /* saved r2 */
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+
+   /* copy local variables into new stack */
+   while (nl-- > 0)
+      *--(struct descrip *)sp = *++(struct descrip *)ap;
+
+   /* set up dummy call to activate */
+   *--(struct descrip *)sp = nulldesc;  /* place for result */
+   *--(struct descrip *)sp = nulldesc;  /* place for activate coexpr */
+   /* these values are the initial register state for the coexpression */
+   *--sp = 1;                          /* nargs */
+#ifdef INT
+   *--sp = interp;                     /* return pc (entry point) */
+#endif INT
+#ifdef CMP
+   *--sp = hp->ep;                     /* return pc (entry point) */
+#endif CMP
+   *--sp = r5;                         /* saved r5 */
+   ep->boundary = sp;                  /*   (initial boundary) */
+   *--sp = 0;                          /* saved r4 */
+   *--sp = 0;                          /* saved r3 */
+#ifdef INT
+   *--sp = hp->ep;                     /* saved r2 */
+#endif INT
+#ifdef CMP
+   *--sp = 0;                          /* saved r2 */
+#endif CMP
+   *--sp = line;                       /* saved line number */
+   *--sp = file;                       /* saved file name */
+   ep->sp = sp;                                /* initial stack pointer */
+   arg0.type = D_ESTACK;
+   BLKLOC(arg0) = ep;
+   }
+struct b_iproc Brefresh = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(refresh),
+   1,
+   -1,
+   0,
+   0,
+   {1, "^"}
+   };
+#endif PDP11
diff --git a/usr/src/new/new/icon/int/operators/rswap.c b/usr/src/new/new/icon/int/operators/rswap.c
new file mode 100644 (file)
index 0000000..8f90eb0
--- /dev/null
@@ -0,0 +1,59 @@
+#include "../h/rt.h"
+
+/*
+ * x <-> y - swap values of x and y.
+ * Reversible.
+ */
+
+rswap(nargs, arg2v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2v, arg2, arg1, arg0;
+   {
+   register union block *bp1, *bp2;
+   int adj1, adj2;
+
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   if (QUAL(arg2) || !VAR(arg2))
+      runerr(111, &arg2);
+   arg0 = arg1;
+   arg2v = arg2;
+   adj1 = adj2 = 0;
+   if (arg1.type == D_TVSUBS && arg2.type == D_TVSUBS) {
+      bp1 = BLKLOC(arg1);
+      bp2 = BLKLOC(arg2);
+      if (VARLOC(bp1->tvsubs.ssvar) == VARLOC(bp2->tvsubs.ssvar)) {
+         if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
+            adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
+         else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
+            adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
+        }
+      }
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);               /* lhs := rhs */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg1);              /* rhs := lhs */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   suspend();                          /* suspend */
+   doasgn(&arg0, &arg1);               /* reverse first assignment */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg2);              /* reverse second assignment */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   fail();
+   }
+struct b_iproc Brswap = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(rswap),
+   3,
+   -1,
+   -2,
+   0,
+   {3, "<->"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/sect.c b/usr/src/new/new/icon/int/operators/sect.c
new file mode 100644 (file)
index 0000000..18020c1
--- /dev/null
@@ -0,0 +1,72 @@
+#include "../h/rt.h"
+
+/*
+ * x[i:j] - form a substring or list section of x.
+ */
+
+sect(nargs, arg1v, arg3, arg2, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg3, arg2, arg1, arg0;
+   {
+   register int i, j;
+   int t, typ1;
+   char sbuf[MAXSTRING];
+   long l1, l2;
+   extern char *alcstr();
+
+   SetBound;
+   hneed(sizeof(struct b_tvsubs));              /* check heap */
+
+   if (cvint(&arg2, &l1) == NULL)
+      runerr(101, &arg2);
+   if (cvint(&arg3, &l2) == NULL)
+      runerr(101, &arg3);
+
+   arg1v = arg1;
+   deref(&arg1);
+
+   if (!QUAL(arg1) && TYPE(arg1) == T_LIST) {
+      i = cvpos(l1, BLKLOC(arg1)->list.cursize);
+      j = cvpos(l2, BLKLOC(arg1)->list.cursize);
+      if (i > j) {
+         t = i;
+         i = j;
+         j = t;
+         }
+      cplist(&arg1, &arg0, i, j);
+      ClearBound;
+      return;
+      }
+
+   if ((typ1 = cvstr(&arg1, sbuf)) == NULL)
+      runerr(110, &arg1);
+
+   i = cvpos(l1, STRLEN(arg1));
+   j = cvpos(l2, STRLEN(arg1));
+   if (i > j) {                                /* convert section to substring */
+      t = i;
+      i = j;
+      j = t - j;
+      }
+   else
+      j = j - i;
+
+   if (typ1 == 1) {                    /* if string was created, */
+      sneed(j);                                /*   just return a string */
+      STRLEN(arg0) = j;
+      STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, j);
+      }
+   else                                        /* else make a substring tv */
+      mksubs(&arg1v, &arg1, i, j, &arg0);
+   ClearBound;
+   }
+struct b_iproc Bsect = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(sect),
+   4,
+   -1,
+   -3,
+   0,
+   {1, ":"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/size.c b/usr/src/new/new/icon/int/operators/size.c
new file mode 100644 (file)
index 0000000..d7ea6e8
--- /dev/null
@@ -0,0 +1,60 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * *x - return size of string or object x.
+ */
+
+size(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   char sbuf[MAXSTRING];
+
+   SetBound;
+   deref(&arg1);
+   if (NULLDESC(arg1))
+      runerr(112, &arg1);
+   if (cvstr(&arg1, sbuf) != NULL) {
+      arg0.type = D_INTEGER;
+      INTVAL(arg0) = STRLEN(arg1);
+      }
+   else {
+      switch (TYPE(arg1)) {
+         case T_LIST:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->list.cursize;
+           break;
+
+         case T_TABLE:
+            arg0.type = D_INTEGER;
+            BLKLOC(arg0) = BLKLOC(arg1)->table.cursize;
+            break;
+
+         case T_RECORD:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->record.recptr->proc.nfields;
+           break;
+
+         case T_ESTACK:
+            arg0.type = D_INTEGER;
+           BLKLOC(arg0) = BLKLOC(arg1)->estack.nresults;
+           break;
+
+         default:
+            runerr(112, &arg1);
+         }
+      }
+   ClearBound;
+   }
+struct b_iproc Bsize = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(size),
+   1,
+   -1,
+   0,
+   0,
+   {1, "*"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/subsc.c b/usr/src/new/new/icon/int/operators/subsc.c
new file mode 100644 (file)
index 0000000..e05b16c
--- /dev/null
@@ -0,0 +1,114 @@
+#include "../h/rt.h"
+#include "../h/record.h"
+
+/*
+ * x[y] - access y'th character or element of x.
+ */
+
+subsc(nargs, arg1v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg1v, arg2, arg1, arg0;
+   {
+   register int i, j;
+   register union block *bp;
+   int typ1;
+   long l1;
+   struct descrip *dp;
+   char sbuf[MAXSTRING];
+   extern char *alcstr();
+   extern struct b_tvtbl *alctvtbl();
+
+   SetBound;
+   arg1v = arg1;
+
+   if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {   /* subscripting a string */
+      if (cvint(&arg2, &l1) == NULL)
+         runerr(101, &arg2);
+      i = cvpos(l1, STRLEN(arg1));
+      if (i > STRLEN(arg1))             /* fail if off string */
+         fail();
+      if (typ1 == 1) {                 /* if string was created, */
+         sneed(1);                     /*   just return a string */
+         STRLEN(arg0) = 1;
+         STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
+         }
+      else {                           /* else make a substring tv */
+         hneed(sizeof(struct b_tvsubs));
+         mksubs(&arg1v, &arg1, i, 1, &arg0);
+        }
+      ClearBound;
+      return;
+      }
+
+   deref(&arg1);
+   switch (TYPE(arg1)) {                /* subscripting an aggregate */
+      case T_LIST:
+         if (cvint(&arg2, &l1) == NULL)
+            runerr(101, &arg2);
+        i = cvpos(l1, BLKLOC(arg1)->list.cursize);
+         if (i > BLKLOC(arg1)->list.cursize)    /* insure legal subscript */
+            fail();
+        bp = BLKLOC(BLKLOC(arg1)->list.listhead);      
+        j = 1;
+        while (i >= j + bp->listb.nused) {
+           j += bp->listb.nused;
+            if (TYPE(bp->listb.listnext) != T_LISTB)
+              syserr("list reference out of bounds in subsc");
+           bp = BLKLOC(bp->listb.listnext);
+           }
+         i += bp->listb.first - j;
+         if (i >= bp->listb.nelem)
+            i -= bp->listb.nelem;
+         dp = &bp->listb.lelem[i];
+         arg0.type = D_VAR + ((int *)dp - (int *)bp);
+        BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      case T_TABLE:
+         deref(&arg2);
+        hneed(sizeof(struct b_tvtbl));
+        bp = BLKLOC(BLKLOC(arg1)->table.buckets[hash(&arg2)]);
+        while (bp != NULL) {
+           if (equiv(&bp->telem.tref, &arg2)) {
+              dp = &bp->telem.tval;
+              arg0.type = D_VAR + ((int *)dp - (int *)bp);
+              BLKLOC(arg0) = dp;
+               ClearBound;
+              return;
+              }
+           bp = BLKLOC(bp->telem.blink);
+           }
+        arg0.type = D_TVTBL;
+         BLKLOC(arg0) = alctvtbl(&arg1, &arg2);
+         ClearBound;
+        return;
+
+      case T_RECORD:
+         if (cvint(&arg2, &l1) == NULL)
+            runerr(101, &arg2);
+        bp = BLKLOC(arg1);
+        i = cvpos(l1, bp->record.recptr->nfields);
+        if (i > bp->record.recptr->nfields)
+           fail();
+        dp = &bp->record.fields[i-1];
+        arg0.type = D_VAR + ((int *)dp - (int *)bp);
+         BLKLOC(arg0) = dp;
+         ClearBound;
+        return;
+
+      default:
+        runerr(114, &arg1);
+      }        
+   ClearBound;
+   }
+struct b_iproc Bsubsc = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(subsc),
+   3,
+   -1,
+   -2,
+   0,
+   {2, "[]"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/swap.c b/usr/src/new/new/icon/int/operators/swap.c
new file mode 100644 (file)
index 0000000..6ee26e5
--- /dev/null
@@ -0,0 +1,51 @@
+#include "../h/rt.h"
+
+/*
+ * x :=: y - swap values of x and y.
+ */
+
+swap(nargs, arg2v, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2v, arg2, arg1, arg0;
+   {
+   register union block *bp1, *bp2;
+   int adj1, adj2;
+
+   SetBound;
+   if (QUAL(arg1) || !VAR(arg1))
+      runerr(111, &arg1);
+   if (QUAL(arg2) || !VAR(arg2))
+      runerr(111, &arg2);
+   arg0 = arg1;
+   arg2v = arg2;
+   adj1 = adj2 = 0;
+   if (arg1.type == D_TVSUBS && arg2.type == D_TVSUBS) {
+      bp1 = BLKLOC(arg1);
+      bp2 = BLKLOC(arg2);
+      if (VARLOC(bp1->tvsubs.ssvar) == VARLOC(bp2->tvsubs.ssvar)) {
+         if (bp1->tvsubs.sspos > bp2->tvsubs.sspos)
+            adj1 = bp1->tvsubs.sslen - bp2->tvsubs.sslen;
+         else if (bp2->tvsubs.sspos > bp1->tvsubs.sspos)
+            adj2 = bp2->tvsubs.sslen - bp1->tvsubs.sslen;
+        }
+      }
+   deref(&arg1);
+   deref(&arg2);
+   doasgn(&arg0, &arg2);          /* lhs := rhs */
+   if (adj2 != 0)
+      BLKLOC(arg2)->tvsubs.sspos += adj2;
+   doasgn(&arg2v, &arg1);         /* rhs := lhs */
+   if (adj1 != 0)
+      BLKLOC(arg1)->tvsubs.sspos += adj1;
+   ClearBound;
+   }
+struct b_iproc Bswap = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(swap),
+   3,
+   -1,
+   -2,
+   0,
+   {3, ":=:"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/tabmat.c b/usr/src/new/new/icon/int/operators/tabmat.c
new file mode 100644 (file)
index 0000000..019d19d
--- /dev/null
@@ -0,0 +1,55 @@
+#include "../h/rt.h"
+
+/*
+ * =x - tab(match(x)).
+ * Reversible.
+ */
+
+tabmat(nargs, oldsubj, arg1, arg0)
+int nargs;
+struct descrip oldsubj, arg1, arg0;
+   {
+   DclSave
+   register int l;
+   register char *s1, *s2;
+   int i, j;
+   char sbuf[MAXSTRING];
+
+   SetBound;
+   if (cvstr(&arg1,sbuf) == NULL)
+      runerr(103, &arg1);
+
+   oldsubj = k_subject;
+   i = k_pos;
+   j = STRLEN(k_subject) - i + 1;
+
+   if (j < STRLEN(arg1))
+      fail();
+
+   s1 = STRLOC(arg1);
+   s2 = STRLOC(k_subject) + i - 1;
+   l = STRLEN(arg1);
+   while (l-- > 0) {
+      if (*s1++ != *s2++)
+        fail();
+      }
+
+   l = STRLEN(arg1);
+   k_pos += l;
+   arg0 = arg1;
+   suspend();
+
+   k_subject = oldsubj;
+   k_pos = i;
+   fail();
+   }
+struct b_iproc Btabmat = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(tabmat),
+   2,
+   -1,
+   -1,
+   0,
+   {1, "="}
+   };
diff --git a/usr/src/new/new/icon/int/operators/toby.c b/usr/src/new/new/icon/int/operators/toby.c
new file mode 100644 (file)
index 0000000..51cb33d
--- /dev/null
@@ -0,0 +1,41 @@
+#include "../h/rt.h"
+
+/*
+ * e1 to e2 by e3 - generate successive values.
+ * Generator.
+ */
+
+toby(nargs, arg3, arg2, arg1, arg0)
+int nargs;
+struct descrip arg3, arg2, arg1, arg0;
+   {
+   DclSave
+   long from, to, by;
+
+   SetBound;
+   if (cvint(&arg1, &from) == NULL)
+      runerr(101, &arg1);
+   if (cvint(&arg2, &to) == NULL)
+      runerr(101, &arg2);
+   if (cvint(&arg3, &by) == NULL)
+      runerr(101, &arg3);
+   if (by == 0)
+      runerr(211, &arg3);
+
+   while ((from <= to && by > 0) || (from >= to && by < 0)) {
+      mkint(from, &arg0);
+      suspend();
+      from += by;
+      }
+   fail();
+   }
+struct b_iproc Btoby = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(toby),
+   3,
+   -1,
+   0,
+   0,
+   {4, "toby"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/unioncs.c b/usr/src/new/new/icon/int/operators/unioncs.c
new file mode 100644 (file)
index 0000000..8fbfac6
--- /dev/null
@@ -0,0 +1,42 @@
+#include "../h/rt.h"
+
+/*
+ * x ++ y - union of csets x and y.
+ */
+
+unioncs(nargs, arg2, arg1, arg0)
+int nargs;
+struct descrip arg2, arg1, arg0;
+   {
+   DclSave
+   register int i;
+   union block *bp;
+   int *cs1, *cs2, csbuf1[CSETSIZE], csbuf2[CSETSIZE];
+   extern struct b_cset *alccset();
+
+   SetBound;
+   hneed(sizeof(struct b_cset));
+
+   if (cvcset(&arg1, &cs1, csbuf1) == NULL)
+      runerr(104, &arg1);
+   if (cvcset(&arg2, &cs2, csbuf2) == NULL)
+      runerr(104, &arg2);
+
+   bp = alccset();
+   for (i = 0; i < CSETSIZE; i++)
+       bp->cset.bits[i] = cs1[i] | cs2[i];
+
+   arg0.type = D_CSET;
+   BLKLOC(arg0) = bp;
+   ClearBound;
+   }
+struct b_iproc Bunioncs = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(unioncs),
+   2,
+   -1,
+   0,
+   0,
+   {2, "++"}
+   };
diff --git a/usr/src/new/new/icon/int/operators/value.c b/usr/src/new/new/icon/int/operators/value.c
new file mode 100644 (file)
index 0000000..18288b8
--- /dev/null
@@ -0,0 +1,26 @@
+#include "../h/rt.h"
+
+/*
+ * .x - dereference x.
+ */
+
+value(nargs, arg1, arg0)
+int nargs;
+struct descrip arg1, arg0;
+   {
+   DclSave
+   SetBound;
+   arg0 = arg1;
+   deref(&arg0);
+   ClearBound;
+   }
+struct b_iproc Bvalue = {
+   T_PROC,
+   sizeof(struct b_proc),
+   EntryPoint(value),
+   1,
+   -1,
+   0,
+   0,
+   {1, "."}
+   };