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