[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.1 and 1.4

version 1.1, 2018/03/29 05:47:11 version 1.4, 2018/03/30 08:48:23
Line 1 
Line 1 
 /* $OpenXM$  /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.3 2018/03/30 04:43:16 takayama Exp $
 */  */
   
 #include <stdio.h>  #include <stdio.h>
 #include <stdlib.h>  #include <stdlib.h>
 #include "ox_toolkit.h"  #include <setjmp.h>
   #include <string.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 16  static cmo **stack = NULL;
Line 21  static cmo **stack = NULL;
   
 int Debug=1;  int Debug=1;
   
 int show_stack_top() {  void show_stack_top() {
   cmo *data;    cmo *data;
   if (stack_pointer > 0) {    if (stack_pointer > 0) {
     data=stack[stack_pointer-1];      data=stack[stack_pointer-1];
     printf("tag=%d\n",data->tag);      print_cmo(data); printf("\n");
   }else {    }else {
     printf("The stack is empty.\n");      printf("The stack is empty.\n");
   }    }
 }  }
   
   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);
 }  }
   
 int 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 int extend_stack()  static void extend_stack()
 {  {
     int size2 = stack_size + EXT_S_SIZE;      int size2 = stack_size + EXT_S_SIZE;
     cmo **stack2 = malloc(size2*sizeof(cmo*));      cmo **stack2 = malloc(size2*sizeof(cmo*));
Line 48  static int extend_stack()
Line 59  static int extend_stack()
     stack_size = size2;      stack_size = size2;
 }  }
   
 int push(cmo* m)  void push(cmo* m)
 {  {
     stack[stack_pointer] = m;      stack[stack_pointer] = m;
     stack_pointer++;      stack_pointer++;
Line 79  void pops(int n)
Line 90  void pops(int n)
   
 int sm_mathcap()  int sm_mathcap()
 {  {
     mathcap_init(OX_GSL_VERSION, ID_STRING, "ox_gsl", NULL, NULL);    int available_cmo[]={
     push(oxf_cmo_mathcap(fd_rw));      CMO_NULL,
       CMO_INT32,
   //    CMO_DATUM,
       CMO_STRING,
       CMO_MATHCAP,
       CMO_LIST,
   //    CMO_MONOMIAL32,
       CMO_ZZ,
   //    CMO_QQ,
       CMO_BIGFLOAT32,
       CMO_COMPLEX,
       CMO_IEEE_DOUBLE_FLOAT,
       CMO_ZERO,
   //    CMO_DMS_GENERIC,
   //    CMO_RING_BY_NAME,
   //    CMO_INDETERMINATE,
   //    CMO_DISTRIBUTED_POLYNOMIAL,
   //    CMO_RECURSIVE_POLYNOMIAL,
   //    CMO_POLYNOMIAL_IN_ONE_VARIABLE,
       CMO_ERROR2,
       0};
     int available_sm_command[]={
       SM_popCMO,
       SM_popString,
       SM_mathcap,
       SM_pops,
   //    SM_executeStringByLocalParser,
       SM_executeFunction,
       SM_setMathCap,
       SM_shutdown,
       SM_control_kill,
       SM_control_reset_connection,
       SM_control_spawn_server,
       SM_control_terminate_server,
       0};
       mathcap_init(OX_GSL_VERSION, ID_STRING, "ox_gsl", available_cmo,available_sm_command);
       push((cmo *)oxf_cmo_mathcap(fd_rw));
     return 0;      return 0;
 }  }
   
Line 95  int sm_popCMO()
Line 142  int sm_popCMO()
     return SM_popCMO;      return SM_popCMO;
 }  }
   
 cmo_error2 *make_error2(int code)  cmo *make_error2(const char *reason,const char *fname,int line,int code)
 {  {
     return new_cmo_int32(-1);  // gsl_error_handler_t void handler(const char *reason,const char *file,int line, int gsl_errno)
       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); strcpy(s,reason);
       }else strcpy(s,"");
       ms = (cmo *) new_cmo_string(s); argv[1] = ms;
       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;
   
       m = (cmo *)new_cmo_list_array((void *)argv,n);
       return (m);
 }  }
   
 int get_i()  int get_i()
