FORM  4.1
token.c
Go to the documentation of this file.
1 
8 /* #[ License : */
9 /*
10  * Copyright (C) 1984-2013 J.A.M. Vermaseren
11  * When using this file you are requested to refer to the publication
12  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
13  * This is considered a matter of courtesy as the development was paid
14  * for by FOM the Dutch physics granting agency and we would like to
15  * be able to track its scientific use to convince FOM of its value
16  * for the community.
17  *
18  * This file is part of FORM.
19  *
20  * FORM is free software: you can redistribute it and/or modify it under the
21  * terms of the GNU General Public License as published by the Free Software
22  * Foundation, either version 3 of the License, or (at your option) any later
23  * version.
24  *
25  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
26  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
27  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
28  * details.
29  *
30  * You should have received a copy of the GNU General Public License along
31  * with FORM. If not, see <http://www.gnu.org/licenses/>.
32  */
33 /* #] License : */
34 /*
35  #[ Includes :
36 */
37 
38 #include "form3.h"
39 
40 /*
41  #] Includes :
42  #[ Compiler :
43  #[ tokenize :
44 
45  Takes the input in 'in' and translates it into tokens.
46  The tokens are put in the token buffer which starts at 'AC.tokens'
47  and runs till 'AC.toptokens'
48  We may assume that the various types of brackets match properly.
49  object = -1: after , or (
50  object = 0: name/variable/number etc is allowed
51  object = 1: variable.
52  object = 2: number
53  object = 3: ) after subexpression
54 */
55 
56 #define CHECKPOLY {if(polyflag)MesPrint("&Illegal use of polynomial function"); polyflag = 0; }
57 
58 int tokenize(UBYTE *in, WORD leftright)
59 {
60  int error = 0, object, funlevel = 0, bracelevel = 0, explevel = 0, numexp;
61  int polyflag = 0;
62  WORD number, type;
63  UBYTE *s, c;
64  SBYTE *out, *outtop, num[MAXNUMSIZE], *t;
65  LONG i;
66  if ( AC.tokens == 0 ) {
67  SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
68  SBYTE **pppp = &(AC.toptokens);
69  DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"start tokens");
70  }
71  out = AC.tokens;
72  outtop = AC.toptokens - MAXNUMSIZE;
73  AC.dumnumflag = 0;
74  object = 0;
75  while ( *in ) {
76  if ( out > outtop ) {
77  LONG oldsize = (LONG)(out - AC.tokens);
78  SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
79  SBYTE **pppp = &(AC.toptokens);
80  DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"expand tokens");
81  out = AC.tokens + oldsize;
82  outtop = AC.toptokens - MAXNUMSIZE;
83  }
84  switch ( FG.cTable[*in] ) {
85  case 0: /* a-zA-Z */
86  CHECKPOLY
87  s = in++;
88  while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1
89  || *in == '_' ) in++;
90 dovariable: c = *in; *in = 0;
91  if ( object > 0 ) {
92  MesPrint("&Illegal position for %s",s);
93  if ( !error ) error = 1;
94  }
95  if ( out > AC.tokens && ( out[-1] == TWILDCARD || out[-1] == TNOT ) ) {
96  type = GetName(AC.varnames,s,&number,NOAUTO);
97  }
98  else {
99  type = GetName(AC.varnames,s,&number,WITHAUTO);
100  }
101  if ( type < 0 )
102  type = GetName(AC.exprnames,s,&number,NOAUTO);
103  switch ( type ) {
104  case CSYMBOL: *out++ = TSYMBOL; break;
105  case CINDEX:
106  if ( number >= (AM.IndDum-AM.OffsetIndex) ) {
107  if ( c != '?' ) {
108  MesPrint("&Generated indices should be of the type Nnumber_?");
109  error = 1;
110  }
111  else {
112  *in++ = c; c = *in; *in = 0;
113  AC.dumnumflag = 1;
114  }
115  }
116  *out++ = TINDEX;
117  break;
118  case CVECTOR: *out++ = TVECTOR; break;
119  case CFUNCTION:
120 #ifdef WITHMPI
121  /*
122  * In the preprocessor, random functions in #$var=... and #inside
123  * may cause troubles, because the program flow on a slave may be
124  * different from those on others. We set AC.RhsExprInModuleFlag in order
125  * to make the change of $-variable be done on the master and thus keep the
126  * consistency among the master and all slave processes. The previous value
127  * of AC.RhsExprInModuleFlag will be restored after #$var=... and #inside.
128  */
129  if ( AP.PreAssignFlag || AP.PreInsideLevel ) {
130  switch ( number + FUNCTION ) {
131  case RANDOMFUNCTION:
132  case RANPERM:
133  AC.RhsExprInModuleFlag = 1;
134  }
135  }
136 #endif
137  *out++ = TFUNCTION;
138  break;
139  case CSET: *out++ = TSET; break;
140  case CEXPRESSION: *out++ = TEXPRESSION;
141  if ( leftright == LHSIDE ) {
142  if ( !error ) error = 1;
143  MesPrint("&Expression not allowed in LH-side of substitution: %s",s);
144  }
145 /*[06nov2003 mt]:*/
146 #ifdef WITHMPI
147  else/*RHSide*/
148  /* NOTE: We always set AC.RhsExprInModuleFlag regardless of
149  * AP.PreAssignFlag or AP.PreInsideLevel because we have to detect
150  * RHS expressions even in those cases. */
151  AC.RhsExprInModuleFlag = 1;
152  if ( !AP.PreAssignFlag && !AP.PreInsideLevel )
153  Expressions[number].vflags |= ISINRHS;
154 #endif
155 /*:[06nov2003 mt]*/
156  if ( AC.exprfillwarning == 0 ) {
157  AC.exprfillwarning = 1;
158  }
159  break;
160  case CDELTA: *out++ = TDELTA; *in = c;
161  object = 1; continue;
162  case CDUBIOUS: *out++ = TDUBIOUS; break;
163  default: *out++ = TDUBIOUS;
164  if ( !error ) error = 1;
165  MesPrint("&Undeclared variable %s",s);
166  number = AddDubious(s);
167  break;
168  }
169  object = 1;
170 donumber: i = 0;
171  do { num[i++] = (SBYTE)(number & 0x7F); number >>= 7; } while ( number );
172  while ( --i >= 0 ) *out++ = num[i];
173  *in = c;
174  break;
175  case 1: /* 0-9 */
176  CHECKPOLY
177  s = in;
178  while ( *s == '0' && s[1] == '0' ) s++;
179  in = s+1; i = 1;
180  while ( FG.cTable[*in] == 1 ) { in++; i++; }
181  if ( object > 0 ) {
182  c = *in; *in = 0;
183  MesPrint("&Illegal position for %s",s);
184  *in = c;
185  if ( !error ) error = 1;
186  }
187  if ( i == 1 && *in == '_' && ( *s == '5' || *s == '6'
188  || *s == '7' ) ) {
189  in++; *out++ = TSGAMMA; *out++ = (SBYTE)(*s - '4');
190  object = 1;
191  break;
192  }
193  *out++ = TNUMBER;
194  if ( ( i & 1 ) != 0 ) *out++ = (SBYTE)(*s++ - '0');
195  while ( out + (in-s)/2 >= AC.toptokens ) {
196  LONG oldsize = (LONG)(out - AC.tokens);
197  SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
198  SBYTE **pppp = &(AC.toptokens);
199  DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"more tokens");
200  out = AC.tokens + oldsize;
201  outtop = AC.toptokens - MAXNUMSIZE;
202  }
203  while ( s < in ) { /* We store in base 100 */
204  *out++ = (SBYTE)(( *s - '0' ) * 10 + ( s[1] - '0' ));
205  s += 2;
206  }
207  object = 2;
208  break;
209  case 2: /* . $ _ ? # ' */
210  CHECKPOLY
211  if ( *in == '?' ) {
212  if ( leftright == LHSIDE ) {
213  if ( object == 1 ) { /* follows a name */
214  in++; *out++ = TWILDCARD;
215  if ( FG.cTable[in[0]] == 0 || in[0] == '[' ) object = 0;
216  }
217  else if ( object == -1 ) { /* follows comma or ( */
218  in++; s = in;
219  while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
220  c = *in; *in = 0;
221  if ( FG.cTable[*s] != 0 ) {
222  MesPrint("&Illegal name for argument list variable %s",s);
223  error = 1;
224  }
225  else {
226  i = AddWildcardName((UBYTE *)s);
227  *in = c;
228  *out++ = TWILDARG;
229  *out++ = (SBYTE)i;
230  }
231  object = 1;
232  }
233  }
234  else {
235  if ( object != -1 ) goto IllPos;
236  in++;
237  if ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) {
238  s = in;
239  while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
240  c = *in; *in = 0;
241  i = GetWildcardName((UBYTE *)s);
242  if ( i <= 0 ) {
243  MesPrint("&Undefined argument list variable %s",s);
244  error = 1;
245  }
246  *in = c;
247  *out++ = TWILDARG;
248  *out++ = (SBYTE)i;
249  }
250  else {
251  *out++ = TGENINDEX;
252  }
253  object = 1;
254  }
255  }
256  else if ( *in == '.' ) {
257  if ( object == 1 ) { /* follows a name */
258  *out++ = TDOT;
259  object = 0;
260  in++;
261  }
262  else goto IllPos;
263  }
264  else if ( *in == '$' ) { /* $ variable */
265  in++;
266  s = in;
267  if ( FG.cTable[*in] == 0 ) {
268  while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
269  if ( *in == '_' && AP.PreAssignFlag == 2 ) in++;
270  c = *in; *in = 0;
271  if ( object > 0 ) {
272  if ( object != 1 || leftright == RHSIDE ) {
273  MesPrint("&Illegal position for $%s",s);
274  if ( !error ) error = 1;
275  } /* else can be assignment in wildcard */
276  else {
277  if ( ( number = GetDollar(s) ) < 0 ) {
278  number = AddDollar(s,0,0,0);
279  }
280  }
281  }
282  else if ( ( number = GetDollar(s) ) < 0 ) {
283  MesPrint("&Undefined variable $%s",s);
284  if ( !error ) error = 1;
285  number = AddDollar(s,0,0,0);
286  }
287  *out++ = TDOLLAR;
288  object = 1;
289  if ( ( AC.exprfillwarning == 0 ) &&
290  ( ( out > AC.tokens+1 ) && ( out[-2] != TWILDCARD ) ) ) {
291  AC.exprfillwarning = 1;
292  }
293  goto donumber;
294  }
295  else {
296  MesPrint("Illegal name for $ variable after %s",in);
297  if ( !error ) error = 1;
298  }
299  }
300  else if ( *in == '#' ) {
301  if ( object == 1 ) { /* follows a name */
302  *out++ = TCONJUGATE;
303  }
304  }
305  else goto IllPos;
306  break;
307  case 3: /* [ ] */
308  CHECKPOLY
309  if ( *in == '[' ) {
310  if ( object == 1 ) { /* after name */
311  t = out-1;
312  if ( *t == RPARENTHESIS ) {
313  *out++ = LBRACE; *out++ = LPARENTHESIS;
314  bracelevel++; explevel = bracelevel;
315  }
316  else {
317  while ( *t >= 0 && t > AC.tokens ) t--;
318  if ( *t == TEXPRESSION ) {
319  *out++ = LBRACE; *out++ = LPARENTHESIS;
320  bracelevel++; explevel = bracelevel;
321  }
322  else {*out++ = LBRACE; bracelevel++; }
323  }
324  object = 0;
325  }
326  else { /* name. find matching ] */
327  s = in;
328  in = SkipAName(in);
329  goto dovariable;
330  }
331  }
332  else {
333  if ( explevel > 0 && explevel == bracelevel ) {
334  *out++ = RPARENTHESIS; explevel = 0;
335  }
336  *out++ = RBRACE; object = 1; bracelevel--;
337  }
338  in++;
339  break;
340  case 4: /* ( ) = ; , */
341  if ( *in == '(' ) {
342  if ( funlevel >= AM.MaxParLevel ) {
343  MesPrint("&More than %d levels of parentheses",AM.MaxParLevel);
344  return(-1);
345  }
346  if ( object == 1 ) { /* After name -> function,vector */
347  AC.tokenarglevel[funlevel++] = TYPEISFUN;
348  *out++ = TFUNOPEN;
349  if ( polyflag ) {
350  if ( in[1] != ')' && in[1] != ',' ) {
351  *out++ = TNUMBER; *out++ = (SBYTE)(polyflag);
352  *out++ = TCOMMA;
353  *out++ = LPARENTHESIS;
354  }
355  else {
356  *out++ = LPARENTHESIS;
357  *out++ = TNUMBER; *out++ = (SBYTE)(polyflag);
358  }
359  polyflag = 0;
360  }
361  else if ( in[1] != ')' && in[1] != ',' ) {
362  *out++ = LPARENTHESIS;
363  }
364  }
365  else if ( object <= 0 ) {
366  CHECKPOLY
367  AC.tokenarglevel[funlevel++] = TYPEISSUB;
368  *out++ = LPARENTHESIS;
369  }
370  else {
371  polyflag = 0;
372  AC.tokenarglevel[funlevel++] = TYPEISMYSTERY;
373  MesPrint("&Illegal position for (: %s",in);
374  if ( error >= 0 ) error = -1;
375  }
376  object = -1;
377  }
378  else if ( *in == ')' ) {
379  funlevel--;
380  if ( funlevel < 0 ) {
381 /* if ( funflag == 0 ) { */
382  MesPrint("&There is an unmatched parenthesis");
383  if ( error >= 0 ) error = -1;
384 /* } */
385  }
386  else if ( object <= 0
387  && ( AC.tokenarglevel[funlevel] != TYPEISFUN
388  || out[-1] != TFUNOPEN ) ) {
389  MesPrint("&Illegal position for closing parenthesis.");
390  if ( error >= 0 ) error = -1;
391  if ( AC.tokenarglevel[funlevel] == TYPEISFUN ) object = 1;
392  else object = 3;
393  }
394  else {
395  if ( AC.tokenarglevel[funlevel] == TYPEISFUN ) {
396  if ( out[-1] == TFUNOPEN ) out--;
397  else {
398  if ( out[-1] != TCOMMA ) *out++ = RPARENTHESIS;
399  *out++ = TFUNCLOSE;
400  }
401  object = 1;
402  }
403  else if ( AC.tokenarglevel[funlevel] == TYPEISSUB ) {
404  *out++ = RPARENTHESIS;
405  object = 3;
406  }
407  }
408  }
409  else if ( *in == ',' ) {
410  if ( /* object > 0 && */ funlevel > 0 &&
411  AC.tokenarglevel[funlevel-1] == TYPEISFUN ) {
412  if ( out[-1] != TFUNOPEN && out[-1] != TCOMMA )
413  *out++ = RPARENTHESIS;
414  else { *out++ = TNUMBER; *out++ = 0; }
415  *out++ = TCOMMA;
416  if ( in[1] != ',' && in[1] != ')' )
417  *out++ = LPARENTHESIS;
418  else if ( in[1] == ')' ) {
419  *out++ = TNUMBER; *out++ = 0;
420  }
421  }
422 /*
423  else if ( object > 0 ) {
424  }
425 */
426  else {
427  MesPrint("&Illegal position for comma: %s",in);
428  MesPrint("&Forgotten ; ?");
429  if ( error >= 0 ) error = -1;
430  }
431  object = -1;
432  }
433  else goto IllPos;
434  in++;
435  break;
436  case 5: /* + - * % / ^ : */
437  CHECKPOLY
438  if ( *in == ':' || *in == '%' ) goto IllPos;
439  if ( *in == '*' || *in == '/' || *in == '^' ) {
440  if ( object <= 0 ) {
441  MesPrint("&Illegal position for operator: %s",in);
442  if ( error >= 0 ) error = -1;
443  }
444  else if ( *in == '*' ) *out++ = TMULTIPLY;
445  else if ( *in == '/' ) *out++ = TDIVIDE;
446  else *out++ = TPOWER;
447  in++;
448  }
449  else {
450  i = 1;
451  while ( *in == '+' || *in == '-' ) {
452  if ( *in == '-' ) i = -i;
453  in++;
454  }
455  if ( i == 1 ) {
456  if ( out > AC.tokens && out[-1] != TFUNOPEN &&
457  out[-1] != LPARENTHESIS && out[-1] != TCOMMA
458  && out[-1] != LBRACE )
459  *out++ = TPLUS;
460  }
461  else *out++ = TMINUS;
462  }
463  object = 0;
464  break;
465  case 6: /* Whitespace */
466  in++; break;
467  case 7: /* { | } */
468  CHECKPOLY
469  if ( *in == '{' ) {
470  s = in+1;
471  SKIPBRA2(in)
472  number = DoTempSet(s,in);
473  in++;
474  if ( number >= 0 ) {
475  *out++ = TSET;
476  i = 0;
477  do { num[i++] = (SBYTE)(number & 0x7F); number >>= 7; } while ( number );
478  while ( --i >= 0 ) *out++ = num[i];
479  }
480  else if ( error == 0 ) error = 1;
481  object = 1;
482  }
483  else goto IllPos;
484  break;
485  case 8: /* ! & < > */
486  CHECKPOLY
487  if ( *in != '!' || leftright == RHSIDE
488  || object != 1 || out[-1] != TWILDCARD ) goto IllPos;
489  *out++ = TNOT;
490  if ( FG.cTable[in[1]] == 0 || in[1] == '[' ) object = 0;
491  in++;
492  break;
493  default:
494 IllPos: MesPrint("&Illegal character at this position: %s",in);
495  if ( error >= 0 ) error = -1;
496  in++;
497  polyflag = 0;
498  break;
499  }
500  }
501  *out++ = TENDOFIT;
502  AC.endoftokens = out;
503  if ( funlevel > 0 || bracelevel != 0 ) {
504  if ( funlevel > 0 ) MesPrint("&Unmatched parentheses");
505  if ( bracelevel != 0 ) MesPrint("&Unmatched braces");
506  return(-1);
507  }
508  if ( AC.TokensWriteFlag ) WriteTokens(AC.tokens);
509 /*
510  Simplify fixed set elements
511 */
512  if ( error == 0 && simp1token(AC.tokens) ) error = 1;
513 /*
514  Collect wildcards for the prototype. Symplify the leftover wildcards
515 */
516  if ( error == 0 && leftright == LHSIDE && simpwtoken(AC.tokens) )
517  error = 1;
518 /*
519  Now prepare the set[n] objects in the RHS.
520 */
521  if ( error == 0 && leftright == RHSIDE && simp4token(AC.tokens) )
522  error = 1;
523 /*
524  Simplify simple function arguments (and 1/fac_ and 1/invfac_)
525 */
526  if ( error == 0 && simp2token(AC.tokens) ) error = 1;
527 /*
528  Next we try to remove composite denominators or exponents and
529  replace them by their internal functions. This may involve expanding
530  the buffer. The return code of 3a is negative if there is an error
531  and positive if indeed we need to do some work.
532  simp3btoken does the work
533 */
534  numexp = 0;
535  if ( error == 0 && ( numexp = simp3atoken(AC.tokens,leftright) ) < 0 )
536  error = 1;
537  if ( numexp > 0 ) {
538  SBYTE *tt;
539  out = AC.tokens;
540  while ( *out != TENDOFIT ) out++;
541  while ( out+numexp*9+20 > outtop ) {
542  LONG oldsize = (LONG)(out - AC.tokens);
543  SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
544  SBYTE **pppp = &(AC.toptokens);
545  DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"out tokens");
546  out = AC.tokens + oldsize;
547  outtop = AC.toptokens - MAXNUMSIZE;
548  }
549  tt = out + numexp*9+20;
550  while ( out >= AC.tokens ) { *tt-- = *out--; }
551  while ( tt >= AC.tokens ) { *tt-- = TEMPTY; }
552  if ( error == 0 && simp3btoken(AC.tokens,leftright) ) error = 1;
553  if ( error == 0 && simp2token(AC.tokens) ) error = 1;
554  }
555 /*
556  In simp5token we test for special cases like sumvariables that are
557  already wildcards, etc.
558 */
559  if ( error == 0 && simp5token(AC.tokens,leftright) ) error = 1;
560 /*
561  In simp6token we test for special cases like factorized expressions
562  that occur in the RHS in an improper way.
563 */
564  if ( error == 0 && simp6token(AC.tokens,leftright) ) error = 1;
565 
566  return(error);
567 }
568 
569 /*
570  #] tokenize :
571  #[ WriteTokens :
572 */
573 
574 char *ttypes[] = { "\n", "S", "I", "V", "F", "set", "E", "dotp", "#",
575  "sub", "d_", "$", "dub", "(", ")", "?", "??", ".", "[", "]",
576  ",", "((", "))", "*", "/", "^", "+", "-", "!", "end", "{{", "}}",
577  "N_?", "conj", "()", "#d", "^d", "_", "snum" };
578 
579 void WriteTokens(SBYTE *in)
580 {
581  int numinline = 0, x, n = sizeof(ttypes)/sizeof(char *);
582  char outbuf[81], *s, *out, c;
583  out = outbuf;
584  while ( *in != TENDOFIT ) {
585  if ( *in < 0 ) {
586  if ( *in >= -n ) {
587  s = ttypes[-*in];
588  while ( *s ) { *out++ = *s++; numinline++; }
589  }
590  else {
591  *out++ = '-'; x = -*in; numinline++;
592  goto writenumber;
593  }
594  }
595  else {
596  x = *in;
597 writenumber:
598  s = out;
599  do {
600  *out++ = (char)(( x % 10 ) + '0');
601  numinline++;
602  x = x / 10;
603  } while ( x );
604  c = out[-1]; out[-1] = *s; *s = c;
605  }
606  if ( numinline > 70 ) {
607  *out = 0;
608  MesPrint("%s",outbuf);
609  out = outbuf; numinline = 0;
610  }
611  else {
612  *out++ = ' '; numinline++;
613  }
614  in++;
615  }
616  if ( numinline > 0 ) { *out = 0; MesPrint("%s",outbuf); }
617 }
618 
619 /*
620  #] WriteTokens :
621  #[ simp1token :
622 
623  Routine substitutes set elements if possible.
624  This means sets with a fixed argument like setname[3].
625 */
626 
627 int simp1token(SBYTE *s)
628 {
629  int error = 0, n, i, base;
630  WORD numsub;
631  SBYTE *fill = s, *start, *t, numtab[10];
632  SETS set;
633  while ( *s != TENDOFIT ) {
634  if ( *s == RBRACE ) {
635  start = fill-1;
636  while ( *start != LBRACE ) start--;
637  t = start - 1;
638  while ( *t >= 0 ) t--;
639  if ( *t == TSET && ( start[1] == TNUMBER || start[1] == TNUMBER1 ) ) {
640  base = start[1] == TNUMBER ? 100: 128;
641  start += 2;
642  numsub = *start++;
643  while ( *start >= 0 && start < fill )
644  { numsub = base*numsub + *start++; }
645  if ( start == fill ) {
646  start = t;
647  t++; n = *t++; while ( *t >= 0 ) { n = 128*n + *t++; }
648  set = Sets+n;
649  if ( ( set->type != CRANGE )
650  && ( numsub > 0 && numsub <= set->last-set->first ) ) {
651  fill = start;
652  n = SetElements[set->first+numsub-1];
653  switch (set->type) {
654  case CSYMBOL:
655  if ( n > MAXPOWER ) {
656  n -= 2*MAXPOWER;
657  if ( n < 0 ) { n = -n; *fill++ = TMINUS; }
658  *fill++ = TNUMBER1;
659  }
660  else *fill++ = TSYMBOL;
661  break;
662  case CINDEX:
663  if ( n < AM.OffsetIndex ) *fill++ = TNUMBER1;
664  else {
665  *fill++ = TINDEX;
666  n -= AM.OffsetIndex;
667  }
668  break;
669  case CVECTOR: *fill++ = TVECTOR;
670  n -= AM.OffsetVector; break;
671  case CFUNCTION: *fill++ = TFUNCTION;
672  n -= FUNCTION; break;
673  case CNUMBER: *fill++ = TNUMBER1; break;
674  case CDUBIOUS: *fill++ = TDUBIOUS; n = 1; break;
675  }
676  i = 0;
677 if ( n < 0 ) {
678  MesPrint("Value of n = %d",n);
679 }
680  do { numtab[i++] = (SBYTE)(n & 0x7F); n >>= 7; } while ( n );
681  while ( --i >= 0 ) *fill++ = numtab[i];
682  }
683  else {
684  MesPrint("&Illegal element %d in set",numsub);
685  error++;
686  }
687  s++; continue;
688  }
689  }
690  *fill++ = *s++;
691  }
692  else *fill++ = *s++;
693  }
694  *fill++ = TENDOFIT;
695  return(error);
696 }
697 
698 /*
699  #] simp1token :
700  #[ simpwtoken :
701 
702  Only to be called in the LHS.
703  Hunts down the wildcards and writes them to the wildcardbuffer.
704  Next it causes the ProtoType to be constructed.
705  All wildcards are simplified into the trailing TWILDCARD,
706  because the specifics are stored in the prototype.
707  These specifics also include the transfer of wildcard values
708  to $variables.
709 
710  Types of wildcards:
711  a?, a?set, a?!set, a?set[i], A?set1?set2, ?a
712  After this we can strip the set information.
713  We still need the ? because of the wildcarding offset in code generation
714 */
715 
716 int simpwtoken(SBYTE *s)
717 {
718  int error = 0, first = 1, notflag;
719  WORD num, numto, numdollar, *w = AC.WildC, *wstart, *wtop;
720  SBYTE *fill = s, *t, *v, *s0 = s;
721  while ( *s != TENDOFIT ) {
722  if ( *s == TWILDCARD ) {
723  notflag = 0; t = fill;
724  while ( t > s0 && t[-1] >= 0 ) t--;
725  v = t; num = 0; *fill++ = *s++;
726  while ( *v >= 0 ) num = 128*num + *v++;
727  if ( t > s0 ) t--;
728  AC.NwildC += 4;
729  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
730  switch ( *t ) {
731  case TSYMBOL:
732  case TDUBIOUS:
733  *w++ = SYMTOSYM; *w++ = 4; *w++ = num; *w++ = -1; break;
734  case TINDEX:
735  num += AM.OffsetIndex;
736  *w++ = INDTOIND; *w++ = 4; *w++ = num; *w++ = 0; break;
737  case TVECTOR:
738  num += AM.OffsetVector;
739  *w++ = VECTOVEC; *w++ = 4; *w++ = num; *w++ = 0; break;
740  case TFUNCTION:
741  num += FUNCTION;
742  *w++ = FUNTOFUN; *w++ = 4; *w++ = num; *w++ = 0; break;
743  default:
744  MesPrint("&Illegal type of wildcard in LHS");
745  error = -1;
746  *w++ = SYMTOSYM; *w++ = 4; *w++ = num; *w++ = -1; break;
747  break;
748  }
749 /*
750  Now the sets. The s pointer sits after the ?
751 */
752  wstart = w;
753  if ( *s == TNOT && s[1] == TSET ) { notflag = 1; s++; }
754  if ( *s == TSET ) {
755  s++; num = 0; while ( *s >= 0 ) num = 128*num + *s++;
756  if ( notflag == 0 && *s == TWILDCARD && s[1] == TSET ) {
757  s += 2; numto = 0; while ( *s >= 0 ) numto = 128*numto + *s++;
758  if ( num < AM.NumFixedSets || numto < AM.NumFixedSets
759  || Sets[num].type == CRANGE || Sets[numto].type == CRANGE ) {
760  MesPrint("&This type of set not allowed in this wildcard construction");
761  error = 1;
762  }
763  else {
764  AC.NwildC += 4;
765  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
766  *w++ = FROMSET; *w++ = 4; *w++ = num; *w++ = numto;
767  wstart = w;
768  }
769  }
770  else if ( notflag == 0 && *s == LBRACE && s[1] == TSYMBOL ) {
771  if ( num < AM.NumFixedSets || Sets[num].type == CRANGE ) {
772  MesPrint("&This type of set not allowed in this wildcard construction");
773  error = 1;
774  }
775  v = s; s += 2;
776  numto = 0; while ( *s >= 0 ) numto = 128*numto + *s++;
777  if ( *s == TWILDCARD ) s++; /* most common mistake */
778  if ( *s == RBRACE ) {
779  s++;
780  AC.NwildC += 8;
781  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
782  *w++ = SETTONUM; *w++ = 4; *w++ = num; *w++ = numto;
783  wstart = w;
784  *w++ = SYMTOSYM; *w++ = 4; *w++ = numto; *w++ = 0;
785  }
786  else if ( *s == TDOLLAR ) {
787  s++; numdollar = 0;
788  while ( *s >= 0 ) numdollar = 128*numdollar + *s++;
789  if ( *s == RBRACE ) {
790  s++;
791  AC.NwildC += 12;
792  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
793  *w++ = SETTONUM; *w++ = 4; *w++ = num; *w++ = numto;
794  wstart = w;
795  *w++ = SYMTOSYM; *w++ = 4; *w++ = numto; *w++ = 0;
796  *w++ = LOADDOLLAR; *w++ = 4; *w++ = numdollar;
797  *w++ = numdollar;
798  }
799  else { s = v; goto singlewild; }
800  }
801  else { s = v; goto singlewild; }
802  }
803  else {
804 singlewild: num += notflag * 2*WILDOFFSET;
805  AC.NwildC += 4;
806  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
807  *w++ = FROMSET; *w++ = 4; *w++ = num; *w++ = -WILDOFFSET;
808  wstart = w;
809  }
810  }
811  else if ( *s != TDOLLAR && *s != TENDOFIT && *s != RPARENTHESIS
812  && *s != RBRACE && *s != TCOMMA && *s != TFUNCLOSE && *s != TMULTIPLY
813  && *s != TPOWER && *s != TDIVIDE && *s != TPLUS && *s != TMINUS
814  && *s != TPOWER1 && *s != TEMPTY && *s != TFUNOPEN && *s != TDOT ) {
815  MesPrint("&Illegal type of wildcard in LHS");
816  error = -1;
817  }
818  if ( *s == TDOLLAR ) {
819  s++; numdollar = 0;
820  while ( *s >= 0 ) numdollar = 128*numdollar + *s++;
821  AC.NwildC += 4;
822  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
823  wtop = w + 4;
824  if ( wstart < w ) {
825  while ( w > wstart ) { w[4] = w[0]; w--; }
826  }
827  *w++ = LOADDOLLAR; *w++ = 4; *w++ = numdollar; *w++ = numdollar;
828  w = wtop;
829  }
830  }
831  else if ( *s == TWILDARG ) {
832  *fill++ = *s++;
833  num = 0;
834  while ( *s >= 0 ) { num = 128*num + *s; *fill++ = *s++; }
835  AC.NwildC += 4;
836  if ( AC.NwildC > 4*AM.MaxWildcards ) {
837 firsterr: if ( first ) {
838  MesPrint("&More than %d wildcards",AM.MaxWildcards);
839  error = -1;
840  first = 0;
841  }
842  }
843  else { *w++ = ARGTOARG; *w++ = 4; *w++ = num; *w++ = -1; }
844  if ( *s == TDOLLAR ) {
845  s++; num = 0; while ( *s >= 0 ) num = 128*num + *s++;
846  AC.NwildC += 4;
847  if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
848  *w++ = LOADDOLLAR; *w++ = 4; *w++ = num; *w++ = num;
849  }
850  }
851  else *fill++ = *s++;
852  }
853  *fill++ = TENDOFIT;
854  AC.WildC = w;
855  return(error);
856 }
857 
858 /*
859  #] simpwtoken :
860  #[ simp2token :
861 
862  Deals with function arguments.
863  The tokenizer has given function arguments extra parentheses.
864  We remove the double parentheses.
865  Next we remove the parentheses around the simple arguments.
866 
867  It also replaces /fac_() by *invfac_() and /invfac_() by *fac_()
868 */
869 
870 int simp2token(SBYTE *s)
871 {
872  SBYTE *to, *fill, *t, *v, *w, *s0 = s, *vv;
873  int error = 0, n;
874 /*
875  Set substitutions
876 */
877  fill = to = s;
878  while ( *s != TENDOFIT ) {
879  if ( *s == LPARENTHESIS && s[1] == LPARENTHESIS ) {
880  t = s+1; n = 0;
881  while ( n >= 0 ) {
882  t++;
883  if ( *t == LPARENTHESIS ) n++;
884  else if ( *t == RPARENTHESIS ) n--;
885  }
886  if ( t[1] == RPARENTHESIS ) {
887  *t = TEMPTY; s++;
888  }
889  *fill++ = *s++;
890  }
891  else if ( *s == TEMPTY ) s++;
892  else if ( *s == AM.facnum && ( fill > (s0+1) ) && fill[-2] == TDIVIDE
893  && fill[-1] == TFUNCTION ) {
894  fill[-2] = TMULTIPLY; *fill++ = (SBYTE)(AM.invfacnum); s++;
895  }
896  else if ( *s == AM.invfacnum && ( fill > (s0+1) ) && fill[-2] == TDIVIDE
897  && fill[-1] == TFUNCTION ) {
898  fill[-2] = TMULTIPLY; *fill++ = (SBYTE)(AM.facnum); s++;
899  }
900  else *fill++ = *s++;
901  }
902  *fill++ = TENDOFIT;
903 /*
904  Second round: try to locate 'simple' arguments and strip their brackets
905 
906  We add (9-feb-2010) to the simple arguments integers of any size
907 */
908  fill = s = to;
909  while ( *s != TENDOFIT ) {
910  if ( *s == LPARENTHESIS ) {
911  t = s; n = 0;
912  while ( n >= 0 ) {
913  t++;
914  if ( *t == LPARENTHESIS ) n++;
915  else if ( *t == RPARENTHESIS ) n--;
916  }
917  if ( t[1] == TFUNCLOSE && s[1] != TWILDARG ) { /* Check for last argument in sum */
918  v = fill - 1; n = 0;
919  while ( n >= 0 && v >= to ) {
920  if ( *v == TFUNOPEN ) n--;
921  else if ( *v == TFUNCLOSE ) n++;
922  v--;
923  }
924  if ( v > to ) {
925  while ( *v >= 0 ) v--;
926  if ( *v == TFUNCTION ) { v++;
927  n = 0; while ( *v >= 0 && v < fill ) n = 128*n + *v++;
928  if ( n == AM.sumnum || n == AM.sumpnum ) {
929  *fill++ = *s++; continue;
930  }
931  else if ( ( n == (FIRSTBRACKET-FUNCTION)
932  || n == (TERMSINEXPR-FUNCTION)
933  || n == (NUMFACTORS-FUNCTION)
934  || n == (GCDFUNCTION-FUNCTION)
935  || n == (DIVFUNCTION-FUNCTION)
936  || n == (REMFUNCTION-FUNCTION)
937  || n == (INVERSEFUNCTION-FUNCTION)
938  || n == (FACTORIN-FUNCTION)
939  || n == (FIRSTTERM-FUNCTION)
940  || n == (CONTENTTERM-FUNCTION) )
941  && fill[-1] == TFUNOPEN ) {
942  v = s+1;
943  if ( *v == TEXPRESSION ) {
944  v++;
945  n = 0; while ( *v >= 0 ) n = 128*n + *v++;
946  if ( v == t ) {
947  *t = TEMPTY; s++;
948  }
949  }
950  }
951  }
952  }
953  }
954  if ( ( fill > to )
955  && ( ( fill[-1] == TFUNOPEN || fill[-1] == TCOMMA )
956  && ( t[1] == TFUNCLOSE || t[1] == TCOMMA ) ) ) {
957  v = s + 1;
958  switch ( *v ) {
959  case TMINUS:
960  v++;
961  if ( *v == TVECTOR ) {
962  w = v+1; while ( *w >= 0 ) w++;
963  if ( w == t ) {
964  *t = TEMPTY; s++;
965  }
966  }
967  else {
968  if ( *v == TNUMBER || *v == TNUMBER1 ) {
969  if ( BITSINWORD == 16 ) { LONG x; WORD base;
970  base = ( *v == TNUMBER ) ? 100: 128;
971  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
972  if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > (MAXPOSITIVE+1) ) )
973  *fill++ = *s++;
974  else { *t = TEMPTY; s++; break; }
975  }
976  else if ( BITSINWORD == 32 ) { LONG x; WORD base;
977  base = ( *v == TNUMBER ) ? 100: 128;
978  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
979  if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > (MAXPOSITIVE+1) ) )
980  *fill++ = *s++;
981  else { *t = TEMPTY; s++; break; }
982  }
983  else {
984  if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
985  { *t = TEMPTY; s++; break; }
986  else *fill++ = *s++;
987  }
988  }
989  else if ( *v == LPARENTHESIS && t[-1] == RPARENTHESIS ) {
990  w = v; n = 0;
991  while ( n >= 0 ) {
992  w++;
993  if ( *w == LPARENTHESIS ) n++;
994  else if ( *w == RPARENTHESIS ) n--;
995  }
996  if ( w == ( t-1 ) ) { *t = TEMPTY; s++; }
997  else *fill++ = *s++;
998  }
999  else *fill++ = *s++;
1000  break;
1001  }
1002  case TSETNUM:
1003  v++; while ( *v >= 0 ) v++;
1004  goto tcommon;
1005  case TSYMBOL:
1006  if ( ( v[1] == COEFFSYMBOL || v[1] == NUMERATORSYMBOL
1007  || v[1] == DENOMINATORSYMBOL ) && v[2] < 0 ) {
1008  *fill++ = *s++; break;
1009  }
1010  case TVECTOR:
1011  case TINDEX:
1012  case TFUNCTION:
1013  case TDOLLAR:
1014  case TDUBIOUS:
1015  case TSGAMMA:
1016 tcommon: v++; while ( *v >= 0 ) v++;
1017  if ( v == t || ( v[0] == TWILDCARD && v+1 == t ) )
1018  { *t = TEMPTY; s++; }
1019  else *fill++ = *s++;
1020  break;
1021  case TGENINDEX:
1022  v++;
1023  if ( v == t ) { *t = TEMPTY; s++; }
1024  else *fill++ = *s++;
1025  break;
1026  case TNUMBER:
1027  case TNUMBER1:
1028  if ( BITSINWORD == 16 ) { LONG x; WORD base;
1029  base = ( *v == TNUMBER ) ? 100: 128;
1030  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1031  if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > MAXPOSITIVE ) )
1032  *fill++ = *s++;
1033  else { *t = TEMPTY; s++; break; }
1034  }
1035  else if ( BITSINWORD == 32 ) { LONG x; WORD base;
1036  base = ( *v == TNUMBER ) ? 100: 128;
1037  vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1038  if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > MAXPOSITIVE ) )
1039  *fill++ = *s++;
1040  else { *t = TEMPTY; s++; break; }
1041  }
1042  else {
1043  if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
1044  { *t = TEMPTY; s++; break; }
1045  else *fill++ = *s++;
1046  }
1047  break;
1048  case TWILDARG:
1049  v++; while ( *v >= 0 ) v++;
1050  if ( v == t ) { *t = TEMPTY; s++; }
1051  else *fill++ = *s++;
1052  break;
1053  case TEXPRESSION:
1054 /*
1055  First establish that there is only the expression
1056  in this argument.
1057 */
1058  vv = s+1;
1059  while ( vv < t ) {
1060  if ( *vv != TEXPRESSION ) break;
1061  vv++; while ( *vv >= 0 ) vv++;
1062  }
1063  if ( vv < t ) { *fill++ = *s++; break; }
1064 /*
1065  Find the function
1066 */
1067  w = fill-1; n = 0;
1068  while ( n >= 0 && w >= to ) {
1069  if ( *w == TFUNOPEN ) n--;
1070  else if ( *w == TFUNCLOSE ) n++;
1071  w--;
1072  }
1073  w--; while ( w > to && *w >= 0 ) w--;
1074  if ( *w != TFUNCTION ) { *fill++ = *s++; break; }
1075  w++; n = 0;
1076  while ( *w >= 0 ) { n = 128*n + *w++; }
1077  if ( n == GCDFUNCTION-FUNCTION
1078  || n == DIVFUNCTION-FUNCTION
1079  || n == REMFUNCTION-FUNCTION
1080  || n == INVERSEFUNCTION-FUNCTION ) {
1081  *t = TEMPTY; s++;
1082  }
1083  else *fill++ = *s++;
1084  break;
1085  default: *fill++ = *s++; break;
1086  }
1087  }
1088  else *fill++ = *s++;
1089  }
1090  else if ( *s == TEMPTY ) s++;
1091  else *fill++ = *s++;
1092  }
1093  *fill++ = TENDOFIT;
1094  return(error);
1095 }
1096 
1097 /*
1098  #] simp2token :
1099  #[ simp3atoken :
1100 
1101  We hunt for denominators and exponents that seem hidden.
1102  For the denominators we have to recognize:
1103  /fun /fun() /fun^power /fun()^power
1104  /set[n] /set[n]() /set[n]^power /set[n]()^power
1105  /symbol^power (power no number or symbol wildcard)
1106  /dotpr^power (id)
1107  /#^power (id)
1108  /() /()^power
1109  /vect /index /vect(anything) /vect(anything)^power
1110 */
1111 
1112 int simp3atoken(SBYTE *s, int mode)
1113 {
1114  int error = 0, n, numexp = 0, denom, base, numprot, i;
1115  SBYTE *t, c;
1116  LONG num;
1117  WORD *prot;
1118  if ( mode == RHSIDE ) {
1119  prot = AC.ProtoType;
1120  numprot = prot[1] - SUBEXPSIZE;
1121  prot += SUBEXPSIZE;
1122  }
1123  else { prot = 0; numprot = 0; }
1124  while ( *s != TENDOFIT ) {
1125  denom = 1;
1126  if ( *s == TDIVIDE ) { denom = -1; s++; }
1127  c = *s;
1128  switch(c) {
1129  case TSYMBOL:
1130  case TNUMBER:
1131  case TNUMBER1:
1132  s++; while ( *s >= 0 ) s++; /* skip the object */
1133  if ( *s == TWILDCARD ) s++; /* and the possible wildcard */
1134 dosymbol:
1135  if ( *s != TPOWER ) continue; /* No power -> done */
1136  s++; /* Skip the power */
1137  if ( *s == TMINUS ) s++; /* negative: no difference here */
1138  if ( *s == TNUMBER || *s == TNUMBER1 ) {
1139  base = *s == TNUMBER ? 100: 128; /* NUMBER = base 100 */
1140  s++; /* Now we compose the power */
1141  num = *s++; /* If the number is way too large */
1142  while ( *s >= 0 ) { /* it may look like not too big */
1143  if ( num > MAXPOWER ) break; /* Hence... */
1144  num = base*num + *s++;
1145  }
1146  while ( *s >= 0 ) s++; /* Finish the number if needed */
1147  if ( *s == TPOWER ) goto doublepower;
1148  if ( num <= MAXPOWER ) continue; /* Simple case */
1149  }
1150  else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1151  s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1152  if ( *s == TWILDCARD ) { s++;
1153  if ( *s == TPOWER ) goto doublepower;
1154  continue; }
1155 /*
1156  Now we have to test whether n happens to be a wildcard
1157 */
1158  if ( mode == RHSIDE ) {
1159  n += 2*MAXPOWER;
1160  for ( i = 0; i < numprot; i += 4 ) {
1161  if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1162  }
1163  if ( i < numprot ) break;
1164  }
1165  if ( *s == TPOWER ) goto doublepower;
1166  }
1167  numexp++;
1168  break;
1169  case TINDEX:
1170  s++; while ( *s >= 0 ) s++;
1171  if ( *s == TWILDCARD ) s++;
1172 doindex:
1173  if ( denom < 0 || *s == TPOWER ) {
1174  MesPrint("&Index to a power or in denominator is illegal");
1175  error = 1;
1176  }
1177  break;
1178  case TVECTOR:
1179  s++; while ( *s >= 0 ) s++;
1180  if ( *s == TWILDCARD ) s++;
1181 dovector:
1182  if ( *s == TFUNOPEN ) {
1183  s++; n = 1;
1184  for(;;) {
1185  if ( *s == TFUNOPEN ) {
1186  n++;
1187  MesPrint("&Illegal vector index");
1188  error = 1;
1189  }
1190  else if ( *s == TFUNCLOSE ) {
1191  n--;
1192  if ( n <= 0 ) break;
1193  }
1194  s++;
1195  }
1196  s++;
1197  }
1198  else if ( *s == TDOT ) goto dodot;
1199  if ( denom < 0 || *s == TPOWER || *s == TPOWER1 ) numexp++;
1200  break;
1201  case TFUNCTION:
1202  s++; while ( *s >= 0 ) s++;
1203  if ( *s == TWILDCARD ) s++;
1204 dofunction:
1205  t = s;
1206  if ( *t == TFUNOPEN ) {
1207  t++; n = 1;
1208  for(;;) {
1209  if ( *t == TFUNOPEN ) n++;
1210  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1211  t++;
1212  }
1213  t++; s++;
1214  }
1215  if ( denom < 0 || *t == TPOWER || *t == TPOWER1 ) numexp++;
1216  break;
1217  case TEXPRESSION:
1218  s++; while ( *s >= 0 ) s++;
1219  t = s;
1220  if ( *t == TFUNOPEN ) {
1221  t++; n = 1;
1222  for(;;) {
1223  if ( *t == TFUNOPEN ) n++;
1224  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1225  t++;
1226  }
1227  t++;
1228  }
1229  if ( *t == LBRACE ) {
1230  t++; n = 1;
1231  for(;;) {
1232  if ( *t == LBRACE ) n++;
1233  else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1234  t++;
1235  }
1236  t++;
1237  }
1238  if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1239  && t[1] == TMINUS ) ) numexp++;
1240  break;
1241  case TDOLLAR:
1242  s++; while ( *s >= 0 ) s++;
1243  if ( denom < 0 || ( ( *s == TPOWER || *s == TPOWER1 )
1244  && s[1] == TMINUS ) ) numexp++;
1245  break;
1246  case LPARENTHESIS:
1247  s++; n = 1; t = s;
1248  for(;;) {
1249  if ( *t == LPARENTHESIS ) n++;
1250  else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1251  t++;
1252  }
1253  t++;
1254  if ( denom > 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1255  if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 ) && t[2] >= 0
1256  && t[3] < 0 ) break;
1257  numexp++;
1258  }
1259  else if ( denom < 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1260  if ( t[1] == TMINUS && ( t[2] == TNUMBER
1261  || t[2] == TNUMBER1 ) && t[3] >= 0
1262  && t[4] < 0 ) break;
1263  numexp++;
1264  }
1265  else if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1266  && ( t[1] == TMINUS || t[1] == LPARENTHESIS ) ) ) numexp++;
1267  break;
1268  case TSET:
1269  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1270  n = Sets[n].type;
1271  switch ( n ) {
1272  case CSYMBOL: goto dosymbol;
1273  case CINDEX: goto doindex;
1274  case CVECTOR: goto dovector;
1275  case CFUNCTION: goto dofunction;
1276  case CNUMBER: goto dosymbol;
1277  default: error = 1; break;
1278  }
1279  break;
1280  case TDOT:
1281 dodot: s++;
1282  if ( *s == TVECTOR ) { s++; while ( *s >= 0 ) s++; }
1283  else if ( *s == TSET ) {
1284  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1285  if ( Sets[n].type != CVECTOR ) {
1286  MesPrint("&Set in dotproduct is not a set of vectors");
1287  error = 1;
1288  }
1289  if ( *s == LBRACE ) {
1290  s++; n = 1;
1291  for(;;) {
1292  if ( *s == LBRACE ) n++;
1293  else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1294  s++;
1295  }
1296  s++;
1297  }
1298  else {
1299  MesPrint("&Set without argument in dotproduct");
1300  error = 1;
1301  }
1302  }
1303  else if ( *s == TSETNUM ) {
1304  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1305  if ( *s != TVECTOR ) goto nodot;
1306  s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1307  if ( Sets[n].type != CVECTOR ) {
1308  MesPrint("&Set in dotproduct is not a set of vectors");
1309  error = 1;
1310  }
1311  }
1312  else {
1313 nodot: MesPrint("&Illegal second element in dotproduct");
1314  error = 1;
1315  s++; while ( *s >= 0 ) s++;
1316  }
1317  goto dosymbol;
1318  default:
1319  s++; while ( *s >= 0 ) s++;
1320  break;
1321  }
1322  }
1323  if ( error ) return(-1);
1324  return(numexp);
1325 doublepower:
1326  MesPrint("&Dubious notation with object^power1^power2");
1327  return(-1);
1328 }
1329 
1330 /*
1331  #] simp3atoken :
1332  #[ simp3btoken :
1333 */
1334 
1335 int simp3btoken(SBYTE *s, int mode)
1336 {
1337  int error = 0, i, numprot, n, denom, base, inset = 0, dotp, sube = 0;
1338  SBYTE *t, c, *fill, *ff, *ss;
1339  LONG num;
1340  WORD *prot;
1341  if ( mode == RHSIDE ) {
1342  prot = AC.ProtoType;
1343  numprot = prot[1] - SUBEXPSIZE;
1344  prot += SUBEXPSIZE;
1345  }
1346  else { prot = 0; numprot = 0; }
1347  fill = s;
1348  while ( *s == TEMPTY ) s++;
1349  while ( *s != TENDOFIT ) {
1350  if ( *s == TEMPTY ) { s++; continue; }
1351  denom = 1;
1352  if ( *s == TDIVIDE ) { denom = -1; *fill++ = *s++; }
1353  ff = fill; ss = s; c = *s;
1354  if ( c == TSETNUM ) {
1355  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1356  c = *s;
1357  }
1358  dotp = 0;
1359  switch(c) {
1360  case TSYMBOL:
1361  case TNUMBER:
1362  case TNUMBER1:
1363  *fill++ = *s++;
1364  while ( *s >= 0 ) *fill++ = *s++;
1365  if ( *s == TWILDCARD ) *fill++ = *s++;
1366 dosymbol:
1367  t = s;
1368  if ( *s != TPOWER ) continue;
1369  *fill++ = *s++;
1370  if ( *s == TMINUS ) *fill++ = *s++;
1371  if ( *s == TPLUS ) s++;
1372  if ( *s == TSETNUM ) {
1373  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1374  inset = 1;
1375  }
1376  else inset = 0;
1377  if ( *s == TNUMBER || *s == TNUMBER1 ) {
1378  base = *s == TNUMBER ? 100: 128;
1379  *fill++ = *s++;
1380  num = *s++; *fill++ = num;
1381  while ( *s >= 0 ) {
1382  if ( num > MAXPOWER ) break;
1383  *fill++ = *s;
1384  num = base*num + *s++;
1385  }
1386  while ( *s >= 0 ) *fill++ = *s++;
1387  if ( num <= MAXPOWER ) continue;
1388  goto putexp1;
1389  }
1390  else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1391  *fill++ = *s++;
1392  n = 0; while ( *s >= 0 ) { n = 128*n + *s; *fill++ = *s++; }
1393  if ( *s == TWILDCARD ) { *fill++ = *s++;
1394  if ( *s == TPOWER ) goto doublepower;
1395  break; }
1396 /*
1397  Now we have to test whether n happens to be a wildcard
1398 */
1399  if ( mode == RHSIDE && inset == 0 ) {
1400 /* n += WILDOFFSET;*/
1401  for ( i = 0; i < numprot; i += 4 ) {
1402  if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1403  }
1404  if ( i < numprot ) break;
1405  }
1406 
1407 putexp1: fill = ff;
1408  if ( denom < 0 ) fill[-1] = TMULTIPLY;
1409  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1410  if ( dotp ) *fill++ = LPARENTHESIS;
1411  while ( ss < t ) *fill++ = *ss++;
1412  if ( dotp ) *fill++ = RPARENTHESIS;
1413  *fill++ = TCOMMA;
1414  ss++; /* Skip TPOWER */
1415  if ( *ss == TMINUS ) { denom = -denom; ss++; }
1416  if ( denom < 0 ) {
1417  *fill++ = LPARENTHESIS;
1418  *fill++ = TMINUS;
1419  while ( ss < s ) *fill++ = *ss++;
1420  *fill++ = RPARENTHESIS;
1421  }
1422  else {
1423  while ( ss < s ) *fill++ = *ss++;
1424  }
1425  *fill++ = TFUNCLOSE;
1426  if ( *ss == TPOWER ) goto doublepower;
1427  }
1428  else { /* other objects can be composite */
1429  goto dofunpower;
1430  }
1431  break;
1432  case TINDEX:
1433  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1434  if ( *s == TWILDCARD ) *fill++ = *s++;
1435  break;
1436  case TVECTOR:
1437  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1438  if ( *s == TWILDCARD ) *fill++ = *s++;
1439 dovector:
1440  if ( *s == TFUNOPEN ) {
1441  while ( *s != TFUNCLOSE ) *fill++ = *s++;
1442  *fill++ = *s++;
1443  }
1444  else if ( *s == TDOT ) goto dodot;
1445  t = s;
1446  goto dofunpower;
1447  case TFUNCTION:
1448  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1449  if ( *s == TWILDCARD ) *fill++ = *s++;
1450 dofunction:
1451  t = s;
1452  if ( *t == TFUNOPEN ) {
1453  t++; n = 1;
1454  for(;;) {
1455  if ( *t == TFUNOPEN ) n++;
1456  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1457  t++;
1458  }
1459  t++; *fill++ = *s++;
1460  }
1461  sube = 0;
1462 dofunpower:
1463  if ( *t == TPOWER || *t == TPOWER1 ) {
1464  if ( sube ) {
1465  if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 )
1466  && denom > 0 ) {
1467  if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1468  }
1469  else if ( t[1] == TMINUS && denom < 0 &&
1470  ( t[2] == TNUMBER || t[2] == TNUMBER1 ) ) {
1471  if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1472  }
1473  sube = 0;
1474  }
1475  fill = ff;
1476  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1477  *fill++ = LPARENTHESIS;
1478  while ( ss < t ) *fill++ = *ss++;
1479  t++;
1480  *fill++ = RPARENTHESIS; *fill++ = TCOMMA;
1481  if ( *t == TMINUS ) { t++; denom = -denom; }
1482  *fill++ = LPARENTHESIS;
1483  if ( denom < 0 ) *fill++ = TMINUS;
1484  if ( *t == LPARENTHESIS ) {
1485  *fill++ = *t++; n = 0;
1486  while ( n >= 0 ) {
1487  if ( *t == LPARENTHESIS ) n++;
1488  else if ( *t == RPARENTHESIS ) n--;
1489  *fill++ = *t++;
1490  }
1491  }
1492  else if ( *t == TFUNCTION || *t == TDUBIOUS ) {
1493  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1494  if ( *t == TWILDCARD ) *fill++ = *t++;
1495  if ( *t == TFUNOPEN ) {
1496  *fill++ = *t++; n = 0;
1497  while ( n >= 0 ) {
1498  if ( *t == TFUNOPEN ) n++;
1499  else if ( *t == TFUNCLOSE ) n--;
1500  *fill++ = *t++;
1501  }
1502  }
1503  }
1504  else if ( *t == TSET ) {
1505  *fill++ = *t++; n = 0;
1506  while ( *t >= 0 ) { n = 128*n + *t; *fill++ = *t++; }
1507  if ( *t == LBRACE ) {
1508  if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1509  MesPrint("&This type of usage of sets is not allowed");
1510  error = 1;
1511  }
1512  *fill++ = *t++; n = 0;
1513  while ( n >= 0 ) {
1514  if ( *t == LBRACE ) n++;
1515  else if ( *t == RBRACE ) n--;
1516  *fill++ = *t++;
1517  }
1518  }
1519  }
1520  else if ( *t == TEXPRESSION ) {
1521  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1522  if ( *t == TFUNOPEN ) {
1523  *fill++ = *t++; n = 0;
1524  while ( n >= 0 ) {
1525  if ( *t == TFUNOPEN ) n++;
1526  else if ( *t == TFUNCLOSE ) n--;
1527  *fill++ = *t++;
1528  }
1529  }
1530  if ( *t == LBRACE ) {
1531  *fill++ = *t++; n = 0;
1532  while ( n >= 0 ) {
1533  if ( *t == LBRACE ) n++;
1534  else if ( *t == RBRACE ) n--;
1535  *fill++ = *t++;
1536  }
1537  }
1538  }
1539  else if ( *t == TVECTOR ) {
1540  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1541  if ( *t == TFUNOPEN ) {
1542  *fill++ = *t++; n = 0;
1543  while ( n >= 0 ) {
1544  if ( *t == TFUNOPEN ) n++;
1545  else if ( *t == TFUNCLOSE ) n--;
1546  *fill++ = *t++;
1547  }
1548  }
1549  else if ( *t == TDOT ) {
1550  *fill++ = *t++;
1551  if ( *t == TVECTOR || *t == TDUBIOUS ) {
1552  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1553  }
1554  else if ( *t == TSET ) {
1555  *fill++ = *t++; num = 0;
1556  while ( *t >= 0 ) { num = 128*num + *t; *fill++ = *t++; }
1557  if ( Sets[num].type != CVECTOR ) {
1558  MesPrint("&Illegal set type in dotproduct");
1559  error = 1;
1560  }
1561  if ( *t == LBRACE ) {
1562  *fill++ = *t++; n = 0;
1563  while ( n >= 0 ) {
1564  if ( *t == LBRACE ) n++;
1565  else if ( *t == RBRACE ) n--;
1566  *fill++ = *t++;
1567  }
1568  }
1569  }
1570  else if ( *t == TSETNUM ) {
1571  *fill++ = *t++;
1572  while ( *t >= 0 ) { *fill++ = *t++; }
1573  *fill++ = *t++;
1574  while ( *t >= 0 ) { *fill++ = *t++; }
1575  }
1576  }
1577  else {
1578  MesPrint("&Illegal second element in dotproduct");
1579  error = 1;
1580  }
1581  }
1582  else {
1583  *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1584  if ( *t == TWILDCARD ) *fill++ = *t++;
1585  }
1586  *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1587  if ( *t == TPOWER ) goto doublepower;
1588  while ( fill > ff ) *--t = *--fill;
1589  s = t;
1590  }
1591  else if ( denom < 0 ) {
1592  fill = ff; ff[-1] = TMULTIPLY;
1593  *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.denomnum);
1594  *fill++ = TFUNOPEN; *fill++ = LPARENTHESIS;
1595  while ( ss < t ) *fill++ = *ss++;
1596  *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1597  while ( fill > ff ) *--t = *--fill;
1598  s = t; denom = 1; sube = 0;
1599  break;
1600  }
1601  sube = 0;
1602  break;
1603  case TEXPRESSION:
1604  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1605  t = s;
1606  if ( *t == TFUNOPEN ) {
1607  t++; n = 1;
1608  for(;;) {
1609  if ( *t == TFUNOPEN ) n++;
1610  else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1611  t++;
1612  }
1613  t++;
1614  }
1615  if ( *t == LBRACE ) {
1616  t++; n = 1;
1617  for(;;) {
1618  if ( *t == LBRACE ) n++;
1619  else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1620  t++;
1621  }
1622  t++;
1623  }
1624  if ( t > s || denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1625  && t[1] == TMINUS ) ) goto dofunpower;
1626  else goto dosymbol;
1627  case TDOLLAR:
1628  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1629  goto dosymbol;
1630  case LPARENTHESIS:
1631  *fill++ = *s++; n = 1; t = s;
1632  for(;;) {
1633  if ( *t == LPARENTHESIS ) n++;
1634  else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1635  t++;
1636  }
1637  t++; sube = 1;
1638  goto dofunpower;
1639  case TSET:
1640  *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1641  while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1642  n = Sets[n].type;
1643  switch ( n ) {
1644  case CSYMBOL: goto dosymbol;
1645  case CINDEX: break;
1646  case CVECTOR: goto dovector;
1647  case CFUNCTION: goto dofunction;
1648  case CNUMBER: goto dosymbol;
1649  default: error = 1; break;
1650  }
1651  break;
1652  case TDOT:
1653 dodot: *fill++ = *s++;
1654  if ( *s == TVECTOR ) {
1655  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1656  }
1657  else if ( *s == TSET ) {
1658  *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1659  while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1660  if ( *s == LBRACE ) {
1661  if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1662  MesPrint("&This type of usage of sets is not allowed");
1663  error = 1;
1664  }
1665  *fill++ = *s++; n = 1;
1666  for(;;) {
1667  if ( *s == LBRACE ) n++;
1668  else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1669  *fill++ = *s++;
1670  }
1671  *fill++ = *s++;
1672  }
1673  else {
1674  MesPrint("&Set without argument in dotproduct");
1675  error = 1;
1676  }
1677  }
1678  else if ( *s == TSETNUM ) {
1679  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1680  if ( *s != TVECTOR ) goto nodot;
1681  *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1682  }
1683  else {
1684 nodot: MesPrint("&Illegal second element in dotproduct");
1685  error = 1;
1686  *fill++ = *s++;
1687  while ( *s >= 0 ) *fill++ = *s++;
1688  }
1689  dotp = 1;
1690  goto dosymbol;
1691  default:
1692  *fill++ = *s++;
1693  while ( *s >= 0 ) *fill++ = *s++;
1694  break;
1695  }
1696  }
1697  *fill = TENDOFIT;
1698  return(error);
1699 doublepower:;
1700  MesPrint("&Dubious notation with power of power");
1701  return(-1);
1702 }
1703 
1704 /*
1705  #] simp3btoken :
1706  #[ simp4token :
1707 
1708  Deal with the set[n] objects in the RHS.
1709 */
1710 
1711 int simp4token(SBYTE *s)
1712 {
1713  int error = 0, n, nsym, settype;
1714  WORD i, *w, *wstop, level;
1715  SBYTE *fill = s, *s1, *s2, *s3, type, s1buf[10];
1716  SBYTE *tbuf = s, *t, *t1;
1717 
1718  while ( *s != TENDOFIT ) {
1719  if ( *s != TSET ) {
1720  if ( *s == TEMPTY ) s++;
1721  else *fill++ = *s++;
1722  continue;
1723  }
1724  if ( fill[-1] == TWILDCARD ) { *fill++ = *s++; continue; }
1725  if ( fill[-1] == TNOT && fill[-2] == TWILDCARD ) { *fill++ = *s++; continue; }
1726  s1 = s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1727  i = Sets[n].type;
1728  if ( *s != LBRACE ) { while ( s1 < s ) *fill++ = *s1++; continue; }
1729  if ( n < AM.NumFixedSets || i == CRANGE ) {
1730  MesPrint("&It is not allowed to refer to individual elements of built in or ranged sets");
1731  error = 1;
1732  }
1733  s++;
1734  if ( *s != TSYMBOL && *s != TDOLLAR ) {
1735  MesPrint("&Set index in RHS is not a wildcard symbol or $-variable");
1736  error = 1;
1737  while ( s1 < s ) *fill++ = *s1++; continue;
1738  }
1739  settype = ( *s == TDOLLAR );
1740  s++; nsym = 0; s2 = s;
1741  while ( *s >= 0 ) nsym = 128*nsym + *s++;
1742  if ( *s != RBRACE ) {
1743  MesPrint("&Improper set argument in RHS");
1744  error = 1;
1745  while ( s1 < s ) *fill++ = *s1++; continue;
1746  }
1747  s++;
1748 /*
1749  Verify that nsym is a wildcard
1750 */
1751  if ( !settype ) {
1752  w = AC.ProtoType; wstop = w + w[1]; w += SUBEXPSIZE;
1753  while ( w < wstop ) {
1754  if ( *w == SYMTOSYM && w[2] == nsym ) break;
1755  w += w[1];
1756  }
1757  if ( w >= wstop ) {
1758 /*
1759  It could still be a summation parameter!
1760 */
1761  t = fill - 1;
1762  while ( t >= tbuf ) {
1763  if ( *t == TFUNCLOSE ) {
1764  level = 1; t--;
1765  while ( t >= tbuf ) {
1766  if ( *t == TFUNCLOSE ) level++;
1767  else if ( *t == TFUNOPEN ) {
1768  level--;
1769  if ( level == 0 ) break;
1770  }
1771  t--;
1772  }
1773  }
1774  else if ( *t == RBRACE ) {
1775  level = 1; t--;
1776  while ( t >= tbuf ) {
1777  if ( *t == RBRACE ) level++;
1778  else if ( *t == LBRACE ) {
1779  level--;
1780  if ( level == 0 ) break;
1781  }
1782  t--;
1783  }
1784  }
1785  else if ( *t == RPARENTHESIS ) {
1786  level = 1; t--;
1787  while ( t >= tbuf ) {
1788  if ( *t == RPARENTHESIS ) level++;
1789  else if ( *t == LPARENTHESIS ) {
1790  level--;
1791  if ( level == 0 ) break;
1792  }
1793  t--;
1794  }
1795  }
1796  else if ( *t == TFUNOPEN ) {
1797  t1 = t-1;
1798  while ( *t1 > 0 && t1 > tbuf ) t1--;
1799  if ( *t1 == TFUNCTION ) {
1800  t1++; level = 0;
1801  while ( *t1 > 0 ) level = level*128+*t1++;
1802  if ( level == (SUMF1-FUNCTION)
1803  || level == (SUMF2-FUNCTION) ) {
1804  t1 = t + 1;
1805  if ( *t1 == LPARENTHESIS ) t1++;
1806  if ( *t1 == TSYMBOL ) {
1807  if ( ( t1[1] == COEFFSYMBOL
1808  || t1[1] == NUMERATORSYMBOL
1809  || t1[1] == DENOMINATORSYMBOL )
1810  && t1[2] < 0 ) {}
1811  else {
1812  t1++; level = 0;
1813  while ( *t1 >= 0 && t1 < fill ) level = 128*level + *t1++;
1814  if ( level == nsym && t1 < fill ) {
1815  if ( t[1] == LPARENTHESIS
1816  && *t1 == RPARENTHESIS && t1[1] == TCOMMA ) break;
1817  if ( t[1] != LPARENTHESIS && *t1 == TCOMMA ) break;
1818  }
1819  }
1820  }
1821  }
1822  }
1823  }
1824  t--;
1825  }
1826  if ( t < tbuf ) {
1827  fill--;
1828  MesPrint("&Set index in RHS is not a wildcard symbol");
1829  error = 1;
1830  while ( s1 < s ) *fill++ = *s1++; continue;
1831  }
1832  }
1833  }
1834 /*
1835  Now replace by a set marker: TSETNUM,nsym,TYPE,setnumber
1836 */
1837  switch ( i ) {
1838  case CSYMBOL: type = TSYMBOL; break;
1839  case CINDEX: type = TINDEX; break;
1840  case CVECTOR: type = TVECTOR; break;
1841  case CFUNCTION: type = TFUNCTION; break;
1842  case CNUMBER: type = TNUMBER1; break;
1843  case CDUBIOUS: type = TDUBIOUS; break;
1844  default:
1845  MesPrint("&Unknown set type in simp4token");
1846  error = 1; type = CDUBIOUS; break;
1847  }
1848  s3 = s1buf; s1++;
1849  while ( *s1 >= 0 ) *s3++ = *s1++;
1850  *s3 = -1; s1 = s1buf;
1851  if ( settype ) *fill++ = TSETDOL;
1852  else *fill++ = TSETNUM;
1853  while ( *s2 >= 0 ) *fill++ = *s2++;
1854  *fill++ = type; while ( *s1 >= 0 ) *fill++ = *s1++;
1855  }
1856  *fill++ = TENDOFIT;
1857  return(error);
1858 }
1859 
1860 /*
1861  #] simp4token :
1862  #[ simp5token :
1863 
1864  Making sure that first argument of sumfunction is not a wildcard already
1865 */
1866 
1867 int simp5token(SBYTE *s, int mode)
1868 {
1869  int error = 0, n, type;
1870  WORD *w, *wstop;
1871  if ( mode == RHSIDE ) {
1872  while ( *s != TENDOFIT ) {
1873  if ( *s == TFUNCTION ) {
1874  s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1875  if ( n == AM.sumnum || n == AM.sumpnum ) {
1876  if ( *s != TFUNOPEN ) continue;
1877  s++;
1878  if ( *s != TSYMBOL && *s != TINDEX ) continue;
1879  type = *s++;
1880  n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1881  if ( type == TINDEX ) n += AM.OffsetIndex;
1882  if ( *s != TCOMMA ) continue;
1883  w = AC.ProtoType;
1884  wstop = w + w[1];
1885  w += SUBEXPSIZE;
1886  while ( w < wstop ) {
1887  if ( w[2] == n ) {
1888  if ( ( type == TSYMBOL && ( w[0] == SYMTOSYM
1889  || w[0] == SYMTONUM || w[0] == SYMTOSUB ) ) || (
1890  type == TINDEX && ( w[0] == INDTOIND
1891  || w[0] == INDTOSUB ) ) ) {
1892  error = 1;
1893  MesPrint("&Parameter of sum function is already a wildcard");
1894  }
1895  }
1896  w += w[1];
1897  }
1898  }
1899  }
1900  else s++;
1901  }
1902  }
1903  return(error);
1904 }
1905 
1906 /*
1907  #] simp5token :
1908  #[ simp6token :
1909 
1910  Making sure that factorized expressions are used properly
1911 */
1912 
1913 int simp6token(SBYTE *tokens, int mode)
1914 {
1915 /* EXPRESSIONS e = Expressions; */
1916  int error = 0, n;
1917  int level = 0, haveone = 0;
1918  SBYTE *s = tokens, *ss;
1919  LONG numterms;
1920  WORD funnum = 0;
1921  GETIDENTITY
1922  if ( mode == RHSIDE ) {
1923  while ( *s == TPLUS || *s == TMINUS ) s++;
1924  numterms = 1;
1925  while ( *s != TENDOFIT ) {
1926  if ( *s == LPARENTHESIS ) level++;
1927  else if ( *s == RPARENTHESIS ) level--;
1928  else if ( *s == TFUNOPEN ) level++;
1929  else if ( *s == TFUNCLOSE ) level--;
1930  else if ( ( *s == TPLUS || *s == TMINUS ) && level == 0 ) {
1931 /*
1932  Special exception: x^-1 etc.
1933 */
1934  if ( s[-1] != TPOWER && s[-1] != TPLUS && s[-1] != TMINUS ) {
1935  numterms++;
1936  }
1937  }
1938  else if ( *s == TEXPRESSION ) {
1939  ss = s;
1940  s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
1941 
1942  if ( Expressions[n].status == STOREDEXPRESSION ) {
1943  POSITION position;
1944 /*
1945 #ifdef WITHPTHREADS
1946  RENUMBER renumber;
1947 #endif
1948 */
1949  RENUMBER renumber;
1950 
1951  WORD TMproto[SUBEXPSIZE];
1952  TMproto[0] = EXPRESSION;
1953  TMproto[1] = SUBEXPSIZE;
1954  TMproto[2] = n;
1955  TMproto[3] = 1;
1956  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1957  AT.TMaddr = TMproto;
1958  PUTZERO(position);
1959 /*
1960  if ( (
1961 #ifdef WITHPTHREADS
1962  renumber =
1963 #endif
1964  GetTable(n,&position,0) ) == 0 )
1965 */
1966  if ( ( renumber = GetTable(n,&position,0) ) == 0 )
1967  {
1968  error = 1;
1969  MesPrint("&Problems getting information about stored expression %s(4)"
1970  ,EXPRNAME(n));
1971  }
1972 /*
1973 #ifdef WITHPTHREADS
1974 */
1975  if ( renumber->symb.lo != AN.dummyrenumlist )
1976  M_free(renumber->symb.lo,"VarSpace");
1977  M_free(renumber,"Renumber");
1978 /*
1979 #endif
1980 */
1981  }
1982 
1983  if ( ( ( AS.Oldvflags[n] & ISFACTORIZED ) != 0 ) && *s != LBRACE ) {
1984  if ( level == 0 ) {
1985  haveone = 1;
1986  }
1987  else if ( error == 0 ) {
1988  if ( ss[-1] != TFUNOPEN || funnum != NUMFACTORS-FUNCTION ) {
1989  MesPrint("&Illegal use of factorized expression(s) in RHS");
1990  error = 1;
1991  }
1992  }
1993  }
1994  continue;
1995  }
1996  else if ( *s == TFUNCTION ) {
1997  s++; funnum = 0; while ( *s >= 0 ) funnum = 128*funnum + *s++;
1998  continue;
1999  }
2000  s++;
2001  }
2002  if ( haveone ) {
2003  if ( numterms > 1 ) {
2004  MesPrint("&Factorized expression in RHS in an expression of more than one term.");
2005  error = 1;
2006  }
2007  else if ( AC.ToBeInFactors == 0 ) {
2008  MesPrint("&Attempt to put a factorized expression inside an unfactorized expression.");
2009  error = 1;
2010  }
2011  }
2012  }
2013  return(error);
2014 }
2015 
2016 /*
2017  #] simp6token :
2018  #] Compiler :
2019 */
2020 /* temporary commentary for forcing cvs merge */
Definition: structs.h:483
VARRENUM symb
Definition: structs.h:180
WORD * lo
Definition: structs.h:167