Annotation of OpenXM/src/ox_gsl/ox_gsl.c, Revision 1.9
1.9 ! takayama 1: /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.8 2018/04/17 00:56:38 takayama Exp $
1.1 takayama 2: */
3:
4: #include <stdio.h>
5: #include <stdlib.h>
1.2 takayama 6: #include <setjmp.h>
7: #include <string.h>
1.3 takayama 8: #include <unistd.h>
9: #include <math.h>
10: #include "ox_gsl.h"
11: #include "call_gsl.h" // need only when you bind call_gsl functions.
1.1 takayama 12:
13: OXFILE *fd_rw;
14:
15: #define INIT_S_SIZE 2048
16: #define EXT_S_SIZE 2048
17:
18: static int stack_size = 0;
19: static int stack_pointer = 0;
20: static cmo **stack = NULL;
21:
22: int Debug=1;
23:
1.2 takayama 24: void show_stack_top() {
1.1 takayama 25: cmo *data;
26: if (stack_pointer > 0) {
27: data=stack[stack_pointer-1];
1.2 takayama 28: print_cmo(data); printf("\n");
1.1 takayama 29: }else {
30: printf("The stack is empty.\n");
31: }
32: }
33:
1.3 takayama 34: void *gc_realloc(void *p,size_t osize,size_t nsize)
35: { return (void *)GC_realloc(p,nsize);}
36:
37: void gc_free(void *p,size_t size)
38: { GC_free(p);}
39:
1.1 takayama 40: void init_gc()
1.3 takayama 41: { GC_INIT();
42: mp_set_memory_functions(GC_malloc,gc_realloc,gc_free);
1.5 takayama 43: init_dic(); // initialize ox_eval.c
1.1 takayama 44: }
45:
1.2 takayama 46: void initialize_stack()
1.1 takayama 47: {
48: stack_pointer = 0;
49: stack_size = INIT_S_SIZE;
1.3 takayama 50: stack = GC_malloc(stack_size*sizeof(cmo*));
1.1 takayama 51: }
52:
1.2 takayama 53: static void extend_stack()
1.1 takayama 54: {
55: int size2 = stack_size + EXT_S_SIZE;
56: cmo **stack2 = malloc(size2*sizeof(cmo*));
57: memcpy(stack2, stack, stack_size*sizeof(cmo *));
58: free(stack);
59: stack = stack2;
60: stack_size = size2;
61: }
62:
1.2 takayama 63: void push(cmo* m)
1.1 takayama 64: {
65: stack[stack_pointer] = m;
66: stack_pointer++;
67: if (stack_pointer >= stack_size) {
68: extend_stack();
69: }
70: }
71:
72: cmo* pop()
73: {
74: if (stack_pointer > 0) {
75: stack_pointer--;
76: return stack[stack_pointer];
77: }
78: return new_cmo_null();
79: }
80:
81: void pops(int n)
82: {
83: stack_pointer -= n;
84: if (stack_pointer < 0) {
85: stack_pointer = 0;
86: }
87: }
88:
89: #define OX_GSL_VERSION 2018032901
90: #define ID_STRING "2018/03/29 13:56:00"
91:
92: int sm_mathcap()
93: {
1.2 takayama 94: int available_cmo[]={
95: CMO_NULL,
96: CMO_INT32,
97: // CMO_DATUM,
98: CMO_STRING,
99: CMO_MATHCAP,
100: CMO_LIST,
101: // CMO_MONOMIAL32,
102: CMO_ZZ,
103: // CMO_QQ,
104: CMO_BIGFLOAT32,
105: CMO_COMPLEX,
106: CMO_IEEE_DOUBLE_FLOAT,
107: CMO_ZERO,
108: // CMO_DMS_GENERIC,
109: // CMO_RING_BY_NAME,
110: // CMO_INDETERMINATE,
111: // CMO_DISTRIBUTED_POLYNOMIAL,
112: // CMO_RECURSIVE_POLYNOMIAL,
113: // CMO_POLYNOMIAL_IN_ONE_VARIABLE,
1.5 takayama 114: CMO_TREE,
1.2 takayama 115: CMO_ERROR2,
116: 0};
117: int available_sm_command[]={
118: SM_popCMO,
119: SM_popString,
120: SM_mathcap,
121: SM_pops,
122: // SM_executeStringByLocalParser,
123: SM_executeFunction,
124: SM_setMathCap,
125: SM_shutdown,
126: SM_control_kill,
127: SM_control_reset_connection,
128: SM_control_spawn_server,
129: SM_control_terminate_server,
130: 0};
131: mathcap_init(OX_GSL_VERSION, ID_STRING, "ox_gsl", available_cmo,available_sm_command);
132: push((cmo *)oxf_cmo_mathcap(fd_rw));
1.1 takayama 133: return 0;
134: }
135:
136: int sm_popCMO()
137: {
138: cmo* m = pop();
139:
140: if (m != NULL) {
141: send_ox_cmo(fd_rw, m);
142: return 0;
143: }
144: return SM_popCMO;
145: }
146:
1.3 takayama 147: cmo *make_error2(const char *reason,const char *fname,int line,int code)
1.1 takayama 148: {
1.3 takayama 149: // gsl_error_handler_t void handler(const char *reason,const char *file,int line, int gsl_errno)
150: cmo *ms;
151: cmo *err;
152: cmo *m;
153: cmo **argv;
154: int n;
155: char *s;
156: n = 5;
157: argv = (cmo **) GC_malloc(sizeof(cmo *)*n);
158: ms = (cmo *)new_cmo_string("Error"); argv[0] = ms;
1.4 takayama 159: if (reason != NULL) {s = (char *)GC_malloc(strlen(reason)+1); strcpy(s,reason);
160: }else strcpy(s,"");
1.3 takayama 161: ms = (cmo *) new_cmo_string(s); argv[1] = ms;
1.4 takayama 162: if (fname != NULL) {s = (char *)GC_malloc(strlen(fname)+1); strcpy(s,fname);
163: }else strcpy(s,"");
1.3 takayama 164: ms = (cmo *) new_cmo_string(s); argv[2] = ms;
165: err = (cmo *)new_cmo_int32(line); argv[3] = err;
166: err = (cmo *)new_cmo_int32(code); argv[4] = err;
167:
168: m = (cmo *)new_cmo_list_array((void *)argv,n);
169: return (m);
1.1 takayama 170: }
171:
172: int get_i()
173: {
174: cmo *c = pop();
175: if (c->tag == CMO_INT32) {
176: return ((cmo_int32 *)c)->i;
177: }else if (c->tag == CMO_ZZ) {
178: return mpz_get_si(((cmo_zz *)c)->mpz);
1.2 takayama 179: }else if (c->tag == CMO_NULL) {
180: return(0);
181: }else if (c->tag == CMO_ZERO) {
182: return(0);
1.1 takayama 183: }
1.4 takayama 184: myhandler("get_i: not an integer",NULL,0,-1);
1.1 takayama 185: return 0;
186: }
187:
1.2 takayama 188: void get_xy(int *x, int *y)
1.1 takayama 189: {
190: pop();
191: *x = get_i();
192: *y = get_i();
193: }
194:
1.2 takayama 195: void my_add_int32()
1.1 takayama 196: {
197: int x, y;
198: get_xy(&x, &y);
1.2 takayama 199: push((cmo *)new_cmo_int32(x+y));
1.1 takayama 200: }
201:
1.2 takayama 202: double get_double()
203: {
1.3 takayama 204: #define mympz(c) (((cmo_zz *)c)->mpz)
1.2 takayama 205: cmo *c = pop();
206: if (c->tag == CMO_INT32) {
207: return( (double) (((cmo_int32 *)c)->i) );
208: }else if (c->tag == CMO_IEEE_DOUBLE_FLOAT) {
1.3 takayama 209: return (((cmo_double *)c)->d); // see ox_toolkit.h
1.2 takayama 210: }else if (c->tag == CMO_ZZ) {
1.3 takayama 211: if ((mpz_cmp_si(mympz(c),(long int) 0x7fffffff)>0) ||
212: (mpz_cmp_si(mympz(c),(long int) -0x7fffffff)<0)) {
1.4 takayama 213: myhandler("get_double: out of int32",NULL,0,-1);
1.3 takayama 214: return(NAN);
215: }
216: return( (double) mpz_get_si(((cmo_zz *)c)->mpz));
1.2 takayama 217: }else if (c->tag == CMO_NULL) {
218: return(0);
219: }else if (c->tag == CMO_ZERO) {
220: return(0);
221: }
1.4 takayama 222: myhandler("get_double: not a double",NULL,0,-1);
1.3 takayama 223: return(NAN);
1.2 takayama 224: }
225:
226: void my_add_double() {
227: double x,y;
228: pop();
229: y = get_double();
230: x = get_double();
231: push((cmo *)new_cmo_double(x+y));
232: }
233:
234: double *get_double_list(int *length) {
235: cmo *c;
236: cmo *entry;
237: cell *cellp;
238: double *d;
239: int n,i;
240: c = pop();
241: if (c->tag != CMO_LIST) {
1.3 takayama 242: // make_error2("get_double_list",NULL,0,-1);
1.2 takayama 243: *length=-1; return(0);
244: }
245: n = *length = list_length((cmo_list *)c);
246: d = (double *) GC_malloc(sizeof(double)*(*length+1));
247: cellp = list_first((cmo_list *)c);
248: entry = cellp->cmo;
249: for (i=0; i<n; i++) {
250: if (Debug) {
251: printf("entry[%d]=",i); print_cmo(entry); printf("\n");
252: }
253: if (entry->tag == CMO_INT32) {
254: d[i]=( (double) (((cmo_int32 *)entry)->i) );
255: }else if (entry->tag == CMO_IEEE_DOUBLE_FLOAT) {
256: d[i]=((cmo_double *)entry)->d;
257: }else if (entry->tag == CMO_ZZ) {
258: d[i]=( (double) mpz_get_si(((cmo_zz *)entry)->mpz));
259: }else if (entry->tag == CMO_NULL) {
260: d[i]= 0;
261: }else {
262: fprintf(stderr,"entries of the list should be int32 or zz or double\n");
263: *length = -1;
1.3 takayama 264: myhandler("get_double_list",NULL,0,-1);
1.2 takayama 265: return(NULL);
266: }
267: cellp = list_next(cellp);
268: entry = cellp->cmo;
269: }
270: return(d);
271: }
272: void show_double_list() {
273: int n;
274: double *d;
275: int i;
276: pop(); // pop argument number;
277: d = get_double_list(&n);
1.3 takayama 278: if (n < 0) fprintf(stderr,"Error in the double list\n");
1.2 takayama 279: printf("show_double_list: length=%d\n",n);
280: for (i=0; i<n; i++) {
281: printf("%lg, ",d[i]);
282: }
283: printf("\n");
284: }
285:
286: char *get_string() {
287: cmo *c;
288: c = pop();
289: if (c->tag == CMO_STRING) {
290: return (((cmo_string *)c)->s);
291: }
1.3 takayama 292: // make_error2(-1);
1.2 takayama 293: return(NULL);
294: }
1.1 takayama 295:
1.7 takayama 296: void test_ox_eval() {
1.5 takayama 297: cmo *c;
298: double d=0;
299: pop();
1.7 takayama 300: c=pop();
1.5 takayama 301: if (Debug) {
1.7 takayama 302: ox_printf("cmo *c="); print_cmo(c); ox_printf("\n");
1.5 takayama 303: }
1.6 ohara 304: init_dic();
1.5 takayama 305: register_entry("x",1.25);
1.7 takayama 306: if (eval_cmo(c,&d) == 0) myhandler("eval_cmo failed",NULL,0,-1);
1.5 takayama 307: push((cmo *)new_cmo_double(d));
308: }
309:
1.1 takayama 310: int sm_executeFunction()
311: {
312: cmo_string *func = (cmo_string *)pop();
313: if (func->tag != CMO_STRING) {
1.3 takayama 314: push(make_error2("sm_executeFunction, not CMO_STRING",NULL,0,-1));
1.1 takayama 315: return -1;
316: }
1.9 ! takayama 317: init_dic();
1.2 takayama 318: // Test functions
1.1 takayama 319: if (strcmp(func->s, "add_int32") == 0) {
320: my_add_int32();
1.2 takayama 321: }else if (strcmp(func->s,"add_double")==0) {
322: my_add_double();
323: }else if (strcmp(func->s,"show_double_list")==0) {
324: show_double_list();
1.3 takayama 325: }else if (strcmp(func->s,"restart")==0) {
326: pop(); restart();
1.5 takayama 327: }else if (strcmp(func->s,"test_ox_eval")==0) {
328: test_ox_eval();
1.2 takayama 329: // The following functions are defined in call_gsl.c
330: }else if (strcmp(func->s,"gsl_sf_lngamma_complex_e")==0) {
331: call_gsl_sf_lngamma_complex_e();
1.8 takayama 332: }else if (strcmp(func->s,"gsl_integration_qags")==0) {
333: call_gsl_integration_qags();
1.1 takayama 334: }else {
1.3 takayama 335: push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
1.1 takayama 336: return -1;
1.2 takayama 337: }
338: return(0);
1.1 takayama 339: }
340:
341:
342: int receive_and_execute_sm_command()
343: {
344: int code = receive_int32(fd_rw);
345: switch(code) {
346: case SM_popCMO:
347: sm_popCMO();
348: break;
349: case SM_executeFunction:
350: sm_executeFunction();
351: break;
352: case SM_mathcap:
353: sm_mathcap();
354: break;
355: case SM_setMathCap:
356: pop();
357: break;
358: default:
359: ;
360: }
1.2 takayama 361: return(0);
1.1 takayama 362: }
363:
364: int receive()
365: {
366: int tag;
367:
368: tag = receive_ox_tag(fd_rw);
369: switch(tag) {
370: case OX_DATA:
371: push(receive_cmo(fd_rw));
372: if (Debug) show_stack_top();
373: break;
374: case OX_COMMAND:
375: if (Debug) show_stack_top();
376: receive_and_execute_sm_command();
377: break;
378: default:
379: ;
380: }
381: return 0;
382: }
383:
1.2 takayama 384: jmp_buf Ox_env;
1.3 takayama 385: int Ox_intr_usr1=0;
1.2 takayama 386: void usr1_handler(int sig)
387: {
1.3 takayama 388: Ox_intr_usr1=1;
389: longjmp(Ox_env,1);
390: }
391: void restart() {
392: Ox_intr_usr1=0;
1.2 takayama 393: longjmp(Ox_env,1);
394: }
395:
1.3 takayama 396: void myhandler(const char *reason,const char *file,int line, int gsl_errno) {
397: cmo *m;
398: FILE *fp;
399: char logname[1024];
400: sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
401: fp = fopen(logname,"w");
402: fprintf(fp,"%d\n",gsl_errno);
403: fprintf(fp,"%d\n",line);
404: if (file != NULL) fprintf(fp,"%s\n",file); else fprintf(fp,"file?\n");
405: if (reason != NULL) fprintf(fp,"%s\n",reason); else fprintf(fp,"reason?\n");
1.4 takayama 406: fflush(NULL); fclose(fp);
1.3 takayama 407: // m = make_error2(reason,file,line,gsl_errno);
408: // send_ox_cmo(fd_rw, m); ox_flush(fd_rw);
409: // send error packet even it is not asked. Todo, OK? --> no
410: restart();
411: }
412: void push_error_from_file() {
413: FILE *fp;
414: #define BUF_SIZE 1024
415: char logname[BUF_SIZE];
416: char cmd[BUF_SIZE];
417: char file[BUF_SIZE];
418: char reason[BUF_SIZE];
419: int gsl_errno, line;
420: cmo *m;
421: fprintf(stderr,"push_error_from_file()\n");
422: sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
1.4 takayama 423: fp = fopen(logname,"r");
424: if (fp == NULL) {
425: fprintf(stderr,"open %s is failed\n",logname); return;
426: }
1.3 takayama 427: fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&gsl_errno);
428: fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&line);
1.4 takayama 429: #define remove_newline(s) {char *tmp_pos; if ((tmp_pos=strchr(s,'\n')) != NULL) *tmp_pos = '\0';}
430: fgets(file,BUF_SIZE-2,fp); remove_newline(file);
431: fgets(reason,BUF_SIZE-2,fp); remove_newline(reason);
1.3 takayama 432: fclose(fp);
433: m = make_error2(reason,file,line,gsl_errno);
434: push(m);
435: sprintf(cmd,"rm -f %s",logname);
436: system(cmd);
437: }
1.1 takayama 438: int main()
439: {
1.2 takayama 440: if ( setjmp(Ox_env) ) {
1.3 takayama 441: fprintf(stderr,"resetting libgsl ...");
1.2 takayama 442: initialize_stack();
1.3 takayama 443: if (Ox_intr_usr1) {
444: fprintf(stderr,"and sending OX_SYNC_BALL...");
445: send_ox_tag(fd_rw,OX_SYNC_BALL);
446: }
1.2 takayama 447: fprintf(stderr,"done\n");
1.3 takayama 448: Ox_intr_usr1=0;
449: push_error_from_file();
1.2 takayama 450: }else{
1.1 takayama 451: ox_stderr_init(stderr);
452: initialize_stack();
453: init_gc();
454: fd_rw = oxf_open(3);
455: oxf_determine_byteorder_server(fd_rw);
1.2 takayama 456: }
457: signal(SIGUSR1,usr1_handler);
458:
459: while(1) {
460: receive();
461: }
462: return(0);
1.1 takayama 463: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ox_gsl.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_gsl