===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v
retrieving revision 1.55
retrieving revision 1.61
diff -u -p -r1.55 -r1.61
--- OpenXM_contrib2/asir2000/builtin/array.c	2006/10/26 10:49:16	1.55
+++ OpenXM_contrib2/asir2000/builtin/array.c	2012/12/17 07:20:44	1.61
@@ -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.54 2006/06/17 10:12:06 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.60 2010/11/09 16:23:45 ohara Exp $
 */
 #include "ca.h"
 #include "base.h"
@@ -54,7 +54,9 @@
 
 #include <sys/types.h>
 #include <sys/stat.h>
+#if !defined(_MSC_VER)
 #include <unistd.h>
+#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);
@@ -391,11 +397,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 +465,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)); 
@@ -2060,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++ )
@@ -2942,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);
@@ -3000,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);
@@ -3435,4 +3456,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<n; i++) {
+		BDY(vect)[i] = BDY(mat)[i][j];
+	}
+	*rp = vect;
 }