FORM v5.0.1-33-gdf7fc94
wildcard.c
Go to the documentation of this file.
1
12/* #[ License : */
13/*
14 * Copyright (C) 1984-2026 J.A.M. Vermaseren
15 * When using this file you are requested to refer to the publication
16 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
17 * This is considered a matter of courtesy as the development was paid
18 * for by FOM the Dutch physics granting agency and we would like to
19 * be able to track its scientific use to convince FOM of its value
20 * for the community.
21 *
22 * This file is part of FORM.
23 *
24 * FORM is free software: you can redistribute it and/or modify it under the
25 * terms of the GNU General Public License as published by the Free Software
26 * Foundation, either version 3 of the License, or (at your option) any later
27 * version.
28 *
29 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
30 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
31 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
32 * details.
33 *
34 * You should have received a copy of the GNU General Public License along
35 * with FORM. If not, see <http://www.gnu.org/licenses/>.
36 */
37/* #] License : */
38/*
39 #[ Includes : wildcard.c
40*/
41
42#include "form3.h"
43
44#define DEBUG(x)
45
46/*
47#define DEBUG(x) x
48
49 #] Includes :
50 #[ Wildcards :
51 #[ WildFill : WORD WildFill(to,from,sub)
52
53 Takes the term in from and puts it into to while
54 making wildcard substitutions.
55 The return value is the number of words put in to.
56 The length as the first word of from is not copied.
57
58 There are two possible algorithms:
59 1: For each element in `from': scan sub.
60 2: For each wildcard in sub replace elements in term.
61 The original algorithm used 1:
62
63*/
64
65WORD WildFill(PHEAD WORD *to, WORD *from, WORD *sub)
66{
67 GETBIDENTITY
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;
73 t = sub;
74 t += sub[1];
75 s = sub + SUBEXPSIZE;
76 i = 0;
77 while ( s < t && *s != FROMBRAC ) {
78 i++; s += s[1];
79 }
80 if ( !i ) { /* No wildcards -> done quickly */
81 j = i = *from;
82 NCOPY(to,from,i);
83 if ( dirty ) AN.WildDirt = dirty;
84 return(j);
85 }
86 sgn = 0;
87 subs = sub + SUBEXPSIZE;
88 t = from;
89 GETSTOP(t,r);
90 t++;
91 m = to + 1;
92 if ( t < r ) do {
93 uu = u = t + t[1];
94 setflag = 0;
95ReSwitch:
96 switch ( *t ) {
97 case SYMBOL:
98/*
99 #[ SYMBOLS :
100*/
101 z = accu;
102 *m++ = *t++;
103 *m++ = *t++;
104 v = m;
105 while ( t < u ) {
106 *m = *t;
107 for ( si = 0; si < setflag; si += 2 ) {
108 if ( t == temp + setlist[si] ) goto sspow;
109 }
110 s = subs;
111 for ( j = 0; j < i; j++ ) {
112 if ( *t == s[2] ) {
113 if ( *s == SYMTOSYM ) {
114 *m = s[3]; dirty = 1;
115 break;
116 }
117 else if ( *s == SYMTONUM ) {
118 dirty = 1;
119 zst = z;
120 *z++ = SNUMBER;
121 *z++ = 4;
122 *z++ = s[3];
123 w = z;
124 *z++ = *++t;
125 if ( ABS(*t) >= 2*MAXPOWER) {
126DoPow: s = subs;
127 for ( j = 0; j < i; j++ ) {
128 if ( ( *s == SYMTONUM ) &&
129 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
130 dirty = 1;
131 *w = s[3];
132 if ( *t < 0 ) *w = -*w;
133 break;
134 }
135 if ( ( *s == SYMTOSYM ) &&
136 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
137 dirty = 1;
138 zz = z;
139 while ( --zz >= zst ) {
140 zz[1+FUNHEAD+ARGHEAD] = *zz;
141 }
142 w += 1+FUNHEAD+ARGHEAD;
143 *zst = EXPONENT;
144 zst[2] = DIRTYFLAG;
145 zst[FUNHEAD+ARGHEAD] = WORDDIF(z,zst)+4;
146 zst[1+FUNHEAD] = 1;
147 zst[FUNHEAD] = WORDDIF(z,zst)+4+ARGHEAD;
148 z += FUNHEAD+ARGHEAD+1;
149 *w = 1; /* exponent -> 1 */
150 *z++ = 1;
151 *z++ = 1;
152 *z++ = 3;
153 if ( *t > 0 ) {
154 *z++ = -SYMBOL;
155 *z++ = s[3];
156 }
157 else {
158 *z++ = ARGHEAD+8;
159 *z++ = 1;
160 *z++ = 8;
161 *z++ = SYMBOL;
162 *z++ = 4;
163 *z++ = s[3];
164 *z++ = 1;
165 *z++ = 1;
166 *z++ = 1;
167 *z++ = -3;
168 }
169 zst[1] = WORDDIF(z,zst);
170 break;
171 }
172 if ( *s == SYMTOSUB &&
173 ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
174MakeExp: dirty = 1;
175 zz = z;
176 while ( --zz >= zst ) {
177 zz[1+FUNHEAD+ARGHEAD] = *zz;
178 }
179 w += 1+FUNHEAD+ARGHEAD;
180 *zst = EXPONENT;
181 zst[2] = DIRTYFLAG;
182 zst[FUNHEAD+ARGHEAD] = WORDDIF(z,zst)+4;
183 zst[1+FUNHEAD] = 1;
184 zst[FUNHEAD] = WORDDIF(z,zst)+4+ARGHEAD;
185 z += FUNHEAD+ARGHEAD+1;
186 *w = 1; /* exponent -> 1 */
187 *z++ = 1;
188 *z++ = 1;
189 *z++ = 3;
190 *z++ = 4+SUBEXPSIZE+ARGHEAD;
191 *z++ = 1;
192 *z++ = 4+SUBEXPSIZE;
193 *z++ = SUBEXPRESSION;
194 *z++ = SUBEXPSIZE;
195 *z++ = s[3];
196 *z++ = 1;
197 *z++ = AT.ebufnum;
198 FILLSUB(z)
199 *z++ = 1;
200 *z++ = 1;
201 *z++ = *t > 0 ? 3: -3;
202 zst[1] = WORDDIF(z,zst);
203 break;
204 }
205 s += s[1];
206 }
207 }
208 if ( !*w ) z = w - 3;
209 t++;
210 goto Seven;
211 }
212 else if ( *s == SYMTOSUB ) {
213 dirty = 1;
214 zst = z;
215 *z++ = SUBEXPRESSION;
216 *z++ = SUBEXPSIZE;
217 *z++ = s[3];
218 w = z;
219 *z++ = *++t;
220 *z++ = AT.ebufnum;
221 FILLSUB(z)
222 goto DoPow;
223 }
224 }
225 s += s[1];
226 }
227sspow:
228 s = subs;
229 *++m = *++t;
230 for ( si = 0; si < setflag; si += 2 ) {
231 if ( t == temp + setlist[si] ) {
232 t++; m++;
233 goto Seven;
234 }
235 }
236 for ( j = 0; j < i; j++ ) {
237 if ( ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
238 if ( *s == SYMTONUM ) {
239 dirty = 1;
240 *m = s[3];
241 if ( *t < 0 ) *m = -*m;
242 break;
243 }
244 else if ( *s == SYMTOSYM ) {
245 dirty = 1;
246 *z++ = EXPONENT;
247 if ( *t < 0 ) *z++ = FUNHEAD+ARGHEAD+10;
248 else *z++ = 4+FUNHEAD;
249 *z++ = 0;
250 FILLFUN3(z)
251 *z++ = -SYMBOL;
252 *z++ = m[-1];
253 if ( *t < 0 ) {
254 *z++ = ARGHEAD+8;
255 *z++ = 0;
256 *z++ = 8;
257 *z++ = SYMBOL;
258 *z++ = 4;
259 *z++ = s[3];
260 *z++ = 1;
261 *z++ = 1;
262 *z++ = 1;
263 *z = -3;
264 }
265 else {
266 *z++ = -SYMBOL;
267 *z++ = s[3];
268 }
269 m -= 2;
270 break;
271 }
272 else if ( *s == SYMTOSUB ) {
273 zst = z;
274 *z++ = SYMBOL;
275 *z++ = 4;
276 *z++ = *--m;
277 w = z;
278 *z++ = *t;
279 goto MakeExp;
280 }
281 }
282 s += s[1];
283 }
284 t++;
285 if ( *m ) m++;
286 else m--;
287Seven:;
288 }
289 j = WORDDIF(m,v);
290 if ( !j ) m -= 2;
291 else v[-1] = j + 2;
292 s = accu;
293 while ( s < z ) *m++ = *s++;
294 break;
295/*
296 #] SYMBOLS :
297*/
298 case DOTPRODUCT:
299/*
300 #[ DOTPRODUCTS :
301*/
302 *m++ = *t++;
303 *m++ = *t++;
304 v = m;
305 z = accu;
306 while ( t < u ) {
307 *m = *t;
308 subcount = 0;
309 /* Process the first vector of the DOTPRODUCT */
310 for ( si = 0; si < setflag; si += 2 ) {
311 if ( t == temp + setlist[si] ) goto ss2;
312 }
313 s = subs;
314 for ( j = 0; j < i; j++ ) {
315 if ( *t == s[2] ) {
316 if ( *s == VECTOVEC ) {
317 *m = s[3]; dirty = 1; break;
318 }
319 if ( *s == VECTOMIN ) {
320 *m = s[3];
321 dirty = 1;
322 if ( ( ABS(t[2]) - 2*MAXPOWER ) < 0 ) {
323 /* The power is a number */
324 sgn += t[2];
325 }
326 else {
327 /* The power is a wildcard. Put a -, resolve later. */
328 sgn++;
329 }
330 break;
331 }
332 if ( *s == VECTOSUB ) {
333 *m = s[3]; dirty = 1; subcount = 1; break;
334 }
335 }
336 s += s[1];
337 }
338ss2:
339 *++m = *++t;
340 s = subs;
341 /* Process the second vector of the DOTPRODUCT */
342 for ( si = 0; si < setflag; si += 2 ) {
343 if ( t == temp + setlist[si] ) goto ss3;
344 }
345 for ( j = 0; j < i; j++ ) {
346 if ( *t == s[2] ) {
347 if ( *s == VECTOVEC ) {
348 *m = s[3]; dirty = 1; break;
349 }
350 if ( *s == VECTOMIN ) {
351 *m = s[3];
352 dirty = 1;
353 if ( ( ABS(t[1]) - 2*MAXPOWER ) < 0 ) {
354 /* The power is a number */
355 sgn += t[1];
356 }
357 else {
358 /* The power is a wildcard. Put a -, resolve later. */
359 sgn++;
360 }
361 break;
362 }
363 if ( *s == VECTOSUB ) {
364 *m = s[3]; dirty = 1; subcount += 2; break;
365 }
366 }
367 s += s[1];
368 }
369ss3: *++m = *++t;
370 /* Process the power */
371 if ( ( ABS(*t) - 2*MAXPOWER ) < 0 ) goto RegPow;
372 s = subs;
373 for ( j = 0; j < i; j++ ) {
374 if ( ( ABS(*t) - 2*MAXPOWER ) == s[2] ) {
375 if ( *s == SYMTONUM ) {
376 *m = s[3];
377 /* Since the power is a wildcard, sgn is 0,1,2 depending whether
378 there were 0,1,2 VECTOMIN in the DOTPRODUCT. Multiply by the
379 power, which is positive currently. */
380 sgn *= *m;
381 /* Now flip the sign of the power, if the wildcard came with a - */
382 if ( *t < 0 ) *m = -*m;
383 dirty = 1;
384 break;
385 }
386 if ( *s <= SYMTOSUB ) {
387/*
388 Here we put together a power function with the proper
389 arguments. Note that a p?.q? resolves to a single power.
390*/
391 m -= 2;
392 *z++ = EXPONENT;
393 w = z;
394 if ( subcount == 0 ) {
395 *z++ = 17+FUNHEAD+2*ARGHEAD;
396 *z++ = DIRTYFLAG;
397 FILLFUN3(z)
398 *z++ = 9+ARGHEAD;
399 *z++ = 0;
400 FILLARG(z)
401 *z++ = 9;
402 *z++ = DOTPRODUCT;
403 *z++ = 5;
404 *z++ = *m;
405 *z++ = m[1];
406 *z++ = 1;
407 *z++ = 1;
408 *z++ = 1;
409 *z++ = 3;
410 if ( *s == SYMTOSYM ) {
411 *z++ = 8+ARGHEAD;
412 *z++ = 0;
413 FILLARG(z)
414 *z++ = 8;
415 *z++ = SYMBOL;
416 *z++ = 4;
417 *z++ = s[3];
418 *z++ = 1;
419 }
420 else {
421 *z++ = 4+SUBEXPSIZE+ARGHEAD;
422 *z++ = 1;
423 FILLARG(z)
424 *z++ = 4+SUBEXPSIZE;
425 *z++ = SUBEXPRESSION;
426 *z++ = SUBEXPSIZE;
427 *z++ = s[3];
428 *z++ = 1;
429 *z++ = AT.ebufnum;
430 FILLSUB(z)
431 }
432 *z++ = 1; *z++ = 1;
433 *z++ = ( s[2] > 0 ) ? 3: -3;
434 }
435 else if ( subcount == 3 ) {
436 *z++ = 20+2*SUBEXPSIZE+FUNHEAD+2*ARGHEAD;
437 *z++ = DIRTYFLAG;
438 FILLFUN3(z)
439 *z++ = 12+2*SUBEXPSIZE+ARGHEAD;
440 *z++ = 1;
441 *z++ = 12+2*SUBEXPSIZE;
442 *z++ = SUBEXPRESSION;
443 *z++ = 4+SUBEXPSIZE;
444 *z++ = *m + 1;
445 *z++ = 1;
446 *z++ = AT.ebufnum;
447 FILLSUB(z)
448 *z++ = INDTOIND;
449 *z++ = 4;
450 *z++ = FUNNYVEC;
451 *z++ = ++AR.CurDum;
452
453 *z++ = SUBEXPRESSION;
454 *z++ = 4+SUBEXPSIZE;
455 *z++ = m[1] + 1;
456 *z++ = 1;
457 *z++ = AT.ebufnum;
458 FILLSUB(z)
459 *z++ = INDTOIND;
460 *z++ = 4;
461 *z++ = FUNNYVEC;
462 *z++ = AR.CurDum;
463 *z++ = 1; *z++ = 1; *z++ = 3;
464 }
465 else {
466 if ( subcount == 2 ) {
467 j = *m; *m = m[1]; m[1] = j;
468 }
469 *z++ = 16+SUBEXPSIZE+FUNHEAD+2*ARGHEAD;
470 *z++ = DIRTYFLAG;
471 FILLFUN3(z)
472 *z++ = 8+SUBEXPSIZE+ARGHEAD;
473 *z++ = 1;
474 *z++ = 8+SUBEXPSIZE;
475 *z++ = SUBEXPRESSION;
476 *z++ = 4+SUBEXPSIZE;
477 *z++ = *m + 1;
478 *z++ = 1;
479 *z++ = AT.ebufnum;
480 FILLSUB(z)
481 *z++ = INDTOIND;
482 *z++ = 4;
483 *z++ = FUNNYVEC;
484 *z++ = m[1];
485 *z++ = 1; *z++ = 1; *z++ = 3;
486 }
487 if ( *s == SYMTOSYM ) {
488 if ( s[2] > 0 ) {
489 *z++ = -SYMBOL;
490 *z++ = s[3];
491 t++;
492 *w = z-w+1;
493 goto NextDot;
494 }
495 *z++ = 8+ARGHEAD;
496 *z++ = 0;
497 *z++ = 8;
498 *z++ = SYMBOL;
499 *z++ = 4;
500 *z++ = s[3];
501 *z++ = 1;
502 }
503 else {
504 *z++ = 4+SUBEXPSIZE+ARGHEAD;
505 *z++ = 1;
506 *z++ = 4+SUBEXPSIZE;
507 *z++ = SUBEXPRESSION;
508 *z++ = SUBEXPSIZE;
509 *z++ = s[3];
510 *z++ = 1;
511 *z++ = AT.ebufnum;
512 FILLSUB(z)
513 }
514 *z++ = 1; *z++ = 1;
515 *z++ = ( s[2] > 0 ) ? 3: -3;
516 t++;
517 *w = z-w+1;
518 goto NextDot;
519 }
520 }
521 s += s[1];
522 }
523RegPow: if ( *m ) m++;
524 else { m -= 2; subcount = 0; }
525 t++;
526 if ( subcount ) {
527 m -= 3;
528 if ( subcount == 3 ) {
529 if ( m[2] < 0 ) {
530 j = (-m[2]) * (2*SUBEXPSIZE+8);
531 *z++ = DENOMINATOR;
532 *z++ = j + 8 + FUNHEAD + ARGHEAD;
533 *z++ = DIRTYFLAG;
534 FILLFUN3(z)
535 *z++ = j + 8 + ARGHEAD;
536 *z++ = 1;
537 *z++ = j + 8;
538 while ( m[2] < 0 ) {
539 (m[2])++;
540 *z++ = SUBEXPRESSION;
541 *z++ = 4+SUBEXPSIZE;
542 *z++ = *m + 1;
543 *z++ = 1;
544 *z++ = AT.ebufnum;
545 FILLSUB(z)
546 *z++ = INDTOIND;
547 *z++ = 4;
548 *z++ = FUNNYVEC;
549 *z++ = ++AR.CurDum;
550 *z++ = SUBEXPRESSION;
551 *z++ = 8+SUBEXPSIZE;
552 *z++ = m[1] + 1;
553 *z++ = 1;
554 *z++ = AT.ebufnum;
555 FILLSUB(z)
556 *z++ = INDTOIND;
557 *z++ = 4;
558 *z++ = FUNNYVEC;
559 *z++ = AR.CurDum;
560 *z++ = SYMTOSYM; /* Needed to avoid */
561 *z++ = 4; /* problems with */
562 *z++ = 1000; /* conversion to */
563 *z++ = 1000; /* square of subexp*/
564 }
565 *z++ = 1; *z++ = 1; *z++ = 3;
566 }
567 else {
568 while ( m[2] > 0 ) {
569 (m[2])--;
570 *z++ = SUBEXPRESSION;
571 *z++ = 4+SUBEXPSIZE;
572 *z++ = *m + 1;
573 *z++ = 1;
574 *z++ = AT.ebufnum;
575 FILLSUB(z)
576 *z++ = INDTOIND;
577 *z++ = 4;
578 *z++ = FUNNYVEC;
579 *z++ = ++AR.CurDum;
580 *z++ = SUBEXPRESSION;
581 *z++ = 4+SUBEXPSIZE;
582 *z++ = m[1] + 1;
583 *z++ = 1;
584 *z++ = AT.ebufnum;
585 FILLSUB(z)
586 *z++ = INDTOIND;
587 *z++ = 4;
588 *z++ = FUNNYVEC;
589 *z++ = AR.CurDum;
590 }
591 }
592 }
593 else {
594 if ( subcount == 2 ) {
595 j = *m; *m = m[1]; m[1] = j;
596 }
597 if ( m[2] < 0 ) {
598 *z++ = DENOMINATOR;
599 *z++ = 8+SUBEXPSIZE+FUNHEAD+ARGHEAD;
600 *z++ = DIRTYFLAG;
601 FILLFUN3(z)
602 *z++ = 8+SUBEXPSIZE+ARGHEAD;
603 *z++ = 1;
604 *z++ = 8+SUBEXPSIZE;
605 }
606 *z++ = SUBEXPRESSION;
607 *z++ = 4+SUBEXPSIZE;
608 *z++ = *m + 1;
609 *z++ = ABS(m[2]);
610 *z++ = AT.ebufnum;
611 FILLSUB(z)
612 *z++ = INDTOIND;
613 *z++ = 4;
614 *z++ = FUNNYVEC;
615 *z++ = m[1];
616 if ( m[2] < 0 ) {
617 *z++ = 1; *z++ = 1; *z++ = 3;
618 }
619 }
620 }
621NextDot:;
622 }
623 if ( m <= v ) m = v - 2;
624 else v[-1] = WORDDIF(m,v) + 2;
625 if ( z > accu ) {
626 j = WORDDIF(z,accu);
627 z = accu;
628 NCOPY(m,z,j);
629 }
630 break;
631/*
632 #] DOTPRODUCTS :
633*/
634 case SETSET:
635/*
636 #[ SETS :
637*/
638 temp = accu + (((AR.ComprTop - accu)>>1)&(-2));
639 if ( ResolveSet(BHEAD t,temp,sub) ) {
640 Terminate(-1);
641 }
642 setlist = t + 2 + t[3];
643 setflag = t[1] - 2 - t[3]; /* Number of elements * 2 */
644 t = temp; u = t + t[1];
645 goto ReSwitch;
646/*
647 #] SETS :
648*/
649 case VECTOR:
650/*
651 #[ VECTORS :
652*/
653 *m++ = *t++;
654 *m++ = *t++;
655 v = m;
656 z = accu;
657 while ( t < u ) {
658 *m = *t;
659 for ( si = 0; si < setflag; si += 2 ) {
660 if ( t == temp + setlist[si] ) goto ss4;
661 }
662 s = subs;
663 for ( j = 0; j < i; j++ ) {
664 if ( *t == s[2] ) {
665 if ( *s == INDTOIND || *s == VECTOVEC ) {
666 *m = s[3]; dirty = 1; break;
667 }
668 if ( *s == VECTOMIN ) {
669 *m = s[3]; dirty = 1; sgn++; break;
670 }
671 else if ( *s == VECTOSUB ) {
672 *z++ = SUBEXPRESSION;
673 *z++ = 4+SUBEXPSIZE;
674 *z++ = s[3]+1;
675 *z++ = 1;
676 *z++ = AT.ebufnum;
677 FILLSUB(z)
678 *z++ = VECTOVEC;
679 *z++ = 4;
680 *z++ = FUNNYVEC;
681 *z++ = *++t;
682 m--;
683 s = subs;
684 for ( j = 0; j < i; j++ ) {
685 if ( z[-1] == s[2] ) {
686 if ( *s == INDTOIND || *s == VECTOVEC ) {
687 z[-1] = s[3];
688 break;
689 }
690 if ( *s == INDTOSUB || *s == VECTOSUB ) {
691 z[-1] = ++AR.CurDum;
692 *z++ = SUBEXPRESSION;
693 *z++ = 4+SUBEXPSIZE;
694 *z++ = s[3]+1;
695 *z++ = 1;
696 *z++ = AT.ebufnum;
697 FILLSUB(z)
698 if ( *s == INDTOSUB ) *z++ = INDTOIND;
699 else *z++ = VECTOSUB;
700 *z++ = 4;
701 *z++ = FUNNYVEC;
702 *z++ = AR.CurDum;
703 break;
704 }
705 }
706 s += s[1];
707 }
708 dirty = 1;
709 break;
710 }
711 else if ( *s == INDTOSUB ) {
712 *z++ = SUBEXPRESSION;
713 *z++ = 4+SUBEXPSIZE;
714 *z++ = s[3]+1;
715 *z++ = 1;
716 *z++ = AT.ebufnum;
717 FILLSUB(z)
718 *z++ = INDTOIND;
719 *z++ = 4;
720 *z++ = FUNNYVEC;
721 m -= 2;
722 *z++ = m[1];
723 dirty = 1;
724 t++;
725 break;
726 }
727 }
728 s += s[1];
729 }
730ss4: m++; t++;
731 }
732 if ( m <= v ) m = v-2;
733 else v[-1] = WORDDIF(m,v)+2;
734 if ( z > accu ) {
735 j = WORDDIF(z,accu); z = accu;
736 NCOPY(m,z,j);
737 }
738 break;
739/*
740 #] VECTORS :
741*/
742 case INDEX:
743/*
744 #[ INDEX :
745*/
746 *m++ = *t++;
747 *m++ = *t++;
748 v = m;
749 z = accu;
750 while ( t < u ) {
751 *m = *t;
752 for ( si = 0; si < setflag; si += 2 ) {
753 if ( t == temp + setlist[si] ) goto ss5;
754 }
755 s = subs;
756 for ( j = 0; j < i; j++ ) {
757 if ( *t == s[2] ) {
758 if ( *s == INDTOIND || *s == VECTOVEC )
759 { *m = s[3]; dirty = 1; break; }
760 if ( *s == VECTOMIN )
761 { *m = s[3]; dirty = 1; sgn++; break; }
762 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
763 *z++ = SUBEXPRESSION;
764 *z++ = SUBEXPSIZE;
765 *z++ = s[3];
766 *z++ = 1;
767 *z++ = AT.ebufnum;
768 FILLSUB(z)
769 m--;
770 dirty = 1;
771 break;
772 }
773 }
774 s += s[1];
775 }
776ss5: m++; t++;
777 }
778 if ( m <= v ) m = v-2;
779 else v[-1] = WORDDIF(m,v)+2;
780 if ( z > accu ) {
781 j = WORDDIF(z,accu); z = accu;
782 NCOPY(m,z,j);
783 }
784 break;
785/*
786 #] INDEX :
787*/
788 case DELTA:
789 case LEVICIVITA:
790 case GAMMA:
791/*
792 #[ SPECIALS :
793*/
794 v = m;
795 *m++ = *t++;
796 *m++ = *t++;
797#if FUNHEAD > 2
798 if ( t[-2] != DELTA ) *m++ = *t++;
799#endif
800Tensors:
801 COPYFUN3(m,t)
802 z = accu;
803 while ( t < u ) {
804 *m = *t;
805 for ( si = 0; si < setflag; si += 2 ) {
806 if ( t == temp + setlist[si] ) goto ss6;
807 }
808 s = subs;
809 if ( *m == FUNNYWILD ) {
810 CBUF *C = cbuf+AT.ebufnum;
811 t++;
812 for ( j = 0; j < i; j++ ) {
813 if ( *s == ARGTOARG && *t == s[2] ) {
814 v[2] |= DIRTYFLAG;
815 if ( s[3] < 0 ) { /* empty */
816 t++; break;
817 }
818 w = C->rhs[s[3]];
819DEBUG(MesPrint("Thread %w(a): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
820 j = *w++;
821 if ( j > 0 ) {
822 NCOPY(m,w,j);
823 }
824 else {
825 while ( *w ) {
826 if ( *w == -INDEX || *w == -VECTOR
827 || *w == -MINVECTOR
828 || ( *w == -SNUMBER && w[1] >= 0
829 && w[1] < AM.OffsetIndex ) ) {
830 if ( *w == -MINVECTOR ) sgn++;
831 w++;
832 *m++ = *w++;
833 }
834 else {
835 MLOCK(ErrorMessageLock);
836DEBUG(MesPrint("Thread %w(aa): *w = %d",*w);)
837 MesPrint("Illegal substitution of argument field in tensor");
838 MUNLOCK(ErrorMessageLock);
839 SETERROR(-1)
840 }
841 }
842 }
843 t++;
844 break;
845 }
846 s += s[1];
847 }
848 }
849 else {
850 for ( j = 0; j < i; j++ ) {
851 if ( *t == s[2] ) {
852 if ( *s == INDTOIND || *s == VECTOVEC )
853 { *m = s[3]; dirty = 1; break; }
854 if ( *s == VECTOMIN )
855 { *m = s[3]; dirty = 1; sgn++; break; }
856 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
857 *m = ++AR.CurDum;
858 *z++ = SUBEXPRESSION;
859 *z++ = 4+SUBEXPSIZE;
860 *z++ = s[3]+1;
861 *z++ = 1;
862 *z++ = AT.ebufnum;
863 FILLSUB(z)
864 *z++ = INDTOIND;
865 *z++ = 4;
866 *z++ = FUNNYVEC;
867 *z++ = AR.CurDum;
868 dirty = 1;
869 break;
870 }
871 }
872 s += s[1];
873 }
874 if ( j < i && *v != DELTA ) v[2] |= DIRTYFLAG;
875ss6: m++; t++;
876 }
877 }
878 v[1] = WORDDIF(m,v);
879 if ( z > accu ) {
880 j = WORDDIF(z,accu); z = accu;
881 NCOPY(m,z,j);
882 }
883 break;
884/*
885 #] SPECIALS :
886*/
887 case SUBEXPRESSION:
888/*
889 #[ SUBEXPRESSION :
890*/
891 dirty = 1;
892 tstop = t + t[1];
893 *m++ = *t++;
894 *m++ = *t++;
895 *m++ = *t++;
896 *m++ = *t++;
897 if ( t[-1] >= 2*MAXPOWER || t[-1] <= -2*MAXPOWER ) {
898 s = subs;
899 for ( j = 0; j < i; j++ ) {
900 if ( *s == SYMTONUM &&
901 ( ABS(t[-1]) - 2*MAXPOWER ) == s[2] ) {
902 m[-1] = s[3];
903 if ( t[-1] < 0 ) m[-1] = -m[-1];
904 break;
905 }
906 s += s[1];
907 }
908 }
909 *m++ = *t++;
910 COPYSUB(m,t)
911 while ( t < tstop ) {
912 for ( si = 0; si < setflag; si += 2 ) {
913 if ( t == temp + setlist[si] - 2 ) goto ss7;
914 }
915 s = subs;
916 for ( j = 0; j < i; j++ ) {
917 if ( s[2] == t[2] ) {
918 if ( ( *s <= SYMTOSUB && *t <= SYMTOSUB )
919 || ( *s == *t && *s < FROMBRAC )
920 || ( *s == VECTOVEC && ( *t == VECTOSUB || *t == VECTOMIN ) )
921 || ( *s == VECTOSUB && ( *t == VECTOVEC || *t == VECTOMIN ) )
922 || ( *s == VECTOMIN && ( *t == VECTOSUB || *t == VECTOVEC ) )
923 || ( *s == INDTOIND && *t == INDTOSUB )
924 || ( *s == INDTOSUB && *t == INDTOIND ) ) {
925 WORD *vv = m;
926/* *t = *s; Wrong!!! Overwrites compiler buffer */
927 j = t[1];
928 NCOPY(m,t,j);
929 vv[0] = s[0];
930 vv[3] = s[3];
931 goto sr7;
932 }
933 }
934 s += s[1];
935 }
936ss7: j = t[1];
937 NCOPY(m,t,j);
938sr7:;
939 }
940 break;
941/*
942 #] SUBEXPRESSION :
943*/
944 case EXPRESSION:
945/*
946 #[ EXPRESSION :
947*/
948 dirty = 1;
949 tstop = t + t[1];
950 v = m;
951 *m++ = *t++;
952 *m++ = *t++;
953 *m++ = *t++;
954 *m++ = *t++;
955 s = subs;
956 for ( j = 0; j < i; j++ ) {
957 if ( ( ABS(t[-1]) - 2*MAXPOWER ) == s[2] ) {
958 if ( *s == SYMTONUM ) {
959 m[-1] = s[3];
960 if ( t[-1] < 0 ) m[-1] = -m[-1];
961 break;
962 }
963 else if ( *s <= SYMTOSUB ) {
964 MLOCK(ErrorMessageLock);
965 MesPrint("Wildcard power of expression should be a number");
966 MUNLOCK(ErrorMessageLock);
967 SETERROR(-1)
968 }
969 }
970 s += s[1];
971 }
972 *m++ = *t++;
973 COPYSUB(m,t)
974 while ( t < tstop && *t != WILDCARDS ) {
975 j = t[1];
976 NCOPY(m,t,j);
977 }
978 if ( t < tstop && *t == WILDCARDS ) {
979 *m++ = *t;
980 s = sub;
981 j = s[1];
982 *m++ = j+2;
983 NCOPY(m,s,j);
984 t += t[1];
985 }
986 if ( t < tstop && *t == FROMBRAC ) {
987 w = m;
988 *m++ = *t;
989 *m++ = t[1];
990 if ( WildFill(BHEAD m,t+2,sub) < 0 ) {
991 MLOCK(ErrorMessageLock);
992 MesCall("WildFill");
993 MUNLOCK(ErrorMessageLock);
994 SETERROR(-1)
995 }
996 m += *m;
997 w[1] = m - w;
998 t += t[1];
999 }
1000 while ( t < tstop ) {
1001 j = t[1];
1002 NCOPY(m,t,j);
1003 }
1004 v[1] = m-v;
1005 break;
1006/*
1007 #] EXPRESSION :
1008*/
1009 default:
1010/*
1011 #[ FUNCTIONS :
1012*/
1013 if ( *t >= FUNCTION ) {
1014 dflag = 0;
1015 na = 0;
1016 *m = *t;
1017 for ( si = 0; si < setflag; si += 2 ) {
1018 if ( t == temp + setlist[si] ) {
1019 dflag = DIRTYFLAG; goto ss8;
1020 }
1021 }
1022 s = subs;
1023 for ( j = 0; j < i; j++ ) {
1024 if ( *s == FUNTOFUN && *t == s[2] )
1025 { *m = s[3]; dirty = 1; dflag = DIRTYFLAG; break; }
1026 s += s[1];
1027 }
1028ss8: v = m;
1029 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec
1030 >= TENSORFUNCTION ) {
1031 if ( *m < FUNCTION || functions[*m-FUNCTION].spec
1032 < TENSORFUNCTION ) {
1033 MLOCK(ErrorMessageLock);
1034 MesPrint("Illegal wildcarding of regular function to tensorfunction");
1035 MUNLOCK(ErrorMessageLock);
1036 SETERROR(-1)
1037 }
1038 m++; t++;
1039 *m++ = *t++;
1040 *m++ = *t++ | dflag;
1041 goto Tensors;
1042 }
1043 m++; t++;
1044 *m++ = *t++;
1045 *m++ = *t++ | dflag;
1046 COPYFUN3(m,t)
1047 z = accu;
1048 while ( t < u ) { /* do an argument */
1049 if ( *t < 0 ) {
1050/*
1051 #[ Simple arguments :
1052*/
1053 CBUF *C = cbuf+AT.ebufnum;
1054 for ( si = 0; si < setflag; si += 2 ) {
1055 if ( *t <= -FUNCTION ) {
1056 if ( t == temp + setlist[si] ) {
1057 v[2] |= DIRTYFLAG; goto ss10; }
1058 }
1059 else {
1060 if ( t == temp + setlist[si]-1 ) {
1061 v[2] |= DIRTYFLAG; goto ss9; }
1062 }
1063 }
1064 if ( *t == -ARGWILD ) {
1065 s = subs;
1066 for ( j = 0; j < i; j++ ) {
1067 if ( *s == ARGTOARG && s[2] == t[1] ) break;
1068 s += s[1];
1069 }
1070 v[2] |= DIRTYFLAG;
1071 w = C->rhs[s[3]];
1072DEBUG(MesPrint("Thread %w(b): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
1073 if ( *w == 0 ) {
1074 w++;
1075 while ( *w ) {
1076 if ( *w > 0 ) j = *w;
1077 else if ( *w <= -FUNCTION ) j = 1;
1078 else j = 2;
1079 NCOPY(m,w,j);
1080 }
1081 }
1082 else {
1083 j = *w++;
1084 while ( --j >= 0 ) {
1085 if ( *w < MINSPEC ) *m++ = -VECTOR;
1086 else if ( *w >= 0 && *w < AM.OffsetIndex )
1087 *m++ = -SNUMBER;
1088 else *m++ = -INDEX;
1089 *m++ = *w++;
1090 }
1091 }
1092 t += 2;
1093 dirty = 1;
1094 if ( ( *v == NUMARGSFUN || *v == NUMTERMSFUN )
1095 && t >= u && m == v + FUNHEAD ) {
1096 m = v;
1097 *m++ = SNUMBER; *m++ = 3; *m++ = 0;
1098 break;
1099 }
1100 }
1101 else if ( *t <= -FUNCTION ) {
1102 *m = *t;
1103 s = subs;
1104 for ( j = 0; j < i; j++ ) {
1105 if ( -*t == s[2] ) {
1106 if ( *s == FUNTOFUN )
1107 { *m = -s[3]; dirty = 1; v[2] |= DIRTYFLAG; break; }
1108 }
1109 s += s[1];
1110 }
1111 m++; t++;
1112 }
1113 else if ( *t == -SYMBOL ) {
1114 *m++ = *t++;
1115 *m = *t;
1116 s = subs;
1117 for ( j = 0; j < i; j++ ) {
1118 if ( *t == s[2] && *s <= SYMTOSUB ) {
1119 dirty = 1; v[2] |= DIRTYFLAG;
1120 if ( AR.PolyFunType == 2 && v[0] == AR.PolyFun )
1121 v[2] |= MUSTCLEANPRF;
1122 if ( *s == SYMTOSYM ) *m = s[3];
1123 else if ( *s == SYMTONUM ) {
1124 m[-1] = -SNUMBER;
1125 *m = s[3];
1126 }
1127 else if ( *s == SYMTOSUB ) {
1128ToSub: m--;
1129 w = C->rhs[s[3]];
1130DEBUG(MesPrint("Thread %w(c): s[3] = %d, w=(%d,%d,%d,%d)",s[3],w[0],w[1],w[2],w[3]);)
1131 s = m;
1132 m += 2;
1133 while ( *w ) {
1134 j = *w;
1135 NCOPY(m,w,j);
1136 }
1137 *s = WORDDIF(m,s);
1138 s[1] = 0;
1139 *m = 0;
1140 if ( t[-1] == -MINVECTOR ) {
1141 w = s+2;
1142 while ( *w ) {
1143 w += *w;
1144 w[-1] = -w[-1];
1145 }
1146 }
1147 if ( ToFast(s,s) ) {
1148 if ( *s <= -FUNCTION ) m = s;
1149 else m = s + 1;
1150 }
1151 else m--;
1152 }
1153 break;
1154 }
1155 s += s[1];
1156 }
1157 m++; t++;
1158 }
1159 else if ( *t == -INDEX ) {
1160 *m++ = *t++;
1161 *m = *t;
1162 s = subs;
1163 for ( j = 0; j < i; j++ ) {
1164 if ( *t == s[2] ) {
1165 if ( *s == INDTOIND || *s == VECTOVEC ) {
1166 *m = s[3];
1167 if ( *m < MINSPEC ) m[-1] = -VECTOR;
1168 else if ( *m >= 0 && *m < AM.OffsetIndex )
1169 m[-1] = -SNUMBER;
1170 else m[-1] = -INDEX;
1171 }
1172 else if ( *s == VECTOSUB || *s == INDTOSUB ) {
1173 m[-1] = -INDEX;
1174 *m = ++AR.CurDum;
1175 *z++ = SUBEXPRESSION;
1176 *z++ = 4+SUBEXPSIZE;
1177 *z++ = s[3]+1;
1178 *z++ = 1;
1179 *z++ = AT.ebufnum;
1180 FILLSUB(z)
1181 *z++ = INDTOIND;
1182 *z++ = 4;
1183 *z++ = FUNNYVEC;
1184 *z++ = AR.CurDum;
1185 }
1186 v[2] |= DIRTYFLAG; dirty = 1;
1187 break;
1188 }
1189 s += s[1];
1190 }
1191 m++; t++;
1192 }
1193 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
1194 *m++ = *t++;
1195 *m = *t;
1196 s = subs;
1197 for ( j = 0; j < i; j++ ) {
1198 if ( *t == s[2] ) {
1199 if ( *s == VECTOVEC ) *m = s[3];
1200 else if ( *s == VECTOMIN ) {
1201 *m = s[3];
1202 if ( t[-1] == -VECTOR )
1203 m[-1] = -MINVECTOR;
1204 else
1205 m[-1] = -VECTOR;
1206 }
1207 else if ( *s == VECTOSUB ) goto ToSub;
1208 dirty = 1; v[2] |= DIRTYFLAG;
1209 break;
1210 }
1211 s += s[1];
1212 }
1213 m++; t++;
1214 }
1215 else if ( *t == -SNUMBER ) {
1216 *m++ = *t++;
1217 *m = *t;
1218 s = subs;
1219 for ( j = 0; j < i; j++ ) {
1220 if ( *t == s[2] && *s >= NUMTONUM && *s <= NUMTOSUB ) {
1221 dirty = 1; v[2] |= DIRTYFLAG;
1222 if ( *s == NUMTONUM ) *m = s[3];
1223 else if ( *s == NUMTOSYM ) {
1224 m[-1] = -SYMBOL;
1225 *m = s[3];
1226 }
1227 else if ( *s == NUMTOIND ) {
1228 m[-1] = -INDEX;
1229 *m = s[3];
1230 }
1231 else if ( *s == NUMTOSUB ) goto ToSub;
1232 break;
1233 }
1234 s += s[1];
1235 }
1236 m++; t++;
1237 }
1238 else {
1239ss9: *m++ = *t++;
1240ss10: *m++ = *t++;
1241 }
1242 na = WORDDIF(z,accu);
1243/*
1244 #] Simple arguments :
1245*/
1246 }
1247 else {
1248 w = m;
1249 zz = t;
1250 NEXTARG(zz)
1251 odirt = AN.WildDirt; AN.WildDirt = 0;
1252 AR.CompressPointer = accu + na;
1253 for ( j = 0; j < ARGHEAD; j++ ) *m++ = *t++;
1254 j = 0;
1255 adirt = 0;
1256 while ( t < zz ) { /* do a term */
1257 if ( ( len = WildFill(BHEAD m,t,sub) ) < 0 ) {
1258 MLOCK(ErrorMessageLock);
1259 MesCall("WildFill");
1260 MUNLOCK(ErrorMessageLock);
1261 SETERROR(-1)
1262 }
1263 if ( AN.WildDirt ) {
1264 adirt = AN.WildDirt;
1265 AN.WildDirt = 0;
1266 }
1267 m += len;
1268 t += *t;
1269 }
1270 *w = WORDDIF(m,w); /* Fill parameter length */
1271 if ( adirt ) {
1272 dirty = w[1] = 1; v[2] |= DIRTYFLAG;
1273 if ( AR.PolyFunType == 2 && v[0] == AR.PolyFun )
1274 v[2] |= MUSTCLEANPRF;
1275 AN.WildDirt = adirt;
1276 }
1277 else {
1278 AN.WildDirt = odirt;
1279 }
1280 if ( ToFast(w,w) ) {
1281 if ( *w <= -FUNCTION ) {
1282 if ( *w == NUMARGSFUN || *w == NUMTERMSFUN ) {
1283 *w = -SNUMBER; w[1] = 0; m = w + 2;
1284 }
1285 else m = w+1;
1286 }
1287 else m = w+2;
1288 }
1289 AR.CompressPointer = oldcpointer;
1290 }
1291 }
1292 v[1] = WORDDIF(m,v); /* Fill function length */
1293 s = accu;
1294 NCOPY(m,s,na);
1295/*
1296 Now some code to speed up a few special cases
1297*/
1298 if ( v[0] == EXPONENT ) {
1299 if ( v[1] == FUNHEAD+4 && v[FUNHEAD] == -SYMBOL &&
1300 v[FUNHEAD+2] == -SNUMBER && v[FUNHEAD+3] < MAXPOWER
1301 && v[FUNHEAD+3] > -MAXPOWER ) {
1302 v[0] = SYMBOL;
1303 v[1] = 4;
1304 v[2] = v[FUNHEAD+1];
1305 v[3] = v[FUNHEAD+3];
1306 m = v+4;
1307 }
1308 else if ( v[1] == FUNHEAD+ARGHEAD+11
1309 && v[FUNHEAD] == ARGHEAD+9
1310 && v[FUNHEAD+ARGHEAD] == 9
1311 && v[FUNHEAD+ARGHEAD+1] == DOTPRODUCT
1312 && v[FUNHEAD+ARGHEAD+8] == 3
1313 && v[FUNHEAD+ARGHEAD+7] == 1
1314 && v[FUNHEAD+ARGHEAD+6] == 1
1315 && v[FUNHEAD+ARGHEAD+5] == 1
1316 && v[FUNHEAD+ARGHEAD+9] == -SNUMBER
1317 && v[FUNHEAD+ARGHEAD+10] < MAXPOWER
1318 && v[FUNHEAD+ARGHEAD+10] > -MAXPOWER ) {
1319 v[0] = DOTPRODUCT;
1320 v[1] = 5;
1321 v[2] = v[FUNHEAD+ARGHEAD+3];
1322 v[3] = v[FUNHEAD+ARGHEAD+4];
1323 v[4] = v[FUNHEAD+ARGHEAD+10];
1324 m = v+5;
1325 }
1326 }
1327 }
1328 else { while ( t < u ) *m++ = *t++; }
1329/*
1330 #] FUNCTIONS :
1331*/
1332 }
1333 t = uu;
1334 } while ( t < r );
1335 t = from; /* Copy coefficient */
1336 t += *t;
1337 if ( r < t ) do { *m++ = *r++; } while ( r < t );
1338 if ( ( sgn & 1 ) != 0 ) m[-1] = -m[-1];
1339 *to = WORDDIF(m,to);
1340 if ( dirty ) AN.WildDirt = dirty;
1341 return(*to);
1342}
1343
1344/*
1345 #] WildFill :
1346 #[ ResolveSet : WORD ResolveSet(from,to,subs)
1347
1348 The set syntax is:
1349 SET,length,subterm,where,whichmember[,where,whichmember]
1350
1351 setlength is 2*n+1 with n the number of set substitutions.
1352 length = setlength + subtermlength + 2
1353
1354 At `where' is the number of the set and `whichmember' is the
1355 number of the element. This is still a symbol/dollar and we
1356 have to find the substitution in the wildcards.
1357 The output is the subterm in which the setelements have been
1358 substituted. This is ready for further wildcard substitutions.
1359*/
1360
1361int ResolveSet(PHEAD WORD *from, WORD *to, WORD *subs)
1362{
1363 GETBIDENTITY
1364 WORD *m, *s, *w, j, i, ii, i3, flag, num;
1365 DOLLARS d = 0;
1366#ifdef WITHPTHREADS
1367 int nummodopt, dtype = -1;
1368#endif
1369 m = to; /* pointer in output */
1370 s = from + 2;
1371 w = s + s[1];
1372 while ( s < w ) *m++ = *s++;
1373 j = (from[1] - WORDDIF(w,from) ) >> 1;
1374 m = subs + subs[1];
1375 subs += SUBEXPSIZE;
1376 s = subs;
1377 i = 0;
1378 while ( s < m ) { i++; s += s[1]; }
1379 m = to;
1380 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1381 >= TENSORFUNCTION ) flag = 0;
1382 else flag = 1;
1383 while ( --j >= 0 ) {
1384 if ( w[1] >= 0 ) {
1385 s = subs;
1386 for ( ii = 0; ii < i; ii++ ) {
1387 if ( *s == SYMTONUM && s[2] == w[1] ) { num = s[3]; goto GotOne; }
1388 s += s[1];
1389 }
1390 MLOCK(ErrorMessageLock);
1391 MesPrint(" Unresolved setelement during substitution");
1392 MUNLOCK(ErrorMessageLock);
1393 return(-1);
1394 }
1395 else { /* Dollar ! */
1396 d = Dollars - w[1];
1397#ifdef WITHPTHREADS
1398 if ( AS.MultiThreaded ) {
1399 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1400 if ( -w[1] == ModOptdollars[nummodopt].number ) break;
1401 }
1402 if ( nummodopt < NumModOptdollars ) {
1403 dtype = ModOptdollars[nummodopt].type;
1404 if ( DollarLocalCopy(dtype) ) {
1405 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1406 }
1407 else {
1408 LOCK(d->pthreadslock);
1409 }
1410 }
1411 }
1412#endif
1413 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
1414 if ( d->where[0] == 4 && d->where[3] == 3 && d->where[2] == 1
1415 && d->where[1] > 0 && d->where[4] == 0 ) {
1416 num = d->where[1]; goto GotOne;
1417 }
1418 }
1419 else if ( d->type == DOLINDEX ) {
1420 if ( d->index > 0 && d->index < AM.OffsetIndex ) {
1421 num = d->index; goto GotOne;
1422 }
1423 }
1424 else if ( d->type == DOLARGUMENT ) {
1425 if ( d->where[0] == -SNUMBER && d->where[1] > 0 ) {
1426 num = d->where[1]; goto GotOne;
1427 }
1428 }
1429 else if ( d->type == DOLWILDARGS ) {
1430 if ( d->where[0] == 1 &&
1431 d->where[1] > 0 && d->where[1] < AM.OffsetIndex ) {
1432 num = d->where[1]; goto GotOne;
1433 }
1434 if ( d->where[0] == 0 && d->where[1] < 0 && d->where[3] == 0 ) {
1435 if ( ( d->where[1] == -SNUMBER && d->where[2] > 0 )
1436 || ( d->where[1] == -INDEX && d->where[2] > 0
1437 && d->where[2] < AM.OffsetIndex ) ) {
1438 num = d->where[2]; goto GotOne;
1439 }
1440 }
1441 }
1442#ifdef WITHPTHREADS
1443 if ( dtype > 0 && ! DollarLocalCopy(dtype) ) { UNLOCK(d->pthreadslock); }
1444#endif
1445 MLOCK(ErrorMessageLock);
1446 MesPrint("Unusable type of variable $%s in set substitution",
1447 AC.dollarnames->namebuffer+d->name);
1448 MUNLOCK(ErrorMessageLock);
1449 return(-1);
1450 }
1451GotOne:;
1452#ifdef WITHPTHREADS
1453 if ( dtype > 0 && ! DollarLocalCopy(dtype) ) { UNLOCK(d->pthreadslock); }
1454#endif
1455 ii = m[*w];
1456 if ( ii >= 2*MAXPOWER ) i3 = ii - 2*MAXPOWER;
1457 else if ( ii <= -2*MAXPOWER ) i3 = -ii - 2*MAXPOWER;
1458 else i3 = ( ii >= 0 ) ? ii: -ii - 1;
1459
1460 if ( num > ( Sets[i3].last - Sets[i3].first ) || num <= 0 ) {
1461 MLOCK(ErrorMessageLock);
1462 MesPrint("Array bound check during set substitution");
1463 MesPrint(" value is %d",num);
1464 MUNLOCK(ErrorMessageLock);
1465 return(-1);
1466 }
1467 m[*w] = (SetElements+Sets[i3].first)[num-1];
1468 if ( Sets[i3].type == CSYMBOL && m[*w] > MAXPOWER ) {
1469 if ( ii >= 2*MAXPOWER ) m[*w] -= 2*MAXPOWER;
1470 else if ( ii <= -2*MAXPOWER ) m[*w] = -(m[*w] - 2*MAXPOWER);
1471 else {
1472 m[*w] -= MAXPOWER;
1473 if ( m[*w] < MAXPOWER ) m[*w] -= 2*MAXPOWER;
1474 if ( flag ) MakeDirty(m,m+*w,1);
1475 }
1476 }
1477 else if ( Sets[i3].type == CSYMBOL ) {
1478 if ( ii >= 2*MAXPOWER ) m[*w] += 2*MAXPOWER;
1479 else if ( ii <= -2*MAXPOWER ) m[*w] = -m[*w] - 2*MAXPOWER;
1480 else if ( ii < 0 ) m[*w] = - m[*w];
1481 }
1482 else if ( ii < 0 ) m[*w] = - m[*w];
1483 w += 2;
1484 }
1485 m = to;
1486 if ( *m >= FUNCTION && functions[*m-FUNCTION].spec
1487 >= TENSORFUNCTION ) {
1488 w = from + 2 + from[3];
1489 if ( *w == 0 ) { /* We had function -> tensor */
1490 m = from + 2 + FUNHEAD; s = to + FUNHEAD;
1491 while ( m < w ) {
1492 if ( *m == -INDEX || *m == -VECTOR ) {}
1493 else if ( *m == -ARGWILD ) { *s++ = FUNNYWILD; }
1494 else {
1495 MLOCK(ErrorMessageLock);
1496 MesPrint("Illegal argument in tensor after set substitution");
1497 MUNLOCK(ErrorMessageLock);
1498 SETERROR(-1)
1499 }
1500 *s++ = m[1];
1501 m += 2;
1502 }
1503 to[1] = WORDDIF(s,to);
1504 }
1505 }
1506 return(0);
1507}
1508
1509/*
1510 #] ResolveSet :
1511 #[ ClearWild : void ClearWild()
1512
1513 Clears the current wildcard settings and makes them ready for
1514 CheckWild and AddWild.
1515
1516*/
1517
1518void ClearWild(PHEAD0)
1519{
1520 GETBIDENTITY
1521 WORD n, nn, *w;
1522 n = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4; /* Number of wildcards */
1523 AN.NumWild = nn = n;
1524 if ( n > 0 ) {
1525 w = AT.WildMask;
1526 do { *w++ = 0; } while ( --n > 0 );
1527 w = AN.WildValue;
1528 do {
1529 if ( *w == SYMTONUM ) *w = SYMTOSYM;
1530 w += w[1];
1531 } while ( --nn > 0 );
1532 }
1533}
1534
1535/*
1536 #] ClearWild :
1537 #[ AddWild : WORD AddWild(oldnumber,type,newnumber)
1538
1539 Adds a wildcard assignment.
1540 Extra parameter in AN.argaddress;
1541
1542*/
1543
1544int AddWild(PHEAD WORD oldnumber, WORD type, WORD newnumber)
1545{
1546 GETBIDENTITY
1547 WORD *w, *m, n, k, i = -1;
1548 CBUF *C = cbuf+AT.ebufnum;
1549 WORD eattensor = type & EATTENSOR;
1550 type = type & ~EATTENSOR;
1551DEBUG(WORD *mm;)
1552 AN.WildReserve = 0;
1553 m = AT.WildMask;
1554 w = AN.WildValue;
1555 n = AN.NumWild;
1556 if ( n <= 0 ) { return(-1); }
1557 if ( type <= SYMTOSUB ) {
1558 do {
1559 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1560 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1561 *w = type;
1562 if ( *m != 2 ) *m = 1;
1563 if ( type != SYMTOSUB ) {
1564 if ( type == SYMTONUM ) AN.MaskPointer = m;
1565 w[3] = newnumber;
1566 goto FlipOn;
1567 }
1568 m = AddRHS(AT.ebufnum,1);
1569 w[3] = C->numrhs;
1570 w = AN.argaddress;
1571DEBUG(mm = m;)
1572 n = *w - ARGHEAD;
1573 w += ARGHEAD;
1574 while ( (m + n + 10) > C->Top ) m = DoubleCbuffer(AT.ebufnum,m,4);
1575 while ( --n >= 0 ) *m++ = *w++;
1576 *m++ = 0;
1577 C->rhs[C->numrhs+1] = m;
1578DEBUG(MesPrint("Thread %w(d): m=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1579 C->Pointer = m;
1580 goto FlipOn;
1581 }
1582 m++; w += w[1];
1583 } while ( --n > 0 );
1584 }
1585 else if ( type == ARGTOARG ) {
1586 do {
1587 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1588 *m = 1;
1589 m = AddRHS(AT.ebufnum,1);
1590 w[3] = C->numrhs;
1591 w = AN.argaddress;
1592DEBUG(mm=m;)
1593 if ( eattensor ) {
1594 n = newnumber;
1595 *m++ = n;
1596 w = AN.argaddress;
1597 }
1598 else {
1599 while ( --newnumber >= 0 ) { NEXTARG(w) }
1600 n = WORDDIF(w,AN.argaddress);
1601 w = AN.argaddress;
1602 *m++ = 0;
1603 }
1604 while ( (m + n + 10) > C->Top ) m = DoubleCbuffer(AT.ebufnum,m,5);
1605DEBUG(if ( mm != m-1 ) MesPrint("Thread %w(e): Alarm!"); mm = m-1;)
1606 while ( --n >= 0 ) *m++ = *w++;
1607 *m++ = 0;
1608 C->rhs[C->numrhs+1] = m;
1609 C->Pointer = m;
1610DEBUG(MesPrint("Thread %w(e): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1611 return(0);
1612 }
1613 m++; w += w[1];
1614 } while ( --n > 0 );
1615 }
1616 else if ( type == ARLTOARL ) {
1617 do {
1618 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1619 WORD **a;
1620 *m = 1;
1621 m = AddRHS(AT.ebufnum,1);
1622 w[3] = C->numrhs;
1623DEBUG(mm=m;)
1624 a = (WORD **)(AN.argaddress); n = 0; k = newnumber;
1625 while ( --newnumber >= 0 ) {
1626 w = *a++;
1627 if ( *w > 0 ) n += *w;
1628 else if ( *w <= -FUNCTION ) n++;
1629 else n += 2;
1630 }
1631 *m++ = 0;
1632 while ( (m + n + 10) > C->Top ) m = DoubleCbuffer(AT.ebufnum,m,6);
1633DEBUG(if ( mm != m-1 ) MesPrint("Thread %w(f): Alarm!"); mm = m-1;)
1634 a = (WORD **)(AN.argaddress);
1635 while ( --k >= 0 ) {
1636 w = *a++;
1637 if ( *w > 0 ) { n = *w; NCOPY(m,w,n); }
1638 else if ( *w <= -FUNCTION ) *m++ = *w++;
1639 else { *m++ = *w++; *m++ = *w++; }
1640 }
1641 *m++ = 0;
1642 C->rhs[C->numrhs+1] = m;
1643DEBUG(MesPrint("Thread %w(f): w=(%d,%d,%d,%d)(%d)",mm[0],mm[1],mm[2],mm[3],C->numrhs);)
1644 C->Pointer = m;
1645 return(0);
1646 }
1647 m++; w += w[1];
1648 } while ( --n > 0 );
1649 }
1650 else if ( type == VECTOSUB || type == INDTOSUB ) {
1651 WORD *ss, *sstop, *tt, *ttstop, j, *v1, *v2 = 0;
1652 do {
1653 if ( w[2] == oldnumber && ( *w == type ||
1654 ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
1655 || ( type == INDTOSUB && *w == INDTOIND ) ) ) {
1656 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1657 *w = type;
1658 *m = 1;
1659 m = AddRHS(AT.ebufnum,1);
1660 w[3] = C->numrhs;
1661 w = AN.argaddress;
1662 n = *w - ARGHEAD;
1663 w += ARGHEAD;
1664 while ( (m + n + 10) > C->Top ) m = DoubleCbuffer(AT.ebufnum,m,7);
1665 while ( --n >= 0 ) *m++ = *w++;
1666 *m++ = 0;
1667 C->rhs[C->numrhs+1] = m;
1668 C->Pointer = m;
1669 m = AddRHS(AT.ebufnum,1);
1670 w = AN.argaddress;
1671 n = *w - ARGHEAD;
1672 w += ARGHEAD;
1673 while ( (m + n + 10) > C->Top ) m = DoubleCbuffer(AT.ebufnum,m,8);
1674 sstop = w + n;
1675 while ( w < sstop ) { /* Run over terms */
1676 tt = w + *w; ttstop = tt - ABS(tt[-1]);
1677 ss = m; m++; w++;
1678 while ( w < ttstop ) { /* Subterms */
1679 if ( *w != INDEX ) {
1680 j = w[1];
1681 NCOPY(m,w,j);
1682 }
1683 else {
1684 v1 = m;
1685 *m++ = *w++;
1686 *m++ = j = *w++;
1687 j -= 2;
1688 while ( --j >= 0 ) {
1689 if ( *w >= MINSPEC ) *m++ = *w++;
1690 else v2 = w++;
1691 }
1692 j = WORDDIF(m,v1);
1693 if ( j != v1[1] ) {
1694 if ( j <= 2 ) m -= 2;
1695 else v1[1] = j;
1696 *m++ = VECTOR;
1697 *m++ = 4;
1698 *m++ = *v2;
1699 *m++ = FUNNYVEC;
1700 }
1701 }
1702 }
1703 while ( w < tt ) *m++ = *w++;
1704 *ss = WORDDIF(m,ss);
1705 }
1706 *m++ = 0;
1707 C->rhs[C->numrhs+1] = m;
1708 C->Pointer = m;
1709 if ( m > C->Top ) {
1710/* INTERNAL_ERROR_EXCL_START */
1711 MLOCK(ErrorMessageLock);
1712 MesPrint("!>Internal problems with extra compiler buffer");
1713 MUNLOCK(ErrorMessageLock);
1714 Terminate(-1);
1715/* INTERNAL_ERROR_EXCL_STOP */
1716 }
1717 goto FlipOn;
1718 }
1719 m++; w += w[1];
1720 } while ( --n > 0 );
1721 }
1722 else {
1723 do {
1724 if ( w[2] == oldnumber && ( *w == type || ( type == VECTOVEC
1725 && ( *w == VECTOMIN || *w == VECTOSUB ) ) || ( type == VECTOMIN
1726 && ( *w == VECTOVEC || *w == VECTOSUB ) )
1727 || ( type == INDTOIND && *w == INDTOSUB ) ) ) {
1728 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1729 *w = type;
1730 w[3] = newnumber;
1731 *m = 1;
1732 goto FlipOn;
1733 }
1734 m++; w += w[1];
1735 } while ( --n > 0 );
1736 }
1737/* INTERNAL_ERROR_EXCL_START */
1738 MLOCK(ErrorMessageLock);
1739 MesPrint("!>Bug in AddWild.");
1740 MUNLOCK(ErrorMessageLock);
1741 return(-1);
1742/* INTERNAL_ERROR_EXCL_STOP */
1743FlipOn:
1744 if ( i >= 0 ) {
1745 m = AT.WildMask;
1746 w = AN.WildValue;
1747 n = AN.NumWild;
1748 while ( --n >= 0 ) {
1749 if ( w[2] == i && *w == SYMTONUM ) {
1750 *m = 2;
1751 return(0);
1752 }
1753 m++; w += w[1];
1754 }
1755/* INTERNAL_ERROR_EXCL_START */
1756 MLOCK(ErrorMessageLock);
1757 MesPrint("!>Bug in AddWild with passing set[i]");
1758 MUNLOCK(ErrorMessageLock);
1759/* INTERNAL_ERROR_EXCL_STOP */
1760/*
1761 For the moment we want to crash here. That is easier with debugging.
1762*/
1763#ifdef WITHPTHREADS
1764 { WORD *s = 0;
1765 *s++ = 1;
1766 }
1767#endif
1768 Terminate(-1);
1769 }
1770 return(0);
1771}
1772
1773/*
1774 #] AddWild :
1775 #[ CheckWild : WORD CheckWild(oldnumber,type,newnumber,newval)
1776
1777 Tests whether a wildcard assignment is allowed.
1778 A return value of zero means that it is allowed (nihil obstat).
1779 If the variable has been assigned already its existing
1780 assignment is returned in AN.oldvalue and AN.oldtype, which are
1781 global variables.
1782
1783 Note the special problem with name?set[i]. Here we have to pass
1784 an extra assignment. This cannot be done via globals as we
1785 call CheckWild sometimes twice before calling AddWild.
1786 Trick: Check the assignment of the number and if OK put it
1787 in place, but don't alter the used flag (if needed).
1788 Then AddWild can alter the used flag but the value is there.
1789 As long as this trick is `hanging' we turn on the flag:
1790 `AN.WildReserve' which is either turned off by AddWild or by
1791 a failing call to CheckWild.
1792
1793 With ARGTOARG the tensors give the number of arguments
1794 or-ed with EATTENSOR which is at least 8192.
1795*/
1796
1797int CheckWild(PHEAD WORD oldnumber, WORD type, WORD newnumber, WORD *newval)
1798{
1799 GETBIDENTITY
1800 WORD *w, *m, *s, n, old2, inset;
1801 WORD n2, oldval, dirty, i, j;
1802 int notflag = 0, retblock = 0;
1803 CBUF *C = cbuf+AT.ebufnum;
1804 WORD eattensor = type & EATTENSOR;
1805 type = type & ~EATTENSOR;
1806 m = AT.WildMask;
1807 w = AN.WildValue;
1808 n = AN.NumWild;
1809 if ( n <= 0 ) { AN.oldtype = -1; AN.WildReserve = 0; return(-1); }
1810 switch ( type ) {
1811 case SYMTONUM :
1812 *newval = newnumber;
1813 do {
1814 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1815 old2 = *w;
1816 if ( !*m ) goto TestSet;
1817 AN.MaskPointer = m;
1818 if ( *w == SYMTONUM && w[3] == newnumber ) {
1819 return(0);
1820 }
1821 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
1822 }
1823 m++; w += w[1];
1824 } while ( --n > 0 );
1825 break;
1826 case SYMTOSYM :
1827 *newval = newnumber;
1828 do {
1829 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1830 old2 = *w;
1831 if ( *w == SYMTOSYM ) {
1832 if ( !*m ) goto TestSet;
1833 if ( newnumber >= 0 && (w+4) < AN.WildStop
1834 && ( w[4] == FROMSET || w[4] == SETTONUM )
1835 && w[7] >= 0 ) goto TestSet;
1836 if ( w[3] == newnumber ) return(0);
1837 }
1838 else {
1839 if ( !*m ) goto TestSet;
1840 }
1841 goto NoM;
1842 }
1843 m++; w += w[1];
1844 } while ( --n > 0 );
1845 break;
1846 case SYMTOSUB :
1847/*
1848 Now newval contains the pointer to the argument.
1849*/
1850 {
1851/*
1852 Search for vector or index nature. If so: reject.
1853*/
1854 WORD *ss, *sstop, *tt, *ttstop;
1855 ss = newval;
1856 sstop = ss + *ss;
1857 ss += ARGHEAD;
1858 while ( ss < sstop ) {
1859 tt = ss + *ss;
1860 ttstop = tt - ABS(tt[-1]);
1861 ss++;
1862 while ( ss < ttstop ) {
1863 if ( *ss == INDEX ) goto NoMatch;
1864 ss += ss[1];
1865 }
1866 ss = tt;
1867 }
1868 }
1869 do {
1870 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1871 old2 = *w;
1872 if ( *w == SYMTONUM || *w == SYMTOSYM ) {
1873 if ( !*m ) {
1874 s = w + w[1];
1875 if ( s >= AN.WildStop || *s != SETTONUM )
1876 goto TestSet;
1877 }
1878 }
1879 else if ( *w == SYMTOSUB ) {
1880 if ( !*m ) {
1881 s = w + w[1];
1882 if ( s >= AN.WildStop || *s != SETTONUM )
1883 goto TestSet;
1884 }
1885 n = *newval - 2;
1886 newval += 2;
1887 m = C->rhs[w[3]];
1888 if ( (C->rhs[w[3]+1] - m - 1) == n ) {
1889 while ( n > 0 ) {
1890 if ( *m != *newval ) {
1891 m++; newval++; break;
1892 }
1893 m++; newval++;
1894 n--;
1895 }
1896 if ( n <= 0 ) return(0);
1897 }
1898 }
1899 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
1900 }
1901 m++; w += w[1];
1902 } while ( --n > 0 );
1903 break;
1904 case ARGTOARG :
1905 do {
1906 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1907 if ( !*m ) return(0); /* nihil obstat */
1908 m = C->rhs[w[3]];
1909 if ( eattensor ) {
1910 n = newnumber;
1911 if ( *m != 0 ) {
1912 if ( n == *m ) {
1913 m++;
1914 while ( --n >= 0 ) {
1915 if ( *m != *newval ) {
1916 m++; newval++; break;
1917 }
1918 m++; newval++;
1919 }
1920 if ( n < 0 ) return(0);
1921 }
1922 }
1923 else {
1924 m++;
1925 while ( --n >= 0 ) {
1926 if ( *newval != m[1] || ( *m != -INDEX
1927 && *m != -VECTOR && *m != -SNUMBER ) ) break;
1928 m += 2;
1929 newval++;
1930 }
1931 if ( n < 0 && *m == 0 ) return(0);
1932 }
1933 }
1934 else {
1935 i = newnumber;
1936 if ( *m != 0 ) { /* Tensor field */
1937 if ( *m == i ) {
1938 m++;
1939 while ( --i >= 0 ) {
1940 if ( *m != newval[1]
1941 || ( *newval != -VECTOR
1942 && *newval != -INDEX
1943 && *newval != -SNUMBER ) ) break;
1944 newval += 2;
1945 m++;
1946 }
1947 if ( i < 0 ) return(0);
1948 }
1949 }
1950 else {
1951 m++;
1952 s = newval;
1953 while ( --i >= 0 ) { NEXTARG(s) }
1954 n = WORDDIF(s,newval);
1955 while ( --n >= 0 ) {
1956 if ( *m != *newval ) {
1957 m++; newval++; break;
1958 }
1959 m++; newval++;
1960 }
1961 if ( n < 0 && *m == 0 ) return(0);
1962 }
1963 }
1964 AN.oldtype = *w; AN.oldvalue = w[3]; goto NoMatch;
1965 }
1966 m++; w += w[1];
1967 } while ( --n > 0 );
1968 break;
1969 case ARLTOARL :
1970 do {
1971 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1972 WORD **a;
1973 if ( !*m ) return(0); /* nihil obstat */
1974 m = C->rhs[w[3]];
1975 i = newnumber;
1976 a = (WORD **)newval;
1977 if ( *m != 0 ) { /* Tensor field */
1978 if ( *m == i ) {
1979 m++;
1980 while ( --i >= 0 ) {
1981 s = *a++;
1982 if ( *m != s[1]
1983 || ( *s != -VECTOR
1984 && *s != -INDEX
1985 && *s != -SNUMBER ) ) break;
1986 m++;
1987 }
1988 if ( i < 0 ) return(0);
1989 }
1990 }
1991 else {
1992 m++;
1993 while ( --i >= 0 ) {
1994 s = *a++;
1995 if ( *s > 0 ) {
1996 n = *s;
1997 while ( --n >= 0 ) {
1998 if ( *s != *m ) {
1999 s++; m++; break;
2000 }
2001 s++; m++;
2002 }
2003 if ( n >= 0 ) break;
2004 }
2005 else if ( *s <= -FUNCTION ) {
2006 if ( *s != *m ) {
2007 s++; m++; break;
2008 }
2009 s++; m++;
2010 }
2011 else {
2012 if ( *s != *m ) {
2013 s++; m++; break;
2014 }
2015 s++; m++;
2016 if ( *s != *m ) {
2017 s++; m++; break;
2018 }
2019 s++; m++;
2020 }
2021 }
2022 if ( i < 0 && *m == 0 ) return(0);
2023 }
2024 AN.oldtype = *w; AN.oldvalue = w[3]; goto NoMatch;
2025 }
2026 m++; w += w[1];
2027 } while ( --n > 0 );
2028 break;
2029 case VECTOSUB :
2030 case INDTOSUB :
2031/*
2032 Now newval contains the pointer to the argument(s).
2033*/
2034 {
2035/*
2036 Search for vector or index nature. If not so: reject.
2037*/
2038 WORD *ss, *sstop, *tt, *ttstop, count, jt;
2039 ss = newval;
2040 sstop = ss + *ss;
2041 ss += ARGHEAD;
2042 while ( ss < sstop ) {
2043 tt = ss + *ss;
2044 ttstop = tt - ABS(tt[-1]);
2045 ss++;
2046 count = 0;
2047 while ( ss < ttstop ) {
2048 if ( *ss == INDEX ) {
2049 jt = ss[1] - 2; ss += 2;
2050 while ( --jt >= 0 ) {
2051 if ( *ss < MINSPEC ) count++;
2052 ss++;
2053 }
2054 }
2055 else ss += ss[1];
2056 }
2057 if ( count != 1 ) goto NoMatch;
2058 ss = tt;
2059 }
2060 }
2061 do {
2062 if ( w[2] == oldnumber ) {
2063 old2 = *w;
2064 if ( ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
2065 || ( type == INDTOSUB && *w == INDTOIND ) ) {
2066 if ( !*m ) goto TestSet;
2067 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2068 }
2069 else if ( *w == type ) {
2070 if ( !*m ) goto TestSet;
2071 if ( type != INDTOIND && type != INDTOSUB ) { /* Prevent double index */
2072 n = *newval - 2;
2073 newval += 2;
2074 m = C->rhs[w[3]];
2075 if ( (C->rhs[w[3]+1] - m - 1) == n ) {
2076 while ( n > 0 ) {
2077 if ( *m != *newval ) {
2078 m++; newval++; break;
2079 }
2080 m++; newval++;
2081 n--;
2082 }
2083 if ( n <= 0 ) return(0);
2084 }
2085 }
2086 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2087 }
2088 }
2089 m++; w += w[1];
2090 } while ( --n > 0 );
2091 break;
2092 default :
2093 *newval = newnumber;
2094 do {
2095 if ( w[2] == oldnumber ) {
2096 if ( *w == type ) {
2097 old2 = *w;
2098 if ( !*m ) goto TestSet;
2099 if ( newnumber >= 0 && (w+4) < AN.WildStop &&
2100 ( w[4] == FROMSET || w[4] == SETTONUM )
2101 && w[7] >= 0 ) goto TestSet;
2102 if ( newnumber < 0 && *w == VECTOVEC
2103 && (w+4) < AN.WildStop && ( w[4] == FROMSET
2104 || w[4] == SETTONUM ) && w[7] >= 0 ) goto TestSet;
2105/*
2106 The next statement kills multiple indices -> vector
2107*/
2108 if ( *w == INDTOIND && w[3] < 0 ) goto NoMatch;
2109 if ( w[3] == newnumber ) {
2110 if ( *w != FUNTOFUN || newnumber < FUNCTION
2111 || functions[newnumber-FUNCTION].spec ==
2112 functions[oldnumber-FUNCTION].spec )
2113 return(0);
2114 }
2115 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2116 }
2117 else if ( ( type == VECTOVEC &&
2118 ( *w == VECTOSUB || *w == VECTOMIN ) )
2119 || ( type == INDTOIND && *w == INDTOSUB ) ) {
2120 if ( *m ) goto NoMatch;
2121 old2 = *w;
2122 goto TestSet;
2123 }
2124 else if ( type == VECTOMIN &&
2125 ( *w == VECTOSUB || *w == VECTOVEC ) ) {
2126 if ( *m ) goto NoMatch;
2127 old2 = *w;
2128 goto TestSet;
2129 }
2130 }
2131 m++; w += w[1];
2132 if ( n > 1 && ( *w == FROMSET
2133 || *w == SETTONUM ) ) { n--; m++; w += w[1]; }
2134 } while ( --n > 0 );
2135 break;
2136 }
2137/* INTERNAL_ERROR_EXCL_START */
2138 AN.oldtype = -1;
2139 AN.oldvalue = -1;
2140 AN.WildReserve = 0;
2141 MLOCK(ErrorMessageLock);
2142 MesPrint("!>Inconsistency in Wildcard prototype.");
2143 MUNLOCK(ErrorMessageLock);
2144 return(-1);
2145/* INTERNAL_ERROR_EXCL_STOP */
2146NoMatch:
2147 AN.WildReserve = 0;
2148 return(1+retblock);
2149/*
2150 Here we test the compatibility with a set specification.
2151*/
2152TestSet:
2153 dirty = *m;
2154 oldval = w[3];
2155 w += w[1];
2156 if ( w < AN.WildStop && ( *w == FROMSET || *w == SETTONUM ) ) {
2157 WORD k;
2158 s = w;
2159 j = w[2]; n2 = w[3];
2160/*
2161 if SETTONUM: x?j[n2]
2162 if FROMSET: x?j?n2 or x?j and n2 = -WOLDOFFSET.
2163*/
2164 if ( j > WILDOFFSET ) {
2165 j -= 2*WILDOFFSET;
2166 notflag = 1;
2167/*
2168 ???????
2169*/
2170 AN.oldtype = -1;
2171 AN.oldvalue = -1;
2172 }
2173 if ( j < AM.NumFixedSets ) { /* special set */
2174 retblock = 1;
2175 switch ( j ) {
2176 case POS_:
2177 if ( type != SYMTONUM ||
2178 newnumber <= 0 ) goto NoMnot;
2179 break;
2180 case POS0_:
2181 if ( type != SYMTONUM ||
2182 newnumber < 0 ) goto NoMnot;
2183 break;
2184 case NEG_:
2185 if ( type != SYMTONUM ||
2186 newnumber >= 0 ) goto NoMnot;
2187 break;
2188 case NEG0_:
2189 if ( type != SYMTONUM ||
2190 newnumber > 0 ) goto NoMnot;
2191 break;
2192 case EVEN_:
2193 if ( type != SYMTONUM ||
2194 ( newnumber & 1 ) != 0 ) goto NoMnot;
2195 break;
2196 case ODD_:
2197 if ( type != SYMTONUM ||
2198 ( newnumber & 1 ) == 0 ) goto NoMnot;
2199 break;
2200 case Z_:
2201 if ( type != SYMTONUM ) goto NoMnot;
2202 break;
2203 case SYMBOL_:
2204 if ( type != SYMTOSYM ) goto NoMnot;
2205 break;
2206 case FIXED_:
2207 if ( type != INDTOIND ||
2208 newnumber >= AM.OffsetIndex ||
2209 newnumber < 0 ) goto NoMnot;
2210 break;
2211 case INDEX_:
2212 if ( type != INDTOIND ||
2213 newnumber < 0 ) goto NoMnot;
2214 break;
2215 case Q_:
2216 if ( type == SYMTONUM ) break;
2217 if ( type == SYMTOSUB ) {
2218 WORD *ss, *sstop;
2219 ss = newval;
2220 sstop = ss + *ss;
2221 ss += ARGHEAD;
2222 if ( ss >= sstop ) break;
2223 if ( ss + *ss < sstop ) goto NoMnot;
2224 if ( ABS(sstop[-1]) == ss[0]-1 ) break;
2225 }
2226 goto NoMnot;
2227 case DUMMYINDEX_:
2228 if ( type != INDTOIND ||
2229 newnumber < AM.IndDum || newnumber >= AM.IndDum+MAXDUMMIES ) goto NoMnot;
2230 break;
2231 case VECTOR_:
2232 if ( type != VECTOVEC ) goto NoMnot;
2233 break;
2234 default:
2235 goto NoMnot;
2236 }
2237Mnot:
2238 if ( notflag ) goto NoM;
2239 return(0);
2240NoMnot:
2241 if ( !notflag ) goto NoM;
2242 return(0);
2243 }
2244 else if ( Sets[j].type == CRANGE ) {
2245 if ( ( type == SYMTONUM )
2246 || ( type == INDTOIND && ( newnumber > 0
2247 && newnumber <= AM.OffsetIndex ) ) ) {
2248 if ( Sets[j].first < MAXPOWER ) {
2249 if ( newnumber >= Sets[j].first ) goto NoMnot;
2250 }
2251 else if ( Sets[j].first < 3*MAXPOWER ) {
2252 if ( newnumber+2*MAXPOWER > Sets[j].first ) goto NoMnot;
2253 }
2254 if ( Sets[j].last > -MAXPOWER ) {
2255 if ( newnumber <= Sets[j].last ) goto NoMnot;
2256 }
2257 else if ( Sets[j].last > -3*MAXPOWER ) {
2258 if ( newnumber-2*MAXPOWER < Sets[j].last ) goto NoMnot;
2259 }
2260 goto Mnot;
2261 }
2262 goto NoMnot;
2263 }
2264/*
2265 Now we have to determine which set element
2266*/
2267 w = SetElements + Sets[j].first;
2268 m = SetElements + Sets[j].last;
2269 if ( w == m ) {
2270/*
2271 The set is empty! This is not a match unless we have !{}, in
2272 which case it is.
2273*/
2274 if ( notflag ) return 0;
2275 AN.oldtype = old2;
2276 AN.oldvalue = oldval;
2277 goto NoMatch;
2278 }
2279
2280 if ( ( Sets[j].flags & ORDEREDSET ) == ORDEREDSET ) {
2281/*
2282 We search first and ask questions later
2283*/
2284 i = BinarySearch(w,Sets[j].last-Sets[j].first,newnumber);
2285 if ( i < 0 ) { /* no matter what, it is not in the set. */
2286 goto NoMnot;
2287 }
2288 else {
2289/*
2290 We can set the proper parameters now to make only the
2291 checks for the given set element.
2292 After that we jump into the appropriate loop.
2293*/
2294 w = m = SetElements + i;
2295 i++;
2296 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2297 goto insideloop1;
2298 }
2299 else {
2300 goto insideloop2;
2301 }
2302 }
2303 }
2304 i = 1;
2305 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2306 do {
2307 insideloop1:
2308 if ( notflag ) {
2309 switch ( type ) {
2310 case SYMTOSYM:
2311 if ( Sets[j].type == CNUMBER ) {}
2312 else {
2313 if ( *w == newnumber ) goto NoMatch;
2314 }
2315 break;
2316 case SYMTONUM:
2317 case INDTOIND:
2318 if ( *w == newnumber ) goto NoMatch;
2319 break;
2320 default:
2321 break;
2322 }
2323 }
2324 else if ( type != SYMTONUM && type != INDTOIND
2325 && type != SYMTOSYM ) goto NoMatch;
2326 else if ( type == SYMTOSYM && Sets[j].type == CNUMBER ) goto NoMatch;
2327 else if ( *w == newnumber ) {
2328 if ( *s == SETTONUM ) {
2329 if ( n2 == oldnumber && type
2330 <= SYMTOSUB ) goto NoMatch;
2331 m = AT.WildMask;
2332 w = AN.WildValue;
2333 n = AN.NumWild;
2334 while ( --n >= 0 ) {
2335 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2336 if ( !*m ) {
2337 *w = SYMTONUM;
2338 w[3] = i;
2339 AN.WildReserve = 1;
2340 return(0);
2341 }
2342 if ( *w != SYMTONUM )
2343 goto NoMatch;
2344 if ( w[3] == i ) return(0);
2345 i = w[3];
2346 j = (SetElements + Sets[j].first)[i];
2347 if ( j == n2 ) return(0);
2348 goto NoMatch;
2349 }
2350 m++; w += w[1];
2351 }
2352 }
2353 else if ( n2 >= 0 ) {
2354 *newval = *(w - Sets[j].first + Sets[n2].first);
2355 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2356 if ( dirty && *newval != oldval ) {
2357 *newval = oldval; goto NoMatch;
2358 }
2359 }
2360 return(0);
2361 }
2362 i++;
2363 } while ( ++w < m );
2364 }
2365 else {
2366 do {
2367 insideloop2:
2368 inset = *w;
2369 if ( notflag ) {
2370 switch ( type ) {
2371 case SYMTONUM:
2372 case SYMTOSYM:
2373 if ( ( type == SYMTOSYM && *w == newnumber )
2374 || ( type == SYMTONUM && *w-2*MAXPOWER == newnumber ) ) {
2375 goto NoMatch;
2376 }
2377 /* fall through */
2378 case SYMTOSUB:
2379 if ( *w < 0 ) {
2380 WORD *mm = AT.WildMask, *mmm, *part;
2381 WORD *ww = AN.WildValue;
2382 WORD nn = AN.NumWild;
2383 k = -*w;
2384 while ( --nn >= 0 ) {
2385 if ( *mm && ww[2] == k && ww[0] == type ) {
2386 if ( type != SYMTOSUB ) {
2387 if ( ww[3] == newnumber ) goto NoMatch;
2388 }
2389 else {
2390 mmm = C->rhs[ww[3]];
2391 nn = *newval-2;
2392 part = newval+2;
2393 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2394 while ( --nn >= 0 ) {
2395 if ( *mmm != *part ) {
2396 mmm++; part++; break;
2397 }
2398 mmm++; part++;
2399 }
2400 if ( nn < 0 ) goto NoMatch;
2401 }
2402 }
2403 break;
2404 }
2405 mm++; ww += ww[1];
2406 }
2407 }
2408 break;
2409 case VECTOMIN:
2410 if ( type == VECTOMIN ) {
2411 if ( inset >= AM.OffsetVector ) { i++; continue; }
2412 inset += WILDMASK;
2413 }
2414 /* fall through */
2415 case VECTOVEC:
2416 if ( inset == newnumber ) goto NoMatch;
2417 /* fall through */
2418 case VECTOSUB:
2419 if ( inset - WILDOFFSET >= AM.OffsetVector ) {
2420 WORD *mm = AT.WildMask, *mmm, *part;
2421 WORD *ww = AN.WildValue;
2422 WORD nn = AN.NumWild;
2423 k = inset - WILDOFFSET;
2424 while ( --nn >= 0 ) {
2425 if ( *mm && ww[2] == k && ww[0] == type ) {
2426 if ( type == VECTOVEC ) {
2427 if ( ww[3] == newnumber ) goto NoMatch;
2428 }
2429 else {
2430 mmm = C->rhs[ww[3]];
2431 nn = *newval-2;
2432 part = newval+2;
2433 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2434 while ( --nn >= 0 ) {
2435 if ( *mmm != *part ) {
2436 mmm++; part++; break;
2437 }
2438 mmm++; part++;
2439 }
2440 if ( nn < 0 ) goto NoMatch;
2441 }
2442 }
2443 break;
2444 }
2445 mm++; ww += ww[1];
2446 }
2447 }
2448 break;
2449 case INDTOIND:
2450 if ( *w == newnumber ) goto NoMatch;
2451 /* fall through */
2452 case INDTOSUB:
2453 if ( *w - (WORD)WILDMASK >= AM.OffsetIndex ) {
2454 WORD *mm = AT.WildMask, *mmm, *part;
2455 WORD *ww = AN.WildValue;
2456 WORD nn = AN.NumWild;
2457 k = *w - WILDMASK;
2458 while ( --nn >= 0 ) {
2459 if ( *mm && ww[2] == k && ww[0] == type ) {
2460 if ( type == INDTOIND ) {
2461 if ( ww[3] == newnumber ) goto NoMatch;
2462 }
2463 else {
2464 mmm = C->rhs[ww[3]];
2465 nn = *newval-2;
2466 part = newval+2;
2467 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2468 while ( --nn >= 0 ) {
2469 if ( *mmm != *part ) {
2470 mmm++; part++; break;
2471 }
2472 mmm++; part++;
2473 }
2474 if ( nn < 0 ) goto NoMatch;
2475 }
2476 }
2477 break;
2478 }
2479 mm++; ww += ww[1];
2480 }
2481 }
2482 break;
2483 case FUNTOFUN:
2484 if ( *w == newnumber ) goto NoMatch;
2485 if ( ( type == FUNTOFUN &&
2486 ( k = *w - WILDMASK ) > FUNCTION ) ) {
2487 WORD *mm = AT.WildMask;
2488 WORD *ww = AN.WildValue;
2489 WORD nn = AN.NumWild;
2490 while ( --nn >= 0 ) {
2491 if ( *mm && ww[2] == k && ww[0] == type ) {
2492 if ( ww[3] == newnumber ) goto NoMatch;
2493 break;
2494 }
2495 mm++; ww += ww[1];
2496 }
2497 }
2498 default:
2499 break;
2500 }
2501 }
2502 else {
2503 if ( type == VECTOMIN ) {
2504 if ( inset >= AM.OffsetVector ) { i++; continue; }
2505 inset += WILDMASK;
2506 }
2507 if ( ( inset == newnumber && type != SYMTONUM ) ||
2508 ( type == SYMTONUM && inset-2*MAXPOWER == newnumber ) ) {
2509 if ( *s == SETTONUM ) {
2510 if ( n2 == oldnumber && type
2511 <= SYMTOSUB ) goto NoMatch;
2512 m = AT.WildMask;
2513 w = AN.WildValue;
2514 n = AN.NumWild;
2515 while ( --n >= 0 ) {
2516 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2517 if ( !*m ) {
2518 *w = SYMTONUM;
2519 w[3] = i;
2520 AN.WildReserve = 1;
2521 return(0);
2522 }
2523 if ( *w != SYMTONUM )
2524 goto NoMatch;
2525 if ( w[3] == i ) return(0);
2526 i = w[3];
2527 j = (SetElements + Sets[j].first)[i];
2528 if ( j == n2 ) return(0);
2529 goto NoMatch;
2530 }
2531 m++; w += w[1];
2532 }
2533 }
2534 else if ( n2 >= 0 ) {
2535 *newval = *(w - Sets[j].first + Sets[n2].first);
2536 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2537 if ( dirty && *newval != oldval ) {
2538 *newval = oldval; goto NoMatch;
2539 }
2540 }
2541 return(0);
2542 }
2543 }
2544 i++;
2545 } while ( ++w < m );
2546 }
2547 if ( notflag ) return(0);
2548 AN.oldtype = old2; AN.oldvalue = oldval; goto NoMatch;
2549 }
2550 else { return(0); }
2551
2552NoM:
2553 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2554}
2555
2556/*
2557 #] CheckWild :
2558 #] Wildcards :
2559 #[ DenToFunction :
2560
2561 Renames the denominator function into a function with the given number.
2562 For the syntax see Denominators,function;
2563*/
2564
2565int DenToFunction(WORD *term, WORD numfun)
2566{
2567 int action = 0;
2568 WORD *t, *tstop, *tnext, *arg, *argstop, *targ;
2569 t = term+1;
2570 tstop = term + *term; tstop -= ABS(tstop[-1]);
2571 while ( t < tstop ) {
2572 if ( *t == DENOMINATOR ) {
2573 *t = numfun; t[2] |= DIRTYFLAG; action = 1;
2574 }
2575 tnext = t + t[1];
2576 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec <= 0 ) {
2577 arg = t + FUNHEAD;
2578 while ( arg < tnext ) {
2579 if ( *arg > 0 ) {
2580 targ = arg + ARGHEAD; argstop = arg + *arg;
2581 while ( targ < argstop ) {
2582 if ( DenToFunction(targ,numfun) ) {
2583 arg[1] |= DIRTYFLAG; t[2] |= DIRTYFLAG; action = 1;
2584 }
2585 targ += *targ;
2586 }
2587 arg = argstop;
2588 }
2589 else if ( *arg <= -FUNCTION ) arg++;
2590 else arg += 2;
2591 }
2592 }
2593 t = tnext;
2594 }
2595 return(action);
2596}
2597
2598/*
2599 #] DenToFunction :
2600*/
AddRHS
WORD * AddRHS(int num, int type)
Definition comtool.c:210
DoubleCbuffer
WORD * DoubleCbuffer(int num, WORD *w, int par)
Definition comtool.c:143
CbUf::Top
WORD * Top
Definition structs.h:972
CbUf::rhs
WORD ** rhs
Definition structs.h:975
CbUf::Pointer
WORD * Pointer
Definition structs.h:973
Generated by doxygen 1.9.8