===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/gr.c,v
retrieving revision 1.24
retrieving revision 1.27
diff -u -p -r1.24 -r1.27
--- OpenXM_contrib2/asir2000/builtin/gr.c	2001/09/07 08:54:57	1.24
+++ OpenXM_contrib2/asir2000/builtin/gr.c	2001/09/11 08:56:47	1.27
@@ -45,13 +45,21 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.23 2001/09/05 08:09:10 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.26 2001/09/11 01:30:31 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 #include "base.h"
 #include "ox.h"
 
+#if defined(__GNUC__)
+#define INLINE inline
+#elif defined(VISUAL)
+#define INLINE __inline
+#else
+#define INLINE
+#endif
+
 #define ITOS(p) (((unsigned int)(p))&0x7fffffff)
 #define STOI(i) ((P)((unsigned int)(i)|0x80000000))
 
@@ -182,7 +190,7 @@ int doing_f4;
 NODE TraceList;
 NODE AllTraceList;
 
-int eqdl(nv,dl1,dl2)
+INLINE int eqdl(nv,dl1,dl2)
 int nv;
 DL dl1,dl2;
 {
@@ -232,7 +240,7 @@ CDP *b;
 	for ( m = BDY(f), len = 0; m; m = NEXT(m), len++ );
 	r = (CDP)MALLOC(sizeof(struct oCDP));
  	r->len = len;
-	r->body = (CMP)MALLOC(sizeof(struct oCMP)*len);
+	r->body = (CM)MALLOC(sizeof(struct oCM)*len);
 
 	for ( m = BDY(f), i = j = 0; m; m = NEXT(m), j++ ) {
 		for ( ; !eqdl(nv,m->dl,at[i]); i++ );
@@ -242,6 +250,29 @@ CDP *b;
 	*b = r;
 }
 
+/* dense vector -> CDP  */
+void compress_vect(a,n,rp)
+int *a;
+int n;
+CDP *rp;
+{
+	int i,j,nz;
+	CDP r;
+
+	for ( i = 0, nz = 0; i < n; i++ )
+		if ( a[i] ) nz++;
+	*rp = r = (CDP)MALLOC(sizeof(struct oCDP));
+	r->len = nz;
+	r->body = (CM)MALLOC(sizeof(struct oCM)*nz);
+	for ( i = 0, j = 0; i < n; i++ ) {
+		if ( a[i] ) {
+			r->body[j].index = i;
+			r->body[j].c = ITOS(a[i]);
+			j++;
+		}
+	}
+}
+
 void dp_to_vect(f,at,b)
 DP f;
 DL *at;
@@ -463,7 +494,7 @@ LIST f,v;
 struct order_spec *ord;
 LIST *rp;
 {
-	int i,mindex,m,nochk;
+	int i,mindex,m,nochk,homogen;
 	struct order_spec ord1;
 	VL fv,vv,vc;
 	NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
@@ -475,13 +506,17 @@ LIST *rp;
 	if ( ord->id && NVars != ord->nv )
 		error("dp_f4_main : invalid order specification");
 	initd(ord);
-	for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+	for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
 		NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+		if ( homogen )
+			homogen = dp_homogeneous(BDY(fd));
 	}
 	if ( fd0 ) NEXT(fd) = 0;
 	setup_arrays(fd0,0,&s);
 	x = gb_f4(s);
-	reduceall(x,&xx); x = xx;
+	if ( !homogen ) {
+		reduceall(x,&xx); x = xx;
+	}
 	for ( r0 = 0; x; x = NEXT(x) ) {
 		NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
 		dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
@@ -496,7 +531,7 @@ int m;
 struct order_spec *ord;
 LIST *rp;
 {
-	int i;
+	int i,homogen;
 	struct order_spec ord1;
 	VL fv,vv,vc;
 	DP b,c,c1;
@@ -509,8 +544,10 @@ LIST *rp;
 	if ( ord->id && NVars != ord->nv )
 		error("dp_f4_mod_main : invalid order specification");
 	initd(ord);
-	for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+	for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
 		ptod(CO,vv,(P)BDY(t),&b);
+		if ( homogen )
+			homogen = dp_homogeneous(b);
 		_dp_mod(b,m,0,&c);
 		_dp_monic(c,m,&c1);
 		if ( c ) {
@@ -520,7 +557,9 @@ LIST *rp;
 	if ( fd0 ) NEXT(fd) = 0;
 	setup_arrays(fd0,m,&s);
 	x = gb_f4_mod(s,m);
-	reduceall_mod(x,m,&xx); x = xx;
+	if ( !homogen ) {
+		reduceall_mod(x,m,&xx); x = xx;
+	}
 	for ( r0 = 0; x; x = NEXT(x) ) {
 		NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 	}
@@ -663,7 +702,7 @@ int m;
 	DL *ht,*at,*st;
 	int **spmat;
 	CDP *redmat;
-	int *colstat,*w;
+	int *colstat,*w,*w1;
 	int rank,nred,nsp,nonzero,spcol;
 	int *indred,*isred;
 	CDP ri;
@@ -729,8 +768,6 @@ int m;
 			}
 		}
 #endif
-		fprintf(stderr,"\n");
-		
 		get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
 		init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
 
@@ -755,6 +792,14 @@ int m;
 		nsp = row-nred;
 
 		/* reducer matrix */
+		/* indred : register the position of the head term */
+#if 0
+		reduce_reducers_mod_compress(blist,nred,at,col,m,&redmat,&indred);
+		isred = (int *)MALLOC(col*sizeof(int));
+		bzero(isred,col*sizeof(int));
+		for ( i = 0; i < nred; i++ )
+			isred[indred[i]] = 1;
+#else
 		redmat = (CDP *)MALLOC(nred*sizeof(CDP));
 		for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
 			_dpmod_to_vect_compress(BDY(r),at,&redmat[i]);
@@ -770,6 +815,7 @@ int m;
 			indred[i] = ri->body[0].index;
 			isred[indred[i]] = 1;
 		}
+#endif
 
 		spcol = col-nred;
 		/* head terms not in ht */
@@ -780,21 +826,35 @@ int m;
 
 		get_eg(&tmp1);
 		/* spoly matrix; stored in reduced form; terms in ht[] are omitted */
-		spmat = almat(nsp,spcol);
+		spmat = (int **)MALLOC(nsp*sizeof(int *));
 		w = (int *)MALLOC(col*sizeof(int));
-		for ( ; i < row; r = NEXT(r), i++ ) {
+
+		/* skip reducers in blist */
+		for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ );
+		for ( i = 0; r; r = NEXT(r) ) {
 			bzero(w,col*sizeof(int));
 			_dpmod_to_vect(BDY(r),at,w);
 			reduce_sp_by_red_mod_compress(w,redmat,indred,nred,col,m);
-			for ( j = 0, k = 0; j < col; j++ )
-				if ( !isred[j] )
-					spmat[i-nred][k++] = w[j];
+			for ( j = 0; j < col; j++ )
+				if ( w[j] )
+					break;
+			if ( j < col ) {
+				w1 = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+				for ( j = 0, k = 0; j < col; j++ )
+					if ( !isred[j] )
+						w1[k++] = w[j];
+				spmat[i] = w1;
+				i++;
+			}
 		}
+		/* update nsp */
+		nsp = i;
 
 		get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
 		init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
 
 		colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+		bzero(colstat,spcol*sizeof(int));
 		for ( i = 0, nonzero=0; i < nsp; i++ )
 			for ( j = 0; j < spcol; j++ )
 				if ( spmat[i][j] )
@@ -816,6 +876,10 @@ int m;
 			print_eg("Elim2",&eg_split_elim2);
 			fprintf(asir_out,"\n");
 		}
+
+		if ( !rank )
+			continue;
+
 		for ( j = 0, i = 0; j < spcol; j++ )
 			if ( colstat[j] ) {
 				mp0 = 0;