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

Diff for /OpenXM_contrib2/asir2000/builtin/array.c between version 1.53 and 1.62

version 1.53, 2006/06/12 11:52:10 version 1.62, 2013/06/14 05:55:24
Line 45 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.52 2006/05/30 07:35:30 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.61 2012/12/17 07:20:44 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "base.h"  #include "base.h"
Line 54 
Line 54 
   
 #include <sys/types.h>  #include <sys/types.h>
 #include <sys/stat.h>  #include <sys/stat.h>
   #if !defined(_MSC_VER)
 #include <unistd.h>  #include <unistd.h>
   #endif
   
 #define F4_INTRAT_PERIOD 8  #define F4_INTRAT_PERIOD 8
   
Line 95  void Pmat();
Line 97  void Pmat();
 void Pmatc();  void Pmatc();
 void Pnd_det();  void Pnd_det();
 void Plu_mat();  void Plu_mat();
   void Pmat_col();
   
 struct ftab array_tab[] = {  struct ftab array_tab[] = {
         {"lu_mat",Plu_mat,1},          {"lu_mat",Plu_mat,1},
Line 140  struct ftab array_tab[] = {
Line 143  struct ftab array_tab[] = {
         {"nbpoly_up2",Pnbpoly_up2,2},          {"nbpoly_up2",Pnbpoly_up2,2},
         {"mat_swap_row_destructive",Pmat_swap_row_destructive,3},          {"mat_swap_row_destructive",Pmat_swap_row_destructive,3},
         {"mat_swap_col_destructive",Pmat_swap_col_destructive,3},          {"mat_swap_col_destructive",Pmat_swap_col_destructive,3},
           {"mat_col",Pmat_col,2},
         {0,0,0},          {0,0,0},
 };  };
   
Line 150  int comp_obj(Obj *a,Obj *b)
Line 154  int comp_obj(Obj *a,Obj *b)
   
 static FUNC generic_comp_obj_func;  static FUNC generic_comp_obj_func;
 static NODE generic_comp_obj_arg;  static NODE generic_comp_obj_arg;
   static NODE generic_comp_obj_option;
   
 int generic_comp_obj(Obj *a,Obj *b)  int generic_comp_obj(Obj *a,Obj *b)
 {  {
Line 157  int generic_comp_obj(Obj *a,Obj *b)
Line 162  int generic_comp_obj(Obj *a,Obj *b)
   
         BDY(generic_comp_obj_arg)=(pointer)(*a);          BDY(generic_comp_obj_arg)=(pointer)(*a);
         BDY(NEXT(generic_comp_obj_arg))=(pointer)(*b);          BDY(NEXT(generic_comp_obj_arg))=(pointer)(*b);
         r = (Q)bevalf(generic_comp_obj_func,generic_comp_obj_arg);          r = (Q)bevalf_with_opts(generic_comp_obj_func,generic_comp_obj_arg,generic_comp_obj_option);
         if ( !r )          if ( !r )
                 return 0;                  return 0;
         else          else
Line 204  void Pqsort(NODE arg,LIST *rp)
Line 209  void Pqsort(NODE arg,LIST *rp)
                         func = (FUNC)v->priv;                          func = (FUNC)v->priv;
                 }                  }
                 generic_comp_obj_func = func;                  generic_comp_obj_func = func;
                 MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n);                  MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n);
                   generic_comp_obj_option = current_option;
                 qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj);                  qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj);
         }          }
     if (OID(t) == O_LIST) {      if (OID(t) == O_LIST) {
Line 338  void Psepmat_destructive(NODE arg,LIST *rp)
Line 344  void Psepmat_destructive(NODE arg,LIST *rp)
                         sgn = SGN(ent);                          sgn = SGN(ent);
                         divn(nm,mod,&quo,&rem);                          divn(nm,mod,&quo,&rem);
 /*                      if ( quo != nm && rem != nm ) */  /*                      if ( quo != nm && rem != nm ) */
 /*                              GC_free(nm); */  /*                              GCFREE(nm); */
 /*                      GC_free(ent); */  /*                      GCFREE(ent); */
                         NTOQ(rem,sgn,a[i][j]); NTOQ(quo,sgn,a1[i][j]);                          NTOQ(rem,sgn,a[i][j]); NTOQ(quo,sgn,a1[i][j]);
                 }                  }
         MKNODE(n1,mat1,0); MKNODE(n0,mat,n1);          MKNODE(n1,mat1,0); MKNODE(n0,mat,n1);
