Annotation of OpenXM/src/ox_pari/ox_pari.c, Revision 1.14
1.14 ! ohara 1: /* $OpenXM: OpenXM/src/ox_pari/ox_pari.c,v 1.13 2016/08/01 01:35:01 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.14 ! ohara 88: char *opts[] = {"no_ox_reset", NULL};
! 89: mathcap_init2(OX_PARI_VERSION, ID_STRING, "ox_pari", NULL, NULL, opts);
1.4 noro 90: push((cmo*)oxf_cmo_mathcap(fd_rw));
91: return 0;
1.1 noro 92: }
93:
94: int sm_popCMO()
95: {
1.4 noro 96: cmo* m = pop();
1.1 noro 97:
1.4 noro 98: if(m != NULL) {
99: send_ox_cmo(fd_rw, m);
100: return 0;
101: }
102: return SM_popCMO;
1.1 noro 103: }
104:
1.8 noro 105: cmo_error2 *make_error2(char *message)
1.1 noro 106: {
1.9 noro 107: return new_cmo_error2((cmo *)new_cmo_string(message));
1.1 noro 108: }
109:
110: int get_i()
111: {
1.4 noro 112: cmo *c = pop();
113: if(c->tag == CMO_INT32) {
114: return ((cmo_int32 *)c)->i;
115: }else if(c->tag == CMO_ZZ) {
116: return mpz_get_si(((cmo_zz *)c)->mpz);
117: }
1.8 noro 118: make_error2("get_i : invalid object");
1.4 noro 119: return 0;
1.1 noro 120: }
121:
122: char *get_str()
123: {
1.4 noro 124: cmo *c = pop();
125: if(c->tag == CMO_STRING) {
126: return ((cmo_string *)c)->s;
127: }
1.8 noro 128: make_error2("get_str : invalid object");
1.4 noro 129: return "";
1.1 noro 130: }
131:
1.8 noro 132: int ismatrix(GEN z)
133: {
134: int len,col,i;
135:
136: if ( typ(z) != t_VEC ) return 0;
137: if ( typ((GEN)z[1]) != t_VEC ) return 0;
138: len = lg(z); col = lg((GEN)z[1]);
139: for ( i = 2; i < len; i++ )
140: if ( lg((GEN)z[i]) != col ) return 0;
141: return 1;
142: }
143:
1.1 noro 144: int sm_executeFunction()
145: {
1.5 noro 146: pari_sp av0;
1.2 noro 147: int ac,i;
148: cmo_int32 *c;
149: cmo *av[PARI_MAX_AC];
150: cmo *ret;
151: GEN z,m;
1.3 noro 152: struct parif *parif;
1.7 noro 153: unsigned long prec;
1.8 noro 154: char buf[BUFSIZ];
1.2 noro 155:
1.3 noro 156: if ( setjmp(GP_DATA->env) ) {
1.8 noro 157: sprintf(buf,"sm_executeFunction : an error occured in PARI.");
158: push((cmo*)make_error2(buf));
1.4 noro 159: return -1;
160: }
161: cmo_string *func = (cmo_string *)pop();
162: if(func->tag != CMO_STRING) {
1.8 noro 163: sprintf(buf,"sm_executeFunction : func->tag=%d is not CMO_STRING",func->tag);
164: push((cmo*)make_error2(buf));
1.4 noro 165: return -1;
166: }
1.1 noro 167:
1.4 noro 168: c = (cmo_int32 *)pop();
1.2 noro 169: ac = c->i;
170: if ( ac > PARI_MAX_AC ) {
1.8 noro 171: push((cmo*)make_error2("sm_executeFunction : too many arguments"));
1.4 noro 172: return -1;
1.2 noro 173: }
174: for ( i = 0; i < ac; i++ ) {
175: av[i] = (cmo *)pop();
1.8 noro 176: // fprintf(stderr,"arg%d:",i);
177: // print_cmo(av[i]);
178: // fprintf(stderr,"\n");
1.2 noro 179: }
1.4 noro 180: if( strcmp( func->s, "exit" ) == 0 )
181: exit(0);
1.3 noro 182:
183: parif =search_parif(func->s);
184: if ( !parif ) {
1.8 noro 185: sprintf(buf,"%s : not implemented",func->s);
186: push((cmo*)make_error2(buf));
1.4 noro 187: return -1;
1.3 noro 188: } else if ( parif->type == 0 ) {
189: /* one long int variable */
190: int a = cmo_to_int(av[0]);
1.4 noro 191: a = (int)(parif->f)(a);
1.3 noro 192: ret = (cmo *)new_cmo_int32(a);
1.2 noro 193: push(ret);
1.4 noro 194: return 0;
1.12 noro 195: } else if ( parif->type == 1 ) {
1.7 noro 196: /* one number/poly/matrix argument possibly with prec */
1.5 noro 197: av0 = avma;
1.2 noro 198: z = cmo_to_GEN(av[0]);
1.7 noro 199: prec = ac==2 ? cmo_to_int(av[1])*3.32193/32+3 : precreal;
1.8 noro 200: if ( ismatrix(z) ) {
1.7 noro 201: int i,len;
202: len = lg(z);
203: for ( i = 1; i < len; i++ )
204: settyp(z[i],t_COL);
205: settyp(z,t_MAT);
206: z = shallowtrans(z);
207: }
208: printf("input : "); output(z);
1.3 noro 209: m = (*parif->f)(z,prec);
1.2 noro 210: ret = GEN_to_cmo(m);
1.5 noro 211: avma = av0;
1.2 noro 212: push(ret);
1.4 noro 213: return 0;
1.13 noro 214: } else if ( parif->type == 2 ) {
215: /* one number/poly/matrix argument with flag=0 */
216: av0 = avma;
217: z = cmo_to_GEN(av[0]);
218: if ( ismatrix(z) ) {
219: int i,len;
220: len = lg(z);
221: for ( i = 1; i < len; i++ )
222: settyp(z[i],t_COL);
223: settyp(z,t_MAT);
224: z = shallowtrans(z);
225: }
226: printf("input : "); output(z);
227: m = (*parif->f)(z,0);
228: ret = GEN_to_cmo(m);
229: avma = av0;
230: push(ret);
231: return 0;
1.3 noro 232: } else {
1.8 noro 233: sprintf(buf,"%s : not implemented",func->s);
234: push((cmo*)make_error2(buf));
1.4 noro 235: return -1;
1.3 noro 236: }
1.1 noro 237: }
238:
239: int receive_and_execute_sm_command()
240: {
1.4 noro 241: int code = receive_int32(fd_rw);
242: switch(code) {
243: case SM_popCMO:
244: sm_popCMO();
245: break;
246: case SM_executeFunction:
247: sm_executeFunction();
248: break;
249: case SM_mathcap:
250: sm_mathcap();
251: break;
252: case SM_setMathCap:
253: pop();
254: break;
1.11 noro 255: case SM_shutdown:
256: exit(0);
257: break;
1.4 noro 258: default:
259: printf("receive_and_execute_sm_command : code=%d\n",code);fflush(stdout);
260: break;
261: }
262: return 0;
1.1 noro 263: }
264:
265: int receive()
266: {
1.4 noro 267: int tag;
1.1 noro 268:
1.4 noro 269: tag = receive_ox_tag(fd_rw);
270: switch(tag) {
271: case OX_DATA:
272: printf("receive : ox_data %d\n",tag);fflush(stdout);
273: push(receive_cmo(fd_rw));
274: break;
275: case OX_COMMAND:
276: printf("receive : ox_command %d\n",tag);fflush(stdout);
277: receive_and_execute_sm_command();
278: break;
279: default:
280: printf("receive : tag=%d\n",tag);fflush(stdout);
281: }
282: return 0;
1.1 noro 283: }
284:
285: int main()
286: {
1.3 noro 287: init_gc();
1.4 noro 288: ox_stderr_init(stderr);
289: initialize_stack();
290: init_pari();
291:
292: fprintf(stderr,"ox_pari\n");
293:
294: fd_rw = oxf_open(3);
295: oxf_determine_byteorder_server(fd_rw);
296:
297: while(1){
298: receive();
299: }
1.1 noro 300: }
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