Annotation of OpenXM/src/ox_pari/ox_pari.c, Revision 1.16
1.16 ! noro 1: /* $OpenXM: OpenXM/src/ox_pari/ox_pari.c,v 1.15 2016/09/23 07:03:29 noro Exp $ */
1.12 noro 2:
3: #include "ox_pari.h"
1.1 noro 4:
5: OXFILE *fd_rw;
6:
7: static int stack_size = 0;
8: static int stack_pointer = 0;
9: static cmo **stack = NULL;
10: extern int debug_print;
1.2 noro 11: long paristack=10000000;
1.1 noro 12:
13: #define INIT_S_SIZE 2048
14: #define EXT_S_SIZE 2048
15:
1.3 noro 16: void *gc_realloc(void *p,size_t osize,size_t nsize)
17: {
18: return (void *)GC_realloc(p,nsize);
19: }
20:
21: void gc_free(void *p,size_t size)
22: {
23: GC_free(p);
24: }
25:
26: void init_gc()
27: {
1.4 noro 28: GC_INIT();
1.3 noro 29: mp_set_memory_functions(GC_malloc,gc_realloc,gc_free);
30: }
31:
1.1 noro 32: void init_pari()
33: {
1.2 noro 34: pari_init(paristack,2);
1.1 noro 35: }
36:
37: int initialize_stack()
38: {
1.4 noro 39: stack_pointer = 0;
40: stack_size = INIT_S_SIZE;
41: stack = MALLOC(stack_size*sizeof(cmo*));
42: return 0;
1.1 noro 43: }
44:
45: static int extend_stack()
46: {
1.4 noro 47: int size2 = stack_size + EXT_S_SIZE;
48: cmo **stack2 = MALLOC(size2*sizeof(cmo*));
49: memcpy(stack2, stack, stack_size*sizeof(cmo *));
50: free(stack);
51: stack = stack2;
52: stack_size = size2;
53: return 0;
1.1 noro 54: }
55:
56: int push(cmo* m)
57: {
1.4 noro 58: stack[stack_pointer] = m;
59: stack_pointer++;
60: if(stack_pointer >= stack_size) {
61: extend_stack();
62: }
63: return 0;
1.1 noro 64: }
65:
66: cmo* pop()
67: {
1.4 noro 68: if(stack_pointer > 0) {
69: stack_pointer--;
70: return stack[stack_pointer];
71: }
72: return new_cmo_null();
1.1 noro 73: }
74:
75: void pops(int n)
76: {
1.4 noro 77: stack_pointer -= n;
78: if(stack_pointer < 0) {
79: stack_pointer = 0;
80: }
1.1 noro 81: }
82:
83: #define OX_PARI_VERSION 20150731
84: #define ID_STRING "2015/07/31 15:00:00"
85:
86: int sm_mathcap()
87: {
1.16 ! noro 88: #if 0
1.14 ohara 89: char *opts[] = {"no_ox_reset", NULL};
90: mathcap_init2(OX_PARI_VERSION, ID_STRING, "ox_pari", NULL, NULL, opts);
1.16 ! noro 91: #else
! 92: mathcap_init2(OX_PARI_VERSION, ID_STRING, "ox_pari", NULL, NULL, NULL);
! 93: #endif
1.4 noro 94: push((cmo*)oxf_cmo_mathcap(fd_rw));
95: return 0;
1.1 noro 96: }
97:
98: int sm_popCMO()
99: {
1.4 noro 100: cmo* m = pop();
1.1 noro 101:
1.4 noro 102: if(m != NULL) {
103: send_ox_cmo(fd_rw, m);
104: return 0;
105: }
106: return SM_popCMO;
1.1 noro 107: }
108:
1.8 noro 109: cmo_error2 *make_error2(char *message)
1.1 noro 110: {
1.9 noro 111: return new_cmo_error2((cmo *)new_cmo_string(message));
1.1 noro 112: }
113:
114: int get_i()
115: {
1.4 noro 116: cmo *c = pop();
117: if(c->tag == CMO_INT32) {
118: return ((cmo_int32 *)c)->i;
119: }else if(c->tag == CMO_ZZ) {
120: return mpz_get_si(((cmo_zz *)c)->mpz);
121: }
1.8 noro 122: make_error2("get_i : invalid object");
1.4 noro 123: return 0;
1.1 noro 124: }
125:
126: char *get_str()
127: {
1.4 noro 128: cmo *c = pop();
129: if(c->tag == CMO_STRING) {
130: return ((cmo_string *)c)->s;
131: }
1.8 noro 132: make_error2("get_str : invalid object");
1.4 noro 133: return "";
1.1 noro 134: }
135:
1.8 noro 136: int ismatrix(GEN z)
137: {
138: int len,col,i;
139:
140: if ( typ(z) != t_VEC ) return 0;
141: if ( typ((GEN)z[1]) != t_VEC ) return 0;
142: len = lg(z); col = lg((GEN)z[1]);
143: for ( i = 2; i < len; i++ )
144: if ( lg((GEN)z[i]) != col ) return 0;
145: return 1;
146: }
147:
1.1 noro 148: int sm_executeFunction()
149: {
1.5 noro 150: pari_sp av0;
1.2 noro 151: int ac,i;
152: cmo_int32 *c;
153: cmo *av[PARI_MAX_AC];
154: cmo *ret;
155: GEN z,m;
1.3 noro 156: struct parif *parif;
1.7 noro 157: unsigned long prec;
1.8 noro 158: char buf[BUFSIZ];
1.15 noro 159: int status;
160: char *err;
1.2 noro 161:
1.15 noro 162: if ( (status = setjmp(GP_DATA->env)) != 0 ) {
163: err = errmessage[status];
164: if ( status == errpile ) {
165: sprintf(buf,"%s\nIncrease PARI stack by pari(allocatemem,size).",err);
166: init_pari();
167: } else if ( strlen(err) != 0 )
168: sprintf(buf,"An error occured in PARI :%s",err);
169: else
170: sprintf(buf,"An error occured in PARI.");
1.8 noro 171: push((cmo*)make_error2(buf));
1.4 noro 172: return -1;
173: }
174: cmo_string *func = (cmo_string *)pop();
175: if(func->tag != CMO_STRING) {
1.8 noro 176: sprintf(buf,"sm_executeFunction : func->tag=%d is not CMO_STRING",func->tag);
177: push((cmo*)make_error2(buf));
1.4 noro 178: return -1;
179: }
1.1 noro 180:
1.4 noro 181: c = (cmo_int32 *)pop();
1.2 noro 182: ac = c->i;
183: if ( ac > PARI_MAX_AC ) {
1.8 noro 184: push((cmo*)make_error2("sm_executeFunction : too many arguments"));
1.4 noro 185: return -1;
1.2 noro 186: }
187: for ( i = 0; i < ac; i++ ) {
188: av[i] = (cmo *)pop();
1.8 noro 189: // fprintf(stderr,"arg%d:",i);
190: // print_cmo(av[i]);
191: // fprintf(stderr,"\n");
1.2 noro 192: }
1.4 noro 193: if( strcmp( func->s, "exit" ) == 0 )
194: exit(0);
1.3 noro 195:
196: parif =search_parif(func->s);
197: if ( !parif ) {
1.8 noro 198: sprintf(buf,"%s : not implemented",func->s);
199: push((cmo*)make_error2(buf));
1.4 noro 200: return -1;
1.3 noro 201: } else if ( parif->type == 0 ) {
202: /* one long int variable */
203: int a = cmo_to_int(av[0]);
1.4 noro 204: a = (int)(parif->f)(a);
1.3 noro 205: ret = (cmo *)new_cmo_int32(a);
1.2 noro 206: push(ret);
1.4 noro 207: return 0;
1.12 noro 208: } else if ( parif->type == 1 ) {
1.7 noro 209: /* one number/poly/matrix argument possibly with prec */
1.5 noro 210: av0 = avma;
1.2 noro 211: z = cmo_to_GEN(av[0]);
1.7 noro 212: prec = ac==2 ? cmo_to_int(av[1])*3.32193/32+3 : precreal;
1.8 noro 213: if ( ismatrix(z) ) {
1.7 noro 214: int i,len;
215: len = lg(z);
216: for ( i = 1; i < len; i++ )
217: settyp(z[i],t_COL);
218: settyp(z,t_MAT);
219: z = shallowtrans(z);
220: }
221: printf("input : "); output(z);
1.3 noro 222: m = (*parif->f)(z,prec);
1.2 noro 223: ret = GEN_to_cmo(m);
1.5 noro 224: avma = av0;
1.2 noro 225: push(ret);
1.4 noro 226: return 0;
1.13 noro 227: } else if ( parif->type == 2 ) {
228: /* one number/poly/matrix argument with flag=0 */
229: av0 = avma;
230: z = cmo_to_GEN(av[0]);
231: if ( ismatrix(z) ) {
232: int i,len;
233: len = lg(z);
234: for ( i = 1; i < len; i++ )
235: settyp(z[i],t_COL);
236: settyp(z,t_MAT);
237: z = shallowtrans(z);
238: }
239: printf("input : "); output(z);
240: m = (*parif->f)(z,0);
241: ret = GEN_to_cmo(m);
242: avma = av0;
243: push(ret);
244: return 0;
1.3 noro 245: } else {
1.8 noro 246: sprintf(buf,"%s : not implemented",func->s);
247: push((cmo*)make_error2(buf));
1.4 noro 248: return -1;
1.3 noro 249: }
1.1 noro 250: }
251:
252: int receive_and_execute_sm_command()
253: {
1.4 noro 254: int code = receive_int32(fd_rw);
255: switch(code) {
256: case SM_popCMO:
257: sm_popCMO();
258: break;
259: case SM_executeFunction:
260: sm_executeFunction();
261: break;
262: case SM_mathcap:
263: sm_mathcap();
264: break;
265: case SM_setMathCap:
266: pop();
267: break;
1.11 noro 268: case SM_shutdown:
269: exit(0);
270: break;
1.4 noro 271: default:
272: printf("receive_and_execute_sm_command : code=%d\n",code);fflush(stdout);
273: break;
274: }
275: return 0;
1.1 noro 276: }
277:
278: int receive()
279: {
1.4 noro 280: int tag;
1.1 noro 281:
1.4 noro 282: tag = receive_ox_tag(fd_rw);
283: switch(tag) {
284: case OX_DATA:
285: printf("receive : ox_data %d\n",tag);fflush(stdout);
286: push(receive_cmo(fd_rw));
287: break;
288: case OX_COMMAND:
289: printf("receive : ox_command %d\n",tag);fflush(stdout);
290: receive_and_execute_sm_command();
291: break;
292: default:
293: printf("receive : tag=%d\n",tag);fflush(stdout);
294: }
295: return 0;
1.1 noro 296: }
297:
1.16 ! noro 298: jmp_buf ox_env;
! 299:
! 300: void usr1_handler(int sig)
! 301: {
! 302: longjmp(ox_env,1);
! 303: }
! 304:
1.1 noro 305: int main()
306: {
1.16 ! noro 307: if ( setjmp(ox_env) ) {
! 308: fprintf(stderr,"resetting libpari and sending OX_SYNC_BALL...");
! 309: initialize_stack();
! 310: init_pari();
! 311: send_ox_tag(fd_rw,OX_SYNC_BALL);
! 312: fprintf(stderr,"done\n");
! 313: } else {
! 314: init_gc();
! 315: ox_stderr_init(stderr);
! 316: initialize_stack();
! 317: init_pari();
! 318:
! 319: fprintf(stderr,"ox_pari\n");
1.4 noro 320:
1.16 ! noro 321: fd_rw = oxf_open(3);
! 322: oxf_determine_byteorder_server(fd_rw);
! 323: }
! 324: signal(SIGUSR1,usr1_handler);
1.4 noro 325:
326: while(1){
327: receive();
328: }
1.1 noro 329: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ox_pari.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_pari