+/* program function */
+
+void prog (int id, element_t *root)
+{
+ int i, n = -1;
+
+ if (programs == NULL) {
+
+ /* initial memory allocation */
+ programs = (workspace_t *) callocordie (1, sizeof (workspace_t));
+ nb_programs = 1;
+ n = 0;
+
+ } else {
+
+ /* look for existing program */
+ for (i = 0; i < nb_programs; i++) {
+ if ((programs + i)->id == id) {
+ n = i;
+ break;
+ }
+ }
+ if (n == -1) {
+
+ /* new program */
+ n = nb_programs++;
+ workspace_t *tmp = (workspace_t *) callocordie (nb_programs, sizeof (workspace_t));
+ memcpy (tmp, programs, (nb_programs - 1) * sizeof (workspace_t));
+ free (programs);
+ programs = tmp;
+ } else {
+
+ /* clean old program */
+ if ((programs + n)->storage) {
+ free ((programs + n)->storage);
+ }
+ if ((programs + n)->stack) {
+ free ((programs + n)->stack);
+ }
+ if ((programs + n)->root) {
+ delelement ((programs + n)->root);
+ }
+ if ((programs + n)->string) {
+ free ((programs + n)->string);
+ (programs + n)->string = NULL;
+ }
+ }
+ }
+
+ /* set program */
+ (programs + n)->id = id;
+ (programs + n)->answer = 0;
+ (programs + n)->storage = NULL;
+ (programs + n)->storage_size = 0;
+ (programs + n)->stack = NULL;
+ (programs + n)->stack_size = 0;
+ (programs + n)->root = dupelement (root);
+}
+
+double arg (int id)
+{
+ double ret = 0;
+ if ((id <= 0) || (id > argument_size)) {
+ VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", id, argument_size));
+ } else {
+ ret = argument[id - 1];
+ }
+ return ret;
+}
+
+double call (int id, int nbargs, element_t **args)
+{
+ workspace_t tmp = {0};
+ int i, l, n = -1;
+ double ret = 0;
+
+ if (programs) {
+
+ /* look for program */
+ for (i = 0; i < nb_programs; i++) {
+ if ((programs + i)->id == id) {
+ n = i;
+ break;
+ }
+ }
+ }
+ if (n == -1) {
+ VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
+ return 0;
+ }
+
+ /* store context */
+ tmp.answer = answer;
+ tmp.argument = argument;
+ tmp.argument_size = argument_size;
+ tmp.storage = storage;
+ tmp.storage_size = storage_size;
+ tmp.stack = stack;
+ tmp.stack_size = stack_size;
+
+ /* change context */
+ answer = 0;
+ storage = (programs + n)->storage;
+ storage_size = (programs + n)->storage_size;
+ argument = NULL;
+ argument_size = 0;
+ stack = (programs + n)->stack;
+ stack_size = (programs + n)->stack_size;
+ if (nbargs > 0) {
+ argument = (double *) callocordie (nbargs, sizeof (double));
+ for (i = 0, l = 0; i < nbargs; l++) {
+ if (args[l]) {
+ argument[i++] = evaluate_element (args[l], 0);
+ }
+ }
+ argument_size = nbargs;
+ }
+
+ /* evaluate program */
+ element_t *elements = dupelement ((programs + n)->root);
+ ret = evaluate_element (elements, 0);
+ delelement (elements);
+ (programs + n)->answer = answer;
+ (programs + n)->storage = storage;
+ (programs + n)->storage_size = storage_size;
+ if (argument) {
+ free (argument);
+ }
+ (programs + n)->stack = stack;
+ (programs + n)->stack_size = stack_size;
+
+ /* restore context */
+ answer = tmp.answer;
+ storage = tmp.storage;
+ storage_size = tmp.storage_size;
+ argument = tmp.argument;
+ argument_size = tmp.argument_size;
+ stack = tmp.stack;
+ stack_size = tmp.stack_size;
+
+ return ret;
+}
+
+void list ()
+{
+ int i;
+ fprintf (stdout, "programs:");
+ for (i = 0; i < nb_programs; i++) {
+ fprintf (stdout, " %d", (programs + i)->id);
+ }
+ fprintf (stdout, "\n");
+}
+
+void edit (int id)
+{
+ int i, n = -1;
+
+ if (programs) {
+
+ /* look for program */
+ for (i = 0; i < nb_programs; i++) {
+ if ((programs + i)->id == id) {
+ n = i;
+ break;
+ }
+ }
+ }
+ if (n == -1) {
+ VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
+ return;
+ }
+
+ /* set string program */
+ fprintf (stdout, "edit: %s\n", (programs + n)->string);
+}
+
+void savestring (int id, char *string)
+{
+ int i, n = -1;
+
+ if (programs) {
+
+ /* look for program */
+ for (i = 0; i < nb_programs; i++) {
+ if ((programs + i)->id == id) {
+ n = i;
+ break;
+ }
+ }
+ }
+
+ /* unnecesary code */
+ //if (n == -1) {
+ // VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
+ // return;
+ //}
+ //if ((programs + n)->string) {
+ // free ((programs + n)->string);
+ //}
+
+ if (string) {
+ (programs + n)->string = strdup (string);
+ }
+}
+
+void del (int id)
+{
+ int i, j, n = -1;
+
+ if (programs) {
+
+ /* look for program */
+ for (i = 0; i < nb_programs; i++) {
+ if ((programs + i)->id == id) {
+ n = i;
+ break;
+ }
+ }
+ }
+ if (n == -1) {
+ VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
+ return;
+ }
+
+ /* clean program */
+ if ((programs + n)->storage) {
+ free ((programs + n)->storage);
+ }
+ if ((programs + n)->stack) {
+ free ((programs + n)->stack);
+ }
+ if ((programs + n)->root) {
+ delelement ((programs + n)->root);
+ }
+ if ((programs + n)->string) {
+ free ((programs + n)->string);
+ }
+
+ /* remove entry */
+ workspace_t *tmp = (workspace_t *) callocordie (nb_programs - 1, sizeof (workspace_t));
+ for (i = 0, j = 0; i < nb_programs; i++) {
+ if (i != n) {
+ memcpy (tmp + j, programs + i, sizeof (workspace_t));
+ j++;
+ }
+ }
+ free (programs);
+ programs = tmp;
+ nb_programs--;
+}
+
+/* stack management */
+
+double get (int n)
+{
+ double ret = 0;
+ if ((n <= 0) || (n > stack_size)) {
+ VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", n, stack_size));
+ } else {
+ ret = stack[n - 1];
+ }
+ return ret;
+}
+
+double length ()
+{
+ return stack_size;
+}
+
+double pop ()
+{
+ double ret = 0;
+ if (stack_size > 0) {
+ ret = stack[--stack_size];
+ double *tmp = (double *) callocordie (stack_size, sizeof (double));
+ memcpy (tmp, stack, stack_size * sizeof (double));
+ free (stack);
+ stack = tmp;
+ } else {
+ VERBOSE (WARNING, fprintf (stdout, "error stack empty\n"));
+ }
+ return ret;
+}
+
+double push (double val)
+{
+ double *tmp = (double *) callocordie (stack_size + 1, sizeof (double));
+ memcpy (tmp, stack, stack_size * sizeof (double));
+ if (stack) {
+ free (stack);
+ }
+ stack = tmp;
+ stack[stack_size++] = val;
+ return val;
+}
+
+double put (int n, double val)
+{
+ if (n <= 0) {
+ VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", n, stack_size));
+ return 0;
+ }
+ if (n > stack_size) {
+ double *tmp = (double *) callocordie (n, sizeof (double));
+ memcpy (tmp, stack, stack_size * sizeof (double));
+ free (stack);
+ stack = tmp;
+ stack_size = n;
+ }
+ stack[n - 1] = val;
+ return val;
+}
+
+double set (int nbops, element_t **ops)
+{
+ int i;
+ if (stack) {
+ free (stack);
+ }
+ stack = NULL;
+ stack_size = 0;
+ if (nbops != 0) {
+ stack = (double *) callocordie (nbops, sizeof (double));
+ for (i = 0; i < nbops; i++) {
+ stack[i] = evaluate_element (ops[i], 0);
+ }
+ stack_size = nbops;
+ }
+ return stack_size;
+}
+
+void show (void)
+{
+ int i;
+ fprintf (stdout, "stack:");
+ for (i = 0; i < stack_size; i++) {
+ fprintf (stdout, " ");
+ fprintf (stdout, minform, stack[i]);
+ }
+ fprintf (stdout, "\n");
+}
+
+/* stack functions */
+
+double max ()
+{
+ double ret = 0;
+ int i;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ ret = stack[0];
+ for (i = 1; i < stack_size; i++) {
+ if (stack[i] > ret) {
+ ret = stack[i];
+ }
+ }
+ return ret;
+}
+
+double mean ()
+{
+ double ret = 0;
+ int i;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ for (i = 0; i < stack_size; i++) {
+ ret += stack[i];
+ }
+ return ret / stack_size;
+}
+
+double min ()
+{
+ double ret = 0;
+ int i;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ ret = stack[0];
+ for (i = 1; i < stack_size; i++) {
+ if (stack[i] < ret) {
+ ret = stack[i];
+ }
+ }
+ return ret;
+}
+
+void order ()
+{
+ int i, j;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return;
+ }
+ for (i = 0; i < stack_size - 1; i++) {
+ int done = 0;
+ for (j = 0; j < stack_size - 1; j++) {
+ if (stack[j] > stack[j + 1]) {
+ double tmp = stack[j];
+ stack[j] = stack[j + 1];
+ stack[j + 1] = tmp;
+ done = 1;
+ }
+ }
+ if (done == 0) {
+ break;
+ }
+ }
+}
+
+double median ()
+{
+ double ret = 0;
+ if (stack_size < 3) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ double *tmp = (double *) callocordie (stack_size, sizeof (double));
+ memcpy (tmp, stack, stack_size * sizeof (double));
+ order ();
+ ret = stack[(stack_size - 1)/ 2];
+ memcpy (stack, tmp, stack_size * sizeof (double));
+ free (tmp);
+ return ret;
+}
+
+double prod ()
+{
+ double ret = 1;
+ int i;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ for (i = 0; i < stack_size; i++) {
+ ret *= stack[i];
+ }
+ return ret;
+}
+
+double sum ()
+{
+ double ret = 0;
+ int i;
+ if (stack_size < 1) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ for (i = 0; i < stack_size; i++) {
+ ret += stack[i];
+ }
+ return ret;
+}
+
+double variance ()
+{
+ double ret = 0;
+ double m = 0;
+ int i;
+ if (stack_size < 2) {
+ VERBOSE (WARNING, fprintf (stdout, "error not enough element in stack (%d)\n", stack_size));
+ return 0;
+ }
+ m = mean ();
+ for (i = 0; i < stack_size; i++) {
+ ret += (stack[i] - m) * (stack[i] - m);
+ }
+ return ret / stack_size;
+}
+
+