Relations with roundoff are implemented, but not tested.

diff --git a/cupl.doc b/cupl.doc
index 739df4c77997780e83002911482ad454309d6272..b2700aa067d819f1f5790a9c86e40a08437e7fc6 100644 (file)
--- a/cupl.doc
+++ b/cupl.doc
@@ -524,5 +524,5 @@ b. If either x or y is not zero:
 
    (ii)  x * 10**n and y * 10**n are truncated to 14 decimal places
 
-   (iii) The specified condition is interpreted or the resulting numbers.
+   (iii) The specified condition is interpreted on the resulting numbers.
 

diff --git a/cupl.h b/cupl.h
index 7fc4081972cbcca7be35525ed089c5b84546f2c8..98d570f9eda8da9498db1c4931786f2f89279870 100644 (file)
--- a/cupl.h
+++ b/cupl.h
@@ -138,6 +138,12 @@ extern value cupl_rand(value);
 
 extern value cupl_sgm(value right);
 
+extern bool cupl_eq(value, value);
+extern bool cupl_lt(value, value);
+extern bool cupl_gt(value, value);
+extern bool cupl_le(value, value);
+extern bool cupl_ge(value, value);
+
 #define DEBUG_PARSEDUMP        1
 #define DEBUG_CHECKDUMP        2
 #define DEBUG_ALLOCATE 3

diff --git a/execute.c b/execute.c
index 0886a5f31cb7fe951dd82532ca58cfbb027e7412..f0a846c54cb5e983d6b02670d7025aa4e172ff65 100644 (file)
--- a/execute.c
+++ b/execute.c
@@ -7,8 +7,8 @@ SYNOPSIS
    void execute(node *tree)    -- execute a parse tree
 
 DESCRIPTION 
-   This code does execution of a CUPL parse tree.  Actual execution is
-handed off to execute().
+   This code does execution of a CUPL parse tree.  It uses the runtime
+support in monitor.c.
 
 *****************************************************************************/
 /*LINTLIBRARY*/
@@ -19,9 +19,8 @@ handed off to execute().
 #include "tokens.h"
 #include "nodetype.h"
 
-#define car    u.n.left
-#define cdr    u.n.right
-#define EVAL_WRAP
+/* debugging macros */
+#define EVAL_WRAP      /* empty */
 #define RETURN_WRAP(t, l, r, v)        display_return(t, l, r, v);
 
 static node *pc;       /* the statement node to evaluate next */
@@ -100,7 +99,7 @@ static void display_return(node *tree, node *left, node *right, value v)
 static value cupl_eval(node *tree)
 /* recursively evaluate a CUPL parse tree */
 {
-    value      leftside, rightside, result;
+    value      leftside, rightside, result, cond;
     node       *np;
 
     switch(tree->type)
@@ -138,6 +137,10 @@ static value cupl_eval(node *tree)
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
 
+       /*
+        * Arithmetic
+        */
+
     case PLUS:
        leftside = EVAL_WRAP(cupl_eval(tree->car));
        rightside = EVAL_WRAP(cupl_eval(tree->cdr));
@@ -192,6 +195,10 @@ static value cupl_eval(node *tree)
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
 
+       /*
+        * Special functions
+        */
+
     case ATAN:
        rightside = EVAL_WRAP(cupl_eval(tree->cdr));
        result = cupl_atan(rightside);
@@ -257,6 +264,10 @@ static value cupl_eval(node *tree)
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
 
+       /*
+        * Matrix functions
+        */
+
     case SGM:
        rightside = EVAL_WRAP(cupl_eval(tree->cdr));
        result = cupl_sgm(rightside);
@@ -264,6 +275,90 @@ static value cupl_eval(node *tree)
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
 
+       /*
+        * Relations.
+        *
+        * These compute their value into the result node's rank field.
+        */
+
+    case '=':
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = cupl_eq(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case NE:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = !cupl_eq(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case LE:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = !cupl_gt(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case GE:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = !cupl_lt(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case LT:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = cupl_lt(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case GT:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = cupl_gt(leftside, rightside);
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+       /*
+        * Conjunctions.
+        *
+        * These assume that their left- and right-side nodes
+        * are relations, so that the relation status is in the
+        * rank field.
+        */
+
+    case AND:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = leftside.rank && rightside.rank;
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+    case OR:
+       leftside = EVAL_WRAP(cupl_eval(tree->car));
+       rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+       result.rank = leftside.rank || rightside.rank;
+       RETURN_WRAP(tree, tree->car, tree->cdr, result)
+       return(result);
+
+       /*
+        * Control structures.
+        */
+
+    case WHILE:
+       do {
+           (void) cupl_eval(tree->car);
+
+           cond = cupl_eval(tree->cdr);
+       } while
+           (cond.rank);        /* conditional values use an odd convention */
+       result.rank = FAIL;
+       break;
+
     case STOP:
        longjmp(jmpbuf, 1);
        /* no fall through */

diff --git a/interpret.c b/interpret.c
index 6a998f41cd1b2188caed3c160f793c42f4fe9bcd..cf37fe9a1fd140a402702eabdd241fc49af2cc88 100644 (file)
--- a/interpret.c
+++ b/interpret.c
@@ -322,8 +322,6 @@ static void rewrite(node *tree)
            if (!found)
                die("no END matching %s BLOCK\n", sp->car->u.string);
        }
-
-       /* rewrite code coes here */
     }
 
     /* now, hack label references to eliminate name references */