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