Line 391  void Pnewvect(NODE arg,VECT *rp)
Line 397  void Pnewvect(NODE arg,VECT *rp)
         if ( argc(arg) == 2 ) {          if ( argc(arg) == 2 ) {
                 list = (LIST)ARG1(arg);                  list = (LIST)ARG1(arg);
                 asir_assert(list,O_LIST,"newvect");                  asir_assert(list,O_LIST,"newvect");
   #if 0
                 for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) );                  for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) );
                 if ( r > len ) {                  if ( r > len ) {
                         *rp = vect;                          *rp = vect;
                         return;                          return;
                 }                  }
   #endif
                 for ( i = 0, tn = BDY(list), vb = BDY(vect); tn; i++, tn = NEXT(tn) )                  for ( i = 0, tn = BDY(list), vb = BDY(vect); tn; i++, tn = NEXT(tn) )
                         vb[i] = (pointer)BDY(tn);                          vb[i] = (pointer)BDY(tn);
         }          }
Line 403  void Pnewvect(NODE arg,VECT *rp)
Line 411  void Pnewvect(NODE arg,VECT *rp)
 }  }
   
 void Pvect(NODE arg,VECT *rp) {  void Pvect(NODE arg,VECT *rp) {
         int len,i,r;          int len,i;
         VECT vect;          VECT vect;
         pointer *vb;          pointer *vb;
         NODE tn;          NODE tn;
Line 457  void Pnewbytearray(NODE arg,BYTEARRAY *rp)
Line 465  void Pnewbytearray(NODE arg,BYTEARRAY *rp)
   
         ac = argc(arg);          ac = argc(arg);
         if ( ac == 1 ) {          if ( ac == 1 ) {
                 /* ARG0(arg) must be a filename */                  if ( !OID((Obj)ARG0(arg)) ) error("newbytearray : invalid argument");
                 asir_assert(ARG0(arg),O_STR,"newbytearray");                  switch ( OID((Obj)ARG0(arg)) ) {
                 fname = BDY((STRING)ARG0(arg));                          case O_STR:
                 fp = fopen(fname,"rb");                                  fname = BDY((STRING)ARG0(arg));
                 if ( !fp ) error("newbytearray : fopen failed");                                  fp = fopen(fname,"rb");
                 if ( stat(fname,&sbuf) < 0 ) error("newbytearray : stat failed");                                  if ( !fp ) error("newbytearray : fopen failed");
                 len = sbuf.st_size;                                  if ( stat(fname,&sbuf) < 0 )
                 MKBYTEARRAY(array,len);                                          error("newbytearray : stat failed");
                 fread(BDY(array),len,sizeof(char),fp);                                  len = sbuf.st_size;
                                   MKBYTEARRAY(array,len);
                                   fread(BDY(array),len,sizeof(char),fp);
                                   break;
                           case O_N:
                                   if ( !RATN(ARG0(arg)) )
                                           error("newbytearray : invalid argument");
                                   len = QTOS((Q)ARG0(arg));
                                   if ( len < 0 )
                                           error("newbytearray : invalid size");
                                   MKBYTEARRAY(array,len);
                                   break;
                           default:
                                   error("newbytearray : invalid argument");
                   }
         } else if ( ac == 2 ) {          } else if ( ac == 2 ) {
                 asir_assert(ARG0(arg),O_N,"newbytearray");                  asir_assert(ARG0(arg),O_N,"newbytearray");
                 len = QTOS((Q)ARG0(arg));                  len = QTOS((Q)ARG0(arg));
Line 901  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
Line 923  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
         int *ri,*ci;          int *ri,*ci;
         VECT rind,cind;          VECT rind,cind;
         Q dn,q;          Q dn,q;
         int i,j,k,l,row,col,t,rank;          int i,row,col,t,rank;
         int is_hensel = 0;          int is_hensel = 0;
         char *key;          char *key;
         Obj value;          Obj value;
Line 1542  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
Line 1564  int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn
         }          }
 }  }
   
 int generic_gauss_elim_hensel_dalg(MAT mat,MAT *nmmat,Q *dn,int **rindp,int **cindp)  int generic_gauss_elim_hensel_dalg(MAT mat,DP *mb,MAT *nmmat,Q *dn,int **rindp,int **cindp)
 {  {
         MAT bmat,xmat;          MAT bmat,xmat;
         Q **a0,**a,**b,**x,**nm;          Q **a0,**a,**b,**x,**nm;
Line 1566  int generic_gauss_elim_hensel_dalg(MAT mat,MAT *nmmat,
Line 1588  int generic_gauss_elim_hensel_dalg(MAT mat,MAT *nmmat,
         N wn;          N wn;
         Q wq;          Q wq;
         NumberField nf;          NumberField nf;
         DP *mb;  
         DP m;          DP m;
         int col1;          int col1;
   
         nf = get_numberfield();  
         mb = nf->mb;  
         a0 = (Q **)mat->body;          a0 = (Q **)mat->body;
         row = mat->row; col = mat->col;          row = mat->row; col = mat->col;
         w = (int **)almat(row,col);          w = (int **)almat(row,col);
Line 1818  int intmtoratm(MAT mat,N md,MAT nm,Q *dn)
Line 1837  int intmtoratm(MAT mat,N md,MAT nm,Q *dn)
                 return 0;                  return 0;
         row = mat->row; col = mat->col;          row = mat->row; col = mat->col;
         bshiftn(md,1,&t);          bshiftn(md,1,&t);
         isqrt(t,&b);  
 #if 0  
         isqrt(t,&s);          isqrt(t,&s);
         bshiftn(s,64,&b);          bshiftn(s,64,&b);
         if ( !b )          if ( !b )
                 b = ONEN;                  b = ONEN;
 #endif  
         dn0 = ONE;          dn0 = ONE;
         tmat = (N **)mat->body;          tmat = (N **)mat->body;
         rmat = (Q **)nm->body;          rmat = (Q **)nm->body;
Line 2066  void red_by_compress(int m,unsigned int *p,unsigned in
Line 2082  void red_by_compress(int m,unsigned int *p,unsigned in
   
 void red_by_vect(int m,unsigned int *p,unsigned int *r,unsigned int hc,int len)  void red_by_vect(int m,unsigned int *p,unsigned int *r,unsigned int hc,int len)
 {  {
         register unsigned int up,lo;          unsigned int up,lo,dmy;
         unsigned int dmy;  
   
         *p++ = 0; r++; len--;          *p++ = 0; r++; len--;
         for ( ; len; len--, r++, p++ )          for ( ; len; len--, r++, p++ )
Line 2948  void inner_product_int(Q *a,Q *b,int n,Q *r)
Line 2963  void inner_product_int(Q *a,Q *b,int n,Q *r)
                         t = wma; wma = sum; sum = t;                          t = wma; wma = sum; sum = t;
                 }                  }
         }          }
         GC_free(wm);          GCFREE(wm);
         GC_free(wma);          GCFREE(wma);
         if ( !sgn ) {          if ( !sgn ) {
                 GC_free(sum);                  GCFREE(sum);
                 *r = 0;                  *r = 0;
         } else          } else
                 NTOQ(sum,sgn,*r);                  NTOQ(sum,sgn,*r);
Line 3006  void inner_product_mat_int_mod(Q **a,int **b,int n,int
Line 3021  void inner_product_mat_int_mod(Q **a,int **b,int n,int
                         t = wma; wma = sum; sum = t;                          t = wma; wma = sum; sum = t;
                 }                  }
         }          }
         GC_free(wm);          GCFREE(wm);
         GC_free(wma);          GCFREE(wma);
         if ( !sgn ) {          if ( !sgn ) {
                 GC_free(sum);                  GCFREE(sum);
                 *r = 0;                  *r = 0;
         } else          } else
                 NTOQ(sum,sgn,*r);                  NTOQ(sum,sgn,*r);
Line 3441  void Pnd_det(NODE arg,P *rp)
Line 3456  void Pnd_det(NODE arg,P *rp)
                 nd_det(0,ARG0(arg),rp);                  nd_det(0,ARG0(arg),rp);
         else          else
                 nd_det(QTOS((Q)ARG1(arg)),ARG0(arg),rp);                  nd_det(QTOS((Q)ARG1(arg)),ARG0(arg),rp);
   }
   
   void Pmat_col(NODE arg,VECT *rp)
   {
           int i,j,n;
           MAT mat;
           VECT vect;
   
           asir_assert(ARG0(arg),O_MAT,"mat_col");
           asir_assert(ARG1(arg),O_N,"mat_col");
           mat = (MAT)ARG0(arg);
           j = QTOS((Q)ARG1(arg));
           if ( j < 0 || j >= mat->col) {
                   error("mat_col : Out of range");
           }
           n = mat->row;
           MKVECT(vect,n);
           for(i=0; i<n; i++) {
                   BDY(vect)[i] = BDY(mat)[i][j];
           }
           *rp = vect;
 }  }
Legend:
Removed from v.1.53  
changed lines
  Added in v.1.62
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>