65 WORD WildFill(PHEAD WORD *to, WORD *from, WORD *sub)
68 WORD i, j, *s, *t, *m, len, dflag, odirt, adirt;
69 WORD *r, *u, *v, *w, *z, *zst, *zz, *subs, *accu, na, dirty = 0, *tstop;
70 WORD *temp = 0, *uu, *oldcpointer, sgn;
71 WORD subcount, setflag, *setlist = 0, si;
72 accu = oldcpointer = AR.CompressPointer;
77 while ( s < t && *s != FROMBRAC ) {
83 if ( dirty ) AN.WildDirt = dirty;
87 subs = sub + SUBEXPSIZE;
107 for ( si = 0; si < setflag; si += 2 ) {
108 if ( t == temp + setlist[si] )
goto sspow;
111 for ( j = 0; j < i; j++ ) {
113 if ( *s == SYMTOSYM ) {
114 *m = s[3]; dirty = 1;
117 else if ( *s == SYMTONUM ) {
125 if ( ABS(*t) >= 2*MAXPOWER) {
127 for ( j = 0; j < i; j++ ) {
128 if ( ( *s == SYMTONUM ) &&
129 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
132 if ( *t < 0 ) *w = -*w;
135 if ( ( *s == SYMTOSYM ) &&
136 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
139 while ( --zz >= zst ) {
140 zz[1+FUNHEAD+ARGHEAD] = *zz;
142 w += 1+FUNHEAD+ARGHEAD;
145 zst[FUNHEAD+ARGHEAD] = WORDDIF(z,zst)+4;
147 zst[FUNHEAD] = WORDDIF(z,zst)+4+ARGHEAD;
148 z += FUNHEAD+ARGHEAD+1;
169 zst[1] = WORDDIF(z,zst);
172 if ( *s == SYMTOSUB &&
173 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
176 while ( --zz >= zst ) {
177 zz[1+FUNHEAD+ARGHEAD] = *zz;
179 w += 1+FUNHEAD+ARGHEAD;
182 zst[FUNHEAD+ARGHEAD] = WORDDIF(z,zst)+4;
184 zst[FUNHEAD] = WORDDIF(z,zst)+4+ARGHEAD;
185 z += FUNHEAD+ARGHEAD+1;
190 *z++ = 4+SUBEXPSIZE+ARGHEAD;
193 *z++ = SUBEXPRESSION;
201 *z++ = *t > 0 ? 3: -3;
202 zst[1] = WORDDIF(z,zst);
208 if ( !*w ) z = w - 3;
212 else if ( *s == SYMTOSUB ) {
215 *z++ = SUBEXPRESSION;
230 for ( si = 0; si < setflag; si += 2 ) {
231 if ( t == temp + setlist[si] ) {
236 for ( j = 0; j < i; j++ ) {
237 if ( ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
238 if ( *s == SYMTONUM ) {
241 if ( *t < 0 ) *m = -*m;
244 else if ( *s == SYMTOSYM ) {
247 if ( *t < 0 ) *z++ = FUNHEAD+ARGHEAD+10;
248 else *z++ = 4+FUNHEAD;
272 else if ( *s == SYMTOSUB ) {
293 while ( s < z ) *m++ = *s++;
309 for ( si = 0; si < setflag; si += 2 ) {
310 if ( t == temp + setlist[si] )
goto ss2;
313 for ( j = 0; j < i; j++ ) {
315 if ( *s == VECTOVEC ) {
316 *m = s[3]; dirty = 1;
break;
318 if ( *s == VECTOMIN ) {
319 *m = s[3]; dirty = 1; sgn += t[2];
break;
321 if ( *s == VECTOSUB ) {
322 *m = s[3]; dirty = 1; subcount = 1;
break;
330 for ( si = 0; si < setflag; si += 2 ) {
331 if ( t == temp + setlist[si] )
goto ss3;
333 for ( j = 0; j < i; j++ ) {
335 if ( *s == VECTOVEC ) {
336 *m = s[3]; dirty = 1;
break;
338 if ( *s == VECTOMIN ) {
339 *m = s[3]; dirty = 1; sgn += t[1];
break;
341 if ( *s == VECTOSUB ) {
342 *m = s[3]; dirty = 1; subcount += 2;
break;
348 if ( ( ABS(*t) - 2*MAXPOWER ) < 0 )
goto RegPow;
350 for ( j = 0; j < i; j++ ) {
351 if ( ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
352 if ( *s == SYMTONUM ) {
354 if ( *t < 0 ) *m = -*m;
358 if ( *s <= SYMTOSUB ) {
366 if ( subcount == 0 ) {
367 *z++ = 17+FUNHEAD+2*ARGHEAD;
382 if ( *s == SYMTOSYM ) {
393 *z++ = 4+SUBEXPSIZE+ARGHEAD;
397 *z++ = SUBEXPRESSION;
405 *z++ = ( s[2] > 0 ) ? 3: -3;
407 else if ( subcount == 3 ) {
408 *z++ = 20+2*SUBEXPSIZE+FUNHEAD+2*ARGHEAD;
411 *z++ = 12+2*SUBEXPSIZE+ARGHEAD;
413 *z++ = 12+2*SUBEXPSIZE;
414 *z++ = SUBEXPRESSION;
425 *z++ = SUBEXPRESSION;
435 *z++ = 1; *z++ = 1; *z++ = 3;
438 if ( subcount == 2 ) {
439 j = *m; *m = m[1]; m[1] = j;
441 *z++ = 16+SUBEXPSIZE+FUNHEAD+2*ARGHEAD;
444 *z++ = 8+SUBEXPSIZE+ARGHEAD;
447 *z++ = SUBEXPRESSION;
457 *z++ = 1; *z++ = 1; *z++ = 3;
459 if ( *s == SYMTOSYM ) {
476 *z++ = 4+SUBEXPSIZE+ARGHEAD;
479 *z++ = SUBEXPRESSION;
487 *z++ = ( s[2] > 0 ) ? 3: -3;
495 RegPow:
if ( *m ) m++;
496 else { m -= 2; subcount = 0; }
500 if ( subcount == 3 ) {
502 j = (-m[2]) * (2*SUBEXPSIZE+8);
504 *z++ = j + 8 + FUNHEAD + ARGHEAD;
507 *z++ = j + 8 + ARGHEAD;
512 *z++ = SUBEXPRESSION;
522 *z++ = SUBEXPRESSION;
537 *z++ = 1; *z++ = 1; *z++ = 3;
542 *z++ = SUBEXPRESSION;
552 *z++ = SUBEXPRESSION;
566 if ( subcount == 2 ) {
567 j = *m; *m = m[1]; m[1] = j;
571 *z++ = 8+SUBEXPSIZE+FUNHEAD+ARGHEAD;
574 *z++ = 8+SUBEXPSIZE+ARGHEAD;
578 *z++ = SUBEXPRESSION;
589 *z++ = 1; *z++ = 1; *z++ = 3;
595 if ( m <= v ) m = v - 2;
596 else v[-1] = WORDDIF(m,v) + 2;
610 temp = accu + (((AR.ComprTop - accu)>>1)&(-2));
611 if ( ResolveSet(BHEAD t,temp,sub) ) {
614 setlist = t + 2 + t[3];
615 setflag = t[1] - 2 - t[3];
616 t = temp; u = t + t[1];
631 for ( si = 0; si < setflag; si += 2 ) {
632 if ( t == temp + setlist[si] )
goto ss4;
635 for ( j = 0; j < i; j++ ) {
637 if ( *s == INDTOIND || *s == VECTOVEC ) {
638 *m = s[3]; dirty = 1;
break;
640 if ( *s == VECTOMIN ) {
641 *m = s[3]; dirty = 1; sgn++;
break;
643 else if ( *s == VECTOSUB ) {
644 *z++ = SUBEXPRESSION;
656 for ( j = 0; j < i; j++ ) {
657 if ( z[-1] == s[2] ) {
658 if ( *s == INDTOIND || *s == VECTOVEC ) {
662 if ( *s == INDTOSUB || *s == VECTOSUB ) {
664 *z++ = SUBEXPRESSION;
670 if ( *s == INDTOSUB ) *z++ = INDTOIND;
671 else *z++ = VECTOSUB;
683 else if ( *s == INDTOSUB ) {
684 *z++ = SUBEXPRESSION;
704 if ( m <= v ) m = v-2;
705 else v[-1] = WORDDIF(m,v)+2;
707 j = WORDDIF(z,accu); z = accu;
724 for ( si = 0; si < setflag; si += 2 ) {
725 if ( t == temp + setlist[si] )
goto ss5;
728 for ( j = 0; j < i; j++ ) {
730 if ( *s == INDTOIND || *s == VECTOVEC )
731 { *m = s[3]; dirty = 1;
break; }
732 if ( *s == VECTOMIN )
733 { *m = s[3]; dirty = 1; sgn++;
break; }
734 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
735 *z++ = SUBEXPRESSION;
750 if ( m <= v ) m = v-2;
751 else v[-1] = WORDDIF(m,v)+2;
753 j = WORDDIF(z,accu); z = accu;
770 if ( t[-2] != DELTA ) *m++ = *t++;
777 for ( si = 0; si < setflag; si += 2 ) {
778 if ( t == temp + setlist[si] )
goto ss6;
781 if ( *m == FUNNYWILD ) {
782 CBUF *C = cbuf+AT.ebufnum;
784 for ( j = 0; j < i; j++ ) {
785 if ( *s == ARGTOARG && *t == s[2] ) {
791 DEBUG(MesPrint(
"Thread %w(a): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
798 if ( *w == -INDEX || *w == -VECTOR
800 || ( *w == -SNUMBER && w[1] >= 0
801 && w[1] < AM.OffsetIndex ) ) {
802 if ( *w == -MINVECTOR ) sgn++;
807 MLOCK(ErrorMessageLock);
808 DEBUG(MesPrint(
"Thread %w(aa): *w = %d",*w);)
809 MesPrint(
"Illegal substitution of argument field in tensor");
810 MUNLOCK(ErrorMessageLock);
822 for ( j = 0; j < i; j++ ) {
824 if ( *s == INDTOIND || *s == VECTOVEC )
825 { *m = s[3]; dirty = 1;
break; }
826 if ( *s == VECTOMIN )
827 { *m = s[3]; dirty = 1; sgn++;
break; }
828 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
830 *z++ = SUBEXPRESSION;
846 if ( j < i && *v != DELTA ) v[2] |= DIRTYFLAG;
852 j = WORDDIF(z,accu); z = accu;
869 if ( t[-1] >= 2*MAXPOWER || t[-1] <= -2*MAXPOWER ) {
871 for ( j = 0; j < i; j++ ) {
872 if ( *s == SYMTONUM &&
873 ( ABS(t[-1]) - 2*MAXPOWER ) == s[2] ) {
875 if ( t[-1] < 0 ) m[-1] = -m[-1];
883 while ( t < tstop ) {
884 for ( si = 0; si < setflag; si += 2 ) {
885 if ( t == temp + setlist[si] - 2 )
goto ss7;
888 for ( j = 0; j < i; j++ ) {
889 if ( s[2] == t[2] ) {
890 if ( ( *s <= SYMTOSUB && *t <= SYMTOSUB )
891 || ( *s == *t && *s < FROMBRAC )
892 || ( *s == VECTOVEC && ( *t == VECTOSUB || *t == VECTOMIN ) )
893 || ( *s == VECTOSUB && ( *t == VECTOVEC || *t == VECTOMIN ) )
894 || ( *s == VECTOMIN && ( *t == VECTOSUB || *t == VECTOVEC ) )
895 || ( *s == INDTOIND && *t == INDTOSUB )
896 || ( *s == INDTOSUB && *t == INDTOIND ) ) {
928 for ( j = 0; j < i; j++ ) {
929 if ( ( ABS(t[-1]) - 2*MAXPOWER ) == s[2] ) {
930 if ( *s == SYMTONUM ) {
932 if ( t[-1] < 0 ) m[-1] = -m[-1];
935 else if ( *s <= SYMTOSUB ) {
936 MLOCK(ErrorMessageLock);
937 MesPrint(
"Wildcard power of expression should be a number");
938 MUNLOCK(ErrorMessageLock);
946 while ( t < tstop && *t != WILDCARDS ) {
950 if ( t < tstop && *t == WILDCARDS ) {
958 if ( t < tstop && *t == FROMBRAC ) {
962 if ( WildFill(BHEAD m,t+2,sub) < 0 ) {
963 MLOCK(ErrorMessageLock);
965 MUNLOCK(ErrorMessageLock);
972 while ( t < tstop ) {
985 if ( *t >= FUNCTION ) {
989 for ( si = 0; si < setflag; si += 2 ) {
990 if ( t == temp + setlist[si] ) {
991 dflag = DIRTYFLAG;
goto ss8;
995 for ( j = 0; j < i; j++ ) {
996 if ( *s == FUNTOFUN && *t == s[2] )
997 { *m = s[3]; dirty = 1; dflag = DIRTYFLAG;
break; }
1001 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec
1002 >= TENSORFUNCTION ) {
1003 if ( *m < FUNCTION || functions[*m-FUNCTION].spec
1004 < TENSORFUNCTION ) {
1005 MLOCK(ErrorMessageLock);
1006 MesPrint(
"Illegal wildcarding of regular function to tensorfunction");
1007 MUNLOCK(ErrorMessageLock);
1012 *m++ = *t++ | dflag;
1017 *m++ = *t++ | dflag;
1025 CBUF *C = cbuf+AT.ebufnum;
1026 for ( si = 0; si < setflag; si += 2 ) {
1027 if ( *t <= -FUNCTION ) {
1028 if ( t == temp + setlist[si] ) {
1029 v[2] |= DIRTYFLAG;
goto ss10; }
1032 if ( t == temp + setlist[si]-1 ) {
1033 v[2] |= DIRTYFLAG;
goto ss9; }
1036 if ( *t == -ARGWILD ) {
1038 for ( j = 0; j < i; j++ ) {
1039 if ( *s == ARGTOARG && s[2] == t[1] )
break;
1044 DEBUG(MesPrint(
"Thread %w(b): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
1048 if ( *w > 0 ) j = *w;
1049 else if ( *w <= -FUNCTION ) j = 1;
1056 while ( --j >= 0 ) {
1057 if ( *w < MINSPEC ) *m++ = -VECTOR;
1058 else if ( *w >= 0 && *w < AM.OffsetIndex )
1066 if ( ( *v == NUMARGSFUN || *v == NUMTERMSFUN )
1067 && t >= u && m == v + FUNHEAD ) {
1069 *m++ = SNUMBER; *m++ = 3; *m++ = 0;
1073 else if ( *t <= -FUNCTION ) {
1076 for ( j = 0; j < i; j++ ) {
1077 if ( -*t == s[2] ) {
1078 if ( *s == FUNTOFUN )
1079 { *m = -s[3]; dirty = 1; v[2] |= DIRTYFLAG;
break; }
1085 else if ( *t == -SYMBOL ) {
1089 for ( j = 0; j < i; j++ ) {
1090 if ( *t == s[2] && *s <= SYMTOSUB ) {
1091 dirty = 1; v[2] |= DIRTYFLAG;
1092 if ( AR.PolyFunType == 2 && v[0] == AR.PolyFun )
1093 v[2] |= MUSTCLEANPRF;
1094 if ( *s == SYMTOSYM ) *m = s[3];
1095 else if ( *s == SYMTONUM ) {
1099 else if ( *s == SYMTOSUB ) {
1102 DEBUG(MesPrint(
"Thread %w(c): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
1112 if ( t[-1] == -MINVECTOR ) {
1119 if ( ToFast(s,s) ) {
1120 if ( *s <= -FUNCTION ) m = s;
1131 else if ( *t == -INDEX ) {
1135 for ( j = 0; j < i; j++ ) {
1137 if ( *s == INDTOIND || *s == VECTOVEC ) {
1139 if ( *m < MINSPEC ) m[-1] = -VECTOR;
1140 else if ( *m >= 0 && *m < AM.OffsetIndex )
1142 else m[-1] = -INDEX;
1144 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
1147 *z++ = SUBEXPRESSION;
1148 *z++ = 4+SUBEXPSIZE;
1158 v[2] |= DIRTYFLAG; dirty = 1;
1165 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
1169 for ( j = 0; j < i; j++ ) {
1171 if ( *s == VECTOVEC ) *m = s[3];
1172 else if ( *s == VECTOMIN ) {
1174 if ( t[-1] == -VECTOR )
1179 else if ( *s == VECTOSUB )
goto ToSub;
1180 dirty = 1; v[2] |= DIRTYFLAG;
1187 else if ( *t == -SNUMBER ) {
1191 for ( j = 0; j < i; j++ ) {
1192 if ( *t == s[2] && *s >= NUMTONUM && *s <= NUMTOSUB ) {
1193 dirty = 1; v[2] |= DIRTYFLAG;
1194 if ( *s == NUMTONUM ) *m = s[3];
1195 else if ( *s == NUMTOSYM ) {
1199 else if ( *s == NUMTOIND ) {
1203 else if ( *s == NUMTOSUB )
goto ToSub;
1214 na = WORDDIF(z,accu);
1223 odirt = AN.WildDirt; AN.WildDirt = 0;
1224 AR.CompressPointer = accu + na;
1225 for ( j = 0; j < ARGHEAD; j++ ) *m++ = *t++;
1229 if ( ( len = WildFill(BHEAD m,t,sub) ) < 0 ) {
1230 MLOCK(ErrorMessageLock);
1231 MesCall(
"WildFill");
1232 MUNLOCK(ErrorMessageLock);
1235 if ( AN.WildDirt ) {
1236 adirt = AN.WildDirt;
1244 dirty = w[1] = 1; v[2] |= DIRTYFLAG;
1245 if ( AR.PolyFunType == 2 && v[0] == AR.PolyFun )
1246 v[2] |= MUSTCLEANPRF;
1247 AN.WildDirt = adirt;
1250 AN.WildDirt = odirt;
1252 if ( ToFast(w,w) ) {
1253 if ( *w <= -FUNCTION ) {
1254 if ( *w == NUMARGSFUN || *w == NUMTERMSFUN ) {
1255 *w = -SNUMBER; w[1] = 0; m = w + 2;
1261 AR.CompressPointer = oldcpointer;
1264 v[1] = WORDDIF(m,v);
1270 if ( v[0] == EXPONENT ) {
1271 if ( v[1] == FUNHEAD+4 && v[FUNHEAD] == -SYMBOL &&
1272 v[FUNHEAD+2] == -SNUMBER && v[FUNHEAD+3] < MAXPOWER
1273 && v[FUNHEAD+3] > -MAXPOWER ) {
1276 v[2] = v[FUNHEAD+1];
1277 v[3] = v[FUNHEAD+3];
1280 else if ( v[1] == FUNHEAD+ARGHEAD+11
1281 && v[FUNHEAD] == ARGHEAD+9
1282 && v[FUNHEAD+ARGHEAD] == 9
1283 && v[FUNHEAD+ARGHEAD+1] == DOTPRODUCT
1284 && v[FUNHEAD+ARGHEAD+8] == 3
1285 && v[FUNHEAD+ARGHEAD+7] == 1
1286 && v[FUNHEAD+ARGHEAD+6] == 1
1287 && v[FUNHEAD+ARGHEAD+5] == 1
1288 && v[FUNHEAD+ARGHEAD+9] == -SNUMBER
1289 && v[FUNHEAD+ARGHEAD+10] < MAXPOWER
1290 && v[FUNHEAD+ARGHEAD+10] > -MAXPOWER ) {
1293 v[2] = v[FUNHEAD+ARGHEAD+3];
1294 v[3] = v[FUNHEAD+ARGHEAD+4];
1295 v[4] = v[FUNHEAD+ARGHEAD+10];
1300 else {
while ( t < u ) *m++ = *t++; }
1309 if ( r < t )
do { *m++ = *r++; }
while ( r < t );
1310 if ( ( sgn & 1 ) != 0 ) m[-1] = -m[-1];
1311 *to = WORDDIF(m,to);
1312 if ( dirty ) AN.WildDirt = dirty;
1333 WORD ResolveSet(PHEAD WORD *from, WORD *to, WORD *subs)
1336 WORD *m, *s, *w, j, i, ii, i3, flag, num;
1339 int nummodopt, dtype = -1;
1344 while ( s < w ) *m++ = *s++;
1345 j = (from[1] - WORDDIF(w,from) ) >> 1;
1350 while ( s < m ) { i++; s += s[1]; }
1352 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1353 >= TENSORFUNCTION ) flag = 0;
1355 while ( --j >= 0 ) {
1358 for ( ii = 0; ii < i; ii++ ) {
1359 if ( *s == SYMTONUM && s[2] == w[1] ) { num = s[3];
goto GotOne; }
1362 MLOCK(ErrorMessageLock);
1363 MesPrint(
" Unresolved setelement during substitution");
1364 MUNLOCK(ErrorMessageLock);
1370 if ( AS.MultiThreaded ) {
1371 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1372 if ( -w[1] == ModOptdollars[nummodopt].number )
break;
1374 if ( nummodopt < NumModOptdollars ) {
1375 dtype = ModOptdollars[nummodopt].type;
1376 if ( dtype == MODLOCAL ) {
1377 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1380 LOCK(d->pthreadslockread);
1385 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
1386 if ( d->where[0] == 4 && d->where[3] == 3 && d->where[2] == 1
1387 && d->where[1] > 0 && d->where[4] == 0 ) {
1388 num = d->where[1];
goto GotOne;
1391 else if ( d->type == DOLINDEX ) {
1392 if ( d->index > 0 && d->index < AM.OffsetIndex ) {
1393 num = d->index;
goto GotOne;
1396 else if ( d->type == DOLARGUMENT ) {
1397 if ( d->where[0] == -SNUMBER && d->where[1] > 0 ) {
1398 num = d->where[1];
goto GotOne;
1401 else if ( d->type == DOLWILDARGS ) {
1402 if ( d->where[0] == 1 &&
1403 d->where[1] > 0 && d->where[1] < AM.OffsetIndex ) {
1404 num = d->where[1];
goto GotOne;
1406 if ( d->where[0] == 0 && d->where[1] < 0 && d->where[3] == 0 ) {
1407 if ( ( d->where[1] == -SNUMBER && d->where[2] > 0 )
1408 || ( d->where[1] == -INDEX && d->where[2] > 0
1409 && d->where[2] < AM.OffsetIndex ) ) {
1410 num = d->where[2];
goto GotOne;
1415 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1417 MLOCK(ErrorMessageLock);
1418 MesPrint(
"Unusable type of variable $%s in set substitution",
1419 AC.dollarnames->namebuffer+d->name);
1420 MUNLOCK(ErrorMessageLock);
1425 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1428 if ( ii >= 2*MAXPOWER ) i3 = ii - 2*MAXPOWER;
1429 else if ( ii <= -2*MAXPOWER ) i3 = -ii - 2*MAXPOWER;
1430 else i3 = ( ii >= 0 ) ? ii: -ii - 1;
1432 if ( num > ( Sets[i3].last - Sets[i3].first ) || num <= 0 ) {
1433 MLOCK(ErrorMessageLock);
1434 MesPrint(
"Array bound check during set substitution");
1435 MesPrint(
" value is %d",num);
1436 MUNLOCK(ErrorMessageLock);
1439 m[*w] = (SetElements+Sets[i3].first)[num-1];
1440 if ( Sets[i3].type == CSYMBOL && m[*w] > MAXPOWER ) {
1441 if ( ii >= 2*MAXPOWER ) m[*w] -= 2*MAXPOWER;
1442 else if ( ii <= -2*MAXPOWER ) m[*w] = -(m[*w] - 2*MAXPOWER);
1445 if ( m[*w] < MAXPOWER ) m[*w] -= 2*MAXPOWER;
1446 if ( flag ) MakeDirty(m,m+*w,1);
1449 else if ( Sets[i3].type == CSYMBOL ) {
1450 if ( ii >= 2*MAXPOWER ) m[*w] += 2*MAXPOWER;
1451 else if ( ii <= -2*MAXPOWER ) m[*w] = -m[*w] - 2*MAXPOWER;
1452 else if ( ii < 0 ) m[*w] = - m[*w];
1454 else if ( ii < 0 ) m[*w] = - m[*w];
1458 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1459 >= TENSORFUNCTION ) {
1460 w = from + 2 + from[3];
1462 m = from + 2 + FUNHEAD; s = to + FUNHEAD;
1464 if ( *m == -INDEX || *m == -VECTOR ) {}
1465 else if ( *m == -ARGWILD ) { *s++ = FUNNYWILD; }
1467 MLOCK(ErrorMessageLock);
1468 MesPrint(
"Illegal argument in tensor after set substitution");
1469 MUNLOCK(ErrorMessageLock);
1475 to[1] = WORDDIF(s,to);
1490 VOID ClearWild(PHEAD0)
1494 n = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1495 AN.NumWild = nn = n;
1498 do { *w++ = 0; }
while ( --n > 0 );
1501 if ( *w == SYMTONUM ) *w = SYMTOSYM;
1503 }
while ( --nn > 0 );
1516 WORD AddWild(PHEAD WORD oldnumber, WORD type, WORD newnumber)
1519 WORD *w, *m, n, k, i = -1;
1520 CBUF *C = cbuf+AT.ebufnum;
1526 if ( n <= 0 ) {
return(-1); }
1527 if ( type <= SYMTOSUB ) {
1529 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1530 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1532 if ( *m != 2 ) *m = 1;
1533 if ( type != SYMTOSUB ) {
1534 if ( type == SYMTONUM ) AN.MaskPointer = m;
1538 m =
AddRHS(AT.ebufnum,1);
1545 while ( --n >= 0 ) *m++ = *w++;
1547 C->
rhs[C->numrhs+1] = m;
1548 DEBUG(MesPrint(
"Thread %w(d): m=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1553 } while ( --n > 0 );
1555 else if ( type == ARGTOARG ) {
1557 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1559 m =
AddRHS(AT.ebufnum,1);
1563 if ( ( newnumber & EATTENSOR ) != 0 ) {
1564 n = newnumber & ~EATTENSOR;
1569 while ( --newnumber >= 0 ) { NEXTARG(w) }
1570 n = WORDDIF(w,AN.argaddress);
1575 DEBUG(
if ( mm != m-1 ) MesPrint(
"Thread %w(e): Alarm!"); mm = m-1;)
1576 while ( --n >= 0 ) *m++ = *w++;
1578 C->
rhs[C->numrhs+1] = m;
1580 DEBUG(MesPrint(
"Thread %w(e): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1584 } while ( --n > 0 );
1586 else if ( type == ARLTOARL ) {
1588 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1591 m =
AddRHS(AT.ebufnum,1);
1594 a = (WORD **)(AN.argaddress); n = 0; k = newnumber;
1595 while ( --newnumber >= 0 ) {
1597 if ( *w > 0 ) n += *w;
1598 else if ( *w <= -FUNCTION ) n++;
1603 DEBUG(
if ( mm != m-1 ) MesPrint(
"Thread %w(f): Alarm!"); mm = m-1;)
1604 a = (WORD **)(AN.argaddress);
1605 while ( --k >= 0 ) {
1607 if ( *w > 0 ) { n = *w; NCOPY(m,w,n); }
1608 else if ( *w <= -FUNCTION ) *m++ = *w++;
1609 else { *m++ = *w++; *m++ = *w++; }
1612 C->
rhs[C->numrhs+1] = m;
1613 DEBUG(MesPrint(
"Thread %w(f): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1618 } while ( --n > 0 );
1620 else if ( type == VECTOSUB || type == INDTOSUB ) {
1621 WORD *ss, *sstop, *tt, *ttstop, j, *v1, *v2 = 0;
1623 if ( w[2] == oldnumber && ( *w == type ||
1624 ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
1625 || ( type == INDTOSUB && *w == INDTOIND ) ) ) {
1626 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1629 m =
AddRHS(AT.ebufnum,1);
1635 while ( --n >= 0 ) *m++ = *w++;
1637 C->
rhs[C->numrhs+1] = m;
1639 m =
AddRHS(AT.ebufnum,1);
1645 while ( w < sstop ) {
1646 tt = w + *w; ttstop = tt - ABS(tt[-1]);
1648 while ( w < ttstop ) {
1649 if ( *w != INDEX ) {
1658 while ( --j >= 0 ) {
1659 if ( *w >= MINSPEC ) *m++ = *w++;
1664 if ( j <= 2 ) m -= 2;
1673 while ( w < tt ) *m++ = *w++;
1674 *ss = WORDDIF(m,ss);
1677 C->
rhs[C->numrhs+1] = m;
1680 MLOCK(ErrorMessageLock);
1681 MesPrint(
"Internal problems with extra compiler buffer");
1682 MUNLOCK(ErrorMessageLock);
1688 }
while ( --n > 0 );
1692 if ( w[2] == oldnumber && ( *w == type || ( type == VECTOVEC
1693 && ( *w == VECTOMIN || *w == VECTOSUB ) ) || ( type == VECTOMIN
1694 && ( *w == VECTOVEC || *w == VECTOSUB ) )
1695 || ( type == INDTOIND && *w == INDTOSUB ) ) ) {
1696 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1703 }
while ( --n > 0 );
1705 MLOCK(ErrorMessageLock);
1706 MesPrint(
"Bug in AddWild.");
1707 MUNLOCK(ErrorMessageLock);
1714 while ( --n >= 0 ) {
1715 if ( w[2] == i && *w == SYMTONUM ) {
1721 MLOCK(ErrorMessageLock);
1722 MesPrint(
" Bug in AddWild with passing set[i]");
1723 MUNLOCK(ErrorMessageLock);
1761 WORD CheckWild(PHEAD WORD oldnumber, WORD type, WORD newnumber, WORD *newval)
1764 WORD *w, *m, *s, n, old2, inset;
1765 WORD n2, oldval, dirty, i, j, notflag = 0, retblock = 0;
1766 CBUF *C = cbuf+AT.ebufnum;
1770 if ( n <= 0 ) { AN.oldtype = -1; AN.WildReserve = 0;
return(-1); }
1773 *newval = newnumber;
1775 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1777 if ( !*m )
goto TestSet;
1779 if ( *w == SYMTONUM && w[3] == newnumber ) {
1782 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
1785 }
while ( --n > 0 );
1788 *newval = newnumber;
1790 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1792 if ( *w == SYMTOSYM ) {
1793 if ( !*m )
goto TestSet;
1794 if ( newnumber >= 0 && (w+4) < AN.WildStop
1795 && ( w[4] == FROMSET || w[4] == SETTONUM )
1796 && w[7] >= 0 )
goto TestSet;
1797 if ( w[3] == newnumber )
return(0);
1800 if ( !*m )
goto TestSet;
1805 }
while ( --n > 0 );
1815 WORD *ss, *sstop, *tt, *ttstop;
1819 while ( ss < sstop ) {
1821 ttstop = tt - ABS(tt[-1]);
1823 while ( ss < ttstop ) {
1824 if ( *ss == INDEX )
goto NoMatch;
1831 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1833 if ( *w == SYMTONUM || *w == SYMTOSYM ) {
1836 if ( s >= AN.WildStop || *s != SETTONUM )
1840 else if ( *w == SYMTOSUB ) {
1843 if ( s >= AN.WildStop || *s != SETTONUM )
1849 if ( (C->
rhs[w[3]+1] - m - 1) == n ) {
1851 if ( *m != *newval ) {
1852 m++; newval++;
break;
1857 if ( n <= 0 )
return(0);
1860 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
1863 }
while ( --n > 0 );
1867 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1868 if ( !*m )
return(0);
1870 if ( ( newnumber & EATTENSOR ) != 0 ) {
1871 n = newnumber & ~EATTENSOR;
1875 while ( --n >= 0 ) {
1876 if ( *m != *newval ) {
1877 m++; newval++;
break;
1881 if ( n < 0 )
return(0);
1886 while ( --n >= 0 ) {
1887 if ( *newval != m[1] || ( *m != -INDEX
1888 && *m != -VECTOR && *m != -SNUMBER ) )
break;
1892 if ( n < 0 && *m == 0 )
return(0);
1900 while ( --i >= 0 ) {
1901 if ( *m != newval[1]
1902 || ( *newval != -VECTOR
1903 && *newval != -INDEX
1904 && *newval != -SNUMBER ) )
break;
1908 if ( i < 0 )
return(0);
1914 while ( --i >= 0 ) { NEXTARG(s) }
1915 n = WORDDIF(s,newval);
1916 while ( --n >= 0 ) {
1917 if ( *m != *newval ) {
1918 m++; newval++;
break;
1922 if ( n < 0 && *m == 0 )
return(0);
1925 AN.oldtype = *w; AN.oldvalue = w[3];
goto NoMatch;
1928 }
while ( --n > 0 );
1932 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1934 if ( !*m )
return(0);
1937 a = (WORD **)newval;
1941 while ( --i >= 0 ) {
1946 && *s != -SNUMBER ) )
break;
1949 if ( i < 0 )
return(0);
1954 while ( --i >= 0 ) {
1958 while ( --n >= 0 ) {
1964 if ( n >= 0 )
break;
1966 else if ( *s <= -FUNCTION ) {
1983 if ( i < 0 && *m == 0 )
return(0);
1985 AN.oldtype = *w; AN.oldvalue = w[3];
goto NoMatch;
1988 }
while ( --n > 0 );
1999 WORD *ss, *sstop, *tt, *ttstop, count, jt;
2003 while ( ss < sstop ) {
2005 ttstop = tt - ABS(tt[-1]);
2008 while ( ss < ttstop ) {
2009 if ( *ss == INDEX ) {
2010 jt = ss[1] - 2; ss += 2;
2011 while ( --jt >= 0 ) {
2012 if ( *ss < MINSPEC ) count++;
2018 if ( count != 1 )
goto NoMatch;
2023 if ( w[2] == oldnumber ) {
2025 if ( ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
2026 || ( type == INDTOSUB && *w == INDTOIND ) ) {
2027 if ( !*m )
goto TestSet;
2028 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2030 else if ( *w == type ) {
2031 if ( !*m )
goto TestSet;
2032 if ( type != INDTOIND && type != INDTOSUB ) {
2036 if ( (C->
rhs[w[3]+1] - m - 1) == n ) {
2038 if ( *m != *newval ) {
2039 m++; newval++;
break;
2044 if ( n <= 0 )
return(0);
2047 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2051 }
while ( --n > 0 );
2054 *newval = newnumber;
2056 if ( w[2] == oldnumber ) {
2059 if ( !*m )
goto TestSet;
2060 if ( newnumber >= 0 && (w+4) < AN.WildStop &&
2061 ( w[4] == FROMSET || w[4] == SETTONUM )
2062 && w[7] >= 0 )
goto TestSet;
2063 if ( newnumber < 0 && *w == VECTOVEC
2064 && (w+4) < AN.WildStop && ( w[4] == FROMSET
2065 || w[4] == SETTONUM ) && w[7] >= 0 )
goto TestSet;
2069 if ( *w == INDTOIND && w[3] < 0 )
goto NoMatch;
2070 if ( w[3] == newnumber ) {
2071 if ( *w != FUNTOFUN || newnumber < FUNCTION
2072 || functions[newnumber-FUNCTION].spec ==
2073 functions[oldnumber-FUNCTION].spec )
2076 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2078 else if ( ( type == VECTOVEC &&
2079 ( *w == VECTOSUB || *w == VECTOMIN ) )
2080 || ( type == INDTOIND && *w == INDTOSUB ) ) {
2081 if ( *m )
goto NoMatch;
2085 else if ( type == VECTOMIN &&
2086 ( *w == VECTOSUB || *w == VECTOVEC ) ) {
2087 if ( *m )
goto NoMatch;
2093 if ( n > 1 && ( *w == FROMSET
2094 || *w == SETTONUM ) ) { n--; m++; w += w[1]; }
2095 }
while ( --n > 0 );
2101 MLOCK(ErrorMessageLock);
2102 MesPrint(
"Inconsistency in Wildcard prototype.");
2103 MUNLOCK(ErrorMessageLock);
2115 if ( w < AN.WildStop && ( *w == FROMSET || *w == SETTONUM ) ) {
2118 j = w[2]; n2 = w[3];
2123 if ( j > WILDOFFSET ) {
2132 if ( j < AM.NumFixedSets ) {
2136 if ( type != SYMTONUM ||
2137 newnumber <= 0 )
goto NoMnot;
2140 if ( type != SYMTONUM ||
2141 newnumber < 0 )
goto NoMnot;
2144 if ( type != SYMTONUM ||
2145 newnumber >= 0 )
goto NoMnot;
2148 if ( type != SYMTONUM ||
2149 newnumber > 0 )
goto NoMnot;
2152 if ( type != SYMTONUM ||
2153 ( newnumber & 1 ) != 0 )
goto NoMnot;
2156 if ( type != SYMTONUM ||
2157 ( newnumber & 1 ) == 0 )
goto NoMnot;
2160 if ( type != SYMTONUM )
goto NoMnot;
2163 if ( type != SYMTOSYM )
goto NoMnot;
2166 if ( type != INDTOIND ||
2167 newnumber >= AM.OffsetIndex ||
2168 newnumber < 0 )
goto NoMnot;
2171 if ( type != INDTOIND ||
2172 newnumber < 0 )
goto NoMnot;
2175 if ( type == SYMTONUM )
break;
2176 if ( type == SYMTOSUB ) {
2181 if ( ss >= sstop )
break;
2182 if ( ss + *ss < sstop )
goto NoMnot;
2183 if ( ABS(sstop[-1]) == ss[0]-1 )
break;
2187 if ( type != INDTOIND ||
2188 newnumber < AM.IndDum || newnumber >= AM.IndDum+MAXDUMMIES )
goto NoMnot;
2191 if ( type != VECTOVEC )
goto NoMnot;
2197 if ( notflag )
goto NoM;
2200 if ( !notflag )
goto NoM;
2203 else if ( Sets[j].type == CRANGE ) {
2204 if ( ( type == SYMTONUM )
2205 || ( type == INDTOIND && ( newnumber > 0
2206 && newnumber <= AM.OffsetIndex ) ) ) {
2207 if ( Sets[j].first < MAXPOWER ) {
2208 if ( newnumber >= Sets[j].first )
goto NoMnot;
2210 else if ( Sets[j].first < 3*MAXPOWER ) {
2211 if ( newnumber+2*MAXPOWER > Sets[j].first )
goto NoMnot;
2213 if ( Sets[j].last > -MAXPOWER ) {
2214 if ( newnumber <= Sets[j].last )
goto NoMnot;
2216 else if ( Sets[j].last > -3*MAXPOWER ) {
2217 if ( newnumber-2*MAXPOWER < Sets[j].last )
goto NoMnot;
2226 w = SetElements + Sets[j].first;
2227 m = SetElements + Sets[j].last;
2228 if ( ( Sets[j].flags & ORDEREDSET ) == ORDEREDSET ) {
2232 i = BinarySearch(w,Sets[j].last-Sets[j].first,newnumber);
2242 w = m = SetElements + i;
2244 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2253 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2259 if ( Sets[j].type == CNUMBER ) {}
2261 if ( *w == newnumber )
goto NoMatch;
2266 if ( *w == newnumber )
goto NoMatch;
2272 else if ( type != SYMTONUM && type != INDTOIND
2273 && type != SYMTOSYM )
goto NoMatch;
2274 else if ( type == SYMTOSYM && Sets[j].type == CNUMBER )
goto NoMatch;
2275 else if ( *w == newnumber ) {
2276 if ( *s == SETTONUM ) {
2277 if ( n2 == oldnumber && type
2278 <= SYMTOSUB )
goto NoMatch;
2282 while ( --n >= 0 ) {
2283 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2290 if ( *w != SYMTONUM )
2292 if ( w[3] == i )
return(0);
2294 j = (SetElements + Sets[j].first)[i];
2295 if ( j == n2 )
return(0);
2301 else if ( n2 >= 0 ) {
2302 *newval = *(w - Sets[j].first + Sets[n2].first);
2303 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2304 if ( dirty && *newval != oldval ) {
2305 *newval = oldval;
goto NoMatch;
2311 }
while ( ++w < m );
2321 if ( ( type == SYMTOSYM && *w == newnumber )
2322 || ( type == SYMTONUM && *w-2*MAXPOWER == newnumber ) ) {
2328 WORD *mm = AT.WildMask, *mmm, *part;
2329 WORD *ww = AN.WildValue;
2330 WORD nn = AN.NumWild;
2332 while ( --nn >= 0 ) {
2333 if ( *mm && ww[2] == k && ww[0] == type ) {
2334 if ( type != SYMTOSUB ) {
2335 if ( ww[3] == newnumber )
goto NoMatch;
2338 mmm = C->
rhs[ww[3]];
2341 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2342 while ( --nn >= 0 ) {
2343 if ( *mmm != *part ) {
2344 mmm++; part++;
break;
2348 if ( nn < 0 )
goto NoMatch;
2358 if ( type == VECTOMIN ) {
2359 if ( inset >= AM.OffsetVector ) { i++;
continue; }
2364 if ( inset == newnumber )
goto NoMatch;
2367 if ( inset - WILDOFFSET >= AM.OffsetVector ) {
2368 WORD *mm = AT.WildMask, *mmm, *part;
2369 WORD *ww = AN.WildValue;
2370 WORD nn = AN.NumWild;
2371 k = inset - WILDOFFSET;
2372 while ( --nn >= 0 ) {
2373 if ( *mm && ww[2] == k && ww[0] == type ) {
2374 if ( type == VECTOVEC ) {
2375 if ( ww[3] == newnumber )
goto NoMatch;
2378 mmm = C->
rhs[ww[3]];
2381 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2382 while ( --nn >= 0 ) {
2383 if ( *mmm != *part ) {
2384 mmm++; part++;
break;
2388 if ( nn < 0 )
goto NoMatch;
2398 if ( *w == newnumber )
goto NoMatch;
2401 if ( *w - (WORD)WILDMASK >= AM.OffsetIndex ) {
2402 WORD *mm = AT.WildMask, *mmm, *part;
2403 WORD *ww = AN.WildValue;
2404 WORD nn = AN.NumWild;
2406 while ( --nn >= 0 ) {
2407 if ( *mm && ww[2] == k && ww[0] == type ) {
2408 if ( type == INDTOIND ) {
2409 if ( ww[3] == newnumber )
goto NoMatch;
2412 mmm = C->
rhs[ww[3]];
2415 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2416 while ( --nn >= 0 ) {
2417 if ( *mmm != *part ) {
2418 mmm++; part++;
break;
2422 if ( nn < 0 )
goto NoMatch;
2432 if ( *w == newnumber )
goto NoMatch;
2433 if ( ( type == FUNTOFUN &&
2434 ( k = *w - WILDMASK ) > FUNCTION ) ) {
2435 WORD *mm = AT.WildMask;
2436 WORD *ww = AN.WildValue;
2437 WORD nn = AN.NumWild;
2438 while ( --nn >= 0 ) {
2439 if ( *mm && ww[2] == k && ww[0] == type ) {
2440 if ( ww[3] == newnumber )
goto NoMatch;
2451 if ( type == VECTOMIN ) {
2452 if ( inset >= AM.OffsetVector ) { i++;
continue; }
2455 if ( ( inset == newnumber && type != SYMTONUM ) ||
2456 ( type == SYMTONUM && inset-2*MAXPOWER == newnumber ) ) {
2457 if ( *s == SETTONUM ) {
2458 if ( n2 == oldnumber && type
2459 <= SYMTOSUB )
goto NoMatch;
2463 while ( --n >= 0 ) {
2464 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2471 if ( *w != SYMTONUM )
2473 if ( w[3] == i )
return(0);
2475 j = (SetElements + Sets[j].first)[i];
2476 if ( j == n2 )
return(0);
2482 else if ( n2 >= 0 ) {
2483 *newval = *(w - Sets[j].first + Sets[n2].first);
2484 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2485 if ( dirty && *newval != oldval ) {
2486 *newval = oldval;
goto NoMatch;
2493 }
while ( ++w < m );
2495 if ( notflag )
return(0);
2496 AN.oldtype = old2; AN.oldvalue = oldval;
goto NoMatch;
2501 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2513 int DenToFunction(WORD *term, WORD numfun)
2516 WORD *t, *tstop, *tnext, *arg, *argstop, *targ;
2518 tstop = term + *term; tstop -= ABS(tstop[-1]);
2519 while ( t < tstop ) {
2520 if ( *t == DENOMINATOR ) {
2521 *t = numfun; t[2] |= DIRTYFLAG; action = 1;
2524 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec == 0 ) {
2526 while ( arg < tnext ) {
2528 targ = arg + ARGHEAD; argstop = arg + *arg;
2529 while ( targ < argstop ) {
2530 if ( DenToFunction(targ,numfun) ) {
2531 arg[1] |= DIRTYFLAG; t[2] |= DIRTYFLAG; action = 1;
2537 else if ( *arg <= -FUNCTION ) arg++;