diff --git a/doc/manual/variable.tex b/doc/manual/variable.tex index 2203305a..3941b863 100644 --- a/doc/manual/variable.tex +++ b/doc/manual/variable.tex @@ -418,6 +418,7 @@ \section{Sets} numbers and whole function arguments. \item[fixed\_]\index{fixed\_} The set of all fixed indices. \item[index\_]\index{index\_} The set of all indices. +\item[vector\_]\index{index\_} The set of all (auto)declared vectors. \item[number\_]\index{number\_} The set of all rational numbers. \item[even\_]\index{even\_} This is a set of symbols. It refers to all even integer numbers that fit inside a {\FORM} word. diff --git a/sources/comexpr.c b/sources/comexpr.c index 58fb0d30..e94cd487 100644 --- a/sources/comexpr.c +++ b/sources/comexpr.c @@ -952,6 +952,28 @@ IllLeft:MesPrint("&Illegal LHS"); AT.WorkPointer = OldWork + OldWork[1]; if ( AC.lhdollarflag ) OldWork[4] |= DOLLARFLAG; AC.lhdollarflag = 0; +/* + Test whether the id/idold configuration is fine. +*/ + if ( type == TYPEIDOLD ) { + WORD ci = C->numlhs; + while ( ci >= 1 ) { + if ( C->lhs[ci][0] == TYPEIDNEW ) { + if ( (C->lhs[ci][2] & SUBMASK) == SUBALL ) { + MesPrint("&Idold/also cannot follow an id,all statement."); + error = 1; + } + break; + } + else if ( C->lhs[ci][0] == TYPEDETCURDUM ) { ci--; continue; } + else if ( C->lhs[ci][0] == TYPEIDOLD ) { ci--; continue; } + else ci = 0; + } + if ( ci < 1 ) { + MesPrint("&Idold/also should follow an id/idnew statement."); + error = 1; + } + } /* Now the right hand side. */ @@ -970,19 +992,7 @@ IllLeft:MesPrint("&Illegal LHS"); /* Actual adding happens only now after numrhs insertion */ - /* if ( !error ) */ { AddNtoL(OldWork[1],OldWork); } - if ( type == TYPEIDOLD ) { - if ( C->numlhs <= 1 || - ( C->lhs[C->numlhs-1][0] != TYPEIDNEW && - C->lhs[C->numlhs-1][0] != TYPEIDOLD ) ) { - MesPrint("&Idold/also should follow an id/idnew statement."); - error = 1; - } - else if ( (C->lhs[C->numlhs-1][2] & SUBMASK) == SUBALL ) { - MesPrint("&Idold/also cannot follow an id,all statement."); - error = 1; - } - } + if ( !error ) { AddNtoL(OldWork[1],OldWork); } AllDone: AC.lhdollarflag = 0; AT.WorkPointer = FirstWork; diff --git a/sources/compcomm.c b/sources/compcomm.c index fce06a50..194b820f 100644 --- a/sources/compcomm.c +++ b/sources/compcomm.c @@ -3737,6 +3737,10 @@ redo: AR.BracketOn++; *to++ = c2 + AM.OffsetVector; *to++ = 1; break; case CDELTA : *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break; +/* + case CSET : + *to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type; break; +*/ default : MesPrint("&Illegal bracket request for %s",pp); error = 1; break; @@ -5635,7 +5639,7 @@ nofunc: MesPrint("&%s is not a table",t); } /* - #] CoClearTable : + #] CoClearTable : #[ CoDenominators : */ diff --git a/sources/declare.h b/sources/declare.h index 7b8b7ba2..dd8390b0 100644 --- a/sources/declare.h +++ b/sources/declare.h @@ -504,6 +504,7 @@ extern WORD MultDo(PHEAD WORD *,WORD *); extern WORD NewSort(PHEAD0); extern WORD ExtraSymbol(WORD,WORD,WORD,WORD *,WORD *); extern WORD Normalize(PHEAD WORD *); +extern WORD BracketNormalize(PHEAD WORD *); extern VOID DropCoefficient(PHEAD WORD *); extern VOID DropSymbols(PHEAD WORD *); extern int PutInside(PHEAD WORD *, WORD *); diff --git a/sources/execute.c b/sources/execute.c index 8e04129b..789491d3 100644 --- a/sources/execute.c +++ b/sources/execute.c @@ -1004,7 +1004,7 @@ WORD PutBracket(PHEAD WORD *termin) WORD *t2, *s1, *s2; WORD *bStop, *bb, *bf, *tStop; WORD *term1,*term2, *m1, *m2, *tStopa; - WORD *bbb = 0, *bind, *binst = 0, bwild = 0; + WORD *bbb = 0, *bind, *binst = 0, bwild = 0, *bss = 0, *bns = 0, bset = 0; term1 = AT.WorkPointer+1; term2 = (WORD *)(((UBYTE *)(term1)) + AM.MaxTer); if ( ( (WORD *)(((UBYTE *)(term2)) + AM.MaxTer) ) > AT.WorkTop ) return(MesWork()); @@ -1017,6 +1017,7 @@ WORD PutBracket(PHEAD WORD *termin) b = AT.BrackBuf; bStop = b+*b; b++; while ( b < bStop ) { if ( *b == INDEX ) { bwild = 1; bbb = b+2; binst = b + b[1]; break; } + if ( *b == SETSET ) { bset = 1; bss = b+2; bns = b + b[1]; break; } b += b[1]; } diff --git a/sources/normal.c b/sources/normal.c index ce4a5798..4a4127da 100644 --- a/sources/normal.c +++ b/sources/normal.c @@ -1954,7 +1954,8 @@ ScanCont: while ( t < r ) { if ( k == 0 ) goto NormZero; if ( t[FUNHEAD] == -SYMBOL && *rr == -SNUMBER && t[1] == FUNHEAD+4 ) { if ( rr[1] < MAXPOWER ) { - t = rr; *rr = t[FUNHEAD+1]; + t[FUNHEAD+2] = t[FUNHEAD+1]; t += FUNHEAD+2; + from = m; goto NextSymbol; } } @@ -3329,10 +3330,15 @@ regularratfun:; } else goto NoRep; } - else if ( *ma == -VECTOR && ma+4 <= mb ) { - if ( ma[2] == -VECTOR ) *ReplaceSub++ = VECTOVEC; - else if ( ma[2] == -MINVECTOR ) - *ReplaceSub++ = VECTOMIN; + else if ( ( *ma == -VECTOR || *ma == -MINVECTOR ) && ma+4 <= mb ) { + if ( ma[2] == -VECTOR ) { + if ( *ma == -VECTOR ) *ReplaceSub++ = VECTOVEC; + else *ReplaceSub++ = VECTOMIN; + } + else if ( ma[2] == -MINVECTOR ) { + if ( *ma == -VECTOR ) *ReplaceSub++ = VECTOMIN; + else *ReplaceSub++ = VECTOVEC; + } /* Next is a vector-like subexpression Search for vector nature first @@ -3340,6 +3346,16 @@ regularratfun:; else if ( ma[2] > 0 ) { WORD *sstop, *ttstop, *w, *mm, n, count; WORD *v1, *v2 = 0; + if ( *ma == -MINVECTOR ) { + ss = ma+2; + sstop = ss + *ss; + ss += ARGHEAD; + while ( ss < sstop ) { + ss += *ss; + ss[-1] = -ss[-1]; + } + *ma = -VECTOR; + } ss = ma+2; sstop = ss + *ss; ss += ARGHEAD; @@ -4981,4 +4997,162 @@ int TestFunFlag(PHEAD WORD *tfun) /* #] TestFunFlag : + #[ BracketNormalize : +*/ + +#define EXCHN(t1,t2,n) { WORD a,i; for(i=0;i= FUNCTION ) { i = t[1]; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tt > termout+1 && tt-termout-1 > termout[2] ) { /* sorting */ + r = termout+1; ii = tt-r; + for ( i = 0; i < ii-FUNHEAD; ii += FUNHEAD ) { /* Bubble sort */ + for ( j = i+FUNHEAD; j > 0; j -= FUNHEAD ) { + if ( functions[r[j-FUNHEAD]-FUNCTION].commute + && functions[r[j]-FUNCTION].commute == 0 ) break; + if ( r[j-FUNHEAD] > r[j] ) EXCH(r[j-FUNHEAD],r[j]) + else break; + } + } + } + + tstart = tt; t = term + 1; *tt++ = DELTA; *tt++ = 2; + while ( t < stop ) { + if ( *t == DELTA ) { i = t[1]-2; t += 2; tstart[1] += i; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tstart[1] > 2 ) { + for ( r = tstart+2; r < tstart+tstart[1]; r += 2 ) { + if ( r[0] > r[1] ) EXCH(r[0],r[1]) + } + } + if ( tstart[1] > 4 ) { /* sorting */ + r = tstart+2; ii = tstart[1]-2; + for ( i = 0; i < ii-2; ii += 2 ) { /* Bubble sort */ + for ( j = i+2; j > 0; j -= 2 ) { + if ( r[j-2] > r[j] ) { + EXCH(r[j-2],r[j]) + EXCH(r[j-1],r[j+1]) + } + else if ( r[j-2] < r[j] ) break; + else { + if ( r[j-1] > r[j+1] ) EXCH(r[j-1],r[j+1]) + else break; + } + } + } + tt = tstart+tstart[1]; + } + else if ( tstart[1] == 2 ) { tt = tstart; } + else tt = tstart+4; + + tstart = tt; t = term + 1; *tt++ = INDEX; *tt++ = 2; + while ( t < stop ) { + if ( *t == INDEX ) { i = t[1]-2; t += 2; tstart[1] += i; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tstart[1] >= 4 ) { /* sorting */ + r = tstart+2; ii = tstart[1]-2; + for ( i = 0; i < ii-1; ii += 1 ) { /* Bubble sort */ + for ( j = i+1; j > 0; j -= 1 ) { + if ( r[j-1] > r[j] ) EXCH(r[j-1],r[j]) + else break; + } + } + tt = tstart+3; + } + else if ( tstart[1] == 2 ) { tt = tstart; } + + tstart = tt; t = term + 1; *tt++ = DOTPRODUCT; *tt++ = 2; + while ( t < stop ) { + if ( *t == DOTPRODUCT ) { i = t[1]-2; t += 2; tstart[1] += i; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tstart[1] > 5 ) { /* sorting */ + r = tstart+2; ii = tstart[1]-2; + for ( i = 0; i < ii; ii += 3 ) { + if ( r[i] < r[i+1] ) EXCH(r[i],r[i+1]) + } + for ( i = 0; i < ii-3; ii += 3 ) { /* Bubble sort */ + for ( j = i+3; j > 0; j -= 3 ) { + if ( r[j-3] < r[j] ) break; + if ( r[j-3] > r[j] ) { + EXCH(r[j-3],r[j]) + EXCH(r[j-2],r[j+1]) + } + else { + if ( r[j-2] > r[j+1] ) EXCH(r[j-2],r[j+1]) + else break; + } + } + } + tt = tstart+tstart[1]; + } + else if ( tstart[1] == 2 ) { tt = tstart; } + else { + if ( tstart[3] > tstart[4] ) EXCH(tstart[3],tstart[4]) + tt = tstart+5; + } + + tstart = tt; t = term + 1; *tt++ = SYMBOL; *tt++ = 2; + while ( t < stop ) { + if ( *t == SYMBOL ) { i = t[1]-2; t += 2; tstart[1] += i; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tstart[1] > 4 ) { /* sorting */ + r = tstart+2; ii = tstart[1]-2; + for ( i = 0; i < ii-2; ii += 2 ) { /* Bubble sort */ + for ( j = i+2; j > 0; j -= 2 ) { + if ( r[j-2] > r[j] ) EXCH(r[j-2],r[j]) + else break; + } + } + tt = tstart+tstart[1]; + } + else if ( tstart[1] == 2 ) { tt = tstart; } + else tt = tstart+4; + + tstart = tt; t = term + 1; *tt++ = SETSET; *tt++ = 2; + while ( t < stop ) { + if ( *t == SETSET ) { i = t[1]-2; t += 2; tstart[1] += i; NCOPY(tt,t,i); } + else t += t[1]; + } + if ( tstart[1] > 4 ) { /* sorting */ + r = tstart+2; ii = tstart[1]-2; + for ( i = 0; i < ii-2; ii += 2 ) { /* Bubble sort */ + for ( j = i+2; j > 0; j -= 2 ) { + if ( r[j-2] > r[j] ) { + EXCH(r[j-2],r[j]) + EXCH(r[j-1],r[j+1]) + } + else break; + } + } + tt = tstart+tstart[1]; + } + else if ( tstart[1] == 2 ) { tt = tstart; } + else tt = tstart+4; + *tt++ = 1; *tt++ = 1; *tt++ = 3; + t = term; i = *termout = tt - termout; tt = termout; + NCOPY(t,tt,i); + AT.WorkPointer = oldwork; + return(0); +} + +/* + #] BracketNormalize : */ diff --git a/sources/proces.c b/sources/proces.c index 33ced0cc..0571600c 100644 --- a/sources/proces.c +++ b/sources/proces.c @@ -1444,7 +1444,7 @@ Important: we may not have enough spots here Note defs at 471,467,460,400,425,328 */ if ( i > *t ) { -redosize: i -= *t; + i -= *t; *t2 -= i; t1[1] -= i; t += *t; @@ -1466,7 +1466,18 @@ redosize: i -= *t; } else { Normalize(BHEAD t); - if ( i > *t ) { retvalue = 1; goto redosize; } +/* if ( i > *t ) { retvalue = 1; goto redosize; } */ + if ( i > *t ) { + retvalue = 1; + i -= *t; + *t2 -= i; + t1[1] -= i; + t += *t; + r = t + i; + m = term + *term; + while ( r < m ) *t++ = *r++; + *term -= i; + } } AN.subsubveto = 0; AT.RecFlag--;