[BACK]Return to ox_pari.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / ox_pari

Annotation of OpenXM/src/ox_pari/ox_pari.c, Revision 1.10

1.10    ! noro        1: /*  $OpenXM: OpenXM/src/ox_pari/ox_pari.c,v 1.9 2015/08/20 07:45:12 noro Exp $  */
1.1       noro        2:
                      3: #include <stdio.h>
                      4: #include <stdlib.h>
                      5: #include <string.h>
1.2       noro        6: #include "pari/pari.h"
1.3       noro        7: #include "pari/paripriv.h"
1.1       noro        8: #include "gmp.h"
1.2       noro        9: #include "gmp-impl.h"
1.3       noro       10: #include "mpfr.h"
1.1       noro       11: #include "ox_toolkit.h"
                     12: OXFILE *fd_rw;
                     13:
1.3       noro       14: #define MPFR_PREC(x)      ((x)->_mpfr_prec)
                     15: #define MPFR_EXP(x)       ((x)->_mpfr_exp)
                     16: #define MPFR_MANT(x)      ((x)->_mpfr_d)
                     17: #define MPFR_LAST_LIMB(x) ((MPFR_PREC (x) - 1) / GMP_NUMB_BITS)
                     18: #define MPFR_LIMB_SIZE(x) (MPFR_LAST_LIMB (x) + 1)
                     19:
1.1       noro       20: static int stack_size = 0;
                     21: static int stack_pointer = 0;
                     22: static cmo **stack = NULL;
                     23: extern int debug_print;
1.2       noro       24: long paristack=10000000;
1.1       noro       25:
                     26: void init_pari(void);
1.2       noro       27: cmo *GEN_to_cmo(GEN z);
                     28: cmo_zz *GEN_to_cmo_zz(GEN z);
1.7       noro       29: cmo_qq *GEN_to_cmo_qq(GEN z);
1.3       noro       30: cmo_bf *GEN_to_cmo_bf(GEN z);
1.2       noro       31: cmo_list *GEN_to_cmo_list(GEN z);
1.6       noro       32: cmo_complex *GEN_to_cmo_cmo_complex(GEN z);
1.8       noro       33: cmo_polynomial_in_one_variable *GEN_to_cmo_up(GEN z);
                     34: cmo_recursive_polynomial *GEN_to_cmo_rp(GEN z);
                     35:
1.2       noro       36: GEN cmo_to_GEN(cmo *c);
1.6       noro       37: GEN cmo_int32_to_GEN(cmo_int32 *c);
1.2       noro       38: GEN cmo_zz_to_GEN(cmo_zz *c);
1.6       noro       39: GEN cmo_qq_to_GEN(cmo_qq *c);
1.3       noro       40: GEN cmo_bf_to_GEN(cmo_bf *c);
1.6       noro       41: GEN cmo_list_to_GEN(cmo_list *c);
                     42: GEN cmo_rp_to_GEN(cmo_recursive_polynomial *c);
                     43: GEN cmo_up_to_GEN(cmo_polynomial_in_one_variable *c);
                     44: GEN cmo_complex_to_GEN(cmo_complex *c);
1.1       noro       45:
1.8       noro       46:
1.1       noro       47: #define INIT_S_SIZE 2048
                     48: #define EXT_S_SIZE  2048
                     49:
1.3       noro       50: void *gc_realloc(void *p,size_t osize,size_t nsize)
                     51: {
                     52:   return (void *)GC_realloc(p,nsize);
                     53: }
                     54:
                     55: void gc_free(void *p,size_t size)
                     56: {
                     57:   GC_free(p);
                     58: }
                     59:
                     60: void init_gc()
                     61: {
1.4       noro       62:   GC_INIT();
1.3       noro       63:   mp_set_memory_functions(GC_malloc,gc_realloc,gc_free);
                     64: }
                     65:
