=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v retrieving revision 1.57 retrieving revision 1.62 diff -u -p -r1.57 -r1.62 --- OpenXM_contrib2/asir2000/builtin/array.c 2009/02/03 00:39:23 1.57 +++ OpenXM_contrib2/asir2000/builtin/array.c 2013/06/14 05:55:24 1.62 @@ -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.56 2007/11/23 05:43:23 ohara Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.61 2012/12/17 07:20:44 noro 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}, }; @@ -150,6 +154,7 @@ int comp_obj(Obj *a,Obj *b) static FUNC generic_comp_obj_func; static NODE generic_comp_obj_arg; +static NODE generic_comp_obj_option; int generic_comp_obj(Obj *a,Obj *b) { @@ -157,7 +162,7 @@ int generic_comp_obj(Obj *a,Obj *b) BDY(generic_comp_obj_arg)=(pointer)(*a); 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 ) return 0; else @@ -204,7 +209,8 @@ void Pqsort(NODE arg,LIST *rp) func = (FUNC)v->priv; } 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); } if (OID(t) == O_LIST) { @@ -338,8 +344,8 @@ void Psepmat_destructive(NODE arg,LIST *rp) sgn = SGN(ent); divn(nm,mod,&quo,&rem); /* if ( quo != nm && rem != nm ) */ -/* GC_free(nm); */ -/* GC_free(ent); */ +/* GCFREE(nm); */ +/* GCFREE(ent); */ NTOQ(rem,sgn,a[i][j]); NTOQ(quo,sgn,a1[i][j]); } MKNODE(n1,mat1,0); MKNODE(n0,mat,n1); @@ -405,7 +411,7 @@ void Pnewvect(NODE arg,VECT *rp) } void Pvect(NODE arg,VECT *rp) { - int len,i,r; + int len,i; VECT vect; pointer *vb; NODE tn; @@ -917,7 +923,7 @@ void Pgeneric_gauss_elim(NODE arg,LIST *rp) int *ri,*ci; VECT rind,cind; Q dn,q; - int i,j,k,l,row,col,t,rank; + int i,row,col,t,rank; int is_hensel = 0; char *key; Obj value; @@ -2076,8 +2082,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++ ) @@ -2958,10 +2963,10 @@ void inner_product_int(Q *a,Q *b,int n,Q *r) t = wma; wma = sum; sum = t; } } - GC_free(wm); - GC_free(wma); + GCFREE(wm); + GCFREE(wma); if ( !sgn ) { - GC_free(sum); + GCFREE(sum); *r = 0; } else NTOQ(sum,sgn,*r); @@ -3016,10 +3021,10 @@ void inner_product_mat_int_mod(Q **a,int **b,int n,int t = wma; wma = sum; sum = t; } } - GC_free(wm); - GC_free(wma); + GCFREE(wm); + GCFREE(wma); if ( !sgn ) { - GC_free(sum); + GCFREE(sum); *r = 0; } else NTOQ(sum,sgn,*r); @@ -3451,4 +3456,25 @@ 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,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