=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/engine/pari.c,v retrieving revision 1.1 retrieving revision 1.11 diff -u -p -r1.1 -r1.11 --- OpenXM_contrib2/asir2000/engine/pari.c 1999/12/03 07:39:08 1.1 +++ OpenXM_contrib2/asir2000/engine/pari.c 2011/12/21 19:38:19 1.11 @@ -1,31 +1,81 @@ -/* $OpenXM: OpenXM/src/asir99/engine/pari.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */ +/* + * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED + * All rights reserved. + * + * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited, + * non-exclusive and royalty-free license to use, copy, modify and + * redistribute, solely for non-commercial and non-profit purposes, the + * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and + * conditions of this Agreement. For the avoidance of doubt, you acquire + * only a limited right to use the SOFTWARE hereunder, and FLL or any + * third party developer retains all rights, including but not limited to + * copyrights, in and to the SOFTWARE. + * + * (1) FLL does not grant you a license in any way for commercial + * purposes. You may use the SOFTWARE only for non-commercial and + * non-profit purposes only, such as academic, research and internal + * business use. + * (2) The SOFTWARE is protected by the Copyright Law of Japan and + * international copyright treaties. If you make copies of the SOFTWARE, + * with or without modification, as permitted hereunder, you shall affix + * to all such copies of the SOFTWARE the above copyright notice. + * (3) An explicit reference to this SOFTWARE and its copyright owner + * shall be made on your publication or presentation in any form of the + * results obtained by use of the SOFTWARE. + * (4) In the event that you modify the SOFTWARE, you shall notify FLL by + * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification + * for such modification or the source code of the modified part of the + * SOFTWARE. + * + * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL + * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND + * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS + * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES' + * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY + * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY. + * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT, + * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL + * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES + * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES + * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY + * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF + * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART + * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY + * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, + * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. + * + * $OpenXM: OpenXM_contrib2/asir2000/engine/pari.c,v 1.10 2009/09/10 01:51:54 noro Exp $ +*/ #include "ca.h" -#if PARI + +#if defined(PARI) #include "base.h" #include #include "genpari.h" -#if defined(THINK_C) void patori(GEN,Obj *); void patori_i(GEN,N *); void ritopa(Obj,GEN *); void ritopa_i(N,int,GEN *); -#else -void patori(); -void patori_i(); -void ritopa(); -void ritopa_i(); -#endif +// PARI_VERSION(2,2,12) == 131596 +#if PARI_VERSION_CODE >= 131596 +#define prec precreal +#endif extern long prec; extern int paristack; -void risa_pari_init() { - char buf[BUFSIZ]; - int i; +long get_pariprec() { + return prec; +} +void set_pariprec(long p) { + prec = p; +} +void risa_pari_init() { pari_init(paristack,2); - prec = 4; + set_pariprec(4); } void create_pari_variable(index) @@ -38,7 +88,11 @@ int index; if ( index > max_varn ) { for ( i = max_varn+1; i <= index; i++ ) { sprintf(name,"x%d",i); +#if (PARI_VERSION_CODE < 131594) fetch_named_var(name,0); +#else + fetch_named_var(name); +#endif } max_varn = index; } @@ -50,12 +104,22 @@ GEN a; return lg(a); } +void gpui_ri(Obj a, Obj e, Obj *c) +{ + GEN pa,pe,z; + long ltop,lbot; + + ltop = avma; ritopa(a,&pa); ritopa(e,&pe); lbot = avma; + z = gerepile(ltop,lbot,gpui(pa,pe,get_pariprec())); + patori(z,c); cgiv(z); +} + void ritopa(a,rp) Obj a; GEN *rp; { long ltop; - GEN pnm,z,w; + GEN pnm,z,w,u; DCP dc; int i,j,l,row,col; VL vl; @@ -73,7 +137,7 @@ GEN *rp; *rp = pnm; else { *rp = z = cgetg(3,4); z[1] = (long)pnm; - ritopa_i(DN((Q)a),1,(GEN *)&z[2]); + ritopa_i(DN((Q)a),1,&u); z[2] = u; } break; case N_R: @@ -82,7 +146,8 @@ GEN *rp; *rp = gcopy((GEN)BDY(((BF)a))); break; case N_C: z = cgetg(3,6); - ritopa((Obj)((C)a)->r,(GEN *)&z[1]); ritopa((Obj)((C)a)->i,(GEN *)&z[2]); + ritopa((Obj)((C)a)->r,&u); z[1] = u; + ritopa((Obj)((C)a)->i,&u); z[2] = u; *rp = z; break; default: @@ -99,21 +164,24 @@ GEN *rp; setlgef(z,l+3); for ( i = l+2; i >= 2; i-- ) z[i] = (long)gzero; - for ( dc = DC((P)a); dc; dc = NEXT(dc) ) - ritopa((Obj)COEF(dc),(GEN *)&z[QTOS(DEG(dc))+2]); + for ( dc = DC((P)a); dc; dc = NEXT(dc) ) { + ritopa((Obj)COEF(dc),&u); z[QTOS(DEG(dc))+2] = u; + } break; case O_VECT: l = ((VECT)a)->len; z = cgetg(l+1,17); - for ( i = 0; i < l; i++ ) - ritopa((Obj)BDY((VECT)a)[i],(GEN *)&z[i+1]); + for ( i = 0; i < l; i++ ) { + ritopa((Obj)BDY((VECT)a)[i],&u); z[i+1] = u; + } *rp = z; break; case O_MAT: row = ((MAT)a)->row; col = ((MAT)a)->col; z = cgetg(col+1,19); for ( j = 0; j < col; j++ ) { w = cgetg(row+1,18); - for ( i = 0; i < row; i++ ) - ritopa((Obj)BDY((MAT)a)[i][j],(GEN *)&w[i+1]); + for ( i = 0; i < row; i++ ) { + ritopa((Obj)BDY((MAT)a)[i][j],&u); w[i+1] = u; + } z[j+1] = (long)w; } *rp = z; @@ -208,7 +276,7 @@ Obj *rp; } } -#if defined(LONG_IS_32BIT) +#if SIZEOF_LONG == 4 void ritopa_i(a,s,rp) N a; int s; @@ -243,9 +311,8 @@ N *rp; for ( j = 0, b = (unsigned int *)BD(z); j < l; j++ ) b[l-j-1] = ((unsigned int *)g)[j+2]; } -#endif -#if defined(LONG_IS_64BIT) +#elif SIZEOF_LONG == 8 void ritopa_i(a,s,rp) N a; int s;