From e7d5c144993fb113e2f009c06cd4341b38b89fbe Mon Sep 17 00:00:00 2001
From: Laurent Mazet <mazet@softndesign.org>
Date: Tue, 31 Jan 2023 08:45:53 +0100
Subject: [PATCH] some fixes on program functions

---
 calc.c   |  3 ++-
 parser.c | 39 ++++++++++++++++++++++++---------------
 2 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/calc.c b/calc.c
index 690b118..d73e821 100644
--- a/calc.c
+++ b/calc.c
@@ -360,7 +360,7 @@ int main (int argc, char *argv[])
 // test: echo -e 'while (inc (1) < 100, sto (2, rcl (1) + rcl (2)))' | calc.exe | grep -q '=> 5050'
 // test: echo -e 'while\nwhile (inc (1) < 3,\nwhile (inc (1) < 100, sto (2, rcl (1) + rcl (2))' | calc.exe | grep -c error | xargs test 3 =
 // test: echo -e 'while (0, 1)' | calc.exe -v 3 | grep -q While
-// test: echo -e '{sto (1, 1 + 1), rcl (1) * 3}' | calc.exe -v 3 | grep -q 'Program'
+// test: echo -e '{sto (1, 1 + 1), rcl (1) * 3}' | calc.exe -v 3 | grep -q 'Code'
 // test: echo -e '{sto (1, 1 + 1), rcl (1) * 3}' | calc.exe | grep -q '=> 6'
 // test: echo -e '{\n{}\n{1, 2\n{sto (1, 1 + 1),\npow(2, {sto (1, 1 + 2), 2}, {rcl(2)})\n2 {sto (1, 1 + 1)}' | calc.exe | grep -c error | xargs test 6 =
 // test: echo -e '1 }\n1 )\n1 , 2\n ' | calc.exe | grep -c error | xargs test 3 =
@@ -376,6 +376,7 @@ int main (int argc, char *argv[])
 // test: echo -e 'dec (2)\ndisp' | calc.exe | grep -q "storage: 0 -1 0 0 0 0 0 0 0 0"
 // test: echo -e 'sto (3, pi)\nclr\ndisp' | calc.exe | grep -q "storage: 0 0 0 0 0 0 0 0 0 0"
 // test: echo -e 'mem (3)\nclr' | calc.exe -v 3 | grep -q Clear
+// test: echo -e 'prog (2, 2, {rcl (2) - rcl (1)})\nprog (1, 1, {cos (rcl (1)^2)})\ncall (1, pi/6)\nls' | calc.exe
 
 // Gauss sequence
 // test: echo -e '{sto (1, 0), sto (10, 0), while (inc (10) < 100, {sto (1, rcl (1) + rcl (10)), print (rcl (1))})};' | calc.exe | grep -q '=> 5050'
diff --git a/parser.c b/parser.c
index 09a6935..4b4fab7 100644
--- a/parser.c
+++ b/parser.c
@@ -784,23 +784,24 @@ void prog (int id, int nbmems, element_t *root)
         exit (1);
     }
     (programs + n)->storage_size = nbmems;
-    (programs + n)->root = root;
+    (programs + n)->root = dupelement (root);
 }
 
-double call (int id, int nbobs, element_t **ops)
+double call (int id, int nbops, element_t **ops)
 {
     workspace_t tmp = {0};
     int i, n = -1;
     double ret = 0;
 
     if (programs) {
+
+        /* look for program */
         for (i = 0; i < nb_programs; i++) {
-            if ((programs + i)->id == i) {
+            if ((programs + i)->id == id) {
                 n = i;
                 break;
             }
         }
-
         if (n == -1) {
             VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
             return 0;
@@ -813,19 +814,20 @@ double call (int id, int nbobs, element_t **ops)
 
         /* change context */
         answer = 0;
-        storage = (programs + i)->storage;
-        storage_size = (programs + i)->storage_size;
-        if (nbobs > storage_size) {
-            storage = realloc (storage, nbobs * sizeof (double));
-            storage_size = nbobs;
+        storage = (programs + n)->storage;
+        storage_size = (programs + n)->storage_size;
+        if (nbops > storage_size) {
+            storage = realloc (storage, nbops * sizeof (double));
+            storage_size = nbops;
         }
-        for (i = 0; i < nbobs; i++) {
-            store (i + 1, evaluate_element (ops[i], 0));
+        for (i = 0; i < nbops; i++) {
+            double val = evaluate_element (ops[i], 0);
+            store (i + 1, val);
         }
 
         /* evaluate program */
-        element_t *element = dupelement ((programs + n)->root);
-        ret = evaluate_element (element, 0);
+        element_t *elements = dupelement ((programs + n)->root);
+        ret = evaluate_element (elements, 0);
 
         /* restore context */
         answer = tmp.answer;
@@ -890,6 +892,7 @@ double evaluate_element (element_t *root, char mask)
 {
     double op0 = 0, op1 = 0;
     char nextmask = mask;
+    int i, nb;
 
     if ((root == NULL) || (root == ERROR_OP)) {
         VERBOSE (WARNING, fprintf (stdout, "error while evaluating\n"));
@@ -963,7 +966,6 @@ double evaluate_element (element_t *root, char mask)
     case Mem:
     case Cond:
     case Call:
-    case List:
     case Edit:
     case Del:
         if (root->ops[0]) {
@@ -981,6 +983,7 @@ double evaluate_element (element_t *root, char mask)
     case Pi:
     case E:
     case Code:
+    case List:
         break;
     case While:
         if (root->ops[0] == NULL) {
@@ -1047,7 +1050,13 @@ double evaluate_element (element_t *root, char mask)
     case Code: return execute_code (root->ops, root->nbops);
     case Print: return print (op0);
     case Prog: prog ((int)op0, (int)op1, root->ops[2]); break;
-    case Call: return call ((int)op0, root->nbops + 1, root->ops + 1);
+    case Call:
+        for (i = 1, nb =0; i < root->nbops; i++) {
+            if (root->ops[i]) {
+                nb++;
+            }
+        }
+        return call ((int)op0, nb, root->ops + 1);
     case List: list (); break;
     case Edit: edit ((int)op0); break;
     case Del: del ((int)op0); break;
-- 
2.30.2