New command in transform. Lots of bugfixes.

sources/compcomm.c

@@ -757,7 +757,12 @@ int CoFormat(UBYTE *s)
 			x = 39;
 		}
 		AO.DoubleFlag = 0;
-		AC.OutputMode = 0;
+/*
+		The next line resets the mode to normal. Because the special modes
+		reset the line length we have a little problem with the special modes
+		and customized line length. We try to improve by removing the next line
+*/
+/*		AC.OutputMode = 0;  */
 		AC.LineLength = x;
 		if ( *s != 0 ) {
 			error = 1;

sources/declare.h

@@ -1369,6 +1369,8 @@ extern UBYTE *ReadRange(UBYTE *s, WORD *out, int par);
 extern WORD RunPermute(PHEAD WORD *fun, WORD *args, WORD *info);
 extern WORD RunReverse(PHEAD WORD *fun, WORD *args);
 extern WORD RunCycle(PHEAD WORD *fun, WORD *args, WORD *info);
+extern WORD RunAddArg(PHEAD WORD *fun, WORD *args);
+extern WORD RunMulArg(PHEAD WORD *fun, WORD *args);
 extern WORD RunIsLyndon(PHEAD WORD *fun, WORD *args, int par);
 extern WORD RunToLyndon(PHEAD WORD *fun, WORD *args, int par);
 

sources/dict.c

@@ -276,7 +276,6 @@ UBYTE *FindSymbol(WORD num)
 
 UBYTE *FindVector(WORD num)
 {
-	num -= AM.OffsetVector;
 	if ( AO.CurrentDictionary > 0 ) {
 		DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
 		int i;
@@ -288,6 +287,7 @@ UBYTE *FindVector(WORD num)
 			}
 		}
 	}
+	num -= AM.OffsetVector;
 	return(VARNAME(vectors,num));
 }
 
@@ -298,7 +298,6 @@ UBYTE *FindVector(WORD num)
 
 UBYTE *FindIndex(WORD num)
 {
-	num -= AM.OffsetIndex;
 	if ( AO.CurrentDictionary > 0 ) {
 		DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
 		int i;
@@ -310,6 +309,7 @@ UBYTE *FindIndex(WORD num)
 			}
 		}
 	}
+	num -= AM.OffsetIndex;
 	return(VARNAME(indices,num));
 }
 
@@ -320,7 +320,6 @@ UBYTE *FindIndex(WORD num)
 
 UBYTE *FindFunction(WORD num)
 {
-	num -= FUNCTION;
 	if ( AO.CurrentDictionary > 0 ) {
 		DICTIONARY *dict = AO.Dictionaries[AO.CurrentDictionary-1];
 		int i;
@@ -332,6 +331,7 @@ UBYTE *FindFunction(WORD num)
 			}
 		}
 	}
+	num -= FUNCTION;
 	return(VARNAME(functions,num));
 }
 
@@ -679,7 +679,7 @@ Compositeness:;
 				if ( s[2] < 0 ) type = DICT_VECTOR;
 				else            type = DICT_INDEX;
 				number = 1;
-				where = s;
+				where = s+2;
 				break;
 			default:
 				if ( *s < FUNCTION ) {
@@ -688,7 +688,9 @@ Compositeness:;
 				}
 				if ( s[1] == FUNHEAD ) {
 					type = DICT_FUNCTION;
-					number = s[0];
+					number = 1;
+					where = s;
+					break;
 				}
 				else {
 					type = DICT_FUNCTION_WITH_ARGUMENTS;

sources/ftypes.h

@@ -650,6 +650,7 @@ typedef int (*TFUN1)();
 #define UNHIDEGEXPRESSION 16
 #define INTOHIDELEXPRESSION 17
 #define INTOHIDEGEXPRESSION 18
+#define SPECTATOREXPRESSION 19
 
 #define PRINTOFF 0
 #define PRINTON 1
@@ -950,6 +951,8 @@ typedef int (*TFUN1)();
 #define ISLYNDONR   14
 #define TOLYNDON    15
 #define TOLYNDONR   16
+#define ADDARG      17
+#define MULTIPLYARG 18
 
 #define BASECODE 1
 #define YESLYNDON 1

sources/if.c

@@ -234,6 +234,7 @@ int FindVar(WORD *v, WORD *term)
 					a = f + ARGHEAD; astop = f + *f;
 					while ( a < astop ) {
 						if ( FindVar(v,a) == 1 ) return(1);
+						a += *a;
 					}
 					f = astop;
 				}

sources/message.c

