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

Diff for /OpenXM_contrib2/asir2000/builtin/bfaux.c between version 1.14 and 1.15

version 1.14, 2017/03/29 01:15:14 version 1.15, 2017/08/31 04:21:48
Line 1 
Line 1 
 /* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.13 2017/03/09 00:46:44 noro Exp $ */  /* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.14 2017/03/29 01:15:14 noro Exp $ */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
   
Line 58  struct ftab bf_tab[] = {
Line 58  struct ftab bf_tab[] = {
   
 int mpfr_roundmode = MPFR_RNDN;  int mpfr_roundmode = MPFR_RNDN;
   
 void Ptodouble(NODE arg,Num *rp)  void todoublen(Num a,Num *rp)
 {  {
         double r,i;          double r,i;
         Real real,imag;          Real real,imag;
         Num num;  
   
         asir_assert(ARG0(arg),O_N,"todouble");          if ( !a ) {
         num = (Num)ARG0(arg);  
         if ( !num ) {  
                 *rp = 0;                  *rp = 0;
                 return;                  return;
         }          }
         switch ( NID(num) ) {          switch ( NID(a) ) {
                 case N_R: case N_Q: case N_B:                  case N_R: case N_Q: case N_B:
                         r = ToReal(num);                          r = ToReal(a);
                         MKReal(r,real);                          MKReal(r,real);
                         *rp = (Num)real;                          *rp = (Num)real;
                         break;                          break;
                 case N_C:                  case N_C:
                         r = ToReal(((C)num)->r);                          r = ToReal(((C)a)->r);
                         i = ToReal(((C)num)->i);                          i = ToReal(((C)a)->i);
                         MKReal(r,real);                          MKReal(r,real);
                         MKReal(i,imag);                          MKReal(i,imag);
                         reimtocplx((Num)real,(Num)imag,rp);                          reimtocplx((Num)real,(Num)imag,rp);
                         break;                          break;
                 default:                  default:
                         *rp = num;                          *rp = a;
                         break;                          break;
         }          }
   }
   
   void todoublep(P a,P *rp)
   {
     DCP dc,dcr,dcr0;
   
     if ( !a ) *rp = 0;
     else if ( OID(a) == O_N ) todoublen((Num)a,(Num *)rp);
     else {
       for ( dcr0 = 0, dc = DC(a); dc; dc = NEXT(dc) ) {
         NEXTDC(dcr0,dcr);
         DEG(dcr) = DEG(dc);
         todoublep(COEF(dc),&COEF(dcr));
       }
       NEXT(dcr) = 0;
       MKP(VR(a),dcr0,*rp);
     }
   }
   
   void todoubler(R a,R *rp)
   {
     R b;
   
     if ( !a ) *rp = 0;
     else if ( OID(a) <= O_P ) todoublep((P)a,(P *)rp);
     else {
       NEWR(b);
       todoublep(a->nm,&b->nm);
       todoublep(a->dn,&b->dn);
       *rp = b;
     }
   }
   
   void todouble(Obj a,Obj *b)
   {
           Obj t;
           LIST l;
           V v;
           int row,col,len;
           VECT vect;
           MAT mat;
           int i,j;
           NODE n0,n,nd;
           MP m,mp,mp0;
           DP d;
   
           if ( !a ) {
                   *b = 0;
                   return;
           }
           switch ( OID(a) ) {
                   case O_N:
         todoublen((Num)a,(Num *)b);
         break;
       case O_P:
         todoublep((P)a,(P *)b);
         break;
       case O_R:
                           todoubler((R)a,(R *)b);
                           break;
                   case O_LIST:
                           n0 = 0;
                           for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) {
                                   NEXTNODE(n0,n);
                                   todouble((Obj)BDY(nd),(Obj *)&BDY(n));
                           }
                           if ( n0 )
                                   NEXT(n) = 0;
                           MKLIST(l,n0);
                           *b = (Obj)l;
                           break;
                   case O_VECT:
                           len = ((VECT)a)->len;
                           MKVECT(vect,len);
                           for ( i = 0; i < len; i++ ) {
                                   todouble((Obj)BDY((VECT)a)[i],(Obj *)&BDY(vect)[i]);
                           }
                           *b = (Obj)vect;
                           break;
                   case O_MAT:
                           row = ((MAT)a)->row;
                           col = ((MAT)a)->col;
                           MKMAT(mat,row,col);
                           for ( i = 0; i < row; i++ )
                                   for ( j = 0; j < col; j++ ) {
                                     todouble((Obj)BDY((MAT)a)[i][j],(Obj *)&BDY(mat)[i][j]);
                                   }
                           *b = (Obj)mat;
                           break;
                   case O_DP:
                           mp0 = 0;
                           for ( m = BDY((DP)a); m; m = NEXT(m) ) {
                                   todouble(C(m),&t);
                                   if ( t ) {
                                           NEXTMP(mp0,mp);
                                           C(mp) = t;
                                           mp->dl = m->dl;
                                   }
                           }
                           if ( mp0 ) {
                                   MKDP(NV((DP)a),mp0,d);
                                   d->sugar = ((DP)a)->sugar;
                                   *b = (Obj)d;
                           } else
                                   *b = 0;
   
                           break;
                   default:
                           error("todouble : invalid argument");
           }
   }
   
   void Ptodouble(NODE arg,Obj *rp)
   {
     todouble((Obj)ARG0(arg),rp);
 }  }
   
 void Peval(NODE arg,Obj *rp)  void Peval(NODE arg,Obj *rp)
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>