FORM  4.1
if.c
Go to the documentation of this file.
1 
5 /* #[ License : */
6 /*
7  * Copyright (C) 1984-2013 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 
106 WORD 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);
131 getnumber:;
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  #[ DoIfStatement : WORD DoIfStatement(PHEAD ifcode,term)
171 
172  The execution time part of the if-statement.
173  The arguments are a pointer to the TYPEIF and a pointer to the term.
174  The answer is either 1 (success) or 0 (fail).
175  The calling routine can figure out where to go in case of failure
176  by picking up gotolevel.
177  Note that the whole setup asks for recursions.
178 */
179 
180 WORD DoIfStatement(PHEAD WORD *ifcode, WORD *term)
181 {
182  GETBIDENTITY
183  WORD *ifstop, *ifp;
184  UWORD *coef1 = 0, *coef2, *coef3, *cc;
185  WORD ncoef1, ncoef2, ncoef3, i = 0, first, *r, acoef, ismul1, ismul2, j;
186  UWORD *Spac1, *Spac2;
187  ifstop = ifcode + ifcode[1];
188  ifp = ifcode + 3;
189  if ( ifp >= ifstop ) return(1);
190  if ( ( ifp + ifp[1] ) >= ifstop ) {
191  switch ( *ifp ) {
192  case LONGNUMBER:
193  if ( ifp[2] ) return(1);
194  else return(0);
195  case MATCH:
196  case TYPEIF:
197  if ( HowMany(BHEAD ifp,term) ) return(1);
198  else return(0);
199  case TYPEFINDLOOP:
200  if ( Lus(term,ifp[3],ifp[4],ifp[5],ifp[6],ifp[2]) ) return(1);
201  else return(0);
202  case TYPECOUNT:
203  if ( CountDo(term,ifp) ) return(1);
204  else return(0);
205  case COEFFI:
206  case MULTIPLEOF:
207  return(1);
208  case IFDOLLAR:
209  {
210  DOLLARS d = Dollars + ifp[2];
211 #ifdef WITHPTHREADS
212  int nummodopt, dtype = -1;
213  if ( AS.MultiThreaded ) {
214  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
215  if ( ifp[2] == ModOptdollars[nummodopt].number ) break;
216  }
217  if ( nummodopt < NumModOptdollars ) {
218  dtype = ModOptdollars[nummodopt].type;
219  if ( dtype == MODLOCAL ) {
220  d = ModOptdollars[nummodopt].dstruct+AT.identity;
221  }
222  }
223  }
224  dtype = d->type;
225 #else
226  int dtype = d->type; /* We use dtype to make the operation atomic */
227 #endif
228  if ( dtype == DOLZERO ) return(0);
229  if ( dtype == DOLUNDEFINED ) {
230  if ( AC.UnsureDollarMode == 0 ) {
231  MesPrint("$%s is undefined",AC.dollarnames->namebuffer+d->name);
232  Terminate(-1);
233  }
234  }
235  }
236  return(1);
237  case IFEXPRESSION:
238  r = ifp+2; j = ifp[1] - 2;
239  while ( --j >= 0 ) {
240  if ( *r == AR.CurExpr ) return(1);
241  r++;
242  }
243  return(0);
244  case IFISFACTORIZED:
245  r = ifp+2; j = ifp[1] - 2;
246  if ( j == 0 ) {
247  if ( ( Expressions[AR.CurExpr].vflags & ISFACTORIZED ) != 0 )
248  return(1);
249  else
250  return(0);
251  }
252  while ( --j >= 0 ) {
253  if ( ( Expressions[*r].vflags & ISFACTORIZED ) == 0 ) return(0);
254  r++;
255  }
256  return(1);
257  default:
258 /*
259  Now we have a subexpression. Test first for one with a single item.
260 */
261  if ( ifp[3] == ( ifp[1] + 3 ) ) return(DoIfStatement(BHEAD ifp,term));
262  ifstop = ifp + ifp[1];
263  ifp += 3;
264  break;
265  }
266  }
267 /*
268  Here is the composite condition.
269 */
270  coef3 = NumberMalloc("DoIfStatement");
271  Spac1 = NumberMalloc("DoIfStatement");
272  Spac2 = (UWORD *)(TermMalloc("DoIfStatement"));
273  ncoef1 = 0; first = 1; ismul1 = 0;
274  do {
275  if ( !first ) {
276  ifp += 2;
277  if ( ifp[-2] == ORCOND && ncoef1 ) {
278  coef1 = Spac1;
279  ncoef1 = 1; coef1[0] = coef1[1] = 1;
280  goto SkipCond;
281  }
282  if ( ifp[-2] == ANDCOND && !ncoef1 ) goto SkipCond;
283  }
284  coef2 = Spac2;
285  ncoef2 = 1;
286  ismul2 = 0;
287  switch ( *ifp ) {
288  case LONGNUMBER:
289  ncoef2 = ifp[2];
290  j = 2*(ABS(ncoef2));
291  cc = (UWORD *)(ifp + 3);
292  for ( i = 0; i < j; i++ ) coef2[i] = cc[i];
293  break;
294  case MATCH:
295  case TYPEIF:
296  coef2[0] = HowMany(BHEAD ifp,term);
297  coef2[1] = 1;
298  if ( coef2[0] == 0 ) ncoef2 = 0;
299  break;
300  case TYPECOUNT:
301  acoef = CountDo(term,ifp);
302  coef2[0] = ABS(acoef);
303  coef2[1] = 1;
304  if ( acoef == 0 ) ncoef2 = 0;
305  else if ( acoef < 0 ) ncoef2 = -1;
306  break;
307  case TYPEFINDLOOP:
308  acoef = Lus(term,ifp[3],ifp[4],ifp[5],ifp[6],ifp[2]);
309  coef2[0] = ABS(acoef);
310  coef2[1] = 1;
311  if ( acoef == 0 ) ncoef2 = 0;
312  else if ( acoef < 0 ) ncoef2 = -1;
313  break;
314  case COEFFI:
315  r = term + *term;
316  ncoef2 = r[-1];
317  i = ABS(ncoef2);
318  cc = (UWORD *)(r - i);
319  if ( ncoef2 < 0 ) ncoef2 = (ncoef2+1)>>1;
320  else ncoef2 = (ncoef2-1)>>1;
321  i--; for ( j = 0; j < i; j++ ) coef2[j] = cc[j];
322  break;
323  case SUBEXPR:
324  ncoef2 = coef2[0] = DoIfStatement(BHEAD ifp,term);
325  coef2[1] = 1;
326  break;
327  case MULTIPLEOF:
328  ncoef2 = 1;
329  coef2[0] = ifp[2];
330  coef2[1] = 1;
331  ismul2 = 1;
332  break;
333  case IFDOLLAREXTRA:
334  break;
335  case IFDOLLAR:
336  {
337 /*
338  We need to abstract a long rational in coef2
339  with length ncoef2. What if that cannot be done?
340 */
341  DOLLARS d = Dollars + ifp[2];
342 #ifdef WITHPTHREADS
343  int nummodopt, dtype = -1;
344  if ( AS.MultiThreaded ) {
345  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
346  if ( ifp[2] == ModOptdollars[nummodopt].number ) break;
347  }
348  if ( nummodopt < NumModOptdollars ) {
349  dtype = ModOptdollars[nummodopt].type;
350  if ( dtype == MODLOCAL ) {
351  d = ModOptdollars[nummodopt].dstruct+AT.identity;
352  }
353  else {
354  LOCK(d->pthreadslockread);
355  }
356  }
357  }
358 #endif
359 /*
360  We have to pick up the IFDOLLAREXTRA pieces for [1], [$y] etc.
361 */
362  if ( ifp+3 < ifstop && ifp[3] == IFDOLLAREXTRA ) {
363  if ( d->nfactors == 0 ) {
364  MLOCK(ErrorMessageLock);
365  MesPrint("Attempt to use a factor of an unfactored $-variable");
366  MUNLOCK(ErrorMessageLock);
367  Terminate(-1);
368  } {
369  WORD num = GetIfDollarNum(ifp+3,ifstop);
370  WORD *w;
371  while ( ifp+3 < ifstop && ifp[3] == IFDOLLAREXTRA ) ifp += 3;
372  if ( num > d->nfactors ) {
373  MLOCK(ErrorMessageLock);
374  MesPrint("Dollar factor number %s out of range",num);
375  MUNLOCK(ErrorMessageLock);
376  Terminate(-1);
377  }
378  if ( num == 0 ) {
379  ncoef2 = 1; coef2[0] = d->nfactors; coef2[1] = 1;
380  break;
381  }
382  w = d->factors[num-1].where;
383  if ( w == 0 ) {
384  if ( d->factors[num-1].value < 0 ) {
385  ncoef2 = -1; coef2[0] = -d->factors[num-1].value; coef2[1] = 1;
386  }
387  else {
388  ncoef2 = 1; coef2[0] = d->factors[num-1].value; coef2[1] = 1;
389  }
390  break;
391  }
392  if ( w[*w] == 0 ) {
393  r = w + *w - 1;
394  i = ABS(*r);
395  if ( i == ( *w-1 ) ) {
396  ncoef2 = (i-1)/2;
397  if ( *r < 0 ) ncoef2 = -ncoef2;
398  i--; cc = coef2; r = w + 1;
399  while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
400  break;
401  }
402  }
403  goto generic;
404  }
405  }
406  else {
407  switch ( d->type ) {
408  case DOLUNDEFINED:
409  if ( AC.UnsureDollarMode == 0 ) {
410 #ifdef WITHPTHREADS
411  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
412 #endif
413  MLOCK(ErrorMessageLock);
414  MesPrint("$%s is undefined",AC.dollarnames->namebuffer+d->name);
415  MUNLOCK(ErrorMessageLock);
416  Terminate(-1);
417  }
418  ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
419  break;
420  case DOLZERO:
421  ncoef2 = coef2[0] = 0; coef2[1] = 1;
422  break;
423  case DOLSUBTERM:
424  if ( d->where[0] != INDEX || d->where[1] != 3
425  || d->where[2] < 0 || d->where[2] >= AM.OffsetIndex ) {
426  if ( AC.UnsureDollarMode == 0 ) {
427 #ifdef WITHPTHREADS
428  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
429 #endif
430  MLOCK(ErrorMessageLock);
431  MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
432  MUNLOCK(ErrorMessageLock);
433  Terminate(-1);
434  }
435  ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
436  break;
437  }
438  d->index = d->where[2];
439  case DOLINDEX:
440  if ( d->index == 0 ) {
441  ncoef2 = coef2[0] = 0; coef2[1] = 1;
442  }
443  else if ( d->index > 0 && d->index < AM.OffsetIndex ) {
444  ncoef2 = 1; coef2[0] = d->index; coef2[1] = 1;
445  }
446  else if ( AC.UnsureDollarMode == 0 ) {
447 #ifdef WITHPTHREADS
448  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
449 #endif
450  MLOCK(ErrorMessageLock);
451  MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
452  MUNLOCK(ErrorMessageLock);
453  Terminate(-1);
454  }
455  ncoef2 = coef2[0] = 0; coef2[1] = 1;
456  break;
457  case DOLWILDARGS:
458  if ( d->where[0] <= -FUNCTION ||
459  ( d->where[0] < 0 && d->where[2] != 0 )
460  || ( d->where[0] > 0 && d->where[d->where[0]] != 0 )
461  ) {
462  if ( AC.UnsureDollarMode == 0 ) {
463 #ifdef WITHPTHREADS
464  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
465 #endif
466  MLOCK(ErrorMessageLock);
467  MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
468  MUNLOCK(ErrorMessageLock);
469  Terminate(-1);
470  }
471  ncoef2 = coef2[0] = 0; coef2[1] = 1;
472  break;
473  }
474  case DOLARGUMENT:
475  if ( d->where[0] == -SNUMBER ) {
476  if ( d->where[1] == 0 ) {
477  ncoef2 = coef2[0] = 0;
478  }
479  else if ( d->where[1] < 0 ) {
480  ncoef2 = -1;
481  coef2[0] = -d->where[1];
482  }
483  else {
484  ncoef2 = 1;
485  coef2[0] = d->where[1];
486  }
487  coef2[1] = 1;
488  }
489  else if ( d->where[0] == -INDEX
490  && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
491  if ( d->where[1] == 0 ) {
492  ncoef2 = coef2[0] = 0; coef2[1] = 1;
493  }
494  else {
495  ncoef2 = 1; coef2[0] = d->where[1];
496  coef2[1] = 1;
497  }
498  }
499  else if ( d->where[0] > 0
500  && d->where[ARGHEAD] == (d->where[0]-ARGHEAD)
501  && ABS(d->where[d->where[0]-1]) ==
502  (d->where[0] - ARGHEAD-1) ) {
503  i = d->where[d->where[0]-1];
504  ncoef2 = (ABS(i)-1)/2;
505  if ( i < 0 ) { ncoef2 = -ncoef2; i = -i; }
506  i--; cc = coef2; r = d->where + ARGHEAD+1;
507  while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
508  }
509  else {
510  if ( AC.UnsureDollarMode == 0 ) {
511 #ifdef WITHPTHREADS
512  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
513 #endif
514  MLOCK(ErrorMessageLock);
515  MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
516  MUNLOCK(ErrorMessageLock);
517  Terminate(-1);
518  }
519  ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
520  }
521  break;
522  case DOLNUMBER:
523  case DOLTERMS:
524  if ( d->where[d->where[0]] == 0 ) {
525  r = d->where + d->where[0]-1;
526  i = ABS(*r);
527  if ( i == ( d->where[0]-1 ) ) {
528  ncoef2 = (i-1)/2;
529  if ( *r < 0 ) ncoef2 = -ncoef2;
530  i--; cc = coef2; r = d->where + 1;
531  while ( --i >= 0 ) *cc++ = (UWORD)(*r++);
532  break;
533  }
534  }
535 generic:;
536  if ( AC.UnsureDollarMode == 0 ) {
537 #ifdef WITHPTHREADS
538  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
539 #endif
540  MLOCK(ErrorMessageLock);
541  MesPrint("$%s is of wrong type",AC.dollarnames->namebuffer+d->name);
542  MUNLOCK(ErrorMessageLock);
543  Terminate(-1);
544  }
545  ncoef2 = 0; coef2[0] = 0; coef2[1] = 1;
546  break;
547  }
548  }
549 #ifdef WITHPTHREADS
550  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
551 #endif
552  }
553  break;
554  case IFEXPRESSION:
555  r = ifp+2; j = ifp[1] - 2; ncoef2 = 0;
556  while ( --j >= 0 ) {
557  if ( *r == AR.CurExpr ) { ncoef2 = 1; break; }
558  r++;
559  }
560  coef2[0] = ncoef2;
561  coef2[1] = 1;
562  break;
563  case IFISFACTORIZED:
564  r = ifp+2; j = ifp[1] - 2;
565  if ( j == 0 ) {
566  ncoef2 = 0;
567  if ( ( Expressions[AR.CurExpr].vflags & ISFACTORIZED ) != 0 ) {
568  ncoef2 = 1;
569  }
570  }
571  else {
572  ncoef2 = 1;
573  while ( --j >= 0 ) {
574  if ( ( Expressions[*r].vflags & ISFACTORIZED ) == 0 ) {
575  ncoef2 = 0;
576  break;
577  }
578  r++;
579  }
580  }
581  coef2[0] = ncoef2;
582  coef2[1] = 1;
583  break;
584  default:
585  break;
586  }
587  if ( !first ) {
588  if ( ifp[-2] != ORCOND && ifp[-2] != ANDCOND ) {
589  if ( ( ifp[-2] == EQUAL || ifp[-2] == NOTEQUAL ) &&
590  ( ismul2 || ismul1 ) ) {
591  if ( ismul1 && ismul2 ) {
592  if ( coef1[0] == coef2[0] ) i = 1;
593  else i = 0;
594  }
595  else {
596  if ( ismul1 ) {
597  if ( ncoef2 )
598  Divvy(BHEAD coef2,&ncoef2,coef1,ncoef1);
599  cc = coef2; ncoef3 = ncoef2;
600  }
601  else {
602  if ( ncoef1 )
603  Divvy(BHEAD coef1,&ncoef1,coef2,ncoef2);
604  cc = coef1; ncoef3 = ncoef1;
605  }
606  if ( ncoef3 < 0 ) ncoef3 = -ncoef3;
607  if ( ncoef3 == 0 ) {
608  if ( ifp[-2] == EQUAL ) i = 1;
609  else i = 0;
610  }
611  else if ( cc[ncoef3] != 1 ) {
612  if ( ifp[-2] == EQUAL ) i = 0;
613  else i = 1;
614  }
615  else {
616  for ( j = 1; j < ncoef3; j++ ) {
617  if ( cc[ncoef3+j] != 0 ) break;
618  }
619  if ( j < ncoef3 ) {
620  if ( ifp[-2] == EQUAL ) i = 0;
621  else i = 1;
622  }
623  else if ( ifp[-2] == EQUAL ) i = 1;
624  else i = 0;
625  }
626  }
627  goto donemul;
628  }
629  else if ( AddRat(BHEAD coef1,ncoef1,coef2,-ncoef2,coef3,&ncoef3) ) {
630  NumberFree(coef3,"DoIfStatement"); NumberFree(Spac1,"DoIfStatement"); TermFree(Spac2,"DoIfStatement");
631  MesCall("DoIfStatement"); return(-1);
632  }
633  switch ( ifp[-2] ) {
634  case GREATER:
635  if ( ncoef3 > 0 ) i = 1;
636  else i = 0;
637  break;
638  case GREATEREQUAL:
639  if ( ncoef3 >= 0 ) i = 1;
640  else i = 0;
641  break;
642  case LESS:
643  if ( ncoef3 < 0 ) i = 1;
644  else i = 0;
645  break;
646  case LESSEQUAL:
647  if ( ncoef3 <= 0 ) i = 1;
648  else i = 0;
649  break;
650  case EQUAL:
651  if ( ncoef3 == 0 ) i = 1;
652  else i = 0;
653  break;
654  case NOTEQUAL:
655  if ( ncoef3 != 0 ) i = 1;
656  else i = 0;
657  break;
658  }
659 donemul: if ( i ) { ncoef2 = 1; coef2 = Spac2; coef2[0] = coef2[1] = 1; }
660  else ncoef2 = 0;
661  ismul1 = ismul2 = 0;
662  }
663  }
664  else {
665  first = 0;
666  }
667  coef1 = Spac1;
668  i = 2*ABS(ncoef2);
669  for ( j = 0; j < i; j++ ) coef1[j] = coef2[j];
670  ncoef1 = ncoef2;
671 SkipCond:
672  ifp += ifp[1];
673  } while ( ifp < ifstop );
674 
675  NumberFree(coef3,"DoIfStatement"); NumberFree(Spac1,"DoIfStatement"); TermFree(Spac2,"DoIfStatement");
676  if ( ncoef1 ) return(1);
677  else return(0);
678 }
679 
680 /*
681  #] DoIfStatement :
682  #[ HowMany : WORD HowMany(ifcode,term)
683 
684  Returns the number of times that the pattern in ifcode
685  can be taken out from term. There is a subkey in ifcode[2];
686  The notation is identical to the lhs of an id statement.
687  Most of the code comes from TestMatch.
688 */
689 
690 WORD HowMany(PHEAD WORD *ifcode, WORD *term)
691 {
692  GETBIDENTITY
693  WORD *m, *t, *r, *w, power, RetVal, i, topje, *newterm;
694  WORD *OldWork, *ww, *mm;
695  int *RepSto, RepVal;
696  int numdollars = 0;
697  m = ifcode + IDHEAD;
698  AN.FullProto = m;
699  AN.WildValue = w = m + SUBEXPSIZE;
700  m += m[1];
701  AN.WildStop = m;
702  OldWork = AT.WorkPointer;
703  if ( ( ifcode[4] & 1 ) != 0 ) { /* We have at least one dollar in the pattern */
704  AR.Eside = LHSIDEX;
705  ww = AT.WorkPointer; i = m[0]; mm = m;
706  NCOPY(ww,mm,i);
707  *OldWork += 3;
708  *ww++ = 1; *ww++ = 1; *ww++ = 3;
709  AT.WorkPointer = ww;
710  RepSto = AN.RepPoint;
711  RepVal = *RepSto;
712  NewSort(BHEAD0);
713  if ( Generator(BHEAD OldWork,AR.Cnumlhs) ) {
714  LowerSortLevel();
715  *RepSto = RepVal;
716  AN.RepPoint = RepSto;
717  AT.WorkPointer = OldWork;
718  return(-1);
719  }
720  AT.WorkPointer = ww;
721  if ( EndSort(BHEAD ww,0) < 0 ) {}
722  *RepSto = RepVal;
723  AN.RepPoint = RepSto;
724  if ( *ww == 0 || *(ww+*ww) != 0 ) {
725  if ( AP.lhdollarerror == 0 ) {
726  MLOCK(ErrorMessageLock);
727  MesPrint("&LHS must be one term");
728  MUNLOCK(ErrorMessageLock);
729  AP.lhdollarerror = 1;
730  }
731  AT.WorkPointer = OldWork;
732  return(-1);
733  }
734  m = ww; AT.WorkPointer = ww = m + *m;
735  if ( m[*m-1] < 0 ) { m[*m-1] = -m[*m-1]; }
736  *m -= m[*m-1];
737  AR.Eside = RHSIDE;
738  }
739  else {
740  ww = term + *term;
741  if ( AT.WorkPointer < ww ) AT.WorkPointer = ww;
742  }
743  ClearWild(BHEAD0);
744  while ( w < AN.WildStop ) {
745  if ( *w == LOADDOLLAR ) numdollars++;
746  w += w[1];
747  }
748  AN.RepFunNum = 0;
749  AN.RepFunList = AT.WorkPointer;
750  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
751  topje = cbuf[AT.ebufnum].numrhs;
752  if ( AT.WorkPointer >= AT.WorkTop ) {
753  MLOCK(ErrorMessageLock);
754  MesWork();
755  MUNLOCK(ErrorMessageLock);
756  return(-1);
757  }
758  AN.DisOrderFlag = ifcode[2] & SUBDISORDER;
759  switch ( ifcode[2] & (~SUBDISORDER) ) {
760  case SUBONLY :
761  /* Must be an exact match */
762  AN.UseFindOnly = 1; AN.ForFindOnly = 0;
763 /*
764  Copy the term first to scratchterm. This is needed
765  because of the Substitute.
766 */
767  i = *term;
768  t = term; newterm = r = AT.WorkPointer;
769  NCOPY(r,t,i); AT.WorkPointer = r;
770  RetVal = 0;
771  if ( FindRest(BHEAD newterm,m) && ( AN.UsedOtherFind ||
772  FindOnly(BHEAD newterm,m) ) ) {
773  Substitute(BHEAD newterm,m,1);
774  if ( numdollars ) {
775  WildDollars(BHEAD0);
776  numdollars = 0;
777  }
778  ClearWild(BHEAD0);
779  RetVal = 1;
780  }
781  else RetVal = 0;
782  break;
783  case SUBMANY :
784 /*
785  Copy the term first to scratchterm. This is needed
786  because of the Substitute.
787 */
788  i = *term;
789  t = term; newterm = r = AT.WorkPointer;
790  NCOPY(r,t,i); AT.WorkPointer = r;
791  RetVal = 0;
792  AN.UseFindOnly = 0;
793  if ( ( power = FindRest(BHEAD newterm,m) ) > 0 ) {
794  if ( ( power = FindOnce(BHEAD newterm,m) ) > 0 ) {
795  AN.UseFindOnly = 0;
796  do {
797  Substitute(BHEAD newterm,m,1);
798  if ( numdollars ) {
799  WildDollars(BHEAD0);
800  numdollars = 0;
801  }
802  ClearWild(BHEAD0);
803  RetVal++;
804  } while ( FindRest(BHEAD newterm,m) && (
805  AN.UsedOtherFind || FindOnce(BHEAD newterm,m) ) );
806  }
807  else if ( power < 0 ) {
808  do {
809  Substitute(BHEAD newterm,m,1);
810  if ( numdollars ) {
811  WildDollars(BHEAD0);
812  numdollars = 0;
813  }
814  ClearWild(BHEAD0);
815  RetVal++;
816  } while ( FindRest(BHEAD newterm,m) );
817  }
818  }
819  else if ( power < 0 ) {
820  if ( FindOnce(BHEAD newterm,m) ) {
821  do {
822  Substitute(BHEAD newterm,m,1);
823  if ( numdollars ) {
824  WildDollars(BHEAD0);
825  numdollars = 0;
826  }
827  ClearWild(BHEAD0);
828  } while ( FindOnce(BHEAD newterm,m) );
829  RetVal = 1;
830  }
831  }
832  break;
833  case SUBONCE :
834 /*
835  Copy the term first to scratchterm. This is needed
836  because of the Substitute.
837 */
838  i = *term;
839  t = term; newterm = r = AT.WorkPointer;
840  NCOPY(r,t,i); AT.WorkPointer = r;
841  RetVal = 0;
842  AN.UseFindOnly = 0;
843  if ( FindRest(BHEAD newterm,m) && ( AN.UsedOtherFind || FindOnce(BHEAD newterm,m) ) ) {
844  Substitute(BHEAD newterm,m,1);
845  if ( numdollars ) {
846  WildDollars(BHEAD0);
847  numdollars = 0;
848  }
849  ClearWild(BHEAD0);
850  RetVal = 1;
851  }
852  else RetVal = 0;
853  break;
854  case SUBMULTI :
855  RetVal = FindMulti(BHEAD term,m);
856  break;
857  case SUBALL :
858  RetVal = 0;
859  for ( i = 0; i < *term; i++ ) ww[i] = term[i];
860  while ( ( power = FindAll(BHEAD ww,m,AR.Cnumlhs,ifcode) ) != 0 ) { RetVal += power; }
861  break;
862  case SUBSELECT :
863  ifcode += IDHEAD; ifcode += ifcode[1]; ifcode += *ifcode;
864  AN.UseFindOnly = 1; AN.ForFindOnly = ifcode;
865  if ( FindRest(BHEAD term,m) && ( AN.UsedOtherFind ||
866  FindOnly(BHEAD term,m) ) ) RetVal = 1;
867  else RetVal = 0;
868  break;
869  default :
870  RetVal = 0;
871  break;
872  }
873  AT.WorkPointer = AN.RepFunList;
874  cbuf[AT.ebufnum].numrhs = topje;
875  return(RetVal);
876 }
877 
878 /*
879  #] HowMany :
880  #[ DoubleIfBuffers :
881 */
882 
883 VOID DoubleIfBuffers()
884 {
885  int newmax, i;
886  WORD *newsumcheck;
887  LONG *newheap, *newifcount;
888  if ( AC.MaxIf == 0 ) newmax = 10;
889  else newmax = 2*AC.MaxIf;
890  newheap = (LONG *)Malloc1(sizeof(LONG)*(newmax+1),"IfHeap");
891  newsumcheck = (WORD *)Malloc1(sizeof(WORD)*(newmax+1),"IfSumCheck");
892  newifcount = (LONG *)Malloc1(sizeof(LONG)*(newmax+1),"IfCount");
893  if ( AC.MaxIf ) {
894  for ( i = 0; i < AC.MaxIf; i++ ) {
895  newheap[i] = AC.IfHeap[i];
896  newsumcheck[i] = AC.IfSumCheck[i];
897  newifcount[i] = AC.IfCount[i];
898  }
899  AC.IfStack = (AC.IfStack-AC.IfHeap) + newheap;
900  M_free(AC.IfHeap,"AC.IfHeap");
901  M_free(AC.IfCount,"AC.IfCount");
902  M_free(AC.IfSumCheck,"AC.IfSumCheck");
903  }
904  else {
905  AC.IfStack = newheap;
906  }
907  AC.IfHeap = newheap;
908  AC.IfSumCheck = newsumcheck;
909  AC.IfCount = newifcount;
910  AC.MaxIf = newmax;
911 }
912 
913 /*
914  #] DoubleIfBuffers :
915  #] If statement :
916 */
917 
#define PHEAD
Definition: ftypes.h:56
VOID LowerSortLevel()
Definition: sort.c:4435
WORD NewSort(PHEAD0)
Definition: sort.c:553
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:2865
LONG EndSort(PHEAD WORD *, int)
Definition: sort.c:632