@@ -450,7 +450,8 @@ va_dcl
 					*t = 0;
 					AddToLine((UBYTE *)Out);
 					if ( d->nfactors >= 1 && AN.listinprint[2] == DOLLAREXPR2 ) {
-						if ( d->type == 0 || d->factors == 0 ) goto dollarzero;
+						if ( d->type == 0 ||
+						 ( d->factors == 0 && d->nfactors != 1 ) ) goto dollarzero;
 						num = EvalDoLoopArg(BHEAD AN.listinprint+2,-1);
 						if ( num == 0 ) {
 							value[0] = 4; value[1] = d->nfactors; value[2] = 1; value[3] = 3; value[4] = 0;

sources/poly.h

@@ -188,7 +188,8 @@ std::ostream& operator<< (std::ostream &, const poly &);
  */
 inline void poly::check_memory (int i) {
 	POLY_GETIDENTITY(*this);
-	if (i + 2 + AN.poly_num_vars + AM.MaxTal >= size_of_terms) expand_memory(i + AM.MaxTal);
+	if (i + 3 + AN.poly_num_vars + AM.MaxTal >= size_of_terms) expand_memory(i + AM.MaxTal);
+//  Used to be i+2 but there should also be space for a trailing zero
 }
 
 // indexing operators

sources/polygcd.cc

@@ -903,6 +903,8 @@ const poly polygcd::gcd_modular_dense_interpolation (const poly &a, const poly &
 	poly lcoeffb(ppb.lcoeff_multivar(X));
 	poly gcdlcoeffs(gcd_Euclidean(lcoeffa,lcoeffb));
 
+	int l = MiN(ppa.degree(x[0]), ppb.degree(x[0]));
+	poly oldres(BHEAD 0);
 	poly res(BHEAD 0);
 	poly newshape(BHEAD 0);
 	poly modpoly(BHEAD 1,a.modp);
@@ -922,31 +924,22 @@ const poly polygcd::gcd_modular_dense_interpolation (const poly &a, const poly &
 		if (gcdmodc.is_zero()) return poly(BHEAD 0);
 
 		// normalize
-		gcdmodc *= substitute_last(gcdconts,X,c);
+		gcdmodc = (gcdmodc * substitute_last(gcdlcoeffs,X,c)) / gcdmodc.integer_lcoeff();
 
-		// compare the new gcd with the old
-		int comp=0;
-		if (res.is_zero())
-			comp=-1;
-		else
-			for (int i=0; i<(int)x.size()-1; i++)
-				if (gcdmodc[2+x[i]] != res[2+x[i]]) {
-					comp = gcdmodc[2+x[i]] - res[2+x[i]];
-					break;
-				}
-
-		poly oldres(res);
+		int m = gcdmodc.degree(x[0]);
 		poly simple(poly::simple_poly(BHEAD X,c,1,a.modp));
 
 		// if power is smaller, the old one was wrong
-		if (comp < 0) {
+		if (res.is_zero() || m < l) {
+			l = m;
+			oldres = res;
 			res = gcdmodc;
 			newshape = gcdmodc;
 			modpoly = simple;
 		}
-		else if (comp == 0) {
+		else if (m == l) {
+			oldres = res;
 			// equal powers, so interpolate results
-
 			poly coeff_poly(substitute_last(modpoly,X,c));
 			WORD coeff_word = coeff_poly[2+AN.poly_num_vars] * coeff_poly[3+AN.poly_num_vars];
 			if (coeff_word < 0) coeff_word += a.modp;
@@ -958,13 +951,14 @@ const poly polygcd::gcd_modular_dense_interpolation (const poly &a, const poly &
 		}
 
 		// check whether this is the complete gcd
-		if (res==oldres && res.lcoeff_univar(x[0])==lc) {
-			if (poly::divides(res,a) && poly::divides(res,b)) {
+		if (res==oldres) {
+			poly nres = res / content_multivar(res, X);
+			if (poly::divides(nres,ppa) && poly::divides(nres,ppb)) {
 #ifdef DEBUG
 				cout << "*** [" << thetime() << "]  RES : gcd_modular_dense_interpolation(" << a << "," << b << ","
-						 << x << "," << lc << "," << s <<") = " << res << endl;
+						 << x << "," << lc << "," << s <<") = " << gcdconts * nres << endl;
 #endif
-				return res;
+				return gcdconts * nres;
 			}
 		}
 	}
@@ -1005,14 +999,12 @@ const poly polygcd::gcd_modular (const poly &origa, const poly &origb, const vec
 
 	POLY_GETIDENTITY(origa);
 
-	// multiply a and b with gcd(lcoeffs), so that a gcd with
-	// lc(gcd)=lcoeff exists
-	poly lcoeffa(origa.lcoeff_univar(x[0]));
-	poly lcoeffb(origb.lcoeff_univar(x[0]));
-	poly lcoeff(gcd(lcoeffa,lcoeffb));
-
-	poly a(lcoeff * origa);
-	poly b(lcoeff * origb);
+	poly ac = integer_content(origa);
+	poly bc = integer_content(origb);
+	poly a(origa / ac);
+	poly b(origb / bc);
+	poly ic = integer_gcd(ac, bc);
+	poly g = integer_gcd(a.integer_lcoeff(), b.integer_lcoeff());
 
 	int pnum=0;
 
@@ -1022,12 +1014,12 @@ const poly polygcd::gcd_modular (const poly &origa, const poly &origb, const vec
 
 	while (true) {
 		// choose a prime and solve modulo the prime
-		WORD p = a.modp;
-		if (p==0) p = NextPrime(BHEAD pnum++);
+		WORD p = NextPrime(BHEAD pnum++);
 		if (poly(a.integer_lcoeff(),p).is_zero()) continue;
 		if (poly(b.integer_lcoeff(),p).is_zero()) continue;
 
-		poly c(gcd_modular_dense_interpolation(poly(a,p),poly(b,p),x,poly(lcoeff,p),poly(d,p)));
+		poly c(gcd_modular_dense_interpolation(poly(a,p),poly(b,p),x,poly(g,p),poly(d,p)));
+		c = (c * poly(g,p)) / c.integer_lcoeff(); // normalize so that lcoeff(c) = g mod p
 
 		if (c.is_zero()) {
 			// unlucky choices somewhere, so start all over again
@@ -1089,10 +1081,13 @@ const poly polygcd::gcd_modular (const poly &origa, const poly &origb, const vec
 			ppd /= content_univar(ppd,x[0]);
 #ifdef DEBUG
 			cout << "*** [" << thetime() << "]  RES : gcd_modular(" << origa << "," << origb << "," << x << ") = "
-					 << ppd << endl;
+					 << ic * ppd << endl;
 #endif
-			return ppd;
+			return ic * ppd;
 		}
+#ifdef DEBUG
+		MesPrint("*** [" << thetime() << "] Retrying modular_gcd with new prime");
+#endif
 	}
 }
 

sources/polywrap.cc

@@ -550,14 +550,22 @@ WORD *poly_ratfun_add (PHEAD WORD *t1, WORD *t2) {
 	// Calculate result
 	if (den1 != den2) {
 		gcd = polygcd::gcd(den1,den2);
+#ifdef OLDADDITION
 		num = num1*(den2/gcd) + num2*(den1/gcd);
 		den = (den1/gcd)*den2;
+		gcd = polygcd::gcd(num,den);
+#else
+		den = den1/gcd;
+		num = num1*(den2/gcd) + num2*den;
+		den = den*den2;
+		gcd = polygcd::gcd(num,gcd);
+#endif
 	}
 	else {
 		num = num1 + num2;
 		den = den1;
-	}
 		gcd = polygcd::gcd(num,den);
+	}
 
 	num /= gcd;
 	den /= gcd;
@@ -569,6 +577,8 @@ WORD *poly_ratfun_add (PHEAD WORD *t1, WORD *t2) {
 	if (num.size_of_form_notation() + den.size_of_form_notation() + 3 >= AM.MaxTer/(int)sizeof(WORD)) {
 		MLOCK(ErrorMessageLock);
 		MesPrint ("ERROR: PolyRatFun doesn't fit in a term");
+		MesPrint ("(1) num size = %d, den size = %d,  MaxTer = %d",num.size_of_form_notation(),
+				den.size_of_form_notation(),AM.MaxTer);
 		MUNLOCK(ErrorMessageLock);
 		Terminate(-1);
 	}
@@ -693,6 +703,8 @@ int poly_ratfun_normalize (PHEAD WORD *term) {
 	if (num1.size_of_form_notation() + den1.size_of_form_notation() + 3 >= AM.MaxTer/(int)sizeof(WORD)) {
 		MLOCK(ErrorMessageLock);
 		MesPrint ("ERROR: PolyRatFun doesn't fit in a term");
+		MesPrint ("(2) num size = %d, den size = %d,  MaxTer = %d",num1.size_of_form_notation(),
+				den1.size_of_form_notation(),AM.MaxTer);
 		MUNLOCK(ErrorMessageLock);
 		Terminate(-1);
 	}

sources/pre.c

@@ -5735,9 +5735,9 @@ int writeToChannel(int wtype, UBYTE *s, HANDLERS *h)
 			fstring++;
 			if ( *fstring == '$' ) {
 				UBYTE *dolalloc;
+				number = AO.OutSkip;
 dodollar:
 				while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
-				number = AO.OutSkip;
 				if ( AC.OutputMode == FORTRANMODE
 				 || AC.OutputMode == PFORTRANMODE ) {
 					number = 7;

sources/sort.c

@@ -875,7 +875,7 @@ LONG EndSort(PHEAD WORD *buffer, int par)
 					else if ( newout->handle >= 0 ) {	/* output too large */
 TooLarge:
 						MLOCK(ErrorMessageLock);
-						MesPrint("Output should fit inside a single term. Increase MaxTermSize?");
+						MesPrint("(1)Output should fit inside a single term. Increase MaxTermSize?");
 						MesCall("EndSort");
 						MUNLOCK(ErrorMessageLock);
 						retval = -1; goto RetRetval;
@@ -1042,7 +1042,7 @@ LONG EndSort(PHEAD WORD *buffer, int par)
 		else if ( newout ) {
 		  if ( newout->handle >= 0 ) {
 			MLOCK(ErrorMessageLock);
-			MesPrint("Output should fit inside a single term. Increase MaxTermSize?");
+			MesPrint("(2)Output should fit inside a single term. Increase MaxTermSize?");
 			MesCall("EndSort");
 			MUNLOCK(ErrorMessageLock);
 			Terminate(-1);

sources/store.c

@@ -296,7 +296,7 @@ int CoSave(UBYTE *inp)
 #endif
 
 	if ( !*p ) return(MesPrint("No filename in save statement"));
-	if ( FG.cTable[*p] && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
+	if ( FG.cTable[*p] > 1 && ( *p != '.' ) && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
 				return(MesPrint("Illegal filename"));
 	while ( *++p && *p != ',' ) {}
 	c = *p;
@@ -490,7 +490,7 @@ int CoLoad(UBYTE *inp)
 		if ( *p == 's' || *p == 'S' ) {
 			silentload = 1;
 			while ( *p && ( *p != ',' && *p != '-' && *p != '+'
-			&& *p != SEPARATOR && *p != ALTSEPARATOR ) ) p++;
+			&& *p != SEPARATOR && *p != ALTSEPARATOR && *p != '.' ) ) p++;
 		}
 		else if ( *p != ',' ) {
 			return(MesPrint("Illegal option in Load statement"));
@@ -499,7 +499,7 @@ int CoLoad(UBYTE *inp)
 	}
 	inp = p;
 	if ( !*p ) return(MesPrint("No filename in load statement"));
-	if ( FG.cTable[*p] && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
+	if ( FG.cTable[*p] > 1 && ( *p != '.' ) && ( *p != SEPARATOR ) && ( *p != ALTSEPARATOR ) )
 				return(MesPrint("Illegal filename"));
 	while ( *++p && *p != ',' ) {}
 	c = *p;

sources/threads.c

@@ -1695,6 +1695,7 @@ bucketstolen:;
 				}
 				AB[0]->R.outfile = oldoutfile;
 				AB[0]->R.hidefile->POfull = AB[0]->R.hidefile->POfill;
+				AB[0]->R.expflags = AR.expflags;
 				UNLOCK(AS.outputslock);
 
 				if ( fout->handle >= 0 ) {	/* Now get rid of the file */

sources/tools.c

@@ -110,15 +110,21 @@ UBYTE *LoadInputFile(UBYTE *filename, int type)
 	filesize = BASEPOSITION(scrpos);
 	PUTZERO(scrpos);
 	SeekFile(handle,&scrpos,SEEK_SET);
-	buffer = (UBYTE *)Malloc1(filesize+1,"LoadInputFile");
+	buffer = (UBYTE *)Malloc1(filesize+2,"LoadInputFile");
 	if ( ReadFile(handle,buffer,filesize) != filesize ) {
 		Error1("Read error for file ",name);
 		M_free(buffer,"LoadInputFile");
 		CloseFile(handle);
 		return(0);
 	}
 	CloseFile(handle);
+	if ( type == PROCEDUREFILE || type == SETUPFILE ) {
+		buffer[filesize] = '\n';
+		buffer[filesize+1] = 0;
+	}
+	else {
 		buffer[filesize] = 0;
+	}
 	return(buffer);
 }