FORM v5.0.0-35-g6318119
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 ( dtype == MODLOCAL ) {
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 && dtype != MODLOCAL ) { 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 && dtype != MODLOCAL ) { 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 MLOCK(ErrorMessageLock);
1711 MesPrint("Internal problems with extra compiler buffer");
1712 MUNLOCK(ErrorMessageLock);
1713 Terminate(-1);
1714 }
1715 goto FlipOn;
1716 }
1717 m++; w += w[1];
1718 } while ( --n > 0 );
1719 }
1720 else {
1721 do {
1722 if ( w[2] == oldnumber && ( *w == type || ( type == VECTOVEC
1723 && ( *w == VECTOMIN || *w == VECTOSUB ) ) || ( type == VECTOMIN
1724 && ( *w == VECTOVEC || *w == VECTOSUB ) )
1725 || ( type == INDTOIND && *w == INDTOSUB ) ) ) {
1726 if ( n > 1 && w[4] == SETTONUM ) i = w[7];
1727 *w = type;
1728 w[3] = newnumber;
1729 *m = 1;
1730 goto FlipOn;
1731 }
1732 m++; w += w[1];
1733 } while ( --n > 0 );
1734 }
1735 MLOCK(ErrorMessageLock);
1736 MesPrint("Bug in AddWild.");
1737 MUNLOCK(ErrorMessageLock);
1738 return(-1);
1739FlipOn:
1740 if ( i >= 0 ) {
1741 m = AT.WildMask;
1742 w = AN.WildValue;
1743 n = AN.NumWild;
1744 while ( --n >= 0 ) {
1745 if ( w[2] == i && *w == SYMTONUM ) {
1746 *m = 2;
1747 return(0);
1748 }
1749 m++; w += w[1];
1750 }
1751 MLOCK(ErrorMessageLock);
1752 MesPrint(" Bug in AddWild with passing set[i]");
1753 MUNLOCK(ErrorMessageLock);
1754/*
1755 For the moment we want to crash here. That is easier with debugging.
1756*/
1757#ifdef WITHPTHREADS
1758 { WORD *s = 0;
1759 *s++ = 1;
1760 }
1761#endif
1762 Terminate(-1);
1763 }
1764 return(0);
1765}
1766
1767/*
1768 #] AddWild :
1769 #[ CheckWild : WORD CheckWild(oldnumber,type,newnumber,newval)
1770
1771 Tests whether a wildcard assignment is allowed.
1772 A return value of zero means that it is allowed (nihil obstat).
1773 If the variable has been assigned already its existing
1774 assignment is returned in AN.oldvalue and AN.oldtype, which are
1775 global variables.
1776
1777 Note the special problem with name?set[i]. Here we have to pass
1778 an extra assignment. This cannot be done via globals as we
1779 call CheckWild sometimes twice before calling AddWild.
1780 Trick: Check the assignment of the number and if OK put it
1781 in place, but don't alter the used flag (if needed).
1782 Then AddWild can alter the used flag but the value is there.
1783 As long as this trick is `hanging' we turn on the flag:
1784 `AN.WildReserve' which is either turned off by AddWild or by
1785 a failing call to CheckWild.
1786
1787 With ARGTOARG the tensors give the number of arguments
1788 or-ed with EATTENSOR which is at least 8192.
1789*/
1790
1791int CheckWild(PHEAD WORD oldnumber, WORD type, WORD newnumber, WORD *newval)
1792{
1793 GETBIDENTITY
1794 WORD *w, *m, *s, n, old2, inset;
1795 WORD n2, oldval, dirty, i, j;
1796 int notflag = 0, retblock = 0;
1797 CBUF *C = cbuf+AT.ebufnum;
1798 WORD eattensor = type & EATTENSOR;
1799 type = type & ~EATTENSOR;
1800 m = AT.WildMask;
1801 w = AN.WildValue;
1802 n = AN.NumWild;
1803 if ( n <= 0 ) { AN.oldtype = -1; AN.WildReserve = 0; return(-1); }
1804 switch ( type ) {
1805 case SYMTONUM :
1806 *newval = newnumber;
1807 do {
1808 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1809 old2 = *w;
1810 if ( !*m ) goto TestSet;
1811 AN.MaskPointer = m;
1812 if ( *w == SYMTONUM && w[3] == newnumber ) {
1813 return(0);
1814 }
1815 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
1816 }
1817 m++; w += w[1];
1818 } while ( --n > 0 );
1819 break;
1820 case SYMTOSYM :
1821 *newval = newnumber;
1822 do {
1823 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1824 old2 = *w;
1825 if ( *w == SYMTOSYM ) {
1826 if ( !*m ) goto TestSet;
1827 if ( newnumber >= 0 && (w+4) < AN.WildStop
1828 && ( w[4] == FROMSET || w[4] == SETTONUM )
1829 && w[7] >= 0 ) goto TestSet;
1830 if ( w[3] == newnumber ) return(0);
1831 }
1832 else {
1833 if ( !*m ) goto TestSet;
1834 }
1835 goto NoM;
1836 }
1837 m++; w += w[1];
1838 } while ( --n > 0 );
1839 break;
1840 case SYMTOSUB :
1841/*
1842 Now newval contains the pointer to the argument.
1843*/
1844 {
1845/*
1846 Search for vector or index nature. If so: reject.
1847*/
1848 WORD *ss, *sstop, *tt, *ttstop;
1849 ss = newval;
1850 sstop = ss + *ss;
1851 ss += ARGHEAD;
1852 while ( ss < sstop ) {
1853 tt = ss + *ss;
1854 ttstop = tt - ABS(tt[-1]);
1855 ss++;
1856 while ( ss < ttstop ) {
1857 if ( *ss == INDEX ) goto NoMatch;
1858 ss += ss[1];
1859 }
1860 ss = tt;
1861 }
1862 }
1863 do {
1864 if ( w[2] == oldnumber && *w <= SYMTOSUB ) {
1865 old2 = *w;
1866 if ( *w == SYMTONUM || *w == SYMTOSYM ) {
1867 if ( !*m ) {
1868 s = w + w[1];
1869 if ( s >= AN.WildStop || *s != SETTONUM )
1870 goto TestSet;
1871 }
1872 }
1873 else if ( *w == SYMTOSUB ) {
1874 if ( !*m ) {
1875 s = w + w[1];
1876 if ( s >= AN.WildStop || *s != SETTONUM )
1877 goto TestSet;
1878 }
1879 n = *newval - 2;
1880 newval += 2;
1881 m = C->rhs[w[3]];
1882 if ( (C->rhs[w[3]+1] - m - 1) == n ) {
1883 while ( n > 0 ) {
1884 if ( *m != *newval ) {
1885 m++; newval++; break;
1886 }
1887 m++; newval++;
1888 n--;
1889 }
1890 if ( n <= 0 ) return(0);
1891 }
1892 }
1893 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
1894 }
1895 m++; w += w[1];
1896 } while ( --n > 0 );
1897 break;
1898 case ARGTOARG :
1899 do {
1900 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1901 if ( !*m ) return(0); /* nihil obstat */
1902 m = C->rhs[w[3]];
1903 if ( eattensor ) {
1904 n = newnumber;
1905 if ( *m != 0 ) {
1906 if ( n == *m ) {
1907 m++;
1908 while ( --n >= 0 ) {
1909 if ( *m != *newval ) {
1910 m++; newval++; break;
1911 }
1912 m++; newval++;
1913 }
1914 if ( n < 0 ) return(0);
1915 }
1916 }
1917 else {
1918 m++;
1919 while ( --n >= 0 ) {
1920 if ( *newval != m[1] || ( *m != -INDEX
1921 && *m != -VECTOR && *m != -SNUMBER ) ) break;
1922 m += 2;
1923 newval++;
1924 }
1925 if ( n < 0 && *m == 0 ) return(0);
1926 }
1927 }
1928 else {
1929 i = newnumber;
1930 if ( *m != 0 ) { /* Tensor field */
1931 if ( *m == i ) {
1932 m++;
1933 while ( --i >= 0 ) {
1934 if ( *m != newval[1]
1935 || ( *newval != -VECTOR
1936 && *newval != -INDEX
1937 && *newval != -SNUMBER ) ) break;
1938 newval += 2;
1939 m++;
1940 }
1941 if ( i < 0 ) return(0);
1942 }
1943 }
1944 else {
1945 m++;
1946 s = newval;
1947 while ( --i >= 0 ) { NEXTARG(s) }
1948 n = WORDDIF(s,newval);
1949 while ( --n >= 0 ) {
1950 if ( *m != *newval ) {
1951 m++; newval++; break;
1952 }
1953 m++; newval++;
1954 }
1955 if ( n < 0 && *m == 0 ) return(0);
1956 }
1957 }
1958 AN.oldtype = *w; AN.oldvalue = w[3]; goto NoMatch;
1959 }
1960 m++; w += w[1];
1961 } while ( --n > 0 );
1962 break;
1963 case ARLTOARL :
1964 do {
1965 if ( w[2] == oldnumber && *w == ARGTOARG ) {
1966 WORD **a;
1967 if ( !*m ) return(0); /* nihil obstat */
1968 m = C->rhs[w[3]];
1969 i = newnumber;
1970 a = (WORD **)newval;
1971 if ( *m != 0 ) { /* Tensor field */
1972 if ( *m == i ) {
1973 m++;
1974 while ( --i >= 0 ) {
1975 s = *a++;
1976 if ( *m != s[1]
1977 || ( *s != -VECTOR
1978 && *s != -INDEX
1979 && *s != -SNUMBER ) ) break;
1980 m++;
1981 }
1982 if ( i < 0 ) return(0);
1983 }
1984 }
1985 else {
1986 m++;
1987 while ( --i >= 0 ) {
1988 s = *a++;
1989 if ( *s > 0 ) {
1990 n = *s;
1991 while ( --n >= 0 ) {
1992 if ( *s != *m ) {
1993 s++; m++; break;
1994 }
1995 s++; m++;
1996 }
1997 if ( n >= 0 ) break;
1998 }
1999 else if ( *s <= -FUNCTION ) {
2000 if ( *s != *m ) {
2001 s++; m++; break;
2002 }
2003 s++; m++;
2004 }
2005 else {
2006 if ( *s != *m ) {
2007 s++; m++; break;
2008 }
2009 s++; m++;
2010 if ( *s != *m ) {
2011 s++; m++; break;
2012 }
2013 s++; m++;
2014 }
2015 }
2016 if ( i < 0 && *m == 0 ) return(0);
2017 }
2018 AN.oldtype = *w; AN.oldvalue = w[3]; goto NoMatch;
2019 }
2020 m++; w += w[1];
2021 } while ( --n > 0 );
2022 break;
2023 case VECTOSUB :
2024 case INDTOSUB :
2025/*
2026 Now newval contains the pointer to the argument(s).
2027*/
2028 {
2029/*
2030 Search for vector or index nature. If not so: reject.
2031*/
2032 WORD *ss, *sstop, *tt, *ttstop, count, jt;
2033 ss = newval;
2034 sstop = ss + *ss;
2035 ss += ARGHEAD;
2036 while ( ss < sstop ) {
2037 tt = ss + *ss;
2038 ttstop = tt - ABS(tt[-1]);
2039 ss++;
2040 count = 0;
2041 while ( ss < ttstop ) {
2042 if ( *ss == INDEX ) {
2043 jt = ss[1] - 2; ss += 2;
2044 while ( --jt >= 0 ) {
2045 if ( *ss < MINSPEC ) count++;
2046 ss++;
2047 }
2048 }
2049 else ss += ss[1];
2050 }
2051 if ( count != 1 ) goto NoMatch;
2052 ss = tt;
2053 }
2054 }
2055 do {
2056 if ( w[2] == oldnumber ) {
2057 old2 = *w;
2058 if ( ( type == VECTOSUB && ( *w == VECTOVEC || *w == VECTOMIN ) )
2059 || ( type == INDTOSUB && *w == INDTOIND ) ) {
2060 if ( !*m ) goto TestSet;
2061 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2062 }
2063 else if ( *w == type ) {
2064 if ( !*m ) goto TestSet;
2065 if ( type != INDTOIND && type != INDTOSUB ) { /* Prevent double index */
2066 n = *newval - 2;
2067 newval += 2;
2068 m = C->rhs[w[3]];
2069 if ( (C->rhs[w[3]+1] - m - 1) == n ) {
2070 while ( n > 0 ) {
2071 if ( *m != *newval ) {
2072 m++; newval++; break;
2073 }
2074 m++; newval++;
2075 n--;
2076 }
2077 if ( n <= 0 ) return(0);
2078 }
2079 }
2080 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2081 }
2082 }
2083 m++; w += w[1];
2084 } while ( --n > 0 );
2085 break;
2086 default :
2087 *newval = newnumber;
2088 do {
2089 if ( w[2] == oldnumber ) {
2090 if ( *w == type ) {
2091 old2 = *w;
2092 if ( !*m ) goto TestSet;
2093 if ( newnumber >= 0 && (w+4) < AN.WildStop &&
2094 ( w[4] == FROMSET || w[4] == SETTONUM )
2095 && w[7] >= 0 ) goto TestSet;
2096 if ( newnumber < 0 && *w == VECTOVEC
2097 && (w+4) < AN.WildStop && ( w[4] == FROMSET
2098 || w[4] == SETTONUM ) && w[7] >= 0 ) goto TestSet;
2099/*
2100 The next statement kills multiple indices -> vector
2101*/
2102 if ( *w == INDTOIND && w[3] < 0 ) goto NoMatch;
2103 if ( w[3] == newnumber ) {
2104 if ( *w != FUNTOFUN || newnumber < FUNCTION
2105 || functions[newnumber-FUNCTION].spec ==
2106 functions[oldnumber-FUNCTION].spec )
2107 return(0);
2108 }
2109 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2110 }
2111 else if ( ( type == VECTOVEC &&
2112 ( *w == VECTOSUB || *w == VECTOMIN ) )
2113 || ( type == INDTOIND && *w == INDTOSUB ) ) {
2114 if ( *m ) goto NoMatch;
2115 old2 = *w;
2116 goto TestSet;
2117 }
2118 else if ( type == VECTOMIN &&
2119 ( *w == VECTOSUB || *w == VECTOVEC ) ) {
2120 if ( *m ) goto NoMatch;
2121 old2 = *w;
2122 goto TestSet;
2123 }
2124 }
2125 m++; w += w[1];
2126 if ( n > 1 && ( *w == FROMSET
2127 || *w == SETTONUM ) ) { n--; m++; w += w[1]; }
2128 } while ( --n > 0 );
2129 break;
2130 }
2131 AN.oldtype = -1;
2132 AN.oldvalue = -1;
2133 AN.WildReserve = 0;
2134 MLOCK(ErrorMessageLock);
2135 MesPrint("Inconsistency in Wildcard prototype.");
2136 MUNLOCK(ErrorMessageLock);
2137 return(-1);
2138NoMatch:
2139 AN.WildReserve = 0;
2140 return(1+retblock);
2141/*
2142 Here we test the compatibility with a set specification.
2143*/
2144TestSet:
2145 dirty = *m;
2146 oldval = w[3];
2147 w += w[1];
2148 if ( w < AN.WildStop && ( *w == FROMSET || *w == SETTONUM ) ) {
2149 WORD k;
2150 s = w;
2151 j = w[2]; n2 = w[3];
2152/*
2153 if SETTONUM: x?j[n2]
2154 if FROMSET: x?j?n2 or x?j and n2 = -WOLDOFFSET.
2155*/
2156 if ( j > WILDOFFSET ) {
2157 j -= 2*WILDOFFSET;
2158 notflag = 1;
2159/*
2160 ???????
2161*/
2162 AN.oldtype = -1;
2163 AN.oldvalue = -1;
2164 }
2165 if ( j < AM.NumFixedSets ) { /* special set */
2166 retblock = 1;
2167 switch ( j ) {
2168 case POS_:
2169 if ( type != SYMTONUM ||
2170 newnumber <= 0 ) goto NoMnot;
2171 break;
2172 case POS0_:
2173 if ( type != SYMTONUM ||
2174 newnumber < 0 ) goto NoMnot;
2175 break;
2176 case NEG_:
2177 if ( type != SYMTONUM ||
2178 newnumber >= 0 ) goto NoMnot;
2179 break;
2180 case NEG0_:
2181 if ( type != SYMTONUM ||
2182 newnumber > 0 ) goto NoMnot;
2183 break;
2184 case EVEN_:
2185 if ( type != SYMTONUM ||
2186 ( newnumber & 1 ) != 0 ) goto NoMnot;
2187 break;
2188 case ODD_:
2189 if ( type != SYMTONUM ||
2190 ( newnumber & 1 ) == 0 ) goto NoMnot;
2191 break;
2192 case Z_:
2193 if ( type != SYMTONUM ) goto NoMnot;
2194 break;
2195 case SYMBOL_:
2196 if ( type != SYMTOSYM ) goto NoMnot;
2197 break;
2198 case FIXED_:
2199 if ( type != INDTOIND ||
2200 newnumber >= AM.OffsetIndex ||
2201 newnumber < 0 ) goto NoMnot;
2202 break;
2203 case INDEX_:
2204 if ( type != INDTOIND ||
2205 newnumber < 0 ) goto NoMnot;
2206 break;
2207 case Q_:
2208 if ( type == SYMTONUM ) break;
2209 if ( type == SYMTOSUB ) {
2210 WORD *ss, *sstop;
2211 ss = newval;
2212 sstop = ss + *ss;
2213 ss += ARGHEAD;
2214 if ( ss >= sstop ) break;
2215 if ( ss + *ss < sstop ) goto NoMnot;
2216 if ( ABS(sstop[-1]) == ss[0]-1 ) break;
2217 }
2218 goto NoMnot;
2219 case DUMMYINDEX_:
2220 if ( type != INDTOIND ||
2221 newnumber < AM.IndDum || newnumber >= AM.IndDum+MAXDUMMIES ) goto NoMnot;
2222 break;
2223 case VECTOR_:
2224 if ( type != VECTOVEC ) goto NoMnot;
2225 break;
2226 default:
2227 goto NoMnot;
2228 }
2229Mnot:
2230 if ( notflag ) goto NoM;
2231 return(0);
2232NoMnot:
2233 if ( !notflag ) goto NoM;
2234 return(0);
2235 }
2236 else if ( Sets[j].type == CRANGE ) {
2237 if ( ( type == SYMTONUM )
2238 || ( type == INDTOIND && ( newnumber > 0
2239 && newnumber <= AM.OffsetIndex ) ) ) {
2240 if ( Sets[j].first < MAXPOWER ) {
2241 if ( newnumber >= Sets[j].first ) goto NoMnot;
2242 }
2243 else if ( Sets[j].first < 3*MAXPOWER ) {
2244 if ( newnumber+2*MAXPOWER > Sets[j].first ) goto NoMnot;
2245 }
2246 if ( Sets[j].last > -MAXPOWER ) {
2247 if ( newnumber <= Sets[j].last ) goto NoMnot;
2248 }
2249 else if ( Sets[j].last > -3*MAXPOWER ) {
2250 if ( newnumber-2*MAXPOWER < Sets[j].last ) goto NoMnot;
2251 }
2252 goto Mnot;
2253 }
2254 goto NoMnot;
2255 }
2256/*
2257 Now we have to determine which set element
2258*/
2259 w = SetElements + Sets[j].first;
2260 m = SetElements + Sets[j].last;
2261 if ( w == m ) {
2262/*
2263 The set is empty! This is not a match unless we have !{}, in
2264 which case it is.
2265*/
2266 if ( notflag ) return 0;
2267 AN.oldtype = old2;
2268 AN.oldvalue = oldval;
2269 goto NoMatch;
2270 }
2271
2272 if ( ( Sets[j].flags & ORDEREDSET ) == ORDEREDSET ) {
2273/*
2274 We search first and ask questions later
2275*/
2276 i = BinarySearch(w,Sets[j].last-Sets[j].first,newnumber);
2277 if ( i < 0 ) { /* no matter what, it is not in the set. */
2278 goto NoMnot;
2279 }
2280 else {
2281/*
2282 We can set the proper parameters now to make only the
2283 checks for the given set element.
2284 After that we jump into the appropriate loop.
2285*/
2286 w = m = SetElements + i;
2287 i++;
2288 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2289 goto insideloop1;
2290 }
2291 else {
2292 goto insideloop2;
2293 }
2294 }
2295 }
2296 i = 1;
2297 if ( Sets[j].type == -1 || Sets[j].type == CNUMBER ) {
2298 do {
2299 insideloop1:
2300 if ( notflag ) {
2301 switch ( type ) {
2302 case SYMTOSYM:
2303 if ( Sets[j].type == CNUMBER ) {}
2304 else {
2305 if ( *w == newnumber ) goto NoMatch;
2306 }
2307 break;
2308 case SYMTONUM:
2309 case INDTOIND:
2310 if ( *w == newnumber ) goto NoMatch;
2311 break;
2312 default:
2313 break;
2314 }
2315 }
2316 else if ( type != SYMTONUM && type != INDTOIND
2317 && type != SYMTOSYM ) goto NoMatch;
2318 else if ( type == SYMTOSYM && Sets[j].type == CNUMBER ) goto NoMatch;
2319 else if ( *w == newnumber ) {
2320 if ( *s == SETTONUM ) {
2321 if ( n2 == oldnumber && type
2322 <= SYMTOSUB ) goto NoMatch;
2323 m = AT.WildMask;
2324 w = AN.WildValue;
2325 n = AN.NumWild;
2326 while ( --n >= 0 ) {
2327 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2328 if ( !*m ) {
2329 *w = SYMTONUM;
2330 w[3] = i;
2331 AN.WildReserve = 1;
2332 return(0);
2333 }
2334 if ( *w != SYMTONUM )
2335 goto NoMatch;
2336 if ( w[3] == i ) return(0);
2337 i = w[3];
2338 j = (SetElements + Sets[j].first)[i];
2339 if ( j == n2 ) return(0);
2340 goto NoMatch;
2341 }
2342 m++; w += w[1];
2343 }
2344 }
2345 else if ( n2 >= 0 ) {
2346 *newval = *(w - Sets[j].first + Sets[n2].first);
2347 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2348 if ( dirty && *newval != oldval ) {
2349 *newval = oldval; goto NoMatch;
2350 }
2351 }
2352 return(0);
2353 }
2354 i++;
2355 } while ( ++w < m );
2356 }
2357 else {
2358 do {
2359 insideloop2:
2360 inset = *w;
2361 if ( notflag ) {
2362 switch ( type ) {
2363 case SYMTONUM:
2364 case SYMTOSYM:
2365 if ( ( type == SYMTOSYM && *w == newnumber )
2366 || ( type == SYMTONUM && *w-2*MAXPOWER == newnumber ) ) {
2367 goto NoMatch;
2368 }
2369 /* fall through */
2370 case SYMTOSUB:
2371 if ( *w < 0 ) {
2372 WORD *mm = AT.WildMask, *mmm, *part;
2373 WORD *ww = AN.WildValue;
2374 WORD nn = AN.NumWild;
2375 k = -*w;
2376 while ( --nn >= 0 ) {
2377 if ( *mm && ww[2] == k && ww[0] == type ) {
2378 if ( type != SYMTOSUB ) {
2379 if ( ww[3] == newnumber ) goto NoMatch;
2380 }
2381 else {
2382 mmm = C->rhs[ww[3]];
2383 nn = *newval-2;
2384 part = newval+2;
2385 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2386 while ( --nn >= 0 ) {
2387 if ( *mmm != *part ) {
2388 mmm++; part++; break;
2389 }
2390 mmm++; part++;
2391 }
2392 if ( nn < 0 ) goto NoMatch;
2393 }
2394 }
2395 break;
2396 }
2397 mm++; ww += ww[1];
2398 }
2399 }
2400 break;
2401 case VECTOMIN:
2402 if ( type == VECTOMIN ) {
2403 if ( inset >= AM.OffsetVector ) { i++; continue; }
2404 inset += WILDMASK;
2405 }
2406 /* fall through */
2407 case VECTOVEC:
2408 if ( inset == newnumber ) goto NoMatch;
2409 /* fall through */
2410 case VECTOSUB:
2411 if ( inset - WILDOFFSET >= AM.OffsetVector ) {
2412 WORD *mm = AT.WildMask, *mmm, *part;
2413 WORD *ww = AN.WildValue;
2414 WORD nn = AN.NumWild;
2415 k = inset - WILDOFFSET;
2416 while ( --nn >= 0 ) {
2417 if ( *mm && ww[2] == k && ww[0] == type ) {
2418 if ( type == VECTOVEC ) {
2419 if ( ww[3] == newnumber ) goto NoMatch;
2420 }
2421 else {
2422 mmm = C->rhs[ww[3]];
2423 nn = *newval-2;
2424 part = newval+2;
2425 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2426 while ( --nn >= 0 ) {
2427 if ( *mmm != *part ) {
2428 mmm++; part++; break;
2429 }
2430 mmm++; part++;
2431 }
2432 if ( nn < 0 ) goto NoMatch;
2433 }
2434 }
2435 break;
2436 }
2437 mm++; ww += ww[1];
2438 }
2439 }
2440 break;
2441 case INDTOIND:
2442 if ( *w == newnumber ) goto NoMatch;
2443 /* fall through */
2444 case INDTOSUB:
2445 if ( *w - (WORD)WILDMASK >= AM.OffsetIndex ) {
2446 WORD *mm = AT.WildMask, *mmm, *part;
2447 WORD *ww = AN.WildValue;
2448 WORD nn = AN.NumWild;
2449 k = *w - WILDMASK;
2450 while ( --nn >= 0 ) {
2451 if ( *mm && ww[2] == k && ww[0] == type ) {
2452 if ( type == INDTOIND ) {
2453 if ( ww[3] == newnumber ) goto NoMatch;
2454 }
2455 else {
2456 mmm = C->rhs[ww[3]];
2457 nn = *newval-2;
2458 part = newval+2;
2459 if ( (C->rhs[ww[3]+1]-mmm-1) == nn ) {
2460 while ( --nn >= 0 ) {
2461 if ( *mmm != *part ) {
2462 mmm++; part++; break;
2463 }
2464 mmm++; part++;
2465 }
2466 if ( nn < 0 ) goto NoMatch;
2467 }
2468 }
2469 break;
2470 }
2471 mm++; ww += ww[1];
2472 }
2473 }
2474 break;
2475 case FUNTOFUN:
2476 if ( *w == newnumber ) goto NoMatch;
2477 if ( ( type == FUNTOFUN &&
2478 ( k = *w - WILDMASK ) > FUNCTION ) ) {
2479 WORD *mm = AT.WildMask;
2480 WORD *ww = AN.WildValue;
2481 WORD nn = AN.NumWild;
2482 while ( --nn >= 0 ) {
2483 if ( *mm && ww[2] == k && ww[0] == type ) {
2484 if ( ww[3] == newnumber ) goto NoMatch;
2485 break;
2486 }
2487 mm++; ww += ww[1];
2488 }
2489 }
2490 default:
2491 break;
2492 }
2493 }
2494 else {
2495 if ( type == VECTOMIN ) {
2496 if ( inset >= AM.OffsetVector ) { i++; continue; }
2497 inset += WILDMASK;
2498 }
2499 if ( ( inset == newnumber && type != SYMTONUM ) ||
2500 ( type == SYMTONUM && inset-2*MAXPOWER == newnumber ) ) {
2501 if ( *s == SETTONUM ) {
2502 if ( n2 == oldnumber && type
2503 <= SYMTOSUB ) goto NoMatch;
2504 m = AT.WildMask;
2505 w = AN.WildValue;
2506 n = AN.NumWild;
2507 while ( --n >= 0 ) {
2508 if ( w[2] == n2 && *w <= SYMTOSUB ) {
2509 if ( !*m ) {
2510 *w = SYMTONUM;
2511 w[3] = i;
2512 AN.WildReserve = 1;
2513 return(0);
2514 }
2515 if ( *w != SYMTONUM )
2516 goto NoMatch;
2517 if ( w[3] == i ) return(0);
2518 i = w[3];
2519 j = (SetElements + Sets[j].first)[i];
2520 if ( j == n2 ) return(0);
2521 goto NoMatch;
2522 }
2523 m++; w += w[1];
2524 }
2525 }
2526 else if ( n2 >= 0 ) {
2527 *newval = *(w - Sets[j].first + Sets[n2].first);
2528 if ( *newval > MAXPOWER ) *newval -= 2*MAXPOWER;
2529 if ( dirty && *newval != oldval ) {
2530 *newval = oldval; goto NoMatch;
2531 }
2532 }
2533 return(0);
2534 }
2535 }
2536 i++;
2537 } while ( ++w < m );
2538 }
2539 if ( notflag ) return(0);
2540 AN.oldtype = old2; AN.oldvalue = oldval; goto NoMatch;
2541 }
2542 else { return(0); }
2543
2544NoM:
2545 AN.oldtype = old2; AN.oldvalue = w[3]; goto NoMatch;
2546}
2547
2548/*
2549 #] CheckWild :
2550 #] Wildcards :
2551 #[ DenToFunction :
2552
2553 Renames the denominator function into a function with the given number.
2554 For the syntax see Denominators,function;
2555*/
2556
2557int DenToFunction(WORD *term, WORD numfun)
2558{
2559 int action = 0;
2560 WORD *t, *tstop, *tnext, *arg, *argstop, *targ;
2561 t = term+1;
2562 tstop = term + *term; tstop -= ABS(tstop[-1]);
2563 while ( t < tstop ) {
2564 if ( *t == DENOMINATOR ) {
2565 *t = numfun; t[2] |= DIRTYFLAG; action = 1;
2566 }
2567 tnext = t + t[1];
2568 if ( *t >= FUNCTION && functions[*t-FUNCTION].spec <= 0 ) {
2569 arg = t + FUNHEAD;
2570 while ( arg < tnext ) {
2571 if ( *arg > 0 ) {
2572 targ = arg + ARGHEAD; argstop = arg + *arg;
2573 while ( targ < argstop ) {
2574 if ( DenToFunction(targ,numfun) ) {
2575 arg[1] |= DIRTYFLAG; t[2] |= DIRTYFLAG; action = 1;
2576 }
2577 targ += *targ;
2578 }
2579 arg = argstop;
2580 }
2581 else if ( *arg <= -FUNCTION ) arg++;
2582 else arg += 2;
2583 }
2584 }
2585 t = tnext;
2586 }
2587 return(action);
2588}
2589
2590/*
2591 #] DenToFunction :
2592*/
AddRHS
WORD * AddRHS(int num, int type)
Definition comtool.c:214
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