===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v
retrieving revision 1.19
retrieving revision 1.23
diff -u -p -r1.19 -r1.23
--- OpenXM_contrib2/asir2000/builtin/array.c	2001/09/17 02:47:07	1.19
+++ OpenXM_contrib2/asir2000/builtin/array.c	2001/10/01 01:58:01	1.23
@@ -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.18 2001/09/17 01:18:34 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.22 2001/09/17 08:37:30 noro Exp $
 */
 #include "ca.h"
 #include "base.h"
@@ -74,6 +74,7 @@ int gauss_elim_mod1(int **,int,int,int);
 int gauss_elim_geninv_mod(unsigned int **,int,int,int);
 int gauss_elim_geninv_mod_swap(unsigned int **,int,int,unsigned int,unsigned int ***,int **);
 void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm();
+void Pinvmat();
 void Pnewbytearray();
 
 void Pgeneric_gauss_elim_mod();
@@ -110,6 +111,7 @@ struct ftab array_tab[] = {
 	{"vtol",Pvtol,1},
 	{"size",Psize,1},
 	{"det",Pdet,-2},
+	{"invmat",Pinvmat,-2},
 	{"leqm",Pleqm,2},
 	{"leqm1",Pleqm1,2},
 	{"geninvm",Pgeninvm,2},
@@ -641,6 +643,41 @@ P *rp;
 	}
 }
 
+void Pinvmat(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	MAT m,r;
+	int n,i,j,mod;
+	P dn;
+	P **mat,**imat,**w;
+	NODE nd;
+
+	m = (MAT)ARG0(arg);
+	asir_assert(m,O_MAT,"invmat");
+	if ( m->row != m->col )
+		error("invmat : non-square matrix");
+	else if ( argc(arg) == 1 ) {
+		n = m->row;
+		invmatp(CO,(P **)BDY(m),n,&imat,&dn);
+		NEWMAT(r); r->row = n; r->col = n; r->body = (pointer **)imat;
+		nd = mknode(2,r,dn);
+		MKLIST(*rp,nd);
+	} else {
+		n = m->row; mod = QTOS((Q)ARG1(arg)); mat = (P **)BDY(m);
+		w = (P **)almat_pointer(n,n);
+		for ( i = 0; i < n; i++ )
+			for ( j = 0; j < n; j++ )
+				ptomp(mod,mat[i][j],&w[i][j]);
+#if 0
+		detmp(CO,mod,w,n,&d);
+		mptop(d,rp);
+#else
+		error("not implemented yet");
+#endif
+	}
+}
+
 /*
 	input : a row x col matrix A
 		A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...
@@ -1399,49 +1436,15 @@ int md;
 }
 
 /*
-	rlist : reducers list 
-	ht(BDY(rlist)) < ht(BDY(NEXT(rlist)) < ...  w.r.t. the term order
-*/
-
-void reduce_reducers_mod_compress(rlist,nred,at,col,md,redmatp,indredp)
-NODE rlist;
-int nred;
-DL *at;
-int col,md;
-CDP **redmatp;
-int **indredp;
-{
-	CDP *redmat;
-	CDP t;
-	int *indred,*w;
-	int i,k;
-	NODE r;
-
-	*redmatp = redmat = (CDP *)CALLOC(nred,sizeof(CDP));
-	*indredp = indred = (int *)CALLOC(nred,sizeof(int));
-	w = (int *)CALLOC(col,sizeof(int));
-
-	_dpmod_to_vect_compress(BDY(rlist),at,&redmat[0]);
-	indred[0] = redmat[0]->body[0].index;
-
-	for ( i = 1, r = NEXT(rlist); i < nred; i++, r = NEXT(r) ) {
-		bzero(w,col*sizeof(int));
-		_dpmod_to_vect(BDY(r),at,w);
-		reduce_sp_by_red_mod_compress(w,redmat,indred,i,col,md);
-		compress_vect(w,col,&redmat[i]);
-		indred[i] = redmat[i]->body[0].index;
-	}
-}
-
-/*
 	mat[i] : compressed reducers (i=0,...,nred-1)
 	mat[0] < mat[1] < ... < mat[nred-1] w.r.t the term order
 */
 
-int red_by_compress(m,p,r,hc,len)
+int red_by_compress(m,p,r,ri,hc,len)
 int m;
 unsigned int *p;
-register struct oCM *r;
+register unsigned int *r;
+register unsigned int *ri;
 unsigned int hc;
 register int len;
 {
@@ -1449,10 +1452,10 @@ register int len;
 	unsigned int dmy;
 	unsigned int *pj;
 
-	p[r->index] = 0; r++;
-	for ( len--; len; len--, r++ ) {
-		pj = p+r->index;
-		DMA0(r->c,hc,*pj,up,lo);
+	p[*ri] = 0; r++; ri++;
+	for ( len--; len; len--, r++, ri++ ) {
+		pj = p+ *ri;
+		DMA(*r,hc,*pj,up,lo);
 		if ( up ) {
 			DSAB(m,up,lo,dmy,*pj);
 		} else
@@ -1474,7 +1477,7 @@ int len;
 	*p++ = 0; r++; len--;
 	for ( ; len; len--, r++, p++ )
 		if ( *r ) {
-			DMA0(*r,hc,*p,up,lo);
+			DMA(*r,hc,*p,up,lo);
 			if ( up ) {
 				DSAB(m,up,lo,dmy,*p);
 			} else
@@ -1482,6 +1485,8 @@ int len;
 		}
 }
 
+extern unsigned int **psca;
+
 void reduce_sp_by_red_mod_compress (sp,redmat,ind,nred,col,md)
 int *sp;
 CDP *redmat;
@@ -1494,7 +1499,6 @@ int md;
 	CDP ri;
 	unsigned int hc,up,lo,up1,lo1,c;
 	unsigned int *usp;
-	struct oCM *rib;
 
 	usp = (unsigned int *)sp;
 	/* reduce the spolys by redmat */
@@ -1506,7 +1510,7 @@ int md;
 			hc = md-hc;
 			ri = redmat[i];
 			len = ri->len;
-			red_by_compress(md,usp,ri->body,hc,len);
+			red_by_compress(md,usp,psca[ri->psindex],ri->body,hc,len);
 		}
 	}
 	for ( i = 0; i < col; i++ )