From bc88c9526c63d3bb336524894a20be43258e2589 Mon Sep 17 00:00:00 2001
From: "Eric S. Raymond" <esr@thyrsus.com>
Date: Thu, 10 Nov 1994 04:54:05 +0000
Subject: [PATCH] Relations and GOTO work OK.

---
 execute.c | 28 ++++++++++++++++++----------
 monitor.c | 46 +++++++++++-----------------------------------
 2 files changed, 29 insertions(+), 45 deletions(-)

diff --git a/execute.c b/execute.c
index 5e311be..17c0cf8 100644
--- 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 d85a5a7..1ab14ea 100644
--- 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);
 	}
 
-- 
2.43.0