=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/parif.c,v retrieving revision 1.21 retrieving revision 1.27 diff -u -p -r1.21 -r1.27 --- OpenXM_contrib2/asir2000/builtin/parif.c 2015/08/07 06:15:00 1.21 +++ OpenXM_contrib2/asir2000/builtin/parif.c 2015/08/18 02:31:32 1.27 @@ -1,3 +1,4 @@ +/* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.26 2015/08/18 02:26:05 noro Exp $ */ #include "ca.h" #include "parse.h" #include "ox.h" @@ -5,94 +6,88 @@ Q ox_pari_stream; int ox_pari_stream_initialized = 0; +typedef void (*mpfr_func)(NODE,Obj *); + +void Pmpfr_ai(); +void Pmpfr_eint(), Pmpfr_erf(),Pmpfr_li2(); +void Pmpfr_zeta(); +void Pmpfr_j0(), Pmpfr_j1(); +void Pmpfr_y0(), Pmpfr_y1(); +void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma(); +void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil(); + +struct mpfr_tab_rec { + char *name; + mpfr_func func; +} mpfr_tab[] = { + {"ai",Pmpfr_ai}, + {"zeta",Pmpfr_zeta}, + {"j0",Pmpfr_j0}, + {"j1",Pmpfr_j1}, + {"y0",Pmpfr_y0}, + {"y1",Pmpfr_y1}, + {"eint",Pmpfr_eint}, + {"erf",Pmpfr_erf}, + {"li2",Pmpfr_li2}, + {"gamma",Pmpfr_gamma}, + {"lngamma",Pmpfr_gamma}, + {"digamma",Pmpfr_gamma}, + {"floor",Pmpfr_floor}, + {"ceil",Pmpfr_ceil}, + {"round",Pmpfr_round}, +}; + +mpfr_func mpfr_search(char *name) +{ + int i,n; + + n = sizeof(mpfr_tab)/sizeof(struct mpfr_tab_rec); + for ( i = 0; i < n; i++ ) + if ( !strcmp(name,mpfr_tab[i].name) ) + return mpfr_tab[i].func; + return 0; +} + pointer evalparif(FUNC f,NODE arg) { int ac,intarg,opt,prec; Q q,r,narg; - NODE nd,oxarg; + NODE nd,oxarg,t,t1,n; STRING name; USINT ui; Obj ret,dmy; + mpfr_func mpfr_function; - if (strcmp(f->name,"gamma")==0) { - Pmpfr_gamma(arg,&ret); - return((pointer) ret); - }else if (strcmp(f->name,"floor")==0) { - Pmpfr_floor(arg,&ret); - return((pointer) ret); + if ( mpfr_function = mpfr_search(f->name) ) { + (*mpfr_function)(arg,&ret); + return (pointer) ret; } + if ( !ox_pari_stream_initialized ) { MKSTR(name,"ox_pari"); nd = mknode(2,NULL,name); - Pox_launch(nd,&r); + Pox_launch_nox(nd,&r); ox_pari_stream = r; ox_pari_stream_initialized = 1; } - switch ( f->type ) { - case 0: /* in/out : integer */ - ac = argc(arg); - if ( ac > 1 ) { - fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); - error(""); - /* NOTREACHED */ - return 0; - } - intarg = ac == 0 ? 0 : QTOS((Q)ARG0(arg)); - MKUSINT(ui,intarg); - oxarg = mknode(2,ox_pari_stream,ui); - Pox_push_cmo(oxarg,&dmy); - MKSTR(name,f->name); - oxarg = mknode(3,ox_pari_stream,name,ONE); - Pox_execute_function(oxarg,&dmy); - oxarg = mknode(1,ox_pari_stream); - Pox_pop_cmo(oxarg,&r); - return r; - case 1: - ac = argc(arg); - if ( !ac || ( ac > 2 ) ) { - fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); - error(""); - /* NOTREACHED */ - return 0; - } - /* arg1 : prec */ - prec = ac == 1 ? 0 : QTOS((Q)ARG1(arg)); - MKUSINT(ui,prec); - oxarg = mknode(2,ox_pari_stream,ui); - Pox_push_cmo(oxarg,&dmy); - - /* arg0 : arg */ - oxarg = mknode(2,ox_pari_stream,ARG0(arg)); - Pox_push_cmo(oxarg,&dmy); - - MKSTR(name,f->name); - STOQ(2,narg); - oxarg = mknode(3,ox_pari_stream,name,narg); - Pox_execute_function(oxarg,&dmy); - oxarg = mknode(1,ox_pari_stream); - Pox_pop_cmo(oxarg,&r); - return r; - - case 2: - ac = argc(arg); - if ( !ac || ( ac > 2 ) ) { - fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); - error(""); - /* NOTREACHED */ - return 0; - } - if ( ac == 1 ) - opt = 0; - else - opt = QTOS((Q)ARG1(arg)); - return r; - - default: - error("evalparif : not implemented yet."); - /* NOTREACHED */ - return 0; - } + ac = argc(arg); + /* reverse the arg list */ + for ( n = arg, t = 0; n; n = NEXT(n) ) { + MKNODE(t1,BDY(n),t); t = t1; + } + /* push the reversed arg list */ + for ( ; t; t = NEXT(t) ) { + oxarg = mknode(2,ox_pari_stream,BDY(t)); + Pox_push_cmo(oxarg,&dmy); + } + MKSTR(name,f->name); + STOQ(ac,narg); + oxarg = mknode(3,ox_pari_stream,name,narg); + Pox_execute_function(oxarg,&dmy); + oxarg = mknode(1,ox_pari_stream); + Pox_pop_cmo(oxarg,&r); + return r; } struct pariftab {