Implemented id_ function and onefill option in tables. Manual will fo…

…llow soon.

sources/declare.h

@@ -1146,6 +1146,7 @@ extern DOLLARS DolToTerms(PHEAD WORD);
 extern WORD   EvalDoLoopArg(PHEAD WORD *,WORD);
 extern int    SetExprCases(int,int,int);
 extern int    TestSelect(WORD *,WORD *);
+extern int    TakeIDfunction(PHEAD WORD *);
 extern int    MakeSetupAllocs(VOID);
 extern int    TryFileSetups(VOID);
 extern void   ExchangeExpressions(int,int);
@@ -1503,6 +1504,6 @@ extern int AddToListPoly(PHEAD0);
 extern int InvPoly(PHEAD WORD *,WORD,WORD);
 
 /*
-  	#] Declarations :
+  	#] Declarations : 
 */
 #endif

sources/ftypes.h

@@ -453,8 +453,9 @@ typedef int (*TFUN1)();
 #define EXTEUCLIDEAN 98
 #define MAKERATIONAL 99
 #define INVERSEFUNCTION 100
+#define IDFUNCTION 101
 
-#define MAXBUILTINFUNCTION 100
+#define MAXBUILTINFUNCTION 101
 #define FIRSTUSERFUNCTION 150
 
 /*

sources/inivar.h

@@ -225,6 +225,7 @@ static struct fixedfun {
 	,{"exteuclidean_",0 ,0            ,0               ,0} /* EXTEUCLIDEAN */
 	,{"makerational_",0 ,0            ,0               ,0} /* MAKERATIONAL */
 	,{"inverse_"    ,0 ,0             ,0               ,0} /* INVERSEFUNCTION */
+	,{"id_"         ,1 ,0             ,0               ,0} /* IDFUNCTION */
 };
 
 FIXEDSET fixedsets[] = {

sources/names.c

@@ -981,7 +981,7 @@ eol:	while ( *s == ',' ) s++;
 }
 
 /*
-  	#] CoSymbol :
+  	#] CoSymbol : 
   	#[ AddIndex :
 
 	The actual addition. Special routine for additions 'on the fly'
@@ -1588,9 +1588,11 @@ IllForm:	MesPrint("&Illegal name or option in table declaration");
 */
 		if      ( StrICmp(name,(UBYTE *)("check" )) == 0 ) checkflag = 1;
 		else if ( StrICmp(name,(UBYTE *)("zero"  )) == 0 ) checkflag = 2;
+		else if ( StrICmp(name,(UBYTE *)("one"   )) == 0 ) checkflag = 3;
 		else if ( StrICmp(name,(UBYTE *)("strict")) == 0 ) rflag = 1;
 		else if ( StrICmp(name,(UBYTE *)("relax" )) == 0 ) rflag = -1;
-		else if ( StrICmp(name,(UBYTE *)("zerofill" )) == 0 ) rflag = -2;
+		else if ( StrICmp(name,(UBYTE *)("zerofill" )) == 0 ) { rflag = -2; checkflag = 2; }
+		else if ( StrICmp(name,(UBYTE *)("onefill" )) == 0 ) { rflag = -3; checkflag = 3; }
 		else if ( StrICmp(name,(UBYTE *)("sparse")) == 0 ) sparseflag |= 1;
 		else if ( StrICmp(name,(UBYTE *)("base")) == 0 ) sparseflag |= 3;
 		else if ( StrICmp(name,(UBYTE *)("tablebase")) == 0 ) sparseflag |= 3;