1.1       noro       66: void init_pari()
                     67: {
1.2       noro       68:   pari_init(paristack,2);
1.1       noro       69: }
                     70:
                     71: int initialize_stack()
                     72: {
1.4       noro       73:   stack_pointer = 0;
                     74:    stack_size = INIT_S_SIZE;
                     75:   stack = MALLOC(stack_size*sizeof(cmo*));
                     76:   return 0;
1.1       noro       77: }
                     78:
                     79: static int extend_stack()
                     80: {
1.4       noro       81:   int size2 = stack_size + EXT_S_SIZE;
                     82:   cmo **stack2 = MALLOC(size2*sizeof(cmo*));
                     83:   memcpy(stack2, stack, stack_size*sizeof(cmo *));
                     84:   free(stack);
                     85:   stack = stack2;
                     86:   stack_size = size2;
                     87:   return 0;
1.1       noro       88: }
                     89:
                     90: int push(cmo* m)
                     91: {
1.4       noro       92:   stack[stack_pointer] = m;
                     93:   stack_pointer++;
                     94:   if(stack_pointer >= stack_size) {
                     95:     extend_stack();
                     96:   }
                     97:   return 0;
1.1       noro       98: }
                     99:
                    100: cmo* pop()
                    101: {
1.4       noro      102:   if(stack_pointer > 0) {
                    103:     stack_pointer--;
                    104:     return stack[stack_pointer];
                    105:   }
                    106:   return new_cmo_null();
1.1       noro      107: }
                    108:
                    109: void pops(int n)
                    110: {
1.4       noro      111:   stack_pointer -= n;
                    112:   if(stack_pointer < 0) {
                    113:     stack_pointer = 0;
                    114:   }
1.1       noro      115: }
                    116:
                    117: #define OX_PARI_VERSION 20150731
                    118: #define ID_STRING  "2015/07/31 15:00:00"
                    119:
                    120: int sm_mathcap()
                    121: {
1.4       noro      122:   mathcap_init(OX_PARI_VERSION, ID_STRING, "ox_pari", NULL, NULL);
                    123:   push((cmo*)oxf_cmo_mathcap(fd_rw));
                    124:   return 0;
1.1       noro      125: }
                    126:
                    127: int sm_popCMO()
                    128: {
1.4       noro      129:   cmo* m = pop();
1.1       noro      130:
1.4       noro      131:   if(m != NULL) {
                    132:     send_ox_cmo(fd_rw, m);
                    133:     return 0;
                    134:   }
                    135:   return SM_popCMO;
1.1       noro      136: }
                    137:
1.8       noro      138: cmo_error2 *make_error2(char *message)
1.1       noro      139: {
1.9       noro      140:   return new_cmo_error2((cmo *)new_cmo_string(message));
1.1       noro      141: }
                    142:
                    143: int get_i()
                    144: {
1.4       noro      145:   cmo *c = pop();
                    146:   if(c->tag == CMO_INT32) {
                    147:     return ((cmo_int32 *)c)->i;
                    148:   }else if(c->tag == CMO_ZZ) {
                    149:     return mpz_get_si(((cmo_zz *)c)->mpz);
                    150:   }
1.8       noro      151:   make_error2("get_i : invalid object");
1.4       noro      152:   return 0;
1.1       noro      153: }
                    154:
                    155: char *get_str()
                    156: {
1.4       noro      157:   cmo *c = pop();
                    158:   if(c->tag == CMO_STRING) {
                    159:     return ((cmo_string *)c)->s;
                    160:   }
1.8       noro      161:   make_error2("get_str : invalid object");
1.4       noro      162:   return "";
1.1       noro      163: }
                    164:
1.6       noro      165: GEN cmo_int32_to_GEN(cmo_int32 *c)
                    166: {
                    167:   GEN z;
                    168:   int i,sgn;
                    169:
                    170:   i = c->i;
                    171:   if ( !i ) return gen_0;
                    172:   z = cgeti(3);
                    173:   sgn = 1;
                    174:   if ( i < 0 ) {
                    175:     i = -i;
                    176:     sgn = -1;
                    177:   }
                    178:   z[2] = i;
                    179:   setsigne(z,sgn);
                    180:   setlgefint(z,lg(z));
                    181:   return z;
                    182: }
                    183:
1.2       noro      184: GEN cmo_zz_to_GEN(cmo_zz *c)
                    185: {
                    186:   mpz_ptr mpz;
                    187:   GEN z;
                    188:   long *ptr;
                    189:   int j,sgn,len;
                    190:
                    191:   mpz = c->mpz;
                    192:   sgn = mpz_sgn(mpz);
                    193:   len = ABSIZ(mpz);
                    194:   ptr = (long *)PTR(mpz);
                    195:   z = cgeti(len+2);
                    196:   for ( j = 0; j < len; j++ )
                    197:     z[len-j+1] = ptr[j];
                    198:   setsigne(z,sgn);
                    199:   setlgefint(z,lg(z));
                    200:   return z;
                    201: }
                    202:
1.6       noro      203: GEN cmo_qq_to_GEN(cmo_qq *c)
                    204: {
                    205:   GEN z,nm,den;
                    206:
1.8       noro      207:   z = cgetg(3,t_FRAC);
1.6       noro      208:   nm = cmo_zz_to_GEN(new_cmo_zz_set_mpz(mpq_numref(c->mpq)));
                    209:   den = cmo_zz_to_GEN(new_cmo_zz_set_mpz(mpq_denref(c->mpq)));
                    210:   z[1] = (long)nm;
                    211:   z[2] = (long)den;
                    212:   return z;
                    213: }
                    214:
1.3       noro      215: GEN cmo_bf_to_GEN(cmo_bf *c)
                    216: {
                    217:   mpfr_ptr mpfr;
                    218:   GEN z;
                    219:   int sgn,len,j;
                    220:   long exp;
                    221:   long *ptr;
                    222:
                    223:   mpfr = c->mpfr;
                    224:   sgn = MPFR_SIGN(mpfr);
                    225:   exp = MPFR_EXP(mpfr)-1;
                    226:   len = MPFR_LIMB_SIZE(mpfr);
                    227:   ptr = (long *)MPFR_MANT(mpfr);
                    228:   z = cgetr(len+2);
                    229:   for ( j = 0; j < len; j++ )
                    230:     z[len-j+1] = ptr[j];
                    231:   z[1] = evalsigne(sgn)|evalexpo(exp);
                    232:   setsigne(z,sgn);
                    233:   return z;
                    234: }
                    235:
