80 WORD ReNumber(
PHEAD WORD *term)
83 WORD *d, *e, **p, **f;
85 AN.DumFound = AN.RenumScratch;
86 AN.DumPlace = AN.PoinScratch;
87 AN.DumFunPlace = AN.FunScratch;
102 if ( *f ) **f |= DIRTYSYMFLAG;
105 for ( j = 1; j <= n; j++ ) {
106 if ( *e && *(p[j]) == old ) {
108 if ( f[j] ) *(f[j]) |= DIRTYSYMFLAG;
130 VOID FunLevel(
PHEAD WORD *term)
133 WORD *t, *tstop, *r, *fun;
137 tstop = r - ABS(r[-1]);
139 if ( t < tstop )
do {
148 if ( *t > AN.IndDum ) {
149 if ( AN.NumFound >= AN.MaxRenumScratch ) AdjustRenumScratch(BHEAD0);
153 *AN.DumFunPlace++ = 0;
169 if ( *t > AN.IndDum ) {
170 if ( AN.NumFound >= AN.MaxRenumScratch ) AdjustRenumScratch(BHEAD0);
174 *AN.DumFunPlace++ = 0;
185 if ( *t < FUNCTION ) {
186 MLOCK(ErrorMessageLock);
187 MesPrint(
"Unexpected code in ReNumber");
188 MUNLOCK(ErrorMessageLock);
192 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec
193 >= TENSORFUNCTION ) {
196 if ( *t > AN.IndDum ) {
197 if ( AN.NumFound >= AN.MaxRenumScratch ) AdjustRenumScratch(BHEAD0);
201 *AN.DumFunPlace++ = fun;
222 if ( *t == -INDEX ) {
224 if ( *t >= AN.IndDum ) {
225 if ( AN.NumFound >= AN.MaxRenumScratch ) AdjustRenumScratch(BHEAD0);
229 *AN.DumFunPlace++ = fun;
233 else if ( *t <= -FUNCTION ) t++;
240 }
while ( t < tstop );
251 WORD DetCurDum(
PHEAD WORD *t)
254 WORD maxval = AN.IndDum;
255 WORD maxtop = AM.IndDum + WILDOFFSET;
256 WORD *tstop, *m, *r, i;
258 tstop -= ABS(*tstop);
260 while ( t < tstop ) {
261 if ( *t == VECTOR ) {
265 if ( *m > maxval && *m < maxtop ) maxval = *m;
269 else if ( *t == DELTA || *t == INDEX ) {
274 if ( *m > maxval && *m < maxtop ) maxval = *m;
278 else if ( *t >= FUNCTION ) {
279 if ( functions[*t-FUNCTION].spec >= TENSORFUNCTION ) {
287 if ( *r <= -FUNCTION ) r++;
288 else if ( *r == -INDEX ) {
289 if ( r[1] > maxval && r[1] < maxtop ) maxval = r[1];
298 i = DetCurDum(BHEAD m);
299 if ( i > maxval && i < maxtop ) maxval = i;
323 int FullRenumber(
PHEAD WORD *term, WORD par)
326 WORD *d, **p, **f, *w, *t, *best, *stac, *perm, a, *termtry;
328 WORD *oldworkpointer = AT.WorkPointer;
329 n = ReNumber(BHEAD term) - AM.IndDum;
330 if ( n <= 1 )
return(0);
331 Normalize(BHEAD term);
332 if ( *term == 0 )
return(0);
333 n = ReNumber(BHEAD term) - AM.IndDum;
337 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
339 best = w = AT.WorkPointer; t = term;
340 for ( i = *term; i > 0; i-- ) *w++ = *t++;
342 Normalize(BHEAD best);
343 AT.WorkPointer = w = best + *best;
346 termtry = perm + n + 1;
347 for ( i = 1; i <= n; i++ ) perm[i] = i + AM.IndDum;
348 for ( i = 1; i <= n; i++ ) stac[i] = i;
349 for ( i = 0; i < k; i++ ) d[i] = *(p[i]) - AM.IndDum;
351 for ( i = 1; i < n; i++ ) {
352 for ( j = i+1; j <= n; j++ ) {
353 a = perm[j]; perm[j] = perm[i]; perm[i] = a;
354 for ( ii = 0; ii < k; ii++ ) {
355 *(p[ii]) = perm[d[ii]];
356 if ( f[ii] ) *(f[ii]) |= DIRTYSYMFLAG;
358 t = term; w = termtry;
359 for ( ii = 0; ii < *term; ii++ ) *w++ = *t++;
361 if ( Normalize(BHEAD termtry) == 0 ) {
362 if ( *termtry == 0 )
goto Return0;
363 if ( ( ii = CompareTerms(BHEAD termtry,best,0) ) > 0 ) {
364 t = termtry; w = best;
365 for ( ii = 0; ii < *termtry; ii++ ) *w++ = *t++;
368 else if ( ii == 0 &&
CompCoef(termtry,best) != 0 )
372 a = perm[j]; perm[j] = perm[i]; perm[i] = a;
376 else if ( par == 1 ) {
379 if ( stac[j] == n ) {
380 a = perm[j]; perm[j] = perm[n]; perm[n] = a;
386 if ( j != stac[j] ) {
387 a = perm[j]; perm[j] = perm[stac[j]]; perm[stac[j]] = a;
390 a = perm[j]; perm[j] = perm[stac[j]]; perm[stac[j]] = a;
392 for ( i = 0; i < k; i++ ) {
393 *(p[i]) = perm[d[i]];
394 if ( f[i] ) *(f[i]) |= DIRTYSYMFLAG;
396 t = term; w = termtry;
397 for ( i = 0; i < *term; i++ ) *w++ = *t++;
399 if ( Normalize(BHEAD termtry) == 0 ) {
400 if ( *termtry == 0 )
goto Return0;
401 if ( ( ii = CompareTerms(BHEAD termtry,best,0) ) > 0 ) {
402 t = termtry; w = best;
403 for ( i = 0; i < *termtry; i++ ) *w++ = *t++;
405 else if ( ii == 0 &&
CompCoef(termtry,best) != 0 )
409 if ( j < n-1 ) { j = n-1; }
414 for ( i = 0; i < n; i++ ) *t++ = *w++;
415 AT.WorkPointer = oldworkpointer;
419 AT.WorkPointer = oldworkpointer;
435 VOID MoveDummies(
PHEAD WORD *term, WORD shift)
438 WORD maxval = AN.IndDum;
439 WORD maxtop = AM.IndDum + WILDOFFSET;
441 tstop = term + *term - 1;
442 tstop -= ABS(*tstop);
444 while ( term < tstop ) {
445 if ( *term == VECTOR ) {
449 if ( *m > maxval && *m < maxtop ) *m += shift;
453 else if ( *term == DELTA || *term == INDEX ) {
458 if ( *m > maxval && *m < maxtop ) *m += shift;
462 else if ( *term >= FUNCTION ) {
463 if ( functions[*term-FUNCTION].spec >= TENSORFUNCTION ) {
471 if ( *r <= -FUNCTION ) r++;
472 else if ( *r == -INDEX ) {
473 if ( r[1] > maxval && r[1] < maxtop ) r[1] += shift;
482 MoveDummies(BHEAD m,shift);
505 void AdjustRenumScratch(PHEAD0)
510 WORD **newpoin, *newnum;
511 if ( AN.MaxRenumScratch == 0 ) newsize = 100;
512 else newsize = AN.MaxRenumScratch*2;
513 if ( newsize > MAXPOSITIVE/2 ) newsize = MAXPOSITIVE/2+1;
515 newpoin = (WORD **)Malloc1(newsize*
sizeof(WORD *),
"PoinScratch");
516 for ( i = 0; i < AN.NumFound; i++ ) newpoin[i] = AN.PoinScratch[i];
517 for ( ; i < newsize; i++ ) newpoin[i] = 0;
518 if ( AN.PoinScratch ) M_free(AN.PoinScratch,
"PoinScratch");
519 AN.PoinScratch = newpoin;
520 AN.DumPlace = newpoin + AN.NumFound;
522 newpoin = (WORD **)Malloc1(newsize*
sizeof(WORD *),
"FunScratch");
523 for ( i = 0; i < AN.NumFound; i++ ) newpoin[i] = AN.FunScratch[i];
524 for ( ; i < newsize; i++ ) newpoin[i] = 0;
525 if ( AN.FunScratch ) M_free(AN.FunScratch,
"FunScratch");
526 AN.FunScratch = newpoin;
527 AN.DumFunPlace = newpoin + AN.NumFound;
529 newnum = (WORD *)Malloc1(newsize*
sizeof(WORD),
"RenumScratch");
530 for ( i = 0; i < AN.NumFound; i++ ) newnum[i] = AN.RenumScratch[i];
531 for ( ; i < newsize; i++ ) newnum[i] = 0;
532 if ( AN.RenumScratch ) M_free(AN.RenumScratch,
"RenumScratch");
533 AN.RenumScratch = newnum;
534 AN.DumFound = newnum + AN.NumFound;
536 AN.MaxRenumScratch = newsize;
551 WORD CountDo(WORD *term, WORD *instruct)
553 WORD *m, *r, i, j, count = 0;
554 WORD *stopper, *tstop, *r1 = 0, *r2 = 0;
558 tstop = term + *term; tstop -= ABS(tstop[-1]); term++;
559 while ( term < tstop ) {
566 while ( m < stopper ) {
567 if ( *m == SYMBOL && m[2] == *term ) {
568 count += m[3] * term[1];
581 while ( m < stopper ) {
582 if ( *m == DOTPRODUCT && (( m[2] == *term &&
583 m[3] == term[1]) || ( m[2] == term[1] &&
585 count += m[4] * term[2];
591 while ( m < stopper ) {
592 if ( *m == VECTOR && m[2] == *term &&
593 ( m[3] & DOTPBIT ) != 0 ) {
594 count += m[m[1]-1] * term[2];
599 while ( m < stopper ) {
600 if ( *m == VECTOR && m[2] == term[1] &&
601 ( m[3] & DOTPBIT ) != 0 ) {
602 count += m[m[1]-1] * term[2];
615 VectInd: i = term[1] - 2;
619 while ( m < stopper ) {
620 if ( *m == VECTOR && m[2] == *term &&
621 ( m[3] & VECTBIT ) != 0 ) {
631 if ( *term >= FUNCTION ) {
634 while ( m < stopper ) {
635 if ( *m == FUNCTION && m[2] == i ) count += m[3];
638 if ( functions[i-FUNCTION].spec >= TENSORFUNCTION ) {
639 i = term[1] - FUNHEAD;
644 while ( m < stopper ) {
645 if ( *m == VECTOR && m[2] == *term &&
646 ( m[3] & FUNBIT ) != 0 ) {
660 if ( ( *term == -INDEX || *term == -VECTOR
661 || *term == -MINVECTOR ) && term[1] < MINSPEC ) {
663 while ( m < stopper ) {
664 if ( *m == VECTOR && term[1] == m[2]
665 && ( m[3] & SETBIT ) != 0 ) {
666 r1 = SetElements + Sets[m[4]].first;
667 r2 = SetElements + Sets[m[4]].last;
681 else { NEXTARG(term) }
705 WORD CountFun(WORD *term, WORD *countfun)
707 WORD *m, *r, i, j, count = 0, *instruct, *stopper, *tstop;
710 instruct = countfun + FUNHEAD;
711 tstop = term + *term; tstop -= ABS(tstop[-1]); term++;
712 while ( term < tstop ) {
719 while ( m < stopper ) {
720 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
721 if ( *m == -SYMBOL && m[1] == *term
722 && m[2] == -SNUMBER && ( m + 2 ) < stopper ) {
723 count += m[3] * term[1]; m += 4;
736 while ( m < stopper ) {
737 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
738 if ( *m == 9+ARGHEAD && m[ARGHEAD] == 9
739 && m[ARGHEAD+1] == DOTPRODUCT
740 && m[ARGHEAD+9] == -SNUMBER && ( m + ARGHEAD+9 ) < stopper
741 && (( m[ARGHEAD+3] == *term &&
742 m[ARGHEAD+4] == term[1]) ||
743 ( m[ARGHEAD+3] == term[1] &&
744 m[ARGHEAD+4] == *term )) ) {
745 count += m[ARGHEAD+10] * term[2];
751 while ( m < stopper ) {
752 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
753 if ( ( *m == -VECTOR || *m == -MINVECTOR )
755 m[2] == -SNUMBER && ( m+2 ) < stopper ) {
756 count += m[3] * term[2]; m += 4;
761 while ( m < stopper ) {
762 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
763 if ( ( *m == -VECTOR || *m == -MINVECTOR )
764 && m[1] == term[1] &&
765 m[2] == -SNUMBER && ( m+2 ) < stopper ) {
766 count += m[3] * term[2];
780 VectInd: i = term[1] - 2;
784 while ( m < stopper ) {
785 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
786 if ( ( *m == -VECTOR || *m == -MINVECTOR )
788 m[2] == -SNUMBER && (m+2) < stopper ) {
789 count += m[3]; m += 4;
798 if ( *term >= FUNCTION ) {
801 while ( m < stopper ) {
802 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
803 if ( *m == -i && m[1] == -SNUMBER && (m+1) < stopper ) {
804 count += m[2]; m += 3;
808 if ( functions[i-FUNCTION].spec >= TENSORFUNCTION ) {
809 i = term[1] - FUNHEAD;
814 while ( m < stopper ) {
815 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
816 if ( ( *m == -VECTOR || *m == -INDEX
817 || *m == -MINVECTOR ) && m[1] == *term &&
818 m[2] == -SNUMBER && (m+2) < stopper ) {
819 count += m[3]; m += 4;
832 if ( ( *term == -INDEX || *term == -VECTOR
833 || *term == -MINVECTOR ) && term[1] < MINSPEC ) {
835 while ( m < stopper ) {
836 if ( *m == -SNUMBER ) { NEXTARG(m) continue; }
837 if ( *m == -VECTOR && m[1] == term[1]
838 && m[2] == -SNUMBER && (m+2) < stopper ) {
846 else { NEXTARG(term) }
866 WORD DimensionSubterm(WORD *subterm)
868 WORD *r, *rstop, dim, i;
870 rstop = subterm + subterm[1];
871 if ( *subterm == SYMBOL ) {
873 while ( r < rstop ) {
874 if ( *r <= NumSymbols && *r > -MAXPOWER ) {
875 dim = symbols[*r].dimension;
876 if ( dim == MAXPOSITIVE )
goto undefined;
878 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
881 else if ( *r <= MAXVARIABLES ) {
885 i = MAXVARIABLES - *r;
886 dim = cbuf[AM.sbufnum].dimension[i];
887 if ( dim == MAXPOSITIVE )
goto undefined;
888 if ( dim == -MAXPOSITIVE )
goto outofrange;
890 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
896 else if ( *subterm == DOTPRODUCT ) {
898 while ( r < rstop ) {
899 dim = vectors[*r-AM.OffsetVector].dimension;
900 if ( dim == MAXPOSITIVE )
goto undefined;
902 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
903 dim = vectors[r[1]-AM.OffsetVector].dimension;
904 if ( dim == MAXPOSITIVE )
goto undefined;
906 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
910 else if ( *subterm == VECTOR ) {
912 while ( r < rstop ) {
913 dim = vectors[*r-AM.OffsetVector].dimension;
914 if ( dim == MAXPOSITIVE )
goto undefined;
916 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
920 else if ( *subterm == INDEX ) {
922 while ( r < rstop ) {
924 dim = vectors[*r-AM.OffsetVector].dimension;
925 if ( dim == MAXPOSITIVE )
goto undefined;
927 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
932 else if ( *subterm >= FUNCTION ) {
933 dim = functions[*subterm-FUNCTION].dimension;
934 if ( dim == MAXPOSITIVE )
goto undefined;
936 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
937 if ( functions[*subterm-FUNCTION].spec > 0 ) {
938 r = subterm + FUNHEAD;
939 while ( r < rstop ) {
941 dim = vectors[*r-AM.OffsetVector].dimension;
942 if ( dim == MAXPOSITIVE )
goto undefined;
944 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
952 return((WORD)MAXPOSITIVE);
954 return(-(WORD)MAXPOSITIVE);
967 WORD DimensionTerm(WORD *term)
969 WORD *t, *tstop, dim;
971 tstop = term + *term; tstop -= ABS(tstop[-1]);
973 while ( t < tstop ) {
974 dim = DimensionSubterm(t);
975 if ( dim == MAXPOSITIVE )
goto undefined;
976 if ( dim == -MAXPOSITIVE )
goto outofrange;
978 if ( x >= MAXPOSITIVE || x <= -MAXPOSITIVE )
goto outofrange;
983 return((WORD)MAXPOSITIVE);
985 return(-(WORD)MAXPOSITIVE);
999 WORD DimensionExpression(
PHEAD WORD *expr)
1001 WORD dim, *term, *old, x = 0;
1005 dim = DimensionTerm(term);
1006 if ( dim == MAXPOSITIVE )
goto undefined;
1007 if ( dim == -MAXPOSITIVE )
goto outofrange;
1008 if ( first ) { x = dim; }
1009 else if ( x != dim ) {
1010 old = AN.currentTerm;
1011 MLOCK(ErrorMessageLock);
1012 MesPrint(
"Dimension is not the same in the terms of the expression");
1015 AN.currentTerm = term;
1018 MUNLOCK(ErrorMessageLock);
1019 AN.currentTerm = old;
1020 return(-(WORD)MAXPOSITIVE);
1026 return((WORD)MAXPOSITIVE);
1028 old = AN.currentTerm;
1029 AN.currentTerm = term;
1030 MLOCK(ErrorMessageLock);
1031 MesPrint(
"Dimension out of range in %t in subexpression");
1032 MUNLOCK(ErrorMessageLock);
1033 AN.currentTerm = old;
1034 return(-(WORD)MAXPOSITIVE);
1043 WORD MultDo(
PHEAD WORD *term, WORD *pattern)
1048 if ( pattern[2] > 0 ) {
1054 *term += SUBEXPSIZE;
1056 do { *--r = *--t; }
while ( --i > 0 );
1059 while ( --i >= 0 ) *t++ = *r++;
1060 AT.WorkPointer = term + *term;
1071 WORD TryDo(
PHEAD WORD *term, WORD *pattern, WORD level)
1074 WORD *t, *r, *m, i, j;
1075 ReNumber(BHEAD term);
1076 Normalize(BHEAD term);
1077 m = r = term + *term;
1087 if ( ( j = Normalize(BHEAD r) ) == 0 || j == 1 ) {
1088 if ( *r == 0 )
return(0);
1089 ReNumber(BHEAD r); Normalize(BHEAD r);
1090 if ( *r == 0 )
return(0);
1091 if ( ( i = CompareTerms(BHEAD term,r,0) ) < 0 )
return(
Generator(BHEAD r,level));
1092 if ( i == 0 &&
CompCoef(term,r) != 0 ) {
return(0); }
1114 WORD DoDistrib(
PHEAD WORD *term, WORD level)
1117 WORD *t, *m, *r = 0, *stop, *tstop, *termout, *endhead, *starttail, *parms;
1118 WORD i, j, k, n, nn, ntype, fun1 = 0, fun2 = 0, typ1 = 0, typ2 = 0;
1119 WORD *arg, *oldwork, *mf, ktype = 0, atype = 0;
1120 WORD sgn, dirtyflag;
1121 AN.TeInFun = AR.TePos = 0;
1124 stop = tstop - ABS(tstop[-1]);
1126 while ( t < stop ) {
1128 if ( *t == DISTRIBUTION && t[FUNHEAD] == -SNUMBER
1129 && t[FUNHEAD+1] >= -2 && t[FUNHEAD+1] <= 2
1130 && t[FUNHEAD+2] == -SNUMBER
1131 && t[FUNHEAD+4] <= -FUNCTION
1132 && t[FUNHEAD+5] <= -FUNCTION ) {
1133 fun1 = -t[FUNHEAD+4];
1134 fun2 = -t[FUNHEAD+5];
1135 typ1 = functions[fun1-FUNCTION].spec;
1136 typ2 = functions[fun2-FUNCTION].spec;
1137 if ( typ1 > 0 || typ2 > 0 ) {
1141 if ( *m != -INDEX && *m != -VECTOR && *m != -MINVECTOR )
1146 MLOCK(ErrorMessageLock);
1147 MesPrint(
"Incompatible function types and arguments in distrib_");
1148 MUNLOCK(ErrorMessageLock);
1157 ntype = t[FUNHEAD+1];
1186 parms = m = t + FUNHEAD+6;
1192 oldwork = AT.WorkPointer;
1193 arg = AT.WorkPointer + 1;
1197 case 0: ktype = 1; atype = n < 0 ? 1: 0; n = 0;
break;
1198 case 1: ktype = 1; atype = 0;
break;
1199 case 2: ktype = 0; atype = 0;
break;
1200 case -1: ktype = 1; atype = 1;
break;
1201 case -2: ktype = 0; atype = 1;
break;
1208 if ( n > i )
return(0);
1210 for ( j = 0; j < n; j++ ) arg[j] = 1;
1211 for ( j = n; j < i; j++ ) arg[j] = 0;
1216 while ( t < endhead ) *m++ = *t++;
1223 while ( k-- > 0 ) *m++ = 0;
1226 for ( k = 0; k < i; k++ ) {
1227 if ( arg[k] == ktype ) {
1228 if ( *r <= -FUNCTION ) *m++ = *r++;
1229 else if ( *r < 0 ) {
1231 if ( *r == -MINVECTOR ) sgn ^= 1;
1235 else { *m++ = *r++; *m++ = *r++; }
1244 mf[1] = WORDDIF(m,mf);
1251 while ( k-- > 0 ) *m++ = 0;
1254 for ( k = 0; k < i; k++ ) {
1255 if ( arg[k] != ktype ) {
1256 if ( *r <= -FUNCTION ) *m++ = *r++;
1257 else if ( *r < 0 ) {
1259 if ( *r == -MINVECTOR ) sgn ^= 1;
1263 else { *m++ = *r++; *m++ = *r++; }
1272 mf[1] = WORDDIF(m,mf);
1276 for ( k = 0; k < i-1; k++ ) {
1277 if ( arg[k] == 0 )
continue;
1279 while ( k < i-1 && EqualArg(parms,k,k+1) ) { k++; k1++; }
1280 while ( k2 <= k && arg[k2] == 1 ) k2++;
1285 if ( k2 != k1 && k2 != 0 ) {
1286 if ( GetBinom((UWORD *)m+3,m+2,k1,k2) ) {
1287 MLOCK(ErrorMessageLock);
1288 MesCall(
"DoDistrib");
1289 MUNLOCK(ErrorMessageLock);
1292 m[1] = ( m[2] < 0 ? -m[2]: m[2] ) + 3;
1300 while ( r < tstop ) *m++ = *r++;
1305 for ( j = 0; j < i && k > 0; j++ ) {
1306 if ( arg[j] == 1 ) k--;
1312 if ( sgn ) m[-1] = -m[-1];
1313 *termout = WORDDIF(m,termout);
1315 if ( AT.WorkPointer > AT.WorkTop ) {
1316 MLOCK(ErrorMessageLock);
1318 MUNLOCK(ErrorMessageLock);
1323 if (
Generator(BHEAD termout,level) ) Terminate(-1);
1329 redok:
while ( arg[j] == 1 && j >= 0 ) { j--; k++; }
1330 while ( arg[j] == 0 && j >= 0 ) j--;
1334 while ( !atype && EqualArg(parms,j,j+1) ) {
1336 if ( j >= i - k - 1 ) { j = k1; k++;
goto redok; }
1339 while ( k >= 0 ) { j++; arg[j] = 1; k--; }
1341 while ( j < i ) { arg[j] = 0; j++; }
1346 while ( arg[j] == 1 && j >= 0 ) { j--; k++; }
1347 while ( arg[j] == 0 && j >= 0 ) j--;
1350 while ( k >= 0 ) { j++; arg[j] = 1; k--; }
1352 while ( j < i ) { arg[j] = 0; j++; }
1355 }
while ( ntype == 0 && ++n <= i );
1356 AT.WorkPointer = oldwork;
1367 WORD EqualArg(WORD *parms, WORD num1, WORD num2)
1372 while ( --num1 >= 0 ) { NEXTARG(t1); }
1374 while ( --num2 >= 0 ) { NEXTARG(t2); }
1375 if ( *t1 != *t2 )
return(0);
1377 if ( *t1 <= -FUNCTION || t1[1] == t2[1] )
return(1);
1381 while ( --i >= 0 ) {
1382 if ( *t1 != *t2 )
return(0);
1393 WORD DoDelta3(
PHEAD WORD *term, WORD level)
1396 WORD *t, *m, *m1, *m2, *stopper, *tstop, *termout, *dels, *taken;
1397 WORD *ic, *jc, *factors;
1398 WORD num, num2, i, j, k, knum, a;
1399 AN.TeInFun = AR.TePos = 0;
1400 tstop = term + *term;
1401 stopper = tstop - ABS(tstop[-1]);
1403 while ( ( *t != DELTA3 || ((t[1]-FUNHEAD) & 1 ) != 0 ) && t < stopper )
1405 if ( t >= stopper ) {
1406 MLOCK(ErrorMessageLock);
1407 MesPrint(
"Internal error with dd_ function");
1408 MUNLOCK(ErrorMessageLock);
1411 m1 = t; m2 = t + t[1];
1412 num = t[1] - FUNHEAD;
1414 termout = t = AT.WorkPointer;
1416 while ( m < m1 ) *t++ = *m++;
1417 m = m2;
while ( m < tstop ) *t++ = *m++;
1418 *termout = WORDDIF(t,termout);
1421 MLOCK(ErrorMessageLock);
1423 MUNLOCK(ErrorMessageLock);
1426 AT.WorkPointer = termout;
1433 for ( i = 1; i < num; i++ ) {
1434 if ( t[i] < t[i-1] ) {
1435 a = t[i]; t[i] = t[i-1]; t[i-1] = a;
1438 if ( t[j] >= t[j-1] )
break;
1439 a = t[j]; t[j] = t[j-1]; t[j-1] = a;
1449 m = taken = AT.WorkPointer;
1450 for ( i = 0; i < num; i++ ) *m++ = 0;
1452 for ( i = 0; i < num; knum++ ) {
1453 *m++ = t[i]; i++; taken[knum] = 1;
1455 if ( t[i] != t[i-1] )
break;
1456 i++; (taken[knum])++;
1459 for ( i = 0; i < knum; i++ ) *m++ = taken[i];
1460 ic = m; num2 = num/2;
1462 factors = jc + num2;
1463 termout = factors + num2;
1470 t = termout; m = term;
1471 while ( m < m1 ) *t++ = *m++;
1472 *t++ = DELTA; *t++ = num+2;
1473 for ( i = 0; i < num2; i++ ) {
1474 *t++ = dels[ic[i]]; *t++ = dels[jc[i]];
1476 for ( i = 0; i < num2; i++ ) {
1477 if ( ic[i] == jc[i] ) {
1479 while ( i < num2-1 && ic[i] == ic[i+1] && ic[i] == jc[i+1] )
1481 for ( a = 1; a < j; a++ ) {
1482 *t++ = SNUMBER; *t++ = 4; *t++ = 2*a+1; *t++ = 1;
1484 for ( a = 0; a+1+i < num2; a++ ) {
1485 if ( ic[a+i] != ic[a+i+1] )
break;
1488 if ( GetBinom((UWORD *)(t+3),t+2,2*j+a,a) ) {
1489 MLOCK(ErrorMessageLock);
1491 MUNLOCK(ErrorMessageLock);
1494 t[1] = ( t[2] < 0 ? -t[2]: t[2] ) + 3;
1499 else if ( factors[i] != 1 ) {
1500 *t++ = SNUMBER; *t++ = 4; *t++ = factors[i]; *t++ = 1;
1503 for ( i = 0; i < num2-1; i++ ) {
1504 if ( ic[i] == jc[i] )
continue;
1506 while ( i < num2-1 && jc[i] == jc[i+1] && ic[i] == ic[i+1] ) {
1509 for ( a = 0; a+i < num2-1; a++ ) {
1510 if ( ic[i+a] != ic[i+a+1] )
break;
1513 if ( GetBinom((UWORD *)(t+3),t+2,j+a,a) ) {
1514 MLOCK(ErrorMessageLock);
1516 MUNLOCK(ErrorMessageLock);
1519 t[1] = ( t[2] < 0 ? -t[2]: t[2] ) + 3;
1525 while ( m < tstop ) *t++ = *m++;
1526 *termout = WORDDIF(t,termout);
1529 MLOCK(ErrorMessageLock);
1531 MUNLOCK(ErrorMessageLock);
1535 if ( k >= 0 )
goto nextj;
1538 for ( ic[k] = 0; ic[k] < knum; ic[k]++ ) {
1539 if ( taken[ic[k]] > 0 )
break;
1541 if ( k > 0 && ic[k-1] == ic[k] ) jc[k] = jc[k-1];
1543 for ( ; jc[k] < knum; jc[k]++ ) {
1544 if ( taken[jc[k]] <= 0 )
continue;
1545 if ( ic[k] == jc[k] ) {
1546 if ( taken[jc[k]] <= 1 )
continue;
1554 factors[k] = taken[jc[k]];
1555 (taken[ic[k]])--; (taken[jc[k]])--;
1560 (taken[ic[k]])++; (taken[jc[k]])++;
1563 if ( k >= 0 )
goto nextj;
1566 AT.WorkPointer = taken;
1592 WORD DoShuffle(
PHEAD WORD *term, WORD level, WORD fun, WORD option)
1596 WORD *t1, *t2, *tstop, ncoef, n = fun, *to, *from;
1602 if ( ( n = DolToFunction(BHEAD -n) ) == 0 ) {
1603 MLOCK(ErrorMessageLock);
1604 MesPrint(
"$-variable in merge statement did not evaluate to a function.");
1605 MUNLOCK(ErrorMessageLock);
1609 if ( AT.WorkPointer + 3*(*term) + AM.MaxTal > AT.WorkTop ) {
1610 MLOCK(ErrorMessageLock);
1612 MUNLOCK(ErrorMessageLock);
1616 tstop = term + *term;
1618 tstop -= ABS(ncoef);
1620 while ( t1 < tstop ) {
1621 if ( ( *t1 == n ) && ( t1+t1[1] < tstop ) && ( t1[1] > FUNHEAD ) ) {
1623 if ( t2 >= tstop ) {
1626 while ( t2 < tstop ) {
1627 if ( ( *t2 == n ) && ( t2[1] > FUNHEAD ) )
break;
1630 if ( t2 < tstop )
break;
1634 if ( t1 >= tstop ) {
1644 SH->finishuf = &FinishShuffle;
1645 SH->do_uffle = &DoShuffle;
1646 SH->outterm = AT.WorkPointer;
1647 AT.WorkPointer += *term;
1648 SH->stop1 = t1 + t1[1];
1649 SH->stop2 = t2 + t2[1];
1650 SH->thefunction = n;
1651 SH->option = option;
1654 SH->nincoef = ncoef;
1656 if ( AN.SHcombi == 0 || AN.SHcombisize == 0 ) {
1657 AN.SHcombisize = 200;
1658 AN.SHcombi = (UWORD *)Malloc1(AN.SHcombisize*
sizeof(UWORD),
"AN.SHcombi");
1660 SHback.combilast = 0;
1663 SH->combilast += AN.SHcombi[SH->combilast]+1;
1664 if ( SH->combilast >= AN.SHcombisize - 100 ) {
1665 newcombi = (UWORD *)Malloc1(2*AN.SHcombisize*
sizeof(UWORD),
"AN.SHcombi");
1666 for ( k = 0; k < AN.SHcombisize; k++ ) newcombi[k] = AN.SHcombi[k];
1667 M_free(AN.SHcombi,
"AN.SHcombi");
1668 AN.SHcombi = newcombi;
1669 AN.SHcombisize *= 2;
1672 AN.SHcombi[SH->combilast] = 1;
1673 AN.SHcombi[SH->combilast+1] = 1;
1675 i = t1-term; to = SH->outterm; from = term;
1678 for ( i = 0; i < FUNHEAD; i++ ) { *to++ = t1[i]; }
1680 error = Shuffle(BHEAD t1+FUNHEAD,t2+FUNHEAD,to);
1682 AT.WorkPointer = SH->outterm;
1685 MesCall(
"DoShuffle");
1726 int Shuffle(
PHEAD WORD *from1, WORD *from2, WORD *to)
1728 WORD *t, *fr, *next1, *next2, na, *fn1, *fn2, *tt;
1729 int i, n, n1, n2, j;
1732 if ( from1 == SH->stop1 && from2 == SH->stop2 ) {
1733 return(FiniShuffle(BHEAD to));
1735 else if ( from1 == SH->stop1 ) {
1736 i = SH->stop2 - from2; t = to; tt = from2; NCOPY(t,tt,i)
1737 return(FiniShuffle(BHEAD t));
1739 else if ( from2 == SH->stop2 ) {
1740 i = SH->stop1 - from1; t = to; tt = from1; NCOPY(t,tt,i)
1741 return(FiniShuffle(BHEAD t));
1746 if ( AreArgsEqual(from1,from2) ) {
1750 next1 = from1; n1 = 1; NEXTARG(next1)
1751 while ( ( next1 < SH->stop1 ) && AreArgsEqual(from1,next1) ) {
1752 n1++; NEXTARG(next1)
1754 next2 = from2; n2 = 1; NEXTARG(next2)
1755 while ( ( next2 < SH->stop2 ) && AreArgsEqual(from2,next2) ) {
1756 n2++; NEXTARG(next2)
1758 combilast = SH->combilast;
1764 while ( --n >= 0 ) { fr = from1; CopyArg(t,fr) }
1765 if ( GetBinom((UWORD *)(t),&na,n1+n2,n1) )
goto shuffcall;
1766 if ( combilast + AN.SHcombi[combilast] + na + 2 >= AN.SHcombisize ) {
1774 UWORD *combi = (UWORD *)Malloc1(2*AN.SHcombisize*2,
"AN.SHcombi");
1776 for ( jj = 0; jj < AN.SHcombisize; jj++ ) combi[jj] = AN.SHcombi[jj];
1777 AN.SHcombisize *= 2;
1778 M_free(AN.SHcombi,
"AN.SHcombi");
1781 if ( MulLong((UWORD *)(AN.SHcombi+combilast+1),AN.SHcombi[combilast],
1783 (UWORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+2),
1784 (WORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+1)) )
goto shuffcall;
1785 SH->combilast = combilast + AN.SHcombi[combilast] + 1;
1786 if ( next1 >= SH->stop1 ) {
1787 fr = next2; i = SH->stop2 - fr;
1789 if ( FiniShuffle(BHEAD t) ) goto shuffcall;
1791 else if ( next2 >= SH->stop2 ) {
1792 fr = next1; i = SH->stop1 - fr;
1794 if ( FiniShuffle(BHEAD t) ) goto shuffcall;
1797 if ( Shuffle(BHEAD next1,next2,t) )
goto shuffcall;
1799 SH->combilast = combilast;
1804 if ( next2 < SH->stop2 ) {
1807 while ( --n >= 0 ) { fr = from1; CopyArg(t,fr) }
1808 for ( j = 0; j < n1; j++ ) {
1809 if ( GetBinom((UWORD *)(t),&na,n2+j,j) )
goto shuffcall;
1810 if ( MulLong((UWORD *)(AN.SHcombi+combilast+1),AN.SHcombi[combilast],
1812 (UWORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+2),
1813 (WORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+1)) )
goto shuffcall;
1814 SH->combilast = combilast + AN.SHcombi[combilast] + 1;
1815 if ( j > 0 ) { fr = from1; CopyArg(t,fr) }
1816 fn2 = next2; tt = t;
1819 if ( fn2 >= SH->stop2 ) {
1821 while ( --n >= 0 ) { fr = from1; CopyArg(tt,fr) }
1822 fr = next1; i = SH->stop1 - fr;
1824 if ( FiniShuffle(BHEAD tt) ) goto shuffcall;
1827 n = j; fn1 = from1;
while ( --n >= 0 ) { NEXTARG(fn1) }
1828 if ( Shuffle(BHEAD fn1,fn2,tt) )
goto shuffcall;
1830 SH->combilast = combilast;
1837 if ( next1 < SH->stop1 ) {
1840 while ( --n >= 0 ) { fr = from1; CopyArg(t,fr) }
1841 for ( j = 0; j < n2; j++ ) {
1842 if ( GetBinom((UWORD *)(t),&na,n1+j,j) )
goto shuffcall;
1843 if ( MulLong((UWORD *)(AN.SHcombi+combilast+1),AN.SHcombi[combilast],
1845 (UWORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+2),
1846 (WORD *)(AN.SHcombi+combilast+AN.SHcombi[combilast]+1)) )
goto shuffcall;
1847 SH->combilast = combilast + AN.SHcombi[combilast] + 1;
1848 if ( j > 0 ) { fr = from1; CopyArg(t,fr) }
1849 fn1 = next1; tt = t;
1852 if ( fn1 >= SH->stop1 ) {
1854 while ( --n >= 0 ) { fr = from1; CopyArg(tt,fr) }
1855 fr = next2; i = SH->stop2 - fr;
1857 if ( FiniShuffle(BHEAD tt) ) goto shuffcall;
1860 n = j; fn2 = from2;
while ( --n >= 0 ) { NEXTARG(fn2) }
1861 if ( Shuffle(BHEAD fn1,fn2,tt) )
goto shuffcall;
1863 SH->combilast = combilast;
1874 if ( fr >= SH->stop1 ) {
1875 fr = from2; i = SH->stop2 - fr;
1877 if ( FiniShuffle(BHEAD t) ) goto shuffcall;
1880 if ( Shuffle(BHEAD fr,from2,t) )
goto shuffcall;
1888 if ( fr >= SH->stop2 ) {
1889 fr = from1; i = SH->stop1 - fr;
1891 if ( FiniShuffle(BHEAD t) ) goto shuffcall;
1894 if ( Shuffle(BHEAD from1,fr,t) )
goto shuffcall;
1917 int FinishShuffle(
PHEAD WORD *fini)
1919 WORD *t, *t1, *oldworkpointer = AT.WorkPointer, *tcoef, ntcoef, *out;
1922 SH->outfun[1] = fini - SH->outfun;
1923 if ( functions[SH->outfun[0]-FUNCTION].symmetric != 0 )
1924 SH->outfun[2] |= DIRTYSYMFLAG;
1925 out = fini; i = fini - SH->outterm; t = SH->outterm;
1929 while ( t1 < SH->stop2 ) { t = t1; t1 = t + t[1]; }
1931 while ( t1 < t ) *fini++ = *t1++;
1933 while ( t < SH->incoef ) *fini++ = *t++;
1935 ntcoef = SH->nincoef;
1938 ntcoef = REDLENG(ntcoef);
1939 Mully(BHEAD (UWORD *)tcoef,&ntcoef,
1940 (UWORD *)(AN.SHcombi+SH->combilast+1),AN.SHcombi[SH->combilast]);
1941 ntcoef = INCLENG(ntcoef);
1942 fini = tcoef + ABS(ntcoef);
1943 if ( ( ( SH->option & 2 ) != 0 ) && ( ( SH->option & 256 ) != 0 ) ) ntcoef = -ntcoef;
1945 i = *out = fini - out;
1949 AT.WorkPointer = out + *out;
1950 if ( ( SH->option & 1 ) == 1 ) {
1951 if (
Generator(BHEAD out,SH->level) )
goto Finicall;
1954 if ( DoShtuffle(BHEAD out,SH->level,SH->thefunction,SH->option) )
goto Finicall;
1956 AT.WorkPointer = oldworkpointer;
1959 AT.WorkPointer = oldworkpointer;
1960 MesCall(
"FinishShuffle");
1982 WORD DoStuffle(
PHEAD WORD *term, WORD level, WORD fun, WORD option)
1986 WORD *t1, *t2, *tstop, *t1stop, *t2stop, ncoef, n = fun, *to, *from;
1992 WORD *rr1, *rr2, i1, i2;
1995 if ( ( n = DolToFunction(BHEAD -n) ) == 0 ) {
1996 MLOCK(ErrorMessageLock);
1997 MesPrint(
"$-variable in merge statement did not evaluate to a function.");
1998 MUNLOCK(ErrorMessageLock);
2002 if ( AT.WorkPointer + 3*(*term) + AM.MaxTal > AT.WorkTop ) {
2003 MLOCK(ErrorMessageLock);
2005 MUNLOCK(ErrorMessageLock);
2009 tstop = term + *term;
2011 tstop -= ABS(ncoef);
2014 while ( t1 < tstop ) {
2015 if ( ( *t1 == n ) && ( t1+t1[1] < tstop ) && ( t1[1] > FUNHEAD ) ) {
2017 if ( t2 >= tstop ) {
2021 while ( t2 < tstop ) {
2022 if ( ( *t2 == n ) && ( t2[1] > FUNHEAD ) )
break;
2025 if ( t2 < tstop )
break;
2029 if ( t1 >= tstop ) {
2037 t1stop = t1 + t1[1];
2039 while ( r1 < t1stop ) {
2040 if ( *r1 != -SNUMBER )
break;
2041 if ( r1[1] == 0 )
break;
2044 if ( r1 < t1stop ) { t1 = t2;
goto retry1; }
2045 t2stop = t2 + t2[1];
2047 while ( r2 < t2stop ) {
2048 if ( *r2 != -SNUMBER )
break;
2049 if ( r2[1] == 0 )
break;
2052 if ( r2 < t2stop ) { t2 = t2 + t2[1];
goto retry2; }
2054 t1stop = t1 + t1[1];
2056 while ( r1 < t1stop ) {
2057 if ( *r1 == -SNUMBER ) {
2058 if ( r1[1] == 0 )
break;
2061 else if ( *r1 == -SYMBOL ) {
2062 if ( ( symbols[r1[1]].complex & VARTYPEROOTOFUNITY ) != VARTYPEROOTOFUNITY )
2066 if ( *r1 > 0 && *r1 == r1[ARGHEAD]+ARGHEAD ) {
2067 if ( ABS(r1[r1[0]-1]) == r1[0]-ARGHEAD-1 ) {}
2068 else if ( r1[ARGHEAD+1] == SYMBOL ) {
2069 rr1 = r1 + ARGHEAD + 3;
2072 if ( ( symbols[*rr1].complex & VARTYPEROOTOFUNITY ) != VARTYPEROOTOFUNITY )
2076 if ( i1 > 0 )
break;
2080 i1 = (ABS(*rr1)-1)/2;
2082 if ( rr1[-1] )
break;
2085 if ( i1 > 1 || rr1[-1] != 1 )
break;
2090 if ( r1 < t1stop ) { t1 = t2;
goto retry1; }
2091 t2stop = t2 + t2[1];
2094 while ( r2 < t2stop ) {
2095 if ( *r2 == -SNUMBER ) {
2096 if ( r2[1] == 0 )
break;
2099 else if ( *r2 == -SYMBOL ) {
2100 if ( ( symbols[r2[1]].complex & VARTYPEROOTOFUNITY ) != VARTYPEROOTOFUNITY )
2104 if ( *r2 > 0 && *r2 == r2[ARGHEAD]+ARGHEAD ) {
2105 if ( ABS(r2[r2[0]-1]) == r2[0]-ARGHEAD-1 ) {}
2106 else if ( r2[ARGHEAD+1] == SYMBOL ) {
2107 rr2 = r2 + ARGHEAD + 3;
2110 if ( ( symbols[*rr2].complex & VARTYPEROOTOFUNITY ) != VARTYPEROOTOFUNITY )
2114 if ( i2 > 0 )
break;
2118 i2 = (ABS(*rr2)-1)/2;
2120 if ( rr2[-1] )
break;
2123 if ( i2 > 1 || rr2[-1] != 1 )
break;
2128 if ( r2 < t2stop ) { t2 = t2 + t2[1];
goto retry2; }
2136 SH->finishuf = &FinishStuffle;
2137 SH->do_uffle = &DoStuffle;
2138 SH->outterm = AT.WorkPointer;
2139 AT.WorkPointer += *term;
2140 SH->ststop1 = t1 + t1[1];
2141 SH->ststop2 = t2 + t2[1];
2142 SH->thefunction = n;
2143 SH->option = option;
2146 SH->nincoef = ncoef;
2147 if ( AN.SHcombi == 0 || AN.SHcombisize == 0 ) {
2148 AN.SHcombisize = 200;
2149 AN.SHcombi = (UWORD *)Malloc1(AN.SHcombisize*
sizeof(UWORD),
"AN.SHcombi");
2151 SHback.combilast = 0;
2154 SH->combilast += AN.SHcombi[SH->combilast]+1;
2155 if ( SH->combilast >= AN.SHcombisize - 100 ) {
2156 newcombi = (UWORD *)Malloc1(2*AN.SHcombisize*
sizeof(UWORD),
"AN.SHcombi");
2157 for ( k = 0; k < AN.SHcombisize; k++ ) newcombi[k] = AN.SHcombi[k];
2158 M_free(AN.SHcombi,
"AN.SHcombi");
2159 AN.SHcombi = newcombi;
2160 AN.SHcombisize *= 2;
2163 AN.SHcombi[SH->combilast] = 1;
2164 AN.SHcombi[SH->combilast+1] = 1;
2166 i = t1-term; to = SH->outterm; from = term;
2169 for ( i = 0; i < FUNHEAD; i++ ) { *to++ = t1[i]; }
2171 error = Stuffle(BHEAD t1+FUNHEAD,t2+FUNHEAD,to);
2173 AT.WorkPointer = SH->outterm;
2176 MesCall(
"DoStuffle");
2197 int Stuffle(
PHEAD WORD *from1, WORD *from2, WORD *to)
2200 WORD *t, *tf, *next1, *next2, *st1, *st2, *save1, *save2;
2206 save1 = SH->stop1; save2 = SH->stop2;
2207 if ( from1 >= SH->ststop1 && from2 == SH->ststop2 ) {
2208 SH->stop1 = SH->ststop1;
2209 SH->stop2 = SH->ststop2;
2210 retval = FinishShuffle(BHEAD to);
2211 SH->stop1 = save1; SH->stop2 = save2;
2214 else if ( from1 >= SH->ststop1 ) {
2215 i = SH->ststop2 - from2; t = to; tf = from2; NCOPY(t,tf,i)
2216 SH->stop1 = SH->ststop1;
2217 SH->stop2 = SH->ststop2;
2218 retval = FinishShuffle(BHEAD t);
2219 SH->stop1 = save1; SH->stop2 = save2;
2222 else if ( from2 >= SH->ststop2 ) {
2223 i = SH->ststop1 - from1; t = to; tf = from1; NCOPY(t,tf,i)
2224 SH->stop1 = SH->ststop1;
2225 SH->stop2 = SH->ststop2;
2226 retval = FinishShuffle(BHEAD t);
2227 SH->stop1 = save1; SH->stop2 = save2;
2233 SH->stop1 = SH->ststop1;
2234 SH->stop2 = SH->ststop2;
2235 SH->finishuf = &FinishShuffle;
2236 if ( Shuffle(BHEAD from1,from2,to) ) goto stuffcall;
2237 SH->finishuf = &FinishStuffle;
2242 st1 = from1; next1 = st1+2;
2244 st1 = next1 = from1;
2247 while ( next1 <= SH->ststop1 ) {
2249 st2 = from2; next2 = st2+2;
2251 next2 = st2 = from2;
2254 while ( next2 <= SH->ststop2 ) {
2257 if ( st1 == from1 && st2 == from2 ) {
2260 *t++ = -SNUMBER; *t++ = StuffAdd(st1[1],st2[1]);
2262 t = StuffRootAdd(st1,st2,t);
2265 if ( Stuffle(BHEAD next1,next2,t) )
goto stuffcall;
2268 else if ( st1 == from1 ) {
2270 t = to; tf = from2; NCOPY(t,tf,i)
2272 *t++ = -SNUMBER; *t++ = StuffAdd(st1[1],st2[1]);
2274 t = StuffRootAdd(st1,st2,t);
2277 if ( Stuffle(BHEAD next1,next2,t) )
goto stuffcall;
2280 else if ( st2 == from2 ) {
2282 t = to; tf = from1; NCOPY(t,tf,i)
2284 *t++ = -SNUMBER; *t++ = StuffAdd(st1[1],st2[1]);
2286 t = StuffRootAdd(st1,st2,t);
2289 if ( Stuffle(BHEAD next1,next2,t) )
goto stuffcall;
2293 if ( Shuffle(BHEAD from1,from2,to) )
goto stuffcall;
2296 st2 = next2; next2 += 2;
2303 st1 = next1; next1 += 2;
2309 SH->stop1 = save1; SH->stop2 = save2;
2324 int FinishStuffle(
PHEAD WORD *fini)
2329 WORD *next1 = SH->stop1, *next2 = SH->stop2;
2330 fini = StuffRootAdd(next1,next2,fini);
2332 *fini++ = -SNUMBER; *fini++ = StuffAdd(SH->stop1[1],SH->stop2[1]);
2338 if ( Stuffle(BHEAD next1,next2,fini) ) goto stuffcall;
2340 if ( Stuffle(BHEAD SH->stop1+2,SH->stop2+2,fini) )
goto stuffcall;
2345 MesCall(
"FinishStuffle");
2371 WORD *StuffRootAdd(WORD *t1, WORD *t2, WORD *to)
2373 int type1, type2, type3, sgn, sgn1, sgn2, sgn3, pow, root, nosymbols, i;
2374 WORD *tt1, *tt2, it1, it2, *t3, *r, size1, size2, size3;
2377 if ( *t1 == -SNUMBER ) { type1 = 1;
if ( t1[1] < 0 ) sgn1 = -1;
else sgn1 = 1; }
2378 else if ( *t1 == -SYMBOL ) { type1 = 2; sgn1 = 1; }
2379 else if ( ABS(t1[*t1-1]) == *t1-ARGHEAD-1 ) {
2380 type1 = 3;
if ( t1[*t1-1] < 0 ) sgn1 = -1;
else sgn1 = 1; }
2381 else { type1 = 4;
if ( t1[*t1-1] < 0 ) sgn1 = -1;
else sgn1 = 1; }
2382 if ( *t2 == -SNUMBER ) { type2 = 1;
if ( t2[1] < 0 ) sgn2 = -1;
else sgn2 = 1; }
2383 else if ( *t2 == -SYMBOL ) { type2 = 2; sgn2 = 1; }
2384 else if ( ABS(t2[*t2-1]) == *t2-ARGHEAD-1 ) {
2385 type2 = 3;
if ( t2[*t2-1] < 0 ) sgn2 = -1;
else sgn2 = 1; }
2386 else { type2 = 4;
if ( t2[*t2-1] < 0 ) sgn2 = -1;
else sgn2 = 1; }
2387 if ( type1 > type2 ) {
2388 t3 = t1; t1 = t2; t2 = t3;
2389 type3 = type1; type1 = type2; type2 = type3;
2390 sgn3 = sgn1; sgn1 = sgn2; sgn2 = sgn3;
2392 nosymbols = 1; sgn3 = 1;
2398 if ( x > MAXPOSITIVE || x < -(MAXPOSITIVE+1) ) {
2399 if ( x < 0 ) { sgn1 = -3; x = -x; }
2404 *to++ = 4; *to++ = (UWORD)x; *to++ = 1; *to++ = sgn1;
2406 else { *to++ = -SNUMBER; *to++ = (WORD)x; }
2408 else if ( type2 == 2 ) {
2409 *to++ = ARGHEAD+8; *to++ = 0; FILLARG(to)
2410 *to++ = 8; *to++ = SYMBOL; *to++ = 4; *to++ = t2[1]; *to++ = 1;
2411 *to++ = ABS(t1[1])+1;
2415 else if ( type2 == 3 ) {
2416 tt1 = (WORD *)scratch; tt1[0] = ABS(t1[1]); size1 = 1;
2417 tt2 = t2+ARGHEAD+1; size2 = (ABS(t2[*t2-1])-1)/2;
2419 *to++ = 0; *to++ = 0; FILLARG(to) *to++ = 0;
2426 tt1 = (WORD *)scratch; tt1[0] = ABS(t1[1]); size1 = 1;
2427 tt2 = t2+ARGHEAD+1; tt2 += tt2[1]; size2 = (ABS(t2[*t2-1])-1)/2;
2428 t3 = to; i = tt2 - t2; r = t2;
2436 if ( t1[1] == t2[1] ) {
2437 if ( ( symbols[t1[1]].maxpower == 4 )
2438 && ( ( symbols[t1[1]].complex & VARTYPEMINUS ) == VARTYPEMINUS ) ) {
2439 *to++ = -SNUMBER; *to++ = -2;
2441 else if ( symbols[t1[1]].maxpower == 2 ) {
2442 *to++ = -SNUMBER; *to++ = 2;
2445 *to++ = ARGHEAD+8; *to++ = 0; FILLARG(to)
2446 *to++ = 8; *to++ = SYMBOL; *to++ = 4;
2447 *to++ = t1[1]; *to++ = 2;
2448 *to++ = 2; *to++ = 1; *to++ = 3;
2452 *to++ = ARGHEAD+10; *to++ = 0; FILLARG(to)
2453 *to++ = 10; *to++ = SYMBOL; *to++ = 6;
2454 if ( t1[1] < t2[1] ) {
2455 *to++ = t1[1]; *to++ = 1; *to++ = t2[1]; *to++ = 1;
2458 *to++ = t2[1]; *to++ = 1; *to++ = t1[1]; *to++ = 1;
2460 *to++ = 2; *to++ = 1; *to++ = 3;
2463 else if ( type2 == 3 ) {
2465 *to++ = 0; *to++ = 0; FILLARG(to) *to++ = 0;
2466 *to++ = SYMBOL; *to++ = 4; *to++ = t1[1]; *to++ = 1;
2467 tt1 = scratch; tt1[1] = 1; size1 = 1;
2468 tt2 = t2+ARGHEAD+1; size2 = (ABS(t2[*t2-1])-1)/2;
2473 tt1 = scratch; tt1[0] = 1; size1 = 1;
2475 *to++ = 0; *to++ = 0; FILLARG(to) *to++ = 0;
2476 *to++ = SYMBOL; *to++ = 0;
2477 tt2 = t2 + ARGHEAD+3; it2 = tt2[-1]-2;
2479 if ( *tt2 == t1[1] ) {
2481 root = symbols[*tt2].maxpower;
2482 if ( pow >= root ) pow -= root;
2483 if ( ( symbols[*tt2].complex & VARTYPEMINUS ) == VARTYPEMINUS ) {
2484 if ( ( root & 1 ) == 0 && pow >= root/2 ) {
2485 pow -= root/2; sgn3 = -sgn3;
2489 *to++ = *tt2; *to++ = pow;
2494 else if ( t1[1] < *tt2 ) {
2495 *to++ = t1[1]; *to++ = 1;
break;
2498 *to++ = *tt2++; *to++ = *tt2++; it2 -= 2;
2499 if ( it2 <= 0 ) { *to++ = t1[1]; *to++ = 1; }
2502 while ( it2 > 0 ) { *to++ = *tt2++; *to++ = *tt2++; it2 -= 2; }
2503 if ( (to - t3) > ARGHEAD+3 ) {
2504 t3[ARGHEAD+2] = (to-t3)-ARGHEAD-1;
2510 size2 = (ABS(t2[*t2-1])-1)/2;
2519 tt1 = t1+ARGHEAD+1; size1 = (ABS(t1[*t1-1])-1)/2;
2520 tt2 = t2+ARGHEAD+1; size2 = (ABS(t2[*t2-1])-1)/2;
2522 *to++ = 0; *to++ = 0; FILLARG(to) *to++ = 0;
2529 tt1 = t1+ARGHEAD+1; size1 = (ABS(t1[*t1-1])-1)/2;
2530 tt2 = t2+ARGHEAD+1; tt2 += tt2[1]; size2 = (ABS(t2[*t2-1])-1)/2;
2531 t3 = to; i = tt2 - t2; r = t2;
2542 tt1 = t1+ARGHEAD+3; it1 = tt1[-1]-2;
2543 tt2 = t2+ARGHEAD+3; it2 = tt2[-1]-2;
2545 *to++ = 0; *to++ = 0; FILLARG(to)
2546 *to++ = 0; *to++ = SYMBOL; *to++ = 0;
2547 while ( it1 > 0 && it2 > 0 ) {
2548 if ( *tt1 == *tt2 ) {
2549 pow = tt1[1]+tt2[1];
2550 root = symbols[*tt1].maxpower;
2551 if ( pow >= root ) pow -= root;
2552 if ( ( symbols[*tt1].complex & VARTYPEMINUS ) == VARTYPEMINUS ) {
2553 if ( ( root & 1 ) == 0 && pow >= root/2 ) {
2554 pow -= root/2; sgn3 = -sgn3;
2558 *to++ = *tt1; *to++ = pow;
2560 tt1 += 2; tt2 += 2; it1 -= 2; it2 -= 2;
2562 else if ( *tt1 < *tt2 ) {
2563 *to++ = *tt1++; *to++ = *tt1++; it1 -= 2;
2566 *to++ = *tt2++; *to++ = *tt2++; it2 -= 2;
2569 while ( it1 > 0 ) { *to++ = *tt1++; *to++ = *tt1++; it1 -= 2; }
2570 while ( it2 > 0 ) { *to++ = *tt2++; *to++ = *tt2++; it2 -= 2; }
2571 if ( (to - t3) > ARGHEAD+3 ) {
2572 t3[ARGHEAD+2] = (to-t3)-ARGHEAD-1;
2578 size1 = (ABS(t1[*t1-1])-1)/2;
2579 size2 = (ABS(t2[*t2-1])-1)/2;
2586 if ( AddLong((UWORD *)tt1,size1,(UWORD *)tt2,size2,(UWORD *)to,&size3) ) {
2587 MLOCK(ErrorMessageLock);
2588 MesPrint(
"Called from StuffRootAdd");
2589 MUNLOCK(ErrorMessageLock);
2592 sgn = sgn1*sgn2*sgn3;
2593 if ( nosymbols && size3 == 1 ) {
2594 if ( (UWORD)(to[0]) <= MAXPOSITIVE && sgn > 0 ) {
2596 to = t3; *to++ = -SNUMBER; *to++ = sgn1;
2598 else if ( (UWORD)(to[0]) <= (MAXPOSITIVE+1) && sgn < 0 ) {
2600 to = t3; *to++ = -SNUMBER; *to++ = -sgn1;
2602 else goto genericcoef;
2607 sgn = sgn*(2*size3+1);
2609 while ( size3 > 1 ) { *to++ = 0; size3--; }
2612 t3[ARGHEAD] = t3[0] - ARGHEAD;
WORD Generator(PHEAD WORD *, WORD)
WORD CompCoef(WORD *, WORD *)