-/* 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;
-}
-
-