]> thyrsus.com Git - cupl.git/commitdiff
Implemented SGM.
authorEric S. Raymond <esr@thyrsus.com>
Mon, 7 Nov 1994 03:49:08 +0000 (03:49 +0000)
committerEric S. Raymond <esr@thyrsus.com>
Mon, 7 Nov 1994 03:49:08 +0000 (03:49 +0000)
cupl.h
execute.c
monitor.c

diff --git a/cupl.h b/cupl.h
index eeacc70b93cac5b763d9ccecb89c863002f72c08..7fc4081972cbcca7be35525ed089c5b84546f2c8 100644 (file)
--- 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
index a6c453e2725dccd298412e2acb4028e8b40a7e65..0886a5f31cb7fe951dd82532ca58cfbb027e7412 100644 (file)
--- 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 */
index e16bbeb2ac420f5f21c120ba10c1a8908c6d39c3..879606bc7e043115f4b93d5923529eb756dac3ce 100644 (file)
--- 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 */
+
+