===================================================================
RCS file: /home/cvs/OpenXM/src/ox_gsl/ox_gsl.c,v
retrieving revision 1.5
retrieving revision 1.13
diff -u -p -r1.5 -r1.13
--- OpenXM/src/ox_gsl/ox_gsl.c	2018/04/04 01:03:59	1.5
+++ OpenXM/src/ox_gsl/ox_gsl.c	2018/06/07 11:13:05	1.13
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.4 2018/03/30 08:48:23 takayama Exp $
+/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.12 2018/06/07 01:53:33 takayama Exp $
 */
 
 #include <stdio.h>
@@ -6,6 +6,7 @@
 #include <setjmp.h>
 #include <string.h>
 #include <unistd.h>
+#include <signal.h>
 #include <math.h>
 #include "ox_gsl.h"
 #include "call_gsl.h" // need only when you bind call_gsl functions.
@@ -293,33 +294,17 @@ 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;
-  }
-  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;
+  cmo *c;
   double d=0;
   pop();
-  c = get_tree();
+  c=pop();
   if (Debug) {
-    ox_printf("cmo_tree *c="); print_tree(c); ox_printf("\n");
+    ox_printf("cmo *c="); print_cmo(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);
+  if (eval_cmo(c,&d) == 0) myhandler("eval_cmo failed",NULL,0,-1);
   push((cmo *)new_cmo_double(d));
 }
 
@@ -330,6 +315,7 @@ int sm_executeFunction()
         push(make_error2("sm_executeFunction, not CMO_STRING",NULL,0,-1));
         return -1;
     }
+    init_dic();
     // Test functions
     if (strcmp(func->s, "add_int32") == 0) {
         my_add_int32();
@@ -344,6 +330,14 @@ int sm_executeFunction()
     // 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();
+    }else if (strcmp(func->s,"gsl_integration_qags")==0) {
+        call_gsl_integration_qags();
+    }else if (strcmp(func->s,"gsl_monte_plain_integrate")==0) {
+        call_gsl_monte_plain_miser_vegas_integrate(0);
+    }else if (strcmp(func->s,"gsl_monte_miser_integrate")==0) {
+        call_gsl_monte_plain_miser_vegas_integrate(1);
+    }else if (strcmp(func->s,"gsl_monte_vegas_integrate")==0) {
+        call_gsl_monte_plain_miser_vegas_integrate(2);
     }else {
         push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
         return -1;
@@ -467,10 +461,46 @@ int main()
     fd_rw = oxf_open(3);
     oxf_determine_byteorder_server(fd_rw);
   }
+#if defined(__CYGWIN__)
+  void *mysignal(int sig,void (*handler)(int m));
+  mysignal(SIGUSR1,usr1_handler);
+#else
   signal(SIGUSR1,usr1_handler);
+#endif
   
   while(1) {
     receive();
   }
   return(0);
+}
+
+cmo *element_of_at(cmo *list,int k) {
+  int length;
+  static cmo * saved_list = NULL;
+  static cmo **dic;
+  int i;
+  cell *cellp;
+  if (list == NULL) {
+    ox_printf("element_of_at: list is NULL.\n");
+    return( (cmo *)NULL);
+  }
+  if (list->tag != CMO_LIST) {
+    ox_printf("element_of_at: list is not list.\n");
+    return((cmo *)NULL);
+  }
+  length = list_length((cmo_list *)list);
+  if ((k < 0) || (k >= length)) {
+    ox_printf("element_of_at: out of bound length=%d, k=%d.\n",length,k);
+    return((cmo *)NULL);
+  }
+  if (list == saved_list) return(dic[k]);
+  saved_list = list;
+  dic = (cmo **)GC_malloc(sizeof(cmo *)*(length+1));
+  if (dic == NULL) return((cmo *)NULL); // no more memory.
+  cellp = list_first((cmo_list *)list);
+  for (i=0; i<length; i++) {
+    dic[i] = cellp->cmo;
+    cellp = list_next(cellp);
+  }
+  return(dic[k]);  
 }