1.6       noro      236: /* list->vector */
                    237:
                    238: GEN cmo_list_to_GEN(cmo_list *c)
                    239: {
                    240:   GEN z;
1.7       noro      241:   int i;
1.6       noro      242:   cell *cell;
                    243:
1.8       noro      244:   z = cgetg(c->length+1,t_VEC);
1.7       noro      245:   for ( i = 0, cell = c->head->next; cell != c->head; cell = cell->next, i++ ) {
                    246:     z[i+1] = (long)cmo_to_GEN(cell->cmo);
1.6       noro      247:   }
                    248:   return z;
                    249: }
                    250:
                    251: GEN cmo_complex_to_GEN(cmo_complex *c)
                    252: {
                    253:   GEN z;
                    254:
1.8       noro      255:   z = cgetg(3,t_COMPLEX);
1.6       noro      256:   z[1] = (long)cmo_to_GEN(c->re);
                    257:   z[2] = (long)cmo_to_GEN(c->im);
                    258:   return z;
                    259: }
                    260:
                    261: GEN cmo_up_to_GEN(cmo_polynomial_in_one_variable *c)
                    262: {
                    263:   GEN z;
                    264:   int d,i;
                    265:   cell *cell;
                    266:
                    267:   d = c->head->next->exp;
1.8       noro      268:   z = cgetg(d+3,t_POL);
1.6       noro      269:   setsigne(z,1);
                    270:   setvarn(z,c->var);
                    271:   setlgef(z,d+3);
                    272:   for ( i = 2; i <= d+2; i++ )
                    273:     z[i] = (long)gen_0;
                    274:   for ( cell = c->head->next; cell != c->head; cell = cell->next ) {
                    275:     z[2+cell->exp] = (long)cmo_to_GEN(cell->cmo);
                    276:   }
                    277:   return z;
                    278: }
                    279:
                    280: cmo_list *current_ringdef;
                    281:
                    282: void register_variables(cmo_list *ringdef)
                    283: {
                    284:   current_ringdef = ringdef;
                    285: }
                    286:
                    287: GEN cmo_rp_to_GEN(cmo_recursive_polynomial *c)
                    288: {
                    289:   register_variables(c->ringdef);
                    290:   switch ( c->coef->tag ) {
                    291:   case CMO_ZERO:
1.7       noro      292:   case CMO_NULL:
1.6       noro      293:     return gen_0;
                    294:   case CMO_INT32:
                    295:     return cmo_int32_to_GEN((cmo_int32 *)c->coef);
                    296:   case CMO_ZZ:
                    297:     return cmo_zz_to_GEN((cmo_zz *)c->coef);
                    298:   case CMO_QQ:
                    299:     return cmo_qq_to_GEN((cmo_qq *)c->coef);
                    300:   case CMO_POLYNOMIAL_IN_ONE_VARIABLE:
                    301:     return cmo_up_to_GEN((cmo_polynomial_in_one_variable *)c->coef);
                    302:   default:
                    303:     return 0;
                    304:   }
                    305: }
                    306:
1.2       noro      307: cmo_zz *GEN_to_cmo_zz(GEN z)
                    308: {
                    309:   cmo_zz *c;
                    310:
                    311:   c = new_cmo_zz();
                    312:   mpz_import(c->mpz,lgef(z)-2,1,sizeof(long),0,0,&z[2]);
                    313:   if ( signe(z) < 0 )
                    314:     mpz_neg(c->mpz,c->mpz);
                    315:   return c;
                    316: }
                    317:
1.7       noro      318: cmo_qq *GEN_to_cmo_qq(GEN z)
                    319: {
                    320:   cmo_qq *c;
                    321:   GEN num,den;
                    322:
                    323:   num = (GEN)z[1];
                    324:   den = (GEN)z[2];
                    325:   c = new_cmo_qq();
                    326:   mpz_import(mpq_numref(c->mpq),lgef(num)-2,1,sizeof(long),0,0,&num[2]);
                    327:   mpz_import(mpq_denref(c->mpq),lgef(num)-2,1,sizeof(long),0,0,&den[2]);
                    328:   if ( signe(num)*signe(den) < 0 )
                    329:     mpz_neg(mpq_numref(c->mpq),mpq_numref(c->mpq));
                    330:   return c;
                    331: }
                    332:
                    333:
1.3       noro      334: cmo_bf *GEN_to_cmo_bf(GEN z)
                    335: {
                    336:   cmo_bf *c;
                    337:   int len,prec,j;
                    338:   long *ptr;
                    339:
                    340:   c = new_cmo_bf();
                    341:   len = lg(z)-2;
                    342:   prec = len*sizeof(long)*8;
                    343:   mpfr_init2(c->mpfr,prec);
                    344:   ptr = (long *)MPFR_MANT(c->mpfr);
                    345:   for ( j = 0; j < len; j++ )
                    346:     ptr[j] = z[len-j+1];
                    347:   MPFR_EXP(c->mpfr) = (long long)(expo(z)+1);
                    348:   MPFR_SIGN(c->mpfr) = gsigne(z);
                    349:   return c;
                    350: }
                    351:
                    352:
