version 1.53, 2006/06/12 11:52:10 |
version 1.61, 2012/12/17 07:20:44 |
|
|
* 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.60 2010/11/09 16:23:45 ohara Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
|
|
|
|
#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 |
|
|
|
|
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 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 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,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; |
} |
} |