[BACK]Return to ox_gsl.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / ox_gsl

Diff for /OpenXM/src/ox_gsl/ox_gsl.c between version 1.2 and 1.3

version 1.2, 2018/03/29 11:52:18 version 1.3, 2018/03/30 04:43:16
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.1 2018/03/29 05:47:11 takayama Exp $  /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.2 2018/03/29 11:52:18 takayama Exp $
 */  */
   
 #include <stdio.h>  #include <stdio.h>
 #include <stdlib.h>  #include <stdlib.h>
 #include <setjmp.h>  #include <setjmp.h>
 #include <string.h>  #include <string.h>
 #include "ox_toolkit.h"  #include <unistd.h>
   #include <math.h>
   #include "ox_gsl.h"
   #include "call_gsl.h" // need only when you bind call_gsl functions.
   
 OXFILE *fd_rw;  OXFILE *fd_rw;
   
Line 28  void show_stack_top() {
Line 31  void show_stack_top() {
   }    }
 }  }
   
   void *gc_realloc(void *p,size_t osize,size_t nsize)
   { return (void *)GC_realloc(p,nsize);}
   
   void gc_free(void *p,size_t size)
   { GC_free(p);}
   
 void init_gc()  void init_gc()
 {  { GC_INIT();
   GC_INIT();    mp_set_memory_functions(GC_malloc,gc_realloc,gc_free);
 }  }
   
 void initialize_stack()  void initialize_stack()
 {  {
     stack_pointer = 0;      stack_pointer = 0;
     stack_size = INIT_S_SIZE;      stack_size = INIT_S_SIZE;
     stack = malloc(stack_size*sizeof(cmo*));      stack = GC_malloc(stack_size*sizeof(cmo*));
 }  }
   
 static void extend_stack()  static void extend_stack()
Line 133  int sm_popCMO()
Line 142  int sm_popCMO()
     return SM_popCMO;      return SM_popCMO;
 }  }
   
 cmo *make_error2(int code)  cmo *make_error2(const char *reason,const char *fname,int line,int code)
 {  {
     fprintf(stderr,"make_error2: not implemented.\n");  // gsl_error_handler_t void handler(const char *reason,const char *file,int line, int gsl_errno)
     return ((cmo *)new_cmo_int32(-1));      cmo *ms;
       cmo *err;
       cmo *m;
       cmo **argv;
       int n;
       char *s;
       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,"");
       ms = (cmo *) new_cmo_string(s); argv[1] = ms;
       if (reason != NULL) s = (char *)GC_malloc(strlen(fname)+1);
       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;
   
       m = (cmo *)new_cmo_list_array((void *)argv,n);
       return (m);
 }  }
   
 int get_i()  int get_i()
Line 151  int get_i()
Line 179  int get_i()
     }else if (c->tag == CMO_ZERO) {      }else if (c->tag == CMO_ZERO) {
         return(0);          return(0);
     }      }
     make_error2(-1);      myhandler("get_i, not an integer",NULL,0,-1);
     return 0;      return 0;
 }  }
   