1.2       noro      353: cmo_list *GEN_to_cmo_list(GEN z)
                    354: {
                    355:   cmo_list *c;
                    356:   cmo *ob;
                    357:   int i,len;
                    358:
                    359:   c = new_cmo_list();
                    360:   len = lg(z)-1;
                    361:   for ( i = 1; i <= len; i++ ) {
                    362:     ob = GEN_to_cmo((GEN)z[i]);
                    363:     c = list_append(c,ob);
                    364:   }
                    365:   return c;
                    366: }
                    367:
1.6       noro      368: cmo_complex *GEN_to_cmo_complex(GEN z)
                    369: {
                    370:   cmo_complex *c;
                    371:
                    372:   c = new_cmo_complex();
                    373:   c->re = GEN_to_cmo((GEN)z[1]);
                    374:   c->im = GEN_to_cmo((GEN)z[2]);
                    375:   return c;
                    376: }
                    377:
1.8       noro      378: cmo_polynomial_in_one_variable *GEN_to_cmo_up(GEN z)
                    379: {
                    380:   cmo_polynomial_in_one_variable *c;
                    381:   int i;
                    382:   cmo *coef;
                    383:
                    384:   c = new_cmo_polynomial_in_one_variable(varn(z));
                    385:   for ( i = lg(z)-1; i >= 2; i-- )
                    386:     if ( (GEN)z[i] != gen_0 ) {
                    387:       coef = GEN_to_cmo((GEN)z[i]);
                    388:       list_append_monomial((cmo_list *)c, coef, i-2);
                    389:     }
                    390:   return c;
                    391: }
                    392:
                    393: cmo_recursive_polynomial *GEN_to_cmo_rp(GEN z)
                    394: {
                    395:   cmo_recursive_polynomial *c;
                    396:
                    397:   if ( !signe(z) ) return (cmo_recursive_polynomial *)new_cmo_zero();
                    398:   c = new_cmo_recursive_polynomial(current_ringdef,(cmo *)GEN_to_cmo_up(z));
                    399:   return c;
                    400: }
1.2       noro      401:
                    402: GEN cmo_to_GEN(cmo *c)
                    403: {
                    404:   switch ( c->tag ) {
                    405:   case CMO_ZERO:
1.7       noro      406:   case CMO_NULL:
1.3       noro      407:     return gen_0;
1.2       noro      408:   case CMO_ZZ: /* int */
                    409:     return cmo_zz_to_GEN((cmo_zz *)c);
1.10    ! noro      410:   case CMO_COMPLEX: /* complex */
        !           411:     return cmo_complex_to_GEN((cmo_complex *)c);
1.8       noro      412:   case CMO_IEEE_DOUBLE_FLOAT:
                    413:      return dbltor(((cmo_double *)c)->d);
1.3       noro      414:   case CMO_BIGFLOAT: /* bigfloat */
                    415:     return cmo_bf_to_GEN((cmo_bf *)c);
1.6       noro      416:   case CMO_LIST:
                    417:     return cmo_list_to_GEN((cmo_list *)c);
                    418:   case CMO_RECURSIVE_POLYNOMIAL:
                    419:     return cmo_rp_to_GEN((cmo_recursive_polynomial *)c);
                    420:   case CMO_POLYNOMIAL_IN_ONE_VARIABLE:
                    421:     return cmo_up_to_GEN((cmo_polynomial_in_one_variable *)c);
1.2       noro      422:   default:
                    423:     return 0;
                    424:   }
                    425: }
                    426:
                    427: cmo *GEN_to_cmo(GEN z)
                    428: {
1.8       noro      429:   char buf[BUFSIZ];
                    430:
1.2       noro      431:   if ( gcmp0(z) )
                    432:     return new_cmo_zero();
                    433:   switch ( typ(z) ) {
1.8       noro      434:   case t_INT: /* int */
1.2       noro      435:     return (cmo *)GEN_to_cmo_zz(z);
1.8       noro      436:   case t_REAL: /* bigfloat */
1.3       noro      437:     return (cmo *)GEN_to_cmo_bf(z);
1.8       noro      438:   case t_FRAC: /* rational number */
1.7       noro      439:     return (cmo *)GEN_to_cmo_qq(z);
1.8       noro      440:   case t_COMPLEX: /* complex */
1.6       noro      441:     return (cmo *)GEN_to_cmo_complex(z);
1.8       noro      442:   case t_POL:
                    443:     return (cmo *)GEN_to_cmo_rp(z);
                    444:   case t_VEC: case t_COL: /* vector */
1.2       noro      445:     return (cmo *)GEN_to_cmo_list(z);
1.8       noro      446:   case t_MAT: /* matrix */
1.2       noro      447:     return (cmo *)GEN_to_cmo_list(shallowtrans(z));
                    448:   default:
1.8       noro      449:     sprintf(buf,"GEN_to_cmo : unsupported type=%d",(int)typ(z));
                    450:     return (cmo *)make_error2(buf);
1.2       noro      451:   }
                    452: }
