=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v retrieving revision 1.54 retrieving revision 1.59 diff -u -p -r1.54 -r1.59 --- OpenXM_contrib2/asir2000/builtin/array.c 2006/06/17 10:12:06 1.54 +++ OpenXM_contrib2/asir2000/builtin/array.c 2009/03/25 07:06:30 1.59 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.53 2006/06/12 11:52:10 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.58 2009/03/03 10:04:10 ohara Exp $ */ #include "ca.h" #include "base.h" @@ -54,7 +54,9 @@ #include #include +#if !defined(_MSC_VER) #include +#endif #define F4_INTRAT_PERIOD 8 @@ -95,6 +97,7 @@ void Pmat(); void Pmatc(); void Pnd_det(); void Plu_mat(); +void Pmat_col(); struct ftab array_tab[] = { {"lu_mat",Plu_mat,1}, @@ -140,6 +143,7 @@ struct ftab array_tab[] = { {"nbpoly_up2",Pnbpoly_up2,2}, {"mat_swap_row_destructive",Pmat_swap_row_destructive,3}, {"mat_swap_col_destructive",Pmat_swap_col_destructive,3}, + {"mat_col",Pmat_col,2}, {0,0,0}, }; @@ -391,11 +395,13 @@ void Pnewvect(NODE arg,VECT *rp) if ( argc(arg) == 2 ) { list = (LIST)ARG1(arg); asir_assert(list,O_LIST,"newvect"); +#if 0 for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) ); if ( r > len ) { *rp = vect; return; } +#endif for ( i = 0, tn = BDY(list), vb = BDY(vect); tn; i++, tn = NEXT(tn) ) vb[i] = (pointer)BDY(tn); } @@ -457,15 +463,29 @@ void Pnewbytearray(NODE arg,BYTEARRAY *rp) ac = argc(arg); if ( ac == 1 ) { - /* ARG0(arg) must be a filename */ - asir_assert(ARG0(arg),O_STR,"newbytearray"); - fname = BDY((STRING)ARG0(arg)); - fp = fopen(fname,"rb"); - if ( !fp ) error("newbytearray : fopen failed"); - if ( stat(fname,&sbuf) < 0 ) error("newbytearray : stat failed"); - len = sbuf.st_size; - MKBYTEARRAY(array,len); - fread(BDY(array),len,sizeof(char),fp); + if ( !OID((Obj)ARG0(arg)) ) error("newbytearray : invalid argument"); + switch ( OID((Obj)ARG0(arg)) ) { + case O_STR: + fname = BDY((STRING)ARG0(arg)); + fp = fopen(fname,"rb"); + if ( !fp ) error("newbytearray : fopen failed"); + if ( stat(fname,&sbuf) < 0 ) + error("newbytearray : stat failed"); + 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 ) { asir_assert(ARG0(arg),O_N,"newbytearray"); len = QTOS((Q)ARG0(arg)); @@ -1542,7 +1562,7 @@ 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; Q **a0,**a,**b,**x,**nm; @@ -1566,12 +1586,9 @@ int generic_gauss_elim_hensel_dalg(MAT mat,MAT *nmmat, N wn; Q wq; NumberField nf; - DP *mb; DP m; int col1; - nf = get_numberfield(); - mb = nf->mb; a0 = (Q **)mat->body; row = mat->row; col = mat->col; w = (int **)almat(row,col); @@ -2063,8 +2080,7 @@ 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) { - register unsigned int up,lo; - unsigned int dmy; + unsigned int up,lo,dmy; *p++ = 0; r++; len--; for ( ; len; len--, r++, p++ ) @@ -3438,4 +3454,26 @@ void Pnd_det(NODE arg,P *rp) nd_det(0,ARG0(arg),rp); else nd_det(QTOS((Q)ARG1(arg)),ARG0(arg),rp); +} + +void Pmat_col(NODE arg,P *rp) +{ + int i,j,n; + pointer t; + 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