=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v retrieving revision 1.56 retrieving revision 1.59 diff -u -p -r1.56 -r1.59 --- OpenXM_contrib2/asir2000/builtin/array.c 2007/11/23 05:43:23 1.56 +++ 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.55 2006/10/26 10:49:16 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}, }; @@ -459,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)); @@ -2062,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++ ) @@ -3437,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