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