WATCH is implemented.

diff --git a/READ.ME b/READ.ME
index d7b27d20335e32be664bf2ebfae8f26d244e9f95..02e9696a2e681e9ce6f577454200939d75e79aec 100644 (file)
--- a/READ.ME
+++ b/READ.ME
@@ -70,6 +70,12 @@ REGRESS                      -- perform regression test on the front end
 
 * For true verismilitude, a program listing should be output before results.
 
+* The matrix algebra facilities are incomplete.  INV and DET are not
+  implemented.  Nor are the implemented matrix facilities at all well-tested,
+  because the CUPL manual did not include any matrix programs.
+
+* Matrix WRITE is not yet implemented.
+
 * For other things to work on, grep for FIXME.
 
-Send comments and bug reports to esr@snark.thyrsus.com.
+Send comments, bug reports, and fixes to esr@snark.thyrsus.com.

diff --git a/cupl.h b/cupl.h
index dc9c8d267973d535e782a38dfb8b3feab250bb06..8c8aee449925a63997ced1f78c327ca9723a2ee5 100644 (file)
--- a/cupl.h
+++ b/cupl.h
@@ -52,13 +52,13 @@ typedef struct edon
        char    *string;        /* for strings and identifiers */
     } u;
 
-    /* back-pointer to the symbol list, set if the node is an identifier */
+    /* identifier nodes only, back-pointer to the symbol list */
     struct lvar_t      *syminf;    
 
-    /* statement node only */
+    /* statement nodes only */
     struct edon                *endnode;       /* end node address, if block label */
 #ifdef PARSEDEBUG
-    int number;                /* statement number, if this is a STATEMENT node */
+    int                number;         /* statement number */
 #endif /* PARSEDEBUG */
 }
 node;
@@ -89,6 +89,7 @@ typedef struct lvar_t
     int                slabelref;
     int                assigned;
     int                used;
+    int                watchcount;
 }
 lvar;
 extern lvar *idlist;

diff --git a/execute.c b/execute.c
index f88d64a493e77a81af8838f19ba29c4973cc5017..5e311be3efc3d5702d4dc8f761aaf6c2fd56ee82 100644 (file)
--- a/execute.c
+++ b/execute.c
@@ -96,6 +96,7 @@ static void cupl_read(node *tp)
 static void eval_write(node *tp)
 /* evaluate a WRITE item */
 {
+    /* FIXME: implement matrix writes */
     if (tp == (node *)NULL)
        cupl_string_write("");
     else if (tp->type == ALL)
@@ -172,6 +173,11 @@ static value cupl_eval(node *tree)
     case LET:
        deallocate_value(&(tree->car->syminf->value));
        tree->car->syminf->value = EVAL_WRAP(cupl_eval(tree->cdr));
+       if (tree->car->syminf->watchcount && tree->car->syminf->watchcount--)
+       {
+           eval_write(tree->car);
+           cupl_eol_write();
+       }
        result.rank = FAIL;
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
@@ -526,8 +532,10 @@ static value cupl_eval(node *tree)
         */
 
     case WATCH:
-       /* FIXME: implement WATCH */
-       die("WATCH is not implemented\n");
+       for_cdr(np, tree)
+           np->car->syminf->watchcount = 10;
+       result.rank == FAIL;
+       return(result);
 
     default:
        die("unknown node type %d (%s), cannot execute\n",

diff --git a/monitor.c b/monitor.c
index 8a81e5517741282676158dad2ba51570518f1ac2..2610193cc4fd0ca34963366dc3e4a792f872fca4 100644 (file)
--- a/monitor.c
+++ b/monitor.c
@@ -241,7 +241,6 @@ value cupl_subtract(value left, value right)
 value cupl_multiply(value left, value right)
 /* multiply two CUPL values */
 {
-    /* FIXME: implement cupl_multiply for non-scalar operands */
     if (left.rank == 0 && right.rank == 0)
     {
        value   result;
@@ -250,14 +249,32 @@ value cupl_multiply(value left, value right)
        result.elements[0] = left.elements[0] * right.elements[0];
        return(result);
     }
+    else if (left.width == right.depth)
+    {
+       value   result;
+       int     i, j;
+
+       result = allocate_value(2, left.depth, right.width);
+       for (i = 0; i < left.depth; i++)
+           for (j = 0; j < right.width; j++)
+           {
+               int k;
+               scalar p = 0;
+
+               for (k = 0; k < left.width; k++)
+                   p += SUB(left, i, k)[0] * SUB(right, k, j)[0];
+
+               SUB(result, i, j)[0] = p;
+           }
+       return(result);
+    }
     else
-       die("multiplication of non-scalars is not yet supported\n");
+       die("multiplication attempt on non-conformable matrices\n");
 }
 
 value cupl_divide(value left, value right)
 /* divide two CUPL values */
 {
-    /* FIXME: implement cupl_divide for non-scalar operands */
     if (left.rank == 0 && right.rank == 0)
     {
        value   result;
@@ -266,8 +283,19 @@ value cupl_divide(value left, value right)
        result.elements[0] = left.elements[0] / right.elements[0];
        return(result);
     }
+    else if (right.rank == 0)
+    {
+       value   result;
+       int     n;
+
+       result = copy_value(left);
+       for (n = 0; n < left.width * left.depth; n++)
+           result.elements[n] = left.elements[n] / right.elements[0];
+       return(result);
+    }
     else
-       die("division of non-scalars is not yet supported\n");
+       die("division of rank %d by rank %d value is undefined\n",
+           left.rank, right.rank);
 }
 
 value cupl_power(value left, value right)