[BACK]Return to bfaux.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2018 / builtin

Diff for /OpenXM_contrib2/asir2018/builtin/bfaux.c between version 1.1 and 1.3

version 1.1, 2018/09/19 05:45:05 version 1.3, 2020/11/10 04:48:49
Line 1 
Line 1 
 /* $OpenXM$ */  /* $OpenXM: OpenXM_contrib2/asir2018/builtin/bfaux.c,v 1.2 2018/09/28 08:20:27 noro Exp $ */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
   
Line 208  void Peval(NODE arg,Obj *rp)
Line 208  void Peval(NODE arg,Obj *rp)
   
   asir_assert(ARG0(arg),O_R,"eval");    asir_assert(ARG0(arg),O_R,"eval");
   if ( argc(arg) == 2 ) {    if ( argc(arg) == 2 ) {
     prec = QTOS((Q)ARG1(arg))*3.32193;      prec = ZTOS((Q)ARG1(arg))*3.32193;
     if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;      if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
     else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;      else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
   } else    } else
Line 227  void Psetprec(NODE arg,Obj *rp)
Line 227  void Psetprec(NODE arg,Obj *rp)
   prec = mpfr_get_default_prec();    prec = mpfr_get_default_prec();
   /* decimal precision */    /* decimal precision */
   dprec = prec*0.30103;    dprec = prec*0.30103;
   STOQ(dprec,q); *rp = (Obj)q;    STOZ(dprec,q); *rp = (Obj)q;
   if ( arg ) {    if ( arg ) {
     asir_assert(ARG0(arg),O_N,"setprec");      asir_assert(ARG0(arg),O_N,"setprec");
     p = QTOS((Q)ARG0(arg))*3.32193;      p = ZTOS((Q)ARG0(arg))*3.32193;
     if ( p > 0 )      if ( p > 0 )
       prec = p;        prec = p;
   }    }
