===================================================================
RCS file: /home/cvs/OpenXM/src/ox_gsl/ox_gsl.c,v
retrieving revision 1.3
retrieving revision 1.6
diff -u -p -r1.3 -r1.6
--- OpenXM/src/ox_gsl/ox_gsl.c	2018/03/30 04:43:16	1.3
+++ OpenXM/src/ox_gsl/ox_gsl.c	2018/04/05 10:50:17	1.6
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.2 2018/03/29 11:52:18 takayama Exp $
+/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.5 2018/04/04 01:03:59 takayama Exp $
 */
 
 #include <stdio.h>
@@ -40,6 +40,7 @@ void gc_free(void *p,size_t size)
 void init_gc()
 { GC_INIT();
   mp_set_memory_functions(GC_malloc,gc_realloc,gc_free);
+  init_dic();  // initialize ox_eval.c
 }
 
 void initialize_stack()
@@ -110,6 +111,7 @@ int sm_mathcap()
 //    CMO_DISTRIBUTED_POLYNOMIAL,
 //    CMO_RECURSIVE_POLYNOMIAL,
 //    CMO_POLYNOMIAL_IN_ONE_VARIABLE,
+    CMO_TREE,
     CMO_ERROR2,
     0};
   int available_sm_command[]={
@@ -154,11 +156,11 @@ cmo *make_error2(const char *reason,const char *fname,
     n = 5;
     argv = (cmo **) GC_malloc(sizeof(cmo *)*n);
     ms = (cmo *)new_cmo_string("Error"); argv[0] = ms; 
-    if (reason != NULL) s = (char *)GC_malloc(strlen(reason)+1);
-    else strcpy(s,"");
+    if (reason != NULL) {s = (char *)GC_malloc(strlen(reason)+1); strcpy(s,reason);
+    }else strcpy(s,"");
     ms = (cmo *) new_cmo_string(s); argv[1] = ms;
-    if (reason != NULL) s = (char *)GC_malloc(strlen(fname)+1);
-    else strcpy(s,"");
+    if (fname != NULL) {s = (char *)GC_malloc(strlen(fname)+1); strcpy(s,fname);
+    }else strcpy(s,"");
     ms = (cmo *) new_cmo_string(s); argv[2] = ms;
     err = (cmo *)new_cmo_int32(line); argv[3] = err;
     err = (cmo *)new_cmo_int32(code); argv[4] = err;
@@ -179,7 +181,7 @@ int get_i()
     }else if (c->tag == CMO_ZERO) {
         return(0);
     }
-    myhandler("get_i, not an integer",NULL,0,-1);
+    myhandler("get_i: not an integer",NULL,0,-1);
     return 0;
 }
 
@@ -208,7 +210,7 @@ double get_double()
     }else if (c->tag == CMO_ZZ) {
        if ((mpz_cmp_si(mympz(c),(long int) 0x7fffffff)>0) ||
            (mpz_cmp_si(mympz(c),(long int) -0x7fffffff)<0)) {
-	 myhandler("get_double, out of int32",NULL,0,-1);
+	 myhandler("get_double: out of int32",NULL,0,-1);
          return(NAN);
        }
        return( (double) mpz_get_si(((cmo_zz *)c)->mpz));
@@ -217,7 +219,7 @@ double get_double()
     }else if (c->tag == CMO_ZERO) {
         return(0);
     }
-    myhandler("get_double, not a double",NULL,0,-1);
+    myhandler("get_double: not a double",NULL,0,-1);
     return(NAN);
 }
 
@@ -291,6 +293,40 @@ char *get_string() {
   return(NULL);
 }
 
+cmo_tree *get_tree() {
+  cmo *c;
+  c = pop();
+  if (c->tag == CMO_TREE) {
+    return ((cmo_tree *)c);
+  }
+  make_error2("cmo_tree is expected",NULL,0,-1);
+  return(NULL);
+}
+void print_tree(cmo_tree *c) {
+  if (c->tag != CMO_TREE) {
+    printf("Error: argument is not CMO_TREE\n");
+    return;
+  }
+  print_cmo((cmo *)c);
+/*
+  ox_printf("(name="); print_cmo((cmo *)(c->name)); ox_printf(",");
+  ox_printf("leaves="); print_cmo((cmo *)(c->leaves)); ox_printf(")");
+*/
+}  
+void test_ox_eval() {
+  cmo_tree *c;
+  double d=0;
+  pop();
+  c = get_tree();
+  if (Debug) {
+    ox_printf("cmo_tree *c="); print_tree(c); ox_printf("\n");
+  }
+  init_dic();
+  register_entry("x",1.25);
+  if (eval_cmo(c,&d) == 0) make_error2("eval_cmo failed",NULL,0,-1);
+  push((cmo *)new_cmo_double(d));
+}
+
 int sm_executeFunction()
 {
     cmo_string *func = (cmo_string *)pop();
@@ -307,6 +343,8 @@ int sm_executeFunction()
         show_double_list();
     }else if (strcmp(func->s,"restart")==0) {
         pop(); restart();
+    }else if (strcmp(func->s,"test_ox_eval")==0) {
+        test_ox_eval();
     // The following functions are defined in call_gsl.c
     }else if (strcmp(func->s,"gsl_sf_lngamma_complex_e")==0) {
         call_gsl_sf_lngamma_complex_e();
@@ -382,13 +420,12 @@ void myhandler(const char *reason,const char *file,int
   fprintf(fp,"%d\n",line);
   if (file != NULL) fprintf(fp,"%s\n",file); else fprintf(fp,"file?\n");
   if (reason != NULL) fprintf(fp,"%s\n",reason); else fprintf(fp,"reason?\n");
-  fflush(NULL); fclose(fp);  // BUG. the contents are deleted after it is closed.
+  fflush(NULL); fclose(fp); 
   // m = make_error2(reason,file,line,gsl_errno);
   //  send_ox_cmo(fd_rw, m);  ox_flush(fd_rw); 
   // send error packet even it is not asked. Todo, OK? --> no
   restart();
 }
-
 void push_error_from_file() {
   FILE *fp;
 #define BUF_SIZE 1024
@@ -400,12 +437,15 @@ void push_error_from_file() {
   cmo *m;
   fprintf(stderr,"push_error_from_file()\n");
   sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
-  fp = fopen(logname,"w");
-  if (fp == NULL) return;
+  fp = fopen(logname,"r");
+  if (fp == NULL) {
+    fprintf(stderr,"open %s is failed\n",logname); return;
+  }
   fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&gsl_errno);
   fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&line);
-  fgets(file,BUF_SIZE-2,fp);
-  fgets(reason,BUF_SIZE-2,fp);
+#define remove_newline(s) {char *tmp_pos; if ((tmp_pos=strchr(s,'\n')) != NULL) *tmp_pos = '\0';}
+  fgets(file,BUF_SIZE-2,fp);  remove_newline(file);
+  fgets(reason,BUF_SIZE-2,fp); remove_newline(reason);
   fclose(fp);
   m = make_error2(reason,file,line,gsl_errno);
   push(m);