=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/parif.c,v retrieving revision 1.26 retrieving revision 1.32 diff -u -p -r1.26 -r1.32 --- OpenXM_contrib2/asir2000/builtin/parif.c 2015/08/18 02:26:05 1.26 +++ OpenXM_contrib2/asir2000/builtin/parif.c 2015/08/21 06:00:29 1.32 @@ -1,10 +1,11 @@ -/* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.25 2015/08/17 05:18:36 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.31 2015/08/20 08:42:07 noro Exp $ */ #include "ca.h" #include "parse.h" #include "ox.h" Q ox_pari_stream; int ox_pari_stream_initialized = 0; +int ox_get_pari_result = 0; typedef void (*mpfr_func)(NODE,Obj *); @@ -48,6 +49,57 @@ mpfr_func mpfr_search(char *name) return 0; } +Obj list_to_vect(Obj a) +{ + int len,i; + VECT v; + NODE nd; + + if ( !a || OID(a) != O_LIST ) return a; + len = length(BDY((LIST)a)); + MKVECT(v,len); + for ( i = 0, nd = BDY((LIST)a); nd; nd = NEXT(nd), i++ ) + v->body[i] = (pointer)list_to_vect((Obj)BDY(nd)); + return (Obj)v; +} + +Obj vect_to_mat(VECT v) +{ + MAT m; + int len,col,i,j; + + len = v->len; + if ( v->body[0] && OID((Obj)v->body[0]) == O_VECT ) { + col = ((VECT)v->body[0])->len; + for ( i = 1; i < len; i++ ) + if ( !v->body[i] || OID((Obj)v->body[i]) != O_VECT + || ((VECT)v->body[i])->len != col ) + break; + if ( i == len ) { + /* convert to a matrix */ + MKMAT(m,len,col); + for ( i = 0; i < len; i++ ) + for ( j = 0; j < col; j++ ) + m->body[i][j] = ((VECT)v->body[i])->body[j]; + return (Obj)m; + } + } + return (Obj)v; +} + +void reset_ox_pari() +{ + NODE nd; + Obj r; + + if ( ox_get_pari_result ) { + nd = mknode(1,ox_pari_stream); + Pox_shutdown(nd,&r); + ox_get_pari_result = 0; + ox_pari_stream_initialized = 0; + } +} + pointer evalparif(FUNC f,NODE arg) { int ac,intarg,opt,prec; @@ -58,16 +110,17 @@ pointer evalparif(FUNC f,NODE arg) Obj ret,dmy; mpfr_func mpfr_function; - if ( mpfr_function = mpfr_search(f->name) ) { - (*mpfr_function)(arg,&ret); - return (pointer) ret; + if ( arg && ARG0(arg) && NID((Num)ARG0(arg)) != N_C + && (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); - ox_pari_stream = r; + MKSTR(name,"ox_pari"); + nd = mknode(2,NULL,name); + Pox_launch_nox(nd,&r); + ox_pari_stream = r; ox_pari_stream_initialized = 1; } @@ -86,8 +139,20 @@ pointer evalparif(FUNC f,NODE arg) 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; + ox_get_pari_result = 1; + Pox_pop_cmo(oxarg,&ret); + ox_get_pari_result = 0; + if ( ret && OID(ret) == O_ERR ) { + char buf[BUFSIZ]; + soutput_init(buf); + sprintexpr(CO,((ERR)ret)->body); + error(buf); + } + if ( ret && OID(ret) == O_LIST ) { + ret = list_to_vect(ret); + ret = vect_to_mat((VECT)ret); + } + return ret; } struct pariftab {