Line 171  void my_add_int32()
Line 199  void my_add_int32()
   
 double get_double()  double get_double()
 {  {
   #define mympz(c) (((cmo_zz *)c)->mpz)
     cmo *c = pop();      cmo *c = pop();
     if (c->tag == CMO_INT32) {      if (c->tag == CMO_INT32) {
         return( (double) (((cmo_int32 *)c)->i) );          return( (double) (((cmo_int32 *)c)->i) );
     }else if (c->tag == CMO_IEEE_DOUBLE_FLOAT) {      }else if (c->tag == CMO_IEEE_DOUBLE_FLOAT) {
         return ((cmo_double *)c)->d;  // see ox_toolkit.h          return (((cmo_double *)c)->d);  // see ox_toolkit.h
     }else if (c->tag == CMO_ZZ) {      }else if (c->tag == CMO_ZZ) {
         return( (double) mpz_get_si(((cmo_zz *)c)->mpz));         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) {      }else if (c->tag == CMO_NULL) {
         return(0);          return(0);
     }else if (c->tag == CMO_ZERO) {      }else if (c->tag == CMO_ZERO) {
         return(0);          return(0);
     }      }
     make_error2(-1);      myhandler("get_double, not a double",NULL,0,-1);
     return 0;      return(NAN);
 }  }
   
 void my_add_double() {  void my_add_double() {
Line 203  double *get_double_list(int *length) {
Line 237  double *get_double_list(int *length) {
   int n,i;    int n,i;
   c = pop();    c = pop();
   if (c->tag != CMO_LIST) {    if (c->tag != CMO_LIST) {
     make_error2(-1);  //    make_error2("get_double_list",NULL,0,-1);
     *length=-1; return(0);      *length=-1; return(0);
   }    }
   n = *length = list_length((cmo_list *)c);    n = *length = list_length((cmo_list *)c);
Line 224  double *get_double_list(int *length) {
Line 258  double *get_double_list(int *length) {
       d[i]= 0;        d[i]= 0;
     }else {      }else {
       fprintf(stderr,"entries of the list should be int32 or zz or double\n");        fprintf(stderr,"entries of the list should be int32 or zz or double\n");
       make_error2(-1);  
       *length = -1;        *length = -1;
         myhandler("get_double_list",NULL,0,-1);
       return(NULL);        return(NULL);
     }      }
     cellp = list_next(cellp);      cellp = list_next(cellp);
Line 239  void show_double_list() {
Line 273  void show_double_list() {
   int i;    int i;
   pop(); // pop argument number;    pop(); // pop argument number;
   d = get_double_list(&n);    d = get_double_list(&n);
     if (n < 0) fprintf(stderr,"Error in the double list\n");
   printf("show_double_list: length=%d\n",n);    printf("show_double_list: length=%d\n",n);
   for (i=0; i<n; i++) {    for (i=0; i<n; i++) {
     printf("%lg, ",d[i]);      printf("%lg, ",d[i]);
Line 252  char *get_string() {
Line 287  char *get_string() {
   if (c->tag == CMO_STRING) {    if (c->tag == CMO_STRING) {
     return (((cmo_string *)c)->s);      return (((cmo_string *)c)->s);
   }    }
   make_error2(-1);    // make_error2(-1);
   return(NULL);    return(NULL);
 }  }
   
Line 260  int sm_executeFunction()
Line 295  int sm_executeFunction()
 {  {
     cmo_string *func = (cmo_string *)pop();      cmo_string *func = (cmo_string *)pop();
     if (func->tag != CMO_STRING) {      if (func->tag != CMO_STRING) {
         push(make_error2(0));          push(make_error2("sm_executeFunction, not CMO_STRING",NULL,0,-1));
         return -1;          return -1;
     }      }
     // Test functions      // Test functions
Line 270  int sm_executeFunction()
Line 305  int sm_executeFunction()
         my_add_double();          my_add_double();
     }else if (strcmp(func->s,"show_double_list")==0) {      }else if (strcmp(func->s,"show_double_list")==0) {
         show_double_list();          show_double_list();
       }else if (strcmp(func->s,"restart")==0) {
           pop(); restart();
     // The following functions are defined in call_gsl.c      // The following functions are defined in call_gsl.c
     }else if (strcmp(func->s,"gsl_sf_lngamma_complex_e")==0) {      }else if (strcmp(func->s,"gsl_sf_lngamma_complex_e")==0) {
         call_gsl_sf_lngamma_complex_e();          call_gsl_sf_lngamma_complex_e();
     }else {      }else {
         push(make_error2(0));          push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
         return -1;          return -1;
     }      }
     return(0);      return(0);
Line 324  int receive()
Line 361  int receive()
 }  }
   
 jmp_buf Ox_env;  jmp_buf Ox_env;
   int Ox_intr_usr1=0;
 void usr1_handler(int sig)  void usr1_handler(int sig)
 {  {
     Ox_intr_usr1=1;
   longjmp(Ox_env,1);    longjmp(Ox_env,1);
 }  }
   void restart() {
     Ox_intr_usr1=0;
     longjmp(Ox_env,1);
   }
   
   void myhandler(const char *reason,const char *file,int line, int gsl_errno) {
     cmo *m;
     FILE *fp;
     char logname[1024];
     sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
     fp = fopen(logname,"w");
     fprintf(fp,"%d\n",gsl_errno);
     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.
     // 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
     char logname[BUF_SIZE];
     char cmd[BUF_SIZE];
     char file[BUF_SIZE];
     char reason[BUF_SIZE];
     int gsl_errno, line;
     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;
     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);
     fclose(fp);
     m = make_error2(reason,file,line,gsl_errno);
     push(m);
     sprintf(cmd,"rm -f %s",logname);
     system(cmd);
   }
 int main()  int main()
 {  {
   if ( setjmp(Ox_env) ) {    if ( setjmp(Ox_env) ) {
     fprintf(stderr,"resetting libgsl and sending OX_SYNC_BALL...");      fprintf(stderr,"resetting libgsl ...");
     initialize_stack();      initialize_stack();
     send_ox_tag(fd_rw,OX_SYNC_BALL);      if (Ox_intr_usr1) {
         fprintf(stderr,"and sending OX_SYNC_BALL...");
         send_ox_tag(fd_rw,OX_SYNC_BALL);
       }
     fprintf(stderr,"done\n");      fprintf(stderr,"done\n");
       Ox_intr_usr1=0;
       push_error_from_file();
   }else{    }else{
     ox_stderr_init(stderr);      ox_stderr_init(stderr);
     initialize_stack();      initialize_stack();
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>