FORM 4.3
if.c
Go to the documentation of this file.
1
5/* #[ License : */
6/*
7 * Copyright (C) 1984-2022 J.A.M. Vermaseren
8 * When using this file you are requested to refer to the publication
9 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
10 * This is considered a matter of courtesy as the development was paid
11 * for by FOM the Dutch physics granting agency and we would like to
12 * be able to track its scientific use to convince FOM of its value
13 * for the community.
14 *
15 * This file is part of FORM.
16 *
17 * FORM is free software: you can redistribute it and/or modify it under the
18 * terms of the GNU General Public License as published by the Free Software
19 * Foundation, either version 3 of the License, or (at your option) any later
20 * version.
21 *
22 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
23 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
24 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
25 * details.
26 *
27 * You should have received a copy of the GNU General Public License along
28 * with FORM. If not, see <http://www.gnu.org/licenses/>.
29 */
30/* #] License : */
31/*
32 #[ Includes : if.c
33*/
34
35#include "form3.h"
36
37/*
38 #] Includes :
39 #[ If statement :
40 #[ Syntax :
41
42 The `if' is a conglomerate of statements: if,else,endif
43
44 The if consists in principle of:
45
46 if ( number );
47 statements
48 else;
49 statements
50 endif;
51
52 The first set is taken when number != 0.
53 The else is not mandatory.
54 TRUE = 1 and FALSE = 0
55
56 The number can be built up via a logical expression:
57
58 expr1 condition expr2
59
60 each expression can be a subexpression again. It has to be
61 enclosed in parentheses in that case.
62 Conditions are:
63 >, >=, <, <=, ==, !=, ||, &&
64
65 When Expressions are chained evaluation is from left to right,
66 independent of whether this indicates nonsense.
67 if ( a || b || c || d ); is a perfectly normal statement.
68 if ( a >= b || c == d ); would be messed up. This should be:
69 if ( ( a >= b ) || ( c == d ) );
70
71 The building blocks of the Expressions are:
72
73 Match(option,pattern) The number of times pattern fits in term_
74 Count(....) The count value of term_
75 Coeff[icient] The coefficient of term_
76 FindLoop(options) Are there loops (as in ReplaceLoop).
77
78 Implementation for internal notation:
79
80 TYPEIF,length,gotolevel(if fail),EXPRTYPE,length,......
81
82 EXPRTYPE can be:
83 SHORTNUMBER ->,4,sign,size
84 LONGNUMBER ->,|ncoef+2|,ncoef,numer,denom
85 MATCH ->,patternsiz+3,keyword,pattern
86 MULTIPLEOF ->,3,thenumber
87 COUNT ->,countsiz+2,countinfo
88 TYPEFINDLOOP ->,7 (findloop info)
89 COEFFICIENT ->,2
90 IFDOLLAR ->,3,dollarnumber
91 SUBEXPR ->,size,dummy,size1,EXPRTYPE,length,...
92 ,2,condition1,size2,...
93 This is like functions.
94
95 Note that there must be a restriction to the number of nestings
96 of parentheses in an if statement. It has been set to 10.
97
98 The syntax of match corresponds to the syntax of the left side
99 of an id statement. The only difference is the keyword
100 MATCH vs TYPEIDNEW.
101
102 #] Syntax :
103 #[ GetIfDollarNum :
104*/
105
106WORD GetIfDollarNum(WORD *ifp, WORD *ifstop)
107{
108 DOLLARS d;
109 WORD num, *w;
110 if ( ifp[2] < 0 ) { return(-ifp[2]-1); }
111 d = Dollars+ifp[2];
112 if ( ifp+3 < ifstop && ifp[3] == IFDOLLAREXTRA ) {
113 if ( d->nfactors == 0 ) {
114 MLOCK(ErrorMessageLock);
115 MesPrint("Attempt to use a factor of an unfactored $-variable");
116 MUNLOCK(ErrorMessageLock);
117 Terminate(-1);
118 }
119 num = GetIfDollarNum(ifp+3,ifstop);
120 if ( num > d->nfactors ) {
121 MLOCK(ErrorMessageLock);
122 MesPrint("Dollar factor number %s out of range",num);
123 MUNLOCK(ErrorMessageLock);
124 Terminate(-1);
125 }
126 if ( num == 0 ) {
127 return(d->nfactors);
128 }
129 w = d->factors[num-1].where;
130 if ( w == 0 ) return(d->factors[num].value);
131getnumber:;
132 if ( *w == 0 ) return(0);
133 if ( *w == 4 && w[3] == 3 && w[2] == 1 && w[1] < MAXPOSITIVE && w[4] == 0 ) {
134 return(w[1]);
135 }
136 if ( ( w[w[0]] != 0 ) || ( ABS(w[w[0]-1]) != w[0]-1 ) ) {
137 MLOCK(ErrorMessageLock);
138 MesPrint("Dollar factor number expected but found expression");
139 MUNLOCK(ErrorMessageLock);
140 Terminate(-1);
141 }
142 else {
143 MLOCK(ErrorMessageLock);
144 MesPrint("Dollar factor number out of range");
145 MUNLOCK(ErrorMessageLock);
146 Terminate(-1);
147 }
148 return(0);
149 }
150/*
151 Now we have just a dollar and should evaluate that into a short number
152*/
153 if ( d->type == DOLZERO ) {
154 return(0);
155 }
156 else if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
157 w = d->where; goto getnumber;
158 }
159 else {
160 MLOCK(ErrorMessageLock);
161 MesPrint("Dollar factor number is wrong type");
162 MUNLOCK(ErrorMessageLock);
163 Terminate(-1);
164 return(0);
165 }
166}
167
168/*
169 #] GetIfDollarNum :
170 #[ FindVar :
171*/
172
173int FindVar(WORD *v, WORD *term)
174{
175 WORD *t, *tstop, *m, *mstop, *f, *fstop, *a, *astop;
176 GETSTOP(term,tstop);
177 t = term+1;
178 while ( t < tstop ) {
179 if ( *v == *t && *v < FUNCTION ) { /* VECTOR, INDEX, SYMBOL, DOTPRODUCT */
180 switch ( *v ) {
181 case SYMBOL:
182 m = t+2; mstop = t+t[1];
183 while ( m < mstop ) {
184 if ( *m == v[1] ) return(1);
185 m += 2;
186 }
187 break;
188 case INDEX:
189 case VECTOR:
190InVe:
191 m = t+2; mstop = t+t[1];
192 while ( m < mstop ) {
193 if ( *m == v[1] ) return(1);
194 m++;
195 }
196 break;
197 case DOTPRODUCT:
198 m = t+2; mstop = t+t[1];
199 while ( m < mstop ) {
200 if ( *m == v[1] && m[1] == v[2] ) return(1);
201 if ( *m == v[2] && m[1] == v[1] ) return(1);
202 m += 3;
203 }
204 break;
205 }
206 }
207 else if ( *v == VECTOR && *t == INDEX ) goto InVe;
208 else if ( *v == INDEX && *t == VECTOR ) goto InVe;
209 else if ( ( *v == VECTOR || *v == INDEX ) && *t == DOTPRODUCT ) {
210 m = t+2; mstop = t+t[1];
211 while ( m < mstop ) {
212 if ( v[1] == m[0] || v[1] == m[1] ) return(1);
213 m += 3;
214 }
215 }
216 else if ( *t >= FUNCTION ) {
217 if ( *v == FUNCTION && v[1] == *t ) return(1);
218 if ( functions[*t-FUNCTION].spec > 0 ) {
219 if ( *v == VECTOR || *v == INDEX ) { /* we need to check arguments */
220 int i;
221 for ( i = FUNHEAD; i < t[1]; i++ ) {
222 if ( v[1] == t[i] ) return(1);
223 }
224 }
225 }
226 else {
227 fstop = t + t[1]; f = t + FUNHEAD;
228 while ( f < fstop ) { /* Do the arguments one by one */
229 if ( *f <= 0 ) {
230 switch ( *f ) {
231 case -SYMBOL:
232 if ( *v == SYMBOL && v[1] == f[1] ) return(1);
233 f += 2;
234 break;
235 case -VECTOR:
236 case -MINVECTOR:
237 case -INDEX:
238 if ( ( *v == VECTOR || *v == INDEX )
239 && ( v[1] == f[1] ) ) return(1);
240 f += 2;
241 break;
242 case -SNUMBER:
243 f += 2;
244 break;
245 default:
246 if ( *v == FUNCTION && v[1] == -*f && *f <= -FUNCTION ) return(1);
247 if ( *f <= -FUNCTION ) f++;
248 else f += 2;
249 break;
250 }
251 }
252 else {
253 a = f + ARGHEAD; astop = f + *f;
254 while ( a < astop ) {
255 if ( FindVar(v,a) == 1 ) return(1);
256 a += *a;
257 }
258 f = astop;
259 }
260 }
261 }
262 }
263 t += t[1];
264 }
265 return(0);
266}
267
268/*
269 #] FindVar :
270 #[ DoIfStatement : WORD DoIfStatement(PHEAD ifcode,term)
271
272 The execution time part of the if-statement.
273 The arguments are a pointer to the TYPEIF and a pointer to the term.
274 The answer is either 1 (success) or 0 (fail).
275 The calling routine can figure out where to go in case of failure
276 by picking up gotolevel.
277 Note that the whole setup asks for recursions.
278*/
279
280WORD DoIfStatement(PHEAD WORD *ifcode, WORD *term)
281{
282 GETBIDENTITY
283 WORD *ifstop, *ifp;
284 UWORD *coef1 = 0, *coef2, *coef3, *cc;
285 WORD ncoef1, ncoef2, ncoef3, i = 0, first, *r, acoef, ismul1, ismul2, j;
286 UWORD *Spac1, *Spac2;
287 ifstop = ifcode + ifcode[1];
288 ifp = ifcode + 3;
289 if ( ifp >= ifstop ) return(1);
290 if ( ( ifp + ifp[1] ) >= ifstop ) {
291 switch ( *ifp ) {
292 case LONGNUMBER:
293 if ( ifp[2] ) return(1);
294 else return(0);
295 case MATCH:
296 case TYPEIF:
297 if ( HowMany(BHEAD ifp,term) ) return(1);
298 else return(0);
299 case TYPEFINDLOOP:
300 if ( Lus(term,ifp[3],ifp[4],ifp[5],ifp[6],ifp[2]) ) return(1);
301 else return(0);
302 case TYPECOUNT:
303 if ( CountDo(term,ifp) ) return(1);
304 else return(0);
305 case COEFFI:
306 case MULTIPLEOF:
307 return(1);
308 case IFDOLLAR:
309 {
310 DOLLARS d = Dollars + ifp[2];
311#ifdef WITHPTHREADS
312 int nummodopt, dtype = -1;
313 if ( AS.MultiThreaded ) {
314 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
315 if ( ifp[2] == ModOptdollars[nummodopt].number ) break;
316 }
317 if ( nummodopt < NumModOptdollars ) {
318 dtype = ModOptdollars[nummodopt].type;
319 if ( dtype == MODLOCAL ) {
320 d = ModOptdollars[nummodopt].dstruct+AT.identity;
321 }
322 }
323 }
324 dtype = d->type;
325#else
326 int dtype = d->type; /* We use dtype to make the operation atomic */
327#endif
328 if ( dtype == DOLZERO ) return(0);
329 if ( dtype == DOLUNDEFINED ) {
330 if ( AC.UnsureDollarMode == 0 ) {
331 MesPrint("$%s is undefined",AC.dollarnames->namebuffer+d->name);
332 Terminate(-1);
333 }
334 }
335 }
336 return(1);
337 case IFEXPRESSION:
338 r = ifp+2; j = ifp[1] - 2;
339 while ( --j >= 0 ) {
340 if ( *r == AR.CurExpr ) return(1);
341 r++;
342 }
343 return(0);
344 case IFISFACTORIZED:
345 r = ifp+2; j = ifp[1] - 2;
346 if ( j == 0 ) {
347 if ( ( Expressions[AR.CurExpr].vflags & ISFACTORIZED ) != 0 )
348 return(1);
349 else
350 return(0);
351 }
352 while ( --j >= 0 ) {
353 if ( ( Expressions[*r].vflags & ISFACTORIZED ) == 0 ) return(0);
354 r++;
355 }
356 return(1);
357 case IFOCCURS:
358 {
359 WORD *OccStop = ifp + ifp[1];
360 ifp += 2;
361 while ( ifp < OccStop ) {
362 if ( FindVar(ifp,term) == 1 ) return(1);
363 if ( *ifp == DOTPRODUCT ) ifp += 3;
364 else ifp += 2;
365 }
366 }
367 return(0);
368 default:
369/*
370 Now we have a subexpression. Test first for one with a single item.
371*/
372 if ( ifp[3] == ( ifp[1] + 3 ) ) return(DoIfStatement(BHEAD ifp,term));
373 ifstop = ifp + ifp[1];
374 ifp += 3;
375 break;
376 }
377 }
378/*
379 Here is the composite condition.
380*/
381 coef3 = NumberMalloc("DoIfStatement");
382 Spac1 = NumberMalloc("DoIfStatement");
383 Spac2 = (UWORD *)(TermMalloc("DoIfStatement"));
384 ncoef1 = 0; first = 1; ismul1 = 0;
385 do {
386 if ( !first ) {
387 ifp += 2;
388 if ( ifp[-2] == ORCOND && ncoef1 ) {
389 coef1 = Spac1;
390 ncoef1 = 1; coef1[0] = coef1[1] = 1;
391 goto SkipCond;
392 }
393 if ( ifp[-2] == ANDCOND && !ncoef1 ) goto SkipCond;
394 }
395 coef2 = Spac2;
396 ncoef2 = 1;
397 ismul2 = 0;
398 switch ( *ifp ) {
399 case LONGNUMBER:
400 ncoef2 = ifp[2];
401 j = 2*(ABS(ncoef2));
402 cc = (UWORD *)(ifp + 3);
403 for ( i = 0; i < j; i++ ) coef2[i] = cc[i];
404 break;
405 case MATCH:
406 case TYPEIF:
407 coef2[0] = HowMany(BHEAD ifp,term);
408 coef2[1] = 1;
409 if ( coef2[0] == 0 ) ncoef2 = 0;
410 break;
411 case TYPECOUNT:
412 acoef = CountDo(term,ifp);
413 coef2[0] = ABS(acoef);
414 coef2[1] = 1;
415 if ( acoef == 0 ) ncoef2 = 0;
416 else if ( acoef < 0 ) ncoef2 = -1;
417 break;
418 case TYPEFINDLOOP:
419 acoef = Lus(term,ifp[3],ifp[4],ifp[5],ifp[6],ifp[2]);
420 coef2[0] = ABS(acoef);
421 coef2[1] = 1;
422 if ( acoef == 0 ) ncoef2 = 0;
423 else if ( acoef < 0 ) ncoef2 = -1;
424 break;
425 case COEFFI:
426 r = term + *term;
427 ncoef2 = r[-1];
428 i = ABS(ncoef2);
429 cc = (UWORD *)(r - i);
430 if ( ncoef2 < 0 ) ncoef2 = (ncoef2+1)>>1;
431 else ncoef2 = (ncoef2-1)>>1;
432 i--; for ( j = 0; j < i; j++ ) coef2[j] = cc[j];
433 break;
434 case SUBEXPR:
435 ncoef2 = coef2[0] = DoIfStatement(BHEAD ifp,term);
436 coef2[1] = 1;
437 break;
438 case MULTIPLEOF:
439 ncoef2 = 1;
440 coef2[0] = ifp[2];
441 coef2[1] = 1;
442 ismul2 = 1;
443 break;
444 case IFDOLLAREXTRA:
445 break;
446 case IFDOLLAR:
447 {
448/*
449 We need to abstract a long rational in coef2
450 with length ncoef2. What if that cannot be done?
451*/
452 DOLLARS d = Dollars + ifp[2];
453#ifdef WITHPTHREADS
454 int nummodopt, dtype = -1;
455 if ( AS.MultiThreaded ) {
456 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
457 if ( ifp[2] == ModOptdollars[nummodopt].number ) break;
458 }
459 if ( nummodopt < NumModOptdollars ) {
460 dtype = ModOptdollars[nummodopt].type;
461 if ( dtype == MODLOCAL ) {
462 d = ModOptdollars[nummodopt].dstruct+AT.identity;
463 }
464 else {
465 LOCK(d->pthreadslockread);
466 }
467 }
468 }
469#endif
470/*
471 We have to pick up the IFDOLLAREXTRA pieces for [1], [$y] etc.
472*/
473 if ( ifp+3 < ifstop && ifp[3] == IFDOLLAREXTRA ) {
474 if ( d->nfactors == 0 ) {
475 MLOCK(ErrorMessageLock);
476 MesPrint("Attempt to use a factor of an unfactored $-variable");
477 MUNLOCK(ErrorMessageLock);
478 Terminate(-1);
479 } {
480 WORD num = GetIfDollarNum(ifp+3,ifstop);
481 WORD *w;
482 while ( ifp+3 < ifstop && ifp[3] == IFDOLLAREXTRA ) ifp += 3;
483 if ( num > d->nfactors ) {
484 MLOCK(ErrorMessageLock);
485 MesPrint("Dollar factor number %s out of range",num);
486 MUNLOCK(ErrorMessageLock);
487 Terminate(-1);
488 }
489 if ( num == 0 ) {
490 ncoef2 = 1; coef2[0] = d->nfactors; coef2[1] = 1;
491 break;
492 }
493 w = d->factors[num-1].where;
494 if ( w == 0 ) {
495 if ( d->factors[num-1].value < 0 ) {
496 ncoef2 = -1; coef2[0] = -d->factors[num-1].value; coef2[1] = 1;
497 }
498 else {
499 ncoef2 = 1; coef2[0] = d->factors[num-1].value; coef2[1] = 1;
500 }
501 break;
502 }
503 if ( w[*w] == 0 ) {
504 r = w + *w - 1;
505 i = ABS(*r);
506 if ( i == ( *w-1 ) ) {
507 ncoef2 = (i-1)/2;
508 if ( *r < 0 ) ncoef2 = -ncoef2;
509 i--; cc = coef2; r = w + 1;
510 while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
511 break;
512 }
513 }
514 goto generic;
515 }
516 }
517 else {
518 switch ( d->type ) {
519 case DOLUNDEFINED:
520 if ( AC.UnsureDollarMode == 0 ) {
521#ifdef WITHPTHREADS
522 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
523#endif
524 MLOCK(ErrorMessageLock);
525 MesPrint("$%s is undefined",AC.dollarnames->namebuffer+d->name);
526 MUNLOCK(ErrorMessageLock);
527 Terminate(-1);
528 }
529 ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
530 break;
531 case DOLZERO:
532 ncoef2 = coef2[0] = 0; coef2[1] = 1;
533 break;
534 case DOLSUBTERM:
535 if ( d->where[0] != INDEX || d->where[1] != 3
536 || d->where[2] < 0 || d->where[2] >= AM.OffsetIndex ) {
537 if ( AC.UnsureDollarMode == 0 ) {
538#ifdef WITHPTHREADS
539 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
540#endif
541 MLOCK(ErrorMessageLock);
542 MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
543 MUNLOCK(ErrorMessageLock);
544 Terminate(-1);
545 }
546 ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
547 break;
548 }
549 d->index = d->where[2];
550 /* fall through */
551 case DOLINDEX:
552 if ( d->index == 0 ) {
553 ncoef2 = coef2[0] = 0; coef2[1] = 1;
554 }
555 else if ( d->index > 0 && d->index < AM.OffsetIndex ) {
556 ncoef2 = 1; coef2[0] = d->index; coef2[1] = 1;
557 }
558 else if ( AC.UnsureDollarMode == 0 ) {
559#ifdef WITHPTHREADS
560 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
561#endif
562 MLOCK(ErrorMessageLock);
563 MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
564 MUNLOCK(ErrorMessageLock);
565 Terminate(-1);
566 }
567 ncoef2 = coef2[0] = 0; coef2[1] = 1;
568 break;
569 case DOLWILDARGS:
570 if ( d->where[0] <= -FUNCTION ||
571 ( d->where[0] < 0 && d->where[2] != 0 )
572 || ( d->where[0] > 0 && d->where[d->where[0]] != 0 )
573 ) {
574 if ( AC.UnsureDollarMode == 0 ) {
575#ifdef WITHPTHREADS
576 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
577#endif
578 MLOCK(ErrorMessageLock);
579 MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
580 MUNLOCK(ErrorMessageLock);
581 Terminate(-1);
582 }
583 ncoef2 = coef2[0] = 0; coef2[1] = 1;
584 break;
585 }
586 /* fall through */
587 case DOLARGUMENT:
588 if ( d->where[0] == -SNUMBER ) {
589 if ( d->where[1] == 0 ) {
590 ncoef2 = coef2[0] = 0;
591 }
592 else if ( d->where[1] < 0 ) {
593 ncoef2 = -1;
594 coef2[0] = -d->where[1];
595 }
596 else {
597 ncoef2 = 1;
598 coef2[0] = d->where[1];
599 }
600 coef2[1] = 1;
601 }
602 else if ( d->where[0] == -INDEX
603 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
604 if ( d->where[1] == 0 ) {
605 ncoef2 = coef2[0] = 0; coef2[1] = 1;
606 }
607 else {
608 ncoef2 = 1; coef2[0] = d->where[1];
609 coef2[1] = 1;
610 }
611 }
612 else if ( d->where[0] > 0
613 && d->where[ARGHEAD] == (d->where[0]-ARGHEAD)
614 && ABS(d->where[d->where[0]-1]) ==
615 (d->where[0] - ARGHEAD-1) ) {
616 i = d->where[d->where[0]-1];
617 ncoef2 = (ABS(i)-1)/2;
618 if ( i < 0 ) { ncoef2 = -ncoef2; i = -i; }
619 i--; cc = coef2; r = d->where + ARGHEAD+1;
620 while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
621 }
622 else {
623 if ( AC.UnsureDollarMode == 0 ) {
624#ifdef WITHPTHREADS
625 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
626#endif
627 MLOCK(ErrorMessageLock);
628 MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
629 MUNLOCK(ErrorMessageLock);
630 Terminate(-1);
631 }
632 ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
633 }
634 break;
635 case DOLNUMBER:
636 case DOLTERMS:
637 if ( d->where[d->where[0]] == 0 ) {
638 r = d->where + d->where[0]-1;
639 i = ABS(*r);
640 if ( i == ( d->where[0]-1 ) ) {
641 ncoef2 = (i-1)/2;
642 if ( *r < 0 ) ncoef2 = -ncoef2;
643 i--; cc = coef2; r = d->where + 1;
644 while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
645 break;
646 }
647 }
648generic:;
649 if ( AC.UnsureDollarMode == 0 ) {
650#ifdef WITHPTHREADS
651 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
652#endif
653 MLOCK(ErrorMessageLock);
654 MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
655 MUNLOCK(ErrorMessageLock);
656 Terminate(-1);
657 }
658 ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
659 break;
660 }
661 }
662#ifdef WITHPTHREADS
663 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
664#endif
665 }
666 break;
667 case IFEXPRESSION:
668 r = ifp+2; j = ifp[1] - 2; ncoef2 = 0;
669 while ( --j >= 0 ) {
670 if ( *r == AR.CurExpr ) { ncoef2 = 1; break; }
671 r++;
672 }
673 coef2[0] = ncoef2;
674 coef2[1] = 1;
675 break;
676 case IFISFACTORIZED:
677 r = ifp+2; j = ifp[1] - 2;
678 if ( j == 0 ) {
679 ncoef2 = 0;
680 if ( ( Expressions[AR.CurExpr].vflags & ISFACTORIZED ) != 0 ) {
681 ncoef2 = 1;
682 }
683 }
684 else {
685 ncoef2 = 1;
686 while ( --j >= 0 ) {
687 if ( ( Expressions[*r].vflags & ISFACTORIZED ) == 0 ) {
688 ncoef2 = 0;
689 break;
690 }
691 r++;
692 }
693 }
694 coef2[0] = ncoef2;
695 coef2[1] = 1;
696 break;
697 case IFOCCURS:
698 {
699 WORD *OccStop = ifp + ifp[1], *ifpp = ifp+2;
700 ncoef2 = 0;
701 while ( ifpp < OccStop ) {
702 if ( FindVar(ifpp,term) == 1 ) {
703 ncoef2 = 1; break;
704 }
705 if ( *ifpp == DOTPRODUCT ) ifp += 3;
706 else ifpp += 2;
707 }
708 coef2[0] = ncoef2;
709 coef2[1] = 1;
710 }
711 break;
712 default:
713 break;
714 }
715 if ( !first ) {
716 if ( ifp[-2] != ORCOND && ifp[-2] != ANDCOND ) {
717 if ( ( ifp[-2] == EQUAL || ifp[-2] == NOTEQUAL ) &&
718 ( ismul2 || ismul1 ) ) {
719 if ( ismul1 && ismul2 ) {
720 if ( coef1[0] == coef2[0] ) i = 1;
721 else i = 0;
722 }
723 else {
724 if ( ismul1 ) {
725 if ( ncoef2 )
726 Divvy(BHEAD coef2,&ncoef2,coef1,ncoef1);
727 cc = coef2; ncoef3 = ncoef2;
728 }
729 else {
730 if ( ncoef1 )
731 Divvy(BHEAD coef1,&ncoef1,coef2,ncoef2);
732 cc = coef1; ncoef3 = ncoef1;
733 }
734 if ( ncoef3 < 0 ) ncoef3 = -ncoef3;
735 if ( ncoef3 == 0 ) {
736 if ( ifp[-2] == EQUAL ) i = 1;
737 else i = 0;
738 }
739 else if ( cc[ncoef3] != 1 ) {
740 if ( ifp[-2] == EQUAL ) i = 0;
741 else i = 1;
742 }
743 else {
744 for ( j = 1; j < ncoef3; j++ ) {
745 if ( cc[ncoef3+j] != 0 ) break;
746 }
747 if ( j < ncoef3 ) {
748 if ( ifp[-2] == EQUAL ) i = 0;
749 else i = 1;
750 }
751 else if ( ifp[-2] == EQUAL ) i = 1;
752 else i = 0;
753 }
754 }
755 goto donemul;
756 }
757 else if ( AddRat(BHEAD coef1,ncoef1,coef2,-ncoef2,coef3,&ncoef3) ) {
758 NumberFree(coef3,"DoIfStatement"); NumberFree(Spac1,"DoIfStatement"); TermFree(Spac2,"DoIfStatement");
759 MesCall("DoIfStatement"); return(-1);
760 }
761 switch ( ifp[-2] ) {
762 case GREATER:
763 if ( ncoef3 > 0 ) i = 1;
764 else i = 0;
765 break;
766 case GREATEREQUAL:
767 if ( ncoef3 >= 0 ) i = 1;
768 else i = 0;
769 break;
770 case LESS:
771 if ( ncoef3 < 0 ) i = 1;
772 else i = 0;
773 break;
774 case LESSEQUAL:
775 if ( ncoef3 <= 0 ) i = 1;
776 else i = 0;
777 break;
778 case EQUAL:
779 if ( ncoef3 == 0 ) i = 1;
780 else i = 0;
781 break;
782 case NOTEQUAL:
783 if ( ncoef3 != 0 ) i = 1;
784 else i = 0;
785 break;
786 }
787donemul: if ( i ) { ncoef2 = 1; coef2 = Spac2; coef2[0] = coef2[1] = 1; }
788 else ncoef2 = 0;
789 ismul1 = ismul2 = 0;
790 }
791 }
792 else {
793 first = 0;
794 }
795 coef1 = Spac1;
796 i = 2*ABS(ncoef2);
797 for ( j = 0; j < i; j++ ) coef1[j] = coef2[j];
798 ncoef1 = ncoef2;
799SkipCond:
800 ifp += ifp[1];
801 } while ( ifp < ifstop );
802
803 NumberFree(coef3,"DoIfStatement"); NumberFree(Spac1,"DoIfStatement"); TermFree(Spac2,"DoIfStatement");
804 if ( ncoef1 ) return(1);
805 else return(0);
806}
807
808/*
809 #] DoIfStatement :
810 #[ HowMany : WORD HowMany(ifcode,term)
811
812 Returns the number of times that the pattern in ifcode
813 can be taken out from term. There is a subkey in ifcode[2];
814 The notation is identical to the lhs of an id statement.
815 Most of the code comes from TestMatch.
816*/
817
818WORD HowMany(PHEAD WORD *ifcode, WORD *term)
819{
820 GETBIDENTITY
821 WORD *m, *t, *r, *w, power, RetVal, i, topje, *newterm;
822 WORD *OldWork, *ww, *mm;
823 int *RepSto, RepVal;
824 int numdollars = 0;
825 m = ifcode + IDHEAD;
826 AN.FullProto = m;
827 AN.WildValue = w = m + SUBEXPSIZE;
828 m += m[1];
829 AN.WildStop = m;
830 OldWork = AT.WorkPointer;
831 if ( ( ifcode[4] & 1 ) != 0 ) { /* We have at least one dollar in the pattern */
832 AR.Eside = LHSIDEX;
833 ww = AT.WorkPointer; i = m[0]; mm = m;
834 NCOPY(ww,mm,i);
835 *OldWork += 3;
836 *ww++ = 1; *ww++ = 1; *ww++ = 3;
837 AT.WorkPointer = ww;
838 RepSto = AN.RepPoint;
839 RepVal = *RepSto;
840 NewSort(BHEAD0);
841 if ( Generator(BHEAD OldWork,AR.Cnumlhs) ) {
843 *RepSto = RepVal;
844 AN.RepPoint = RepSto;
845 AT.WorkPointer = OldWork;
846 return(-1);
847 }
848 AT.WorkPointer = ww;
849 if ( EndSort(BHEAD ww,0) < 0 ) {}
850 *RepSto = RepVal;
851 AN.RepPoint = RepSto;
852 if ( *ww == 0 || *(ww+*ww) != 0 ) {
853 if ( AP.lhdollarerror == 0 ) {
854 MLOCK(ErrorMessageLock);
855 MesPrint("&LHS must be one term");
856 MUNLOCK(ErrorMessageLock);
857 AP.lhdollarerror = 1;
858 }
859 AT.WorkPointer = OldWork;
860 return(-1);
861 }
862 m = ww; AT.WorkPointer = ww = m + *m;
863 if ( m[*m-1] < 0 ) { m[*m-1] = -m[*m-1]; }
864 *m -= m[*m-1];
865 AR.Eside = RHSIDE;
866 }
867 else {
868 ww = term + *term;
869 if ( AT.WorkPointer < ww ) AT.WorkPointer = ww;
870 }
871 ClearWild(BHEAD0);
872 while ( w < AN.WildStop ) {
873 if ( *w == LOADDOLLAR ) numdollars++;
874 w += w[1];
875 }
876 AN.RepFunNum = 0;
877 AN.RepFunList = AT.WorkPointer;
878 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
879 topje = cbuf[AT.ebufnum].numrhs;
880 if ( AT.WorkPointer >= AT.WorkTop ) {
881 MLOCK(ErrorMessageLock);
882 MesWork();
883 MUNLOCK(ErrorMessageLock);
884 return(-1);
885 }
886 AN.DisOrderFlag = ifcode[2] & SUBDISORDER;
887 switch ( ifcode[2] & (~SUBDISORDER) ) {
888 case SUBONLY :
889 /* Must be an exact match */
890 AN.UseFindOnly = 1; AN.ForFindOnly = 0;
891/*
892 Copy the term first to scratchterm. This is needed
893 because of the Substitute.
894*/
895 i = *term;
896 t = term; newterm = r = AT.WorkPointer;
897 NCOPY(r,t,i); AT.WorkPointer = r;
898 RetVal = 0;
899 if ( FindRest(BHEAD newterm,m) && ( AN.UsedOtherFind ||
900 FindOnly(BHEAD newterm,m) ) ) {
901 Substitute(BHEAD newterm,m,1);
902 if ( numdollars ) {
903 WildDollars(BHEAD (WORD *)0);
904 numdollars = 0;
905 }
906 ClearWild(BHEAD0);
907 RetVal = 1;
908 }
909 else RetVal = 0;
910 break;
911 case SUBMANY :
912/*
913 Copy the term first to scratchterm. This is needed
914 because of the Substitute.
915*/
916 i = *term;
917 t = term; newterm = r = AT.WorkPointer;
918 NCOPY(r,t,i); AT.WorkPointer = r;
919 RetVal = 0;
920 AN.UseFindOnly = 0;
921 if ( ( power = FindRest(BHEAD newterm,m) ) > 0 ) {
922 if ( ( power = FindOnce(BHEAD newterm,m) ) > 0 ) {
923 AN.UseFindOnly = 0;
924 do {
925 Substitute(BHEAD newterm,m,1);
926 if ( numdollars ) {
927 WildDollars(BHEAD (WORD *)0);
928 numdollars = 0;
929 }
930 ClearWild(BHEAD0);
931 RetVal++;
932 } while ( FindRest(BHEAD newterm,m) && (
933 AN.UsedOtherFind || FindOnce(BHEAD newterm,m) ) );
934 }
935 else if ( power < 0 ) {
936 do {
937 Substitute(BHEAD newterm,m,1);
938 if ( numdollars ) {
939 WildDollars(BHEAD (WORD *)0);
940 numdollars = 0;
941 }
942 ClearWild(BHEAD0);
943 RetVal++;
944 } while ( FindRest(BHEAD newterm,m) );
945 }
946 }
947 else if ( power < 0 ) {
948 if ( FindOnce(BHEAD newterm,m) ) {
949 do {
950 Substitute(BHEAD newterm,m,1);
951 if ( numdollars ) {
952 WildDollars(BHEAD (WORD *)0);
953 numdollars = 0;
954 }
955 ClearWild(BHEAD0);
956 } while ( FindOnce(BHEAD newterm,m) );
957 RetVal = 1;
958 }
959 }
960 break;
961 case SUBONCE :
962/*
963 Copy the term first to scratchterm. This is needed
964 because of the Substitute.
965*/
966 i = *term;
967 t = term; newterm = r = AT.WorkPointer;
968 NCOPY(r,t,i); AT.WorkPointer = r;
969 RetVal = 0;
970 AN.UseFindOnly = 0;
971 if ( FindRest(BHEAD newterm,m) && ( AN.UsedOtherFind || FindOnce(BHEAD newterm,m) ) ) {
972 Substitute(BHEAD newterm,m,1);
973 if ( numdollars ) {
974 WildDollars(BHEAD (WORD *)0);
975 numdollars = 0;
976 }
977 ClearWild(BHEAD0);
978 RetVal = 1;
979 }
980 else RetVal = 0;
981 break;
982 case SUBMULTI :
983 RetVal = FindMulti(BHEAD term,m);
984 break;
985 case SUBVECTOR :
986 RetVal = 0;
987 for ( i = 0; i < *term; i++ ) ww[i] = term[i];
988 while ( ( power = FindAll(BHEAD ww,m,AR.Cnumlhs,ifcode) ) != 0 ) { RetVal += power; }
989 break;
990 case SUBSELECT :
991 ifcode += IDHEAD; ifcode += ifcode[1]; ifcode += *ifcode;
992 AN.UseFindOnly = 1; AN.ForFindOnly = ifcode;
993 if ( FindRest(BHEAD term,m) && ( AN.UsedOtherFind ||
994 FindOnly(BHEAD term,m) ) ) RetVal = 1;
995 else RetVal = 0;
996 break;
997 default :
998 RetVal = 0;
999 break;
1000 }
1001 AT.WorkPointer = AN.RepFunList;
1002 cbuf[AT.ebufnum].numrhs = topje;
1003 return(RetVal);
1004}
1005
1006/*
1007 #] HowMany :
1008 #[ DoubleIfBuffers :
1009*/
1010
1011VOID DoubleIfBuffers()
1012{
1013 int newmax, i;
1014 WORD *newsumcheck;
1015 LONG *newheap, *newifcount;
1016 if ( AC.MaxIf == 0 ) newmax = 10;
1017 else newmax = 2*AC.MaxIf;
1018 newheap = (LONG *)Malloc1(sizeof(LONG)*(newmax+1),"IfHeap");
1019 newsumcheck = (WORD *)Malloc1(sizeof(WORD)*(newmax+1),"IfSumCheck");
1020 newifcount = (LONG *)Malloc1(sizeof(LONG)*(newmax+1),"IfCount");
1021 if ( AC.MaxIf ) {
1022 for ( i = 0; i < AC.MaxIf; i++ ) {
1023 newheap[i] = AC.IfHeap[i];
1024 newsumcheck[i] = AC.IfSumCheck[i];
1025 newifcount[i] = AC.IfCount[i];
1026 }
1027 AC.IfStack = (AC.IfStack-AC.IfHeap) + newheap;
1028 M_free(AC.IfHeap,"AC.IfHeap");
1029 M_free(AC.IfCount,"AC.IfCount");
1030 M_free(AC.IfSumCheck,"AC.IfSumCheck");
1031 }
1032 else {
1033 AC.IfStack = newheap;
1034 }
1035 AC.IfHeap = newheap;
1036 AC.IfSumCheck = newsumcheck;
1037 AC.IfCount = newifcount;
1038 AC.MaxIf = newmax;
1039}
1040
1041/*
1042 #] DoubleIfBuffers :
1043 #] If statement :
1044 #[ Switch statement :
1045 #[ DoSwitch :
1046*/
1047
1048int DoSwitch(PHEAD WORD *term, WORD *lhs)
1049{
1050/*
1051 For the moment we ignore the compiler buffer problems.
1052*/
1053 WORD numdollar = lhs[2];
1054 WORD ncase = DolToNumber(BHEAD numdollar);
1055 SWITCHTABLE *swtab = FindCase(lhs[3],ncase);
1056 return(Generator(BHEAD term,swtab->value));
1057}
1058
1059/*
1060 #] DoSwitch :
1061 #[ DoEndSwitch :
1062*/
1063
1064int DoEndSwitch(PHEAD WORD *term, WORD *lhs)
1065{
1066 SWITCH *sw = AC.SwitchArray+lhs[2];
1067 return(Generator(BHEAD term,sw->endswitch.value+1));
1068}
1069
1070/*
1071 #] DoEndSwitch :
1072 #[ FindCase :
1073*/
1074
1075SWITCHTABLE *FindCase(WORD nswitch, WORD ncase)
1076{
1077/*
1078 First find the switch table and determine how we have to search.
1079*/
1080 SWITCH *sw = AC.SwitchArray+nswitch;
1081 WORD hi, lo, med;
1082 if ( sw->typetable == DENSETABLE ) {
1083 med = ncase - sw->caseoffset;
1084 if ( med >= sw->numcases || med < 0 ) return(&sw->defaultcase);
1085 }
1086 else {
1087/*
1088 We need a binary search in the table.
1089*/
1090 if ( ncase > sw->maxcase || ncase < sw->mincase ) return(&sw->defaultcase);
1091 hi = sw->numcases-1; lo = 0;
1092 for(;;) {
1093 med = (hi+lo)/2;
1094 if ( ncase == sw->table[med].ncase ) break;
1095 else if ( ncase > sw->table[med].ncase ) {
1096 lo = med+1;
1097 if ( lo > hi ) return(&sw->defaultcase);
1098 }
1099 else {
1100 hi = med-1;
1101 if ( hi < lo ) return(&sw->defaultcase);
1102 }
1103 }
1104 }
1105 return(&sw->table[med]);
1106}
1107
1108/*
1109 #] FindCase :
1110 #[ DoubleSwitchBuffers :
1111*/
1112
1113int DoubleSwitchBuffers()
1114{
1115 int newmax, i;
1116 SWITCH *newarray;
1117 WORD *newheap;
1118 if ( AC.MaxSwitch == 0 ) newmax = 10;
1119 else newmax = 2*AC.MaxSwitch;
1120 newarray = (SWITCH *)Malloc1(sizeof(SWITCH)*(newmax+1),"SwitchArray");
1121 newheap = (WORD *)Malloc1(sizeof(WORD)*(newmax+1),"SwitchHeap");
1122 if ( AC.MaxSwitch ) {
1123 for ( i = 0; i < AC.MaxSwitch; i++ ) {
1124 newarray[i] = AC.SwitchArray[i];
1125 newheap[i] = AC.SwitchHeap[i];
1126 }
1127 M_free(AC.SwitchHeap,"AC.SwitchHeap");
1128 M_free(AC.SwitchArray,"AC.SwitchArray");
1129 }
1130 for ( i = AC.MaxSwitch; i <= newmax; i++ ) {
1131 newarray[i].table = 0;
1132 newarray[i].tablesize = 0;
1133 newarray[i].defaultcase.ncase = 0;
1134 newarray[i].defaultcase.value = 0;
1135 newarray[i].defaultcase.compbuffer = 0;
1136 newarray[i].endswitch.ncase = 0;
1137 newarray[i].endswitch.value = 0;
1138 newarray[i].endswitch.compbuffer = 0;
1139 newarray[i].typetable = 0;
1140 newarray[i].mincase = 0;
1141 newarray[i].maxcase = 0;
1142 newarray[i].numcases = 0;
1143 newarray[i].caseoffset = 0;
1144 newarray[i].iflevel = 0;
1145 newarray[i].whilelevel = 0;
1146 newarray[i].nestingsum = 0;
1147 newheap[i] = 0;
1148 }
1149 AC.SwitchArray = newarray;
1150 AC.SwitchHeap = newheap;
1151 AC.MaxSwitch = newmax;
1152 return(0);
1153}
1154
1155/*
1156 #] DoubleSwitchBuffers :
1157 #[ SwitchSplitMerge :
1158
1159 Sorts an array of WORDs. No adding of equal objects.
1160*/
1161
1162VOID SwitchSplitMergeRec(SWITCHTABLE *array,WORD num,SWITCHTABLE *auxarray)
1163{
1164 WORD n1,n2,i,j,k;
1165 SWITCHTABLE *t1,*t2, t;
1166 if ( num < 2 ) return;
1167 if ( num == 2 ) {
1168 if ( array[0].ncase > array[1].ncase ) {
1169 t = array[0]; array[0] = array[1]; array[1] = t;
1170 }
1171 return;
1172 }
1173 n1 = num/2;
1174 n2 = num - n1;
1175 SwitchSplitMergeRec(array,n1,auxarray);
1176 SwitchSplitMergeRec(array+n1,n2,auxarray);
1177 if ( array[n1-1].ncase <= array[n1].ncase ) return;
1178
1179 t1 = array; t2 = auxarray; i = n1; NCOPY(t2,t1,i);
1180 i = 0; j = n1; k = 0;
1181 while ( i < n1 && j < num ) {
1182 if ( auxarray[i].ncase <= array[j].ncase ) { array[k++] = auxarray[i++]; }
1183 else { array[k++] = array[j++]; }
1184 }
1185 while ( i < n1 ) array[k++] = auxarray[i++];
1186/*
1187 Remember: remnants of j are still in place!
1188*/
1189}
1190
1191VOID SwitchSplitMerge(SWITCHTABLE *array,WORD num)
1192{
1193 SWITCHTABLE *auxarray = (SWITCHTABLE *)Malloc1(sizeof(SWITCHTABLE)*num/2,"SwitchSplitMerge");
1194 SwitchSplitMergeRec(array,num,auxarray);
1195 M_free(auxarray,"SwitchSplitMerge");
1196}
1197
1198/*
1199 #] SwitchSplitMerge :
1200 #] Switch statement :
1201*/
WORD NewSort(PHEAD0)
Definition sort.c:592
LONG EndSort(PHEAD WORD *, int)
Definition sort.c:682
WORD Generator(PHEAD WORD *, WORD)
Definition proces.c:3101
VOID LowerSortLevel()
Definition sort.c:4727