1.7       noro      453: /* type=1 : num/poly arg, type=2 : matrix arg */
1.2       noro      454:
1.3       noro      455: struct parif {
                    456:   char *name;
1.4       noro      457:   GEN (*f)();
1.3       noro      458:   int type;
                    459: } parif_tab[] = {
1.4       noro      460: /* (ulong)allocatemoremem(ulong) */
                    461:   {"allocatemem",(GEN (*)())allocatemoremem,0},
                    462: /* num/num */
                    463:   {"abs",gabs,1},
                    464:   {"erfc",gerfc,1},
                    465:   {"arg",garg,1},
                    466:   {"isqrt",racine,1},
                    467:   {"gamma",ggamma,1},
                    468:   {"zeta",gzeta,1},
                    469:   {"floor",gfloor,1},
                    470:   {"frac",gfrac,1},
                    471:   {"imag",gimag,1},
                    472:   {"conj",gconj,1},
                    473:   {"ceil",gceil,1},
                    474:   {"isprime",gisprime,2},
                    475:   {"bigomega",gbigomega,1},
                    476:   {"denom",denom,1},
                    477:   {"numer",numer,1},
                    478:   {"lngamma",glngamma,1},
                    479:   {"logagm",glogagm,1},
                    480:   {"classno",classno,1},
                    481:   {"classno2",classno2,1},
                    482:   {"dilog",dilog,1},
                    483:   {"disc",discsr,1},
                    484:   {"discf",discf,1},
                    485:   {"nextprime",nextprime,1},
                    486:   {"eintg1",eint1,1},
                    487:   {"eta",eta,1},
                    488:   {"issqfree",gissquarefree,1},
                    489:   {"issquare",gcarreparfait,1},
                    490:   {"gamh",ggamd,1},
                    491:   {"hclassno",classno3,1},
                    492:
                    493:   /* num/array */
                    494:   {"binary",binaire,1},
                    495:   {"factorint",factorint,2},
                    496:   {"factor",Z_factor,1},
                    497:   {"cf",gcf,1},
                    498:   {"divisors",divisors,1},
                    499:   {"smallfact",smallfact,1},
                    500:
                    501:   /* poly/poly */
                    502:   {"centerlift",centerlift,1},
                    503:   {"content",content,1},
                    504:
                    505:   /* poly/array */
                    506:   {"galois",galois,1},
                    507:   {"roots",roots,1},
                    508:
1.7       noro      509:   /* mat/mat */
                    510:   {"adj",adj,2},
                    511:   {"lll",lll,2},
                    512:   {"lllgen",lllgen,2},
                    513:   {"lllgram",lllgram,2},
                    514:   {"lllgramgen",lllgramgen,2},
                    515:   {"lllgramint",lllgramint,2},
                    516:   {"lllgramkerim",lllgramkerim,2},
                    517:   {"lllgramkerimgen",lllgramkerimgen,2},
                    518:   {"lllint",lllint,2},
                    519:   {"lllkerim",lllkerim,2},
                    520:   {"lllkerimgen",lllkerimgen,2},
                    521:   {"trans",gtrans,2},
                    522:   {"eigen",eigen,2},
                    523:   {"hermite",hnf,2},
                    524:   {"mat",gtomat,2},
                    525:   {"matrixqz2",matrixqz2,2},
                    526:   {"matrixqz3",matrixqz3,2},
                    527:   {"hess",hess,2},
                    528:   {"ker",ker,2},
                    529:   {"keri",keri,2},
                    530:   {"kerint",kerint,2},
                    531:   {"kerintg1",kerint1,2},
                    532:
                    533:   /* mat/poly */
                    534:   {"det",det,2},
                    535:   {"det2",det2,2},
                    536:
1.3       noro      537: };
1.2       noro      538:
                    539: #define PARI_MAX_AC 64
                    540:
1.3       noro      541: struct parif *search_parif(char *name)
                    542: {
                    543:   int tablen,i;
                    544:
                    545:   tablen = sizeof(parif_tab)/sizeof(struct parif);
                    546:   for ( i = 0; i < tablen; i++ ) {
                    547:     if ( !strcmp(parif_tab[i].name,name) )
                    548:       return &parif_tab[i];
                    549:   }
                    550:   return 0;
                    551: }
                    552:
1.8       noro      553: int ismatrix(GEN z)
                    554: {
                    555:   int len,col,i;
                    556:
                    557:   if ( typ(z) != t_VEC ) return 0;
                    558:   if ( typ((GEN)z[1]) != t_VEC ) return 0;
                    559:   len = lg(z); col = lg((GEN)z[1]);
                    560:   for ( i = 2; i < len; i++ )
                    561:     if ( lg((GEN)z[i]) != col ) return 0;
                    562:   return 1;
                    563: }
                    564:
1.1       noro      565: int sm_executeFunction()
                    566: {
1.5       noro      567:   pari_sp av0;
1.2       noro      568:   int ac,i;
                    569:   cmo_int32 *c;
                    570:   cmo *av[PARI_MAX_AC];
                    571:   cmo *ret;
                    572:   GEN z,m;
1.3       noro      573:   struct parif *parif;
1.7       noro      574:   unsigned long prec;
1.8       noro      575:   char buf[BUFSIZ];
1.2       noro      576:
1.3       noro      577:   if ( setjmp(GP_DATA->env) ) {
1.8       noro      578:     sprintf(buf,"sm_executeFunction : an error occured in PARI.");
                    579:     push((cmo*)make_error2(buf));
1.4       noro      580:     return -1;
                    581:   }
                    582:   cmo_string *func = (cmo_string *)pop();
                    583:   if(func->tag != CMO_STRING) {
1.8       noro      584:     sprintf(buf,"sm_executeFunction : func->tag=%d is not CMO_STRING",func->tag);
                    585:     push((cmo*)make_error2(buf));
1.4       noro      586:     return -1;
                    587:   }
1.1       noro      588:
1.4       noro      589:   c = (cmo_int32 *)pop();
1.2       noro      590:   ac = c->i;
                    591:   if ( ac > PARI_MAX_AC ) {
1.8       noro      592:     push((cmo*)make_error2("sm_executeFunction : too many arguments"));
1.4       noro      593:     return -1;
1.2       noro      594:   }
                    595:   for ( i = 0; i < ac; i++ ) {
                    596:     av[i] = (cmo *)pop();
1.8       noro      597: //    fprintf(stderr,"arg%d:",i);
                    598: //    print_cmo(av[i]);
                    599: //    fprintf(stderr,"\n");
1.2       noro      600:   }
1.4       noro      601:   if( strcmp( func->s, "exit" ) == 0 )
                    602:     exit(0);
1.3       noro      603:
                    604:   parif =search_parif(func->s);
                    605:   if ( !parif ) {
1.8       noro      606:     sprintf(buf,"%s : not implemented",func->s);
                    607:     push((cmo*)make_error2(buf));
1.4       noro      608:     return -1;
1.3       noro      609:  } else if ( parif->type == 0 ) {
                    610:     /* one long int variable */
                    611:     int a = cmo_to_int(av[0]);
1.4       noro      612:     a = (int)(parif->f)(a);
1.3       noro      613:     ret = (cmo *)new_cmo_int32(a);
1.2       noro      614:     push(ret);
1.4       noro      615:     return 0;
1.7       noro      616:   } else if ( parif->type == 1 || parif->type == 2 ) {
                    617:     /* one number/poly/matrix argument possibly with prec */
1.5       noro      618:     av0 = avma;
1.2       noro      619:     z = cmo_to_GEN(av[0]);
1.7       noro      620:     prec = ac==2 ? cmo_to_int(av[1])*3.32193/32+3 : precreal;
1.8       noro      621:     if ( ismatrix(z) ) {
1.7       noro      622:       int i,len;
                    623:       len = lg(z);
                    624:       for ( i = 1; i < len; i++ )
                    625:         settyp(z[i],t_COL);
                    626:       settyp(z,t_MAT);
                    627:       z = shallowtrans(z);
                    628:     }
                    629:     printf("input : "); output(z);
1.3       noro      630:     m = (*parif->f)(z,prec);
1.2       noro      631:     ret = GEN_to_cmo(m);
1.5       noro      632:     avma = av0;
1.2       noro      633:     push(ret);
1.4       noro      634:     return 0;
1.3       noro      635:   } else {
1.8       noro      636:     sprintf(buf,"%s : not implemented",func->s);
                    637:     push((cmo*)make_error2(buf));
1.4       noro      638:     return -1;
1.3       noro      639:   }
1.1       noro      640: }
                    641:
                    642: int receive_and_execute_sm_command()
                    643: {
1.4       noro      644:   int code = receive_int32(fd_rw);
                    645:   switch(code) {
                    646:   case SM_popCMO:
                    647:     sm_popCMO();
                    648:     break;
                    649:   case SM_executeFunction:
                    650:     sm_executeFunction();
                    651:     break;
                    652:   case SM_mathcap:
                    653:     sm_mathcap();
                    654:     break;
                    655:   case SM_setMathCap:
                    656:     pop();
                    657:     break;
                    658:   default:
                    659:     printf("receive_and_execute_sm_command : code=%d\n",code);fflush(stdout);
                    660:     break;
                    661:   }
                    662:   return 0;
1.1       noro      663: }
                    664:
                    665: int receive()
                    666: {
1.4       noro      667:   int tag;
1.1       noro      668:
1.4       noro      669:   tag = receive_ox_tag(fd_rw);
                    670:   switch(tag) {
                    671:   case OX_DATA:
                    672:     printf("receive : ox_data %d\n",tag);fflush(stdout);
                    673:     push(receive_cmo(fd_rw));
                    674:     break;
                    675:   case OX_COMMAND:
                    676:     printf("receive : ox_command %d\n",tag);fflush(stdout);
                    677:     receive_and_execute_sm_command();
                    678:     break;
                    679:   default:
                    680:     printf("receive : tag=%d\n",tag);fflush(stdout);
                    681:   }
                    682:   return 0;
1.1       noro      683: }
                    684:
                    685: int main()
                    686: {
1.3       noro      687:   init_gc();
1.4       noro      688:   ox_stderr_init(stderr);
                    689:   initialize_stack();
                    690:   init_pari();
                    691:
                    692:   fprintf(stderr,"ox_pari\n");
                    693:
                    694:   fd_rw = oxf_open(3);
                    695:   oxf_determine_byteorder_server(fd_rw);
                    696:
                    697:   while(1){
                    698:     receive();
                    699:   }
1.1       noro      700: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>