Relations and GOTO work OK.

diff --git a/execute.c b/execute.c
index 5e311be3efc3d5702d4dc8f761aaf6c2fd56ee82..17c0cf8b5a6f87aab9d0e7829ccfbdf552120df5 100644 (file)
--- a/execute.c
+++ b/execute.c
@@ -67,6 +67,7 @@ static void cupl_read(node *tp)
        die("internal error -- garbled READ list\n");
     else
     {
+       /* FIXME: read into subscripted variables and slices won't work */
        value *v = &(tp->syminf->value);
        int     n;
 
@@ -141,6 +142,8 @@ static value cupl_eval(node *tree)
 {
     value      leftside, rightside, result, cond;
     node       *np;
+    int                n;
+    jmp_buf    jmpperf;
 
     switch(tree->type)
     {
@@ -472,8 +475,12 @@ static value cupl_eval(node *tree)
        return(result);
 
     case WHILE:
-       /* FIXME: implement WHILE */
-       die("WHILE is not implemented\n");
+       do {
+           cupl_eval(tree->cdr);
+
+           cond = cupl_eval(tree->car);
+       } while
+           (cond.rank);
        result.rank = FAIL;
        return(result);
 
@@ -484,15 +491,17 @@ static value cupl_eval(node *tree)
        return(result);
 
     case TIMES:
-       /* FIXME: implement TIMES */
-       die("TIMES is not implemented\n");
+       result = cupl_eval(tree->car);
+       for (n = floor(result.elements[0]); n; n--)
+            (void) cupl_eval(tree->cdr);
        result.rank = FAIL;
        return(result);
 
     case PERFORM:
-       next = tree->car;
-       pushstack(pc->cdr);
-       longjmp(nextbuf, 1);
+       if (setjmp(jmpperf) == 0)
+           cupl_eval(tree->car);
+       result.rank = FAIL;
+       return(result);
 
     case BLOCK:
        next = pc->endnode->cdr;
@@ -502,10 +511,9 @@ static value cupl_eval(node *tree)
        next = tree->car;
        longjmp(nextbuf, 1);
 
-    case END:
     case OG:
-       next = popstack();
-       longjmp(nextbuf, 1);
+    case END:
+       longjmp(jmpperf, 1);
 
     case IF:
        leftside = EVAL_WRAP(cupl_eval(tree->car));

diff --git a/monitor.c b/monitor.c
index d85a5a73b88200dcc7038e19f58d254562646e80..1ab14ea55a6ac54d1fc8c400b340e60467c4d9d3 100644 (file)
--- a/monitor.c
+++ b/monitor.c
@@ -504,29 +504,11 @@ value cupl_rand(value right)
  *
  ****************************************************************************/
 
-static bool normalize(scalar *ep1, scalar *ep2)
-/* normalize a pair of scalars for conversion purposes */
-{
-    int        mult;
-
-    if (*ep1 == 0 && *ep2 == 0)
-       return;
-
-    /*
-     * Note: this is not precisely the roundoff method used by original
-     * CUPL, though it should (famous last words) be equivalent.
-     */
-    if (fabs(*ep1) > fabs(*ep2))
-       mult = pow(10, log10(*ep2) + 14);
-    else
-       mult = pow(10, log10(*ep1) + 14);
-
-    *ep1 *= mult;
-    *ep2 *= mult;
-
-    *ep1 = floor(*ep1);
-    *ep2 = floor(*ep2);
-}
+/*
+ * Original CUPL's roundoff rule for relations seems to have been designed
+ * to throw away all digits of precision more than 14,
+ */
+#define FUZZY_EQUAL(m, n)      (fabs((m) - (n)) < 10e-15)
 
 bool cupl_eq(value v1, value v2)
 /* test any two CUPL values for pairwise equality */
@@ -539,11 +521,9 @@ bool cupl_eq(value v1, value v2)
 
        for (n = 0; n < v2.width * v2.depth; n++)
        {
-           scalar e1 = v1.elements[n], e2 = v1.elements[n];
-
-           normalize(&e1, &e2);
+           scalar e1 = v1.elements[n], e2 = v2.elements[n];
 
-           if (e1 != e2)
+           if (!FUZZY_EQUAL(e1, e2))
                return(FALSE);
        }
 
@@ -564,11 +544,9 @@ bool cupl_le(value v1, value v2)
 
        for (n = 0; n < v2.width * v2.depth; n++)
        {
-           scalar e1 = v1.elements[n], e2 = v1.elements[n];
+           scalar e1 = v1.elements[n], e2 = v2.elements[n];
 
-           normalize(&e1, &e2);
-
-           if (e1 > e2)
+           if (!FUZZY_EQUAL(e1, e2) && e1 > e2)
                return(FALSE);
        }
 
@@ -587,11 +565,9 @@ bool cupl_ge(value v1, value v2)
 
        for (n = 0; n < v2.width * v2.depth; n++)
        {
-           scalar e1 = v1.elements[n], e2 = v1.elements[n];
-
-           normalize(&e1, &e2);
+           scalar e1 = v1.elements[n], e2 = v2.elements[n];
 
-           if (e1 < e2)
+           if (!FUZZY_EQUAL(e1, e2) && e1 < e2)
                return(FALSE);
        }