From: Eric S. Raymond <esr@thyrsus.com>
Date: Mon, 7 Nov 1994 03:49:08 +0000 (+0000)
Subject: Implemented SGM.
X-Git-Tag: 1-2~63
X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=5d1e0e9b5fcbe5f3f297a4f33aeb099b0a56a35f;p=cupl.git

Implemented SGM.
---

diff --git a/cupl.h b/cupl.h
index eeacc70..7fc4081 100644
--- a/cupl.h
+++ b/cupl.h
@@ -136,6 +136,8 @@ extern value cupl_max(value, value);
 extern value cupl_min(value, value);
 extern value cupl_rand(value);
 
+extern value cupl_sgm(value right);
+
 #define DEBUG_PARSEDUMP	1
 #define DEBUG_CHECKDUMP	2
 #define DEBUG_ALLOCATE	3
diff --git a/execute.c b/execute.c
index a6c453e..0886a5f 100644
--- a/execute.c
+++ b/execute.c
@@ -257,6 +257,13 @@ static value cupl_eval(node *tree)
 	RETURN_WRAP(tree, tree->car, tree->cdr, result)
 	return(result);
 
+    case SGM:
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result = cupl_sgm(rightside);
+	deallocate_value(&rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
     case STOP:
 	longjmp(jmpbuf, 1);
 	/* no fall through */
diff --git a/monitor.c b/monitor.c
index e16bbeb..879606b 100644
--- a/monitor.c
+++ b/monitor.c
@@ -33,6 +33,8 @@ SYNOPSIS
     value cupl_min(value, value)
     value cupl_rand(value)
 
+    value cupl_sgm(value right)
+
 DESCRIPTION 
    Runtime support.  This is segregated from the execute() code in case anyone
 ever wants to write a back end that is a compiler.  For the same reason
@@ -273,19 +275,12 @@ value cupl_abs(value right)
 /* apply absolute-value function */
 {
     value	result;
+    int	n;
 
-    if (right.rank != 0)
-	die("ABS is only defined for scalar arguments\n");
-    else
-    {
-	value	result;
-	int	n;
-
-	result = copy_value(right);
-	for (n = 0; n < right.width * right.depth; n++)
-	    result.elements[n] = fabs(right.elements[n]);
-	return(result);
-    }
+    result = copy_value(right);
+    for (n = 0; n < right.width * right.depth; n++)
+	result.elements[n] = fabs(right.elements[n]);
+    return(result);
 }
 
 value cupl_atan(value right)
@@ -436,6 +431,20 @@ value cupl_rand(value right)
  *
  ****************************************************************************/
 
-/* FIXME: not yet implemented */
+/* FIXME: most not yet implemented */
+
+value cupl_sgm(value right)
+/* compute the sum of the elements of a matrix */
+{
+    value result;
+    int	n;
+
+    make_scalar(&result, 0);
+    for (n = 0; n < right.width * right.depth; n++)
+	result.elements[0] += fabs(right.elements[n]);
+    return(result);
+}
 
 /* monitor.c ends here */
+
+