===================================================================
RCS file: /home/cvs/OpenXM/src/ox_gsl/ox_gsl.c,v
retrieving revision 1.8
retrieving revision 1.17
diff -u -p -r1.8 -r1.17
--- OpenXM/src/ox_gsl/ox_gsl.c	2018/04/17 00:56:38	1.8
+++ OpenXM/src/ox_gsl/ox_gsl.c	2019/10/23 07:00:43	1.17
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.7 2018/04/06 01:56:49 takayama Exp $
+/* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.16 2019/10/21 05:37:20 takayama Exp $
 */
 
 #include <stdio.h>
@@ -6,9 +6,11 @@
 #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.
+#include "call_gsl_sf.h"
 
 OXFILE *fd_rw;
 
@@ -222,6 +224,30 @@ double get_double()
     myhandler("get_double: not a double",NULL,0,-1);
     return(NAN);
 }
+/* get_double() will be obsolted and will be replaced by cmo2double(c) */
+double cmo2double(cmo *c)
+{
+#define mympz(c) (((cmo_zz *)c)->mpz)
+  if (c == NULL) c = pop();
+    if (c->tag == CMO_INT32) {
+        return( (double) (((cmo_int32 *)c)->i) );
+    }else if (c->tag == CMO_IEEE_DOUBLE_FLOAT) {
+        return (((cmo_double *)c)->d);  // see ox_toolkit.h
+    }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);
+         return(NAN);
+       }
+       return( (double) mpz_get_si(((cmo_zz *)c)->mpz));
+    }else if (c->tag == CMO_NULL) {
+        return(0);
+    }else if (c->tag == CMO_ZERO) {
+        return(0);
+    }
+    myhandler("cmo2double: not a double",NULL,0,-1);
+    return(NAN);
+}
 
 void my_add_double() {
   double x,y;
@@ -269,6 +295,44 @@ double *get_double_list(int *length) {
   }
   return(d);
 }
+/* get_double_list will be obsolted and will be replaced by cmo2double_list() */
+double *cmo2double_list(int *length,cmo *c) {
+  cmo *entry;
+  cell *cellp;
+  double *d;
+  int n,i;
+  if (c == NULL) c = pop();
+  if (c->tag != CMO_LIST) {
+//    make_error2("get_double_list",NULL,0,-1);
+    *length=-1; return(0);
+  }
+  n = *length = list_length((cmo_list *)c);
+  d = (double *) GC_malloc(sizeof(double)*(*length+1));
+  cellp = list_first((cmo_list *)c);
+  entry = cellp->cmo;
+  for (i=0; i<n; i++) {
+    if (Debug) {
+      printf("entry[%d]=",i); print_cmo(entry); printf("\n");
+    }
+    if (entry->tag == CMO_INT32) {
+      d[i]=( (double) (((cmo_int32 *)entry)->i) );
+    }else if (entry->tag == CMO_IEEE_DOUBLE_FLOAT) {
+      d[i]=((cmo_double *)entry)->d;  
+    }else if (entry->tag == CMO_ZZ) {
+      d[i]=( (double) mpz_get_si(((cmo_zz *)entry)->mpz));
+    }else if (entry->tag == CMO_NULL) {
+      d[i]= 0;
+    }else {
+      fprintf(stderr,"entries of the list should be int32 or zz or double\n");
+      *length = -1;
+      myhandler("get_double_list",NULL,0,-1);
+      return(NULL);
+    }
+    cellp = list_next(cellp);
+    entry = cellp->cmo;
+  }
+  return(d);
+}
 void show_double_list() {
   int n;
   double *d;
@@ -314,6 +378,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();
@@ -330,6 +395,18 @@ int sm_executeFunction()
         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 if (strcmp(func->s,"gsl_odeiv_step_rk4")==0) {
+        call_gsl_odeiv_step("rk4");
+    }else if (strcmp(func->s,"gsl_sf_gamma_inc")==0) {
+        call_gsl_sf_gamma_inc();
+    }else if (strcmp(func->s,"gsl_eigen_nonsymmv")==0) {
+        call_gsl_eigen_nonsymmv();
     }else {
         push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
         return -1;
@@ -453,10 +530,53 @@ 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]);  
+}
+
+int get_length(cmo *c) {
+  if (c->tag != CMO_LIST) {
+    return(-1);
+  }
+  return(list_length((cmo_list *)c));
 }