From c149b1da1d93042c06d24e4df7f8138aaa0facbc Mon Sep 17 00:00:00 2001
From: "Eric S. Raymond" <esr@thyrsus.com>
Date: Mon, 7 Nov 1994 22:36:37 +0000
Subject: [PATCH] WATCH is implemented.

---
 READ.ME   |  8 +++++++-
 cupl.h    |  7 ++++---
 execute.c | 12 ++++++++++--
 monitor.c | 36 ++++++++++++++++++++++++++++++++----
 4 files changed, 53 insertions(+), 10 deletions(-)

diff --git a/READ.ME b/READ.ME
index d7b27d2..02e9696 100644
--- 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 dc9c8d2..8c8aee4 100644
--- 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 f88d64a..5e311be 100644
--- 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 8a81e55..2610193 100644
--- 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)
-- 
2.43.0