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 ( *s == SYMTOSYM ) *m = s[3];
1093 else if ( *s == SYMTONUM ) {
1097 else if ( *s == SYMTOSUB ) {
1100 DEBUG(MesPrint(
"Thread %w(c): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
1110 if ( t[-1] == -MINVECTOR ) {
1117 if ( ToFast(s,s) ) {
1118 if ( *s <= -FUNCTION ) m = s;
1129 else if ( *t == -INDEX ) {
1133 for ( j = 0; j < i; j++ ) {
1135 if ( *s == INDTOIND || *s == VECTOVEC ) {
1137 if ( *m < MINSPEC ) m[-1] = -VECTOR;
1138 else if ( *m >= 0 && *m < AM.OffsetIndex )
1140 else m[-1] = -INDEX;
1142 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
1145 *z++ = SUBEXPRESSION;
1146 *z++ = 4+SUBEXPSIZE;
1156 v[2] |= DIRTYFLAG; dirty = 1;
1163 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
1167 for ( j = 0; j < i; j++ ) {
1169 if ( *s == VECTOVEC ) *m = s[3];
1170 else if ( *s == VECTOMIN ) {
1172 if ( t[-1] == -VECTOR )
1177 else if ( *s == VECTOSUB )
goto ToSub;
1178 dirty = 1; v[2] |= DIRTYFLAG;
1185 else if ( *t == -SNUMBER ) {
1189 for ( j = 0; j < i; j++ ) {
1190 if ( *t == s[2] && *s >= NUMTONUM && *s <= NUMTOSUB ) {
1191 dirty = 1; v[2] |= DIRTYFLAG;
1192 if ( *s == NUMTONUM ) *m = s[3];
1193 else if ( *s == NUMTOSYM ) {
1197 else if ( *s == NUMTOIND ) {
1201 else if ( *s == NUMTOSUB )
goto ToSub;
1212 na = WORDDIF(z,accu);
1221 odirt = AN.WildDirt; AN.WildDirt = 0;
1222 AR.CompressPointer = accu + na;
1223 for ( j = 0; j < ARGHEAD; j++ ) *m++ = *t++;
1227 if ( ( len = WildFill(BHEAD m,t,sub) ) < 0 ) {
1228 MLOCK(ErrorMessageLock);
1229 MesCall(
"WildFill");
1230 MUNLOCK(ErrorMessageLock);
1233 if ( AN.WildDirt ) {
1234 adirt = AN.WildDirt;
1242 dirty = w[1] = 1; v[2] |= DIRTYFLAG;
1243 AN.WildDirt = adirt;
1246 AN.WildDirt = odirt;
1248 if ( ToFast(w,w) ) {
1249 if ( *w <= -FUNCTION ) {
1250 if ( *w == NUMARGSFUN || *w == NUMTERMSFUN ) {
1251 *w = -SNUMBER; w[1] = 0; m = w + 2;
1257 AR.CompressPointer = oldcpointer;
1260 v[1] = WORDDIF(m,v);
1266 if ( v[0] == EXPONENT ) {
1267 if ( v[1] == FUNHEAD+4 && v[FUNHEAD] == -SYMBOL &&
1268 v[FUNHEAD+2] == -SNUMBER && v[FUNHEAD+3] < MAXPOWER
1269 && v[FUNHEAD+3] > -MAXPOWER ) {
1272 v[2] = v[FUNHEAD+1];
1273 v[3] = v[FUNHEAD+3];
1276 else if ( v[1] == FUNHEAD+ARGHEAD+11
1277 && v[FUNHEAD] == ARGHEAD+9
1278 && v[FUNHEAD+ARGHEAD] == 9
1279 && v[FUNHEAD+ARGHEAD+1] == DOTPRODUCT
1280 && v[FUNHEAD+ARGHEAD+8] == 3
1281 && v[FUNHEAD+ARGHEAD+7] == 1
1282 && v[FUNHEAD+ARGHEAD+6] == 1
1283 && v[FUNHEAD+ARGHEAD+5] == 1
1284 && v[FUNHEAD+ARGHEAD+9] == -SNUMBER
1285 && v[FUNHEAD+ARGHEAD+10] < MAXPOWER
1286 && v[FUNHEAD+ARGHEAD+10] > -MAXPOWER ) {
1289 v[2] = v[FUNHEAD+ARGHEAD+3];
1290 v[3] = v[FUNHEAD+ARGHEAD+4];
1291 v[4] = v[FUNHEAD+ARGHEAD+10];
1296 else {
while ( t < u ) *m++ = *t++; }
1305 if ( r < t )
do { *m++ = *r++; }
while ( r < t );
1306 if ( ( sgn & 1 ) != 0 ) m[-1] = -m[-1];
1307 *to = WORDDIF(m,to);
1308 if ( dirty ) AN.WildDirt = dirty;
1329 WORD ResolveSet(
PHEAD WORD *from, WORD *to, WORD *subs)
1332 WORD *m, *s, *w, j, i, ii, i3, flag, num;
1335 int nummodopt, dtype = -1;
1340 while ( s < w ) *m++ = *s++;
1341 j = (from[1] - WORDDIF(w,from) ) >> 1;
1346 while ( s < m ) { i++; s += s[1]; }
1348 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1349 >= TENSORFUNCTION ) flag = 0;
1351 while ( --j >= 0 ) {
1354 for ( ii = 0; ii < i; ii++ ) {
1355 if ( *s == SYMTONUM && s[2] == w[1] ) { num = s[3];
goto GotOne; }
1358 MLOCK(ErrorMessageLock);
1359 MesPrint(
" Unresolved setelement during substitution");
1360 MUNLOCK(ErrorMessageLock);
1366 if ( AS.MultiThreaded ) {
1367 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1368 if ( -w[1] == ModOptdollars[nummodopt].number )
break;
1370 if ( nummodopt < NumModOptdollars ) {
1371 dtype = ModOptdollars[nummodopt].type;
1372 if ( dtype == MODLOCAL ) {
1373 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1376 LOCK(d->pthreadslockread);
1381 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
1382 if ( d->where[0] == 4 && d->where[3] == 3 && d->where[2] == 1
1383 && d->where[1] > 0 && d->where[4] == 0 ) {
1384 num = d->where[1];
goto GotOne;
1387 else if ( d->type == DOLINDEX ) {
1388 if ( d->index > 0 && d->index < AM.OffsetIndex ) {
1389 num = d->index;
goto GotOne;
1392 else if ( d->type == DOLARGUMENT ) {
1393 if ( d->where[0] == -SNUMBER && d->where[1] > 0 ) {
1394 num = d->where[1];
goto GotOne;
1397 else if ( d->type == DOLWILDARGS ) {
1398 if ( d->where[0] == 1 &&
1399 d->where[1] > 0 && d->where[1] < AM.OffsetIndex ) {
1400 num = d->where[1];
goto GotOne;
1402 if ( d->where[0] == 0 && d->where[1] < 0 && d->where[3] == 0 ) {
1403 if ( ( d->where[1] == -SNUMBER && d->where[2] > 0 )
1404 || ( d->where[1] == -INDEX && d->where[2] > 0
1405 && d->where[2] < AM.OffsetIndex ) ) {
1406 num = d->where[2];
goto GotOne;
1411 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1413 MLOCK(ErrorMessageLock);
1414 MesPrint(
"Unusable type of variable $%s in set substitution",
1415 AC.dollarnames->namebuffer+d->name);
1416 MUNLOCK(ErrorMessageLock);
1421 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1424 if ( ii >= 2*MAXPOWER ) i3 = ii - 2*MAXPOWER;
1425 else if ( ii <= -2*MAXPOWER ) i3 = -ii - 2*MAXPOWER;
1426 else i3 = ( ii >= 0 ) ? ii: -ii - 1;
1428 if ( num > ( Sets[i3].last - Sets[i3].first ) || num <= 0 ) {
1429 MLOCK(ErrorMessageLock);
1430 MesPrint(
"Array bound check during set substitution");
1431 MesPrint(
" value is %d",num);
1432 MUNLOCK(ErrorMessageLock);
1435 m[*w] = (SetElements+Sets[i3].first)[num-1];
1436 if ( Sets[i3].type == CSYMBOL && m[*w] > MAXPOWER ) {
1437 if ( ii >= 2*MAXPOWER ) m[*w] -= 2*MAXPOWER;
1438 else if ( ii <= -2*MAXPOWER ) m[*w] = -(m[*w] - 2*MAXPOWER);
1441 if ( m[*w] < MAXPOWER ) m[*w] -= 2*MAXPOWER;
1442 if ( flag ) MakeDirty(m,m+*w,1);
1445 else if ( Sets[i3].type == CSYMBOL ) {
1446 if ( ii >= 2*MAXPOWER ) m[*w] += 2*MAXPOWER;
1447 else if ( ii <= -2*MAXPOWER ) m[*w] = -m[*w] - 2*MAXPOWER;
1448 else if ( ii < 0 ) m[*w] = - m[*w];
1450 else if ( ii < 0 ) m[*w] = - m[*w];
1454 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1455 >= TENSORFUNCTION ) {
1456 w = from + 2 + from[3];
1458 m = from + 2 + FUNHEAD; s = to + FUNHEAD;
1460 if ( *m == -INDEX || *m == -VECTOR ) {}
1461 else if ( *m == -ARGWILD ) { *s++ = FUNNYWILD; }
1463 MLOCK(ErrorMessageLock);
1464 MesPrint(
"Illegal argument in tensor after set substitution");
1465 MUNLOCK(ErrorMessageLock);
1471 to[1] = WORDDIF(s,to);
1486 VOID ClearWild(PHEAD0)
1490 n = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1491 AN.NumWild = nn = n;
1494 do { *w++ = 0; }
while ( --n > 0 );
1497 if ( *w == SYMTONUM ) *w = SYMTOSYM;
1499 }
while ( --nn > 0 );
1512 WORD AddWild(
PHEAD WORD oldnumber, WORD type, WORD newnumber)
1515 WORD *w, *m, n, k, i = -1;
1516 CBUF *C = cbuf+AT.ebufnum;
1522 if ( n <= 0 ) {
return(-1); }
1523 if ( type <= SYMTOSUB ) {
1525 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1526 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1528 if ( *m != 2 ) *m = 1;
1529 if ( type != SYMTOSUB ) {
1530 if ( type == SYMTONUM ) AN.MaskPointer = m;
1534 m = AddRHS(AT.ebufnum,1);
1540 while ( (m + n + 10) > C->
Top ) m = DoubleCbuffer(AT.ebufnum,m);
1541 while ( --n >= 0 ) *m++ = *w++;
1543 C->
rhs[C->numrhs+1] = m;
1544 DEBUG(MesPrint(
"Thread %w(d): m=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1549 } while ( --n > 0 );
1551 else if ( type == ARGTOARG ) {
1553 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1555 m = AddRHS(AT.ebufnum,1);
1559 if ( ( newnumber & EATTENSOR ) != 0 ) {
1560 n = newnumber & ~EATTENSOR;
1565 while ( --newnumber >= 0 ) { NEXTARG(w) }
1566 n = WORDDIF(w,AN.argaddress);
1570 while ( (m + n + 10) > C->
Top ) m = DoubleCbuffer(AT.ebufnum,m);
1571 DEBUG(
if ( mm != m-1 ) MesPrint(
"Thread %w(e): Alarm!"); mm = m-1;)
1572 while ( --n >= 0 ) *m++ = *w++;
1574 C->
rhs[C->numrhs+1] = m;
1576 DEBUG(MesPrint(
"Thread %w(e): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1580 } while ( --n > 0 );
1582 else if ( type == ARLTOARL ) {
1584 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1587 m = AddRHS(AT.ebufnum,1);
1590 a = (WORD **)(AN.argaddress); n = 0; k = newnumber;
1591 while ( --newnumber >= 0 ) {
1593 if ( *w > 0 ) n += *w;
1594 else if ( *w <= -FUNCTION ) n++;
1598 while ( (m + n + 10) > C->
Top ) m = DoubleCbuffer(AT.ebufnum,m);
1599 DEBUG(
if ( mm != m-1 ) MesPrint(
"Thread %w(f): Alarm!"); mm = m-1;)
1600 a = (WORD **)(AN.argaddress);
1601 while ( --k >= 0 ) {
1603 if ( *w > 0 ) { n = *w; NCOPY(m,w,n); }
1604 else if ( *w <= -FUNCTION ) *m++ = *w++;
1605 else { *m++ = *w++; *m++ = *w++; }
1608 C->
rhs[C->numrhs+1] = m;
1609 DEBUG(MesPrint(
"Thread %w(f): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1614 } while ( --n > 0 );
1616 else if ( type == VECTOSUB || type == INDTOSUB ) {
1617 WORD *ss, *sstop, *tt, *ttstop, j, *v1, *v2 = 0;
1619 if ( w[2] == oldnumber && ( *w == type ||
1620 ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
1621 || ( type == INDTOSUB && *w == INDTOIND ) ) ) {
1622 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1625 m = AddRHS(AT.ebufnum,1);
1630 while ( (m + n + 10) > C->
Top ) m = DoubleCbuffer(AT.ebufnum,m);
1631 while ( --n >= 0 ) *m++ = *w++;
1633 C->
rhs[C->numrhs+1] = m;
1635 m = AddRHS(AT.ebufnum,1);
1639 while ( (m + n + 10) > C->
Top ) m = DoubleCbuffer(AT.ebufnum,m);
1641 while ( w < sstop ) {
1642 tt = w + *w; ttstop = tt - ABS(tt[-1]);
1644 while ( w < ttstop ) {
1645 if ( *w != INDEX ) {
1654 while ( --j >= 0 ) {
1655 if ( *w >= MINSPEC ) *m++ = *w++;
1660 if ( j <= 2 ) m -= 2;
1669 while ( w < tt ) *m++ = *w++;
1670 *ss = WORDDIF(m,ss);
1673 C->
rhs[C->numrhs+1] = m;
1676 MLOCK(ErrorMessageLock);
1677 MesPrint(
"Internal problems with extra compiler buffer");
1678 MUNLOCK(ErrorMessageLock);
1684 }
while ( --n > 0 );
1688 if ( w[2] == oldnumber && ( *w == type || ( type == VECTOVEC
1689 && ( *w == VECTOMIN || *w == VECTOSUB ) )
1690 || ( type == INDTOIND && *w == INDTOSUB ) ) ) {
1691 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1698 }
while ( --n > 0 );
1700 MLOCK(ErrorMessageLock);
1701 MesPrint(
"Bug in AddWild.");
1702 MUNLOCK(ErrorMessageLock);
1709 while ( --n >= 0 ) {
1710 if ( w[2] == i && *w == SYMTONUM ) {
1716 MLOCK(ErrorMessageLock);
1717 MesPrint(
" Bug in AddWild with passing set[i]");
1718 MUNLOCK(ErrorMessageLock);
1756 WORD CheckWild(
PHEAD WORD oldnumber, WORD type, WORD newnumber, WORD *newval)
1759 WORD *w, *m, *s, n, old2;
1760 WORD n2, oldval, dirty, i, j, notflag = 0, retblock = 0;
1761 CBUF *C = cbuf+AT.ebufnum;
1765 if ( n <= 0 ) { AN.oldtype = -1; AN.WildReserve = 0;
return(-1); }
1768 *newval = newnumber;
1770 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1772 if ( !*m )
goto TestSet;
1774 if ( *w == SYMTONUM && w[3] == newnumber ) {
1777 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
1780 }
while ( --n > 0 );
1783 *newval = newnumber;
1785 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1787 if ( *w == SYMTOSYM ) {
1788 if ( !*m )
goto TestSet;
1789 if ( newnumber >= 0 && (w+4) < AN.WildStop
1790 && ( w[4] == FROMSET || w[4] == SETTONUM )
1791 && w[7] >= 0 )
goto TestSet;
1792 if ( w[3] == newnumber )
return(0);
1795 if ( !*m )
goto TestSet;
1800 }
while ( --n > 0 );
1810 WORD *ss, *sstop, *tt, *ttstop;
1814 while ( ss < sstop ) {
1816 ttstop = tt - ABS(tt[-1]);
1818 while ( ss < ttstop ) {
1819 if ( *ss == INDEX )
goto NoMatch;
1826 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1828 if ( *w == SYMTONUM || *w == SYMTOSYM ) {
1831 if ( s >= AN.WildStop || *s != SETTONUM )
1835 else if ( *w == SYMTOSUB ) {
1838 if ( s >= AN.WildStop || *s != SETTONUM )
1844 if ( (C->
rhs[w[3]+1] - m - 1) == n ) {
1846 if ( *m != *newval ) {
1847 m++; newval++;
break;
1852 if ( n <= 0 )
return(0);
1855 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
1858 }
while ( --n > 0 );
1862 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1863 if ( !*m )
return(0);
1865 if ( ( newnumber & EATTENSOR ) != 0 ) {
1866 n = newnumber & ~EATTENSOR;
1870 while ( --n >= 0 ) {
1871 if ( *m != *newval ) {
1872 m++; newval++;
break;
1876 if ( n < 0 )
return(0);
1881 while ( --n >= 0 ) {
1882 if ( *newval != m[1] || ( *m != -INDEX
1883 && *m != -VECTOR && *m != -SNUMBER ) )
break;
1887 if ( n < 0 && *m == 0 )
return(0);
1895 while ( --i >= 0 ) {
1896 if ( *m != newval[1]
1897 || ( *newval != -VECTOR
1898 && *newval != -INDEX
1899 && *newval != -SNUMBER ) )
break;
1903 if ( i < 0 )
return(0);
1909 while ( --i >= 0 ) { NEXTARG(s) }
1910 n = WORDDIF(s,newval);
1911 while ( --n >= 0 ) {
1912 if ( *m != *newval ) {
1913 m++; newval++;
break;
1917 if ( n < 0 && *m == 0 )
return(0);
1920 AN.oldtype = *w; AN.oldvalue = w[3];
goto NoMatch;
1923 }
while ( --n > 0 );
1927 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1929 if ( !*m )
return(0);
1932 a = (WORD **)newval;
1936 while ( --i >= 0 ) {
1941 && *s != -SNUMBER ) )
break;
1944 if ( i < 0 )
return(0);
1949 while ( --i >= 0 ) {
1953 while ( --n >= 0 ) {
1959 if ( n >= 0 )
break;
1961 else if ( *s <= -FUNCTION ) {
1978 if ( i < 0 && *m == 0 )
return(0);
1980 AN.oldtype = *w; AN.oldvalue = w[3];
goto NoMatch;
1983 }
while ( --n > 0 );
1994 WORD *ss, *sstop, *tt, *ttstop, count, jt;
1998 while ( ss < sstop ) {
2000 ttstop = tt - ABS(tt[-1]);
2003 while ( ss < ttstop ) {
2004 if ( *ss == INDEX ) {
2005 jt = ss[1] - 2; ss += 2;
2006 while ( --jt >= 0 ) {
2007 if ( *ss < MINSPEC ) count++;
2013 if ( count != 1 )
goto NoMatch;
2018 if ( w[2] == oldnumber ) {
2020 if ( ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
2021 || ( type == INDTOSUB && *w == INDTOIND ) ) {
2022 if ( !*m )
goto TestSet;
2023 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2025 else if ( *w == type ) {
2026 if ( !*m )
goto TestSet;
2027 if ( type != INDTOIND && type != INDTOSUB ) {
2031 if ( (C->
rhs[w[3]+1] - m - 1) == n ) {
2033 if ( *m != *newval ) {
2034 m++; newval++;
break;
2039 if ( n <= 0 )
return(0);
2042 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2046 }
while ( --n > 0 );
2049 *newval = newnumber;
2051 if ( w[2] == oldnumber ) {
2054 if ( !*m )
goto TestSet;
2055 if ( newnumber >= 0 && (w+4) < AN.WildStop &&
2056 ( w[4] == FROMSET || w[4] == SETTONUM )
2057 && w[7] >= 0 )
goto TestSet;
2058 if ( newnumber < 0 && *w == VECTOVEC
2059 && (w+4) < AN.WildStop && ( w[4] == FROMSET
2060 || w[4] == SETTONUM ) && w[7] >= 0 )
goto TestSet;
2064 if ( *w == INDTOIND && w[3] < 0 )
goto NoMatch;
2065 if ( w[3] == newnumber ) {
2066 if ( *w != FUNTOFUN || newnumber < FUNCTION
2067 || functions[newnumber-FUNCTION].spec ==
2068 functions[oldnumber-FUNCTION].spec )
2071 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2073 else if ( ( type == VECTOVEC &&
2074 ( *w == VECTOSUB || *w == VECTOMIN ) )
2075 || ( type == INDTOIND && *w == INDTOSUB ) ) {
2076 if ( *m )
goto NoMatch;
2082 if ( n > 1 && ( *w == FROMSET
2083 || *w == SETTONUM ) ) { n--; m++; w += w[1]; }
2084 }
while ( --n > 0 );
2090 MLOCK(ErrorMessageLock);
2091 MesPrint(
"Inconsistency in Wildcard prototype.");
2092 MUNLOCK(ErrorMessageLock);
2104 if ( w < AN.WildStop && ( *w == FROMSET || *w == SETTONUM ) ) {
2107 j = w[2]; n2 = w[3];
2108 if ( j > WILDOFFSET ) {
2117 if ( j < AM.NumFixedSets ) {
2121 if ( type != SYMTONUM ||
2122 newnumber <= 0 )
goto NoMnot;
2125 if ( type != SYMTONUM ||
2126 newnumber < 0 )
goto NoMnot;
2129 if ( type != SYMTONUM ||
2130 newnumber >= 0 )
goto NoMnot;
2133 if ( type != SYMTONUM ||
2134 newnumber > 0 )
goto NoMnot;
2137 if ( type != SYMTONUM ||
2138 ( newnumber & 1 ) != 0 )
goto NoMnot;
2141 if ( type != SYMTONUM ||
2142 ( newnumber & 1 ) == 0 )
goto NoMnot;
2145 if ( type != SYMTONUM )
goto NoMnot;
2148 if ( type != SYMTOSYM )
goto NoMnot;
2151 if ( type != INDTOIND ||
2152 newnumber >= AM.OffsetIndex ||
2153 newnumber < 0 )
goto NoMnot;
2156 if ( type != INDTOIND ||
2157 newnumber < 0 )
goto NoMnot;
2160 if ( type == SYMTONUM )
break;
2161 if ( type == SYMTOSUB ) {
2166 if ( ss >= sstop )
break;
2167 if ( ss + *ss < sstop )
goto NoMnot;
2168 if ( ABS(sstop[-1]) == ss[0]-1 )
break;
2172 if ( type != INDTOIND ||
2173 newnumber < AM.IndDum || newnumber >= AM.IndDum+MAXDUMMIES )
goto NoMnot;
2179 if ( notflag )
goto NoM;
2182 if ( !notflag )
goto NoM;
2185 else if ( Sets[j].type == CRANGE ) {
2186 if ( ( type == SYMTONUM )
2187 || ( type == INDTOIND && ( newnumber > 0
2188 && newnumber <= AM.OffsetIndex ) ) ) {
2189 if ( Sets[j].first < MAXPOWER ) {
2190 if ( newnumber >= Sets[j].first )
goto NoMnot;
2192 else if ( Sets[j].first < 3*MAXPOWER ) {
2193 if ( newnumber+2*MAXPOWER > Sets[j].first )
goto NoMnot;
2195 if ( Sets[j].last > -MAXPOWER ) {
2196 if ( newnumber <= Sets[j].last )
goto NoMnot;
2198 else if ( Sets[j].last > -3*MAXPOWER ) {
2199 if ( newnumber-2*MAXPOWER < Sets[j].last )
goto NoMnot;
2205 w = SetElements + Sets[j].first;
2206 m = SetElements + Sets[j].last;
2208 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
do {
2212 if ( Sets[j].type == CNUMBER ) {}
2214 if ( *w == newnumber )
goto NoMatch;
2219 if ( *w == newnumber )
goto NoMatch;
2225 else if ( type != SYMTONUM && type != INDTOIND
2226 && type != SYMTOSYM )
goto NoMatch;
2227 else if ( type == SYMTOSYM && Sets[j].type == CNUMBER )
goto NoMatch;
2228 else if ( *w == newnumber ) {
2229 if ( *s == SETTONUM ) {
2230 if ( n2 == oldnumber && type
2231 <= SYMTOSUB )
goto NoMatch;
2235 while ( --n >= 0 ) {
2236 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2243 if ( *w != SYMTONUM )
2245 if ( w[3] == i )
return(0);
2247 j = (SetElements + Sets[j].first)[i];
2248 if ( j == n2 )
return(0);
2254 else if ( n2 >= 0 ) {
2255 *newval = *(w - Sets[j].first + Sets[n2].first);
2256 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2257 if ( dirty && *newval != oldval ) {
2258 *newval = oldval;
goto NoMatch;
2264 }
while ( ++w < m ); }
2270 if ( ( type == SYMTOSYM && *w == newnumber )
2271 || ( type == SYMTONUM && *w-2*MAXPOWER == newnumber ) ) {
2276 WORD *mm = AT.WildMask, *mmm, *part;
2277 WORD *ww = AN.WildValue;
2278 WORD nn = AN.NumWild;
2280 while ( --nn >= 0 ) {
2281 if ( *mm && ww[2] == k && ww[0] == type ) {
2282 if ( type != SYMTOSUB ) {
2283 if ( ww[3] == newnumber )
goto NoMatch;
2286 mmm = C->
rhs[ww[3]];
2289 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2290 while ( --nn >= 0 ) {
2291 if ( *mmm != *part ) {
2292 mmm++; part++;
break;
2296 if ( nn < 0 )
goto NoMatch;
2306 if ( *w == newnumber )
goto NoMatch;
2308 if ( *w - WILDOFFSET >= AM.OffsetVector ) {
2309 WORD *mm = AT.WildMask, *mmm, *part;
2310 WORD *ww = AN.WildValue;
2311 WORD nn = AN.NumWild;
2312 k = *w - WILDOFFSET;
2313 while ( --nn >= 0 ) {
2314 if ( *mm && ww[2] == k && ww[0] == type ) {
2315 if ( type == VECTOVEC ) {
2316 if ( ww[3] == newnumber )
goto NoMatch;
2319 mmm = C->
rhs[ww[3]];
2322 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2323 while ( --nn >= 0 ) {
2324 if ( *mmm != *part ) {
2325 mmm++; part++;
break;
2329 if ( nn < 0 )
goto NoMatch;
2339 if ( *w == newnumber )
goto NoMatch;
2341 if ( *w - (WORD)WILDMASK >= AM.OffsetIndex ) {
2342 WORD *mm = AT.WildMask, *mmm, *part;
2343 WORD *ww = AN.WildValue;
2344 WORD nn = AN.NumWild;
2346 while ( --nn >= 0 ) {
2347 if ( *mm && ww[2] == k && ww[0] == type ) {
2348 if ( type == INDTOIND ) {
2349 if ( ww[3] == newnumber )
goto NoMatch;
2352 mmm = C->
rhs[ww[3]];
2355 if ( (C->
rhs[ww[3]+1]-mmm-1) == nn ) {
2356 while ( --nn >= 0 ) {
2357 if ( *mmm != *part ) {
2358 mmm++; part++;
break;
2362 if ( nn < 0 )
goto NoMatch;
2372 if ( *w == newnumber )
goto NoMatch;
2373 if ( ( type == FUNTOFUN &&
2374 ( k = *w - WILDMASK ) > FUNCTION ) ) {
2375 WORD *mm = AT.WildMask;
2376 WORD *ww = AN.WildValue;
2377 WORD nn = AN.NumWild;
2378 while ( --nn >= 0 ) {
2379 if ( *mm && ww[2] == k && ww[0] == type ) {
2380 if ( ww[3] == newnumber )
goto NoMatch;
2390 else if ( ( *w == newnumber && type != SYMTONUM ) ||
2391 ( type == SYMTONUM && *w-2*MAXPOWER == newnumber ) ) {
2392 if ( *s == SETTONUM ) {
2393 if ( n2 == oldnumber && type
2394 <= SYMTOSUB )
goto NoMatch;
2398 while ( --n >= 0 ) {
2399 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2406 if ( *w != SYMTONUM )
2408 if ( w[3] == i )
return(0);
2410 j = (SetElements + Sets[j].first)[i];
2411 if ( j == n2 )
return(0);
2417 else if ( n2 >= 0 ) {
2418 *newval = *(w - Sets[j].first + Sets[n2].first);
2419 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2420 if ( dirty && *newval != oldval ) {
2421 *newval = oldval;
goto NoMatch;
2427 }
while ( ++w < m ); }
2428 if ( notflag )
return(0);
2429 AN.oldtype = old2; AN.oldvalue = oldval;
goto NoMatch;
2434 AN.oldtype = old2; AN.oldvalue = w[3];
goto NoMatch;
2446 int DenToFunction(WORD *term, WORD numfun)
2449 WORD *t, *tstop, *tnext, *arg, *argstop, *targ;
2451 tstop = term + *term; tstop -= ABS(tstop[-1]);
2452 while ( t < tstop ) {
2453 if ( *t == DENOMINATOR ) {
2454 *t = numfun; t[2] |= DIRTYFLAG; action = 1;
2457 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec == 0 ) {
2459 while ( arg < tnext ) {
2461 targ = arg + ARGHEAD; argstop = arg + *arg;
2462 while ( targ < argstop ) {
2463 if ( DenToFunction(targ,numfun) ) {
2464 arg[1] |= DIRTYFLAG; t[2] |= DIRTYFLAG; action = 1;
2470 else if ( *arg <= -FUNCTION ) arg++;