Annotation of OpenXM/src/ox_gsl/ox_gsl.c, Revision 1.6
1.6 ! ohara 1: /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.5 2018/04/04 01:03:59 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.5 takayama 296: cmo_tree *get_tree() {
297: cmo *c;
298: c = pop();
299: if (c->tag == CMO_TREE) {
300: return ((cmo_tree *)c);
301: }
302: make_error2("cmo_tree is expected",NULL,0,-1);
303: return(NULL);
304: }
305: void print_tree(cmo_tree *c) {
306: if (c->tag != CMO_TREE) {
307: printf("Error: argument is not CMO_TREE\n");
308: return;
309: }
1.6 ! ohara 310: print_cmo((cmo *)c);
! 311: /*
1.5 takayama 312: ox_printf("(name="); print_cmo((cmo *)(c->name)); ox_printf(",");
313: ox_printf("leaves="); print_cmo((cmo *)(c->leaves)); ox_printf(")");
1.6 ! ohara 314: */
1.5 takayama 315: }
316: void test_ox_eval() {
317: cmo_tree *c;
318: double d=0;
319: pop();
320: c = get_tree();
321: if (Debug) {
322: ox_printf("cmo_tree *c="); print_tree(c); ox_printf("\n");
323: }
1.6 ! ohara 324: init_dic();
1.5 takayama 325: register_entry("x",1.25);
326: if (eval_cmo(c,&d) == 0) make_error2("eval_cmo failed",NULL,0,-1);
327: push((cmo *)new_cmo_double(d));
328: }
329:
1.1 takayama 330: int sm_executeFunction()
331: {
332: cmo_string *func = (cmo_string *)pop();
333: if (func->tag != CMO_STRING) {
1.3 takayama 334: push(make_error2("sm_executeFunction, not CMO_STRING",NULL,0,-1));
1.1 takayama 335: return -1;
336: }
1.2 takayama 337: // Test functions
1.1 takayama 338: if (strcmp(func->s, "add_int32") == 0) {
339: my_add_int32();
1.2 takayama 340: }else if (strcmp(func->s,"add_double")==0) {
341: my_add_double();
342: }else if (strcmp(func->s,"show_double_list")==0) {
343: show_double_list();
1.3 takayama 344: }else if (strcmp(func->s,"restart")==0) {
345: pop(); restart();
1.5 takayama 346: }else if (strcmp(func->s,"test_ox_eval")==0) {
347: test_ox_eval();
1.2 takayama 348: // The following functions are defined in call_gsl.c
349: }else if (strcmp(func->s,"gsl_sf_lngamma_complex_e")==0) {
350: call_gsl_sf_lngamma_complex_e();
1.1 takayama 351: }else {
1.3 takayama 352: push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
1.1 takayama 353: return -1;
1.2 takayama 354: }
355: return(0);
1.1 takayama 356: }
357:
358:
359: int receive_and_execute_sm_command()
360: {
361: int code = receive_int32(fd_rw);
362: switch(code) {
363: case SM_popCMO:
364: sm_popCMO();
365: break;
366: case SM_executeFunction:
367: sm_executeFunction();
368: break;
369: case SM_mathcap:
370: sm_mathcap();
371: break;
372: case SM_setMathCap:
373: pop();
374: break;
375: default:
376: ;
377: }
1.2 takayama 378: return(0);
1.1 takayama 379: }
380:
381: int receive()
382: {
383: int tag;
384:
385: tag = receive_ox_tag(fd_rw);
386: switch(tag) {
387: case OX_DATA:
388: push(receive_cmo(fd_rw));
389: if (Debug) show_stack_top();
390: break;
391: case OX_COMMAND:
392: if (Debug) show_stack_top();
393: receive_and_execute_sm_command();
394: break;
395: default:
396: ;
397: }
398: return 0;
399: }
400:
1.2 takayama 401: jmp_buf Ox_env;
1.3 takayama 402: int Ox_intr_usr1=0;
1.2 takayama 403: void usr1_handler(int sig)
404: {
1.3 takayama 405: Ox_intr_usr1=1;
406: longjmp(Ox_env,1);
407: }
408: void restart() {
409: Ox_intr_usr1=0;
1.2 takayama 410: longjmp(Ox_env,1);
411: }
412:
1.3 takayama 413: void myhandler(const char *reason,const char *file,int line, int gsl_errno) {
414: cmo *m;
415: FILE *fp;
416: char logname[1024];
417: sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
418: fp = fopen(logname,"w");
419: fprintf(fp,"%d\n",gsl_errno);
420: fprintf(fp,"%d\n",line);
421: if (file != NULL) fprintf(fp,"%s\n",file); else fprintf(fp,"file?\n");
422: if (reason != NULL) fprintf(fp,"%s\n",reason); else fprintf(fp,"reason?\n");
1.4 takayama 423: fflush(NULL); fclose(fp);
1.3 takayama 424: // m = make_error2(reason,file,line,gsl_errno);
425: // send_ox_cmo(fd_rw, m); ox_flush(fd_rw);
426: // send error packet even it is not asked. Todo, OK? --> no
427: restart();
428: }
429: void push_error_from_file() {
430: FILE *fp;
431: #define BUF_SIZE 1024
432: char logname[BUF_SIZE];
433: char cmd[BUF_SIZE];
434: char file[BUF_SIZE];
435: char reason[BUF_SIZE];
436: int gsl_errno, line;
437: cmo *m;
438: fprintf(stderr,"push_error_from_file()\n");
439: sprintf(logname,"/tmp/ox_gsl-%d.txt",(int) getpid());
1.4 takayama 440: fp = fopen(logname,"r");
441: if (fp == NULL) {
442: fprintf(stderr,"open %s is failed\n",logname); return;
443: }
1.3 takayama 444: fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&gsl_errno);
445: fgets(cmd,BUF_SIZE-2,fp); sscanf(cmd,"%d",&line);
1.4 takayama 446: #define remove_newline(s) {char *tmp_pos; if ((tmp_pos=strchr(s,'\n')) != NULL) *tmp_pos = '\0';}
447: fgets(file,BUF_SIZE-2,fp); remove_newline(file);
448: fgets(reason,BUF_SIZE-2,fp); remove_newline(reason);
1.3 takayama 449: fclose(fp);
450: m = make_error2(reason,file,line,gsl_errno);
451: push(m);
452: sprintf(cmd,"rm -f %s",logname);
453: system(cmd);
454: }
1.1 takayama 455: int main()
456: {
1.2 takayama 457: if ( setjmp(Ox_env) ) {
1.3 takayama 458: fprintf(stderr,"resetting libgsl ...");
1.2 takayama 459: initialize_stack();
1.3 takayama 460: if (Ox_intr_usr1) {
461: fprintf(stderr,"and sending OX_SYNC_BALL...");
462: send_ox_tag(fd_rw,OX_SYNC_BALL);
463: }
1.2 takayama 464: fprintf(stderr,"done\n");
1.3 takayama 465: Ox_intr_usr1=0;
466: push_error_from_file();
1.2 takayama 467: }else{
1.1 takayama 468: ox_stderr_init(stderr);
469: initialize_stack();
470: init_gc();
471: fd_rw = oxf_open(3);
472: oxf_determine_byteorder_server(fd_rw);
1.2 takayama 473: }
474: signal(SIGUSR1,usr1_handler);
475:
476: while(1) {
477: receive();
478: }
479: return(0);
1.1 takayama 480: }
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