Line 107  int get_i()
Line 174  int get_i()
         return ((cmo_int32 *)c)->i;          return ((cmo_int32 *)c)->i;
     }else if (c->tag == CMO_ZZ) {      }else if (c->tag == CMO_ZZ) {
         return mpz_get_si(((cmo_zz *)c)->mpz);          return mpz_get_si(((cmo_zz *)c)->mpz);
       }else if (c->tag == CMO_NULL) {
           return(0);
       }else if (c->tag == CMO_ZERO) {
           return(0);
     }      }
     make_error2(-1);      myhandler("get_i: not an integer",NULL,0,-1);
     return 0;      return 0;
 }  }
   
 int get_xy(int *x, int *y)  void get_xy(int *x, int *y)
 {  {
     pop();      pop();
     *x = get_i();      *x = get_i();
     *y = get_i();      *y = get_i();
 }  }
   
 int my_add_int32()  void my_add_int32()
 {  {
     int x, y;      int x, y;
     get_xy(&x, &y);      get_xy(&x, &y);
     push(new_cmo_int32(x+y));      push((cmo *)new_cmo_int32(x+y));
 }  }
   
   double get_double()
   {
   #define mympz(c) (((cmo_zz *)c)->mpz)
       cmo *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("get_double: not a double",NULL,0,-1);
       return(NAN);
   }
   
   void my_add_double() {
     double x,y;
     pop();
     y = get_double();
     x = get_double();
     push((cmo *)new_cmo_double(x+y));
   }
   
   double *get_double_list(int *length) {
     cmo *c;
     cmo *entry;
     cell *cellp;
     double *d;
     int n,i;
     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;
     int i;
     pop(); // pop argument number;
     d = get_double_list(&n);
     if (n < 0) fprintf(stderr,"Error in the double list\n");
     printf("show_double_list: length=%d\n",n);
     for (i=0; i<n; i++) {
       printf("%lg, ",d[i]);
     }
     printf("\n");
   }
   
   char *get_string() {
     cmo *c;
     c = pop();
     if (c->tag == CMO_STRING) {
       return (((cmo_string *)c)->s);
     }
     // make_error2(-1);
     return(NULL);
   }
   
 int sm_executeFunction()  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
     if (strcmp(func->s, "add_int32") == 0) {      if (strcmp(func->s, "add_int32") == 0) {
         my_add_int32();          my_add_int32();
       }else if (strcmp(func->s,"add_double")==0) {
           my_add_double();
       }else if (strcmp(func->s,"show_double_list")==0) {
           show_double_list();
       }else if (strcmp(func->s,"restart")==0) {
           pop(); restart();
       // 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 {      }else {
         push(make_error2(0));          push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
         return -1;          return -1;
     }      }
       return(0);
 }  }
   
   
Line 162  int receive_and_execute_sm_command()
Line 337  int receive_and_execute_sm_command()
     default:      default:
                 ;                  ;
     }      }
       return(0);
 }  }
   
 int receive()  int receive()
Line 184  int receive()
Line 360  int receive()
     return 0;      return 0;
 }  }
   
   jmp_buf Ox_env;
   int Ox_intr_usr1=0;
   void usr1_handler(int sig)
   {
     Ox_intr_usr1=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);
     // 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,"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);
   #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);
     sprintf(cmd,"rm -f %s",logname);
     system(cmd);
   }
 int main()  int main()
 {  {
     if ( setjmp(Ox_env) ) {
       fprintf(stderr,"resetting libgsl ...");
       initialize_stack();
       if (Ox_intr_usr1) {
         fprintf(stderr,"and sending OX_SYNC_BALL...");
         send_ox_tag(fd_rw,OX_SYNC_BALL);
       }
       fprintf(stderr,"done\n");
       Ox_intr_usr1=0;
       push_error_from_file();
     }else{
     ox_stderr_init(stderr);      ox_stderr_init(stderr);
     initialize_stack();      initialize_stack();
     init_gc();      init_gc();
   
     fd_rw = oxf_open(3);      fd_rw = oxf_open(3);
     oxf_determine_byteorder_server(fd_rw);      oxf_determine_byteorder_server(fd_rw);
     }
     while(1) {    signal(SIGUSR1,usr1_handler);
         receive();  
     }    while(1) {
       receive();
     }
     return(0);
 }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>