Line 245  void Psetbprec(NODE arg,Obj *rp)
Line 245  void Psetbprec(NODE arg,Obj *rp)
 {  {
   long p;    long p;
   Z q;    Z q;
   long prec;    long prec,dprec;
   
   prec = mpfr_get_default_prec();    prec = mpfr_get_default_prec();
   STOQ(prec,q); *rp = (Obj)q;    STOZ(prec,q); *rp = (Obj)q;
   if ( arg ) {    if ( arg ) {
     asir_assert(ARG0(arg),O_N,"setbprec");      asir_assert(ARG0(arg),O_N,"setbprec");
     p = QTOS((Q)ARG0(arg));      p = ZTOS((Q)ARG0(arg));
     if ( p > 0 )      if ( p > 0 )
       prec = p;        prec = p;
   }    }
Line 264  void Psetround(NODE arg,Z *rp)
Line 264  void Psetround(NODE arg,Z *rp)
 {  {
   int round;    int round;
   
   STOQ(mpfr_roundmode,*rp);    STOZ(mpfr_roundmode,*rp);
   if ( arg ) {    if ( arg ) {
     asir_assert(ARG0(arg),O_N,"setround");      asir_assert(ARG0(arg),O_N,"setround");
     round = QTOS((Q)ARG0(arg));      round = ZTOS((Q)ARG0(arg));
     switch ( round ) {      switch ( round ) {
     case 0:      case 0:
       mpfr_roundmode = MPFR_RNDN;        mpfr_roundmode = MPFR_RNDN;
Line 304  void mp_pi(NODE arg,BF *rp)
Line 304  void mp_pi(NODE arg,BF *rp)
   int prec;    int prec;
   BF r;    BF r;
   
   prec = arg ? QTOS((Q)ARG0(arg)) : 0;    prec = arg ? ZTOS((Q)ARG0(arg)) : 0;
   NEWBF(r);    NEWBF(r);
   prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);    prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
   mpfr_const_pi(r->body,mpfr_roundmode);    mpfr_const_pi(r->body,mpfr_roundmode);
Line 318  void mp_e(NODE arg,BF *rp)
Line 318  void mp_e(NODE arg,BF *rp)
   mpfr_t one;    mpfr_t one;
   BF r;    BF r;
   
   prec = arg ? QTOS((Q)ARG0(arg)) : 0;    prec = arg ? ZTOS((Q)ARG0(arg)) : 0;
   NEWBF(r);    NEWBF(r);
   prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);    prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
   mpfr_init(one);    mpfr_init(one);
Line 336  void mpfr_or_mpc(NODE arg,int (*mpfr_f)(),int (*mpc_f)
Line 336  void mpfr_or_mpc(NODE arg,int (*mpfr_f)(),int (*mpc_f)
   C c;    C c;
   mpc_t mpc,a1;    mpc_t mpc,a1;
   
   prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : mpfr_get_default_prec();    prec = NEXT(arg) ? ZTOS((Q)ARG1(arg)) : mpfr_get_default_prec();
   a = tobf(ARG0(arg),prec);    a = tobf(ARG0(arg),prec);
   if ( a && NID(a)==N_C ) {    if ( a && NID(a)==N_C ) {
     mpc_init2(mpc,prec); mpc_init2(a1,prec);      mpc_init2(mpc,prec); mpc_init2(a1,prec);
Line 463  void mp_pow(NODE arg,Num *rp)
Line 463  void mp_pow(NODE arg,Num *rp)
   C c;    C c;
   mpc_t mpc,a1,e1;    mpc_t mpc,a1,e1;
   
   prec = NEXT(NEXT(arg)) ? QTOS((Q)ARG2(arg)) : mpfr_get_default_prec();    prec = NEXT(NEXT(arg)) ? ZTOS((Q)ARG2(arg)) : mpfr_get_default_prec();
   a = tobf(ARG0(arg),prec);    a = tobf(ARG0(arg),prec);
   e = tobf(ARG1(arg),prec);    e = tobf(ARG1(arg),prec);
   if ( NID(a) == N_C || NID(e) == N_C || MPFR_SIGN(((BF)a)->body) < 0 ) {    if ( NID(a) == N_C || NID(e) == N_C || MPFR_SIGN(((BF)a)->body) < 0 ) {
Line 502  void mp_pow(NODE arg,Num *rp)
Line 502  void mp_pow(NODE arg,Num *rp)
 }  }
   
 #define SETPREC \  #define SETPREC \
  (prec)=NEXT(arg)?QTOS((Q)ARG1(arg)):0;\   (prec)=NEXT(arg)?ZTOS((Q)ARG1(arg)):0;\
  (prec)*=3.32193;\   (prec)*=3.32193;\
  (a)=tobf(ARG0(arg),prec);\   (a)=tobf(ARG0(arg),prec);\
  NEWBF(r);\   NEWBF(r);\
Line 765  void Prk_ratmat(NODE arg,LIST *rp)
Line 765  void Prk_ratmat(NODE arg,LIST *rp)
   Real x,t;    Real x,t;
   LIST l;    LIST l;
   
   ord = QTOS((Q)ARG0(arg));    ord = ZTOS((Q)ARG0(arg));
   mat = (VECT)ARG1(arg); den = (P)ARG2(arg);    mat = (VECT)ARG1(arg); den = (P)ARG2(arg);
   x0 = ToReal((Num)ARG3(arg)); x1 = ToReal((Num)ARG4(arg));    x0 = ToReal((Num)ARG3(arg)); x1 = ToReal((Num)ARG4(arg));
   step = QTOS((Q)ARG5(arg)); fv = (VECT)ARG6(arg);    step = ZTOS((Q)ARG5(arg)); fv = (VECT)ARG6(arg);
   h = (x1-x0)/step;    h = (x1-x0)/step;
   
   n = fv->len;    n = fv->len;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>