@@ -1609,6 +1611,7 @@ IllForm:	MesPrint("&Illegal name or option in table declaration");
 	if ( sparseflag ) {
 		if ( checkflag == 1 ) rflag = 0;
 		else if ( checkflag == 2 ) rflag = -2;
+		else if ( checkflag == 3 ) rflag = -3;
 		else rflag = -1;
 	}
 	if ( ( ret = GetVar(name,&type,&funnum,CFUNCTION,NOAUTO) ) ==

sources/normal.c

@@ -2861,6 +2861,7 @@ WithFix:				shortnum = k;
 
 		for ( i = 0; i < nnco; i++ ) {
 			t = pnco[i];
+			if ( *t == IDFUNCTION ) AN.idfunctionflag = 1;
 			if ( *t >= GAMMA && *t <= GAMMASEVEN ) {
 				WORD gtype;
 				to = m;

sources/pattern.c

@@ -1849,6 +1849,202 @@ int TestSelect(WORD *term, WORD *setp)
 
 /*
  		#] TestSelect : 
+ 		#[ TakeIDfunction :
+*/
+
+#define PutInBuffers(pow) \
+	AddRHS(AT.ebufnum,1); \
+	*out++ = SUBEXPRESSION; \
+	*out++ = SUBEXPSIZE; \
+	*out++ = C->numrhs; \
+	*out++ = pow; \
+	*out++ = AT.ebufnum; \
+	FILLSUB(out) \
+	r = AT.pWorkSpace[rhs+i]; \
+	if ( *r > 0 ) { \
+		oldinr = r[*r]; r[*r] = 0; \
+		AddNtoC(AT.ebufnum,(*r+1-ARGHEAD),(r+ARGHEAD)); \
+		r[*r] = oldinr; \
+	} \
+	else { \
+		ToGeneral(r,buffer,1); \
+		buffer[buffer[0]] = 0; \
+		AddNtoC(AT.ebufnum,buffer[0]+1,buffer); \
+	}
+
+int TakeIDfunction(PHEAD WORD *term)
+{
+	WORD *tstop, *t, *r, *m, *f, *nextf, *funstop, *left, *l, *newterm;
+	WORD *oldworkpointer, *out, oldinr, pow;
+	WORD buffer[20];
+	int i, ii, j, numsub, numfound = 0, first;
+	LONG lhs,rhs;
+	CBUF *C;
+	GETSTOP(term,tstop);
+	for ( t = term+1; t < tstop; t += t[1] ) { if ( *t == IDFUNCTION ) break; }
+	if ( t >= tstop ) return(0);
+/*
+	Step 1: test validity
+*/
+	funstop = t + t[1]; f = t + FUNHEAD;
+	left = term + *term;
+	l = left+1; numsub = 0;
+	while ( f < funstop ) {
+		nextf = f; NEXTARG(nextf)
+		if ( nextf >= funstop ) { return(0); } /* odd number of arguments */
+		if ( *f == -SYMBOL ) { *l++ = SYMBOL; *l++ = 4; *l++ = f[1]; *l++ = 1; }
+		else if ( *f < -FUNCTION ) { *l++ = *f; *l++ = FUNHEAD; FILLFUN(l) }
+		else if ( *f > 0 ) {
+			if ( *f != f[ARGHEAD]+ARGHEAD ) goto noaction;
+			if ( nextf[-1] != 3 || nextf[-2] != 1 || nextf[-3] != 1 ) goto noaction;
+			if ( f[ARGHEAD] <= 4 ) goto noaction;
+			if ( f[ARGHEAD] != f[ARGHEAD+2]+4 ) goto noaction;
+			if ( f[ARGHEAD] == 8 && f[ARGHEAD+1] == SYMBOL ) {
+				for ( i = 0; i < 4; i++ ) *l++ = f[ARGHEAD+1+i];
+			}
+			else if ( f[ARGHEAD] == 9 && f[ARGHEAD+1] == DOTPRODUCT ) {
+				for ( i = 0; i < 5; i++ ) *l++ = f[ARGHEAD+1+i];
+			}
+			else if ( f[ARGHEAD+1] >= FUNCTION ) {
+				for ( i = 0; i < f[ARGHEAD+1]-4; i++ ) *l++ = f[ARGHEAD+1+i];
+			}
+			else goto noaction;
+		}
+		else goto noaction;
+		numsub++;
+		f = nextf;
+		NEXTARG(f)
+	}
+	C = cbuf+AT.ebufnum;
+	oldworkpointer = AT.WorkPointer;
+	AT.WorkPointer = l;
+	*left = l-left;
+/*
+	Put the pointers to the lhs and the rhs in the pointer workspace
+*/
+	WantAddPointers(2*numsub);
+	lhs = AT.pWorkPointer;
+	rhs = lhs+numsub;
+	AT.pWorkPointer = rhs+numsub;
+	f = t + FUNHEAD; l = left+1;
+	for ( i = 0; i < numsub; i++ ) {
+		AT.pWorkSpace[lhs+i] = l; l += l[1];
+		NEXTARG(f);
+		AT.pWorkSpace[rhs+i] = f;
+		NEXTARG(f);
+	}
+/*
+	Take out the patterns and replace them by SUBEXPRESSIONs pointing at
+	the e buffer. We put the resulting term above the left sides.
+	Note that we take out only the first id_ if there is more than one!
+*/
+	first = 1;
+	t = term+1; newterm = AT.WorkPointer; out = newterm+1;
+	while ( t < tstop ) {
+		if ( *t == IDFUNCTION && first ) { first = 0; t += t[1]; continue; }
+		if ( *t >= FUNCTION ) {
+			for ( i = 0; i < numsub; i++ ) {
+				m = AT.pWorkSpace[lhs+i];
+				if ( *m != *t ) continue;
+				for ( j = 1; j < t[1]; j++ ) {
+					if ( m[j] != t[j] ) break;
+				}
+				if ( j != t[1] ) continue;
+				numfound++;
+/*
+				We have a match! Set up a SUBEXPRESSION subterm and put the
+				corresponding rhs in the eBuffer.
+*/
+				PutInBuffers(1)
+				t += t[1];
+			}
+			if ( i == numsub ) {	/* no match. Just copy to output. */
+				j = t[1]; NCOPY(out,t,j)
+			}
+		}
+		else if ( *t == SYMBOL ) {
+			for ( i = 0; i < numsub; i++ ) {
+				m = AT.pWorkSpace[lhs+i];
+				if ( *m != SYMBOL ) continue;
+				for ( ii = 2; ii < t[1]; ii += 2 ) {
+					if ( m[2] != t[ii] ) continue;
+					pow = t[ii+1]/m[3];
+					if ( pow <= 0 ) continue;
+					t[ii+1] = t[ii+1]%m[3];
+					numfound++;
+/*
+					Create the proper rhs in the eBuffer and set up a
+					SUBEXPRESSION subterm.
+*/
+					PutInBuffers(pow)
+				}
+			}
+/*
+			Now we copy whatever remains of the SYMBOL subterm to the output
+*/
+			m = out; *out++ = t[0]; *out++ = t[1];
+			for ( ii = 2; ii < t[1]; ii += 2 ) {
+				if ( t[ii+1] ) { *out++ = t[ii]; *out++ = t[ii+1]; }
+			}
+			m[1] = out-m;
+			if ( m[1] == 2 ) out = m;
+			t += t[1];
+		}
+		else if ( *t == DOTPRODUCT ) {
+			for ( i = 0; i < numsub; i++ ) {
+				m = AT.pWorkSpace[lhs+i];
+				if ( *m != DOTPRODUCT ) continue;
+				for ( ii = 2; ii < t[1]; ii += 3 ) {
+					if ( m[2] != t[ii] || m[3] != t[ii+1] ) continue;
+					pow = t[ii+2]/m[4];
+					if ( pow <= 0 ) continue;
+					t[ii+2] = t[ii+2]%m[4];
+					numfound++;
+/*
+					Create the proper rhs in the eBuffer and set up a
+					SUBEXPRESSION subterm.
+*/
+					PutInBuffers(pow)
+				}
+			}
+/*
+			Now we copy whatever remains of the DOTPRODUCT subterm to the output
+*/
+			m = out; *out++ = t[0]; *out++ = t[1];
+			for ( ii = 2; ii < t[1]; ii += 3 ) {
+				if ( t[ii+2] ) { *out++ = t[ii]; *out++ = t[ii+1]; *out++ = t[ii+2]; }
+			}
+			m[1] = out-m;
+			if ( m[1] == 2 ) out = m;
+			t += t[1];
+		}
+		else {
+			j = t[1]; NCOPY(out,t,j)
+		}
+	}
+/*
+	Copy the coefficient and set the size.
+*/
+	t = tstop; r = term+*term; while ( t < r ) *out++ = *t++;
+	*newterm = out-newterm;
+/*
+	Finally we move the new term over the original term.
+*/
+	i = *newterm;
+	t = term; r = newterm; NCOPY(t,r,i)
+/*
+	At this point we can return and if the calling Generator jumps back to
+	its start, TestSub can take care of the expansions of SUBEXPRESSIONs.
+*/
+	AT.pWorkPointer = lhs;
+	AT.WorkPointer = t;
+	return(numfound);
+noaction:
+	return(0);
+}
+
+/*
+ 		#] TakeIDfunction : 
   	#] Patterns : 
 */
 

sources/proces.c

@@ -257,7 +257,7 @@ WORD Processor()
 			if ( AR.expchanged ) AR.expflags |= ISUNMODIFIED;
 			AR.GetFile = 0;
 /*
-			#] in memory : 
+			#] in memory :
 */
 		}
 		else {
@@ -1660,17 +1660,41 @@ redosize:							i -= *t;
 						if ( i < T->numind ) goto teststrict;
 
 						isp = FindTableTree(T,t1+FUNHEAD,2);
-						if ( isp < 0 ) goto teststrict;
-						rhsnumber = T->tablepointers[isp+T->numind];
+						if ( isp < 0 ) {
+teststrict:					if ( T->strict == -2 ) {
+								rhsnumber = AM.zerorhs;
+								tbufnum = AM.zbufnum;
+							}
+							else if ( T->strict == -3 ) {
+								rhsnumber = AM.onerhs;
+								tbufnum = AM.zbufnum;
+							}
+							else if ( T->strict < 0 ) goto NextFun;
+							else {
+								MLOCK(ErrorMessageLock);
+								MesPrint("Element in table is undefined");
+								goto showtable;
+							}
+/*
+							Copy the indices;
+*/
+							t = t1+FUNHEAD+1;
+							for ( i = 0; i < T->numind; i++ ) {
+								*p = *t; p+=2; t+=2;
+							}
+						}
+						else {
+							rhsnumber = T->tablepointers[isp+T->numind];
 #if ( TABLEEXTENSION == 2 )
-						tbufnum = T->bufnum;
+							tbufnum = T->bufnum;
 #else
-						tbufnum = T->tablepointers[isp+T->numind+1];
+							tbufnum = T->tablepointers[isp+T->numind+1];
 #endif
-						t = t1+FUNHEAD+1;
-						ii = T->numind;
-						while ( --ii >= 0 ) {
-							*p = *t; t += 2; p += 2;
+							t = t1+FUNHEAD+1;
+							ii = T->numind;
+							while ( --ii >= 0 ) {
+								*p = *t; t += 2; p += 2;
+							}
 						}
 						goto caughttable;
 					}
@@ -1706,19 +1730,14 @@ showtable:							AO.OutFill = AO.OutputLine = (UBYTE *)m;
 */
 						i *= TABLEEXTENSION;
 						if ( T->tablepointers[i] == -1 ) {
-teststrict:					if ( T->strict == -2 ) {
-/*
-								AN.ncmod = oldncmod;
-								term[0] = 0;
-								return(0);
-
-								This goes wrong inside functions.
-								We need a pointer to a zero expression.
-								The following is slower but more general
-*/
+							if ( T->strict == -2 ) {
 								rhsnumber = AM.zerorhs;
 								tbufnum = AM.zbufnum;
 							}
+							else if ( T->strict == -3 ) {
+								rhsnumber = AM.onerhs;
+								tbufnum = AM.zbufnum;
+							}
 							else if ( T->strict < 0 ) goto NextFun;
 							else {
 								MLOCK(ErrorMessageLock);
@@ -2916,7 +2935,7 @@ WORD Generator(PHEAD WORD *term, WORD level)
 	CBUF *C = cbuf+AM.rbufnum, *CC = cbuf + AT.ebufnum;
 	LONG posisub, oldcpointer;
 	DOLLARS d = 0;
-	WORD numfac[5];
+	WORD numfac[5], idfunctionflag;
 #ifdef WITHPTHREADS
 	int nummodopt, dtype = -1, id;
 #endif
@@ -2934,14 +2953,17 @@ WORD Generator(PHEAD WORD *term, WORD level)
 */
 Renormalize:
 		AN.PolyNormFlag = 0;
+		AN.idfunctionflag = 0;
 		if ( ( retnorm = Normalize(BHEAD term) ) != 0 ) {
 			if ( retnorm > 0 ) {
 				if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
 				goto ReStart;
 			}
 			goto GenCall;
 		}
+		idfunctionflag = AN.idfunctionflag;
 		if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
+
 		if ( AN.PolyNormFlag ) {
 			if ( AN.PolyFunTodo == 0 ) {
 				if ( PolyFunMul(BHEAD term) ) goto GenCall;
@@ -2962,6 +2984,12 @@ WORD Generator(PHEAD WORD *term, WORD level)
 				AN.PolyFunTodo = 0;
 			}
 		}
+		if ( idfunctionflag > 0 ) {
+			if ( TakeIDfunction(BHEAD term) ) {
+				AT.WorkPointer = term + *term;
+				goto ReStart;
+			}
+		}
 		if ( AT.WorkPointer < (WORD *)(((UBYTE *)(term)) + AM.MaxTer) )
 			 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
 		do {