Annotation of OpenXM/src/ox_pari/ox_pari.c, Revision 1.15
1.15 ! noro 1: /* $OpenXM: OpenXM/src/ox_pari/ox_pari.c,v 1.14 2016/08/23 03:03:26 ohara 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.15 ! noro 155: int status;
! 156: char *err;
1.2 noro 157:
1.15 ! noro 158: if ( (status = setjmp(GP_DATA->env)) != 0 ) {
! 159: err = errmessage[status];
! 160: if ( status == errpile ) {
! 161: sprintf(buf,"%s\nIncrease PARI stack by pari(allocatemem,size).",err);
! 162: init_pari();
! 163: } else if ( strlen(err) != 0 )
! 164: sprintf(buf,"An error occured in PARI :%s",err);
! 165: else
! 166: sprintf(buf,"An error occured in PARI.");
1.8 noro 167: push((cmo*)make_error2(buf));
1.4 noro 168: return -1;
169: }
170: cmo_string *func = (cmo_string *)pop();
171: if(func->tag != CMO_STRING) {
1.8 noro 172: sprintf(buf,"sm_executeFunction : func->tag=%d is not CMO_STRING",func->tag);
173: push((cmo*)make_error2(buf));
1.4 noro 174: return -1;
175: }
1.1 noro 176:
1.4 noro 177: c = (cmo_int32 *)pop();
1.2 noro 178: ac = c->i;
179: if ( ac > PARI_MAX_AC ) {
1.8 noro 180: push((cmo*)make_error2("sm_executeFunction : too many arguments"));
1.4 noro 181: return -1;
1.2 noro 182: }
183: for ( i = 0; i < ac; i++ ) {
184: av[i] = (cmo *)pop();
1.8 noro 185: // fprintf(stderr,"arg%d:",i);
186: // print_cmo(av[i]);
187: // fprintf(stderr,"\n");
1.2 noro 188: }
1.4 noro 189: if( strcmp( func->s, "exit" ) == 0 )
190: exit(0);
1.3 noro 191:
192: parif =search_parif(func->s);
193: if ( !parif ) {
1.8 noro 194: sprintf(buf,"%s : not implemented",func->s);
195: push((cmo*)make_error2(buf));
1.4 noro 196: return -1;
1.3 noro 197: } else if ( parif->type == 0 ) {
198: /* one long int variable */
199: int a = cmo_to_int(av[0]);
1.4 noro 200: a = (int)(parif->f)(a);
1.3 noro 201: ret = (cmo *)new_cmo_int32(a);
1.2 noro 202: push(ret);
1.4 noro 203: return 0;
1.12 noro 204: } else if ( parif->type == 1 ) {
1.7 noro 205: /* one number/poly/matrix argument possibly with prec */
1.5 noro 206: av0 = avma;
1.2 noro 207: z = cmo_to_GEN(av[0]);
1.7 noro 208: prec = ac==2 ? cmo_to_int(av[1])*3.32193/32+3 : precreal;
1.8 noro 209: if ( ismatrix(z) ) {
1.7 noro 210: int i,len;
211: len = lg(z);
212: for ( i = 1; i < len; i++ )
213: settyp(z[i],t_COL);
214: settyp(z,t_MAT);
215: z = shallowtrans(z);
216: }
217: printf("input : "); output(z);
1.3 noro 218: m = (*parif->f)(z,prec);
1.2 noro 219: ret = GEN_to_cmo(m);
1.5 noro 220: avma = av0;
1.2 noro 221: push(ret);
1.4 noro 222: return 0;
1.13 noro 223: } else if ( parif->type == 2 ) {
224: /* one number/poly/matrix argument with flag=0 */
225: av0 = avma;
226: z = cmo_to_GEN(av[0]);
227: if ( ismatrix(z) ) {
228: int i,len;
229: len = lg(z);
230: for ( i = 1; i < len; i++ )
231: settyp(z[i],t_COL);
232: settyp(z,t_MAT);
233: z = shallowtrans(z);
234: }
235: printf("input : "); output(z);
236: m = (*parif->f)(z,0);
237: ret = GEN_to_cmo(m);
238: avma = av0;
239: push(ret);
240: return 0;
1.3 noro 241: } else {
1.8 noro 242: sprintf(buf,"%s : not implemented",func->s);
243: push((cmo*)make_error2(buf));
1.4 noro 244: return -1;
1.3 noro 245: }
1.1 noro 246: }
247:
248: int receive_and_execute_sm_command()
249: {
1.4 noro 250: int code = receive_int32(fd_rw);
251: switch(code) {
252: case SM_popCMO:
253: sm_popCMO();
254: break;
255: case SM_executeFunction:
256: sm_executeFunction();
257: break;
258: case SM_mathcap:
259: sm_mathcap();
260: break;
261: case SM_setMathCap:
262: pop();
263: break;
1.11 noro 264: case SM_shutdown:
265: exit(0);
266: break;
1.4 noro 267: default:
268: printf("receive_and_execute_sm_command : code=%d\n",code);fflush(stdout);
269: break;
270: }
271: return 0;
1.1 noro 272: }
273:
274: int receive()
275: {
1.4 noro 276: int tag;
1.1 noro 277:
1.4 noro 278: tag = receive_ox_tag(fd_rw);
279: switch(tag) {
280: case OX_DATA:
281: printf("receive : ox_data %d\n",tag);fflush(stdout);
282: push(receive_cmo(fd_rw));
283: break;
284: case OX_COMMAND:
285: printf("receive : ox_command %d\n",tag);fflush(stdout);
286: receive_and_execute_sm_command();
287: break;
288: default:
289: printf("receive : tag=%d\n",tag);fflush(stdout);
290: }
291: return 0;
1.1 noro 292: }
293:
294: int main()
295: {
1.3 noro 296: init_gc();
1.4 noro 297: ox_stderr_init(stderr);
298: initialize_stack();
299: init_pari();
300:
301: fprintf(stderr,"ox_pari\n");
302:
303: fd_rw = oxf_open(3);
304: oxf_determine_byteorder_server(fd_rw);
305:
306: while(1){
307: receive();
308: }
1.1 noro 309: }
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